Rosetta Code

Ramsey's theorem: Difference between revisions

Page Discussion

Ramsey's theorem (view source)

Revision as of 15:32, 29 January 2024

6,145 bytes added ,  4 months ago
m
→‎{{header|Wren}}: Minor tidy
(Ramsey's theorem in BASIC256)
m (→‎{{header|Wren}}: Minor tidy)
 
(7 intermediate revisions by 3 users not shown)
Line 10:
{{trans|Python}}
 
<langsyntaxhighlight lang="11l">V a = [[‘0’] * 17] * 17
V idx = [0] * 4
 
Line 50:
L.break
L.was_no_break
print(‘all good’)</langsyntaxhighlight>
 
{{out}}
Line 76:
=={{header|360 Assembly}}==
{{trans|C}}
<langsyntaxhighlight lang="360asm">* Ramsey's theorem 19/03/2017
RAMSEY CSECT
USING RAMSEY,R13 base register
Line 220:
XDEC DS CL12 temp xdeco
YREGS
END RAMSEY</langsyntaxhighlight>
{{out}}
<pre>
Line 244:
 
=={{header|AWK}}==
<syntaxhighlight lang="awk">
<lang AWK>
# syntax: GAWK -f RAMSEYS_THEOREM.AWK
# converted from Ring
Line 270:
exit(0)
}
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 294:
=={{header|BASIC256}}==
{{trans|FreeBASIC}}
<langsyntaxhighlight BASIC256lang="basic256">global k, a, idx
k = 1
dim a(18,18)
Line 357:
next i
return false
end function</langsyntaxhighlight>
{{out}}
<pre>Same as FreeBASIC entry.</pre>
Line 365:
 
No issue with the code or the output, there seems to be a bug with Rosettacode's tag handlers. - aamrun
<langsyntaxhighlight lang="c">#include <stdio.h>
 
int a[17][17], idx[4];
Line 426:
puts("all good");
return 0;
}</langsyntaxhighlight>
{{out}} (17 x 17 connectivity matrix):
<pre>
Line 451:
=={{header|D}}==
{{trans|Tcl}}
<langsyntaxhighlight lang="d">import std.stdio, std.string, std.algorithm, std.range;
 
/// Generate the connectivity matrix.
Line 507:
writefln("%-(%(%c %)\n%)", mat);
mat.ramseyCheck.writeln;
}</langsyntaxhighlight>
{{out}}
<pre>- 1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 1
Line 530:
=={{header|Elixir}}==
{{trans|Erlang}}
<langsyntaxhighlight lang="elixir">defmodule Ramsey do
def main(n\\17) do
vertices = Enum.to_list(0 .. n-1)
Line 585:
end
 
Ramsey.main</langsyntaxhighlight>
 
{{out}}
Line 611:
=={{header|Erlang}}==
{{trans|C}} {{libheader|Erlang digraph}}
<langsyntaxhighlight lang="erlang">-module(ramsey_theorem).
-export([main/0]).
 
Line 683:
++ [{wholly_connected,V1,V2,V3,V4}
|| {V1,V2,V3,V4,_,false} <- ListConditions]}
end.</langsyntaxhighlight>
{{out}}
<pre>- 1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 1
Line 708:
{{trans|Ring}}
{{trans|Go}}
<langsyntaxhighlight lang="freebasic">
Dim Shared As Integer i, j, k = 1
Dim Shared As Integer a(17,17), idx(4)
Line 771:
Print Chr(10) & "Satisface el teorema de Ramsey."
End
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 797:
=={{header|Go}}==
{{trans|C}}
<langsyntaxhighlight lang="go">package main
 
import "fmt"
Line 871:
}
fmt.Println("All good.")
}</langsyntaxhighlight>
 
{{out}}
Line 896:
 
=={{header|J}}==
Interpreting this task as "reproduce the output of all the other examples", then here's a stroll to the goal through the J interpreter: <langsyntaxhighlight lang="j"> i.@<.&.(2&^.) N =: 17 NB. Count to N by powers of 2
1 2 4 8
1 #~ 1 j. 0 _1:} i.@<.&.(2&^.) N =: 17 NB. Turn indices into bit mask
Line 941:
0 1 0 0 0 1 1 0 0 0 1 0 1 1 _ 1 1
1 0 1 0 0 0 1 1 0 0 0 1 0 1 1 _ 1
1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 1 _</langsyntaxhighlight>
 
To test if all combinations of 4 rows and columns contain both a 0 and a 1
<syntaxhighlight lang="j">
<lang j>
comb=: 4 : 0 M. NB. All size x combinations of i.y
if. (x>:y)+.0=x do. i.(x<:y),x else. (0,.x comb&.<: y),1+x comb y-1 end.
Line 956:
*./ (4 comb 17) checkRow ramsey 17
1
</syntaxhighlight>
</lang>
 
=={{header|Java}}==
Translation of Tcl via D
{{works with|Java|8}}
<langsyntaxhighlight lang="java">import java.util.Arrays;
import java.util.stream.IntStream;
 
Line 1,022:
System.out.println(ramseyCheck(mat));
}
}</langsyntaxhighlight>
 
<pre>[-, 1, 1, 0, 1, 0, 0, 0, 1, 1, 0, 0, 0, 1, 0, 1, 1]
Line 1,042:
[1, 1, 0, 1, 0, 0, 0, 1, 1, 0, 0, 0, 1, 0, 1, 1, -]
Satisfies Ramsey condition.</pre>
 
=={{header|jq}}==
'''Adapted from [[#Wren|Wren]]'''
{{works with|jq}}
'''Also works with gojq, the Go implementation of jq.'''
 
With a minor tweak of the line using string interpolation, the following program also works with jaq (as of April 13, 2023), the Rust implementation of jq.
 
In the following, if a is a connectivity matrix and if $i != $j,
then a[$i][$j] is either 0 or 1 depending on whether the nodes are
unconnected or connected respectively.
<syntaxhighlight lang=jq>
# Input: {a, idx} where .a is a connectivity matrix and
# .idx is an array with length equal to the size of the group of interest.
# Assuming .idx[0] is 0, then depending on the value of $ctype,
# findGroup($ctype; 1; 1) will either find
# a completely connected or a uncompletely unconnected
# group of size `.idx|length` in .a, if it exists, or emit false.
# Set $ctype to 0 to find a completely unconnected group.
def findGroup($ctype; $min; $depth):
. as $in
| (.a|length) as $max
| (.idx|length) as $size
| if $depth == $size
then (if $ctype == 0 then "un" else "" end) as $cs
| "Totally \($cs)connected group: " + (.idx | map(tostring) | join(" "))
else .i = $min
| until (.i >= $max or .emit;
.n = 0
| until (.n >= $depth or .a[.idx[.n]][.i] != $ctype;
.n += 1)
| if .n == $depth
then .idx[.n] = .i
| .emit = findGroup($ctype; 1; $depth+1)
else .
end
| .i += 1 )
| .emit // false
end ;
 
# Output: {a, idx}
def init:
def a:
[range(0;17) | 0] as $zero
| [range(0;17) | $zero]
| reduce range(0;17) as $i (.; .[$i][$i] = 2);
def idx: [range(0;4)|0];
 
{a: a, idx: idx, k: 1}
| until (.k > 8;
reduce range(0;17) as $i (.;
(($i + .k) % 17) as $j
| .a[$i][$j] = 1
| .a[$j][$i] = 1)
| .k *= 2 )
| del(.k);
 
# input: {a}
def printout:
def mark(n): "01-"[n:n+1];
.a as $a
| range(0; $a|length) as $i
| reduce range(0; $a|length) as $j (""; . + mark($a[$i][$j]) + " ") ;
 
# input: {a, idx}
def check:
first( range(0; .a|length) as $i
| .idx[0] = $i
| findGroup(1; $i+1; 1) // findGroup(0; $i+1; 1) // empty
| . + "\nNo good.")
// "All good." ;
 
