予定のみ †

  • 日時　：2006/6/26 (Mon)
  • 場所　：名大 理学部1号館(多元数理科学研究科) 307室
  • 時刻　：18:00〜19:30
  • 参加者：??名

↑

Chapter 6. Exercise続き †

↑

Exercise 1 †

↑

Exercise 6 (小笠原) †

↑

Exercise 7 †

↑

Exercise 8 (樋口) †

1,2,3,4からなる二分探索木を列挙し，それらを構成するためにaddに渡す要素の列を求めよ．

まず，テキストより，2分木および，add, mem, preorderの定義があるとする．

type 'a tree = Lf | Br of 'a * 'a tree * 'a tree
let rec mem t x = 
   match t with 
    Lf -> false
   |Br (y,left,right) -> if x = y then true else
                         if x < y then mem left x else mem right x
let rec add t x = 
   match t with 
    Lf -> Br (x,Lf,Lf)
   |(Br (y,left,right) as whole) -> if x = y then whole else
                               if x < y then Br(y, add left x, right)
                                        else Br(y, left, add right x)
let rec preorder t l = 
   match t with 
    Lf -> l
   |Br(x, left, right) -> x :: (preorder left (preorder right l));;

基本方針は，[1;2;3;4]から順列を作り出し， それらをaddして得られたtreeをpreorderでめぐり， preorderがユニークなら新たな形の木として残し， addへの入力した列を保存してゆく．

makeUniqTreeInputs?
excerciseの目標 [1;2;3;4] -> [(addへの入力のリスト)]
makeUniqTrees?
makeUniqTreeInputs? と同様だが，返すものがaddへ入力後のtreeのリストを得る．
makeSTree
与えられたリストの要素を順にaddしtreeを得る．
permutation
リストから順列を得る
prefix
permutationで利用． ex. prefix [2;3] -> [[]; [2]; [2;3]]
suffix
permutationで利用． ex. suffix [2;3] -> [[2;3]; [3]; []]
interleave
permutationで利用． ex. interleave 1 [2;3] -> [[1;2;3]; [2;1;3]; [2;3;1]]
let rec prefix = function
   [] -> [[]]
  |x::xs -> [] :: (List.map (fun el -> x::el) (prefix xs))
let rec suffix = function
   [] -> [[]]
  |x::xs -> (x::xs)::(suffix xs)
let interleave el l =
   let pl = (prefix l) and sl = (suffix l) in
    (List.map2 (fun a b -> a @ el :: b) pl sl)
let rec permutation  = function
   [] -> [[]]
  |x::xs -> List.flatten (List.map (fun e -> (interleave x e)) (permutation xs))
let rec makeSTree = function
   [] -> Lf
  |x::xs -> add (makeSTree xs) x
let makeUniqTreeInputs nodes = 
  let addTree input set =
   let pord = (preorder (makeSTree input) []) in
    if List.mem pord (fst set) then set else ((pord::(fst set)),input::(snd set))
  in 
  let rec addTrees nodel set = 
   match nodel with 
    [] -> (set)
   |x::xs -> addTree x (addTrees xs set)
  in
   snd (addTrees (permutation nodes) ([],[]))
let makeUniqTrees nodes =
   let rec input2trees = function []->[]|x::xs -> (makeSTree x)::(input2trees xs) in
   input2trees (makeUniqTreeInputs nodes);;
↑

実行結果 &dagger;

# makeUniqTreeInputs [1;2;3;4];;
- : int list list =
[[1; 2; 3; 4]; [2; 1; 3; 4]; [2; 3; 1; 4]; [2; 3; 4; 1]; [3; 1; 2; 4];
 [3; 2; 1; 4]; [3; 2; 4; 1]; [3; 4; 1; 2]; [3; 4; 2; 1]; [4; 1; 2; 3];
 [4; 2; 1; 3]; [4; 2; 3; 1]; [4; 3; 1; 2]; [4; 3; 2; 1]]
# makeUniqTrees [1;2;3;4];;
- : int tree list =
[Br (4, Br (3, Br (2, Br (1, Lf, Lf), Lf), Lf), Lf);
 Br (4, Br (3, Br (1, Lf, Br (2, Lf, Lf)), Lf), Lf);
 Br (4, Br (1, Lf, Br (3, Br (2, Lf, Lf), Lf)), Lf);
 Br (1, Lf, Br (4, Br (3, Br (2, Lf, Lf), Lf), Lf));
 Br (4, Br (2, Br (1, Lf, Lf), Br (3, Lf, Lf)), Lf);
 Br (4, Br (1, Lf, Br (2, Lf, Br (3, Lf, Lf))), Lf);
 Br (1, Lf, Br (4, Br (2, Lf, Br (3, Lf, Lf)), Lf));
 Br (2, Br (1, Lf, Lf), Br (4, Br (3, Lf, Lf), Lf));
 Br (1, Lf, Br (2, Lf, Br (4, Br (3, Lf, Lf), Lf)));
 Br (3, Br (2, Br (1, Lf, Lf), Lf), Br (4, Lf, Lf));
 Br (3, Br (1, Lf, Br (2, Lf, Lf)), Br (4, Lf, Lf));
 Br (1, Lf, Br (3, Br (2, Lf, Lf), Br (4, Lf, Lf)));
 Br (2, Br (1, Lf, Lf), Br (3, Lf, Br (4, Lf, Lf)));
 Br (1, Lf, Br (2, Lf, Br (3, Lf, Br (4, Lf, Lf))))]
