2018 LP Programming Contest



Mary's Partitions

 
main =>
    mary(7,4321).
     
main([File]) =>
    [$mary(M,N)] = read_file_terms(File),
    mary(M,N).

mary(M,N) =>
    d(M,N,C),
    printf("solution(%d).\n",C).

d(M,N,C) => 
    K = to_int(log(M,N)),
    Ps = [M**I : I in K..-1..0],
    count(Ps,N,C).

table
count([],0,C) => C = 1.
count([1],_N,C) => C = 1.
count([P|Ps],N,C) =>
    Coe = N div P,
    count_rec(P,Ps,Coe,N,C).

count_rec(_P,_Ps,Coe,_N,C), Coe < 0 => C = 0.
count_rec(P,Ps,Coe,N,C) =>
    count(Ps,N-Coe*P,C1),
    count_rec(P,Ps,Coe-1,N,C2),
    C = C1+C2.

RBAC

 
import sat.

main =>
    rbac($[users(3),roles(3),perms(3),urs(3),ur(1,1,1),ur(2,1,2),ur(3,1,3),
           rps(3),rp(1,1,1),rp(2,1,2),rp(3,1,3),
           rhs(3),rh(1,1,2),rh(1,2,3),rh(1,1,3)]).

main([File]) =>
    Fs = read_file_terms(File),
    rbac(Fs).

rbac(Fs) =>
    cl_facts(Fs),
    users(NUs),
    roles(NRs),
    perms(NPs),
    A0 = new_array(NUs,NPs),
    foreach (U in 1..NUs, P in 1..NPs)
        (reach(U,P) -> A0[U,P] = 1;    A0[U,P] = 0)
    end,
    BURs = new_array(NUs,NRs),
    foreach (U in 1..NUs, R in 1..NRs)
        (ur(_,U,R) -> true; BURs[U,R] = 0)
    end,
    BURs :: 0..1,
    BRPs = new_array(NRs,NPs),
    foreach (R in 1..NRs, P in 1..NPs)
        (rp(_,R,P) -> true; BRPs[R,P] = 0)
    end,
    BRPs :: 0..1,
    BRHs = new_array(NRs,NRs),
    foreach (R1 in 1..NRs, R2 in 1..NRs)
        (rh(_,R1,R2) -> true; BRHs[R1,R2] = 0)
    end,
    BRHs :: 0..1,
    foreach (U in 1..NUs, P in 1..NPs)
        A0[U,P] #= sum([BURs[U,R]*BRPs[R,P] : R in 1..NRs]) +
                   sum([BURs[U,R]*BRHs[R,R1]*BRPs[R1,P] : R in 1..NRs, R1 in 1..NRs])
    end,
    To #= sum([BURs[U,R] : U in 1..NUs, R in 1..NRs]) +
          sum([BRPs[R,P] : R in 1..NRs, P in 1..NPs]) +
          sum([BRHs[R1,R2] : R1 in 1..NRs, R2 in 1..NRs]),
    solve([$min(To)],(BURs,BRPs,BRHs)),
    printf("minRoleAssignmentsWithHierarchy(%d).\n",To).

reach(U,P) =>
    ur(_,U,R),
    (rp(_,R,P); rh(_,R,R1),rp(_,R1,P)).

The Hatter

 
%% This program counts the solutions that satisfy the constraints (all-different and disciples).
%% It may take long time to count.
%
import cp.

main =>
    Fs = $[students(4),
          disciples(1, 0),
          disciples(2, 2),
          disciples(3, 1),
          disciples(4, 0)],
    ha(Fs).

test =>
    Fs = $[students(4),
    disciples(1, 0),
    disciples(2, 2),
    disciples(3, 1),
    disciples(4, 1)],
    ha(Fs).
    
main([File]) =>
    Fs = read_file_terms(File),
    ha(Fs).

ha(Fs) ?=>
    once member($students(N),Fs),
    A = new_array(N),
    foreach ($disciples(I,K) in Fs)
        A[I] = K
    end,
    A[N] = 0,
    V = new_array(N),
    V :: 1..N,
    all_different(V),
    constr_desciples(1,N,A,V),
    printf("solutions(%d).\n",count_all(solve(V)) mod 1000000007).
ha(_Fs) =>
    print("solutions(0).\n").
    
