4-rings or 4-squares puzzle

From Rosetta Code


Task
4-rings or 4-squares puzzle
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[edit]

Translation of: Python
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[edit]

Works with: as version Raspberry Pi 3B version Buster 64 bits
/* 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![edit]

Translation of: ALGOL 68
;;; 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[edit]

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[edit]

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[edit]

Translation of: ALGOL 68
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[edit]

Translation of: JavaScript
Translation of: Haskell

(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[edit]

Translation of: C
 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[edit]

Works with: as version Raspberry Pi
/* 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

AWK[edit]

# 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

Befunge[edit]

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[edit]

#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#[edit]

Translation of: Java
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++[edit]

//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.

Clojure[edit]

(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[edit]

(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[edit]

Translation of: 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)

D[edit]

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[edit]

See #Pascal

F#[edit]

(* 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[edit]

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[edit]

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[edit]

' 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[edit]

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[edit]

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[edit]

Translation of: Java
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[edit]

By exhaustive search[edit]

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[edit]

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:

  1. 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.
  2. 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[edit]

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[edit]

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[edit]

ES6[edit]

Translation of: Haskell
(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[edit]

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[edit]

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[edit]

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[edit]

Translation of: Python
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

Kotlin[edit]

Translation of: C
// 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[edit]

Translation of: D
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[edit]

{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

Modula-2[edit]

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[edit]

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[edit]

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[edit]

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.

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[edit]

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.

Library: ntheory
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[edit]

#!/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[edit]

-- 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[edit]

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[edit]

Translation of: ALGOL 68
Works with: 8080 PL/M Compiler
... 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[edit]

Works with: Oracle
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[edit]

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[edit]

Procedural[edit]

Itertools[edit]

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[edit]

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[edit]

Translation of: Haskell
Translation of: JavaScript
Works with: Python version 3.7
'''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[edit]

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[edit]

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[edit]

(formerly Perl 6)

Works with: Rakudo version 2016.12
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[edit]

fast version[edit]

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[edit]

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[edit]

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[edit]

#![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[edit]

Translation of: Java
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[edit]

(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[edit]

Translation of: Raku
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[edit]

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[edit]

Works with: Db2 LUW
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[edit]

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[edit]

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[edit]

Translation of: C
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[edit]

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)[edit]

Translation of: Go
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[edit]

Translation of: C
Library: Wren-fmt
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[edit]

See 4-rings_or_4-squares_puzzle/X86 Assembly

XPL0[edit]

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[edit]

Translation of: D
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]

zkl[edit]

    // 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.