「prolog勉強プロジェクトオイラー171～180」の編集履歴（バックアップ）一覧はこちら
追加された行は緑色になります。
削除された行は赤色になります。
プロジェクトオイラーという数学の問題が掲載されているサイトの問題を堀江伸一さんがProlog言語で解くページ。
*Problem 171 「各桁の平方の和が平方数となる数を求めよ」 †
http://odz.sakura.ne.jp/projecteuler/index.php?cmd=read&page=Problem%20171
正の整数nについて, f(n)を各桁の数字(10進数)の平方の和と定義する. 例えば,
f(3) = 3^2 = 9,
f(25) = 2^2 + 5^2 = 4 + 25 = 29,
f(442) = 4^2 + 4^2 + 2^2 = 16 + 16 + 4 = 36
0 < n < 10^20について, f(n)が平方数となるようなnの和の末尾9桁を求めよ.
解法
何も考えずまとめて計算すれば即座に答えが出ます。
PrologはC++でないのでstd::mapや配列が使えませんが素朴に遅く実装しても２秒くらいで答えが出ます。
配列が使えたらはるかに高速に解けます。
union_sum([],Y,[Y]):-!.
union_sum([[Sum,N,Perm]|Rest],[Sum,N1,Perm1],Result):-
!,
N2 is N+N1,
Perm2 is Perm+Perm1,
union_sum(Rest,[Sum,N2,Perm2],Result).
union_sum([X|Rest],[Sum,N,Perm],[[Sum,N1,Perm]|Result]):-
N1 is N mod 10^9,
union_sum(Rest,X,Result).
ans_sum([],Ans,Ans):-!.
ans_sum([[Sum,NSum,_]|Rest],Ans,Result):-
is_square(Sum),
!,
Ans1 is Ans+NSum,
ans_sum(Rest,Ans1,Result).
ans_sum([_|Rest],Ans,Result):-
ans_sum(Rest,Ans,Result).
next_calc(Sets,[Sum1,N1,Perm]):-
member([Sum,N,Perm],Sets),
between(0,9,K),
Sum1 is Sum+K*K,
N1 is N*10+K*Perm.
is_square(N):-
T is floor(sqrt(N)),
N=:=T*T.
seed([Sum,N,1]):-
between(1,9,N),
Sum is N*N.
search(_,21,Ans):-!,
Ans1 is Ans mod 10^9,
write(Ans1).
search(Sets,N,Ans):-
ans_sum(Sets,Ans,Ans1),
findall(Set,next_calc(Sets,Set),Sets1),
msort(Sets1,Sets2),
[Top|Sets3]=Sets2,
union_sum(Sets3,Top,Sets4),
N1 is N+1,
write([N,Ans1]),nl,
search(Sets4,N1,Ans1).
main171:-findall(Set,seed(Set),Sets),
search(Sets,1,0).
*Problem 172 「桁の繰り返しが少ない数について調べ上げよ」 †
どの数字も3回を超えて現れないような18桁の数(先頭の0は許されない)はいくつあるか?
解法
先頭桁を１に固定してあとはどの桁の数字を何回使うか全探索で決めたら数学の教科書に書いてある組み合わせの公式通りで答えが出ます。
あとは１から9まで対称なので９倍すれば１秒で答えが出ますがこれは遅い実装です。
全探索が少し遅いので全探索を動的計画法（メモ化計算？）で置き換えれば、全探索の使った桁数と分母に来る数を主キーにしてまとめて計算すれば速度は上がります。
速度が上がりますがめんどいので私はここまで、興味のある方はどうぞ。
fact(0,1):-!.
fact(N,Result):-
N1 is N-1,
fact(N1,Re),
Result is Re*N.
calc(Keta,_,_,_):-Keta>17,!,fail.
calc(17,_,Div,Div):-!.
calc(_,[],_,_):-!,fail.
calc(Keta,[C|Count],Div,Result):-
between(0,C,Add),
nth0(Add,[1,1,2,6,24],D),
Keta1 is Keta+Add,
Div1 is Div*D,
calc(Keta1,Count,Div1,Result).
divsum(_,[],0):-!.
divsum(All,[Div|Divs],Result):-
divsum(All,Divs,Re),
Result is All//Div+Re.
main172:-
findall(Div,calc(0,[3,2,3,3,3,3,3,3,3,3],1,Div),Divs),
fact(17,All),
divsum(All,Divs,Ans),
Ans1 is Ans*9,
write(Ans1).
*Problem 173 「最大100万個のタイルを使っていくつの穴あき正方形laminaを作れるか?」 †
http://odz.sakura.ne.jp/projecteuler/index.php?cmd=read&page=Problem%20173
１００万個までのタイルを使って真ん中に正方形の穴の開いた上下左右に対称な正方形は何種類作れるか。
問題の解説図があるのでリンク先参照のこと。
解法
中心にあける穴のサイズを決めたらあとは外側の最大値を２次方程式で求めれば答えが出ます。
答えが出るまで１秒、これはちょっと遅いな。
calc(A,Result):-
Result is floor(-A+sqrt(A^2+10^6))//2.
search(A,Ans):-
calc(A,M),
0<M,
!,
Ans1 is Ans+M,
A1 is A+1,
search(A1,Ans1).
search(_,Ans):-
write(Ans).
main173:-search(1,0).
*Problem 174 「1つ, 2つ, 3つ... と明確に異なる配置を形作ることができる穴あき正方形laminaを数え上げよ」 †
http://odz.sakura.ne.jp/projecteuler/index.php?cmd=read&page=Problem%20174
輪郭が正方形で, 正方形の穴を持ち, 縦にも横にも対称性をもつようなものをlaminaと定義する.
8個のタイルが与えられると, 3x3の1x1の穴をもつlaminaしか作れないが, 32個のタイルならば2つの異なったlaminaeが作れる.
以下略、詳細はリンク先を参照のこと。
解法
Prologで効率的に実装する方法を思いつかなかったので、とりあえずC++で答えを見ました。
探索範囲が狭いのでこれでもなんとかなり１秒もかかりません。
全探索テーブル化で答えは出ますが、N(2)とか与えると一発で答えが出るか条件を満たす集合のリストが得られる関数などの工夫が必要な気がします。
-現在思考中の発想。
問174は以下の問題に帰着する。
t=m^2+kmでt,m,kは1以上の自然数とする。
ｔが決まった時この式を満たす何組の(m,k)があるかという問題に帰着される。
mの上限ｎとt<250000のとき
g(n,1)をmが１～ｎまでの値をとり、ｔ＜250000を満たすtがｔ＝m^2+kmで１通りでしか表せないものの集合だと考える。
g(n,2)はmが１～ｎまでの値をとり、ｔ＜250000を満たすtがｔ＝m^2+kmで２通りでしか表せないものの集合だと考える。
g(n,u)はmが１～ｎまでの値をとり ｔ＜250000を満たすtがｔ＝m^2+kmでu通りでしか表せないものの集合だと考える。
ｎが１増加した時のｇの漸化式的なものを立てれればこの問題、１００万と言わずかなり大きな値まで求められるかも？
#include<stdio.h>
#include<math.h>
#include<iostream>
__int64 calc(__int64 a){
return (-a+sqrt(a*a+1000000))/2;
}
const int up=1000*1000;
__int64 memo[up+2]={0};
int main(){
__int64 a,m,s,b;
for(__int64 a=1;;a++){
m=calc(a);
if(m==0)break;
for(b=1;b <= m;b++){
s=4*b*b+4*b*a;
if(up<s)break;
memo[(int)s]++;
}
int x;
}
int ans=0;
for(int i=1;i<=1000*1000;i++){
if(1<=memo[i]&&memo[i]<=10)ans++;
}
std::cout<<ans;
}
*Problem 178 「ステップ数」 †
http://odz.sakura.ne.jp/projecteuler/index.php?cmd=read&page=Problem%20178
45656を考えよう. 連続する2桁の数は全て差の絶対値が 1 である.
連続する2桁の数の差の絶対値が全て 1 である数をステップ数と呼ぶ.
パンデジタル数では0から9の各数が少なくとも 1 回出現する.
10^40未満の数でパンデジタル数かつステップ数であるものの数を答えよ.
解法
簡単なメモ化計算で簡単に出ます
std::mapがないので集計でコードが膨らんでいます。
step(N,N1):-0<N,N1 is N-1.
step(N,N1):-N<9,N1 is N+1.
union_sum([],Y,[Y]).
union_sum([[Pans,N,Perm]|Rest],[Pans,N,Perm1],Result):-
!,
Perm2 is Perm+Perm1,
union_sum(Rest,[Pans,N,Perm2],Result).
union_sum([X|Rest],Y,[Y|Result]):-
!,
union_sum(Rest,X,Result).
next_calc([Pans,N,Perm],[Pans1,N1,Perm]):-
step(N,N1),
sort([N1|Pans],Pans1).
seed([[N],N,1]):-
between(1,9,N).
ans_sum([],Ans,Ans):-!.
ans_sum([[[0,1,2,3,4,5,6,7,8,9],_,Perm]|Rest],Ans,Result):-
!,
Ans1 is Ans+Perm,
ans_sum(Rest,Ans1,Result).
ans_sum([_|Rest],Ans,Result):-
ans_sum(Rest,Ans,Result).
calc(Sets,Result):-
member(Set,Sets),
next_calc(Set,Result).
search(_,41,Ans):-!,write([ans,Ans]).
search(Sets,N,Ans):-
!,
ans_sum(Sets,Ans,Ans1),
findall(Set,calc(Sets,Set),Sets1),
msort(Sets1,Sets2),
[Top|Sets3]=Sets2,
write([N,Ans1]),nl,
union_sum(Sets3,Top,Sets4),
N1 is N+1,
search(Sets4,N1,Ans1).
main178:-
X is 512*1024*1024,set_prolog_stack(global,limit(X)),
findall(Set,seed(Set),Sets),
search(Sets,1,0).
プロジェクトオイラーという数学の問題が掲載されているサイトの問題を堀江伸一さんがProlog言語で解くページ。
*Problem 171 「各桁の平方の和が平方数となる数を求めよ」 †
http://odz.sakura.ne.jp/projecteuler/index.php?cmd=read&page=Problem%20171
正の整数nについて, f(n)を各桁の数字(10進数)の平方の和と定義する. 例えば,
f(3) = 3^2 = 9,
f(25) = 2^2 + 5^2 = 4 + 25 = 29,
f(442) = 4^2 + 4^2 + 2^2 = 16 + 16 + 4 = 36
0 < n < 10^20について, f(n)が平方数となるようなnの和の末尾9桁を求めよ.
解法
何も考えずまとめて計算すれば即座に答えが出ます。
PrologはC++でないのでstd::mapや配列が使えませんが素朴に遅く実装しても２秒くらいで答えが出ます。
配列が使えたらはるかに高速に解けます。
union_sum([],Y,[Y]):-!.
union_sum([[Sum,N,Perm]|Rest],[Sum,N1,Perm1],Result):-
!,
N2 is N+N1,
Perm2 is Perm+Perm1,
union_sum(Rest,[Sum,N2,Perm2],Result).
union_sum([X|Rest],[Sum,N,Perm],[[Sum,N1,Perm]|Result]):-
N1 is N mod 10^9,
union_sum(Rest,X,Result).
ans_sum([],Ans,Ans):-!.
ans_sum([[Sum,NSum,_]|Rest],Ans,Result):-
is_square(Sum),
!,
Ans1 is Ans+NSum,
ans_sum(Rest,Ans1,Result).
ans_sum([_|Rest],Ans,Result):-
ans_sum(Rest,Ans,Result).
next_calc(Sets,[Sum1,N1,Perm]):-
member([Sum,N,Perm],Sets),
between(0,9,K),
Sum1 is Sum+K*K,
N1 is N*10+K*Perm.
is_square(N):-
T is floor(sqrt(N)),
N=:=T*T.
seed([Sum,N,1]):-
between(1,9,N),
Sum is N*N.
search(_,21,Ans):-!,
Ans1 is Ans mod 10^9,
write(Ans1).
search(Sets,N,Ans):-
ans_sum(Sets,Ans,Ans1),
findall(Set,next_calc(Sets,Set),Sets1),
msort(Sets1,Sets2),
[Top|Sets3]=Sets2,
union_sum(Sets3,Top,Sets4),
N1 is N+1,
write([N,Ans1]),nl,
search(Sets4,N1,Ans1).
main171:-findall(Set,seed(Set),Sets),
search(Sets,1,0).
*Problem 172 「桁の繰り返しが少ない数について調べ上げよ」 †
どの数字も3回を超えて現れないような18桁の数(先頭の0は許されない)はいくつあるか?
解法
何も考えないメモ化で一発です。
最初種として先頭桁を１に固定し組み合わせ数を残りの１７けた、17！で計算しておきます。
あとは確定する桁数を確定していきながら、N桁確定したを主キーに動的計画法（メモ化計算？）していけば非常に少ない計算量で答えが出ます。
適当計算ですが計算量800くらいです。
fact(0,1):-!.
fact(N,Result):-
N1 is N-1,
fact(N1,Re),
Result is Re*N.
union_sum([],Y,[Y]):-!.
union_sum([[Keta,Perm]|Rest],[Keta,Perm1],Result):-
!,
Perm2 is Perm+Perm1,
union_sum(Rest,[Keta,Perm2],Result).
union_sum([X|Rest],Y,[Y|Result]):-
union_sum(Rest,X,Result).
next_calc(N,Sets,[ReKeta,RePerm]):-
member([Keta,Perm],Sets),
between(0,N,Add),
ReKeta is Keta+Add,
ReKeta=<18,
nth0(Add,[1,1,2,6,24],Div),
RePerm is Perm//Div.
search(Sets,[]):-!,member([18,Ans],Sets),
Ans1 is Ans*9,
write(Ans1).
search(Sets,[C|Count]):-
findall(Set,next_calc(C,Sets,Set),Sets1),
msort(Sets1,Sets2),
[Top|Sets3]=Sets2,
union_sum(Sets3,Top,Sets4),
search(Sets4,Count).
main172:-fact(17,Perm),
Perm1 is Perm,
search([[1,Perm1]],[3,2,3,3,3,3,3,3,3,3]).
*Problem 173 「最大100万個のタイルを使っていくつの穴あき正方形laminaを作れるか?」 †
http://odz.sakura.ne.jp/projecteuler/index.php?cmd=read&page=Problem%20173
１００万個までのタイルを使って真ん中に正方形の穴の開いた上下左右に対称な正方形は何種類作れるか。
問題の解説図があるのでリンク先参照のこと。
解法
中心にあける穴のサイズを決めたらあとは外側の最大値を２次方程式で求めれば答えが出ます。
答えが出るまで１秒、これはちょっと遅いな。
calc(A,Result):-
Result is floor(-A+sqrt(A^2+10^6))//2.
search(A,Ans):-
calc(A,M),
0<M,
!,
Ans1 is Ans+M,
A1 is A+1,
search(A1,Ans1).
search(_,Ans):-
write(Ans).
main173:-search(1,0).
*Problem 174 「1つ, 2つ, 3つ... と明確に異なる配置を形作ることができる穴あき正方形laminaを数え上げよ」 †
http://odz.sakura.ne.jp/projecteuler/index.php?cmd=read&page=Problem%20174
輪郭が正方形で, 正方形の穴を持ち, 縦にも横にも対称性をもつようなものをlaminaと定義する.
8個のタイルが与えられると, 3x3の1x1の穴をもつlaminaしか作れないが, 32個のタイルならば2つの異なったlaminaeが作れる.
以下略、詳細はリンク先を参照のこと。
解法
Prologで効率的に実装する方法を思いつかなかったので、とりあえずC++で答えを見ました。
探索範囲が狭いのでこれでもなんとかなり１秒もかかりません。
全探索テーブル化で答えは出ますが、N(2)とか与えると一発で答えが出るか条件を満たす集合のリストが得られる関数などの工夫が必要な気がします。
-現在思考中の発想。
問174は以下の問題に帰着する。
t=m^2+kmでt,m,kは1以上の自然数とする。
ｔが決まった時この式を満たす何組の(m,k)があるかという問題に帰着される。
mの上限ｎとt<250000のとき
g(n,1)をmが１～ｎまでの値をとり、ｔ＜250000を満たすtがｔ＝m^2+kmで１通りでしか表せないものの集合だと考える。
g(n,2)はmが１～ｎまでの値をとり、ｔ＜250000を満たすtがｔ＝m^2+kmで２通りでしか表せないものの集合だと考える。
g(n,u)はmが１～ｎまでの値をとり ｔ＜250000を満たすtがｔ＝m^2+kmでu通りでしか表せないものの集合だと考える。
ｎが１増加した時のｇの漸化式的なものを立てれればこの問題、１００万と言わずかなり大きな値まで求められるかも？
#include<stdio.h>
#include<math.h>
#include<iostream>
__int64 calc(__int64 a){
return (-a+sqrt(a*a+1000000))/2;
}
const int up=1000*1000;
__int64 memo[up+2]={0};
int main(){
__int64 a,m,s,b;
for(__int64 a=1;;a++){
m=calc(a);
if(m==0)break;
for(b=1;b <= m;b++){
s=4*b*b+4*b*a;
if(up<s)break;
memo[(int)s]++;
}
int x;
}
int ans=0;
for(int i=1;i<=1000*1000;i++){
if(1<=memo[i]&&memo[i]<=10)ans++;
}
std::cout<<ans;
}
*Problem 178 「ステップ数」 †
http://odz.sakura.ne.jp/projecteuler/index.php?cmd=read&page=Problem%20178
45656を考えよう. 連続する2桁の数は全て差の絶対値が 1 である.
連続する2桁の数の差の絶対値が全て 1 である数をステップ数と呼ぶ.
パンデジタル数では0から9の各数が少なくとも 1 回出現する.
10^40未満の数でパンデジタル数かつステップ数であるものの数を答えよ.
解法
簡単なメモ化計算で簡単に出ます
std::mapがないので集計でコードが膨らんでいます。
step(N,N1):-0<N,N1 is N-1.
step(N,N1):-N<9,N1 is N+1.
union_sum([],Y,[Y]).
union_sum([[Pans,N,Perm]|Rest],[Pans,N,Perm1],Result):-
!,
Perm2 is Perm+Perm1,
union_sum(Rest,[Pans,N,Perm2],Result).
union_sum([X|Rest],Y,[Y|Result]):-
!,
union_sum(Rest,X,Result).
next_calc([Pans,N,Perm],[Pans1,N1,Perm]):-
step(N,N1),
sort([N1|Pans],Pans1).
seed([[N],N,1]):-
between(1,9,N).
ans_sum([],Ans,Ans):-!.
ans_sum([[[0,1,2,3,4,5,6,7,8,9],_,Perm]|Rest],Ans,Result):-
!,
Ans1 is Ans+Perm,
ans_sum(Rest,Ans1,Result).
ans_sum([_|Rest],Ans,Result):-
ans_sum(Rest,Ans,Result).
calc(Sets,Result):-
member(Set,Sets),
next_calc(Set,Result).
search(_,41,Ans):-!,write([ans,Ans]).
search(Sets,N,Ans):-
!,
ans_sum(Sets,Ans,Ans1),
findall(Set,calc(Sets,Set),Sets1),
msort(Sets1,Sets2),
[Top|Sets3]=Sets2,
write([N,Ans1]),nl,
union_sum(Sets3,Top,Sets4),
N1 is N+1,
search(Sets4,N1,Ans1).
main178:-
X is 512*1024*1024,set_prolog_stack(global,limit(X)),
findall(Set,seed(Set),Sets),
search(Sets,1,0).
