Improving the code -- Dudeney The Ten Barrels puzzle

[Doug Edmunds]

Dudeney (536 Puzzles and Curious Problems)  #462, asks to find the lowest value of each side of a triangle using the numbers 1 to 9, with one barrel having no number.  Each side has 4 barrels, with the corner barrels are shared by two sides..  

My solution finds the correct value by accident, depending entirely on the order of variables in solve().  I would like a solution that controls the outcome, to allow, for example,  finding the second lowest value of each side.

% Dudeney 536 Puzzles & Curious Problems -- #462 Ten barrels

% Sum of each side is the same, but the smallest (less than the 16 in the picture)

import cp.

main =>

  go.

go =>

  B = [B0, B1, B2, B3, B4, B5, B6, B7, B8, B9],

  B :: 0..9,

  all_different(B),

/*

4 rows, triangular shape,  

B0, B1 & B2, B3 &B4 & B5, B6 & B7 & B8 & B9

*/

Left     =  [B0 , B1 , B3 , B6],

Right    =  [B0 , B2 , B5 , B9],

Bottom   =  [B6 , B7 , B8 , B9],

LS #= sum(Left),

RS #= sum(Right),

BS #= sum(Bottom),

LS #= RS,

RS #= BS,

Sides = flatten([Left, Right, Bottom]),

SumSides #= sum(Sides),

%Vars = [SumSides] ++ B, % produces Each side totals 13

Vars = B ++ [SumSides], % produces Each side totals 17

%Vars = B,  % produces Each side totals 17

solve(Vars),

println(Vars),

println(Left),

println(Right),

println(Bottom),

println(eachSideTotal=LS),

nl.

 (each side will have the same total)

[Hakan Kjellerstrand]

Hi Doug.

Here's my model of the problem (written some years ago): http://hakank.org/picat/the_ten_barrels.pi

There are 96 optimal solution with the sum of sides = 13. The model uses symmetry breaking to reduce the number of optimal solutions to 8,

(It's in two steps: First it finds the minimum number of sides and then search for all the solutions with that value.)

Different order of the variables in solve/1-2 can indeed give different results (and the order can thus be manipulated to get faster models).

I notice  that you don't minimize the sum. Using this solve instead

   solve($[min(SumSides)],Vars),

gives this solution:

   [0,3,5,8,9,7,2,4,6,1,39]
   [0,3,8,2]
   [0,5,7,1]
   [2,4,6,1]
   eachSideTotal = 13

This solution is deterministic. You can get some other solutions with some other search heuristics, e.g.

   solve($[degree,updown,min(SumSides)],Vars),

with give this solution instead

   [0,7,8,5,9,3,1,6,4,2,39]
   [0,7,5,1]
   [0,8,3,2]
   [1,6,4,2]
   eachSideTotal = 13

The different search heuristics might give different optimal results but should give the same solution deterministically (except the rand* heuristics).

But I guess that doesn't really answer your question:  "I would like a solution that controls the outcome, to allow,  for example,  finding the second lowest value of each side."

However, I'm not sure what you mean by "finding the second lowest value of each side". Do you mean to minimize the total of the second lowest value of each side? I would assume that it's for the solution with the side totals are 13?

One approach would be to collect all the 96 optimal solutions and then search for the specific solution you have in mind.

Hope this helps

Hakan

[Hakan Kjellerstrand]

Hi again, Doug,

Here's a model which does the following:

1) Find the optimal (minimal) value of the sides,

2) Find the minimum sum of the second value of each side, where "second value" means the second in an increasing list.

It uses the decompositions sort/2 and permutation3/3 for this.

I guess it's still not really what you want, but it might give you some ideas.

