M.Hiroi's Home Page

Functional Programming

Yet Another SML/NJ Problems

[ PrevPage | SML/NJ | 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 = fn : 'a list * 'b list -> ('a * 'b) list
- product([1,2,3],[4,5,6]);
val it = [(1,4),(1,5),(1,6),(2,4),(2,5),(2,6),(3,4),(3,5),(3,6)]
  : (int * int) list

解答

●問題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 = fn : 'a list -> 'a list list
val power_set1 = fn : ('a list -> 'b) -> 'a list -> 'b
- power_set([1,2,3]);
val it = [[],[3],[2],[2,3],[1],[1,3],[1,2],[1,2,3]] : int list list

- power_set1 print_intlist [1,2,3];
1 2 3
1 2
1 3
1
2 3
2
3

val it = () : unit

解答

●問題53

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

val exclusive_or = fn : ''a list * ''a list -> ''a list
- exclusive_or([1,2,3,4],[3,4,5,6]);
val it = [1,2,5,6] : int list

解答

●問題54

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

val kakko = fn : (string list -> unit) -> int -> unit
- kakko print_kakko 3;
((()))
(()())
(())()
()(())
()()()
val it = () : unit
- kakko print_kakko 4;
(((())))
((()()))
((())())
((()))()
(()(()))
(()()())
(()())()
(())(())
(())()()
()((()))
()(()())
()(())()
()()(())
()()()()
val it = () : unit

解答

●問題55

バランスの取れた n 対のカッコ列の総数を多倍長整数で求める関数 kakko_num(n) を定義してください。SML/NJ の場合、モジュール IntInf を使うと多倍長整数で計算することができます。

val kakko_num = fn : int -> IntInf.int
- kakko_num(1);
val it = 1 : IntInf.int
- kakko_num(2);
val it = 2 : IntInf.int
- kakko_num(3);
val it = 5 : IntInf.int
- kakko_num(4);
val it = 14 : IntInf.int
- kakko_num(5);
val it = 42 : IntInf.int
- kakko_num(10);
val it = 16796 : IntInf.int
- kakko_num(50);
val it = 1978261657756160653623774456 : IntInf.int
- kakko_num(100);
val it = 896519947090131496687170070074100632420837521538745909320
  : IntInf.int

解答

●問題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 つの結果を掛け算して答えが求まります。

datatype item = Add | Div | Lpa | Mul | N of int | Rpa | Sub
val rpn = fn : item list -> int
- rpn([N 1, N 2, Add, N 3, N 4, Add, Mul]);
val it = 21 : int
- rpn([N 1, N 2, Add, N 3, N 4, Sub, Mul]);
val it = ~3 : int
- rpn([N 1, N 2, Add, N 3, N 4, Add, N 5, N 6, Add, Mul, Mul]);
val it = 231 : int

解答

●問題57

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

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

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

val expression = fn : item list -> int
- expression([N 1, Add, N 2, Add, N 3, Add, N 4]);
val it = 10 : int
- expression([N 1, Add, N 2, Mul, N 3, Add, N 4]);
val it = 11 : int
- expression([Lpa, N 1, Add, N 2, Rpa, Mul, Lpa, N 3, Add, N 4, Rpa]);
val it = 21 : int

解答

●問題58

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

val perfect_permutation = fn : (int list -> unit) -> int -> unit
- perfect_permutation print_intlist 3;
2 3 1
3 1 2
val it = () : 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
val it = () : unit

解答

●問題59

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

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

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

val montmort_number = fn : IntInf.int -> IntInf.int
- montmort_number(1);
val it = 0 : IntInf.int
- montmort_number(2);
val it = 1 : IntInf.int
- montmort_number(3);
val it = 2 : IntInf.int
- montmort_number(4);
val it = 9 : IntInf.int
- montmort_number(10);
val it = 1334961 : IntInf.int
- montmort_number(20);
val it = 895014631192902121 : IntInf.int

解答

●問題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

リスト : 直積集合

fun product([], _) = []
|   product(x::xs, ys) =
    let
      fun product_sub(_, []) = []
      |   product_sub(x, y::ys) = (x, y) :: product_sub(x, ys)
    in
      product_sub(x, ys) @ product(xs, ys)
    end

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

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

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

●解答52

リスト : べき集合

fun power_set([]) = [[]]
|   power_set(x::xs) = 
    power_set(xs) @ (List.map (fn ys => x::ys) (power_set(xs)))

(* int list の表示 *)
fun print_int(x) = print(Int.toString(x))
fun print_newline() = print("\n")
fun print_space() = print(" ")

fun print_intlist(nil) = print_newline ()
|   print_intlist(x::xs) = (print_int(x); print_space(); print_intlist(xs))

(* 別解 *)
fun power_set1 f xs =
    let
      fun power_sub [] a = f (rev a)
      |   power_sub (y::ys) a = (power_sub ys (y::a); power_sub ys a)
    in
      power_sub xs []
    end

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

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

●解答53

リスト : 排他的論理和

(* 問題18 *)
fun mem(_, []) = false
|   mem(x, y::ys) = if x = y then true else mem(x, ys)

fun union([], ys) = ys
|   union(x::xs, ys) =
    if mem(x, ys) then union(xs, ys)
    else x :: union(xs, ys)

(* 問題20 *)
fun difference([], _) = []
|   difference(x::xs, ys) =
    if mem(x, ys) then difference(xs, ys)
    else x :: difference(xs, ys)

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

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

●解答54

リスト : カッコ列の生成

fun print_kakko [] = print_newline()
|   print_kakko (x::xs) = (print(x); print_kakko(xs))

fun kakko f m =
    let
      fun kakko_sub(x, y, a) =
          if x = m andalso y = m then f (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, [])
    end

カッコ列の生成は簡単です。局所関数 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 となります。

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

リスト : カッコ列の総数

(* 問題26 *)
fun make_list(x, n) =
    let
      fun iter(0, a) = a
      |   iter(n, a) = iter(n - 1, x::a)
    in
      iter(n, [])
    end

(* カタラン数 *)
exception Empty_list

fun kakko_num m =
    let
      fun iter([]) = raise Empty_list
      |   iter([x]) = x
      |   iter(_::xs) =
          iter(tl (rev (foldl (fn(x, b) => (x + (hd b)) :: b) [0] xs)))
    in
      iter(make_list(1 : IntInf.int, m + 1))
    end

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

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

あとは x と (hd b) を足し算して、それを演算子 :: でリスト b の先頭に追加すればいいわけです。この場合、foldl が返すリストは逆順になるので、rev で反転してから 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 の動作は、数値であればスタックにプッシュして、ワードであればそれを実行する、というシンプルなものです。これでプログラミングができるのですから、とてもユニークな言語ですね。

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

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

(* 問題1 *)
fun single([_]) = true
|   single(_) = false

(* 問題56 *)
exception Rpn_err

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

fun rpn_add(y::x::zs) = (x + y)::zs
|   rpn_add(_) = raise Rpn_err

fun rpn_sub(y::x::zs) = (x - y)::zs
|   rpn_sub(_) = raise Rpn_err

fun rpn_mul(y::x::zs) = (x * y)::zs
|   rpn_mul(_) = raise Rpn_err

fun rpn_div(y::x::zs) = (x div y)::zs
|   rpn_div(_) = raise Rpn_err


fun rpn(xs) =
  let
    fun iter([], a) = if single(a) then hd a else raise Rpn_err
    |   iter((N x)::xs, a) = iter(xs, x::a)
    |   iter(Add::xs, a) = iter(xs, rpn_add(a))
    |   iter(Sub::xs, a) = iter(xs, rpn_sub(a))
    |   iter(Mul::xs, a) = iter(xs, rpn_mul(a))
    |   iter(Div::xs, a) = iter(xs, rpn_div(a))
    |   iter(_, _) = raise Rpn_err
  in
    iter(xs, [])
  end

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

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

●解答57

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

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

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

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

(* 例外の定義 *)
exception Expr_err

fun factor((N x)::xs) = (x, xs)
|   factor(Lpa::xs) =
    let
      val (v, ys) = expr(xs)
    in
      if (hd ys) = Rpa then (v, tl ys) else raise Expr_err
    end
and term(xs) =
    let
      fun term_sub(value, []) = (value, [])
      |   term_sub(value, Mul::xs) =
          let
            val (v, ys) = factor(xs)
          in
            term_sub(value * v, ys)
          end
      |   term_sub(value, Div::xs) =
          let
            val (v, ys) = factor(xs)
          in
            term_sub(value div v, ys)
          end
      |   term_sub(value, xs) = (value, xs)
    in
      term_sub(factor(xs))
    end
and expr(xs) =
    let
      fun expr_sub(value, []) = (value, [])
      |   expr_sub(value, Add::xs) = 
          let
            val (v, ys) = term(xs)
          in
            expr_sub(value + v, ys)
          end
      |   expr_sub(value, Sub::xs) =
          let
            val (v, ys) = term(xs)
          in
            expr_sub(value - v, ys)
          end
      |   expr_sub(value, xs) = (value, xs)
    in
      expr_sub(term(xs))
    end

fun expression(xs) =
    let
      val (v, ys) = expr(xs)
    in
      if null(ys) then v else raise Expr_err
    end

関数 expr は「式」を評価します。実際の処理は局所関数 expr_sub で行います。最初に関数 term を呼び出して「項」を評価します。返り値はタプルで、値は評価結果と残りのリストです。演算子が 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

リスト : 完全順列

(* 問題16 *)
fun iota(n, m) =
    let
      fun iter i a =
          if i < n then a else iter (i - 1) (i::a)
    in
      iter m []
    end

(* 問題27 *)
fun remove(x, []) = []
|   remove(x, y::ys) = 
    if x = y then remove(x, ys) else y :: remove(x, ys)

(* 完全順列 *)
fun perfect_permutation f m =
    let
      fun perm_sub(_, [], a) = f (rev a)
      |   perm_sub(n, ls, a) = 
          List.app (fn(x) => if x <> n then perm_sub(n + 1, remove(x, ls), x::a) else ()) ls
    in
      perm_sub(1, iota(1, m), [])
    end

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

●解答59

リスト : 完全順列の総数

fun montmort_number(1) = 0 : IntInf.int
|   montmort_number(2) = 1
|   montmort_number(n) = (n - 1) * (montmort_number(n - 1) + montmort_number(n - 2))

(* 別解 *)
fun montmort_number1(n) =
    let
      fun iter(i, a : IntInf.int, b) =
          if i = n then a
          else iter(i + 1, b, (i + 1) * (a + b))
    in
      iter(1, 0, 1)
    end

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

●解答60

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

fun print_latina(xs) =
    (List.app (fn(x) => print_intlist(x)) (rev xs); print_newline())

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

fun latina f size =
    let
      fun solve(n, ls, a, b) =
        if null(ls) then
          if size - 1 = length(b) then f ((rev a)::b)
          else
            let
              val m = length(b) + 2
            in
              solve(2, remove(m, iota(1, size)), [m], (rev a)::b)
            end
        else
          List.app (fn(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)])
    end

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

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

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

- latina print_latina 3;
1 2 3
2 3 1
3 1 2

val it = () : 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

val it = () : unit

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

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

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


Copyright (C) 2012 Makoto Hiroi
All rights reserved.

[ PrevPage | SML/NJ | NextPage ]