Amb

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

Works with: ELLA ALGOL 68 version Any (with appropriate job cards) - tested with release 1.8-8d

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 algol68>MODE PAGE = FLEX[0]STRING; MODE YIELDPAGE = PROC(PAGE)VOID; MODE ITERPAGE = PROC(YIELDPAGE)VOID;

OP INITITERPAGE = (PAGE self)ITERPAGE:

 (YIELDPAGE yield)VOID: # scope violation #
   FOR i TO UPB self DO
     yield(self[i])
   OD;
     

OP + = (ITERPAGE for strings, PAGE b)ITERPAGE:

 (YIELDPAGE yield)VOID: # scope violation #
   for strings((PAGE 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 + = (PAGE a, PAGE b)ITERPAGE: INITITERPAGE a + b;

ITERPAGE gen amb :=

  PAGE("the", "that", "a") +
  PAGE("frog", "elephant", "thing") +
  PAGE("walked", "treaded", "grows") +
  PAGE("slowly", "quickly");

PAGE sep;

1. FOR PAGE amb IN # gen amb( # ) DO #
   1. (PAGE amb)VOID:

   print((amb[1]+" "+amb[2]+" "+amb[3]+" "+amb[4], new line))

1. 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>

C#

The implementation of the Amb class <lang csharp>using System; using System.Collections.Generic;

public class Amb : IDisposable {

   List<IValueSet> streams = new List<IValueSet>();
   List<IAssertOrAction> assertsOrActions = new List<IAssertOrAction>();
   volatile bool stopped = false;

   public IAmbValue<T> DefineValues<T>(params T[] values)
   {
       return DefineValueSet(values);
   }

   public IAmbValue<T> DefineValueSet<T>(IEnumerable<T> values)
   {
       ValueSet<T> stream = new ValueSet<T>();
       stream.Enumerable = values;
       streams.Add(stream);
       return stream;
   }

   public Amb Assert(Func<bool> function)
   {
       assertsOrActions.Add(new AmbAssert()
       {
           Level = streams.Count,
           IsValidFunction = function
       });
       return this;
   }

   public Amb Perform(Action action)
   {
       assertsOrActions.Add(new AmbAction()
       {
           Level = streams.Count,
           Action = action
       });
       return this;
   }

   public void Stop()
   {
       stopped = true;
   }

   public void Dispose()
   {
       RunLevel(0, 0);
       if (!stopped)
       {
           throw new AmbException();
       }
   }

   void RunLevel(int level, int actionIndex)
   {
       while (actionIndex < assertsOrActions.Count && assertsOrActions[actionIndex].Level <= level)
       {
           if (!assertsOrActions[actionIndex].Invoke() || stopped)
               return;
           actionIndex++;
       }
       if (level < streams.Count)
       {
           using (IValueSetIterator iterator = streams[level].CreateIterator())
           {
               while (iterator.MoveNext())
               {
                   RunLevel(level + 1, actionIndex);
               }
           }
       }
   }

   interface IValueSet
   {
       IValueSetIterator CreateIterator();
   }

   interface IValueSetIterator : IDisposable
   {
       bool MoveNext();
   }

   interface IAssertOrAction
   {
       int Level { get; }
       bool Invoke();
   }

   class AmbAssert : IAssertOrAction
   {
       internal int Level;
       internal Func<bool> IsValidFunction;

       int IAssertOrAction.Level { get { return Level; } }

       bool IAssertOrAction.Invoke()
       {
           return IsValidFunction();
       }
   }

   class AmbAction : IAssertOrAction
   {
       internal int Level;
       internal Action Action;

       int IAssertOrAction.Level { get { return Level; } }

       bool IAssertOrAction.Invoke()
       {
           Action(); return true;
       }
   }

   class ValueSet<T> : IValueSet, IAmbValue<T>, IValueSetIterator
   {
       internal IEnumerable<T> Enumerable;
       private IEnumerator<T> enumerator;

       public T Value { get { return enumerator.Current; } }

       public IValueSetIterator CreateIterator()
       {
           enumerator = Enumerable.GetEnumerator();
           return this;
       }

       public bool MoveNext()
       {
           return enumerator.MoveNext();
       }

       public void Dispose()
       {
           enumerator.Dispose();
       }
   }

}

public interface IAmbValue<T> {

   T Value { get; }

}

public class AmbException : Exception {

   public AmbException() : base("AMB is angry") { }

} </lang>

Usage:

<lang csharp> // original problem

   using (Amb amb = new Amb())
   {
       var set1 = amb.DefineValues("the", "that", "a");
       var set2 = amb.DefineValues("frog", "elephant", "thing");
       var set3 = amb.DefineValues("walked", "treaded", "grows");
       var set4 = amb.DefineValues("slowly", "quickly");

       amb.Assert(() => IsJoinable(set1.Value, set2.Value));
       amb.Assert(() => IsJoinable(set2.Value, set3.Value));
       amb.Assert(() => IsJoinable(set3.Value, set4.Value));

       amb.Perform(() =>
           {
               System.Console.WriteLine("{0} {1} {2} {3}", set1.Value, set2.Value, set3.Value, set4.Value);
               amb.Stop();
           });
   }
   // problem from http://www.randomhacks.net/articles/2005/10/11/amb-operator
   using (Amb amb = new Amb())
   {
       IAmbValue<int> x = amb.DefineValues(1, 2, 3);
       IAmbValue<int> y = amb.DefineValues(4, 5, 6);
       amb.Assert(() => x.Value * y.Value == 8);
       amb.Perform(() =>
           {
               System.Console.WriteLine("{0} {1}", x.Value, y.Value);
               amb.Stop();
           });
   }

</lang>

Clojure

<lang clojure>(ns amb

 (:use clojure.contrib.monads))

(defn amb [wss]

 (let [valid-word (fn [w1 w2]
                    (if (and w1 (= (last w1) (first w2)))
                      (str w1 " " w2)))]
   (filter #(reduce valid-word %)
           (with-monad sequence-m (m-seq wss)))))

amb> (amb '(("the" "that" "a") ("frog" "elephant" "thing") ("walked" "treaded" "grows") ("slowly" "quickly"))) (("that" "thing" "grows" "slowly")) </lang>

Common Lisp

Common Lisp lacks the call/cc present in Scheme, and so the straightforward implementation using continuations would require a full-blown code walker (and could still have some issues with dynamically bound variables). A workable compromise uses the condition system and some convenience macros to define amblet a binding construct like let except that if a variable's init-form is of the form (amb {form}*) the amblet's body will be evaluated with the variable bound to successive values produced by each form until some evaluation does not signal an amb-error.

<lang lisp>(define-condition amb-failure () ()

 (:report "No amb alternative succeeded."))

(defun invoke-ambiguously (function thunks)

 "Call function with successive values produced by successive

functions in thunks until some invocation of function does not signal an amb-failure."

 (do ((thunks thunks (rest thunks)))
     ((endp thunks) (error 'amb-failure))
   (let ((argument (funcall (first thunks))))
     (handler-case (return (funcall function argument))
       (amb-failure ())))))

(defmacro amblet1 ((var form) &body body)

 "If form is of the form (amb {form}*) then amblet1 is a convenient

syntax for invoke-ambiguously, by which body is evaluated with var bound the results of each form until some evaluation of body does not signal an amb-failure. For any other form, amblet binds var the result of form, and evaluates body."

 (if (and (listp form) (eq (first form) 'amb))
   `(invoke-ambiguously
     #'(lambda (,var) ,@body)
     (list ,@(loop for amb-form in (rest form)
                   collecting `#'(lambda () ,amb-form))))
   `(let ((,var ,form))
      ,@body)))

(defmacro amblet (bindings &body body)

 "Like let, except that if an init-form is of the form (amb {form}*),

then the corresponding var is bound with amblet1."

 (if (endp bindings)
   `(progn ,@body)
   `(amblet1 ,(first bindings)
      (amblet ,(rest bindings)
        ,@body))))</lang>

Example:

> (flet ((string-adjacent (s1 s2)
           (char= (char s1 (1- (length s1)))
                  (char s2 0))))
    (amblet ((w1 (amb "the" "that" "a"))
             (w2 (amb "frog" "elephant" "thing"))
             (w3 (amb "walked" "treaded" "grows"))
             (w4 (amb "slowly" "quickly")))
      (if (and (string-adjacent w1 w2)
               (string-adjacent w2 w3)
               (string-adjacent w3 w4))
        (list w1 w2 w3 w4)
        (signal 'amb-failure))))
("that" "thing" "grows" "slowly")

D

This example may not display the original intent of this exercise, since the implementer was not fully aware of what the amb operator is used for. <lang d> import std.stdio; import std.string; char[][]set1 = ["the","that","a"]; char[][]set2 = ["frog","elephant","thing"]; char[][]set3 = ["walked","treaded","grows"]; char[][]set4 = ["slowly","quickly"];

// this amb function takes a function pointer to a comparison function and the possibilities that need to be checked char[][]amb(bool function(char[],char[])comp,char[][][]options,char[]prev = "") {

       char[][]res;
       char[][]set = options[0];
       options = options[1..$];
       foreach(opt;set) {
               // if this is the base call, prev is "" and we need to continue (unfortunately, this is array specific,
               // but could be reworked with pointers)
               if (!prev.length || comp(prev,opt)) {
                       // take care of the case where we have no options left
                       if (!options.length) return [opt];
                       // traverse into the tree
                       res = amb(comp,options,opt);
                       // if it was a failure, try the next one
                       if (res is null) continue;
                       // we have a match!
                       else return opt~res;
               }
       }
       // no matches
       return null;

}

bool comparator(char[]left,char[]right) {

       return left[$-1] == right[0];

}

int main() {

       // pass in the comparator and the available sets
       char[][]ret = amb(&comparator,[set1,set2,set3,set4]);
       if (ret is null) writefln("No matches found!");
       else writefln("%s",ret.join(" "));
       return 0;

} </lang>

E

Some lines in this example are too long (more than 80 characters). Please fix the code if it's possible and remove this message.

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) and do 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 like instance Monoid a => Monoid (Amb a) where Amb ... `mconcat` Amb ... = ..., which would have a similar need to track decisions.

Ela

<lang ela>open Core

let amb [] _ _ = None

   amb (x::xs) next w | eq' w x, next x is Some x' = Some (x ++ " " ++ x')
                      | else = amb xs next w
                      where eq' w x | w == "" = true
                                    | else = last w == head x</lang>

Usage:

<lang ela>let (Some x) = f ""

   where f = 
       amb ["the","that","a"] 
       <| amb ["frog","elephant","thing"] 
       <| amb ["walked","treaded","grows"]
       <| amb ["slowly","quickly"] (\_ -> Some "")
   in x</lang>

Elena

The implementation

<lang elena>#define basic'* = std'basic'*.

1. define ctrl'* = std'patterns'*.
2. define exctrl'* = ext'patterns'*.

1. subject amb_enumerator.

// --- AmbEnumerator ---

1. class AmbEnumerator

{

   #field theValues.
   
   #role BOF
   {
       #method proceed
       [
           theValues $reset.
           
           #shift.
           
           ^ basic'True.
       ]
   }
   
   #method new : Values
   [
       theValues := Values.
       
       #shift BOF.
   ]
    
   #method proceed
   [
       ^ theValues $next.
   ]
   
   #method clear
   [
       #shift BOF.
   ]
   
   #method get = theValues.

}

// --- AmbValue ---

1. class AmbValue

{

   #field theValues.
   #field theCurrent.
   
   #method enumerator = AmbEnumerator::self.
   
   #method $reset
   [
       theCurrent := theValues@0.
   ]
   
   #method $next
   [
       #var anIndexer := theCurrent indexer.
       
       anIndexer += 1.
       
       ^ anIndexer eof'is back:basic'False | back:basic'True.
   ]
   
   #method new : Values
   [
       theValues := Values.
       theCurrent := nil.
   ]
   
   #union (theCurrent primary).

}

// --- AmbExpression ---

1. symbol AmbOperator : Values =

{

   seek : anExpression
   [
       ctrl'Control run &enumerator:(exctrl'MultiEnumerator::Values) &foreach: aCurrent =>
       [
           ^ anExpression evaluate inverted.
       ].
   ]

}. </lang>

Usage:

<lang elena>// --- Joinable ---

1. symbol Join =

{

   if &first:aFirst &second:aSecond
   [
       ^ aFirst@(aFirst length - 1) == aSecond@0.
   ]

}.

1. symbol Joinable : aPair = Join if:(ctrl'Args::aPair).

1. symbol Program =>

[

   #var A := AmbValue::("the","that","a").
   #var B := AmbValue::("frog", "elephant", "thing").
   #var C := AmbValue::("walked", "treaded", "grows").
   #var D := AmbValue::("slowly", "quickly").

   AmbOperator::(A, B, C, D) seek:
      => (Joinable::(A,B) and:(Joinable::(B,C)) and:(Joinable::(C,D))).
   
   'program'Output << A << " " << B << " " << C << " " << D.

]. </lang>

Factor

<lang factor>USING: backtrack continuations kernel prettyprint sequences ; IN: amb

CONSTANT: words {

   { "the" "that" "a" }
   { "frog" "elephant" "thing" }
   { "walked" "treaded" "grows" }
   { "slowly" "quickly"  }

}

letters-match? ( str1 str2 -- ? ) [ last ] [ first ] bi* = ;

sentence-match? ( seq -- ? ) dup rest [ letters-match? ] 2all? ;

select ( seq -- seq' ) [ amb-lazy ] map ;

search ( -- )

   words select dup sentence-match? [ " " join ] [ fail ] if . ;

MAIN: search</lang>

Running it from the listener :

( scratchpad ) "amb" run
"that thing grows slowly"

F#

Translation of: Haskell

Important differences to the Haskell solution:

• The list monad is not predefined in F#. (But it is easy to define it.)
• F# is not lazy, so this will check all combinations even if we just want one solution.

Both problems could be addressed by using sequence expressions instead.

<lang fsharp>// define the List "workflow" (monad) type ListBuilder() =

  member o.Bind( lst, f ) = List.concat( List.map (fun x -> f x) lst )
  member o.Return( x ) = [x]
  member o.Zero() = []

let list = ListBuilder()

let amb = id

// last element of a sequence let last s = Seq.nth ((Seq.length s) - 1) s

// is the last element of left the same as the first element of right? let joins left right = last left = Seq.head right

let example = list { let! w1 = amb ["the"; "that"; "a"]

                    let! w2 = amb ["frog"; "elephant"; "thing"]
                    let! w3 = amb ["walked"; "treaded"; "grows"]
                    let! w4 = amb ["slowly"; "quickly"]
                    if joins w1 w2 &&
                       joins w2 w3 &&
                       joins w3 w4
                    then
                       return String.concat " " [w1; w2; w3; w4]
                  }

printfn "%s" (List.head example)</lang>

Go

<lang Go>package main import "fmt"

func amb(wordsets [][]string, res []string) bool { if len(wordsets) == 0 { return true }

var s string

l := len(res) if l > 0 { s = res[l - 1] }

// odd Go syntax for pre-alloc'd array res = res[0:len(res) + 1]

for _, res[l] = range(wordsets[0]) { if l > 0 && s[len(s) - 1] != res[l][0] { continue }

if amb(wordsets[1:len(wordsets)], res) { return true } }

return false }

func main() { wordset := [][]string { { "the", "that", "a" }, { "frog", "elephant", "thing" }, { "walked", "treaded", "grows" }, { "slowly", "quickly" } } res := make([]string, len(wordset))

if amb(wordset, res[0:0]) { fmt.Println(res) } else { fmt.Println("No amb found") } }</lang>

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

Some lines in this example are too long (more than 80 characters). Please fix the code if it's possible and remove this message.

<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>

Icon and Unicon

<lang icon>procedure main()

   s1 := ["the","that","a"]
   s2 := ["frog","elephant","thing"]
   s3 := ["walked","treaded","grows"]
   s4 := ["slowly","quickly"]

   write(amb(!s1,!s2,!s3,!s4))

end

procedure amb(exprs[])

   s := ""
   every e := !exprs do {
       if \c ~== e[1] then fail
       c := e[-1]
       s ||:= e || " "
       }
   return s

end</lang>

J

<lang j>

  amb=. ([ , ' ' , ])&>/&.>@:((({:@:[ = {.@:])&>/&> # ])@:,@:({@(,&<)))
  >@(amb&.>/) ('the';'that';'a');('frog';'elephant';'thing');('walked';'treaded';'grows');(<'slowly';'quickly')

+-----------------------+ |that thing grows slowly| +-----------------------+ </lang> amb is a dyadic verb: <lang j>

  ('the';'that';'a') amb ('frog';'elephant';'thing') amb ('walked';'treaded';'grows') amb ('slowly';'quickly')

+-----------------------+ |that thing grows slowly| +-----------------------+ </lang> A structured derivation of amb follows: <lang j>

  NB. Dynamic programming method...
  
  o=. @:                NB. Composing verbs
  success=. {:o[ = {.o] NB. Is the last letter of the left word equal to the first of the right?
  join=. [ , ' ' , ]    NB. Joining the left and right words
  cp=. {@(,&<)          NB. Cartesian product
  
  amb=. join&>/&.> o ((success&>/ &> # ]) o , o cp)f.
  amb NB. Showing the point-free code...

([ , ' ' , ])&>/&.>@:((({:@:[ = {.@:])&>/&> # ])@:,@:({@(,&<))) </lang>

JavaScript

<lang javascript> function ambRun(func) {

   var choices = [];
   var index;

   function amb(values) {
       if (values.length == 0) {
           fail();
       }
       if (index == choices.length) {
           choices.push({i: 0,
                         count: values.length});
       }
       var choice = choices[index++];
       return values[choice.i];
   }

   function fail() { throw fail; }

   while (true) {
       try {
           index = 0;
           return func(amb, fail);
       } catch (e) {
           if (e != fail) {
               throw e;
           }
           var choice;
           while ((choice = choices.pop()) && ++choice.i == choice.count) {}
           if (choice == undefined) {
               return undefined;
           }
           choices.push(choice);
       }
   }

}

ambRun(function(amb, fail) {

   function linked(s1, s2) {
       return s1.slice(-1) == s2.slice(0, 1);
   }

   var w1 = amb(["the", "that", "a"]);
   var w2 = amb(["frog", "elephant", "thing"]);
   if (!linked(w1, w2)) fail();

   var w3 = amb(["walked", "treaded", "grows"]);
   if (!linked(w2, w3)) fail();

   var w4 = amb(["slowly", "quickly"]);
   if (!linked(w3, w4)) fail();

   return [w1, w2, w3, w4].join(' ');

}); // "that thing grows slowly" </lang>

Lua

<lang lua>function amb (set)

   local workset = {}
   if (#set == 0) or (type(set) ~= 'table') then return end
   if #set == 1 then return set end
   if #set > 2 then
       local first = table.remove(set,1)
       set = amb(set)
       for i,v in next,first do
           for j,u in next,set do
               if v:byte(#v) == u[1]:byte(1) then table.insert(workset, {v,unpack(u)}) end
           end
       end
       return workset
   end
   for i,v in next,set[1] do
       for j,u in next,set[2] do
           if v:byte(#v) == u:byte(1) then table.insert(workset,{v,u}) end
       end
   end
   return workset

end</lang> Usage example: <lang lua>result = amb({{'the','that','a'},{'frog','elephant','thing'},{'walked','treaded','grows'},{'slowly','quickly'}}) for i,v in next,result do

   io.write (i,':\t')
   for j,u in next,v do
       io.write (u,' ')
   end
   io.write ('\n')

end</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).

Alternative algorithm (slightly faster on most data sets): <lang Mathematica>CheckValid2[i_List] := StringFreeQ[StringJoin[Riffle[i, ","]], a_ ~~ "," ~~ b_ /; a =!= b]</lang>

OCaml

There is no Amb operator in OCaml. So below are two solutions to solve the same task. The first one is the more idiomatic for OCaml (and is similar to the Haskell solution), it builds all possible combinations and then take the good result in it.

The second solution tries to be closer to the way of solving the problem of Amb. It does not build and accumulate the combinations, it iterates over these with a higher order function and it stops when it finds a solution that matches the predicate.

Filtering possible combinations

<lang ocaml>let set_1 = ["the"; "that"; "a"] let set_2 = ["frog"; "elephant"; "thing"] let set_3 = ["walked"; "treaded"; "grows"] let set_4 = ["slowly"; "quickly"]

let combs ll =

 let rec aux acc = function
 | [] -> (List.map List.rev acc)
 | hd::tl ->
     let acc =
       List.fold_left
         (fun _ac l ->
           List.fold_left (fun _ac v -> (v::l)::_ac) _ac hd
         ) [] acc
     in
     aux acc tl
 in
 aux [[]] ll

let last s = s.[pred(String.length s)] let joined a b = (last a = b.[0])

let rec test = function

 | a::b::tl -> (joined a b) && (test (b::tl))
 | _ -> true

let print_set set =

 List.iter (Printf.printf " %s") set;
 print_newline();

let () =

 let sets = combs [set_1; set_2; set_3; set_4] in
 let sets = List.filter test sets in
 List.iter print_set sets;

</lang>

We can take all the good results with List.filter or just take the first one with List.find.

Higher order function

Here the function comb_search replaces the function combs and uses arrays instead of lists. This function takes successively all the possible results by their indicies (with the array nx). When a result satisfies the predicate p, it is returned.

<lang ocaml>let set_1 = [| "the"; "that"; "a" |] let set_2 = [| "frog"; "elephant"; "thing" |] let set_3 = [| "walked"; "treaded"; "grows" |] let set_4 = [| "slowly"; "quickly" |]

let comb_search p aa =

 let nx = Array.make (Array.length aa) 0 in
 let lx = Array.map Array.length aa in
 let la = Array.length aa in
 let rec loop() =
   let res = Array.mapi (fun i j -> aa.(i).(j)) nx in
   if p res then (res)
   else    
   ( nx.(0) <- nx.(0) + 1;
     if nx.(0) < lx.(0)
     then loop()
     else
     ( nx.(0) <- 0;
       let rec roll n =
         if n >= la then raise Not_found
         else 
         ( nx.(n) <- nx.(n) + 1;
           if nx.(n) >= lx.(n)
           then ( nx.(n) <- 0; roll (n+1) )
           else loop()
         )
       in
       roll 1
     )
   )
 in
 loop()
 

let last s = s.[pred(String.length s)] let joined a b = (last a = b.[0])

let rec test = function

 | a::b::tl -> (joined a b) && (test (b::tl))
 | _ -> true

let test r = test(Array.to_list r)

let print_set set =

 Array.iter (Printf.printf " %s") set;
 print_newline();

let () =

 let result = comb_search test [| set_1; set_2; set_3; set_4 |] in
 print_set result;

</lang>

OpenEdge/Progress

<lang progress>DEF VAR cset AS CHAR EXTENT 4 INIT [

  "the,that,a",
  "frog,elephant,thing", 
  "walked,treaded,grows",
  "slowly,quickly"

].

FUNCTION getAmb RETURNS CHARACTER (

  i_cwords AS CHAR,
  i_iset   AS INT

):

  DEF VAR cresult   AS CHAR.
  DEF VAR ii        AS INT.
  DEF VAR cword     AS CHAR.

  DO ii = 1 TO NUM-ENTRIES( cset [ i_iset ] ) WHILE NUM-ENTRIES( cresult, " " ) < EXTENT( cset ):

     cword = ENTRY( ii, cset[ i_iset ] ).
     IF i_cwords = "" OR 
        SUBSTRING( i_cwords, LENGTH( i_cwords ), 1 ) = SUBSTRING( cword, 1, 1 )
     THEN DO:
        IF i_iset = EXTENT ( cset ) THEN
           cresult = i_cwords + " " + cword.
        ELSE
           cresult = getAmb( i_cwords + " " + cword, i_iset + 1 ).
     END.

  END.

  RETURN cresult.

END FUNCTION. /* getAmb */

MESSAGE getAmb( "", 1 ) VIEW-AS ALERT-BOX.</lang>

Output:

---------------------------
Message
---------------------------
 that thing grows slowly
---------------------------
OK   
---------------------------

Oz

Oz is, among other things, a logic programming language and has a choice operator. Using recursion we can easily build an Amb operator with it. <lang oz>declare

 fun {Amb Xs}
    case Xs of nil then fail
    [] [X] then X
    [] X|Xr then
       choice X
       [] {Amb Xr}
       end
    end
 end

 fun {Example}
    W1 = {Amb ["the" "that" "a"]}
    W2 = {Amb ["frog" "elephant" "thing"]}
    W3 = {Amb ["walked" "treaded" "grows"]}
    W4 = {Amb ["slowly" "quickly"]}
 in
    {List.last W1 W2.1}
    {List.last W2 W3.1}
    {List.last W3 W4.1}
    W1#" "#W2#" "#W3#" "#W4
 end

in

 {ForAll {SearchAll Example} System.showInfo}</lang>

In Oz, the programmer explicitly controls how a logic program is executed (search strategy, number of required solutions, laziness, which physical machines are used for the search process...). In this case we use the predefined function SearchAll to eagerly calculate all possible solution. All work is done within the current process.

PARI/GP

<lang parigp>Amb(V)={ amb(vector(#V,i,vector(#V[i],j,Vec(V[i][j]))),[]) }; amb(V,s)={ if (#V == 0, return(concat(s))); my(v=V[1],U=vecextract(V,2^#V-2),t,final=if(#s,s[#s])); if(#s, s = concat(s,[" "])); for(i=1,#v, if ((#s == 0 | final == v[i][1]), t = amb(U, concat(s, v[i])); if (t, return(t)) ) ); 0 }; Amb([["the","that","a"],["frog","elephant","thing"],["walked","treaded","grows"],["slowly","quickly"]])</lang>

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>

Perl

Generates permutation of the sets with the glob function. Then, validate the combination with a regular expression. <lang perl>$s1 = "the|,that|,a|"; $s2 = "frog|,elephant|,thing|"; $s3 = "walked|,treaded|,grows|"; $s4 = "slowly|,quickly|";

$sets = "{$s1}{$s2}{$s3}{$s4}"; print "$sets\n";

for( glob($sets) ) {

       tr/|/ /;
       print "$_\n" if(m/\w+?(\w) \1\w+?(\w) \2\w+?(\w) \3\w+/);

}</lang>

PicoLisp

For backtracking, Pilog (PicoLisp Prolog) is the natural choice.

Translation of: Prolog

<lang PicoLisp>(be amb (@E @Lst)

  (lst @E @Lst) )

(be joins (@Left @Right)

  (@T last (chop (-> @Left)))
  (@R car (chop (-> @Right)))
  (or
     ((equal @T @R))
     ((amb @ NIL)) ) )  # Explicitly using amb fail as required

(be ambExample ((@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>

Output:

: (? (ambExample @Result))
 @Result=("that" "thing" "grows" "slowly")
-> NIL

PureBasic

<lang PureBasic>Procedure Words_Ok(String1.s, String2.s)

 If Mid(String1,Len(String1),1)=Mid(String2,1,1)
   ProcedureReturn #True
 EndIf
 ProcedureReturn #False

EndProcedure

Procedure.s Amb(Array A.s(1), Array B.s(1), Array C.s(1), Array D.s(1))

 Protected a, b, c, d
 For a=0 To ArraySize(A())
   For b=0 To ArraySize(B())
     For c=0 To ArraySize(C())
       For d=0 To ArraySize(D())
         If Words_Ok(A(a),B(b)) And Words_Ok(B(b),C(c)) And Words_Ok(C(c),D(d))
           ProcedureReturn A(a)+" "+B(b)+" "+C(c)+" "+D(d)
         EndIf
       Next
     Next
   Next
 Next
 ProcedureReturn ""   ; Empty string, e.g. fail

EndProcedure

If OpenConsole()

 Define Text.s
 Dim Set1.s(2)
 Dim Set2.s(2)
 Dim Set3.s(2)
 Dim Set4.s(1)
 
 Set1(0)="the":    set1(1)="that":     set1(2)="a"
 Set2(0)="frog":   set2(1)="elephant": set2(2)="thing" 
 Set3(0)="walked": set3(1)="treaded":  set3(2)="grows" 
 Set4(0)="slowly": set4(1)="quickly"
 
 text=Amb(set1(),set2(),Set3(),set4())
 If Text<>""
   PrintN("Correct sentence would be,"+#CRLF$+Text)
 Else
   PrintN("Failed to fine a correct sentence.")
 EndIf
 PrintN(#CRLF$+#CRLF$+"Press ENTER to exit."): Input()
 CloseConsole()

EndIf</lang>

Python

(Note: The code is also imported and used as a module in the solution to this task).

Python does not have the amb function, but the declarative style of programming and the use of the one "function" to do all three tasks of:

• Setting ranges
• Setting the constraint
• Iterating over all solutions

can be done in what appears to be a declarative manner with the following class Amb: <lang python>import itertools as _itertools

class Amb(object):

   def __init__(self):
       self._names2values   = {}       # set of values for each global name
       self._func           = None     # Boolean constraint function
       self._valueiterator  = None     # itertools.product of names values
       self._funcargnames   = None     # Constraint parameter names

   def __call__(self, arg=None):
       if hasattr(arg, 'func_globals'):
           ##
           ## Called with a constraint function. 
           ##
           globls = arg.func_globals
           # Names used in constraint
           argv = arg.__code__.co_varnames[:arg.__code__.co_argcount]
           for name in argv:
               if name not in self._names2values:
                   assert name in globls, \
                          "Global name %s not found in function globals" % name
                   self._names2values[name] = globls[name]
           # Gather the range of values of all names used in the constraint
           valuesets = [self._names2values[name] for name in argv]
           self._valueiterator = _itertools.product(*valuesets)
           self._func = arg
           self._funcargnames = argv
           return self
       elif arg is not None:
           ##
           ## Assume called with an iterable set of values
           ##
           arg = frozenset(arg)
           return arg
       else:
           ##
           ## blank call tries to return next solution
           ##
           return self._nextinsearch()

   def _nextinsearch(self):
       arg = self._func
       globls = arg.func_globals
       argv = self._funcargnames
       found = False
       for values in self._valueiterator:
           if arg(*values):
               # Set globals.
               found = True
               for n, v in zip(argv, values):
                   globls[n] = v
               break
       if not found: raise StopIteration
       return values

   def __iter__(self):
       return self
   
   def next(self):
       return self()

if __name__ == '__main__':

   if True:
       amb = Amb()
       
       print("\nSmall Pythagorean triples problem:")
       x = amb(range(1,11))
       y = amb(range(1,11))
       z = amb(range(1,11))

       for _dummy in amb( lambda x, y, z: x*x + y*y == z*z ):
           print x, y, z

   if True:
       amb = Amb()
       
       print("\nRosetta Code Amb problem:")
       w1 = amb(["the", "that", "a"])
       w2 = amb(["frog", "elephant", "thing"])
       w3 = amb(["walked", "treaded", "grows"])
       w4 = amb(["slowly", "quickly"])

       for _dummy in amb( lambda w1, w2, w3, w4: \
                            w1[-1] == w2[0] and \
                            w2[-1] == w3[0] and \
                            w3[-1] == w4[0] ):
           print w1, w2, w3, w4

   if True:
       amb = Amb()
       
       print("\nAmb problem from "
           "http://www.randomhacks.net/articles/2005/10/11/amb-operator:")
       x = amb([1, 2, 3])
       y = amb([4, 5, 6])

       for _dummy in amb( lambda x, y: x * y != 8 ):
           print x, y

</lang>

Sample output:

Small Pythagorean triples problem:
3 4 5
4 3 5
6 8 10
8 6 10

Rosetta Code Amb problem:
that thing grows slowly

Amb problem from http://www.randomhacks.net/articles/2005/10/11/amb-operator:
1 4
1 5
1 6
2 5
2 6
3 4
3 5
3 6

R

A brute force approach that depends on the expand.grid() function, which generates all possible paths through a list of vectors: <lang> checkSentence <- function(sentence){

1. Input: character vector
2. Output: whether the sentence formed by the elements of the vector is valid

 for (index in 1:(length(sentence)-1)){
   first.word  <- sentence[index]
   second.word <- sentence[index+1]
   
   last.letter  <- substr(first.word, nchar(first.word), nchar(first.word))
   first.letter <- substr(second.word, 1, 1)
   
   if (last.letter != first.letter){ return(FALSE) } 
 }
 return(TRUE)

}

amb <- function(sets){

1. Input: list of character vectors containing all sets to consider
2. Output: list of character vectors that are valid

 all.paths      <- apply(expand.grid(sets), 2, as.character)
 all.paths.list <- split(all.paths, 1:nrow(all.paths))
 winners        <- all.paths.list[sapply(all.paths.list, checkSentence)]
 return(winners)

} </lang>

Some sample output: <lang> sentence1 <- c("that", "thing", "grows", "slowly") sentence2 <- c("rosetta", "code", "is", "cool") sentence <- list(sentence1, sentence2) sapply(sentence, checkSentence) [1] TRUE FALSE

set1 <- c("the", "that", "a") set2 <- c("frog", "elephant", "thing") set3 <- c("walked", "treaded", "grows") set4 <- c("slowly", "quickly") sets <- list(set1, set2, set3, set4) amb(sets) $`26` [1] "that" "thing" "grows" "slowly" </lang>

REXX

The example didn't say so, but an assumption made (for this program) that
lowercase and uppercase letters are considered to be considered a match. <lang rexx> /*REXX program demonstrates Amd operator (choosing 4 words from 4 sets).*/

@.= /*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  /*find how many sets there are.  */
                                      /*@.0   contains number of sets. */

call Amb 1 /*find combo of words that works.*/ exit

/*─────────────────────────────────────AMB procedure────────────────────*/ Amb: procedure expose @.; parse arg # _; arg . u; if #== then return if #>@.0 then do; if u== then return

             w=word(u,1)              /*(Below) use upper case version.*/
                  do n=2 to words(_)
                  c=word(u,n); if left(c,1)\==right(w,1) then return; w=c
                  end
             say strip(_)             /*_ has an extra leading blank.  */
             end
 do j=1 for words(@.#)
 call amb #+1 _ word(@.#,j)           /*generate the next combination. */
 end

return </lang> Output

that thing grows slowly

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() unless w1[-1] == w2[0] A.choose() unless w2[-1] == w3[0] A.choose() unless w3[-1] == w4[0]

puts w1, w2, w3, w4 </lang>

Scala

<lang Scala> object Amb {

 def amb(wss: List[List[String]]): Option[String] = {
   def _amb(ws: List[String], wss: List[List[String]]): Option[String] = wss match {
     case Nil => ((Some(ws.head): Option[String]) /: ws.tail)((a, w) => a match {
       case Some(x) => if (x.last == w.head) Some(x + " " + w) else None
       case None => None
     })
     case ws1 :: wss1 => ws1.flatMap(w => _amb(w :: ws, wss1)).headOption
   }
   _amb(Nil, wss.reverse)
 }

 def main(args: Array[String]) {
   println(amb(List(List("the", "that", "a"),
                    List("frog", "elephant", "thing"),
                    List("walked", "treaded", "grows"),
                    List("slowly", "quickly"))))
 }

} </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

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>

With Coroutines

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>package require Tcl 8.6 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>

TUSCRIPT

<lang tuscript> $$ MODE TUSCRIPT set1="the'that'a" set2="frog'elephant'thing" set3="walked'treaded'grows" set4="slowly'quickly" LOOP w1=set1

lastw1=EXTRACT (w1,-1,0)
LOOP w2=set2
IF (w2.sw.$lastw1) THEN
 lastw2=EXTRACT (w2,-1,0)
 LOOP w3=set3
 IF (w3.sw.$lastw2) THEN
  lastw3=EXTRACT (w3,-1,0)
  LOOP w4=set4
  IF (w4.sw.$lastw3) sentence=JOIN (w1," ",w2,w3,w4)
  ENDLOOP
 ENDIF
 ENDLOOP
ENDIF
ENDLOOP

ENDLOOP PRINT sentence </lang> Output:

that thing grows slowly

VBScript

Implementation

<lang vb> class ambiguous dim sRule

public property let rule( x ) sRule = x end property

public default function amb(p1, p2) amb = eval(sRule) end function end class </lang>

Invocation

<lang vb> dim amb set amb = new ambiguous

amb.rule = "right(p1,1)=left(p2,1)"

dim w1, w2, w3, w4 for each w1 in split("the that a", " ") for each w2 in split("frog elephant thing", " ") for each w3 in split("walked treaded grows", " ") for each w4 in split("slowly quickly", " ") if amb(w1, w2) and amb(w2, w3) and amb(w3, w4) then wscript.echo w1, w2, w3, w4 end if next next next next </lang>

Output

that thing grows slowly