「prolog勉強プロジェクトオイラー21~30」の編集履歴(バックアップ)一覧に戻る

prolog勉強プロジェクトオイラー21~30 - (2013/07/22 (月) 02:55:02) のソース

プロジェクトオイラーの問題をPrologで解くページ。
創価学会の皆さまから小学校の算数までしかできないと言われている堀江伸一さんがこのページのコードを書いているようです。


独り言
今日見つけたもの。
今日はリンク先質問には答えたけどこういう子どもには何と答えればよいのだろう、こういう子どもをきちんと教育するのは大人なら誰にでも責任があるものだとは思うけど?
http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q12110042462



*問い21
http://projecteuler.net/problem=21
10000以下の友愛数の和を求めよという問題。
そのまま定義通り計算するだけです。
複数の関数で一つの関数を表現するPrologて独特。

 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).




*問い22 Names scores
Prologの徹底ぶりを思い知った問題。
まさかファイル読み込み関数までバックトラックの対象だとは思わず、他の言語と同じノリで一回読んだらそれで終わり的な発想でコードを書いてすこしだけはまった。
気がついて慌てて修正。
このコードは正しいのだろうか?
一応末尾再帰で再帰の深さを回避はしてるつもり。
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([]).


*問い23 Non-abundant sums
http://projecteuler.net/problem=23
配列のある言語だったら簡単で高速に解ける問題だけど、Prologには配列がないためにちょっとしたパズルになってしまう問題。
一応末尾再帰で再帰にまつわる問題を回避しているので、再帰が深くなりすぎて停止することはないはず。
末尾に置いた述語はバックトラックが起きないよう述語内でカットしておかないと末尾再帰にならないようである。
このへんPrologの利点が欠点になってる。
末尾再帰になるよう色々プログラマの方でチェックしてあげないといけない。


 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
手計算で解いた方が100倍早い問題。
一行で書ける言語で解くのが正しいが、これをProlog的に書くとこんな風になる。
この問題をプログラムで解くこと自体がナンセンスと言われても仕方ない。


 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).



*問い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).