Anonymous user
4-rings or 4-squares puzzle: Difference between revisions
no edit summary
m (→{{header|jq}}: tidy) |
imported>Chinhouse No edit summary |
||
| (33 intermediate revisions by 18 users not shown) | |||
Line 47:
{{trans|Python}}
<
V solutions = 0
L(c) lo .. hi
Line 76:
foursquares(1, 7, 1B, 1B)
foursquares(3, 9, 1B, 1B)
foursquares(0, 9, 0B, 0B)</
{{out}}
Line 101:
=={{header|AArch64 Assembly}}==
{{works with|as|Raspberry Pi 3B version Buster 64 bits}}
<syntaxhighlight lang="aarch64 assembly">
/* ARM assembly AARCH64 Raspberry PI 3B */
/* program square4_64.s */
Line 504:
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"
</syntaxhighlight>
{{out}}
<pre>
Line 538:
Number of solutions : 2860
</pre>
=={{header|Action!}}==
{{Trans|ALGOL 68}}
<syntaxhighlight lang="action!">
;;; solve the 4 rings or 4 squares puzzle
DEFINE TRUE = "1", FALSE = "0"
;;; finds 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 fourRings( INT lo, hi BYTE allowDuplicates, show )
INT solutions, t, a, b, c, d, e, f, g, uniqueOrNot
solutions = 0
FOR a = lo TO hi DO
FOR b = lo TO hi DO
IF allowDuplicates OR a <> b THEN
t = a + b
FOR c = lo TO hi DO
IF allowDuplicates OR ( a <> c AND b <> c ) THEN
d = t - ( b + c )
IF d >= lo AND d <= hi
AND ( allowDuplicates OR ( a <> d AND b <> d AND c <> d ) )
THEN
FOR e = lo TO hi DO
IF allowDuplicates
OR ( a <> e AND b <> e AND c <> e AND d <> e )
THEN
g = d + e
f = t - g
IF f >= lo AND f <= hi
AND g >= lo AND g <= hi
AND ( allowDuplicates
OR ( a <> f AND b <> f AND c <> f
AND d <> f AND e <> f
AND a <> g AND b <> g AND c <> g
AND d <> g AND e <> g AND f <> g
)
)
THEN
solutions ==+ 1
IF show THEN
PrintF( " %U %U %U %U", a, b, c, d )
PrintF( " %U %U %U%E", e, f, g )
FI
FI
FI
OD
FI
FI
OD
FI
OD
OD
IF allowDuplicates
THEN uniqueOrNot = "non-unique"
ELSE uniqueOrNot = "unique"
FI
PrintF( "%U %S solutions in %U to %U%E%E", solutions, uniqueOrNot, lo, hi )
RETURN
;;; find the solutions as required for the task
PROC Main()
fourRings( 1, 7, FALSE, TRUE )
fourRings( 3, 9, FALSE, TRUE )
fourRings( 0, 9, TRUE, FALSE )
RETURN
</syntaxhighlight>
{{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|Ada}}==
<
procedure Puzzle_Square_4 is
Line 608 ⟶ 698:
Four_Rings (Low => 3, High => 9, Unique => True, Show => True);
Four_Rings (Low => 0, High => 9, Unique => False, Show => False);
end Puzzle_Square_4;</
{{out}}
Line 632 ⟶ 722:
=={{header|ALGOL 68}}==
As with the REXX solution, we use explicit loops to generate the permutations.
<
# 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
BEGIN
INT solutions := 0;
# calculate field width for printinhg solutions #
INT width := -1;
Line 655 ⟶ 744:
FOR c FROM lo TO hi DO
IF allow duplicates OR ( a /= c AND b /= c ) THEN
AND ( allow
OR ( a /=
IF allow
OR ( a /= e AND b /= e AND c /=
INT g
INT f = t -
IF f >= lo
AND g >= lo
AND (
OR (
AND d /= f AND e /=
AND a /= g AND b /= g AND c
AND d /= g AND e /= g AND f
solutions +:=
IF show
print( ( whole( a, width ), whole( b,
, whole( c, width ), whole( d,
, whole( e, width ), whole( f, width
, whole( g, width ),
FI
FI
FI
OD # c #
Line 699 ⟶ 785:
OD # a # ;
print( ( whole( solutions, 0 )
, IF
, " solutions in "
, whole( lo, 0 )
Line 711 ⟶ 797:
# find the solutions as required for the task #
four rings( 1, 7,
four rings( 3, 9,
four rings( 0, 9,
END</
{{out}}
<pre>
Line 734 ⟶ 820:
2860 non-unique solutions in 0 to 9
</pre>
=={{header|ALGOL W}}==
{{Trans|ALGOL 68}}
<syntaxhighlight lang="ada">begin % -- solve the 4 rings or 4 squares puzzle i.e., 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 %
procedure fourRings ( integer value lo, hi; logical value allowDuplicates, show ) ;
begin
integer solutions, width, maxLimit;
solutions := 0;
% -- calculate field width for printinhg solutions %
width := 1;
maxLimit := abs ( if abs lo > abs hi then lo else hi );
while maxLimit > 0 do begin
width := width + 1;
maxLimit := maxLimit div 10
end while_maxLimit_gt_0 ;
% -- find solutions %
for a := lo until hi do begin
for b := lo until hi do begin
if allowduplicates or a not = b then begin
integer t;
t := a + b;
for c := lo until hi do begin
if allowDuplicates
or ( a not = c and b not = c )
then begin
integer d;
d := t - ( b + c );
if d >= lo and d <= hi
and ( allowduplicates
or ( a not = d and b not = d and c not = d )
)
then begin
for e := lo until hi do begin
if allowDuplicates
or ( a not = e and b not = e and c not = e and d not = e )
then begin
integer f, g;
g := d + e;
f := t - g;
if f >= lo and f <= hi
and g >= lo and g <= hi
and ( allowDuplicates
or ( a not = f and b not = f and c not = f
and d not = f and e not = f
and a not = g and b not = g and c not = g
and d not = g and e not = g and f not = g
)
)
then begin
solutions := solutions + 1;
if show then write( i_w := width, s_w := 0, a, b, c, d, e, f, g )
end
end
end for_e
end
end
end for_c
end
end for_b
end for_a ;
write( i_w := 1, s_w := 0, solutions, if allowDuplicates then " non-unique" else " unique", " solutions in ", lo, " to ", hi );
write()
end % -- fourRings % ;
% -- find the solutions as required for the task %
fourRings( 1, 7, false, true );
fourRings( 3, 9, false, true );
fourRings( 0, 9, true, false )
end.</syntaxhighlight>
{{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>
Line 740 ⟶ 919:
{{Trans|Haskell}}
(Structured search example)
<
on run
Line 1,046 ⟶ 1,225:
on unlines(xs)
intercalate(linefeed, xs)
end unlines</
{{Out}}
<pre>rings(true, enumFromTo(1, 7))
Line 1,070 ⟶ 1,249:
2860</pre>
=={{header|Applesoft BASIC}}==
{{trans|C}}
<syntaxhighlight lang="gwbasic"> 100 TRUE = NOT FALSE
110 PLO = 1:PHI = 7:PUNIQUE = TRUE:PSHOW = TRUE: GOSUB 150"FOURSQUARES"
120 PLO = 3:PHI = 9:PUNIQUE = TRUE:PSHOW = TRUE: GOSUB 150"FOURSQUARES"
130 PLO = 0:PHI = 9:PUNIQUE = FALSE:PSHOW = FALSE: GOSUB 150"FOURSQUARES"
140 END
150 LO = PLO
160 HI = PHI
170 UNIQUE = PUNIQUE
180 SHOW = PSHOW
190 S = 0: REM SOLUTIONS
200 PRINT
210 GOSUB 270"ACD"
220 PRINT
230 PRINT S" ";
240 IF NOT UNIQUE THEN PRINT "NON-";
250 PRINT "UNIQUE SOLUTIONS IN "LO" TO "HI
260 RETURN
270 FOR C = LO TO HI
280 FOR D = LO TO HI
290 IF ( NOT UNIQUE) OR (C < > D) THEN A = C + D: IF (A > = LO) AND (A < = HI) AND (( NOT UNIQUE) OR ((C < > 0) AND (D < > 0))) THEN GOSUB 320"GE"
300 NEXT D,C
310 RETURN
320 FOR E = LO TO HI
330 IF ( NOT UNIQUE) OR ((E < > A) AND (E < > C) AND (E < > D)) THEN G = D + E: IF (G > = LO) AND (G < = HI) AND (( NOT UNIQUE) OR ((G < > A) AND (G < > C) AND (G < > D) AND (G < > E))) THEN GOSUB 360"BF"
340 NEXT E
350 RETURN
360 FOR F = LO TO HI
370 IF (( NOT UNIQUE) OR ((F < > A) AND (F < > C) AND (F < > D) AND (F < > G) AND (F < > E))) THEN GOSUB 400
380 NEXT F
390 RETURN
400 B = E + F - C: IF ((B > = LO) AND (B < = HI) AND (( NOT UNIQUE) OR ((B < > A) AND (B < > C) AND (B < > D) AND (B < > G) AND (B < > E) AND (B < > F)))) THEN S = S + 1: IF (SHOW) THEN PRINT A" "B" "C" "D" "E" "F" "G
410 RETURN</syntaxhighlight>
=={{header|ARM Assembly}}==
{{works with|as|Raspberry Pi}}
<syntaxhighlight lang="arm assembly">
/* ARM assembly Raspberry PI */
Line 1,511 ⟶ 1,724:
iMagicNumber: .int 0xCCCCCCCD
</syntaxhighlight>
{{out}}
Line 1,557 ⟶ 1,770:
Number of solutions :2860
</pre>
=={{header|AutoHotkey}}==
<syntaxhighlight lang="autohotkey">
rotina(min,max,unique)
{
global totalcount := 0
global totalunique := 0
global result := "min=" min " max=" max " unique=" unique "`n`n"
max := max - min + 1
loop %max%
{
a := min + A_Index - 1
loop %max%
{
b := min + A_Index - 1
loop %max%
{
c := min + A_Index - 1
loop %max%
{
d := min + A_Index - 1
loop %max%
{
e := min + A_Index - 1
loop %max%
{
f := min + A_Index - 1
loop %max%
{
g := min + A_Index - 1
sum := a+b
if (b+c+d = sum and d+e+f = sum and f+g = sum)
{
totalcount += 1
if (unique=0)
continue
if not (a=b or a=c or a=d or a=e or a=f or a=g or b=c or b=d or b=e or b=f or b=g or c=d or c=e or c=f or c=g or d=e or d=f or d=g or e=f or e=g or f=g)
{
result .= a " " b " " c " " d " " e " " f " " g "`n"
totalunique += 1
}
}
}
}
}
}
}
}
}
}
rotina(1,7,1)
MsgBox %result% `ntotal unique = %totalunique% `ntotalcount = %totalcount%
rotina(3,9,1)
MsgBox %result% `ntotal unique = %totalunique% `ntotalcount = %totalcount%
rotina(0,9,0)
MsgBox %result% `ntotalcount = %totalcount%
ExitApp
return
</syntaxhighlight>
{{Output}}
<pre>
min=1 max=7 unique=1
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
total unique = 8
totalcount = 497
---------------------------
OK
---------------------------
min=3 max=9 unique=1
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
total unique = 4
totalcount = 180
---------------------------
OK
---------------------------
min=0 max=9 unique=0
totalcount = 2860
---------------------------
OK
---------------------------
</pre>
=={{header|AWK}}==
<syntaxhighlight lang="awk">
# syntax: GAWK -f 4-RINGS_OR_4-SQUARES_PUZZLE.AWK
# converted from C
Line 1,627 ⟶ 1,937:
}
}
</syntaxhighlight>
{{out}}
<pre>
Line 1,657 ⟶ 1,967:
</pre>
=={{header|
<syntaxhighlight lang="vb">call four_square(1, 7, TRUE, TRUE)
call four_square(3, 9, TRUE, TRUE)
call four_square(0, 9, FALSE, FALSE)
end
subroutine four_square(low, high, unique, show)
total = 0
if show then print " a b c d e f g" + chr(10) + " ============="
for a = low to high
for b = low to high
if unique and b = a then continue for
t = a + b
for c = low to high
if unique then
if c = a or c = b then continue for
end if
for d = low to high
if unique then
if d = a or d = b or d = c then continue for
end if
if b + c + d = t then
for e = low to high
if unique then
if e = a or e = b or e = c or e = d then continue for
end if
for f = low to high
if unique then
if f = a or f = b or f = c or f = d or f = e then continue for
end if
if d + e + f = t then
for g = low to high
if unique then
if g = a or g = b or g = c or g = d or g = e or g = f then continue for
end if
if f + g = t then
total += 1
if show then print " ";a;" ";b;" ";c;" ";d;" ";e;" ";f;" ";g
end if
next g
end if
next f
next e
end if
next d
next c
next b
next a
print
if unique then
print "There are ";total;" unique solutions in [";string(low);", ";string(high);"]"
else
print "There are ";total;" non-unique solutions in [";string(low);", ";string(high);"]"
end if
print
end subroutine</syntaxhighlight>
=={{header|Befunge}}==
This is loosely based on the [[4-rings_or_4-squares_puzzle#C|C]] algorithm, although many of the conditions have been combined to minimize branching. There is no option to choose whether the results are displayed or not - unique solutions are always displayed, and non-unique solutions just return the solution count.
<
v!g03!:\*`\g01\!`\g00:p05:+g03:p04:_$30g1+:10g\`v1g<,+$p02%2_|#`*8<
>>+\30g-!+20g*!*00g\#v_$40g1+:10g\`^<<1g00p03<<<_$55+:,\."snoitul"v
Line 1,668 ⟶ 2,037:
>0g50g.......55+,0vg02+1_80g1+:10g\`!^>>:80p60g+30g-:90p::00g\`!>>v
^9g03g04g06g08g07<_>>0>>^<<*!*g02++!-g07\+!-g06\+!-g05\+!-g04\!-<<\
>>10g\`*\:::::30g-!\40g-!+\50g-!+\60g-!+\70g-!+\80g-!+80g::::30g^^></
{{out}}
Line 1,706 ⟶ 2,075:
=={{header|C}}==
<syntaxhighlight lang="c">
#include <stdio.h>
Line 1,790 ⟶ 2,159:
foursquares(0,9,FALSE,FALSE);
}
</syntaxhighlight>
Output
<pre>
Line 1,818 ⟶ 2,187:
=={{header|C sharp|C#}}==
{{trans|Java}}
<
using System.Linq;
Line 1,879 ⟶ 2,248:
}
}
}</
{{out}}
<pre>a b c d e f g
Line 1,900 ⟶ 2,269:
=={{header|C++}}==
<
//C++14/17
#include <algorithm>//std::for_each
Line 1,994 ⟶ 2,363:
return 0;
}
</syntaxhighlight>
Output
<pre>
Line 2,016 ⟶ 2,385:
</pre>
=={{header|Chipmunk Basic}}==
{{works with|Chipmunk Basic|3.6.4}}
{{trans|Applesoft BASIC}}
<syntaxhighlight lang="qbasic">10 plo = 1 : phi = 7 : punique = true : pshow = true : gosub 50 : rem "FOURSQUARES"
20 plo = 3 : phi = 9 : punique = true : pshow = true : gosub 50 : rem "FOURSQUARES"
30 plo = 0 : phi = 9 : punique = false : pshow = false : gosub 50 : rem "FOURSQUARES"
40 end
50 lo = plo
60 hi = phi
70 unique = punique
80 show = pshow
90 s = 0 : rem SOLUTIONS
100 print
110 gosub 170 : rem "ACD"
120 print
130 print s " ";
140 if not unique then print "NON-";
150 print "UNIQUE SOLUTIONS IN " lo " TO " hi
160 return
170 for c = lo to hi
180 for d = lo to hi
190 if ( not unique) or (c <> d) then
200 a = c+d
210 if (a >= lo) and (a <= hi) and (( not unique) or ((c <> 0) and (d <> 0))) then gosub 250 : rem "GE"
220 endif
230 next d,c
240 return
250 for e = lo to hi
260 if ( not unique) or ((e <> a) and (e <> c) and (e <> d)) then
270 g = d+e
280 if (g >= lo) and (g <= hi) and (( not unique) or ((g <> a) and (g <> c) and (g <> d) and (g <> e))) then gosub 320 : rem "BF"
290 endif
300 next e
310 return
320 for f = lo to hi
330 if (( not unique) or ((f <> a) and (f <> c) and (f <> d) and (f <> g) and (f <> e))) then gosub 360
340 next f
350 return
360 b = e+f-c
370 if ((b >= lo) and (b <= hi) and (( not unique) or ((b <> a) and (b <> c) and (b <> d) and (b <> g) and (b <> e) and (b <> f)))) then
380 s = s+1
390 if (show) then print a " " b " " c " " d " " e " " f " " g
400 endif
410 return</syntaxhighlight>
{{out}}
<pre>>run
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
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|Clojure}}==
<
(defn rings [r & {:keys [unique] :or {unique true}}]
Line 2,028 ⟶ 2,465:
(for [[a b c d e f g] (rings (range low (inc high)) :unique unique)
:when (= (+ a b) (+ b c d) (+ d e f) (+ f g))] [a b c d e f g]))
</syntaxhighlight>
{{out}}
Line 2,052 ⟶ 2,489:
=={{header|Common Lisp}}==
<
(defpackage four-rings
(:use common-lisp)
Line 2,088 ⟶ 2,525:
(format t "Number of solutions for Low 0, High 9 non-unique:~%~A~%"
(length (four-rings-solutions 0 9 nil)))))
</syntaxhighlight>
Output:
<pre>
Line 2,117 ⟶ 2,554:
=={{header|Crystal}}==
{{trans|Ruby}}
<
a, b, c, d, e, f, g = list
first = a + b
Line 2,143 ⟶ 2,580:
four_squares(low, high)
end
four_squares(0, 9, false)</
=={{header|D}}==
<
void main() {
Line 2,208 ⟶ 2,645:
}
return true;
}</
{{out}}
Line 2,230 ⟶ 2,667:
=={{header|Delphi}}==
See [[#Pascal]]
=={{header|EasyLang}}==
{{trans|AWK}}
<syntaxhighlight lang=easylang>
func ok v t[] .
for h in t[]
if v = h
return 0
.
.
return 1
.
proc four lo hi uni show . .
#
subr bf
for f = lo to hi
if uni = 0 or ok f [ a c d g e ] = 1
b = e + f - c
if b >= lo and b <= hi and (uni = 0 or ok b [ a c d g e f ] = 1)
solutions += 1
if show = 1
for h in [ a b c d e f g ]
write h & " "
.
print ""
.
.
.
.
.
subr ge
for e = lo to hi
if uni = 0 or ok e [ a c d ] = 1
g = d + e
if g >= lo and g <= hi and (uni = 0 or ok g [ a c d e ] = 1)
bf
.
.
.
.
subr acd
for c = lo to hi
for d = lo to hi
if uni = 0 or c <> d
a = c + d
if a >= lo and a <= hi and (uni = 0 or c <> 0 and d <> 0)
ge
.
.
.
.
.
print "low:" & lo & " hi:" & hi & " unique:" & uni
acd
print solutions & " solutions"
print ""
.
four 1 7 1 1
four 3 9 1 1
four 0 9 0 0
</syntaxhighlight>
=={{header|F_Sharp|F#}}==
<
(* A simple function to generate the sequence
Nigel Galloway: January 31st., 2017 *)
Line 2,239 ⟶ 2,738:
seq{for a in n .. g do for b in n .. g do if (a+b) = x then for c in n .. g do if (b+c+d) = x then yield b} |> Seq.collect(fun b ->
seq{for f in n .. g do for G in n .. g do if (f+G) = x then for e in n .. g do if (f+e+d) = x then yield f} |> Seq.map(fun f -> {d=d;x=x;b=b;f=f}))))
</syntaxhighlight>
Then:
<
printfn "%d" (Seq.length (N 0 9))
</syntaxhighlight>
{{out}}
<pre>
2860
</pre>
<
(* A simple function to generate the sequence with unique values
Nigel Galloway: January 31st., 2017 *)
Line 2,256 ⟶ 2,755:
seq{for a in n .. g do if a <> d then for b in n .. g do if (a+b) = x && b <> a && b <> d then for c in n .. g do if (b+c+d) = x && c <> d && c <> a && c <> b then yield b} |> Seq.collect(fun b ->
seq{for f in n .. g do if f <> d && f <> b && f <> (x-b) && f <> (x-d-b) then for G in n .. g do if (f+G) = x && G <> d && G <> b && G <> f && G <> (x-b) && G <> (x-d-b) then for e in n .. g do if (f+e+d) = x && e <> d && e <> b && e <> f && e <> G && e <> (x-b) && e <> (x-d-b) then yield f} |> Seq.map(fun f -> {d=d;x=x;b=b;f=f}))))
</syntaxhighlight>
Then:
<
for n in N 1 7 do printfn "%d,%d,%d,%d,%d,%d,%d" (n.x-n.b) n.b (n.x-n.d-n.b) n.d (n.x-n.d-n.f) n.f (n.x-n.f)
</syntaxhighlight>
{{out}}
<pre>
Line 2,273 ⟶ 2,772:
</pre>
and:
<
for n in N 3 9 do printfn "%d,%d,%d,%d,%d,%d,%d" (n.x-n.b) n.b (n.x-n.d-n.b) n.d (n.x-n.d-n.f) n.f (n.x-n.f)
</syntaxhighlight>
{{out}}
<pre>
Line 2,288 ⟶ 2,787:
<code>bag-of</code> is a combinator (higher-order function) that yields <i>every</i> solution in a collection. If we had written <code>4-rings</code> without using <code>bag-of</code>, it would have returned only the first solution it found.
<
math.ranges prettyprint sequences sequences.generalizations
sets ;
Line 2,312 ⟶ 2,811:
1 7 t report
3 9 t report
0 9 f report</
{{out}}
<pre>
Line 2,341 ⟶ 2,840:
One could abandon the use of the named variables in favour of manipulating the array equivalent, and indeed develop code which performs the nested loops via messing with the array, but for simplicity, the individual variables are used. However, tempting though it is to write a systematic sequence of seven nested DO-loops, the variables are not in fact all independent: some are fixed once others are chosen. Just cycling through all the notional possibilities when one only is in fact possible is a bit too much brute-force-and-ignorance, though other problems with other constraints, may encourage such exhaustive stepping. As a result, the code is more tightly bound to the specific features of the problem.
Also standardised in F90 is the $ format code, which specifies that the output line is not to end with the WRITE statement. The problem here is that Fortran does not offer an IF ...FI bracketing construction inside an expression, that would allow something like <
So, a two-part output, and to reduce the blather, two IF-statements. <
Choose values such that A+B = B+C+D = D+E+F = F+G, all being integers in FIRST:LAST...
INTEGER FIRST,LAST !The range of allowed values.
Line 2,390 ⟶ 2,889:
CALL FOURSHOW(0,9,.FALSE.)
END </
Output: not in a neat order because the first variable is not determined first.
<pre>
Line 2,466 ⟶ 2,965:
=={{header|FreeBASIC}}==
<
' compile with: fbc -s console
Line 2,556 ⟶ 3,055:
Print : Print "hit any key to end program"
Sleep
End</
{{out}}
<pre> a b c d e f g
Line 2,584 ⟶ 3,083:
2860 Non unique solutions for 0 to 9
----------------------------------------</pre>
=={{header|FutureBasic}}==
This simple example uses old-style, length-limited Pascal strings for formatting to make it easier to compare with similar code posted here for this task. However, FB more commonly uses Apple's modern and superior Core Foundation strings.
<syntaxhighlight lang="futurebasic">
local fn FourRings( low as long, high as long, unique as BOOL, show as BOOL )
long a, b, c, d, e, f, g
unsigned long t, total = 0
unsigned long l = len$( str$(high) )
if l < len$( str$(low) ) then l = len$( str$( low) )
if ( show == YES )
for a = 97 to 103
print space$(l); chr$(a);
next
print
print " "; string$( ( l + 1 ) * 7, "-" );
print
end if
for a = low to high
for b = low to high
if ( unique == YES )
if b == a then continue
end if
t = a + b
for c = low to high
if unique == YES
if c == a or c == b then continue
end if
for d = low to high
if unique == YES
if d == a or d == b or d == c then continue
end if
if b + c + d == t
for e = low to high
if unique == YES
if e == a or e == b or e == c or e == d then continue
end if
for f = low to high
if unique == YES
if f == a or f == b or f == c or f == d or f == e then continue
end if
if ( d + e + f == t )
for g = low to high
if unique == YES
if g == a or g == b or g == c or g == d or g == e or g == f then continue
end if
if ( f + g == t )
total += 1
if( show == YES )
printf @"%3d%3d%3d%3d%3d%3d%3d", a, b, c, d, e, f, g
end if
end if
next
end if
next
next
end if
next
next
next
next
if ( unique == YES )
print
print total; " unique solutions for"; str$(low); " to"; str$(high)
print string$(30, "-") : print
else
print total; " non-unique solutions for"; str$(low); " to"; str$(high)
print string$(36, "-") : print
end if
end fn
window 1, @"4 Rings", ( 0, 0, 350, 400 )
fn FourRings( 1, 7, YES, YES )
fn FourRings( 3, 9, YES, YES )
fn FourRings( 0, 9, NO, NO )
HandleEvents
</syntaxhighlight>
For interest, the following solution uses CoreFoundation (CF) strings.
<syntaxhighlight lang="futurebasic">local fn FourRings( low as long, high as long, unique as BOOL, show as BOOL )
long a, b, c, d, e, f, g
long t, total = 0
long l = len(str(high))
if ( l < len(str(low)) ) then l = len(str(low))
if ( show )
for a = 97 to 103
print space(l);fn StringWithCharacters( @a, 1 );
next
print
print @" ";fn StringByPaddingToLength( @"", ( l + 1 ) * 7, @"-", 0 )
end if
for a = low to high
for b = low to high
if ( unique )
if ( b == a ) then continue
end if
t = a + b
for c = low to high
if ( unique )
if ( c == a or c == b ) then continue
end if
for d = low to high
if ( unique )
if ( d == a or d == b or d == c ) then continue
end if
if ( b + c + d == t )
for e = low to high
if ( unique )
if ( e == a or e == b or e == c or e == d ) then continue
end if
for f = low to high
if ( unique )
if ( f == a or f == b or f == c or f == d or f == e ) then continue
end if
if ( d + e + f == t )
for g = low to high
if ( unique )
if ( g == a or g == b or g == c or g == d or g == e or g == f ) then continue
end if
if ( f + g == t )
total += 1
if ( show )
printf @"%3d%3d%3d%3d%3d%3d%3d", a, b, c, d, e, f, g
end if
end if
next
end if
next
next
end if
next
next
next
next
if ( unique )
print
print total;@" unique solutions for ";low;@" to ";high
print fn StringByPaddingToLength( @"", 30, @"-", 0 )
print
else
print total;@" non-unique solutions for ";low;@" to ";high
print fn StringByPaddingToLength( @"", 37, @"-", 0 )
print
end if
end fn
window 1, @"4 Rings", ( 0, 0, 350, 400 )
fn FourRings( 1, 7, YES, YES )
fn FourRings( 3, 9, YES, YES )
fn FourRings( 0, 9, NO, NO )
HandleEvents</syntaxhighlight>
{{output}}
<pre style="font-size: 13px">
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 for 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 for 3 to 9
------------------------------
2860 non-unique solutions for 0 to 9
------------------------------------
</pre>
=={{header|Go}}==
<
import "fmt"
Line 2,642 ⟶ 3,336:
return square1 == square2 && square2 == square3 && square3 == square4
}
</syntaxhighlight>
{{Out}}
<pre>
Line 2,654 ⟶ 3,348:
=={{header|Groovy}}==
{{trans|Java}}
<
static void main(String[] args) {
fourSquare(1, 7, true, true)
Line 2,709 ⟶ 3,403:
return unique && Arrays.stream(haystack).anyMatch({ p -> p == needle })
}
}</
{{out}}
<pre>a b c d e f g
Line 2,731 ⟶ 3,425:
=={{header|Haskell}}==
====By exhaustive search====
<
import Control.Monad
Line 2,771 ⟶ 3,465:
fourRings 1 7 False True
fourRings 3 9 False True
fourRings 0 9 True False</
{{out}}
Line 2,803 ⟶ 3,497:
Nesting four bind operators (>>=), we can then build the set of solutions in the order: queens, left bishops and rooks, right bishops and rooks, knights.
Probably less readable, but already fast, and could be further optimised.
<
--------------- 4 RINGS OR 4 SQUARES PUZZLE --------------
Line 2,903 ⟶ 3,597:
( "length (rings False [0 .. 9])",
[length (rings False [0 .. 9])]
)</
{{Out}}
<pre>rings True [1 .. 7]
Line 2,931 ⟶ 3,625:
Implementation for the unique version of the puzzle:
<
range=: x+i.1+y-x
lo=. 6+3*x
Line 2,949 ⟶ 3,643:
end.
end.
)</
Implementation for the non-unique version of the puzzle:
<
range=: x+i.1+y-x
lo=. 3*x
Line 2,969 ⟶ 3,663:
end.
end.
)</
Task examples:
<
4 5 3 1 6 2 7
7 2 6 1 3 5 4
Line 2,988 ⟶ 3,682:
9 6 5 4 3 8 7
#0 fspuz2 9
2860</
=={{header|Java}}==
Uses java 8 features.
<
public class FourSquares {
Line 3,049 ⟶ 3,743:
return unique && Arrays.stream(haystack).anyMatch(p -> p == needle);
}
}</
{{out}}
<pre>a b c d e f g
Line 3,072 ⟶ 3,766:
===ES6===
{{Trans|Haskell}} (Structured search version)
<
"use strict";
//
// rings :: noRepeatedDigits -> DigitList -> solutions
// rings :: Bool -> [Int] -> [[Int]]
const rings =
const ns =
// CENTRAL DIGIT :: d
return
ringTriage(uniq)(ns
const ringTriage = uniq => ns => d => {
const
h =
ts = ns.filter(x => (x + d) <=
uniq ? (delete_(d)(ts)) : ns
)
.flatMap(c => {
// RIGHT OF CENTRE :: e and
return
) :
uniq ?
difference(ts)([d, c,
) :
});
};
const subTriage = uniq =>
) ? (
[]
) : (() => {
const
agDelta = a - g,
bfs = uniq ? (
difference(ns)([
d, c, e, g, a
])
) : ns;
// MID LEFT, MID RIGHT :: b and f
return (bfs).includes(f) && (
!uniq || ![
a, b, c, d, e, g
].includes(f)
) ? ([
[a, b, c, d, e, f, g]
]) : [];
});
})();
};
// ---------------------- TEST -----------------------
const
"rings(true, enumFromTo(1,7))\n",
unlines(
rings(true)(
enumFromTo(1)(7)
).map(show)
),
"\nrings(true, enumFromTo(3, 9))\n",
unlines(
rings(true)(
enumFromTo(3)(9)
).map(show)
),
"\nlength(rings(false, enumFromTo(0, 9)))\n",
rings(false)(
enumFromTo(0)(9)
)
.length
.toString(),
""
]);
// ---------------- GENERIC FUNCTIONS ----------------
// compare :: a -> a -> Ordering
const compare = (a, b) =>
a < b ? -1 : (a > b ? 1 : 0);
//
const
Boolean(xs.length) ? (
(x === xs[0]) ? (
xs.slice(1)
) : [xs[0]].concat(go(xs.slice(1)))
) : [];
return go;
};
const difference = xs =>
ys => {
const s = new Set(ys);
return xs.filter(x => !s.has(x));
};
// enumFromTo :: Int -> Int -> [Int]
const enumFromTo =
n => Array.from({
length:
}, (_, i) => m + i);
// flip :: (a -> b -> c) -> b -> a -> c
const flip =
// The binary function op with
// its arguments reversed.
1 !== op.length ? (
(a, b) => op(b, a)
) : (a => b => op(b)(a));
// head :: [a] -> a
const head = xs =>
// The first item (if any) in a list.
Boolean(xs.length) ? (
) : null;
// show :: a -> String
const show = x =>
JSON.stringify(x);
// unlines :: [String] -> String
const unlines = xs =>
// A single string formed by the intercalation
// of a list of strings with the newline character.
xs.join("\n");
// MAIN ---
return main();
})();</
{{Out}}
<pre>rings(true, enumFromTo(1,7))
Line 3,251 ⟶ 3,979:
The solution in this subsection is quite efficient for the family of problems based on permutations, but as is shown, can also be used without the permutation constraint.
<
def permutations:
if length == 0 then []
Line 3,290 ⟶ 4,018:
;
tasks</
{{out}}
<pre>
Line 3,323 ⟶ 4,051:
[[0,1], [1,2,3], [3,4,5], [5,6]].
<
# Input: ignored.
# Output: a stream of solutions, i.e. a stream of arrays.
Line 3,377 ⟶ 4,105:
| solve($bx; .[-1]; add) ;
def count(s): reduce s as $x (null; .+1);</
'''The specific task'''
<
def boxes: [[0,1], [1,2,3], [3,4,5], [5,6]];
count(rings(boxes; 0; 9))</
{{out}}
<pre>
Line 3,390 ⟶ 4,118:
=={{header|Julia}}==
{{Trans|Python}}
<
using Combinatorics
Line 3,413 ⟶ 4,141:
foursquares(3, 9, true, true)
foursquares(0, 9, false, false)
</syntaxhighlight>
{{output}}
<pre>
Line 3,431 ⟶ 4,159:
Total unique solutions for HIGH 9, LOW 3: 4
Total solutions for HIGH 9, LOW 0: 2860
</pre>
=={{header|Koka}}==
{{trans|Rust}}
<syntaxhighlight lang="koka">
fun is_unique(a: int, b: int, c: int, d: int, e: int, f: int, g: int)
a != b && a != c && a != d && a != e && a != f && a != g &&
b != c && b != d && b != e && b != f && b != g &&
c != d && c != e && c != f && c != g &&
d != e && d != f && d != g &&
e != f && e != g &&
f != g
fun is_solution(a: int, b: int, c: int, d: int, e: int, f: int, g: int)
val bcd = b + c + d
val ab = a + b
if ab != bcd then return False
val def = d + e + f
if bcd != def then return False
val fg = f + g
return def == fg
fun four_squares(low: int, high: int, unique:bool=True)
var count := 0
for(low, high) fn(a)
for(low, high) fn(b)
for(low, high) fn(c)
for(low, high) fn(d)
for(low, high) fn(e)
for(low, high) fn(f)
for(low, high) fn(g)
if (!unique || is_unique(a, b, c, d, e, f, g)) && is_solution(a, b, c, d, e, f, g) then
count := count + 1
if unique then
println([a, b, c, d, e, f, g].show)
else
()
val uniquestr = if unique then "unique" else "non-unique"
println(count.show ++ " " ++ uniquestr ++ " solutions in " ++ low.show ++ " to " ++ high.show ++ " range\n")
fun main()
four_squares(1, 7)
four_squares(3, 9)
four_squares(0, 9, False)
</syntaxhighlight>
{{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 range
[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 range
2860 non-unique solutions in 0 to 9 range
</pre>
=={{header|Kotlin}}==
{{trans|C}}
<
class FourSquares(
Line 3,507 ⟶ 4,300:
FourSquares(3, 9, true, true)
FourSquares(0, 9, false, false)
}</
{{out}}
Line 3,539 ⟶ 4,332:
=={{header|Lua}}==
{{trans|D}}
<
if unique then
for _,value in pairs(haystack) do
Line 3,595 ⟶ 4,388:
fourSquare(1,7,true,true)
fourSquare(3,9,true,true)
fourSquare(0,9,false,false)</
{{out}}
<pre>a b c d e f g
Line 3,616 ⟶ 4,409:
=={{header|Mathematica}}/{{header|Wolfram Language}}==
<
SolveValues[{a + b == b + c + d == d + e + f == f + g, low <= a <= high,
low <= b <= high, low <= c <= high, low <= d <= high,
Line 3,632 ⟶ 4,425:
low <= b <= high, low <= c <= high, low <= d <= high,
low <= e <= high, low <= f <= high, low <= g <= high}, {a, b, c, d,
e, f, g}, Integers] // Length</
{{out}}
<pre>{{3, 7, 2, 1, 5, 4, 6}, {4, 5, 3, 1, 6, 2, 7}, {4, 7, 1, 3, 2, 6,
Line 3,642 ⟶ 4,435:
2860</pre>
=={{header|MiniScript}}==
<syntaxhighlight lang="miniscript">combinations = function(elements, comboLength, unique=true)
n = elements.len
if comboLength > n then return []
allCombos = []
genCombos=function(start, currCombo)
if currCombo.len == comboLength then
allCombos.push(currCombo)
return
end if
if start == n then return
for i in range(start, n - 1)
newCombo = currCombo + [elements[i]]
genCombos(i + unique, newCombo)
end for
end function
genCombos(0, [])
return allCombos
end function
permutations = function(elements, permLength=null)
n = elements.len
elements.sort
if permLength == null then permLength = n
allPerms = []
genPerms = function(prefix, remainingElements)
if prefix.len == permLength then
allPerms.push(prefix)
return
end if
for i in range(0, remainingElements.len - 1)
if i > 0 and remainingElements[i] == remainingElements[i-1] then continue
newPrefix = prefix + [remainingElements[i]]
newRemains = remainingElements[:i] + remainingElements[i+1:]
genPerms(newPrefix, newRemains)
end for
end function
genPerms([],elements)
return allPerms
end function
ringsEqual = function(a)
if a.len != 7 then return false
return a[0]+a[1] == a[1]+a[2]+a[3] == a[3]+a[4]+a[5] == a[5] + a[6]
end function
fourRings = function(lo, hi, unique, show)
rng = range(lo, hi)
combos = combinations(rng, 7, unique)
cnt = 0
for c in combos
for p in permutations(c)
if ringsEqual(p) then
cnt += 1
if show then print p.join(", ")
end if
end for
end for
uniStr = [" nonunique", " unique"]
print cnt + uniStr[unique] + " solutions for " + lo + " to " + hi
print
end function
fourRings(1, 7, true, true)
fourRings(3, 9, true, true)
fourRings(0, 9, false, false)
</syntaxhighlight>
{{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 for 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 for 3 to 9
2860 nonunique solutions for 0 to 9</pre>
=={{header|Modula-2}}==
<
FROM Conversions IMPORT IntToStr;
FROM Terminal IMPORT *;
Line 3,737 ⟶ 4,623:
four_square(0,9,FALSE,FALSE);
ReadChar; (* Wait so results can be viewed. *)
END FourSquare.</
=={{header|Nim}}==
Adapted from Rust version.
<
a != b and a != c and a != d and a != e and a != f and a != g and
b != c and b != d and b != e and b != f and b != g and
Line 3,778 ⟶ 4,664:
printFourSquares(1, 7)
printFourSquares(3, 9)
printFourSquares(0, 9, unique = false)</
{{out}}
<pre>[3, 7, 2, 1, 5, 4, 6]
Line 3,797 ⟶ 4,683:
2860 non-unique solutions in 0 to 9 range</pre>
=={{header|OCaml}}==
Original version by [http://rosettacode.org/wiki/User:Vanyamil User:Vanyamil]
<syntaxhighlight lang="OCaml">
(* Task : 4-rings_or_4-squares_puzzle *)
(*
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.
Squares are: ab; bcd; def; fg
Solution: brute force from generating a, b, d, g from possible range
*)
(*** Helpers ***)
type assignment = {
a: int;
b: int;
c: int;
d: int;
e: int;
f: int;
g: int;
}
let generate ((a, b), (d, g)) =
let s = a + b in
let c = s - b - d in
let f = s - g in
let e = s - f - d in
{a; b; c; d; e; f; g}
let list_of_assign assign =
[assign.a; assign.b; assign.c; assign.d; assign.e; assign.f; assign.g]
let test unique low high assign =
let l = list_of_assign assign in
let test_el e =
e >= low && e <= high &&
(not unique || (l |> List.filter ((=) e) |> List.length) == 1)
in
List.for_all test_el l
let generator low high =
let single () = Seq.ints low |> Seq.take_while (fun x -> x <= high) in
let first_two = Seq.product (single ()) (single ()) in
let second_two = Seq.product (single ()) (single ()) in
let final = Seq.product first_two second_two in
Seq.map generate final
let print_assign a =
Printf.printf "a: %d, b: %d, c: %d, d: %d, e: %d, f: %d, g: %d\n"
a.a a.b a.c a.d a.e a.f a.g
(*** Actual task at hand ***)
let evaluate low high unique log =
let seqs = generator low high |> Seq.filter (test unique low high) in
let unique_str = if unique then "unique" else "non-unique" in
if log then Seq.iter print_assign seqs;
Printf.printf "%d %s sequences found between %d and %d\n\n" (Seq.length seqs) unique_str low high
(*** Output ***)
let () =
evaluate 1 7 true true;
evaluate 3 9 true true;
evaluate 0 9 false false
;;
</syntaxhighlight>
{{out}}
<pre>
a: 7, b: 2, c: 6, d: 1, e: 3, f: 5, g: 4
a: 6, b: 4, c: 5, d: 1, e: 2, f: 7, g: 3
a: 3, b: 7, c: 2, d: 1, e: 5, f: 4, g: 6
a: 4, b: 5, c: 3, d: 1, e: 6, f: 2, g: 7
a: 5, b: 6, c: 2, d: 3, e: 1, f: 7, g: 4
a: 4, b: 7, c: 1, d: 3, e: 2, f: 6, g: 5
a: 7, b: 3, c: 2, d: 5, e: 1, f: 4, g: 6
a: 6, b: 4, c: 1, d: 5, e: 2, f: 3, g: 7
8 unique sequences found between 1 and 7
a: 9, b: 6, c: 5, d: 4, e: 3, f: 8, g: 7
a: 9, b: 6, c: 4, d: 5, e: 3, f: 7, g: 8
a: 7, b: 8, c: 3, d: 4, e: 5, f: 6, g: 9
a: 8, b: 7, c: 3, d: 5, e: 4, f: 6, g: 9
4 unique sequences found between 3 and 9
2860 non-unique sequences found between 0 and 9
</pre>
=={{header|Pascal}}==
{{works with|Free Pascal}}
There are so few solutions of 7 consecutive numbers, so I used a modified version, to get all the expected solutions at once.
<
{$MODE DELPHI}
{$R+,O+}
Line 3,915 ⟶ 4,895:
writeln(' solution count for ',loDgt,' to ',HiDgt,' = ',cnt);
writeln('unique solution count for ',loDgt,' to ',HiDgt,' = ',uniqueCount);
end.</
{{Out}}
<pre>
Line 3,956 ⟶ 4,936:
Relying on the modules <code>ntheory</code> and <code>Set::CrossProduct</code> to generate the tuples needed. Both are supply results via iterators, particularly important in the latter case, to avoid gobbling too much memory.
{{libheader|ntheory}}
<
use Set::CrossProduct;
Line 4,001 ⟶ 4,981:
display four_sq_permute( [3..9] );
display four_sq_permute( [8, 9, 11, 12, 17, 18, 20, 21] );
four_sq_cartesian( [0..9] );</
{{out}}
<pre>8 unique solutions found using: 1, 2, 3, 4, 5, 6, 7
Line 4,034 ⟶ 5,014:
2860 non-unique solutions found using: 0, 1, 2, 3, 4, 5, 6, 7, 8, 9</pre>
===With Recursion===
<
use strict; # https://rosettacode.org/wiki/4-rings_or_4-squares_puzzle
Line 4,067 ⟶ 5,047:
elsif( @_ == 7 ) { $_[3] + $_[4] == $_[6] and $count++; return }
findcount( @_, $_ ) for 0 .. 9;
}</
{{out}}
<pre>
Line 4,092 ⟶ 5,072:
=={{header|Phix}}==
<!--<
<span style="color: #000080;font-style:italic;">-- demo/rosetta/4_rings_or_4_squares_puzzle.exw</span>
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">solutions</span>
Line 4,105 ⟶ 5,087:
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">foursquares</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">lo</span><span style="color: #0000FF;">,
<span style="color: #004080;">sequence</span> <span style="color: #000000;">set</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #000000;">lo</span><span style="color: #0000FF;">,</span><span style="color: #000000;">7</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">solutions</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
Line 4,135 ⟶ 5,117:
<span style="color: #000000;">foursquares</span><span style="color: #0000FF;">(</span><span style="color: #000000;">3</span><span style="color: #0000FF;">,</span><span style="color: #000000;">9</span><span style="color: #0000FF;">,</span><span style="color: #004600;">true</span><span style="color: #0000FF;">,</span><span style="color: #004600;">true</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">foursquares</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">9</span><span style="color: #0000FF;">,</span><span style="color: #004600;">false</span><span style="color: #0000FF;">,</span><span style="color: #004600;">false</span><span style="color: #0000FF;">)</span>
<!--</
{{out}}
<pre>
Line 4,156 ⟶ 5,138:
=={{header|Picat}}==
<
main =>
Line 4,186 ⟶ 5,168:
% Sums = $[A+B,B+C+D,D+E+F,F+G],
% foreach(I in 2..Sums.len) Sums[I] #= Sums[I-1] end,
LL = solve_all(L).</syntaxhighlight>
{{out}}
<pre>
Picat> main
Line 4,206 ⟶ 5,187:
[9,6,5,4,3,8,7]
len = 2860</pre>
=={{header|PL/M}}==
{{Trans|ALGOL 68}}
{{works with|8080 PL/M Compiler}} ... under CP/M (or an emulator)
<syntaxhighlight lang="pli">100H: /* SOLVE THE 4 RINGS OR 4 SQUARES PUZZLE */
DECLARE FALSE LITERALLY '0';
DECLARE TRUE LITERALLY '0FFH';
/* CP/M SYSTEM CALL AND I/O ROUTINES */
BDOS: PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5; END;
PR$CHAR: PROCEDURE( C ); DECLARE C BYTE; CALL BDOS( 2, C ); END;
PR$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END;
PR$NL: PROCEDURE; CALL PR$CHAR( 0DH ); CALL PR$CHAR( 0AH ); END;
PR$NUMBER: PROCEDURE( N ); /* PRINTS A NUMBER IN THE MINIMUN FIELD WIDTH */
DECLARE N ADDRESS;
DECLARE V ADDRESS, N$STR ( 6 )BYTE, W BYTE;
V = N;
W = LAST( N$STR );
N$STR( W ) = '$';
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
DO WHILE( ( V := V / 10 ) > 0 );
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
END;
CALL PR$STRING( .N$STR( W ) );
END PR$NUMBER;
/* 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 */
FOUR$RINGS: PROCEDURE( LO, HI, ALLOW$DUPLICATES, SHOW );
DECLARE ( LO, HI ) ADDRESS;
DECLARE ( ALLOW$DUPLICATES, SHOW ) BYTE;
DECLARE ( SOLUTIONS, A, B, C, D, E, F, G, T ) ADDRESS;
SOLUTIONS = 0;
DO A = LO TO HI;
DO B = LO TO HI;
IF ALLOWDUPLICATES OR A <> B THEN DO;
T = A + B;
DO C = LO TO HI;
IF ALLOWDUPLICATES OR ( A <> C AND B <> C ) THEN DO;
D = T - ( B + C );
IF D >= LO AND D <= HI
AND ( ALLOW$DUPLICATES
OR ( A <> D AND B <> D AND C <> D )
)
THEN DO;
DO E = LO TO HI;
IF ALLOWDUPLICATES
OR ( A <> E AND B <> E
AND C <> E AND D <> E
)
THEN DO;
G = D + E;
F = T - G;
IF F >= LO AND F <= HI
AND G >= LO AND G <= HI
AND ( ALLOWDUPLICATES
OR ( A <> F AND B <> F AND C <> F
AND D <> F AND E <> F
AND A <> G AND B <> G AND C <> G
AND D <> G AND E <> G AND F <> G
)
)
THEN DO;
SOLUTIONS = SOLUTIONS + 1;
IF SHOW THEN DO;
CALL PR$CHAR( ' ' ); CALL PR$NUMBER( A );
CALL PR$CHAR( ' ' ); CALL PR$NUMBER( B );
CALL PR$CHAR( ' ' ); CALL PR$NUMBER( C );
CALL PR$CHAR( ' ' ); CALL PR$NUMBER( D );
CALL PR$CHAR( ' ' ); CALL PR$NUMBER( E );
CALL PR$CHAR( ' ' ); CALL PR$NUMBER( F );
CALL PR$CHAR( ' ' ); CALL PR$NUMBER( G );
CALL PR$NL;
END;
END;
END;
END;
END;
END;
END;
END;
END;
END;
CALL PR$NUMBER( SOLUTIONS );
IF ALLOW$DUPLICATES THEN CALL PR$STRING( .' NON-UNIQUE$' );
ELSE CALL PR$STRING( .' UNIQUE$' );
CALL PR$STRING( .' SOLUTIONS IN $' );
CALL PR$NUMBER( LO );
CALL PR$STRING( .' TO $' );
CALL PR$NUMBER( HI );
CALL PR$NL;
CALL PR$NL;
END FOUR$RINGS;
/* FIND THE SOLUTIONS AS REQUIRED FOR THE TASK */
CALL FOUR$RINGS( 1, 7, FALSE, TRUE );
CALL FOUR$RINGS( 3, 9, FALSE, TRUE );
CALL FOUR$RINGS( 0, 9, TRUE, FALSE );
EOF</syntaxhighlight>
{{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>
Line 4,212 ⟶ 5,314:
=={{header|PL/SQL}}==
{{works with|Oracle}}
<
create table allints (v number);
create table results
Line 4,344 ⟶ 5,446:
end;
/
</syntaxhighlight>
Output
<pre>
Line 4,377 ⟶ 5,479:
=={{header|Prolog}}==
Works with SWI-Prolog 7.5.8
<syntaxhighlight lang="prolog">
:- use_module(library(clpfd)).
Line 4,401 ⟶ 5,503:
my_sum(Min, Max, 1, LL),
length(LL, Len).
</syntaxhighlight>
Output
<pre>
Line 4,429 ⟶ 5,531:
===Procedural===
====Itertools====
<
def all_equal(a,b,c,d,e,f,g):
Line 4,451 ⟶ 5,553:
print str(solutions)+" "+uorn+" solutions in "+str(lo)+" to "+str(hi)
print</
Output
<pre>foursquares(1,7,True,True)
Line 4,478 ⟶ 5,580:
====Generators====
Faster solution without itertools
<syntaxhighlight lang="python">
def foursquares(lo,hi,unique,show):
Line 4,543 ⟶ 5,645:
print str(solutions)+" "+uorn+" solutions in "+str(lo)+" to "+str(hi)
print</
Output<pre>
foursquares(1,7,True,True)
Line 4,572 ⟶ 5,674:
{{Trans|JavaScript}}
{{Works with|Python|3.7}}
<
from itertools import chain
Line 4,717 ⟶ 5,819:
# MAIN ---
if __name__ == '__main__':
main()</
{{Out}}
<pre>Testing unique digits [1..7], [3..9] and unrestricted digits:
Line 4,746 ⟶ 5,848:
=={{header|R}}==
Function "perms" is a modified version of the "permutations" function from the "gtools" R package.
<
perms <- function (n, r, v = 1:n, repeats.allowed = FALSE) {
Line 4,806 ⟶ 5,908:
print_perms(10, 7, v = 0:9, repeats.allowed = TRUE, table.out = FALSE)
</syntaxhighlight>
{{Out}}
<pre>
Line 4,834 ⟶ 5,936:
Using a folder, so we can count as well as produce lists of results
<
(define solution? (match-lambda [(list a b c d e f g) (= (+ a b) (+ b c d) (+ d e f) (+ f g))]))
Line 4,847 ⟶ 5,949:
(fold-4-rings-or-4-squares-puzzle 1 7 cons null)
(fold-4-rings-or-4-squares-puzzle 3 9 cons null)
(fold-4-rings-or-4-squares-puzzle 0 9 (λ (ignored-solution count) (add1 count)) 0)</
{{out}}
Line 4,859 ⟶ 5,961:
{{works with|Rakudo|2016.12}}
<syntaxhighlight lang="raku"
my @solutions;
Line 4,886 ⟶ 5,988:
four-squares( [3..9] );
four-squares( [8, 9, 11, 12, 17, 18, 20, 21] );
four-squares( [0..9], :unique(0), :show(0) );</
{{out}}
Line 4,932 ⟶ 6,034:
This REXX version is faster than the more idiomatic version, but is longer (statement-wise) and
<br>a bit easier to read (visualize).
<
arg LO HI unique show . /*the ARG statement capitalizes args.*/
if LO=='' | LO=="," then LO=1 /*Not specified? Then use the default.*/
Line 5,001 ⟶ 6,103:
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</
{{out|output|text= when using the default inputs: <tt> 1 7 </tt>}}
<pre>
Line 5,038 ⟶ 6,140:
Note that the REXX language doesn't have short-circuits (when executing multiple clauses
in <big> '''if''' </big> (and other) statements.
<
arg LO HI unique show . /*the ARG statement capitalizes args.*/
if LO=='' | LO=="," then LO=1 /*Not specified? Then use the default.*/
Line 5,079 ⟶ 6,181:
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</
{{out|output|text= is identical to the faster REXX version.}} <br><br>
=={{header|Ruby}}==
<
f = -> (a,b,c,d,e,f,g) {[a+b, b+c+d, d+e+f, f+g].uniq.size == 1}
if unique
Line 5,103 ⟶ 6,205:
four_squares(low, high)
end
four_squares(0, 9, false)</
{{out}}
Line 5,129 ⟶ 6,231:
=={{header|Rust}}==
<
#![feature(inclusive_range_syntax)]
Line 5,204 ⟶ 6,306:
nonuniques(0, 9);
}
</syntaxhighlight>
{{Out}}
<pre>
Line 5,228 ⟶ 6,330:
=={{header|Scala}}==
{{trans|Java}}
<
def fourSquare(low: Int, high: Int, unique: Boolean, print: Boolean): Unit = {
Line 5,258 ⟶ 6,360:
fourSquare(0, 9, unique = false, print = false)
}
}</
{{out}}
<pre>a b c d e f g
Line 5,280 ⟶ 6,382:
=={{header|Scheme}}==
<
(import (scheme base)
(scheme write)
Line 5,328 ⟶ 6,430:
(display (count (lambda (combination) (apply solution? combination))
(combinations 7 (iota 10 0) #f))) (newline)
</syntaxhighlight>
{{out}}
Line 5,342 ⟶ 6,444:
=={{header|Sidef}}==
{{trans|Raku}}
<
var solutions = []
Line 5,384 ⟶ 6,486:
four_squares(@(3..9))
four_squares([8, 9, 11, 12, 17, 18, 20, 21])
four_squares(@(0..9), unique: false, show: false)</
{{out}}
<pre>
Line 5,423 ⟶ 6,525:
=={{header|Simula}}==
<
INTEGER PROCEDURE GETCOMBS(LOW, HIGH, UNIQUE, COMBS);
Line 5,537 ⟶ 6,639:
END.
</syntaxhighlight>
{{out}}
<pre>8 UNIQUE SOLUTIONS IN 1 TO 7
Line 5,559 ⟶ 6,661:
{{works with|Db2 LUW}} version 9.7 or higher.
With SQL PL:
<
--#SET TERMINATOR @
Line 5,675 ⟶ 6,777:
CALL FOUR_SQUARES(3, 9, 0, 0)@
CALL FOUR_SQUARES(0, 9, 1, 1)@
</syntaxhighlight>
Output:
<pre>
Line 5,724 ⟶ 6,826:
Use the program '''perm''' in the [[Permutations]] task for the first two questions, as it's fast enough. Use '''joinby''' for the third.
<
rename * (a b c d e f g)
list if a==c+d & b+c==e+f & d+e==g, noobs sep(50)
Line 5,775 ⟶ 6,877:
erase temp.dta
count
2,860</
=={{header|Tcl}}==
Line 5,784 ⟶ 6,886:
The puzzle can be varied freely by changing the values of <tt>$vars</tt> and <tt>$exprs</tt> specified at the top of the script.
<
set exprs {
{$a+$b}
Line 5,858 ⟶ 6,960:
solve_4rings $vars $exprs [range 3 9]
puts "# Number of solutions, free over 0..9:"
puts [solve_4rings_hard $vars $exprs [range 0 9]]</
{{out}}
Line 5,880 ⟶ 6,982:
=={{header|VBA}}==
{{trans|C}}
<
Dim e As Integer, f As Integer, g As Integer
Dim lo As Integer, hi As Integer, unique As Boolean, show As Boolean
Line 5,943 ⟶ 7,045:
Call foursquares(0, 9, False, False)
End Sub
</syntaxhighlight>
{{out}}
<pre>
Line 5,969 ⟶ 7,071:
=={{header|Visual Basic .NET}}==
Similar to the other brute-force algorithims, but with a couple of enhancements. A "used" list is maintained to simplify checking of the nested variables overlap. Also the ''d'', ''f'' and ''g'' '''For Each''' loops are constrained by the other variables instead of blindly going through all combinations.
<
Dim CA As Char() = "0123456789ABC".ToCharArray()
Line 6,014 ⟶ 7,116:
End Sub
End Module</
{{out}}
Added the zkl example for [5,12]<pre>a b c d e f g
Line 6,045 ⟶ 7,147:
C 9 7 5 6 A B
4 unique solutions for [5,12]</pre>
=={{header|V (Vlang)}}==
{{trans|Go}}
<syntaxhighlight lang="v (vlang)">fn main(){
mut n, mut c := get_combs(1,7,true)
println("$n unique solutions in 1 to 7")
println(c)
n, c = get_combs(3,9,true)
println("$n unique solutions in 3 to 9")
println(c)
n, _ = get_combs(0,9,false)
println("$n non-unique solutions in 0 to 9")
}
fn get_combs(low int,high int,unique bool) (int, [][]int) {
mut num := 0
mut valid_combs := [][]int{}
for a := low; a <= high; a++ {
for b := low; b <= high; b++ {
for c := low; c <= high; c++ {
for d := low; d <= high; d++ {
for e := low; e <= high; e++ {
for f := low; f <= high; f++ {
for g := low; g <= high; g++ {
if valid_comb(a,b,c,d,e,f,g) {
if !unique || is_unique(a,b,c,d,e,f,g) {
num++
valid_combs << [a,b,c,d,e,f,g]
}
}
}
}
}
}
}
}
}
return num, valid_combs
}
fn is_unique(a int,b int,c int,d int,e int,f int,g int) bool {
mut data := map[int]int{}
data[a]++
data[b]++
data[c]++
data[d]++
data[e]++
data[f]++
data[g]++
return data.len == 7
}
fn valid_comb(a int,b int,c int,d int,e int,f int,g int) bool {
square1 := a + b
square2 := b + c + d
square3 := d + e + f
square4 := f + g
return square1 == square2 && square2 == square3 && square3 == square4
}</syntaxhighlight>
{{out}}
<pre>
8 unique solutions in 1 to 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, 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 in 3 to 9
[[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]]
2860 non-unique solutions in 0 to 9
</pre>
=={{header|Wren}}==
{{trans|C}}
{{libheader|Wren-fmt}}
<
var a = 0
Line 6,127 ⟶ 7,295:
foursquares.call(1, 7, true, true)
foursquares.call(3, 9, true, true)
foursquares.call(0, 9, false, false)</
{{out}}
Line 6,160 ⟶ 7,328:
=={{header|XPL0}}==
<syntaxhighlight lang="xpl0">int Show, Low, High, Digit(7\a..g\), Count;
proc Rings(Level);
int Level; \of recursion
int
[for D:= Low to High do
[Digit(Level):= D;
if Level < 7-1 then Rings(Level+1)
else [
if Temp = Digit(1) + Digit(2) + Digit(3) and
Temp = Digit(3) + Digit(4) + Digit(5) and
[
];
];
];
[
Low:= 1; High:= 7;
Rings(0);
CrLf(0);
Low:= 3; High:= 9;
Rings(0);
CrLf(0);
Show:= false;
Low:= 0; High:= 9; Count:= 0;
Rings(0);
IntOut(0, Count);
CrLf(0);
]</syntaxhighlight>
{{out}}
Line 6,218 ⟶ 7,385:
9 6 5 4 3 8 7
2860
</pre>
=={{header|Yabasic}}==
{{trans|D}}
<
fourSquare(3,9,true,true)
fourSquare(0,9,false,false)
Line 6,286 ⟶ 7,453:
end if
return true
end sub</
{{out}}
<pre>a b c d e f g
Line 6,305 ⟶ 7,472:
There are 4 unique solutions in [3,9]
There are 2860 non-unique solutions in [0,9]</pre>
=={{header|Zig}}==
{{trans|Go}}
This is a direct translation of the Go solution - the Zig implementation
having manual memory management and Zig not ignoring errors or return values.
<syntaxhighlight lang="zig">const std = @import("std");
const Allocator = std.mem.Allocator;
</syntaxhighlight><syntaxhighlight lang="zig">
pub fn main() !void {
const stdout = std.io.getStdOut().writer();
var gpa = std.heap.GeneralPurposeAllocator(.{}){};
defer {
const ok = gpa.deinit();
std.debug.assert(ok == .ok);
}
const allocator = gpa.allocator();
{
const nc = try getCombs(allocator, 1, 7, true);
defer allocator.free(nc.combinations);
try stdout.print("{d} unique solutions in 1 to 7\n", .{nc.num});
try stdout.print("{any}\n", .{nc.combinations});
}
{
const nc = try getCombs(allocator, 3, 9, true);
defer allocator.free(nc.combinations);
try stdout.print("{d} unique solutions in 3 to 9\n", .{nc.num});
try stdout.print("{any}\n", .{nc.combinations});
}
{
const nc = try getCombs(allocator, 0, 9, false);
defer allocator.free(nc.combinations);
try stdout.print("{d} non-unique solutions in 0 to 9\n", .{nc.num});
}
}
</syntaxhighlight><syntaxhighlight lang="zig">
/// Caller owns combinations slice memory.
fn getCombs(allocator: Allocator, low: u16, high: u16, unique: bool) !struct { num: usize, combinations: [][7]usize } {
var num: usize = 0;
var valid_combinations = std.ArrayList([7]usize).init(allocator);
for (low..high + 1) |a|
for (low..high + 1) |b|
for (low..high + 1) |c|
for (low..high + 1) |d|
for (low..high + 1) |e|
for (low..high + 1) |f|
for (low..high + 1) |g|
if (validComb(a, b, c, d, e, f, g))
if (!unique or try isUnique(allocator, a, b, c, d, e, f, g)) {
num += 1;
try valid_combinations.append([7]usize{ a, b, c, d, e, f, g });
};
return .{ .num = num, .combinations = try valid_combinations.toOwnedSlice() };
}
</syntaxhighlight><syntaxhighlight lang="zig">
fn isUnique(allocator: Allocator, a: usize, b: usize, c: usize, d: usize, e: usize, f: usize, g: usize) !bool {
var data = std.AutoArrayHashMap(usize, void).init(allocator);
defer data.deinit();
try data.put(a, {});
try data.put(b, {});
try data.put(c, {});
try data.put(d, {});
try data.put(e, {});
try data.put(f, {});
try data.put(g, {});
return data.count() == 7;
}
</syntaxhighlight><syntaxhighlight lang="zig">
fn validComb(a: usize, b: usize, c: usize, d: usize, e: usize, f: usize, g: usize) bool {
const square1 = a + b;
const square2 = b + c + d;
const square3 = d + e + f;
const square4 = f + g;
return square1 == square2 and square2 == square3 and square3 == square4;
}</syntaxhighlight>
{{out}}
<pre>8 unique solutions in 1 to 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, 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 in 3 to 9
{ { 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 } }
2860 non-unique solutions in 0 to 9</pre>
=={{header|zkl}}==
<
fcn fourSquaresPuzzle(lo=1,hi=7,unique=True){ //-->list of solutions
_assert_(0<=lo and hi<36);
Line 6,326 ⟶ 7,576:
}
s
}</
<
if(not solutions){ println("No solutions for",msg); return(); }
Line 6,341 ⟶ 7,591:
fourSquaresPuzzle(5,12) : show(_," unique (5-12)"); println();
println(fourSquaresPuzzle(0,9,False).len(), // 10^7 possibilities
" non-unique (0-9) solutions found.");</
{{out}}
<pre>
Line 6,374 ⟶ 7,624:
2860 non-unique (0-9) solutions found.
</pre>
[[Category:Games]]
[[Category:Puzzles]]
| |||