constr_desciples(I,N,_A,_V), I == N => true.
constr_desciples(I,N,A,V) =>
    foreach (J in I+1..I+A[I])
        V[J] #< V[I]
    end,
    (A[I]+I+1 =< N ->
        V[A[I]+I+1] #> V[I]
    ;
        true
    ),
    constr_desciples(I+1,N,A,V).

Stars

 
%% Brute-force algorithm; can be made incremental and more efficient.
%
main =>
    Fs = $[sky(3, 5, 4),
           star(1, 1, 2, 3),
           star(2, 2, 3, 2),
           star(3, 6, 3, 1)],
    star(Fs).

main([File]) =>
    Fs = read_file_terms(File),
    star(Fs).

star(Fs) =>
    once member($sky(_N,WinW,WinH),Fs),
    SkyW = max([X : $star(_,X,_,_) in Fs]),
    SkyH = max([Y : $star(_,_,Y,_) in Fs]),
    maxof($scan_win(WinW,WinH,SkyW,SkyH,Fs,SumB),SumB),
    printf("solution(%d).\n",SumB).

scan_win(WinW,WinH,SkyW,SkyH,Stars,SumB) =>
    between(0,SkyW-WinW+1,X),
    between(0,SkyH-WinH+1,Y),
    SumB = sum([B : $star(_,X1,Y1,B) in Stars, X1 > X, X1 < X+WinW, Y1 > Y, Y1 < Y+WinH]).

Latin Square

 
import cp.

main =>
    latin($[row(1,-1,0,0,-1,0,1),
            vertical(2,1,-1,1,1,-1,-1,1,-1,0),
            row(3,1,0,-1,0,0,-1),
            vertical(4,1,-1,-1,1,-1,1,1,-1,-1),
            row(5,-1,-1,1,0,0,-1),
            row(6,0,-1,0,1,0,1),
            vertical(7,1,1,-1,-1,1,0,-1,1,-1),
            row(8,1,-1,1,1,1,-1),
            vertical(9,0,0,0,0,0,-1,-1,1,1),
            row(10,-1,1,-1,-1,1,1),
            row(11,-1,1,-1,1,-1,-1),
            vertical(12,-1,1,1,-1,1,1,-1,1,0),
            row(13,0,1,1,-1,0,1),
            vertical(14,-1,1,-1,-1,1,-1,1,-1,1),
            row(15,-1,1,0,1,0,-1)]).

main([File]) =>
    Fs = read_file_terms(File),
    latin(Fs).

latin(Fs) ?=>
    SFs = sort(Fs),
    A = new_array(9,9),
    A :: 1..9,
    foreach(Row in 1..9)
        all_different(A[Row])
    end,
    foreach(Col in 1..9)
        all_different([A[Row,Col] : Row in 1..9])
    end,
    foreach(Row in 1..3..7, Col in 1..3..7) 
        Square = [A[Row+Dr,Col+Dc] : Dr in 0..2, Dc in 0..2],
        all_different(Square)
    end,
    Os = {{O1,O2,O3,O4,O5,O6} : $row(_,O1,O2,O3,O4,O5,O6) in SFs},
    constr_rel(A,Os),
    Vs = {{O1,O2,O3,O4,O5,O6,O7,O8,O9} : $vertical(_,O1,O2,O3,O4,O5,O6,O7,O8,O9) in SFs},
    transpose(A,A1),
    transpose(Vs,Os1),
    constr_rel(A1,Os1),
    printf("solutions(%d).\n",count_all(solve(A))).
latin(_Fs) =>    
    print("solutions(0).\n").

transpose(M,T) =>
    NRows = len(M),
    NCols = len(M[1]),
    T = new_array(NCols,NRows),
    foreach(R in 1..NRows, C in 1..NCols)
        T[C,R] = M[R,C]
    end.
    
constr_rel(A,Os) =>
    foreach (I in 1..9)
        constr_row(A[I],Os[I])
    end.

constr_row({C1,C2,C3,C4,C5,C6,C7,C8,C9},{O1,O2,O3,O4,O5,O6}) =>
    constr_cell(C1,C2,O1),
    constr_cell(C2,C3,O2),
    constr_cell(C4,C5,O3),
    constr_cell(C5,C6,O4),
    constr_cell(C7,C8,O5),
    constr_cell(C8,C9,O6).

constr_cell(C1,C2,1) =>
    C1+C2 #> 10.
constr_cell(C1,C2,0) =>
    C1+C2 #= 10.
constr_cell(C1,C2,_) =>
    C1+C2 #< 10.