/* Several examples in Picat */
/**** begin file exs.pi ****/
import cp, planner.   

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% PREDICATES AND FUNCTIONS
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% Here are several versions for computing Fibonacci numbers 
% A predicate
fibp(0,F) => F = 1.
fibp(1,F) => F = 1.
fibp(N,F),N>1 => fibp(N-1,F1), fibp(N-2,F2), F = F1+F2.

% A function
fibf(0)=F => F = 1.
fibf(1)=F => F = 1.
fibf(N)=F, N>1 => F = fibf(N-1)+fibf(N-2).

% A function with function facts
fibfa(0) = 1.
fibfa(1) = 1.
fibfa(N) = fibfa(N-1)+fibfa(N-2).

% Using if-then-else
fibi(N) = F => 
    if N == 0 then
        F = 1
    elseif N == 1 then
        F = 1
    else
        F =  fibg(N-1)+fibg(N-2)
    end.

% Using Prolog-style if-then-else
fibg(N) = F => 
    (N == 0 -> 
        F = 1
    ;N == 1 ->
        F = 1
    ; 
        F = fibg(N-1)+fibg(N-2)
    ).

% Using a conditional expression
fibc(N) = cond((N == 0; N == 1), 1, fibc(N-1)+fibc(N-2)).

% A tabled function
table
fibt(0) = 1.
fibt(1) = 1.
fibt(N) = fibt(N-1)+fibt(N-2).

% A nondeterministic predicate with a backtrackable rule
my_member(Y,[X|_]) ?=> Y = X.
my_member(Y,[_|L]) => my_member(Y,L).

my_between(From,To,X), From == To => X = From.
my_between(From,To,X),From < To => X = From; my_between(From+1,To,X).

my_select(Y,[X|L],LR) ?=> Y = X, LR = L.
my_select(Y,[X|L],LR) => LR = [X|LRR], my_select(Y,L,LRR).

my_permutation([],P) => P = [].
my_permutation(L,P) => 
    P = [X|PR],                    
    my_select(X,L,LR),
    my_permutation(LR,PR).

% predicate facts
index(+,-) (-,+)
edge(1,2).
edge(1,3).
edge(2,3).
edge(3,2).

% several sort algorithms
merge_sort([]) = [].
merge_sort([X]) = [X].
merge_sort(L) = SL => split(L,L1,L2), SL = merge(merge_sort(L1),merge_sort(L2)).

split([X,Y|Zs],L1,L2) => L1 = [X|LL1], L2 = [Y|LL2], split(Zs,LL1,LL2).
split(Zs,L1,L2) => L1 = Zs,L2 = [].

merge([],Ys) = Ys.
merge(Xs,[]) = Xs.
merge([X|Xs],Ys@[Y|_]) = [X|Zs], X < Y => Zs = merge(Xs,Ys).  % Ys@[Y|_] is an as-pattern
merge(Xs,[Y|Ys]) = [Y|Zs] => Zs = merge(Xs,Ys).

insert_sort([]) = [].
insert_sort([H|T]) = insert(H,insert_sort(T)).

private
insert(X,[]) = [X].
insert(X,Ys@[Y|_]) = Zs, X =< Y => Zs = [X|Ys].
insert(X,[Y|Ys]) = [Y|insert(X,Ys)].

% two versions that return the minumum and maximum of a list
% a predicate
min_max_p([H|T],Min,Max) => min_max_p_aux(T,H,Min,H,Max).

% A private function is not visiable outside
private
min_max_p_aux([],CMin,Min,CMax,Max) => CMin = Min,CMax = Max.
min_max_p_aux([H|T],CMin,Min,CMax,Max) => min_max_p_aux(T,min(CMin,H),Min,max(CMax,H),Max).

% a function that returns the minimum and maximum of a list as a pair 
min_max([H|T]) = min_max_aux(T,H,H).

private
min_max_aux([],CMin,CMax) = (CMin,CMax).
min_max_aux([H|T],CMin,CMax) = min_max_aux(T,min(CMin,H),max(CMax,H)).

% return the sum of a list
sum_list(L) = Sum =>
    sum_list_aux(L,0,Sum).

% a private predicate is never exported
private
sum_list_aux([],Acc,Sum) => Sum = Acc.
sum_list_aux([X|L],Acc,Sum) => sum_list_aux(L,Acc+X,Sum).

% two lists that are structually equal, e.g., struct_equal(X,[a]) fails
struct_equal(A,B),atomic(A) => A == B.
struct_equal([H1|T1],[H2|T2]) =>
  struct_equal(H1,H2),
  struct_equal(T1,T2).

