投稿者: koyahata

Problem 68 Magic 5-gon ring

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

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

2017年5月12日

Problem 6 ２乗和の差

問題

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

プログラム：

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

2017年5月12日

Problem 5 最小公倍数

問題

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, !.

実行結果：

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

2017年5月12日

Problem 44　五角数

問題

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.

2017年5月12日

問題を「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).

実行結果：

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

2017年5月12日

Problem 35 循環素数

問題

解説：
①エラトステネスのふるいによる素数列挙、すべて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).

実行結果：

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.

2017年5月12日

Problem 3 最大の素因数

問題

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

2017年5月12日

投稿者: koyahata

Problem 9 特別なピタゴラス数

Problem 8 数字列中の最大の積

Problem 7 10001番目の素数

Problem 68 Magic 5-gon ring

Problem 6 ２乗和の差

Problem 5 最小公倍数

Problem 44　五角数

Problem 4 最大回文積

Problem 35 循環素数

Problem 3 最大の素因数