Amb

From Rosetta Code
Task
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 yeilds 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").

Haskell

import Control.Monad
import Data.List

amb choices = if null choices then mzero else choices

joins left right = head (reverse left) == head right

example = head $ do
  w1 <- amb ["the", "that", "a"]
  w2 <- amb ["frog", "elephant", "thing"]
  w3 <- amb ["walked", "treaded", "grows"]
  w4 <- amb ["slowly", "quickly"]
  if joins w1 w2 then return () else amb []
  if joins w2 w3 then return () else amb []
  if joins w3 w4 then return () else amb []
  return $ intercalate " " [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).

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>