Rosetta Code

4-rings or 4-squares puzzle: Difference between revisions

Page Discussion

4-rings or 4-squares puzzle (view source)

Revision as of 23:36, 25 August 2022

2,106 bytes added ,  1 year ago
m
syntax highlighting fixup automation
(Added PL/M)
m (syntax highlighting fixup automation)
Line 47:
{{trans|Python}}
 
<langsyntaxhighlight lang=11l>F foursquares(lo, hi, unique, show)
V solutions = 0
L(c) lo .. hi
Line 76:
foursquares(1, 7, 1B, 1B)
foursquares(3, 9, 1B, 1B)
foursquares(0, 9, 0B, 0B)</langsyntaxhighlight>
 
{{out}}
Line 101:
=={{header|AArch64 Assembly}}==
{{works with|as|Raspberry Pi 3B version Buster 64 bits}}
<langsyntaxhighlight lang=AArch64 Assembly>
/* ARM assembly AARCH64 Raspberry PI 3B */
/* program square4_64.s */
Line 504:
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 541:
 
=={{header|Ada}}==
<langsyntaxhighlight lang=Ada>with Ada.Text_IO;
 
procedure Puzzle_Square_4 is
Line 608:
Four_Rings (Low => 3, High => 9, Unique => True, Show => True);
Four_Rings (Low => 0, High => 9, Unique => False, Show => False);
end Puzzle_Square_4;</langsyntaxhighlight>
 
{{out}}
Line 632:
=={{header|ALGOL 68}}==
As with the REXX solution, we use explicit loops to generate the permutations.
<langsyntaxhighlight lang=algol68>BEGIN
# solve the 4 rings or 4 squares puzzle #
# we need to find solutions to the equations: a + b = b + c + d = d + e + f = f + g #
Line 710:
four rings( 3, 9, FALSE, TRUE );
four rings( 0, 9, TRUE, FALSE )
END</langsyntaxhighlight>
{{out}}
<pre>
Line 734:
=={{header|ALGOL W}}==
{{Trans|ALGOL 68}}
<langsyntaxhighlight lang=ada>begin % -- solve the 4 rings or 4 squares puzzle i.e., find solutions to the %
% -- equations: a + b = b + c + d = d + e + f = f + g %
% -- where a, b, c, d, e, f, g in lo : hi ( not necessarily unique ) %
Line 802:
fourRings( 3, 9, false, true );
fourRings( 0, 9, true, false )
end.</langsyntaxhighlight>
{{out}}
<pre>
Line 829:
{{Trans|Haskell}}
(Structured search example)
<langsyntaxhighlight lang=applescript>use framework "Foundation" -- for basic NSArray sort
 
on run
Line 1,135:
on unlines(xs)
intercalate(linefeed, xs)
end unlines</langsyntaxhighlight>
{{Out}}
<pre>rings(true, enumFromTo(1, 7))
Line 1,161:
=={{header|Applesoft BASIC}}==
{{trans|C}}
<langsyntaxhighlight lang=gwbasic> 100 TRUE = NOT FALSE
110 PLO = 1:PHI = 7:PUNIQUE = TRUE:PSHOW = TRUE: GOSUB 150"FOURSQUARES"
120 PLO = 3:PHI = 9:PUNIQUE = TRUE:PSHOW = TRUE: GOSUB 150"FOURSQUARES"
Line 1,192:
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</langsyntaxhighlight>
=={{header|ARM Assembly}}==
{{works with|as|Raspberry Pi}}
<langsyntaxhighlight lang=ARM Assembly>
 
/* ARM assembly Raspberry PI */
Line 1,634:
iMagicNumber: .int 0xCCCCCCCD
 
</syntaxhighlight>
</lang>
{{out}}
 
Line 1,683:
 
