「prolog勉強プロジェクトオイラー191～200」の編集履歴（バックアップ）一覧に戻る
プロジェクトオイラーの問題を堀江伸一こと私が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))で解けます。
動的計画法（メモ化計算？）で考えると、連続欠席の日数と遅刻の回数だけを主キーに計算すれば主キーはたったの６種類、計算量は非常に小さくなります。
それだけの簡単な問題です。
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
***解法
まずＡユニットＢユニットを自由に着色した場合の組み合わせを考えます。
７か所の配色が条件を満たすようにします。
最初はＡかＢ一個だけです。
それに右へとＡかＢをくっつけながら伸ばしていきます。
くっつけるときくっつけた２か所は色が固定され２色消費されます。
よって残りはその２か所以外の組み合わせを決定する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 一番大きな円と内接し、２つの円に外接する
-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).
