vieweditattachhistoryswikistopchangessearchhelp

Smalltalk で既約分数クイズ

結城さんの日記、「2003年12月30日 (火) - 既約分数」から、

問題：正の整数Nが与えられているとき、 以下の条件を満たす既約分数p/qを「すべて」求めるアルゴリズムを示してください。 条件は：

補足をすると、クイズとしては GCD を使わずに 既約分数を列挙するアルゴリズムを見つけられる(知っている、調べてこれる)かを問う問題だったようです。そこに気づかなかったので、せっかくの時計技師のヒントも活かせませんでした。暗号化技術とも関係なかったみたいです。--sumim

関連

--sumim

目次


とりあえず、Smalltalk で Fraction、Set を使ったバージョン

アルゴリズムと呼べるものではありませんが、Smalltalk の、それを単なる言語処理系として見たときの冗長さ(あるいは、“Smalltalk システム”というものになじみのない人にとって必要以上に複雑に感じられ、それゆえに批判の的にされることの多いクラスライブラリのきめの細かさ）に便乗した何のヒネリもない解法。分数の約分の作業は、Fraction (分数クラス。処理的には最大公約数を使用)に、重複排除は Set (要素の重複を許さないコンテナ)に委譲しているためコードには現れない、お気楽なコーディング。

やっていることは単純で、「要素の重複を許さない入れ物(Set)に、考え得る組み合わせでできる p/q を片っ端から放り込んでゆく」だけ。コードもそのままで短く読みやすい反面、効率はあまり良くはなく(Fraction への委譲はそれほどでもないが、Set のインスタンスの運用にはコストが伴う)、N = 500 くらいになるともうしばらくは返ってこない。0/1 、1/1 が 0 、1 になるのは Fraction に一任した都合。
| 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))
おなじものを、ひとつの式ですむよう書き直したもの。
(1 to: 12) inject: Set new into: [ :fractions :q | (0 to: q) do: [ :p | fractions add: (p/q) ]. fractions ]
分数を扱えるよう mathn をあらかじめロード (load 'mathn.rb') しておく必要はあるが、Ruby でも、Smalltalk の Set の役割を、その Array と Array#uniq に置き換えることでほぼ同様のことが可能である (ただし、Enumerable#inject を使うときは 1.7 以降で)。
(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

Fraction のインスタンスには大小関係があるので、出力をソートすれば大きさ順になる。
| 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)
--sumim

Set を使わないことで高速化

重複を排除するためにクラス Set を用いたのが思わぬ足かせになってしまっていたので、これをあきらめて、下の他の方法と同じように、an OrderedCollection に add: するかどうかを p と q の組み合わせで決める方式に切り換えてみた。ただ、ここで、p と q の最大公約数などを求めていては二度手間なので、p/q の結果が約分されたかどうかを、生成された分数の分子(numerator)と p とを比べることで判断している。0 と 1 はこの過程で省かれてしまうのであらかじめ追加しておいた。
| 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
かなり高速化が図られ、String 生成のコストがかからないのもあってか、Set 版の最遅から一転、下に示す GCD 版を抜いて Squeak 環境における最高速をたたき出した。--sumim

分子の素因数を使ってその出現の要不要を判断するバージョン

最大公約数を求めるのに素因数分解を使うのは効率が悪いとされているので、（最大公約数を直接求めるようなことはしていないものの）既約分数を得るのにこの方法は得策ではない可能性が高い。あと、つきつめると、p と q の最大公約数を求めているのと一緒で目新しさはない(^_^;)。

まず、nobsun さんの解法の着眼点を真似て、既約分数列の分子の数の現れ方にパターンがないかを調べてみた。
(/ 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
すると、分子 p が素数のとき( p が 1 のときを除き)、p - 1 回出現して 1 回休むを繰り返している。p が素数でないときは、p の素因数の出現パターンそれぞれの合成（論理積）であることも分かった。そこで、分母 q のとき、1 から q - 1 までの可能性のある p について、その素因数の出現パターンに照らして要不要が判断できることが分かる。素因数はあらかじめ、n までの数について求めたものをそれぞれ配列 factors の対応する位置に収めておき、p の要不要判断時に呼び出している。出現数 (q - p) の剰余 (#\\) がゼロになる p の素因数があれば、その p は省く。
| 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')
残念ながら、Smalltalk システムにはあらかじめ素因数分解機能が組み込まれていないので別に用意しておく必要がある。まず 2 で割り切れなくなるまで割って、次に 3 で割り切れなくなるまで割って…と単純に繰り返すブルート・フォース法で実装した。
Integer >> 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]
--sumim

指定した自然数以下の素数を出力するユーティリティメソッド (Integer class >> #primesUpTo: ) を使えば、もう少しすっきり書け、効率も若干向上する。
Integer >> 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]
--sumim

nobsun さん版を Smalltalk で

まず繰り返し無限数列を扱うことができるクラス Cycle を簡単に定義して、それを使って s を Integer >> irreducibilityCheckList に、最終的には p isIrreducibleWith: q で true か false かチェックできるようにして nobsun さんの Haskell 版の雰囲気を、いささか強引に Smalltalk で醸し出してみた。
| 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
ちなみに、#selct:thenCollect: は Haskell 版の [(n,i) | (p,i) <- zip (ss !! n) [0..n-1], p] の雰囲気を醸し出すために使っただけなので、わざわざこう変えなくとも、他のと同様に、
(1 to: n) do: [ :q | 
	(0 to: q) do: [ :p | 
		(p isIrreducibleWith: q) ifTrue: [fractions add: (p asString, '/', q asString)] ]].
とネストさせたループのままで、Smalltalk 的には(Smalltalk 的にも?)ぜんぜんかまわない。
Integer >> 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
--sumim

Shiro さん版を Smalltalk で

正直しくみはわけわかんないっす…けど、とりあえずコードだけコピー。(※ 模範解答と同じスターン・ブロコット木を使った解法でした)
Integer >> 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))
--sumim

