Ramsey's theorem: Difference between revisions
Content added Content deleted
Thundergnat (talk | contribs) (Rename Perl 6 -> Raku, alphabetize, minor clean-up) |
|||
Line 175: | Line 175: | ||
check=yes |
check=yes |
||
</pre> |
</pre> |
||
=={{header|AWK}}== |
=={{header|AWK}}== |
||
<lang AWK> |
<lang AWK> |
||
Line 471: | Line 472: | ||
Satisfies Ramsey condition. |
Satisfies Ramsey condition. |
||
</pre> |
</pre> |
||
=={{header|Erlang}}== |
|||
{{trans|C}} {{libheader|Erlang digraph}} |
|||
<lang erlang>-module(ramsey_theorem). |
|||
-export([main/0]). |
|||
main() -> |
|||
Vertices = lists:seq(0,16), |
|||
G = create_graph(Vertices), |
|||
String_ramsey = |
|||
case ramsey_check(G,Vertices) of |
|||
true -> |
|||
"Satisfies Ramsey condition."; |
|||
{false,Reason} -> |
|||
"Not satisfies Ramsey condition:\n" |
|||
++ io_lib:format("~p\n",[Reason]) |
|||
end, |
|||
io:format("~s\n~s\n",[print_graph(G,Vertices),String_ramsey]). |
|||
create_graph(Vertices) -> |
|||
G = digraph:new([cyclic]), |
|||
[digraph:add_vertex(G,V) || V <- Vertices], |
|||
[begin |
|||
J = ((I + K) rem 17), |
|||
digraph:add_edge(G, I, J), |
|||
digraph:add_edge(G, J, I) |
|||
end || I <- Vertices, K <- [1,2,4,8]], |
|||
G. |
|||
print_graph(G,Vertices) -> |
|||
Edges = |
|||
[{V1,V2} || |
|||
V1 <- digraph:vertices(G), |
|||
V2 <- digraph:out_neighbours(G, V1)], |
|||
lists:flatten( |
|||
[[ |
|||
[case I of |
|||
J -> |
|||
$-; |
|||
_ -> |
|||
case lists:member({I,J},Edges) of |
|||
true -> $1; |
|||
false -> $0 |
|||
end |
|||
end,$ ] |
|||
|| I <- Vertices] ++ [$\n] || J <- Vertices]). |
|||
ramsey_check(G,Vertices) -> |
|||
Edges = |
|||
[{V1,V2} || |
|||
V1 <- digraph:vertices(G), |
|||
V2 <- digraph:out_neighbours(G, V1)], |
|||
ListConditions = |
|||
[begin |
|||
All_cases = |
|||
[lists:member({V1,V2},Edges), |
|||
lists:member({V1,V3},Edges), |
|||
lists:member({V1,V4},Edges), |
|||
lists:member({V2,V3},Edges), |
|||
lists:member({V2,V4},Edges), |
|||
lists:member({V3,V4},Edges)], |
|||
{V1,V2,V3,V4, |
|||
lists:any(fun(X) -> X end, All_cases), |
|||
not(lists:all(fun(X) -> X end, All_cases))} |
|||
end |
|||
|| V1 <- Vertices, V2 <- Vertices, V3 <- Vertices, V4 <- Vertices, |
|||
V1/=V2,V1/=V3,V1/=V4,V2/=V3,V2/=V4,V3/=V4], |
|||
case lists:all(fun({_,_,_,_,C1,C2}) -> C1 and C2 end,ListConditions) of |
|||
true -> true; |
|||
false -> |
|||
{false, |
|||
[{wholly_unconnected,V1,V2,V3,V4} |
|||
|| {V1,V2,V3,V4,false,_} <- ListConditions] |
|||
++ [{wholly_connected,V1,V2,V3,V4} |
|||
|| {V1,V2,V3,V4,_,false} <- ListConditions]} |
|||
end.</lang> |
|||
{{out}} |
|||
<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 - |
|||
Satisfies Ramsey condition.</pre> |
|||
=={{header|FreeBASIC}}== |
=={{header|FreeBASIC}}== |
||
Line 661: | Line 758: | ||
All good. |
All good. |
||
</pre> |
</pre> |
||
=={{header|Erlang}}== |
|||
{{trans|C}} {{libheader|Erlang digraph}} |
|||
<lang erlang>-module(ramsey_theorem). |
|||
-export([main/0]). |
|||
main() -> |
|||
Vertices = lists:seq(0,16), |
|||
G = create_graph(Vertices), |
|||
String_ramsey = |
|||
case ramsey_check(G,Vertices) of |
|||
true -> |
|||
"Satisfies Ramsey condition."; |
|||
{false,Reason} -> |
|||
"Not satisfies Ramsey condition:\n" |
|||
++ io_lib:format("~p\n",[Reason]) |
|||
end, |
|||
io:format("~s\n~s\n",[print_graph(G,Vertices),String_ramsey]). |
|||
create_graph(Vertices) -> |
|||
G = digraph:new([cyclic]), |
|||
[digraph:add_vertex(G,V) || V <- Vertices], |
|||
[begin |
|||
J = ((I + K) rem 17), |
|||
digraph:add_edge(G, I, J), |
|||
digraph:add_edge(G, J, I) |
|||
end || I <- Vertices, K <- [1,2,4,8]], |
|||
G. |
|||
print_graph(G,Vertices) -> |
|||
Edges = |
|||
[{V1,V2} || |
|||
V1 <- digraph:vertices(G), |
|||
V2 <- digraph:out_neighbours(G, V1)], |
|||
lists:flatten( |
|||
[[ |
|||
[case I of |
|||
J -> |
|||
$-; |
|||
_ -> |
|||
case lists:member({I,J},Edges) of |
|||
true -> $1; |
|||
false -> $0 |
|||
end |
|||
end,$ ] |
|||
|| I <- Vertices] ++ [$\n] || J <- Vertices]). |
|||
ramsey_check(G,Vertices) -> |
|||
Edges = |
|||
[{V1,V2} || |
|||
V1 <- digraph:vertices(G), |
|||
V2 <- digraph:out_neighbours(G, V1)], |
|||
ListConditions = |
|||
[begin |
|||
All_cases = |
|||
[lists:member({V1,V2},Edges), |
|||
lists:member({V1,V3},Edges), |
|||
lists:member({V1,V4},Edges), |
|||
lists:member({V2,V3},Edges), |
|||
lists:member({V2,V4},Edges), |
|||
lists:member({V3,V4},Edges)], |
|||
{V1,V2,V3,V4, |
|||
lists:any(fun(X) -> X end, All_cases), |
|||
not(lists:all(fun(X) -> X end, All_cases))} |
|||
end |
|||
|| V1 <- Vertices, V2 <- Vertices, V3 <- Vertices, V4 <- Vertices, |
|||
V1/=V2,V1/=V3,V1/=V4,V2/=V3,V2/=V4,V3/=V4], |
|||
case lists:all(fun({_,_,_,_,C1,C2}) -> C1 and C2 end,ListConditions) of |
|||
true -> true; |
|||
false -> |
|||
{false, |
|||
[{wholly_unconnected,V1,V2,V3,V4} |
|||
|| {V1,V2,V3,V4,false,_} <- ListConditions] |
|||
++ [{wholly_connected,V1,V2,V3,V4} |
|||
|| {V1,V2,V3,V4,_,false} <- ListConditions]} |
|||
end.</lang> |
|||
{{out}} |
|||
<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 - |
|||
Satisfies Ramsey condition.</pre> |
|||
=={{header|J}}== |
=={{header|J}}== |
||
Line 1,144: | Line 1,145: | ||
print join(' ' ,@$_) . "\n" for @a; |
print join(' ' ,@$_) . "\n" for @a; |
||
print 'OK'</lang> |
print 'OK'</lang> |
||
{{out}} |
|||
<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 - |
|||
OK</pre> |
|||
=={{header|Perl 6}}== |
|||
{{Works with|rakudo|2018.08}} |
|||
<lang perl6>my $n = 17; |
|||
my @a = [ 0 xx $n ] xx $n; |
|||
@a[$_;$_] = '-' for ^$n; |
|||
for flat ^$n X 1,2,4,8 -> $i, $k { |
|||
my $j = ($i + $k) % $n; |
|||
@a[$i;$j] = @a[$j;$i] = 1; |
|||
} |
|||
.say for @a; |
|||
for combinations($n,4) -> $quartet { |
|||
my $links = [+] $quartet.combinations(2).map: -> $i,$j { @a[$i;$j] } |
|||
die "Bogus!" unless 0 < $links < 6; |
|||
} |
|||
say "OK";</lang> |
|||
{{out}} |
{{out}} |
||
<pre>- 1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 1 |
<pre>- 1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 1 |
||
Line 1,360: | Line 1,324: | ||
(for ([row v]) (displayln row))</lang> |
(for ([row v]) (displayln row))</lang> |
||
=={{header|Raku}}== |
|||
(formerly Perl 6) |
|||
{{Works with|rakudo|2018.08}} |
|||
<lang perl6>my $n = 17; |
|||
my @a = [ 0 xx $n ] xx $n; |
|||
@a[$_;$_] = '-' for ^$n; |
|||
for flat ^$n X 1,2,4,8 -> $i, $k { |
|||
my $j = ($i + $k) % $n; |
|||
@a[$i;$j] = @a[$j;$i] = 1; |
|||
} |
|||
.say for @a; |
|||
for combinations($n,4) -> $quartet { |
|||
my $links = [+] $quartet.combinations(2).map: -> $i,$j { @a[$i;$j] } |
|||
die "Bogus!" unless 0 < $links < 6; |
|||
} |
|||
say "OK";</lang> |
|||
{{out}} |
|||
<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 - |
|||
OK</pre> |
|||
=={{header|REXX}}== |
=={{header|REXX}}== |