=={{header|AWK}}==
<langsyntaxhighlight lang=AWK>
# syntax: GAWK -f 4-RINGS_OR_4-SQUARES_PUZZLE.AWK
# converted from C
Line 1,750:
}
}
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 1,784:
This is loosely based on the [[4-rings_or_4-squares_puzzle#C|C]] algorithm, although many of the conditions have been combined to minimize branching. There is no option to choose whether the results are displayed or not - unique solutions are always displayed, and non-unique solutions just return the solution count.
 
<langsyntaxhighlight lang=befunge>550" :woL">:#,_&>00p" :hgiH">:#,_&>1+10p" :)n/y( euqinU">:#,_>~>:4v
v!g03!:\*`\g01\!`\g00:p05:+g03:p04:_$30g1+:10g\`v1g<,+$p02%2_|#`*8<
>>+\30g-!+20g*!*00g\#v_$40g1+:10g\`^<<1g00p03<<<_$55+:,\."snoitul"v
Line 1,791:
>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^^></langsyntaxhighlight>
 
{{out}}
Line 1,829:
 
=={{header|C}}==
<syntaxhighlight lang=C>
<lang C>
#include <stdio.h>
 
Line 1,913:
foursquares(0,9,FALSE,FALSE);
}
</syntaxhighlight>
</lang>
Output
<pre>
Line 1,941:
=={{header|C sharp|C#}}==
{{trans|Java}}
<langsyntaxhighlight lang=csharp>using System;
using System.Linq;
 
Line 2,002:
}
}
}</langsyntaxhighlight>
{{out}}
<pre>a b c d e f g
Line 2,023:
 
=={{header|C++}}==
<langsyntaxhighlight lang=cpp>
//C++14/17
#include <algorithm>//std::for_each
Line 2,117:
return 0;
}
</syntaxhighlight>
</lang>
Output
<pre>
Line 2,141:
 
=={{header|Clojure}}==
<langsyntaxhighlight lang=clojure>(use '[clojure.math.combinatorics]
 
(defn rings [r & {:keys [unique] :or {unique true}}]
Line 2,151:
(for [[a b c d e f g] (rings (range low (inc high)) :unique unique)
:when (= (+ a b) (+ b c d) (+ d e f) (+ f g))] [a b c d e f g]))
</syntaxhighlight>
</lang>
 
{{out}}
Line 2,175:
 
=={{header|Common Lisp}}==
<langsyntaxhighlight lang=lisp>
(defpackage four-rings
(:use common-lisp)
Line 2,211:
(format t "Number of solutions for Low 0, High 9 non-unique:~%~A~%"
(length (four-rings-solutions 0 9 nil)))))
</syntaxhighlight>
</lang>
Output:
<pre>
Line 2,240:
=={{header|Crystal}}==
{{trans|Ruby}}
<langsyntaxhighlight lang=ruby>def check(list)
a, b, c, d, e, f, g = list
first = a + b
Line 2,266:
four_squares(low, high)
end
four_squares(0, 9, false)</langsyntaxhighlight>
 
=={{header|D}}==
<langsyntaxhighlight lang=D>import std.stdio;
 
void main() {
Line 2,331:
}
return true;
}</langsyntaxhighlight>
 
