- プロジェクトオイラーの問題をＰｒｏlogで解くページ。
作者 堀江 伸一
近況 問い３６のコードの無駄を修正。
こんなネットの裏の裏の一番端っこの誰からも注目されないＷｉｋｉに何を書いたって世の中に何の影響も与えないので結構好きかって書いてます。
Problem 31 「硬貨の和」 †
解法
Ｐｒｏｌｏｇには破壊的代入がないので動的計画法が素直に使えません。
なのでちょっと苦労しましたがその結果まあまあの速度となりました。
今ならもうちょっと賢い方法で実装しますね
肝心のプログラムは以下の通り。
Hide Code
fast_reverse(List1,List2):-fr(List1,[],List2).
fr([Head|Tail],SoFar,Result):-fr(Tail,[Head|SoFar],Result).
fr([],SoFar,SoFar).
drop_w(Xs,Ys,Result):-length(Xs,Len1),length(Ys,Len2),Len3 is Len1-Len2,
drop(Xs,Len3,Result).
drop(Xs, 0, Xs).
drop([], N, []) :- N > 0.
drop([_ | Xs], N, Ys) :-
N > 0, N1 is N - 1, drop(Xs, N1, Ys).
add([],[],[]):-!.
add([Z1|Zs1],[Y|Ys],[Z2|Sum]):-Z2 is Z1+Y,add(Zs1,Ys,Sum).
setY([],Zs1,Ys1,Ans,_,_,Coins):-
drop_w(Zs1,Ys1,Zs2),
add(Zs2,Ys1,Zs3),
!,
NextZ=[Zs3|Ans],
flatten(NextZ,NextZ1),
fast_reverse(NextZ1,NextZ2),
(Coins==[]->write(NextZ2);
[Coin|Coins1]=Coins,
first_set(NextZ2,[],Zs4,Coin,NextZ3),
setY(NextZ3,Zs4,[],Zs4,0,Coin,Coins1)).
setY(Xs,Zs1,Ys1,Ans,N,N,Coins):-!,
add(Zs1,Ys1,NextZs),
setY(Xs,NextZs,[],[NextZs|Ans],0,N,Coins).
setY([X|Xs],Zs1,Ys1,Ans,Count,N,Coins):-!,
Count1 is Count+1,
setY(Xs,Zs1,[X|Ys1],Ans,Count1,N,Coins).
first_set(List,Zs,Zs,0,List):-!.
first_set([X|List],Zs,Result,N,Result2):-
N1 is N-1,
first_set(List,[X|Zs],Result,N1,Result2).
main_31_3:-
[C|Coins]=[1,2,5,10,20,50,100,200],
findall(0,between(0,199,_),List),
List1 = [1|List],
first_set(List1,[],Zs,C,List2),
setY(List2,Zs,[],Zs,0,C,Coins).
Problem 32 「パンデジタル積」 †
解法
うーん？
ヒュースティリックに解いてしまった。
コードはむやみに長いし、自動的に解の探索範囲がもとまらず探索範囲を人手で指定しているし。
これっていいコードなんだろうか？
sets([_],[_,_,_,_]).
sets([_,_],[_,_,_]).
selects([],Rest,Rest).
selects([X|Rest],Nums,Result):-select(X,Nums,NumRest),selects(Rest,NumRest,Result).
toNum([],C1,C1).
toNum([X|Rest],C1,Result):-
C2 is C1*10+X,toNum(Rest,C2,Result).
calc(Z):-
sets(Xs,Ys),
selects(Xs,[1,2,3,4,5,6,7,8,9],Rest1),
toNum(Xs,0,X),
selects(Ys,Rest1,Rest2),
toNum(Ys,0,Y),
Z is X*Y,
Z<10000,
Z1 is Z mod 10,
Z2 is (Z//10) mod 10,
Z3 is (Z//100) mod 10,
Z4 is (Z//1000) mod 10,
selects([Z1,Z2,Z3,Z4],Rest2,_).
sum([],Sum,Sum).
sum([X|Rest],Sum,Result):-Sum1 is Sum+X,sum(Rest,Sum1,Result).
main32:-
findall(Z,calc(Z),List),sort(List,List1),
sum(List1,0,Ans),write(Ans).
Problem 33 「桁消去分数」 †
解法
この問題コードは圧倒的に短くなるらしい。
とりあえず全部検討してみた。
search述語で重複が出なかったのでそのまま答えとした。
gcd(0, B, B).
gcd(A, B, G) :- A > 0, R is B mod A, gcd(R, A, G).
calc(U,D,N,ReU,ReD):-ReU is U*10+N,ReD is D*10+N.
calc(U,D,N,ReU,ReD):-ReU is U*10+N,ReD is D+N*10.
calc(U,D,N,ReU,ReD):-ReU is U+N*10,ReD is D*10+N.
calc(U,D,N,ReU,ReD):-ReU is U+N*10,ReD is D+N*10.
search([U1,D1]):-
between(1,8,U),
T is U+1,
between(T,9,D),
between(1,9,N),
calc(U,D,N,U1,D1),
gcd(U1,D1,G1),
gcd(U,D,G),
U//G=:=U1//G1,
D//G=:=D1//G1.
calc([],AnsU,AnsD):-gcd(AnsU,AnsD,G),Ans is AnsD//G,write(Ans).
calc([[U,D]|Rest],AnsU,AnsD):-
AnsU1 is U*AnsU,
AnsD1 is D*AnsD,
calc(Rest,AnsU1,AnsD1).
main33:-findall([U1,D1],search([U1,D1]),List),write(List),calc(List,1,1).
Problem 34 「桁の階乗」 †
問い30のコードをそのまま流用。
特に書くことなし。
check([_|_],0):-!,fail.
check([],0):-!.
check(Nums,Sum):-
T is Sum mod 10,
select(T,Nums,Rest),!,
Sum1 is Sum//10,
check(Rest,Sum1).
search(Nums,_,_,Sum,Sum):-
check(Nums,Sum).
search(_,_,7,_,_):-!,fail.
search(Nums,P,Deep,Sum,Result):-
between(P,9,N),
nth0(N,[1,1,2,6,24,120,720,5040,40320,362880],N1),
Sum1 is Sum+N1,
Deep1 is Deep+1,
search([N|Nums],N,Deep1,Sum1,Result).
sum([],Sum,Sum):-!.
sum([X|Rest],Sum,Result):-
Sum1 is Sum+X,sum(Rest,Sum1,Result).
main34:-findall(Re,search([],0,0,0,Re),List),
sum(List,0,Ans),Ans1 is Ans-3,write(Ans1).
Problem 35 「巡回素数」 †
http://odz.sakura.ne.jp/projecteuler/index.php?cmd=read&page=Problem%2035
197は巡回素数と呼ばれる. 桁を回転させたときに得られる数 197, 971, 719 が全て素数だからである.
100未満には巡回素数が13個ある: 2, 3, 5, 7, 11, 13, 17, 31, 37, 71, 73, 79, および97である.
100万未満の巡回素数はいくつあるか?
計算量低減テクニックで書いたコードといっても。
どの桁も奇数であるというものだけを探索して検討するようにしただけ。
２は探索では検討せず最後に足している。
テクニックがみについたら無意味に使いたがる、そういうコードかもしれない。
テクニックで遊ぶのも技術習得には必要な気もするのでこれもありかと。
round_list([],[],_).
round_list([X|L],R,Result):-round_list(L,[X|R],Result).
round_list([X|L],R,[X|Result]):-
reverse(R,R1),
append(L,R1,Result).
not_prime(N):-N<2,!.
not_prime(N):-
sqrt(N,N1),
N2 is floor(N1),
between(2,N2,N3),
N4 is N mod N3,
N4=:=0,!.
to_num([],Result,Result):-!.
to_num([X|List],Num,Result):-Num1 is Num*10+X,to_num(List,Num1,Result).
check_exe(List,Ans):-
round_list(List,[],Perm),
to_num(Perm,0,Num),
(member(Num,Ans)->!,true;true),
(not_prime(Num)->
true,!;fail).
result_list(List,_,_,List).
result_list(List,Deep,Ans,Result):-
create_perm(List,Deep,Ans,Result).
check_perm(List,Deep,Ans,Result):-
not(check_exe(List,Ans)),!,
to_num(List,0,Num),
result_list(List,Deep,[Num|Ans],Result).
check_perm(List,Deep,Ans,Result):-
create_perm(List,Deep,Ans,Result).
create_perm(_,6,_,_):-!,fail.
create_perm(List,Deep,Ans,Result):-
Deep<6,
between(1,9,N),
T1 is N mod 2,
T1\==0,
Deep1 is Deep+1,
check_perm([N|List],Deep1,Ans,Result).
main35:-findall(L,create_perm([],0,[],L),List),write(List),
length(List,Len),Len1 is Len+1,write(Len1).
問い36 Double-base palindromes
解法
Prolog的コードで書いたつもり。
前載せてたコードに恥ずかしい部分（実装上の無駄）があったので単純修正。
set([_]).
set([X1,X1]).
set([X1,_,X1]).
set([X2,X1,X1,X2]).
set([X2,X1,_,X1,X2]).
set([X2,X1,X0,X0,X1,X2]).
num_perm([]).
num_perm([X|Rest]):-member(X,[0,1,2,3,4,5,6,7,8,9]),num_perm(Rest).
to_num([],Sum,Sum).
to_num([X|Rest],Sum,Result):-Sum1 is Sum*10+X,to_num(Rest,Sum1,Result).
to_bit2(0,[]):-!.
to_bit2(Y,[B|Result]):-Y1 is Y//2,B is Y mod 2,to_bit2(Y1,Result).
calc(X):-
set(A),
num_perm(A),
[Top|_]=A,
0<Top,
to_num(A,0,X),
to_bit2(X,Re),
reverse(Re,Re).
sum([],Sum,Sum).
sum([X|Rest],Sum,Result):-Sum1 is X+Sum,sum(Rest,Sum1,Result).
main36:-
findall(Y,calc(Y),List),write(List),
sum(List,0,Ans),write(Ans).
Problem 37 「切り詰め可能素数」 †
http://odz.sakura.ne.jp/projecteuler/index.php?cmd=read&page=Problem%2037
3797は面白い性質を持っている. まずそれ自身が素数であり, 左から右に桁を除いたときに全て素数になっている (3797, 797, 97, 7). 同様に右から左に桁を除いたときも全て素数である (3797, 379, 37, 3).
右から切り詰めても左から切り詰めても素数になるような素数は11個しかない. 総和を求めよ.
注: 2, 3, 5, 7を切り詰め可能な素数とは考えない.
解法
ちょっとコードが冗長かもしれない。
速度はそれなり。
短い方から左へ数字列を伸ばしてそれが条件を満たす限りのばす単純な探索で作成。
右側を消したとき素数でなくなる数でも左側へ無限に数字を加えたらどこかで素数になるものがあるかもしれないので。
素数が１１個という情報がなかったらこの問題は恐ろしい難問となるはず。
探索は深さ制限で実行。
not_prime(N):-N<2,!.
not_prime(N):-
sqrt(N,N1),
N2 is floor(N1),
between(2,N2,N3),
N4 is N mod N3,
N4=:=0,!.
is_prime(N):-not(not_prime(N)).
to_num([],Sum,Sum).
to_num([X|Rest],Sum,Result):-Sum1 is Sum*10+X,to_num(Rest,Sum1,Result).
check_exe_R(0):-!.
check_exe_R(Num):-
Num1 is Num//10,
is_prime(Num),
check_exe_R(Num1).
search(List,List,_):-
to_num(List,0,Num),
10<Num,
check_exe_R(Num).
search(List,Ans,Deep):-
Deep>0,
Deep1 is Deep-1,
member(N,[1,2,3,5,7,9]),
to_num([N|List],0,Num),
is_prime(Num),
search([N|List],Ans,Deep1).
sum([],Sum,Sum).
sum([X|Rest],Sum,Result):-to_num(X,0,Num),Sum1 is Sum+Num,sum(Rest,Sum1,Result).
main37:-between(2,10,N),
findall(Ans,search([],Ans,N),List),length(List,11),
!,write(List),sum(List,0,Ans),write(Ans).
Problem 38 「パンデジタル倍数」 †
192 に 1, 2, 3 を掛けてみよう.
192 × 1 = 192
192 × 2 = 384
192 × 3 = 576
積を連結することで1から9の パンデジタル数 192384576 が得られる. 192384576 を 192 と (1,2,3) の連結積と呼ぶ.
同じようにして, 9 を 1,2,3,4,5 と掛け連結することでパンデジタル数 918273645 が得られる. これは 9 と (1,2,3,4,5) との連結積である.
整数と (1,2,...,n) (n > 1) との連結積として得られる9桁のパンデジタル数の中で最大のものはいくつか?
解法
探索するだけの問題です。
最後に出てきた数字の並びが答えとなります。
num_add(0,List,List):-!.
num_add(Num,List,[X|Result]):-
X is Num mod 10,
Num1 is Num//10,
num_add(Num1,List,Result),
X>0,
not(member(X,Result)).
search(_,_,List,_):-
length(List,Len),9<Len,!,fail.
search(_,_,List,List1):-
length(List,9),reverse(List,List1),!.
search(N,P,List,Result):-
N1 is N*P,
P1 is P+1,
num_add(N1,List,NextList),
search(N,P1,NextList,Result).
search_start(Re):-
between(1,9999,N),
search(N,1,[],Re).
main38:-
findall(Re,search_start(Re),List),
sort(List,List1),write(List1).
Problem 39 「整数の直角三角形」 †
http://odz.sakura.ne.jp/projecteuler/index.php?cmd=read&page=Problem%2039
辺の長さが {a,b,c} と整数の3つ組である直角三角形を考え, その周囲の長さを p とする. p = 120のときには3つの解が存在する:
{20,48,52}, {24,45,51}, {30,40,50}
p ≤ 1000 のとき解の数が最大になる p はいくつか?
%1000=>2*M*(M+N)
%500/M=>M+N
%500/M-M=>N
gcd(0, B, G) :- G is abs(B).
gcd(A, B, G) :- A =\= 0, R is B mod A, gcd(R, A, G).
qsort([], []).
qsort([X|L], S) :-
mypartition(L, X, L1, L2),
qsort(L1, S1),
qsort(L2, S2),
append(S1, [X|S2], S).
mypartition([], _, [], []).
mypartition([Y|L], X, [Y|L1], L2) :-
Y < X,
mypartition(L, X, L1, L2).
mypartition([Y|L], X, L1, [Y|L2]) :-
Y >= X,
mypartition(L, X, L1, L2).
set_MN([M,N]):-
between(2,500,M),
Up is floor(500/M-M)+1,
between(1,Up,N),
M>N,
1=:=(M-N) mod 2,
gcd(M,N,1),
L1 is 2*M*(M+N),
L1<1001.
calc2(L, _,[]):-L>1000,!.
calc2(L,Add,[L|Result]):-
L1 is L+Add,
calc2(L1,Add,Result).
calc([],[]):-!.
calc([[M,N]|Rest],[List|Result]):-
L is 2*M*(M+N),
calc2(L,L,List),
calc(Rest,Result).
count([],Count,L,[Count,L]):-!.
count([L|Rest],Count,L,Result):-!,
Count1 is Count+1,
count(Rest,Count1,L,Result).
count([L|Rest],Count,OldL,[[Count,OldL]|Result]):-
count(Rest,1,L,Result).
main39:-
findall([M,N],set_MN([M,N]),List),
calc(List,Re1),
flatten(Re1,Re2),
qsort(Re2,Re3),
count(Re3,0,0,Result),write(Result),sort(Result,Ans),write(Ans).
Problem 40 「チャンパーノウン定数」 †
解法
割り算とユニフィケーションどちらが遅いのだろうか？
まあ値が小さいからあっという間に答えは出るけれど、数式的に解くとどうなんだろう？
と思って調べてみたら高速に解くということは数字列のn番目の要素を高速に計算する関数を作ることだったようです。
ま妥当な話ですね。
とりあえず素朴に計算する例。
len(N,1):-N<10,!.
len(N,2):-N<100,!.
len(N,3):-N<1000,!.
len(N,4):-N<10000,!.
len(N,5):-N<100000,!.
len(N,6):-N<1000000,!.
len(N,7):-N<10000000,!.
no(0,N,Result):-!,Result is N mod 10.
no(D,N,Result):-D1 is D-1,N1 is N//10,no(D1,N1,Result).
calc([],_,_,Ans):-!,write(Ans).
calc([D|Rest],N,Len,Ans):-
len(N,Add),
Len1 is Len+Add,
D=<Len1,!,
D2 is Len1-D,
no(D2,N,F),
Ans1 is Ans*F,
N1 is N+1,
calc(Rest,N1,Len1,Ans1).
calc(Ds,N,Len,Ans):-
len(N,Add),
Len1 is Len+Add,
N1 is N+1,
calc(Ds,N1,Len1,Ans).
main40:-
calc([1,10,100,1000,10000,100000,1000000],1,0,1).
最終更新：2013年12月15日 06:31
