CHR : Project Euler 90-99

90.swi

:- use_module(library(chr)).
:- chr_option(optimize, full).
:- chr_type list(T) ---> []; [T|list(T)].
:- chr_constraint
	push(+list(int),+list(int)), list(+list(int)), dice(+list(int)),
	answer(+list(int),+list(int)), answer, count(+int), problem90.

problem90 <=> numlist(5,9,L), push(L,[]), answer.

push([],_)    <=> true.
push([H|T],L) <=> list([H|L]), push(T,L).

list(L)     <=> length(L,6) | dice(L).
list([0|_]) <=> true.
list([H|T]) <=> H1 is H-1, numlist(0,H1,L), push(L,[H|T]).

dice(L), dice(L1)
==> display([0,1],L,L1),
    display([0,4],L,L1),
    (display([0,9],L,L1); display([0,6],L,L1)),
    (display([1,6],L,L1); display([1,9],L,L1)),
    display([2,5],L,L1),
    (display([3,6],L,L1); display([3,9],L,L1)),
    (display([4,9],L,L1); display([4,6],L,L1)),
    (display([6,4],L,L1); display([9,4],L,L1)),
    display([8,1],L,L1) |
    answer(L,L1).

answer(L,L1) \ answer(L1,L) <=> true.

answer \ answer(_,_)  <=> count(1).
answer \ dice(_)      <=> true.
answer                <=> true.

count(M), count(N) <=> X is M+N, count(X).

display([A,B],L,L1) :- (member(A,L), member(B,L1); member(A,L1), member(B,L)).

92.swi

:- use_module(library(digits),[i2d/2,d2i/2]).
:- use_module(library(chr)).
:- chr_option(optimize, full).
:- chr_type list(T) ---> []; [T|list(T)].
:- chr_constraint
	list(+list(int)), push(+list(int),+list(int)),
	digits(+list(int),+int),
	next(+list(int),-int), next(+list(int),+int,-int),
	set(+list(int),+int), count(+int), fact(+int,-int),
	problem92.

problem92 <=> numlist(1,9,L), push(L,[]).

push([],_)    <=> true.
push([H|T],L) <=> list([H|L]), push(T,L).

list(L)     <=> length(L,7) | d2i(L,N), next(N,X), digits(L,X).
list([H|T]) <=> numlist(0,H,L), push(L,[H|T]).

next(N,X)       <=> i2d(N,L), next(L,0,X).
next([],N,X)    <=> X = N.
next([H|T],N,X) <=> N1 is H**2+N, next(T,N1,X).

digits(_,1)  <=> true.
digits(L,89) <=> fact(7,N), set(L,N).
digits(L,N)  <=> next(N,N1), digits(L,N1).

fact(0,X) <=> X is 1.
fact(N,X) <=> N1 is N-1, fact(N1,X1), X is N*X1.

set([],N)    <=> count(N).
set([H|T],N) <=> delete(T,H,L), length([H|T],Len1), length(L,Len2),
	         Len is Len1-Len2, fact(Len,X), N1 is N//X, set(L,N1).

count(M), count(N) <=> X is M+N, count(X).

93.swi

:- use_module(library(chr)).
:- chr_option(optimize, full).
:- chr_type list(T) ---> []; [T|list(T)].
:- chr_type op ---> add; dif; mul; div.
:- chr_constraint
	num(+int), nums(+list(int)), number(+int,+list(int)),
	op(+op), ops(+list(op)), operator(+list(op)),
	set(+int,+list(int)), answer, answer(+int,+int), problem93.

problem93 <=> num(9), op(add), op(dif), op(mul), op(div), answer.

num(N) ==> N > 0 | N1 is N-1, num(N1).
num(N) ==> nums([N]).
nums(L) <=> length(L,4)
          | sort(L,[A,B,C,D]), X is 1000*A+100*B+10*C+D, number(X,L).
num(N), nums(L) ==> \+ member(N,L) | nums([N|L]).

op(X)         ==> ops([X]).
ops(L)        <=> length(L,3) | operator(L).
op(X), ops(L) ==> ops([X|L]).

number(X,L) # passive, operator(L1)     ==> expr(L,L1,N) | set(X,[N]).
number(X,[H|T]) # passive, operator(L1) ==> expr([-H|T],L1,N) | set(X,[N]).

set(Key,L), set(Key,L1) <=> append(L,L1,L2), set(Key,L2).

