4-rings or 4-squares puzzle

From Rosetta Code
Revision as of 15:22, 20 January 2017 by rosettacode>Horsth (inserted Pascal. Not really like the task discription)
4-rings or 4-squares puzzle is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.
Task

Replace       a, b, c, d, e, f,   and   g       with the decimal digits   LOW   ───►   HIGH
such that the sum of the letters inside of each of the four large squares add up to the same sum.

            ╔══════════════╗      ╔══════════════╗
            ║              ║      ║              ║
            ║      a       ║      ║      e       ║
            ║              ║      ║              ║
            ║          ┌───╫──────╫───┐      ┌───╫─────────┐
            ║          │   ║      ║   │      │   ║         │
            ║          │ b ║      ║ d │      │ f ║         │
            ║          │   ║      ║   │      │   ║         │
            ║          │   ║      ║   │      │   ║         │
            ╚══════════╪═══╝      ╚═══╪══════╪═══╝         │
                       │       c      │      │      g      │
                       │              │      │             │
                       │              │      │             │
                       └──────────────┘      └─────────────┘

Show all output here.


  •   Show all solutions for each letter being unique with
        LOW=1     HIGH=7
  •   Show all solutions for each letter being unique with
        LOW=3     HIGH=9
  •   Show only the   number   of solutions when each letter can be non-unique
        LOW=0     HIGH=9




ALGOL 68

As with the REXX solution, we use explicit loops to generate the permutations. <lang algol68>BEGIN

   # solve the 4 rings or 4 squares puzzle                                             #
   # we need to find solutions to the equations: a + b = b + c + d = d + e + f = f + g #
   # where a, b, c, d, e, f, g in lo : hi ( not necessarily unique )                   #
   # depending on show, the solutions will be printed or not                           #
   PROC four rings = ( INT lo, hi, BOOL unique, show )VOID:
   BEGIN
       INT  solutions := 0;
       BOOL allow duplicates = NOT unique;
       # calculate field width for printinhg solutions #
       INT  width := -1;
       INT  max := ABS IF ABS lo > ABS hi THEN lo ELSE hi FI;
       WHILE max > 0 DO
           width -:= 1;
           max OVERAB 10
       OD;
       # find solutions #
       FOR a FROM lo TO hi DO
           FOR b FROM lo TO hi DO
               IF allow duplicates OR a /= b THEN
                   INT t = a + b;
                   FOR c FROM lo TO hi DO
                       IF allow duplicates OR ( a /= c AND b /= c ) THEN
                           FOR d FROM lo TO hi DO
                               IF allow duplicates OR ( a /= d AND b /= d AND c /= d )
                               THEN
                                   IF b + c + d = t THEN
                                       FOR e FROM lo TO hi DO
                                           IF allow duplicates
                                           OR ( a /= e AND b /= e AND c /= e AND d /= e )
                                           THEN
                                               FOR f FROM lo TO hi DO
                                                   IF allow duplicates
                                                   OR ( a /= f AND b /= f AND c /= f AND d /= f AND e /= f )
                                                   THEN
                                                       IF d + e + f = t THEN
                                                           FOR g FROM lo TO hi DO
                                                               IF allow duplicates
                                                               OR ( a /= g AND b /= g AND c /= g AND d /= g AND e /= g AND f /= g )
                                                               THEN
                                                                   IF f + g = t THEN
                                                                       solutions +:= 1;
                                                                       IF show THEN
                                                                           print( ( whole( a, width ), whole( b, width )
                                                                                  , whole( c, width ), whole( d, width )
                                                                                  , whole( e, width ), whole( f, width )
                                                                                  , whole( g, width ), newline
                                                                                  )
                                                                                )
                                                                       FI
                                                                   FI
                                                               FI
                                                           OD # g #
                                                       FI
                                                   FI
                                               OD # f #
                                           FI
                                       OD # e #
                                   FI
                               FI
                           OD # d #
                       FI
                   OD # c #
               FI
           OD # b #
       OD # a # ;
       print( ( whole( solutions, 0 )
              , IF unique THEN " unique" ELSE " non-unique" FI
              , " solutions in "
              , whole( lo, 0 )
              , " to "
              , whole( hi, 0 )
              , newline
              , newline
              )
            )
   END # four rings # ;
   # find the solutions as required for the task #
   four rings( 1, 7, TRUE,  TRUE  );
   four rings( 3, 9, TRUE,  TRUE  );
   four rings( 0, 9, FALSE, FALSE )

END</lang>

