Category Archives: Project Euler

Project Euler 46

久しぶりに解きました。
あんまり良いプログラムではないけど…

%problem 46
:-lib(ic).
solve:-
	PrimeMax is 100000,
	assert(max(PrimeMax)),
	make_list(PrimeMax,Lst),
	eratosthenes_sieve(Lst,PrimeLst), % エラトステネスのふるいによる素数列挙

	Prime1#::PrimeLst,
	Prime2#::PrimeLst,
	A#=Prime1*Prime2,
	A#=_*2+1, % Aは奇数
	indomain(A,min),
	(
		Prime#::PrimeLst,
		B#>0,
		(A-Prime)/2 #= B*B,
		
		labeling([B])->
		(
%			printf(output,"%d = %d + 2*%d^2\n",[A,Prime,B]),
%			flush(output)
			true
		);
		(
			labeling([Prime1,Prime2]),
			printf(output,"answer %d = %d * %d\n",[A,Prime1,Prime2]),
			flush(output),
			abort
		)
	),
	fail.

mk_lst([],_,[]):-!.
mk_lst([First|Rest],Th,[Rest]):-
	First>Th,
	mk_lst(Rest,Th,Rest).
mk_lst([First|Rest],Th,[First|Rest]):-
	mk_lst(Rest,Th,Rest).

% 2 ～ Idx までのリストを作成
make_list(Idx,List):-
make_list_sub(Idx,List,[]).

make_list_sub(1,Ret,Ret):-!.
make_list_sub(Idx,Ret,List):-
Idx1 is Idx - 1,
make_list_sub(Idx1,Ret,[Idx | List]).

% 素数列挙 エラトステネスのふるい
eratosthenes_sieve([],[]):-!.
eratosthenes_sieve([First | Rest],[First | Rest]):-
max(Max),
First * First > Max ,
!.
eratosthenes_sieve([First | Rest], [First | Ret]):-
erase_baisu(First,Rest,Rest1),
eratosthenes_sieve(Rest1,Ret).

erase_baisu(_,[],[]):-!.
erase_baisu(Base,[First | Rest],[First | Ret]):-
First mod Base =\= 0,
!,
erase_baisu(Base,Rest,Ret).
erase_baisu(Base,[_ | Rest],Ret):-
erase_baisu(Base,Rest,Ret).

%problem 46

:-lib(ic).

solve:-

PrimeMax is 100000,

assert(max(PrimeMax)),

make_list(PrimeMax,Lst),

eratosthenes_sieve(Lst,PrimeLst), % エラトステネスのふるいによる素数列挙

Prime1#::PrimeLst,

Prime2#::PrimeLst,

A#=Prime1*Prime2,

A#=_*2+1, % Aは奇数

indomain(A,min),

(

Prime#::PrimeLst,

B#>0,

(A-Prime)/2 #= B*B,

labeling([B])->

(

% printf(output,"%d = %d + 2*%d^2\n",[A,Prime,B]),

% flush(output)

true

);

(

labeling([Prime1,Prime2]),

printf(output,"answer %d = %d * %d\n",[A,Prime1,Prime2]),

flush(output),

abort

)

fail.

mk_lst([],_,[]):-!.

mk_lst([First|Rest],Th,[Rest]):-

First>Th,

mk_lst(Rest,Th,Rest).

mk_lst([First|Rest],Th,[First|Rest]):-

mk_lst(Rest,Th,Rest).

% 2 ～ Idx までのリストを作成

make_list(Idx,List):-

make_list_sub(Idx,List,[]).

make_list_sub(1,Ret,Ret):-!.

make_list_sub(Idx,Ret,List):-

Idx1 is Idx - 1,

make_list_sub(Idx1,Ret,[Idx | List]).

% 素数列挙エラトステネスのふるい

eratosthenes_sieve([],[]):-!.

eratosthenes_sieve([First | Rest],[First | Rest]):-

max(Max),

First * First > Max ,

eratosthenes_sieve([First | Rest], [First | Ret]):-

erase_baisu(First,Rest,Rest1),

eratosthenes_sieve(Rest1,Ret).

erase_baisu(_,[],[]):-!.

erase_baisu(Base,[First | Rest],[First | Ret]):-

First mod Base =\= 0,

erase_baisu(Base,Rest,Ret).

erase_baisu(Base,[_ | Rest],Ret):-

erase_baisu(Base,Rest,Ret).

実行結果(回答伏せます) solve. answer XXXX = XXXX * XXXX Aborting execution ...

Project Euler Problem 62

2 Replies

Problem 62

ECLiPSe CLP で解きました。
ほぼPure Prolog で、制約論理の述語は使用してません。
自分のマシンで約9秒。

プログラム：

:-lib(util).
:-dynamic(cubic_sorted/2).

go:-
	retractall(cubic_sorted(_,_)),
	between(1,1000000000000,I),
		CubicNum is I * I * I,
		digit_sort(CubicNum,Sorted),
		assert(cubic_sorted(Sorted,I)),
		findall(Num,cubic_sorted(Sorted,Num),NumLst),
		length(NumLst,NumLen),
		(
			NumLen>=5->
				sort(NumLst,NumLstSorted),
				[First|_]=NumLstSorted,
				CubeFirst is First * First * First,
				printf(output, "CubicNum %d ,Lst %w", [CubeFirst, NumLst]),nl,
				true
				;
				fail
		)
	.

digit_sort(Num,Sorted):-
	num2lst(Num,Lst),
	msort(Lst,Sorted).

% convert number to list(reversed)
num2lst(0,[]):-!.
num2lst(Num,[Dig|DigRst]):-
	Dig is Num mod 10,
	RestNum is Num // 10,
	num2lst(RestNum,DigRst).

:-lib(util).

:-dynamic(cubic_sorted/2).

go:-

retractall(cubic_sorted(_,_)),

between(1,1000000000000,I),

CubicNum is I * I * I,

digit_sort(CubicNum,Sorted),

assert(cubic_sorted(Sorted,I)),

findall(Num,cubic_sorted(Sorted,Num),NumLst),

length(NumLst,NumLen),

(

NumLen>=5->

sort(NumLst,NumLstSorted),

[First|_]=NumLstSorted,

CubeFirst is First * First * First,

printf(output, "CubicNum %d ,Lst %w", [CubeFirst, NumLst]),nl,

true

;

fail

)

digit_sort(Num,Sorted):-

num2lst(Num,Lst),

msort(Lst,Sorted).

% convert number to list(reversed)

num2lst(0,[]):-!.

num2lst(Num,[Dig|DigRst]):-

Dig is Num mod 10,

RestNum is Num // 10,

num2lst(RestNum,DigRst).

コマンドライン：
?- time(go). Yes (9.22s cpu)

標準出力：
<解答伏せます。>

Success, times: 9.218750s thread, 9.219+0.000s process, 9.224s real

Project Euler Problem 59

Leave a reply

Problem 59

全体の文字数 – 「何文字がA-Z a-zの範囲だったか」　の数値をコストとして計算し、一番コストが小さくなるものをbb_minで調べました。
あんまり効率よくないプログラムで、1900秒くらいかかりました…遅いな…
あとテキストの文字数が3の倍数というところは前もって調べてて、それをあてにしたプログラムになってます（文字数が3の倍数でないとdecryptでこける）

ソース

:-lib(ic).
:-lib(ic_sets).
:-lib(propia).
:-lib(branch_and_bound).
:-lib(csv).

go(Str,Cost,Sum) :-
	csv:(csv_read("p059_cipher.txt", [InLst], Option)),
	char_code('a',AscA),
	char_code('z',AscZ),
	[Key1,Key2,Key3]#::AscA..AscZ,
	decrypt(InLst,OutLst,[Key1,Key2,Key3]),
	OutLst#::0..127,
	OutLst#::0..127,
	letter_count(OutLst,Cnt),
	length(OutLst,Len),
	Cost #= Len - Cnt, 
	flatten([Key1,Key2,Key3,OutLst],AllVals),
	labeling(AllVals),
	iso_light:(atom_codes(Str,OutLst)),
	mysum(OutLst,Sum).

decrypt([],[],_).
decrypt([N1,N2,N3|NRest],[D1,D2,D3|DRest],[K1,K2,K3]):-
	xor(N1,K1,D1) infers most,
	xor(N2,K2,D2) infers most,
	xor(N3,K3,D3) infers most,
	decrypt(NRest,DRest,[K1,K2,K3]).

letter_count([],0).
letter_count([First|Rest],Cnt):-
	letter_count(Rest,Cnt1),
	#::(First, [65..90, 97..122],Hit),
	Cnt #= Cnt1+Hit.

mysum([],0).
mysum([First|Rest],Sum):-
	mysum(Rest,Sum1),
	Sum is Sum1 + First.

:-lib(ic).

:-lib(ic_sets).

:-lib(propia).

:-lib(branch_and_bound).

:-lib(csv).

go(Str,Cost,Sum) :-

csv:(csv_read("p059_cipher.txt", [InLst], Option)),

char_code('a',AscA),

char_code('z',AscZ),

[Key1,Key2,Key3]#::AscA..AscZ,

decrypt(InLst,OutLst,[Key1,Key2,Key3]),

OutLst#::0..127,

letter_count(OutLst,Cnt),

length(OutLst,Len),

Cost #= Len - Cnt,

flatten([Key1,Key2,Key3,OutLst],AllVals),

labeling(AllVals),

iso_light:(atom_codes(Str,OutLst)),

mysum(OutLst,Sum).

decrypt([],[],_).

decrypt([N1,N2,N3|NRest],[D1,D2,D3|DRest],[K1,K2,K3]):-

xor(N1,K1,D1) infers most,

xor(N2,K2,D2) infers most,

xor(N3,K3,D3) infers most,

decrypt(NRest,DRest,[K1,K2,K3]).

letter_count([],0).

letter_count([First|Rest],Cnt):-

letter_count(Rest,Cnt1),

#::(First, [65..90, 97..122],Hit),

Cnt #= Cnt1+Hit.

mysum([],0).

mysum([First|Rest],Sum):-

mysum(Rest,Sum1),

Sum is Sum1 + First.

実行結果

?- bb_min(go(A, Cost, Sum), Cost, _223).
A = 復号化した文字列（伏せます）
Cost = 伏せます
Sum = 伏せます
Yes (1893.05s cpu)

?- bb_min(go(A, Cost, Sum), Cost, _223).

A = 復号化した文字列（伏せます）

Cost = 伏せます

Sum = 伏せます

Yes (1893.05s cpu)

Project Euler Problem 52

Leave a reply

Problem52

ECLiPSeで解きました。
処理時間は自分のマシン(Intel(R) Core(TM) i5-3340M CPU @ 270GHz)で6.5秒くらい。
見どころ？はECLiPSeのlogical-loopで書いた順列permutationと、propiaで数値を入れ替えた制約を作っているところ
logical loop はループ用のサブ述語みたいなアホっぽい定義がなくなってコードがエレガントになるのでSWI-Prologでもぜひ正式採用してほしい。
桁のところは一般化してなく、1桁、2桁、3桁…　と手入力で増やしながら確認しました
（bb_minでそれぞれの桁での最小の数値が取れるようにしてます）。

プログラム：

:-lib(ic).
:-lib(propia).
:-lib(branch_and_bound).

go(Digits,[X1num,X2num,X3num,X4num,X5num,X6num]) :-
	length(X1Lst,Digits),
	X1Lst#::[0..9],
	lst2num(X1Lst,X1num),
	X1num #> 10 ^ (Digits-1),
	X2num #= X1num * 2,
	X3num #= X1num * 3,
	X4num #= X1num * 4,
	X5num #= X1num * 5,
	X6num #= X1num * 6,
	permutation(X1Lst,X2Lst) infers most,
	lst2num(X2Lst,X2num),
	permutation(X1Lst,X3Lst) infers most,
	lst2num(X3Lst,X3num),
	permutation(X1Lst,X4Lst) infers most,
	lst2num(X4Lst,X4num),
	permutation(X1Lst,X5Lst) infers most,
	lst2num(X5Lst,X5num),
	permutation(X1Lst,X6Lst) infers most,
	lst2num(X6Lst,X6num),
	labeling([X1num,X2num,X3num,X4num,X5num,X6num]).
	
lst2num(L,N):-
	(foreach(Num,L),fromto(0,In,Out,N),count(I,0,_)
		do
		Out #= In + 10^I * Num
	).

permutation(A,B):-
	(fromto(A,AIn,AOut,[]),fromto(B,[BFirst|BRest],BRest,[])
		do
		select(BFirst,AIn,AOut)
	).

:-lib(ic).

:-lib(propia).

:-lib(branch_and_bound).

go(Digits,[X1num,X2num,X3num,X4num,X5num,X6num]) :-

length(X1Lst,Digits),

X1Lst#::[0..9],

lst2num(X1Lst,X1num),

X1num #> 10 ^ (Digits-1),

X2num #= X1num * 2,

X3num #= X1num * 3,

X4num #= X1num * 4,

X5num #= X1num * 5,

X6num #= X1num * 6,

permutation(X1Lst,X2Lst) infers most,

lst2num(X2Lst,X2num),

permutation(X1Lst,X3Lst) infers most,

lst2num(X3Lst,X3num),

permutation(X1Lst,X4Lst) infers most,

lst2num(X4Lst,X4num),

permutation(X1Lst,X5Lst) infers most,

lst2num(X5Lst,X5num),

permutation(X1Lst,X6Lst) infers most,

lst2num(X6Lst,X6num),

labeling([X1num,X2num,X3num,X4num,X5num,X6num]).

lst2num(L,N):-

(foreach(Num,L),fromto(0,In,Out,N),count(I,0,_)

Out #= In + 10^I * Num

permutation(A,B):-

(fromto(A,AIn,AOut,[]),fromto(B,[BFirst|BRest],BRest,[])

select(BFirst,AIn,AOut)

実行結果（解答伏せます）：

?- bb_min(go(XXXXXXX, [N1, N2, N3, N4, N5, N6]), N1, Option).
N1 = XXXXXXXX
N2 = XXXXXXXX
N3 = XXXXXXXX
N4 = XXXXXXXX
N5 = XXXXXXXX
N6 = XXXXXXXX
Option = bb_options(continue, -1.0Inf, 1.0Inf, 1, 1, 0, 0, one, _466, _467, _468)
Yes (6.59s cpu)

?- bb_min(go(XXXXXXX, [N1, N2, N3, N4, N5, N6]), N1, Option).

N1 = XXXXXXXX

N2 = XXXXXXXX

N3 = XXXXXXXX

N4 = XXXXXXXX

N5 = XXXXXXXX

N6 = XXXXXXXX

Option = bb_options(continue, -1.0Inf, 1.0Inf, 1, 1, 0, 0, one, _466, _467, _468)

Yes (6.59s cpu)

Project Euler Problem79

Leave a reply

久しぶりにProject Eulerやってみました。
制約論理プログラミングで解きました。ほとんど頭使ってない…
SWI-Prologです。

Problem79

:-use_module(library(clpfd)).

solve(A,Len):-
	length(A,Len),
	A ins 0..9,
	choice(A,[3,1,9],IdxLst1,Len),
	choice(A,[6,8,0],IdxLst2,Len),
	choice(A,[1,8,0],IdxLst3,Len),
	choice(A,[6,9,0],IdxLst4,Len),
	choice(A,[1,2,9],IdxLst5,Len),
	choice(A,[6,2,0],IdxLst6,Len),
	choice(A,[7,6,2],IdxLst7,Len),
	choice(A,[6,8,9],IdxLst8,Len),
	choice(A,[7,6,2],IdxLst9,Len),
	choice(A,[3,1,8],IdxLst10,Len),
	choice(A,[3,6,8],IdxLst11,Len),
	choice(A,[7,1,0],IdxLst12,Len),
	choice(A,[7,2,0],IdxLst13,Len),
	choice(A,[7,1,0],IdxLst14,Len),
	choice(A,[6,2,9],IdxLst15,Len),
	choice(A,[1,6,8],IdxLst16,Len),
	choice(A,[1,6,0],IdxLst17,Len),
	choice(A,[6,8,9],IdxLst18,Len),
	choice(A,[7,1,6],IdxLst19,Len),
	choice(A,[7,3,1],IdxLst20,Len),
	choice(A,[7,3,6],IdxLst21,Len),
	choice(A,[7,2,9],IdxLst22,Len),
	choice(A,[3,1,6],IdxLst23,Len),
	choice(A,[7,2,9],IdxLst24,Len),
	choice(A,[7,2,9],IdxLst25,Len),
	choice(A,[7,1,0],IdxLst26,Len),
	choice(A,[7,6,9],IdxLst27,Len),
	choice(A,[2,9,0],IdxLst28,Len),
	choice(A,[7,1,9],IdxLst29,Len),
	choice(A,[6,8,0],IdxLst30,Len),
	choice(A,[3,1,8],IdxLst31,Len),
	choice(A,[3,8,9],IdxLst32,Len),
	choice(A,[1,6,2],IdxLst33,Len),
	choice(A,[2,8,9],IdxLst34,Len),
	choice(A,[1,6,2],IdxLst35,Len),
	choice(A,[7,1,8],IdxLst36,Len),
	choice(A,[7,2,9],IdxLst37,Len),
	choice(A,[3,1,9],IdxLst38,Len),
	choice(A,[7,9,0],IdxLst39,Len),
	choice(A,[6,8,0],IdxLst40,Len),
	choice(A,[8,9,0],IdxLst41,Len),
	choice(A,[3,6,2],IdxLst42,Len),
	choice(A,[3,1,9],IdxLst43,Len),
	choice(A,[7,6,0],IdxLst44,Len),
	choice(A,[3,1,6],IdxLst45,Len),
	choice(A,[7,2,9],IdxLst46,Len),
	choice(A,[3,8,0],IdxLst47,Len),
	choice(A,[3,1,9],IdxLst48,Len),
	choice(A,[7,2,8],IdxLst49,Len),
	choice(A,[7,1,6],IdxLst50,Len),
	label(A).


choice(A,[P1,P2,P3],[N1,N2,N3],Cnt):-
	[N1,N2,N3] ins 1..Cnt,
	element(N1,A,P1),
	element(N2,A,P2),
	element(N3,A,P3),
	N1 #< N2,
	N2 #< N3.

:-use_module(library(clpfd)).

solve(A,Len):-

length(A,Len),

A ins 0..9,

choice(A,[3,1,9],IdxLst1,Len),

choice(A,[6,8,0],IdxLst2,Len),

choice(A,[1,8,0],IdxLst3,Len),

choice(A,[6,9,0],IdxLst4,Len),

choice(A,[1,2,9],IdxLst5,Len),

choice(A,[6,2,0],IdxLst6,Len),

choice(A,[7,6,2],IdxLst7,Len),

choice(A,[6,8,9],IdxLst8,Len),

choice(A,[7,6,2],IdxLst9,Len),

choice(A,[3,1,8],IdxLst10,Len),

choice(A,[3,6,8],IdxLst11,Len),

choice(A,[7,1,0],IdxLst12,Len),

choice(A,[7,2,0],IdxLst13,Len),

choice(A,[7,1,0],IdxLst14,Len),

choice(A,[6,2,9],IdxLst15,Len),

choice(A,[1,6,8],IdxLst16,Len),

choice(A,[1,6,0],IdxLst17,Len),

choice(A,[6,8,9],IdxLst18,Len),

choice(A,[7,1,6],IdxLst19,Len),

choice(A,[7,3,1],IdxLst20,Len),

choice(A,[7,3,6],IdxLst21,Len),

choice(A,[7,2,9],IdxLst22,Len),

choice(A,[3,1,6],IdxLst23,Len),

choice(A,[7,2,9],IdxLst24,Len),

choice(A,[7,2,9],IdxLst25,Len),

choice(A,[7,1,0],IdxLst26,Len),

choice(A,[7,6,9],IdxLst27,Len),

choice(A,[2,9,0],IdxLst28,Len),

choice(A,[7,1,9],IdxLst29,Len),

choice(A,[6,8,0],IdxLst30,Len),

choice(A,[3,1,8],IdxLst31,Len),

choice(A,[3,8,9],IdxLst32,Len),

choice(A,[1,6,2],IdxLst33,Len),

choice(A,[2,8,9],IdxLst34,Len),

choice(A,[1,6,2],IdxLst35,Len),

choice(A,[7,1,8],IdxLst36,Len),

choice(A,[7,2,9],IdxLst37,Len),

choice(A,[3,1,9],IdxLst38,Len),

choice(A,[7,9,0],IdxLst39,Len),

choice(A,[6,8,0],IdxLst40,Len),

choice(A,[8,9,0],IdxLst41,Len),

choice(A,[3,6,2],IdxLst42,Len),

choice(A,[3,1,9],IdxLst43,Len),

choice(A,[7,6,0],IdxLst44,Len),

choice(A,[3,1,6],IdxLst45,Len),

choice(A,[7,2,9],IdxLst46,Len),

choice(A,[3,8,0],IdxLst47,Len),

choice(A,[3,1,9],IdxLst48,Len),

choice(A,[7,2,8],IdxLst49,Len),

choice(A,[7,1,6],IdxLst50,Len),

label(A).

choice(A,[P1,P2,P3],[N1,N2,N3],Cnt):-

[N1,N2,N3] ins 1..Cnt,

element(N1,A,P1),

element(N2,A,P2),

element(N3,A,P3),

N1 #< N2,

N2 #< N3.

回答伏せます

発見

Leave a reply

CLP(B)を使ってProjectEuler の No.172を解いている記事を見つけた。

CLPFD の開発者のMarkus Triskaさんが書いている。

The Boolean Constraint Solver of SWI-Prolog: System Description

他にも No.161 に関する記載もありますね。

…しかし律儀に全数を数え上げる方法を使ってるからムチャクチャ効率悪くて、メモリ20Gbyte積んだマシン使って7時間もかかって解いてる…ダメだなこりゃ…

Probrem 185 Number Mind

Leave a reply

Project Eulerの問題はものすごくたくさんあるし（2017.05.12現在で600問弱）自分の目的はProlog関連技術の威力を試すためにやっている側面が強く全問制覇が目標ではないので、これからはまずそれに適した問題から解いてゆこうと思う。

Probrem 185 Number Mind

この問題は「ザ・制約論理プログラミング用問題」というくらい制約論理プログラミングに向いていると感じ手を付けた。ほとんど探索の工夫をせずに問題の定義のみ書いて、ちゃんと解けている。

今回プログラムを作っていてハマってしまった箇所があり、勉強になった。
・術語内で制約論理用変数を使いそれを呼び元に返さない状態でlabelingを行うと、それらの変数がガベージコレクトされておかしくなる。
・上記のエラーメッセージはguess述語の呼び出しをかなり減らした状態から順々に増やしてゆかないと見ることができない（全て書いた状態で実行すると一晩返ってこないプログラムとなり時間をかけて正しく動いているようにも見え、プログラムが間違っているという手がかりは全く得られなかった）

上記のような手続き型言語と異なる独自の開発ノウハウが結構あるので、これからも要勉強である。

labelingのオプションでも相当速度が変わる。基本はffもしくはffcをつけるで良いと思う。

この問題は Difficulty Rating が55% で、 2017年5月12日現在で解いた人が 2273 人しかいない問題だそうで、今まで自分が解いた中では一番難しい問題のようだ。

個人的には今までチャレンジかつ正答した問題の中では 191 Prize String が一番難しく、これは1週間位組み合わせ・順列系のサイトを調べまくって解いた。自分の解き方はエレガントでなかったが、正答者のみ見れるスレッドによると動的計画法でエレガントかつ超スピードで解けるようだ。

Number Mindの問題は前述のハマり以外はとくに問題はなかった。正答者スレによるとECLiPSeとかいう（IDEのほうではない）同じく制約論理ライブラリを使って解いている人がいた。その人のコードもほぼ問題の定義のみが記述されているエレガントなものだった。自分のスピードより数十倍速いようだったので、Eclipse恐るべしと思った。いつか勉強するかも。

正答者スレを見ることにより、自分より遥かに優秀な取り組み方をしている人の使用言語やソースコードを確認できるのも Project Euler の良いところだと思う。

ソースコード：

:-use_module(library(clpfd)).
solve(Num):-
	length(Num,16),
	Num ins 0..9,
	
	guess(Num,2321386104303845,0,Hits00),
	guess(Num,6375711915077050,1,Hits01),
	guess(Num,6913859173121360,1,Hits02),
	guess(Num,3847439647293047,1,Hits03),
	guess(Num,3174248439465858,1,Hits04),
	guess(Num,8157356344118483,1,Hits05),
	guess(Num,4895722652190306,1,Hits06),
	guess(Num,4513559094146117,2,Hits07),
	guess(Num,5616185650518293,2,Hits08),
	guess(Num,2615250744386899,2,Hits09),
	guess(Num,6442889055042768,2,Hits10),
	guess(Num,2326509471271448,2,Hits11),
	guess(Num,5251583379644322,2,Hits12),
	guess(Num,2659862637316867,2,Hits13),
	guess(Num,5855462940810587,3,Hits14),
	guess(Num,9742855507068353,3,Hits15),
	guess(Num,4296849643607543,3,Hits16),
	guess(Num,7890971548908067,3,Hits17),
	guess(Num,8690095851526254,3,Hits18),
	guess(Num,1748270476758276,3,Hits19),
	guess(Num,3041631117224635,3,Hits20),
	guess(Num,1841236454324589,3,Hits21),
	
	Hits=[	Hits00,Hits01,Hits02,Hits03,Hits04,
			Hits05,Hits06,Hits07,Hits08,Hits09,
			Hits10,Hits11,Hits12,Hits13,Hits14,
			Hits15,Hits16,Hits17,Hits18,Hits19,
			Hits20,Hits21],
	
	flatten([Num,Hits],Flatten),
	labeling([ff,bisect],Flatten).
	
guess(Num,CompareNum,HitNum,Hits):-
	number_codes(CompareNum,Codes),
	maplist(code_num,Codes,Nums),
	%write(Nums),nl,
	maplist(chk_hit,Num,Nums,Hits),
	sum(Hits,#=,HitNum).

chk_hit(A,B,H):-
	A#=B #<==> H.
	
code_num(Cd,Num):-
	Num is Cd - 48.

:-use_module(library(clpfd)).

solve(Num):-

length(Num,16),

Num ins 0..9,

guess(Num,2321386104303845,0,Hits00),

guess(Num,6375711915077050,1,Hits01),

guess(Num,6913859173121360,1,Hits02),

guess(Num,3847439647293047,1,Hits03),

guess(Num,3174248439465858,1,Hits04),

guess(Num,8157356344118483,1,Hits05),

guess(Num,4895722652190306,1,Hits06),

guess(Num,4513559094146117,2,Hits07),

guess(Num,5616185650518293,2,Hits08),

guess(Num,2615250744386899,2,Hits09),

guess(Num,6442889055042768,2,Hits10),

guess(Num,2326509471271448,2,Hits11),

guess(Num,5251583379644322,2,Hits12),

guess(Num,2659862637316867,2,Hits13),

guess(Num,5855462940810587,3,Hits14),

guess(Num,9742855507068353,3,Hits15),

guess(Num,4296849643607543,3,Hits16),

guess(Num,7890971548908067,3,Hits17),

guess(Num,8690095851526254,3,Hits18),

guess(Num,1748270476758276,3,Hits19),

guess(Num,3041631117224635,3,Hits20),

guess(Num,1841236454324589,3,Hits21),

Hits=[ Hits00,Hits01,Hits02,Hits03,Hits04,

Hits05,Hits06,Hits07,Hits08,Hits09,

Hits10,Hits11,Hits12,Hits13,Hits14,

Hits15,Hits16,Hits17,Hits18,Hits19,

Hits20,Hits21],

flatten([Num,Hits],Flatten),

labeling([ff,bisect],Flatten).

guess(Num,CompareNum,HitNum,Hits):-

number_codes(CompareNum,Codes),

maplist(code_num,Codes,Nums),

%write(Nums),nl,

maplist(chk_hit,Num,Nums,Hits),

sum(Hits,#=,HitNum).

chk_hit(A,B,H):-

A#=B #<==> H.

code_num(Cd,Num):-

Num is Cd - 48.

実行結果：

?- time(solve(Num)),write(Num).
% 585,922,243 inferences, 43.774 CPU in 43.975 seconds (100% CPU, 13385202 Lips)
**********解答伏せてます**********
% 176,962,326 inferences, 13.057 CPU in 13.140 seconds (99% CPU, 13552767 Lips)
false.

?- time(solve(Num)),write(Num).

% 585,922,243 inferences, 43.774 CPU in 43.975 seconds (100% CPU, 13385202 Lips)

**********解答伏せてます**********

% 176,962,326 inferences, 13.057 CPU in 13.140 seconds (99% CPU, 13552767 Lips)

false.

Problem2　偶数のフィボナッチ数

Leave a reply

問題

% problem 2
solve:-
	fibo([2,1],Fibo),
	even_sum(Fibo,Sum),
	write(Sum).
	
even_sum([],0):-!.
even_sum([First|Rest],Sum):-
	First mod 2 =:= 0,
	!,
	even_sum(Rest,Sum1),
	Sum is First + Sum1.
even_sum([_|Rest],Sum):-
	even_sum(Rest,Sum).
	
	
fibo([First|Rest],Rest):-
	First >= 4000000,
	!.
fibo([P1,P2|Rest],Out):-
	P0 is P1 + P2,
	fibo([P0,P1,P2|Rest],Out).

% problem 2

solve:-

fibo([2,1],Fibo),

even_sum(Fibo,Sum),

write(Sum).

even_sum([],0):-!.

even_sum([First|Rest],Sum):-

First mod 2 =:= 0,

even_sum(Rest,Sum1),

Sum is First + Sum1.

even_sum([_|Rest],Sum):-

even_sum(Rest,Sum).

fibo([First|Rest],Rest):-

First >= 4000000,

fibo([P1,P2|Rest],Out):-

P0 is P1 + P2,

fibo([P0,P1,P2|Rest],Out).

実行結果：
1 ?- solve.
***********************(解答伏せます)**********************
true.

Problem 9 特別なピタゴラス数

Leave a reply

問題

CLPFDを使って解いた。こんなのでも結構時間かかっていて、CLPFD大丈夫か？？と不安になった…

% problem 9
:-use_module(library(clpfd)).

solve:-
	[A,B,C] ins 1..1000,
	A + B + C #= 1000,
	A #< B, B #< C,
	A * A + B * B #= C * C,
	label([A,B,C]),
	write([A,B,C]).

% problem 9

:-use_module(library(clpfd)).

solve:-

[A,B,C] ins 1..1000,

A + B + C #= 1000,

A #< B, B #< C,

A * A + B * B #= C * C,

label([A,B,C]),

write([A,B,C]).

実行結果：

1 ?- time(solve).
[XXX,XXX,XXX]
% 69,890,740 inferences, 132.578 CPU in 134.625 seconds (98% CPU, 527166 Lips)
true

1 ?- time(solve).

[XXX,XXX,XXX]

% 69,890,740 inferences, 132.578 CPU in 134.625 seconds (98% CPU, 527166 Lips)

true

Problem 8 数字列中の最大の積

Leave a reply

問題

他にも挑戦している人がいると思うので今回から解答を伏せます。

% problem 8
:- dynamic
	gvar/2.
	
gvar(max,0).

set_gvar(Name,X):-
	nonvar(Name),retract(gvar(Name,_)),!,asserta(gvar(Name,X)).
set_gvar(Name,X):-
	nonvar(Name),asserta(gvar(Name,X)).
	
bignum(7316717653133062491922511967442657474235534919493496983520312774506326239578318016984801869478851843858615607891129494954595017379583319528532088055111254069874715852386305071569329096329522744304355766896648950445244523161731856403098711121722383113622298934233803081353362766142828064444866452387493035890729629049156044077239071381051585930796086670172427121883998797908792274921901699720888093776657273330010533678812202354218097512545405947522435258490771167055601360483958644670632441572215539753697817977846174064955149290862569321978468622482839722413756570560574902614079729686524145351004748216637048440319989000889524345065854122758866688116427171479924442928230863465674813919123162824586178664583591245665294765456828489128831426076900422421902267105562632111110937054421750694165896040807198403850962455444362981230987879927244284909188845801561660979191338754992005240636899125607176060588611646710940507754100225698315520005593572972571636269561882670428252483600823257530420752963450).

solve:-
	gvar(max,0),
	bignum(BigNumAtom),
	number_chars(BigNumAtom,BigNumChars),
	bignum_mul(BigNumChars).
	
bignum_mul([A01,A02,A03,A04,A05,A06,A07,A08,A09,A10,A11,A12,A13 | Rest]):-
	!,
	List = [A01,A02,A03,A04,A05,A06,A07,A08,A09,A10,A11,A12,A13],
	mul_chars(List,Mul),
	gvar(max,Max),
	(Mul > Max->(set_gvar(max,Mul),write(Mul),nl);true),
	bignum_mul([A02,A03,A04,A05,A06,A07,A08,A09,A10,A11,A12,A13 | Rest]).
	
mul_chars([],1):-!.
mul_chars([First|Rest],Mul):-
	number_chars(FirstNum,[First]),
	mul_chars(Rest,MulRest),
	Mul is MulRest * FirstNum.

% problem 8

:- dynamic

gvar/2.

gvar(max,0).

set_gvar(Name,X):-

nonvar(Name),retract(gvar(Name,_)),!,asserta(gvar(Name,X)).

set_gvar(Name,X):-

nonvar(Name),asserta(gvar(Name,X)).

bignum(7316717653133062491922511967442657474235534919493496983520312774506326239578318016984801869478851843858615607891129494954595017379583319528532088055111254069874715852386305071569329096329522744304355766896648950445244523161731856403098711121722383113622298934233803081353362766142828064444866452387493035890729629049156044077239071381051585930796086670172427121883998797908792274921901699720888093776657273330010533678812202354218097512545405947522435258490771167055601360483958644670632441572215539753697817977846174064955149290862569321978468622482839722413756570560574902614079729686524145351004748216637048440319989000889524345065854122758866688116427171479924442928230863465674813919123162824586178664583591245665294765456828489128831426076900422421902267105562632111110937054421750694165896040807198403850962455444362981230987879927244284909188845801561660979191338754992005240636899125607176060588611646710940507754100225698315520005593572972571636269561882670428252483600823257530420752963450).

solve:-

gvar(max,0),

bignum(BigNumAtom),

number_chars(BigNumAtom,BigNumChars),

bignum_mul(BigNumChars).

bignum_mul([A01,A02,A03,A04,A05,A06,A07,A08,A09,A10,A11,A12,A13 | Rest]):-

List = [A01,A02,A03,A04,A05,A06,A07,A08,A09,A10,A11,A12,A13],

mul_chars(List,Mul),

gvar(max,Max),

(Mul > Max->(set_gvar(max,Mul),write(Mul),nl);true),

bignum_mul([A02,A03,A04,A05,A06,A07,A08,A09,A10,A11,A12,A13 | Rest]).

mul_chars([],1):-!.

mul_chars([First|Rest],Mul):-

number_chars(FirstNum,[First]),

mul_chars(Rest,MulRest),

Mul is MulRest * FirstNum.

実行結果：

1 ?- time(solve).
***********************(解答伏せます)**********************
% 42,565 inferences, 0.047 CPU in 0.047 seconds (100% CPU, 908053 Lips)
false.

1 ?- time(solve).

***********************(解答伏せます)**********************

% 42,565 inferences, 0.047 CPU in 0.047 seconds (100% CPU, 908053 Lips)

false.