Amb
You are encouraged to solve this task according to the task description, using any language you may know.
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 example is using amb to choose four words from the following strings:
set 1: "the" "that" "a"
set 2: "frog" "elephant" "thing"
set 3: "walked" "treaded" "grows"
set 4: "slowly" "quickly"
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").
Ada
<lang ada> with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with Ada.Text_IO; use Ada.Text_IO;
procedure Test_Amb is
type Alternatives is array (Positive range <>) of Unbounded_String;
type Amb (Count : Positive) is record
This : Positive := 1;
Left : access Amb;
List : Alternatives (1..Count);
end record;
function Image (L : Amb) return String is
begin
return To_String (L.List (L.This));
end Image;
function "/" (L, R : String) return Amb is
Result : Amb (2);
begin
Append (Result.List (1), L);
Append (Result.List (2), R);
return Result;
end "/";
function "/" (L : Amb; R : String) return Amb is
Result : Amb (L.Count + 1);
begin
Result.List (1..L.Count) := L.List ;
Append (Result.List (Result.Count), R);
return Result;
end "/";
function "=" (L, R : Amb) return Boolean is
Left : Unbounded_String renames L.List (L.This);
begin
return Element (Left, Length (Left)) = Element (R.List (R.This), 1);
end "=";
procedure Failure (L : in out Amb) is
begin
loop
if L.This < L.Count then
L.This := L.This + 1;
else
L.This := 1;
Failure (L.Left.all);
end if;
exit when L.Left = null or else L.Left.all = L;
end loop;
end Failure;
procedure Join (L : access Amb; R : in out Amb) is
begin
R.Left := L;
while L.all /= R loop
Failure (R);
end loop;
end Join;
W_1 : aliased Amb := "the" / "that" / "a"; W_2 : aliased Amb := "frog" / "elephant" / "thing"; W_3 : aliased Amb := "walked" / "treaded" / "grows"; W_4 : aliased Amb := "slowly" / "quickly";
begin
Join (W_1'Access, W_2); Join (W_2'Access, W_3); Join (W_3'Access, W_4); Put_Line (Image (W_1) & ' ' & Image (W_2) & ' ' & Image (W_3) & ' ' & Image (W_4));
end Test_Amb; </lang> The type Amb is implemented with the operations "/" to construct it from strings. Each instance keeps its state. The operation Failure performs back tracing. Join connects two elements into a chain. The implementation propagates Constraint_Error when matching fails. Sample output:
that thing grows slowly
ALGOL 68
Note: This program violates ALGOL 68's scoping rules when a locally scoped procedure is returned to a more global scope. ELLA ALGOL 68RS misses this violation, but ALGOL 68 Genie spots it at run time and then produces an assert. However ELLA ALGOL 68RS does produce the desired result, but may potentially suffer from "mysterious" stack problems. <lang algol>MODE STRINGS = [0][0]CHAR; MODE YIELDSTRINGS = PROC(STRINGS)VOID; MODE ITERSTRINGS = PROC(YIELDSTRINGS)VOID;
OP INITITERSTRINGS = (STRINGS self)ITERSTRINGS:
(YIELDSTRINGS yield)VOID: # scope violation #
FOR i TO UPB self DO
yield(self[i])
OD;
OP + = (ITERSTRINGS for strings, STRINGS b)ITERSTRINGS:
(YIELDSTRINGS yield)VOID: # scope violation #
for strings((STRINGS amb)VOID:(
[UPB amb + 1]STRING joined;
joined[:UPB amb] := amb;
STRING last string := amb[UPB amb];
CHAR last char := last string[UPB last string];
FOR i TO UPB b DO
IF last char = b[i][1] THEN
joined[UPB joined] := b[i];
yield(joined)
FI
OD
));
OP + = (STRINGS a, STRINGS b)ITERSTRINGS: INITITERSTRINGS a + b;
ITERSTRINGS for amb :=
STRINGS("the", "that", "a") +
STRINGS("frog", "elephant", "thing") +
STRINGS("walked", "treaded", "grows") +
STRINGS("slowly", "quickly");
STRINGS sep;
- FOR amb IN for amb DO#
for amb((STRINGS amb)VOID:( print((amb[1]," ",amb[2]," ",amb[3]," ",amb[4], new line)) ))
- OD#</lang>
Output:
that thing grows slowly
AutoHotkey
Search autohotkey.com: [1]
Source: AMB - Ambiguous selector by infogulch
<lang autohotkey>
set1 := "the that a"
set2 := "frog elephant thing"
set3 := "walked treaded grows"
set4 := "slowly quickly"
MsgBox % amb( "", set1, set2, set3, set4 )
- this takes a total of 17 iterations to complete
amb( char = "", set1 = "", set2 = "", set3 = "", set4 = "" ) { ; original call to amb must leave char param blank
Loop, Parse, set1, %A_Space%
If (char = (idxchar := SubStr(A_LoopField, 1, 1)) && set2 = ""
|| (char = idxchar || char = "") && ((retval:= amb(SubStr(A_LoopField, 0, 1), set2, set3, set4)) != ""))
Return A_LoopField " " retval
Return ""
} </lang>
C
Note: This uses the continuations code from http://homepage.mac.com/sigfpe/Computing/continuations.html <lang c> typedef const char * amb_t;
amb_t amb(size_t argc, ...) {
amb_t *choices;
va_list ap;
int i;
if(argc) {
choices = malloc(argc*sizeof(amb_t));
va_start(ap, argc);
i = 0;
do { choices[i] = va_arg(ap, amb_t); } while(++i < argc);
va_end(ap);
i = 0;
do { TRY(choices[i]); } while(++i < argc);
free(choices);
}
FAIL;
}
int joins(const char *left, const char *right) { return left[strlen(left)-1] == right[0]; }
int _main() {
const char *w1,*w2,*w3,*w4;
w1 = amb(3, "the", "that", "a");
w2 = amb(3, "frog", "elephant", "thing");
w3 = amb(3, "walked", "treaded", "grows");
w4 = amb(2, "slowly", "quickly");
if(!joins(w1, w2)) amb(0);
if(!joins(w2, w3)) amb(0);
if(!joins(w3, w4)) amb(0);
printf("%s %s %s %s\n", w1, w2, w3, w4);
return EXIT_SUCCESS;
} </lang>
E
E does not currently have any kind of backtracking control flow (though there is a proposal in the works to backtrack upon exceptions, for the sake of consistency). However, since (Almost) Everything Is Message Passing, we can create an object which represents a set of possible values.
This is complicated, however, by the fact that any given amb must appear to produce only one result; that is, def x := amb(["a", "b"]); x + x produces aa or bb, not aa,bb,ab,ba as amb(["a", "b"]) + amb(["a", "b"]) would. Therefore, each choice is associated with the decisions which produced it: a map from amb objects to which member of them was chosen; any combination of two ambs discards any combination of choices which have inconsistent decisions.
Note that the choices are not evaluated lazily; this is a breadth-first rather than depth-first search through possibilities. Also, every amb remembers all of the ambs which produced it. As such, this is probably not a practical system for large problems.
<lang e>pragma.enable("accumulator")
def [amb, unamb] := { # block hides internals
def Choice := Tuple[any, Map]
def [ambS, ambU] := <elib:sealing.makeBrand>("amb")
var counter := 0 # Used just for printing ambs
/** Check whether two sets of decisions are consistent */
def consistent(decA, decB) {
def overlap := decA.domain() & decB.domain()
for ambObj in overlap {
if (decA[ambObj] != decB[ambObj]) { return false }
}
return true
}
/** From an amb object, extract the possible choices */
def getChoices(obj, decisions) :List[Choice] {
if (decisions.maps(obj)) {
return [[decisions[obj], decisions]]
} else if (ambU.amplify(obj) =~ choices, _) {
return accum [] for [chosen, dec] ? (consistent(decisions, dec)) in choices { _ + getChoices(chosen, (decisions | dec).with(obj, chosen)) }
} else {
return obj, decisions
}
}
/** Construct an amb object with remembered decisions */
def ambDec(choices :List[Choice]) {
def serial := (counter += 1)
def ambObj {
to __printOn(out) {
out.print("<amb(", serial, ")")
for [chosen, decisions] in choices {
out.print(" ", chosen)
for k => v in decisions {
out.print(";", ambU.amplify(k)[0][1], "=", v)
}
}
out.print(">")
}
to __optSealedDispatch(brand) {
if (brand == ambS.getBrand()) {
return ambS.seal([choices, serial])
}
}
match [verb, args] {
var results := []
for [rec, rdec] in getChoices(ambObj, [].asMap()) {
def expandArgs(dec, prefix, choosing) {
switch (choosing) {
match [] { results with= [E.call(rec, verb, prefix), dec] }
match [argAmb] + moreArgs {
for [arg, adec] in getChoices(argAmb, dec) {
expandArgs(adec, prefix.with(arg), moreArgs)
}
}
}
}
expandArgs(rdec, [], args)
}
ambDec(results)
}
}
return ambObj
}
/** Construct an amb object with no remembered decisions. (public interface) */
def amb(choices) {
return ambDec(accum [] for c in choices { _.with([c, [].asMap()]) })
}
/** Get the possible results from an amb object, discarding decision info. (public interface) */
def unamb(ambObj) {
return accum [] for [c,_] in getChoices(ambObj, [].asMap()) { _.with(c) }
}
[amb, unamb]
}</lang>
<lang e>def join(a, b) {
# This must not use the builtin if, since it coerces to boolean rather than passing messages.
# false.pick(x, y) returns y and true.pick(x, y) returns x; we protect the amb([]) from causing
# unconditional failure by putting both options in functions.
# <=> is the comparison operator that happens to be message-based.
return (a.last() <=> b[0]).pick(fn {
a + " " + b
}, fn {
amb([])
})()
}
def w1 := amb(["the", "that", "a" ]) def w2 := amb(["frog", "elephant", "thing" ]) def w3 := amb(["walked", "treaded", "grows" ]) def w4 := amb(["slowly", "quickly" ])
unamb(join(join(join(w1, w2), w3), w4))</lang>
Comparison with Haskell
This can be compared with the Haskell use of lists as a monad to represent choice.
- Haskell uses lazy evaluation; E does not. This implementation does not simulate lazy evaluation with thunks; it is eager (computes every intermediate choice before continuing) and therefore inefficient if you only need one successful result.
- Haskell does not need to track decisions. This is because when using a monad in Haskell, the points of choice are explicitly written, either by monadic operators or combinators. The analogues to the two "ab" operations given above are:
do x <- ["a","b"]; return (x ++ x)anddo x <- ["a","b"]; y <- ["a","b"]; return (x ++ y)— the relevant difference being the number of<-operators. In this implementation, we instead absorb the choice into normal method calls; the Haskell analogue would be something likeinstance Monoid a => Monoid (Amb a) where Amb ... `mconcat` Amb ... = ..., which would have a similar need to track decisions.
Haskell
Haskell's List monad returns all the possible choices. Use the "head" function on the result if you just want one. <lang haskell> import Control.Monad
amb = id
joins left right = last left == head right
example = do
w1 <- amb ["the", "that", "a"] w2 <- amb ["frog", "elephant", "thing"] w3 <- amb ["walked", "treaded", "grows"] w4 <- amb ["slowly", "quickly"] unless (joins w1 w2) (amb []) unless (joins w2 w3) (amb []) unless (joins w3 w4) (amb []) return (unwords [w1, w2, w3, w4])
</lang>
Note that "amb" is defined as a no-op and is written only to help show the analogy with other implementations; ordinary style is to write e.g. w1 <- ["the", "that", "a"].
haXe
<lang haXe> class RosettaDemo {
static var SetA : Array<String> = ['the', 'that', 'a']; static var SetB : Array<String> = ['frog', 'elephant', 'thing']; static var SetC : Array<String> = ['walked', 'treaded', 'grows']; static var SetD : Array<String> = ['slowly', 'quickly'];
static public function main()
{
neko.Lib.print(AmbParse([ SetA, SetB, SetC, SetD ]).toString());
}
static function AmbParse(Sets : Array<Array<String>>)
{
var AmbData : Dynamic = Amb(Sets);
for (data in 0...AmbData.length)
{
var tmpData : String = parseIt(AmbData[data]);
var tmpArray : Array<String> = tmpData.split(' ');
tmpArray.pop();
if (tmpArray.length == Sets.length)
{
return tmpData;
}
}
return ; }
static function Amb(?StartingWith : String = , Sets : Array<Array<String>>)
{
if (Sets.length == 0 || Sets[0].length == 0) { return; }
var match : Dynamic = [];
for (Reference in 0...Sets[0].length)
{
if (StartingWith == || StartingWith == Sets[0][Reference].charAt(0))
{
if (Std.is(Amb(Sets[0][Reference].charAt(Sets[0][Reference].length-1), Sets.slice(1)), Array))
{
match.push([ Sets[0][Reference], Amb(Sets[0][Reference].charAt(Sets[0][Reference].length-1), Sets.slice(1))]);
}
else
{
match.push([ Sets[0][Reference] ]);
}
}
}
return match;
}
static function parseIt(data : Dynamic)
{
var retData : String = ;
if (Std.is(data, Array))
{
for (elements in 0...data.length)
{
if (Std.is(data[elements], Array))
{
retData = retData + parseIt(data[elements]);
}
else
{
retData = retData + data[elements] + ' ';
}
}
}
return retData;
}
} </lang>
Mathematica
Make all the tuples of all the lists, then filter out the good ones: <lang Mathematica>
CheckValid[i_List]:=If[Length[i]<=1,True,And@@(StringTake[#1,-1]==StringTake[#2,1]&/@Partition[i,2,1])] sets={{"the","that","a"},{"frog","elephant","thing"},{"walked","treaded","grows"},{"slowly","quickly"}}; Select[Tuples[sets],CheckValid]
</lang> gives back: <lang Mathematica> Template:"that", "thing", "grows", "slowly" </lang> Note that it will return multiple values if multiple sentences match the requirement, that is why the returned value is a list of list (1 element, 4 elements).
Prolog
<lang prolog> amb(E, [E|_]). amb(E, [_|ES]) :- amb(E, ES).
joins(Left, Right) :-
append(_, [T], Left), append([R], _, Right), ( T \= R -> amb(_, []) % (explicitly using amb fail as required) ; true ).
amb_example([Word1, Word2, Word3, Word4]) :-
amb(Word1, ["the","that","a"]), amb(Word2, ["frog","elephant","thing"]), amb(Word3, ["walked","treaded","grows"]), amb(Word4, ["slowly","quickly"]), joins(Word1, Word2), joins(Word2, Word3), joins(Word3, Word4).
</lang>
Python
Python does not have the amb function, but, in the spirit of the task, here is an implementation in Python (version 2.6) that uses un-ordered sets of words; the itertools.product function to loop through all the word sets lazily; and a generator comprehension to lazily give the first answer: <lang python> >>> from itertools import product >>> sets = [ set('the that a'.split()), set('frog elephant thing'.split()), set('walked treaded grows'.split()), set('slowly quickly'.split()) ] >>> success = ( sentence for sentence in product(*sets)
if all(sentence[word][-1]==sentence[word+1][0]
for word in range(3))
)
>>> success.next() ('that', 'thing', 'grows', 'slowly') >>> </lang>
The following is inspired by Haskell. For loops in a generator kind of act as an amb operator. Of course the indenting won't be right because for-blocks have to be indented. I will try to replicate the "amb with empty list" here faithfully but it is really awkward:. <lang python> def amb(*args): return args
def joins(left, right): return left[-1] == right[0]
def example():
for w1 in amb("the", "that", "a"):
for w2 in amb("frog", "elephant", "thing"):
for w3 in amb("walked", "treaded", "grows"):
for w4 in amb("slowly", "quickly"):
for _ in joins(w1,w2) and amb(42) or amb(): # this is really just "if joins(w1,w2):"
for _ in joins(w2,w3) and amb(42) or amb(): # this is really just "if joins(w2,w3):"
for _ in joins(w3,w4) and amb(42) or amb(): # this is really just "if joins(w3,w4):"
yield "%s %s %s %s" % (w1,w2,w3,w4)
</lang>
<lang python> >>> list(example()) ['that thing grows slowly'] </lang>
Ruby
<lang ruby> class Amb
class ExhaustedError < RuntimeError; end
def initialize
@fail = proc { fail ExhaustedError, "amb tree exhausted" }
end
def choose(*choices)
prev_fail = @fail
callcc { |sk|
choices.each { |choice|
callcc { |fk| @fail = proc { @fail = prev_fail fk.call(:fail) } if choice.respond_to? :call sk.call(choice.call) else sk.call(choice) end }
}
@fail.call
}
end
def failure choose end
def assert(cond) failure unless cond end
end
A = Amb.new w1 = A.choose("the", "that", "a") w2 = A.choose("frog", "elephant", "thing") w3 = A.choose("walked", "treaded", "grows") w4 = A.choose("slowly", "quickly")
A.choose() if not w1[-1] == w2[0] A.choose() if not w2[-1] == w3[0] A.choose() if not w3[-1] == w4[0]
puts w1, w2, w3, w4 </lang>
Scheme
<lang scheme> (define fail
(lambda () (error "Amb tree exhausted")))
(define-syntax amb
(syntax-rules ()
((AMB) (FAIL)) ; Two shortcuts.
((AMB expression) expression)
((AMB expression ...)
(LET ((FAIL-SAVE FAIL))
((CALL-WITH-CURRENT-CONTINUATION ; Capture a continuation to
(LAMBDA (K-SUCCESS) ; which we return possibles.
(CALL-WITH-CURRENT-CONTINUATION
(LAMBDA (K-FAILURE) ; K-FAILURE will try the next
(SET! FAIL K-FAILURE) ; possible expression.
(K-SUCCESS ; Note that the expression is
(LAMBDA () ; evaluated in tail position
expression)))) ; with respect to AMB.
...
(SET! FAIL FAIL-SAVE) ; Finally, if this is reached,
FAIL-SAVE))))))) ; we restore the saved FAIL.
(let ((w-1 (amb "the" "that" "a"))
(w-2 (amb "frog" "elephant" "thing"))
(w-3 (amb "walked" "treaded" "grows"))
(w-4 (amb "slowly" "quickly")))
(define (joins? left right)
(equal? (string-ref left (- (string-length left) 1)) (string-ref right 0)))
(if (joins? w-1 w-2) '() (amb))
(if (joins? w-2 w-3) '() (amb))
(if (joins? w-3 w-4) '() (amb))
(list w-1 w-2 w-3 w-4))
</lang>
SETL
<lang SETL>program amb;
sets := unstr('[{the that a} {frog elephant thing} {walked treaded grows} {slowly quickly}]');
words := [amb(words): words in sets]; if exists lWord = words(i), rWord in {words(i+1)} |
lWord(#lWord) /= rWord(1) then fail;
end if;
proc amb(words);
return arb {word in words | ok};
end proc;
end program;</lang> Sadly ok and fail were only ever implemented in CIMS SETL, and are not in any compiler or interpreter that is available today, so this is not very useful as it stands.
Alternate version (avoids backtracking)
<lang SETL>program amb;
sets := unstr('[{the that a} {frog elephant thing} {walked treaded grows} {slowly quickly}]');
print(amb(sets));
proc amb(sets);
return amb1([], {}, sets);
end proc;
proc amb1(prev, mbLast, sets);
if sets = [] then
return prev;
else
words fromb sets;
if exists word in words |
(forall last in mbLast |
last(#last) = word(1)) and
(exists sentence in {amb1(prev with word, {word}, sets)} |
true) then
return sentence;
end if;
end if;
end proc;
end program;</lang> We cheat a bit here - this version of amb must be given the whole list of word sets, and that list is consumed recursively. It can't pick a word from an individual list.
Tcl
Brute force, with quick kill of failing attempts: <lang Tcl>set amb {
{the that a}
{frog elephant thing}
{walked treaded grows}
{slowly quickly}
}
proc joins {a b} {
expr {[string index $a end] eq [string index $b 0]}
}
foreach i [lindex $amb 0] {
foreach j [lindex $amb 1] {
if ![joins $i $j] continue
foreach k [lindex $amb 2] {
if ![joins $j $k] continue
foreach l [lindex $amb 3] {
if [joins $k $l] {
puts [list $i $j $k $l]
}
}
}
}
}</lang> A more sophisticated using Tcl 8.6's coroutine facility that avoids the assumption of what the problem is in the code structure: <lang Tcl>proc cp {args} {
coroutine cp.[incr ::cps] apply {{list args} {
yield [info coroutine] foreach item $list { if {[llength $args]} { set c [cp {*}$args] while 1 { yield [list $item {*}[$c]] } } else { yield $item } } return -code break
}} {*}$args
} proc amb {name filter args} {
coroutine $name apply {{filter args} {
set c [cp {*}$args] yield [info coroutine] while 1 { set value [$c] if {[{*}$filter $value]} { yield $value } } return -code break
}} $filter {*}$args
}
proc joins {a b} {
expr {[string index $a end] eq [string index $b 0]}
} proc joins* list {
foreach a [lrange $list 0 end-1] b [lrange $list 1 end] {
if {![joins $a $b]} {return 0}
} return 1
}
amb words joins* \
{the that a} \
{frog elephant thing} \
{walked treaded grows} \
{slowly quickly}
while 1 { puts [words] }</lang>