Output:
 3 7 2 1 5 4 6
 4 5 3 1 6 2 7
 4 7 1 3 2 6 5
 5 6 2 3 1 7 4
 6 4 1 5 2 3 7
 6 4 5 1 2 7 3
 7 2 6 1 3 5 4
 7 3 2 5 1 4 6
8 unique solutions in 1 to 7

 7 8 3 4 5 6 9
 8 7 3 5 4 6 9
 9 6 4 5 3 7 8
 9 6 5 4 3 8 7
4 unique solutions in 3 to 9

2860 non-unique solutions in 0 to 9

Pascal

Works with: Free Pascal

There are so few solutions of 7 consecutive numbers, so I used a modified solution.

<lang pascal>program square4; {$MODE DELPHI} {$R+,O+} const

 LoDgt = 0;
 HiDgt = 31;

type

 tchkset = set of LoDgt..HiDgt;
 tSol = record
          solMin : integer;
          solDat : array[1..7] of integer;
        end;

var

 sum,a,b,c,d,e,f,g,cnt,uniqueCount : NativeInt;
 sol : array of tSol;

procedure SolOut; var

 i,j,mn: NativeInt;

Begin

 mn := 0;
 repeat
   writeln(mn:3,' ...',mn+6:3);
   For i := Low(sol) to High(sol) do
     with sol[i] do
       IF solMin = mn then
       Begin
         For j := 1 to 7 do
           write(solDat[j]:3);
         writeln;
       end;
   writeln;
   inc(mn);
 until mn> 4;

end;

function CheckUnique:Boolean; var

 i,sum,mn: NativeInt;
 chkset : tchkset;

Begin

 chkset:= [];
 include(chkset,a);include(chkset,b);include(chkset,c);
 include(chkset,d);include(chkset,e);include(chkset,f);
 include(chkset,g);
 sum := 0;
 For i := LoDgt to HiDgt do
   IF i in chkset then
     inc(sum);
 result := sum = 7;
 IF result then
 begin
   inc(uniqueCount);
   //find the lowest entry
   mn:= LoDgt;
   For i := LoDgt to HiDgt do
     IF i in chkset then
     Begin
       mn := i;
       BREAK;
     end;
   // are they consecutive
   For i := mn+1 to mn+6  do
     IF NOT(i in chkset) then
       EXIT;
   setlength(sol,Length(sol)+1);
   with sol[high(sol)] do
     Begin
       solMin:= mn;
       solDat[1]:= a;solDat[2]:= b;solDat[3]:= c;
       solDat[4]:= d;solDat[5]:= e;solDat[6]:= f;
       solDat[7]:= g;
     end;
 end;

end;

Begin

 cnt := 0;
 uniqueCount := 0;
 For a:= LoDgt to HiDgt do
 Begin
   For b := LoDgt to HiDgt do
   Begin
     sum := a+b;
     //a+b = b+c+d => a = c+d => d := a-c
     For c := a-LoDgt downto LoDgt do
     begin
       d := a-c;
       e := sum-d;
       IF e>HiDgt then
         e:= HiDgt;
       For e := e downto LoDgt do
         begin
         f := sum-e-d;
         IF f in [loDGt..Hidgt]then
         Begin
           g := sum-f;
           IF g in [loDGt..Hidgt]then
           Begin
             inc(cnt);
             CheckUnique;
           end;
         end;
       end;
     end;
   end;
 end;
 SolOut;
 writeln('       solution count for ',loDgt,' to ',HiDgt,' = ',cnt);
 writeln('unique solution count for ',loDgt,' to ',HiDgt,' = ',uniqueCount);

end.</lang>

Output:
  0 ...  6
  4  2  3  1  5  0  6
  5  1  3  2  4  0  6
  6  0  5  1  3  2  4
  6  0  4  2  3  1  5

  1 ...  7
  3  7  2  1  5  4  6
  4  5  3  1  6  2  7
  4  7  1  3  2  6  5
  5  6  2  3  1  7  4
  6  4  5  1  2  7  3
  6  4  1  5  2  3  7
  7  2  6  1  3  5  4
  7  3  2  5  1  4  6

  2 ...  8
  5  7  3  2  6  4  8
  5  8  3  2  4  7  6
  5  8  2  3  4  6  7
  6  7  4  2  3  8  5
  7  4  5  2  6  3  8
  7  6  4  3  2  8  5
  8  3  6  2  5  4  7
  8  4  6  2  3  7  5

  3 ...  9
  7  8  3  4  5  6  9
  8  7  3  5  4  6  9
  9  6  5  4  3  8  7
  9  6  4  5  3  7  8

  4 ... 10
  9  8  5  4  6  7 10
 10  7  6  4  5  8  9

       solution count for 0 to 31 = 273328