{{out}}
Line 2,354:
See [[#Pascal]]
=={{header|F_Sharp|F#}}==
<langsyntaxhighlight lang=fsharp>
(* A simple function to generate the sequence
Nigel Galloway: January 31st., 2017 *)
Line 2,362:
seq{for a in n .. g do for b in n .. g do if (a+b) = x then for c in n .. g do if (b+c+d) = x then yield b} |> Seq.collect(fun b ->
seq{for f in n .. g do for G in n .. g do if (f+G) = x then for e in n .. g do if (f+e+d) = x then yield f} |> Seq.map(fun f -> {d=d;x=x;b=b;f=f}))))
</syntaxhighlight>
</lang>
Then:
<langsyntaxhighlight lang=fsharp>
printfn "%d" (Seq.length (N 0 9))
</syntaxhighlight>
</lang>
{{out}}
<pre>
2860
</pre>
<langsyntaxhighlight lang=fsharp>
(* A simple function to generate the sequence with unique values
Nigel Galloway: January 31st., 2017 *)
Line 2,379:
seq{for a in n .. g do if a <> d then for b in n .. g do if (a+b) = x && b <> a && b <> d then for c in n .. g do if (b+c+d) = x && c <> d && c <> a && c <> b then yield b} |> Seq.collect(fun b ->
seq{for f in n .. g do if f <> d && f <> b && f <> (x-b) && f <> (x-d-b) then for G in n .. g do if (f+G) = x && G <> d && G <> b && G <> f && G <> (x-b) && G <> (x-d-b) then for e in n .. g do if (f+e+d) = x && e <> d && e <> b && e <> f && e <> G && e <> (x-b) && e <> (x-d-b) then yield f} |> Seq.map(fun f -> {d=d;x=x;b=b;f=f}))))
</syntaxhighlight>
</lang>
Then:
<langsyntaxhighlight lang=fsharp>
for n in N 1 7 do printfn "%d,%d,%d,%d,%d,%d,%d" (n.x-n.b) n.b (n.x-n.d-n.b) n.d (n.x-n.d-n.f) n.f (n.x-n.f)
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 2,396:
</pre>
and:
<langsyntaxhighlight lang=fsharp>
for n in N 3 9 do printfn "%d,%d,%d,%d,%d,%d,%d" (n.x-n.b) n.b (n.x-n.d-n.b) n.d (n.x-n.d-n.f) n.f (n.x-n.f)
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 2,411:
 
<code>bag-of</code> is a combinator (higher-order function) that yields <i>every</i> solution in a collection. If we had written <code>4-rings</code> without using <code>bag-of</code>, it would have returned only the first solution it found.
<langsyntaxhighlight lang=factor>USING: arrays backtrack formatting grouping kernel locals math
math.ranges prettyprint sequences sequences.generalizations
sets ;
Line 2,435:
1 7 t report
3 9 t report
0 9 f report</langsyntaxhighlight>
{{out}}
<pre>
Line 2,464:
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 <langsyntaxhighlight lang=Fortran>WRITE(...) FIRST,LAST,IF (UNIQUE) THEN "Distinct values only" ELSE "Repeated values allowed" FI // "."</langsyntaxhighlight> 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. <langsyntaxhighlight lang=Fortran> SUBROUTINE FOURSHOW(FIRST,LAST,UNIQUE) !The "Four Rings" or "Four Squares" puzzle.
Choose values such that A+B = B+C+D = D+E+F = F+G, all being integers in FIRST:LAST...
INTEGER FIRST,LAST !The range of allowed values.
Line 2,513:
CALL FOURSHOW(0,9,.FALSE.)
 
END </langsyntaxhighlight>
Output: not in a neat order because the first variable is not determined first.
<pre>
Line 2,589:
 
=={{header|FreeBASIC}}==
<langsyntaxhighlight lang=freebasic>' version 18-03-2017
' compile with: fbc -s console
 
Line 2,679:
Print : Print "hit any key to end program"
Sleep
End</langsyntaxhighlight>
{{out}}
<pre> a b c d e f g
Line 2,712:
=={{header|FutureBasic}}==
This simple example uses old-style, length-limited Pascal strings for formatting to make it easier to compare with similar code posted here for this task. However, FB more commonly uses Apple's modern and superior Core Foundation strings.
<langsyntaxhighlight lang=futurebasic>
local fn FourRings( low as long, high as long, unique as BOOL, show as BOOL )
long a, b, c, d, e, f, g
Line 2,790:
 
HandleEvents
</syntaxhighlight>
</lang>
{{output}}
<pre style="font-size: 13px">
Line 2,822:
 
=={{header|Go}}==
<langsyntaxhighlight lang=go>package main
 
import "fmt"
Line 2,878:
return square1 == square2 && square2 == square3 && square3 == square4
}
</syntaxhighlight>
</lang>
{{Out}}
<pre>
Line 2,890:
=={{header|Groovy}}==
{{trans|Java}}
<langsyntaxhighlight lang=groovy>class FourRings {
static void main(String[] args) {
fourSquare(1, 7, true, true)
Line 2,945:
return unique && Arrays.stream(haystack).anyMatch({ p -> p == needle })
}
}</langsyntaxhighlight>
{{out}}
<pre>a b c d e f g
Line 2,967:
=={{header|Haskell}}==
====By exhaustive search====
<langsyntaxhighlight lang=haskell>import Data.List
import Control.Monad
 
Line 3,007:
fourRings 1 7 False True
fourRings 3 9 False True
fourRings 0 9 True False</langsyntaxhighlight>
 
{{out}}
Line 3,039:
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.
<langsyntaxhighlight lang=haskell>import Data.List (delete, sortBy, (\\))
 
--------------- 4 RINGS OR 4 SQUARES PUZZLE --------------
Line 3,139:
( "length (rings False [0 .. 9])",
[length (rings False [0 .. 9])]
)</langsyntaxhighlight>
{{Out}}
<pre>rings True [1 .. 7]
Line 3,167:
Implementation for the unique version of the puzzle:
 
<langsyntaxhighlight lang=J>fspuz=:dyad define
range=: x+i.1+y-x
lo=. 6+3*x
Line 3,185:
end.
end.
)</langsyntaxhighlight>
 
Implementation for the non-unique version of the puzzle:
 
<langsyntaxhighlight lang=J>fspuz2=:dyad define
range=: x+i.1+y-x
lo=. 3*x
Line 3,205:
end.
end.
)</langsyntaxhighlight>
 
Task examples:
 
<langsyntaxhighlight lang=J> 1 fspuz 7
4 5 3 1 6 2 7
7 2 6 1 3 5 4
Line 3,224:
9 6 5 4 3 8 7
#0 fspuz2 9
2860</langsyntaxhighlight>
 
=={{header|Java}}==
Uses java 8 features.
<langsyntaxhighlight lang=Java>import java.util.Arrays;
 
public class FourSquares {
Line 3,285:
return unique && Arrays.stream(haystack).anyMatch(p -> p == needle);
}
}</langsyntaxhighlight>
{{out}}
<pre>a b c d e f g
Line 3,308:
===ES6===
{{Trans|Haskell}} (Structured search version)
<langsyntaxhighlight lang=javascript>(() => {
"use strict";
 
Line 3,478:
// MAIN ---
return main();
})();</langsyntaxhighlight>
{{Out}}
<pre>rings(true, enumFromTo(1,7))
Line 3,521:
 
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.
<langsyntaxhighlight lang=jq># Generate a stream of all the permutations of the input array
def permutations:
if length == 0 then []
Line 3,560:
;
 
tasks</langsyntaxhighlight>
{{out}}
<pre>
Line 3,593:
[[0,1], [1,2,3], [3,4,5], [5,6]].
 
<langsyntaxhighlight lang=jq># rings/3 assumes that each box (except for the last) has exactly one overlap with its successor.
# Input: ignored.
# Output: a stream of solutions, i.e. a stream of arrays.
Line 3,647:
| solve($bx; .[-1]; add) ;
 
def count(s): reduce s as $x (null; .+1);</langsyntaxhighlight>
'''The specific task'''
<langsyntaxhighlight lang=jq># a=0, b=1, etc
def boxes: [[0,1], [1,2,3], [3,4,5], [5,6]];
 
count(rings(boxes; 0; 9))</langsyntaxhighlight>
{{out}}
<pre>
Line 3,660:
=={{header|Julia}}==
{{Trans|Python}}
<langsyntaxhighlight lang=julia>
using Combinatorics
 
Line 3,683:
foursquares(3, 9, true, true)
foursquares(0, 9, false, false)
</syntaxhighlight>
</lang>
{{output}}
<pre>
Line 3,705:
=={{header|Kotlin}}==
{{trans|C}}
<langsyntaxhighlight lang=scala>// version 1.1.2
 
class FourSquares(
Line 3,777:
FourSquares(3, 9, true, true)
FourSquares(0, 9, false, false)
}</langsyntaxhighlight>
 
{{out}}
Line 3,809:
=={{header|Lua}}==
{{trans|D}}
<langsyntaxhighlight lang=lua>function valid(unique,needle,haystack)
if unique then
for _,value in pairs(haystack) do
Line 3,865:
fourSquare(1,7,true,true)
fourSquare(3,9,true,true)
fourSquare(0,9,false,false)</langsyntaxhighlight>
{{out}}
<pre>a b c d e f g
Line 3,886:
 
