4-rings or 4-squares puzzle: Difference between revisions
imported>Chinhouse No edit summary |
|||
(129 intermediate revisions by 52 users not shown) | |||
Line 1: | Line 1: | ||
[[Category:Games]] |
[[Category:Games]] |
||
[[Category:Puzzles]] |
[[Category:Puzzles]] |
||
{{task}} |
{{task}} |
||
<!-- Squares were chosen as it's much easier to display squares instead of rings. !--> |
<!-- Squares were chosen for the diagram as it's much easier to display squares instead of rings. !--> |
||
;Task: |
;Task: |
||
Line 42: | Line 43: | ||
* [[Solve the no connection puzzle]] |
* [[Solve the no connection puzzle]] |
||
<br><br> |
<br><br> |
||
=={{header|11l}}== |
|||
{{trans|Python}} |
|||
<syntaxhighlight lang="11l">F foursquares(lo, hi, unique, show) |
|||
V solutions = 0 |
|||
L(c) lo .. hi |
|||
L(d) lo .. hi |
|||
I !unique | (c != d) |
|||
V a = c + d |
|||
I a >= lo & a <= hi |
|||
I !unique | (c != 0 & d != 0) |
|||
L(e) lo .. hi |
|||
I !unique | (e !C (a, c, d)) |
|||
V g = d + e |
|||
I g >= lo & g <= hi |
|||
I !unique | (g !C (a, c, d, e)) |
|||
L(f) lo .. hi |
|||
I !unique | (f !C (a, c, d, g, e)) |
|||
V b = e + f - c |
|||
I b >= lo & b <= hi |
|||
I !unique | (b !C (a, c, d, g, e, f)) |
|||
solutions++ |
|||
I show |
|||
print(String((a, b, c, d, e, f, g))[1 .< (len)-1]) |
|||
V uorn = I unique {‘unique’} E ‘non-unique’ |
|||
print(solutions‘ ’uorn‘ solutions in ’lo‘ to ’hi) |
|||
print() |
|||
foursquares(1, 7, 1B, 1B) |
|||
foursquares(3, 9, 1B, 1B) |
|||
foursquares(0, 9, 0B, 0B)</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
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|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 */ |
|||
/*******************************************/ |
|||
/* Constantes file */ |
|||
/*******************************************/ |
|||
/* for this file see task include a file in language AArch64 assembly*/ |
|||
.include "../includeConstantesARM64.inc" |
|||
.equ NBBOX, 7 |
|||
/*********************************/ |
|||
/* Initialized data */ |
|||
/*********************************/ |
|||
.data |
|||
sMessDeb: .asciz "a= @ b= @ c= @ d= @ e= @ f= @ g= @ \n***********************\n" |
|||
szCarriageReturn: .asciz "\n************************\n" |
|||
sMessNbSolution: .asciz "Number of solutions : @ \n\n\n" |
|||
/*********************************/ |
|||
/* UnInitialized data */ |
|||
/*********************************/ |
|||
.bss |
|||
.align 8 |
|||
sZoneConv: .skip 24 |
|||
qValues_a: .skip 8 * NBBOX |
|||
qValues_b: .skip 8 * NBBOX - 1 |
|||
qValues_c: .skip 8 * NBBOX - 2 |
|||
qValues_d: .skip 8 * NBBOX - 3 |
|||
qValues_e: .skip 8 * NBBOX - 4 |
|||
qValues_f: .skip 8 * NBBOX - 5 |
|||
qValues_g: .skip 8 * NBBOX - 6 |
|||
qCounterSol: .skip 8 |
|||
/*********************************/ |
|||
/* code section */ |
|||
/*********************************/ |
|||
.text |
|||
.global main |
|||
main: // entry of program |
|||
mov x0,#1 |
|||
mov x1,#7 |
|||
mov x2,#3 // 0 = rien 1 = display 2 = count 3 = les deux |
|||
bl searchPb |
|||
mov x0,#3 |
|||
mov x1,#9 |
|||
mov x2,#3 // 0 = rien 1 = display 2 = count 3 = les deux |
|||
bl searchPb |
|||
mov x0,#0 |
|||
mov x1,#9 |
|||
mov x2,#2 // 0 = rien 1 = display 2 = count 3 = les deux |
|||
bl prepSearchNU |
|||
100: // standard end of the program |
|||
mov x0, #0 // return code |
|||
mov x8, #EXIT // request to exit program |
|||
svc #0 // perform the system call |
|||
qAdrszCarriageReturn: .quad szCarriageReturn |
|||
/******************************************************************/ |
|||
/* search problèm value not unique */ |
|||
/******************************************************************/ |
|||
/* x0 contains start digit */ |
|||
/* x1 contains end digit */ |
|||
/* x2 contains action (0 display 1 count) */ |
|||
prepSearchNU: |
|||
stp x12,lr,[sp,-16]! // save registres |
|||
stp x2,x3,[sp,-16]! // save registres |
|||
stp x4,x5,[sp,-16]! // save registres |
|||
stp x6,x7,[sp,-16]! // save registres |
|||
stp x8,x9,[sp,-16]! // save registres |
|||
stp x10,fp,[sp,-16]! // save registres |
|||
mov x5,#0 // counter |
|||
mov x12,x0 // a |
|||
1: |
|||
mov x11,x0 // b |
|||
2: |
|||
mov x10,x0 // c |
|||
3: |
|||
mov x9,x0 // d |
|||
4: |
|||
add x4,x12,x11 // a + b reference |
|||
add x3,x11,x10 |
|||
add x3,x3,x9 // b + c + d |
|||
cmp x4,x3 |
|||
bne 10f |
|||
mov x8,x0 // e |
|||
5: |
|||
mov x7,x0 // f |
|||
6: |
|||
add x3,x9,x8 |
|||
add x3,x3,x7 // d + e + f |
|||
cmp x3,x4 |
|||
bne 9f |
|||
mov x6,x0 // g |
|||
7: |
|||
add x3,x7,x6 // f + g |
|||
cmp x3,x4 |
|||
bne 8f // not OK |
|||
// OK |
|||
add x5,x5,1 // increment counter |
|||
8: |
|||
add x6,x6,1 // increment g |
|||
cmp x6,x1 |
|||
ble 7b |
|||
9: |
|||
add x7,x7,1 // increment f |
|||
cmp x7,x1 |
|||
ble 6b |
|||
add x8,x8,1 // increment e |
|||
cmp x8,x1 |
|||
ble 5b |
|||
10: |
|||
add x9,x9,1 // increment d |
|||
cmp x9,x1 |
|||
ble 4b |
|||
add x10,x10,1 // increment c |
|||
cmp x10,x1 |
|||
ble 3b |
|||
add x11,x11,1 // increment b |
|||
cmp x11,x1 |
|||
ble 2b |
|||
add x12,x12,1 // increment a |
|||
cmp x12,x1 |
|||
ble 1b |
|||
// end |
|||
tst x2,#0b10 // print count ? |
|||
beq 100f |
|||
mov x0,x5 // counter |
|||
ldr x1,qAdrsZoneConv |
|||
bl conversion10 |
|||
ldr x0,qAdrsMessNbSolution |
|||
ldr x1,qAdrsZoneConv // insert conversion in message |
|||
bl strInsertAtCharInc |
|||
bl affichageMess |
|||
100: |
|||
ldp x10,fp,[sp],16 // restaur des 2 registres |
|||
ldp x8,x9,[sp],16 // restaur des 2 registres |
|||
ldp x6,x7,[sp],16 // restaur des 2 registres |
|||
ldp x4,x5,[sp],16 // restaur des 2 registres |
|||
ldp x2,x3,[sp],16 // restaur des 2 registres |
|||
ldp x12,lr,[sp],16 // restaur des 2 registres |
|||
ret |
|||
//qAdrsMessCounter: .quad sMessCounter |
|||
qAdrsMessNbSolution: .quad sMessNbSolution |
|||
qAdrsZoneConv: .quad sZoneConv |
|||
/******************************************************************/ |
|||
/* search problem unique solution */ |
|||
/******************************************************************/ |
|||
/* x0 contains start digit */ |
|||
/* x1 contains end digit */ |
|||
/* x2 contains action (0 display 1 count) */ |
|||
searchPb: |
|||
stp x12,lr,[sp,-16]! // save registres |
|||
stp x2,x3,[sp,-16]! // save registres |
|||
stp x4,x5,[sp,-16]! // save registres |
|||
stp x6,x7,[sp,-16]! // save registres |
|||
stp x8,x9,[sp,-16]! // save registres |
|||
stp x10,fp,[sp,-16]! // save registres |
|||
mov x14,x2 // save action |
|||
// init |
|||
ldr x3,qAdrqValues_a // area value a |
|||
mov x4,#0 |
|||
1: // loop init value a |
|||
str x0,[x3,x4,lsl #3] |
|||
add x4,x4,1 |
|||
add x0,x0,1 |
|||
cmp x0,x1 |
|||
ble 1b |
|||
mov x5,#0 // solution counter |
|||
mov x12,#-1 |
|||
2: |
|||
add x12,x12,1 // increment indice a |
|||
cmp x12,#NBBOX-1 |
|||
bgt 90f |
|||
ldr x0,qAdrqValues_a // area value a |
|||
ldr x1,qAdrqValues_b // area value b |
|||
mov x2,x12 // indice a |
|||
mov x3,#NBBOX // number of origin values |
|||
bl prepValues |
|||
mov x11,#-1 |
|||
3: |
|||
add x11,x11,1 // increment indice b |
|||
cmp x11,#NBBOX - 2 |
|||
bgt 2b |
|||
ldr x0,qAdrqValues_b // area value b |
|||
ldr x1,qAdrqValues_c // area value c |
|||
mov x2,x11 // indice b |
|||
mov x3,#NBBOX -1 // number of origin values |
|||
bl prepValues |
|||
mov x10,#-1 |
|||
4: |
|||
add x10,x10,1 |
|||
cmp x10,#NBBOX - 3 |
|||
bgt 3b |
|||
ldr x0,qAdrqValues_c |
|||
ldr x1,qAdrqValues_d |
|||
mov x2,x10 |
|||
mov x3,#NBBOX - 2 |
|||
bl prepValues |
|||
mov x9,#-1 |
|||
5: |
|||
add x9,x9,1 |
|||
cmp x9,#NBBOX - 4 |
|||
bgt 4b |
|||
// control 2 firsts squares |
|||
ldr x0,qAdrqValues_a |
|||
ldr x0,[x0,x12,lsl #3] |
|||
ldr x1,qAdrqValues_b |
|||
ldr x1,[x1,x11,lsl #3] |
|||
add x4,x0,x1 // a + b value first square |
|||
ldr x0,qAdrqValues_c |
|||
ldr x0,[x0,x10,lsl #3] |
|||
add x7,x1,x0 // b + c |
|||
ldr x1,qAdrqValues_d |
|||
ldr x1,[x1,x9,lsl #3] |
|||
add x7,x7,x1 // b + c + d |
|||
cmp x7,x4 // equal first square ? |
|||
bne 5b |
|||
ldr x0,qAdrqValues_d |
|||
ldr x1,qAdrqValues_e |
|||
mov x2,x9 |
|||
mov x3,#NBBOX - 3 |
|||
bl prepValues |
|||
mov x8,#-1 |
|||
6: |
|||
add x8,x8,1 |
|||
cmp x8,#NBBOX - 5 |
|||
bgt 5b |
|||
ldr x0,qAdrqValues_e |
|||
ldr x1,qAdrqValues_f |
|||
mov x2,x8 |
|||
mov x3,#NBBOX - 4 |
|||
bl prepValues |
|||
mov x7,#-1 |
|||
7: |
|||
add x7,x7,1 |
|||
cmp x7,#NBBOX - 6 |
|||
bgt 6b |
|||
ldr x0,qAdrqValues_d |
|||
ldr x0,[x0,x9,lsl #3] |
|||
ldr x1,qAdrqValues_e |
|||
ldr x1,[x1,x8,lsl #3] |
|||
add x3,x0,x1 // d + e |
|||
ldr x1,qAdrqValues_f |
|||
ldr x1,[x1,x7,lsl #3] |
|||
add x3,x3,x1 // d + e + f |
|||
cmp x3,x4 // equal first square ? |
|||
bne 7b |
|||
ldr x0,qAdrqValues_f |
|||
ldr x1,qAdrqValues_g |
|||
mov x2,x7 |
|||
mov x3,#NBBOX - 5 |
|||
bl prepValues |
|||
mov x6,#-1 |
|||
8: |
|||
add x6,x6,1 |
|||
cmp x6,#NBBOX - 7 |
|||
bgt 7b |
|||
ldr x0,qAdrqValues_f |
|||
ldr x0,[x0,x7,lsl #3] |
|||
ldr x1,qAdrqValues_g |
|||
ldr x1,[x1,x6,lsl #3] |
|||
add x3,x0,x1 // f +g |
|||
cmp x4,x3 // equal first square ? |
|||
bne 8b |
|||
add x5,x5,1 // increment counter |
|||
tst x14,#0b1 |
|||
beq 9f // display solution ? |
|||
ldr x0,qAdrqValues_a |
|||
ldr x0,[x0,x12,lsl #3] |
|||
ldr x1,qAdrsZoneConv |
|||
bl conversion10 |
|||
ldr x0,qAdrsMessDeb |
|||
ldr x1,qAdrsZoneConv // insert conversion in message |
|||
bl strInsertAtCharInc |
|||
mov x2,x0 |
|||
ldr x0,qAdrqValues_b |
|||
ldr x0,[x0,x11,lsl #3] |
|||
ldr x1,qAdrsZoneConv |
|||
bl conversion10 |
|||
mov x0,x2 |
|||
ldr x1,qAdrsZoneConv // insert conversion in message |
|||
bl strInsertAtCharInc |
|||
mov x2,x0 |
|||
ldr x0,qAdrqValues_c |
|||
ldr x0,[x0,x10,lsl #3] |
|||
ldr x1,qAdrsZoneConv |
|||
bl conversion10 |
|||
mov x0,x2 |
|||
ldr x1,qAdrsZoneConv // insert conversion in message |
|||
bl strInsertAtCharInc |
|||
mov x2,x0 |
|||
ldr x0,qAdrqValues_d |
|||
ldr x0,[x0,x9,lsl #3] |
|||
ldr x1,qAdrsZoneConv |
|||
bl conversion10 |
|||
mov x0,x2 |
|||
ldr x1,qAdrsZoneConv // insert conversion in message |
|||
bl strInsertAtCharInc |
|||
mov x2,x0 |
|||
ldr x0,qAdrqValues_e |
|||
ldr x0,[x0,x8,lsl #3] |
|||
ldr x1,qAdrsZoneConv |
|||
bl conversion10 |
|||
mov x0,x2 |
|||
ldr x1,qAdrsZoneConv // insert conversion in message |
|||
bl strInsertAtCharInc |
|||
mov x2,x0 |
|||
ldr x0,qAdrqValues_f |
|||
ldr x0,[x0,x7,lsl #3] |
|||
ldr x1,qAdrsZoneConv |
|||
bl conversion10 |
|||
mov x0,x2 |
|||
ldr x1,qAdrsZoneConv // insert conversion in message |
|||
bl strInsertAtCharInc |
|||
mov x2,x0 |
|||
ldr x0,qAdrqValues_g |
|||
ldr x0,[x0,x6,lsl #3] |
|||
ldr x1,qAdrsZoneConv |
|||
bl conversion10 |
|||
mov x0,x2 |
|||
ldr x1,qAdrsZoneConv // insert conversion in message |
|||
bl strInsertAtCharInc |
|||
bl affichageMess |
|||
9: |
|||
b 8b // suite |
|||
90: |
|||
tst x14,#0b10 |
|||
beq 100f // display counter ? |
|||
mov x0,x5 |
|||
ldr x1,qAdrsZoneConv |
|||
bl conversion10 |
|||
ldr x0,qAdrsMessNbSolution |
|||
ldr x1,qAdrsZoneConv // insert conversion in message |
|||
bl strInsertAtCharInc |
|||
bl affichageMess |
|||
100: |
|||
ldp x10,fp,[sp],16 // restaur des 2 registres |
|||
ldp x8,x9,[sp],16 // restaur des 2 registres |
|||
ldp x6,x7,[sp],16 // restaur des 2 registres |
|||
ldp x4,x5,[sp],16 // restaur des 2 registres |
|||
ldp x2,x3,[sp],16 // restaur des 2 registres |
|||
ldp x12,lr,[sp],16 // restaur des 2 registres |
|||
ret |
|||
qAdrqValues_a: .quad qValues_a |
|||
qAdrqValues_b: .quad qValues_b |
|||
qAdrqValues_c: .quad qValues_c |
|||
qAdrqValues_d: .quad qValues_d |
|||
qAdrqValues_e: .quad qValues_e |
|||
qAdrqValues_f: .quad qValues_f |
|||
qAdrqValues_g: .quad qValues_g |
|||
qAdrsMessDeb: .quad sMessDeb |
|||
qAdrqCounterSol: .quad qCounterSol |
|||
/******************************************************************/ |
|||
/* copy value area and substract value of indice */ |
|||
/******************************************************************/ |
|||
/* x0 contains the address of values origin */ |
|||
/* x1 contains the address of values destination */ |
|||
/* x2 contains value indice to substract */ |
|||
/* x3 contains origin values number */ |
|||
prepValues: |
|||
stp x1,lr,[sp,-16]! // save registres |
|||
stp x2,x3,[sp,-16]! // save registres |
|||
stp x4,x5,[sp,-16]! // save registres |
|||
stp x6,x7,[sp,-16]! // save registres |
|||
mov x4,#0 // indice origin value |
|||
mov x5,#0 // indice destination value |
|||
1: |
|||
cmp x4,x2 // substract indice ? |
|||
beq 2f // yes -> jump |
|||
ldr x6,[x0,x4,lsl #3] // no -> copy value |
|||
str x6,[x1,x5,lsl #3] |
|||
add x5,x5,1 // increment destination indice |
|||
2: |
|||
add x4,x4,1 // increment origin indice |
|||
cmp x4,x3 // end ? |
|||
blt 1b |
|||
100: |
|||
ldp x6,x7,[sp],16 // restaur des 2 registres |
|||
ldp x4,x5,[sp],16 // restaur des 2 registres |
|||
ldp x2,x3,[sp],16 // restaur des 2 registres |
|||
ldp x1,lr,[sp],16 // restaur des 2 registres |
|||
ret |
|||
/********************************************************/ |
|||
/* File Include fonctions */ |
|||
/********************************************************/ |
|||
/* for this file see task include a file in language AArch64 assembly */ |
|||
.include "../includeARM64.inc" |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
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= 4 b= 7 c= 1 d= 3 e= 2 f= 6 g= 5 |
|||
*********************** |
|||
a= 5 b= 6 c= 2 d= 3 e= 1 f= 7 g= 4 |
|||
*********************** |
|||
a= 6 b= 4 c= 1 d= 5 e= 2 f= 3 g= 7 |
|||
*********************** |
|||
a= 6 b= 4 c= 5 d= 1 e= 2 f= 7 g= 3 |
|||
*********************** |
|||
a= 7 b= 2 c= 6 d= 1 e= 3 f= 5 g= 4 |
|||
*********************** |
|||
a= 7 b= 3 c= 2 d= 5 e= 1 f= 4 g= 6 |
|||
*********************** |
|||
Number of solutions : 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 |
|||
*********************** |
|||
a= 9 b= 6 c= 4 d= 5 e= 3 f= 7 g= 8 |
|||
*********************** |
|||
a= 9 b= 6 c= 5 d= 4 e= 3 f= 8 g= 7 |
|||
*********************** |
|||
Number of solutions : 4 |
|||
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}}== |
|||
<syntaxhighlight lang="ada">with Ada.Text_IO; |
|||
procedure Puzzle_Square_4 is |
|||
procedure Four_Rings (Low, High : in Natural; Unique, Show : in Boolean) is |
|||
subtype Test_Range is Natural range Low .. High; |
|||
type Value_List is array (Positive range <>) of Natural; |
|||
function Is_Unique (Values : Value_List) return Boolean is |
|||
Count : array (Test_Range) of Natural := (others => 0); |
|||
begin |
|||
for Value of Values loop |
|||
Count (Value) := Count (Value) + 1; |
|||
if Count (Value) > 1 then |
|||
return False; |
|||
end if; |
|||
end loop; |
|||
return True; |
|||
end Is_Unique; |
|||
function Is_Valid (A,B,C,D,E,F,G : in Natural) return Boolean is |
|||
Ring_1 : constant Integer := A + B; |
|||
Ring_2 : constant Integer := B + C + D; |
|||
Ring_3 : constant Integer := D + E + F; |
|||
Ring_4 : constant Integer := F + G; |
|||
begin |
|||
return |
|||
Ring_1 = Ring_2 and |
|||
Ring_1 = Ring_3 and |
|||
Ring_1 = Ring_4; |
|||
end Is_Valid; |
|||
use Ada.Text_IO; |
|||
Count : Natural := 0; |
|||
begin |
|||
for A in Test_Range loop |
|||
for B in Test_Range loop |
|||
for C in Test_Range loop |
|||
for D in Test_Range loop |
|||
for E in Test_Range loop |
|||
for F in Test_Range loop |
|||
for G in Test_Range loop |
|||
if Is_Valid (A,B,C,D,E,F,G) then |
|||
if not Unique or (Unique and Is_Unique ((A,B,C,D,E,F,G))) then |
|||
Count := Count + 1; |
|||
if Show then |
|||
Put_Line (A'Image & B'Image & C'Image & D'Image & E'Image & F'Image & G'Image); |
|||
end if; |
|||
end if; |
|||
end if; |
|||
end loop; |
|||
end loop; |
|||
end loop; |
|||
end loop; |
|||
end loop; |
|||
end loop; |
|||
end loop; |
|||
Put_Line ("There are " & Count'Image & |
|||
(if Unique then " unique " else " non-unique ") & |
|||
"solutions in " & Low'Image & " .." & High'Image); |
|||
New_Line; |
|||
end Four_Rings; |
|||
begin |
|||
Four_Rings (Low => 1, High => 7, Unique => True, Show => True); |
|||
Four_Rings (Low => 3, High => 9, Unique => True, Show => True); |
|||
Four_Rings (Low => 0, High => 9, Unique => False, Show => False); |
|||
end Puzzle_Square_4;</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 |
|||
There are 8 unique solutions in 1 .. 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 |
|||
There are 4 unique solutions in 3 .. 9 |
|||
There are 2860 non-unique solutions in 0 .. 9 |
|||
</pre> |
|||
=={{header|ALGOL 68}}== |
=={{header|ALGOL 68}}== |
||
As with the REXX solution, we use explicit loops to generate the permutations. |
As with the REXX solution, we use explicit loops to generate the permutations. |
||
< |
<syntaxhighlight lang="algol68">BEGIN |
||
# solve the 4 rings or 4 squares puzzle # |
# 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 # |
# 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 ) # |
# where a, b, c, d, e, f, g in lo : hi ( not necessarily unique ) # |
||
# depending on show, the solutions will be printed or not # |
# depending on show, the solutions will be printed or not # |
||
PROC four rings = ( INT lo, hi, BOOL |
PROC four rings = ( INT lo, hi, BOOL allow duplicates, show )VOID: |
||
BEGIN |
BEGIN |
||
INT solutions := 0; |
INT solutions := 0; |
||
BOOL allow duplicates = NOT unique; |
|||
# calculate field width for printinhg solutions # |
# calculate field width for printinhg solutions # |
||
INT width := -1; |
INT width := -1; |
||
Line 68: | Line 744: | ||
FOR c FROM lo TO hi DO |
FOR c FROM lo TO hi DO |
||
IF allow duplicates OR ( a /= c AND b /= c ) THEN |
IF allow duplicates OR ( a /= c AND b /= c ) THEN |
||
INT d = t - ( b + c ); |
|||
IF d >= lo AND d <= hi |
|||
AND ( allow duplicates |
|||
OR ( a /= d AND b /= d AND c /= d ) |
|||
) |
|||
THEN |
|||
FOR e FROM lo TO hi DO |
|||
IF allow duplicates |
|||
OR ( a /= e AND b /= e AND c /= e AND d /= e ) |
|||
THEN |
|||
INT g = d + e; |
|||
INT f = t - g; |
|||
IF f >= lo AND f <= hi |
|||
AND g >= lo AND g <= hi |
|||
AND ( allow duplicates |
|||
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 |
|||
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 |
|||
OD # f # |
|||
FI |
FI |
||
FI |
|||
FI |
FI |
||
OD # e # |
|||
FI |
|||
FI |
FI |
||
OD # c # |
OD # c # |
||
Line 112: | Line 785: | ||
OD # a # ; |
OD # a # ; |
||
print( ( whole( solutions, 0 ) |
print( ( whole( solutions, 0 ) |
||
, IF |
, IF allow duplicates THEN " non-unique" ELSE " unique" FI |
||
, " solutions in " |
, " solutions in " |
||
, whole( lo, 0 ) |
, whole( lo, 0 ) |
||
Line 124: | Line 797: | ||
# find the solutions as required for the task # |
# find the solutions as required for the task # |
||
four rings( 1, 7, |
four rings( 1, 7, FALSE, TRUE ); |
||
four rings( 3, 9, |
four rings( 3, 9, FALSE, TRUE ); |
||
four rings( 0, 9, |
four rings( 0, 9, TRUE, FALSE ) |
||
END</ |
END</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
Line 147: | Line 820: | ||
2860 non-unique solutions in 0 to 9 |
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> |
</pre> |
||
Line 153: | Line 919: | ||
{{Trans|Haskell}} |
{{Trans|Haskell}} |
||
(Structured search example) |
(Structured search example) |
||
< |
<syntaxhighlight lang="applescript">use framework "Foundation" -- for basic NSArray sort |
||
on run |
on run |
||
Line 459: | Line 1,225: | ||
on unlines(xs) |
on unlines(xs) |
||
intercalate(linefeed, xs) |
intercalate(linefeed, xs) |
||
end unlines</ |
end unlines</syntaxhighlight> |
||
{{Out}} |
{{Out}} |
||
<pre>rings(true, enumFromTo(1, 7)) |
<pre>rings(true, enumFromTo(1, 7)) |
||
Line 482: | Line 1,248: | ||
2860</pre> |
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 */ |
|||
/* program square4.s */ |
|||
/************************************/ |
|||
/* Constantes */ |
|||
/************************************/ |
|||
.equ STDOUT, 1 @ Linux output console |
|||
.equ EXIT, 1 @ Linux syscall |
|||
.equ WRITE, 4 @ Linux syscall |
|||
.equ NBBOX, 7 |
|||
/*********************************/ |
|||
/* Initialized data */ |
|||
/*********************************/ |
|||
.data |
|||
sMessDeb: .ascii "a=" |
|||
sMessValeur_a: .fill 11, 1, ' ' @ size => 11 |
|||
.ascii "b=" |
|||
sMessValeur_b: .fill 11, 1, ' ' @ size => 11 |
|||
.ascii "c=" |
|||
sMessValeur_c: .fill 11, 1, ' ' @ size => 11 |
|||
.ascii "d=" |
|||
sMessValeur_d: .fill 11, 1, ' ' @ size => 11 |
|||
.ascii "\n" |
|||
.ascii "e=" |
|||
sMessValeur_e: .fill 11, 1, ' ' @ size => 11 |
|||
.ascii "f=" |
|||
sMessValeur_f: .fill 11, 1, ' ' @ size => 11 |
|||
.ascii "g=" |
|||
sMessValeur_g: .fill 11, 1, ' ' @ size => 11 |
|||
szCarriageReturn: .asciz "\n************************\n" |
|||
sMessNbSolution: .ascii "Number of solutions :" |
|||
sMessCounter: .fill 11, 1, ' ' @ size => 11 |
|||
.asciz "\n\n\n" |
|||
/*********************************/ |
|||
/* UnInitialized data */ |
|||
/*********************************/ |
|||
.bss |
|||
.align 4 |
|||
iValues_a: .skip 4 * NBBOX |
|||
iValues_b: .skip 4 * NBBOX - 1 |
|||
iValues_c: .skip 4 * NBBOX - 2 |
|||
iValues_d: .skip 4 * NBBOX - 3 |
|||
iValues_e: .skip 4 * NBBOX - 4 |
|||
iValues_f: .skip 4 * NBBOX - 5 |
|||
iValues_g: .skip 4 * NBBOX - 6 |
|||
iCounterSol: .skip 4 |
|||
/*********************************/ |
|||
/* code section */ |
|||
/*********************************/ |
|||
.text |
|||
.global main |
|||
main: @ entry of program |
|||
mov r0,#1 |
|||
mov r1,#7 |
|||
mov r2,#3 @ 0 = rien 1 = display 2 = count 3 = les deux |
|||
bl searchPb |
|||
mov r0,#3 |
|||
mov r1,#9 |
|||
mov r2,#3 @ 0 = rien 1 = display 2 = count 3 = les deux |
|||
bl searchPb |
|||
mov r0,#0 |
|||
mov r1,#9 |
|||
mov r2,#2 @ 0 = rien 1 = display 2 = count 3 = les deux |
|||
bl prepSearchNU |
|||
100: @ standard end of the program |
|||
mov r0, #0 @ return code |
|||
mov r7, #EXIT @ request to exit program |
|||
svc #0 @ perform the system call |
|||
iAdrszCarriageReturn: .int szCarriageReturn |
|||
/******************************************************************/ |
|||
/* search problèm value not unique */ |
|||
/******************************************************************/ |
|||
/* r0 contains start digit */ |
|||
/* r1 contains end digit */ |
|||
/* r2 contains action (0 display 1 count) */ |
|||
prepSearchNU: |
|||
push {r3-r12,lr} @ save registers |
|||
mov r5,#0 @ counter |
|||
mov r12,r0 @ a |
|||
1: |
|||
mov r11,r0 @ b |
|||
2: |
|||
mov r10,r0 @ c |
|||
3: |
|||
mov r9,r0 @ d |
|||
4: |
|||
add r4,r12,r11 @ a + b reference |
|||
add r3,r11,r10 |
|||
add r3,r9 @ b + c + d |
|||
cmp r4,r3 |
|||
bne 10f |
|||
mov r8,r0 @ e |
|||
5: |
|||
mov r7,r0 @ f |
|||
6: |
|||
add r3,r9,r8 |
|||
add r3,r7 @ d + e + f |
|||
cmp r3,r4 |
|||
bne 9f |
|||
mov r6,r0 @ g |
|||
7: |
|||
add r3,r7,r6 @ f + g |
|||
cmp r3,r4 |
|||
bne 8f @ not OK |
|||
@ OK |
|||
add r5,#1 @ increment counter |
|||
8: |
|||
add r6,#1 @ increment g |
|||
cmp r6,r1 |
|||
ble 7b |
|||
9: |
|||
add r7,#1 @ increment f |
|||
cmp r7,r1 |
|||
ble 6b |
|||
add r8,#1 @ increment e |
|||
cmp r8,r1 |
|||
ble 5b |
|||
10: |
|||
add r9,#1 @ increment d |
|||
cmp r9,r1 |
|||
ble 4b |
|||
add r10,#1 @ increment c |
|||
cmp r10,r1 |
|||
ble 3b |
|||
add r11,#1 @ increment b |
|||
cmp r11,r1 |
|||
ble 2b |
|||
add r12,#1 @ increment a |
|||
cmp r12,r1 |
|||
ble 1b |
|||
@ end |
|||
tst r2,#0b10 @ print count ? |
|||
beq 100f |
|||
mov r0,r5 @ counter |
|||
ldr r1,iAdrsMessCounter |
|||
bl conversion10 |
|||
ldr r0,iAdrsMessNbSolution |
|||
bl affichageMess |
|||
100: |
|||
pop {r3-r12,lr} @ restaur registers |
|||
bx lr @return |
|||
iAdrsMessCounter: .int sMessCounter |
|||
iAdrsMessNbSolution: .int sMessNbSolution |
|||
/******************************************************************/ |
|||
/* search problem unique solution */ |
|||
/******************************************************************/ |
|||
/* r0 contains start digit */ |
|||
/* r1 contains end digit */ |
|||
/* r2 contains action (0 display 1 count) */ |
|||
searchPb: |
|||
push {r0-r12,lr} @ save registers |
|||
@ init |
|||
ldr r3,iAdriValues_a @ area value a |
|||
mov r4,#0 |
|||
1: @ loop init value a |
|||
str r0,[r3,r4,lsl #2] |
|||
add r4,#1 |
|||
add r0,#1 |
|||
cmp r0,r1 |
|||
ble 1b |
|||
mov r5,#0 @ solution counter |
|||
mov r12,#-1 |
|||
2: |
|||
add r12,#1 @ increment indice a |
|||
cmp r12,#NBBOX-1 |
|||
bgt 90f |
|||
ldr r0,iAdriValues_a @ area value a |
|||
ldr r1,iAdriValues_b @ area value b |
|||
mov r2,r12 @ indice a |
|||
mov r3,#NBBOX @ number of origin values |
|||
bl prepValues |
|||
mov r11,#-1 |
|||
3: |
|||
add r11,#1 @ increment indice b |
|||
cmp r11,#NBBOX - 2 |
|||
bgt 2b |
|||
ldr r0,iAdriValues_b @ area value b |
|||
ldr r1,iAdriValues_c @ area value c |
|||
mov r2,r11 @ indice b |
|||
mov r3,#NBBOX -1 @ number of origin values |
|||
bl prepValues |
|||
mov r10,#-1 |
|||
4: |
|||
add r10,#1 |
|||
cmp r10,#NBBOX - 3 |
|||
bgt 3b |
|||
ldr r0,iAdriValues_c |
|||
ldr r1,iAdriValues_d |
|||
mov r2,r10 |
|||
mov r3,#NBBOX - 2 |
|||
bl prepValues |
|||
mov r9,#-1 |
|||
5: |
|||
add r9,#1 |
|||
cmp r9,#NBBOX - 4 |
|||
bgt 4b |
|||
@ control 2 firsts squares |
|||
ldr r0,iAdriValues_a |
|||
ldr r0,[r0,r12,lsl #2] |
|||
ldr r1,iAdriValues_b |
|||
ldr r1,[r1,r11,lsl #2] |
|||
add r4,r0,r1 @ a + b value first square |
|||
ldr r0,iAdriValues_c |
|||
ldr r0,[r0,r10,lsl #2] |
|||
add r7,r1,r0 @ b + c |
|||
ldr r1,iAdriValues_d |
|||
ldr r1,[r1,r9,lsl #2] |
|||
add r7,r1 @ b + c + d |
|||
cmp r7,r4 @ equal first square ? |
|||
bne 5b |
|||
ldr r0,iAdriValues_d |
|||
ldr r1,iAdriValues_e |
|||
mov r2,r9 |
|||
mov r3,#NBBOX - 3 |
|||
bl prepValues |
|||
mov r8,#-1 |
|||
6: |
|||
add r8,#1 |
|||
cmp r8,#NBBOX - 5 |
|||
bgt 5b |
|||
ldr r0,iAdriValues_e |
|||
ldr r1,iAdriValues_f |
|||
mov r2,r8 |
|||
mov r3,#NBBOX - 4 |
|||
bl prepValues |
|||
mov r7,#-1 |
|||
7: |
|||
add r7,#1 |
|||
cmp r7,#NBBOX - 6 |
|||
bgt 6b |
|||
ldr r0,iAdriValues_d |
|||
ldr r0,[r0,r9,lsl #2] |
|||
ldr r1,iAdriValues_e |
|||
ldr r1,[r1,r8,lsl #2] |
|||
add r3,r0,r1 @ d + e |
|||
ldr r1,iAdriValues_f |
|||
ldr r1,[r1,r7,lsl #2] |
|||
add r3,r1 @ de + e + f |
|||
cmp r3,r4 @ equal first square ? |
|||
bne 7b |
|||
ldr r0,iAdriValues_f |
|||
ldr r1,iAdriValues_g |
|||
mov r2,r7 |
|||
mov r3,#NBBOX - 5 |
|||
bl prepValues |
|||
mov r6,#-1 |
|||
8: |
|||
add r6,#1 |
|||
cmp r6,#NBBOX - 7 |
|||
bgt 7b |
|||
ldr r0,iAdriValues_f |
|||
ldr r0,[r0,r7,lsl #2] |
|||
ldr r1,iAdriValues_g |
|||
ldr r1,[r1,r6,lsl #2] |
|||
add r3,r0,r1 @ f +g |
|||
cmp r4,r3 @ equal first square ? |
|||
bne 8b |
|||
add r5,#1 @ increment counter |
|||
ldr r0,[sp,#8] @ load action for two parameter in stack |
|||
tst r0,#0b1 |
|||
beq 9f @ display solution ? |
|||
ldr r0,iAdriValues_a |
|||
ldr r0,[r0,r12,lsl #2] |
|||
ldr r1,iAdrsMessValeur_a |
|||
bl conversion10 |
|||
ldr r0,iAdriValues_b |
|||
ldr r0,[r0,r11,lsl #2] |
|||
ldr r1,iAdrsMessValeur_b |
|||
bl conversion10 |
|||
ldr r0,iAdriValues_c |
|||
ldr r0,[r0,r10,lsl #2] |
|||
ldr r1,iAdrsMessValeur_c |
|||
bl conversion10 |
|||
ldr r0,iAdriValues_d |
|||
ldr r0,[r0,r9,lsl #2] |
|||
ldr r1,iAdrsMessValeur_d |
|||
bl conversion10 |
|||
ldr r0,iAdriValues_e |
|||
ldr r0,[r0,r8,lsl #2] |
|||
ldr r1,iAdrsMessValeur_e |
|||
bl conversion10 |
|||
ldr r0,iAdriValues_f |
|||
ldr r0,[r0,r7,lsl #2] |
|||
ldr r1,iAdrsMessValeur_f |
|||
bl conversion10 |
|||
ldr r0,iAdriValues_g |
|||
ldr r0,[r0,r6,lsl #2] |
|||
ldr r1,iAdrsMessValeur_g |
|||
bl conversion10 |
|||
ldr r0,iAdrsMessDeb |
|||
bl affichageMess |
|||
9: |
|||
b 8b @ suite |
|||
90: |
|||
ldr r0,[sp,#8] @ load action for two parameter in stack |
|||
tst r0,#0b10 |
|||
beq 100f @ display counter ? |
|||
mov r0,r5 |
|||
ldr r1,iAdrsMessCounter |
|||
bl conversion10 |
|||
ldr r0,iAdrsMessNbSolution |
|||
bl affichageMess |
|||
100: |
|||
pop {r0-r12,lr} @ restaur registers |
|||
bx lr @return |
|||
iAdriValues_a: .int iValues_a |
|||
iAdriValues_b: .int iValues_b |
|||
iAdriValues_c: .int iValues_c |
|||
iAdriValues_d: .int iValues_d |
|||
iAdriValues_e: .int iValues_e |
|||
iAdriValues_f: .int iValues_f |
|||
iAdriValues_g: .int iValues_g |
|||
iAdrsMessValeur_a: .int sMessValeur_a |
|||
iAdrsMessValeur_b: .int sMessValeur_b |
|||
iAdrsMessValeur_c: .int sMessValeur_c |
|||
iAdrsMessValeur_d: .int sMessValeur_d |
|||
iAdrsMessValeur_e: .int sMessValeur_e |
|||
iAdrsMessValeur_f: .int sMessValeur_f |
|||
iAdrsMessValeur_g: .int sMessValeur_g |
|||
iAdrsMessDeb: .int sMessDeb |
|||
iAdriCounterSol: .int iCounterSol |
|||
/******************************************************************/ |
|||
/* copy value area and substract value of indice */ |
|||
/******************************************************************/ |
|||
/* r0 contains the address of values origin */ |
|||
/* r1 contains the address of values destination */ |
|||
/* r2 contains value indice to substract */ |
|||
/* r3 contains origin values number */ |
|||
prepValues: |
|||
push {r1-r6,lr} @ save registres |
|||
mov r4,#0 @ indice origin value |
|||
mov r5,#0 @ indice destination value |
|||
1: |
|||
cmp r4,r2 @ substract indice ? |
|||
beq 2f @ yes -> jump |
|||
ldr r6,[r0,r4,lsl #2] @ no -> copy value |
|||
str r6,[r1,r5,lsl #2] |
|||
add r5,#1 @ increment destination indice |
|||
2: |
|||
add r4,#1 @ increment origin indice |
|||
cmp r4,r3 @ end ? |
|||
blt 1b |
|||
100: |
|||
pop {r1-r6,lr} @ restaur registres |
|||
bx lr @return |
|||
/******************************************************************/ |
|||
/* display text with size calculation */ |
|||
/******************************************************************/ |
|||
/* r0 contains the address of the message */ |
|||
affichageMess: |
|||
push {r0,r1,r2,r7,lr} @ save registres |
|||
mov r2,#0 @ counter length |
|||
1: @ loop length calculation |
|||
ldrb r1,[r0,r2] @ read octet start position + index |
|||
cmp r1,#0 @ if 0 its over |
|||
addne r2,r2,#1 @ else add 1 in the length |
|||
bne 1b @ and loop |
|||
@ so here r2 contains the length of the message |
|||
mov r1,r0 @ address message in r1 |
|||
mov r0,#STDOUT @ code to write to the standard output Linux |
|||
mov r7, #WRITE @ code call system "write" |
|||
svc #0 @ call systeme |
|||
pop {r0,r1,r2,r7,lr} @ restaur des 2 registres */ |
|||
bx lr @ return |
|||
/******************************************************************/ |
|||
/* Converting a register to a decimal unsigned */ |
|||
/******************************************************************/ |
|||
/* r0 contains value and r1 address area */ |
|||
/* r0 return size of result (no zero final in area) */ |
|||
/* area size => 11 bytes */ |
|||
.equ LGZONECAL, 10 |
|||
conversion10: |
|||
push {r1-r4,lr} @ save registers |
|||
mov r3,r1 |
|||
mov r2,#LGZONECAL |
|||
1: @ start loop |
|||
bl divisionpar10U @ unsigned r0 <- dividende. quotient ->r0 reste -> r1 |
|||
add r1,#48 @ digit |
|||
strb r1,[r3,r2] @ store digit on area |
|||
cmp r0,#0 @ stop if quotient = 0 |
|||
subne r2,#1 @ else previous position |
|||
bne 1b @ and loop |
|||
@ and move digit from left of area |
|||
mov r4,#0 |
|||
2: |
|||
ldrb r1,[r3,r2] |
|||
strb r1,[r3,r4] |
|||
add r2,#1 |
|||
add r4,#1 |
|||
cmp r2,#LGZONECAL |
|||
ble 2b |
|||
@ and move spaces in end on area |
|||
mov r0,r4 @ result length |
|||
mov r1,#' ' @ space |
|||
3: |
|||
strb r1,[r3,r4] @ store space in area |
|||
add r4,#1 @ next position |
|||
cmp r4,#LGZONECAL |
|||
ble 3b @ loop if r4 <= area size |
|||
100: |
|||
pop {r1-r4,lr} @ restaur registres |
|||
bx lr @return |
|||
/***************************************************/ |
|||
/* division par 10 unsigned */ |
|||
/***************************************************/ |
|||
/* r0 dividende */ |
|||
/* r0 quotient */ |
|||
/* r1 remainder */ |
|||
divisionpar10U: |
|||
push {r2,r3,r4, lr} |
|||
mov r4,r0 @ save value |
|||
ldr r3,iMagicNumber @ r3 <- magic_number raspberry 1 2 |
|||
umull r1, r2, r3, r0 @ r1<- Lower32Bits(r1*r0) r2<- Upper32Bits(r1*r0) |
|||
mov r0, r2, LSR #3 @ r2 <- r2 >> shift 3 |
|||
add r2,r0,r0, lsl #2 @ r2 <- r0 * 5 |
|||
sub r1,r4,r2, lsl #1 @ r1 <- r4 - (r2 * 2) = r4 - (r0 * 10) |
|||
pop {r2,r3,r4,lr} |
|||
bx lr @ leave function |
|||
iMagicNumber: .int 0xCCCCCCCD |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
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=4 b=7 c=1 d=3 |
|||
e=2 f=6 g=5 |
|||
************************ |
|||
a=5 b=6 c=2 d=3 |
|||
e=1 f=7 g=4 |
|||
************************ |
|||
a=6 b=4 c=1 d=5 |
|||
e=2 f=3 g=7 |
|||
************************ |
|||
a=6 b=4 c=5 d=1 |
|||
e=2 f=7 g=3 |
|||
************************ |
|||
a=7 b=2 c=6 d=1 |
|||
e=3 f=5 g=4 |
|||
************************ |
|||
a=7 b=3 c=2 d=5 |
|||
e=1 f=4 g=6 |
|||
************************ |
|||
Number of solutions :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 |
|||
************************ |
|||
a=9 b=6 c=4 d=5 |
|||
e=3 f=7 g=8 |
|||
************************ |
|||
a=9 b=6 c=5 d=4 |
|||
e=3 f=8 g=7 |
|||
************************ |
|||
Number of solutions :4 |
|||
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 |
|||
BEGIN { |
|||
cmd = "SORT /+16" |
|||
four_squares(1,7,1,1) |
|||
four_squares(3,9,1,1) |
|||
four_squares(0,9,0,0) |
|||
four_squares(0,6,1,0) |
|||
four_squares(2,8,1,0) |
|||
exit(0) |
|||
} |
|||
function four_squares(plo,phi,punique,pshow) { |
|||
lo = plo |
|||
hi = phi |
|||
unique = punique |
|||
show = pshow |
|||
solutions = 0 |
|||
print("") |
|||
if (show) { |
|||
print("A B C D E F G sum A+B B+C+D D+E+F F+G") |
|||
print("------------- --- -------------------") |
|||
} |
|||
acd() |
|||
close(cmd) |
|||
tmp = (unique) ? "unique" : "non-unique" |
|||
printf("%d-%d: %d %s solutions\n",lo,hi,solutions,tmp) |
|||
} |
|||
function acd() { |
|||
for (c=lo; c<=hi; c++) { |
|||
for (d=lo; d<=hi; d++) { |
|||
if (!unique || c != d) { |
|||
a = c + d |
|||
if (a >= lo && a <= hi && (!unique || (c != 0 && d != 0))) { |
|||
ge() |
|||
} |
|||
} |
|||
} |
|||
} |
|||
} |
|||
function bf() { |
|||
for (f=lo; f<=hi; f++) { |
|||
if (!unique || (f != a && f != c && f != d && f != g && f != e)) { |
|||
b = e + f - c |
|||
if (b >= lo && b <= hi && (!unique || (b != a && b != c && b != d && b != g && b != e && b != f))) { |
|||
solutions++ |
|||
if (show) { |
|||
printf("%d %d %d %d %d %d %d %4d ",a,b,c,d,e,f,g,a+b) | cmd |
|||
printf("%d+%d ",a,b) | cmd |
|||
printf("%d+%d+%d ",b,c,d) | cmd |
|||
printf("%d+%d+%d ",d,e,f) | cmd |
|||
printf("%d+%d\n",f,g) | cmd |
|||
} |
|||
} |
|||
} |
|||
} |
|||
} |
|||
function ge() { |
|||
for (e=lo; e<=hi; e++) { |
|||
if (!unique || (e != a && e != c && e != d)) { |
|||
g = d + e |
|||
if (g >= lo && g <= hi && (!unique || (g != a && g != c && g != d && g != e))) { |
|||
bf() |
|||
} |
|||
} |
|||
} |
|||
} |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
A B C D E F G sum A+B B+C+D D+E+F F+G |
|||
------------- --- ------------------- |
|||
4 5 3 1 6 2 7 9 4+5 5+3+1 1+6+2 2+7 |
|||
7 2 6 1 3 5 4 9 7+2 2+6+1 1+3+5 5+4 |
|||
3 7 2 1 5 4 6 10 3+7 7+2+1 1+5+4 4+6 |
|||
6 4 1 5 2 3 7 10 6+4 4+1+5 5+2+3 3+7 |
|||
6 4 5 1 2 7 3 10 6+4 4+5+1 1+2+7 7+3 |
|||
7 3 2 5 1 4 6 10 7+3 3+2+5 5+1+4 4+6 |
|||
4 7 1 3 2 6 5 11 4+7 7+1+3 3+2+6 6+5 |
|||
5 6 2 3 1 7 4 11 5+6 6+2+3 3+1+7 7+4 |
|||
1-7: 8 unique solutions |
|||
A B C D E F G sum A+B B+C+D D+E+F F+G |
|||
------------- --- ------------------- |
|||
7 8 3 4 5 6 9 15 7+8 8+3+4 4+5+6 6+9 |
|||
8 7 3 5 4 6 9 15 8+7 7+3+5 5+4+6 6+9 |
|||
9 6 4 5 3 7 8 15 9+6 6+4+5 5+3+7 7+8 |
|||
9 6 5 4 3 8 7 15 9+6 6+5+4 4+3+8 8+7 |
|||
3-9: 4 unique solutions |
|||
0-9: 2860 non-unique solutions |
|||
0-6: 4 unique solutions |
|||
2-8: 8 unique solutions |
|||
</pre> |
|||
=={{header|BASIC256}}== |
|||
<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. |
|||
<syntaxhighlight lang="befunge">550" :woL">:#,_&>00p" :hgiH">:#,_&>1+10p" :)n/y( euqinU">:#,_>~>:4v |
|||
v!g03!:\*`\g01\!`\g00:p05:+g03:p04:_$30g1+:10g\`v1g<,+$p02%2_|#`*8< |
|||
>>+\30g-!+20g*!*00g\#v_$40g1+:10g\`^<<1g00p03<<<_$55+:,\."snoitul"v |
|||
v!`\g00::p07:+g04p06:<^<`\g01:+1g06$<_v#!\g00*!*g02++!-g05< v"so"< |
|||
>\10g\`*\:::30g-!\40g-!+\50g-!+\60g-! +60g::30g-!\40g-!+\^ >:#,_@ |
|||
>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^^></syntaxhighlight> |
|||
{{out}} |
|||
<pre>Low: 1 |
|||
High: 7 |
|||
Unique (y/n): y |
|||
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 solutions</pre> |
|||
<pre>Low: 3 |
|||
High: 9 |
|||
Unique (y/n): y |
|||
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 solutions</pre> |
|||
<pre>Low: 0 |
|||
High: 9 |
|||
Unique (y/n): n |
|||
2860 solutions</pre> |
|||
=={{header|C}}== |
=={{header|C}}== |
||
<syntaxhighlight lang="c"> |
|||
<lang C> |
|||
#include <stdio.h> |
#include <stdio.h> |
||
Line 568: | Line 2,159: | ||
foursquares(0,9,FALSE,FALSE); |
foursquares(0,9,FALSE,FALSE); |
||
} |
} |
||
</syntaxhighlight> |
|||
</lang> |
|||
Output |
Output |
||
<pre> |
<pre> |
||
Line 592: | Line 2,183: | ||
2860 non-unique solutions in 0 to 9 |
2860 non-unique solutions in 0 to 9 |
||
</pre> |
|||
=={{header|C sharp|C#}}== |
|||
{{trans|Java}} |
|||
<syntaxhighlight lang="csharp">using System; |
|||
using System.Linq; |
|||
namespace Four_Squares_Puzzle { |
|||
class Program { |
|||
static void Main(string[] args) { |
|||
fourSquare(1, 7, true, true); |
|||
fourSquare(3, 9, true, true); |
|||
fourSquare(0, 9, false, false); |
|||
} |
|||
private static void fourSquare(int low, int high, bool unique, bool print) { |
|||
int count = 0; |
|||
if (print) { |
|||
Console.WriteLine("a b c d e f g"); |
|||
} |
|||
for (int a = low; a <= high; ++a) { |
|||
for (int b = low; b <= high; ++b) { |
|||
if (notValid(unique, b, a)) continue; |
|||
int fp = a + b; |
|||
for (int c = low; c <= high; ++c) { |
|||
if (notValid(unique, c, b, a)) continue; |
|||
for (int d = low; d <= high; ++d) { |
|||
if (notValid(unique, d, c, b, a)) continue; |
|||
if (fp != b + c + d) continue; |
|||
for (int e = low; e <= high; ++e) { |
|||
if (notValid(unique, e, d, c, b, a)) continue; |
|||
for (int f = low; f <= high; ++f) { |
|||
if (notValid(unique, f, e, d, c, b, a)) continue; |
|||
if (fp != d + e + f) continue; |
|||
for (int g = low; g <= high; ++g) { |
|||
if (notValid(unique, g, f, e, d, c, b, a)) continue; |
|||
if (fp != f + g) continue; |
|||
++count; |
|||
if (print) { |
|||
Console.WriteLine("{0} {1} {2} {3} {4} {5} {6}", a, b, c, d, e, f, g); |
|||
} |
|||
} |
|||
} |
|||
} |
|||
} |
|||
} |
|||
} |
|||
} |
|||
if (unique) { |
|||
Console.WriteLine("There are {0} unique solutions in [{1}, {2}]", count, low, high); |
|||
} |
|||
else { |
|||
Console.WriteLine("There are {0} non-unique solutions in [{1}, {2}]", count, low, high); |
|||
} |
|||
} |
|||
private static bool notValid(bool unique, int needle, params int[] haystack) { |
|||
return unique && haystack.Any(p => p == needle); |
|||
} |
|||
} |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre>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 |
|||
There are 8 unique solutions in [1, 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 |
|||
There are 4 unique solutions in [3, 9] |
|||
There are 2860 non-unique solutions in [0, 9]</pre> |
|||
=={{header|C++}}== |
|||
<syntaxhighlight lang="cpp"> |
|||
//C++14/17 |
|||
#include <algorithm>//std::for_each |
|||
#include <iostream> //std::cout |
|||
#include <numeric> //std::iota |
|||
#include <vector> //std::vector, save solutions |
|||
#include <list> //std::list, for fast erase |
|||
using std::begin, std::end, std::for_each; |
|||
//Generates all the valid solutions for the problem in the specified range [from, to) |
|||
std::list<std::vector<int>> combinations(int from, int to) |
|||
{ |
|||
if (from > to) |
|||
return {}; //Return nothing if limits are invalid |
|||
auto pool = std::vector<int>(to - from);//Here we'll save our values |
|||
std::iota(begin(pool), end(pool), from);//Populates pool |
|||
auto solutions = std::list<std::vector<int>>{}; //List for the solutions |
|||
//Brute-force calculation of valid values... |
|||
for (auto a : pool) |
|||
for (auto b : pool) |
|||
for (auto c : pool) |
|||
for (auto d : pool) |
|||
for (auto e : pool) |
|||
for (auto f : pool) |
|||
for (auto g : pool) |
|||
if ( a == c + d |
|||
&& b + c == e + f |
|||
&& d + e == g ) |
|||
solutions.push_back({a, b, c, d, e, f, g}); |
|||
return solutions; |
|||
} |
|||
//Filter the list generated from "combinations" and return only lists with no repetitions |
|||
std::list<std::vector<int>> filter_unique(int from, int to) |
|||
{ |
|||
//Helper lambda to check repetitions: |
|||
//If the count is > 1 for an element, there must be a repetition inside the range |
|||
auto has_non_unique_values = [](const auto & range, auto target) |
|||
{ |
|||
return std::count( begin(range), end(range), target) > 1; |
|||
}; |
|||
//Generates all the solutions... |
|||
auto results = combinations(from, to); |
|||
//For each solution, find duplicates inside |
|||
for (auto subrange = cbegin(results); subrange != cend(results); ++subrange) |
|||
{ |
|||
bool repetition = false; |
|||
//If some element is repeated, repetition becomes true |
|||
for (auto x : *subrange) |
|||
repetition |= has_non_unique_values(*subrange, x); |
|||
if (repetition) //If repetition is true, remove the current subrange from the list |
|||
{ |
|||
results.erase(subrange); //Deletes subrange from solutions |
|||
--subrange; //Rewind to the last subrange analysed |
|||
} |
|||
} |
|||
return results; //Finally return remaining results |
|||
} |
|||
template <class Container> //Template for the sake of simplicity |
|||
inline void print_range(const Container & c) |
|||
{ |
|||
for (const auto & subrange : c) |
|||
{ |
|||
std::cout << "["; |
|||
for (auto elem : subrange) |
|||
std::cout << elem << ' '; |
|||
std::cout << "\b]\n"; |
|||
} |
|||
} |
|||
int main() |
|||
{ |
|||
std::cout << "Unique-numbers combinations in range 1-7:\n"; |
|||
auto solution1 = filter_unique(1, 8); |
|||
print_range(solution1); |
|||
std::cout << "\nUnique-numbers combinations in range 3-9:\n"; |
|||
auto solution2 = filter_unique(3,10); |
|||
print_range(solution2); |
|||
std::cout << "\nNumber of combinations in range 0-9: " |
|||
<< combinations(0, 10).size() << "." << std::endl; |
|||
return 0; |
|||
} |
|||
</syntaxhighlight> |
|||
Output |
|||
<pre> |
|||
Unique-numbers combinations in range 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 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] |
|||
Unique-numbers combinations in range 3-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] |
|||
Number of combinations in range 0-9: 2860. |
|||
</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}}== |
|||
<syntaxhighlight lang="clojure">(use '[clojure.math.combinatorics] |
|||
(defn rings [r & {:keys [unique] :or {unique true}}] |
|||
(if unique |
|||
(apply concat (map permutations (combinations r 7))) |
|||
(selections r 7))) |
|||
(defn four-rings [low high & {:keys [unique] :or {unique true}}] |
|||
(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}} |
|||
<pre> |
|||
=> (pprint (four-rings 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 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]) |
|||
nil |
|||
=> (pprint (four-rings 3 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]) |
|||
nil |
|||
=> (count (four-rings 0 9 :unique false)) |
|||
2860 |
|||
</pre> |
</pre> |
||
=={{header|Common Lisp}}== |
=={{header|Common Lisp}}== |
||
< |
<syntaxhighlight lang="lisp"> |
||
(defpackage four-rings |
(defpackage four-rings |
||
(:use common-lisp) |
(:use common-lisp) |
||
Line 631: | Line 2,525: | ||
(format t "Number of solutions for Low 0, High 9 non-unique:~%~A~%" |
(format t "Number of solutions for Low 0, High 9 non-unique:~%~A~%" |
||
(length (four-rings-solutions 0 9 nil))))) |
(length (four-rings-solutions 0 9 nil))))) |
||
</syntaxhighlight> |
|||
</lang> |
|||
Output: |
Output: |
||
<pre> |
<pre> |
||
Line 657: | Line 2,551: | ||
NIL |
NIL |
||
</pre> |
</pre> |
||
=={{header|Crystal}}== |
|||
{{trans|Ruby}} |
|||
<syntaxhighlight lang="ruby">def check(list) |
|||
a, b, c, d, e, f, g = list |
|||
first = a + b |
|||
{b + c + d, d + e + f, f + g}.all? &.==(first) |
|||
end |
|||
def four_squares(low, high, unique = true, show = unique) |
|||
solutions = [] of Array(Int32) |
|||
if unique |
|||
uniq = "unique" |
|||
(low..high).to_a.each_permutation(7, true) { |ary| solutions << ary.clone if check(ary) } |
|||
else |
|||
uniq = "non-unique" |
|||
(low..high).to_a.each_repeated_permutation(7, true) { |ary| solutions << ary.clone if check(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)</syntaxhighlight> |
|||
=={{header|D}}== |
|||
<syntaxhighlight lang="d">import std.stdio; |
|||
void main() { |
|||
fourSquare(1,7,true,true); |
|||
fourSquare(3,9,true,true); |
|||
fourSquare(0,9,false,false); |
|||
} |
|||
void fourSquare(int low, int high, bool unique, bool print) { |
|||
int count; |
|||
if (print) { |
|||
writeln("a b c d e f g"); |
|||
} |
|||
for (int a=low; a<=high; ++a) { |
|||
for (int b=low; b<=high; ++b) { |
|||
if (!valid(unique, a, b)) continue; |
|||
int fp = a+b; |
|||
for (int c=low; c<=high; ++c) { |
|||
if (!valid(unique, c, a, b)) continue; |
|||
for (int d=low; d<=high; ++d) { |
|||
if (!valid(unique, d, a, b, c)) continue; |
|||
if (fp != b+c+d) continue; |
|||
for (int e=low; e<=high; ++e) { |
|||
if (!valid(unique, e, a, b, c, d)) continue; |
|||
for (int f=low; f<=high; ++f) { |
|||
if (!valid(unique, f, a, b, c, d, e)) continue; |
|||
if (fp != d+e+f) continue; |
|||
for (int g=low; g<=high; ++g) { |
|||
if (!valid(unique, g, a, b, c, d, e, f)) continue; |
|||
if (fp != f+g) continue; |
|||
++count; |
|||
if (print) { |
|||
writeln(a,' ',b,' ',c,' ',d,' ',e,' ',f,' ',g); |
|||
} |
|||
} |
|||
} |
|||
} |
|||
} |
|||
} |
|||
} |
|||
} |
|||
if (unique) { |
|||
writeln("There are ", count, " unique solutions in [",low,",",high,"]"); |
|||
} else { |
|||
writeln("There are ", count, " non-unique solutions in [",low,",",high,"]"); |
|||
} |
|||
} |
|||
bool valid(bool unique, int needle, int[] haystack ...) { |
|||
if (unique) { |
|||
foreach (value; haystack) { |
|||
if (needle == value) { |
|||
return false; |
|||
} |
|||
} |
|||
} |
|||
return true; |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre>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 |
|||
There are 8 unique solutions in [1,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 |
|||
There are 4 unique solutions in [3,9] |
|||
There are 2860 non-unique solutions in [0,9]</pre> |
|||
=={{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#}}== |
=={{header|F_Sharp|F#}}== |
||
< |
<syntaxhighlight lang="fsharp"> |
||
(* A simple function to generate the sequence |
(* A simple function to generate the sequence |
||
Nigel Galloway: January 31st., 2017 *) |
Nigel Galloway: January 31st., 2017 *) |
||
Line 667: | Line 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 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})))) |
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> |
|||
</lang> |
|||
Then: |
Then: |
||
< |
<syntaxhighlight lang="fsharp"> |
||
printfn "%d" (Seq.length (N 0 9)) |
printfn "%d" (Seq.length (N 0 9)) |
||
</syntaxhighlight> |
|||
</lang> |
|||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
2860 |
2860 |
||
</pre> |
</pre> |
||
< |
<syntaxhighlight lang="fsharp"> |
||
(* A simple function to generate the sequence with unique values |
(* A simple function to generate the sequence with unique values |
||
Nigel Galloway: January 31st., 2017 *) |
Nigel Galloway: January 31st., 2017 *) |
||
Line 684: | Line 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 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})))) |
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> |
|||
</lang> |
|||
Then: |
Then: |
||
< |
<syntaxhighlight lang="fsharp"> |
||
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) |
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> |
|||
</lang> |
|||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
Line 701: | Line 2,772: | ||
</pre> |
</pre> |
||
and: |
and: |
||
< |
<syntaxhighlight lang="fsharp"> |
||
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) |
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> |
|||
</lang> |
|||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
Line 711: | Line 2,782: | ||
9,6,4,5,3,7,8 |
9,6,4,5,3,7,8 |
||
</pre> |
</pre> |
||
=={{header|Factor}}== |
|||
This solution uses the <code>backtrack</code> vocabulary — Factor's implementation of John McCarthy's ''[http://www.rosettacode.org/wiki/Amb ambiguous operator]''. In short, we define 7 integers that can take up any value within the range that we give it, such as [3,9], and assign them names a-g. We then test whether the four sums from the puzzle are equal, and if applicable, whether a-g are unique. We send this boolean value to <code>must-be-true</code> and if it's false, then the other possibilities will be explored through the power of continuations. |
|||
<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. |
|||
<syntaxhighlight lang="factor">USING: arrays backtrack formatting grouping kernel locals math |
|||
math.ranges prettyprint sequences sequences.generalizations |
|||
sets ; |
|||
IN: rosetta-code.4-rings |
|||
:: 4-rings ( lo hi unique? -- seq ) [ |
|||
7 [ lo hi [a,b] amb-lazy ] replicate |
|||
7 firstn :> ( a b c d e f g ) |
|||
{ a b c d e f g } :> p |
|||
a b + |
|||
b c d + + |
|||
d e f + + |
|||
f g + |
|||
4array all-equal? |
|||
unique? [ p all-unique? and ] when |
|||
must-be-true p |
|||
] bag-of ; |
|||
: report ( lo hi unique? -- ) |
|||
3dup 4-rings over [ dup . ] when length swap "" "non-" ? |
|||
"In [%d, %d] there are %d %sunique solutions.\n" printf ; |
|||
1 7 t report |
|||
3 9 t report |
|||
0 9 f report</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
V{ |
|||
{ 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 } |
|||
} |
|||
In [1, 7] there are 8 unique solutions. |
|||
V{ |
|||
{ 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 } |
|||
} |
|||
In [3, 9] there are 4 unique solutions. |
|||
In [0, 9] there are 2860 non-unique solutions. |
|||
</pre> |
|||
=={{header|Fortran}}== |
|||
This uses the facility standardised in F90 whereby DO-loops can have text labels attached (not in the usual label area) so that the END DO statement can have the corresponding label, and any CYCLE statements can use it also. Similarly, the subroutine's END statement bears the name of the subroutine. This is just syntactic decoration. Rather more useful is extended syntax for dealing with arrays and especially the function ANY for making multiple tests without having to enumerate them in the code. To gain this convenience, the EQUIVALENCE statement makes variables A, B, C, D, E, F, and G occupy the same storage as <code>INTEGER V(7)</code>, an array. |
|||
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 <syntaxhighlight lang="fortran">WRITE(...) FIRST,LAST,IF (UNIQUE) THEN "Distinct values only" ELSE "Repeated values allowed" FI // "."</syntaxhighlight> so that the correct alternative will be selected. Further, an array (that would hold those two texts) can't be indexed by a LOGICAL variable, and playing with EQUIVALENCE won't help, because the numerical values revealed thereby for .TRUE. and .FALSE. may not be 1 and 0. And anyway, parameters are not allowed to be accessed via EQUIVALENCE to another variable. |
|||
So, a two-part output, and to reduce the blather, two IF-statements. <syntaxhighlight lang="fortran"> SUBROUTINE FOURSHOW(FIRST,LAST,UNIQUE) !The "Four Rings" or "Four Squares" puzzle. |
|||
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. |
|||
LOGICAL UNIQUE !Solutions need not have unique values. |
|||
INTEGER A,B,C,D,E,F,G !Ah, Diophantus of Alexandria. |
|||
INTEGER V(7),S,N !Assistants. |
|||
EQUIVALENCE (V(1),A),(V(2),B),(V(3),C), !Yes, |
|||
1 (V(4),D),(V(5),E),(V(6),F),(V(7),G) !We're all individuals. |
|||
WRITE (6,1) FIRST,LAST !Announce: first part. |
|||
1 FORMAT (/,"The Four Rings puzzle, over ",I0," to ",I0,".",$) !$: An addendum follows. |
|||
IF (UNIQUE) WRITE (6,*) "Distinct values only." !Save on the THEN ... ELSE ... END IF blather. |
|||
IF (.NOT.UNIQUE) WRITE (6,*) "Repeated values allowed." !Perhaps the compiler will be smarter. |
|||
N = 0 !No solutions have been found. |
|||
BB:DO B = FIRST,LAST !Start chugging through the possibilities. |
|||
CC:DO C = FIRST,LAST !Brute force and ignorance. |
|||
IF (UNIQUE .AND. B.EQ.C) CYCLE CC !The first constraint shows up. |
|||
DD:DO D = FIRST,LAST !Start by forming B, C, and D. |
|||
IF (UNIQUE .AND. ANY(V(2:3).EQ.D)) CYCLE DD !Ignoring A just for now. |
|||
S = B + C + D !This is the common sum. |
|||
A = S - B !The value of A is not free from BCD. |
|||
IF (A < FIRST .OR. A > LAST) CYCLE DD !And it may not be within bounds. |
|||
IF (UNIQUE .AND. ANY(V(2:4).EQ.A)) CYCLE DD !Or, if required so, unique. |
|||
EE:DO E = FIRST,LAST !Righto, A,B,C,D are valid. Try an E. |
|||
IF (UNIQUE .AND. ANY(V(1:4).EQ.E)) CYCLE EE !Precluded already? |
|||
F = S - (E + D) !No. So therefore, F is determined. |
|||
IF (F < FIRST .OR. F > LAST) CYCLE EE !Acceptable? |
|||
IF (UNIQUE .AND. ANY(V(1:5).EQ.F)) CYCLE EE !And, if required, unique? |
|||
G = S - F !Yes! So finally, G is determined. |
|||
IF (G < FIRST .OR. G > LAST) CYCLE EE !Acceptable? |
|||
IF (UNIQUE .AND. ANY(V(1:6).EQ.G)) CYCLE EE !And, if required, unique? |
|||
N = N + 1 !Yes! Count a solution set! |
|||
IF (UNIQUE) WRITE (6,"(7I3)") V !Show its values. |
|||
END DO EE !Consder another E. |
|||
END DO DD !Consider another D. |
|||
END DO CC !Consider another C. |
|||
END DO BB !Consider another B. |
|||
WRITE (6,2) N !Announce the count. |
|||
2 FORMAT (I9," found.") !Numerous, if no need for distinct values. |
|||
END SUBROUTINE FOURSHOW !That was fun! |
|||
PROGRAM POKE |
|||
CALL FOURSHOW(1,7,.TRUE.) |
|||
CALL FOURSHOW(3,9,.TRUE.) |
|||
CALL FOURSHOW(0,9,.FALSE.) |
|||
END </syntaxhighlight> |
|||
Output: not in a neat order because the first variable is not determined first. |
|||
<pre> |
|||
The Four Rings puzzle, over 1 to 7. Distinct values only. |
|||
7 2 6 1 3 5 4 |
|||
7 3 2 5 1 4 6 |
|||
6 4 1 5 2 3 7 |
|||
6 4 5 1 2 7 3 |
|||
4 5 3 1 6 2 7 |
|||
5 6 2 3 1 7 4 |
|||
4 7 1 3 2 6 5 |
|||
3 7 2 1 5 4 6 |
|||
8 found. |
|||
The Four Rings puzzle, over 3 to 9. Distinct values only. |
|||
9 6 4 5 3 7 8 |
|||
9 6 5 4 3 8 7 |
|||
8 7 3 5 4 6 9 |
|||
7 8 3 4 5 6 9 |
|||
4 found. |
|||
The Four Rings puzzle, over 0 to 9. Repeated values allowed. |
|||
2860 found. |
|||
</pre> |
|||
One might hope that the ANY function will quit as soon as possible and that it will not be invoked if UNIQUE is false, but the modernisers have rejected reliance on [[Talk:Short-circuit_evaluation#Compiler_optimisations.3F|short-circuit evaluation]] and the "help" is quite general on the workings of the ANY function, as also is modern. Here is a sample of the code produced by the Compaq 6.6a Visual Fortran F90/95 compiler, in its normal "debugging" condition and array bound checking of course active... |
|||
<pre> |
|||
31: IF (UNIQUE .AND. ANY(V(1:6).EQ.G)) CYCLE EE !And, if required, unique? |
|||
00401496 mov edi,dword ptr [UNIQUE] |
|||
00401499 mov edi,dword ptr [edi] |
|||
0040149B mov ebx,dword ptr [G (00470380)] |
|||
004014A1 mov eax,0 |
|||
004014A6 mov ecx,1 |
|||
004014AB mov dword ptr [ebp-60h],1 |
|||
004014B2 cmp dword ptr [ebp-60h],6 |
|||
004014B6 jg FOURSHOW+4C4h (004014fc) |
|||
004014B8 cmp ecx,1 |
|||
004014BB jl FOURSHOW+48Ah (004014c2) |
|||
004014BD cmp ecx,7 |
|||
004014C0 jle FOURSHOW+493h (004014cb) |
|||
004014C2 xor esi,esi |
|||
004014C4 mov dword ptr [ebp-6Ch],esi |
|||
004014C7 dec esi |
|||
004014C8 bound esi,qword ptr [ebp-6Ch] |
|||
004014CB imul esi,ecx,4 |
|||
004014CE mov esi,dword ptr S+4 (00470364)[esi] |
|||
004014D4 xor edx,edx |
|||
004014D6 cmp esi,ebx |
|||
004014D8 sete dl |
|||
004014DB mov dword ptr [ebp-6Ch],edx |
|||
004014DE mov edx,eax |
|||
004014E0 or edx,dword ptr [ebp-6Ch] |
|||
004014E3 and edx,1 |
|||
004014E6 mov eax,edx |
|||
004014E8 neg eax |
|||
004014EA mov esi,ecx |
|||
004014EC add esi,1 |
|||
004014EF mov ecx,esi |
|||
004014F1 mov edx,dword ptr [ebp-60h] |
|||
004014F4 add edx,1 |
|||
004014F7 mov dword ptr [ebp-60h],edx |
|||
004014FA jmp FOURSHOW+47Ah (004014b2) |
|||
004014FC and edi,eax |
|||
004014FE mov edx,edi |
|||
00401500 and edx,1 |
|||
00401503 cmp edx,0 |
|||
00401506 jne FOURSHOW+531h (00401569) |
|||
32: N = N + 1 !Yes! Count a solution set! |
|||
00401508 mov esi,dword ptr [N (0047035c)] |
|||
0040150E add esi,1 |
|||
00401511 mov dword ptr [N (0047035c)],esi |
|||
33: IF (UNIQUE) WRITE (6,"(7I3)") V !Show its values. |
|||
</pre> |
|||
I'd rather say nothing at all. |
|||
=={{header|FreeBASIC}}== |
=={{header|FreeBASIC}}== |
||
< |
<syntaxhighlight lang="freebasic">' version 18-03-2017 |
||
' compile with: fbc -s console |
' compile with: fbc -s console |
||
Line 802: | Line 3,055: | ||
Print : Print "hit any key to end program" |
Print : Print "hit any key to end program" |
||
Sleep |
Sleep |
||
End</ |
End</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre> a b c d e f g |
<pre> a b c d e f g |
||
Line 830: | Line 3,083: | ||
2860 Non unique solutions for 0 to 9 |
2860 Non unique solutions for 0 to 9 |
||
----------------------------------------</pre> |
----------------------------------------</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}}== |
=={{header|Go}}== |
||
< |
<syntaxhighlight lang="go">package main |
||
import "fmt" |
import "fmt" |
||
Line 856: | Line 3,304: | ||
for g := low; g <= high; g++ { |
for g := low; g <= high; g++ { |
||
if validComb(a,b,c,d,e,f,g) { |
if validComb(a,b,c,d,e,f,g) { |
||
if unique{ |
if !unique || isUnique(a,b,c,d,e,f,g) { |
||
if isUnique(a,b,c,d,e,f,g) { |
|||
num++ |
|||
validCombs = append(validCombs,[]int{a,b,c,d,e,f,g}) |
|||
} |
|||
}else{ |
|||
num++ |
num++ |
||
validCombs = append(validCombs,[]int{a,b,c,d,e,f,g}) |
validCombs = append(validCombs,[]int{a,b,c,d,e,f,g}) |
||
Line 884: | Line 3,327: | ||
data[f]++ |
data[f]++ |
||
data[g]++ |
data[g]++ |
||
return len(data) == 7 |
|||
return true |
|||
}else { |
|||
return false |
|||
} |
|||
} |
} |
||
func validComb(a,b,c,d,e,f,g int) bool{ |
func validComb(a,b,c,d,e,f,g int) bool{ |
||
Line 897: | Line 3,336: | ||
return square1 == square2 && square2 == square3 && square3 == square4 |
return square1 == square2 && square2 == square3 && square3 == square4 |
||
} |
} |
||
</syntaxhighlight> |
|||
</lang> |
|||
{{Out}} |
{{Out}} |
||
<pre> |
<pre> |
||
Line 906: | Line 3,345: | ||
2860 non-unique solutions in 0 to 9 |
2860 non-unique solutions in 0 to 9 |
||
</pre> |
</pre> |
||
=={{header|Groovy}}== |
|||
{{trans|Java}} |
|||
<syntaxhighlight lang="groovy">class FourRings { |
|||
static void main(String[] args) { |
|||
fourSquare(1, 7, true, true) |
|||
fourSquare(3, 9, true, true) |
|||
fourSquare(0, 9, false, false) |
|||
} |
|||
private static void fourSquare(int low, int high, boolean unique, boolean print) { |
|||
int count = 0 |
|||
if (print) { |
|||
println("a b c d e f g") |
|||
} |
|||
for (int a = low; a <= high; ++a) { |
|||
for (int b = low; b <= high; ++b) { |
|||
if (notValid(unique, a, b)) continue |
|||
int fp = a + b |
|||
for (int c = low; c <= high; ++c) { |
|||
if (notValid(unique, c, a, b)) continue |
|||
for (int d = low; d <= high; ++d) { |
|||
if (notValid(unique, d, a, b, c)) continue |
|||
if (fp != b + c + d) continue |
|||
for (int e = low; e <= high; ++e) { |
|||
if (notValid(unique, e, a, b, c, d)) continue |
|||
for (int f = low; f <= high; ++f) { |
|||
if (notValid(unique, f, a, b, c, d, e)) continue |
|||
if (fp != d + e + f) continue |
|||
for (int g = low; g <= high; ++g) { |
|||
if (notValid(unique, g, a, b, c, d, e, f)) continue |
|||
if (fp != f + g) continue |
|||
++count |
|||
if (print) { |
|||
printf("%d %d %d %d %d %d %d%n", a, b, c, d, e, f, g) |
|||
} |
|||
} |
|||
} |
|||
} |
|||
} |
|||
} |
|||
} |
|||
} |
|||
if (unique) { |
|||
printf("There are %d unique solutions in [%d, %d]%n", count, low, high) |
|||
} else { |
|||
printf("There are %d non-unique solutions in [%d, %d]%n", count, low, high) |
|||
} |
|||
} |
|||
private static boolean notValid(boolean unique, int needle, int ... haystack) { |
|||
return unique && Arrays.stream(haystack).anyMatch({ p -> p == needle }) |
|||
} |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre>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 |
|||
There are 8 unique solutions in [1, 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 |
|||
There are 4 unique solutions in [3, 9] |
|||
There are 2860 non-unique solutions in [0, 9]</pre> |
|||
=={{header|Haskell}}== |
=={{header|Haskell}}== |
||
====By exhaustive search==== |
====By exhaustive search==== |
||
< |
<syntaxhighlight lang="haskell">import Data.List |
||
import Control.Monad |
import Control.Monad |
||
Line 948: | Line 3,465: | ||
fourRings 1 7 False True |
fourRings 1 7 False True |
||
fourRings 3 9 False True |
fourRings 3 9 False True |
||
fourRings 0 9 True False</ |
fourRings 0 9 True False</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
Line 978: | Line 3,495: | ||
Nesting four |
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. |
Probably less readable, but already fast, and could be further optimised. |
||
< |
<syntaxhighlight lang="haskell">import Data.List (delete, sortBy, (\\)) |
||
--------------- 4 RINGS OR 4 SQUARES PUZZLE -------------- |
|||
rings :: Bool -> [Int] -> [(Int, Int, Int, Int, Int, Int, Int)] |
|||
type Rings = [(Int, Int, Int, Int, Int, Int, Int)] |
|||
rings :: Bool -> [Int] -> Rings |
|||
rings u digits = |
rings u digits = |
||
((>>=) <*> (queen u =<< head)) |
|||
concatMap |
|||
(sortBy (flip compare) digits) |
|||
-- QUEEN --------------------------------------------------------------------- |
|||
(\q -> |
|||
queen :: Bool -> Int -> [Int] -> Int -> Rings |
|||
let ts = filter ((<= h) . (q +)) ds |
|||
queen u h ds q = xs >>= leftBishop u q h ts ds |
|||
where |
|||
if u |
|||
ts = filter ((<= h) . (q +)) ds |
|||
xs |
|||
else ds |
|||
| u = delete q ts |
|||
| otherwise = ds |
|||
-- LEFT BISHOP AND ITS ROOK ----------------------------------------- |
|||
(\lb -> |
|||
leftBishop :: |
|||
let lRook = lb + q |
|||
Bool -> |
|||
in if lRook <= h |
|||
Int -> |
|||
then let rbs = |
|||
Int -> |
|||
if u |
|||
[Int] -> |
|||
then ts \\ [q, lb, lRook] |
|||
[Int] -> |
|||
else ds |
|||
Int -> |
|||
in concatMap |
|||
Rings |
|||
-- RIGHT BISHOP AND ITS ROOK --------------------- |
|||
leftBishop u q h ts ds lb |
|||
(\rb -> |
|||
| lRook <= h = xs >>= rightBishop u q h lb ds lRook |
|||
let rRook = q + rb |
|||
| otherwise = [] |
|||
in if (rRook <= h) && |
|||
where |
|||
(not u || (rRook /= lb)) |
|||
lRook = lb + q |
|||
then let ks = |
|||
xs |
|||
if u |
|||
| u = ts \\ [q, lb, lRook] |
|||
then ds \\ |
|||
| otherwise = ds |
|||
[ q |
|||
, lb |
|||
rightBishop :: |
|||
, rb |
|||
Bool -> |
|||
, rRook |
|||
Int -> |
|||
, lRook |
|||
Int -> |
|||
] |
|||
Int -> |
|||
else ds |
|||
[Int] -> |
|||
rookDelta = lRook - rRook |
|||
Int -> |
|||
in concatMap |
|||
Int -> |
|||
-- KNIGHTS LEFT & RIGHT ------- |
|||
Rings |
|||
(\k -> |
|||
rightBishop u q h lb ds lRook rb |
|||
let k2 = k + rookDelta |
|||
| (rRook <= h) && (not u || (rRook /= lb)) = |
|||
in [ ( lRook |
|||
let ks |
|||
, k |
|||
| u = (ds \\ [q, lb, rb, rRook, lRook]) |
|||
| otherwise = ds |
|||
, q |
|||
in ks |
|||
, rb |
|||
>>= knights |
|||
, k2 |
|||
u |
|||
, rRook) |
|||
(lRook - rRook) |
|||
| (k2 `elem` ks) && |
|||
lRook |
|||
(not u || |
|||
lb |
|||
notElem |
|||
q |
|||
k2 |
|||
rb |
|||
[ lRook |
|||
rRook |
|||
, k |
|||
ks |
|||
, lb |
|||
| otherwise = [] |
|||
, q |
|||
where |
|||
, rb |
|||
rRook = q + rb |
|||
, rRook |
|||
]) ]) |
|||
knights :: |
|||
ks |
|||
Bool -> |
|||
else []) |
|||
Int -> |
|||
rbs |
|||
Int -> |
|||
else []) |
|||
Int -> |
|||
bs) |
|||
Int -> |
|||
Int -> |
|||
Int -> |
|||
[Int] -> |
|||
Int -> |
|||
Rings |
|||
knights u rookDelta lRook lb q rb rRook ks k = |
|||
[ (lRook, k, lb, q, rb, k2, rRook) |
|||
| (k2 `elem` ks) |
|||
&& ( not u |
|||
|| notElem |
|||
k2 |
|||
[lRook, k, lb, q, rb, rRook] |
|||
) |
|||
] |
|||
where |
where |
||
k2 = k + rookDelta |
|||
h = head ds |
|||
--------------------------- TEST ------------------------- |
|||
main :: IO () |
main :: IO () |
||
main = do |
main = do |
||
putStrLn |
let f (k, xs) = putStrLn k >> nl >> mapM_ print xs >> nl |
||
nl = putStrLn [] |
|||
mapM_ |
|||
putStrLn "\nrings True [3 .. 9]\n" |
|||
f |
|||
mapM_ print $ rings True [3 .. 9] |
|||
[ ("rings True [1 .. 7]", rings True [1 .. 7]), |
|||
("rings True [3 .. 9]", rings True [3 .. 9]) |
|||
] |
|||
f |
|||
( "length (rings False [0 .. 9])", |
|||
[length (rings False [0 .. 9])] |
|||
)</syntaxhighlight> |
|||
{{Out}} |
{{Out}} |
||
<pre>rings True [1 .. 7] |
<pre>rings True [1 .. 7] |
||
Line 1,081: | Line 3,620: | ||
2860</pre> |
2860</pre> |
||
=={{header|J}}== |
|||
Implementation for the unique version of the puzzle: |
|||
<syntaxhighlight lang="j">fspuz=:dyad define |
|||
range=: x+i.1+y-x |
|||
lo=. 6+3*x |
|||
hi=. _3+2*y |
|||
r=.i.0 0 |
|||
if. lo <: hi do. |
|||
for_T.lo ([+[:i.1+-~) hi do. |
|||
range2=: (#~ (T-{.range)>:]) range |
|||
range3=: (#~ (T-+/2{.range)>:]) range |
|||
ab=: (#~ ~:/"1) (,.T-])range2 |
|||
abc=: ;ab <@([ ,"1 0 -.~)"1/range3 |
|||
abcd=: (#~ T = +/@}."1) ;abc <@([ ,"1 0 -.~)"1/range3 |
|||
abcde=: ;abcd <@([ ,"1 0 -.~)"1/range3 |
|||
abcdef=: (#~ T = +/@(3}.])"1) ;abcde <@([ ,"1 0 -.~)"1/range3 |
|||
abcdefg=: (#~ T = +/@(5}.])"1) ;abcdef <@([ ,"1 0 -.~)"1/range2 |
|||
r=.r,(#~ x<:<./"1)(#~ y>:>./"1)abcdefg |
|||
end. |
|||
end. |
|||
)</syntaxhighlight> |
|||
Implementation for the non-unique version of the puzzle: |
|||
<syntaxhighlight lang="j">fspuz2=:dyad define |
|||
range=: x+i.1+y-x |
|||
lo=. 3*x |
|||
hi=. 2*y |
|||
r=.i.0 0 |
|||
if. lo <: hi do. |
|||
for_T.lo ([+[:i.1+-~) hi do. |
|||
ab=: (,.T-])range |
|||
abc=: ,/ab,"1 0/ range |
|||
abcd=: (#~ T = +/@}."1) ,/abc,"1 0/ range |
|||
abcde=: ,/abcd,"1 0/ range |
|||
abcdef=: (#~ T = +/@(3}.])"1) ,/abcde ,"1 0/ range |
|||
abcdefg=: (#~ T = +/@(5}.])"1) ,/abcdef,"1 0/ range |
|||
r=.r,(#~ x<:<./"1)(#~ y>:>./"1)abcdefg |
|||
end. |
|||
end. |
|||
)</syntaxhighlight> |
|||
Task examples: |
|||
<syntaxhighlight lang="j"> 1 fspuz 7 |
|||
4 5 3 1 6 2 7 |
|||
7 2 6 1 3 5 4 |
|||
3 7 2 1 5 4 6 |
|||
6 4 1 5 2 3 7 |
|||
6 4 5 1 2 7 3 |
|||
7 3 2 5 1 4 6 |
|||
4 7 1 3 2 6 5 |
|||
5 6 2 3 1 7 4 |
|||
3 fspuz 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 |
|||
#0 fspuz2 9 |
|||
2860</syntaxhighlight> |
|||
=={{header|Java}}== |
|||
Uses java 8 features. |
|||
<syntaxhighlight lang="java">import java.util.Arrays; |
|||
public class FourSquares { |
|||
public static void main(String[] args) { |
|||
fourSquare(1, 7, true, true); |
|||
fourSquare(3, 9, true, true); |
|||
fourSquare(0, 9, false, false); |
|||
} |
|||
private static void fourSquare(int low, int high, boolean unique, boolean print) { |
|||
int count = 0; |
|||
if (print) { |
|||
System.out.println("a b c d e f g"); |
|||
} |
|||
for (int a = low; a <= high; ++a) { |
|||
for (int b = low; b <= high; ++b) { |
|||
if (notValid(unique, a, b)) continue; |
|||
int fp = a + b; |
|||
for (int c = low; c <= high; ++c) { |
|||
if (notValid(unique, c, a, b)) continue; |
|||
for (int d = low; d <= high; ++d) { |
|||
if (notValid(unique, d, a, b, c)) continue; |
|||
if (fp != b + c + d) continue; |
|||
for (int e = low; e <= high; ++e) { |
|||
if (notValid(unique, e, a, b, c, d)) continue; |
|||
for (int f = low; f <= high; ++f) { |
|||
if (notValid(unique, f, a, b, c, d, e)) continue; |
|||
if (fp != d + e + f) continue; |
|||
for (int g = low; g <= high; ++g) { |
|||
if (notValid(unique, g, a, b, c, d, e, f)) continue; |
|||
if (fp != f + g) continue; |
|||
++count; |
|||
if (print) { |
|||
System.out.printf("%d %d %d %d %d %d %d%n", a, b, c, d, e, f, g); |
|||
} |
|||
} |
|||
} |
|||
} |
|||
} |
|||
} |
|||
} |
|||
} |
|||
if (unique) { |
|||
System.out.printf("There are %d unique solutions in [%d, %d]%n", count, low, high); |
|||
} else { |
|||
System.out.printf("There are %d non-unique solutions in [%d, %d]%n", count, low, high); |
|||
} |
|||
} |
|||
private static boolean notValid(boolean unique, int needle, int... haystack) { |
|||
return unique && Arrays.stream(haystack).anyMatch(p -> p == needle); |
|||
} |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre>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 |
|||
There are 8 unique solutions in [1, 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 |
|||
There are 4 unique solutions in [3, 9] |
|||
There are 2860 non-unique solutions in [0, 9]</pre> |
|||
=={{header|JavaScript}}== |
=={{header|JavaScript}}== |
||
===ES6=== |
===ES6=== |
||
{{Trans|Haskell}} (Structured search version) |
{{Trans|Haskell}} (Structured search version) |
||
< |
<syntaxhighlight lang="javascript">(() => { |
||
"use strict"; |
|||
// |
// ----------- 4-RINGS OR 4-SQUARES PUZZLE ----------- |
||
// rings :: noRepeatedDigits -> DigitList -> |
// rings :: noRepeatedDigits -> DigitList -> solutions |
||
// rings :: Bool -> [Int] -> [[Int]] |
// rings :: Bool -> [Int] -> [[Int]] |
||
const rings = |
const rings = uniq => |
||
digits => Boolean(digits.length) ? ( |
|||
const |
|||
() => { |
|||
const ns = digits.sort(flip(compare)); |
|||
// CENTRAL DIGIT :: d |
|||
// QUEEN (i.e. middle digit of 7)--------------------------------------- |
|||
return |
return ns.flatMap( |
||
ringTriage(uniq)(ns) |
|||
); |
|||
})() : []; |
|||
bs = u ? delete_(q, ts) : ds; |
|||
// LEFT BISHOP (next to queen) AND ITS ROOK (leftmost digit)---- |
|||
return concatMap( |
|||
lb => { |
|||
const lRook = lb + q; |
|||
return lRook > h ? [] : (() => { |
|||
const rbs = u ? difference(ts, [q, lb, lRook]) : ds; |
|||
const ringTriage = uniq => ns => d => { |
|||
// RIGHT BISHOP AND ITS ROOK ----------------------- |
|||
const |
|||
return concatMap(rb => { |
|||
h = head(ns), |
|||
ts = ns.filter(x => (x + d) <= h); |
|||
[] |
|||
) : (() => { |
|||
const |
|||
rookDelta = lRook - rRook, |
|||
ks = u ? difference( |
|||
ds, [q, lb, rb, rRook, lRook] |
|||
) : ds; |
|||
// LEFT OF CENTRE :: c and a |
|||
// KNIGHTS LEFT AND RIGHT ------------------ |
|||
return ( |
|||
uniq ? (delete_(d)(ts)) : ns |
|||
const k2 = k + rookDelta; |
|||
) |
|||
return (elem(k2, ks) && |
|||
.flatMap(c => { |
|||
(!u || notElem(k2, [ |
|||
const a = c + d; |
|||
]))) ? ( |
|||
// RIGHT OF CENTRE :: e and g |
|||
return a > h ? ( |
|||
[lRook, k, lb, q, rb, k2, rRook] |
|||
[] |
|||
) : ( |
|||
uniq ? ( |
|||
difference(ts)([d, c, a]) |
|||
) : ns |
|||
) |
|||
.flatMap(subTriage(uniq)([ns, h, a, c, d])); |
|||
}); |
|||
); |
|||
}, |
|||
ds |
|||
); |
|||
}; |
}; |
||
// GENERIC FUNCTIONS ------------------------------------------------------ |
|||
const subTriage = uniq => |
|||
([ns, h, a, c, d]) => e => { |
|||
const g = d + e; |
|||
return ((g > h) || ( |
|||
uniq && (g === c)) |
|||
) ? ( |
|||
[] |
|||
) : (() => { |
|||
const |
|||
agDelta = a - g, |
|||
bfs = uniq ? ( |
|||
difference(ns)([ |
|||
d, c, e, g, a |
|||
]) |
|||
) : ns; |
|||
// MID LEFT, MID RIGHT :: b and f |
|||
return bfs.flatMap(b => { |
|||
const f = b + agDelta; |
|||
return (bfs).includes(f) && ( |
|||
!uniq || ![ |
|||
a, b, c, d, e, g |
|||
].includes(f) |
|||
) ? ([ |
|||
[a, b, c, d, e, f, g] |
|||
]) : []; |
|||
}); |
|||
})(); |
|||
}; |
|||
// ---------------------- TEST ----------------------- |
|||
const main = () => unlines([ |
|||
"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 |
// compare :: a -> a -> Ordering |
||
const compare = (a, b) => |
const compare = (a, b) => |
||
a < b ? -1 : (a > b ? 1 : 0); |
|||
// concatMap :: (a -> [b]) -> [a] -> [b] |
|||
const concatMap = (f, xs) => [].concat.apply([], xs.map(f)); |
|||
// |
// delete :: Eq a => a -> [a] -> [a] |
||
const delete_ = |
const delete_ = x => { |
||
xs |
// xs with first instance of x (if any) removed. |
||
const go = xs => |
|||
Boolean(xs.length) ? ( |
|||
(x === xs[0]) ? ( |
|||
xs.slice(1) |
|||
) : [xs[0]].concat(go(xs.slice(1))) |
|||
) : []; |
|||
return go; |
|||
// (\\) :: (Eq a) => [a] -> [a] -> [a] |
|||
}; |
|||
const difference = (xs, ys) => |
|||
ys.reduce((a, x) => delete_(x, a), xs); |
|||
// difference :: Eq a => [a] -> [a] -> [a] |
|||
const difference = xs => |
|||
ys => { |
|||
const s = new Set(ys); |
|||
return xs.filter(x => !s.has(x)); |
|||
}; |
|||
// elem :: Eq a => a -> [a] -> Bool |
|||
const elem = (x, xs) => xs.indexOf(x) !== -1; |
|||
// enumFromTo :: Int -> Int -> [Int] |
// enumFromTo :: Int -> Int -> [Int] |
||
const enumFromTo = |
const enumFromTo = m => |
||
Array.from({ |
n => Array.from({ |
||
length: |
length: 1 + n - m |
||
}, (_, i) => m + i); |
}, (_, i) => m + i); |
||
// filter :: (a -> Bool) -> [a] -> [a] |
|||
const filter = (f, xs) => xs.filter(f); |
|||
// flip :: (a -> b -> c) -> b -> a -> c |
// flip :: (a -> b -> c) -> b -> a -> c |
||
const flip = |
const flip = op => |
||
// The binary function op with |
|||
// its arguments reversed. |
|||
1 !== op.length ? ( |
|||
(a, b) => op(b, a) |
|||
) : (a => b => op(b)(a)); |
|||
// head :: [a] -> a |
// head :: [a] -> a |
||
const head = xs => |
const head = xs => |
||
// The first item (if any) in a list. |
|||
Boolean(xs.length) ? ( |
|||
// length :: [a] -> Int |
|||
xs[0] |
|||
) : null; |
|||
// map :: (a -> b) -> [a] -> [b] |
|||
const map = (f, xs) => xs.map(f); |
|||
// notElem :: Eq a => a -> [a] -> Bool |
|||
const notElem = (x, xs) => xs.indexOf(x) === -1; |
|||
// show :: a -> String |
// show :: a -> String |
||
const show = x => |
const show = x => |
||
JSON.stringify(x); |
|||
// sortBy :: (a -> a -> Ordering) -> [a] -> [a] |
|||
const sortBy = (f, xs) => xs.sort(f); |
|||
// unlines :: [String] -> String |
// unlines :: [String] -> String |
||
const unlines = xs => |
const unlines = xs => |
||
// A single string formed by the intercalation |
|||
// of a list of strings with the newline character. |
|||
xs.join("\n"); |
|||
// MAIN --- |
|||
// TEST -------------------------------------------------------------------- |
|||
return |
return main(); |
||
})();</syntaxhighlight> |
|||
'rings(true, enumFromTo(1,7))\n', |
|||
unlines(map(show, rings(true, enumFromTo(1, 7)))), |
|||
'\nrings(true, enumFromTo(3, 9))\n', |
|||
unlines(map(show, rings(true, enumFromTo(3, 9)))), |
|||
'\nlength(rings(false, enumFromTo(0, 9)))\n', |
|||
length(rings(false, enumFromTo(0, 9))) |
|||
.toString(), |
|||
'' |
|||
]); |
|||
})();</lang> |
|||
{{Out}} |
{{Out}} |
||
<pre>rings(true, enumFromTo(1,7)) |
<pre>rings(true, enumFromTo(1,7)) |
||
Line 1,236: | Line 3,959: | ||
2860</pre> |
2860</pre> |
||
=={{header|jq}}== |
|||
{{works with|jq}} |
|||
'''Works with gojq, the Go implementation of jq''' |
|||
Since jq is built on back-tracking and optimizes the tail-recursion involved here, |
|||
this entry will focus on generic solutiond for problems of this sort. |
|||
Specifically, the number of boxes is unrestricted. |
|||
====N boxes with arbitrary overlaps==== |
|||
In this section, an arbitrary pattern of overlaps can be specified as follows. |
|||
We will associate the letters "a", "b", ... with the integers 0, 1,... |
|||
so that each box can be represented as an array of integers; the |
|||
puzzle configuration can then be characterized by an array of such arrays. |
|||
For the particular puzzle under consideration, the characteristic array is: |
|||
[[0,1], [1,2,3], [3,4,5], [5,6]] |
|||
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. |
|||
<syntaxhighlight lang="jq"># Generate a stream of all the permutations of the input array |
|||
def permutations: |
|||
if length == 0 then [] |
|||
else |
|||
range(0;length) as $i |
|||
| [.[$i]] + (del(.[$i])|permutations) |
|||
end ; |
|||
# Permutations of a ... n inclusive |
|||
def permutations(a;n): |
|||
[range(a;n+1)] | permutations; |
|||
# value of a box |
|||
# Input: the table of values |
|||
def valueOfBox($box): |
|||
[ .[ $box[] ]] | add; |
|||
def allEqual($boxes): |
|||
. as $values |
|||
| valueOfBox($boxes[0]) as $sum |
|||
| all($boxes[1:][]; . as $box | $values | valueOfBox($box) == $sum); |
|||
def combinations($m; $n; $size): |
|||
[range(0; $size) | [range($m; $n)]] | combinations; |
|||
def count(s): reduce s as $x (null; .+1); |
|||
# a=0, b=1, etc |
|||
def boxes: [[0,1], [1,2,3], [3,4,5], [5,6]]; |
|||
def tasks: |
|||
"1 to 7:", |
|||
(permutations(1;7) | select(allEqual(boxes))), |
|||
"\n3 to 9:", |
|||
(permutations(3;9) | select(allEqual(boxes))), |
|||
"\n0 to 9:\n\(count(permutations(0;9) | select(allEqual(boxes))))", |
|||
"\nThere are \(count(combinations(0;10;7) | select(allEqual(boxes)))) solutions for 0 to 9 with replacement." |
|||
; |
|||
tasks</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
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] |
|||
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] |
|||
There are 1152 distinct solutions for 0 to 9. |
|||
There are 2860 solutions for 0 to 9 with replacement. |
|||
</pre> |
|||
====N boxes with one overlap between adjacent boxes and no uniqueness constraint==== |
|||
In this subsection, an efficient solution for the N-boxes puzzle in the case of non-uniqueness |
|||
(i.e. unrestricted choice of values within the specified range) is given. It is assumed, however, |
|||
that each box (except for the last) has exactly one overlap with its successor. |
|||
For consistency with the prior section, the pattern can be specified in the same way, |
|||
i.e. as a characteristic array, which for the specific problem at hand could be: |
|||
[[0,1], [1,2,3], [3,4,5], [5,6]]. |
|||
<syntaxhighlight lang="jq"># rings/3 assumes that each box (except for the last) has exactly one overlap with its successor. |
|||
# Input: ignored. |
|||
# Output: a stream of solutions, i.e. a stream of arrays. |
|||
# $boxes is an array of boxes, each box being a flat array. |
|||
# $min and $max define the range of permissible values of items in the boxes (inclusive) |
|||
def rings($boxes; $min; $max): |
|||
def inrange: $min <= . and . <= $max; |
|||
# The following helper function deals with the case when the global per-box sum ($sum) is known. |
|||
# Input: an array representing the solution so far, or null. |
|||
# Output: the input plus the solution corresponding to the first argument. |
|||
# $this is the sum of the previous items in the first box, or 0. |
|||
def solve($boxes; $this; $sum): |
|||
# The following is a helper function for handling the case when: |
|||
# * $sum is known |
|||
# * $boxes[0] | length == 1, and |
|||
# * $boxes|length>1 |
|||
def lastInBox($boxes; $this): |
|||
. as $in |
|||
| ($boxes[1:] | (.[0] |= .[1:])) as $bx |
|||
# the first entry in the next box must be the same: |
|||
| ($sum - $this) as $next |
|||
| select($next | inrange) |
|||
| (. + [$next]) | solve( $bx; $next; $sum) ; |
|||
. as $in |
|||
| if $boxes|length == 0 then $in |
|||
else $boxes[0] as $box |
|||
| if $box|length == 0 |
|||
then solve( $boxes[1:]; 0; $sum ) |
|||
elif $box|length == 1 |
|||
# is this the last box? |
|||
then if $boxes|length == 1 |
|||
then ($sum - $this) as $next |
|||
| select($next | inrange) |
|||
| $in + [$next] |
|||
else lastInBox($boxes; $this) |
|||
end |
|||
else # $box|length > 1 |
|||
range($min; $max + 1) as $first |
|||
| select( ($this + $first) <= $sum) |
|||
| ($in + [$first]) | solve( [$box[1:]] + $boxes[1:]; $this + $first; $sum) |
|||
end |
|||
end ; |
|||
. as $in |
|||
| $boxes[0] as $box |
|||
| ($boxes[1:] | .[0] |= .[1:]) as $bx |
|||
| [range(0; $box|length) | [range($min; $max + 1)]] |
|||
| combinations |
|||
| solve($bx; .[-1]; add) ; |
|||
def count(s): reduce s as $x (null; .+1);</syntaxhighlight> |
|||
'''The specific task''' |
|||
<syntaxhighlight lang="jq"># a=0, b=1, etc |
|||
def boxes: [[0,1], [1,2,3], [3,4,5], [5,6]]; |
|||
count(rings(boxes; 0; 9))</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
2860 |
|||
</pre> |
|||
=={{header|Julia}}== |
|||
{{Trans|Python}} |
|||
<syntaxhighlight lang="julia"> |
|||
using Combinatorics |
|||
function foursquares(low, high, onlyunique=true, showsolutions=true) |
|||
integers = collect(low:high) |
|||
count = 0 |
|||
sumsallequal(c) = c[1] + c[2] == c[2] + c[3] + c[4] == c[4] + c[5] + c[6] == c[6] + c[7] |
|||
combos = onlyunique ? combinations(integers) : |
|||
with_replacement_combinations(integers, 7) |
|||
for combo in combos, plist in unique(collect(permutations(combo, 7))) |
|||
if sumsallequal(plist) |
|||
count += 1 |
|||
if showsolutions |
|||
println("$plist is a solution for the list $integers") |
|||
end |
|||
end |
|||
end |
|||
println("""Total $(onlyunique?"unique ":"")solutions for HIGH $high, LOW $low: $count""") |
|||
end |
|||
foursquares(1, 7, true, true) |
|||
foursquares(3, 9, true, true) |
|||
foursquares(0, 9, false, false) |
|||
</syntaxhighlight> |
|||
{{output}} |
|||
<pre> |
|||
[3, 7, 2, 1, 5, 4, 6] is a solution for the list [1, 2, 3, 4, 5, 6, 7] |
|||
[4, 5, 3, 1, 6, 2, 7] is a solution for the list [1, 2, 3, 4, 5, 6, 7] |
|||
[4, 7, 1, 3, 2, 6, 5] is a solution for the list [1, 2, 3, 4, 5, 6, 7] |
|||
[5, 6, 2, 3, 1, 7, 4] is a solution for the list [1, 2, 3, 4, 5, 6, 7] |
|||
[6, 4, 1, 5, 2, 3, 7] is a solution for the list [1, 2, 3, 4, 5, 6, 7] |
|||
[6, 4, 5, 1, 2, 7, 3] is a solution for the list [1, 2, 3, 4, 5, 6, 7] |
|||
[7, 2, 6, 1, 3, 5, 4] is a solution for the list [1, 2, 3, 4, 5, 6, 7] |
|||
[7, 3, 2, 5, 1, 4, 6] is a solution for the list [1, 2, 3, 4, 5, 6, 7] |
|||
Total unique solutions for HIGH 7, LOW 1: 8 |
|||
[7, 8, 3, 4, 5, 6, 9] is a solution for the list [3, 4, 5, 6, 7, 8, 9] |
|||
[8, 7, 3, 5, 4, 6, 9] is a solution for the list [3, 4, 5, 6, 7, 8, 9] |
|||
[9, 6, 4, 5, 3, 7, 8] is a solution for the list [3, 4, 5, 6, 7, 8, 9] |
|||
[9, 6, 5, 4, 3, 8, 7] is a solution for the list [3, 4, 5, 6, 7, 8, 9] |
|||
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}}== |
=={{header|Kotlin}}== |
||
{{trans|C}} |
{{trans|C}} |
||
< |
<syntaxhighlight lang="scala">// version 1.1.2 |
||
class FourSquares( |
class FourSquares( |
||
Line 1,311: | Line 4,300: | ||
FourSquares(3, 9, true, true) |
FourSquares(3, 9, true, true) |
||
FourSquares(0, 9, false, false) |
FourSquares(0, 9, false, false) |
||
}</ |
}</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
Line 1,340: | Line 4,329: | ||
2860 non-unique solutions in 0 to 9 |
2860 non-unique solutions in 0 to 9 |
||
</pre> |
</pre> |
||
=={{header|Lua}}== |
|||
{{trans|D}} |
|||
<syntaxhighlight lang="lua">function valid(unique,needle,haystack) |
|||
if unique then |
|||
for _,value in pairs(haystack) do |
|||
if needle == value then |
|||
return false |
|||
end |
|||
end |
|||
end |
|||
return true |
|||
end |
|||
function fourSquare(low,high,unique,prnt) |
|||
count = 0 |
|||
if prnt then |
|||
print("a", "b", "c", "d", "e", "f", "g") |
|||
end |
|||
for a=low,high do |
|||
for b=low,high do |
|||
if valid(unique, a, {b}) then |
|||
fp = a + b |
|||
for c=low,high do |
|||
if valid(unique, c, {a, b}) then |
|||
for d=low,high do |
|||
if valid(unique, d, {a, b, c}) and fp == b + c + d then |
|||
for e=low,high do |
|||
if valid(unique, e, {a, b, c, d}) then |
|||
for f=low,high do |
|||
if valid(unique, f, {a, b, c, d, e}) and fp == d + e + f then |
|||
for g=low,high do |
|||
if valid(unique, g, {a, b, c, d, e, f}) and fp == f + g then |
|||
count = count + 1 |
|||
if prnt then |
|||
print(a, b, c, d, e, f, g) |
|||
end |
|||
end |
|||
end |
|||
end |
|||
end |
|||
end |
|||
end |
|||
end |
|||
end |
|||
end |
|||
end |
|||
end |
|||
end |
|||
end |
|||
if unique then |
|||
print(string.format("There are %d unique solutions in [%d, %d]", count, low, high)) |
|||
else |
|||
print(string.format("There are %d non-unique solutions in [%d, %d]", count, low, high)) |
|||
end |
|||
end |
|||
fourSquare(1,7,true,true) |
|||
fourSquare(3,9,true,true) |
|||
fourSquare(0,9,false,false)</syntaxhighlight> |
|||
{{out}} |
|||
<pre>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 |
|||
There are 8 unique solutions in [1, 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 |
|||
There are 4 unique solutions in [3, 9] |
|||
There are 2860 non-unique solutions in [0, 9]</pre> |
|||
=={{header|Mathematica}}/{{header|Wolfram Language}}== |
|||
<syntaxhighlight lang="mathematica">{low, high} = {1, 7}; |
|||
SolveValues[{a + b == b + c + d == d + e + f == f + g, low <= a <= high, |
|||
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}, {a, b, c, d, e, f, g}, Integers] |
|||
{low, high} = {3, 9}; |
|||
SolveValues[{a + b == b + c + d == d + e + f == f + g, low <= a <= high, |
|||
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}, {a, b, c, d, e, f, g}, Integers] |
|||
{low, high} = {0, 9}; |
|||
SolveValues[{a + b == b + c + d == d + e + f == f + g, low <= a <= high, |
|||
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</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}} |
|||
{{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</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}}== |
|||
<syntaxhighlight lang="modula2">MODULE FourSquare; |
|||
FROM Conversions IMPORT IntToStr; |
|||
FROM Terminal IMPORT *; |
|||
PROCEDURE WriteInt(num : INTEGER); |
|||
VAR str : ARRAY[0..16] OF CHAR; |
|||
BEGIN |
|||
IntToStr(num,str); |
|||
WriteString(str); |
|||
END WriteInt; |
|||
PROCEDURE four_square(low, high : INTEGER; unique, print : BOOLEAN); |
|||
VAR count : INTEGER; |
|||
VAR a, b, c, d, e, f, g : INTEGER; |
|||
VAR fp : INTEGER; |
|||
BEGIN |
|||
count:=0; |
|||
IF print THEN |
|||
WriteString('a b c d e f g'); |
|||
WriteLn; |
|||
END; |
|||
FOR a:=low TO high DO |
|||
FOR b:=low TO high DO |
|||
IF unique AND (b=a) THEN CONTINUE; END; |
|||
fp:=a+b; |
|||
FOR c:=low TO high DO |
|||
IF unique AND ((c=a) OR (c=b)) THEN CONTINUE; END; |
|||
FOR d:=low TO high DO |
|||
IF unique AND ((d=a) OR (d=b) OR (d=c)) THEN CONTINUE; END; |
|||
IF fp # b+c+d THEN CONTINUE; END; |
|||
FOR e:=low TO high DO |
|||
IF unique AND ((e=a) OR (e=b) OR (e=c) OR (e=d)) THEN CONTINUE; END; |
|||
FOR f:=low TO high DO |
|||
IF unique AND ((f=a) OR (f=b) OR (f=c) OR (f=d) OR (f=e)) THEN CONTINUE; END; |
|||
IF fp # d+e+f THEN CONTINUE; END; |
|||
FOR g:=low TO high DO |
|||
IF unique AND ((g=a) OR (g=b) OR (g=c) OR (g=d) OR (g=e) OR (g=f)) THEN CONTINUE; END; |
|||
IF fp # f+g THEN CONTINUE; END; |
|||
INC(count); |
|||
IF print THEN |
|||
WriteInt(a); |
|||
WriteString(' '); |
|||
WriteInt(b); |
|||
WriteString(' '); |
|||
WriteInt(c); |
|||
WriteString(' '); |
|||
WriteInt(d); |
|||
WriteString(' '); |
|||
WriteInt(e); |
|||
WriteString(' '); |
|||
WriteInt(f); |
|||
WriteString(' '); |
|||
WriteInt(g); |
|||
WriteLn; |
|||
END; |
|||
END; |
|||
END; |
|||
END; |
|||
END; |
|||
END; |
|||
END; |
|||
END; |
|||
IF unique THEN |
|||
WriteString('There are '); |
|||
WriteInt(count); |
|||
WriteString(' unique solutions in ['); |
|||
WriteInt(low); |
|||
WriteString(', '); |
|||
WriteInt(high); |
|||
WriteString(']'); |
|||
WriteLn; |
|||
ELSE |
|||
WriteString('There are '); |
|||
WriteInt(count); |
|||
WriteString(' non-unique solutions in ['); |
|||
WriteInt(low); |
|||
WriteString(', '); |
|||
WriteInt(high); |
|||
WriteString(']'); |
|||
WriteLn; |
|||
END; |
|||
END four_square; |
|||
BEGIN |
|||
four_square(1,7,TRUE,TRUE); |
|||
four_square(3,9,TRUE,TRUE); |
|||
four_square(0,9,FALSE,FALSE); |
|||
ReadChar; (* Wait so results can be viewed. *) |
|||
END FourSquare.</syntaxhighlight> |
|||
=={{header|Nim}}== |
|||
Adapted from Rust version. |
|||
<syntaxhighlight lang="nim">func isUnique(a, b, c, d, e, f, g: uint8): bool = |
|||
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 |
|||
c != d and c != e and c != f and c != g and |
|||
d != e and d != f and d != f and |
|||
e != f and e != g and |
|||
f != g |
|||
func isSolution(a, b, c, d, e, f, g: uint8): bool = |
|||
let sum = a + b |
|||
sum == b + c + d and sum == d + e + f and sum == f + g |
|||
func fourSquares(l, h: uint8, unique: bool): seq[array[7, uint8]] = |
|||
for a in l..h: |
|||
for b in l..h: |
|||
for c in l..h: |
|||
for d in l..h: |
|||
for e in l..h: |
|||
for f in l..h: |
|||
for g in l..h: |
|||
if (not unique or isUnique(a, b, c, d, e, f, g)) and |
|||
isSolution(a, b, c, d, e, f, g): |
|||
result &= [a, b, c, d, e, f, g] |
|||
proc printFourSquares(l, h: uint8, unique = true) = |
|||
let solutions = fourSquares(l, h, unique) |
|||
if unique: |
|||
for s in solutions: |
|||
echo s |
|||
echo solutions.len, (if unique: " " else: " non-"), "unique solutions in ", |
|||
l, " to ", h, " range\n" |
|||
when isMainModule: |
|||
printFourSquares(1, 7) |
|||
printFourSquares(3, 9) |
|||
printFourSquares(0, 9, unique = 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|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}}== |
=={{header|Pascal}}== |
||
{{works with|Free 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. |
There are so few solutions of 7 consecutive numbers, so I used a modified version, to get all the expected solutions at once. |
||
< |
<syntaxhighlight lang="pascal">program square4; |
||
{$MODE DELPHI} |
{$MODE DELPHI} |
||
{$R+,O+} |
{$R+,O+} |
||
Line 1,458: | Line 4,895: | ||
writeln(' solution count for ',loDgt,' to ',HiDgt,' = ',cnt); |
writeln(' solution count for ',loDgt,' to ',HiDgt,' = ',cnt); |
||
writeln('unique solution count for ',loDgt,' to ',HiDgt,' = ',uniqueCount); |
writeln('unique solution count for ',loDgt,' to ',HiDgt,' = ',uniqueCount); |
||
end.</ |
end.</syntaxhighlight> |
||
{{Out}} |
{{Out}} |
||
<pre> |
<pre> |
||
Line 1,496: | Line 4,933: | ||
unique solution count for 0 to 9 = 192</pre> |
unique solution count for 0 to 9 = 192</pre> |
||
=={{header|Perl |
=={{header|Perl}}== |
||
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. |
|||
{{works with|Rakudo|2016.12}} |
|||
{{libheader|ntheory}} |
|||
<syntaxhighlight lang="perl">use ntheory qw/forperm/; |
|||
use Set::CrossProduct; |
|||
sub four_sq_permute { |
|||
<lang perl6>sub four-squares ( @list, :$unique=1, :$show=1 ) { |
|||
my($list) = @_; |
|||
my @solutions; |
|||
forperm { |
|||
@c = @$list[@_]; |
|||
push @solutions, [@c] if check(@c); |
|||
} @$list; |
|||
print +@solutions . " unique solutions found using: " . join(', ', @$list) . "\n"; |
|||
return @solutions; |
|||
} |
|||
sub four_sq_cartesian { |
|||
my(@list) = @_; |
|||
my @solutions; |
my @solutions; |
||
my $iterator = Set::CrossProduct->new( [(@list) x 7] ); |
|||
while( my $c = $iterator->get ) { |
|||
@solutions |
push @solutions, [@$c] if check(@$c); |
||
@c[0] + @c[1], |
|||
@c[1] + @c[2] + @c[3], |
|||
@c[3] + @c[4] + @c[5], |
|||
@c[5] + @c[6]; |
|||
} |
} |
||
print +@solutions . " non-unique solutions found using: " . join(', ', @{@list[0]}) . "\n"; |
|||
return @solutions; |
|||
} |
|||
sub check { |
|||
say +@solutions, ($unique ?? ' ' !! ' non-'), "unique solutions found using {join(', ', @list)}.\n"; |
|||
my(@c) = @_; |
|||
$a = $c[0] + $c[1]; |
|||
$b = $c[1] + $c[2] + $c[3]; |
|||
$c = $c[3] + $c[4] + $c[5]; |
|||
$d = $c[5] + $c[6]; |
|||
$a == $b and $a == $c and $a == $d; |
|||
} |
|||
sub display { |
|||
my $f = "%{@list.max.chars}s"; |
|||
my(@solutions) = @_; |
|||
my $fmt = "%2s " x 7 . "\n"; |
|||
printf $fmt, ('a'..'g'); |
|||
printf $fmt, @$_ for @solutions; |
|||
print "\n"; |
|||
} |
|||
display four_sq_permute( [1..7] ); |
|||
say join "\n", (('a'..'g').fmt: $f), @solutions».fmt($f), "\n" if $show; |
|||
display four_sq_permute( [3..9] ); |
|||
display four_sq_permute( [8, 9, 11, 12, 17, 18, 20, 21] ); |
|||
four_sq_cartesian( [0..9] );</syntaxhighlight> |
|||
{{out}} |
|||
<pre>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 |
|||
multi combos ( $ where so * ) { @list.combinations(7).map: |*.permutations } |
|||
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 |
|||
multi combos ( $ where not * ) { [X] @list xx 7 } |
|||
a b c d e f g |
|||
} |
|||
17 21 8 9 11 18 20 |
|||
17 21 9 8 12 18 20 |
|||
20 18 8 12 9 17 21 |
|||
20 18 11 9 8 21 17 |
|||
20 18 11 9 12 17 21 |
|||
20 18 12 8 9 21 17 |
|||
21 17 9 12 8 18 20 |
|||
21 17 12 9 11 18 20 |
|||
2860 non-unique solutions found using: 0, 1, 2, 3, 4, 5, 6, 7, 8, 9</pre> |
|||
# TASK |
|||
===With Recursion=== |
|||
four-squares( [1..7] ); |
|||
<syntaxhighlight lang="perl">#!/usr/bin/perl |
|||
four-squares( [3..9] ); |
|||
four-squares( [8, 9, 11, 12, 17, 18, 20, 21] ); |
|||
four-squares( [0..9], :unique(0), :show(0) );</lang> |
|||
use strict; # https://rosettacode.org/wiki/4-rings_or_4-squares_puzzle |
|||
{{out}} |
|||
use warnings; |
|||
for ( [1 .. 7], [3 .. 9] ) |
|||
<pre>8 unique solutions found using 1, 2, 3, 4, 5, 6, 7. |
|||
{ |
|||
print "for @$_\n\n"; |
|||
findunique( $_ ); |
|||
print "\n"; |
|||
} |
|||
my $count = 0; |
|||
findcount(); |
|||
print "count of non-unique 0-9: $count\n"; |
|||
sub findunique |
|||
{ |
|||
my @allowed = @{ shift @_ }; |
|||
if( @_ == 4 ) { $_[0] == $_[2] + $_[3] or return } |
|||
elsif( @_ == 6 ) { $_[1] + $_[2] == $_[4] + $_[5] or return } |
|||
elsif( @_ == 7 ) { $_[3] + $_[4] == $_[6] and print "@_\n"; return } |
|||
for my $n ( @allowed ) |
|||
{ |
|||
findunique( [ grep $n != $_, @allowed ], @_, $n ); |
|||
} |
|||
} |
|||
sub findcount |
|||
{ |
|||
if( @_ == 4 ) { $_[0] == $_[2] + $_[3] or return } |
|||
elsif( @_ == 6 ) { $_[1] + $_[2] == $_[4] + $_[5] or return } |
|||
elsif( @_ == 7 ) { $_[3] + $_[4] == $_[6] and $count++; return } |
|||
findcount( @_, $_ ) for 0 .. 9; |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
for 1 2 3 4 5 6 7 |
|||
a b c d e f g |
|||
3 7 2 1 5 4 6 |
3 7 2 1 5 4 6 |
||
4 5 3 1 6 2 7 |
4 5 3 1 6 2 7 |
||
Line 1,542: | Line 5,061: | ||
7 3 2 5 1 4 6 |
7 3 2 5 1 4 6 |
||
for 3 4 5 6 7 8 9 |
|||
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 |
7 8 3 4 5 6 9 |
||
8 7 3 5 4 6 9 |
8 7 3 5 4 6 9 |
||
Line 1,551: | Line 5,068: | ||
9 6 5 4 3 8 7 |
9 6 5 4 3 8 7 |
||
count of non-unique 0-9: 2860 |
|||
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. |
|||
</pre> |
</pre> |
||
=={{header|Phix}}== |
|||
<lang Phix>integer solutions |
|||
=={{header|Phix}}== |
|||
procedure check(sequence set, bool show) |
|||
<!--<syntaxhighlight lang="phix">(phixonline)--> |
|||
integer {a,b,c,d,e,f,g} = set, ab = a+b |
|||
<span style="color: #000080;font-style:italic;">-- demo/rosetta/4_rings_or_4_squares_puzzle.exw</span> |
|||
if ab=b+d+c and ab=d+e+f and ab=f+g then |
|||
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span> |
|||
solutions += 1 |
|||
<span style="color: #004080;">integer</span> <span style="color: #000000;">solutions</span> |
|||
if show then |
|||
?set |
|||
<span style="color: #008080;">procedure</span> <span style="color: #000000;">check</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">set</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">bool</span> <span style="color: #000000;">show</span><span style="color: #0000FF;">)</span> |
|||
end if |
|||
<span style="color: #004080;">integer</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,</span><span style="color: #000000;">b</span><span style="color: #0000FF;">,</span><span style="color: #000000;">c</span><span style="color: #0000FF;">,</span><span style="color: #000000;">d</span><span style="color: #0000FF;">,</span><span style="color: #000000;">e</span><span style="color: #0000FF;">,</span><span style="color: #000000;">f</span><span style="color: #0000FF;">,</span><span style="color: #000000;">g</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">set</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">ab</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">+</span><span style="color: #000000;">b</span> |
|||
end if |
|||
<span style="color: #008080;">if</span> <span style="color: #000000;">ab</span><span style="color: #0000FF;">=</span><span style="color: #000000;">b</span><span style="color: #0000FF;">+</span><span style="color: #000000;">d</span><span style="color: #0000FF;">+</span><span style="color: #000000;">c</span> <span style="color: #008080;">and</span> <span style="color: #000000;">ab</span><span style="color: #0000FF;">=</span><span style="color: #000000;">d</span><span style="color: #0000FF;">+</span><span style="color: #000000;">e</span><span style="color: #0000FF;">+</span><span style="color: #000000;">f</span> <span style="color: #008080;">and</span> <span style="color: #000000;">ab</span><span style="color: #0000FF;">=</span><span style="color: #000000;">f</span><span style="color: #0000FF;">+</span><span style="color: #000000;">g</span> <span style="color: #008080;">then</span> |
|||
end procedure |
|||
<span style="color: #000000;">solutions</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span> |
|||
<span style="color: #008080;">if</span> <span style="color: #000000;">show</span> <span style="color: #008080;">then</span> |
|||
procedure foursquares(integer lo, integer hi, bool uniq, bool show) |
|||
<span style="color: #0000FF;">?</span><span style="color: #000000;">set</span> |
|||
sequence set = repeat(lo,7) |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span> |
|||
solutions = 0 |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span> |
|||
if uniq then |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span> |
|||
for i=1 to 7 do |
|||
set[i] = lo+i-1 |
|||
<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> <span style="color: #000000;">hi</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">bool</span> <span style="color: #000000;">uniq</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">show</span><span style="color: #0000FF;">)</span> |
|||
end for |
|||
<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> |
|||
for i=1 to factorial(7) do |
|||
<span style="color: #000000;">solutions</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span> |
|||
check(permute(i,set),show) |
|||
<span style="color: #008080;">if</span> <span style="color: #000000;">uniq</span> <span style="color: #008080;">then</span> |
|||
end for |
|||
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">7</span> <span style="color: #008080;">do</span> |
|||
else |
|||
<span style="color: #000000;">set</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">lo</span><span style="color: #0000FF;">+</span><span style="color: #000000;">i</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span> |
|||
integer done = 0 |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span> |
|||
while not done do |
|||
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">factorial</span><span style="color: #0000FF;">(</span><span style="color: #000000;">7</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span> |
|||
check(set,show) |
|||
<span style="color: #000000;">check</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">permute</span><span style="color: #0000FF;">(</span><span style="color: #000000;">i</span><span style="color: #0000FF;">,</span><span style="color: #000000;">set</span><span style="color: #0000FF;">),</span><span style="color: #000000;">show</span><span style="color: #0000FF;">)</span> |
|||
for i=1 to 7 do |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span> |
|||
set[i] += 1 |
|||
<span style="color: #008080;">else</span> |
|||
if set[i]<=hi then exit end if |
|||
<span style="color: #004080;">integer</span> <span style="color: #000000;">done</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span> |
|||
if i=7 then |
|||
<span style="color: #008080;">while</span> <span style="color: #008080;">not</span> <span style="color: #000000;">done</span> <span style="color: #008080;">do</span> |
|||
done = 1 |
|||
<span style="color: #000000;">check</span><span style="color: #0000FF;">(</span><span style="color: #000000;">set</span><span style="color: #0000FF;">,</span><span style="color: #000000;">show</span><span style="color: #0000FF;">)</span> |
|||
exit |
|||
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">7</span> <span style="color: #008080;">do</span> |
|||
end if |
|||
<span style="color: #000000;">set</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span> |
|||
set[i] = lo |
|||
<span style="color: #008080;">if</span> <span style="color: #000000;">set</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]<=</span><span style="color: #000000;">hi</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span> |
|||
end for |
|||
<span style="color: #008080;">if</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">7</span> <span style="color: #008080;">then</span> |
|||
end while |
|||
<span style="color: #000000;">done</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span> |
|||
end if |
|||
<span style="color: #008080;">exit</span> |
|||
printf(1,"%d solutions\n",solutions) |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span> |
|||
end procedure |
|||
<span style="color: #000000;">set</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">lo</span> |
|||
foursquares(1,7,uniq:=True,show:=True) |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span> |
|||
foursquares(3,9,True,True) |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span> |
|||
foursquares(0,9,False,False)</lang> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span> |
|||
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%d solutions\n"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">solutions</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span> |
|||
<span style="color: #000000;">foursquares</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">7</span><span style="color: #0000FF;">,</span><span style="color: #000000;">uniq</span><span style="color: #0000FF;">:=</span><span style="color: #004600;">true</span><span style="color: #0000FF;">,</span><span style="color: #000000;">show</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;">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> |
|||
<!--</syntaxhighlight>--> |
|||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
Line 1,627: | Line 5,135: | ||
4 solutions |
4 solutions |
||
2860 solutions |
2860 solutions |
||
</pre> |
|||
=={{header|Picat}}== |
|||
<syntaxhighlight lang="picat">import cp. |
|||
main => |
|||
puzzle_all(1, 7, true, Sol1), |
|||
foreach(Sol in Sol1) println(Sol) end, |
|||
nl, |
|||
puzzle_all(3, 9, true, Sol2), |
|||
foreach(Sol in Sol2) println(Sol) end, |
|||
nl, |
|||
puzzle_all(0, 9, false, Sol3), |
|||
println(len=Sol3.len), |
|||
nl. |
|||
puzzle_all(Min, Max, Distinct, LL) => |
|||
L = [A,B,C,D,E,F,G], |
|||
L :: Min..Max, |
|||
if Distinct then |
|||
all_different(L) |
|||
else |
|||
true |
|||
end, |
|||
T #= A+B, |
|||
T #= B+C+D, |
|||
T #= D+E+F, |
|||
T #= F+G, |
|||
% Another approach: |
|||
% 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 |
|||
[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] |
|||
[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] |
|||
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> |
</pre> |
||
=={{header|PL/SQL}}== |
=={{header|PL/SQL}}== |
||
{{works with|Oracle}} |
{{works with|Oracle}} |
||
< |
<syntaxhighlight lang="plsql"> |
||
create table allints (v number); |
create table allints (v number); |
||
create table results |
create table results |
||
Line 1,763: | Line 5,446: | ||
end; |
end; |
||
/ |
/ |
||
</syntaxhighlight> |
|||
</lang> |
|||
Output |
Output |
||
<pre> |
<pre> |
||
Line 1,792: | Line 5,475: | ||
PL/SQL procedure successfully completed. |
PL/SQL procedure successfully completed. |
||
</pre> |
|||
=={{header|Prolog}}== |
|||
Works with SWI-Prolog 7.5.8 |
|||
<syntaxhighlight lang="prolog"> |
|||
:- use_module(library(clpfd)). |
|||
% main predicate |
|||
my_sum(Min, Max, Top, LL):- |
|||
L = [A,B,C,D,E,F,G], |
|||
L ins Min..Max, |
|||
( Top == 0 |
|||
-> all_distinct(L) |
|||
; true), |
|||
R #= A+B, |
|||
R #= B+C+D, |
|||
R #= D+E+F, |
|||
R #= F+G, |
|||
setof(L, labeling([ff], L), LL). |
|||
my_sum_1(Min, Max) :- |
|||
my_sum(Min, Max, 0, LL), |
|||
maplist(writeln, LL). |
|||
my_sum_2(Min, Max, Len) :- |
|||
my_sum(Min, Max, 1, LL), |
|||
length(LL, Len). |
|||
</syntaxhighlight> |
|||
Output |
|||
<pre> |
|||
?- my_sum_1(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,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] |
|||
true. |
|||
?- my_sum_1(3,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] |
|||
true. |
|||
?- my_sum_2(0,9,N). |
|||
N = 2860. |
|||
</pre> |
</pre> |
||
=={{header|Python}}== |
=={{header|Python}}== |
||
===Procedural=== |
|||
<lang Python> |
|||
====Itertools==== |
|||
import itertools |
|||
<syntaxhighlight lang="python">import itertools |
|||
def all_equal(a,b,c,d,e,f,g): |
def all_equal(a,b,c,d,e,f,g): |
||
return a+b == b+c+d |
return a+b == b+c+d == d+e+f == f+g |
||
def foursquares(lo,hi,unique,show): |
def foursquares(lo,hi,unique,show): |
||
Line 1,818: | Line 5,553: | ||
print str(solutions)+" "+uorn+" solutions in "+str(lo)+" to "+str(hi) |
print str(solutions)+" "+uorn+" solutions in "+str(lo)+" to "+str(hi) |
||
print |
print</syntaxhighlight> |
||
</lang> |
|||
Output |
Output |
||
<pre>foursquares(1,7,True,True) |
|||
<pre> |
|||
foursquares(1,7,True,True) |
|||
4, 5, 3, 1, 6, 2, 7 |
4, 5, 3, 1, 6, 2, 7 |
||
3, 7, 2, 1, 5, 4, 6 |
3, 7, 2, 1, 5, 4, 6 |
||
Line 1,843: | Line 5,576: | ||
foursquares(0,9,False,False) |
foursquares(0,9,False,False) |
||
2860 non-unique solutions in 0 to 9 |
2860 non-unique solutions in 0 to 9</pre> |
||
====Generators==== |
|||
</pre> |
|||
Faster solution without itertools |
Faster solution without itertools |
||
<syntaxhighlight lang="python"> |
|||
<lang Python> |
|||
def foursquares(lo,hi,unique,show): |
def foursquares(lo,hi,unique,show): |
||
Line 1,912: | Line 5,645: | ||
print str(solutions)+" "+uorn+" solutions in "+str(lo)+" to "+str(hi) |
print str(solutions)+" "+uorn+" solutions in "+str(lo)+" to "+str(hi) |
||
print |
print</syntaxhighlight> |
||
Output<pre> |
|||
</lang> |
|||
Output |
|||
<pre> |
|||
foursquares(1,7,True,True) |
foursquares(1,7,True,True) |
||
4, 7, 1, 3, 2, 6, 5 |
4, 7, 1, 3, 2, 6, 5 |
||
Line 1,938: | Line 5,668: | ||
foursquares(0,9,False,False) |
foursquares(0,9,False,False) |
||
2860 non-unique solutions in 0 to 9 |
2860 non-unique solutions in 0 to 9</pre> |
||
===Functional=== |
|||
{{Trans|Haskell}} |
|||
{{Trans|JavaScript}} |
|||
{{Works with|Python|3.7}} |
|||
<syntaxhighlight lang="python">'''4-rings or 4-squares puzzle''' |
|||
from itertools import chain |
|||
# rings :: noRepeatedDigits -> DigitList -> Lists of solutions |
|||
# rings :: Bool -> [Int] -> [[Int]] |
|||
def rings(uniq): |
|||
'''Sets of unique or non-unique integer values |
|||
(drawn from the `digits` argument) |
|||
for each of the seven names [a..g] such that: |
|||
(a + b) == (b + c + d) == (d + e + f) == (f + g) |
|||
''' |
|||
def go(digits): |
|||
ns = sorted(digits, reverse=True) |
|||
h = ns[0] |
|||
# CENTRAL DIGIT :: d |
|||
def central(d): |
|||
xs = list(filter(lambda x: h >= (d + x), ns)) |
|||
# LEFT NEIGHBOUR AND LEFTMOST :: c and a |
|||
def left(c): |
|||
a = c + d |
|||
if a > h: |
|||
return [] |
|||
else: |
|||
# RIGHT NEIGHBOUR AND RIGHTMOST :: e and g |
|||
def right(e): |
|||
g = d + e |
|||
if ((g > h) or (uniq and (g == c))): |
|||
return [] |
|||
else: |
|||
agDelta = a - g |
|||
bfs = difference(ns)( |
|||
[d, c, e, g, a] |
|||
) if uniq else ns |
|||
# MID LEFT AND RIGHT :: b and f |
|||
def midLeftRight(b): |
|||
f = b + agDelta |
|||
return [[a, b, c, d, e, f, g]] if ( |
|||
(f in bfs) and ( |
|||
(not uniq) or ( |
|||
f not in [a, b, c, d, e, g] |
|||
) |
|||
) |
|||
) else [] |
|||
# CANDIDATE DIGITS BOUND TO POSITIONS [a .. g] -------- |
|||
return concatMap(midLeftRight)(bfs) |
|||
return concatMap(right)( |
|||
difference(xs)([d, c, a]) if uniq else ns |
|||
) |
|||
return concatMap(left)( |
|||
delete(d)(xs) if uniq else ns |
|||
) |
|||
return concatMap(central)(ns) |
|||
return lambda digits: go(digits) if digits else [] |
|||
# TEST ---------------------------------------------------- |
|||
# main :: IO () |
|||
def main(): |
|||
'''Testing unique digits [1..7], [3..9] and unrestricted digits''' |
|||
print(main.__doc__ + ':\n') |
|||
print(unlines(map( |
|||
lambda tpl: '\nrings' + repr(tpl) + ':\n\n' + unlines( |
|||
map(repr, uncurry(rings)(*tpl)) |
|||
), [ |
|||
(True, enumFromTo(1)(7)), |
|||
(True, enumFromTo(3)(9)) |
|||
] |
|||
))) |
|||
tpl = (False, enumFromTo(0)(9)) |
|||
print( |
|||
'\n\nlen(rings' + repr(tpl) + '):\n\n' + |
|||
str(len(uncurry(rings)(*tpl))) |
|||
) |
|||
# GENERIC ------------------------------------------------- |
|||
# concatMap :: (a -> [b]) -> [a] -> [b] |
|||
def concatMap(f): |
|||
'''A concatenated list over which a function has been mapped. |
|||
The list monad can be derived by using a function f which |
|||
wraps its output in a list, |
|||
(using an empty list to represent computational failure). |
|||
''' |
|||
return lambda xs: list( |
|||
chain.from_iterable(map(f, xs)) |
|||
) |
|||
# delete :: Eq a => a -> [a] -> [a] |
|||
def delete(x): |
|||
'''xs with the first of any instances of x removed.''' |
|||
def go(xs): |
|||
xs.remove(x) |
|||
return xs |
|||
return lambda xs: go(list(xs)) if ( |
|||
x in xs |
|||
) else list(xs) |
|||
# difference :: Eq a => [a] -> [a] -> [a] |
|||
def difference(xs): |
|||
'''All elements of ys except any also found in xs''' |
|||
def go(ys): |
|||
s = set(ys) |
|||
return [x for x in xs if x not in s] |
|||
return lambda ys: go(ys) |
|||
# enumFromTo :: (Int, Int) -> [Int] |
|||
def enumFromTo(m): |
|||
'''Integer enumeration from m to n.''' |
|||
return lambda n: list(range(m, 1 + n)) |
|||
# uncurry :: (a -> b -> c) -> ((a, b) -> c) |
|||
def uncurry(f): |
|||
'''A function over a pair of arguments, |
|||
derived from a vanilla or curried function. |
|||
''' |
|||
return lambda x, y: f(x)(y) |
|||
# unlines :: [String] -> String |
|||
def unlines(xs): |
|||
'''A single string formed by the intercalation |
|||
of a list of strings with the newline character. |
|||
''' |
|||
return '\n'.join(xs) |
|||
# MAIN --- |
|||
if __name__ == '__main__': |
|||
main()</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>Testing unique digits [1..7], [3..9] and unrestricted digits: |
|||
rings(True, [1, 2, 3, 4, 5, 6, 7]): |
|||
[7, 3, 2, 5, 1, 4, 6] |
|||
[6, 4, 1, 5, 2, 3, 7] |
|||
[5, 6, 2, 3, 1, 7, 4] |
|||
[4, 7, 1, 3, 2, 6, 5] |
|||
[7, 2, 6, 1, 3, 5, 4] |
|||
[6, 4, 5, 1, 2, 7, 3] |
|||
[4, 5, 3, 1, 6, 2, 7] |
|||
[3, 7, 2, 1, 5, 4, 6] |
|||
rings(True, [3, 4, 5, 6, 7, 8, 9]): |
|||
[9, 6, 4, 5, 3, 7, 8] |
|||
[8, 7, 3, 5, 4, 6, 9] |
|||
[9, 6, 5, 4, 3, 8, 7] |
|||
[7, 8, 3, 4, 5, 6, 9] |
|||
len(rings(False, [0, 1, 2, 3, 4, 5, 6, 7, 8, 9])): |
|||
2860</pre> |
|||
=={{header|R}}== |
|||
Function "perms" is a modified version of the "permutations" function from the "gtools" R package. |
|||
<syntaxhighlight lang="r"># 4 rings or 4 squares puzzle |
|||
perms <- function (n, r, v = 1:n, repeats.allowed = FALSE) { |
|||
if (repeats.allowed) |
|||
sub <- function(n, r, v) { |
|||
if (r == 1) |
|||
matrix(v, n, 1) |
|||
else if (n == 1) |
|||
matrix(v, 1, r) |
|||
else { |
|||
inner <- Recall(n, r - 1, v) |
|||
cbind(rep(v, rep(nrow(inner), n)), matrix(t(inner), |
|||
ncol = ncol(inner), nrow = nrow(inner) * n, |
|||
byrow = TRUE)) |
|||
} |
|||
} |
|||
else sub <- function(n, r, v) { |
|||
if (r == 1) |
|||
matrix(v, n, 1) |
|||
else if (n == 1) |
|||
matrix(v, 1, r) |
|||
else { |
|||
X <- NULL |
|||
for (i in 1:n) X <- rbind(X, cbind(v[i], Recall(n - 1, r - 1, v[-i]))) |
|||
X |
|||
} |
|||
} |
|||
X <- sub(n, r, v[1:n]) |
|||
result <- vector(mode = "numeric") |
|||
for(i in 1:nrow(X)){ |
|||
y <- X[i, ] |
|||
x1 <- y[1] + y[2] |
|||
x2 <- y[2] + y[3] + y[4] |
|||
x3 <- y[4] + y[5] + y[6] |
|||
x4 <- y[6] + y[7] |
|||
if(x1 == x2 & x2 == x3 & x3 == x4) result <- rbind(result, y) |
|||
} |
|||
return(result) |
|||
} |
|||
print_perms <- function(n, r, v = 1:n, repeats.allowed = FALSE, table.out = FALSE) { |
|||
a <- perms(n, r, v, repeats.allowed) |
|||
colnames(a) <- rep("", ncol(a)) |
|||
rownames(a) <- rep("", nrow(a)) |
|||
if(!repeats.allowed){ |
|||
print(a) |
|||
cat(paste('\n', nrow(a), 'unique solutions from', min(v), 'to', max(v))) |
|||
} else { |
|||
cat(paste('\n', nrow(a), 'non-unique solutions from', min(v), 'to', max(v))) |
|||
} |
|||
} |
|||
registerS3method("print_perms", "data.frame", print_perms) |
|||
print_perms(7, 7, repeats.allowed = FALSE, table.out = TRUE) |
|||
print_perms(7, 7, v = 3:9, repeats.allowed = FALSE, table.out = TRUE) |
|||
print_perms(10, 7, v = 0:9, repeats.allowed = TRUE, table.out = 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 from 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 from 3 to 9 |
|||
2860 non-unique solutions from 0 to 9 |
|||
</pre> |
|||
=={{header|Racket}}== |
|||
Using a folder, so we can count as well as produce lists of results |
|||
<syntaxhighlight lang="racket">#lang racket |
|||
(define solution? (match-lambda [(list a b c d e f g) (= (+ a b) (+ b c d) (+ d e f) (+ f g))])) |
|||
(define (fold-4-rings-or-4-squares-puzzle lo hi kons k0) |
|||
(for*/fold ((k k0)) |
|||
((combination (in-combinations (range lo (add1 hi)) 7)) |
|||
(permutation (in-permutations combination)) |
|||
#:when (solution? permutation)) |
|||
(kons permutation k))) |
|||
(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)</syntaxhighlight> |
|||
{{out}} |
|||
<pre>'((6 4 1 5 2 3 7) (4 5 3 1 6 2 7) (3 7 2 1 5 4 6) (7 3 2 5 1 4 6) (4 7 1 3 2 6 5) (5 6 2 3 1 7 4) (7 2 6 1 3 5 4) (6 4 5 1 2 7 3)) |
|||
'((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)) |
|||
192</pre> |
|||
=={{header|Raku}}== |
|||
(formerly Perl 6) |
|||
{{works with|Rakudo|2016.12}} |
|||
<syntaxhighlight lang="raku" line>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) );</syntaxhighlight> |
|||
{{out}} |
|||
<pre>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. |
|||
</pre> |
</pre> |
||
Line 1,946: | Line 6,034: | ||
This REXX version is faster than the more idiomatic version, but is longer (statement-wise) and |
This REXX version is faster than the more idiomatic version, but is longer (statement-wise) and |
||
<br>a bit easier to read (visualize). |
<br>a bit easier to read (visualize). |
||
< |
<syntaxhighlight 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.*/ |
arg LO HI unique show . /*the ARG statement capitalizes args.*/ |
||
if LO=='' | LO=="," then LO=1 /*Not specified? Then use the default.*/ |
if LO=='' | LO=="," then LO=1 /*Not specified? Then use the default.*/ |
||
Line 2,015: | Line 6,103: | ||
if show then say left('',9) center(a1,w) center(a2,w) center(a3,w) center(a4,w), |
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) |
center(a5,w) center(a6,w) center(a7,w) |
||
return</ |
return</syntaxhighlight> |
||
{{out|output|text= when using the default inputs: <tt> 1 7 </tt>}} |
|||
<pre> |
<pre> |
||
a b c d e f g |
a b c d e f g |
||
Line 2,031: | Line 6,119: | ||
8 unique solutions found. |
8 unique solutions found. |
||
</pre> |
</pre> |
||
{{out|output|text= when using the input of: <tt> 3 9 </tt>}} |
|||
<pre> |
<pre> |
||
a b c d e f g |
a b c d e f g |
||
Line 2,042: | Line 6,130: | ||
4 unique solutions found. |
4 unique solutions found. |
||
</pre> |
</pre> |
||
{{out|output|text= when using the input of: <tt> 0 9 non-unique noshow </tt>}} |
|||
<pre> |
<pre> |
||
2860 non-unique solutions found. |
2860 non-unique solutions found. |
||
Line 2,052: | Line 6,140: | ||
Note that the REXX language doesn't have short-circuits (when executing multiple clauses |
Note that the REXX language doesn't have short-circuits (when executing multiple clauses |
||
in <big> '''if''' </big> (and other) statements. |
in <big> '''if''' </big> (and other) statements. |
||
< |
<syntaxhighlight 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.*/ |
arg LO HI unique show . /*the ARG statement capitalizes args.*/ |
||
if LO=='' | LO=="," then LO=1 /*Not specified? Then use the default.*/ |
if LO=='' | LO=="," then LO=1 /*Not specified? Then use the default.*/ |
||
Line 2,072: | Line 6,160: | ||
do g=LO for times; if u then if g==a|g==b|g==c|g==d|g==e|g==f then iterate |
do g=LO for times; if u then if g==a|g==b|g==c|g==d|g==e|g==f then iterate |
||
sum=a+b |
sum=a+b |
||
if f+g==sum & b+c+d==sum & d+e+f==sum then #=#+1 |
if f+g==sum & b+c+d==sum & d+e+f==sum then #=#+1 /*bump # of solutions.*/ |
||
else iterate |
else iterate /*sum not equal, no─go*/ |
||
#=# + 1 /*bump count of solutions.*/ |
|||
if #==1 then call align 'a', 'b', 'c', 'd', 'e', 'f', 'g' |
if #==1 then call align 'a', 'b', 'c', 'd', 'e', 'f', 'g' |
||
if #==1 then call align bar, bar, bar, bar, bar, bar, bar |
if #==1 then call align bar, bar, bar, bar, bar, bar, bar |
||
Line 2,094: | Line 6,181: | ||
if show then say left('',9) center(a1,w) center(a2,w) center(a3,w) center(a4,w), |
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) |
center(a5,w) center(a6,w) center(a7,w) |
||
return</ |
return</syntaxhighlight> |
||
{{out|output|text= is identical to the faster REXX version.}} <br><br> |
|||
<br><br> |
|||
=={{header|Ruby}}== |
=={{header|Ruby}}== |
||
< |
<syntaxhighlight 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} |
f = -> (a,b,c,d,e,f,g) {[a+b, b+c+d, d+e+f, f+g].uniq.size == 1} |
||
if unique |
if unique |
||
Line 2,119: | Line 6,205: | ||
four_squares(low, high) |
four_squares(low, high) |
||
end |
end |
||
four_squares(0, 9, false)</ |
four_squares(0, 9, false)</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
Line 2,143: | Line 6,229: | ||
2860 non-unique solutions in 0 to 9 |
2860 non-unique solutions in 0 to 9 |
||
</pre> |
</pre> |
||
=={{header|Rust}}== |
|||
<syntaxhighlight lang="rust"> |
|||
#![feature(inclusive_range_syntax)] |
|||
fn is_unique(a: u8, b: u8, c: u8, d: u8, e: u8, f: u8, g: u8) -> bool { |
|||
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 |
|||
} |
|||
fn is_solution(a: u8, b: u8, c: u8, d: u8, e: u8, f: u8, g: u8) -> bool { |
|||
a + b == b + c + d && |
|||
b + c + d == d + e + f && |
|||
d + e + f == f + g |
|||
} |
|||
fn four_squares(low: u8, high: u8, unique: bool) -> Vec<Vec<u8>> { |
|||
let mut results: Vec<Vec<u8>> = Vec::new(); |
|||
for a in low..=high { |
|||
for b in low..=high { |
|||
for c in low..=high { |
|||
for d in low..=high { |
|||
for e in low..=high { |
|||
for f in low..=high { |
|||
for g in low..=high { |
|||
if (!unique || is_unique(a, b, c, d, e, f, g)) && |
|||
is_solution(a, b, c, d, e, f, g) { |
|||
results.push(vec![a, b, c, d, e, f, g]); |
|||
} |
|||
} |
|||
} |
|||
} |
|||
} |
|||
} |
|||
} |
|||
} |
|||
results |
|||
} |
|||
fn print_results(solutions: &Vec<Vec<u8>>) { |
|||
for solution in solutions { |
|||
println!("{:?}", solution) |
|||
} |
|||
} |
|||
fn print_results_summary(solutions: usize, low: u8, high: u8, unique: bool) { |
|||
let uniqueness = if unique { |
|||
"unique" |
|||
} else { |
|||
"non-unique" |
|||
}; |
|||
println!("{} {} solutions in {} to {} range", solutions, uniqueness, low, high) |
|||
} |
|||
fn uniques(low: u8, high: u8) { |
|||
let solutions = four_squares(low, high, true); |
|||
print_results(&solutions); |
|||
print_results_summary(solutions.len(), low, high, true); |
|||
} |
|||
fn nonuniques(low: u8, high: u8) { |
|||
let solutions = four_squares(low, high, false); |
|||
print_results_summary(solutions.len(), low, high, false); |
|||
} |
|||
fn main() { |
|||
uniques(1, 7); |
|||
println!(); |
|||
uniques(3, 9); |
|||
println!(); |
|||
nonuniques(0, 9); |
|||
} |
|||
</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|Scala}}== |
|||
{{trans|Java}} |
|||
<syntaxhighlight lang="scala">object FourRings { |
|||
def fourSquare(low: Int, high: Int, unique: Boolean, print: Boolean): Unit = { |
|||
def isValid(needle: Integer, haystack: Integer*) = !unique || !haystack.contains(needle) |
|||
if (print) println("a b c d e f g") |
|||
var count = 0 |
|||
for { |
|||
a <- low to high |
|||
b <- low to high if isValid(a, b) |
|||
fp = a + b |
|||
c <- low to high if isValid(c, a, b) |
|||
d <- low to high if isValid(d, a, b, c) && fp == b + c + d |
|||
e <- low to high if isValid(e, a, b, c, d) |
|||
f <- low to high if isValid(f, a, b, c, d, e) && fp == d + e + f |
|||
g <- low to high if isValid(g, a, b, c, d, e, f) && fp == f + g |
|||
} { |
|||
count += 1 |
|||
if (print) println(s"$a $b $c $d $e $f $g") |
|||
} |
|||
println(s"There are $count ${if(unique) "unique" else "non-unique"} solutions in [$low, $high]") |
|||
} |
|||
def main(args: Array[String]): Unit = { |
|||
fourSquare(1, 7, unique = true, print = true) |
|||
fourSquare(3, 9, unique = true, print = true) |
|||
fourSquare(0, 9, unique = false, print = false) |
|||
} |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre>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 |
|||
There are 8 unique solutions in [1, 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 |
|||
There are 4 unique solutions in [3, 9] |
|||
There are 2860 non-unique solutions in [0, 9]</pre> |
|||
=={{header|Scheme}}== |
=={{header|Scheme}}== |
||
< |
<syntaxhighlight lang="scheme"> |
||
(import (scheme base) |
(import (scheme base) |
||
(scheme write) |
(scheme write) |
||
Line 2,194: | Line 6,430: | ||
(display (count (lambda (combination) (apply solution? combination)) |
(display (count (lambda (combination) (apply solution? combination)) |
||
(combinations 7 (iota 10 0) #f))) (newline) |
(combinations 7 (iota 10 0) #f))) (newline) |
||
</syntaxhighlight> |
|||
</lang> |
|||
{{out}} |
{{out}} |
||
Line 2,205: | Line 6,441: | ||
2860 |
2860 |
||
</pre> |
</pre> |
||
=={{header|Sidef}}== |
|||
{{trans|Raku}} |
|||
<syntaxhighlight lang="ruby">func four_squares (list, unique=true, show=true) { |
|||
var solutions = [] |
|||
func check(c) { |
|||
solutions << c if ([ |
|||
c[0] + c[1], |
|||
c[1] + c[2] + c[3], |
|||
c[3] + c[4] + c[5], |
|||
c[5] + c[6], |
|||
].uniq.len == 1) |
|||
} |
|||
if (unique) { |
|||
list.combinations(7, {|*a| |
|||
a.permutations { |*c| |
|||
check(c) |
|||
} |
|||
}) |
|||
} else { |
|||
7.of { list }.cartesian {|*c| |
|||
check(c) |
|||
} |
|||
} |
|||
say (solutions.len, |
|||
(unique ? ' ' : ' non-'), |
|||
"unique solutions found using #{list.join(', ')}.\n") |
|||
if (show) { |
|||
var f = "%#{list.max.len+1}s" |
|||
say ("\n".join( |
|||
('a'..'g').map{f % _}.join, |
|||
solutions.map{ .map{f % _}.join }... |
|||
), "\n") |
|||
} |
|||
} |
|||
# TASK |
|||
four_squares(@(1..7)) |
|||
four_squares(@(3..9)) |
|||
four_squares([8, 9, 11, 12, 17, 18, 20, 21]) |
|||
four_squares(@(0..9), unique: false, show: false)</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
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. |
|||
</pre> |
|||
=={{header|Simula}}== |
|||
<syntaxhighlight lang="modula2">BEGIN |
|||
INTEGER PROCEDURE GETCOMBS(LOW, HIGH, UNIQUE, COMBS); |
|||
INTEGER LOW, HIGH; |
|||
INTEGER ARRAY COMBS; |
|||
BOOLEAN UNIQUE; |
|||
BEGIN |
|||
INTEGER A, B, C, D, E, F, G; |
|||
INTEGER NUM; |
|||
BOOLEAN PROCEDURE ISUNIQUE(A, B, C, D, E, F, G); |
|||
INTEGER A, B, C, D, E, F, G; |
|||
BEGIN |
|||
INTEGER ARRAY DATA(LOW:HIGH); |
|||
INTEGER I; |
|||
FOR I := LOW STEP 1 UNTIL HIGH DO |
|||
DATA(I) := -1; |
|||
FOR I := A, B, C, D, E, F, G DO |
|||
IF DATA(I) = -1 |
|||
THEN DATA(I) := 1 |
|||
ELSE GOTO L; |
|||
ISUNIQUE := TRUE; |
|||
L: |
|||
END; |
|||
PROCEDURE ADDCOMB; |
|||
BEGIN |
|||
NUM := NUM + 1; |
|||
COMBS(NUM, LOW + 0) := A; |
|||
COMBS(NUM, LOW + 1) := B; |
|||
COMBS(NUM, LOW + 2) := C; |
|||
COMBS(NUM, LOW + 3) := D; |
|||
COMBS(NUM, LOW + 4) := E; |
|||
COMBS(NUM, LOW + 5) := F; |
|||
COMBS(NUM, LOW + 6) := G; |
|||
END; |
|||
FOR A := LOW STEP 1 UNTIL HIGH DO |
|||
FOR B := LOW STEP 1 UNTIL HIGH DO |
|||
FOR C := LOW STEP 1 UNTIL HIGH DO |
|||
FOR D := LOW STEP 1 UNTIL HIGH DO |
|||
FOR E := LOW STEP 1 UNTIL HIGH DO |
|||
FOR F := LOW STEP 1 UNTIL HIGH DO |
|||
FOR G := LOW STEP 1 UNTIL HIGH DO |
|||
BEGIN |
|||
IF VALIDCOMB(A, B, C, D, E, F, G) THEN |
|||
BEGIN |
|||
IF UNIQUE THEN |
|||
BEGIN IF ISUNIQUE(A, B, C, D, E, F, G) THEN ADDCOMB END |
|||
ELSE ADDCOMB; |
|||
END; |
|||
END; |
|||
GETCOMBS := NUM; |
|||
END; |
|||
BOOLEAN PROCEDURE VALIDCOMB(A, B, C, D, E, F, G); |
|||
INTEGER A, B, C, D, E, F, G; |
|||
BEGIN |
|||
INTEGER SQUARE1, SQUARE2, SQUARE3, SQUARE4; |
|||
SQUARE1 := A + B; |
|||
SQUARE2 := B + C + D; |
|||
SQUARE3 := D + E + F; |
|||
SQUARE4 := F + G; |
|||
VALIDCOMB := SQUARE1 = SQUARE2 AND SQUARE2 = SQUARE3 AND SQUARE3 = SQUARE4 |
|||
END; |
|||
COMMENT ----- MAIN PROGRAM ----- ; |
|||
INTEGER ARRAY LO(1:3); |
|||
INTEGER ARRAY HI(1:3); |
|||
BOOLEAN ARRAY UQ(1:3); |
|||
INTEGER I; |
|||
LO(1) := 1; HI(1) := 7; UQ(1) := TRUE; |
|||
LO(2) := 3; HI(2) := 9; UQ(2) := TRUE; |
|||
LO(3) := 0; HI(3) := 9; UQ(3) := FALSE; |
|||
FOR I := 1 STEP 1 UNTIL 3 DO |
|||
BEGIN |
|||
INTEGER LOW, HIGH; |
|||
BOOLEAN UNIQ; |
|||
LOW := LO(I); HIGH := HI(I); UNIQ := UQ(I); |
|||
BEGIN |
|||
INTEGER ARRAY VALIDCOMBS(1:8000, LOW:HIGH); |
|||
INTEGER N; |
|||
N := GETCOMBS(LOW, HIGH, UNIQ, VALIDCOMBS); |
|||
OUTINT(N, 0); |
|||
IF UNIQ THEN OUTTEXT(" UNIQUE"); |
|||
OUTTEXT(" SOLUTIONS IN "); |
|||
OUTINT(LOW, 0); OUTTEXT(" TO "); |
|||
OUTINT(HIGH, 0); |
|||
OUTIMAGE; |
|||
IF I < 3 THEN |
|||
BEGIN INTEGER I, J; |
|||
FOR I := 1 STEP 1 UNTIL N DO |
|||
BEGIN |
|||
OUTTEXT("["); |
|||
FOR J := LOW STEP 1 UNTIL HIGH DO |
|||
OUTINT(VALIDCOMBS(I, J), 2); |
|||
OUTTEXT(" ]"); |
|||
OUTIMAGE; |
|||
END; |
|||
END; |
|||
END; |
|||
END; |
|||
END. |
|||
</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 SOLUTIONS IN 0 TO 9 |
|||
</pre> |
|||
=={{header|SQL PL}}== |
|||
{{works with|Db2 LUW}} version 9.7 or higher. |
|||
With SQL PL: |
|||
<syntaxhighlight lang="sql pl"> |
|||
--#SET TERMINATOR @ |
|||
SET SERVEROUTPUT ON @ |
|||
CREATE TABLE ALL_INTS ( |
|||
V INTEGER |
|||
)@ |
|||
CREATE TABLE RESULTS ( |
|||
A INTEGER, |
|||
B INTEGER, |
|||
C INTEGER, |
|||
D INTEGER, |
|||
E INTEGER, |
|||
F INTEGER, |
|||
G INTEGER |
|||
)@ |
|||
CREATE OR REPLACE PROCEDURE FOUR_SQUARES( |
|||
IN LO INTEGER, |
|||
IN HI INTEGER, |
|||
IN UNIQ SMALLINT, |
|||
--IN UNIQ BOOLEAN, |
|||
IN SHOW SMALLINT) |
|||
--IN SHOW BOOLEAN) |
|||
BEGIN |
|||
DECLARE A INTEGER; |
|||
DECLARE B INTEGER; |
|||
DECLARE C INTEGER; |
|||
DECLARE D INTEGER; |
|||
DECLARE E INTEGER; |
|||
DECLARE F INTEGER; |
|||
DECLARE G INTEGER; |
|||
DECLARE OUT_LINE VARCHAR(2000); |
|||
DECLARE I SMALLINT; |
|||
DECLARE SOLUTIONS INTEGER; |
|||
DECLARE UORN VARCHAR(2000); |
|||
SET SOLUTIONS = 0; |
|||
DELETE FROM ALL_INTS; |
|||
DELETE FROM RESULTS; |
|||
SET I = LO; |
|||
WHILE (I <= HI) DO |
|||
INSERT INTO ALL_INTS VALUES (I); |
|||
SET I = I + 1; |
|||
END WHILE; |
|||
COMMIT; |
|||
-- Computes unique solutions. |
|||
IF (UNIQ = 0) THEN |
|||
--IF (UNIQ = TRUE) THEN |
|||
INSERT INTO RESULTS |
|||
SELECT |
|||
A.V A, B.V B, C.V C, D.V D, E.V E, F.V F, G.V G |
|||
FROM |
|||
ALL_INTS A, ALL_INTS B, ALL_INTS C, ALL_INTS D, ALL_INTS E, ALL_INTS F, |
|||
ALL_INTS G |
|||
WHERE |
|||
A.V NOT IN (B.V, C.V, D.V, E.V, F.V, G.V) |
|||
AND B.V NOT IN (C.V, D.V, E.V, F.V, G.V) |
|||
AND C.V NOT IN (D.V, E.V, F.V, G.V) |
|||
AND D.V NOT IN (E.V, F.V, G.V) |
|||
AND E.V NOT IN (F.V, G.V) |
|||
AND F.V NOT IN (G.V) |
|||
AND A.V = C.V + D.V |
|||
AND G.V = D.V + E.V |
|||
AND B.V = E.V + F.V - C.V |
|||
ORDER BY |
|||
A, B, C, D, E, F, G; |
|||
SET UORN = ' unique solutions in '; |
|||
ELSE |
|||
-- Compute non-unique solutions. |
|||
INSERT INTO RESULTS |
|||
SELECT |
|||
A.V A, B.V B, C.V C, D.V D, E.V E, F.V F, G.V G |
|||
FROM |
|||
ALL_INTS A, ALL_INTS B, ALL_INTS C, ALL_INTS D, ALL_INTS E, ALL_INTS F, |
|||
ALL_INTS G |
|||
WHERE |
|||
A.V = C.V + D.V |
|||
AND G.V = D.V + E.V |
|||
AND B.V = E.V + F.V - C.V |
|||
ORDER BY |
|||
A, B, C, D, E, F, G; |
|||
SET UORN = ' non-unique solutions in '; |
|||
END IF; |
|||
COMMIT; |
|||
-- Counts the possible solutions. |
|||
FOR v AS c CURSOR FOR |
|||
SELECT |
|||
A, B, C, D, E, F, G |
|||
FROM RESULTS |
|||
ORDER BY |
|||
A, B, C, D, E, F, G |
|||
DO |
|||
SET SOLUTIONS = SOLUTIONS + 1; |
|||
-- Shows the results. |
|||
IF (SHOW = 0) THEN |
|||
--IF (SHOW = TRUE) THEN |
|||
SET OUT_LINE = A || ' ' || B || ' ' || C || ' ' || D || ' ' || E || ' ' |
|||
|| F ||' ' || G; |
|||
CALL DBMS_OUTPUT.PUT_LINE(OUT_LINE); |
|||
END IF; |
|||
END FOR; |
|||
SET OUT_LINE = SOLUTIONS || UORN || LO || ' to ' || HI; |
|||
CALL DBMS_OUTPUT.PUT_LINE(OUT_LINE); |
|||
END |
|||
@ |
|||
CALL FOUR_SQUARES(1, 7, 0, 0)@ |
|||
CALL FOUR_SQUARES(3, 9, 0, 0)@ |
|||
CALL FOUR_SQUARES(0, 9, 1, 1)@ |
|||
</syntaxhighlight> |
|||
Output: |
|||
<pre> |
|||
db2 -td@ |
|||
db2 => CREATE TABLE ALL_INTS ( V INTEGER ) |
|||
DB20000I The SQL command completed successfully. |
|||
db2 => CREATE TABLE RESULTS ( A INTEGER, B INTEGER, C INTEGER, D INTEGER, E INTEGER, F INTEGER, G INTEGER ) |
|||
DB20000I The SQL command completed successfully. |
|||
db2 => CREATE OR REPLACE PROCEDURE FOUR_SQUARES( |
|||
... |
|||
db2 (cont.) => END @ |
|||
DB20000I The SQL command completed successfully. |
|||
db2 => CALL FOUR_SQUARES(1, 7, 0, 0) |
|||
Return Status = 0 |
|||
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 |
|||
db2 => CALL FOUR_SQUARES(3, 9, 0, 0) |
|||
Return Status = 0 |
|||
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 |
|||
CALL FOUR_SQUARES(0, 9, 1, 1) |
|||
Return Status = 0 |
|||
2860 non-unique solutions in 0 TO 9 |
|||
</pre> |
|||
=={{header|Stata}}== |
|||
Use the program '''perm''' in the [[Permutations]] task for the first two questions, as it's fast enough. Use '''joinby''' for the third. |
|||
<syntaxhighlight lang="stata">perm 7 |
|||
rename * (a b c d e f g) |
|||
list if a==c+d & b+c==e+f & d+e==g, noobs sep(50) |
|||
+---------------------------+ |
|||
| 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 | |
|||
+---------------------------+ |
|||
foreach var of varlist _all { |
|||
replace `var'=`var'+2 |
|||
} |
|||
list if a==c+d & b+c==e+f & d+e==g, noobs sep(50) |
|||
+---------------------------+ |
|||
| 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 | |
|||
+---------------------------+ |
|||
clear |
|||
set obs 10 |
|||
gen b=_n-1 |
|||
gen q=1 |
|||
save temp, replace |
|||
rename b c |
|||
joinby q using temp |
|||
rename b d |
|||
joinby q using temp |
|||
rename b e |
|||
gen a=c+d |
|||
gen g=d+e |
|||
drop if a>9 | g>9 |
|||
joinby q using temp |
|||
gen f=b+c-e |
|||
drop if f<0 | f>9 |
|||
drop q |
|||
order a b c d e f g |
|||
erase temp.dta |
|||
count |
|||
2,860</syntaxhighlight> |
|||
=={{header|Tcl}}== |
=={{header|Tcl}}== |
||
Line 2,213: | Line 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. |
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. |
||
< |
<syntaxhighlight lang="tcl">set vars {a b c d e f g} |
||
set exprs { |
set exprs { |
||
{$a+$b} |
{$a+$b} |
||
Line 2,287: | Line 6,960: | ||
solve_4rings $vars $exprs [range 3 9] |
solve_4rings $vars $exprs [range 3 9] |
||
puts "# Number of solutions, free over 0..9:" |
puts "# Number of solutions, free over 0..9:" |
||
puts [solve_4rings_hard $vars $exprs [range 0 9]]</ |
puts [solve_4rings_hard $vars $exprs [range 0 9]]</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
Line 2,306: | Line 6,979: | ||
# Number of solutions, free over 0..9: |
# Number of solutions, free over 0..9: |
||
2860</pre> |
2860</pre> |
||
=={{header|VBA}}== |
|||
{{trans|C}} |
|||
<syntaxhighlight lang="vb">Dim a As Integer, b As Integer, c As Integer, d As Integer |
|||
Dim e As Integer, f As Integer, g As Integer |
|||
Dim lo As Integer, hi As Integer, unique As Boolean, show As Boolean |
|||
Dim solutions As Integer |
|||
Private Sub bf() |
|||
For f = lo To hi |
|||
If ((Not unique) Or _ |
|||
((f <> a And f <> c And f <> d And f <> g And f <> e))) Then |
|||
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 |
|||
solutions = solutions + 1 |
|||
If show Then Debug.Print a; b; c; d; e; f; g |
|||
End If |
|||
End If |
|||
Next |
|||
End Sub |
|||
Private Sub ge() |
|||
For e = lo To hi |
|||
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 |
|||
bf |
|||
End If |
|||
End If |
|||
Next |
|||
End Sub |
|||
Private Sub acd() |
|||
For c = lo To hi |
|||
For d = lo To hi |
|||
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 |
|||
ge |
|||
End If |
|||
End If |
|||
Next d |
|||
Next c |
|||
End Sub |
|||
Private Sub foursquares(plo As Integer, phi As Integer, punique As Boolean, pshow As Boolean) |
|||
lo = plo |
|||
hi = phi |
|||
unique = punique |
|||
show = pshow |
|||
solutions = 0 |
|||
acd |
|||
Debug.Print |
|||
If unique Then |
|||
Debug.Print solutions; " unique solutions in"; lo; "to"; hi |
|||
Else |
|||
Debug.Print solutions; " non-unique solutions in"; lo; "to"; hi |
|||
End If |
|||
End Sub |
|||
Public Sub program() |
|||
Call foursquares(1, 7, True, True) |
|||
Debug.Print |
|||
Call foursquares(3, 9, True, True) |
|||
Call foursquares(0, 9, False, False) |
|||
End Sub |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
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|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. |
|||
<syntaxhighlight lang="vbnet">Module Module1 |
|||
Dim CA As Char() = "0123456789ABC".ToCharArray() |
|||
Sub FourSquare(lo As Integer, hi As Integer, uni As Boolean, sy As Char()) |
|||
If sy IsNot Nothing Then Console.WriteLine("a b c d e f g" & vbLf & "-------------") |
|||
Dim r = Enumerable.Range(lo, hi - lo + 1).ToList(), u As New List(Of Integer), |
|||
t As Integer, cn As Integer = 0 |
|||
For Each a In r |
|||
u.Add(a) |
|||
For Each b In r |
|||
If uni AndAlso u.Contains(b) Then Continue For |
|||
u.Add(b) |
|||
t = a + b |
|||
For Each c In r : If uni AndAlso u.Contains(c) Then Continue For |
|||
u.Add(c) |
|||
For d = a - c To a - c |
|||
If d < lo OrElse d > hi OrElse uni AndAlso u.Contains(d) OrElse |
|||
t <> b + c + d Then Continue For |
|||
u.Add(d) |
|||
For Each e In r |
|||
If uni AndAlso u.Contains(e) Then Continue For |
|||
u.Add(e) |
|||
For f = b + c - e To b + c - e |
|||
If f < lo OrElse f > hi OrElse uni AndAlso u.Contains(f) OrElse |
|||
t <> d + e + f Then Continue For |
|||
u.Add(f) |
|||
For g = t - f To t - f : If g < lo OrElse g > hi OrElse |
|||
uni AndAlso u.Contains(g) Then Continue For |
|||
cn += 1 : If sy IsNot Nothing Then _ |
|||
Console.WriteLine("{0} {1} {2} {3} {4} {5} {6}", |
|||
sy(a), sy(b), sy(c), sy(d), sy(e), sy(f), sy(g)) |
|||
Next : u.Remove(f) : Next : u.Remove(e) : Next : u.Remove(d) |
|||
Next : u.Remove(c) : Next : u.Remove(b) : Next : u.Remove(a) |
|||
Next : Console.WriteLine("{0} {1}unique solutions for [{2},{3}]{4}", |
|||
cn, If(uni, "", "non-"), lo, hi, vbLf) |
|||
End Sub |
|||
Sub main() |
|||
fourSquare(1, 7, True, CA) |
|||
fourSquare(3, 9, True, CA) |
|||
fourSquare(0, 9, False, Nothing) |
|||
fourSquare(5, 12, True, CA) |
|||
End Sub |
|||
End Module</syntaxhighlight> |
|||
{{out}} |
|||
Added the zkl example for [5,12]<pre>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,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,9] |
|||
2860 non-unique solutions for [0,9] |
|||
a b c d e f g |
|||
------------- |
|||
B 9 6 5 7 8 C |
|||
B A 6 5 7 9 C |
|||
C 8 7 5 6 9 B |
|||
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}} |
|||
<syntaxhighlight lang="wren">import "./fmt" for Fmt |
|||
var a = 0 |
|||
var b = 0 |
|||
var c = 0 |
|||
var d = 0 |
|||
var e = 0 |
|||
var f = 0 |
|||
var g = 0 |
|||
var lo |
|||
var hi |
|||
var unique |
|||
var show |
|||
var solutions |
|||
var bf = Fn.new { |
|||
f = lo |
|||
while (f <= hi) { |
|||
if (!unique || (f != a && f != c && f != d && f != e && f != g)) { |
|||
b = e + f - c |
|||
if (b >= lo && b <= hi && |
|||
(!unique || (b != a && b != c && b != d && b != e && b != f && b != g))) { |
|||
solutions = solutions + 1 |
|||
if (show) Fmt.lprint("$d $d $d $d $d $d $d", [a, b, c, d, e, f, g]) |
|||
} |
|||
} |
|||
f = f + 1 |
|||
} |
|||
} |
|||
var ge = Fn.new { |
|||
e = lo |
|||
while (e <= hi) { |
|||
if (!unique || (e != a && e != c && e != d)) { |
|||
g = d + e |
|||
if (g >= lo && g <= hi && |
|||
(!unique || (g != a && g != c && g != d && g != e))) bf.call() |
|||
} |
|||
e = e + 1 |
|||
} |
|||
} |
|||
var acd = Fn.new { |
|||
c = lo |
|||
while (c <= hi) { |
|||
d = lo |
|||
while (d <= hi) { |
|||
if (!unique || c != d) { |
|||
a = c + d |
|||
if (a >= lo && a <= hi && (!unique || (c != 0 && d != 0))) ge.call() |
|||
} |
|||
d = d + 1 |
|||
} |
|||
c = c + 1 |
|||
} |
|||
} |
|||
var foursquares = Fn.new { |plo, phi, punique, pshow| |
|||
lo = plo |
|||
hi = phi |
|||
unique = punique |
|||
show = pshow |
|||
solutions = 0 |
|||
if (show) { |
|||
System.print("\na b c d e f g") |
|||
System.print("-------------") |
|||
} |
|||
acd.call() |
|||
if (unique) { |
|||
Fmt.print("\n$d unique solutions in $d to $d", solutions, lo, hi) |
|||
} else { |
|||
Fmt.print("\n$d non-unique solutions in $d to $d\n", solutions, lo, hi) |
|||
} |
|||
} |
|||
foursquares.call(1, 7, true, true) |
|||
foursquares.call(3, 9, true, true) |
|||
foursquares.call(0, 9, false, false)</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
a b c d e f g |
|||
------------- |
|||
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 |
|||
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 |
|||
</pre> |
|||
=={{header|X86 Assembly}}== |
=={{header|X86 Assembly}}== |
||
See [[4-rings_or_4-squares_puzzle/X86 Assembly]] |
See [[4-rings_or_4-squares_puzzle/X86 Assembly]] |
||
=={{header|XPL0}}== |
|||
<syntaxhighlight lang="xpl0">int Show, Low, High, Digit(7\a..g\), Count; |
|||
proc Rings(Level); |
|||
int Level; \of recursion |
|||
int D, Temp, I, Set; |
|||
[for D:= Low to High do |
|||
[Digit(Level):= D; |
|||
if Level < 7-1 then Rings(Level+1) |
|||
else [ Temp:= Digit(0) + Digit(1); \solution? |
|||
if Temp = Digit(1) + Digit(2) + Digit(3) and |
|||
Temp = Digit(3) + Digit(4) + Digit(5) and |
|||
Temp = Digit(5) + Digit(6) then |
|||
[Count:= Count+1; |
|||
if Show then |
|||
[Set:= 0; \digits must be unique |
|||
for I:= 0 to 7-1 do |
|||
Set:= Set ! 1<<Digit(I); |
|||
if Set = %111_1111 << Low then |
|||
[for I:= 0 to 7-1 do |
|||
[IntOut(0, Digit(I)); ChOut(0, ^ )]; |
|||
CrLf(0); |
|||
]; |
|||
]; |
|||
]; |
|||
]; |
|||
]; |
|||
]; |
|||
[Show:= true; |
|||
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}} |
|||
<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 |
|||
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 |
|||
</pre> |
|||
=={{header|Yabasic}}== |
|||
{{trans|D}} |
|||
<syntaxhighlight lang="yabasic">fourSquare(1,7,true,true) |
|||
fourSquare(3,9,true,true) |
|||
fourSquare(0,9,false,false) |
|||
sub fourSquare(low, high, unique, prin) |
|||
local count, a, b, c, d, e, f, g, fp |
|||
if (prin) print "a b c d e f g" |
|||
for a = low to high |
|||
for b = low to high |
|||
if (not valid(unique, a, b)) continue |
|||
fp = a+b |
|||
for c = low to high |
|||
if (not valid(unique, c, a, b)) continue |
|||
for d = low to high |
|||
if (not valid(unique, d, a, b, c)) continue |
|||
if (fp <> b+c+d) continue |
|||
for e = low to high |
|||
if (not valid(unique, e, a, b, c, d)) continue |
|||
for f = low to high |
|||
if (not valid(unique, f, a, b, c, d, e)) continue |
|||
if (fp <> d+e+f) continue |
|||
for g = low to high |
|||
if (not valid(unique, g, a, b, c, d, e, f)) continue |
|||
if (fp <> f+g) continue |
|||
count = count + 1 |
|||
if (prin) print a," ",b," ",c," ",d," ",e," ",f," ",g |
|||
next |
|||
next |
|||
next |
|||
next |
|||
next |
|||
next |
|||
next |
|||
if (unique) then |
|||
print "There are ", count, " unique solutions in [",low,",",high,"]" |
|||
else |
|||
print "There are ", count, " non-unique solutions in [",low,",",high,"]" |
|||
end if |
|||
end sub |
|||
sub valid(unique, needle, n1, n2, n3, n4, n5, n6) |
|||
local i |
|||
if (unique) then |
|||
for i = 1 to numparams - 2 |
|||
switch i |
|||
case 1: if needle = n1 return false : break |
|||
case 2: if needle = n2 return false : break |
|||
case 3: if needle = n3 return false : break |
|||
case 4: if needle = n4 return false : break |
|||
case 5: if needle = n5 return false : break |
|||
case 6: if needle = n6 return false : break |
|||
end switch |
|||
next |
|||
end if |
|||
return true |
|||
end sub</syntaxhighlight> |
|||
{{out}} |
|||
<pre>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 |
|||
There are 8 unique solutions in [1,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 |
|||
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}}== |
=={{header|zkl}}== |
||
< |
<syntaxhighlight lang="zkl"> // unique: No repeated numbers in solution |
||
fcn fourSquaresPuzzle(lo=1,hi=7,unique=True){ //-->list of solutions |
fcn fourSquaresPuzzle(lo=1,hi=7,unique=True){ //-->list of solutions |
||
_assert_(0<=lo and hi<36); |
_assert_(0<=lo and hi<36); |
||
Line 2,330: | Line 7,576: | ||
} |
} |
||
s |
s |
||
}</ |
}</syntaxhighlight> |
||
< |
<syntaxhighlight lang="zkl">fcn show(solutions,msg){ |
||
if(not solutions){ println("No solutions for",msg); return(); } |
if(not solutions){ println("No solutions for",msg); return(); } |
||
Line 2,345: | Line 7,591: | ||
fourSquaresPuzzle(5,12) : show(_," unique (5-12)"); println(); |
fourSquaresPuzzle(5,12) : show(_," unique (5-12)"); println(); |
||
println(fourSquaresPuzzle(0,9,False).len(), // 10^7 possibilities |
println(fourSquaresPuzzle(0,9,False).len(), // 10^7 possibilities |
||
" non-unique (0-9) solutions found.");</ |
" non-unique (0-9) solutions found.");</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
Line 2,378: | Line 7,624: | ||
2860 non-unique (0-9) solutions found. |
2860 non-unique (0-9) solutions found. |
||
</pre> |
</pre> |
||
[[Category:Games]] |
|||
[[Category:Puzzles]] |
Latest revision as of 01:59, 26 November 2023
You are encouraged to solve this task according to the task description, using any language you may know.
- 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
- Related task
11l
F foursquares(lo, hi, unique, show)
V solutions = 0
L(c) lo .. hi
L(d) lo .. hi
I !unique | (c != d)
V a = c + d
I a >= lo & a <= hi
I !unique | (c != 0 & d != 0)
L(e) lo .. hi
I !unique | (e !C (a, c, d))
V g = d + e
I g >= lo & g <= hi
I !unique | (g !C (a, c, d, e))
L(f) lo .. hi
I !unique | (f !C (a, c, d, g, e))
V b = e + f - c
I b >= lo & b <= hi
I !unique | (b !C (a, c, d, g, e, f))
solutions++
I show
print(String((a, b, c, d, e, f, g))[1 .< (len)-1])
V uorn = I unique {‘unique’} E ‘non-unique’
print(solutions‘ ’uorn‘ solutions in ’lo‘ to ’hi)
print()
foursquares(1, 7, 1B, 1B)
foursquares(3, 9, 1B, 1B)
foursquares(0, 9, 0B, 0B)
- Output:
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
AArch64 Assembly
/* ARM assembly AARCH64 Raspberry PI 3B */
/* program square4_64.s */
/*******************************************/
/* Constantes file */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"
.equ NBBOX, 7
/*********************************/
/* Initialized data */
/*********************************/
.data
sMessDeb: .asciz "a= @ b= @ c= @ d= @ e= @ f= @ g= @ \n***********************\n"
szCarriageReturn: .asciz "\n************************\n"
sMessNbSolution: .asciz "Number of solutions : @ \n\n\n"
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
.align 8
sZoneConv: .skip 24
qValues_a: .skip 8 * NBBOX
qValues_b: .skip 8 * NBBOX - 1
qValues_c: .skip 8 * NBBOX - 2
qValues_d: .skip 8 * NBBOX - 3
qValues_e: .skip 8 * NBBOX - 4
qValues_f: .skip 8 * NBBOX - 5
qValues_g: .skip 8 * NBBOX - 6
qCounterSol: .skip 8
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: // entry of program
mov x0,#1
mov x1,#7
mov x2,#3 // 0 = rien 1 = display 2 = count 3 = les deux
bl searchPb
mov x0,#3
mov x1,#9
mov x2,#3 // 0 = rien 1 = display 2 = count 3 = les deux
bl searchPb
mov x0,#0
mov x1,#9
mov x2,#2 // 0 = rien 1 = display 2 = count 3 = les deux
bl prepSearchNU
100: // standard end of the program
mov x0, #0 // return code
mov x8, #EXIT // request to exit program
svc #0 // perform the system call
qAdrszCarriageReturn: .quad szCarriageReturn
/******************************************************************/
/* search problèm value not unique */
/******************************************************************/
/* x0 contains start digit */
/* x1 contains end digit */
/* x2 contains action (0 display 1 count) */
prepSearchNU:
stp x12,lr,[sp,-16]! // save registres
stp x2,x3,[sp,-16]! // save registres
stp x4,x5,[sp,-16]! // save registres
stp x6,x7,[sp,-16]! // save registres
stp x8,x9,[sp,-16]! // save registres
stp x10,fp,[sp,-16]! // save registres
mov x5,#0 // counter
mov x12,x0 // a
1:
mov x11,x0 // b
2:
mov x10,x0 // c
3:
mov x9,x0 // d
4:
add x4,x12,x11 // a + b reference
add x3,x11,x10
add x3,x3,x9 // b + c + d
cmp x4,x3
bne 10f
mov x8,x0 // e
5:
mov x7,x0 // f
6:
add x3,x9,x8
add x3,x3,x7 // d + e + f
cmp x3,x4
bne 9f
mov x6,x0 // g
7:
add x3,x7,x6 // f + g
cmp x3,x4
bne 8f // not OK
// OK
add x5,x5,1 // increment counter
8:
add x6,x6,1 // increment g
cmp x6,x1
ble 7b
9:
add x7,x7,1 // increment f
cmp x7,x1
ble 6b
add x8,x8,1 // increment e
cmp x8,x1
ble 5b
10:
add x9,x9,1 // increment d
cmp x9,x1
ble 4b
add x10,x10,1 // increment c
cmp x10,x1
ble 3b
add x11,x11,1 // increment b
cmp x11,x1
ble 2b
add x12,x12,1 // increment a
cmp x12,x1
ble 1b
// end
tst x2,#0b10 // print count ?
beq 100f
mov x0,x5 // counter
ldr x1,qAdrsZoneConv
bl conversion10
ldr x0,qAdrsMessNbSolution
ldr x1,qAdrsZoneConv // insert conversion in message
bl strInsertAtCharInc
bl affichageMess
100:
ldp x10,fp,[sp],16 // restaur des 2 registres
ldp x8,x9,[sp],16 // restaur des 2 registres
ldp x6,x7,[sp],16 // restaur des 2 registres
ldp x4,x5,[sp],16 // restaur des 2 registres
ldp x2,x3,[sp],16 // restaur des 2 registres
ldp x12,lr,[sp],16 // restaur des 2 registres
ret
//qAdrsMessCounter: .quad sMessCounter
qAdrsMessNbSolution: .quad sMessNbSolution
qAdrsZoneConv: .quad sZoneConv
/******************************************************************/
/* search problem unique solution */
/******************************************************************/
/* x0 contains start digit */
/* x1 contains end digit */
/* x2 contains action (0 display 1 count) */
searchPb:
stp x12,lr,[sp,-16]! // save registres
stp x2,x3,[sp,-16]! // save registres
stp x4,x5,[sp,-16]! // save registres
stp x6,x7,[sp,-16]! // save registres
stp x8,x9,[sp,-16]! // save registres
stp x10,fp,[sp,-16]! // save registres
mov x14,x2 // save action
// init
ldr x3,qAdrqValues_a // area value a
mov x4,#0
1: // loop init value a
str x0,[x3,x4,lsl #3]
add x4,x4,1
add x0,x0,1
cmp x0,x1
ble 1b
mov x5,#0 // solution counter
mov x12,#-1
2:
add x12,x12,1 // increment indice a
cmp x12,#NBBOX-1
bgt 90f
ldr x0,qAdrqValues_a // area value a
ldr x1,qAdrqValues_b // area value b
mov x2,x12 // indice a
mov x3,#NBBOX // number of origin values
bl prepValues
mov x11,#-1
3:
add x11,x11,1 // increment indice b
cmp x11,#NBBOX - 2
bgt 2b
ldr x0,qAdrqValues_b // area value b
ldr x1,qAdrqValues_c // area value c
mov x2,x11 // indice b
mov x3,#NBBOX -1 // number of origin values
bl prepValues
mov x10,#-1
4:
add x10,x10,1
cmp x10,#NBBOX - 3
bgt 3b
ldr x0,qAdrqValues_c
ldr x1,qAdrqValues_d
mov x2,x10
mov x3,#NBBOX - 2
bl prepValues
mov x9,#-1
5:
add x9,x9,1
cmp x9,#NBBOX - 4
bgt 4b
// control 2 firsts squares
ldr x0,qAdrqValues_a
ldr x0,[x0,x12,lsl #3]
ldr x1,qAdrqValues_b
ldr x1,[x1,x11,lsl #3]
add x4,x0,x1 // a + b value first square
ldr x0,qAdrqValues_c
ldr x0,[x0,x10,lsl #3]
add x7,x1,x0 // b + c
ldr x1,qAdrqValues_d
ldr x1,[x1,x9,lsl #3]
add x7,x7,x1 // b + c + d
cmp x7,x4 // equal first square ?
bne 5b
ldr x0,qAdrqValues_d
ldr x1,qAdrqValues_e
mov x2,x9
mov x3,#NBBOX - 3
bl prepValues
mov x8,#-1
6:
add x8,x8,1
cmp x8,#NBBOX - 5
bgt 5b
ldr x0,qAdrqValues_e
ldr x1,qAdrqValues_f
mov x2,x8
mov x3,#NBBOX - 4
bl prepValues
mov x7,#-1
7:
add x7,x7,1
cmp x7,#NBBOX - 6
bgt 6b
ldr x0,qAdrqValues_d
ldr x0,[x0,x9,lsl #3]
ldr x1,qAdrqValues_e
ldr x1,[x1,x8,lsl #3]
add x3,x0,x1 // d + e
ldr x1,qAdrqValues_f
ldr x1,[x1,x7,lsl #3]
add x3,x3,x1 // d + e + f
cmp x3,x4 // equal first square ?
bne 7b
ldr x0,qAdrqValues_f
ldr x1,qAdrqValues_g
mov x2,x7
mov x3,#NBBOX - 5
bl prepValues
mov x6,#-1
8:
add x6,x6,1
cmp x6,#NBBOX - 7
bgt 7b
ldr x0,qAdrqValues_f
ldr x0,[x0,x7,lsl #3]
ldr x1,qAdrqValues_g
ldr x1,[x1,x6,lsl #3]
add x3,x0,x1 // f +g
cmp x4,x3 // equal first square ?
bne 8b
add x5,x5,1 // increment counter
tst x14,#0b1
beq 9f // display solution ?
ldr x0,qAdrqValues_a
ldr x0,[x0,x12,lsl #3]
ldr x1,qAdrsZoneConv
bl conversion10
ldr x0,qAdrsMessDeb
ldr x1,qAdrsZoneConv // insert conversion in message
bl strInsertAtCharInc
mov x2,x0
ldr x0,qAdrqValues_b
ldr x0,[x0,x11,lsl #3]
ldr x1,qAdrsZoneConv
bl conversion10
mov x0,x2
ldr x1,qAdrsZoneConv // insert conversion in message
bl strInsertAtCharInc
mov x2,x0
ldr x0,qAdrqValues_c
ldr x0,[x0,x10,lsl #3]
ldr x1,qAdrsZoneConv
bl conversion10
mov x0,x2
ldr x1,qAdrsZoneConv // insert conversion in message
bl strInsertAtCharInc
mov x2,x0
ldr x0,qAdrqValues_d
ldr x0,[x0,x9,lsl #3]
ldr x1,qAdrsZoneConv
bl conversion10
mov x0,x2
ldr x1,qAdrsZoneConv // insert conversion in message
bl strInsertAtCharInc
mov x2,x0
ldr x0,qAdrqValues_e
ldr x0,[x0,x8,lsl #3]
ldr x1,qAdrsZoneConv
bl conversion10
mov x0,x2
ldr x1,qAdrsZoneConv // insert conversion in message
bl strInsertAtCharInc
mov x2,x0
ldr x0,qAdrqValues_f
ldr x0,[x0,x7,lsl #3]
ldr x1,qAdrsZoneConv
bl conversion10
mov x0,x2
ldr x1,qAdrsZoneConv // insert conversion in message
bl strInsertAtCharInc
mov x2,x0
ldr x0,qAdrqValues_g
ldr x0,[x0,x6,lsl #3]
ldr x1,qAdrsZoneConv
bl conversion10
mov x0,x2
ldr x1,qAdrsZoneConv // insert conversion in message
bl strInsertAtCharInc
bl affichageMess
9:
b 8b // suite
90:
tst x14,#0b10
beq 100f // display counter ?
mov x0,x5
ldr x1,qAdrsZoneConv
bl conversion10
ldr x0,qAdrsMessNbSolution
ldr x1,qAdrsZoneConv // insert conversion in message
bl strInsertAtCharInc
bl affichageMess
100:
ldp x10,fp,[sp],16 // restaur des 2 registres
ldp x8,x9,[sp],16 // restaur des 2 registres
ldp x6,x7,[sp],16 // restaur des 2 registres
ldp x4,x5,[sp],16 // restaur des 2 registres
ldp x2,x3,[sp],16 // restaur des 2 registres
ldp x12,lr,[sp],16 // restaur des 2 registres
ret
qAdrqValues_a: .quad qValues_a
qAdrqValues_b: .quad qValues_b
qAdrqValues_c: .quad qValues_c
qAdrqValues_d: .quad qValues_d
qAdrqValues_e: .quad qValues_e
qAdrqValues_f: .quad qValues_f
qAdrqValues_g: .quad qValues_g
qAdrsMessDeb: .quad sMessDeb
qAdrqCounterSol: .quad qCounterSol
/******************************************************************/
/* copy value area and substract value of indice */
/******************************************************************/
/* x0 contains the address of values origin */
/* x1 contains the address of values destination */
/* x2 contains value indice to substract */
/* x3 contains origin values number */
prepValues:
stp x1,lr,[sp,-16]! // save registres
stp x2,x3,[sp,-16]! // save registres
stp x4,x5,[sp,-16]! // save registres
stp x6,x7,[sp,-16]! // save registres
mov x4,#0 // indice origin value
mov x5,#0 // indice destination value
1:
cmp x4,x2 // substract indice ?
beq 2f // yes -> jump
ldr x6,[x0,x4,lsl #3] // no -> copy value
str x6,[x1,x5,lsl #3]
add x5,x5,1 // increment destination indice
2:
add x4,x4,1 // increment origin indice
cmp x4,x3 // end ?
blt 1b
100:
ldp x6,x7,[sp],16 // restaur des 2 registres
ldp x4,x5,[sp],16 // restaur des 2 registres
ldp x2,x3,[sp],16 // restaur des 2 registres
ldp x1,lr,[sp],16 // restaur des 2 registres
ret
/********************************************************/
/* File Include fonctions */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"
- Output:
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= 4 b= 7 c= 1 d= 3 e= 2 f= 6 g= 5 *********************** a= 5 b= 6 c= 2 d= 3 e= 1 f= 7 g= 4 *********************** a= 6 b= 4 c= 1 d= 5 e= 2 f= 3 g= 7 *********************** a= 6 b= 4 c= 5 d= 1 e= 2 f= 7 g= 3 *********************** a= 7 b= 2 c= 6 d= 1 e= 3 f= 5 g= 4 *********************** a= 7 b= 3 c= 2 d= 5 e= 1 f= 4 g= 6 *********************** Number of solutions : 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 *********************** a= 9 b= 6 c= 4 d= 5 e= 3 f= 7 g= 8 *********************** a= 9 b= 6 c= 5 d= 4 e= 3 f= 8 g= 7 *********************** Number of solutions : 4 Number of solutions : 2860
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
- 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
Ada
with Ada.Text_IO;
procedure Puzzle_Square_4 is
procedure Four_Rings (Low, High : in Natural; Unique, Show : in Boolean) is
subtype Test_Range is Natural range Low .. High;
type Value_List is array (Positive range <>) of Natural;
function Is_Unique (Values : Value_List) return Boolean is
Count : array (Test_Range) of Natural := (others => 0);
begin
for Value of Values loop
Count (Value) := Count (Value) + 1;
if Count (Value) > 1 then
return False;
end if;
end loop;
return True;
end Is_Unique;
function Is_Valid (A,B,C,D,E,F,G : in Natural) return Boolean is
Ring_1 : constant Integer := A + B;
Ring_2 : constant Integer := B + C + D;
Ring_3 : constant Integer := D + E + F;
Ring_4 : constant Integer := F + G;
begin
return
Ring_1 = Ring_2 and
Ring_1 = Ring_3 and
Ring_1 = Ring_4;
end Is_Valid;
use Ada.Text_IO;
Count : Natural := 0;
begin
for A in Test_Range loop
for B in Test_Range loop
for C in Test_Range loop
for D in Test_Range loop
for E in Test_Range loop
for F in Test_Range loop
for G in Test_Range loop
if Is_Valid (A,B,C,D,E,F,G) then
if not Unique or (Unique and Is_Unique ((A,B,C,D,E,F,G))) then
Count := Count + 1;
if Show then
Put_Line (A'Image & B'Image & C'Image & D'Image & E'Image & F'Image & G'Image);
end if;
end if;
end if;
end loop;
end loop;
end loop;
end loop;
end loop;
end loop;
end loop;
Put_Line ("There are " & Count'Image &
(if Unique then " unique " else " non-unique ") &
"solutions in " & Low'Image & " .." & High'Image);
New_Line;
end Four_Rings;
begin
Four_Rings (Low => 1, High => 7, Unique => True, Show => True);
Four_Rings (Low => 3, High => 9, Unique => True, Show => True);
Four_Rings (Low => 0, High => 9, Unique => False, Show => False);
end Puzzle_Square_4;
- 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 There are 8 unique solutions in 1 .. 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 There are 4 unique solutions in 3 .. 9 There are 2860 non-unique solutions in 0 .. 9
ALGOL 68
As with the REXX solution, we use explicit loops to generate the permutations.
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 allow duplicates, show )VOID:
BEGIN
INT solutions := 0;
# 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
INT d = t - ( b + c );
IF d >= lo AND d <= hi
AND ( allow duplicates
OR ( a /= d AND b /= d AND c /= d )
)
THEN
FOR e FROM lo TO hi DO
IF allow duplicates
OR ( a /= e AND b /= e AND c /= e AND d /= e )
THEN
INT g = d + e;
INT f = t - g;
IF f >= lo AND f <= hi
AND g >= lo AND g <= hi
AND ( allow duplicates
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
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 # e #
FI
FI
OD # c #
FI
OD # b #
OD # a # ;
print( ( whole( solutions, 0 )
, IF allow duplicates THEN " non-unique" ELSE " 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, FALSE, TRUE );
four rings( 3, 9, FALSE, TRUE );
four rings( 0, 9, TRUE, FALSE )
END
- 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
ALGOL W
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.
- 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
AppleScript
(Structured search example)
use framework "Foundation" -- for basic NSArray sort
on run
unlines({"rings(true, enumFromTo(1, 7))\n", ¬
map(show, (rings(true, enumFromTo(1, 7)))), ¬
"\nrings(true, enumFromTo(3, 9))\n", ¬
map(show, (rings(true, enumFromTo(3, 9)))), ¬
"\nlength(rings(false, enumFromTo(0, 9)))\n", ¬
show(|length|(rings(false, enumFromTo(0, 9))))})
end run
-- RINGS -----------------------------------------------------------------------
-- rings :: noRepeatedDigits -> DigitList -> Lists of solutions
-- rings :: Bool -> [Int] -> [[Int]]
on rings(u, digits)
set ds to reverse_(sort(digits))
set h to head(ds)
-- QUEEN -------------------------------------------------------------------
script queen
on |λ|(q)
script
on |λ|(x)
x + q ≤ h
end |λ|
end script
set ts to filter(result, ds)
if u then
set bs to delete_(q, ts)
else
set bs to ds
end if
-- LEFT BISHOP and its ROOK-----------------------------------------
script leftBishop
on |λ|(lb)
set lRook to lb + q
if lRook > h then
{}
else
if u then
set rbs to difference(ts, {q, lb, lRook})
else
set rbs to ds
end if
-- RIGHT BISHOP and its ROOK ---------------------------
script rightBishop
on |λ|(rb)
set rRook to rb + q
if (rRook > h) or (u and (rRook = lb)) then
{}
else
set rookDelta to lRook - rRook
if u then
set ks to difference(ds, ¬
{q, lb, rb, rRook, lRook})
else
set ks to ds
end if
-- KNIGHTS LEFT AND RIGHT ------------------
script knights
on |λ|(k)
set k2 to k + rookDelta
if elem(k2, ks) and ((not u) or ¬
notElem(k2, ¬
{lRook, k, lb, q, rb, rRook})) then
{{lRook, k, lb, q, rb, k2, rRook}}
else
{}
end if
end |λ|
end script
concatMap(knights, ks)
end if
end |λ|
end script
concatMap(rightBishop, rbs)
end if
end |λ|
end script
concatMap(leftBishop, bs)
end |λ|
end script
concatMap(queen, ds)
end rings
-- GENERIC FUNCTIONS -----------------------------------------------------------
-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
set lst to {}
set lng to length of xs
tell mReturn(f)
repeat with i from 1 to lng
set lst to (lst & |λ|(contents of item i of xs, i, xs))
end repeat
end tell
return lst
end concatMap
-- delete :: Eq a => a -> [a] -> [a]
on delete_(x, xs)
set mbIndex to elemIndex(x, xs)
set lng to length of xs
if mbIndex is not missing value then
if lng > 1 then
if mbIndex = 1 then
items 2 thru -1 of xs
else if mbIndex = lng then
items 1 thru -2 of xs
else
tell xs to items 1 thru (mbIndex - 1) & ¬
items (mbIndex + 1) thru -1
end if
else
{}
end if
else
xs
end if
end delete_
-- difference :: [a] -> [a] -> [a]
on difference(xs, ys)
script mf
on except(a, y)
if a contains y then
my delete_(y, a)
else
a
end if
end except
end script
foldl(except of mf, xs, ys)
end difference
-- elem :: Eq a => a -> [a] -> Bool
on elem(x, xs)
xs contains x
end elem
-- elemIndex :: a -> [a] -> Maybe Int
on elemIndex(x, xs)
set lng to length of xs
repeat with i from 1 to lng
if x = (item i of xs) then return i
end repeat
return missing value
end elemIndex
-- enumFromTo :: Int -> Int -> [Int]
on enumFromTo(m, n)
if n < m then
set d to -1
else
set d to 1
end if
set lst to {}
repeat with i from m to n by d
set end of lst to i
end repeat
return lst
end enumFromTo
-- filter :: (a -> Bool) -> [a] -> [a]
on filter(f, xs)
tell mReturn(f)
set lst to {}
set lng to length of xs
repeat with i from 1 to lng
set v to item i of xs
if |λ|(v, i, xs) then set end of lst to v
end repeat
return lst
end tell
end filter
-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
tell mReturn(f)
set v to startValue
set lng to length of xs
repeat with i from 1 to lng
set v to |λ|(v, item i of xs, i, xs)
end repeat
return v
end tell
end foldl
-- head :: [a] -> a
on head(xs)
if length of xs > 0 then
item 1 of xs
else
missing value
end if
end head
-- intercalate :: Text -> [Text] -> Text
on intercalate(strText, lstText)
set {dlm, my text item delimiters} to {my text item delimiters, strText}
set strJoined to lstText as text
set my text item delimiters to dlm
return strJoined
end intercalate
-- length :: [a] -> Int
on |length|(xs)
length of xs
end |length|
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
tell mReturn(f)
set lng to length of xs
set lst to {}
repeat with i from 1 to lng
set end of lst to |λ|(item i of xs, i, xs)
end repeat
return lst
end tell
end map
-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
if class of f is script then
f
else
script
property |λ| : f
end script
end if
end mReturn
-- notElem :: Eq a => a -> [a] -> Bool
on notElem(x, xs)
xs does not contain x
end notElem
-- reverse_ :: [a] -> [a]
on |reverse|:xs
if class of xs is text then
(reverse of characters of xs) as text
else
reverse of xs
end if
end |reverse|:
-- show :: a -> String
on show(e)
set c to class of e
if c = list then
script serialized
on |λ|(v)
show(v)
end |λ|
end script
"[" & intercalate(", ", map(serialized, e)) & "]"
else if c = record then
script showField
on |λ|(kv)
set {k, ev} to kv
"\"" & k & "\":" & show(ev)
end |λ|
end script
"{" & intercalate(", ", ¬
map(showField, zip(allKeys(e), allValues(e)))) & "}"
else if c = date then
"\"" & iso8601Z(e) & "\""
else if c = text then
"\"" & e & "\""
else if (c = integer or c = real) then
e as text
else if c = class then
"null"
else
try
e as text
on error
("«" & c as text) & "»"
end try
end if
end show
-- sort :: [a] -> [a]
on sort(xs)
((current application's NSArray's arrayWithArray:xs)'s ¬
sortedArrayUsingSelector:"compare:") as list
end sort
-- unlines :: [String] -> String
on unlines(xs)
intercalate(linefeed, xs)
end unlines
- Output:
rings(true, enumFromTo(1, 7)) [7, 3, 2, 5, 1, 4, 6] [6, 4, 1, 5, 2, 3, 7] [5, 6, 2, 3, 1, 7, 4] [4, 7, 1, 3, 2, 6, 5] [7, 2, 6, 1, 3, 5, 4] [6, 4, 5, 1, 2, 7, 3] [4, 5, 3, 1, 6, 2, 7] [3, 7, 2, 1, 5, 4, 6] rings(true, enumFromTo(3, 9)) [9, 6, 4, 5, 3, 7, 8] [8, 7, 3, 5, 4, 6, 9] [9, 6, 5, 4, 3, 8, 7] [7, 8, 3, 4, 5, 6, 9] length(rings(false, enumFromTo(0, 9))) 2860
Applesoft BASIC
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
ARM Assembly
/* ARM assembly Raspberry PI */
/* program square4.s */
/************************************/
/* Constantes */
/************************************/
.equ STDOUT, 1 @ Linux output console
.equ EXIT, 1 @ Linux syscall
.equ WRITE, 4 @ Linux syscall
.equ NBBOX, 7
/*********************************/
/* Initialized data */
/*********************************/
.data
sMessDeb: .ascii "a="
sMessValeur_a: .fill 11, 1, ' ' @ size => 11
.ascii "b="
sMessValeur_b: .fill 11, 1, ' ' @ size => 11
.ascii "c="
sMessValeur_c: .fill 11, 1, ' ' @ size => 11
.ascii "d="
sMessValeur_d: .fill 11, 1, ' ' @ size => 11
.ascii "\n"
.ascii "e="
sMessValeur_e: .fill 11, 1, ' ' @ size => 11
.ascii "f="
sMessValeur_f: .fill 11, 1, ' ' @ size => 11
.ascii "g="
sMessValeur_g: .fill 11, 1, ' ' @ size => 11
szCarriageReturn: .asciz "\n************************\n"
sMessNbSolution: .ascii "Number of solutions :"
sMessCounter: .fill 11, 1, ' ' @ size => 11
.asciz "\n\n\n"
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
.align 4
iValues_a: .skip 4 * NBBOX
iValues_b: .skip 4 * NBBOX - 1
iValues_c: .skip 4 * NBBOX - 2
iValues_d: .skip 4 * NBBOX - 3
iValues_e: .skip 4 * NBBOX - 4
iValues_f: .skip 4 * NBBOX - 5
iValues_g: .skip 4 * NBBOX - 6
iCounterSol: .skip 4
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: @ entry of program
mov r0,#1
mov r1,#7
mov r2,#3 @ 0 = rien 1 = display 2 = count 3 = les deux
bl searchPb
mov r0,#3
mov r1,#9
mov r2,#3 @ 0 = rien 1 = display 2 = count 3 = les deux
bl searchPb
mov r0,#0
mov r1,#9
mov r2,#2 @ 0 = rien 1 = display 2 = count 3 = les deux
bl prepSearchNU
100: @ standard end of the program
mov r0, #0 @ return code
mov r7, #EXIT @ request to exit program
svc #0 @ perform the system call
iAdrszCarriageReturn: .int szCarriageReturn
/******************************************************************/
/* search problèm value not unique */
/******************************************************************/
/* r0 contains start digit */
/* r1 contains end digit */
/* r2 contains action (0 display 1 count) */
prepSearchNU:
push {r3-r12,lr} @ save registers
mov r5,#0 @ counter
mov r12,r0 @ a
1:
mov r11,r0 @ b
2:
mov r10,r0 @ c
3:
mov r9,r0 @ d
4:
add r4,r12,r11 @ a + b reference
add r3,r11,r10
add r3,r9 @ b + c + d
cmp r4,r3
bne 10f
mov r8,r0 @ e
5:
mov r7,r0 @ f
6:
add r3,r9,r8
add r3,r7 @ d + e + f
cmp r3,r4
bne 9f
mov r6,r0 @ g
7:
add r3,r7,r6 @ f + g
cmp r3,r4
bne 8f @ not OK
@ OK
add r5,#1 @ increment counter
8:
add r6,#1 @ increment g
cmp r6,r1
ble 7b
9:
add r7,#1 @ increment f
cmp r7,r1
ble 6b
add r8,#1 @ increment e
cmp r8,r1
ble 5b
10:
add r9,#1 @ increment d
cmp r9,r1
ble 4b
add r10,#1 @ increment c
cmp r10,r1
ble 3b
add r11,#1 @ increment b
cmp r11,r1
ble 2b
add r12,#1 @ increment a
cmp r12,r1
ble 1b
@ end
tst r2,#0b10 @ print count ?
beq 100f
mov r0,r5 @ counter
ldr r1,iAdrsMessCounter
bl conversion10
ldr r0,iAdrsMessNbSolution
bl affichageMess
100:
pop {r3-r12,lr} @ restaur registers
bx lr @return
iAdrsMessCounter: .int sMessCounter
iAdrsMessNbSolution: .int sMessNbSolution
/******************************************************************/
/* search problem unique solution */
/******************************************************************/
/* r0 contains start digit */
/* r1 contains end digit */
/* r2 contains action (0 display 1 count) */
searchPb:
push {r0-r12,lr} @ save registers
@ init
ldr r3,iAdriValues_a @ area value a
mov r4,#0
1: @ loop init value a
str r0,[r3,r4,lsl #2]
add r4,#1
add r0,#1
cmp r0,r1
ble 1b
mov r5,#0 @ solution counter
mov r12,#-1
2:
add r12,#1 @ increment indice a
cmp r12,#NBBOX-1
bgt 90f
ldr r0,iAdriValues_a @ area value a
ldr r1,iAdriValues_b @ area value b
mov r2,r12 @ indice a
mov r3,#NBBOX @ number of origin values
bl prepValues
mov r11,#-1
3:
add r11,#1 @ increment indice b
cmp r11,#NBBOX - 2
bgt 2b
ldr r0,iAdriValues_b @ area value b
ldr r1,iAdriValues_c @ area value c
mov r2,r11 @ indice b
mov r3,#NBBOX -1 @ number of origin values
bl prepValues
mov r10,#-1
4:
add r10,#1
cmp r10,#NBBOX - 3
bgt 3b
ldr r0,iAdriValues_c
ldr r1,iAdriValues_d
mov r2,r10
mov r3,#NBBOX - 2
bl prepValues
mov r9,#-1
5:
add r9,#1
cmp r9,#NBBOX - 4
bgt 4b
@ control 2 firsts squares
ldr r0,iAdriValues_a
ldr r0,[r0,r12,lsl #2]
ldr r1,iAdriValues_b
ldr r1,[r1,r11,lsl #2]
add r4,r0,r1 @ a + b value first square
ldr r0,iAdriValues_c
ldr r0,[r0,r10,lsl #2]
add r7,r1,r0 @ b + c
ldr r1,iAdriValues_d
ldr r1,[r1,r9,lsl #2]
add r7,r1 @ b + c + d
cmp r7,r4 @ equal first square ?
bne 5b
ldr r0,iAdriValues_d
ldr r1,iAdriValues_e
mov r2,r9
mov r3,#NBBOX - 3
bl prepValues
mov r8,#-1
6:
add r8,#1
cmp r8,#NBBOX - 5
bgt 5b
ldr r0,iAdriValues_e
ldr r1,iAdriValues_f
mov r2,r8
mov r3,#NBBOX - 4
bl prepValues
mov r7,#-1
7:
add r7,#1
cmp r7,#NBBOX - 6
bgt 6b
ldr r0,iAdriValues_d
ldr r0,[r0,r9,lsl #2]
ldr r1,iAdriValues_e
ldr r1,[r1,r8,lsl #2]
add r3,r0,r1 @ d + e
ldr r1,iAdriValues_f
ldr r1,[r1,r7,lsl #2]
add r3,r1 @ de + e + f
cmp r3,r4 @ equal first square ?
bne 7b
ldr r0,iAdriValues_f
ldr r1,iAdriValues_g
mov r2,r7
mov r3,#NBBOX - 5
bl prepValues
mov r6,#-1
8:
add r6,#1
cmp r6,#NBBOX - 7
bgt 7b
ldr r0,iAdriValues_f
ldr r0,[r0,r7,lsl #2]
ldr r1,iAdriValues_g
ldr r1,[r1,r6,lsl #2]
add r3,r0,r1 @ f +g
cmp r4,r3 @ equal first square ?
bne 8b
add r5,#1 @ increment counter
ldr r0,[sp,#8] @ load action for two parameter in stack
tst r0,#0b1
beq 9f @ display solution ?
ldr r0,iAdriValues_a
ldr r0,[r0,r12,lsl #2]
ldr r1,iAdrsMessValeur_a
bl conversion10
ldr r0,iAdriValues_b
ldr r0,[r0,r11,lsl #2]
ldr r1,iAdrsMessValeur_b
bl conversion10
ldr r0,iAdriValues_c
ldr r0,[r0,r10,lsl #2]
ldr r1,iAdrsMessValeur_c
bl conversion10
ldr r0,iAdriValues_d
ldr r0,[r0,r9,lsl #2]
ldr r1,iAdrsMessValeur_d
bl conversion10
ldr r0,iAdriValues_e
ldr r0,[r0,r8,lsl #2]
ldr r1,iAdrsMessValeur_e
bl conversion10
ldr r0,iAdriValues_f
ldr r0,[r0,r7,lsl #2]
ldr r1,iAdrsMessValeur_f
bl conversion10
ldr r0,iAdriValues_g
ldr r0,[r0,r6,lsl #2]
ldr r1,iAdrsMessValeur_g
bl conversion10
ldr r0,iAdrsMessDeb
bl affichageMess
9:
b 8b @ suite
90:
ldr r0,[sp,#8] @ load action for two parameter in stack
tst r0,#0b10
beq 100f @ display counter ?
mov r0,r5
ldr r1,iAdrsMessCounter
bl conversion10
ldr r0,iAdrsMessNbSolution
bl affichageMess
100:
pop {r0-r12,lr} @ restaur registers
bx lr @return
iAdriValues_a: .int iValues_a
iAdriValues_b: .int iValues_b
iAdriValues_c: .int iValues_c
iAdriValues_d: .int iValues_d
iAdriValues_e: .int iValues_e
iAdriValues_f: .int iValues_f
iAdriValues_g: .int iValues_g
iAdrsMessValeur_a: .int sMessValeur_a
iAdrsMessValeur_b: .int sMessValeur_b
iAdrsMessValeur_c: .int sMessValeur_c
iAdrsMessValeur_d: .int sMessValeur_d
iAdrsMessValeur_e: .int sMessValeur_e
iAdrsMessValeur_f: .int sMessValeur_f
iAdrsMessValeur_g: .int sMessValeur_g
iAdrsMessDeb: .int sMessDeb
iAdriCounterSol: .int iCounterSol
/******************************************************************/
/* copy value area and substract value of indice */
/******************************************************************/
/* r0 contains the address of values origin */
/* r1 contains the address of values destination */
/* r2 contains value indice to substract */
/* r3 contains origin values number */
prepValues:
push {r1-r6,lr} @ save registres
mov r4,#0 @ indice origin value
mov r5,#0 @ indice destination value
1:
cmp r4,r2 @ substract indice ?
beq 2f @ yes -> jump
ldr r6,[r0,r4,lsl #2] @ no -> copy value
str r6,[r1,r5,lsl #2]
add r5,#1 @ increment destination indice
2:
add r4,#1 @ increment origin indice
cmp r4,r3 @ end ?
blt 1b
100:
pop {r1-r6,lr} @ restaur registres
bx lr @return
/******************************************************************/
/* display text with size calculation */
/******************************************************************/
/* r0 contains the address of the message */
affichageMess:
push {r0,r1,r2,r7,lr} @ save registres
mov r2,#0 @ counter length
1: @ loop length calculation
ldrb r1,[r0,r2] @ read octet start position + index
cmp r1,#0 @ if 0 its over
addne r2,r2,#1 @ else add 1 in the length
bne 1b @ and loop
@ so here r2 contains the length of the message
mov r1,r0 @ address message in r1
mov r0,#STDOUT @ code to write to the standard output Linux
mov r7, #WRITE @ code call system "write"
svc #0 @ call systeme
pop {r0,r1,r2,r7,lr} @ restaur des 2 registres */
bx lr @ return
/******************************************************************/
/* Converting a register to a decimal unsigned */
/******************************************************************/
/* r0 contains value and r1 address area */
/* r0 return size of result (no zero final in area) */
/* area size => 11 bytes */
.equ LGZONECAL, 10
conversion10:
push {r1-r4,lr} @ save registers
mov r3,r1
mov r2,#LGZONECAL
1: @ start loop
bl divisionpar10U @ unsigned r0 <- dividende. quotient ->r0 reste -> r1
add r1,#48 @ digit
strb r1,[r3,r2] @ store digit on area
cmp r0,#0 @ stop if quotient = 0
subne r2,#1 @ else previous position
bne 1b @ and loop
@ and move digit from left of area
mov r4,#0
2:
ldrb r1,[r3,r2]
strb r1,[r3,r4]
add r2,#1
add r4,#1
cmp r2,#LGZONECAL
ble 2b
@ and move spaces in end on area
mov r0,r4 @ result length
mov r1,#' ' @ space
3:
strb r1,[r3,r4] @ store space in area
add r4,#1 @ next position
cmp r4,#LGZONECAL
ble 3b @ loop if r4 <= area size
100:
pop {r1-r4,lr} @ restaur registres
bx lr @return
/***************************************************/
/* division par 10 unsigned */
/***************************************************/
/* r0 dividende */
/* r0 quotient */
/* r1 remainder */
divisionpar10U:
push {r2,r3,r4, lr}
mov r4,r0 @ save value
ldr r3,iMagicNumber @ r3 <- magic_number raspberry 1 2
umull r1, r2, r3, r0 @ r1<- Lower32Bits(r1*r0) r2<- Upper32Bits(r1*r0)
mov r0, r2, LSR #3 @ r2 <- r2 >> shift 3
add r2,r0,r0, lsl #2 @ r2 <- r0 * 5
sub r1,r4,r2, lsl #1 @ r1 <- r4 - (r2 * 2) = r4 - (r0 * 10)
pop {r2,r3,r4,lr}
bx lr @ leave function
iMagicNumber: .int 0xCCCCCCCD
- Output:
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=4 b=7 c=1 d=3 e=2 f=6 g=5 ************************ a=5 b=6 c=2 d=3 e=1 f=7 g=4 ************************ a=6 b=4 c=1 d=5 e=2 f=3 g=7 ************************ a=6 b=4 c=5 d=1 e=2 f=7 g=3 ************************ a=7 b=2 c=6 d=1 e=3 f=5 g=4 ************************ a=7 b=3 c=2 d=5 e=1 f=4 g=6 ************************ Number of solutions :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 ************************ a=9 b=6 c=4 d=5 e=3 f=7 g=8 ************************ a=9 b=6 c=5 d=4 e=3 f=8 g=7 ************************ Number of solutions :4 Number of solutions :2860
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
- Output:
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 ---------------------------
AWK
# syntax: GAWK -f 4-RINGS_OR_4-SQUARES_PUZZLE.AWK
# converted from C
BEGIN {
cmd = "SORT /+16"
four_squares(1,7,1,1)
four_squares(3,9,1,1)
four_squares(0,9,0,0)
four_squares(0,6,1,0)
four_squares(2,8,1,0)
exit(0)
}
function four_squares(plo,phi,punique,pshow) {
lo = plo
hi = phi
unique = punique
show = pshow
solutions = 0
print("")
if (show) {
print("A B C D E F G sum A+B B+C+D D+E+F F+G")
print("------------- --- -------------------")
}
acd()
close(cmd)
tmp = (unique) ? "unique" : "non-unique"
printf("%d-%d: %d %s solutions\n",lo,hi,solutions,tmp)
}
function acd() {
for (c=lo; c<=hi; c++) {
for (d=lo; d<=hi; d++) {
if (!unique || c != d) {
a = c + d
if (a >= lo && a <= hi && (!unique || (c != 0 && d != 0))) {
ge()
}
}
}
}
}
function bf() {
for (f=lo; f<=hi; f++) {
if (!unique || (f != a && f != c && f != d && f != g && f != e)) {
b = e + f - c
if (b >= lo && b <= hi && (!unique || (b != a && b != c && b != d && b != g && b != e && b != f))) {
solutions++
if (show) {
printf("%d %d %d %d %d %d %d %4d ",a,b,c,d,e,f,g,a+b) | cmd
printf("%d+%d ",a,b) | cmd
printf("%d+%d+%d ",b,c,d) | cmd
printf("%d+%d+%d ",d,e,f) | cmd
printf("%d+%d\n",f,g) | cmd
}
}
}
}
}
function ge() {
for (e=lo; e<=hi; e++) {
if (!unique || (e != a && e != c && e != d)) {
g = d + e
if (g >= lo && g <= hi && (!unique || (g != a && g != c && g != d && g != e))) {
bf()
}
}
}
}
- Output:
A B C D E F G sum A+B B+C+D D+E+F F+G ------------- --- ------------------- 4 5 3 1 6 2 7 9 4+5 5+3+1 1+6+2 2+7 7 2 6 1 3 5 4 9 7+2 2+6+1 1+3+5 5+4 3 7 2 1 5 4 6 10 3+7 7+2+1 1+5+4 4+6 6 4 1 5 2 3 7 10 6+4 4+1+5 5+2+3 3+7 6 4 5 1 2 7 3 10 6+4 4+5+1 1+2+7 7+3 7 3 2 5 1 4 6 10 7+3 3+2+5 5+1+4 4+6 4 7 1 3 2 6 5 11 4+7 7+1+3 3+2+6 6+5 5 6 2 3 1 7 4 11 5+6 6+2+3 3+1+7 7+4 1-7: 8 unique solutions A B C D E F G sum A+B B+C+D D+E+F F+G ------------- --- ------------------- 7 8 3 4 5 6 9 15 7+8 8+3+4 4+5+6 6+9 8 7 3 5 4 6 9 15 8+7 7+3+5 5+4+6 6+9 9 6 4 5 3 7 8 15 9+6 6+4+5 5+3+7 7+8 9 6 5 4 3 8 7 15 9+6 6+5+4 4+3+8 8+7 3-9: 4 unique solutions 0-9: 2860 non-unique solutions 0-6: 4 unique solutions 2-8: 8 unique solutions
BASIC256
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
Befunge
This is loosely based on the 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.
550" :woL">:#,_&>00p" :hgiH">:#,_&>1+10p" :)n/y( euqinU">:#,_>~>:4v
v!g03!:\*`\g01\!`\g00:p05:+g03:p04:_$30g1+:10g\`v1g<,+$p02%2_|#`*8<
>>+\30g-!+20g*!*00g\#v_$40g1+:10g\`^<<1g00p03<<<_$55+:,\."snoitul"v
v!`\g00::p07:+g04p06:<^<`\g01:+1g06$<_v#!\g00*!*g02++!-g05< v"so"<
>\10g\`*\:::30g-!\40g-!+\50g-!+\60g-! +60g::30g-!\40g-!+\^ >:#,_@
>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^^>
- Output:
Low: 1 High: 7 Unique (y/n): y 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 solutions
Low: 3 High: 9 Unique (y/n): y 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 solutions
Low: 0 High: 9 Unique (y/n): n 2860 solutions
C
#include <stdio.h>
#define TRUE 1
#define FALSE 0
int a,b,c,d,e,f,g;
int lo,hi,unique,show;
int solutions;
void
bf()
{
for (f = lo;f <= hi; f++)
if ((!unique) ||
((f != a) && (f != c) && (f != d) && (f != g) && (f != e)))
{
b = e + f - c;
if ((b >= lo) && (b <= hi) &&
((!unique) || ((b != a) && (b != c) &&
(b != d) && (b != g) && (b != e) && (b != f))))
{
solutions++;
if (show)
printf("%d %d %d %d %d %d %d\n",a,b,c,d,e,f,g);
}
}
}
void
ge()
{
for (e = lo;e <= hi; e++)
if ((!unique) || ((e != a) && (e != c) && (e != d)))
{
g = d + e;
if ((g >= lo) && (g <= hi) &&
((!unique) || ((g != a) && (g != c) &&
(g != d) && (g != e))))
bf();
}
}
void
acd()
{
for (c = lo;c <= hi; c++)
for (d = lo;d <= hi; d++)
if ((!unique) || (c != d))
{
a = c + d;
if ((a >= lo) && (a <= hi) &&
((!unique) || ((c != 0) && (d != 0))))
ge();
}
}
void
foursquares(int plo,int phi, int punique,int pshow)
{
lo = plo;
hi = phi;
unique = punique;
show = pshow;
solutions = 0;
printf("\n");
acd();
if (unique)
printf("\n%d unique solutions in %d to %d\n",solutions,lo,hi);
else
printf("\n%d non-unique solutions in %d to %d\n",solutions,lo,hi);
}
main()
{
foursquares(1,7,TRUE,TRUE);
foursquares(3,9,TRUE,TRUE);
foursquares(0,9,FALSE,FALSE);
}
Output
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
C#
using System;
using System.Linq;
namespace Four_Squares_Puzzle {
class Program {
static void Main(string[] args) {
fourSquare(1, 7, true, true);
fourSquare(3, 9, true, true);
fourSquare(0, 9, false, false);
}
private static void fourSquare(int low, int high, bool unique, bool print) {
int count = 0;
if (print) {
Console.WriteLine("a b c d e f g");
}
for (int a = low; a <= high; ++a) {
for (int b = low; b <= high; ++b) {
if (notValid(unique, b, a)) continue;
int fp = a + b;
for (int c = low; c <= high; ++c) {
if (notValid(unique, c, b, a)) continue;
for (int d = low; d <= high; ++d) {
if (notValid(unique, d, c, b, a)) continue;
if (fp != b + c + d) continue;
for (int e = low; e <= high; ++e) {
if (notValid(unique, e, d, c, b, a)) continue;
for (int f = low; f <= high; ++f) {
if (notValid(unique, f, e, d, c, b, a)) continue;
if (fp != d + e + f) continue;
for (int g = low; g <= high; ++g) {
if (notValid(unique, g, f, e, d, c, b, a)) continue;
if (fp != f + g) continue;
++count;
if (print) {
Console.WriteLine("{0} {1} {2} {3} {4} {5} {6}", a, b, c, d, e, f, g);
}
}
}
}
}
}
}
}
if (unique) {
Console.WriteLine("There are {0} unique solutions in [{1}, {2}]", count, low, high);
}
else {
Console.WriteLine("There are {0} non-unique solutions in [{1}, {2}]", count, low, high);
}
}
private static bool notValid(bool unique, int needle, params int[] haystack) {
return unique && haystack.Any(p => p == needle);
}
}
}
- 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 There are 8 unique solutions in [1, 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 There are 4 unique solutions in [3, 9] There are 2860 non-unique solutions in [0, 9]
C++
//C++14/17
#include <algorithm>//std::for_each
#include <iostream> //std::cout
#include <numeric> //std::iota
#include <vector> //std::vector, save solutions
#include <list> //std::list, for fast erase
using std::begin, std::end, std::for_each;
//Generates all the valid solutions for the problem in the specified range [from, to)
std::list<std::vector<int>> combinations(int from, int to)
{
if (from > to)
return {}; //Return nothing if limits are invalid
auto pool = std::vector<int>(to - from);//Here we'll save our values
std::iota(begin(pool), end(pool), from);//Populates pool
auto solutions = std::list<std::vector<int>>{}; //List for the solutions
//Brute-force calculation of valid values...
for (auto a : pool)
for (auto b : pool)
for (auto c : pool)
for (auto d : pool)
for (auto e : pool)
for (auto f : pool)
for (auto g : pool)
if ( a == c + d
&& b + c == e + f
&& d + e == g )
solutions.push_back({a, b, c, d, e, f, g});
return solutions;
}
//Filter the list generated from "combinations" and return only lists with no repetitions
std::list<std::vector<int>> filter_unique(int from, int to)
{
//Helper lambda to check repetitions:
//If the count is > 1 for an element, there must be a repetition inside the range
auto has_non_unique_values = [](const auto & range, auto target)
{
return std::count( begin(range), end(range), target) > 1;
};
//Generates all the solutions...
auto results = combinations(from, to);
//For each solution, find duplicates inside
for (auto subrange = cbegin(results); subrange != cend(results); ++subrange)
{
bool repetition = false;
//If some element is repeated, repetition becomes true
for (auto x : *subrange)
repetition |= has_non_unique_values(*subrange, x);
if (repetition) //If repetition is true, remove the current subrange from the list
{
results.erase(subrange); //Deletes subrange from solutions
--subrange; //Rewind to the last subrange analysed
}
}
return results; //Finally return remaining results
}
template <class Container> //Template for the sake of simplicity
inline void print_range(const Container & c)
{
for (const auto & subrange : c)
{
std::cout << "[";
for (auto elem : subrange)
std::cout << elem << ' ';
std::cout << "\b]\n";
}
}
int main()
{
std::cout << "Unique-numbers combinations in range 1-7:\n";
auto solution1 = filter_unique(1, 8);
print_range(solution1);
std::cout << "\nUnique-numbers combinations in range 3-9:\n";
auto solution2 = filter_unique(3,10);
print_range(solution2);
std::cout << "\nNumber of combinations in range 0-9: "
<< combinations(0, 10).size() << "." << std::endl;
return 0;
}
Output
Unique-numbers combinations in range 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 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] Unique-numbers combinations in range 3-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] Number of combinations in range 0-9: 2860.
Chipmunk Basic
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
- Output:
>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
Clojure
(use '[clojure.math.combinatorics]
(defn rings [r & {:keys [unique] :or {unique true}}]
(if unique
(apply concat (map permutations (combinations r 7)))
(selections r 7)))
(defn four-rings [low high & {:keys [unique] :or {unique true}}]
(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]))
- Output:
=> (pprint (four-rings 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 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]) nil => (pprint (four-rings 3 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]) nil => (count (four-rings 0 9 :unique false)) 2860
Common Lisp
(defpackage four-rings
(:use common-lisp)
(:export display-solutions))
(in-package four-rings)
(defun correct-answer-p (a b c d e f g)
(let ((v (+ a b)))
(and (equal v (+ b c d))
(equal v (+ d e f))
(equal v (+ f g)))))
(defun combinations-if (func len unique min max)
(let ((results nil))
(labels ((inner (cur)
(if (eql (length cur) len)
(when (apply func (reverse cur))
(push cur results))
(dotimes (i (- max min))
(when (or (not unique)
(not (member (+ i min) cur)))
(inner (append (list (+ i min)) cur)))))))
(inner nil))
results))
(defun four-rings-solutions (low high unique)
(combinations-if #'correct-answer-p 7 unique low (1+ high)))
(defun display-solutions ()
(let ((letters '((a b c d e f g))))
(format t "Low 1, High 7, unique letters: ~%~{~{~3A~}~%~}~%"
(append letters (four-rings-solutions 1 7 t)))
(format t "Low 3, High 9, unique letters: ~%~{~{~3A~}~%~}~%"
(append letters (four-rings-solutions 3 9 t)))
(format t "Number of solutions for Low 0, High 9 non-unique:~%~A~%"
(length (four-rings-solutions 0 9 nil)))))
Output:
CL-USER> (four-rings:display-solutions) Low 1, High 7, unique letters: A B C D E F G 6 4 1 5 2 3 7 4 5 3 1 6 2 7 3 7 2 1 5 4 6 7 3 2 5 1 4 6 4 7 1 3 2 6 5 5 6 2 3 1 7 4 7 2 6 1 3 5 4 6 4 5 1 2 7 3 Low 3, High 9, unique letters: 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 Number of solutions for Low 0, High 9 non-unique: 2860 NIL
Crystal
def check(list)
a, b, c, d, e, f, g = list
first = a + b
{b + c + d, d + e + f, f + g}.all? &.==(first)
end
def four_squares(low, high, unique = true, show = unique)
solutions = [] of Array(Int32)
if unique
uniq = "unique"
(low..high).to_a.each_permutation(7, true) { |ary| solutions << ary.clone if check(ary) }
else
uniq = "non-unique"
(low..high).to_a.each_repeated_permutation(7, true) { |ary| solutions << ary.clone if check(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)
D
import std.stdio;
void main() {
fourSquare(1,7,true,true);
fourSquare(3,9,true,true);
fourSquare(0,9,false,false);
}
void fourSquare(int low, int high, bool unique, bool print) {
int count;
if (print) {
writeln("a b c d e f g");
}
for (int a=low; a<=high; ++a) {
for (int b=low; b<=high; ++b) {
if (!valid(unique, a, b)) continue;
int fp = a+b;
for (int c=low; c<=high; ++c) {
if (!valid(unique, c, a, b)) continue;
for (int d=low; d<=high; ++d) {
if (!valid(unique, d, a, b, c)) continue;
if (fp != b+c+d) continue;
for (int e=low; e<=high; ++e) {
if (!valid(unique, e, a, b, c, d)) continue;
for (int f=low; f<=high; ++f) {
if (!valid(unique, f, a, b, c, d, e)) continue;
if (fp != d+e+f) continue;
for (int g=low; g<=high; ++g) {
if (!valid(unique, g, a, b, c, d, e, f)) continue;
if (fp != f+g) continue;
++count;
if (print) {
writeln(a,' ',b,' ',c,' ',d,' ',e,' ',f,' ',g);
}
}
}
}
}
}
}
}
if (unique) {
writeln("There are ", count, " unique solutions in [",low,",",high,"]");
} else {
writeln("There are ", count, " non-unique solutions in [",low,",",high,"]");
}
}
bool valid(bool unique, int needle, int[] haystack ...) {
if (unique) {
foreach (value; haystack) {
if (needle == value) {
return false;
}
}
}
return true;
}
- 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 There are 8 unique solutions in [1,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 There are 4 unique solutions in [3,9] There are 2860 non-unique solutions in [0,9]
Delphi
See #Pascal
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
F#
(* A simple function to generate the sequence
Nigel Galloway: January 31st., 2017 *)
type G = {d:int;x:int;b:int;f:int}
let N n g =
{(max (n-g) n) .. (min (g-n) g)} |> Seq.collect(fun d->{(max (d+n+n) (n+n))..(min (g+g) (d+g+g))} |> Seq.collect(fun x ->
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}))))
Then:
printfn "%d" (Seq.length (N 0 9))
- Output:
2860
(* A simple function to generate the sequence with unique values
Nigel Galloway: January 31st., 2017 *)
type G = {d:int;x:int;b:int;f:int}
let N n g =
{(max (n-g) n) .. (min (g-n) g)} |> Seq.filter(fun d -> d <> 0) |> Seq.collect(fun d->{(max (d+n+n) (n+n)) .. (min (g+g) (d+g+g))} |> Seq.collect(fun x ->
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}))))
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)
- Output:
4,5,3,1,6,2,7 7,2,6,1,3,5,4 3,7,2,1,5,4,6 6,4,5,1,2,7,3 4,7,1,3,2,6,5 5,6,2,3,1,7,4 6,4,1,5,2,3,7 7,3,2,5,1,4,6
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)
- Output:
7,8,3,4,5,6,9 9,6,5,4,3,8,7 8,7,3,5,4,6,9 9,6,4,5,3,7,8
Factor
This solution uses the backtrack
vocabulary — Factor's implementation of John McCarthy's ambiguous operator. In short, we define 7 integers that can take up any value within the range that we give it, such as [3,9], and assign them names a-g. We then test whether the four sums from the puzzle are equal, and if applicable, whether a-g are unique. We send this boolean value to must-be-true
and if it's false, then the other possibilities will be explored through the power of continuations.
bag-of
is a combinator (higher-order function) that yields every solution in a collection. If we had written 4-rings
without using bag-of
, it would have returned only the first solution it found.
USING: arrays backtrack formatting grouping kernel locals math
math.ranges prettyprint sequences sequences.generalizations
sets ;
IN: rosetta-code.4-rings
:: 4-rings ( lo hi unique? -- seq ) [
7 [ lo hi [a,b] amb-lazy ] replicate
7 firstn :> ( a b c d e f g )
{ a b c d e f g } :> p
a b +
b c d + +
d e f + +
f g +
4array all-equal?
unique? [ p all-unique? and ] when
must-be-true p
] bag-of ;
: report ( lo hi unique? -- )
3dup 4-rings over [ dup . ] when length swap "" "non-" ?
"In [%d, %d] there are %d %sunique solutions.\n" printf ;
1 7 t report
3 9 t report
0 9 f report
- Output:
V{ { 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 } } In [1, 7] there are 8 unique solutions. V{ { 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 } } In [3, 9] there are 4 unique solutions. In [0, 9] there are 2860 non-unique solutions.
Fortran
This uses the facility standardised in F90 whereby DO-loops can have text labels attached (not in the usual label area) so that the END DO statement can have the corresponding label, and any CYCLE statements can use it also. Similarly, the subroutine's END statement bears the name of the subroutine. This is just syntactic decoration. Rather more useful is extended syntax for dealing with arrays and especially the function ANY for making multiple tests without having to enumerate them in the code. To gain this convenience, the EQUIVALENCE statement makes variables A, B, C, D, E, F, and G occupy the same storage as INTEGER V(7)
, an array.
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
WRITE(...) FIRST,LAST,IF (UNIQUE) THEN "Distinct values only" ELSE "Repeated values allowed" FI // "."
so that the correct alternative will be selected. Further, an array (that would hold those two texts) can't be indexed by a LOGICAL variable, and playing with EQUIVALENCE won't help, because the numerical values revealed thereby for .TRUE. and .FALSE. may not be 1 and 0. And anyway, parameters are not allowed to be accessed via EQUIVALENCE to another variable. So, a two-part output, and to reduce the blather, two IF-statements.
SUBROUTINE FOURSHOW(FIRST,LAST,UNIQUE) !The "Four Rings" or "Four Squares" puzzle.
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.
LOGICAL UNIQUE !Solutions need not have unique values.
INTEGER A,B,C,D,E,F,G !Ah, Diophantus of Alexandria.
INTEGER V(7),S,N !Assistants.
EQUIVALENCE (V(1),A),(V(2),B),(V(3),C), !Yes,
1 (V(4),D),(V(5),E),(V(6),F),(V(7),G) !We're all individuals.
WRITE (6,1) FIRST,LAST !Announce: first part.
1 FORMAT (/,"The Four Rings puzzle, over ",I0," to ",I0,".",$) !$: An addendum follows.
IF (UNIQUE) WRITE (6,*) "Distinct values only." !Save on the THEN ... ELSE ... END IF blather.
IF (.NOT.UNIQUE) WRITE (6,*) "Repeated values allowed." !Perhaps the compiler will be smarter.
N = 0 !No solutions have been found.
BB:DO B = FIRST,LAST !Start chugging through the possibilities.
CC:DO C = FIRST,LAST !Brute force and ignorance.
IF (UNIQUE .AND. B.EQ.C) CYCLE CC !The first constraint shows up.
DD:DO D = FIRST,LAST !Start by forming B, C, and D.
IF (UNIQUE .AND. ANY(V(2:3).EQ.D)) CYCLE DD !Ignoring A just for now.
S = B + C + D !This is the common sum.
A = S - B !The value of A is not free from BCD.
IF (A < FIRST .OR. A > LAST) CYCLE DD !And it may not be within bounds.
IF (UNIQUE .AND. ANY(V(2:4).EQ.A)) CYCLE DD !Or, if required so, unique.
EE:DO E = FIRST,LAST !Righto, A,B,C,D are valid. Try an E.
IF (UNIQUE .AND. ANY(V(1:4).EQ.E)) CYCLE EE !Precluded already?
F = S - (E + D) !No. So therefore, F is determined.
IF (F < FIRST .OR. F > LAST) CYCLE EE !Acceptable?
IF (UNIQUE .AND. ANY(V(1:5).EQ.F)) CYCLE EE !And, if required, unique?
G = S - F !Yes! So finally, G is determined.
IF (G < FIRST .OR. G > LAST) CYCLE EE !Acceptable?
IF (UNIQUE .AND. ANY(V(1:6).EQ.G)) CYCLE EE !And, if required, unique?
N = N + 1 !Yes! Count a solution set!
IF (UNIQUE) WRITE (6,"(7I3)") V !Show its values.
END DO EE !Consder another E.
END DO DD !Consider another D.
END DO CC !Consider another C.
END DO BB !Consider another B.
WRITE (6,2) N !Announce the count.
2 FORMAT (I9," found.") !Numerous, if no need for distinct values.
END SUBROUTINE FOURSHOW !That was fun!
PROGRAM POKE
CALL FOURSHOW(1,7,.TRUE.)
CALL FOURSHOW(3,9,.TRUE.)
CALL FOURSHOW(0,9,.FALSE.)
END
Output: not in a neat order because the first variable is not determined first.
The Four Rings puzzle, over 1 to 7. Distinct values only. 7 2 6 1 3 5 4 7 3 2 5 1 4 6 6 4 1 5 2 3 7 6 4 5 1 2 7 3 4 5 3 1 6 2 7 5 6 2 3 1 7 4 4 7 1 3 2 6 5 3 7 2 1 5 4 6 8 found. The Four Rings puzzle, over 3 to 9. Distinct values only. 9 6 4 5 3 7 8 9 6 5 4 3 8 7 8 7 3 5 4 6 9 7 8 3 4 5 6 9 4 found. The Four Rings puzzle, over 0 to 9. Repeated values allowed. 2860 found.
One might hope that the ANY function will quit as soon as possible and that it will not be invoked if UNIQUE is false, but the modernisers have rejected reliance on short-circuit evaluation and the "help" is quite general on the workings of the ANY function, as also is modern. Here is a sample of the code produced by the Compaq 6.6a Visual Fortran F90/95 compiler, in its normal "debugging" condition and array bound checking of course active...
31: IF (UNIQUE .AND. ANY(V(1:6).EQ.G)) CYCLE EE !And, if required, unique? 00401496 mov edi,dword ptr [UNIQUE] 00401499 mov edi,dword ptr [edi] 0040149B mov ebx,dword ptr [G (00470380)] 004014A1 mov eax,0 004014A6 mov ecx,1 004014AB mov dword ptr [ebp-60h],1 004014B2 cmp dword ptr [ebp-60h],6 004014B6 jg FOURSHOW+4C4h (004014fc) 004014B8 cmp ecx,1 004014BB jl FOURSHOW+48Ah (004014c2) 004014BD cmp ecx,7 004014C0 jle FOURSHOW+493h (004014cb) 004014C2 xor esi,esi 004014C4 mov dword ptr [ebp-6Ch],esi 004014C7 dec esi 004014C8 bound esi,qword ptr [ebp-6Ch] 004014CB imul esi,ecx,4 004014CE mov esi,dword ptr S+4 (00470364)[esi] 004014D4 xor edx,edx 004014D6 cmp esi,ebx 004014D8 sete dl 004014DB mov dword ptr [ebp-6Ch],edx 004014DE mov edx,eax 004014E0 or edx,dword ptr [ebp-6Ch] 004014E3 and edx,1 004014E6 mov eax,edx 004014E8 neg eax 004014EA mov esi,ecx 004014EC add esi,1 004014EF mov ecx,esi 004014F1 mov edx,dword ptr [ebp-60h] 004014F4 add edx,1 004014F7 mov dword ptr [ebp-60h],edx 004014FA jmp FOURSHOW+47Ah (004014b2) 004014FC and edi,eax 004014FE mov edx,edi 00401500 and edx,1 00401503 cmp edx,0 00401506 jne FOURSHOW+531h (00401569) 32: N = N + 1 !Yes! Count a solution set! 00401508 mov esi,dword ptr [N (0047035c)] 0040150E add esi,1 00401511 mov dword ptr [N (0047035c)],esi 33: IF (UNIQUE) WRITE (6,"(7I3)") V !Show its values.
I'd rather say nothing at all.
FreeBASIC
' version 18-03-2017
' compile with: fbc -s console
' TRUE/FALSE are built-in constants since FreeBASIC 1.04
' But we have to define them for older versions.
#Ifndef TRUE
#Define FALSE 0
#Define TRUE Not FALSE
#EndIf
Sub four_rings(low As Long, high As Long, unique As Long, show As Long)
Dim As Long a, b, c, d, e, f, g
Dim As ULong t, total
Dim As ULong l = Len(Str(high))
If l < Len(Str(low)) Then l = Len(Str(low))
If show = TRUE Then
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 = TRUE Then
If b = a Then Continue For
End If
t = a + b
For c = low To high
If unique = TRUE Then
If c = a OrElse c = b Then Continue For
End If
For d = low To high
If unique = TRUE Then
If d = a OrElse d = b OrElse d = c Then Continue For
End If
If b + c + d = t Then
For e = low To high
If unique = TRUE Then
If e = a OrElse e = b OrElse e = c OrElse e = d Then Continue For
End If
For f = low To high
If unique = TRUE Then
If f = a OrElse f = b OrElse f = c OrElse f = d OrElse f = e Then Continue For
End If
If d + e + f = t Then
For g = low To high
If unique = TRUE Then
If g = a OrElse g = b OrElse g = c OrElse g = d OrElse g = e OrElse g = f Then Continue For
End If
If f + g = t Then
total += 1
If show = TRUE Then
Print Using String(l +1, "#"); a; b; c; d; e; f; g
End If
End If
Next
End If
Next
Next
End If
Next
Next
Next
Next
If unique = TRUE Then
Print
Print total; " Unique solutions for "; Str(low); " to "; Str(high)
Else
Print total; " Non unique solutions for "; Str(low); " to "; Str(high)
End If
Print String(40, "-") : Print
End Sub
' ------=< MAIN >=------
four_rings(1, 7, TRUE, TRUE)
four_rings(3, 9, TRUE, TRUE)
four_rings(0, 9, FALSE, FALSE)
' empty keyboard buffer
While InKey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End
- 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 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 ----------------------------------------
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.
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
For interest, the following solution uses CoreFoundation (CF) strings.
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
- 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 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 ------------------------------------
Go
package main
import "fmt"
func main(){
n, c := getCombs(1,7,true)
fmt.Printf("%d unique solutions in 1 to 7\n",n)
fmt.Println(c)
n, c = getCombs(3,9,true)
fmt.Printf("%d unique solutions in 3 to 9\n",n)
fmt.Println(c)
n, _ = getCombs(0,9,false)
fmt.Printf("%d non-unique solutions in 0 to 9\n",n)
}
func getCombs(low,high int,unique bool) (num int,validCombs [][]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 validComb(a,b,c,d,e,f,g) {
if !unique || isUnique(a,b,c,d,e,f,g) {
num++
validCombs = append(validCombs,[]int{a,b,c,d,e,f,g})
}
}
}
}
}
}
}
}
}
return
}
func isUnique(a,b,c,d,e,f,g int) (res bool) {
data := make(map[int]int)
data[a]++
data[b]++
data[c]++
data[d]++
data[e]++
data[f]++
data[g]++
return len(data) == 7
}
func validComb(a,b,c,d,e,f,g int) bool{
square1 := a + b
square2 := b + c + d
square3 := d + e + f
square4 := f + g
return square1 == square2 && square2 == square3 && square3 == square4
}
- Output:
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
Groovy
class FourRings {
static void main(String[] args) {
fourSquare(1, 7, true, true)
fourSquare(3, 9, true, true)
fourSquare(0, 9, false, false)
}
private static void fourSquare(int low, int high, boolean unique, boolean print) {
int count = 0
if (print) {
println("a b c d e f g")
}
for (int a = low; a <= high; ++a) {
for (int b = low; b <= high; ++b) {
if (notValid(unique, a, b)) continue
int fp = a + b
for (int c = low; c <= high; ++c) {
if (notValid(unique, c, a, b)) continue
for (int d = low; d <= high; ++d) {
if (notValid(unique, d, a, b, c)) continue
if (fp != b + c + d) continue
for (int e = low; e <= high; ++e) {
if (notValid(unique, e, a, b, c, d)) continue
for (int f = low; f <= high; ++f) {
if (notValid(unique, f, a, b, c, d, e)) continue
if (fp != d + e + f) continue
for (int g = low; g <= high; ++g) {
if (notValid(unique, g, a, b, c, d, e, f)) continue
if (fp != f + g) continue
++count
if (print) {
printf("%d %d %d %d %d %d %d%n", a, b, c, d, e, f, g)
}
}
}
}
}
}
}
}
if (unique) {
printf("There are %d unique solutions in [%d, %d]%n", count, low, high)
} else {
printf("There are %d non-unique solutions in [%d, %d]%n", count, low, high)
}
}
private static boolean notValid(boolean unique, int needle, int ... haystack) {
return unique && Arrays.stream(haystack).anyMatch({ p -> p == needle })
}
}
- 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 There are 8 unique solutions in [1, 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 There are 4 unique solutions in [3, 9] There are 2860 non-unique solutions in [0, 9]
Haskell
By exhaustive search
import Data.List
import Control.Monad
perms :: (Eq a) => [a] -> [[a]]
perms [] = [[]]
perms xs = [ x:xr | x <- xs, xr <- perms (xs\\[x]) ]
combs :: (Eq a) => Int -> [a] -> [[a]]
combs 0 _ = [[]]
combs n xs = [ x:xr | x <- xs, xr <- combs (n-1) xs ]
ringCheck :: [Int] -> Bool
ringCheck [x0, x1, x2, x3, x4, x5, x6] =
v == x1+x2+x3
&& v == x3+x4+x5
&& v == x5+x6
where v = x0 + x1
fourRings :: Int -> Int -> Bool -> Bool -> IO ()
fourRings low high allowRepeats verbose = do
let candidates = if allowRepeats
then combs 7 [low..high]
else perms [low..high]
solutions = filter ringCheck candidates
when verbose $ mapM_ print solutions
putStrLn $ show (length solutions)
++ (if allowRepeats then " non" else "")
++ " unique solutions for "
++ show low
++ " to "
++ show high
putStrLn ""
main = do
fourRings 1 7 False True
fourRings 3 9 False True
fourRings 0 9 True False
- 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 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 non unique solutions for 0 to 9
By structured search
For a faster solution (under a third of a second, vs over 25 seconds on this system for the brute force approach above), we can nest a series of smaller and more focused searches from the central digit outwards.
Two things to notice:
- If we call the central digit the Queen, then in any solution the Queen plus its left neighbour (left Bishop) must sum to the value of the left Rook (leftmost digit). Symmetrically, the right Rook must be the sum of the Queen and right Bishop.
- The difference between the left Rook and the right Rook must be (minus) the difference between the left Knight (between bishop and rook) and the right Knight.
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.
import Data.List (delete, sortBy, (\\))
--------------- 4 RINGS OR 4 SQUARES PUZZLE --------------
type Rings = [(Int, Int, Int, Int, Int, Int, Int)]
rings :: Bool -> [Int] -> Rings
rings u digits =
((>>=) <*> (queen u =<< head))
(sortBy (flip compare) digits)
queen :: Bool -> Int -> [Int] -> Int -> Rings
queen u h ds q = xs >>= leftBishop u q h ts ds
where
ts = filter ((<= h) . (q +)) ds
xs
| u = delete q ts
| otherwise = ds
leftBishop ::
Bool ->
Int ->
Int ->
[Int] ->
[Int] ->
Int ->
Rings
leftBishop u q h ts ds lb
| lRook <= h = xs >>= rightBishop u q h lb ds lRook
| otherwise = []
where
lRook = lb + q
xs
| u = ts \\ [q, lb, lRook]
| otherwise = ds
rightBishop ::
Bool ->
Int ->
Int ->
Int ->
[Int] ->
Int ->
Int ->
Rings
rightBishop u q h lb ds lRook rb
| (rRook <= h) && (not u || (rRook /= lb)) =
let ks
| u = (ds \\ [q, lb, rb, rRook, lRook])
| otherwise = ds
in ks
>>= knights
u
(lRook - rRook)
lRook
lb
q
rb
rRook
ks
| otherwise = []
where
rRook = q + rb
knights ::
Bool ->
Int ->
Int ->
Int ->
Int ->
Int ->
Int ->
[Int] ->
Int ->
Rings
knights u rookDelta lRook lb q rb rRook ks k =
[ (lRook, k, lb, q, rb, k2, rRook)
| (k2 `elem` ks)
&& ( not u
|| notElem
k2
[lRook, k, lb, q, rb, rRook]
)
]
where
k2 = k + rookDelta
--------------------------- TEST -------------------------
main :: IO ()
main = do
let f (k, xs) = putStrLn k >> nl >> mapM_ print xs >> nl
nl = putStrLn []
mapM_
f
[ ("rings True [1 .. 7]", rings True [1 .. 7]),
("rings True [3 .. 9]", rings True [3 .. 9])
]
f
( "length (rings False [0 .. 9])",
[length (rings False [0 .. 9])]
)
- Output:
rings True [1 .. 7] (7,3,2,5,1,4,6) (6,4,1,5,2,3,7) (5,6,2,3,1,7,4) (4,7,1,3,2,6,5) (7,2,6,1,3,5,4) (6,4,5,1,2,7,3) (4,5,3,1,6,2,7) (3,7,2,1,5,4,6) rings True [3 .. 9] (9,6,4,5,3,7,8) (8,7,3,5,4,6,9) (9,6,5,4,3,8,7) (7,8,3,4,5,6,9) length (rings False [0 .. 9]) 2860
J
Implementation for the unique version of the puzzle:
fspuz=:dyad define
range=: x+i.1+y-x
lo=. 6+3*x
hi=. _3+2*y
r=.i.0 0
if. lo <: hi do.
for_T.lo ([+[:i.1+-~) hi do.
range2=: (#~ (T-{.range)>:]) range
range3=: (#~ (T-+/2{.range)>:]) range
ab=: (#~ ~:/"1) (,.T-])range2
abc=: ;ab <@([ ,"1 0 -.~)"1/range3
abcd=: (#~ T = +/@}."1) ;abc <@([ ,"1 0 -.~)"1/range3
abcde=: ;abcd <@([ ,"1 0 -.~)"1/range3
abcdef=: (#~ T = +/@(3}.])"1) ;abcde <@([ ,"1 0 -.~)"1/range3
abcdefg=: (#~ T = +/@(5}.])"1) ;abcdef <@([ ,"1 0 -.~)"1/range2
r=.r,(#~ x<:<./"1)(#~ y>:>./"1)abcdefg
end.
end.
)
Implementation for the non-unique version of the puzzle:
fspuz2=:dyad define
range=: x+i.1+y-x
lo=. 3*x
hi=. 2*y
r=.i.0 0
if. lo <: hi do.
for_T.lo ([+[:i.1+-~) hi do.
ab=: (,.T-])range
abc=: ,/ab,"1 0/ range
abcd=: (#~ T = +/@}."1) ,/abc,"1 0/ range
abcde=: ,/abcd,"1 0/ range
abcdef=: (#~ T = +/@(3}.])"1) ,/abcde ,"1 0/ range
abcdefg=: (#~ T = +/@(5}.])"1) ,/abcdef,"1 0/ range
r=.r,(#~ x<:<./"1)(#~ y>:>./"1)abcdefg
end.
end.
)
Task examples:
1 fspuz 7
4 5 3 1 6 2 7
7 2 6 1 3 5 4
3 7 2 1 5 4 6
6 4 1 5 2 3 7
6 4 5 1 2 7 3
7 3 2 5 1 4 6
4 7 1 3 2 6 5
5 6 2 3 1 7 4
3 fspuz 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
#0 fspuz2 9
2860
Java
Uses java 8 features.
import java.util.Arrays;
public class FourSquares {
public static void main(String[] args) {
fourSquare(1, 7, true, true);
fourSquare(3, 9, true, true);
fourSquare(0, 9, false, false);
}
private static void fourSquare(int low, int high, boolean unique, boolean print) {
int count = 0;
if (print) {
System.out.println("a b c d e f g");
}
for (int a = low; a <= high; ++a) {
for (int b = low; b <= high; ++b) {
if (notValid(unique, a, b)) continue;
int fp = a + b;
for (int c = low; c <= high; ++c) {
if (notValid(unique, c, a, b)) continue;
for (int d = low; d <= high; ++d) {
if (notValid(unique, d, a, b, c)) continue;
if (fp != b + c + d) continue;
for (int e = low; e <= high; ++e) {
if (notValid(unique, e, a, b, c, d)) continue;
for (int f = low; f <= high; ++f) {
if (notValid(unique, f, a, b, c, d, e)) continue;
if (fp != d + e + f) continue;
for (int g = low; g <= high; ++g) {
if (notValid(unique, g, a, b, c, d, e, f)) continue;
if (fp != f + g) continue;
++count;
if (print) {
System.out.printf("%d %d %d %d %d %d %d%n", a, b, c, d, e, f, g);
}
}
}
}
}
}
}
}
if (unique) {
System.out.printf("There are %d unique solutions in [%d, %d]%n", count, low, high);
} else {
System.out.printf("There are %d non-unique solutions in [%d, %d]%n", count, low, high);
}
}
private static boolean notValid(boolean unique, int needle, int... haystack) {
return unique && Arrays.stream(haystack).anyMatch(p -> p == needle);
}
}
- 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 There are 8 unique solutions in [1, 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 There are 4 unique solutions in [3, 9] There are 2860 non-unique solutions in [0, 9]
JavaScript
ES6
(Structured search version)
(() => {
"use strict";
// ----------- 4-RINGS OR 4-SQUARES PUZZLE -----------
// rings :: noRepeatedDigits -> DigitList -> solutions
// rings :: Bool -> [Int] -> [[Int]]
const rings = uniq =>
digits => Boolean(digits.length) ? (
() => {
const ns = digits.sort(flip(compare));
// CENTRAL DIGIT :: d
return ns.flatMap(
ringTriage(uniq)(ns)
);
})() : [];
const ringTriage = uniq => ns => d => {
const
h = head(ns),
ts = ns.filter(x => (x + d) <= h);
// LEFT OF CENTRE :: c and a
return (
uniq ? (delete_(d)(ts)) : ns
)
.flatMap(c => {
const a = c + d;
// RIGHT OF CENTRE :: e and g
return a > h ? (
[]
) : (
uniq ? (
difference(ts)([d, c, a])
) : ns
)
.flatMap(subTriage(uniq)([ns, h, a, c, d]));
});
};
const subTriage = uniq =>
([ns, h, a, c, d]) => e => {
const g = d + e;
return ((g > h) || (
uniq && (g === c))
) ? (
[]
) : (() => {
const
agDelta = a - g,
bfs = uniq ? (
difference(ns)([
d, c, e, g, a
])
) : ns;
// MID LEFT, MID RIGHT :: b and f
return bfs.flatMap(b => {
const f = b + agDelta;
return (bfs).includes(f) && (
!uniq || ![
a, b, c, d, e, g
].includes(f)
) ? ([
[a, b, c, d, e, f, g]
]) : [];
});
})();
};
// ---------------------- TEST -----------------------
const main = () => unlines([
"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);
// delete :: Eq a => a -> [a] -> [a]
const delete_ = x => {
// xs with first instance of x (if any) removed.
const go = xs =>
Boolean(xs.length) ? (
(x === xs[0]) ? (
xs.slice(1)
) : [xs[0]].concat(go(xs.slice(1)))
) : [];
return go;
};
// difference :: Eq a => [a] -> [a] -> [a]
const difference = xs =>
ys => {
const s = new Set(ys);
return xs.filter(x => !s.has(x));
};
// enumFromTo :: Int -> Int -> [Int]
const enumFromTo = m =>
n => Array.from({
length: 1 + n - m
}, (_, i) => m + i);
// flip :: (a -> b -> c) -> b -> a -> c
const flip = op =>
// 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) ? (
xs[0]
) : 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();
})();
- Output:
rings(true, enumFromTo(1,7)) [7,3,2,5,1,4,6] [6,4,1,5,2,3,7] [5,6,2,3,1,7,4] [4,7,1,3,2,6,5] [7,2,6,1,3,5,4] [6,4,5,1,2,7,3] [4,5,3,1,6,2,7] [3,7,2,1,5,4,6] rings(true, enumFromTo(3, 9)) [9,6,4,5,3,7,8] [8,7,3,5,4,6,9] [9,6,5,4,3,8,7] [7,8,3,4,5,6,9] length(rings(false, enumFromTo(0, 9))) 2860
jq
Works with gojq, the Go implementation of jq
Since jq is built on back-tracking and optimizes the tail-recursion involved here, this entry will focus on generic solutiond for problems of this sort. Specifically, the number of boxes is unrestricted.
N boxes with arbitrary overlaps
In this section, an arbitrary pattern of overlaps can be specified as follows.
We will associate the letters "a", "b", ... with the integers 0, 1,... so that each box can be represented as an array of integers; the puzzle configuration can then be characterized by an array of such arrays. For the particular puzzle under consideration, the characteristic array is:
[[0,1], [1,2,3], [3,4,5], [5,6]]
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.
# Generate a stream of all the permutations of the input array
def permutations:
if length == 0 then []
else
range(0;length) as $i
| [.[$i]] + (del(.[$i])|permutations)
end ;
# Permutations of a ... n inclusive
def permutations(a;n):
[range(a;n+1)] | permutations;
# value of a box
# Input: the table of values
def valueOfBox($box):
[ .[ $box[] ]] | add;
def allEqual($boxes):
. as $values
| valueOfBox($boxes[0]) as $sum
| all($boxes[1:][]; . as $box | $values | valueOfBox($box) == $sum);
def combinations($m; $n; $size):
[range(0; $size) | [range($m; $n)]] | combinations;
def count(s): reduce s as $x (null; .+1);
# a=0, b=1, etc
def boxes: [[0,1], [1,2,3], [3,4,5], [5,6]];
def tasks:
"1 to 7:",
(permutations(1;7) | select(allEqual(boxes))),
"\n3 to 9:",
(permutations(3;9) | select(allEqual(boxes))),
"\n0 to 9:\n\(count(permutations(0;9) | select(allEqual(boxes))))",
"\nThere are \(count(combinations(0;10;7) | select(allEqual(boxes)))) solutions for 0 to 9 with replacement."
;
tasks
- Output:
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] 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] There are 1152 distinct solutions for 0 to 9. There are 2860 solutions for 0 to 9 with replacement.
N boxes with one overlap between adjacent boxes and no uniqueness constraint
In this subsection, an efficient solution for the N-boxes puzzle in the case of non-uniqueness (i.e. unrestricted choice of values within the specified range) is given. It is assumed, however, that each box (except for the last) has exactly one overlap with its successor.
For consistency with the prior section, the pattern can be specified in the same way, i.e. as a characteristic array, which for the specific problem at hand could be: [[0,1], [1,2,3], [3,4,5], [5,6]].
# rings/3 assumes that each box (except for the last) has exactly one overlap with its successor.
# Input: ignored.
# Output: a stream of solutions, i.e. a stream of arrays.
# $boxes is an array of boxes, each box being a flat array.
# $min and $max define the range of permissible values of items in the boxes (inclusive)
def rings($boxes; $min; $max):
def inrange: $min <= . and . <= $max;
# The following helper function deals with the case when the global per-box sum ($sum) is known.
# Input: an array representing the solution so far, or null.
# Output: the input plus the solution corresponding to the first argument.
# $this is the sum of the previous items in the first box, or 0.
def solve($boxes; $this; $sum):
# The following is a helper function for handling the case when:
# * $sum is known
# * $boxes[0] | length == 1, and
# * $boxes|length>1
def lastInBox($boxes; $this):
. as $in
| ($boxes[1:] | (.[0] |= .[1:])) as $bx
# the first entry in the next box must be the same:
| ($sum - $this) as $next
| select($next | inrange)
| (. + [$next]) | solve( $bx; $next; $sum) ;
. as $in
| if $boxes|length == 0 then $in
else $boxes[0] as $box
| if $box|length == 0
then solve( $boxes[1:]; 0; $sum )
elif $box|length == 1
# is this the last box?
then if $boxes|length == 1
then ($sum - $this) as $next
| select($next | inrange)
| $in + [$next]
else lastInBox($boxes; $this)
end
else # $box|length > 1
range($min; $max + 1) as $first
| select( ($this + $first) <= $sum)
| ($in + [$first]) | solve( [$box[1:]] + $boxes[1:]; $this + $first; $sum)
end
end ;
. as $in
| $boxes[0] as $box
| ($boxes[1:] | .[0] |= .[1:]) as $bx
| [range(0; $box|length) | [range($min; $max + 1)]]
| combinations
| solve($bx; .[-1]; add) ;
def count(s): reduce s as $x (null; .+1);
The specific task
# a=0, b=1, etc
def boxes: [[0,1], [1,2,3], [3,4,5], [5,6]];
count(rings(boxes; 0; 9))
- Output:
2860
Julia
using Combinatorics
function foursquares(low, high, onlyunique=true, showsolutions=true)
integers = collect(low:high)
count = 0
sumsallequal(c) = c[1] + c[2] == c[2] + c[3] + c[4] == c[4] + c[5] + c[6] == c[6] + c[7]
combos = onlyunique ? combinations(integers) :
with_replacement_combinations(integers, 7)
for combo in combos, plist in unique(collect(permutations(combo, 7)))
if sumsallequal(plist)
count += 1
if showsolutions
println("$plist is a solution for the list $integers")
end
end
end
println("""Total $(onlyunique?"unique ":"")solutions for HIGH $high, LOW $low: $count""")
end
foursquares(1, 7, true, true)
foursquares(3, 9, true, true)
foursquares(0, 9, false, false)
- Output:
[3, 7, 2, 1, 5, 4, 6] is a solution for the list [1, 2, 3, 4, 5, 6, 7] [4, 5, 3, 1, 6, 2, 7] is a solution for the list [1, 2, 3, 4, 5, 6, 7] [4, 7, 1, 3, 2, 6, 5] is a solution for the list [1, 2, 3, 4, 5, 6, 7] [5, 6, 2, 3, 1, 7, 4] is a solution for the list [1, 2, 3, 4, 5, 6, 7] [6, 4, 1, 5, 2, 3, 7] is a solution for the list [1, 2, 3, 4, 5, 6, 7] [6, 4, 5, 1, 2, 7, 3] is a solution for the list [1, 2, 3, 4, 5, 6, 7] [7, 2, 6, 1, 3, 5, 4] is a solution for the list [1, 2, 3, 4, 5, 6, 7] [7, 3, 2, 5, 1, 4, 6] is a solution for the list [1, 2, 3, 4, 5, 6, 7] Total unique solutions for HIGH 7, LOW 1: 8 [7, 8, 3, 4, 5, 6, 9] is a solution for the list [3, 4, 5, 6, 7, 8, 9] [8, 7, 3, 5, 4, 6, 9] is a solution for the list [3, 4, 5, 6, 7, 8, 9] [9, 6, 4, 5, 3, 7, 8] is a solution for the list [3, 4, 5, 6, 7, 8, 9] [9, 6, 5, 4, 3, 8, 7] is a solution for the list [3, 4, 5, 6, 7, 8, 9] Total unique solutions for HIGH 9, LOW 3: 4 Total solutions for HIGH 9, LOW 0: 2860
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)
- 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 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
Kotlin
// version 1.1.2
class FourSquares(
private val lo: Int,
private val hi: Int,
private val unique: Boolean,
private val show: Boolean
) {
private var a = 0
private var b = 0
private var c = 0
private var d = 0
private var e = 0
private var f = 0
private var g = 0
private var s = 0
init {
println()
if (show) {
println("a b c d e f g")
println("-------------")
}
acd()
println("\n$s ${if (unique) "unique" else "non-unique"} solutions in $lo to $hi")
}
private fun acd() {
c = lo
while (c <= hi) {
d = lo
while (d <= hi) {
if (!unique || c != d) {
a = c + d
if ((a in lo..hi) && (!unique || (c != 0 && d!= 0))) ge()
}
d++
}
c++
}
}
private fun bf() {
f = lo
while (f <= hi) {
if (!unique || (f != a && f != c && f != d && f != e && f!= g)) {
b = e + f - c
if ((b in lo..hi) && (!unique || (b != a && b != c && b != d && b != e && b != f && b!= g))) {
s++
if (show) println("$a $b $c $d $e $f $g")
}
}
f++
}
}
private fun ge() {
e = lo
while (e <= hi) {
if (!unique || (e != a && e != c && e != d)) {
g = d + e
if ((g in lo..hi) && (!unique || (g != a && g != c && g != d && g != e))) bf()
}
e++
}
}
}
fun main(args: Array<String>) {
FourSquares(1, 7, true, true)
FourSquares(3, 9, true, true)
FourSquares(0, 9, false, false)
}
- Output:
a b c d e f g ------------- 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 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
Lua
function valid(unique,needle,haystack)
if unique then
for _,value in pairs(haystack) do
if needle == value then
return false
end
end
end
return true
end
function fourSquare(low,high,unique,prnt)
count = 0
if prnt then
print("a", "b", "c", "d", "e", "f", "g")
end
for a=low,high do
for b=low,high do
if valid(unique, a, {b}) then
fp = a + b
for c=low,high do
if valid(unique, c, {a, b}) then
for d=low,high do
if valid(unique, d, {a, b, c}) and fp == b + c + d then
for e=low,high do
if valid(unique, e, {a, b, c, d}) then
for f=low,high do
if valid(unique, f, {a, b, c, d, e}) and fp == d + e + f then
for g=low,high do
if valid(unique, g, {a, b, c, d, e, f}) and fp == f + g then
count = count + 1
if prnt then
print(a, b, c, d, e, f, g)
end
end
end
end
end
end
end
end
end
end
end
end
end
end
if unique then
print(string.format("There are %d unique solutions in [%d, %d]", count, low, high))
else
print(string.format("There are %d non-unique solutions in [%d, %d]", count, low, high))
end
end
fourSquare(1,7,true,true)
fourSquare(3,9,true,true)
fourSquare(0,9,false,false)
- 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 There are 8 unique solutions in [1, 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 There are 4 unique solutions in [3, 9] There are 2860 non-unique solutions in [0, 9]
Mathematica/Wolfram Language
{low, high} = {1, 7};
SolveValues[{a + b == b + c + d == d + e + f == f + g, low <= a <= high,
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}, {a, b, c, d, e, f, g}, Integers]
{low, high} = {3, 9};
SolveValues[{a + b == b + c + d == d + e + f == f + g, low <= a <= high,
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}, {a, b, c, d, e, f, g}, Integers]
{low, high} = {0, 9};
SolveValues[{a + b == b + c + d == d + e + f == f + g, low <= a <= high,
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
- 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}} {{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
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)
- 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 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
Modula-2
MODULE FourSquare;
FROM Conversions IMPORT IntToStr;
FROM Terminal IMPORT *;
PROCEDURE WriteInt(num : INTEGER);
VAR str : ARRAY[0..16] OF CHAR;
BEGIN
IntToStr(num,str);
WriteString(str);
END WriteInt;
PROCEDURE four_square(low, high : INTEGER; unique, print : BOOLEAN);
VAR count : INTEGER;
VAR a, b, c, d, e, f, g : INTEGER;
VAR fp : INTEGER;
BEGIN
count:=0;
IF print THEN
WriteString('a b c d e f g');
WriteLn;
END;
FOR a:=low TO high DO
FOR b:=low TO high DO
IF unique AND (b=a) THEN CONTINUE; END;
fp:=a+b;
FOR c:=low TO high DO
IF unique AND ((c=a) OR (c=b)) THEN CONTINUE; END;
FOR d:=low TO high DO
IF unique AND ((d=a) OR (d=b) OR (d=c)) THEN CONTINUE; END;
IF fp # b+c+d THEN CONTINUE; END;
FOR e:=low TO high DO
IF unique AND ((e=a) OR (e=b) OR (e=c) OR (e=d)) THEN CONTINUE; END;
FOR f:=low TO high DO
IF unique AND ((f=a) OR (f=b) OR (f=c) OR (f=d) OR (f=e)) THEN CONTINUE; END;
IF fp # d+e+f THEN CONTINUE; END;
FOR g:=low TO high DO
IF unique AND ((g=a) OR (g=b) OR (g=c) OR (g=d) OR (g=e) OR (g=f)) THEN CONTINUE; END;
IF fp # f+g THEN CONTINUE; END;
INC(count);
IF print THEN
WriteInt(a);
WriteString(' ');
WriteInt(b);
WriteString(' ');
WriteInt(c);
WriteString(' ');
WriteInt(d);
WriteString(' ');
WriteInt(e);
WriteString(' ');
WriteInt(f);
WriteString(' ');
WriteInt(g);
WriteLn;
END;
END;
END;
END;
END;
END;
END;
END;
IF unique THEN
WriteString('There are ');
WriteInt(count);
WriteString(' unique solutions in [');
WriteInt(low);
WriteString(', ');
WriteInt(high);
WriteString(']');
WriteLn;
ELSE
WriteString('There are ');
WriteInt(count);
WriteString(' non-unique solutions in [');
WriteInt(low);
WriteString(', ');
WriteInt(high);
WriteString(']');
WriteLn;
END;
END four_square;
BEGIN
four_square(1,7,TRUE,TRUE);
four_square(3,9,TRUE,TRUE);
four_square(0,9,FALSE,FALSE);
ReadChar; (* Wait so results can be viewed. *)
END FourSquare.
Nim
Adapted from Rust version.
func isUnique(a, b, c, d, e, f, g: uint8): bool =
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
c != d and c != e and c != f and c != g and
d != e and d != f and d != f and
e != f and e != g and
f != g
func isSolution(a, b, c, d, e, f, g: uint8): bool =
let sum = a + b
sum == b + c + d and sum == d + e + f and sum == f + g
func fourSquares(l, h: uint8, unique: bool): seq[array[7, uint8]] =
for a in l..h:
for b in l..h:
for c in l..h:
for d in l..h:
for e in l..h:
for f in l..h:
for g in l..h:
if (not unique or isUnique(a, b, c, d, e, f, g)) and
isSolution(a, b, c, d, e, f, g):
result &= [a, b, c, d, e, f, g]
proc printFourSquares(l, h: uint8, unique = true) =
let solutions = fourSquares(l, h, unique)
if unique:
for s in solutions:
echo s
echo solutions.len, (if unique: " " else: " non-"), "unique solutions in ",
l, " to ", h, " range\n"
when isMainModule:
printFourSquares(1, 7)
printFourSquares(3, 9)
printFourSquares(0, 9, unique = false)
- 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 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
OCaml
Original version by User:Vanyamil
(* 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
;;
- Output:
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
Pascal
There are so few solutions of 7 consecutive numbers, so I used a modified version, to get all the expected solutions at once.
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.
- 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
Relying on the modules ntheory
and Set::CrossProduct
to generate the tuples needed. Both are supply results via iterators, particularly important in the latter case, to avoid gobbling too much memory.
use ntheory qw/forperm/;
use Set::CrossProduct;
sub four_sq_permute {
my($list) = @_;
my @solutions;
forperm {
@c = @$list[@_];
push @solutions, [@c] if check(@c);
} @$list;
print +@solutions . " unique solutions found using: " . join(', ', @$list) . "\n";
return @solutions;
}
sub four_sq_cartesian {
my(@list) = @_;
my @solutions;
my $iterator = Set::CrossProduct->new( [(@list) x 7] );
while( my $c = $iterator->get ) {
push @solutions, [@$c] if check(@$c);
}
print +@solutions . " non-unique solutions found using: " . join(', ', @{@list[0]}) . "\n";
return @solutions;
}
sub check {
my(@c) = @_;
$a = $c[0] + $c[1];
$b = $c[1] + $c[2] + $c[3];
$c = $c[3] + $c[4] + $c[5];
$d = $c[5] + $c[6];
$a == $b and $a == $c and $a == $d;
}
sub display {
my(@solutions) = @_;
my $fmt = "%2s " x 7 . "\n";
printf $fmt, ('a'..'g');
printf $fmt, @$_ for @solutions;
print "\n";
}
display four_sq_permute( [1..7] );
display four_sq_permute( [3..9] );
display four_sq_permute( [8, 9, 11, 12, 17, 18, 20, 21] );
four_sq_cartesian( [0..9] );
- 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 17 21 9 8 12 18 20 20 18 8 12 9 17 21 20 18 11 9 8 21 17 20 18 11 9 12 17 21 20 18 12 8 9 21 17 21 17 9 12 8 18 20 21 17 12 9 11 18 20 2860 non-unique solutions found using: 0, 1, 2, 3, 4, 5, 6, 7, 8, 9
With Recursion
#!/usr/bin/perl
use strict; # https://rosettacode.org/wiki/4-rings_or_4-squares_puzzle
use warnings;
for ( [1 .. 7], [3 .. 9] )
{
print "for @$_\n\n";
findunique( $_ );
print "\n";
}
my $count = 0;
findcount();
print "count of non-unique 0-9: $count\n";
sub findunique
{
my @allowed = @{ shift @_ };
if( @_ == 4 ) { $_[0] == $_[2] + $_[3] or return }
elsif( @_ == 6 ) { $_[1] + $_[2] == $_[4] + $_[5] or return }
elsif( @_ == 7 ) { $_[3] + $_[4] == $_[6] and print "@_\n"; return }
for my $n ( @allowed )
{
findunique( [ grep $n != $_, @allowed ], @_, $n );
}
}
sub findcount
{
if( @_ == 4 ) { $_[0] == $_[2] + $_[3] or return }
elsif( @_ == 6 ) { $_[1] + $_[2] == $_[4] + $_[5] or return }
elsif( @_ == 7 ) { $_[3] + $_[4] == $_[6] and $count++; return }
findcount( @_, $_ ) for 0 .. 9;
}
- Output:
for 1 2 3 4 5 6 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 for 3 4 5 6 7 8 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 count of non-unique 0-9: 2860
Phix
-- demo/rosetta/4_rings_or_4_squares_puzzle.exw with javascript_semantics integer solutions procedure check(sequence set, bool show) integer {a,b,c,d,e,f,g} = set, ab = a+b if ab=b+d+c and ab=d+e+f and ab=f+g then solutions += 1 if show then ?set end if end if end procedure procedure foursquares(integer lo, hi, bool uniq, show) sequence set = repeat(lo,7) solutions = 0 if uniq then for i=1 to 7 do set[i] = lo+i-1 end for for i=1 to factorial(7) do check(permute(i,set),show) end for else integer done = 0 while not done do check(set,show) for i=1 to 7 do set[i] += 1 if set[i]<=hi then exit end if if i=7 then done = 1 exit end if set[i] = lo end for end while end if printf(1,"%d solutions\n",solutions) end procedure foursquares(1,7,uniq:=true,show:=true) foursquares(3,9,true,true) foursquares(0,9,false,false)
- Output:
{6,4,5,1,2,7,3} {3,7,2,1,5,4,6} {6,4,1,5,2,3,7} {4,7,1,3,2,6,5} {7,3,2,5,1,4,6} {5,6,2,3,1,7,4} {4,5,3,1,6,2,7} {7,2,6,1,3,5,4} 8 solutions {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 solutions 2860 solutions
Picat
import cp.
main =>
puzzle_all(1, 7, true, Sol1),
foreach(Sol in Sol1) println(Sol) end,
nl,
puzzle_all(3, 9, true, Sol2),
foreach(Sol in Sol2) println(Sol) end,
nl,
puzzle_all(0, 9, false, Sol3),
println(len=Sol3.len),
nl.
puzzle_all(Min, Max, Distinct, LL) =>
L = [A,B,C,D,E,F,G],
L :: Min..Max,
if Distinct then
all_different(L)
else
true
end,
T #= A+B,
T #= B+C+D,
T #= D+E+F,
T #= F+G,
% Another approach:
% 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).
- Output:
Picat> main [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] [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] len = 2860
PL/M
... under CP/M (or an emulator)
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
- 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
PL/SQL
create table allints (v number);
create table results
(
a number,
b number,
c number,
d number,
e number,
f number,
g number
);
create or replace procedure foursquares(lo number,hi number,uniq boolean,show boolean)
as
a number;
b number;
c number;
d number;
e number;
f number;
g number;
out_line varchar2(2000);
cursor results_cur is
select
a,
b,
c,
d,
e,
f,
g
from
results
order by
a,b,c,d,e,f,g;
results_rec results_cur%rowtype;
solutions number;
uorn varchar2(2000);
begin
solutions := 0;
delete from allints;
delete from results;
for i in lo..hi loop
insert into allints values (i);
end loop;
commit;
if uniq = TRUE then
insert into results
select
a.v a,
b.v b,
c.v c,
d.v d,
e.v e,
f.v f,
g.v g
from
allints a, allints b, allints c,allints d,
allints e, allints f, allints g
where
a.v not in (b.v,c.v,d.v,e.v,f.v,g.v) and
b.v not in (c.v,d.v,e.v,f.v,g.v) and
c.v not in (d.v,e.v,f.v,g.v) and
d.v not in (e.v,f.v,g.v) and
e.v not in (f.v,g.v) and
f.v not in (g.v) and
a.v = c.v + d.v and
g.v = d.v + e.v and
b.v = e.v + f.v - c.v
order by
a,b,c,d,e,f,g;
uorn := ' unique solutions in ';
else
insert into results
select
a.v a,
b.v b,
c.v c,
d.v d,
e.v e,
f.v f,
g.v g
from
allints a, allints b, allints c,allints d,
allints e, allints f, allints g
where
a.v = c.v + d.v and
g.v = d.v + e.v and
b.v = e.v + f.v - c.v
order by
a,b,c,d,e,f,g;
uorn := ' non-unique solutions in ';
end if;
commit;
open results_cur;
loop
fetch results_cur into results_rec;
exit when results_cur%notfound;
a := results_rec.a;
b := results_rec.b;
c := results_rec.c;
d := results_rec.d;
e := results_rec.e;
f := results_rec.f;
g := results_rec.g;
solutions := solutions + 1;
if show = TRUE then
out_line := to_char(a) || ' ';
out_line := out_line || ' ' || to_char(b) || ' ';
out_line := out_line || ' ' || to_char(c) || ' ';
out_line := out_line || ' ' || to_char(d) || ' ';
out_line := out_line || ' ' || to_char(e) || ' ';
out_line := out_line || ' ' || to_char(f) ||' ';
out_line := out_line || ' ' || to_char(g);
end if;
dbms_output.put_line(out_line);
end loop;
close results_cur;
out_line := to_char(solutions) || uorn;
out_line := out_line || to_char(lo) || ' to ' || to_char(hi);
dbms_output.put_line(out_line);
end;
/
Output
SQL> execute foursquares(1,7,TRUE,TRUE); 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 PL/SQL procedure successfully completed. SQL> execute 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 PL/SQL procedure successfully completed. SQL> execute foursquares(0,9,FALSE,FALSE); 2860 non-unique solutions in 0 to 9 PL/SQL procedure successfully completed.
Prolog
Works with SWI-Prolog 7.5.8
:- use_module(library(clpfd)).
% main predicate
my_sum(Min, Max, Top, LL):-
L = [A,B,C,D,E,F,G],
L ins Min..Max,
( Top == 0
-> all_distinct(L)
; true),
R #= A+B,
R #= B+C+D,
R #= D+E+F,
R #= F+G,
setof(L, labeling([ff], L), LL).
my_sum_1(Min, Max) :-
my_sum(Min, Max, 0, LL),
maplist(writeln, LL).
my_sum_2(Min, Max, Len) :-
my_sum(Min, Max, 1, LL),
length(LL, Len).
Output
?- my_sum_1(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,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] true. ?- my_sum_1(3,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] true. ?- my_sum_2(0,9,N). N = 2860.
Python
Procedural
Itertools
import itertools
def all_equal(a,b,c,d,e,f,g):
return a+b == b+c+d == d+e+f == 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
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
Generators
Faster solution without itertools
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
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
Functional
'''4-rings or 4-squares puzzle'''
from itertools import chain
# rings :: noRepeatedDigits -> DigitList -> Lists of solutions
# rings :: Bool -> [Int] -> [[Int]]
def rings(uniq):
'''Sets of unique or non-unique integer values
(drawn from the `digits` argument)
for each of the seven names [a..g] such that:
(a + b) == (b + c + d) == (d + e + f) == (f + g)
'''
def go(digits):
ns = sorted(digits, reverse=True)
h = ns[0]
# CENTRAL DIGIT :: d
def central(d):
xs = list(filter(lambda x: h >= (d + x), ns))
# LEFT NEIGHBOUR AND LEFTMOST :: c and a
def left(c):
a = c + d
if a > h:
return []
else:
# RIGHT NEIGHBOUR AND RIGHTMOST :: e and g
def right(e):
g = d + e
if ((g > h) or (uniq and (g == c))):
return []
else:
agDelta = a - g
bfs = difference(ns)(
[d, c, e, g, a]
) if uniq else ns
# MID LEFT AND RIGHT :: b and f
def midLeftRight(b):
f = b + agDelta
return [[a, b, c, d, e, f, g]] if (
(f in bfs) and (
(not uniq) or (
f not in [a, b, c, d, e, g]
)
)
) else []
# CANDIDATE DIGITS BOUND TO POSITIONS [a .. g] --------
return concatMap(midLeftRight)(bfs)
return concatMap(right)(
difference(xs)([d, c, a]) if uniq else ns
)
return concatMap(left)(
delete(d)(xs) if uniq else ns
)
return concatMap(central)(ns)
return lambda digits: go(digits) if digits else []
# TEST ----------------------------------------------------
# main :: IO ()
def main():
'''Testing unique digits [1..7], [3..9] and unrestricted digits'''
print(main.__doc__ + ':\n')
print(unlines(map(
lambda tpl: '\nrings' + repr(tpl) + ':\n\n' + unlines(
map(repr, uncurry(rings)(*tpl))
), [
(True, enumFromTo(1)(7)),
(True, enumFromTo(3)(9))
]
)))
tpl = (False, enumFromTo(0)(9))
print(
'\n\nlen(rings' + repr(tpl) + '):\n\n' +
str(len(uncurry(rings)(*tpl)))
)
# GENERIC -------------------------------------------------
# concatMap :: (a -> [b]) -> [a] -> [b]
def concatMap(f):
'''A concatenated list over which a function has been mapped.
The list monad can be derived by using a function f which
wraps its output in a list,
(using an empty list to represent computational failure).
'''
return lambda xs: list(
chain.from_iterable(map(f, xs))
)
# delete :: Eq a => a -> [a] -> [a]
def delete(x):
'''xs with the first of any instances of x removed.'''
def go(xs):
xs.remove(x)
return xs
return lambda xs: go(list(xs)) if (
x in xs
) else list(xs)
# difference :: Eq a => [a] -> [a] -> [a]
def difference(xs):
'''All elements of ys except any also found in xs'''
def go(ys):
s = set(ys)
return [x for x in xs if x not in s]
return lambda ys: go(ys)
# enumFromTo :: (Int, Int) -> [Int]
def enumFromTo(m):
'''Integer enumeration from m to n.'''
return lambda n: list(range(m, 1 + n))
# uncurry :: (a -> b -> c) -> ((a, b) -> c)
def uncurry(f):
'''A function over a pair of arguments,
derived from a vanilla or curried function.
'''
return lambda x, y: f(x)(y)
# unlines :: [String] -> String
def unlines(xs):
'''A single string formed by the intercalation
of a list of strings with the newline character.
'''
return '\n'.join(xs)
# MAIN ---
if __name__ == '__main__':
main()
- Output:
Testing unique digits [1..7], [3..9] and unrestricted digits: rings(True, [1, 2, 3, 4, 5, 6, 7]): [7, 3, 2, 5, 1, 4, 6] [6, 4, 1, 5, 2, 3, 7] [5, 6, 2, 3, 1, 7, 4] [4, 7, 1, 3, 2, 6, 5] [7, 2, 6, 1, 3, 5, 4] [6, 4, 5, 1, 2, 7, 3] [4, 5, 3, 1, 6, 2, 7] [3, 7, 2, 1, 5, 4, 6] rings(True, [3, 4, 5, 6, 7, 8, 9]): [9, 6, 4, 5, 3, 7, 8] [8, 7, 3, 5, 4, 6, 9] [9, 6, 5, 4, 3, 8, 7] [7, 8, 3, 4, 5, 6, 9] len(rings(False, [0, 1, 2, 3, 4, 5, 6, 7, 8, 9])): 2860
R
Function "perms" is a modified version of the "permutations" function from the "gtools" R package.
# 4 rings or 4 squares puzzle
perms <- function (n, r, v = 1:n, repeats.allowed = FALSE) {
if (repeats.allowed)
sub <- function(n, r, v) {
if (r == 1)
matrix(v, n, 1)
else if (n == 1)
matrix(v, 1, r)
else {
inner <- Recall(n, r - 1, v)
cbind(rep(v, rep(nrow(inner), n)), matrix(t(inner),
ncol = ncol(inner), nrow = nrow(inner) * n,
byrow = TRUE))
}
}
else sub <- function(n, r, v) {
if (r == 1)
matrix(v, n, 1)
else if (n == 1)
matrix(v, 1, r)
else {
X <- NULL
for (i in 1:n) X <- rbind(X, cbind(v[i], Recall(n - 1, r - 1, v[-i])))
X
}
}
X <- sub(n, r, v[1:n])
result <- vector(mode = "numeric")
for(i in 1:nrow(X)){
y <- X[i, ]
x1 <- y[1] + y[2]
x2 <- y[2] + y[3] + y[4]
x3 <- y[4] + y[5] + y[6]
x4 <- y[6] + y[7]
if(x1 == x2 & x2 == x3 & x3 == x4) result <- rbind(result, y)
}
return(result)
}
print_perms <- function(n, r, v = 1:n, repeats.allowed = FALSE, table.out = FALSE) {
a <- perms(n, r, v, repeats.allowed)
colnames(a) <- rep("", ncol(a))
rownames(a) <- rep("", nrow(a))
if(!repeats.allowed){
print(a)
cat(paste('\n', nrow(a), 'unique solutions from', min(v), 'to', max(v)))
} else {
cat(paste('\n', nrow(a), 'non-unique solutions from', min(v), 'to', max(v)))
}
}
registerS3method("print_perms", "data.frame", print_perms)
print_perms(7, 7, repeats.allowed = FALSE, table.out = TRUE)
print_perms(7, 7, v = 3:9, repeats.allowed = FALSE, table.out = TRUE)
print_perms(10, 7, v = 0:9, repeats.allowed = TRUE, table.out = FALSE)
- 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 from 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 from 3 to 9 2860 non-unique solutions from 0 to 9
Racket
Using a folder, so we can count as well as produce lists of results
#lang racket
(define solution? (match-lambda [(list a b c d e f g) (= (+ a b) (+ b c d) (+ d e f) (+ f g))]))
(define (fold-4-rings-or-4-squares-puzzle lo hi kons k0)
(for*/fold ((k k0))
((combination (in-combinations (range lo (add1 hi)) 7))
(permutation (in-permutations combination))
#:when (solution? permutation))
(kons permutation k)))
(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)
- Output:
'((6 4 1 5 2 3 7) (4 5 3 1 6 2 7) (3 7 2 1 5 4 6) (7 3 2 5 1 4 6) (4 7 1 3 2 6 5) (5 6 2 3 1 7 4) (7 2 6 1 3 5 4) (6 4 5 1 2 7 3)) '((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)) 192
Raku
(formerly Perl 6)
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) );
- 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.
REXX
fast version
This REXX version is faster than the more idiomatic version, but is longer (statement-wise) and
a bit easier to read (visualize).
/*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). */
times=HI - LO + 1 /*calculate number of times to loop. */
#=0 /*number of solutions found (so far). */
do a=LO for times
do b=LO for times
if unique then if b==a then iterate
do c=LO for times
if unique then do; if c==a then iterate
if c==b then iterate
end
do d=LO for times
if unique then do; if d==a then iterate
if d==b then iterate
if d==c then iterate
end
do e=LO for times
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 for times
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 for times
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
- 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.
idiomatic version
This REXX version is slower than the faster version (because of the multiple if clauses.
Note that the REXX language doesn't have short-circuits (when executing multiple clauses in if (and other) statements.
/*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 u=1 /*unique letter solutions*/
else u=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). */
times=HI - LO + 1 /*calculate number of times to loop. */
#=0 /*number of solutions found (so far). */
do a=LO for times
do b=LO for times; if u then if b==a then iterate
do c=LO for times; if u then if c==a|c==b then iterate
do d=LO for times; if u then if d==a|d==b|d==c then iterate
do e=LO for times; if u then if e==a|e==b|e==c|e==d then iterate
do f=LO for times; if u then if f==a|f==b|f==c|f==d|f==e then iterate
do g=LO for times; if u then if g==a|g==b|g==c|g==d|g==e|g==f then iterate
sum=a+b
if f+g==sum & b+c+d==sum & d+e+f==sum then #=#+1 /*bump # of solutions.*/
else iterate /*sum not equal, no─go*/
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*/ /*for 1st time, show title*/
end /*f*/
end /*e*/
end /*d*/
end /*c*/
end /*b*/
end /*a*/
say
_= ' non-unique'
if u 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
- output is identical to the faster REXX version.
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)
- 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
Rust
#![feature(inclusive_range_syntax)]
fn is_unique(a: u8, b: u8, c: u8, d: u8, e: u8, f: u8, g: u8) -> bool {
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
}
fn is_solution(a: u8, b: u8, c: u8, d: u8, e: u8, f: u8, g: u8) -> bool {
a + b == b + c + d &&
b + c + d == d + e + f &&
d + e + f == f + g
}
fn four_squares(low: u8, high: u8, unique: bool) -> Vec<Vec<u8>> {
let mut results: Vec<Vec<u8>> = Vec::new();
for a in low..=high {
for b in low..=high {
for c in low..=high {
for d in low..=high {
for e in low..=high {
for f in low..=high {
for g in low..=high {
if (!unique || is_unique(a, b, c, d, e, f, g)) &&
is_solution(a, b, c, d, e, f, g) {
results.push(vec![a, b, c, d, e, f, g]);
}
}
}
}
}
}
}
}
results
}
fn print_results(solutions: &Vec<Vec<u8>>) {
for solution in solutions {
println!("{:?}", solution)
}
}
fn print_results_summary(solutions: usize, low: u8, high: u8, unique: bool) {
let uniqueness = if unique {
"unique"
} else {
"non-unique"
};
println!("{} {} solutions in {} to {} range", solutions, uniqueness, low, high)
}
fn uniques(low: u8, high: u8) {
let solutions = four_squares(low, high, true);
print_results(&solutions);
print_results_summary(solutions.len(), low, high, true);
}
fn nonuniques(low: u8, high: u8) {
let solutions = four_squares(low, high, false);
print_results_summary(solutions.len(), low, high, false);
}
fn main() {
uniques(1, 7);
println!();
uniques(3, 9);
println!();
nonuniques(0, 9);
}
- 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 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
Scala
object FourRings {
def fourSquare(low: Int, high: Int, unique: Boolean, print: Boolean): Unit = {
def isValid(needle: Integer, haystack: Integer*) = !unique || !haystack.contains(needle)
if (print) println("a b c d e f g")
var count = 0
for {
a <- low to high
b <- low to high if isValid(a, b)
fp = a + b
c <- low to high if isValid(c, a, b)
d <- low to high if isValid(d, a, b, c) && fp == b + c + d
e <- low to high if isValid(e, a, b, c, d)
f <- low to high if isValid(f, a, b, c, d, e) && fp == d + e + f
g <- low to high if isValid(g, a, b, c, d, e, f) && fp == f + g
} {
count += 1
if (print) println(s"$a $b $c $d $e $f $g")
}
println(s"There are $count ${if(unique) "unique" else "non-unique"} solutions in [$low, $high]")
}
def main(args: Array[String]): Unit = {
fourSquare(1, 7, unique = true, print = true)
fourSquare(3, 9, unique = true, print = true)
fourSquare(0, 9, unique = false, print = false)
}
}
- 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 There are 8 unique solutions in [1, 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 There are 4 unique solutions in [3, 9] There are 2860 non-unique solutions in [0, 9]
Scheme
(import (scheme base)
(scheme write)
(srfi 1))
;; return all combinations of size elements from given set
(define (combinations size set unique?)
(if (zero? size)
(list '())
(let loop ((base-combns (combinations (- size 1) set unique?))
(results '())
(items set))
(cond ((null? base-combns) ; end, as no base-combinations to process
results)
((null? items) ; check next base-combination
(loop (cdr base-combns)
results
set))
((and unique? ; ignore if wanting list unique
(member (car items) (car base-combns) =))
(loop base-combns
results
(cdr items)))
(else ; keep the new combination
(loop base-combns
(cons (cons (car items) (car base-combns))
results)
(cdr items)))))))
;; checks if all 4 sums are the same
(define (solution? a b c d e f g)
(= (+ a b)
(+ b c d)
(+ d e f)
(+ f g)))
;; Tasks
(display "Solutions: LOW=1 HIGH=7\n")
(display (filter (lambda (combination) (apply solution? combination))
(combinations 7 (iota 7 1) #t))) (newline)
(display "Solutions: LOW=3 HIGH=9\n")
(display (filter (lambda (combination) (apply solution? combination))
(combinations 7 (iota 7 3) #t))) (newline)
(display "Solution count: LOW=0 HIGH=9 non-unique\n")
(display (count (lambda (combination) (apply solution? combination))
(combinations 7 (iota 10 0) #f))) (newline)
- Output:
Solutions: LOW=1 HIGH=7 ((4 5 3 1 6 2 7) (6 4 1 5 2 3 7) (3 7 2 1 5 4 6) (7 3 2 5 1 4 6) (4 7 1 3 2 6 5) (7 2 6 1 3 5 4) (5 6 2 3 1 7 4) (6 4 5 1 2 7 3)) Solutions: LOW=3 HIGH=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)) Solution count: LOW=0 HIGH=9 non-unique 2860
Sidef
func four_squares (list, unique=true, show=true) {
var solutions = []
func check(c) {
solutions << c if ([
c[0] + c[1],
c[1] + c[2] + c[3],
c[3] + c[4] + c[5],
c[5] + c[6],
].uniq.len == 1)
}
if (unique) {
list.combinations(7, {|*a|
a.permutations { |*c|
check(c)
}
})
} else {
7.of { list }.cartesian {|*c|
check(c)
}
}
say (solutions.len,
(unique ? ' ' : ' non-'),
"unique solutions found using #{list.join(', ')}.\n")
if (show) {
var f = "%#{list.max.len+1}s"
say ("\n".join(
('a'..'g').map{f % _}.join,
solutions.map{ .map{f % _}.join }...
), "\n")
}
}
# TASK
four_squares(@(1..7))
four_squares(@(3..9))
four_squares([8, 9, 11, 12, 17, 18, 20, 21])
four_squares(@(0..9), unique: false, show: false)
- 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.
Simula
BEGIN
INTEGER PROCEDURE GETCOMBS(LOW, HIGH, UNIQUE, COMBS);
INTEGER LOW, HIGH;
INTEGER ARRAY COMBS;
BOOLEAN UNIQUE;
BEGIN
INTEGER A, B, C, D, E, F, G;
INTEGER NUM;
BOOLEAN PROCEDURE ISUNIQUE(A, B, C, D, E, F, G);
INTEGER A, B, C, D, E, F, G;
BEGIN
INTEGER ARRAY DATA(LOW:HIGH);
INTEGER I;
FOR I := LOW STEP 1 UNTIL HIGH DO
DATA(I) := -1;
FOR I := A, B, C, D, E, F, G DO
IF DATA(I) = -1
THEN DATA(I) := 1
ELSE GOTO L;
ISUNIQUE := TRUE;
L:
END;
PROCEDURE ADDCOMB;
BEGIN
NUM := NUM + 1;
COMBS(NUM, LOW + 0) := A;
COMBS(NUM, LOW + 1) := B;
COMBS(NUM, LOW + 2) := C;
COMBS(NUM, LOW + 3) := D;
COMBS(NUM, LOW + 4) := E;
COMBS(NUM, LOW + 5) := F;
COMBS(NUM, LOW + 6) := G;
END;
FOR A := LOW STEP 1 UNTIL HIGH DO
FOR B := LOW STEP 1 UNTIL HIGH DO
FOR C := LOW STEP 1 UNTIL HIGH DO
FOR D := LOW STEP 1 UNTIL HIGH DO
FOR E := LOW STEP 1 UNTIL HIGH DO
FOR F := LOW STEP 1 UNTIL HIGH DO
FOR G := LOW STEP 1 UNTIL HIGH DO
BEGIN
IF VALIDCOMB(A, B, C, D, E, F, G) THEN
BEGIN
IF UNIQUE THEN
BEGIN IF ISUNIQUE(A, B, C, D, E, F, G) THEN ADDCOMB END
ELSE ADDCOMB;
END;
END;
GETCOMBS := NUM;
END;
BOOLEAN PROCEDURE VALIDCOMB(A, B, C, D, E, F, G);
INTEGER A, B, C, D, E, F, G;
BEGIN
INTEGER SQUARE1, SQUARE2, SQUARE3, SQUARE4;
SQUARE1 := A + B;
SQUARE2 := B + C + D;
SQUARE3 := D + E + F;
SQUARE4 := F + G;
VALIDCOMB := SQUARE1 = SQUARE2 AND SQUARE2 = SQUARE3 AND SQUARE3 = SQUARE4
END;
COMMENT ----- MAIN PROGRAM ----- ;
INTEGER ARRAY LO(1:3);
INTEGER ARRAY HI(1:3);
BOOLEAN ARRAY UQ(1:3);
INTEGER I;
LO(1) := 1; HI(1) := 7; UQ(1) := TRUE;
LO(2) := 3; HI(2) := 9; UQ(2) := TRUE;
LO(3) := 0; HI(3) := 9; UQ(3) := FALSE;
FOR I := 1 STEP 1 UNTIL 3 DO
BEGIN
INTEGER LOW, HIGH;
BOOLEAN UNIQ;
LOW := LO(I); HIGH := HI(I); UNIQ := UQ(I);
BEGIN
INTEGER ARRAY VALIDCOMBS(1:8000, LOW:HIGH);
INTEGER N;
N := GETCOMBS(LOW, HIGH, UNIQ, VALIDCOMBS);
OUTINT(N, 0);
IF UNIQ THEN OUTTEXT(" UNIQUE");
OUTTEXT(" SOLUTIONS IN ");
OUTINT(LOW, 0); OUTTEXT(" TO ");
OUTINT(HIGH, 0);
OUTIMAGE;
IF I < 3 THEN
BEGIN INTEGER I, J;
FOR I := 1 STEP 1 UNTIL N DO
BEGIN
OUTTEXT("[");
FOR J := LOW STEP 1 UNTIL HIGH DO
OUTINT(VALIDCOMBS(I, J), 2);
OUTTEXT(" ]");
OUTIMAGE;
END;
END;
END;
END;
END.
- Output:
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 SOLUTIONS IN 0 TO 9
SQL PL
version 9.7 or higher.
With SQL PL:
--#SET TERMINATOR @
SET SERVEROUTPUT ON @
CREATE TABLE ALL_INTS (
V INTEGER
)@
CREATE TABLE RESULTS (
A INTEGER,
B INTEGER,
C INTEGER,
D INTEGER,
E INTEGER,
F INTEGER,
G INTEGER
)@
CREATE OR REPLACE PROCEDURE FOUR_SQUARES(
IN LO INTEGER,
IN HI INTEGER,
IN UNIQ SMALLINT,
--IN UNIQ BOOLEAN,
IN SHOW SMALLINT)
--IN SHOW BOOLEAN)
BEGIN
DECLARE A INTEGER;
DECLARE B INTEGER;
DECLARE C INTEGER;
DECLARE D INTEGER;
DECLARE E INTEGER;
DECLARE F INTEGER;
DECLARE G INTEGER;
DECLARE OUT_LINE VARCHAR(2000);
DECLARE I SMALLINT;
DECLARE SOLUTIONS INTEGER;
DECLARE UORN VARCHAR(2000);
SET SOLUTIONS = 0;
DELETE FROM ALL_INTS;
DELETE FROM RESULTS;
SET I = LO;
WHILE (I <= HI) DO
INSERT INTO ALL_INTS VALUES (I);
SET I = I + 1;
END WHILE;
COMMIT;
-- Computes unique solutions.
IF (UNIQ = 0) THEN
--IF (UNIQ = TRUE) THEN
INSERT INTO RESULTS
SELECT
A.V A, B.V B, C.V C, D.V D, E.V E, F.V F, G.V G
FROM
ALL_INTS A, ALL_INTS B, ALL_INTS C, ALL_INTS D, ALL_INTS E, ALL_INTS F,
ALL_INTS G
WHERE
A.V NOT IN (B.V, C.V, D.V, E.V, F.V, G.V)
AND B.V NOT IN (C.V, D.V, E.V, F.V, G.V)
AND C.V NOT IN (D.V, E.V, F.V, G.V)
AND D.V NOT IN (E.V, F.V, G.V)
AND E.V NOT IN (F.V, G.V)
AND F.V NOT IN (G.V)
AND A.V = C.V + D.V
AND G.V = D.V + E.V
AND B.V = E.V + F.V - C.V
ORDER BY
A, B, C, D, E, F, G;
SET UORN = ' unique solutions in ';
ELSE
-- Compute non-unique solutions.
INSERT INTO RESULTS
SELECT
A.V A, B.V B, C.V C, D.V D, E.V E, F.V F, G.V G
FROM
ALL_INTS A, ALL_INTS B, ALL_INTS C, ALL_INTS D, ALL_INTS E, ALL_INTS F,
ALL_INTS G
WHERE
A.V = C.V + D.V
AND G.V = D.V + E.V
AND B.V = E.V + F.V - C.V
ORDER BY
A, B, C, D, E, F, G;
SET UORN = ' non-unique solutions in ';
END IF;
COMMIT;
-- Counts the possible solutions.
FOR v AS c CURSOR FOR
SELECT
A, B, C, D, E, F, G
FROM RESULTS
ORDER BY
A, B, C, D, E, F, G
DO
SET SOLUTIONS = SOLUTIONS + 1;
-- Shows the results.
IF (SHOW = 0) THEN
--IF (SHOW = TRUE) THEN
SET OUT_LINE = A || ' ' || B || ' ' || C || ' ' || D || ' ' || E || ' '
|| F ||' ' || G;
CALL DBMS_OUTPUT.PUT_LINE(OUT_LINE);
END IF;
END FOR;
SET OUT_LINE = SOLUTIONS || UORN || LO || ' to ' || HI;
CALL DBMS_OUTPUT.PUT_LINE(OUT_LINE);
END
@
CALL FOUR_SQUARES(1, 7, 0, 0)@
CALL FOUR_SQUARES(3, 9, 0, 0)@
CALL FOUR_SQUARES(0, 9, 1, 1)@
Output:
db2 -td@ db2 => CREATE TABLE ALL_INTS ( V INTEGER ) DB20000I The SQL command completed successfully. db2 => CREATE TABLE RESULTS ( A INTEGER, B INTEGER, C INTEGER, D INTEGER, E INTEGER, F INTEGER, G INTEGER ) DB20000I The SQL command completed successfully. db2 => CREATE OR REPLACE PROCEDURE FOUR_SQUARES( ... db2 (cont.) => END @ DB20000I The SQL command completed successfully. db2 => CALL FOUR_SQUARES(1, 7, 0, 0) Return Status = 0 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 db2 => CALL FOUR_SQUARES(3, 9, 0, 0) Return Status = 0 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 CALL FOUR_SQUARES(0, 9, 1, 1) Return Status = 0 2860 non-unique solutions in 0 TO 9
Stata
Use the program perm in the Permutations task for the first two questions, as it's fast enough. Use joinby for the third.
perm 7
rename * (a b c d e f g)
list if a==c+d & b+c==e+f & d+e==g, noobs sep(50)
+---------------------------+
| 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 |
+---------------------------+
foreach var of varlist _all {
replace `var'=`var'+2
}
list if a==c+d & b+c==e+f & d+e==g, noobs sep(50)
+---------------------------+
| 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 |
+---------------------------+
clear
set obs 10
gen b=_n-1
gen q=1
save temp, replace
rename b c
joinby q using temp
rename b d
joinby q using temp
rename b e
gen a=c+d
gen g=d+e
drop if a>9 | g>9
joinby q using temp
gen f=b+c-e
drop if f<0 | f>9
drop q
order a b c d e f g
erase temp.dta
count
2,860
Tcl
This task is a good opportunity to practice metaprogramming in Tcl. The procedure compile_4rings builds a lambda expression which takes values for {a b c d e f g} as parameters and returns true if those values satisfy the specified expressions ($exprs). This approach lets the bytecode compiler optimise our code.
For the final challenge, we vary the code generation a bit in compile_4rings_hard: instead of a lambda taking parameters, this generates a nested loop that searches exhaustively through the possible values for each variable.
The puzzle can be varied freely by changing the values of $vars and $exprs specified at the top of the script.
set vars {a b c d e f g}
set exprs {
{$a+$b}
{$b+$c+$d}
{$d+$e+$f}
{$f+$g}
}
proc permute {xs} {
if {[llength $xs] < 2} {
return $xs
}
set i -1
foreach x $xs {
incr i
set rest [lreplace $xs $i $i]
foreach rest [permute $rest] {
lappend res [list $x {*}$rest]
}
}
return $res
}
proc range {a b} {
set a [uplevel 1 [list expr $a]]
set b [uplevel 1 [list expr $b]]
set res {}
while {$a <= $b} {
lappend res $a
incr a
}
return $res
}
proc compile_4rings {vars exprs} {
set script "set _ \[[list expr [lindex $exprs 0]]\]\n"
foreach expr [lrange $exprs 1 end] {
append script "if {\$_ != $expr} {return false}\n"
}
append script "return true\n"
list $vars $script
}
proc solve_4rings {vars exprs range} {
set lambda [compile_4rings $vars $exprs]
foreach values [permute $range] {
if {[apply $lambda {*}$values]} {
puts " $values"
}
}
}
proc compile_4rings_hard {vars exprs values} {
append script "set _ \[[list expr [lindex $exprs 0]]\]\n"
foreach expr [lrange $exprs 1 end] {
append script "if {\$_ != $expr} {continue}\n"
}
append script "incr res\n"
foreach var $vars {
set script [list foreach $var $values $script]
}
set script "set res 0\n$script\nreturn \$res"
list {} $script
}
proc solve_4rings_hard {vars exprs range} {
apply [compile_4rings_hard $vars $exprs $range]
}
puts "# Combinations of 1..7:"
solve_4rings $vars $exprs [range 1 7]
puts "# Combinations of 3..9:"
solve_4rings $vars $exprs [range 3 9]
puts "# Number of solutions, free over 0..9:"
puts [solve_4rings_hard $vars $exprs [range 0 9]]
- Output:
# Combinations of 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 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 # Combinations of 3..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 # Number of solutions, free over 0..9: 2860
VBA
Dim a As Integer, b As Integer, c As Integer, d As Integer
Dim e As Integer, f As Integer, g As Integer
Dim lo As Integer, hi As Integer, unique As Boolean, show As Boolean
Dim solutions As Integer
Private Sub bf()
For f = lo To hi
If ((Not unique) Or _
((f <> a And f <> c And f <> d And f <> g And f <> e))) Then
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
solutions = solutions + 1
If show Then Debug.Print a; b; c; d; e; f; g
End If
End If
Next
End Sub
Private Sub ge()
For e = lo To hi
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
bf
End If
End If
Next
End Sub
Private Sub acd()
For c = lo To hi
For d = lo To hi
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
ge
End If
End If
Next d
Next c
End Sub
Private Sub foursquares(plo As Integer, phi As Integer, punique As Boolean, pshow As Boolean)
lo = plo
hi = phi
unique = punique
show = pshow
solutions = 0
acd
Debug.Print
If unique Then
Debug.Print solutions; " unique solutions in"; lo; "to"; hi
Else
Debug.Print solutions; " non-unique solutions in"; lo; "to"; hi
End If
End Sub
Public Sub program()
Call foursquares(1, 7, True, True)
Debug.Print
Call foursquares(3, 9, True, True)
Call foursquares(0, 9, False, False)
End Sub
- Output:
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
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.
Module Module1
Dim CA As Char() = "0123456789ABC".ToCharArray()
Sub FourSquare(lo As Integer, hi As Integer, uni As Boolean, sy As Char())
If sy IsNot Nothing Then Console.WriteLine("a b c d e f g" & vbLf & "-------------")
Dim r = Enumerable.Range(lo, hi - lo + 1).ToList(), u As New List(Of Integer),
t As Integer, cn As Integer = 0
For Each a In r
u.Add(a)
For Each b In r
If uni AndAlso u.Contains(b) Then Continue For
u.Add(b)
t = a + b
For Each c In r : If uni AndAlso u.Contains(c) Then Continue For
u.Add(c)
For d = a - c To a - c
If d < lo OrElse d > hi OrElse uni AndAlso u.Contains(d) OrElse
t <> b + c + d Then Continue For
u.Add(d)
For Each e In r
If uni AndAlso u.Contains(e) Then Continue For
u.Add(e)
For f = b + c - e To b + c - e
If f < lo OrElse f > hi OrElse uni AndAlso u.Contains(f) OrElse
t <> d + e + f Then Continue For
u.Add(f)
For g = t - f To t - f : If g < lo OrElse g > hi OrElse
uni AndAlso u.Contains(g) Then Continue For
cn += 1 : If sy IsNot Nothing Then _
Console.WriteLine("{0} {1} {2} {3} {4} {5} {6}",
sy(a), sy(b), sy(c), sy(d), sy(e), sy(f), sy(g))
Next : u.Remove(f) : Next : u.Remove(e) : Next : u.Remove(d)
Next : u.Remove(c) : Next : u.Remove(b) : Next : u.Remove(a)
Next : Console.WriteLine("{0} {1}unique solutions for [{2},{3}]{4}",
cn, If(uni, "", "non-"), lo, hi, vbLf)
End Sub
Sub main()
fourSquare(1, 7, True, CA)
fourSquare(3, 9, True, CA)
fourSquare(0, 9, False, Nothing)
fourSquare(5, 12, True, CA)
End Sub
End Module
- Output:
Added the zkl example for [5,12]
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,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,9] 2860 non-unique solutions for [0,9] a b c d e f g ------------- B 9 6 5 7 8 C B A 6 5 7 9 C C 8 7 5 6 9 B C 9 7 5 6 A B 4 unique solutions for [5,12]
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
}
- Output:
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
Wren
import "./fmt" for Fmt
var a = 0
var b = 0
var c = 0
var d = 0
var e = 0
var f = 0
var g = 0
var lo
var hi
var unique
var show
var solutions
var bf = Fn.new {
f = lo
while (f <= hi) {
if (!unique || (f != a && f != c && f != d && f != e && f != g)) {
b = e + f - c
if (b >= lo && b <= hi &&
(!unique || (b != a && b != c && b != d && b != e && b != f && b != g))) {
solutions = solutions + 1
if (show) Fmt.lprint("$d $d $d $d $d $d $d", [a, b, c, d, e, f, g])
}
}
f = f + 1
}
}
var ge = Fn.new {
e = lo
while (e <= hi) {
if (!unique || (e != a && e != c && e != d)) {
g = d + e
if (g >= lo && g <= hi &&
(!unique || (g != a && g != c && g != d && g != e))) bf.call()
}
e = e + 1
}
}
var acd = Fn.new {
c = lo
while (c <= hi) {
d = lo
while (d <= hi) {
if (!unique || c != d) {
a = c + d
if (a >= lo && a <= hi && (!unique || (c != 0 && d != 0))) ge.call()
}
d = d + 1
}
c = c + 1
}
}
var foursquares = Fn.new { |plo, phi, punique, pshow|
lo = plo
hi = phi
unique = punique
show = pshow
solutions = 0
if (show) {
System.print("\na b c d e f g")
System.print("-------------")
}
acd.call()
if (unique) {
Fmt.print("\n$d unique solutions in $d to $d", solutions, lo, hi)
} else {
Fmt.print("\n$d non-unique solutions in $d to $d\n", solutions, lo, hi)
}
}
foursquares.call(1, 7, true, true)
foursquares.call(3, 9, true, true)
foursquares.call(0, 9, false, false)
- Output:
a b c d e f g ------------- 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 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
X86 Assembly
See 4-rings_or_4-squares_puzzle/X86 Assembly
XPL0
int Show, Low, High, Digit(7\a..g\), Count;
proc Rings(Level);
int Level; \of recursion
int D, Temp, I, Set;
[for D:= Low to High do
[Digit(Level):= D;
if Level < 7-1 then Rings(Level+1)
else [ Temp:= Digit(0) + Digit(1); \solution?
if Temp = Digit(1) + Digit(2) + Digit(3) and
Temp = Digit(3) + Digit(4) + Digit(5) and
Temp = Digit(5) + Digit(6) then
[Count:= Count+1;
if Show then
[Set:= 0; \digits must be unique
for I:= 0 to 7-1 do
Set:= Set ! 1<<Digit(I);
if Set = %111_1111 << Low then
[for I:= 0 to 7-1 do
[IntOut(0, Digit(I)); ChOut(0, ^ )];
CrLf(0);
];
];
];
];
];
];
[Show:= true;
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);
]
- 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 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
Yabasic
fourSquare(1,7,true,true)
fourSquare(3,9,true,true)
fourSquare(0,9,false,false)
sub fourSquare(low, high, unique, prin)
local count, a, b, c, d, e, f, g, fp
if (prin) print "a b c d e f g"
for a = low to high
for b = low to high
if (not valid(unique, a, b)) continue
fp = a+b
for c = low to high
if (not valid(unique, c, a, b)) continue
for d = low to high
if (not valid(unique, d, a, b, c)) continue
if (fp <> b+c+d) continue
for e = low to high
if (not valid(unique, e, a, b, c, d)) continue
for f = low to high
if (not valid(unique, f, a, b, c, d, e)) continue
if (fp <> d+e+f) continue
for g = low to high
if (not valid(unique, g, a, b, c, d, e, f)) continue
if (fp <> f+g) continue
count = count + 1
if (prin) print a," ",b," ",c," ",d," ",e," ",f," ",g
next
next
next
next
next
next
next
if (unique) then
print "There are ", count, " unique solutions in [",low,",",high,"]"
else
print "There are ", count, " non-unique solutions in [",low,",",high,"]"
end if
end sub
sub valid(unique, needle, n1, n2, n3, n4, n5, n6)
local i
if (unique) then
for i = 1 to numparams - 2
switch i
case 1: if needle = n1 return false : break
case 2: if needle = n2 return false : break
case 3: if needle = n3 return false : break
case 4: if needle = n4 return false : break
case 5: if needle = n5 return false : break
case 6: if needle = n6 return false : break
end switch
next
end if
return true
end sub
- 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 There are 8 unique solutions in [1,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 There are 4 unique solutions in [3,9] There are 2860 non-unique solutions in [0,9]
Zig
This is a direct translation of the Go solution - the Zig implementation having manual memory management and Zig not ignoring errors or return values.
const std = @import("std");
const Allocator = std.mem.Allocator;
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});
}
}
/// 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() };
}
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;
}
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;
}
- Output:
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
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
}
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.");
- 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.
- Games
- Puzzles
- Programming Tasks
- Solutions by Programming Task
- 11l
- AArch64 Assembly
- Action!
- Ada
- ALGOL 68
- ALGOL W
- AppleScript
- Applesoft BASIC
- ARM Assembly
- AutoHotkey
- AWK
- BASIC256
- Befunge
- C
- C sharp
- C++
- Chipmunk Basic
- Clojure
- Common Lisp
- Crystal
- D
- Delphi
- EasyLang
- F Sharp
- Factor
- Fortran
- FreeBASIC
- FutureBasic
- Go
- Groovy
- Haskell
- J
- Java
- JavaScript
- Jq
- Julia
- Koka
- Kotlin
- Lua
- Mathematica
- Wolfram Language
- MiniScript
- Modula-2
- Nim
- OCaml
- Pascal
- Perl
- Ntheory
- Phix
- Picat
- PL/M
- PL/SQL
- Prolog
- Python
- R
- Racket
- Raku
- REXX
- Ruby
- Rust
- Scala
- Scheme
- Sidef
- Simula
- SQL PL
- Stata
- Tcl
- VBA
- Visual Basic .NET
- V (Vlang)
- Wren
- Wren-fmt
- X86 Assembly
- XPL0
- Yabasic
- Zig
- Zkl