M.Hiroi's Home Page

OCaml Programming

Yet Another OCaml Problems

[ PrevPage | OCaml | NextPage ]

●問題51

集合を表すリスト xs, ys の直積集合を求める関数 product xs ys を定義してください。xs の要素を xi, ys 要素を yj とすると、直積集合の要素は (xi, yj) となります。たとえば、Xs = [1; 2; 3], Ys = [4; 5] とすると、直積集合は[(1, 4); (1, 5); (2, 4); (2, 5); (3, 4); (3, 5)] になります。

val product : 'a list -> 'b list -> ('a * 'b) list = <fun>
# product [1; 2; 3; 4] [5; 6; 7; 8];;
- : (int * int) list =
[(1, 5); (1, 6); (1, 7); (1, 8); (2, 5); (2, 6); (2, 7); (2, 8); (3, 5);
 (3, 6); (3, 7); (3, 8); (4, 5); (4, 6); (4, 7); (4, 8)]

解答

●問題52

リスト ls のべき集合を求める関数 power_set ls を定義してください。たとえばリスト [1; 2; 3] のべき集合は [[]; [1]; [2]; [3]; [1; 2]; [1; 3]; [2; 3]; [1; 2; 3]] になります。また、power_set の高階関数版 power_set1 も定義してください。

val power_set : 'a list -> 'a list list = <fun>
val power_set1 : ('a list -> 'b) -> 'a list -> 'b = <fun>
# power_set [1; 2; 3];;
- : int list list = [[]; [3]; [2]; [2; 3]; [1]; [1; 3]; [1; 2]; [1; 2; 3]]
# power_set1 print_intlist [1; 2; 3];;
1 2 3
1 2
1 3
1
2 3
2
3

- : unit = ()

解答

●問題53

集合を表すリスト xs と ys の排他的論理和を求める関数 exclusive_or xs ys を定義してください。返り値は xs と ys の両方にちょうど 1 つだけ現れているような要素のリストになります。

val exclusive_or : 'a list -> 'a list -> 'a list = <fun>
# exclusive_or [1; 2; 3; 4] [3; 4; 5; 6];;
- : int list = [1; 2; 5; 6]

解答

●問題54

