プロジェクトオイラーの問題を堀江伸一こと私がProlog言語で解くページ。
兵庫県加古川市加古川町南備後79-16
名前 堀江伸一
解法
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 「着色配置」 †
解法
まず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 「反復円充填」 †
解法
あるサイズの円が描かれたときより小さな円の描かれ方は、
- 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).
最終更新:2013年12月11日 12:46