=={{header|Mathematica}}/{{header|Wolfram Language}}==
<langsyntaxhighlight lang=Mathematica>{low, high} = {1, 7};
SolveValues[{a + b == b + c + d == d + e + f == f + g, low <= a <= high,
low <= b <= high, low <= c <= high, low <= d <= high,
Line 3,902:
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</langsyntaxhighlight>
{{out}}
<pre>{{3, 7, 2, 1, 5, 4, 6}, {4, 5, 3, 1, 6, 2, 7}, {4, 7, 1, 3, 2, 6,
Line 3,914:
 
=={{header|Modula-2}}==
<langsyntaxhighlight lang=modula2>MODULE FourSquare;
FROM Conversions IMPORT IntToStr;
FROM Terminal IMPORT *;
Line 4,007:
four_square(0,9,FALSE,FALSE);
ReadChar; (* Wait so results can be viewed. *)
END FourSquare.</langsyntaxhighlight>
 
=={{header|Nim}}==
Adapted from Rust version.
<langsyntaxhighlight lang=nim>func isUnique(a, b, c, d, e, f, g: uint8): bool =
a != b and a != c and a != d and a != e and a != f and a != g and
b != c and b != d and b != e and b != f and b != g and
Line 4,048:
printFourSquares(1, 7)
printFourSquares(3, 9)
printFourSquares(0, 9, unique = false)</langsyntaxhighlight>
{{out}}
<pre>[3, 7, 2, 1, 5, 4, 6]
Line 4,071:
{{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.
<langsyntaxhighlight lang=pascal>program square4;
{$MODE DELPHI}
{$R+,O+}
Line 4,185:
writeln(' solution count for ',loDgt,' to ',HiDgt,' = ',cnt);
writeln('unique solution count for ',loDgt,' to ',HiDgt,' = ',uniqueCount);
end.</langsyntaxhighlight>
{{Out}}
<pre>
Line 4,226:
Relying on the modules <code>ntheory</code> and <code>Set::CrossProduct</code> to generate the tuples needed. Both are supply results via iterators, particularly important in the latter case, to avoid gobbling too much memory.
{{libheader|ntheory}}
<langsyntaxhighlight lang=perl>use ntheory qw/forperm/;
use Set::CrossProduct;
 
Line 4,271:
display four_sq_permute( [3..9] );
display four_sq_permute( [8, 9, 11, 12, 17, 18, 20, 21] );
four_sq_cartesian( [0..9] );</langsyntaxhighlight>
{{out}}
<pre>8 unique solutions found using: 1, 2, 3, 4, 5, 6, 7
Line 4,304:
2860 non-unique solutions found using: 0, 1, 2, 3, 4, 5, 6, 7, 8, 9</pre>
===With Recursion===
<langsyntaxhighlight lang=perl>#!/usr/bin/perl
 
use strict; # https://rosettacode.org/wiki/4-rings_or_4-squares_puzzle
Line 4,337:
elsif( @_ == 7 ) { $_[3] + $_[4] == $_[6] and $count++; return }
findcount( @_, $_ ) for 0 .. 9;
}</langsyntaxhighlight>
{{out}}
<pre>
Line 4,362:
 
=={{header|Phix}}==
<!--<langsyntaxhighlight lang=Phix>(phixonline)-->
<span style="color: #000080;font-style:italic;">-- demo/rosetta/4_rings_or_4_squares_puzzle.exw</span>
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
Line 4,407:
<span style="color: #000000;">foursquares</span><span style="color: #0000FF;">(</span><span style="color: #000000;">3</span><span style="color: #0000FF;">,</span><span style="color: #000000;">9</span><span style="color: #0000FF;">,</span><span style="color: #004600;">true</span><span style="color: #0000FF;">,</span><span style="color: #004600;">true</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">foursquares</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">9</span><span style="color: #0000FF;">,</span><span style="color: #004600;">false</span><span style="color: #0000FF;">,</span><span style="color: #004600;">false</span><span style="color: #0000FF;">)</span>
<!--</langsyntaxhighlight>-->
{{out}}
<pre>
Line 4,428:
 
=={{header|Picat}}==
<langsyntaxhighlight lang=Picat>import cp.
 
main =>
Line 4,458:
% 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).</langsyntaxhighlight>
 
{{out}}
Line 4,482:
{{Trans|ALGOL 68}}
{{works with|8080 PL/M Compiler}} ... under CP/M (or an emulator)
<langsyntaxhighlight lang=pli>100H: /* SOLVE THE 4 RINGS OR 4 SQUARES PUZZLE */
 
DECLARE FALSE LITERALLY '0';
Line 4,579:
CALL FOUR$RINGS( 3, 9, FALSE, TRUE );
CALL FOUR$RINGS( 0, 9, TRUE, FALSE );
EOF</langsyntaxhighlight>
{{out}}
<pre>
Line 4,604:
=={{header|PL/SQL}}==
{{works with|Oracle}}
<langsyntaxhighlight lang=plsql>
create table allints (v number);
create table results
Line 4,736:
end;
/
</syntaxhighlight>
</lang>
Output
<pre>
Line 4,769:
=={{header|Prolog}}==
Works with SWI-Prolog 7.5.8
<langsyntaxhighlight lang=Prolog>
:- use_module(library(clpfd)).
 
Line 4,793:
my_sum(Min, Max, 1, LL),
length(LL, Len).
</syntaxhighlight>
</lang>
Output
<pre>
Line 4,821:
===Procedural===
====Itertools====
<langsyntaxhighlight lang=Python>import itertools
 
def all_equal(a,b,c,d,e,f,g):
Line 4,843:
 
print str(solutions)+" "+uorn+" solutions in "+str(lo)+" to "+str(hi)
print</langsyntaxhighlight>
Output
<pre>foursquares(1,7,True,True)
Line 4,870:
====Generators====
Faster solution without itertools
<langsyntaxhighlight lang=Python>
def foursquares(lo,hi,unique,show):
 
Line 4,935:
print str(solutions)+" "+uorn+" solutions in "+str(lo)+" to "+str(hi)
print</langsyntaxhighlight>
Output<pre>
foursquares(1,7,True,True)
Line 4,964:
{{Trans|JavaScript}}
{{Works with|Python|3.7}}
<langsyntaxhighlight lang=python>'''4-rings or 4-squares puzzle'''
 
from itertools import chain
Line 5,109:
# MAIN ---
if __name__ == '__main__':
main()</langsyntaxhighlight>
{{Out}}
<pre>Testing unique digits [1..7], [3..9] and unrestricted digits:
Line 5,138:
=={{header|R}}==
Function "perms" is a modified version of the "permutations" function from the "gtools" R package.
<langsyntaxhighlight lang=R># 4 rings or 4 squares puzzle
 
perms <- function (n, r, v = 1:n, repeats.allowed = FALSE) {
Line 5,198:
print_perms(10, 7, v = 0:9, repeats.allowed = TRUE, table.out = FALSE)
 
</syntaxhighlight>
</lang>
{{Out}}
<pre>
Line 5,226:
Using a folder, so we can count as well as produce lists of results
 
<langsyntaxhighlight lang=racket>#lang racket
 
(define solution? (match-lambda [(list a b c d e f g) (= (+ a b) (+ b c d) (+ d e f) (+ f g))]))
Line 5,239:
(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)</langsyntaxhighlight>
 
{{out}}
Line 5,251:
{{works with|Rakudo|2016.12}}
 
<langsyntaxhighlight lang=perl6>sub four-squares ( @list, :$unique=1, :$show=1 ) {
 
my @solutions;
Line 5,278:
four-squares( [3..9] );
four-squares( [8, 9, 11, 12, 17, 18, 20, 21] );
four-squares( [0..9], :unique(0), :show(0) );</langsyntaxhighlight>
 
{{out}}
Line 5,324:
This REXX version is faster than the more idiomatic version, but is longer (statement-wise) and
<br>a bit easier to read (visualize).
<langsyntaxhighlight lang=rexx>/*REXX pgm solves the 4-rings puzzle, where letters represent unique (or not) digits). */
arg LO HI unique show . /*the ARG statement capitalizes args.*/
if LO=='' | LO=="," then LO=1 /*Not specified? Then use the default.*/
Line 5,393:
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</langsyntaxhighlight>
{{out|output|text=&nbsp; when using the default inputs: &nbsp; <tt> &nbsp; 1 &nbsp; 7 </tt>}}
<pre>
Line 5,430:
Note that the REXX language doesn't have short-circuits &nbsp; (when executing multiple clauses
in &nbsp; <big> '''if''' </big> &nbsp; (and other) &nbsp; statements.
<langsyntaxhighlight lang=rexx>/*REXX pgm solves the 4-rings puzzle, where letters represent unique (or not) digits). */
arg LO HI unique show . /*the ARG statement capitalizes args.*/
if LO=='' | LO=="," then LO=1 /*Not specified? Then use the default.*/
Line 5,471:
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</langsyntaxhighlight>
{{out|output|text=&nbsp; is identical to the faster REXX version.}} <br><br>
 
=={{header|Ruby}}==
<langsyntaxhighlight lang=ruby>def four_squares(low, high, unique=true, show=unique)
f = -> (a,b,c,d,e,f,g) {[a+b, b+c+d, d+e+f, f+g].uniq.size == 1}
if unique
Line 5,495:
four_squares(low, high)
end
four_squares(0, 9, false)</langsyntaxhighlight>
 
{{out}}
Line 5,521:
 
=={{header|Rust}}==
<langsyntaxhighlight lang=rust>
#![feature(inclusive_range_syntax)]
 
Line 5,596:
nonuniques(0, 9);
}
</syntaxhighlight>
</lang>
{{Out}}
<pre>
Line 5,620:
=={{header|Scala}}==
{{trans|Java}}
<langsyntaxhighlight lang=scala>object FourRings {
def fourSquare(low: Int, high: Int, unique: Boolean, print: Boolean): Unit = {
Line 5,650:
fourSquare(0, 9, unique = false, print = false)
}
}</langsyntaxhighlight>
{{out}}
<pre>a b c d e f g
Line 5,672:
=={{header|Scheme}}==
 
<langsyntaxhighlight lang=scheme>
(import (scheme base)
(scheme write)
Line 5,720:
(display (count (lambda (combination) (apply solution? combination))
(combinations 7 (iota 10 0) #f))) (newline)
</syntaxhighlight>
</lang>
 
{{out}}
Line 5,734:
=={{header|Sidef}}==
{{trans|Raku}}
<langsyntaxhighlight lang=ruby>func four_squares (list, unique=true, show=true) {
 
var solutions = []
Line 5,776:
four_squares(@(3..9))
four_squares([8, 9, 11, 12, 17, 18, 20, 21])
four_squares(@(0..9), unique: false, show: false)</langsyntaxhighlight>
{{out}}
<pre>
Line 5,815:
 
=={{header|Simula}}==
<langsyntaxhighlight lang=modula2>BEGIN
 
INTEGER PROCEDURE GETCOMBS(LOW, HIGH, UNIQUE, COMBS);
Line 5,929:
 
END.
</syntaxhighlight>
</lang>
{{out}}
<pre>8 UNIQUE SOLUTIONS IN 1 TO 7
Line 5,951:
{{works with|Db2 LUW}} version 9.7 or higher.
With SQL PL:
<langsyntaxhighlight lang=sql pl>
--#SET TERMINATOR @
 
Line 6,067:
CALL FOUR_SQUARES(3, 9, 0, 0)@
CALL FOUR_SQUARES(0, 9, 1, 1)@
</syntaxhighlight>
</lang>
Output:
<pre>
Line 6,116:
Use the program '''perm''' in the [[Permutations]] task for the first two questions, as it's fast enough. Use '''joinby''' for the third.
 
<langsyntaxhighlight lang=stata>perm 7
rename * (a b c d e f g)
list if a==c+d & b+c==e+f & d+e==g, noobs sep(50)
Line 6,167:
erase temp.dta
count
2,860</langsyntaxhighlight>
 
=={{header|Tcl}}==
Line 6,176:
The puzzle can be varied freely by changing the values of <tt>$vars</tt> and <tt>$exprs</tt> specified at the top of the script.
 
<langsyntaxhighlight lang=Tcl>set vars {a b c d e f g}
set exprs {
{$a+$b}
Line 6,250:
solve_4rings $vars $exprs [range 3 9]
puts "# Number of solutions, free over 0..9:"
puts [solve_4rings_hard $vars $exprs [range 0 9]]</langsyntaxhighlight>
 
{{out}}
Line 6,272:
=={{header|VBA}}==
{{trans|C}}
<langsyntaxhighlight lang=vb>Dim a As Integer, b As Integer, c As Integer, d As Integer
Dim e As Integer, f As Integer, g As Integer
Dim lo As Integer, hi As Integer, unique As Boolean, show As Boolean
Line 6,335:
Call foursquares(0, 9, False, False)
End Sub
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 6,361:
=={{header|Visual Basic .NET}}==
Similar to the other brute-force algorithims, but with a couple of enhancements. A "used" list is maintained to simplify checking of the nested variables overlap. Also the ''d'', ''f'' and ''g'' '''For Each''' loops are constrained by the other variables instead of blindly going through all combinations.
<langsyntaxhighlight lang=vbnet>Module Module1
 
Dim CA As Char() = "0123456789ABC".ToCharArray()
Line 6,406:
End Sub
 
End Module</langsyntaxhighlight>
{{out}}
Added the zkl example for [5,12]<pre>a b c d e f g
Line 6,440:
=={{header|Vlang}}==
{{trans|Go}}
<langsyntaxhighlight lang=vlang>fn main(){
mut n, mut c := get_combs(1,7,true)
println("$n unique solutions in 1 to 7")
Line 6,493:
square4 := f + g
return square1 == square2 && square2 == square3 && square3 == square4
}</langsyntaxhighlight>
 
{{out}}
Line 6,507:
{{trans|C}}
{{libheader|Wren-fmt}}
<langsyntaxhighlight lang=ecmascript>import "/fmt" for Fmt
 
var a = 0
Line 6,585:
foursquares.call(1, 7, true, true)
foursquares.call(3, 9, true, true)
foursquares.call(0, 9, false, false)</langsyntaxhighlight>
 
{{out}}
Line 6,618:
 
=={{header|XPL0}}==
<langsyntaxhighlight lang=XPL0>int Show, Low, High, Digit(7\a..g\), Count;
proc Rings(Level);
int Level; \of recursion
Line 6,657:
IntOut(0, Count);
CrLf(0);
]</langsyntaxhighlight>
 
{{out}}
Line 6,680:
=={{header|Yabasic}}==
{{trans|D}}
<langsyntaxhighlight lang=Yabasic>fourSquare(1,7,true,true)
fourSquare(3,9,true,true)
fourSquare(0,9,false,false)
Line 6,743:
end if
return true
end sub</langsyntaxhighlight>
{{out}}
<pre>a b c d e f g
Line 6,764:
 
=={{header|zkl}}==
<langsyntaxhighlight lang=zkl> // unique: No repeated numbers in solution
fcn fourSquaresPuzzle(lo=1,hi=7,unique=True){ //-->list of solutions
_assert_(0<=lo and hi<36);
Line 6,783:
}
s
}</langsyntaxhighlight>
<langsyntaxhighlight lang=zkl>fcn show(solutions,msg){
if(not solutions){ println("No solutions for",msg); return(); }
 
Line 6,798:
fourSquaresPuzzle(5,12) : show(_," unique (5-12)"); println();
println(fourSquaresPuzzle(0,9,False).len(), // 10^7 possibilities
" non-unique (0-9) solutions found.");</langsyntaxhighlight>
{{out}}
<pre>
Thundergnat
10,333

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/326958"