2
2

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 1 year has passed since last update.

多段階選抜 (VB)

Last updated at Posted at 2014-09-10
多段階選抜 解答日 シリーズ:yieldの練習/ジェネレータを入れ子に/整数平方根・立方根の実装
問題   http://nabetani.sakura.ne.jp/hena/ord24eliseq/
https://qiita.com/Nabetani/items/1c83005a854d2c6cbb69
Ruby 2014/8/2(当日) https://qiita.com/cielavenir/items/9f15e29b73ecf98968a5
C#/Python 2014/8/4 https://qiita.com/cielavenir/items/a1156e6a4f71ddbe5dcb
  ここから上はdrop_prev_square/drop_prev_cubicをまとめる前の答案
Go/C#/Ruby/Python 2014/8/5 https://qiita.com/cielavenir/items/2a685d3080862f2c2c47
PHP/JavaScript 2014/9/9 https://qiita.com/cielavenir/items/28d613ac3823afbf8407
VB 2014/9/10 https://qiita.com/cielavenir/items/cb7266abd30eadd71c04
D 2015/12/21 https://qiita.com/cielavenir/items/47c9e50ee60bef2847ec
Perl 2017/3/10 https://qiita.com/cielavenir/items/6dfbff749d833c0fd423
Lua 2017/3/13 https://qiita.com/cielavenir/items/c60fe7e8da73487ba062
C++20(TS) 2017/3/15 https://qiita.com/cielavenir/items/e1129ca185008f49cbab (MSVC)
https://qiita.com/cielavenir/items/1cfa90d73d11bb7dc3d4 (clang)
F# 2017/3/17 https://qiita.com/cielavenir/items/a698d6a26824ff53de81
Boo/Nemerle 2017/5/13 https://qiita.com/cielavenir/items/e2a783f0fe4b0fe0ed48
Perl6 2017/5/15 https://qiita.com/cielavenir/items/656ea17fa96c865c4498
Kotlin 2017/5/25 https://qiita.com/cielavenir/items/9c46ce8d9d12e51de285
Crystal 2018/5/8 https://qiita.com/cielavenir/items/1815bfa6a860fd1f90db
MoonScript 2018/6/16 https://qiita.com/cielavenir/items/8b03cce0386f4537b5ad
Julia/Rust 2018/12/20 https://qiita.com/cielavenir/items/3ddf72b06d625da0c4a5
Nim 2018/12/26 https://qiita.com/cielavenir/items/5728944867e609fd52a7
Tcl 2018/12/31 https://qiita.com/cielavenir/items/76cbd9c2022b48c9a2c9
Pascal/Cobra 2019/1/16 https://qiita.com/cielavenir/items/81b81baf8dfc1f877903
Icon 2019/1/17 https://qiita.com/cielavenir/items/889622dcc721f5a4da24
Swift 2020/5/31 https://qiita.com/cielavenir/items/3b0b84a218e35d538f7f
Java/Groovy/Scala 2020/5/31 https://qiita.com/cielavenir/items/7f058203a8fd03b65870
V 2020/10/17 https://qiita.com/cielavenir/items/df30a6c101a97a713df5
Zig/Zen 2020/10/17 https://qiita.com/cielavenir/items/9cced9e4a94dcd70df0f
Pike 2020/11/2 https://qiita.com/cielavenir/items/3a8248f41611302b34fd
Vala/Smalltalk 2020/11/29 https://qiita.com/cielavenir/items/085dabe593cd916af5e8
Objective-C 2020/11/30 https://qiita.com/cielavenir/items/a1736e38789a3dd5cc5a
Ruby(Ractor) 2021/1/2 https://qiita.com/cielavenir/items/f493c6d512b63cc571cc
Python(_xxsubinterpreters) 2021/6/29 https://qiita.com/cielavenir/items/f1f581a055db918954f1
Falcon/Scheme 2021/9/5 https://qiita.com/cielavenir/items/c13d12cf44f0d17f4a94
Clojure/Lisp 2021/9/7 https://qiita.com/cielavenir/items/7458ba076f4e5bc0f196
(icbrtの実装に関する)補題 2017/5/11 整数除算であってもn/(x*y)はn/x/yに等しい(ことの証明)
https://qiita.com/cielavenir/items/21a6711afd6be8c18c55

VB

うまくテストできなかったので、WinでコンパイルしたexeをOSXに転送してテストした。
なので細かい部分が怪しいですが、気にしない。
ちなみにWinで直接実行した限りでは、DllImportは msvcr120 にしないといけなかった。びっくり。

