Use Prolog

    Hey, full steaks, let's practice skills. I propose to knead the gyrus, it seems to me that it is interesting to do it using a different, unusual, paradigm. Most developers have an advanced algorithmization skill - the task turns into building blocks that need to be connected, to think over a sequence of moves that leads to the desired conclusion.


    Here then , a week ago, has been mentioned prologue, I would like to say that the language Prolog is suitable for solving brainteasers. I have already touched on this topic, and cited several solutions of random problems from the site with tasks for algorithms that are available to me , I would like to show that any complex solution is available in a declarative language, and it can work no slower (well, maybe, noticeably not very slower).


    I couldn’t take the next task for a long time, and now I’ve got the first solution, showing the problem and finding out how much slow it is.


    The prologue is interesting because you can create a deductive program that shows a lot of solutions and can even limit it, but does not provide a way to go through, the
    algorithm will be developedsolver an interpreter.


    So, the problem is this :


    1. It is a trace of raindrop
      .
      Note:
      Both m and n are less than 110. The height of each unit cell is greater than 0 and is less than 20,000.
      Example:

      image

      Given the following 3x6 height map:
      [
      [1,4,3,1,3,2],
      [3,2,1,3,2,4],
      [2,3,3,2,3,1 ]
      ]
      Return 4.



    After lengthy attempts to formulate a solution, I came to the following formulation:
    It is necessary to pour a maximum of water into each cell, which would not pour out of it . I propose to pour into each cell, some amount of water, but so that it is less equal to the maximum value of all possible.


    It turned out like this:


    reptest(X0,X2):-
          flatten(X0,FX0),
          sort(0,>,FX0,Vals),
          repdown(X0,Vals,X0,X2),!.

    this predicate takes an input list (matrix), and turns it into a solution, into a matrix in which there are other values ​​that will be a valid answer. Then another predicate will take these two lists element by element and find the total sum.


    repdown(X0,Vals,X,X1):-
          puts(Vals,X0,X1),
          X\=X1,
          balns(X0,X1),!.
    repdown(_,_,X,X).

    this predicate will take one of the solutions, and check whether it is “normal” if it satisfies the condition of the problem, then this is the solution.


    This is the "generate and test" method, we say that the value is in such and such a set and we review all the elements of this set, checking some output condition.


    This means that the predicate puts (Vals, X0, X1) will receive a new solution, here in the first place there is a list of all possible values ​​of heights that are in this matrix, the possible values ​​of heights for each cell will be selected from it. By analyzing the input tests, it was found that in this task you can fill the entire cell, if you can insert so much water around it that it pours with the head.


    Overall, this predicate looks more complicated, it is necessary to process triples of lines that make up one 3x3 square (yes, there is no array in Prolog, but the description of the input data looks like this, so we use this, in declarative programming you may not know about the indexes of the elements in the array , there is only a list with his head and tail, so we simply describe such a template that corresponds to the input specification).


    puts(_,[],[]).
    puts(_,[X],[X]).
    puts(_,[X,Z],[X,Z]).
    puts(V,[R1,R2,R3|T],[R1|St]) :- number(R2),!,sel_biger(R2,V,R21),puts(V,[R21,R3|T],St).
    puts(V,[R1,R2,R3|T],[R1|St]) :- puts(V,R2,R21),puts(V,[R21,R3|T],St).

    This is how it turns out to express a detour of the matrix from which you can take the first three (and further) lines from which, you can also select, from left to right, triples of elements, and now between the eight neighbors there will be one [Ita] [This] landscape cell. With sel_biger (R2, V, R21) a new value of this cell is made.


    This value can be set to the current cell, it can be one of the possible heights, and even a list of them sorted in descending order, so that the first one will be the greatest height available at all, and then any one after it:


    sel_biger(C,[H|_],H):-H>=C.
    sel_biger(C,[_|T],X):-sel_biger(C,T,X).

    It was a description of the "decision generator", and then we need to make sure that the matrix is ​​received, from whatever heights filled in at each point, is similar to the answer required from us.


    But it was necessary to find such a state that the water settles in the wells, I will try to express it like this:
    out of nine values ​​of three by three squares, there should always be such a height in the center that it does not contradict the input map so that the balance does not change, which was originally in these cells, if there was a height, then the cells should not remain above it, even if everything is flooded with water, then we can say that a high cell should remain itself or be replaced with a higher value, but such that it is equal to all neighbors, t. e. the cells on the left-right and above-below from the current should exceed or be equal, if there is more water in the cell, then only if it has risen around ...


    %%проход по строкамbalns([],[]).
    balns([_],[_]).
    balns([_,_],[_,_]).
    balns([B1,B2,B3|Tb],[R1,R2,R3|T]) :-
               blevel(B1,B2,B3,R1,R2,R3),
               balns([B2,B3|Tb],[R2,R3|T]).
    %%из трех строк выбираем по тройке, для создания квадрата 3х3
    blevel([],[],[],[],[],[]).
    blevel([_],[_],[_],[_],[_],[_]).
    blevel([_,_],[_,_],[_,_],[_,_],[_,_],[_,_]).
    blevel([_,U1,U2|Tu],[R,C,L|T],[_,B1,B2|Tb],
           [_,U10,U20|Tu0],[R0,C0,L0|T0],[_,B10,B20|Tb0]):-
                      equ(C,[U1,L,R,B1],C0,[U10,L0,R0,B10]),
                      blevel([U1,U2|Tu],[C,L|T],[B1,B2|Tb],
                             [U10,U20|Tu0],[C0,L0|T0],[B10,B20|Tb0]).
    %%одинаков характер элементов в квадратах, 
    %значение может сохраняется или быть менее равно соседей
    equ(_,[],_,[]):-!.
    equ(C,_,C,_):-!.
    equ(C0,_,C,N):-C>C0,!,findall(X,(member(X,N),X<C),[]).
    equ(C0,[C0|T0],C,[C|T]):-!,equ(C0,T0,C,T).

    And the final two predicates, which take the input matrix, start searching for a suitable result, subtract the sum of the elements among themselves, and find the final amount that was required in the problem:


    diffall(L0,L2,S):-
         flatten(L0,F0),sum_list(F0,S0),
         flatten(L2,F2),sum_list(F2,S2),
         S is S2-S0.
    %%это главный предикат, входной список и выход сумма
    sums(X,S):-reptest(X,X1),diffall(X,X1,S).

    I will demonstrate the tests that provided the site .


    reptest(X0,X2):-
          flatten(X0,FX0),
          sort(0,>,FX0,Vals),
          repdown(X0,Vals,X0,X2),!.
    repdown(X0,Vals,X,X1):-
          puts(Vals,X0,X1),
          X\=X1,
          balns(X0,X1),!.
    repdown(_,_,X,X).
    puts(_,[],[]).
    puts(_,[X],[X]).
    puts(_,[X,Z],[X,Z]).
    puts(V,[R1,R2,R3|T],[R1|St]) :- number(R2),!,sel_biger(R2,V,R21),puts(V,[R21,R3|T],St).
    puts(V,[R1,R2,R3|T],[R1|St]) :- puts(V,R2,R21),puts(V,[R21,R3|T],St).
    sel_biger(C,[H|_],H):-H>=C.
    sel_biger(C,[_|T],X):-sel_biger(C,T,X).
    %проход по строкам
    balns([],[]).
    balns([_],[_]).
    balns([_,_],[_,_]).
    balns([B1,B2,B3|Tb],[R1,R2,R3|T]) :-
               blevel(B1,B2,B3,R1,R2,R3),
               balns([B2,B3|Tb],[R2,R3|T]).
    %из трех строк выбираем по тройке, для создания квадрата 3х3
    blevel([],[],[],[],[],[]).
    blevel([_],[_],[_],[_],[_],[_]).
    blevel([_,_],[_,_],[_,_],[_,_],[_,_],[_,_]).
    blevel([_,U1,U2|Tu],[R,C,L|T],[_,B1,B2|Tb],
           [_,U10,U20|Tu0],[R0,C0,L0|T0],[_,B10,B20|Tb0]):-
                      equ(C,[U1,L,R,B1],C0,[U10,L0,R0,B10]),
                      blevel([U1,U2|Tu],[C,L|T],[B1,B2|Tb],
                             [U10,U20|Tu0],[C0,L0|T0],[B10,B20|Tb0]).
    %одинаков характер элементов в квадратах, 
    %значение может сохраняется или быть более равно соседей
    equ(_,[],_,[]):-!.
    equ(C,_,C,_):-!.
    equ(C0,_,C,N):-C>C0,!,findall(X,(member(X,N),X<C),[]).
    equ(C0,[C0|T0],C,[C|T]):-!,equ(C0,T0,C,T).
    diffall(L0,L2,S):-
         flatten(L0,F0),sum_list(F0,S0),
         flatten(L2,F2),sum_list(F2,S2),
         S is S2-S0.
    sums(X,S):-reptest(X,X1),diffall(X,X1,S).
    %unit-testsframeworkassert_are_equal(Goal, false):-get_time(St),not(Goal),!,get_time(Fin),Perisround(Fin-St),writeln(Goal->ok:Per/sec).
    assert_are_equal(Goal, true):- get_time(St),Goal,     !,get_time(Fin),Perisround(Fin-St),writeln(Goal->ok:Per/sec).
    assert_are_equal(Goal, Exp):-writeln(Goal->failed:expected-Exp).
    :-assert_are_equal(sums([[1,4,3,1,3,2],[3,2,1,3,2,4],[2,3,3,2,3,1]],4),true).
    :-assert_are_equal(sums([[1,3,3,1,3,2],[3,2,1,3,2,3],[3,3,3,2,3,1]],4),true).
    :-assert_are_equal(sums([[12,13,1,12],[13,4,13,12],[13,8,10,12],[12,13,12,12],[13,13,13,13]],14),true).
    :-assert_are_equal(sums([[2,3,4],[5,6,7],[8,9,10],[11,12,13],[14,15,16]],0),true).
    :-assert_are_equal(sums([],0),true).
    :-assert_are_equal(sums([[1]],0),true).
    :-assert_are_equal(sums([[2,3]],0),true).
    :-assert_are_equal(sums([[3],[2]],0),true).
    :-assert_are_equal(sums([[18,2,3],[4,5,6],[7,8,9]],0),true).
    :-assert_are_equal(sums([[3,5,5],[5,4,5],[5,5,5]],1),true).
    :-assert_are_equal(sums([[5,5,5,1],[5,1,1,5],[5,1,5,5],[5,2,5,8]],3),true).
    :-assert_are_equal(sums([[2,2,2],[2,1,2],[2,1,2],[2,1,2]],0),true).
    :-assert_are_equal(sums([[17,2,3,4,5,6,7,8,9,10]],0),true).
    :-assert_are_equal(sums([[9,9,9,9,9],[9,2,1,2,9],[9,2,8,2,9],[9,2,3,2,9],[9,9,9,9,9]],57),true).
    %:-assert_are_equal(sums([[9,9,9,9,9,9,8,9,9,9,9],[9,0,0,0,0,0,1,0,0,0,9],[9,0,0,0,0,0,0,0,0,0,9],[9,0,0,0,0,0,0,0,0,0,9],[9,9,9,9,9,9,9,9,9,9,9]],215),true).
    :-assert_are_equal(sums([[11,21,31],[81,9,41],[17,61,51]],12),true).
    :-assert_are_equal(sums([[3,3,4,4,4,2],[3,1,3,2,1,4],[7,3,1,6,4,1]],5),true).
    %:-assert_are_equal(sums([[78,16,94,36],[87,93,50,22],[63,28,91,60],[64,27,41,27],[73,37,12,69],[68,30,83,31],[63,24,68,36]],44),true).

    I had to comment on the tests . not everyone passed.


    The challenge, how to speed it up?


    Part of the solutions is not to be, because of the long search of solutions, it is too slow to generate them in this order, here the complexity is probably n !, all possible values ​​for each cell of the array are sorted.


    It is convenient to express this task in the programming system in constraints, just on the Prologue this is called: CLP (FD): Constraint Logic Programming over Finite Domains.


    clp (fd) SWI-Prolog distribution. The variables need to be set.

    >>

    I will formulate the problem like this:
    We need such a list, each element of which is from the set of values ​​is more or equal to its maximum value across the entire map, taking into account the restriction that the elements should be arranged clearly in the order corresponding to the spilled liquid.


    This is how I make from the input list, a new list, the elements of which have become unknown in a given range (from the R2 value of the current element and up to the Maximum value V).
    At the input there is a list of lists, the output is a new list with a maximum distribution of values
    that satisfy the "balance" fluid "balns:


    checks(X0,X2):-
          flatten(X0,FX),
          max_list(FX,Max),checks(Max,X0,X2),
          balns(X0,X2),      
          flatten(X2,FX2),
          labeling([down],FX2).
    checks(_,[],[]).
    checks(_,[X],[X]).
    checks(_,[X,Z],[X,Z]).
    checks(V,[R1,R2,R3|T],[R1|St]) :- number(R2),!,
                      R21 in R2..V,
                      checks(V,[R21,R3|T],St).
    checks(V,[R1,R2,R3|T],[R1|St]) :- checks(V,R2,R21),checks(V,[R21,R3|T],St).

    This is both a generator and simultaneously a check, it is indicated that the elements are in such a set, and then gradually imposing a check the narrowing of this set occurs. Further, something remains, and it can be "marked", i.e. arrange integer values ​​that will satisfy the sum of all constraints. Calling labeling ([down], FX2) causes to fill (connect)variable unknown with specific values, and there may be several such options, but we always take the very first one, since it was said that all variables move down in the search, from their upper bounds, these are the search options [down].


    And there you can see such complex settings as:
    16.2.1. variable selection strategy
    The variable selection strategy lets you specify which variable of Vars is labeled next and is one of:
    leftmost — Label the variables in the order they occur in Vars. This is the default.
    ff First fail. Label the leftmost variable with smallest domain next, in order to detect infeasibility early. This is often a good strategy when there are small domains for the subsequent variables when a first variable is chosen.
    ffc Of the variables with smallest domains, the leftmost one participating in most constraints is labeled next. Applying a constraint has to remove a subtree, so this can be a good strategy.
    min Label the leftmost variable whose lower bound is the lowest next. note that this is min/0, different than min/1, which determines solution order and is discussed in the previous section above. This is a good tactic if you’re trying to minimize some global value that is likely to be lower if various variables are (e.g. a minimum cost solution).
    max Label the leftmost variable whose upper bound is the highest next. This too is different than max/1. And the advice for min applies to max when trying to maximize a global value.
    16.2.2. value order
    The value order is one of:
    up Try the elements of the chosen variable’s domain in ascending order. This is the default.
    down Try the domain elements in descending order.
    Obviously, if you’ve got an assymmetric distribution, like we demonstraed in how to label efficiently above, try elements in most common first order.
    16.2.3. branching strategy
    The branching strategy is one of:
    step For each variable X, a choice is made between X = V and X #\= V, where V is determined by the value ordering options. This is the default.
    enum For each variable X, a choice is made between X = V_1, X = V_2 etc., for all values V_i of the domain of X. The order is determined by the value ordering options.
    bisect For each variable X, a choice is made between X #=< M and X #> M, where M is the midpoint of the domain of X. Choose this option if many variables are selections among a range of integers, a value, rather than one among a set of enumerated values (e.g. percentages, vs a=0, b=1, c=2)


    Now, in fact, what is "balanced" is when poured water does not overflow from cell to cell. This is the correspondence of the initial ordering of elements. One may think that filling the cells will retain the shape of the original landscape, this means if there was a wall, then it can be covered with water on top, so that it becomes necessarily equal to all its neighbors, or if it is not a wall covered with water ...


    Consider the balance of situations:
    -If the cell is flooded, then next to the same or even higher (all of a sudden it is the wall).
    -If the cell was equal to the next, then it must be equal to the new and next.
    - And in the extreme case, the cell did not change its meaning, and still, what were its neighbors:


    %проход по строкамbalns([],[]).
    balns([_],[_]).
    balns([_,_],[_,_]).
    balns([B1,B2,B3|Tb],[R1,R2,R3|T]) :-
               blevel(B1,B2,B3,R1,R2,R3),
               balns([B2,B3|Tb],[R2,R3|T]).
    %из трех строк выбираем по тройке, для создания квадрата 3х3
    blevel([],[],[],[],[],[]).
    blevel([_],[_],[_],[_],[_],[_]).
    blevel([_,_],[_,_],[_,_],[_,_],[_,_],[_,_]).
    blevel([_,U1,U2|Tu],[R,C,L|T],[_,B1,B2|Tb],
           [_,U10,U20|Tu0],[R0,C0,L0|T0],[_,B10,B20|Tb0]):-
                      equ(C,[U1,L,R,B1],C0,[U10,L0,R0,B10]),
                      blevel([U1,U2|Tu],[C,L|T],[B1,B2|Tb],
                             [U10,U20|Tu0],[C0,L0|T0],[B10,B20|Tb0]).
    %одинаков характер элементов в квадратах,
    %значение может сохраняется или быть менее равно соседей
    equ(C0,_,C,[U,L,R,D]):-C#>C0,C#=<U,C#=<R,C#=<L,C#=<D.
    equ(_,[],_,[]).
    equ(C0,[C0|T0],C,[C|T]):-equ(C0,T0,C,T).
    equ(C,_,C1,_):-C1#=C.

    This is how you can transfer your attitude to the task into the program. I don’t need to think about the solution algorithm; it’s important to provide a correct description of the result, to set correctly all the initial constraints (sets of values). This approach can simply be "mixed" with the usual search with return and recursion inherent in Prolog. This is a way to formulate even more declarative programs than using the classical methods of Prolog.


    I will give the resulting solution, with a set of tests:


    :- use_module(library(clpfd)).
    checks(X0,X2):-
          flatten(X0,FX),
          max_list(FX,Max),checks(Max,X0,X2),
          balns(X0,X2),      
          flatten(X2,FX2),
          labeling([down],FX2).
    checks(_,[],[]).
    checks(_,[X],[X]).
    checks(_,[X,Z],[X,Z]).
    checks(V,[R1,R2,R3|T],[R1|St]) :- number(R2),!,
                      R21 in R2..V,
                      checks(V,[R21,R3|T],St).
    checks(V,[R1,R2,R3|T],[R1|St]) :- checks(V,R2,R21),checks(V,[R21,R3|T],St).
    %проход по строкам
    balns([],[]).
    balns([_],[_]).
    balns([_,_],[_,_]).
    balns([B1,B2,B3|Tb],[R1,R2,R3|T]) :-
               blevel(B1,B2,B3,R1,R2,R3),
               balns([B2,B3|Tb],[R2,R3|T]).
    %из трех строк выбираем по тройке, для создания квадрата 3х3
    blevel([],[],[],[],[],[]).
    blevel([_],[_],[_],[_],[_],[_]).
    blevel([_,_],[_,_],[_,_],[_,_],[_,_],[_,_]).
    blevel([_,U1,U2|Tu],[R,C,L|T],[_,B1,B2|Tb],
           [_,U10,U20|Tu0],[R0,C0,L0|T0],[_,B10,B20|Tb0]):-
                      equ(C,[U1,L,R,B1],C0,[U10,L0,R0,B10]),
                      blevel([U1,U2|Tu],[C,L|T],[B1,B2|Tb],
                             [U10,U20|Tu0],[C0,L0|T0],[B10,B20|Tb0]).
    %одинаков характер элементов в квадратах,
    %значение может сохраняется или быть менее равно соседей
    equ(C0,_,C,[U,L,R,D]):-C#>C0,C#=<U,C#=<R,C#=<L,C#=<D.
    equ(_,[],_,[]).
    equ(C0,[C0|T0],C,[C|T]):-equ(C0,T0,C,T).
    equ(C,_,C1,_):-C1#=C.
    diffall(L0,L2,S):-
         flatten(L0,F0),sum_list(F0,S0),
         flatten(L2,F2),sum_list(F2,S2),
         S is S2-S0.
    sums(X,S):-checks(X,X1),!,diffall(X,X1,S).
    %unit-testsframeworkassert_are_equal(Goal, false):-get_time(St),not(Goal),!,get_time(Fin),Perisround(Fin-St),writeln(Goal->ok:Per/sec).
    assert_are_equal(Goal, true):- get_time(St),Goal,     !,get_time(Fin),Perisround(Fin-St),writeln(Goal->ok:Per/sec).
    assert_are_equal(Goal, Exp):-writeln(Goal->failed:expected-Exp).
    :-assert_are_equal(sums([[1,4,3,1,3,2],[3,2,1,3,2,4],[2,3,3,2,3,1]],4),true).
    :-assert_are_equal(sums([[1,3,3,1,3,2],[3,2,1,3,2,3],[3,3,3,2,3,1]],4),true).
    :-assert_are_equal(sums([[12,13,1,12],[13,4,13,12],[13,8,10,12],[12,13,12,12],[13,13,13,13]],14),true).
    :-assert_are_equal(sums([[2,3,4],[5,6,7],[8,9,10],[11,12,13],[14,15,16]],0),true).
    :-assert_are_equal(sums([[18,2,3],[4,5,6],[7,8,9]],0),true).
    :-assert_are_equal(sums([[3,5,5],[5,4,5],[5,5,5]],1),true).
    :-assert_are_equal(sums([[5,5,5,1],[5,1,1,5],[5,1,5,5],[5,2,5,8]],3),true).
    :-assert_are_equal(sums([[2,2,2],[2,1,2],[2,1,2],[2,1,2]],0),true).
    :-assert_are_equal(sums([[17,2,3,4,5,6,7,8,9,10]],0),true).
    :-assert_are_equal(sums([[9,9,9,9,9],[9,2,1,2,9],[9,2,8,2,9],[9,2,3,2,9],[9,9,9,9,9]],57),true).
    :-assert_are_equal(sums([[78,16,94,36],[87,93,50,22],[63,28,91,60],[64,27,41,27],[73,37,12,69],[68,30,83,31],[63,24,68,36]],44),true).
    :-assert_are_equal(sums([[11,21,31],[81,9,41],[17,61,51]],12),true).
    :-assert_are_equal(sums([[5,5,5],[5,1,5],[5,5,5]],4),true).
    :-assert_are_equal(sums([[5,5,5],[5,1,5],[5,1000,6]],4),true).
    :-assert_are_equal(sums([[5,8,7,7],[5,2,1,5],[7,1,7,1],[8,9,6,9],[9,8,9,9]],12),true).
    :-assert_are_equal(sums([[11,21,31],[81,9,41],[17,61,51]],12),true).
    :-assert_are_equal(sums([[3,3,4,4,4,2],[3,1,3,2,1,4],[7,3,1,6,4,1]],5),true).
    :-assert_are_equal(sums([[14,17,18,16,14,16],[17,3,10,2,3,8],[11,10,4,7,1,7],[13,7,2,9,8,10],[13,1,3,4,8,6],[20,3,3,9,10,8]],25),true).
    :-assert_are_equal(sums([[14,17,12,13,20,14],[12,10,5,8,9,5],[16,1,4,7,2,1],[17,4,3,1,7,2],[16,6,
        

    Also popular now: