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

<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; </ada> The type Amb is implemented with the operations "/" to construct it from strings. Each instance keeps it 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

C

Note: This uses the continuations code from http://homepage.mac.com/sigfpe/Computing/continuations.html <c> typedef 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(char *left, char *right) { return left[strlen(left)-1] == right[0]; }

int _main() {

 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;

} </c>

Haskell

import Control.Monad
import Data.List

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 [])
  unwords [w1, w2, w3, w4]

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

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: <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') >>> </python>

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

Scheme

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

</scheme>