hena24_enum.vb
' http://qiita.com/Nabetani/items/1c83005a854d2c6cbb69
' http://nabetani.sakura.ne.jp/hena/ord24eliseq/

imports System
imports System.Linq
imports System.Collections.Generic
'imports System.Runtime.InteropServices

module Hena24
	'<DllImport("c")>
	'private function cbrt(ByVal d as double) as double
	'end function

	private function isqrt(ByVal n as integer) as integer
		if n<=0
			return 0
		end if
		if n<4
			return 1
		end if
		dim x as integer=0
		dim y as integer=n
		while x<>y andalso x+1<>y
			x=y
			y=((n\y)+y)\2
		end while
		return x
	end function
	private function icbrt(ByVal n as integer) as integer
		if n<0
			return -icbrt(-n)
		end if
		if n=0
			return 0
		end if
		if n<8
			return 1
		end if
		dim x as integer=0
		dim y as integer=n
		while x<>y andalso x+1<>y
			x=y
			y=((n\y\y)+y*2)\3
		end while
		return x
	end function

	private function is_sq(ByVal n as integer) as boolean
		dim x as integer=isqrt(n)
		'cint(Math.Sqrt(n))
		return x*x=n
	end function

	private function is_cb(ByVal n as integer) as boolean
		dim x as integer=icbrt(n)
		'cint(cbrt(n))
		return x*x*x=n
	end function

	private function is_multiple(ByVal i as integer,ByVal n as integer) as boolean
		return i mod n=0
	end function
	private function is_le(ByVal i as integer,ByVal n as integer) as boolean
		return i<=n
	end function

	iterator function generate() as IEnumerable(of integer)
		dim i as integer=1
		while true
			yield i
			i+=1
		end while
	end function

	iterator function drop_prev(ByVal check as Func(of integer,boolean),ByVal _prev as IEnumerable(of integer)) as IEnumerable(of integer)
		dim prev as IEnumerator(of integer)=_prev.GetEnumerator()
		prev.MoveNext()
		dim a as integer=prev.Current
		prev.MoveNext()
		dim b as integer=prev.Current
		while true
			if not check(b)
				yield a
			end if
			a=b
			prev.MoveNext()
			b=prev.Current
		end while
	end function

	iterator function drop_next(ByVal check as Func(of integer,boolean),ByVal _prev as IEnumerable(of integer)) as IEnumerable(of integer)
		dim prev as IEnumerator(of integer)=_prev.GetEnumerator()
		prev.MoveNext()
		dim a as integer=prev.Current
		prev.MoveNext()
		dim b as integer=prev.Current
		yield a
		while true
			if not check(a)
				yield b
			end if
			a=b
			prev.MoveNext()
			b=prev.Current
		end while
	end function

	iterator function drop_n(ByVal check as Func(of integer,integer,boolean),ByVal n as integer,ByVal _prev as IEnumerable(of integer)) as IEnumerable(of integer)
		dim prev as IEnumerator(of integer)=_prev.GetEnumerator()
		dim i as integer=0
		while true
			i+=1
			prev.MoveNext()
			dim a as integer=prev.Current
			if not check(i,n)
				yield a
			end if
		end while
	end function

	sub Main()
		dim f as new Dictionary(of char,Func(of IEnumerable(of integer),IEnumerable(of integer))) from {
			{"S"c,Function(e) drop_next(addressof is_sq,e)},
			{"s"c,Function(e) drop_prev(addressof is_sq,e)},
			{"C"c,Function(e) drop_next(addressof is_cb,e)},
			{"c"c,Function(e) drop_prev(addressof is_cb,e)},
			{"h"c,Function(e) drop_n(addressof is_le,100,e)}
		}
		for i as integer=2 to 9
			dim j as integer=i
			f(chr(48+j)) = Function(e) drop_n(addressof is_multiple,j,e)
		next
		dim line as string=Console.ReadLine()
		while line isnot nothing
			dim first as boolean=true
			'cS => f("S"c)(f("c"c)(generate()))
			for each n as integer in line.Aggregate(generate(),Function(s,e) f(e)(s)).Take(10)
				if not first
					Console.Write(","c)
				end if
				first=false
				Console.Write(n)
			next
			Console.WriteLine()
			Console.Out.Flush()
			line=Console.ReadLine()
		end while
	end sub
end module
2
2
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
2
2

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?