4-rings or 4-squares puzzle: Difference between revisions
(Added Ruby) |
m (→{{header|Pascal}}: reduce LoDgt..HiDgt from : 0...31 to 0..9 to get 2860 solutions instead of 273328) |
||
Line 147: | Line 147: | ||
=={{header|Pascal}}== |
=={{header|Pascal}}== |
||
{{Incomplete|Pascal | <br> This solution doesn't show the result for the third task requirement. <br> <br> }} |
|||
{{works with|Free Pascal}} |
{{works with|Free Pascal}} |
||
There are so few solutions of 7 consecutive numbers, so I used a modified |
There are so few solutions of 7 consecutive numbers, so I used a modified version, to get all the expected solutions at once. |
||
<lang pascal>program square4; |
<lang pascal>program square4; |
||
{$MODE DELPHI} |
{$MODE DELPHI} |
||
Line 158: | Line 154: | ||
const |
const |
||
LoDgt = 0; |
LoDgt = 0; |
||
HiDgt = |
HiDgt = 9; |
||
type |
type |
||
tchkset = set of LoDgt..HiDgt; |
tchkset = set of LoDgt..HiDgt; |
||
Line 187: | Line 183: | ||
writeln; |
writeln; |
||
inc(mn); |
inc(mn); |
||
until mn> |
until mn > HiDgt-6; |
||
end; |
end; |
||
Line 302: | Line 298: | ||
9 6 4 5 3 7 8 |
9 6 4 5 3 7 8 |
||
⚫ | |||
4 ... 10 |
|||
⚫ | |||
9 8 5 4 6 7 10 |
|||
10 7 6 4 5 8 9 |
|||
⚫ | |||
⚫ | |||
real 0m0.024s</pre> |
|||
=={{header|Perl 6}}== |
=={{header|Perl 6}}== |
Revision as of 07:43, 21 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
Pascal
There are so few solutions of 7 consecutive numbers, so I used a modified version, to get all the expected solutions at once. <lang pascal>program square4; {$MODE DELPHI} {$R+,O+} const
LoDgt = 0; HiDgt = 9;
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 > HiDgt-6;
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 solution count for 0 to 9 = 2860 unique solution count for 0 to 9 = 192
Perl 6
<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 }
}
- 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). */
- =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.
Ruby
<lang ruby>def four_squares(low, high, unique=true, show=unique)
f = -> (a,b,c,d,e,f,g) {[a+b, b+c+d, d+e+f, f+g].uniq.size == 1} if unique uniq = "unique" solutions = [*low..high].permutation(7).select{|ary| f.call(*ary)} else uniq = "non-unique" solutions = [*low..high].repeated_permutation(7).select{|ary| f.call(*ary)} end if show puts " " + [*"a".."g"].join(" ") solutions.each{|ary| p ary} end puts "#{solutions.size} #{uniq} solutions in #{low} to #{high}" puts
end
[[1,7], [3,9]].each do |low, high|
four_squares(low, high)
end four_squares(0, 9, false)</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 solutions in 1 to 7 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 in 3 to 9 2860 non-unique solutions in 0 to 9
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.