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

prolog勉強プロジェクトオイラー21~30 - (2013/07/18 (木) 14:12:17) の1つ前との変更点

追加された行は青色になります

削除された行は赤色になります。

 プロジェクトオイラーの問題を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的に書くとこんな風になる。
+一行で書ける言語で解くのが正しいが、これを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],[]).