aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Another update from ingydotnet^djgoku

Browse source
This commit is contained in:
Ingy döt Net 2015-11-18 06:14:39 +00:00
parent 91df62d461
commit 948b86eafa
7604 changed files with 108452 additions and 22726 deletions
Download patch file Download diff file Expand all files Collapse all files

47
Task/Amb/00DESCRIPTION
View file

@ -1,17 +1,46 @@
Define and give an example of the Amb operator.
The Amb operator takes some number of expressions (or values if that's simpler in the language) and nondeterministically yields the one or fails if given no parameter, amb returns the value that doesn't lead to failure.
The Amb operator expresses nondeterminism. This doesn't refer to randomness (as in "nondeterministic universe") but is closely related to the term as it is used in automata theory ("non-deterministic finite automaton").
The example is using amb to choose four words from the following strings:
The Amb operator takes a variable number of expressions (or values if that's simpler in the language) and yields a correct one which will satisfy a constraint in some future computation, thereby avoiding failure.
set 1: "the" "that" "a"
Problems whose solution the Amb operator naturally expresses can be approached with other tools, such as explicit nested iterations over data sets, or with pattern matching. By contrast, the Amb operator appears integrated into the language. Invocations of Amb are not wrapped in any visible loops or other search patterns; they appear to be independent.
set 2: "frog" "elephant" "thing"
Essentially Amb(x, y, z) splits the computation into three possible futures: a future in which the value x is yielded, a future in which the value y is yielded and a future in which the value z is yielded. The future which leads to a successful subsequent computation is chosen. The other "parallel universes" somehow go away. Amb called with no arguments fails.
set 3: "walked" "treaded" "grows"
For simplicity, one of the domain values usable with Amb may denote failure, if that is convenient. For instance, it is convenient if a Boolean false denotes failure, so that Amb(false) fails, and thus constraints can be expressed using Boolean expressions like Amb(x * y == 8) which unless x and y add to four.
set 4: "slowly" "quickly"
A pseudo-code program which satisfies this constraint might look like:
It is a failure if the last character of word 1 is not equal to the first character
of word 2, and similarly with word 2 and word 3, as well as word 3 and word 4.
(the only successful sentence is "that thing grows slowly").
<pre>let x = Amb(1, 2, 3)
let y = Amb(7, 6, 4, 5)
Amb(x * y = 8)
print x, y</pre>
The output is <code>2 4</code> because <code>Amb(1, 2, 3)</code> correctly chooses the future in which <code>x</code> has value <code>2</code>, <code>Amb(7, 6, 4, 5)</code> chooses <code>4</code> and consequently <code>Amb(x * y = 8)</code> produces a success.
Alternatively, failure could be represented using strictly <code>Amb()</code>:
<pre>unless x * y = 8 do Amb()</pre>
Or else Amb could take the form of two operators or functions: one for producing values and one for enforcing constraints:
<pre>let x = Ambsel(1, 2, 3)
let y = Ambsel(4, 5, 6)
Ambassert(x * y = 8)
print x, y</pre>
where <code>Ambassert</code> behaves like <code>Amb()</code> if the Boolean expression is false, otherwise it allows the future computation to take place, without yielding any value.
The task is to somehow implement Amb, and demonstrate it with a program which chooses one word from each of the following four sets of character strings to generate a four-word sentence:
#<code>"the" "that" "a"</code>
#<code>"frog" "elephant" "thing"</code>
#<code>"walked" "treaded" "grows"</code>
#<code>"slowly" "quickly"</code>
The constraint to be satisfied is that the last character of each word (other than the last) is the same as the first character of its successor.
The only successful sentence is <code>"that thing grows slowly"</code>; other combinations do not satisfy the constraint and thus fail.
The goal of this task isn't to simply process the four lists of words with explicit, deterministic program flow such as nested iteration, to trivially demonstrate the correct output. The goal is to implement the Amb operator, or a facsimile thereof that is possible within the language limitations.

124
Task/Amb/ATS/amb.ats Normal file
View file

@ -0,0 +1,124 @@
(* ****** ****** *)
//
#include
"share/atspre_staload.hats"
#include
"share/HATS/atspre_staload_libats_ML.hats"
//
(* ****** ****** *)
//
staload "libats/ML/SATS/monad_list.sats"
staload _ = "libats/ML/DATS/monad_list.dats"
//
(* ****** ****** *)
//
datatype
words =
| Sing of stringGt(0)
| Comb of (words, words)
//
(* ****** ****** *)
//
extern
fun words_get_beg(words): char
extern
fun words_get_end(words): char
//
(* ****** ****** *)
//
implement
words_get_beg(w0) =
(
case+ w0 of
| Sing(cs) => cs[0]
| Comb(w1, w2) => words_get_beg(w1)
)
//
implement
words_get_end(w0) =
(
case+ w0 of
| Sing(cs) => cs[pred(length(cs))]
| Comb(w1, w2) => words_get_end(w2)
)
//
(* ****** ****** *)
//
fun
words_comb
(
w1: words, w2: words
) : list0(words) =
if (words_get_end(w1)=words_get_beg(w2))
then list0_sing(Comb(w1, w2)) else list0_nil()
//
(* ****** ****** *)
//
extern
fun
fprint_words: fprint_type(words)
//
overload fprint with fprint_words
//
implement
fprint_words(out, ws) =
(
case+ ws of
| Sing(w) => fprint(out, w)
| Comb(w1, w2) => fprint!(out, w1, ' ', w2)
)
//
implement fprint_val<words> = fprint_words
//
(* ****** ****** *)
//
typedef
a = stringGt(0) and b = words
//
val ws1 =
$list{a}("this", "that", "a")
val ws1 =
list_map_fun<a><b>(ws1, lam(x) => Sing(x))
val ws1 = monad_list_list(list0_of_list_vt(ws1))
//
val ws2 =
$list{a}("frog", "elephant", "thing")
val ws2 =
list_map_fun<a><b>(ws2, lam(x) => Sing(x))
val ws2 = monad_list_list(list0_of_list_vt(ws2))
//
val ws3 =
$list{a}("walked", "treaded", "grows")
val ws3 =
list_map_fun<a><b>(ws3, lam(x) => Sing(x))
val ws3 = monad_list_list(list0_of_list_vt(ws3))
//
val ws4 =
$list{a}("slowly", "quickly")
val ws4 =
list_map_fun<a><b>(ws4, lam(x) => Sing(x))
val ws4 = monad_list_list(list0_of_list_vt(ws4))
//
(* ****** ****** *)
//
val
ws12 =
monad_bind2<b,b><b>
(ws1, ws2, lam (w1, w2) => monad_list_list(words_comb(w1, w2)))
val
ws123 =
monad_bind2<b,b><b>
(ws12, ws3, lam (w12, w3) => monad_list_list(words_comb(w12, w3)))
val
ws1234 =
monad_bind2<b,b><b>
(ws123, ws4, lam (w123, w4) => monad_list_list(words_comb(w123, w4)))
//
(* ****** ****** *)
implement main0 () =
{
val () = fprintln! (stdout_ref, "ws1234 = ", ws1234)
}
(* ****** ****** *)

97
Task/Amb/Elena/amb.elena
View file

@ -1,125 +1,74 @@
#define system.
#define system'routines.
#define extensions.
#define extensions'routines.
// --- Joinable --
#symbol joinable = (:aFormer:aLater)
[ (aFormer @ (aFormer length - 1)) == (aLater @ 0) ].
[ (aFormer@(aFormer length - 1)) == (aLater@0) ].
// --- Activatora ---
#class(role)Activator2
#symbol dispatcher =
{
#method eval : anArray
eval : anArray &func2:aFunction
[
^ self eval:(anArray@0):(anArray@1).
^ aFunction eval:(anArray@0):(anArray@1).
]
}
#class(role)Activator3
{
#method eval : anArray
eval : anArray &func3:aFunction
[
^ self eval:(anArray@0):(anArray@1):(anArray@2).
^ aFunction eval:(anArray@0):(anArray@1):(anArray@2).
]
}
#class(role)Activator4
{
#method eval : anArray
eval : anArray &func4:aFunction
[
^ self eval:(anArray@0):(anArray@1):(anArray@2):(anArray@3).
^ aFunction eval:(anArray@0):(anArray@1):(anArray@2):(anArray@3).
]
}
#class(role)Activator5
{
#method eval : anArray
eval : anArray &func5:aFunction
[
^ self eval:(anArray@0):(anArray@1):(anArray@2):(anArray@3):(anArray@4).
^ aFunction eval:(anArray@0):(anArray@1):(anArray@2):(anArray@3):(anArray@4).
]
}
// --- AmbValueCollection ---
}.
#class AmbValueCollection
{
#field theCombinator.
#field theRole.
#constructor new : aSet1 : aSet2
#constructor new &args:Arguments
[
theRole := Activator2.
theCombinator := CombinatorWithRepetition new:(aSet1,aSet2).
]
#constructor new : aSet1 : aSet2 : aSet3
[
theRole := Activator3.
theCombinator := CombinatorWithRepetition new:(aSet1,aSet2,aSet3).
]
#constructor new : aSet1 : aSet2 : aSet3 : aSet4
[
theRole := Activator4.
theCombinator := CombinatorWithRepetition new:(aSet1,aSet2,aSet3,aSet4).
]
#constructor new : aSet1 : aSet2 : aSet3 : aSet4 : aSet5
[
theRole := Activator5.
theCombinator := CombinatorWithRepetition new:(aSet1,aSet2,aSet3,aSet4,aSet5).
theCombinator := SequentialEnumerator new &args:Arguments.
]
#method seek : aCondition
[
theCombinator reset.
control while:[ theCombinator next ] &do:
theCombinator seek &each: v
[
aCondition~theRole eval:(theCombinator get) ?
[ #break nil. ].
^ aCondition cast:%eval &to:dispatcher &with:v.
].
]
#method do : aFunction
[
#var aResult := theCombinator get.
nil != aResult
? [ aFunction~theRole eval:aResult. ]
(nil != aResult)
? [ aFunction cast:%eval &to:dispatcher &with:aResult. ]
! [ #throw InvalidArgumentException new. ].
]
}
// --- ambOperator ---
#symbol ambOperator =
{
for : aSet1 : aSet2
= AmbValueCollection new:aSet1:aSet2.
for : aSet1 : aSet2 : aSet3
= AmbValueCollection new:aSet1:aSet2:aSet3.
for : aSet1 : aSet2 : aSet3 : aSet4
= AmbValueCollection new:aSet1:aSet2:aSet3:aSet4.
for : aSet1 : aSet2 : aSet3 : aSet4 : aSet5
= AmbValueCollection new:aSet1:aSet2:aSet3:aSet4:aSet5.
for &args:Arguments
= AmbValueCollection new &args:Arguments.
}.
// --- Program ---
#symbol program =
[
ambOperator for:(1,2,4):(4,5,6) seek: (:a:b) [ a * b == 8 ] do: (:a:b)
[ consoleEx writeLine: a : " * " : b : " = 8" ]
| if &InvalidArgumentError: e [ consoleEx writeLine:"AMB is angry". ].
ambOperator
for:("the","that","a"):("frog", "elephant", "thing"):("walked", "treaded", "grows"):("slowly", "quickly")
for &args:("the","that","a"):("frog", "elephant", "thing"):("walked", "treaded", "grows"):("slowly", "quickly")
seek: (:a:b:c:d) [ (joinable:a:b) and:(joinable:b:c) and:(joinable:c:d) ]
do: (:a:b:c:d) [ consoleEx writeLine:a:" ":b:" ":c:" ":d. ]
| if &InvalidArgumentError: e [ consoleEx writeLine:"AMB is angry". ].
do: (:a:b:c:d) [ console writeLine:a:" ":b:" ":c:" ":d. ]
| if &InvalidArgumentError: e [ console writeLine:"AMB is angry". ].
].

52
Task/Amb/Julia/amb.julia Normal file
View file

@ -0,0 +1,52 @@
# This is a general purpose AMB function that takes a two-argument failure function and
# arbitrary number of iterable objects and returns the first solution found as an array
# this function is in essence an iterative backtracking solver
function amb(failure,objs...)
n=length(objs)
if n==1 return end
states=cell(n)
values=cell(n)
# starting point, we put down the first value from the first iterable object
states[1]=start(objs[1])
values[1],states[1]=next(objs[1],states[1])
i=1
# main solver loop
while true
# test for failure
if i>1&&failure(values[i-1],values[i])
# loop for generating a new value upon failure
# in fact this would be way more readable using goto, but Julia doesn't seem to have that :(
while true
# if we failed, we must generate a new value, but first we must check whether there is any
if done(objs[i],states[i])
# backtracking step with sanity check in case we ran out of values from the current generator
if i==1 return else i-=1; continue end
else
# if there is indeed a new value, generate it
values[i],states[i]=next(objs[i],states[i])
break
end
end
else
# no failure branch
# if solution is ready (i.e. all generators are used) just return it
if i==n return values end
# else start up the next generator
i+=1
states[i]=start(objs[i])
values[i],states[i]=next(objs[i],states[i])
end
end
end
# Call our generic AMB function according to the task description and
# form the solution sentence from the returned array of words
println(join(amb(
(s1,s2)->s1[end]!=s2[1],
["the","that","a"],
["frog","elephant","thing"],
["walked","treaded","grows"],
["slowly","quickly"]
)," "))

10
Task/Amb/Perl-6/amb-2.pl6
View file

@ -4,15 +4,19 @@ sub amb($var,*@a) {
}]";
}
sub joins ($word1, $word2) {
substr($word1,*-1,1) eq substr($word2,0,1)
}
'' ~~ m/
:my ($a,$b,$c,$d);
<{ amb '$a', <the that a> }>
<{ amb '$b', <frog elephant thing> }>
<?{ substr($a,*-1,1) eq substr($b,0,1) }>
<?{ joins $a, $b }>
<{ amb '$c', <walked treaded grows> }>
<?{ substr($b,*-1,1) eq substr($c,0,1) }>
<?{ joins $b, $c }>
<{ amb '$d', <slowly quickly> }>
<?{ substr($c,*-1,1) eq substr($d,0,1) }>
<?{ joins $c, $d }>
{ say "$a $b $c $d" }
<!>
/;

53
Task/Amb/Perl/amb-2.pl
View file

@ -1,40 +1,27 @@
#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
use re 'eval';
sub amb {
if( @_ == 0 ) {
no warnings 'exiting';
next AMB;
}
my $code = pop;
my @words = @_;
my @index = (0) x @words;
AMB: while( 1 ) {
my @w = map $words[$_][$index[$_]], 0 .. $#_;
return $code->( @w );
} continue {
my $i = 0;
while( ++$index[$i] == @{$words[$i]} ) {
$index[$i] = 0;
return if ++$i == @index;
}
}
sub amb ($@) {
my $var = shift;
join ' || ', map { "(?{ $var = '$_' })" } @_;
}
my @w1 = qw(the that a);
my @w2 = qw(frog elephant thing);
my @w3 = qw(walked treaded grows);
my @w4 = qw(slowly quickly);
sub joined {
my ($join_a, $join_b) = @_;
substr($join_a, -1) eq substr($join_b, 0, 1);
sub joins {
substr(shift,-1,1) eq substr(shift,0,1)
}
amb( \(@w1, @w2, @w3, @w4), sub {
my ($w1, $w2, $w3, $w4) = @_;
amb() unless joined($w1, $w2);
amb() unless joined($w2, $w3);
amb() unless joined($w3, $w4);
print "$w1 $w2 $w3 $w4\n";
});
my ($a,$b,$c,$d);
'' =~ m/
(??{ amb '$a', qw[the that a] })
(??{ amb '$b', qw[frog elephant thing] })
(??{ amb '$c', qw[walked treaded grows] })
(??{ amb '$d', qw[slowly quickly] })
(?(?{ joins($b, $c) })|(*FAIL))
(?(?{ joins($a, $b) })|(*FAIL))
(?(?{ joins($c, $d) })|(*FAIL))
(?{ say "$a $b $c $d" })
/x;

40
Task/Amb/Perl/amb-3.pl Normal file
View file

@ -0,0 +1,40 @@
use strict;
use warnings;
sub amb {
if( @_ == 0 ) {
no warnings 'exiting';
next AMB;
}
my $code = pop;
my @words = @_;
my @index = (0) x @words;
AMB: while( 1 ) {
my @w = map $words[$_][$index[$_]], 0 .. $#_;
return $code->( @w );
} continue {
my $i = 0;
while( ++$index[$i] == @{$words[$i]} ) {
$index[$i] = 0;
return if ++$i == @index;
}
}
}
my @w1 = qw(the that a);
my @w2 = qw(frog elephant thing);
my @w3 = qw(walked treaded grows);
my @w4 = qw(slowly quickly);
sub joined {
my ($join_a, $join_b) = @_;
substr($join_a, -1) eq substr($join_b, 0, 1);
}
amb( \(@w1, @w2, @w3, @w4), sub {
my ($w1, $w2, $w3, $w4) = @_;
amb() unless joined($w1, $w2);
amb() unless joined($w2, $w3);
amb() unless joined($w3, $w4);
print "$w1 $w2 $w3 $w4\n";
});

42
Task/Amb/REXX/amb-1.rexx
View file

@ -1,22 +1,20 @@
/*REXX program demonstrates Amd operator, choosing a word from each set.*/
@.= /*default value for any # of sets*/
@.1 = "the that a"
@.2 = "frog elephant thing"
@.3 = "walked treaded grows"
@.4 = "slowly quickly"
do j=1 until @.j==''; end; @.0=j-1 /*set @.0 to the number of sets.*/
call Amb 1 /*find combo of words that works.*/
exit /*stick a fork in it, we're done.*/
/*─────────────────────────────────────AMB procedure────────────────────*/
Amb: procedure expose @.; parse arg # _; arg . u; if #=='' then return
if #>@.0 then do; if u=='' then return /*return if no words are left. */
w=word(u,1) /*use upper case version of word.*/
do n=2 to words(u); c=word(u,n)
if left(c,1)\==right(w,1) then return; w=c
end /*n*/
say strip(_) /* _ has an extra leading blank. */
end
do k=1 for words(@.#)
call amb #+1 _ word(@.#,k) /*generate the next combination. */
end /*k*/
return
/*REXX program demonstrates the Amd operator, choosing a word from each set.*/
@.=; @.1 = "the that a"
@.2 = "frog elephant thing"
@.3 = "walked treaded grows"
@.4 = "slowly quickly"
do j=1 until @.j==''; end; @.0=j-1 /*define @.0 as the number of sets.*/
call Amb 1 /*find all word combinations that works*/
exit /*stick a fork in it, we're all done. */
/*────────────────────────────────────────────────────────────────────────────*/
Amb: procedure expose @.; parse arg # _; arg . u /*2nd parse uppercases U*/
if #>@.0 then do; w=word(u,1) /*W: is a uppercased U*/
do n=2 to words(u); ?=word(u,n)
if left(?,1)\==right(w,1) then return; w=?
end /*n*/
say space(_)
end
do k=1 for words(@.#) /*process words in sets.*/
call Amb #+1 _ word(@.#,k) /*generate combinations,*/
end /*k*/ /* [↑] (recursively).*/
return

2
Task/Amb/Ruby/amb.rb
View file

@ -1,3 +1,5 @@
require "continuation"
class Amb
class ExhaustedError < RuntimeError; end

26
Task/Amb/TXR/amb-1.txr
View file

@ -1,24 +1,2 @@
@(define first_last (first last whole))
@ (all)
@(skip :greedy)@{last 1}
@ (and)
@{first 1}@(skip)
@ (and)
@whole
@ (end)
@(end)
@(next "amb/set1")
@(skip)
@(first_last fi1 la1 w1)
@(next "amb/set2")
@(skip)
@(first_last la1 la2 w2)
@(next "amb/set3")
@(skip)
@(first_last la2 la3 w3)
@(next "amb/set4")
@(skip)
@(first_last la3 la4 w4)
@(output)
@w1 @w2 @w3 @w4
@(end)
(defmacro amb-scope (. forms)
^(block amb-scope ,*forms))

29
Task/Amb/TXR/amb-2.txr
View file

@ -1,24 +1,5 @@
@(define first_last (first last whole))
@ (all)
@(skip :greedy)@{last 1}
@ (and)
@{first 1}@(skip)
@ (and)
@whole
@ (end)
@(end)
@(next :list ("the" "that" "a"))
@(skip)
@(first_last fi1 la1 w1)
@(next :list ("frog" "elephant" "thing"))
@(skip)
@(first_last la1 la2 w2)
@(next :list ("walked" "treaded" "grows"))
@(skip)
@(first_last la2 la3 w3)
@(next :list ("slowly" "quickly"))
@(skip)
@(first_last la3 la4 w4)
@(output)
@w1 @w2 @w3 @w4
@(end)
(defun amb (. args)
(suspend amb-scope cont
(each ((a args))
(when (and a (call cont a))
(return-from amb a)))))

24
Task/Amb/TXR/amb-3.txr Normal file
View file

@ -0,0 +1,24 @@
@(define first_last (first last whole))
@ (all)
@(skip :greedy)@{last 1}
@ (and)
@{first 1}@(skip)
@ (and)
@whole
@ (end)
@(end)
@(next "amb/set1")
@(skip)
@(first_last fi1 la1 w1)
@(next "amb/set2")
@(skip)
@(first_last la1 la2 w2)
@(next "amb/set3")
@(skip)
@(first_last la2 la3 w3)
@(next "amb/set4")
@(skip)
@(first_last la3 la4 w4)
@(output)
@w1 @w2 @w3 @w4
@(end)

24
Task/Amb/TXR/amb-4.txr Normal file
View file

@ -0,0 +1,24 @@
@(define first_last (first last whole))
@ (all)
@(skip :greedy)@{last 1}
@ (and)
@{first 1}@(skip)
@ (and)
@whole
@ (end)
@(end)
@(next :list ("the" "that" "a"))
@(skip)
@(first_last fi1 la1 w1)
@(next :list ("frog" "elephant" "thing"))
@(skip)
@(first_last la1 la2 w2)
@(next :list ("walked" "treaded" "grows"))
@(skip)
@(first_last la2 la3 w3)
@(next :list ("slowly" "quickly"))
@(skip)
@(first_last la3 la4 w4)
@(output)
@w1 @w2 @w3 @w4
@(end)