is_sorted([]) => true.
is_sorted([_]) => true.
is_sorted([X|L@[Y|_]]) =>X @<= Y, is_sorted(L).

% An empty tree is represented by {}, and a non-empty binary tree is 
% represented by its root, which takes form {Val,Left,Right}.

is_btree({}) => true.
is_btree({_Val,Left,Right}) =>
    is_btree(Left),
    is_btree(Right).

inorder({}) = [].
inorder({Val,Left,Right}) = inorder(Left) ++ [Val] ++ inorder(Right).

% binary search tree
is_bstree({}) => true.
is_bstree(BT@{Val,Left,Right}) =>
    is_bstree(Left,min_bstree(BT),Val),
    is_bstree(Right,Val,max_bstree(BT)).

is_bstree({},_,_) => true.
is_bstree({Val,Left,Right},Min,Max) => 
    Val @>= Min,  Val @=< Max,
    is_bstree(Left,Min,Val),
    is_bstree(Right,Val,Max).

min_bstree({Elm,{},_Right}) = Elm.
min_bstree({_Elm,Left,_Right}) = min_bstree(Left).

max_bstree({Elm,_Left,{}}) = Elm.
max_bstree({_Elm,_Left,Right}) = max_bstree(Right).

lookup_bstree({Elm,_,_},Elm) => true.
lookup_bstree({Val,Left,_},Elm), Elm < Val => 
    lookup_bstree(Left,Elm).
lookup_bstree({_,_,Right},Elm) =>
    lookup_bstree(Right,Elm).

tree_inst1 = {6, {5, {4, {}, {}}, 
                     {7, {}, {}}}, 
                 {8, {3, {}, {}}, 
                     {9, {}, {}}}}.

tree_inst2 = {7, {5, {4, {}, {}}, 
                     {6, {}, {}}}, 
                 {8, {8, {}, {}}, 
                     {9, {}, {}}}}.

test_btree =>
    Tree1 = tree_inst1(),
    println(inorder(Tree1)),
    println(cond(is_bstree(Tree1),"a binary search tree","not a binary search tree")),
    Tree2 = tree_inst2(),
    println(inorder(Tree2)),
    println(cond(is_bstree(Tree2),"a binary search tree","not a binary search tree")).

% An example that uses data constructors
% A term in the form of $f(X) is a data constructor 
divide_main => 
   Exp= $((((((((x/x)/x)/x)/x)/x)/x)/x)/x)/x,
   d(Exp,x,D),
   writeln(D).

d(U+V,X,D) => 
    D = $DU+DV,
    d(U,X,DU),
    d(V,X,DV).
d(U-V,X,D) =>
    D = $DU-DV,
    d(U,X,DU),
    d(V,X,DV).
d(U*V,X,D) =>
    D = $DU*V+U*DV,
    d(U,X,DU),
    d(V,X,DV).
d(U/V,X,D) =>
    D = $(DU*V-U*DV)/(^(V,2)),
    d(U,X,DU),
    d(V,X,DV).
d(^(U,N),X,D) =>
    D = $DU*N*(^(U,N1)),
    integer(N),
    N1 = N-1,
    d(U,X,DU).
d(-U,X,D) =>
    D = $-DU,
    d(U,X,DU).
d(exp(U),X,D) =>
    D = $exp(U)*DU,
    d(U,X,DU).
d(log(U),X,D) =>
    D = $DU/U,
    d(U,X,DU).
d(X,X,D) => D=1.
d(_,_,D) => D=0.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% LOOPS
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% another version for summing up a list 
sum_list_imp(L) = Sum =>
    S = 0,
    foreach (X in L)
       S := S+X
    end,
    Sum = S.

% using a loop to find the minimum and maximum of a list
min_max_ip([H|T], Min, Max) =>
    LMin = H,
    LMax = H,
    foreach (E in T)
        LMin := min(LMin, E),
        LMax := max(LMax, E)
    end,
    Min = LMin,
    Max = LMax.

% draw the Pascal triangle
pascal =>
    print("enter an integer:"),
    N = read_int(),
    foreach(I in 0..N)
        Num := 1,
        foreach(K in 1..I+1) 
            printf("%d ",Num),
            Num := Num*(I-K+1) div K
        end,
        nl
    end.

% another solution
pascal2 =>
    print("enter an integer:"),
    N = read_int(),
    Row = [1], 
    foreach(_I in 1..N)
        writeln(Row),
        Row := next_row(Row)
    end.

private
next_row(Row)=Res =>
    NewRow = [1], Prev = 1,
    foreach (K in tail(Row))
        NewRow := [Prev+K|NewRow],
        Prev := K
    end,
    Res = [1|NewRow].

/* another definition, not so efficient because Row[I] takes O(I) time
private
next_row(Row) = [1] ++ [Row[I]+Row[I+1] : I in 1..Row.length-1] ++ [1].
*/

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% LIST COMPREHENSION
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% a list comprehension inside another list comprehension
% Picat> L=list_of_lists(5)
% L = [[1],[1,2] [1,2,3],[1,2,3,4],[1,2,3,4,5]]
list_of_lists(N) = [[Y : Y in 1..X] : X in 1..N].   

% another definition
another_list_of_lists(N) = [1..X : X in 1..N].   

qsort([]) = [].
qsort([H|T]) = qsort([E : E in T, E =< H])++[H]++qsort([E : E in T, E>H]).

power_set([]) = [[]].
power_set([H|T]) = P1++P2 =>
    P1 = power_set(T),
    P2 = [[H|S] : S in P1].

% generate permutations
perm([]) = [[]].
perm(Lst) = [[E|P] : E in Lst, P in perm(Lst.delete(E))].

%another definition
perm1([]) = [[]].
perm1([H|T]) = [insert(P,I,H) : P in Ps, I in 1..P.length+1] => Ps = perm1(T).

% A*B=C
matrix_multi(A,B) = C =>
    C = new_array(A.length,B[1].length),
    foreach(I in 1..A.length, J in 1..B[1].length)
        C[I,J] = sum([A[I,K]*B[K,J] : K in 1..A[1].length])
    end.

% Sieve of Eratosthenes
my_primes(N) = L =>
    A = new_array(N),
    foreach(I in 2..floor(sqrt(N)))
        if (var(A[I])) then
            foreach(J in I**2..I..N)
                A[J] = 0
            end
         end
     end,
     L = [I : I in 2..N, var(A[I])].

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% TABLING
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% mode-directed tabling
% finding shortest paths on a graph given by the relation edge/3.
table(+,+,-,min) 
sp(X,Y,Path,W) ?=>
    Path=[(X,Y)],
    edge(X,Y,W).
sp(X,Y,Path,W) =>
    Path = [(X,Z)|PathR],
    edge(X,Z,W1),
    sp(Z,Y,PathR,W2),
    W = W1+W2.

index(+,-,-) (+,+,-)
edge(1,2,1).
edge(1,3,2).
edge(2,3,3).
edge(3,2,4).

% binomial coefficient
bc(_N,0) = 1.
bc(N,N) = 1.
bc(N,1) = N.
bc(N,K) = bc(N-1,K-1) + bc(N-1,K).

% computing the minimal editing distance of two given lists
table(+,+,min)
edit([],[],D) => D=0.
edit([X|Xs],[X|Ys],D) =>   % copy
    edit(Xs,Ys,D).
edit(Xs,[_Y|Ys],D) ?=>      % insert
    edit(Xs,Ys,D1),
    D = D1+1.
edit([_X|Xs],Ys,D) =>       % delete
    edit(Xs,Ys,D1),
    D = D1+1.

% the Farmer's problem (use planner)
farmer =>
    S0 = [s,s,s,s],
    plan(S0,Plan),
    println(Plan).

final([n,n,n,n]) => true.

action([F,F,G,C],S1,Action,ActionCost) ?=>
    Action = farmer_wolf,
    ActionCost = 1,        
    opposite(F,F1),
    S1 = [F1,F1,G,C],
    not unsafe(S1).
action([F,W,F,C],S1,Action,ActionCost) ?=>
    Action = farmer_goat,
    ActionCost = 1,        
    opposite(F,F1),
    S1 = [F1,W,F1,C],
    not unsafe(S1).
action([F,W,G,F],S1,Action,ActionCost) ?=>
    Action = farmer_cabbage,
    ActionCost = 1,        
    opposite(F,F1),
    S1 = [F1,W,G,F1],
    not unsafe(S1).
action([F,W,G,C],S1,Action,ActionCost) =>
    Action = farmer_alone,
    ActionCost = 1,        
    opposite(F,F1),
    S1 = [F1,W,G,C],
    not unsafe(S1).

index (+,-) (-,+)
opposite(n,s).
opposite(s,n).

unsafe([F,W,G,_C]),W == G,F !== W => true.
unsafe([F,_W,G,C]),G == C,F !== G => true.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% CONSTRAINT PROGRAMS (using cp)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% SEND+MORE=MONEY
sendmory => 
    Vars = [S,E,N,D,M,O,R,Y],    % generate variables
    Vars :: 0..9,
    all_different(Vars),       % generate constraints
    S #!= 0,
    M #!= 0,
    1000*S+100*E+10*N+D+1000*M+100*O+10*R+E 
    #= 10000*M+1000*O+100*N+10*E+Y,
    solve(Vars),               %  search
    writeln(Vars).

