「prolog勉強プロジェクトオイラー191~200」の編集履歴(バックアップ)一覧はこちら

prolog勉強プロジェクトオイラー191~200」(2013/12/11 (水) 12:46:21) の最新版変更点

追加された行は緑色になります。

削除された行は赤色になります。

プロジェクトオイラーの問題を堀江伸一こと私がProlog言語で解くページ。 兵庫県加古川市加古川町南備後79-16 名前 堀江伸一 Problem 191 「賞を貰える文字列」 † http://odz.sakura.ne.jp/projecteuler/index.php?cmd=read&page=Problem%20191 ある学校では出席率が高く遅刻率が低い生徒に褒賞金を出している. 3日連続で休む, または, 2回以上遅刻した生徒は褒賞金を得る権利を失う. n日間の各生徒の出席状況を3進の文字列で表す. 文字はL (late, 遅刻), O (on time, 出席), A (absent, 欠席) である. 4日間の場合, 81通りの3進の文字列が考えられる. そのうち賞を貰えるのは以下の43個の文字列である. 30日間の場合, 賞を貰える文字列は何通りか? 解法 BigO(30*(6*4+24*log(24)+24))で解けます。 動的計画法(メモ化計算?)で考えると、連続欠席の日数と遅刻の回数だけを主キーに計算すれば主キーはたったの6種類、計算量は非常に小さくなります。 それだけの簡単な問題です。 one_calc([L,_,P],[L,0,P]).% one_calc([0,_,P],[1,0,P]).% one_calc([L,0,P],[L,1,P]).% one_calc([L,1,P],[L,2,P]).% union_sum([],Y,[Y]):-!. union_sum([[L,A,P]|Rest],[L,A,P1],Result):- !, P2 is P+P1, union_sum(Rest,[L,A,P2],Result). union_sum([X|Rest],Y,[Y|Result]):- union_sum(Rest,X,Result). next_calc(Sets,Result):- member(Set,Sets), one_calc(Set,Result). sum([],0):-!. sum([[_,_,P]|Rest],Result):-sum(Rest,Re),Result is Re+P. search(30,Sets):-!,write(Sets),nl,sum(Sets,Ans),write(Ans). search(N,Sets):- findall(Set,next_calc(Sets,Set),Sets1), msort(Sets1,Sets2), [Top|Sets3]=Sets2, union_sum(Sets3,Top,Sets4), N1 is N+1, search(N1,Sets4). main191:- search(0,[[0,0,1]]). *Problem 194 「着色配置」 † http://odz.sakura.ne.jp/projecteuler/index.php?cmd=read&page=Problem%20194 ***解法 まずAユニットBユニットを自由に着色した場合の組み合わせを考えます。 7か所の敗色が条件を満たすようにします。 最初はAかB一個だけです。 それに右へとAかBをくっつけながら伸ばしていきます。 くっつけるときくっつけた2か所は色が固定され2色消費されます。 よって残りはその2か所以外の組み合わせを決定する5か所の配色組み合わせとなります。 あとはこれを動的計画法で編めば答えとなります。 ok_a([C1], C2):-C1=\=C2,!. ok_a([ _,C1], C3):-C1=\=C3,!. ok_a([C3, _, _], C4):-C3=\=C4,!. ok_a([C4, _,C2, _], C5):-C2=\=C5,C4=\=C5,!. ok_a([ _, _,C3, _,C1], C6):-C1=\=C6,C3=\=C6,!. ok_a([C6,C5, _, _,C2, _],C7):-C6=\=C7,C5=\=C7,C2=\=C7,!. ok_b(Perm,C7):- [C6,C5,_,_,_,_]=Perm, !, C5=\=C7, C6=\=C7. ok_b(Perm,Cn):-ok_a(Perm,Cn). calc_ab(Perm,_,_,_,Count,Count):- length(Perm,7), !. calc_ab(Perm,C,ColorCount,Check,Count,Result):- sort(Perm,Perm1), member(P,Perm1), call(Check,Perm,P), calc_ab([P|Perm],C,ColorCount,Check,Count,Result). calc_ab(Perm,C,ColorCount,Check,Count,Result):- ColorCount1 is ColorCount+1, ColorCount=<C, Count1 is Count*(C-ColorCount+1), calc_ab([ColorCount|Perm],C,ColorCount1,Check,Count1,Result). sum([],0):-!. sum([X|Xs],Result):-sum(Xs,Re),Result is (X+Re) mod (10^8). sumP([],0):-!. sumP([[_,_,Perm]|Rest],Result):-sumP(Rest,Re),Result is (Re+Perm) mod (10^8). calc_a1(PermA1,Colors):- findall(P,calc_ab([],Colors,1,ok_a,1,P),Perm), sum(Perm,PermA1). calc_b1(PermB1,Colors):- findall(P,calc_ab([],Colors,1,ok_b,1,P),Perm), sum(Perm,PermB1). calc_An(PermAn,Colors):- findall(P,calc_ab([2,1],Colors,3,ok_a,1,P),Perm), sum(Perm,PermAn). calc_Bn(PermBn,Colors):- findall(P,calc_ab([2,1],Colors,3,ok_b,1,P),Perm), sum(Perm,PermBn). union_sum([],Y,[Y]):-!. union_sum([[A,B,Perm]|Rest],[A,B,Perm1],Result):- !, Perm2 is (Perm1+Perm) mod (10^8), union_sum(Rest,[A,B,Perm2],Result). union_sum([X|Rest],Y,[Y|Result]):- !, union_sum(Rest,X,Result). one_calc([A,B,Perm],[LimitA,LimitB],[PermA,_],[A1,B,PermRe]):- A1 is A+1, PermRe is Perm*PermA, B=<LimitB, A1=<LimitA. one_calc([A,B,Perm],[LimitA,LimitB],[_,PermB],[A,B1,PermRe]):- B1 is B+1, PermRe is Perm*PermB, A=<LimitA, B1=<LimitB. next_calc(Memo,LimitAB,PermAB,Result):- member(M,Memo), one_calc(M,LimitAB,PermAB,Result). calc_ans(Memos,_,_,1):- write(Memos),nl, !, sumP(Memos,Ans), write(Ans). calc_ans(Memos,PermAB,LimitAB,Counter):- !, findall(M,next_calc(Memos,LimitAB,PermAB,M),Memos1), msort(Memos1,Memos2), [Top|Memos3]=Memos2, union_sum(Memos3,Top,Memos4), Counter1 is Counter-1, calc_ans(Memos4,PermAB,LimitAB,Counter1). n(LimitA,LimitB,Colors):- calc_a1(PermA1,Colors), calc_b1(PermB1,Colors), calc_An(PermAn,Colors), calc_Bn(PermBn,Colors), All=LimitA+LimitB, calc_ans([[1,0,PermA1],[0,1,PermB1]],[PermAn,PermBn],[LimitA,LimitB],All). main194:- n(25,75,1984). *Problem 199 「反復円充填」 † http://odz.sakura.ne.jp/projecteuler/index.php?cmd=read&page=Problem%20199 円で円を充填していく問題。 解法 あるサイズの円が描かれたときより小さな円の描かれ方は、 -A 一番大きな円と内接し、2つの円に外接する -B 3つの円に外接する円 の2種類があり得ます。 そしてより小さな円のサイズはAにしろBにしろ親となる3つの円のサイズだけから決まる関数となります。 AとBを求める関数が決まればあとは実装ゲームです。 計算誤差を最小化するということを考えて実装。 ただひたすらめんどくさい問題でした。 大卒なら数式変形ソフトで一発で解くのかもしれませんが高卒の私はそういうソフトの使い方の教育を受けたことがないので手計算で式変形してます。 in(R1,R2,R3,Result):- A is R3+R2, B is R1+R3, C is R1+R2, CosA is (B^2+C^2-A^2)/(2*B*C), SinA is sqrt(1-CosA^2), X1 is C, X2 is B*CosA, Y2 is B*SinA, S1 is X1^2+R1^2-R2^2, S2 is X2^2+R1^2+Y2^2-R3^2, S3 is X1*R1-X1*R3-X2*R1+X2*R2, S4 is -1*S1*X2+S2*X1, S5 is R1-R2, S6 is 4*Y2^2*S5^2+4*S3^2-4*Y2^2*X1^2, S7 is 4*Y2^2*S5*S1+4*S3*S4-8*Y2^2*X1^2*R1, S8 is Y2^2*S1^2+S4^2-4*Y2^2*X1^2*R1^2, Result is (-S7-sqrt(S7^2-4*S6*S8))/(2*S6). %XA is (2*Result*(R1-R2)+S1)/(2*X1), %YA is (2*Result*(R1-R3)-2*XA*X2+S2)/(2*Y2). out(R1,R2,R3,Result):- A is R2+R3, B is R1-R3, C is R1-R2, CosA is (B^2+C^2-A^2)/(2*B*C), SinA is sqrt(1-CosA^2), X1 is R1-R2, X2 is B*CosA, Y2 is B*SinA, S1 is R1^2+X1^2-R2^2, S2 is X2^2+R1^2+Y2^2-R3^2, S3 is R1+R2, S4 is R1+R3, S5 is 2*(S3*X2-S4*X1), S6 is S2*X1-S1*X2, S7 is 4*Y2^2*S3^2+S5^2-4*Y2^2*X1^2, S8 is -4*S1*S3*Y2^2+2*S5*S6+2*R1*4*Y2^2*X1^2, S9 is S1^2*Y2^2+S6^2-R1^2*4*Y2^2*X1^2, Result is (-S8-sqrt(S8^2-4*S7*S9))/(2*S7). %XA is (-2*Result*(R1+R2)+S1)/(2*X1), %YA is (Result*S5+S6)/(2*Y2*X1), %write([XA,YA]). sum([],0):-!. sum([X|Xs],Result):-sum(Xs,Re),Result is Re+X. next_in_a(_,_,_,_,R4,R44):-R44 is R4^2. next_in_a(10,_,_,_,_,0):-!,fail. next_in_a(N,R1,R2,_,R4,Result):- next_in(N,R1,R2,R4,Result). next_in_a(N,R1,_,R3,R4,Result):- next_in(N,R1,R3,R4,Result). next_in_a(N,_,R2,R3,R4,Result):- next_in(N,R2,R3,R4,Result). next_out_a(_,_,_,_,R4,R44):-R44 is R4^2. next_out_a(10,_,_,_,_,0):-!,fail. next_out_a(N,R1,R2,_,R4,Result):- next_out(N,R1,R2,R4,Result). next_out_a(N,R1,_,R3,R4,Result):- next_out(N,R1,R4,R3,Result). next_out_a(N,_,R2,R3,R4,Result):- next_in(N,R2,R3,R4,Result). next_in(N,R1,R2,R3,Result):- N1 is N+1, in(R1,R2,R3,R4), findall(S,next_in_a(N1,R1,R2,R3,R4,S),Sum), sum(Sum,Result). next_out(N,R1,R2,R3,Result):- N1 is N+1, out(R1,R2,R3,R4), findall(S,next_out_a(N1,R1,R2,R3,R4,S),Sum), sum(Sum,Result). main199:- R2 is (-6+sqrt(48))/2, S2 is R2^2*3, next_in(0,R2,R2,R2,AnsIn),nl,nl, next_out(0,1,R2,R2,AnsOut), nl,write([AnsIn,AnsOut,S2]),nl, Ans is 1-(AnsIn+AnsOut*3+S2), write(Ans).
プロジェクトオイラーの問題を堀江伸一こと私がProlog言語で解くページ。 兵庫県加古川市加古川町南備後79-16 名前 堀江伸一 Problem 191 「賞を貰える文字列」 † http://odz.sakura.ne.jp/projecteuler/index.php?cmd=read&page=Problem%20191 ある学校では出席率が高く遅刻率が低い生徒に褒賞金を出している. 3日連続で休む, または, 2回以上遅刻した生徒は褒賞金を得る権利を失う. n日間の各生徒の出席状況を3進の文字列で表す. 文字はL (late, 遅刻), O (on time, 出席), A (absent, 欠席) である. 4日間の場合, 81通りの3進の文字列が考えられる. そのうち賞を貰えるのは以下の43個の文字列である. 30日間の場合, 賞を貰える文字列は何通りか? 解法 BigO(30*(6*4+24*log(24)+24))で解けます。 動的計画法(メモ化計算?)で考えると、連続欠席の日数と遅刻の回数だけを主キーに計算すれば主キーはたったの6種類、計算量は非常に小さくなります。 それだけの簡単な問題です。 one_calc([L,_,P],[L,0,P]).% one_calc([0,_,P],[1,0,P]).% one_calc([L,0,P],[L,1,P]).% one_calc([L,1,P],[L,2,P]).% union_sum([],Y,[Y]):-!. union_sum([[L,A,P]|Rest],[L,A,P1],Result):- !, P2 is P+P1, union_sum(Rest,[L,A,P2],Result). union_sum([X|Rest],Y,[Y|Result]):- union_sum(Rest,X,Result). next_calc(Sets,Result):- member(Set,Sets), one_calc(Set,Result). sum([],0):-!. sum([[_,_,P]|Rest],Result):-sum(Rest,Re),Result is Re+P. search(30,Sets):-!,write(Sets),nl,sum(Sets,Ans),write(Ans). search(N,Sets):- findall(Set,next_calc(Sets,Set),Sets1), msort(Sets1,Sets2), [Top|Sets3]=Sets2, union_sum(Sets3,Top,Sets4), N1 is N+1, search(N1,Sets4). main191:- search(0,[[0,0,1]]). *Problem 194 「着色配置」 † http://odz.sakura.ne.jp/projecteuler/index.php?cmd=read&page=Problem%20194 ***解法 まずAユニットBユニットを自由に着色した場合の組み合わせを考えます。 7か所の配色が条件を満たすようにします。 最初はAかB一個だけです。 それに右へとAかBをくっつけながら伸ばしていきます。 くっつけるときくっつけた2か所は色が固定され2色消費されます。 よって残りはその2か所以外の組み合わせを決定する5か所の配色組み合わせとなります。 あとはこれを動的計画法で編めば答えとなります。 ok_a([C1], C2):-C1=\=C2,!. ok_a([ _,C1], C3):-C1=\=C3,!. ok_a([C3, _, _], C4):-C3=\=C4,!. ok_a([C4, _,C2, _], C5):-C2=\=C5,C4=\=C5,!. ok_a([ _, _,C3, _,C1], C6):-C1=\=C6,C3=\=C6,!. ok_a([C6,C5, _, _,C2, _],C7):-C6=\=C7,C5=\=C7,C2=\=C7,!. ok_b(Perm,C7):- [C6,C5,_,_,_,_]=Perm, !, C5=\=C7, C6=\=C7. ok_b(Perm,Cn):-ok_a(Perm,Cn). calc_ab(Perm,_,_,_,Count,Count):- length(Perm,7), !. calc_ab(Perm,C,ColorCount,Check,Count,Result):- sort(Perm,Perm1), member(P,Perm1), call(Check,Perm,P), calc_ab([P|Perm],C,ColorCount,Check,Count,Result). calc_ab(Perm,C,ColorCount,Check,Count,Result):- ColorCount1 is ColorCount+1, ColorCount=<C, Count1 is Count*(C-ColorCount+1), calc_ab([ColorCount|Perm],C,ColorCount1,Check,Count1,Result). sum([],0):-!. sum([X|Xs],Result):-sum(Xs,Re),Result is (X+Re) mod (10^8). sumP([],0):-!. sumP([[_,_,Perm]|Rest],Result):-sumP(Rest,Re),Result is (Re+Perm) mod (10^8). calc_a1(PermA1,Colors):- findall(P,calc_ab([],Colors,1,ok_a,1,P),Perm), sum(Perm,PermA1). calc_b1(PermB1,Colors):- findall(P,calc_ab([],Colors,1,ok_b,1,P),Perm), sum(Perm,PermB1). calc_An(PermAn,Colors):- findall(P,calc_ab([2,1],Colors,3,ok_a,1,P),Perm), sum(Perm,PermAn). calc_Bn(PermBn,Colors):- findall(P,calc_ab([2,1],Colors,3,ok_b,1,P),Perm), sum(Perm,PermBn). union_sum([],Y,[Y]):-!. union_sum([[A,B,Perm]|Rest],[A,B,Perm1],Result):- !, Perm2 is (Perm1+Perm) mod (10^8), union_sum(Rest,[A,B,Perm2],Result). union_sum([X|Rest],Y,[Y|Result]):- !, union_sum(Rest,X,Result). one_calc([A,B,Perm],[LimitA,LimitB],[PermA,_],[A1,B,PermRe]):- A1 is A+1, PermRe is Perm*PermA, B=<LimitB, A1=<LimitA. one_calc([A,B,Perm],[LimitA,LimitB],[_,PermB],[A,B1,PermRe]):- B1 is B+1, PermRe is Perm*PermB, A=<LimitA, B1=<LimitB. next_calc(Memo,LimitAB,PermAB,Result):- member(M,Memo), one_calc(M,LimitAB,PermAB,Result). calc_ans(Memos,_,_,1):- write(Memos),nl, !, sumP(Memos,Ans), write(Ans). calc_ans(Memos,PermAB,LimitAB,Counter):- !, findall(M,next_calc(Memos,LimitAB,PermAB,M),Memos1), msort(Memos1,Memos2), [Top|Memos3]=Memos2, union_sum(Memos3,Top,Memos4), Counter1 is Counter-1, calc_ans(Memos4,PermAB,LimitAB,Counter1). n(LimitA,LimitB,Colors):- calc_a1(PermA1,Colors), calc_b1(PermB1,Colors), calc_An(PermAn,Colors), calc_Bn(PermBn,Colors), All=LimitA+LimitB, calc_ans([[1,0,PermA1],[0,1,PermB1]],[PermAn,PermBn],[LimitA,LimitB],All). main194:- n(25,75,1984). *Problem 199 「反復円充填」 † http://odz.sakura.ne.jp/projecteuler/index.php?cmd=read&page=Problem%20199 円で円を充填していく問題。 解法 あるサイズの円が描かれたときより小さな円の描かれ方は、 -A 一番大きな円と内接し、2つの円に外接する -B 3つの円に外接する円 の2種類があり得ます。 そしてより小さな円のサイズはAにしろBにしろ親となる3つの円のサイズだけから決まる関数となります。 AとBを求める関数が決まればあとは実装ゲームです。 計算誤差を最小化するということを考えて実装。 ただひたすらめんどくさい問題でした。 大卒なら数式変形ソフトで一発で解くのかもしれませんが高卒の私はそういうソフトの使い方の教育を受けたことがないので手計算で式変形してます。 in(R1,R2,R3,Result):- A is R3+R2, B is R1+R3, C is R1+R2, CosA is (B^2+C^2-A^2)/(2*B*C), SinA is sqrt(1-CosA^2), X1 is C, X2 is B*CosA, Y2 is B*SinA, S1 is X1^2+R1^2-R2^2, S2 is X2^2+R1^2+Y2^2-R3^2, S3 is X1*R1-X1*R3-X2*R1+X2*R2, S4 is -1*S1*X2+S2*X1, S5 is R1-R2, S6 is 4*Y2^2*S5^2+4*S3^2-4*Y2^2*X1^2, S7 is 4*Y2^2*S5*S1+4*S3*S4-8*Y2^2*X1^2*R1, S8 is Y2^2*S1^2+S4^2-4*Y2^2*X1^2*R1^2, Result is (-S7-sqrt(S7^2-4*S6*S8))/(2*S6). %XA is (2*Result*(R1-R2)+S1)/(2*X1), %YA is (2*Result*(R1-R3)-2*XA*X2+S2)/(2*Y2). out(R1,R2,R3,Result):- A is R2+R3, B is R1-R3, C is R1-R2, CosA is (B^2+C^2-A^2)/(2*B*C), SinA is sqrt(1-CosA^2), X1 is R1-R2, X2 is B*CosA, Y2 is B*SinA, S1 is R1^2+X1^2-R2^2, S2 is X2^2+R1^2+Y2^2-R3^2, S3 is R1+R2, S4 is R1+R3, S5 is 2*(S3*X2-S4*X1), S6 is S2*X1-S1*X2, S7 is 4*Y2^2*S3^2+S5^2-4*Y2^2*X1^2, S8 is -4*S1*S3*Y2^2+2*S5*S6+2*R1*4*Y2^2*X1^2, S9 is S1^2*Y2^2+S6^2-R1^2*4*Y2^2*X1^2, Result is (-S8-sqrt(S8^2-4*S7*S9))/(2*S7). %XA is (-2*Result*(R1+R2)+S1)/(2*X1), %YA is (Result*S5+S6)/(2*Y2*X1), %write([XA,YA]). sum([],0):-!. sum([X|Xs],Result):-sum(Xs,Re),Result is Re+X. next_in_a(_,_,_,_,R4,R44):-R44 is R4^2. next_in_a(10,_,_,_,_,0):-!,fail. next_in_a(N,R1,R2,_,R4,Result):- next_in(N,R1,R2,R4,Result). next_in_a(N,R1,_,R3,R4,Result):- next_in(N,R1,R3,R4,Result). next_in_a(N,_,R2,R3,R4,Result):- next_in(N,R2,R3,R4,Result). next_out_a(_,_,_,_,R4,R44):-R44 is R4^2. next_out_a(10,_,_,_,_,0):-!,fail. next_out_a(N,R1,R2,_,R4,Result):- next_out(N,R1,R2,R4,Result). next_out_a(N,R1,_,R3,R4,Result):- next_out(N,R1,R4,R3,Result). next_out_a(N,_,R2,R3,R4,Result):- next_in(N,R2,R3,R4,Result). next_in(N,R1,R2,R3,Result):- N1 is N+1, in(R1,R2,R3,R4), findall(S,next_in_a(N1,R1,R2,R3,R4,S),Sum), sum(Sum,Result). next_out(N,R1,R2,R3,Result):- N1 is N+1, out(R1,R2,R3,R4), findall(S,next_out_a(N1,R1,R2,R3,R4,S),Sum), sum(Sum,Result). main199:- R2 is (-6+sqrt(48))/2, S2 is R2^2*3, next_in(0,R2,R2,R2,AnsIn),nl,nl, next_out(0,1,R2,R2,AnsOut), nl,write([AnsIn,AnsOut,S2]),nl, Ans is 1-(AnsIn+AnsOut*3+S2), write(Ans).

表示オプション

横に並べて表示:
変化行の前後のみ表示: