4-rings or 4-squares puzzle: Difference between revisions
Thundergnat (talk | contribs) (→{{header|Perl 6}}: Add perl 6 example) |
(Added Algol 68) |
||
Line 39: | Line 39: | ||
<br><br> |
<br><br> |
||
=={{header|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> |
|||
{{out}} |
|||
<pre> |
|||
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 |
|||
</pre> |
|||
=={{header|Perl 6}}== |
=={{header|Perl 6}}== |
Revision as of 13:33, 2 January 2017
- 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
Perl 6
<lang perl6>sub MAIN ( Int :$lo!, Int :$hi!, :$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]; }
display() if so $show; count();
multi combos ( $ where so *.Bool ) { ($lo..$hi).combinations(7)».permutations.flat.rotor(7) }
multi combos ( $ where not *.Bool ) { [X] ($lo..$hi) xx 7 }
sub display { say ' ', join ' ', 'a'..'g'; .say for @solutions; say ; }
sub count { say +@solutions, ' ', ($unique ?? !! 'non-'), "unique solutions found using {join(', ', $lo..$hi)}."; }
}</lang>
- Output:
With parameters: --lo=1 --hi=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 using 1, 2, 3, 4, 5, 6, 7.
- Output:
With parameters: --lo=3 --hi=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 using 3, 4, 5, 6, 7, 8, 9.
- Output:
With parameters: --lo=0 --hi=9 --unique=0 --show=0
2860 non-unique solutions found using 0, 1, 2, 3, 4, 5, 6, 7, 8, 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). */
- =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
notUnic:=fcn(a,b,c,etc){ (abc:=vm.arglist).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){
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())) } println(solutions.len(),msg," solutions found.");
}
fourSquaresPuzzle() : show(_," unique (1-7)"); println(); fourSquaresPuzzle(3,9) : show(_," unique (3-9)"); println(); println(fourSquaresPuzzle(0,9,False).len(), // 10^7 possibilities
" non-unique (0-9) solutions found.");</lang>
- Output:
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 (1-7) 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 (3-9) solutions found. 2860 non-unique (0-9) solutions found.