% N-queens
queens(N) =>
    Qs = new_array(N),
    Qs :: 1..N,
    foreach (I in 1..N-1, J in I+1..N)
        Qs[I] #!= Qs[J],
        abs(Qs[I]-Qs[J]) #!= J-I
    end,
    solve([ff],Qs),
    writeln(Qs).

% another program for N-queens
queens2(N, Q) =>
    Q = new_list(N),
    Q :: 1..N,
    Q2 = [$Q[I]+I : I in 1..N],
    Q3 = [$Q[I]-I : I in 1..N],
    all_different(Q),
    all_different(Q2),
    all_different(Q3),       
    solve([ff],Q).

% graph coloring (reuse edge/2 defined above)
color(NV,NC) =>
    A = new_array(NV),
    A :: 1..NC,
    foreach(I in 1..NV-1, J in I+1..NV)
        if edge(I,J);edge(J,I) then
             A[I] #!= A[J]
        end
    end,
    solve(A),
    writeln(A).

% a 0-1 integer model for graph coloring
bcolor(NV,NC) =>
    A = new_array(NV,NC),
    A :: [0,1],
    foreach(I in 1..NV)
        sum([A[I,K] : K in 1..NC]) #= 1
    end,
    foreach(I in 1..NV-1, J in I+1..NV)
        if edge(I,J);edge(J,I) then
             foreach(K in 1..NC)
                 #~ A[I,K] #\/ #~ A[J,K]
             end
        end
    end,
    solve(A),
    writeln(A).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% I/O
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% Read a list of integers, stopping when 0 is read
read_array_main =>
    A = new_array(100),
    Len = read_array(A),
    foreach (I in 1..Len)
        writeln(A[I])
    end.

read_array(A) = Len =>
    Count = 0,
    E = read_int(),         % read from stdin
    while (E != 0) 
        Count := Count+1,
        A[Count] = E,
        E := read_int()
    end,
    Len = Count.

% copy a text file line-by-line
copy(IName,OName) =>
    IStream = open(IName),
    OStream = open(OName,write),
    Line = IStream.read_line(),
    while (Line != end_of_file)
        OStream.printf("%s%n",Line),
        Line := IStream.read_line()
    end,
    close(IStream),
    close(OStream).

% Picat> output_students([$student("john","cs",3),$student("mary","math",4.0)])
%      john         cs  3.00
%      mary       math  4.00
output_students(Students) =>
    foreach($student(Name,Major,GPA) in Students)
        printf("%10s %10s %5.2f%n",Name,Major,to_real(GPA))
    end.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% HIGHER-ORDER (not recommended because of poor performance)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Picat> my_map(-,[1,2,3]) = L
% L = [-1,-2,-3]
% Picat> my_map(+,[1,2,3],[4,5,6]) = L
% L = [5,6,7]
% Picat> my_fold(+,0,[1,2,3]) = S
% S = 6

my_map(_F,[]) = [].
my_map(F,[X|Xs]) = [apply(F,X)|my_map(F,Xs)].

my_map(_F,[],[]) = [].
my_map(F,[X|Xs],[Y|Ys]) = [apply(F,X,Y)|my_map(F,Xs,Ys)].

my_fold(_F,Acc,[]) = Acc.
my_fold(F,Acc,[H|T]) = my_fold(F, apply(F,H,Acc),T).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% ACTION RULES
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
test_ar =>
    watch_event(X), 
    watch_dom(X),
    watch_dom_any(X),
    watch_ins(X),
    watch_bound(X),
    X.post_event(event),
    X.post_event_dom(dom),
    X.post_event_ins(),
    X.post_event_bound(),
    X.post_event_any(any).

watch_event(X), 
    {event(X,T)}
=> 
    writeln($event(T)).

watch_dom(X),
    {dom(X,T)}
=>
    writeln($dom(T)).

watch_dom_any(X),
    {dom_any(X,T)}
=>
    writeln($dom_any(T)).

watch_ins(X),
    {ins(X)}
=>
    writeln($ins(X)).

watch_bound(X),
    {bound(X)}
=>
    writeln($bound(X)).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% EXCEPTIONS
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

catch_divided_by_zero =>
   catch(write(myd(4,0)),E, $handle(E)).

myd(X,Y)=X/Y.

handle(E) =>
    writeln(E),
    throw(E).  % just re-throw it

/**** end file exs.pi ****/