unique solution count for 0 to 31 = 142794

real    0m0.024s

Perl 6

Works with: Rakudo version 2016.12

<lang perl6>sub four-squares ( @list, :$unique=1, :$show=1 ) {

   my @solutions;
   for $unique.&combos -> @c {
       @solutions.push: @c if [==]
         @c[0] + @c[1],
         @c[1] + @c[2] + @c[3],
         @c[3] + @c[4] + @c[5],
         @c[5] + @c[6];
   }
   say +@solutions, ($unique ?? ' ' !! ' non-'), "unique solutions found using {join(', ', @list)}.\n";
   my $f = "%{@list.max.chars}s";
   say join "\n", (('a'..'g').fmt: $f), @solutions».fmt($f), "\n" if $show;
   multi combos ( $ where so * ) { @list.combinations(7).map: |*.permutations }
   multi combos ( $ where not * ) { [X] @list xx 7 }

}

  1. TASK

four-squares( [1..7] ); four-squares( [3..9] ); four-squares( [8, 9, 11, 12, 17, 18, 20, 21] ); four-squares( [0..9], :unique(0), :show(0) );</lang>

Output:
8 unique solutions found using 1, 2, 3, 4, 5, 6, 7.

a b c d e f g
3 7 2 1 5 4 6
4 5 3 1 6 2 7
4 7 1 3 2 6 5
5 6 2 3 1 7 4
6 4 1 5 2 3 7
6 4 5 1 2 7 3
7 2 6 1 3 5 4
7 3 2 5 1 4 6


4 unique solutions found using 3, 4, 5, 6, 7, 8, 9.

a b c d e f g
7 8 3 4 5 6 9
8 7 3 5 4 6 9
9 6 4 5 3 7 8
9 6 5 4 3 8 7


8 unique solutions found using 8, 9, 11, 12, 17, 18, 20, 21.

 a  b  c  d  e  f  g
17 21  8  9 11 18 20
20 18 11  9  8 21 17
17 21  9  8 12 18 20
20 18  8 12  9 17 21
20 18 12  8  9 21 17
21 17  9 12  8 18 20
20 18 11  9 12 17 21
21 17 12  9 11 18 20


2860 non-unique solutions found using 0, 1, 2, 3, 4, 5, 6, 7, 8, 9.

Python

<lang Python> import itertools

def all_equal(a,b,c,d,e,f,g):

   return a+b == b+c+d and a+b == d+e+f and a+b == f+g

def foursquares(lo,hi,unique,show):

   solutions = 0
   if unique:
       uorn = "unique"
       citer = itertools.combinations(range(lo,hi+1),7)
   else:
       uorn = "non-unique"
       citer =  itertools.combinations_with_replacement(range(lo,hi+1),7)
                   
   for c in citer:
           for p in set(itertools.permutations(c)):
               if all_equal(*p):
                   solutions += 1
                   if show:
                       print str(p)[1:-1]
   print str(solutions)+" "+uorn+" solutions in "+str(lo)+" to "+str(hi)
   print

</lang> Output

foursquares(1,7,True,True)
4, 5, 3, 1, 6, 2, 7
3, 7, 2, 1, 5, 4, 6
5, 6, 2, 3, 1, 7, 4
4, 7, 1, 3, 2, 6, 5
6, 4, 5, 1, 2, 7, 3
7, 3, 2, 5, 1, 4, 6
7, 2, 6, 1, 3, 5, 4
6, 4, 1, 5, 2, 3, 7
8 unique solutions in 1 to 7


foursquares(3,9,True,True)
7, 8, 3, 4, 5, 6, 9
9, 6, 4, 5, 3, 7, 8
8, 7, 3, 5, 4, 6, 9
9, 6, 5, 4, 3, 8, 7
4 unique solutions in 3 to 9


foursquares(0,9,False,False)
2860 non-unique solutions in 0 to 9

