補足をすると、クイズとしては GCD を使わずに 既約分数を列挙するアルゴリズムを見つけられる(知っている、調べてこれる)かを問う問題だったようです。そこに気づかなかったので、せっかくの時計技師のヒントも活かせませんでした。暗号化技術とも関係なかったみたいです。--sumim問題:正の整数Nが与えられているとき、 以下の条件を満たす既約分数p/qを「すべて」求めるアルゴリズムを示してください。 条件は:
- p, qは整数(pは0以上で、qは1以上N以下).
- gcd(p, q) = 1 (pとqの最大公約数は1).
- 0 <= p/q <= 1.
おなじものを、ひとつの式ですむよう書き直したもの。| n fractions | n := 12. fractions := Set new. (1 to: n) do: [ :q | (0 to: q) do: [ :p | fractions add: (p/q) ]]. ^ fractions => a Set(0 1 (1/3) (1/2) (2/3) (1/4) (1/5) (3/4) (2/5) (3/5) (4/5) (1/6) (5/6) (1/7) (2/7) (3/7) (4/7) (5/7) (6/7) (1/8) (3/8) (5/8) (7/8) (1/9) (2/9) (4/9) (5/9) (7/9) (8/9) (1/10) (3/10) (7/10) (9/10) (1/11) (2/11) (3/11) (4/11) (5/11) (6/11) (7/11) (8/11) (9/11) (10/11) (1/12) (5/12) (7/12) (11/12))
分数を扱えるよう mathn をあらかじめロード (load 'mathn.rb') しておく必要はあるが、Ruby でも、Smalltalk の Set の役割を、その Array と Array#uniq に置き換えることでほぼ同様のことが可能である (ただし、Enumerable#inject を使うときは 1.7 以降で)。(1 to: 12) inject: Set new into: [ :fractions :q | (0 to: q) do: [ :p | fractions add: (p/q) ]. fractions ]
--sumim(1..12).inject([]){|fracs,q|(0..q).each{|p|fracs<<(p/q)};fracs}.uniq => [0, 1, 1/2, 1/3, 2/3, 1/4, 3/4, 1/5, 2/5, 3/5, 4/5, 1/6, 5/6, 1/7, 2/7, 3/7, 4/7, 5/7, 6/7, 1/8, 3/8, 5/8, 7/8, 1/9, 2/9, 4/9, 5/9, 7/9, 8/9, 1/10, 3/10, 7/10, 9/10, 1/11, 2/11, 3/11, 4/11, 5/11, 6/11, 7/11, 8/11, 9/11, 10/11, 1/12, 5/12, 7/12, 11/12]
--sumim| n fractions | n := 12. fractions := Set new. (1 to: n) do: [ :q | (0 to: q) do: [ :p | fractions add: (p/q) ]]. ^ fractions asSortedCollection => a SortedCollection(0 (1/12) (1/11) (1/10) (1/9) (1/8) (1/7) (1/6) (2/11) (1/5) (2/9) (1/4) (3/11) (2/7) (3/10) (1/3) (4/11) (3/8) (2/5) (5/12) (3/7) (4/9) (5/11) (1/2) (6/11) (5/9) (4/7) (7/12) (3/5) (5/8) (7/11) (2/3) (7/10) (5/7) (8/11) (3/4) (7/9) (4/5) (9/11) (5/6) (6/7) (7/8) (8/9) (9/10) (10/11) (11/12) 1) あるいは、 | n fractions | n := 12. fractions := Set new. (1 to: n) do: [ :q | (0 to: q) do: [ :p | fractions add: (p/q) ]]. ^ fractions asSortedArray => #(0 (1/12) (1/11) (1/10) (1/9) (1/8) (1/7) (1/6) (2/11) (1/5) (2/9) (1/4) (3/11) (2/7) (3/10) (1/3) (4/11) (3/8) (2/5) (5/12) (3/7) (4/9) (5/11) (1/2) (6/11) (5/9) (4/7) (7/12) (3/5) (5/8) (7/11) (2/3) (7/10) (5/7) (8/11) (3/4) (7/9) (4/5) (9/11) (5/6) (6/7) (7/8) (8/9) (9/10) (10/11) (11/12) 1)
かなり高速化が図られ、String 生成のコストがかからないのもあってか、Set 版の最遅から一転、下に示す GCD 版を抜いて Squeak 環境における最高速をたたき出した。--sumim| n fractions | n := 12. fractions := OrderedCollection newFrom: #(0 1). (1 to: n) do: [ :q | (0 to: q) do: [ :p | | fraction | ((fraction := p/q) class == Fraction and: [fraction numerator == p]) ifTrue: [fractions add: fraction]]]. ^ fractions asSortedArray
すると、分子 p が素数のとき( p が 1 のときを除き)、p - 1 回出現して 1 回休むを繰り返している。p が素数でないときは、p の素因数の出現パターンそれぞれの合成(論理積)であることも分かった。そこで、分母 q のとき、1 から q - 1 までの可能性のある p について、その素因数の出現パターンに照らして要不要が判断できることが分かる。素因数はあらかじめ、n までの数について求めたものをそれぞれ配列 factors の対応する位置に収めておき、p の要不要判断時に呼び出している。出現数 (q - p) の剰余 (#\\) がゼロになる p の素因数があれば、その p は省く。(/ 2): 1 (/ 3): 1 2 (/ 4): 1 3 (/ 5): 1 2 3 4 (/ 6): 1 5 (/ 7): 1 2 3 4 5 6 (/ 8): 1 3 5 7 (/ 9): 1 2 4 5 7 8 (/10): 1 3 7 9 (/11): 1 2 3 4 5 6 7 8 9 10 (/12): 1 5 7 11 (/13): 1 2 3 4 5 6 7 8 9 10 11 12 (/14): 1 3 5 9 11 13 (/15): 1 2 4 7 8 11 13 14 (/16): 1 3 5 7 9 11 13 15 (/17): 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 (/18): 1 5 7 11 13 17 (/19): 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 (/20): 1 3 7 9 11 13 17 19 (/21): 1 2 4 5 8 10 11 13 16 17 19 20 (/22): 1 3 5 7 9 13 15 17 19 21 (/23): 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
残念ながら、Smalltalk システムにはあらかじめ素因数分解機能が組み込まれていないので別に用意しておく必要がある。まず 2 で割り切れなくなるまで割って、次に 3 で割り切れなくなるまで割って…と単純に繰り返すブルート・フォース法で実装した。| n fractions factors | n := 12. fractions := OrderedCollection newFrom: #('0/1'). factors := Array new: n. (1 to: n) do: [ :m | factors at: m put: m factors asSet ]. (1 to: n) do: [ :q | | ps | ps := (1 to: q) reject: [ :p | (p > 1) and: [ ((factors at: p) collect: [ :factor | (q - p) \\ factor ]) includes: 0]]. ps do: [ :p | fractions add: p asString, '/', q asString ]]. ^ fractions => an OrderedCollection('0/1' '1/1' '1/2' '1/3' '2/3' '1/4' '3/4' '1/5' '2/5' '3/5' '4/5' '1/6' '5/6' '1/7' '2/7' '3/7' '4/7' '5/7' '6/7' '1/8' '3/8' '5/8' '7/8' '1/9' '2/9' '4/9' '5/9' '7/9' '8/9' '1/10' '3/10' '7/10' '9/10' '1/11' '2/11' '3/11' '4/11' '5/11' '6/11' '7/11' '8/11' '9/11' '10/11' '1/12' '5/12' '7/12' '11/12')
--sumimInteger >> factors | n factors reduce | n := self. factors := Bag new. reduce := [ :x | [ (n \\ x) == 0 ] whileTrue: [ factors add: x. n := n // x ]]. reduce value: 2. (3 to: self - 1 by: 2) do: [ :each | reduce value: each ]. ^ factors isEmpty ifTrue: [Bag with: self] ifFalse: [factors]
--sumimInteger >> factors | n factors | n := self. factors := Bag new. (Integer primesUpTo: (n // 2 max: 1)) do: [ :prime | [ (n \\ prime) == 0 ] whileTrue: [ factors add: prime. n := n // prime ]]. ^ factors isEmpty ifTrue: [Bag with: self] ifFalse: [factors]
ちなみに、#selct:thenCollect: は Haskell 版の [(n,i) | (p,i) <- zip (ss !! n) [0..n-1], p] の雰囲気を醸し出すために使っただけなので、わざわざこう変えなくとも、他のと同様に、| n fractions | n := 12. fractions := OrderedCollection new. (1 to: n) do: [ :q | fractions addAll: ( (0 to: q) select: [ :p | p isIrreducibleWith: q ] thenCollect: [ :p | p asString, '/', q asString ])]. ^ fractions
とネストさせたループのままで、Smalltalk 的には(Smalltalk 的にも?)ぜんぜんかまわない。(1 to: n) do: [ :q | (0 to: q) do: [ :p | (p isIrreducibleWith: q) ifTrue: [fractions add: (p asString, '/', q asString)] ]].
--sumimInteger >> irreducibilityCheckList | n cycle | n := self abs. n = 0 ifTrue: [^ Cycle newWith: {false} preceding: {false. true}]. cycle := (0 to: n - 1) collect: [ :m | m isIrreducibleWith: n ]. ^ Cycle newWith: cycle Integer >> isIrreducibleWith: anInteger ^ self irreducibilityCheckList at: anInteger + 1
--sumimInteger >> farey self = 1 ifTrue: [^ #((0 1) (1 1))]. ^ self rec: (self - 1) farey Integer >> rec: seriesArray seriesArray size = 1 ifTrue: [^ seriesArray]. seriesArray first second + seriesArray second second = self ifTrue: [ ^ {seriesArray first. {seriesArray first first + seriesArray second first. seriesArray first second + seriesArray second second}}, (self rec: seriesArray allButFirst)]. ^ {seriesArray first}, (self rec: seriesArray allButFirst) 12 farey => #(#(0 1) #(1 12) #(1 11) #(1 10) #(1 9) #(1 8) #(1 7) #(1 6) #(2 11) #(1 5) #(2 9) #(1 4) #(3 11) #(2 7) #(3 10) #(1 3) #(4 11) #(3 8) #(2 5) #(5 12) #(3 7) #(4 9) #(5 11) #(1 2) #(6 11) #(5 9) #(4 7) #(7 12) #(3 5) #(5 8) #(7 11) #(2 3) #(7 10) #(5 7) #(8 11) #(3 4) #(7 9) #(4 5) #(9 11) #(5 6) #(6 7) #(7 8) #(8 9) #(9 10) #(10 11) #(11 12) #(1 1))
--sumimInteger >> rec: series series cdr ifNil: [^ series]. series cdar + series cdadr = self ifTrue: [ ^ series car dot: ((series caar + series caadr dot: series cdar + series cdadr) dot: (self rec: series cdr))]. ^ series car dot: (self rec: series cdr) Integer >> farey self = 1 ifTrue: [^ List withAll: {0 dot: 1. 1 dot: 1}]. ^ self rec: (self - 1) farey (FileStream fileNamed: 'Farey.cs') fileIntoNewChangeSet. 12 farey => ((0 . 1) (1 . 12) (1 . 11) (1 . 10) (1 . 9) (1 . 8) (1 . 7) (1 . 6) (2 . 11) (1 . 5) (2 . 9) (1 . 4) (3 . 11) (2 . 7) (3 . 10) (1 . 3) (4 . 11) (3 . 8) (2 . 5) (5 . 12) (3 . 7) (4 . 9) (5 . 11) (1 . 2) (6 . 11) (5 . 9) (4 . 7) (7 . 12) (3 . 5) (5 . 8) (7 . 11) (2 . 3) (7 . 10) (5 . 7) (8 . 11) (3 . 4) (7 . 9) (4 . 5) (9 . 11) (5 . 6) (6 . 7) (7 . 8) (8 . 9) (9 . 10) (10 . 11) (11 . 12) (1 . 1))
--sumimgosh> (let ((t (make <real-time-counter>))) (with-time-counter t (farey 150)) (format #t "=> ~s\n" (time-counter-value t))) => 14.135 gosh> (time (farey 150) ()) ;(time (farey 150) ()) ; real 16.319 ; user 12.998 ; sys 0.000 () Time millisecondsToRun: [150 farey] => 7451
もちろん再帰版よりはるかに速いです。といっても、GCD 版、Set 抜きの Fraction 版には遠く及びませんが…。--sumim| n fractions isSaturated | n := 12. fractions := List withAll: {0 dot: 1. 1 dot: 1}. isSaturated := false. [isSaturated] whileFalse: [ | cons cdr | isSaturated := true. cons := fractions. [(cdr := cons cdr) isNil] whileFalse: [ | q | q := cons cdar + cdr cdar. q <= n ifTrue: [ cons cdr: ((cons caar + cdr caar dot: q) dot: cdr). q < n ifTrue: [isSaturated := false]]. cons := cdr]]. ^ fractions
--sumim| n rp | n := 12. World findATranscript: nil. Transcript cr. rp := RPrime new: n. (1 to: n) do: [ :d | (0 to: d) do: [ :n1 | (rp check: n1 with: d) ifTrue: [ Transcript show: n1 asString, '/', d asString; space]]]
ちなみに Squeak 環境では (Fraction を使わないのなら) これが一番速い。--sumim| n fractions | n := 12. fractions := OrderedCollection new. (1 to: n) do: [ :q | (0 to: q) do: [ :p | (p gcd: q) == 1 ifTrue: [fractions add: (p asString, '/', q asString)]]]. ^ fractions
| n list stable | n := 12. World findATranscript: nil. Transcript cr; show: 'N = ', n printString. list := OrderedCollection new. list add: (YukiFraction up: 0 down: 1). list add: (YukiFraction up: 1 down: 1). stable := false. [stable not] whileTrue: [ | next | next := OrderedCollection new. stable := true. (1 to: list size) do: [ :i | | left | left := list at: i. next add: left. (i < list size) ifTrue: [ | right middle | right := list at: i + 1. middle := left makeBetween: right. middle down <= n ifTrue: [ next add: middle. stable := false]]]. list := next]. Transcript cr; show: list asArray トランスクリプト (Smalltalk 環境の標準出力) への出力 => N = 12 #(0/1 1/12 1/11 1/10 1/9 1/8 1/7 1/6 2/11 1/5 2/9 1/4 3/11 2/7 3/10 1/3 4/11 3/8 2/5 5/12 3/7 4/9 5/11 1/2 6/11 5/9 4/7 7/12 3/5 5/8 7/11 2/3 7/10 5/7 8/11 3/4 7/9 4/5 9/11 5/6 6/7 7/8 8/9 9/10 10/11 11/12 1/1)
この手続きを済ませると、次のスクリプトが実行できるようになります。Link subclass: #YukiFraction instanceVariableNames: 'up down ' classVariableNames: '' poolDictionaries: '' category: 'Category-Yuki Quiz'
Link と LinkedList の組み合わせによって実現される連結リストは Java の Vector のそれに比べるとちょっと扱いにくいです。でも、まあ、仕組みを考えながら気をつけて扱えれば、OrderedCollection 版よりは速く動作するスクリプトを組むことができます。--sumim| n fractions isSaturated | n := 12. fractions := LinkedList new. fractions add: (YukiFraction up: 0 down: 1). fractions add: (YukiFraction up: 1 down: 1). isSaturated := false. [isSaturated] whileFalse: [ | left | isSaturated := true. left := fractions first. [left == fractions last] whileFalse: [ | right middle | right := left nextLink. middle := left makeBetween: right. middle down <= n ifTrue: [ left nextLink: (middle nextLink: right; yourself). middle down < n ifTrue: [isSaturated := false]]. left := right]]. ^ fractions
--sumim| n zeroFrac prevFracs nextFracs | n := 12. zeroFrac := #(0 1). prevFracs := OrderedCollection with: #(1 1). (2 to: n) do: [ :q | | prevFrac | nextFracs := OrderedCollection new. prevFrac := zeroFrac. prevFracs do: [ :nextFrac | prevFrac second + nextFrac second = q ifTrue: [nextFracs add: prevFrac + nextFrac]. nextFracs add: (prevFrac := nextFrac)]. prevFracs := nextFracs]. ^ {zeroFrac}, nextFracs => #(#(0 1) #(1 12) #(1 11) #(1 10) #(1 9) #(1 8) #(1 7) #(1 6) #(2 11) #(1 5) #(2 9) #(1 4) #(3 11) #(2 7) #(3 10) #(1 3) #(4 11) #(3 8) #(2 5) #(5 12) #(3 7) #(4 9) #(5 11) #(1 2) #(6 11) #(5 9) #(4 7) #(7 12) #(3 5) #(5 8) #(7 11) #(2 3) #(7 10) #(5 7) #(8 11) #(3 4) #(7 9) #(4 5) #(9 11) #(5 6) #(6 7) #(7 8) #(8 9) #(9 10) #(10 11) #(11 12) #(1 1))
しかし、ちょっとした文字列の連結にいちいち一時変数をあてがって、こんな長いコードを書いていられないので、String class >> #streamContents: という便利なメソッドが用意されているのでこれを利用する。さらに ; を使ったカスケード (同じオブジェクトにたたみかけるように次々とメッセージを送る)をうまく使えば、同じことを少しだけ短く表現できる。| p q stream | p := 2. q := 3. stream := WriteStream on: (String new: 10). stream print: p. stream nextPut: $/. stream print: q. ^ stream contents
これを使って、GCD 版を書き直すと、| p q | p := 2. q := 3. ^ String streamContents: [ :stream | stream print: p; nextPut: $/; print: q ]
となり、N = 500 のとき、連結版が約 10 秒(800Mhz Crusoe/Win XP) なのに対して、Stream 版は約 5 秒と 4 割強の節約になる。スターン・ブロコット木版が遅いのも、おそらく同じような理由 (配列オブジェクト生成のコスト) であると予想される。--sumim| n fractions | n := 12. fractions := OrderedCollection new. (1 to: n) do: [ :q | (0 to: q) do: [ :p | (p gcd: q) == 1 ifTrue: [ fractions add: (String streamContents: [ :stream | stream print: p; nextPut: $/; print: q ])]]]. ^ fractions
このページを編集 (23809 bytes)
以下の 1 ページから参照されています。 |
This page has been visited 10724 times.