% mathler solver tool by S.Devulder

:- use_module(lists).

/*
:- dynamic m_/3.
member2(X, Y) :-
    (   m_(X, Y, 1) ->
        true
    ;   m_(X, Y, 0) ->
        fail
    ;   (   member(X, Y) ->
            Z=1
        ;   Z=0
        ),
        assertz(m_(X,Y,Z)),
        Z==1
    ).
*/
%:- use_module(tabling), table member2/2.
member2(X,Y) :- member(X,Y).
%member2(X,Y) :- append(_, [X|_] ,Y).

%:- dynamic digit_/1.
%digit(X) :-  digit_(X),!;member(X, "0123456789"),assert(digit_(X)).
%digit(X) :- memberchk(X,"0123456789").
digit(0'0). digit(0'1). digit(0'2). digit(0'3). digit(0'4).
digit(0'5). digit(0'6). digit(0'7). digit(0'8). digit(0'9).

% parses a number
num(Num, [Digit|L], Res, M) :- digit(Digit), !, num(Num*10+Digit-48, L, Res, M).
num(Num, L, Res/1, L) :- Res is Num.

% convert list of ascii codes into tokens
tokenize(0'+,+). tokenize(0'-,-). tokenize(0'*,*). tokenize(0'/,/).
tokenize(0'(,'('). tokenize(0'),')').
tokenize(0'0,0). tokenize(0'1,1). tokenize(0'2,2). tokenize(0'3,3). tokenize(0'4,4).
tokenize(0'5,5). tokenize(0'6,6). tokenize(0'7,7). tokenize(0'8,8). tokenize(0'9,9).

tokenize([],[]).
tokenize([Ascii|L], [Symbol|M]) :-
    tokenize(Ascii, Symbol),
    tokenize(L, M).
tokenize([0'0,Digit|_],_) :-  digit(Digit),!,fail. % reject leading digit.
tokenize([Digit|L], [Num|M]) :-
    digit(Digit),
    num(Digit-48, L, Num, R),
    tokenize(R, M).

%testcase
%main :- tokenize("(1-2)*345+0",X), write(X),nl,fail.

% symbol kind
operator(+). operator(-). operator(*). operator(/).
bra('('). ket(')').

% calculate a simple opeation
rational(_/_).
calc(U, V, P/Q) :- % normalize
    X is U,
    (   X=0 ->
        P=0,
        Q=1
    ;   Y is V,
        Z is gcd(X,Y),
        P is X div Z,
        Q is Y div Z
    ).
calc(A/B, +, C/D, R) :- calc(A*D+B*C, B*D, R).
calc(A/B, -, C/D, R) :- calc(A*D-B*C, B*D, R).
calc(A/B, *, C/D, R) :- calc(A*C, B*D, R).
calc(_, /, 0/_, _) :- !, fail. % can’t divide by 0
calc(A/B, /, C/D, R) :- calc(A*D, B*C, R).

:- dynamic c_/4.
calc2(X,Op,Y,R) :-
%    calc(X,Op,Y,R).
    c_(X,Op,Y,R),!;calc(X,Op,Y,R), asserta(c(X,Op,Y,R)).

% operator precedence
precedence(+,1). precedence(-,1). precedence(*,2). precedence(/,2).

% Shunting-yard algorithm
eval_op(X, L, [A,B|Nums], [Y|Ops], Res) :-
    precedence(X, Px),
    precedence(Y, Py),
    Px =< Py, !,
    calc2(B, Y, A, C),
    eval(L, [C|Nums], [X|Ops], Res).
eval_op(X, L, Nums, Ops, Res) :-
    eval(L, Nums, [X|Ops], Res).

eval_ket(L, Nums, [X|Ops], Res) :-
    bra(X), !,
    eval(L, Nums, Ops, Res).
eval_ket(L, [X,Y|Nums], [Op|Ops], Res) :-
    calc2(Y, Op, X, Z),
    eval_ket(L, [Z|Nums], Ops, Res).

eval([Tk|L], Nums, Ops, Res) :-
    (   rational(Tk) ->
        eval(L, [Tk|Nums], Ops, Res)
    ;   operator(Tk) ->
        eval_op(Tk, L, Nums, Ops, Res)
    ;   bra(Tk) ->
        eval(L, Nums, [Tk|Ops], Res)
    ;   ket(Tk) ->
        eval_ket(L, Nums, Ops, Res)
    ).
eval([], [X,Y|Nums], [Op|Ops], Res) :-
    calc(Y, Op, X, Z),
    eval([], [Z|Nums], Ops, Res).
eval([],[N],[],N).

% eval(-String, +Value)
eval(Str, Val) :- tokenize(Str, TokenList), eval(TokenList, [], [], Val).

% print a string
puts([0'\\,0'n| L]) :- nl, puts(L).
puts([X|L]) :- put_code(X),puts(L).
puts([]).

%testcase
%main :- member(L,["1+2*3","(1+2)","1","1+2","1+2-3","(1+2)*3","1+(2*3)"]),puts(L),nl,eval(L,R),write(=),write(R),nl,fail.

% possible next character
:- dynamic(after_/3).
after(X, Y) :-
    (   after_(X, Y, Z), !
    ;   (   memberchk(X, "0123456789") ->
            memberchk(Y, "0123456789+-*/)"),
            Z=1
        ;   memberchk(X, "+-*/(") ->
            memberchk(Y, "0123456789("),
            Z=1
        ;   memberchk(X, ")") ->
            memberchk(Y, "+-*/)"),
            Z=1
        ;   Z=0
        ),
        assert(after_(X,Y,Z))
    ), !,
    Z=1.

% utility to select either a l8st with or without distinct elements
filter(+distinct,Ascii,L,_) :- member(Ascii,L), !,fail.
filter(+distinct,Ascii,L,[Ascii|L]) :- !.
filter(+distinct,_,_,done).

filter(-distinct, Ascii, L, done) :- member(Ascii, L), !.
filter(-distinct, _, done, done) :- !.
filter(-distinct, Ascii, L, [Ascii|L]).

filter(all, _, _, _).

% at most MaxOps operator
op_count(Ascii, NumOps, MaxOps, NumOp2) :-
    (   memberchk(Ascii, "+-*/") ->
        NumOp2 is NumOps+1,
        NumOp2 =< MaxOps
    ;   NumOp2 =  NumOps
    ).

% choose(+Possible_symbols, +Previous_symbol, +Distinct_filter, -Result)
choose([Alphabet], Prev, filter(Mode,In),  _, _, [Ascii]) :-
    member2(Ascii, Alphabet),
%    memberchk(Ascii, "0123456789)"),
    (Ascii=0');digit(Ascii)),
    after(Prev, Ascii),
    filter(Mode, Ascii, In, done).
choose([Alphabet|Choices], Prev, filter(Mode,In), NumOps, MaxOps, [Ascii|M]) :-
    member2(Ascii, Alphabet),
    after(Prev, Ascii),
    op_count(Ascii, NumOps, MaxOps, NumOp2),
    filter(Mode, Ascii, In, Out),
    choose(Choices, Ascii, filter(Mode,Out), NumOp2, MaxOps, M).

% choose(+List_of_choices, -String_respecting_the_list_of_choices)
choose2(Choices, MaxOps, String) :-
    choose(Choices, 0'(, filter(all,[]), 0, MaxOps, String).

% mandatory(+ListOfString,-ResultString)
% builds a string containing all distinct chars from a list of string
mandatory(Misplaced, Mandatory) :- append(Misplaced, T), sort(T, Mandatory).

% build_choice(+FoundSymbols,+AllPossibleSymbols,+MisplacedSymbols,-Result)
% build a list of choices accounting for the ones already known, the list of
% all possible symbols, and the mizplaced ohes.
get_choice(Symbol, _, [Symbol]) :- memberchk(Symbol, "0123456789+-*/()"), !.
get_choice(_, Alphabet, Alphabet).

build_choices([Symbol|L], Alphabet, [Misplaced|M], [Choice|C]) :-
    get_choice(Symbol, Alphabet, Choice_),
    subtract(Choice_, Misplaced, Choice),
    build_choices(L, Alphabet, M, C).
build_choices([], _, [], []).

% find a string compatible with the current constraints
find(TargetNum, Found, Alphabet, Misplaced, MaxOps, String) :-
    mandatory(Misplaced, Mandatory), % all misplaced symbols must be used (eg. mandatory)
    build_choices(Found, Alphabet, Misplaced, Choices), % find all possible symbols for each cell
    choose(Choices, MaxOps, String), % build a string from the possilities
    subset(Mandatory, String), %  check that it uses all of the mandatory symbols
    eval(String, Val), % evaluate the string
    calc(TargetNum/1, -, Val, 0/_). % the value must match the goal number.

%main  :- find(12,"0123456789+-*/()", ["","","",""],S), puts(S), nl, fail.

%012.4.6.89+-*/()
%....4.6.89+.*/..


%main(Str) :- find(132, "../.*.+.", "0124689+-*/()", ["9","64","*","","/","8","","46"],Str),puts(Str), nl.
%main(Str) :- find(132, "../.*.+.", "0124689+-*/()", ["","4","*","","/","","","6"],Str),puts(Str), nl.
%main(Str) :- find(41, "........","5790-*/()",["","2","","","","-","8",""],Str),puts(Str),nl.
%main(Str) :- find(41, "...-../.","257890-*/()",["","2","9","","2","-8","8",""],Str),puts(Str),nl.

%main(S) :- find(5,".....","1234567890+-*/",["","","","",""],S),puts(S),nl.
%main(S) :- find(5,".....","1245690+*/",["","","","6",""],S),puts(S),nl.

%main(S):- find(26,"......","1234567890+-*/",["","","","","",""],S),puts(S),nl.
%main(S):- find(26,"......","245680+-*/",["","2","","-","",""],S),puts(S),nl.
%main(S):- find(26,"2..8..","24580-*/",["","24","","-","-",""],S),puts(S),nl.

%main(S):- find(69,".....","1234567890+-*/",["","","","",""],1,S),puts(S),nl.
%main(S):- find(69,"....7","13467890-*/",["1","","","",""],1,S),puts(S),nl.

%main(S):- find(108,"......","1234567890+-*/",["","","","","",""],2,S),puts(S),nl.
%main(S):- find(108,"1.5-.7","14567890+-*/",["","","","","",""],2,S),puts(S),nl.

%main(S) :- find(7,"........","1234567890+-*/()",["","","","","","","",""],3,S),puts(S),nl.
%main(S) :- find(7,"1.3.....","12345689-/()",["","2","","4","","","",""],3,S),puts(S),nl.

%main(S):- find(28,"......","1234567890+-*/",["","","","","",""],2,S),puts(S),nl.
%main(S):- find(28,".2....","246780+*/",["","","","","",""],2,S),puts(S),nl
%main(S):- find(28,"42/...","24680*/",["","","","","",""],2,S),puts(S),nl.

%main(S) :- find(15,"........","1234567890+-*/()",["","","","","","","",""],3,S),puts(S),nl.
%main(S) :- find(15,"........","2467890+-()",["","2","9","","","","4",""],3,S),puts(S),nl.

%main(S):- find(2,"../2.","24890+-*/",["2","4","","",""],1,S),puts(S),nl.

:- use_module(date).
%main :- now(T1), findall(Str,main(Str),Set), now(T2), Time is T2-T1, length(Set,Size), write([size = Size, time = Time]), nl.

cmp_le(_=A, _=B) :- A  =<  B.

pivoting(_,[],[],[]).
pivoting(H,[X|T],[X|L],G):-cmp_le(X,H),!,pivoting(H,T,L,G).
pivoting(H,[X|T],L,[X|G]):-pivoting(H,T,L,G).

qsort(List,Sorted):-q_sort(List,[],Sorted).
q_sort([],Acc,Acc).
q_sort([H|T], Acc, Sorted) :-
    pivoting(H, T, L1, L2),
    q_sort(L1, Acc, Sorted1),
    q_sort(L2, [H|Sorted1], Sorted).

:- dynamic count/2.
start_stat :- retractall(count/2), forall(member(S, "0123456789+-*/()N"), assert(count(S,0))).
inc_stat(S) :- retract(count(S,N)),N1 is N+1,assert(count(S,N1)).
str_stat([X|L]) :- inc_stat(X), str_stat(L).
str_stat([]).
print_stat :-
    findall(S=N, count(S,N), L),
    qsort(L, Ls),
    forall(member((S=N),Ls), (put_code(S),write(=),write(N),nl)),
    nl.

rep(0,_,[]):-!.
rep(N,X,[X|L]):-N1 is N-1, rep(N1, X, L).


find2(Found, Alphabet, Misplaced, MaxOps, String) :-
    mandatory(Misplaced, Mandatory), % all misplaced symbols must be used (eg. mandatory)
    build_choices(Found, Alphabet, Misplaced, Choices), % find all possible symbols for each cell
    choose2(Choices, MaxOps, String), % build a string from the possilities
    subset(Mandatory, String), %  check that it uses all of the mandatory symbols
    eval(String, Val/1),
    between(10,99,Val),
    str_stat(String),
    str_stat("N"),
    count(78, C),
    write(C),
    write('   '),
    puts(String),
    write(=),
    write(Val),
    nl.

main2(Size, MaxOp) :-
    rep(Size, 0'., Found),
    rep(Size, [], Misplaced),
    find2(Found, "0123456789+-*/()", Misplaced, MaxOp, _).

main :- start_stat,forall(main2(6,2),true),nl,print_stat.