Rosetta Code

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

Page Discussion

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

Revision as of 20:04, 29 August 2022

200 bytes added ,  1 year ago
m
Automated syntax highlighting fixup (second round - minor fixes)
m (syntax highlighting fixup automation)
m (Automated syntax highlighting fixup (second round - minor fixes))
Line 47:
{{trans|Python}}
 
<syntaxhighlight lang="11l">F foursquares(lo, hi, unique, show)
V solutions = 0
L(c) lo .. hi
Line 101:
=={{header|AArch64 Assembly}}==
{{works with|as|Raspberry Pi 3B version Buster 64 bits}}
<syntaxhighlight lang=AArch64"aarch64 Assemblyassembly">
/* ARM assembly AARCH64 Raspberry PI 3B */
/* program square4_64.s */
Line 541:
 
=={{header|Ada}}==
<syntaxhighlight lang=Ada"ada">with Ada.Text_IO;
 
procedure Puzzle_Square_4 is
Line 632:
=={{header|ALGOL 68}}==
As with the REXX solution, we use explicit loops to generate the permutations.
<syntaxhighlight lang="algol68">BEGIN
# solve the 4 rings or 4 squares puzzle #
# we need to find solutions to the equations: a + b = b + c + d = d + e + f = f + g #
Line 734:
=={{header|ALGOL W}}==
{{Trans|ALGOL 68}}
<syntaxhighlight lang="ada">begin % -- solve the 4 rings or 4 squares puzzle i.e., find solutions to the %
% -- equations: a + b = b + c + d = d + e + f = f + g %
% -- where a, b, c, d, e, f, g in lo : hi ( not necessarily unique ) %
Line 829:
{{Trans|Haskell}}
(Structured search example)
<syntaxhighlight lang="applescript">use framework "Foundation" -- for basic NSArray sort
 
on run
Line 1,161:
=={{header|Applesoft BASIC}}==
{{trans|C}}
<syntaxhighlight lang="gwbasic"> 100 TRUE = NOT FALSE
110 PLO = 1:PHI = 7:PUNIQUE = TRUE:PSHOW = TRUE: GOSUB 150"FOURSQUARES"
120 PLO = 3:PHI = 9:PUNIQUE = TRUE:PSHOW = TRUE: GOSUB 150"FOURSQUARES"
Line 1,195:
=={{header|ARM Assembly}}==
{{works with|as|Raspberry Pi}}
<syntaxhighlight lang=ARM"arm Assemblyassembly">
 
/* ARM assembly Raspberry PI */
Line 1,683:
 
=={{header|AWK}}==
<syntaxhighlight lang=AWK"awk">
# syntax: GAWK -f 4-RINGS_OR_4-SQUARES_PUZZLE.AWK
# converted from C
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.
 
<syntaxhighlight lang="befunge">550" :woL">:#,_&>00p" :hgiH">:#,_&>1+10p" :)n/y( euqinU">:#,_>~>:4v
v!g03!:\*`\g01\!`\g00:p05:+g03:p04:_$30g1+:10g\`v1g<,+$p02%2_|#`*8<
>>+\30g-!+20g*!*00g\#v_$40g1+:10g\`^<<1g00p03<<<_$55+:,\."snoitul"v
Line 1,829:
 
=={{header|C}}==
<syntaxhighlight lang=C"c">
#include <stdio.h>
 
