●問題71
前置記法の数式を後置記法に変換する関数 prefix->postfix expr を定義してください。数式はリストで表して、演算子は +, -, *, / とします。
gosh> (prefix->postfix '(* (+ 1 2) (- 3 4))) (1 2 + 3 4 - *) gosh> (prefix->postfix '(* (+ 1 2) (- 3 (/ 4 5)))) (1 2 + 3 4 5 / - *)
●問題72
後置記法の数式を前置記法に変換する関数 postfix->prefix expr を定義してください。数式はリストで表して、演算子は +, -, *, / とします。
gosh> (postfix->prefix '(1 2 + 3 4 - *)) (* (+ 1 2) (- 3 4)) gosh> (postfix->prefix '(1 2 + 3 4 5 / - *)) (* (+ 1 2) (- 3 (/ 4 5)))
●問題73
前置記法の数式を中置記法に変換する関数 prefix->infix expr を定義してください。数式はリストで表して、演算子は +, -, *, / とします。なお、中置記法はカッコを使うことができます。
gosh> (prefix->infix '(* (+ 1 2) (- 3 4))) ((1 + 2) * (3 - 4)) gosh> (prefix->infix '(* (+ 1 2) (- 3 (/ 4 5)))) ((1 + 2) * (3 - (4 / 5)))
●問題74
中置記法で冗長なカッコをはずす関数 flatexpr expr を定義してください。
gosh> (flatexpr '((1 + 2) * (3 - 4))) ((1 + 2) * (3 - 4)) gosh> (flatexpr '((1 + 2) + (3 - 4))) (1 + 2 + 3 - 4) gosh> (flatexpr '((1 * 2) + (3 / 4))) (1 * 2 + 3 / 4)
●問題75
中置記法の数式を前置記法に変換する関数 infix->prefix expr を定義してください。数式はリストで表して、演算子は +, -, *, / とします。中置記法はカッコを使うことができます。
gosh> (infix->prefix '(1 + 2 + 3 + 4)) (+ (+ (+ 1 2) 3) 4) () gosh> (infix->prefix '((1 + 2) * (3 - 4))) (* (+ 1 2) (- 3 4)) () gosh> (infix->prefix '(1 * 2 + 3 / 4)) (+ (* 1 2) (/ 3 4)) ()
●問題76
後置記法の数式を中置記法に変換する関数 postfix->infix expr を定義してください。数式はリストで表して、演算子は +, -, *, / とします。中置記法はカッコを使うことができます。
gosh> (postfix->infix '(1 2 + 3 4 - *)) ((1 + 2) * (3 - 4)) gosh> (postfix->infix '(1 2 + 3 4 5 / - *)) ((1 + 2) * (3 - (4 / 5)))
●問題77
中置記法の数式を後置記法に変換する関数 infix->postfix expr を定義してください。数式はリストで表して、演算子は +, -, *, / とします。中置記法はカッコを使うことができます。
gosh> (infix->postfix '(1 + 2 - 3 + 4)) (1 2 + 3 - 4 +) () gosh> (infix->postfix '((1 + 2) * (3 - 4))) (1 2 + 3 4 - *) () gosh> (infix->postfix '((1 + 2) * (3 - 4 / 5))) (1 2 + 3 4 5 / - *) ()
●問題78
リスト ls のべき集合を求める関数 power-set ls を定義してください。たとえばリスト (a b c) のべき集合は nil, (a), (b), (c), (a b), (a c), (b c), (a b c) になります。
gosh> (power-set '(a b c)) (() (c) (b) (b c) (a) (a c) (a b) (a b c)) gosh> (power-set1 display '(a b c)) (a b c)(a b)(a c)(a)(b c)(b)(c)()#<undef>
●問題79
複雑なデータ構造をファイルなどに保存する場合、データ構造を線形なデータに変換できると便利です。このような操作を「シリアライズ (serialize) 」とか「シリアル化」といいます。逆に、元のデータ構造に戻す操作を「デシリアライズ」といいます。
リストを二分木として考えて、二分木をシリアライズする関数 serialize tree を定義してください。二分木は次の方法で簡単にシリアライズすることができます。
- 二分木を行きがけ順に巡回する。
- 節ではフラグ 0 を出力して左右の枝をたどる。
- 葉に到達したらフラグ 1 と要素を出力する。
なお、シリアライズしたデータはリストに格納して返すことにします。
gosh> (serialize '(a . b)) (0 1 a 1 b) gosh> (serialize '((a . b) . c)) (0 0 1 a 1 b 1 c) gosh> (serialize '((a . b) (c . d))) (0 0 1 a 1 b 0 0 1 c 1 d 1 ()) gosh> (serialize '(a (b (c . d) e) f)) (0 1 a 0 0 1 b 0 0 1 c 1 d 0 1 e 1 () 0 1 f 1 ())
●問題80
関数 seriallize でシリアライズしたデータを復元する関数 deserialize ls を定義してください。
gosh> (deserialize '(0 1 a 1 b)) (a . b) () gosh> (deserialize '(0 0 1 a 1 b 1 c)) ((a . b) . c) () gosh> (deserialize '(0 0 1 a 1 b 0 0 1 c 1 d 1 ())) ((a . b) (c . d)) ()
●問題81
バランスの取れた n 対のカッコ列を生成する高階関数 kakko func n を定義してください。カッコ列は ( と ) からなる列のことで、バランスが取れているカッコ列は、右カッコで閉じることができる、つまり右カッコに対応する左カッコがある状態のことをいいます。たとえば n = 1 の場合、( ) はバランスの取れたカッコ列ですが、) ( はバランスが取れていません。
gosh> (kakko print 3) ((())) (()()) (())() ()(()) ()()() #<undef> gosh> (kakko print 4) (((()))) ((()())) ((())()) ((()))() (()(())) (()()()) (()())() (())(()) (())()() ()((())) ()(()()) ()(())() ()()(()) ()()()() #<undef>
●問題82
カッコ列は二分木に対応させることができます。二分木の節をリスト (N L L) で表すことにします。N は節を表すシンボル、L は葉を表すシンボルとします。二分木をカッコ列に変換する関数 tree->kakko ls を定義してください。
gosh> (tree->kakko '(N (N (N L L) L) L)) "((()))" gosh> (tree->kakko '(N (N L L) (N L L))) "(())()" gosh> (tree->kakko '(N L (N L (N L L)))) "()()()" gosh> (tree->kakko '(N L (N (N L L) L))) "()(())" gosh> (tree->kakko '(N (N L (N L L)) L)) "(()())"
●問題83
tree->kakko の逆変換を行う関数 kakko->tree を定義してください。
gosh> (kakko->tree "((()))") (N (N (N L L) L) L) () gosh> (kakko->tree "(())()") (N (N L L) (N L L)) () gosh> (kakko->tree "()()()") (N L (N L (N L L))) () gosh> (kakko->tree "()(())") (N L (N (N L L) L)) () gosh> (kakko->tree "(()())") (N (N L (N L L)) L) ()
●問題84
バランスの取れた n 対のカッコ列の総数を求める関数 kakko-num n を定義してください。
gosh> (kakko-num 1) 1 gosh> (kakko-num 2) 2 gosh> (kakko-num 3) 5 gosh> (kakko-num 4) 14 gosh> (kakko-num 5) 42 gosh> (kakko-num 10) 16796 gosh> (kakko-num 50) 1978261657756160653623774456 gosh> (kakko-num 100) 896519947090131496687170070074100632420837521538745909320
●問題85
1 桁の 4 つの数字 (0 - 9 から 4 つ選ぶ) と *, -, *, /, ( ,) を使って、値が N になる式を求めるプログラムを作ってください。数字は並べ替えて使うことができます。ただし、18 や 26 のように複数の数字を連結して使ってはいけません。－を符号として使うことも禁止します。
●解答71
前置記法を後置記法に変換するのは簡単です。次の図を見てください。
上図のように、前置記法の数式は二分木そのものです。再帰呼び出しで二分木をたどり、(op x y) を (x y op) に変換すればいいだけです。プログラムは次のようになります。
リスト : 前置記法 -> 後置記法
(define (prefix->postfix expr)
(cond ((pair? expr)
(append (prefix->postfix (cadr expr))
(prefix->postfix (caddr expr))
(list (car expr))))
(else (list expr))))
引数 expr が数式を表すリストです。expr がリストの場合、prefix->postfix を再帰呼び出します。prefix->postfix の返り値はリストなので、カッコを外すために append で連結します。expr がリストでない場合、list で expr をリストに格納して返します。
●解答72
postfix->prefix は、後置記法の計算で作成した関数 rpn を改造すると簡単です。次のリストを見てください。
リスト : 後置記法 -> 前置記法
(define (postfix->prefix expr)
(let loop ((xs expr) (a '()))
(cond ((null? xs)
(if (null? (cdr a))
(car a)
(error "invalid expression")))
((number? (car xs))
(loop (cdr xs) (cons (car xs) a)))
((symbol? (car xs))
(loop (cdr xs) (cons (list (car xs) (cadr a) (car a)) (drop a 2))))
(else
(error "invalid data")))))
演算子を処理する場合、値を計算するかわりに前置記法に変換した数式 (op x y) をスタック a に追加するだけです。
●解答73
前置記法から中置記法へ変換する場合、冗長なカッコを取り除かないでよければとても簡単です。数式 (op x y) を (x op y) に変換するだけでいいのです。プログラムは次のようになります。
リスト : 前置記法 -> 中置記法
(define (prefix->infix expr)
(if (pair? expr)
(list (prefix->infix (cadr expr))
(car expr)
(prefix->infix (caddr expr)))
expr))
最初に expr をチェックして、リストでなければ expr をそのまま返します。これが再帰の停止条件になります。リストの場合は記法の変換を行います。prefix->infix を再帰呼び出しして引数を中置記法に変換します。そして、演算子を引数の間にセットして返します。
●解答74
冗長なカッコは、演算子の優先度を考慮することで取り除くことができます。たとえば、数式が ((1 + 2) * (3 / 4)) の場合を考えてみましょう。
((1 + 2) * (3 / 4)) => ((1 + 2) * 3 / 4)
演算子 * と + では、+ の方の重みが小さいですね。この場合、+ の方はカッコをはずすことができません。次の演算子 / は * と重みが同じなので、カッコをはずすことができます。
基本的な処理はこれでいいのですが、ひとつだけ問題があります。それは演算子が - と / のときにカッコをはずす場合です。次の例を見てください。
(1 - (2 - (3 - 4))) => (1 - (2 - 3 + 4))
=> (1 - 2 + 3 - 4)
(1 / (2 / (3 / 4))) => (1 / (2 / 3 * 4))
=> (1 / 2 * 3 / 4)
このように、演算子が - のときはカッコ内の + と - を、/ のときはカッコ内の * と / を反転させないといけません。この処理は map を使うと簡単に実現できます。
gosh> (map (lambda (x) (case x (+ '-) (- '+) (else x))) '(2 - 3 + 4)) (2 + 3 - 4) gosh> (map (lambda (x) (case x (+ '-) (- '+) (else x))) '(2 * (3 - 4))) (2 * (3 - 4))
リストの要素が + であれば - に、- であれば + に変更します。それ以外の要素はそのまま出力します。map はリストのトップレベルの要素に対してラムダ式を適用するので、たとえば、数式 (2 * (3 - 4)) の - を + に変更することはありません。
プログラムは次のようになります。
リスト : 余分なカッコをはずす
(define (change-op1 expr)
(map (lambda (x)
(case x
((+) '-)
((-) '+)
(else x)))
expr))
(define (change-op2 expr)
(map (lambda (x)
(case x
((*) '/)
((/) '*)
(else x)))
expr))
(define (check-op1 expr)
(if (pair? (cdr expr))
(case (cadr expr)
((+ -) (list expr))
(else expr))
expr))
(define (flatexpr expr)
(if (pair? expr)
(let ((e1 (flatexpr (car expr)))
(e2 (flatexpr (caddr expr))))
(case (cadr expr)
((+)
(append e1 (list '+) e2))
((-)
(append e1 (list '-) (change-op1 e2)))
((*)
(append (check-op1 e1) (list '*) (check-op1 e2)))
((/)
(append (check-op1 e1) (list '/) (change-op2 (check-op1 e2))))))
(list expr)))
関数 change-op1 は + と - を反転します。関数 change-op2 は * と / を反転します。関数 check-op1 は、演算子が + と - のとき、数式 expr をリストに格納して返します。これは演算子が * と / のときに呼び出します。
関数 flatexpr は引数 expr の余分なカッコをはずします。expr がリストの場合、flatexpr を再帰呼び出しします。(x op y) の x を変換して e1 に、y を変換して e2 にセットします。次に、op によって処理を分けます。+ の場合、append で e1 と (+) と e2 を連結するだけです。- の場合、change-op1 で e2 を変換して append で連結します。
* の場合、check-op1 で e2 の演算子をチェックします。+ と - の場合、e2 はリストに格納されて返されるので、カッコがはずされることはありません。* と / の場合はカッコがはずされます。/ の場合は、check-op1 の返り値を change-op2 で変換します。これでカッコをはずしたあとで、* と / を反転することができます。
●解答75
中置記法を前置記法に変換する関数 infix->prefix は、中置記法を数式を計算する関数 expression を改造すると簡単です。次のリストを見てください。
リスト : 中置記法 -> 前置記法
(define (inf-pre-factor ls)
(cond ((number? (car ls))
(values (car ls) (cdr ls)))
((pair? (car ls))
(values (infix->prefix (car ls)) (cdr ls)))
(else
(error "invalid expression"))))
(define (inf-pre-term ls)
(receive (x xs) (inf-pre-factor ls)
(let loop ((x x) (xs xs))
(cond ((null? xs) (values x '()))
((= (weight (car xs)) 2)
(receive (y ys) (inf-pre-factor (cdr xs))
(loop (list (car xs) x y) ys)))
(else (values x xs))))))
(define (infix->prefix ls)
(receive (x xs) (inf-pre-term ls)
(let loop ((x x) (xs xs))
(cond ((null? xs) (values x '()))
((= (weight (car xs)) 1)
(receive (y ys) (inf-pre-term (cdr xs))
(loop (list (car xs) x y) ys)))
(else (values x xs))))))
項の処理を関数 inf-pre-term で、因子の処理を inf-pre-factor で行います。値を計算するかわりに、x op y を (op x y) に変換して返すだけです。
●解答76
postfix->infix は、後置記法の計算で作成した関数 rpn を改造すると簡単に作成できます。次のリストを見てください。
リスト : 後置記法 -> 中置記法
(define (postfix->infix expr)
(let loop ((ls expr) (a '()))
(cond ((null? ls)
(if (null? (cdr a))
(car a)
(error "invalid expression")))
((number? (car ls))
(loop (cdr ls) (cons (car ls) a)))
((symbol? (car ls))
(if (null? (cdr a))
(error "stack underflow")
(loop (cdr ls)
(cons (list (cadr a) (car ls) (car a))
(drop a 2)))))
(else
(error "invalid data")))))
演算子を処理する場合、値を計算するかわりに中置記法に変換した数式 (x op y) をスタック a に追加するだけです。余分なカッコをはずす場合は flatexpr を適用してください。
●解答77
中置記法を後置記法に変換する関数 infix->postfix は、中置記法を数式を計算する関数 expression を改造すると簡単です。次のリストを見てください。
リスト : 中置記法 -> 後置記法
(define (inf-post-factor ls)
(cond ((number? (car ls))
(values (list (car ls)) (cdr ls)))
((pair? (car ls))
(values (infix->postfix (car ls)) (cdr ls)))
(else
(error "invalid expression"))))
(define (inf-post-term ls)
(receive (x xs) (inf-post-factor ls)
(let loop ((x x) (xs xs))
(cond ((null? xs) (values x '()))
((= (weight (car xs)) 2)
(receive (y ys) (inf-post-factor (cdr xs))
(loop (append x y (list (car xs))) ys)))
(else (values x xs))))))
(define (infix->postfix ls)
(receive (x xs) (inf-post-term ls)
(let loop ((x x) (xs xs))
(cond ((null? xs) (values x '()))
((= (weight (car xs)) 1)
(receive (y ys) (inf-post-term (cdr xs))
(loop (append x y (list (car xs))) ys)))
(else (values x xs))))))
項の処理を関数 inf-post-term で、因子の処理を inf-post-factor で行います。値を計算するかわりに、x op y を (x y op) に変換します。このとき、append で連結してカッコをはずすことに注意してください。
●解答78
リスト : べき集合
; べき集合
(define (power-set ls)
(if (null? ls)
(list '())
(append (power-set (cdr ls))
(map (lambda (xs) (cons (car ls) xs))
(power-set (cdr ls))))))
; 別解
(define (power-set1 func ls)
(define (power-sub ls a)
(if (null? ls)
(func (reverse a))
(begin
(power-sub (cdr ls) (cons (car ls) a))
(power-sub (cdr ls) a))))
;
(power-sub ls '()))
べき集合を求める関数 power-set は簡単です。ls が空リストの場合は nil を格納したリストを返します。そうでなければ power-set を再帰呼び出しして (cdr ls) のべき集合を求め、その集合に先頭要素 (car ls) を追加します。そして、その集合と (cdr ls) のべき集合を append で連結します。
別解の power-set1 は高階関数バージョンです。リストの長さを N とすると、べき集合の要素数は 2 ^ N になります。N が大きくなると、べき集合をリストに格納して返すことは困難になります。その場合は高階関数を使うとよいでしょう。
●解答79
リスト : 二分木のシリアライズ
(define (serialize tree)
(if (pair? tree)
(append (list 0)
(serialize (car tree))
(serialize (cdr tree)))
(list 1 tree)))
二分木のシリアライズは簡単です。引数 tree がリストの場合、0 を出力してから再帰呼び出しして CAR 部をたどり、それから CDR 部をたどります。その結果を append で連結すればいいわけです。葉 (要素) の場合は 1 と要素を格納したリストを返します。
●解答80
リスト : 二分木のデシリアライズ
(define (deserialize ls)
(case (car ls)
((0)
(receive (x ls1) (deserialize (cdr ls))
(receive (y ls2) (deserialize ls1)
(values (cons x y) ls2))))
((1)
(values (cadr ls) (cddr ls)))
(else
(error "deserialize error"))))
デシリアライズも簡単です。関数 deserialize は生成した二分木と残りのデータを多値で返します。リスト ls の先頭要素が 0 の場合、deserialize を再帰呼び出しして CAR 部の部分木 x を生成し、それから CDR 部の部分木 y を生成します。あとは (cons x y) を返すだけです。ls の先頭要素が 1 の場合は葉なので、次の要素 (cadr ls) を返すだけです。
●解答81
リスト : カッコ列の生成
(define (kakko func m)
(define (kakko-sub x y a)
(cond ((= x y m)
(func (list->string (reverse a))))
(else
(when (< x m)
(kakko-sub (+ 1 x) y (cons #\( a)))
(when (< y x)
(kakko-sub x (+ 1 y) (cons #\) a))))))
;
(kakko-sub 0 0 '()))
カッコ列の生成は簡単です。局所関数 kakko-sub の引数 x が左カッコの個数、引数 y が右カッコの個数を表します。引数 a は累積変数で、文字 #\(, #\) を格納したリストです。
バランスの取れたカッコ列の場合、x, y, m には y <= x <= m の関係が成り立ちます。x = y = m の場合、カッコ列がひとつ完成しました。リスト a を反転して list->string で文字列に変換し、引数の関数 func を呼び出します。そうでなければ、kakko-sub を再帰呼び出しします。x < m であれば左カッコを追加し、y < x であれば右カッコを追加します。これでカッコ列を生成することができます。
●解答82
バランスの取れたカッコ列と二分木は 1 対 1 に対応します。二分木を行きがけ順で巡回するとき、途中の節では左カッコ ( を出力して左右の枝をたどり、葉に到達したら右カッコ ) を出力すると、カッコ列を生成することができます。
リスト : 二分木をカッコ列に変換
(define (tree->kakko ls)
(define (tree-kakko-sub ls)
(cond ((pair? ls)
(append (list #\()
(tree-kakko-sub (cadr ls))
(tree-kakko-sub (caddr ls))))
(else (list #\)))))
;
(list->string (drop-right (tree-kakko-sub ls) 1)))
実際の処理は局所関数 tree-kakko-sub で行います。基本的な考え方は関数 serialize と同じです。ただし、最後に余分な右カッコが付いてくるので、関数 drop-right で最後の要素を削除してから、list->string で文字列に変換しています。drop-right は SRFI-1 に定義されている関数です。
●解答83
リスト : カッコ列を二分木に変換
(define (kakko->tree ks)
(define (kakko-sub ls)
(cond ((null? ls)
(values 'L '()))
((eqv? (car ls) #\))
(values 'L (cdr ls)))
(else
(receive (x xs) (kakko-sub (cdr ls))
(receive (y ys) (kakko-sub xs)
(values (list 'N x y) ys))))))
;
(kakko-sub (string->list ks)))
実際の処理は局所関数 kakko-sub で行います。基本的な考え方は関数 deserialize と同じです。ただし、右カッコがひとつ少ないので、引数 ls が空リストの場合は葉 L を返すようにします。
●解答84
カタラン数 - Wikipedia によると、カッコ列の総数は「カタラン数 (Catalan number) 」になるとのことです。カタラン数は次に示す公式で求めることができます。
(2n)!
Ｃn = ----------
(n+1)!n!
これをそのままプログラムしてもいいのですが、それではちょっと面白くないので別な方法でプログラムを作ってみましょう。カタラン数は次に示す経路図において、A から B までの最短距離の道順を求めるとき、対角線を超えないものの総数に一致します。
図 : 道順の総数の求め方
A からある地点にいたる最短距離の道順の総数は、左隣と真下の地点の値を足したものになります。一番下の地点は 1 で、対角線を越えた地点は 0 になります。あとは下から順番に足し算していけば、A から B までの道順の総数を求めることができます。上図の場合はカラタン数 Ｃ4 に相当し、その値は 14 となります。
これをそのままプログラムすると、次のようになります。
リスト : カッコ列の総数
(define (kakko-num m)
(let loop ((a (make-list (+ m 1) 1)))
(cond ((null? (cdr a))
(car a))
(else
(loop (cdr (reverse (fold (lambda (x b) (cons (+ x (car b)) b))
(list 0)
(cdr a)))))))))
最初に make-list で一番下の地点の道順の総数 (1) を格納したリスト生成します。これが変数 a の初期値になります。引数 m のカラタン数を求める場合、リストの大きさは m + 1 になります。あとは、リストの要素がひとつになるまで named-let で処理を繰り返します。
一段上の地点の値を求める場合、畳み込み fold を使うと簡単です。初期値はリスト (0) とします。これが対角線を越えた地点の値を表します。a の先頭要素は不要なので、cdr で削除してから fold に渡します。ラムダ式の引数 x が真下の地点の値、引数 b の先頭要素が左隣の地点の値になります。
あとは x と (car b) を足し算して、それを cons でリスト b の先頭に追加すればいいわけです。この場合、fold が返すリストは逆順になるので、reverse で反転してから cdr で先頭要素 (対角線を越えた地点の値) を削除します。これでカッコ列の総数 (カラタン数) を求めることができます。
●別解 (2012/01/08)
ベクタを使うともっと簡単になります。次の図を見てください。
0 : #(1 1 1 1 1) 1 : #(1 1 1 1 1) 2 : #(1 1 1+1=2 2+1=3 3+1=4) => #(1 1 2 3 4) 3 : #(1 1 2 3+2=5 5+4=9) => #(1 1 2 5 9) 4 : #(1 1 2 5 5+9=14) => #(1 1 2 5 14)
上図は Ｃn (n = 4) を求める場合です。大きさが n + 1, 要素の値が 1 のベクタを用意します。n = 0, 1 の場合は n 番目の要素をそのまま返します。n が 2 よりも大きい場合、変数 i を 2 に初期化して、i - 1 番目以降の要素の累積和を求めます。
たとえば i = 2 の場合、2 番目の要素は 1 番目の要素と自分自身を加算した値 2 になります。3 番目の要素は 2 番目の要素と自分自身を足した値 3 になり、4 番目の要素は 3 + 1 = 4 になります。次に i を +1 して同じことを繰り返します。3 番目の要素は 2 + 3 = 5 になり、4 番目の要素は 5 + 4 = 9 になります。i = 4 のとき、4 番目の要素は 5 + 9 = 14 となり、Ｃ4 の値を求めることができました。
プログラムは次のようになります。
リスト : カッコ列の総数
(define (kakko-num1 n)
(let ((table (make-vector (+ n 1) 1)))
(do ((i 2 (+ i 1)))
((< n i) (vector-ref table n))
(do ((j i (+ j 1)))
((< n j))
(inc! (vector-ref table j) (vector-ref table (- j 1)))))))
説明したことをそのままプログラムしただけなので、とくに難しいところはないと思います。
●解答85
それではプログラムを作りましょう。数式を二分木で表すと、次に示す 5 つのパターンになります。
X, Y, Z が演算子を表します。これを式で表すと、次のようになります。
(1) (a Y b) X (c Z d) (2) a X (b Y (c Z d)) (3) ((a Z b) Y c) X d (4) a X ((b Z c) Y d) (5) (a Y (b Z c)) X d
あとは、a, b, c, d に数字を、X, Y, Z に演算子 +, -, *, / を入れて数式を計算すればいいわけです。ただし、注意事項がひとつあります。Gauche の場合、0 で除算してもエラーにはなりません。次の例を見てください。
gosh> (/ 1 0) +inf.0 gosh> (+ (/ 1 0) 1) +inf.0 gosh> (= 10 +inf.0) #f
このように、Gauche では +inf.0 のまま計算できますが、0 で除算したときにエラーを送出する処理系の場合は、エラーを捕捉する処理が必要になります。ご注意くださいませ。
プログラムは次のようになります。
リスト : 切符番号の問題
; 数式を作る
(define (make-expr x y z a b c d)
`(((,a ,y ,b) ,x (,c ,z ,d))
(,a ,x (,b ,y (,c ,z ,d)))
(((,a ,z ,b) ,y ,c) ,x ,d)
(,a ,x ((,b ,z ,c) ,y ,d))
((,a ,y (,b ,z ,c)) ,x ,d)))
; 判定関数の生成
(define (make-checker n)
(let ((table '()))
(lambda (expr)
(let ((e1 (flatexpr expr)))
(when (and (= (expression e1) n)
(not (member e1 table)))
(push! table e1)
(print e1))))))
; 解法
(define (solve fn ls)
(for-each
(lambda (op)
(for-each
(lambda (nums)
(for-each
(lambda (expr) (fn expr))
(apply make-expr (append op nums))))
(permutation 4 ls)))
(repeat-perm 3 '(+ - * /))))
関数 make-expr は数字と演算子から 5 つ数式をリストに格納して返します。関数 make-checker は数式をチェックする関数を生成して返します。この関数の中で数式 expr を計算します。数式の計算は expression を使うと簡単です。このとき、flatexpr で冗長なカッコをはずしておきます。値が引数 n と等しくて、今までに出現していない数式であれば、それを table に格納して print で表示します。
関数 solve は for-each を 3 重で使います。最初に演算子の組み合わせを求めます。これは重複順列になるので関数 repeat-perm を使うと簡単です。次に数字の並びを求めます。これは順列になるので関数 permutaiton を使います。最後に、make-expr で 5 つの数式を生成し、引数として渡された関数 fn を呼び出して、条件を満たしている数式を出力します。
簡単な実行例を示します。
gosh> (solve (make-checker 10) '(6 7 8 9)) (6 + 8 / (9 - 7)) (8 / (9 - 7) + 6) (8 * (9 - 7) - 6) ((9 - 7) * 8 - 6) (6 - 8 / (7 - 9)) ((7 + 8) * 6 / 9) ((8 + 7) * 6 / 9) (6 * (7 + 8) / 9) (6 * (8 + 7) / 9) (6 / 9 * (7 + 8)) (6 / 9 * (8 + 7)) ((7 + 8) / 9 * 6) ((8 + 7) / 9 * 6) #<undef> gosh> (solve (make-checker 10) '(1 2 6 9)) (6 + (9 - 1) / 2) ((9 - 1) / 2 + 6) (2 * (9 - 1) - 6) ((9 - 1) * 2 - 6) (6 - (1 - 9) / 2) #<undef>