init
| printout, check, "",
# Test case breakage
( .a[2][1] = 0
| .a[1][2] = 0
| printout, check )
</syntaxhighlight>
{{output}}
<pre>
- 1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 1
1 - 1 1 0 1 0 0 0 1 1 0 0 0 1 0 1
1 1 - 1 1 0 1 0 0 0 1 1 0 0 0 1 0
0 1 1 - 1 1 0 1 0 0 0 1 1 0 0 0 1
1 0 1 1 - 1 1 0 1 0 0 0 1 1 0 0 0
0 1 0 1 1 - 1 1 0 1 0 0 0 1 1 0 0
0 0 1 0 1 1 - 1 1 0 1 0 0 0 1 1 0
0 0 0 1 0 1 1 - 1 1 0 1 0 0 0 1 1
1 0 0 0 1 0 1 1 - 1 1 0 1 0 0 0 1
1 1 0 0 0 1 0 1 1 - 1 1 0 1 0 0 0
0 1 1 0 0 0 1 0 1 1 - 1 1 0 1 0 0
0 0 1 1 0 0 0 1 0 1 1 - 1 1 0 1 0
0 0 0 1 1 0 0 0 1 0 1 1 - 1 1 0 1
1 0 0 0 1 1 0 0 0 1 0 1 1 - 1 1 0
0 1 0 0 0 1 1 0 0 0 1 0 1 1 - 1 1
1 0 1 0 0 0 1 1 0 0 0 1 0 1 1 - 1
1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 1 -
All good.
 
- 1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 1
1 - 0 1 0 1 0 0 0 1 1 0 0 0 1 0 1
1 0 - 1 1 0 1 0 0 0 1 1 0 0 0 1 0
0 1 1 - 1 1 0 1 0 0 0 1 1 0 0 0 1
1 0 1 1 - 1 1 0 1 0 0 0 1 1 0 0 0
0 1 0 1 1 - 1 1 0 1 0 0 0 1 1 0 0
0 0 1 0 1 1 - 1 1 0 1 0 0 0 1 1 0
0 0 0 1 0 1 1 - 1 1 0 1 0 0 0 1 1
1 0 0 0 1 0 1 1 - 1 1 0 1 0 0 0 1
1 1 0 0 0 1 0 1 1 - 1 1 0 1 0 0 0
0 1 1 0 0 0 1 0 1 1 - 1 1 0 1 0 0
0 0 1 1 0 0 0 1 0 1 1 - 1 1 0 1 0
0 0 0 1 1 0 0 0 1 0 1 1 - 1 1 0 1
1 0 0 0 1 1 0 0 0 1 0 1 1 - 1 1 0
0 1 0 0 0 1 1 0 0 0 1 0 1 1 - 1 1
1 0 1 0 0 0 1 1 0 0 0 1 0 1 1 - 1
1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 1 -
Totally unconnected group: 1 2 7 12
No good.
</pre>
 
=={{header|Julia}}==
{{trans|C}}
<langsyntaxhighlight lang="julia">const a, idx = zeros(Int, 17, 17), zeros(Int, 4)
 
function findgroup(typ, nmin, nmax, depth)
Line 1,102 ⟶ 1,222:
 
testnodes()
</langsyntaxhighlight>{{out}}
<pre>
- 1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 1
Line 1,126 ⟶ 1,246:
=={{header|Kotlin}}==
{{trans|C}}
<langsyntaxhighlight lang="scala">// version 1.1.0
 
val a = Array(17) { IntArray(17) }
Line 1,178 ⟶ 1,298:
}
println("\nRamsey condition satisfied.")
}</langsyntaxhighlight>
 
{{out}}
Line 1,204 ⟶ 1,324:
 