Faster solution without itertools <lang Python> def foursquares(lo,hi,unique,show):

   def acd_iter():
       """
       Iterates through all the possible valid values of 
       a, c, and d.
       
       a = c + d
       """
       for c in range(lo,hi+1):
           for d in range(lo,hi+1):
               if (not unique) or (c <> d):
                   a = c + d
                   if a >= lo and a <= hi:
                       if (not unique) or (c <> 0 and d <> 0):
                           yield (a,c,d)
                           
   def ge_iter():
       """
       Iterates through all the possible valid values of 
       g and e.
       
       g = d + e
       """
       for e in range(lo,hi+1):
           if (not unique) or (e not in (a,c,d)):
               g = d + e
               if g >= lo and g <= hi:
                   if (not unique) or (g not in (a,c,d,e)):
                       yield (g,e)
                       
   def bf_iter():
       """
       Iterates through all the possible valid values of 
       b and f.
       
       b = e + f - c
       """
       for f in range(lo,hi+1):
           if (not unique) or (f not in (a,c,d,g,e)):
               b = e + f - c
               if b >= lo and b <= hi:
                   if (not unique) or (b not in (a,c,d,g,e,f)):
                       yield (b,f)
   solutions = 0                    
   acd_itr = acd_iter()              
   for acd in acd_itr:
       a,c,d = acd
       ge_itr = ge_iter()
       for ge in ge_itr:
           g,e = ge
           bf_itr = bf_iter()
           for bf in bf_itr:
               b,f = bf
               solutions += 1
               if show:
                   print str((a,b,c,d,e,f,g))[1:-1]
   if unique:
       uorn = "unique"
   else:
       uorn = "non-unique"
              
   print str(solutions)+" "+uorn+" solutions in "+str(lo)+" to "+str(hi)
   print

</lang> Output

foursquares(1,7,True,True)
4, 7, 1, 3, 2, 6, 5
6, 4, 1, 5, 2, 3, 7
3, 7, 2, 1, 5, 4, 6
5, 6, 2, 3, 1, 7, 4
7, 3, 2, 5, 1, 4, 6
4, 5, 3, 1, 6, 2, 7
6, 4, 5, 1, 2, 7, 3
7, 2, 6, 1, 3, 5, 4
8 unique solutions in 1 to 7


foursquares(3,9,True,True)
7, 8, 3, 4, 5, 6, 9
8, 7, 3, 5, 4, 6, 9
9, 6, 4, 5, 3, 7, 8
9, 6, 5, 4, 3, 8, 7
4 unique solutions in 3 to 9


foursquares(0,9,False,False)
2860 non-unique solutions in 0 to 9

REXX

<lang rexx>/*REXX pgm solves the 4-rings puzzle, where letters represent unique (or not) digits). */ arg LO HI unique show . /*the ARG statement capitalizes args.*/ if LO== | LO=="," then LO=1 /*Not specified? Then use the default.*/ if HI== | HI=="," then HI=7 /* " " " " " " */ if unique== | unique==',' | unique=='UNIQUE' then unique=1 /*unique letter solutions*/

                                               else unique=0  /*non-unique        "    */

if show== | show==',' | show=='SHOW' then show=1 /*noshow letter solutions*/

                                               else show=0    /*  show    "       "    */

w=max(3, length(LO), length(HI) ) /*maximum width of any number found. */ bar=copies('═', w) /*define a horizontal bar (for title). */

  1. =0 /*number of solutions found (so far). */
      do a=LO    to HI
         do b=LO  to HI
         if unique  then  if b==a  then  iterate
            do c=LO  to HI
            if unique  then  do;  if c==a  then  iterate
                                  if c==b  then  iterate
                             end
               do d=LO  to HI
               if unique  then  do;  if d==a  then  iterate
                                     if d==b  then  iterate
                                     if d==c  then  iterate
                                end
                  do e=LO  to HI
                  if unique  then  do;  if e==a  then  iterate
                                        if e==b  then  iterate
                                        if e==c  then  iterate
                                        if e==d  then  iterate
                                   end
                     do f=LO  to HI
                     if unique  then  do;  if f==a  then  iterate
                                           if f==b  then  iterate
                                           if f==c  then  iterate
                                           if f==d  then  iterate
                                           if f==e  then  iterate
                                      end
                        do g=LO  to HI
                        if unique  then  do;  if g==a  then  iterate
                                              if g==b  then  iterate
                                              if g==c  then  iterate
                                              if g==d  then  iterate
                                              if g==e  then  iterate
                                              if g==f  then  iterate
                                         end
                        sum=a+b
                        if   f+g\==sum  then  iterate
                        if b+c+d\==sum  then  iterate
                        if d+e+f\==sum  then  iterate
                        #=# + 1                          /*bump the count of solutions.*/
                        if #==1  then call align  'a',  'b',  'c',  'd',  'e',  'f',  'g'
                        if #==1  then call align  bar,  bar,  bar,  bar,  bar,  bar,  bar
                                      call align   a,    b,    c,    d,    e,    f,    g 
                        end   /*g*/
                     end      /*f*/
                  end         /*e*/
               end            /*d*/
            end               /*c*/
         end                  /*b*/
      end                     /*a*/