Shiro さん版を Smalltalk で、もうすこし速く

配列連結のコストが無視できないため、上の Scheme から Smalltalk への焼き直し版は非常に遅い。そこで、低コストで連結できるリストをクラス List として定義し、それを使って書き直してみたところ N = 500 は無理だったが、N = 100 くらい (Time millisecondsToRun: [100 farey]) なら数秒で戻ってくるようになった。

Integer >> 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))
--sumim

計測してみると、意外や Gauche より速いので、このへたれリストを使うのも、そう悪くないのかも。
gosh> (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
--sumim

この自前 List を使って、再帰ではないループ版も書いてみました。
| 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
もちろん再帰版よりはるかに速いです。といっても、GCD 版、Set 抜きの Fraction 版には遠く及びませんが…。--sumim

向井さんの Ruby 版を Smalltalk で

キャッシュ付きの「互いに素」チェッカー(RPrime)を実現しておられるようです。(解説)

| 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]]]
--sumim

GCD を使ったオーソドックスなバージョン

問題にある条件をそのままコードに書き下したもの。
| 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
ちなみに Squeak 環境では (Fraction を使わないのなら) これが一番速い。--sumim

結城さんの Java 版を Smalltalk で

YukiFraction >> #makeBetween が既約分数になるのがみそのようです。これはやられちゃいました。Shiro さん版も同じ理屈？


| 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)

Java の Vector っぽいクラスはないものかと探していたら、a Link を要素とすることを前提とする LinkedList というクラスを見つけたので、これで書き直してみました。まず、YukiFraction を Link のサブクラスにする必要があります。
Link subclass: #YukiFraction
	instanceVariableNames: 'up down '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Category-Yuki Quiz'
この手続きを済ませると、次のスクリプトが実行できるようになります。
| 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
Link と LinkedList の組み合わせによって実現される連結リストは Java の Vector のそれに比べるとちょっと扱いにくいです。でも、まあ、仕組みを考えながら気をつけて扱えれば、OrderedCollection 版よりは速く動作するスクリプトを組むことができます。--sumim

Smalltalk でスターン・ブロコット木

あらためて、示された模範解答を Smalltalk で書き下ろし。
| 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))
--sumim

ちょっとだけ、Smalltalk 的な処理スピード考

Fraction のインスタンスを作る p / q (すべてがメッセージ送信の Smalltalk の場合、p ÷ q という二項演算ではなく、「 p というオブジェクトに / q というメッセージを送っている」と解釈する）はそれほど問題にならないが、p asString, '/', q asString はその都度、4 つもの String インスタンスが生成されるため思わぬコストがかかる (ちなみに、Smalltalk ではカンマ #, は、コレクションを引数にとるいっぱしのメソッド名である) 。つまり、
必要なのは最後のメッセージ送信で作られる 'p/q' だけで、他の 'p'、'q'、'p/' は無駄になる。このように複数の #, で文字列などを連続して連結する場合はいったん Stream のインスタンスを作ってそこに相次いで連結したい文字列を流し込み、その Stream の内容を改めて文字列などに戻したほうが効率がよい。
| p q stream |
p := 2.
q := 3.
stream := WriteStream on: (String new: 10).
stream print: p.
stream nextPut: $/.
stream print: q.
^ stream contents
しかし、ちょっとした文字列の連結にいちいち一時変数をあてがって、こんな長いコードを書いていられないので、String class >> #streamContents: という便利なメソッドが用意されているのでこれを利用する。さらに ; を使ったカスケード (同じオブジェクトにたたみかけるように次々とメッセージを送る)をうまく使えば、同じことを少しだけ短く表現できる。 
| p q |
p := 2.
q := 3.
^ String streamContents: [ :stream | stream print: p; nextPut: $/; print: q ]
これを使って、GCD 版を書き直すと、
| 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
となり、N = 500 のとき、連結版が約 10 秒（800Mhz Crusoe/Win XP) なのに対して、Stream 版は約 5 秒と 4 割強の節約になる。スターン・ブロコット木版が遅いのも、おそらく同じような理由 (配列オブジェクト生成のコスト) であると予想される。--sumim

このページを編集 (23809 bytes)

Congratulations! 以下の 1 ページから参照されています。

This page has been visited 10721 times.