Line 1,941:
=={{header|C sharp|C#}}==
{{trans|Java}}
<syntaxhighlight lang="csharp">using System;
using System.Linq;
 
Line 2,023:
 
=={{header|C++}}==
<syntaxhighlight lang="cpp">
//C++14/17
#include <algorithm>//std::for_each
Line 2,141:
 
=={{header|Clojure}}==
<syntaxhighlight lang="clojure">(use '[clojure.math.combinatorics]
 
(defn rings [r & {:keys [unique] :or {unique true}}]
Line 2,175:
 
=={{header|Common Lisp}}==
<syntaxhighlight lang="lisp">
(defpackage four-rings
(:use common-lisp)
Line 2,240:
=={{header|Crystal}}==
{{trans|Ruby}}
<syntaxhighlight lang="ruby">def check(list)
a, b, c, d, e, f, g = list
first = a + b
Line 2,269:
 
=={{header|D}}==
<syntaxhighlight lang=D"d">import std.stdio;
 
void main() {
Line 2,354:
See [[#Pascal]]
=={{header|F_Sharp|F#}}==
<syntaxhighlight lang="fsharp">
(* A simple function to generate the sequence
Nigel Galloway: January 31st., 2017 *)
Line 2,364:
</syntaxhighlight>
Then:
<syntaxhighlight lang="fsharp">
printfn "%d" (Seq.length (N 0 9))
</syntaxhighlight>
Line 2,371:
2860
</pre>
<syntaxhighlight lang="fsharp">
(* A simple function to generate the sequence with unique values
Nigel Galloway: January 31st., 2017 *)
Line 2,381:
</syntaxhighlight>
Then:
<syntaxhighlight lang="fsharp">
for n in N 1 7 do printfn "%d,%d,%d,%d,%d,%d,%d" (n.x-n.b) n.b (n.x-n.d-n.b) n.d (n.x-n.d-n.f) n.f (n.x-n.f)
</syntaxhighlight>
Line 2,396:
</pre>
and:
<syntaxhighlight lang="fsharp">
for n in N 3 9 do printfn "%d,%d,%d,%d,%d,%d,%d" (n.x-n.b) n.b (n.x-n.d-n.b) n.d (n.x-n.d-n.f) n.f (n.x-n.f)
</syntaxhighlight>
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.
<syntaxhighlight lang="factor">USING: arrays backtrack formatting grouping kernel locals math
math.ranges prettyprint sequences sequences.generalizations
sets ;
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 <syntaxhighlight lang=Fortran"fortran">WRITE(...) FIRST,LAST,IF (UNIQUE) THEN "Distinct values only" ELSE "Repeated values allowed" FI // "."</syntaxhighlight> so that the correct alternative will be selected. Further, an array (that would hold those two texts) can't be indexed by a LOGICAL variable, and playing with EQUIVALENCE won't help, because the numerical values revealed thereby for .TRUE. and .FALSE. may not be 1 and 0. And anyway, parameters are not allowed to be accessed via EQUIVALENCE to another variable.
 
So, a two-part output, and to reduce the blather, two IF-statements. <syntaxhighlight lang=Fortran"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,589:
 
=={{header|FreeBASIC}}==
<syntaxhighlight lang="freebasic">' version 18-03-2017
' compile with: fbc -s console
 
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.
<syntaxhighlight lang="futurebasic">
local fn FourRings( low as long, high as long, unique as BOOL, show as BOOL )
long a, b, c, d, e, f, g
Line 2,822:
 
=={{header|Go}}==
<syntaxhighlight lang="go">package main
 
import "fmt"
Line 2,890:
=={{header|Groovy}}==
{{trans|Java}}
<syntaxhighlight lang="groovy">class FourRings {
static void main(String[] args) {
fourSquare(1, 7, true, true)
Line 2,967:
=={{header|Haskell}}==
====By exhaustive search====
<syntaxhighlight lang="haskell">import Data.List
import Control.Monad
 
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.
<syntaxhighlight lang="haskell">import Data.List (delete, sortBy, (\\))
 
--------------- 4 RINGS OR 4 SQUARES PUZZLE --------------
Line 3,167:
Implementation for the unique version of the puzzle:
 
<syntaxhighlight lang=J"j">fspuz=:dyad define
range=: x+i.1+y-x
lo=. 6+3*x
Line 3,189:
Implementation for the non-unique version of the puzzle:
 
<syntaxhighlight lang=J"j">fspuz2=:dyad define
range=: x+i.1+y-x
lo=. 3*x
Line 3,209:
Task examples:
 
<syntaxhighlight lang=J"j"> 1 fspuz 7
4 5 3 1 6 2 7
7 2 6 1 3 5 4
Line 3,228:
=={{header|Java}}==
Uses java 8 features.
<syntaxhighlight lang=Java"java">import java.util.Arrays;
 
public class FourSquares {
Line 3,308:
===ES6===
{{Trans|Haskell}} (Structured search version)
<syntaxhighlight lang="javascript">(() => {
"use strict";
 
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.
<syntaxhighlight lang="jq"># Generate a stream of all the permutations of the input array
def permutations:
if length == 0 then []
Line 3,593:
[[0,1], [1,2,3], [3,4,5], [5,6]].
 
<syntaxhighlight lang="jq"># rings/3 assumes that each box (except for the last) has exactly one overlap with its successor.
# Input: ignored.
# Output: a stream of solutions, i.e. a stream of arrays.
Line 3,649:
def count(s): reduce s as $x (null; .+1);</syntaxhighlight>
'''The specific task'''
<syntaxhighlight lang="jq"># a=0, b=1, etc
def boxes: [[0,1], [1,2,3], [3,4,5], [5,6]];
 
Line 3,660:
=={{header|Julia}}==
{{Trans|Python}}
<syntaxhighlight lang="julia">
using Combinatorics
 
Line 3,705:
=={{header|Kotlin}}==
{{trans|C}}
<syntaxhighlight lang="scala">// version 1.1.2
 
class FourSquares(
Line 3,809:
=={{header|Lua}}==
{{trans|D}}
<syntaxhighlight lang="lua">function valid(unique,needle,haystack)
if unique then
for _,value in pairs(haystack) do
Line 3,886:
 
=={{header|Mathematica}}/{{header|Wolfram Language}}==
<syntaxhighlight lang=Mathematica"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,914:
 
=={{header|Modula-2}}==
<syntaxhighlight lang="modula2">MODULE FourSquare;
FROM Conversions IMPORT IntToStr;
FROM Terminal IMPORT *;
Line 4,011:
=={{header|Nim}}==
Adapted from Rust version.
<syntaxhighlight lang="nim">func isUnique(a, b, c, d, e, f, g: uint8): bool =
a != b and a != c and a != d and a != e and a != f and a != g and
b != c and b != d and b != e and b != f and b != g and
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.
<syntaxhighlight lang="pascal">program square4;
{$MODE DELPHI}
{$R+,O+}
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}}
<syntaxhighlight lang="perl">use ntheory qw/forperm/;
use Set::CrossProduct;
 
Line 4,304:
2860 non-unique solutions found using: 0, 1, 2, 3, 4, 5, 6, 7, 8, 9</pre>
===With Recursion===
<syntaxhighlight lang="perl">#!/usr/bin/perl
 
use strict; # https://rosettacode.org/wiki/4-rings_or_4-squares_puzzle
Line 4,362:
 
=={{header|Phix}}==
<!--<syntaxhighlight lang=Phix"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,428:
 
=={{header|Picat}}==
<syntaxhighlight lang=Picat"picat">import cp.
 
main =>
Line 4,482:
{{Trans|ALGOL 68}}
{{works with|8080 PL/M Compiler}} ... under CP/M (or an emulator)
<syntaxhighlight lang="pli">100H: /* SOLVE THE 4 RINGS OR 4 SQUARES PUZZLE */
 
DECLARE FALSE LITERALLY '0';
Line 4,604:
=={{header|PL/SQL}}==
{{works with|Oracle}}
<syntaxhighlight lang="plsql">
create table allints (v number);
create table results
Line 4,769:
=={{header|Prolog}}==
Works with SWI-Prolog 7.5.8
<syntaxhighlight lang=Prolog"prolog">
:- use_module(library(clpfd)).
 
Line 4,821:
===Procedural===
====Itertools====
<syntaxhighlight lang=Python"python">import itertools
 
def all_equal(a,b,c,d,e,f,g):
Line 4,870:
====Generators====
Faster solution without itertools
<syntaxhighlight lang=Python"python">
def foursquares(lo,hi,unique,show):
 
Line 4,964:
{{Trans|JavaScript}}
{{Works with|Python|3.7}}
<syntaxhighlight lang="python">'''4-rings or 4-squares puzzle'''
 
from itertools import chain
Line 5,138:
=={{header|R}}==
Function "perms" is a modified version of the "permutations" function from the "gtools" R package.
<syntaxhighlight lang=R"r"># 4 rings or 4 squares puzzle
 
perms <- function (n, r, v = 1:n, repeats.allowed = FALSE) {
Line 5,226:
Using a folder, so we can count as well as produce lists of results
 
<syntaxhighlight lang="racket">#lang racket
 
(define solution? (match-lambda [(list a b c d e f g) (= (+ a b) (+ b c d) (+ d e f) (+ f g))]))
Line 5,251:
{{works with|Rakudo|2016.12}}
 
<syntaxhighlight lang=perl6"raku" line>sub four-squares ( @list, :$unique=1, :$show=1 ) {
 
my @solutions;
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).
<syntaxhighlight lang="rexx">/*REXX pgm solves the 4-rings puzzle, where letters represent unique (or not) digits). */
arg LO HI unique show . /*the ARG statement capitalizes args.*/
if LO=='' | LO=="," then LO=1 /*Not specified? Then use the default.*/
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.
<syntaxhighlight lang="rexx">/*REXX pgm solves the 4-rings puzzle, where letters represent unique (or not) digits). */
arg LO HI unique show . /*the ARG statement capitalizes args.*/
if LO=='' | LO=="," then LO=1 /*Not specified? Then use the default.*/
Line 5,475:
 
=={{header|Ruby}}==
<syntaxhighlight lang="ruby">def four_squares(low, high, unique=true, show=unique)
f = -> (a,b,c,d,e,f,g) {[a+b, b+c+d, d+e+f, f+g].uniq.size == 1}
if unique
Line 5,521:
 
=={{header|Rust}}==
<syntaxhighlight lang="rust">
#![feature(inclusive_range_syntax)]
 
Line 5,620:
=={{header|Scala}}==
{{trans|Java}}
<syntaxhighlight lang="scala">object FourRings {
def fourSquare(low: Int, high: Int, unique: Boolean, print: Boolean): Unit = {
Line 5,672:
=={{header|Scheme}}==
 
<syntaxhighlight lang="scheme">
(import (scheme base)
(scheme write)
Line 5,734:
=={{header|Sidef}}==
{{trans|Raku}}
<syntaxhighlight lang="ruby">func four_squares (list, unique=true, show=true) {
 
var solutions = []
Line 5,815:
 
=={{header|Simula}}==
<syntaxhighlight lang="modula2">BEGIN
 
INTEGER PROCEDURE GETCOMBS(LOW, HIGH, UNIQUE, COMBS);
Line 5,951:
{{works with|Db2 LUW}} version 9.7 or higher.
With SQL PL:
<syntaxhighlight lang="sql pl">
--#SET TERMINATOR @
 
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.
 
<syntaxhighlight lang="stata">perm 7
rename * (a b c d e f g)
list if a==c+d & b+c==e+f & d+e==g, noobs sep(50)
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.
 
<syntaxhighlight lang=Tcl"tcl">set vars {a b c d e f g}
set exprs {
{$a+$b}
Line 6,272:
=={{header|VBA}}==
{{trans|C}}
<syntaxhighlight lang="vb">Dim a As Integer, b As Integer, c As Integer, d As Integer
Dim e As Integer, f As Integer, g As Integer
Dim lo As Integer, hi As Integer, unique As Boolean, show As Boolean
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.
<syntaxhighlight lang="vbnet">Module Module1
 
Dim CA As Char() = "0123456789ABC".ToCharArray()
Line 6,440:
=={{header|Vlang}}==
{{trans|Go}}
<syntaxhighlight lang="vlang">fn main(){
mut n, mut c := get_combs(1,7,true)
println("$n unique solutions in 1 to 7")
Line 6,507:
{{trans|C}}
{{libheader|Wren-fmt}}
<syntaxhighlight lang="ecmascript">import "/fmt" for Fmt
 
var a = 0
Line 6,618:
 
=={{header|XPL0}}==
<syntaxhighlight lang=XPL0"xpl0">int Show, Low, High, Digit(7\a..g\), Count;
proc Rings(Level);
int Level; \of recursion
Line 6,680:
=={{header|Yabasic}}==
{{trans|D}}
<syntaxhighlight lang=Yabasic"yabasic">fourSquare(1,7,true,true)
fourSquare(3,9,true,true)
fourSquare(0,9,false,false)
Line 6,764:
 
=={{header|zkl}}==
<syntaxhighlight 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,784:
s
}</syntaxhighlight>
<syntaxhighlight lang="zkl">fcn show(solutions,msg){
if(not solutions){ println("No solutions for",msg); return(); }
 
Line 6,831:
2860 non-unique (0-9) solutions found.
</pre>
[[Category:Games]]
[[Category:Puzzles]]
Thundergnat
10,333

edits

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