say

                _= ' non-unique'

if unique then _= ' unique ' say # _ 'solutions found.' exit /*stick a fork in it, we're all done. */ /*──────────────────────────────────────────────────────────────────────────────────────*/ align: parse arg a1,a2,a3,a4,a5,a6,a7

      if show  then say left(,9)   center(a1,w) center(a2,w) center(a3,w) center(a4,w),
                                     center(a5,w) center(a6,w) center(a7,w)
      return</lang>

output   when using the default inputs:     1   7

           a   b   c   d   e   f   g
          ═══ ═══ ═══ ═══ ═══ ═══ ═══
           3   7   2   1   5   4   6
           4   5   3   1   6   2   7
           4   7   1   3   2   6   5
           5   6   2   3   1   7   4
           6   4   1   5   2   3   7
           6   4   5   1   2   7   3
           7   2   6   1   3   5   4
           7   3   2   5   1   4   6

8  unique  solutions found.

output   when using the input of:     3   9

           a   b   c   d   e   f   g
          ═══ ═══ ═══ ═══ ═══ ═══ ═══
           7   8   3   4   5   6   9
           8   7   3   5   4   6   9
           9   6   4   5   3   7   8
           9   6   5   4   3   8   7

4  unique  solutions found.

output   when using the input of:     0   9   non-unique   noshow

2860  non-unique solutions found.

zkl

<lang zkl> // unique: No repeated numbers in solution fcn fourSquaresPuzzle(lo=1,hi=7,unique=True){ //-->list of solutions

  _assert_(0<=lo and hi<36);
  notUnic:=fcn(a,b,c,etc){ abc:=vm.arglist; // use base 36, any repeated character?
     abc.apply("toString",36).concat().unique().len()!=abc.len()
  };
  s:=List();		// solutions
  foreach a,b,c in ([lo..hi],[lo..hi],[lo..hi]){ // chunk to reduce unique
     if(unique and notUnic(a,b,c)) continue;     // solution space. Slow VM
     foreach d,e in ([lo..hi],[lo..hi]){	  // -->for d { for e {} }
        if(unique and notUnic(a,b,c,d,e)) continue;

foreach f,g in ([lo..hi],[lo..hi]){ if(unique and notUnic(a,b,c,d,e,f,g)) continue; sqr1,sqr2,sqr3,sqr4 := a+b,b+c+d,d+e+f,f+g; if((sqr1==sqr2==sqr3) and sqr1==sqr4) s.append(T(a,b,c,d,e,f,g)); }

     }
  }
  s

}</lang> <lang zkl>fcn show(solutions,msg){

  if(not solutions){ println("No solutions for",msg); return(); }
  println(solutions.len(),msg," solutions found:");
  w:=(1).max(solutions.pump(List,(0).max,"numDigits")); // max width of any number found
  fmt:=" " + "%%%ds ".fmt(w)*7;  // eg " %1s %1s %1s %1s %1s %1s %1s"
  println(fmt.fmt(["a".."g"].walk().xplode()));
  println("-"*((w+1)*7 + 1));	  // calculate the width of horizontal bar
  foreach s in (solutions){ println(fmt.fmt(s.xplode())) }

} fourSquaresPuzzle() : show(_," unique (1-7)"); println(); fourSquaresPuzzle(3,9) : show(_," unique (3-9)"); println(); fourSquaresPuzzle(5,12) : show(_," unique (5-12)"); println(); println(fourSquaresPuzzle(0,9,False).len(), // 10^7 possibilities

  " non-unique (0-9) solutions found.");</lang>
Output:
8 unique (1-7) solutions found:
 a b c d e f g 
---------------
 3 7 2 1 5 4 6 
 4 5 3 1 6 2 7 
 4 7 1 3 2 6 5 
 5 6 2 3 1 7 4 
 6 4 1 5 2 3 7 
 6 4 5 1 2 7 3 
 7 2 6 1 3 5 4 
 7 3 2 5 1 4 6 

4 unique (3-9) solutions found:
 a b c d e f g 
---------------
 7 8 3 4 5 6 9 
 8 7 3 5 4 6 9 
 9 6 4 5 3 7 8 
 9 6 5 4 3 8 7 

4 unique (5-12) solutions found:
  a  b  c  d  e  f  g 
----------------------
 11  9  6  5  7  8 12 
 11 10  6  5  7  9 12 
 12  8  7  5  6  9 11 
 12  9  7  5  6 10 11 

2860 non-unique (0-9) solutions found.