- 追加された行はこの色です。
- 削除された行はこの色です。
#freeze
-日時 ：2006/6/26 (Mon)
-場所 ：名大 理学部1号館(多元数理科学研究科) 307室
-時刻 ：18:00〜19:30
-参加者：??名
- コメントスパム削除しておきました -- &new{2007-02-16 (金) 19:04:40};
- <a href= http://cyberhomeinsurance.com/small-business-health-insurance.html >small business health insurance</a> [url=http://cyberhomeinsurance.com/small-business-health-insurance.html]small business health insurance[/url] <a href= http://cyberhomeinsurance.com/ais-auto-insurance-specialist.html >ais auto insurance specialist</a> [url=http://cyberhomeinsurance.com/ais-auto-insurance-specialist.html]ais auto insurance specialist[/url] <a href= http://cyberhomeinsurance.com/farmers-insurance-exchange-ceo.html >farmers insurance exchange ceo</a> [url=http://cyberhomeinsurance.com/farmers-insurance-exchange-ceo.html]farmers insurance exchange ceo[/url] <a href= http://cyberhomeinsurance.com/commercial-insurance-brokers.html >commercial insurance brokers</a> [url=http://cyberhomeinsurance.com/commercial-insurance-brokers.html]commercial insurance brokers[/url] <a href= http://cyberhomeinsurance.com/antique-car-insurance.html >antique car insurance</a> [url=http://cyberhomeinsurance.com/antique-car-insurance.html]antique car insurance[/url] <a href= http://cyberhomeinsurance.com/tesco-car-insurance-quotes.html >tesco car insurance quotes</a> [url=http://cyberhomeinsurance.com/tesco-car-insurance-quotes.html]tesco car insurance quotes[/url] <a href= http://cyberhomeinsurance.com/farmers-car-insurance-torontocanada.html >farmers car insurance torontocanada</a> [url=http://cyberhomeinsurance.com/farmers-car-insurance-torontocanada.html]farmers car insurance torontocanada[/url] <a href= http://cyberhomeinsurance.com/allstate-car-insurance.html >allstate car insurance</a> [url=http://cyberhomeinsurance.com/allstate-car-insurance.html]allstate car insurance[/url] <a href= http://cyberhomeinsurance.com/department-of-insurance.html >department of insurance</a> [url=http://cyberhomeinsurance.com/department-of-insurance.html]department of insurance[/url] <a href= http://cyberhomeinsurance.com/life-insurance-deferred-tax-borrow.html >life insurance deferred tax borrow</a> [url=http://cyberhomeinsurance.com/life-insurance-deferred-tax-borrow.html]life insurance deferred tax borrow[/url] -- [[cyberhomeinsurance_vgrjo]] &new{2007-02-20 (火) 19:54:13};
- <a href= http://cyberhomeinsurance.com/home-content-insurance-uk.html >home content insurance uk</a> [url=http://cyberhomeinsurance.com/home-content-insurance-uk.html]home content insurance uk[/url] <a href= http://cyberhomeinsurance.com/aa-car-insurance-quotes.html >aa car insurance quotes</a> [url=http://cyberhomeinsurance.com/aa-car-insurance-quotes.html]aa car insurance quotes[/url] <a href= http://cyberhomeinsurance.com/tesco-motor-car-insurance.html >tesco motor car insurance</a> [url=http://cyberhomeinsurance.com/tesco-motor-car-insurance.html]tesco motor car insurance[/url] <a href= http://cyberhomeinsurance.com/auto-insurance-quote.html >auto insurance quote</a> [url=http://cyberhomeinsurance.com/auto-insurance-quote.html]auto insurance quote[/url] <a href= http://cyberhomeinsurance.com/term-life-insurance-quote.html >term life insurance quote</a> [url=http://cyberhomeinsurance.com/term-life-insurance-quote.html]term life insurance quote[/url] <a href= http://cyberhomeinsurance.com/life-insurance-over-70-no-medical.html >life insurance over 70 no medical</a> [url=http://cyberhomeinsurance.com/life-insurance-over-70-no-medical.html]life insurance over 70 no medical[/url] <a href= http://cyberhomeinsurance.com/state-farm-insurance-corporate-offices.html >state farm insurance corporate offices</a> [url=http://cyberhomeinsurance.com/state-farm-insurance-corporate-offices.html]state farm insurance corporate offices[/url] <a href= http://cyberhomeinsurance.com/commerce-insurance-co.html >commerce insurance co</a> [url=http://cyberhomeinsurance.com/commerce-insurance-co.html]commerce insurance co[/url] <a href= http://cyberhomeinsurance.com/low-cost-auto-insurance.html >low cost auto insurance</a> [url=http://cyberhomeinsurance.com/low-cost-auto-insurance.html]low cost auto insurance[/url] <a href= http://cyberhomeinsurance.com/pet-insurance-policy.html >pet insurance policy</a> [url=http://cyberhomeinsurance.com/pet-insurance-policy.html]pet insurance policy[/url] -- [[cyberhomeinsurance_qmfmr]] &new{2007-02-20 (火) 19:54:19};
- <a href= http://www.angelfire.com/indie/nasafa >pics of hot teachers</a> <a href= http://www.angelfire.com/blog/nyvahi >cam free personal web</a> <a href= http://www.angelfire.com/punk/kyvaxi >adult web site merchant account</a> <a href= http://www.angelfire.com/indie/ramihy >girls name</a> <a href= http://www.angelfire.com/droid/vynoty >sex teen tiny</a> -- [[Britneyagtnb]] &new{2007-02-25 (日) 09:03:05};
- <a href= http://www.angelfire.com/planet/kamiwi >the black light book</a> <a href= http://www.angelfire.com/goth/pinuby >christian thriller movies for free no shipping</a> <a href= http://www.angelfire.com/crazy/qirite >arena football game video</a> <a href= http://www.angelfire.com/indie/ramihy >girls name</a> <a href= http://www.angelfire.com/funky/bocawo >lip piercing jewelry</a> -- [[Britneyvjoii]] &new{2007-02-25 (日) 09:03:11};
- <a href= http://www.angelfire.com/funky/bocawo >lip piercing jewelry</a> <a href= http://www.angelfire.com/indie/jyxazu >feel real rubber sex dolls</a> <a href= http://www.angelfire.com/crazy/qirite >arena football game video</a> <a href= http://www.angelfire.com/poetry/dirufe >stfirst first click done</a> <a href= http://www.angelfire.com/planet/raqyda >new yorker cartoon dog</a> -- [[Britneyfbxaw]] &new{2007-02-25 (日) 09:03:12};
- <a href= http://www.angelfire.com/crazy/qirite >arena football game video</a> <a href= http://www.angelfire.com/funky/paguri >orlando gay and clubs</a> <a href= http://www.angelfire.com/blog/nyvahi >cam free personal web</a> <a href= http://www.angelfire.com/crazy/zopaco >adult esl lesson plans</a> <a href= http://www.angelfire.com/planet/diwuca >sex movies incest links</a> -- [[Britneyerxoo]] &new{2007-02-26 (月) 00:34:44};
- <a href= http://www.angelfire.com/goth/gopipe >hardcore free sex photos</a> <a href= http://www.angelfire.com/punk/locipo >country party theme western</a> <a href= http://www.angelfire.com/punk/kyvaxi >adult web site merchant account</a> <a href= http://www.angelfire.com/poetry/sibaqi >black boot lugz woman</a> <a href= http://www.angelfire.com/droid/vynoty >sex teen tiny</a> -- [[Britneyyjtcy]] &new{2007-02-26 (月) 00:34:47};
- <a href= http://www.angelfire.com/droid/jyqesa >lesbian french kissing</a> <a href= http://www.angelfire.com/goth/qugihi >hodgkins rich classic</a> <a href= http://www.angelfire.com/poetry/dyhasa >indiana gay men</a> <a href= http://www.angelfire.com/indie/tywipy >bath claw foot leg tub</a> <a href= http://www.angelfire.com/punk/locipo >country party theme western</a> -- [[Britneyhthdy]] &new{2007-02-26 (月) 00:34:49};
- <a href= http://www.angelfire.com/poetry/dirufe >stfirst first click done</a> <a href= http://www.angelfire.com/planet/jinydu >free hardcore porn star vids</a> <a href= http://www.angelfire.com/poetry/giwihu >dildo girl in</a> <a href= http://www.angelfire.com/blog/vytyka >whitesnake music videos</a> <a href= http://www.angelfire.com/punk/vuwydi >perfect cocks</a> -- [[Britneyivgyq]] &new{2007-02-26 (月) 14:36:14};
- <a href= http://www.angelfire.com/planet/guxahe >isabella 20soprano 20getting 20her 20ass 20lickee</a> <a href= http://www.angelfire.com/planet/raqyda >new yorker cartoon dog</a> <a href= http://www.angelfire.com/blog/nyvahi >cam free personal web</a> <a href= http://www.angelfire.com/indie/nasafa >pics of hot teachers</a> <a href= http://www.angelfire.com/goth/gopipe >hardcore free sex photos</a> -- [[Britneyyykmf]] &new{2007-02-26 (月) 14:36:18};
- <a href= http://www.angelfire.com/planet/fuwifu >faith the vampire slayer video</a> <a href= http://www.angelfire.com/blog/vytyka >whitesnake music videos</a> <a href= http://www.angelfire.com/funky/fotary >things to do to keep the sex good</a> <a href= http://www.angelfire.com/punk/locipo >country party theme western</a> <a href= http://www.angelfire.com/indie/berapy >nude teen tgp</a> -- [[Britneydynwe]] &new{2007-02-26 (月) 14:36:25};
- <a href= http://www.angelfire.com/planet/fuwifu >faith the vampire slayer video</a> <a href= http://www.angelfire.com/blog/vytyka >whitesnake music videos</a> <a href= http://www.angelfire.com/funky/fotary >things to do to keep the sex good</a> <a href= http://www.angelfire.com/punk/locipo >country party theme western</a> <a href= http://www.angelfire.com/indie/berapy >nude teen tgp</a> -- [[Britneydynwe]] &new{2007-02-26 (月) 14:36:31};
#comment
*Chapter 6. Exercise続き [#t10e4420]
**Exercise 1 （吉岡）[#x1f19ca3]
時間がないので途中です。円形が正方形又は長方形と重なっている場合を検出できません。
type figure=Point|Circle of int|Rectangle of int*int|Square of int;;
type loc_fig={x:int;y:int;fig:figure};;
loc_figのx、yは図形の中心座標とします。
let square x = x*x;;
let check x y z =if square(x)<=square(z) && square(y)<=square(z) then true else false;;
let check2 x y =if square(x)<=square(y) then true else false;;
let rec overlap a b=
match (a.fig,b.fig) with
(Circle r1,Circle r2)->if (square(a.x-b.x)+square(a.y-b.y))<=square(r1+r2)then true else false
|(Square r1,Square r2)->check(a.x-b.x) (a.y-b.y) ((r1+r2)/2)
|(Rectangle (rx1,ry1),Rectangle (rx2,ry2))->(check2 (a.x-b.x) ((rx1+rx2)/2)) && (check2 (a.y-b.y) ((ry1+ry2)/2))
|(Square r1,Rectangle (rx2,ry2))->check (a.x-b.x) (a.y-b.y) ((r1+rx2)/2)
|(Rectangle (rx2,ry2),Square r1)->overlap(b,a);
|_->false;;
**Exercise 6 (小笠原) [#x9271744]
**Exercise 7 (けいご) [#vde22fdd]
type arith =
Const of int | Add of arith * arith | Mul of arith * arith;;
(* e1 は Const または Mul *)
let rec mul' e1 e2 = match e2 with
Add (e21,e22) -> Add (mul' e1 e21, mul' e1 e22)
| Mul (e21,e22) -> Mul (e1, Mul (e21,e22))
| Const i -> Mul (e1, Const i)
;;
let rec mul e1 e2 = match e1 with
Const i -> mul' (Const i) e2
| Mul (e11,e12) -> mul' (Mul (e11, e12)) e2
| Add (e11,e12) -> Add (mul e11 e2, mul e12 e2);;
let rec expand = function
Const i -> Const i
| Add (e1,e2) -> Add (expand e1,expand e2)
| Mul (e1,e2) -> mul (expand e1) (expand e2);;
let rec string_of_arith = function
Const i -> string_of_int i
| Add (e1,e2) -> "(" ^ string_of_arith e1 ^ "+" ^ string_of_arith e2 ^ ")"
| Mul (e1,e2) -> "(" ^ string_of_arith e1 ^ "*" ^ string_of_arith e2 ^ ")"
;;
**Exercise 8 (樋口)[#k7994cd4]
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);;
***実行結果 [#k19a8025]
# 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))))]
***おまけ [#m4ad1608]
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]);;
#ref(test.png)
**Exercise 9 (源馬) [#s4d9ace6]
無限リストを使って1000番目(あるいは学籍番号+3000)の素数を求める。
type 'a seq = Cons of 'a * (unit -> 'a seq);;
let rec from n = Cons (n, fun () -> from (n + 1));;
let head (Cons (x, _)) = x;;
let tail (Cons (_, f)) = f ();;
let rec take n s =
if n = 0 then [] else head s :: take (n - 1) (tail s);;
let rec sift n f =
if (head f) mod n = 0
then sift n (tail f)
else Cons (head f, fun () -> sift n (tail f));;
let rec sieve (Cons (x, f)) = Cons (x, fun () -> sieve (sift x (f())));;
let primes = sieve (from 2);;
take 20 primes;;
let rec nthseq n (Cons (x, f)) =
if n = 1 then x else nthseq (n - 1) (f());;
nthseq 1000 primes;;
解説。~
sieveの定義を見る。~
sift n f は、Cons (整数, thunk) を返すようだ。~
sieve (from 2)を見る。~
sieve (from 2)を人間評価して見る。sieve (Cons (2, from 3)) = Cons (2, fun () -> sieve (sift 2 (from 3)));;~
さあ、 sift 2 (from 3)) が登場した。~
ちなみに、素数列は、Cons (2, Cons (3, Cons (5, ...) だ。~
sieve (from 2)を実行した結果がそうなることを期待するのだから、経過として、~
Cons (2, fun () -> sieve (sift 2 (from 3)))
Cons (2, Cons (3, fun () -> sieve (sift 3 (sift 2 (from 4)))))
Cons (2, Cons (3, fun () -> sieve (sift 3 (sift 2 (from 5)))))
Cons (2, Cons (3, Cons (5, fun () -> sieve (sift 5 (sift 3 (sift 2 (from 6)))))))
Cons (2, Cons (3, Cons (5, fun () -> sieve (sift 5 (sift 3 (sift 2 (from 7)))))))
Cons (2, Cons (3, Cons (5, Cons (7, fun () -> sieve (sift 7 (sift 5 (sift 3 (sift 2 (from 8)))))))))
だろう。~
リスト風で書けば、~
2, fun () -> sieve (sift 2 (from 3))
2, 3, fun () -> sieve (sift 3 (sift 2 (from 4)))
2, 3, fun () -> sieve (sift 3 (sift 2 (from 5)))
2, 3, 5, fun () -> sieve (sift 5 (sift 3 (sift 2 (from 6))))
2, 3, 5, fun () -> sieve (sift 5 (sift 3 (sift 2 (from 7))))
2, 3, 5, 7, fun () -> sieve (sift 7 (sift 5 (sift 3 (sift 2 (from 8)))))
となる。~
よく見てほしい。~
sift 2 (from 3)は、 Cons (3, fun () -> sift 2 (from 4)) を返すのだということがわかるまで。~
そして、次の行。~
sift 2 (from 4)は、4が2で割り切れることに気づき、ただちに次の数字をよこせと、(from 4)に要求する。それで、(from 5)をもらえて一安心。~
sift 2 (from 5)は、Cons (5, fun () -> sift 2 (from 6)) を返す。~
それを受け取った sift 3 Cons (5, fun () -> sift 2 (from 6)) は、5が3で割り切れないことに安心しつつ、Cons (5, fun () -> sift 3 (sift 2 (from 6)))を返す。~
sift n fの定義は、~
head fを見て、割り切れることに気づいたら、ただちにtail fでやり直す。~
割り切れなかったら、安心しつつ、Cons (head f, fun () -> sift n (tail f)) を返す。~
let rec sift n f =
if (head f) mod n = 0
then sift n (tail f)
else Cons (head f, fun () -> sift n (tail f));;
*Chapter 7. Exercise [#dc67177c]
**Exercise 1 [#oe649801]
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 [#u76c0a17]
整数の参照をインクリメントする関数incr
# let incr x = x := !x + 1;;
val incr : int ref -> unit = <fun>
**Exercise 3 [#fe92b783]
# 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 [#v6d2c968]
# 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(みずの) [#q5984fe9]
let rec fact n = if n < 0 then raise (Invalid_argument "n should be positive")
else if n = 0 then 1
else n*fact(n-1);;
**Exercise 6 (飯田)[#ke8a0983]
先週お話があった、値多相についての問題。
letで名前が与えられる式の右辺が値であるときのみ、その変数が多相的に使える。
1
# let x = ref [];;
val x : '_a list ref = {contents = []}
'_a listは一度だけ任意の型に置換できる型変数である。
こうすることで、
# x := [1];;
# true :: !x;;
が許されてしまうのを防いでいる。xの型は[1]を代入したときに int list ref となる。
# true :: !x;;
Characters 8-10:
true :: !x;;
^^
This expression has type int list but is here used with type bool list
2
getとsetの定義。
# let (get, set) =
let r = ref [] in
((fun () -> !r), (fun x -> r := x));;
val get : unit -> '_a list = <fun>
val set : '_a list -> unit = <fun>
getは !r 返す関数なので、unit -> '_a list
setは rにxを格納する関数なので、'_a list -> unit
次に、
# 1 :: get ();;
- : int list = [1]
この時点で参照 r の型が int list ref に置換されるので、
get : unit -> int list
set : int list -> unit
となる。
# 1.0 :: get();;
Characters 7-12:
1.0 :: get();;
^^^^^
This expression has type int list but is here used with type float list
**Exercise 7 (吉岡)[#n2c3331e]
元のプログラムだと、pointCのincを継承した時に、
setが処理されcol:=WhileのあるcpointC内のcsetが実行されていない。
そのため、cincをしても座標はセットされるが、白色がセットされない。
そこで、pointCで継承するメソッドをsetからcsetにcpointCで変更できるようにする。
type pointI={get:unit->int;set:int->unit;inc:unit->unit};;
let pointC x this () ={
get=(fun () -> !x);
set=(fun newx -> x:=newx);
inc=(fun () -> (this ()).set ((this ()).get () + 1))
};;
let new_point x =
let x = ref x in
let rec this () = pointC x this () in
this ();;
相互再帰でsuper ()とthis ()を定義している。
super ()、this ()となっているのは、相互再帰が関数でのみ定義できるから。
type color=Blue|Red|Green|White;;
type cpointI={cget:unit->int;cset:int->unit;cinc:unit->unit;getcolor:unit->color};;
let cpointC x col=
let rec super ()= pointC x (fun ()->{get=(this ()).cget;set=(this ()).cset;inc=(this ()).cinc}) ()
and this ()=
{cget= (super ()).get;
cset= (fun x -> (super ()).set x; col := White);
cinc= (super ()).inc;
getcolor = (fun () -> !col)} in
this ();;
let new_cpoint x col = cpointC (ref x) (ref col);;
実行結果：
# cp.cinc();;
- : unit = ()
# cp.cget();;
- : int = 1
# cp.getcolor();;
- : color = White
**Exercise 8 (末次) [#n6faefa9]
まず元の定義
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]
と計算できる．
**Exercise 9 (下村) [#l136f82b]
すいません、時間がなくてあんまり考えてません…。
こんなんでいいのだろうか。簡単すぎ？
let print_int x = output_string stdout (string_of_int x);;
**Exercise 10(山畑) [#l213c9f8]
ファイルをコピーする関数cpを書く
let cp infn outfn =
let input = open_in infn in
let output = open_out outfn in
try
while true do
output_string output ((input_line input) ^ "?n")
done
with
End_of_file -> ();
close_in input;
close_out output;;
自分で改行を入れるのはどうかと思う。
![[PukiWiki]](image/caml3.jpg "[PukiWiki]")