↑

おまけ &dagger;

let trees2dot inputs =
let rec trees2edges inputs delta=
 let rec tree2edges n = function 
   Lf -> "L" ^ (string_of_int n)
  |Br(x,left,right) -> (string_of_int (x+n))^"[label="^(string_of_int x)^"];"^ 
       match (left,right)with
        (Lf,Lf) -> ""
       |(Br(x1,_,_),Br(x2,_,_)) -> (string_of_int (x+n))^":sw ->"^(string_of_int (x1+n))^";"
                                  ^(string_of_int (x+n))^":se ->"^(string_of_int (x2+n))^";"
                                  ^(tree2edges n left) ^(tree2edges n right)
       |(Br(x1,_,_),Lf) -> (string_of_int (x+n))^":sw ->"^(string_of_int (x1+n))^";"
                          ^(tree2edges n left)
       |(Lf,Br(x2,_,_)) -> (string_of_int (x+n))^":se ->"^(string_of_int (x2+n))^";"
                          ^(tree2edges n right)
 in match inputs with [] -> ""
  |x::xs -> (tree2edges delta (makeSTree x) ) ^ " " ^ (trees2edges xs (delta+(List.length x)))
in "digraph forrest{ node [shape=box];"^(trees2edges inputs 0)^"}";;
trees2dot (makeUniqTreeInputs [1;2;3;4]);;
test.png
↑

Exercise 9 (けいご) &dagger;

↑

Chapter 7. Exercise &dagger;

↑

Exercise 1 &dagger;

ref型を

type 'a ref = { mutable contents : 'a};;

こんな定義の更新可能レコードと見て， 関数ref, 前置演算子!, 中置演算子:= をレコード操作で書け．

  • 関数ref 
    # let ref x = { contents = x } ;;
val ref : 'a -> 'a ref = <fun>
  • 前置演算子! 
    # let ( ! ) x = x.contents ;;
val ( ! ) : 'a ref -> 'a = <fun>
  • 中置演算子:= 
    # let ( := ) x y = x.contents <- y;;
val ( := ) : 'a ref -> 'a -> unit = <fun>
↑

Exercise 2 &dagger;

整数の参照をインクリメントする関数incr

# let incr x = x := !x + 1;;
val incr : int ref -> unit = <fun>
↑

Exercise 3 &dagger;

# let f = ref (fun y -> y+1)
  let funny_fact x = if x = 1 then 1 else x * (!f(x-1));;
# f := funny_fact;;
# funny_fact 5;;

let fは単に関数の参照が用意したいだけで，funで定義された関数の中身に意味は無い．(例えば let f = ref (fun y -> 1) でもOK)
f := funny_factによりfがfunny_factをさすようになる．
その結果，funny_factの定義中の!fが自分自身(funny_fact)を呼ぶ事になり，
階乗を素直に再帰的に定義した時と同じ形になっている．

↑

Exercise 4 &dagger;

# let fact_imp n =
   let i = ref n and res = ref 1 in
    while ( !i > 0 ) do
     res := !res * !i;
     i := !i - 1
    done;
    !res;;
val fact_imp : int -> int = <fun>
↑

Exercise 5 &dagger;

↑

Exercise 6 &dagger;

↑

Exercise 7 &dagger;

↑

Exercise 8 (末次) &dagger;

まず元の定義

let rec change = function
    (_, 0) -> []
  | ((c :: rest) as coins, total) ->
      if c > total then change (rest, total)
      else c :: change (coins, total - c) ;;

これだと

let us_coins = [25; 10; 5; 1]
and gb_coins = [50; 20; 10; 5; 2; 1];;

change (gb_coins, 43);;
change (us_coins, 43);;

は成功するが、

change ([5; 2], 16);;
Exception: Match_failure ("", 66, -211).

となって失敗する．これは大きい額から試していくので 5 で3回割ったあと、リストの最後 nil まで行って、 ([], 1) にマッチする規則が無いため．

そこで失敗したら戻って小さな額で割るようにすればよい．

let rec change = function
    (_, 0) -> []
  | ((c :: rest) as coins, total) ->
      if c > total then change (rest, total)
      else
	 (try
	      c :: change (coins, total - c)
	  with Failure "change" -> change (rest, total))  (* 失敗したら c で割るのを諦めて次に小さい数で続ける *)
  | _ -> raise (Failure "change");;  (* ([], 1以上) のときは例外を投げる *)

このようにすれば

change ([5; 2], 16);;
- : int list = [5; 5; 2; 2; 2]

と計算できる．

トップ   新規 一覧 単語検索 最終更新   ヘルプ   最終更新のRSS