:- dynamic digit_/1.
%digit(X) :-  digit_(X),!;member(X, "0123456789"),assert(digit_(X)).
digit(X) :- member(X,"0123456789").

% 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([],[]).
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).

% 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, !,
    calc(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) :-
    calc(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([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_/2).
after(X, Y) :-
    (   after_(X, Y), !
    ;   (   member(X, "0123456789") ->
            member(Y, "0123456789+-*/)")
        ;   member(X, "+-*/(") ->
            member(Y, "0123456789(")
        ;   member(X, ")") ->
            member(Y, "+-*/)")
        ),
        assert(after_(X,Y))
    ).

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

% choose(+Possible_symbols, +Previous_symbol, +Distinct_filter, -Result)
choose([Alphabet], Prev, filter(Mode,In), [Ascii]) :-
    member(Ascii, Alphabet),
    member(Ascii, "0123456789)"),
    after(Prev, Ascii),
    filter(Mode, Ascii, In, done).
choose([Alphabet|Choices], Prev, filter(Mode,In), [Ascii|M]) :-
    member(Ascii, Alphabet),
    after(Prev, Ascii),
    filter(Mode, Ascii, In, Out),
    choose(Choices, Ascii, filter(Mode,Out), M).

% choose(+List_of_choices, -String_respecting_the_list_of_choices)
choose(Choices, String) :-
    choose(Choices, 0'(, filter(+distinct,[]), String) ; % distinct ekelents first
    choose(Choices, 0'(, filter(-distinct,[]), String).

% for debuugging
found(String, Val, Target) :-
    puts(String),
    write(=),
    E is Val-Target,
    write(Target+E),
    nl.

% all_ member(+String1, +Srring2) check that all chars of String1 appear in String2
all_member([X|L], String) :- member(X, String), all_member(L, String).
all_member("",_).

% mandatory(+ListOfString,+Auxlist,-ResultString)
% builds a string containing all distinct chars from a list of string
mandatory([X|M],InSet,OutSet) :-
    mandatory2(X,InSet,TempSet),
    mandatory(M,TempSet,OutSet).
mandatory([],Set,Set).
mandatory2([X|L], InSet, OutSet) :-
    (   member(X, InSet) ->
        mandatory2(L, InSet, OutSet)
    ;   mandatory2(L, [X|InSet], OutSet)
    ).
mandatory2([],Set,Set).

% set difference
diff([X|L], Set, Diff) :-
    (   member(X, Set) ->
        diff(L, Set, Diff)
    ;   Diff=[X|Diff2],
        diff(L, Set, Diff2)
    ).
diff([],_,[]).

% 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]) :- member(Symbol, "0123456789+-*/()"), !.
get_choice(_, Alphabet, Alphabet).
build_choices([Symbol|L], Alphabet, [Misplaced|M], [Choice|C]) :-
    get_choice(Symbol, Alphabet, Choice_),
    diff(Choice_, Misplaced, Choice),
    build_choices(L, Alphabet, M, C).
build_choices([], _, [], []).

% find a string compatible with the current constraints
find(GoalNumber, Found, Alphabet, Misplaced, 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, String), % build a string from the possilities
    all_member(Mandatory, String), %  check that it uses all of the mandatory symbols
    eval(String, Val), % evaluate the string
    calc(GoalNumber/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.

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