プロジェクトオイラーの問題をPrologで解くページ。 創価学会の皆さまから小学校の算数までしかできないと言われている堀江伸一さんがこのページのコードを書いているようです。 独り言 今日見つけたもの。 今日はリンク先質問には答えたけどこういう子どもには何と答えればよいのだろう、こういう子どもをきちんと教育するのは大人なら誰にでも責任があるものだとは思うけど？ http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q12110042462 *問い21 http://projecteuler.net/problem=21 10000以下の友愛数の和を求めよという問題。 そのまま定義通り計算するだけです。 複数の関数で一つの関数を表現するＰｒｏlogて独特。 yakusuu_sum(1,_,1,Sum,Sum):-!. yakusuu_sum(N,M,1,Sum,Sum1):-N<M*M,!,Sum1 is Sum*(N+1). yakusuu_sum(N,M,Multi,Sum,Result):- 0=:=N mod M,!, N1 is N//M, Multi1 is Multi*M+1, yakusuu_sum(N1,M,Multi1,Sum,Result). yakusuu_sum(N,M,Multi,Sum,Result):- Sum1 is Sum*Multi, M1 is M+1, yakusuu_sum(N,M1,1,Sum1,Result). yakusuu_sum_w(N,Result):- yakusuu_sum(N,2,1,1,Result). check(N):-yakusuu_sum_w(N,N1),N2 is N1-N,N\==N2,yakusuu_sum_w(N2,N3), N4 is N3-N2,N=:=N4. calc(N):- between(2,10000,N),check(N). sum([],Sum,Sum):-!. sum([X|Rest],Sum,Result):-Sum1 is Sum+X,sum(Rest,Sum1,Result). main21:-findall(N,calc(N),List),sum(List,0,Ans),write(Ans). *問い２２ Names scores Ｐｒｏｌｏｇの徹底ぶりを思い知った問題。 まさかファイル読み込み関数までバックトラックの対象だとは思わず、他の言語と同じノリで一回読んだらそれで終わり的な発想でコードを書いてすこしだけはまった。 気がついて慌てて修正。 このコードは正しいのだろうか？ 一応末尾再帰で再帰の深さを回避はしてるつもり。 findallを使う方が正しくないだろうか？ last(-1). spliter(34). read_name(Names,Name):- get0(C), (spliter(C)-> reverse(Name,Name1),karayomi_read([Name1|Names]); C1 is C-"A"+1, read_name(Names,[C1|Name])). karayomi_read(Names):-get0(C),karayomi(Names,C). karayomi(Names,C):-last(C),!,calc(Names). karayomi(Names,C):-spliter(C),!,read_name(Names,[]). karayomi(Names,_):-karayomi_read(Names). sum_score([],Sum,Sum). sum_score([X|Rest],Sum,Result):-Sum1 is Sum+X,sum_score(Rest,Sum1,Result). score_calc([],_,Score,Score). score_calc([Name|Rest],N,Score,Result):-sum_score(Name,0,S),Score1 is Score+N*S, N1 is N+1, score_calc(Rest,N1,Score1,Result). calc(Names):-seen,sort(Names,Names1), score_calc(Names1,1,0,Ans),write(Ans). main22:-seen,see('e22.txt'),karayomi_read([]). *問い２３ Non-abundant sums http://projecteuler.net/problem=23 配列のある言語だったら簡単で高速に解ける問題だけど、Ｐｒｏｌｏｇには配列がないためにちょっとしたパズルになってしまう問題。 一応末尾再帰で再帰にまつわる問題を回避しているので、再帰が深くなりすぎて停止することはないはず。 末尾に置いた述語はバックトラックが起きないよう述語内でカットしておかないと末尾再帰にならないようである。 このへんＰｒｏｌｏｇの利点が欠点になってる。 末尾再帰になるよう色々プログラマの方でチェックしてあげないといけない。 yakusuu_sum(N,M,Multi,Sum,Result):- 0=:=N mod M,!, N1 is N//M, Multi1 is Multi*M+1, yakusuu_sum(N1,M,Multi1,Sum,Result). yakusuu_sum(N,M,Multi,Sum,Result):- !,Sum1 is Sum*Multi, M1 is M+1, yakusuu_sum(N,M1,1,Sum1,Result). yakusuu_sum_w(N,Result):- yakusuu_sum(N,2,1,1,Result). sa_list(_,[],[]):-!. sa_list(N,[X|Rest],[N1|Result]):- N1 is N-X, sa_list(N,Rest,Result). check([],_,List,N,Ans):-!,add_next(List,N,Ans,N). check(_,[],List,N,Ans):-!,add_next(List,N,Ans,N). check([X1|_],[X1|_],List,N,Ans):-!,add_next(List,N,Ans,0). check([X1|Rest1],[X2|Rest2],List,N,Ans):-X1<X2,!, check(Rest1,[X2|Rest2],List,N,Ans). check([X1|Rest1],[X2|Rest2],List,N,Ans):-X1>X2, check([X1|Rest1],Rest2,List,N,Ans). check_w(List,List2,N,Ans):- reverse(List,List1),!, check(List1,List2,List,N,Ans). add_next(List,N,Ans,Add):- yakusuu_sum_w(N,Re), N1 is N+1, N2 is N*2, Re>N2,!, Ans1 is Ans + Add, get_kazyou_list([N|List],N1,Ans1). add_next(List,N,Ans,Add):- N1 is N+1,!, Ans1 is Ans+Add, get_kazyou_list(List,N1,Ans1). get_kazyou_list(List,28123,Ans):-!,nl,write([Ans]),length(List,Len),write(Len). get_kazyou_list(List,N,Ans):-!, sa_list(N,List,List1), check_w(List,List1,N,Ans). main23:-get_kazyou_list([],1,0). *問24 Lexicographic permutations 手計算で解いた方が１00倍早い問題。 一行で書ける言語で解くのが正しいが、これをＰｒｏｌｏｇ的に書くとこんな風になる。 この問題をプログラムで解くこと自体がナンセンスと言われても仕方ない。 facts(0,[1]):-!. facts(X,[T1|Result]):- X1 is X-1, facts(X1,Result), [T|_]=Result, T1 is T*X. calc(0,[],_,Ans):-!,reverse(Ans,Ans1),write(Ans1). calc(X,[M|Facters],Nums,Ans):- X1 is X mod M, P1 is X //M, nth0(P1,Nums,N1), select(N1,Nums,Nums1), calc(X1,Facters,Nums1,[N1|Ans]). main24:- facts(9,Facters),write(Facters),calc(999999,Facters,[0,1,2,3,4,5,6,7,8,9],[]). *問い25 1000-digit Fibonacci number http://projecteuler.net/problem=25 多桁計算を標準でサポートしている言語ではこれは簡単な問題。 fibo(A,_,N):-10^999=<A,!,write(N). fibo(A,B,N):-C is A+B,N1 is N+1,fibo(B,C,N1). main25:-fibo(1,1,1). *問い26 Reciprocal cycles http://projecteuler.net/problem=26 一番素朴な方法で実装。 もうちょっとましな処理を書きたいところだなこれは。 この手法では小学生と変わらない。 そのうえ割り算のたびにリストを精査してるから遅い。 せめて配列があれば楽なんだけど。 9、、、9で割ればよいのですが循環小数の循環節開始点の判別が出来ないのが問題。 http://www2r.biglobe.ne.jp/kosanhp/math/junkan.pdf この資料が役立つらしい。 zyunn_len(_,Num,_,M,0):-0=:=Num mod M,!. zyunn_len(List,Num,P,M,Ans):- Num<M,!,Num1 is Num*10,zyunn_len(List,Num1,P,M,Ans). zyunn_len(List,Num,P,M,Ans):- P1 is P+1, Num1 is Num mod M, (member([X,Num1],List)-> Ans is P-X; zyunn_len([[P,Num1]|List],Num1,P1,M,Ans)). calc(Num,Len):- between(1,1000,Num), zyunn_len([],1,0,Num,Len). max([],[0,0]):-!. max([[Num,Len]|List],[Num2,Len2]):- max(List,[Num1,Len1]), (Len1<Len-> Len2 is Len ,Num2 is Num; Len2 is Len1,Num2 is Num1). main26:-findall([Num,Len],calc(Num,Len),List), max(List,Ans),write(Ans). 他人のＣコードを参考に書きなおしたコード。 循環節がどこから始まるにせよ小数点以下Ｎ桁目よりは開始点が手前にあるという性質をりようして、Ｎ桁目まで求め、後はその時の余りが出てくるまでさらに割り続ければ循環節の長さが出てくる。 コードを見てるとなるほどと思う発想。 こういうちょっとした発想、思いつけるようになったら仕事でもちょっとは使えそうな気がする。 calc(0,_,_,_,0):-!. calc(N,M,R,Len,Len1):-N1 is (N*10) mod M,N1=:=R,!,Len1 is Len+1. calc(N,M,R,Len,Result):- Len1 is Len+1, N1 is (N*10) mod M, calc(N1,M,R,Len1,Result). calc_mod(N,R,N,R):-!. calc_mod(N,R,C,Result):- C1 is C+1, R1 is (R*10) mod N, calc_mod(N,R1,C1,Result). search([Len,N]):- between(2,1000,N), calc_mod(N,1,0,R), calc(R,N,R,0,Len). main26:-findall([Len,N],search([Len,N]),List), sort(List,List1),write(List1). *問い27 Quadratic primes 色々考えたが、処理手順を並べ替えるだけの素朴な発想では計算手数が落ちない。 高度な数学知識を使った方法は知らないので結論として素朴に全部試している。 not_prime(N):-N<2,!,true. not_prime(N):- sqrt(N,A), B is floor(A), between(2,B,M), M1 is N mod M, 0=:=M1,!,true. calc(N,A,B,N):-V is N*N+A*N+B,not_prime(V),!. calc(N,A,B,Result):-N1 is N+1,calc(N1,A,B,Result). search(N,A,B):- between(2,1000,B), not(not_prime(B)), between(-1000,1000,A), calc(0,A,B,N). main27:-findall([N,A,B],search(N,A,B),List), sort(List,List1),write(List1). *問い28 数式一発で解いても良かったけど、1001*1001と小さなサイズなので足し合わせて解いてみたり。 プロジェクトオイラーの問題は基本問題番号が大きいほど難しくなります。 このへんの低い問題はまだまだ中学生レベルです。 まあこのへんでも賢い解き方と私みたいなコンピュータパワーに頼った余り賢くない解き方に分かれるのでプログラムは結構奥深いものがあるようです。 calc(501,Sum):-!,write(Sum). calc(N,Sum):-Sum1 is Sum+(2*N-1)*(2*N-1)*4+10*2*N, N1 is N+1, calc(N1,Sum1). main28:-calc(1,1).