answer \ num(_)      <=> true.
answer \ nums(_)     <=> true.
answer \ number(_,_) <=> true.
answer \ op(_)       <=> true.
answer \ ops(_)      <=> true.
answer \ operator(_) <=> true.
answer \ set(Key,L)  <=> max_length(L,N) | answer(Key,N).
answer \ set(_,_)    <=> true.
answer               <=> true.

answer(_,M) \ answer(_,N) <=> M > N | true.

max_length(L,X)         :- sort(L,L1), L1 = [1|_], max_length(L1,1,X).
max_length([A,B|T],N,X) :- A+1 =:= B, !, N1 is N+1, max_length([B|T],N1,X).
max_length(_,X,X).

expr([A,B,C,D],[F,G,H],X) :-
	call(F,A,B,M), call(G,M,C,N), call(H,N,D,X), integer(X), X > 0.

add(A,B,X) :- X is A+B.
dif(A,B,X) :- X is A-B.
mul(A,B,X) :- X is A*B.
div(_,0,_) :- !, false.
div(A,B,X) :- X is A rdiv B.

97.swi

:- use_module(library(chr)).
:- chr_option(optimize, full).
:- chr_constraint answer(+int), problem97.

problem97 <=> X is (28433 * powm(2,7830457,10**10) + 1) rem 10**10, answer(X).

98.swi

:- use_module(library(chr)).
:- chr_option(optimize, full).
:- chr_type list(T) ---> []; [T|list(T)].
:- chr_constraint
	list(+list(any)),
	word(+list(int),+list(int)),
	word_pair(+list(int),+list(int)),
	max_digit(+int),
	square(+int,+int,+list(int),+list(int)),
	square_pair(+list(int),+list(int),+int),
	max(+int),
	answer,
	problem98.

problem98 <=> csv_read_file('words.txt',[H|_]), H =.. [_|L], list(L),
	      max_digit(0), square(1,1,[1],[1]), answer.

answer \ word(_,_)          <=> true.
answer \ square(_,_,_,_)    <=> true.
answer \ word_pair(_,_)     <=> true.
answer \ square_pair(_,_,_) <=> true.
answer                      <=> true.

list([H|T]) <=> list(T), atom_chars(H,X), msort(X,X1), word(X,X1).
list([])    <=> true.

word(X,Key), word(Y,Key) ==> word_pair(X,Y).

word_pair(X,_) \ max_digit(N) <=> length(X,X1), X1 > N | max_digit(X1).

max_digit(M), square(_,N,_,_) <=> N > 10**M | true.
square(M,_,_,_) ==> M1 is M+1, N1 is M1*M1, i2d(N1,L1), msort(L1,L2),
	            square(M1,N1,L1,L2).

square(_,M,L,Key), square(_,N,L1,Key)
==> M < N | square_pair(L,L1,N).

square_pair(A,B,C), word_pair(M,N)
==> length(A,Len), length(M,Len),
    zip(A,M,X), zip(B,N,Y),
    check(X), keysort(X,X1), keysort(Y,X1)
  | max(C).

max(M) \ max(N) <=> M >= N | true.

i2d(N,X)   :- i2d(N,[],X).
i2d(0,X,X) :- !.
i2d(N,L,X) :- N1 is N//10, N2 is N rem 10, i2d(N1,[N2|L],X).

zip([],_,[])                :- !.
zip([H|T],[H1|T1],[H-H1|X]) :- zip(T,T1,X).

check(L) :- keysort(L,A), group_pairs_by_key(A,A1), check_sub(A1),
	    transpose_pairs(L,L1),
	    keysort(L1,B), group_pairs_by_key(B,B1), check_sub(B1).
check_sub([])      :- !, true.
check_sub([_-L|T]) :- length(L,1), !, check_sub(T).
check_sub(_)       :- false.

99.swi

:- use_module(library(chr)).
:- chr_option(optimize, full).
:- chr_type list(T) ---> []; [T|list(T)].
:- chr_type row ---> row(int,int).
:- chr_constraint data(+int,+list(row)), answer(+int,+float), problem99.

problem99 <=> csv_read_file('base_exp.txt',L), data(1,L).

data(N,[row(A,B)|T]) <=> X is log10(A)*B, answer(N,X), N1 is N+1, data(N1,T).
data(_,[])           <=> true.

answer(_,M) \ answer(_,N) <=> M >= N | true.