バランスの取れた n 対のカッコ列を生成する高階関数 kakko func n を定義してください。カッコ列は ( と ) からなる列のことで、バランスが取れているカッコ列は、右カッコで閉じることができる、つまり右カッコに対応する左カッコがある状態のことをいいます。たとえば n = 1 の場合、( ) はバランスの取れたカッコ列ですが、) ( はバランスが取れていません。

val kakko : (char list -> unit) -> int -> unit = <fun>
# kakko print_kakko 3;;
((()))
(()())
(())()
()(())
()()()
- : unit = ()
# kakko print_kakko 4;;
(((())))
((()()))
((())())
((()))()
(()(()))
(()()())
(()())()
(())(())
(())()()
()((()))
()(()())
()(())()
()()(())
()()()()
- : unit = ()

解答

●問題55

バランスの取れた n 対のカッコ列の総数を多倍長整数で求める関数 kakko_num n を定義してください。OCaml の場合、モジュール Num を使うと多倍長整数で計算することができます。モジュール Num は標準モジュールではないので、対話モードで #load "nums.cma";; とするか、ocaml nums.cma のように起動時にファイル名を指定して、モジュール Num をロードしてください。

# kakko_num 1;;
- : Num.num = Int 1
# kakko_num 2;;
- : Num.num = Int 2
# kakko_num 3;;
- : Num.num = Int 5
# kakko_num 4;;
- : Num.num = Int 14
# kakko_num 5;;
- : Num.num = Int 42
# kakko_num 10;;
- : Num.num = Int 16796
# string_of_num (kakko_num 50);;
- : string = "1978261657756160653623774456"
# string_of_num (kakko_num 100);;
- : string = "896519947090131496687170070074100632420837521538745909320"

解答

●問題56

逆ポーランド記法で書かれた数式を計算するプログラムを作ってください。数式はリストで表すものとにします。リストの要素は次のように定義します。

type item = Add | Sub | Mul | Div | Rpa | Lpa | N of int

演算子は Add (+), Sub (-), Mul (*), Div (/) で、数値は整数 (int) だけとします。Rpa, Lpa はカッコを表しますが、このプログラムでは使いません。

逆ポーランド記法について簡単に説明します。私達が普通に式を書く場合、1 + 2 のように演算子を真ん中に置きます。この書き方を「中置記法」といいます。このほかに、「前置記法」と「後置記法」という書き方があります。前置記法は演算子を前に置く書き方で、ポーランド記法 (Polish Notation) と呼ばれることもあります。たとえば、1 + 2 であれば + 1 2 と書きます。数式にカッコをつけてみると (+ 1 2) となり、Lisp / Scheme のプログラムになります。

後置記法は演算子を後ろに置く書き方で、逆ポーランド記法 (RPN : Reverse Polish Notation) と呼ばれることもあります。1 + 2 であれば 1 2 + のように書きます。逆ポーランド記法の利点は、計算する順番に演算子が現れるため、カッコが不要になることです。たとえば、1 と 2 の和と 3 と 4 の和との積という数式を表してみましょう。

中置記法: (1 + 2) * (3 + 4)
後置記法: 1 2 + 3 4 + *

逆ポーランド記法は、日本語の読み方とまったく同じです。1 2 + で 1 と 2 の和を求め、3 4 + で 3 と 4 を求め、最後に 2 つの結果を掛け算して答えが求まります。

exception Rpn_err
val rpn : item list -> int = <fun>
# rpn [N 1; N 2; Add; N 3; N 4; Add; Mul];;
- : int = 21
# rpn [N 1; N 2; Add; N 3; N 4; Sub; Mul];;
- : int = -3
# rpn [N 1; N 2; Add; N 3; N 4; Add; N 5; N 6; Add; Mul; Mul];;
- : int = 231

解答

●問題57

中置記法で書かれた数式を計算するプログラムを作ってください。数式はリストで表すことにします。リストの要素は次のように定義します。

type item = Add | Sub | Mul | Div | Rpa | Lpa | N of int

演算子は Add (+), Sub (-), Mul (*), Div (/) で、数値は整数 (int) だけとします。数式はカッコを使うことできます。右カッコを Rpa で、左カッコを Lpa で表します。

val expression : item list -> int = <fun>
# expression [N 1; Add; N 2; Add; N 3; Add; N 4];;
- : int = 10
# expression [N 1; Add; N 2; Mul; N 3; Add; N 4];;
- : int = 11
# expression [Lpa; N 1; Add; N 2; Rpa; Mul; Lpa; N 3; Add; N 4; Rpa];;
- : int = 21

解答

●問題58

m 個の整数 1, 2, ..., m の順列を考えます。先頭の要素を 1 から数えることとすると、i 番目の要素が整数 i ではない順列を「完全順列」といいます。1 から m までの整数値で完全順列を生成する高階関数 perfect_permutation fn m を定義してください。

val perfect_permutation : (int list -> unit) -> int -> unit = <fun>
# perfect_permutation print_intlist 3;;
2 3 1
3 1 2
- : unit = ()
# perfect_permutation print_intlist 4;;
2 1 4 3
2 3 4 1
2 4 1 3
3 1 4 2
3 4 1 2
3 4 2 1
4 1 2 3
4 3 1 2
4 3 2 1
- : unit = ()

解答

●問題59

完全順列の総数を「モンモール数 (Montmort number) 」といいます。モンモール数は次の漸化式で求めることができます。

A1 = 0
A2 = 1
An = (n - 1) * (An-1 + An-2)  ; n >= 3

モンモール数を求める関数 montmort_number を定義してください。なお、計算にはモジュール Num を使うものとします。

val montmort_number : Num.num -> Num.num = <fun>
# montmort_number (Int 1);;
- : Num.num = Int 0
# montmort_number (Int 2);;
- : Num.num = Int 1
# montmort_number (Int 3);;
- : Num.num = Int 2
# montmort_number (Int 4);;
- : Num.num = Int 9
# montmort_number (Int 5);;
- : Num.num = Int 44
# montmort_number (Int 10);;
- : Num.num = Int 1334961
# string_of_num (montmort_number (Int 20));;
- : string = "895014631192902121"

解答

●問題60

「ラテン方陣」は数独の枠の条件を無くした方陣です。ラテン方陣の定義を 参考文献 [1] より引用します。

『ラテン方陣を一般的にいうなら、n 行 n 列の正方形の枡に n 種類の記号を n 個ずつ配列して、各行各列に記号の重複のないものを n 次のラテン方陣というのです。』

このラテン方陣をパズルに応用したものが数独というわけです。

簡単な例を示しましょう。3 次のラテン方陣は次に示す 12 通りになります。

 1 2 3    1 2 3    1 3 2    1 3 2    2 1 3    2 1 3 
 2 3 1    3 1 2    2 1 3    3 2 1    1 3 2    3 2 1 
 3 1 2    2 3 1    3 2 1    2 1 3    3 2 1    1 3 2 
 標準形

 2 3 1    2 3 1    3 1 2    3 1 2    3 2 1    3 2 1 
 1 2 3    3 1 2    1 2 3    2 3 1    1 3 2    2 1 3 
 3 1 2    1 2 3    2 3 1    1 2 3    2 1 3    1 3 2 


               図 : 3 次のラテン方陣

この中で、最初の行と列の要素を昇順に並べたものを「標準形」といいます。3 次のラテン方陣の場合、標準形は 1 種類しかありません。ラテン方陣は任意の行を交換する、または任意の列を交換してもラテン方陣になります。3 次のラテン方陣の場合、標準形から行または列を交換することで、残りの 11 種類のラテン方陣を生成することができます。

4 次の標準形ラテン方陣をすべて求めてください。

解答

-- 参考文献 --------
[1] 大村平, 『数理パズルのはなし』, 日科技連出版社, 1998

●解答51

リスト : 直積集合

let rec product_sub x = function
  [] -> []
| y::ys -> (x, y) :: (product_sub x ys)

let rec product xs ys =
  match xs with
    [] -> []
  | z::zs -> (product_sub z ys) @ (product zs ys)

(* 別解 *)
let product1 xs ys =
  List.fold_right (fun x a -> (List.map (fun y -> (x, y)) ys) @ a) xs []

product は引数 x とリストの要素 y の組を生成する関数 product_sub を定義すると簡単です。product_sub は引数のリストから要素 y を取り出して、組 (x, y) を作って返り値のリストに追加します。product はリスト xs の要素 z を取り出し、product_sub で z と ys の要素の組を作ります。あとは演算子 @ で product zs ys の返り値と連結すればいいわけです。

なお、この処理はマッピングと畳み込みを使うと簡単に作成することができます。別解の関数 product1 は List.map と List.fold_right を使ってプログラムしたものです。

●解答52

リスト : べき集合

let rec power_set = function
  [] -> [[]]
| x::xs -> (power_set xs) @ (List.map (fun ys -> x::ys) (power_set xs))

(* 別解 *)
let print_intlist xs =
  List.iter (fun x -> print_int x; print_string " ") xs;
  print_newline ()

let power_set1 f xs =
  let rec power_sub xs a =
    match xs with
      [] -> f (List.rev a)
    | y::ys -> power_sub ys (y::a); power_sub ys a
  in
  power_sub xs []

べき集合を求める関数 power_set は簡単です。引数が空リストの場合は [ ] を格納したリストを返します。そうでなければ、引数を x::xs で分解します。 そして、power_set を再帰呼び出しして xs のべき集合を求め、その集合に先頭要素 x を追加します。そして、その集合と xs のべき集合を演算子 @ で連結します。

別解の power_set1 は高階関数バージョンです。リストの長さを N とすると、べき集合の要素数は 2 ^ N になります。N が大きくなると、べき集合をリストに格納して返すことは困難になります。その場合は高階関数を使うとよいでしょう。

●解答53

リスト : 排他的論理和

(* Q18 集合の和 *)
let rec union xs ys =
  match xs with
    [] -> ys
  | z::zs -> if List.mem z ys then union zs ys
             else z :: union zs ys

(* Q20 集合の差 *)
let rec difference xs ys =
  match xs with
    [] -> []
  | z::zs -> if List.mem z ys then difference zs ys
             else z::difference zs ys

(* 排他的論理和 *)
let exclusive_or xs ys =
  union (difference xs ys) (difference ys xs)

exclusive_or は union と difference を使って簡単に定義することができます。xs と ys の差集合は xs にしか属していない要素になります。同様に、ys と xs の差集合は ys にしか属していない要素になります。あとは、union で和集合を求めればいいわけです。

●解答54

リスト : カッコ列の生成

let print_kakko xs = 
  List.iter print_char xs;
  print_newline ()

let kakko f m =
  let rec kakko_sub x y a =
    if x = m && y = m then f (List.rev a)
    else
      if x < m then kakko_sub (x + 1) y ('('::a) else ();
      if y < x then kakko_sub x (y + 1) (')'::a) else ()
  in
  kakko_sub 0 0 []

カッコ列の生成は簡単です。局所関数 kakko_sub の引数 x が左カッコの個数、引数 y が右カッコの個数を表します。引数 a は累積変数で、文字 '(', ')' を格納したリストです。

バランスの取れたカッコ列の場合、x, y, m には y <= x <= m の関係が成り立ちます。x = m かつ y = m の場合、カッコ列がひとつ完成しました。リスト a を反転して、引数の関数 f を呼び出します。そうでなければ、kakko_sub を再帰呼び出しします。x < m であれば左カッコを追加し、y < x であれば右カッコを追加します。これでカッコ列を生成することができます。

●解答55

カタラン数 - Wikipedia によると、

カッコ列の総数は「カタラン数 (Catalan number) 」になるとのことです。カタラン数は次に示す公式で求めることができます。
         (2n)!
Cn = ----------
       (n+1)!n!

これをそのままプログラムしてもいいのですが、それではちょっと面白くないので別な方法でプログラムを作ってみましょう。カタラン数は次に示す経路図において、A から B までの最短距離の道順を求めるとき、対角線を超えないものの総数に一致します。


              図 : 道順の総数の求め方

A からある地点にいたる最短距離の道順の総数は、左隣と真下の地点の値を足したものになります。一番下の地点は 1 で、対角線を越えた地点は 0 になります。あとは下から順番に足し算していけば、A から B までの道順の総数を求めることができます。上図の場合はカラタン数 C4 に相当し、その値は 14 となります。

これをそのままプログラムすると、次のようになります。

リスト : カッコ列の総数

(* Q26 リストの生成 *)
let make_list x n =
  let rec iter n a =
    if n = 0 then a
    else iter (n - 1) (x::a)
  in
    iter n []

let kakko_num m =
  let rec iter = function
      [x] -> x
    | _::xs -> iter (List.tl (List.rev (List.fold_left (fun b x -> (x +/ (List.hd b))::b) [(Int 0)] xs)))
  in
  iter (make_list (Int 1) (m + 1))

実際の処理は局所関数 iter で行います。最初に make_list で一番下の地点の道順の総数 (1) を格納したリスト生成します。これが iter に渡す初期値になります。引数 m のカラタン数を求める場合、リストの大きさは m + 1 になります。あとは、リストの要素がひとつになるまで iter を再帰呼び出しします。

一段上の地点の値を求める場合、畳み込み fold_left を使うと簡単です。初期値はリスト [(Int 0)] とします。これが対角線を越えた地点の値を表します。引数の先頭要素は不要なので、パターン _::xs で分解して fold_left に渡します。匿名関数の引数 x が真下の地点の値、引数 b の先頭要素が左隣の地点の値になります。

あとは x と (List.hd b) を足し算して、それを演算子 :: でリスト b の先頭に追加すればいいわけです。この場合、fold_left が返すリストは逆順になるので、List.rev で反転してから List.tl で先頭要素 (対角線を越えた地点の値) を削除します。これでカッコ列の総数 (カラタン数) を求めることができます。

●解答56

逆ポーランド記法の数式はスタックを使うと簡単に計算することができます。アルゴリズムは次のようになります。

1. 数値はスタックに追加する。
2. 演算子であればスタックから 2 つ数値を取り出し、演算結果をスタックに追加する。
3. 最後にスタックに残った値が答えになる。

たったこれだけの規則で数式を計算することができます。それでは、実際に 1 2 + 3 4 + * を試してみましょう。次の表を見てください。

表 : 計算過程
数式操作スタック
1PUSH( 1 )
2PUSH( 2 1 )
+POP (2)( 1 )
POP (1)( )
1+2=3( )
PUSH( 3 )
3PUSH( 3 3 )
4PUSH( 4 3 3 )
+POP (4)( 3 3 )
POP (3)( 3 )
3+4=7( 3 )
PUSH( 7 3 )
*POP (7)( 3 )
POP (3)( )
3*7=21( )
PUSH( 21 )

スタックはリスト ( ) で表します。最初の 1 と 2 は数値なのでスタックにプッシュします。次は演算子 + なので、スタックからデータを取り出して 1 + 2 を計算します。そして、計算結果 3 をスタックにプッシュします。次に、3 と 4 は数値なのでスタックにプッシュします。その次は演算子 + なので同じように処理して、計算結果 7 をスタックにプッシュします。

スタックの中身は ( 7 3 ) となり、最初の計算結果 3 と次に計算した結果 7 がスタックに格納されています。この状態で最後の * を処理します。7 と 3 を取り出すとスタックは空の状態になります。そして、3 * 7 を計算して 21 をスタックにプッシュします。これで計算は終了です。スタックに残っている値 21 が計算結果となります。

このように、スタックを使うことで逆ポーランド記法で書かれた数式を簡単に計算することができます。実は数式だけではなく、スタックを用いてプログラムを実行することもできます。プログラミング言語 Forth は「数値」と「ワード」という 2 種類のデータしかありません。ワードには +, -, *, / などの演算子のほかに、いろいろな処理が定義されています。もちろん、ユーザが新しいワードを定義することもできます。

Forth の動作は、数値であればスタックにプッシュして、ワードであればそれを実行する、というシンプルなものです。これでプログラミングができるのですから、とてもユニークな言語ですね。

プログラムは次のようになります。

リスト : 数式の計算 (後置記法)

(* 例外の定義 *)
exception Rpn_err

type rpn = Add | Sub | Mul | Div | N of int

let rpn_add = function
  y::x::zs -> (x + y)::zs
| _ -> raise Rpn_err

let rpn_sub = function
  y::x::zs -> (x - y)::zs
| _ -> raise Rpn_err

let rpn_mul = function
  y::x::zs -> (x * y)::zs
| _ -> raise Rpn_err

let rpn_div = function
  y::x::zs -> (x / y)::zs
| _ -> raise Rpn_err

let rpn xs =
  let rec iter expr a =
    match expr with
      [] -> if List.length a = 1 then List.hd a
            else raise Rpn_err
    | (N x)::xs -> iter xs (x::a)
    | Add::xs -> iter xs (rpn_add a)
    | Sub::xs -> iter xs (rpn_sub a)
    | Mul::xs -> iter xs (rpn_mul a)
    | Div::xs -> iter xs (rpn_div a)
    | _ -> raise Rpn_err
  in
    iter xs []

実際の処理は局所関数 iter で行います。引数 expr が数式を表すリストで、引数 a がスタックを表します。expr が空リストになったら、スタックトップの値を返します。このとき、スタックに複数の値が格納されている場合はエラーを送出します。

次に、先頭要素が数値の場合はそれをスタックに追加します。演算子の場合、対応する関数を呼び出します。このとき、最低でも 2 つの値がスタックになければいけません。y::x::xs とマッチングしない場合はエラーを送出します。計算するときは、先頭の要素が第 2 引数、2 番目の要素が第 1 引数になることに注意してください。結果はリスト zs の先頭に追加します。

●解答57

参考文献 [2] の「式の評価」によると、四則演算の数式は次の構文規則で表すことができます。

式 := 項 (+ | -) 項 (+ | -) 項 ...
項 :- 因子 (* | /) 因子 (* | /) 因子 ...
因子 := 数 | (式)

これをそのままプログラムすると、次のようになります。

リスト : 数式の計算 (中置記法)

(* 例外の定義 *)
exception Expr_err

let rec factor = function
  (N x)::xs -> (x, xs)
| Lpa::xs -> let (v, ys) = expr xs in
               if List.hd ys = Rpa then (v, List.tl ys)
               else raise Expr_err
| _ -> raise Expr_err
and term xs =
  let rec term_sub value = function
    [] -> (value, [])
  | Mul::xs -> let (v, ys) = factor xs in term_sub (value * v) ys
  | Div::xs -> let (v, ys) = factor xs in term_sub (value / v) ys
  | xs -> (value, xs)
  in
    let (v, ys) = factor xs in term_sub v ys
and expr xs =
  let rec expr_sub value = function
    [] -> (value, [])
  | Add::xs -> let (v, ys) = term xs in expr_sub (value + v) ys
  | Sub::xs -> let (v, ys) = term xs in expr_sub (value - v) ys
  | xs -> (value, xs)
  in
    let (v, ys) = term xs in expr_sub v ys

let expression xs =
  let (v, ys) = expr xs in
    match ys with
      [] -> v
    | _ -> raise Expr_err

関数 expr は「式」を評価します。実際の処理は局所関数 expr_sub で行います。最初に関数 term を呼び出して「項」を評価します。返り値はタプルで、値は評価結果 v と残りのリスト ys です。演算子が Add (+) または Sub (-) の場合、term を呼び出して式 xs を評価し、返り値を v と ys にセットします。そして、value と v を加算 (または減算) して expr_sub を再帰呼び出しします。そうでなければ、評価結果 x と残りのリスト xs をタプルで返します。

関数 term も同様の処理を行います。この場合は最初に関数 factor を呼び出して「因子」を評価します。そして、演算子が Mul (*) または Div (/) の場合は factor を呼び出して評価を続行します。そうでなければ、評価結果 x と残りのリスト xs をタプルで返します。関数 factor は簡単で、引数の先頭要素が数値の場合はそれをそのまま返し、Lpa であれば xs を expr に渡して評価します。戻ってきたら、リスト ys の先頭要素が Rpa であることを確認します。それ以外の場合はエラーを送出します。

最後に、関数 expression から expr を呼び出します。リスト ys が空リストでなければ式に誤りがあるのでエラーを送出します。そうでなければ計算結果 v を返します。

-- 参考文献 --------
[2] 奥村晴彦,『C言語による最新アルゴリズム事典』, 技術評論社, 1991

●解答58

リスト : 完全順列

(* Q16 *)
let iota n m =
  let rec iter i a =
    if i < n then a
    else iter (i - 1) (i::a)
  in
    iter m []

(* Q27 *)
let rec remove x = function
  [] -> []
| y::ys -> if x = y then remove x ys
           else y :: remove x ys

let perfect_permutation f m =
  let rec perm_sub n ls a =
    if ls = [] then f (List.rev a)
    else List.iter (fun x -> if n <> x then perm_sub (n + 1) (remove x ls) (x::a)
                             else ())
                   ls
  in
    perm_sub 1 (iota 1 m) []

perfect_permutation は簡単です。実際の処理は局所関数 perm_sub で行います。関数 iota で 1 から m までの数値を格納したリストを生成し、それを引数 ls に渡します。引数 n が順番を表します。List.iter の匿名関数の中で、数字 x が n と等しくない場合、その数字を選択することできます。等しい場合は選択しません。ls が空リストになったら、List.rev で a を反転して f を評価します。これで完全順列を生成することができます。

●解答59

リスト : 完全順列の総数

let rec montmort_number = function
  Int 1 -> Int 0
| Int 2 -> Int 1
| n -> (n -/ (Int 1)) */ ((montmort_number (n -/ (Int 1))) +/ (montmort_number (n -/ (Int 2))))

(* 別解 *)
let montmort_number1 n =
  let rec iter i a b =
    if i = n then a
    else iter (i + 1) b (((Int i) +/ (Int 1)) */ (a +/ b))
  in
    iter 1 (Int 0) (Int 1)

関数 montmort_number は公式をそのままプログラムしただけです。二重再帰になっているので、実行速度はとても遅くなります。これを繰り返しに変換すると別解のようになります。考え方はフィボナッチ数列と同じです。累積変数 a に i 番目の値を、b に i + 1 番目の値を保存しておきます。すると、i + 2 番目の値は (i + 1) * (a + b) で計算することができます。あとは、b の値を a に、新しい値を b にセットして処理を繰り返すだけです。

●解答60

リスト : 標準形ラテン方陣を求める

let print_latina xs =
  List.iter (fun x -> print_intlist x) (List.rev xs);
  print_newline ()

let check_latina n x xs =
  List.mem x (List.map (fun ys -> List.nth ys (n - 1)) xs)

let latina f size = 
  let rec solve n ls a b =
    if ls = [] then
      if size - 1 = List.length b then f ((List.rev a)::b)
      else let m = (List.length b) + 2 in
           solve 2 (remove m (iota 1 size)) [m] ((List.rev a)::b)
    else
      List.iter (fun x -> if not (check_latina n x b) then
                            solve (n + 1) (remove x ls) (x::a) b
                          else ())
                ls
  in
    solve 1 (iota 1 size) [] [(iota 1 size)]

実際の処理は局所関数 solve で行います。基本的な考え方は完全順列とほぼ同じで、累積変数 a に順列を格納し、完成した順列を累積変数 b に格納します。引数 ls が空リストの場合、順列がひとつ完成しました。b の要素数をチェックして、size - 1 と等しければラテン方陣ができました。(List.rev a) を b に追加して関数 f を評価します。そうでなければ solve を再帰呼び出しします。このとき、先頭要素は b の要素数 + 2 になることに注意してください。

順列を生成する場合、関数 check_latina を呼び出して数字 x を選択できるかチェックします。List.map で xs に格納されたリストの n - 1 番目の要素を List.nth で取り出します。OCaml のリストは 0 から数えることに注意してください。そして、x が List.map の返り値に含まれているか List.mem でチェックします。x が含まれていれば、x を選択することはできません。そうでなければ x を選択します。

実行結果は次のようになります。

# latina print_latina 3;;
1 2 3
2 3 1
3 1 2

- : unit = ()
# latina print_latina 4;;
1 2 3 4
2 1 4 3
3 4 1 2
4 3 2 1

1 2 3 4
2 1 4 3
3 4 2 1
4 3 1 2

1 2 3 4
2 3 4 1
3 4 1 2
4 1 2 3

1 2 3 4
2 4 1 3
3 1 4 2
4 3 2 1

- : unit = ()

ちなみに、標準形ラテン方陣の総数は次のようになります。

I4 = 4
I5 = 56
I6 = 9408
I7 = 16942080

高次の標準形ラテン方陣の総数は、簡単に求めることができない非常にハードな問題だといわれています。


Copyright (C) 2011 Makoto Hiroi
All rights reserved.

[ PrevPage | OCaml | NextPage ]