Update all new Tasks
This commit is contained in:
parent
00a190b0a6
commit
91df62d461
5697 changed files with 93386 additions and 804 deletions
17
Task/Amb/00DESCRIPTION
Normal file
17
Task/Amb/00DESCRIPTION
Normal file
|
|
@ -0,0 +1,17 @@
|
|||
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").
|
||||
38
Task/Amb/ALGOL-68/amb.alg
Normal file
38
Task/Amb/ALGOL-68/amb.alg
Normal file
|
|
@ -0,0 +1,38 @@
|
|||
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;
|
||||
#FOR PAGE amb IN # gen amb( # ) DO #
|
||||
## (PAGE amb)VOID:
|
||||
print((amb[1]+" "+amb[2]+" "+amb[3]+" "+amb[4], new line))
|
||||
#OD# )
|
||||
70
Task/Amb/Ada/amb.ada
Normal file
70
Task/Amb/Ada/amb.ada
Normal file
|
|
@ -0,0 +1,70 @@
|
|||
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;
|
||||
16
Task/Amb/AutoHotkey/amb.ahk
Normal file
16
Task/Amb/AutoHotkey/amb.ahk
Normal file
|
|
@ -0,0 +1,16 @@
|
|||
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 ""
|
||||
}
|
||||
23
Task/Amb/Bracmat/amb.bracmat
Normal file
23
Task/Amb/Bracmat/amb.bracmat
Normal file
|
|
@ -0,0 +1,23 @@
|
|||
( ( Amb
|
||||
= first last list words word solution
|
||||
. !arg:(?first.?list)
|
||||
& ( !list:
|
||||
| !list:(.?words) ?list
|
||||
& !words
|
||||
: ?
|
||||
%( @(?word:!first ? @?last)
|
||||
& Amb$(!last.!list):?solution
|
||||
& !word !solution:?solution
|
||||
)
|
||||
?
|
||||
& !solution
|
||||
)
|
||||
)
|
||||
& Amb
|
||||
$ (
|
||||
. (.the that a)
|
||||
(.frog elephant thing)
|
||||
(.walked treaded grows)
|
||||
(.slowly quickly)
|
||||
)
|
||||
)
|
||||
152
Task/Amb/C-sharp/amb-1.cs
Normal file
152
Task/Amb/C-sharp/amb-1.cs
Normal file
|
|
@ -0,0 +1,152 @@
|
|||
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") { }
|
||||
}
|
||||
30
Task/Amb/C-sharp/amb-2.cs
Normal file
30
Task/Amb/C-sharp/amb-2.cs
Normal file
|
|
@ -0,0 +1,30 @@
|
|||
// 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();
|
||||
});
|
||||
}
|
||||
41
Task/Amb/C/amb.c
Normal file
41
Task/Amb/C/amb.c
Normal file
|
|
@ -0,0 +1,41 @@
|
|||
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;
|
||||
}
|
||||
12
Task/Amb/Clojure/amb.clj
Normal file
12
Task/Amb/Clojure/amb.clj
Normal file
|
|
@ -0,0 +1,12 @@
|
|||
(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"))
|
||||
35
Task/Amb/Common-Lisp/amb-1.lisp
Normal file
35
Task/Amb/Common-Lisp/amb-1.lisp
Normal file
|
|
@ -0,0 +1,35 @@
|
|||
(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))))
|
||||
50
Task/Amb/Common-Lisp/amb-2.lisp
Normal file
50
Task/Amb/Common-Lisp/amb-2.lisp
Normal file
|
|
@ -0,0 +1,50 @@
|
|||
(defparameter *amb-ops* nil)
|
||||
(defparameter *amb-hist* nil)
|
||||
|
||||
(setf *random-state* (make-random-state t))
|
||||
(defun shuffle (items)
|
||||
(loop for i from 0 with r = items with l = (length r) while (< i l) do
|
||||
(rotatef (elt r i) (elt r (+ i (random (- l i)))))
|
||||
finally (return r)))
|
||||
|
||||
;;; (assert '(mess in, mess out))
|
||||
(defmacro amb (a &rest rest)
|
||||
(let ((f (first rest))
|
||||
(rest (rest rest)))
|
||||
(if (not f)
|
||||
`(let ((items (shuffle ,a)))
|
||||
(let ((y (car (last *amb-hist*)))
|
||||
(o (car (last *amb-ops*))))
|
||||
(loop for x in items do
|
||||
(if (or (not *amb-ops*)
|
||||
(funcall o y x))
|
||||
(return (append *amb-hist* (list x))))
|
||||
(elt items (random (length items))))))
|
||||
|
||||
`(let ((items (shuffle ,a)))
|
||||
(let ((y (car (last *amb-hist*)))
|
||||
(o (car (last *amb-ops*))))
|
||||
(loop for x in items do
|
||||
(if (or (not *amb-ops*)
|
||||
(funcall o y x))
|
||||
(let ((*amb-hist* (append *amb-hist* (list x)))
|
||||
(*amb-ops* (append *amb-ops* (list ,f))))
|
||||
(let ((r ,@rest))
|
||||
(if r (return r)))))))))))
|
||||
|
||||
;; test cases
|
||||
(defun joins (a b)
|
||||
(char= (char a (1- (length a))) (char b 0)))
|
||||
|
||||
(defun w34()
|
||||
(amb '("walked" "treaded" "grows") #'joins
|
||||
(amb '("slowly" "quickly"))))
|
||||
|
||||
(print
|
||||
(amb '("the" "that" "a") #'joins
|
||||
(amb '("frog" "elephant" "thing") #'joins
|
||||
(w34))))
|
||||
|
||||
(print (amb '(1 2 5) #'<
|
||||
(amb '(2 3 4) #'=
|
||||
(amb '(3 4 5))))) ; 1 4 4, 2 3 3, etc
|
||||
47
Task/Amb/D/amb.d
Normal file
47
Task/Amb/D/amb.d
Normal file
|
|
@ -0,0 +1,47 @@
|
|||
import std.stdio, std.array;
|
||||
|
||||
/** This amb function takes a comparison function and
|
||||
the possibilities that need to be checked.*/
|
||||
//string[] amb(in bool function(in string, in string) pure comp,
|
||||
const(string)[] amb(in bool function(in string, in string) pure comp,
|
||||
in string[][] options,
|
||||
in string prev = null) pure {
|
||||
if (options.empty)
|
||||
return null;
|
||||
|
||||
foreach (immutable opt; options.front) {
|
||||
// If this is the base call, prev is null and we need to
|
||||
// continue.
|
||||
if (!prev.empty && !comp(prev, opt))
|
||||
continue;
|
||||
|
||||
// Take care of the case where we have no options left.
|
||||
if (options.length == 1)
|
||||
return [opt];
|
||||
|
||||
// Traverse into the tree.
|
||||
const res = amb(comp, options[1 .. $], opt);
|
||||
|
||||
// If it was a failure, try the next one.
|
||||
if (!res.empty)
|
||||
return opt ~ res; // We have a match!
|
||||
}
|
||||
|
||||
return null; // No matches.
|
||||
}
|
||||
|
||||
void main() {
|
||||
immutable sets = [["the", "that", "a"],
|
||||
["frog", "elephant", "thing"],
|
||||
["walked", "treaded", "grows"],
|
||||
["slowly", "quickly"]];
|
||||
|
||||
// Pass in the comparator and the available sets.
|
||||
// (The comparator is not nothrow because of UTF.)
|
||||
const result = amb((s, t) => s.back == t.front, sets);
|
||||
|
||||
if (result.empty)
|
||||
writeln("No matches found!");
|
||||
else
|
||||
writefln("%-(%s %)", result);
|
||||
}
|
||||
81
Task/Amb/E/amb-1.e
Normal file
81
Task/Amb/E/amb-1.e
Normal file
|
|
@ -0,0 +1,81 @@
|
|||
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]
|
||||
}
|
||||
18
Task/Amb/E/amb-2.e
Normal file
18
Task/Amb/E/amb-2.e
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
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))
|
||||
15
Task/Amb/Ela/amb-1.ela
Normal file
15
Task/Amb/Ela/amb-1.ela
Normal file
|
|
@ -0,0 +1,15 @@
|
|||
open list core
|
||||
|
||||
amb xs = x where
|
||||
(Some x) = & join xs ""
|
||||
join (x::xs) = amb' x (join xs)
|
||||
join [] = \_ -> Some ""
|
||||
eq' [] x = true
|
||||
eq' w x = last w == head x
|
||||
amb' [] _ _ = None
|
||||
amb' (x::xs) n w
|
||||
| eq' w x =
|
||||
match n x with
|
||||
Some v = Some (x ++ " " ++ v)
|
||||
_ = amb' xs n w
|
||||
| else = amb' xs n w
|
||||
6
Task/Amb/Ela/amb-2.ela
Normal file
6
Task/Amb/Ela/amb-2.ela
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
amb [
|
||||
["the","that","a"]
|
||||
,["frog","elephant","thing"]
|
||||
,["walked","treaded","grows"]
|
||||
,["slowly","quickly"]
|
||||
]
|
||||
125
Task/Amb/Elena/amb.elena
Normal file
125
Task/Amb/Elena/amb.elena
Normal file
|
|
@ -0,0 +1,125 @@
|
|||
#define system.
|
||||
#define extensions.
|
||||
#define extensions'routines.
|
||||
|
||||
// --- Joinable --
|
||||
|
||||
#symbol joinable = (:aFormer:aLater)
|
||||
[ (aFormer @ (aFormer length - 1)) == (aLater @ 0) ].
|
||||
|
||||
// --- Activatora ---
|
||||
|
||||
#class(role)Activator2
|
||||
{
|
||||
#method eval : anArray
|
||||
[
|
||||
^ self eval:(anArray@0):(anArray@1).
|
||||
]
|
||||
}
|
||||
|
||||
#class(role)Activator3
|
||||
{
|
||||
#method eval : anArray
|
||||
[
|
||||
^ self eval:(anArray@0):(anArray@1):(anArray@2).
|
||||
]
|
||||
}
|
||||
|
||||
#class(role)Activator4
|
||||
{
|
||||
#method eval : anArray
|
||||
[
|
||||
^ self eval:(anArray@0):(anArray@1):(anArray@2):(anArray@3).
|
||||
]
|
||||
}
|
||||
|
||||
#class(role)Activator5
|
||||
{
|
||||
#method eval : anArray
|
||||
[
|
||||
^ self eval:(anArray@0):(anArray@1):(anArray@2):(anArray@3):(anArray@4).
|
||||
]
|
||||
}
|
||||
|
||||
// --- AmbValueCollection ---
|
||||
|
||||
#class AmbValueCollection
|
||||
{
|
||||
#field theCombinator.
|
||||
#field theRole.
|
||||
|
||||
#constructor new : aSet1 : aSet2
|
||||
[
|
||||
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).
|
||||
]
|
||||
|
||||
#method seek : aCondition
|
||||
[
|
||||
theCombinator reset.
|
||||
|
||||
control while:[ theCombinator next ] &do:
|
||||
[
|
||||
aCondition~theRole eval:(theCombinator get) ?
|
||||
[ #break nil. ].
|
||||
].
|
||||
]
|
||||
|
||||
#method do : aFunction
|
||||
[
|
||||
#var aResult := theCombinator get.
|
||||
nil != aResult
|
||||
? [ aFunction~theRole eval: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.
|
||||
}.
|
||||
|
||||
// --- 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")
|
||||
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". ].
|
||||
].
|
||||
20
Task/Amb/Factor/amb.factor
Normal file
20
Task/Amb/Factor/amb.factor
Normal file
|
|
@ -0,0 +1,20 @@
|
|||
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
|
||||
49
Task/Amb/Go/amb-1.go
Normal file
49
Task/Amb/Go/amb-1.go
Normal file
|
|
@ -0,0 +1,49 @@
|
|||
package main
|
||||
|
||||
import (
|
||||
"fmt"
|
||||
"sync"
|
||||
)
|
||||
|
||||
func ambStrings(ss []string) chan []string {
|
||||
c := make(chan []string)
|
||||
go func() {
|
||||
for _, s := range ss {
|
||||
c <- []string{s}
|
||||
}
|
||||
close(c)
|
||||
}()
|
||||
return c
|
||||
}
|
||||
|
||||
func ambChain(ss []string, cIn chan []string) chan []string {
|
||||
cOut := make(chan []string)
|
||||
go func() {
|
||||
var w sync.WaitGroup
|
||||
for chain := range cIn {
|
||||
w.Add(1)
|
||||
go func(chain []string) {
|
||||
for s1 := range ambStrings(ss) {
|
||||
if s1[0][len(s1[0])-1] == chain[0][0] {
|
||||
cOut <- append(s1, chain...)
|
||||
}
|
||||
}
|
||||
w.Done()
|
||||
}(chain)
|
||||
}
|
||||
w.Wait()
|
||||
close(cOut)
|
||||
}()
|
||||
return cOut
|
||||
}
|
||||
|
||||
func main() {
|
||||
s1 := []string{"the", "that", "a"}
|
||||
s2 := []string{"frog", "elephant", "thing"}
|
||||
s3 := []string{"walked", "treaded", "grows"}
|
||||
s4 := []string{"slowly", "quickly"}
|
||||
c := ambChain(s1, ambChain(s2, ambChain(s3, ambStrings(s4))))
|
||||
for s := range c {
|
||||
fmt.Println(s)
|
||||
}
|
||||
}
|
||||
39
Task/Amb/Go/amb-2.go
Normal file
39
Task/Amb/Go/amb-2.go
Normal file
|
|
@ -0,0 +1,39 @@
|
|||
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] }
|
||||
|
||||
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")
|
||||
}
|
||||
}
|
||||
15
Task/Amb/Haskell/amb.hs
Normal file
15
Task/Amb/Haskell/amb.hs
Normal file
|
|
@ -0,0 +1,15 @@
|
|||
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])
|
||||
73
Task/Amb/Haxe/amb.haxe
Normal file
73
Task/Amb/Haxe/amb.haxe
Normal file
|
|
@ -0,0 +1,73 @@
|
|||
class RosettaDemo
|
||||
{
|
||||
static var setA = ['the', 'that', 'a'];
|
||||
static var setB = ['frog', 'elephant', 'thing'];
|
||||
static var setC = ['walked', 'treaded', 'grows'];
|
||||
static var setD = ['slowly', 'quickly'];
|
||||
|
||||
static public function main()
|
||||
{
|
||||
Sys.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 = parseIt(ambData[data]);
|
||||
var tmpArray = tmpData.split(' ');
|
||||
tmpArray.pop();
|
||||
if (tmpArray.length == sets.length)
|
||||
{
|
||||
return tmpData;
|
||||
}
|
||||
}
|
||||
|
||||
return '';
|
||||
}
|
||||
|
||||
static function amb(startingWith : String = '', sets : Array<Array<String>>) : Dynamic
|
||||
{
|
||||
if (sets.length == 0 || sets[0].length == 0) return;
|
||||
|
||||
var match : Dynamic = [];
|
||||
for (reference in sets[0])
|
||||
{
|
||||
if (startingWith == '' || startingWith == reference.charAt(0))
|
||||
{
|
||||
var lastChar = reference.charAt(reference.length-1);
|
||||
if (Std.is(amb(lastChar, sets.slice(1)), Array))
|
||||
{
|
||||
match.push([ reference, amb(lastChar, sets.slice(1))]);
|
||||
}
|
||||
else
|
||||
{
|
||||
match.push([ reference ]);
|
||||
}
|
||||
}
|
||||
}
|
||||
return match;
|
||||
}
|
||||
|
||||
static function parseIt(data : Dynamic)
|
||||
{
|
||||
var retData = '';
|
||||
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;
|
||||
}
|
||||
}
|
||||
18
Task/Amb/Icon/amb.icon
Normal file
18
Task/Amb/Icon/amb.icon
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
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
|
||||
5
Task/Amb/J/amb-1.j
Normal file
5
Task/Amb/J/amb-1.j
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
amb=. ([ , ' ' , ])&>/&.>@:((({:@:[ = {.@:])&>/&> # ])@:,@:({@(,&<)))
|
||||
>@(amb&.>/) ('the';'that';'a');('frog';'elephant';'thing');('walked';'treaded';'grows');(<'slowly';'quickly')
|
||||
+-----------------------+
|
||||
|that thing grows slowly|
|
||||
+-----------------------+
|
||||
4
Task/Amb/J/amb-2.j
Normal file
4
Task/Amb/J/amb-2.j
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
('the';'that';'a') amb ('frog';'elephant';'thing') amb ('walked';'treaded';'grows') amb ('slowly';'quickly')
|
||||
+-----------------------+
|
||||
|that thing grows slowly|
|
||||
+-----------------------+
|
||||
10
Task/Amb/J/amb-3.j
Normal file
10
Task/Amb/J/amb-3.j
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
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...
|
||||
([ , ' ' , ])&>/&.>@:((({:@:[ = {.@:])&>/&> # ])@:,@:({@(,&<)))
|
||||
53
Task/Amb/JavaScript/amb.js
Normal file
53
Task/Amb/JavaScript/amb.js
Normal file
|
|
@ -0,0 +1,53 @@
|
|||
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"
|
||||
21
Task/Amb/Lua/amb-1.lua
Normal file
21
Task/Amb/Lua/amb-1.lua
Normal file
|
|
@ -0,0 +1,21 @@
|
|||
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
|
||||
8
Task/Amb/Lua/amb-2.lua
Normal file
8
Task/Amb/Lua/amb-2.lua
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
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
|
||||
3
Task/Amb/Mathematica/amb-1.math
Normal file
3
Task/Amb/Mathematica/amb-1.math
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
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]
|
||||
1
Task/Amb/Mathematica/amb-2.math
Normal file
1
Task/Amb/Mathematica/amb-2.math
Normal file
|
|
@ -0,0 +1 @@
|
|||
{{"that", "thing", "grows", "slowly"}}
|
||||
1
Task/Amb/Mathematica/amb-3.math
Normal file
1
Task/Amb/Mathematica/amb-3.math
Normal file
|
|
@ -0,0 +1 @@
|
|||
CheckValid2[i_List] := StringFreeQ[StringJoin[Riffle[i, ","]], a_ ~~ "," ~~ b_ /; a =!= b]
|
||||
25
Task/Amb/Mercury/amb-1.mercury
Normal file
25
Task/Amb/Mercury/amb-1.mercury
Normal file
|
|
@ -0,0 +1,25 @@
|
|||
:- module amb.
|
||||
:- interface.
|
||||
:- import_module io.
|
||||
:- pred main(io::di, io::uo) is cc_multi.
|
||||
:- implementation.
|
||||
:- import_module list, string, char, int.
|
||||
|
||||
main(!IO) :-
|
||||
( solution(S) -> io.write_string(S, !IO), io.nl(!IO)
|
||||
; io.write_string("No solutions found :-(\n", !IO) ).
|
||||
|
||||
:- pred solution(string::out) is nondet.
|
||||
solution(S) :-
|
||||
member(A, ["the", "that", "a"]),
|
||||
member(N, ["frog", "elephant", "thing"]),
|
||||
member(V, ["walked", "treaded", "grows"]),
|
||||
member(E, ["slowly", "quickly"]),
|
||||
S = join_list(" ", [A, N, V, E]),
|
||||
rule1(A, N), rule1(N, V), rule1(V, E).
|
||||
|
||||
:- pred rule1(string::in, string::in) is semidet.
|
||||
rule1(A, B) :- last_char(A) = C, first_char(B, C, _).
|
||||
|
||||
:- func last_char(string::in) = (char::out) is semidet.
|
||||
last_char(S) = C :- index(S, length(S) - 1, C).
|
||||
6
Task/Amb/Mercury/amb-2.mercury
Normal file
6
Task/Amb/Mercury/amb-2.mercury
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
:- pred noun(string).
|
||||
:- mode noun(out) is multi. % provide any one noun.
|
||||
:- mode noun(in) is semidet. % fail if given string isn't a known noun.
|
||||
noun("frog").
|
||||
noun("elephant").
|
||||
noun("thing").
|
||||
71
Task/Amb/NetRexx/amb.netrexx
Normal file
71
Task/Amb/NetRexx/amb.netrexx
Normal file
|
|
@ -0,0 +1,71 @@
|
|||
/* REXX **************************************************************
|
||||
* 25.08.2013 Walter Pachl derived from REXX version 2
|
||||
*********************************************************************/
|
||||
w=''
|
||||
l=0
|
||||
mm=0
|
||||
mkset(1,'the that a if',w,mm,l)
|
||||
mkset(2,'frog elephant thing',w,mm,l)
|
||||
mkset(3,'walked treaded grows trots',w,mm,l)
|
||||
mkset(4,'slowly quickly',w,mm,l)
|
||||
show(w,mm,l)
|
||||
|
||||
Loop i=1 to 3 /* loop over sets */
|
||||
k=i+1 /* the following set */
|
||||
Loop ii=1 To 10 /* loop over elements in set k*/
|
||||
If w[i,ii].words=i Then Do /* a sentence part found */
|
||||
Loop jj=1 To 10 /* loop over following words */
|
||||
If w[i,ii].right(1)=w[k,jj].left(1) Then Do /* fitting */
|
||||
ns=w[i,ii]' 'w[k,jj] /* build new sentence (part) */
|
||||
If ns.words=k Then /* 'complete' part */
|
||||
add(w,k,ns) /* add to set k */
|
||||
End
|
||||
End
|
||||
End
|
||||
End
|
||||
End
|
||||
Say 'Results:'
|
||||
Loop jj=1 To 10 /* show the results */
|
||||
If w[4,jj].words=4 Then
|
||||
Say '-->' w[4,jj]
|
||||
End
|
||||
|
||||
method add(w,k,s) public static
|
||||
/*********************************************************************
|
||||
* add a fitting sentence (part) s to set w[k,*]
|
||||
*********************************************************************/
|
||||
Loop i=1 To 10 While w[k,i]>'' /* look for an empty slot */
|
||||
End
|
||||
w[k,i]=s /* add the sentence (part) */
|
||||
Return
|
||||
|
||||
method mkset(n,arg,smp,mm,l) public static
|
||||
/*********************************************************************
|
||||
* create set smp[n,*] from data in arg
|
||||
* mm[0] maximum number of elements in any set
|
||||
* l[n] maximum word length in set n
|
||||
*********************************************************************/
|
||||
loop i = 1 to arg.words
|
||||
smp[n,i] = arg.word(i)
|
||||
If smp[n,i].length>l[n] Then
|
||||
l[n]=smp[n,i].length
|
||||
end
|
||||
if i-1>mm[0] Then Do
|
||||
mm[0]=i-1
|
||||
End
|
||||
return
|
||||
|
||||
method show(w,mm,l) public static
|
||||
/*********************************************************************
|
||||
* show the input
|
||||
*********************************************************************/
|
||||
Say 'Input:'
|
||||
Loop j=1 To mm[0] /* output lines */
|
||||
ol=''
|
||||
Loop i=1 To 4
|
||||
ol=ol w[i,j].left(l[i])
|
||||
End
|
||||
Say ol.strip
|
||||
End;
|
||||
say ''
|
||||
Return
|
||||
36
Task/Amb/OCaml/amb-1.ocaml
Normal file
36
Task/Amb/OCaml/amb-1.ocaml
Normal file
|
|
@ -0,0 +1,36 @@
|
|||
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;
|
||||
;;
|
||||
51
Task/Amb/OCaml/amb-2.ocaml
Normal file
51
Task/Amb/OCaml/amb-2.ocaml
Normal file
|
|
@ -0,0 +1,51 @@
|
|||
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;
|
||||
;;
|
||||
36
Task/Amb/OpenEdge-Progress/amb.openedge
Normal file
36
Task/Amb/OpenEdge-Progress/amb.openedge
Normal file
|
|
@ -0,0 +1,36 @@
|
|||
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.
|
||||
27
Task/Amb/Oz/amb.oz
Normal file
27
Task/Amb/Oz/amb.oz
Normal file
|
|
@ -0,0 +1,27 @@
|
|||
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}
|
||||
16
Task/Amb/PARI-GP/amb.pari
Normal file
16
Task/Amb/PARI-GP/amb.pari
Normal file
|
|
@ -0,0 +1,16 @@
|
|||
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"]])
|
||||
86
Task/Amb/PL-I/amb.pli
Normal file
86
Task/Amb/PL-I/amb.pli
Normal file
|
|
@ -0,0 +1,86 @@
|
|||
*process or(!) source attributes xref;
|
||||
amb: Proc Options(main);
|
||||
/*********************************************************************
|
||||
* 25.08.2013 Walter Pachl
|
||||
*********************************************************************/
|
||||
Dcl w(4,10) Char(40) Var
|
||||
Init('the','that','a','if',(6)(1)' ',
|
||||
'frog','elephant','thing',(7)(1)' ',
|
||||
'walked','treaded','grows','trots',(6)(1)' ',
|
||||
'slowly','quickly',(8)(1)' ');
|
||||
Dcl ns Char(40) Var;
|
||||
Dcl (i,k,j,ii,jj,m,n) Bin Fixed(31);
|
||||
n=hbound(w,1); /* number of sets */
|
||||
m=hbound(w,2); /* max number of words in set */
|
||||
Call show; /* show the input */
|
||||
Do i=1 To n-1; /* loop over sets */
|
||||
k=i+1; /* the following set */
|
||||
Do ii=1 To m; /* loop over elements in set k*/
|
||||
If words(w(i,ii))=i Then Do; /* a sentence part found */
|
||||
Do jj=1 To m; /* loop over following words */
|
||||
If right(w(i,ii),1)=left(w(k,jj),1) Then Do; /* fitting */
|
||||
ns=w(i,ii)!!' '!!w(k,jj); /* build new sentence (part) */
|
||||
If words(ns)=k Then /* 'complete' part */
|
||||
Call add(k,ns); /* add to set k */
|
||||
End;
|
||||
End;
|
||||
End;
|
||||
End;
|
||||
Do jj=1 To m; /* show the results */
|
||||
If words(w(4,jj))=4 Then
|
||||
put edit('--> ',w(4,jj))(Skip,a,a);
|
||||
End;
|
||||
|
||||
add: Proc(ni,s);
|
||||
/*********************************************************************
|
||||
* add a sentence (part) to set ni
|
||||
*********************************************************************/
|
||||
Dcl (i,ni) Bin Fixed(31);
|
||||
Dcl s Char(40) Var;
|
||||
Do i=1 To m While(w(ni,i)>''); /* look for an empty slot */
|
||||
End;
|
||||
w(ni,i)=s; /* add the sentence (part) */
|
||||
End;
|
||||
|
||||
words: Proc(s) Returns(Bin Fixed(31));
|
||||
/*********************************************************************
|
||||
* return the number of blank separated words in s
|
||||
*********************************************************************/
|
||||
Dcl s Char(40) Var;
|
||||
Dcl nw Bin Fixed(31) Init(0);
|
||||
Dcl i Bin Fixed(31) Init(1);
|
||||
If s>'' Then Do;
|
||||
nw=1;
|
||||
Do i=1 To length(s);
|
||||
If substr(s,i,1)=' ' Then
|
||||
nw+=1;
|
||||
End;
|
||||
End;
|
||||
Return(nw);
|
||||
End;
|
||||
|
||||
show: Proc;
|
||||
/*********************************************************************
|
||||
* show the input sets
|
||||
*********************************************************************/
|
||||
Dcl (i,j,mm) Bin Fixed(31) Init(0);
|
||||
Dcl l(4) Bin Fixed(31) Init((4)0);
|
||||
Do i=1 To n;
|
||||
Do j=1 To m;
|
||||
If w(i,j)>'' Then Do;
|
||||
mm=max(mm,j); /* max number of words in any set */
|
||||
l(i)=max(l(i),length(w(i,j))); /* max word length in set i */
|
||||
End;
|
||||
End;
|
||||
End;
|
||||
Put Edit('Input:')(Skip,a);
|
||||
Do j=1 To mm; /* output lines */
|
||||
Put Skip;
|
||||
Do i=1 To n;
|
||||
Put Edit(w(i,j),' ')(a(l(i)),a);
|
||||
End;
|
||||
End;
|
||||
Put Skip;
|
||||
End;
|
||||
|
||||
End;
|
||||
18
Task/Amb/Perl-6/amb-1.pl6
Normal file
18
Task/Amb/Perl-6/amb-1.pl6
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
sub infix:<lf> ($a,$b) {
|
||||
next unless try $a.substr(*-1,1) eq $b.substr(0,1);
|
||||
"$a $b";
|
||||
}
|
||||
|
||||
multi dethunk(Callable $x) { try take $x() }
|
||||
multi dethunk( Any $x) { take $x }
|
||||
|
||||
sub amb (*@c) { gather @c».&dethunk }
|
||||
|
||||
say first *, do
|
||||
amb(<the that a>, { die 'oops'}) Xlf
|
||||
amb('frog',{'elephant'},'thing') Xlf
|
||||
amb(<walked treaded grows>) Xlf
|
||||
amb { die 'poison dart' },
|
||||
{'slowly'},
|
||||
{'quickly'},
|
||||
{ die 'fire' };
|
||||
18
Task/Amb/Perl-6/amb-2.pl6
Normal file
18
Task/Amb/Perl-6/amb-2.pl6
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
sub amb($var,*@a) {
|
||||
"[{
|
||||
@a.pick(*).map: {"||\{ $var = '$_' }"}
|
||||
}]";
|
||||
}
|
||||
|
||||
'' ~~ 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) }>
|
||||
<{ amb '$c', <walked treaded grows> }>
|
||||
<?{ substr($b,*-1,1) eq substr($c,0,1) }>
|
||||
<{ amb '$d', <slowly quickly> }>
|
||||
<?{ substr($c,*-1,1) eq substr($d,0,1) }>
|
||||
{ say "$a $b $c $d" }
|
||||
<!>
|
||||
/;
|
||||
35
Task/Amb/Perl/amb-1.pl
Normal file
35
Task/Amb/Perl/amb-1.pl
Normal file
|
|
@ -0,0 +1,35 @@
|
|||
use strict;
|
||||
use warnings;
|
||||
|
||||
use constant EXIT_FAILURE => 1;
|
||||
use constant EXIT_SUCCESS => 0;
|
||||
|
||||
sub amb {
|
||||
exit(EXIT_FAILURE) if !@_;
|
||||
for my $word (@_) {
|
||||
my $pid = fork;
|
||||
die $! unless defined $pid;
|
||||
return $word if !$pid;
|
||||
my $wpid = waitpid $pid, 0;
|
||||
die $! unless $wpid == $pid;
|
||||
exit(EXIT_SUCCESS) if $? == EXIT_SUCCESS;
|
||||
}
|
||||
exit(EXIT_FAILURE);
|
||||
}
|
||||
|
||||
sub joined {
|
||||
my ($join_a, $join_b) = @_;
|
||||
substr($join_a, -1) eq substr($join_b, 0, 1);
|
||||
}
|
||||
|
||||
my $w1 = amb(qw(the that a));
|
||||
my $w2 = amb(qw(frog elephant thing));
|
||||
my $w3 = amb(qw(walked treaded grows));
|
||||
my $w4 = amb(qw(slowly quickly));
|
||||
|
||||
amb() unless joined $w1, $w2;
|
||||
amb() unless joined $w2, $w3;
|
||||
amb() unless joined $w3, $w4;
|
||||
|
||||
print "$w1 $w2 $w3 $w4\n";
|
||||
exit(EXIT_SUCCESS);
|
||||
40
Task/Amb/Perl/amb-2.pl
Normal file
40
Task/Amb/Perl/amb-2.pl
Normal 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";
|
||||
});
|
||||
18
Task/Amb/PicoLisp/amb.l
Normal file
18
Task/Amb/PicoLisp/amb.l
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
(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) )
|
||||
17
Task/Amb/Prolog/amb.pro
Normal file
17
Task/Amb/Prolog/amb.pro
Normal file
|
|
@ -0,0 +1,17 @@
|
|||
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).
|
||||
44
Task/Amb/PureBasic/amb.purebasic
Normal file
44
Task/Amb/PureBasic/amb.purebasic
Normal file
|
|
@ -0,0 +1,44 @@
|
|||
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
|
||||
100
Task/Amb/Python/amb.py
Normal file
100
Task/Amb/Python/amb.py
Normal file
|
|
@ -0,0 +1,100 @@
|
|||
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, '__code__'):
|
||||
##
|
||||
## Called with a constraint function.
|
||||
##
|
||||
globls = arg.__globals__ if hasattr(arg, '__globals__') else 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.__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()
|
||||
next = __next__ # Python 2
|
||||
|
||||
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 ('%s %s %s' % (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 ('%s %s %s %s' % (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 ('%s %s' % (x, y))
|
||||
23
Task/Amb/R/amb-1.r
Normal file
23
Task/Amb/R/amb-1.r
Normal file
|
|
@ -0,0 +1,23 @@
|
|||
checkSentence <- function(sentence){
|
||||
# Input: character vector
|
||||
# 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){
|
||||
# Input: list of character vectors containing all sets to consider
|
||||
# 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)
|
||||
}
|
||||
14
Task/Amb/R/amb-2.r
Normal file
14
Task/Amb/R/amb-2.r
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
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"
|
||||
1
Task/Amb/README
Normal file
1
Task/Amb/README
Normal file
|
|
@ -0,0 +1 @@
|
|||
Data source: http://rosettacode.org/wiki/Amb
|
||||
22
Task/Amb/REXX/amb-1.rexx
Normal file
22
Task/Amb/REXX/amb-1.rexx
Normal file
|
|
@ -0,0 +1,22 @@
|
|||
/*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
|
||||
85
Task/Amb/REXX/amb-2.rexx
Normal file
85
Task/Amb/REXX/amb-2.rexx
Normal file
|
|
@ -0,0 +1,85 @@
|
|||
/* REXX **************************************************************
|
||||
* 25.08.2013 Walter Pachl derived from PL/I
|
||||
*********************************************************************/
|
||||
mm=0
|
||||
w.=''
|
||||
l.=0
|
||||
Call mkset 1,'the that a if'
|
||||
Call mkset 2,'frog elephant thing'
|
||||
Call mkset 3,'walked treaded grows trots'
|
||||
Call mkset 4,'slowly quickly'
|
||||
|
||||
Call show
|
||||
Do i=1 to 3 /* loop over sets */
|
||||
Call showm
|
||||
k=i+1 /* the following set */
|
||||
Do ii=1 To 10 /* loop over elements in set k*/
|
||||
If words(w.i.ii)=i Then Do /* a sentence part found */
|
||||
Do jj=1 To 10 /* loop over following words */
|
||||
If right(w.i.ii,1)=left(w.k.jj,1) Then Do /* fitting */
|
||||
ns=w.i.ii' 'w.k.jj /* build new sentence (part) */
|
||||
If words(ns)=k Then /* 'complete' part */
|
||||
Call add k,ns /* add to set k */
|
||||
End
|
||||
End
|
||||
End
|
||||
End
|
||||
End
|
||||
|
||||
Do jj=1 To 10 /* show the results */
|
||||
If words(w.4.jj)=4 Then
|
||||
Say '-->' w.4.jj
|
||||
End
|
||||
Return
|
||||
|
||||
add: Procedure Expose w.
|
||||
/*********************************************************************
|
||||
* add a sentence (part) to set ni
|
||||
*********************************************************************/
|
||||
Parse Arg ni,s
|
||||
Do i=1 To 10 While w.ni.i>'' /* look for an empty slot */
|
||||
End
|
||||
w.ni.i=s /* add the sentence (part) */
|
||||
Return
|
||||
|
||||
mkset: Procedure Expose w. mm l.
|
||||
/*********************************************************************
|
||||
* initialize the sets
|
||||
*********************************************************************/
|
||||
Parse Arg i,wl
|
||||
Do j=1 By 1 While wl<>''
|
||||
Parse Var wl w.i.j wl
|
||||
l.i=max(l.i,length(w.i.j))
|
||||
End
|
||||
mm=max(mm,j-1)
|
||||
Return
|
||||
|
||||
show: Procedure Expose w. mm l.
|
||||
/*********************************************************************
|
||||
* show the input
|
||||
*********************************************************************/
|
||||
Say 'Input:'
|
||||
Do j=1 To mm /* output lines */
|
||||
ol=''
|
||||
Do i=1 To 4
|
||||
ol=ol left(w.i.j,l.i)
|
||||
End
|
||||
Say strip(ol)
|
||||
End;
|
||||
say ''
|
||||
Return
|
||||
|
||||
showm: Procedure Expose w.
|
||||
/*********************************************************************
|
||||
* show the sets' contents
|
||||
*********************************************************************/
|
||||
dbg=0
|
||||
If dbg Then Do
|
||||
Do i=1 To 4
|
||||
Do j=1 To 10
|
||||
If w.i.j>'' Then
|
||||
Say i j w.i.j
|
||||
End
|
||||
End
|
||||
End
|
||||
Return
|
||||
30
Task/Amb/Racket/amb.rkt
Normal file
30
Task/Amb/Racket/amb.rkt
Normal file
|
|
@ -0,0 +1,30 @@
|
|||
#lang racket
|
||||
|
||||
;; A quick `amb' implementation (same as in the Twelve Statements task)
|
||||
(define failures null)
|
||||
|
||||
(define (fail)
|
||||
(if (pair? failures) ((first failures)) (error "no more choices!")))
|
||||
|
||||
(define (amb/thunks choices)
|
||||
(let/cc k (set! failures (cons k failures)))
|
||||
(if (pair? choices)
|
||||
(let ([choice (first choices)]) (set! choices (rest choices)) (choice))
|
||||
(begin (set! failures (rest failures)) (fail))))
|
||||
|
||||
(define-syntax-rule (amb E ...) (amb/thunks (list (lambda () E) ...)))
|
||||
|
||||
(define (assert condition) (unless condition (fail)))
|
||||
|
||||
;; Problem solution
|
||||
|
||||
(define (joins? left right)
|
||||
(regexp-match? #px"(.)\0\\1" (~a left "\0" right)))
|
||||
|
||||
(let ([result (list (amb "the" "that" "a")
|
||||
(amb "frog" "elephant" "thing")
|
||||
(amb "walked" "treaded" "grows")
|
||||
(amb "slowly" "quickly"))])
|
||||
(for ([x result] [y (cdr result)]) (assert (joins? x y)))
|
||||
result)
|
||||
;; -> '("that" "thing" "grows" "slowly")
|
||||
47
Task/Amb/Ruby/amb.rb
Normal file
47
Task/Amb/Ruby/amb.rb
Normal file
|
|
@ -0,0 +1,47 @@
|
|||
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
|
||||
15
Task/Amb/SETL/amb-1.setl
Normal file
15
Task/Amb/SETL/amb-1.setl
Normal file
|
|
@ -0,0 +1,15 @@
|
|||
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;
|
||||
26
Task/Amb/SETL/amb-2.setl
Normal file
26
Task/Amb/SETL/amb-2.setl
Normal file
|
|
@ -0,0 +1,26 @@
|
|||
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;
|
||||
20
Task/Amb/Scala/amb.scala
Normal file
20
Task/Amb/Scala/amb.scala
Normal file
|
|
@ -0,0 +1,20 @@
|
|||
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"))))
|
||||
}
|
||||
}
|
||||
34
Task/Amb/Scheme/amb.ss
Normal file
34
Task/Amb/Scheme/amb.ss
Normal file
|
|
@ -0,0 +1,34 @@
|
|||
(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))
|
||||
51
Task/Amb/Seed7/amb.seed7
Normal file
51
Task/Amb/Seed7/amb.seed7
Normal file
|
|
@ -0,0 +1,51 @@
|
|||
$ include "seed7_05.s7i";
|
||||
|
||||
const type: setListType is array array string;
|
||||
|
||||
const func array string: amb (in string: word1, in setListType: listOfSets) is func
|
||||
result
|
||||
var array string: ambResult is 0 times "";
|
||||
local
|
||||
var string: word2 is "";
|
||||
begin
|
||||
for word2 range listOfSets[1] do
|
||||
if length(ambResult) = 0 and word1[length(word1) len 1] = word2[1 len 1] then
|
||||
if length(listOfSets) = 1 then
|
||||
ambResult := [] (word1) & [] (word2);
|
||||
else
|
||||
ambResult := amb(word2, listOfSets[2 ..]);
|
||||
if length(ambResult) <> 0 then
|
||||
ambResult := [] (word1) & ambResult;
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
end for;
|
||||
end func;
|
||||
|
||||
const func array string: amb (in setListType: listOfSets) is func
|
||||
result
|
||||
var array string: ambResult is 0 times "";
|
||||
local
|
||||
var string: word1 is "";
|
||||
begin
|
||||
for word1 range listOfSets[1] do
|
||||
if length(ambResult) = 0 then
|
||||
ambResult := amb(word1, listOfSets[2 ..]);
|
||||
end if;
|
||||
end for;
|
||||
end func;
|
||||
|
||||
const proc: main is func
|
||||
local
|
||||
var array string: ambResult is 0 times "";
|
||||
var string: word is "";
|
||||
begin
|
||||
ambResult := amb([] ([] ("the", "that", "a"),
|
||||
[] ("frog", "elephant", "thing"),
|
||||
[] ("walked", "treaded", "grows"),
|
||||
[] ("slowly", "quickly")));
|
||||
for word range ambResult do
|
||||
write(word <& " ");
|
||||
end for;
|
||||
writeln;
|
||||
end func;
|
||||
22
Task/Amb/TUSCRIPT/amb.tu
Normal file
22
Task/Amb/TUSCRIPT/amb.tu
Normal file
|
|
@ -0,0 +1,22 @@
|
|||
$$ 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
|
||||
24
Task/Amb/TXR/amb-1.txr
Normal file
24
Task/Amb/TXR/amb-1.txr
Normal 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-2.txr
Normal file
24
Task/Amb/TXR/amb-2.txr
Normal 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)
|
||||
24
Task/Amb/Tcl/amb-1.tcl
Normal file
24
Task/Amb/Tcl/amb-1.tcl
Normal file
|
|
@ -0,0 +1,24 @@
|
|||
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]
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
41
Task/Amb/Tcl/amb-2.tcl
Normal file
41
Task/Amb/Tcl/amb-2.tcl
Normal file
|
|
@ -0,0 +1,41 @@
|
|||
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] }
|
||||
11
Task/Amb/VBScript/amb-1.vb
Normal file
11
Task/Amb/VBScript/amb-1.vb
Normal file
|
|
@ -0,0 +1,11 @@
|
|||
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
|
||||
17
Task/Amb/VBScript/amb-2.vb
Normal file
17
Task/Amb/VBScript/amb-2.vb
Normal file
|
|
@ -0,0 +1,17 @@
|
|||
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
|
||||
Loading…
Add table
Add a link
Reference in a new issue