=={{header|Mathematica}}/{{header|Wolfram Language}}==
<langsyntaxhighlight lang="mathematica">g = CirculantGraph[17, {1, 2, 4, 8}]
vl = VertexList[g];
ss = Subsets[vl, {4}];
NoneTrue[ss, CompleteGraphQ[Subgraph[g, #]] &]
NoneTrue[ss, Length[ConnectedComponents[Subgraph[g, #]]] == 4 &]</langsyntaxhighlight>
{{out}}
[[File:Ramsey.png]]
Line 1,216 ⟶ 1,336:
=={{header|Mathprog}}==
{{lines too long|Mathprog}}
<syntaxhighlight lang="text">/*Ramsey 4 4 17
This model finds a graph with 17 Nodes such that no clique of 4 Nodes is either fully
Line 1,229 ⟶ 1,349:
clique{a in 1..(Nodes-3), b in (a+1)..(Nodes-2), c in (b+1)..(Nodes-1), d in (c+1)..Nodes} : 1 <= Arc[a,b] + Arc[a,c] + Arc[a,d] + Arc[b,c] + Arc[b,d] + Arc[c,d] <= 5;
 
end;</langsyntaxhighlight>
 
This may be run with:
<langsyntaxhighlight lang="bash">glpsol --minisat --math R_4_4_17.mprog --output R_4_4_17.sol</langsyntaxhighlight>
The solution may be viewed on [[Solution Ramsey Mathprog|this page]].
In the solution file, the first section identifies the number of nodes connected in this clique. In the second part of the solution, the status of each arc in the graph (connected=<tt>1</tt>, unconnected=<tt>0</tt>) is shown.
Line 1,238 ⟶ 1,358:
=={{header|Nim}}==
{{trans|Kotlin}}
<langsyntaxhighlight Nimlang="nim">var a: array[17, array[17, int]]
var idx: array[4, int]
 
Line 1,282 ⟶ 1,402:
quit "\nRamsey condition not satisfied.", QuitFailure
 
echo "\nRamsey condition satisfied."</langsyntaxhighlight>
 
{{out}}
Line 1,307 ⟶ 1,427:
=={{header|PARI/GP}}==
This takes the [[#C|C]] solution to its logical extreme.
<langsyntaxhighlight lang="parigp">
 
check(M)={
Line 1,328 ⟶ 1,448:
 
M=matrix(17,17,x,y,my(t=abs(x-y)%17);t==2^min(valuation(t,2),3))
check(M)</langsyntaxhighlight>
 
=={{header|Perl}}==
{{trans|Raku}}
{{libheader|ntheory}}
<langsyntaxhighlight lang="perl">use ntheory qw(forcomb);
use Math::Cartesian::Product;
 
Line 1,355 ⟶ 1,475:
 
print join(' ' ,@$_) . "\n" for @a;
print 'OK'</langsyntaxhighlight>
{{out}}
<pre>- 1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 1
Line 1,378 ⟶ 1,498:
=={{header|Phix}}==
{{trans|Go}}
<!--<langsyntaxhighlight Phixlang="phix">(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">a</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #008000;">'0'</span><span style="color: #0000FF;">,</span><span style="color: #000000;">17</span><span style="color: #0000FF;">),</span><span style="color: #000000;">17</span><span style="color: #0000FF;">),</span>
Line 1,437 ⟶ 1,557:
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">all_good</span><span style="color: #0000FF;">?</span><span style="color: #008000;">"Satisfies Ramsey condition.\n"</span><span style="color: #0000FF;">:</span><span style="color: #008000;">"No good.\n"</span><span style="color: #0000FF;">))</span>
<!--</langsyntaxhighlight>-->
{{out}}
<pre>
Line 1,466 ⟶ 1,586:
{{trans|C}}
 
<langsyntaxhighlight lang="python">range17 = range(17)
a = [['0'] * 17 for i in range17]
idx = [0] * 4
Line 1,514 ⟶ 1,634:
exit()
 
print("all good")</langsyntaxhighlight>
 
{{out|Output same as C}}
Line 1,525 ⟶ 1,645:
 
Kind of a translation of C (ie, reducing this problem to generating a printout of a specific matrix).
<langsyntaxhighlight lang="racket">#lang racket
 
(define N 17)
Line 1,538 ⟶ 1,658:
(λ(j) (case (dist i j) [(0) '-] [(1 2 4 8) 1] [else 0]))))))
 
(for ([row v]) (displayln row))</langsyntaxhighlight>
 
=={{header|Raku}}==
(formerly Perl 6)
{{Works with|rakudo|2018.08}}
<syntaxhighlight lang="raku" perl6line>my $n = 17;
my @a = [ 0 xx $n ] xx $n;
@a[$_;$_] = '-' for ^$n;
Line 1,557 ⟶ 1,677:
die "Bogus!" unless 0 < $links < 6;
}
say "OK";</langsyntaxhighlight>
{{out}}
<pre>- 1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 1
Line 1,580 ⟶ 1,700:
=={{header|REXX}}==
Mainline programming was borrowed from &nbsp; '''C'''.
<langsyntaxhighlight lang="rexx">/*REXX program finds & displays a 17 node graph such that any four nodes are neither ···*/
/*────────────────────────────────────────── totally connected nor totally unconnected. */
@.=0; #=17 /*initialize the node graph to zero. */
Line 1,615 ⟶ 1,735:
end /*h*/ /* divide the total by two. */
say /*stick a fork in it, we're all done. */
say space("Ramsey's condition is"word("'nt", 1+ok) 'satisfied.') /*show yea─or─nay.*/</langsyntaxhighlight>
{{out|output|text=&nbsp; ('''17x17''' connectivity matrix):}}
<pre>
Line 1,640 ⟶ 1,760:
 
=={{header|Ring}}==
<langsyntaxhighlight lang="ring">
# Project : Ramsey's theorem
 
Line 1,666 ⟶ 1,786:
see nl
next
</syntaxhighlight>
</lang>
Output:
<pre>
Line 1,689 ⟶ 1,809:
 
=={{header|Ruby}}==
<langsyntaxhighlight lang="ruby">a = Array.new(17){['0'] * 17}
17.times{|i| a[i][i] = '-'}
4.times do |k|
Line 1,704 ⟶ 1,824:
end
puts "Ok"
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 1,729 ⟶ 1,849:
=={{header|Run BASIC}}==
{{incorrect|Run BASIC|The task has been changed to also require demonstrating that the graph is a solution.}}
<langsyntaxhighlight lang="runbasic">dim a(17,17)
for i = 1 to 17: a(i,i) = -1: next i
k = 1
Line 1,745 ⟶ 1,865:
next j
print
next i</langsyntaxhighlight>
<pre>-1 1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 1
1 -1 1 1 0 1 0 0 0 1 1 0 0 0 1 0 1
Line 1,766 ⟶ 1,886:
=={{header|Sidef}}==
{{trans|Ruby}}
<langsyntaxhighlight lang="ruby">var a = 17.of { 17.of(0) }
 
17.times {|i| a[i][i] = '-' }
Line 1,782 ⟶ 1,902:
((0 < links) && (links < 6)) || die "Bogus!"
})
say "Ok"</langsyntaxhighlight>
{{out}}
<pre>
Line 1,807 ⟶ 1,927:
=={{header|Tcl}}==
{{works with|Tcl|8.6}}
<langsyntaxhighlight lang="tcl">package require Tcl 8.6
 
# Generate the connectivity matrix
Line 1,851 ⟶ 1,971:
 
puts [join $matrix \n]
ramseyCheck4 $matrix</langsyntaxhighlight>
{{out}}
<pre>
Line 1,877 ⟶ 1,997:
{{trans|C}}
{{libheader|Wren-fmt}}
<langsyntaxhighlight ecmascriptlang="wren">import "./fmt" for Fmt
 
var a = List.filled(17, null)
Line 1,937 ⟶ 2,057:
}
}
System.print("All good.")</langsyntaxhighlight>
 
{{out}}
Line 1,960 ⟶ 2,080:
All good.
</pre>
 
=={{header|Yabasic}}==
<syntaxhighlight lang="yabasic">// Rosetta Code problem: https://www.rosettacode.org/wiki/Ramsey%27s_theorem
// by Jjuanhdez, 06/2022
 
clear screen
k = 1
dim a(17,17), idx(4)
for i = 0 to 17
a(i,i) = 2 //-1
next i
 
sub EncontrarGrupo(tipo, mini, maxi, fondo)
if fondo = 0 then
c$ = ""
if tipo = 0 then c$ = "des" : fi
print "Grupo totalmente ", c, "conectado:"
for i = 0 to 4
print " ", idx(i)
next i
print
return true
end if
for i = mini to maxi
k = 0
for j = k to fondo
if a(idx(k),i) <> tipo then break : fi
next j
if k = fondo then
idx(k) = i
if EncontrarGrupo(tipo, 1, maxi, fondo+1) then return true : fi
end if
next i
return false
end sub
 
while k <= 8
for i = 1 to 17
j = mod((i + k), 17)
if j <> 0 then
a(i,j) = 1 : a(j,i) = 1
end if
next i
k = k * 2
wend
for i = 1 to 17
for j = 1 to 17
if a(i,j) = 2 then
print "- ";
else
print a(i,j), " ";
end if
next j
print
next i
 
// Es simétrico, por lo que solo necesita probar grupos que contengan el nodo 0.
for i = 0 to 17
idx(0) = i
if EncontrarGrupo(1, i+1, 17, 1) or EncontrarGrupo(0, i+1, 17, 1) then
print color("red") "\nNo satisfecho.\n"
break
end if
next i
print color("gre") "\nSatisface el teorema de Ramsey.\n"
end</syntaxhighlight>
{{out}}
<pre>Same as FreeBASIC entry.</pre>
PureFox
9,482

edits

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