```

% Doug:
% "I would like a solution that controls the outcome, to allow,  for example,
%   finding the second lowest value of each side."
go2 =>

  % Step1: Find the optimal value of each side
  s(_B,LS),
  println(min=LS),

  nl,

  % Step 2: Find the optimal solution with the minimum sum of the
  % second lowest value of each side
  s(B,LS),
  nl.

s(B,LS) =>

  B = [B0, B1, B2, B3, B4, B5, B6, B7, B8, B9],
  B :: 0..9,
  all_different(B),
  /*
  4 rows, triangular shape,  
  B0, B1 & B2, B3 &B4 & B5, B6 & B7 & B8 & B9
  */

  Left     =  [B0 , B1 , B3 , B6],
  Right    =  [B0 , B2 , B5 , B9],
  Bottom   =  [B6 , B7 , B8 , B9],

  LS #= sum(Left),
  RS #= sum(Right),
  BS #= sum(Bottom),

  LS #= RS,
  RS #= BS,

  Sides = flatten([Left, Right, Bottom]),
  SumSides #= sum(Sides),

  Vars = B ++ [SumSides],

  if var(LS) then
     solve($[min(LS)],Vars),
  else
     % Minimize the sum of the second value in each side
     Left2 = new_list(4),
     Left2 :: 0..9,
     sorted(Left,Left2),
     
     Right2 = new_list(4),
     Right2 :: 0..9,    
     sorted(Right,Right2),
     
     Bottom2 = new_list(4),
     Bottom2 :: 0..9,    
     sorted(Bottom,Bottom2),
     % The second value in each side
     V = [Left2[2],Right2[2],Bottom2[2]],
     solve($[min(sum(V))],V++Vars)
  end,

  println(Vars),
  println(Left),
  println(Right),
  println(Bottom),
  println(eachSideTotal=LS),

  nl,

  nl.

%
% The permutation from A <-> B using the permutation P

%

permutation3(A,P,B) =>
   foreach(I in 1..A.length)
       PI #= P[I],
       BI #= B[I],
       element(PI, A, BI)
   end.

%

% L2 contains the elements in L but sorted.

%

sorted(L,L2) =>
  N = L.len,
  P = new_list(N),
  P :: 1..N,
  all_different(P),
  permutation3(L,P,L2),
  increasing(L2).

```

The output is

[0,3,5,8,9,7,2,4,6,1,39]
[0,3,8,2]
[0,5,7,1]
[2,4,6,1]
eachSideTotal = 13

min = 13

[0,4,5,8,9,6,1,3,7,2,39]
[0,4,8,1]
[0,5,6,2]
[1,3,7,2]
eachSideTotal = 13

"""

/Hakan

[Doug Edmunds]

Thanks for pointing out  "solve($[min(SumSides)],Vars),"
The Guide simply says  $min(Var). I am still learning the syntax, and whatever I had tried generated an error.  

I see that  solve($[max(SumSides)],Vars),  will return 23, the highest total for a side.  My question about next highest total 

was trying to determine which other values are possible beside 13, 16 and 23, if any.

I'll give your code a run and try to figure out what's going on. 

[Hakan Kjellerstrand]

Hi Doug.

Here's a model that shows all possible values of LS (and thus RS and BS). solve_all/1 generates all the 6528 solutions, and then we pick the value of LS to show (sorted and with duplicates removed)

```

% Find all possible values of LS
go3 =>

  B = [B0, B1, B2, B3, B4, B5, B6, B7, B8, B9],
  B :: 0..9,
  all_different(B),

  Left     =  [B0 , B1 , B3 , B6],
  Right    =  [B0 , B2 , B5 , B9],
  Bottom   =  [B6 , B7 , B8 , B9],

  LS #= sum(Left),
  RS #= sum(Right),
  BS #= sum(Bottom),

  LS #= RS,
  RS #= BS,

  Sides = flatten([Left, Right, Bottom]),
  SumSides #= sum(Sides),

  Vars = B ++ [SumSides,LS], % produces Each side totals 17

  All=solve_all(Vars),
  println(all=[A.last : A in All].sort_remove_dups),
  nl.

```

Output:

all = [13,14,15,16,17,18,19,20,21,22,23]

/Hakan