Category Archives: Project Euler

Problem 7 10001番目の素数

% problem 7

% Idx は 9 のみで構成されている必要あり
solve(Idx):-
	retractall(sosu),
	assert(max(Idx)),
	make_list(Idx,List),
	eratosthenes_sieve(List,List1), % エラトステネスのふるいによる素数列挙
	nth1(10001,List1,Sosu),
	write(Sosu).

% 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).
	rotate_sub(Rot1,Idx1,Rot).

% problem 7

% Idx は 9 のみで構成されている必要あり

solve(Idx):-

retractall(sosu),

assert(max(Idx)),

make_list(Idx,List),

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

nth1(10001,List1,Sosu),

write(Sosu).

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

rotate_sub(Rot1,Idx1,Rot).

実行結果：

1 ?- solve(1000000).
***********************(解答伏せます)**********************
true.

1 ?- solve(1000000).

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

true.

Problem 68 Magic 5-gon ring

Leave a reply

問題

CLPFDを用いて解いた。こういうのがCLPFDの得意分野だと思う。
作成時間1時間弱？

変数の場所

:-use_module(library(clpfd)).

main:-
	List = [A,B,C,D,E,F,G,H,I,J],
	List ins 1..10,
	all_different(List),
	A #= 10 #\/ B #= 10 #\/ C #= 10 #\/ D #= 10 #\/ E #= 10,
	maplist(#<(A),[B,C,D,E]),
	maplist(
			sum,
			[[A,F,G],[B,G,H],[C,H,I],[D,I,J],[E,J,F]],
			[#=,#=,#=,#=,#=],
			[Sum,Sum,Sum,Sum,Sum]),
	flatten([[A,F,G],[B,G,H],[C,H,I],[D,I,J],[E,J,F]],Flatten),
	setof(Flatten,label(List),Num15List),
	maplist(num_chr_recursive,Num15List,Num16List),
	write(Num15List),nl,nl,
	write(Num16List),nl,nl,
	msort(Num16List,Sorted),
	write(Sorted),nl,nl,
	last(Sorted,Last),
	write('answer:'),nl,
	write(Last).
	
num_chr_recursive([],[]):-!.
num_chr_recursive([FirstNum|RestNums],Ret):-
	!,
	num_chr_recursive(RestNums,RestChrs),
	atom_chars(FirstNum,Chrs),
	append(Chrs,RestChrs,Ret).

:-use_module(library(clpfd)).

main:-

List = [A,B,C,D,E,F,G,H,I,J],

List ins 1..10,

all_different(List),

A #= 10 #\/ B #= 10 #\/ C #= 10 #\/ D #= 10 #\/ E #= 10,

maplist(#<(A),[B,C,D,E]),

maplist(

sum,

[[A,F,G],[B,G,H],[C,H,I],[D,I,J],[E,J,F]],

[#=,#=,#=,#=,#=],

[Sum,Sum,Sum,Sum,Sum]),

flatten([[A,F,G],[B,G,H],[C,H,I],[D,I,J],[E,J,F]],Flatten),

setof(Flatten,label(List),Num15List),

maplist(num_chr_recursive,Num15List,Num16List),

write(Num15List),nl,nl,

write(Num16List),nl,nl,

msort(Num16List,Sorted),

write(Sorted),nl,nl,

last(Sorted,Last),

write('answer:'),nl,

write(Last).

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

num_chr_recursive([FirstNum|RestNums],Ret):-

num_chr_recursive(RestNums,RestChrs),

atom_chars(FirstNum,Chrs),

append(Chrs,RestChrs,Ret).

実行結果
[10] 25 ?- main.
***********************(解答伏せます)**********************
true.

Problem 6 ２乗和の差

Leave a reply

問題

最初のほうのはみんな簡単ですね…歯ごたえあるやつまでとばしてやるかな…

プログラム：

% problem 6	
solve:-
	make_list(100,L),
	calc_pow2_sum(L,PowSum),
	calc_sum(L,Sum),
	SumPow is Sum * Sum,
	Ans is SumPow - PowSum ,
	write(Ans).

calc_pow2_sum([],0):-!.
calc_pow2_sum([First|Rest],PowSum):-
	FirstPow is First * First,
	calc_pow2_sum(Rest,PowSumRest),
	PowSum is FirstPow + PowSumRest.
	
calc_sum([],0):-!.
calc_sum([First|Rest],Sum):-
	calc_sum(Rest,RestSum),
	Sum is First + RestSum.
	
% 1 ～ Idx までのリストを作成
make_list(Idx,List):-
	make_list_sub(Idx,List,[]).
	
make_list_sub(0,Ret,Ret):-!.
make_list_sub(Idx,Ret,List):-
	Idx1 is Idx - 1,
	make_list_sub(Idx1,Ret,[Idx | List]).

% problem 6

solve:-

make_list(100,L),

calc_pow2_sum(L,PowSum),

calc_sum(L,Sum),

SumPow is Sum * Sum,

Ans is SumPow - PowSum ,

write(Ans).

calc_pow2_sum([],0):-!.

calc_pow2_sum([First|Rest],PowSum):-

FirstPow is First * First,

calc_pow2_sum(Rest,PowSumRest),

PowSum is FirstPow + PowSumRest.

calc_sum([],0):-!.

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

calc_sum(Rest,RestSum),

Sum is First + RestSum.

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

make_list(Idx,List):-

make_list_sub(Idx,List,[]).

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

make_list_sub(Idx,Ret,List):-

Idx1 is Idx - 1,

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

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

Problem 5 最小公倍数

Leave a reply

問題

1～20の最小公倍数を求めているだけ

プログラム：

% problem 5
	
solve:-
	calc_lcm_all([2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20],Lcm),
	write(Lcm).

% すべての数字の最小公倍数を取得
calc_lcm_all([],1):-!.
calc_lcm_all([First|Rest],Lcm):-
	calc_lcm_all(Rest,LcmRest),
	lcm(First,LcmRest,Lcm).

% 最小公倍数
lcm(N, M, Lcm) :-
	Gcd is gcd(N , M),
	Lcm is (N * M) // Gcd, !.

% problem 5

solve:-

calc_lcm_all([2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20],Lcm),

write(Lcm).

% すべての数字の最小公倍数を取得

calc_lcm_all([],1):-!.

calc_lcm_all([First|Rest],Lcm):-

calc_lcm_all(Rest,LcmRest),

lcm(First,LcmRest,Lcm).

% 最小公倍数

lcm(N, M, Lcm) :-

Gcd is gcd(N , M),

Lcm is (N * M) // Gcd, !.

実行結果：

[2] 9 ?- time(solve).
***********************(解答伏せます)**********************
% 79 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips)
true.

[2] 9 ?- time(solve).

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

% 79 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips)

true.

Problem 44　五角数

Leave a reply

問題

assertのハッシュとselectの順番に頼った力まかせのひどいプログラム。エレガントさのかけらもない。遅いし…

make_pent_list(10000,PentLst)の数字も小さいものから試していって見つかるまでだんだんと増やしてった（ひどい）

答えは合ってた。

:-use_module(library(clpfd)).


main:-

	make_pent_list(10000,PentLst),

	select(B,PentLst,Rest),

	select(A,Rest,_),

	A < B,

	Sum is A+B,

	p(Sum),

	Diff is B-A,

	p(Diff),

	write([Diff]).
make_pent_list(0,[]):-!.

make_pent_list(Idx,[First|Rest]):-

	!,

	First is Idx * (3*Idx - 1) / 2,

	assert(p(First)),

	Idx1 is Idx - 1,

	make_pent_list(Idx1,Rest).
%　実行結果

%

%1 ?- time(once(main)).

%[5482660]

%% 252,016,073 inferences, 295.203 CPU in 296.719 seconds (99% CPU, 853704 Lips)

%true.

Problem 4 最大回文積

Leave a reply

問題

問題を「3桁の数3つの最大回文積を求めよ」と読み間違っていてずっと解答が合わずに頭を抱えていた。勘違いしていた問題のほうが本題より難しいがこちらの答えは以下のとおり967262769になるようだ。
1 ?- time(solve).
967262769=999*989*979
% 30,373,524 inferences, 16.703 CPU in 16.734 seconds (100% CPU, 1818434 Lips)
true
between述語のデクリメントバージョンdetween_decを作成して対応した。

プログラム：

% problem 4
	
solve:-
	between_dec(999,100,Left3Dig),
	number_chars(Left3Dig,NumChars),
	[D1,D2,D3] = NumChars,
	[D1,D2,D3,D3,D2,D1] = KaibunChars,
	number_chars(Kaibun,KaibunChars),
	
	between_dec(999,100,A),
	Kaibun mod A =:= 0,
	
	B is Kaibun / A,
	
	100 =< B, B =<  999,
	!,
	write(Kaibun),write('='),write(A),write('*'),write(B),nl.

% decrimental version of between
between_dec(Max,Min,Val):-
	integer(Val),
	!,
	Max >= Val,
	Val >= Min.
between_dec(Max,Min,Val):-
	var(Val),
	between_dec_sub(Max,Min,Max,Val).

between_dec_sub(_,Min,Val,_):-
	Val<Min,
	!,
	fail.
between_dec_sub(Max,Min,Val,Val):-
	Min =< Val,Val =< Max.
between_dec_sub(Max,Min,Val,RetVal):-
	Val1 is Val - 1,
	between_dec_sub(Max,Min,Val1,RetVal).

% problem 4

solve:-

between_dec(999,100,Left3Dig),

number_chars(Left3Dig,NumChars),

[D1,D2,D3] = NumChars,

[D1,D2,D3,D3,D2,D1] = KaibunChars,

number_chars(Kaibun,KaibunChars),

between_dec(999,100,A),

Kaibun mod A =:= 0,

B is Kaibun / A,

100 =< B, B =< 999,

write(Kaibun),write('='),write(A),write('*'),write(B),nl.

% decrimental version of between

between_dec(Max,Min,Val):-

integer(Val),

Max >= Val,

Val >= Min.

between_dec(Max,Min,Val):-

var(Val),

between_dec_sub(Max,Min,Max,Val).

between_dec_sub(_,Min,Val,_):-

Val<Min,

fail.

between_dec_sub(Max,Min,Val,Val):-

Min =< Val,Val =< Max.

between_dec_sub(Max,Min,Val,RetVal):-

Val1 is Val - 1,

between_dec_sub(Max,Min,Val1,RetVal).

実行結果：

1 ?- time(solve).
回答伏せます
% 420,104 inferences, 0.219 CPU in 0.219 seconds (100% CPU, 1920475 Lips)
true.

1 ?- time(solve).

回答伏せます

% 420,104 inferences, 0.219 CPU in 0.219 seconds (100% CPU, 1920475 Lips)

true.

Problem 35 循環素数

Leave a reply

問題

解説：
①エラトステネスのふるいによる素数列挙、すべてsosu述語としてassert
②rotate述語で転回した数字をsosu述語で存在するか確認
　すべての転回に関して存在すればretract
　見つかった分カウントをアップ

結構速く動作してると思います（自分の基準では）

% problem 35

% Idx は 9 のみで構成されている必要あり
solve(Idx):-
	retractall(sosu),
	flag(junkan_sosu_cnt, _, 0),
	assert(max(Idx)),
	make_list(Idx,List),
	eratosthenes_sieve(List,List1), % エラトステネスのふるいによる素数列挙
	assert_all(List1),
	rot_chks(List1),
	!,
	flag(junkan_sosu_cnt, Cnt1, Cnt1),nl,
	write(Cnt1).

rot_chks([]):-!.
rot_chks([First|Rest]):-
	rot_chk(First),
	rot_chks(Rest).
rot_chks([_|Rest]):-
	!,
	rot_chks(Rest).
	
rot_chk(Num):-
	!,
	findall(Rot,rotate(Num,Rot),RotLst),
	sort(RotLst,RotLst1),  % delete duplicate numbers like [11,11]
	sosu_assert_chk(RotLst1),
	write(RotLst1),nl,
	length(RotLst1,Len),
	flag(junkan_sosu_cnt, Cnt, Cnt + Len),
	retract_sosu_list(RotLst1).

% リスト内がすべて素数としてassertされているかかェック
sosu_assert_chk([]):-!.
sosu_assert_chk([First|Rest]):-
	sosu(First),
	sosu_assert_chk(Rest).

retract_sosu_list([]):-!.
retract_sosu_list([First|Rest]):-
	retract(sosu(First)),
	retract_sosu_list(Rest).

assert_all([]):-!.
assert_all([First|Rest]):-
	assert(sosu(First)),
	assert_all(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).

% Num を回転させた数字が Rot (Choice Pointあり)
% 123 -> 231 , 312
rotate(Num,Rot):-
	number_chars(Num,Chrs),
	length(Chrs,Len),
	rotate_sub(Chrs,Len,Rot).

rotate_sub(_,0,_):-!,fail.
rotate_sub(Chrs,_,RotNum):-
	number_chars(RotNum,Chrs).
rotate_sub([First | Rest],Idx ,Rot ):-
	append(Rest,[First],Rot1),
	Idx1 is Idx -1 ,
	rotate_sub(Rot1,Idx1,Rot).

% problem 35

% Idx は 9 のみで構成されている必要あり

solve(Idx):-

retractall(sosu),

flag(junkan_sosu_cnt, _, 0),

assert(max(Idx)),

make_list(Idx,List),

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

assert_all(List1),

rot_chks(List1),

flag(junkan_sosu_cnt, Cnt1, Cnt1),nl,

write(Cnt1).

rot_chks([]):-!.

rot_chks([First|Rest]):-

rot_chk(First),

rot_chks(Rest).

rot_chks([_|Rest]):-

rot_chks(Rest).

rot_chk(Num):-

findall(Rot,rotate(Num,Rot),RotLst),

sort(RotLst,RotLst1), % delete duplicate numbers like [11,11]

sosu_assert_chk(RotLst1),

write(RotLst1),nl,

length(RotLst1,Len),

flag(junkan_sosu_cnt, Cnt, Cnt + Len),

retract_sosu_list(RotLst1).

% リスト内がすべて素数としてassertされているかかェック

sosu_assert_chk([]):-!.

sosu_assert_chk([First|Rest]):-

sosu(First),

sosu_assert_chk(Rest).

retract_sosu_list([]):-!.

retract_sosu_list([First|Rest]):-

retract(sosu(First)),

retract_sosu_list(Rest).

assert_all([]):-!.

assert_all([First|Rest]):-

assert(sosu(First)),

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

% Num を回転させた数字が Rot (Choice Pointあり)

% 123 -> 231 , 312

rotate(Num,Rot):-

number_chars(Num,Chrs),

length(Chrs,Len),

rotate_sub(Chrs,Len,Rot).

rotate_sub(_,0,_):-!,fail.

rotate_sub(Chrs,_,RotNum):-

number_chars(RotNum,Chrs).

rotate_sub([First | Rest],Idx ,Rot ):-

append(Rest,[First],Rot1),

Idx1 is Idx -1 ,

rotate_sub(Rot1,Idx1,Rot).

実行結果：

1 ?- 
% c:/Documents and Settings/Owner/My Documents/Prolog/junkan_sosu.pl compiled 0.02 sec, 25 clauses
1 ?- time(solve(999999)).
***********************(解答伏せます)**********************
% 42,859,931 inferences, 35.094 CPU in 35.156 seconds (100% CPU, 1221298 Lips)
true.

1 ?-

% c:/Documents and Settings/Owner/My Documents/Prolog/junkan_sosu.pl compiled 0.02 sec, 25 clauses

1 ?- time(solve(999999)).

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

% 42,859,931 inferences, 35.094 CPU in 35.156 seconds (100% CPU, 1221298 Lips)

true.

Problem 3 最大の素因数

Leave a reply

問題

% problem 3

solve:-
	write('600851475143 = '),
	div_mod0(600851475143,2),
	!.

div_mod0(1,_):-
	!,
	write('1').
div_mod0(BaseNum,DivNum):-
	BaseNum mod DivNum =:= 0,
	Divided is BaseNum / DivNum,
	DivNum1 is 2,
	write(DivNum),write(' * '),
	div_mod0(Divided,DivNum1).

div_mod0(BaseNum,DivNum):-
	DivNum1 is DivNum + 1,
	div_mod0(BaseNum,DivNum1).

% problem 3

solve:-

write('600851475143 = '),

div_mod0(600851475143,2),

div_mod0(1,_):-

write('1').

div_mod0(BaseNum,DivNum):-

BaseNum mod DivNum =:= 0,

Divided is BaseNum / DivNum,

DivNum1 is 2,

write(DivNum),write(' * '),

div_mod0(Divided,DivNum1).

div_mod0(BaseNum,DivNum):-

DivNum1 is DivNum + 1,

div_mod0(BaseNum,DivNum1).

実行結果：

1 ?- time(solve).
***********************(解答伏せます)**********************
% 18,489 inferences, 0.016 CPU in 0.016 seconds (100% CPU, 1183296 Lips)
true.

1 ?- time(solve).

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

% 18,489 inferences, 0.016 CPU in 0.016 seconds (100% CPU, 1183296 Lips)

true.

Problem 11 格子内の最大の積

Leave a reply

問題

最初の問題は簡単だなあ…作業感出てきた…早くもう少し難しくなってほしい

% problem 11

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

solve:-
	set_gvar(squares,
		masu(
			hline(08,02,22,97,38,15,00,40,00,75,04,05,07,78,52,12,50,77,91,08),
			hline(49,49,99,40,17,81,18,57,60,87,17,40,98,43,69,48,04,56,62,00),
			hline(81,49,31,73,55,79,14,29,93,71,40,67,53,88,30,03,49,13,36,65),
			hline(52,70,95,23,04,60,11,42,69,24,68,56,01,32,56,71,37,02,36,91),
			hline(22,31,16,71,51,67,63,89,41,92,36,54,22,40,40,28,66,33,13,80),
			hline(24,47,32,60,99,03,45,02,44,75,33,53,78,36,84,20,35,17,12,50),
			hline(32,98,81,28,64,23,67,10,26,38,40,67,59,54,70,66,18,38,64,70),
			hline(67,26,20,68,02,62,12,20,95,63,94,39,63,08,40,91,66,49,94,21),
			hline(24,55,58,05,66,73,99,26,97,17,78,78,96,83,14,88,34,89,63,72),
			hline(21,36,23,09,75,00,76,44,20,45,35,14,00,61,33,97,34,31,33,95),
			hline(78,17,53,28,22,75,31,67,15,94,03,80,04,62,16,14,09,53,56,92),
			hline(16,39,05,42,96,35,31,47,55,58,88,24,00,17,54,24,36,29,85,57),
			hline(86,56,00,48,35,71,89,07,05,44,44,37,44,60,21,58,51,54,17,58),
			hline(19,80,81,68,05,94,47,69,28,73,92,13,86,52,17,77,04,89,55,40),
			hline(04,52,08,83,97,35,99,16,07,97,57,32,16,26,26,79,33,27,98,66),
			hline(88,36,68,87,57,62,20,72,03,46,33,67,46,55,12,32,63,93,53,69),
			hline(04,42,16,73,38,25,39,11,24,94,72,18,08,46,29,32,40,62,76,36),
			hline(20,69,36,41,72,30,23,88,34,62,99,69,82,67,59,85,74,04,36,16),
			hline(20,73,35,29,78,31,90,01,74,31,49,71,48,86,81,16,23,57,05,54),
			hline(01,70,54,71,83,51,54,69,16,92,33,48,61,43,52,01,89,19,67,48)
		)
	),
	set_gvar(max,0),
	\+vartical,
	\+horizontal,
	\+diagonal_topleft2bottomright,
	\+diagonal_topright2bottomleft,
	!,
	gvar(max,Max),
	write(Max).
	
vartical:-
	gvar(squares,Masu),
	between(1,20,H),
	between(1,17,V),
	V1 is V+1,
	V2 is V+2,
	V3 is V+3,
	arg(V,Masu,HLine),
	arg(V1,Masu,HLine1),
	arg(V2,Masu,HLine2),
	arg(V3,Masu,HLine3),
	arg(H,HLine,Val),
	arg(H,HLine1,Val1),
	arg(H,HLine2,Val2),
	arg(H,HLine3,Val3),
	Mul is Val * Val1 * Val2 * Val3,
	gvar(max,Max),
		(Mul > Max -> set_gvar(max,Mul);true),
	fail.

horizontal:-
	gvar(squares,Masu),
	between(1,17,H),
	between(1,20,V),
	H1 is H+1,
	H2 is H+2,
	H3 is H+3,
	arg(V,Masu,HLine),
	arg(H,HLine,Val),
	arg(H1,HLine,Val1),
	arg(H2,HLine,Val2),
	arg(H3,HLine,Val3),
	Mul is Val * Val1 * Val2 * Val3,
	gvar(max,Max),
	(Mul > Max -> set_gvar(max,Mul);true),
	fail.
	

diagonal_topleft2bottomright:-
	gvar(squares,Masu),
	between(1,17,H),
	between(1,17,V),
	H1 is H+1,
	H2 is H+2,
	H3 is H+3,
	V1 is V+1,
	V2 is V+2,
	V3 is V+3,
	arg(V,Masu,HLine),
	arg(V1,Masu,HLine1),
	arg(V2,Masu,HLine2),
	arg(V3,Masu,HLine3),
	arg(H,HLine,Val),
	arg(H1,HLine1,Val1),
	arg(H2,HLine2,Val2),
	arg(H3,HLine3,Val3),
	Mul is Val * Val1 * Val2 * Val3,
	gvar(max,Max),
	(Mul > Max -> set_gvar(max,Mul);true),
	fail.

diagonal_topright2bottomleft:-
	gvar(squares,Masu),
	between(4,20,H),
	between(4,20,V),
	H1 is H-1,
	H2 is H-2,
	H3 is H-3,
	V1 is V+1,
	V2 is V+2,
	V3 is V+3,
	arg(V,Masu,HLine),
	arg(V1,Masu,HLine1),
	arg(V2,Masu,HLine2),
	arg(V3,Masu,HLine3),
	arg(H,HLine,Val),
	arg(H1,HLine1,Val1),
	arg(H2,HLine2,Val2),
	arg(H3,HLine3,Val3),
	Mul is Val * Val1 * Val2 * Val3,
	gvar(max,Max),
	(Mul > Max -> set_gvar(max,Mul);true),
	fail.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

% problem 11

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

solve:-

set_gvar(squares,

masu(

hline(08,02,22,97,38,15,00,40,00,75,04,05,07,78,52,12,50,77,91,08),

hline(49,49,99,40,17,81,18,57,60,87,17,40,98,43,69,48,04,56,62,00),

hline(81,49,31,73,55,79,14,29,93,71,40,67,53,88,30,03,49,13,36,65),

hline(52,70,95,23,04,60,11,42,69,24,68,56,01,32,56,71,37,02,36,91),

hline(22,31,16,71,51,67,63,89,41,92,36,54,22,40,40,28,66,33,13,80),

hline(24,47,32,60,99,03,45,02,44,75,33,53,78,36,84,20,35,17,12,50),

hline(32,98,81,28,64,23,67,10,26,38,40,67,59,54,70,66,18,38,64,70),

hline(67,26,20,68,02,62,12,20,95,63,94,39,63,08,40,91,66,49,94,21),

hline(24,55,58,05,66,73,99,26,97,17,78,78,96,83,14,88,34,89,63,72),

hline(21,36,23,09,75,00,76,44,20,45,35,14,00,61,33,97,34,31,33,95),

hline(78,17,53,28,22,75,31,67,15,94,03,80,04,62,16,14,09,53,56,92),

hline(16,39,05,42,96,35,31,47,55,58,88,24,00,17,54,24,36,29,85,57),

hline(86,56,00,48,35,71,89,07,05,44,44,37,44,60,21,58,51,54,17,58),

hline(19,80,81,68,05,94,47,69,28,73,92,13,86,52,17,77,04,89,55,40),

hline(04,52,08,83,97,35,99,16,07,97,57,32,16,26,26,79,33,27,98,66),

hline(88,36,68,87,57,62,20,72,03,46,33,67,46,55,12,32,63,93,53,69),

hline(04,42,16,73,38,25,39,11,24,94,72,18,08,46,29,32,40,62,76,36),

hline(20,69,36,41,72,30,23,88,34,62,99,69,82,67,59,85,74,04,36,16),

hline(20,73,35,29,78,31,90,01,74,31,49,71,48,86,81,16,23,57,05,54),

hline(01,70,54,71,83,51,54,69,16,92,33,48,61,43,52,01,89,19,67,48)

)

set_gvar(max,0),

\+vartical,

\+horizontal,

\+diagonal_topleft2bottomright,

\+diagonal_topright2bottomleft,

gvar(max,Max),

write(Max).

vartical:-

gvar(squares,Masu),

between(1,20,H),

between(1,17,V),

V1 is V+1,

V2 is V+2,

V3 is V+3,

arg(V,Masu,HLine),

arg(V1,Masu,HLine1),

arg(V2,Masu,HLine2),

arg(V3,Masu,HLine3),

arg(H,HLine,Val),

arg(H,HLine1,Val1),

arg(H,HLine2,Val2),

arg(H,HLine3,Val3),

Mul is Val * Val1 * Val2 * Val3,

gvar(max,Max),

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

fail.

horizontal:-

gvar(squares,Masu),

between(1,17,H),

between(1,20,V),

H1 is H+1,

H2 is H+2,

H3 is H+3,

arg(V,Masu,HLine),

arg(H,HLine,Val),

arg(H1,HLine,Val1),

arg(H2,HLine,Val2),

arg(H3,HLine,Val3),

Mul is Val * Val1 * Val2 * Val3,

gvar(max,Max),

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

fail.

diagonal_topleft2bottomright:-

gvar(squares,Masu),

between(1,17,H),

between(1,17,V),

H1 is H+1,

H2 is H+2,

H3 is H+3,

V1 is V+1,

V2 is V+2,

V3 is V+3,

arg(V,Masu,HLine),

arg(V1,Masu,HLine1),

arg(V2,Masu,HLine2),

arg(V3,Masu,HLine3),

arg(H,HLine,Val),

arg(H1,HLine1,Val1),

arg(H2,HLine2,Val2),

arg(H3,HLine3,Val3),

Mul is Val * Val1 * Val2 * Val3,

gvar(max,Max),

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

fail.

diagonal_topright2bottomleft:-

gvar(squares,Masu),

between(4,20,H),

between(4,20,V),

H1 is H-1,

H2 is H-2,

H3 is H-3,

V1 is V+1,

V2 is V+2,

V3 is V+3,

arg(V,Masu,HLine),

arg(V1,Masu,HLine1),

arg(V2,Masu,HLine2),

arg(V3,Masu,HLine3),

arg(H,HLine,Val),

arg(H1,HLine1,Val1),

arg(H2,HLine2,Val2),

arg(H3,HLine3,Val3),

Mul is Val * Val1 * Val2 * Val3,

gvar(max,Max),

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

fail.

実行結果(解答伏せています）：

1 ?- time(solve).
XXXXXXXX
% 12,531 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips)
true.

1 ?- time(solve).

XXXXXXXX

% 12,531 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips)

true.

Problem 10 二百万以下の素数の和

Leave a reply

問題

プロジェクトオイラーは一度素数列挙ロジックを作るとあちこちで使いまわせる。

% problem 10

solve(Idx):-
	assert(max(Idx)),
	make_list(Idx,List),
	eratosthenes_sieve(List,List1), % エラトステネスのふるいによる素数列挙
	add_all(List1,Sum),
	write(Sum).

add_all([],0):-!.
add_all([First|Rest],Ret):-
	add_all(Rest,RestSum),
	Ret is First + RestSum.

retract_sosu_list([]):-!.
retract_sosu_list([First|Rest]):-
	retract(sosu(First)),
	retract_sosu_list(Rest).

assert_all([]):-!.
assert_all([First|Rest]):-
	assert(sosu(First)),
	assert_all(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 10

solve(Idx):-

assert(max(Idx)),

make_list(Idx,List),

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

add_all(List1,Sum),

write(Sum).

add_all([],0):-!.

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

add_all(Rest,RestSum),

Ret is First + RestSum.

retract_sosu_list([]):-!.

retract_sosu_list([First|Rest]):-

retract(sosu(First)),

retract_sosu_list(Rest).

assert_all([]):-!.

assert_all([First|Rest]):-

assert(sosu(First)),

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

実行結果：

1 ?- time(solve(2000000)).
XXXXXXXXXXX
% 91,150,992 inferences, 76.484 CPU in 77.969 seconds (98% CPU, 1191760 Lips)
true.

1 ?- time(solve(2000000)).

XXXXXXXXXXX

% 91,150,992 inferences, 76.484 CPU in 77.969 seconds (98% CPU, 1191760 Lips)

true.