Data update

Task/Amb/Ada/amb-1.adb

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

Task/Amb/Ada/amb-2.adb

@@ -0,0 +1,78 @@
+-- MacOS, GNAT, gnat-aarch64-darwin-15.1.0-2
+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 "/" (L, R : String) return Amb;
+   function "/" (L : Amb; R : String) return Amb;
+   function "=" (L, R : Amb) return Boolean;
+   function Image (L : Amb) return String;
+   procedure Join (L : access Amb; R : in out Amb);
+   procedure Failure (L : in out Amb);
+
+   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;

Task/Amb/Crystal/amb.cr

@@ -0,0 +1,108 @@
+class Amb
+  @sels = [] of ASel
+
+  def sel (options : Array(T)) forall T
+    s = Sel(T).new(options)
+    @sels << s
+    s
+  end
+
+  def assert (&)
+    from = @sels.map {|s| s.fixed? ? s.index : 0 }
+    to =   @sels.map {|s| s.fixed? ? s.index : s.option_count - 1 }
+    indices = from.dup
+
+    loop do
+      begin
+        @sels.zip(indices).each do |sel, idx| sel.set_option_no(idx) end
+        success = yield
+      rescue
+        success = false
+      end
+      break if success
+      (0..indices.size).each do |i|
+        if i == indices.size
+          raise Error.new("Couldn't find values to make the expression be true")
+        end
+        if indices[i] < to[i]
+          indices[i] += 1
+          break
+        else
+          indices[i] = from[i]
+        end
+      end
+    end
+    @sels.each do |s| s.fix! end
+  end
+
+  class Error < Exception
+  end
+
+  abstract class ASel
+  end
+
+  class Sel (T) < ASel
+    @options : Array(T)
+    getter index = 0
+    getter? fixed = false
+
+    def initialize (options)
+      @options = options.dup
+    end
+
+    def set_option_no (@index)
+    end
+
+    def fix!
+      @fixed = true
+    end
+
+    def option_count
+      @options.size
+    end
+
+    def current_value
+      @options[@index]
+    end
+
+    def to_s (io)
+      if @fixed
+        @options[@index].to_s(io)
+      else
+        io << '{' << @options.join(",") << "}"
+      end
+    end
+
+    macro method_missing (call)
+      {% for arg, i in call.args %}
+        param{{i.id}} = {{arg.id}}
+      {% end %}
+      @options[@index].{{call.name}}(
+        {{(0...call.args.size).map {|i| "param#{i}.is_a?(ASel) ? param#{i}.current_value : param#{i}".id }.splat}}
+      )
+    end
+  end
+end
+
+macro show_vars (*vars)
+  {% for v in vars %}
+    print {{v.stringify}}, " = ", {{v}}.to_s, "\n"
+  {% end %}
+end
+
+amb = Amb.new
+
+a = amb.sel %w(the that a)
+b = amb.sel %w(frog elephant thing)
+c = amb.sel %w(walked treaded grows)
+d = amb.sel %w(slowly quickly)
+
+puts "before:"
+show_vars a, b, c, d
+
+amb.assert {
+  [a, b, c, d].each.cons_pair.all? {|x, y| x[-1] == y[0] }
+}
+
+puts "\nafter:"
+show_vars a, b, c, d

Task/Amb/Haxe/amb.hx

@@ -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;
+	}
+}

Task/Amb/Langur/amb.langur

@@ -5,11 +5,11 @@ val wordsets = [
     fw/slowly quickly/,
 ]
 
-val alljoin = fn words: for[=true] i of len(words)-1 {
+val alljoin = fn(words) { for[=true] i of len(words)-1 {
     if words[i][-1] != words[i+1][1]: break val=false
-}
+}}
 
 # amb expects 2 or more arguments
-val amb = fn words...[2..]: if alljoin(words) { join words, delim=" " }
+val amb = fn(words...[2..]) { if alljoin(words) { join words, delim=" " } }
 
 writeln join(mapX(wordsets..., by=amb) -> filter, delim="\n")

Task/Amb/Pluto/amb.pluto

@@ -0,0 +1,31 @@
+local final_res = {}
+
+local function amb(wordsets, res)
+    if #wordsets == 0 then
+        table.move(res, 1, #res, #final_res + 1, final_res)
+        return true
+    end
+    local s = ""
+    local l = #res
+    if l > 0 then s = res[l] end
+    res:insert("")
+    for wordsets[1] as word do
+        res[l + 1] = word
+        if l > 0 and s[-1] != res[l + 1][1] then continue end
+        if amb(wordsets:slice(2), res:clone()) then return true end
+    end
+    return false
+end
+
+local wordsets = {
+    { "the", "that", "a" },
+    { "frog", "elephant", "thing" },
+    { "walked", "treaded", "grows" },
+    { "slowly", "quickly" }
+}
+
+if amb(wordsets, {}) then
+    print(final_res:concat(" "))
+else
+    print("No amb found")
+end

Task/Amb/Rebol/amb.rebol

@@ -0,0 +1,84 @@
+Rebol [
+    title: "Rosetta code: Amb"
+    file:  %Amb.r3
+    url:   https://rosettacode.org/wiki/Amb
+    note: "Based on Red language implementation!"
+]
+; findblock: Walk a block tree and find the first WORD! whose value is a BLOCK!
+;            This identifies the next nondeterministic choice variable to expand.
+findblock: func [
+    blk [block!]
+][
+    foreach w blk [
+        ; If w is a word and its value (get w) is a block, we found a choice point.
+        if all [word? w block? get w] [return w]
+        ; If w is itself a block, recurse to search deeper for a choice point.
+        if block? w [findblock w]
+    ]
+]
+
+;; Rebol does not provide replace/deep as Red, so use this function.
+; replace-deep: Deeply replace occurrences of a (needle) with b (replacement)
+;               across a nested block structure. Useful for substituting a choice
+;               variable with one concrete alternative throughout the condition.
+replace-deep: func [blk a b][
+    ; Do a shallow replace for direct occurrences at this level.
+    replace/all blk a b
+    ; Walk the block; whenever we see a nested block, recurse.
+    forall blk [
+        if any-block? blk/1 [
+            replace-deep blk/1 a b
+        ]
+    ]
+    blk
+]
+
+; amb: Evaluate a condition with nondeterministic choices.
+;      The condition is expressed as a block containing logic and possibly
+;      choice variables (words whose values are blocks of alternatives).
+;      amb returns TRUE if there exists an assignment of choices that makes
+;      the condition succeed; otherwise FALSE.
+amb: func [
+    cond [block!]
+    /local b cond2
+][
+    ; Look for the next choice variable (a WORD! whose value is a BLOCK!)
+    either b: findblock cond [
+        ; For each alternative 'a' in the domain of choice variable 'b'
+        foreach a get b [
+            ; Create a new version of the condition where 'b' is replaced by 'a'
+            cond2: replace-deep copy/deep cond b a
+            ; Recurse: if any branch succeeds, lock in this choice and return TRUE
+            if amb cond2 [
+                set b a          ; Commit the successful choice to the variable
+                return true
+            ]
+        ]
+        ; If no alternative leads to success, this branch fails (implicit NONE/falsey)
+    ][
+        ; Base case: No more choice variables; directly evaluate the condition.
+        ; If it evaluates to TRUE, this path is a solution; otherwise it fails.
+        do cond
+    ]
+]
+
+
+; examples
+x: [1 2 3 4]
+y: [4 5 6]
+z: [5 2]
+print amb [x * y * z = 8]
+print [x y z]
+
+a: ["the" "that" "a"]
+b: ["frog" "elephant" "thing"]
+c: ["walked" "treaded" "grows"]
+d: ["slowly" "quickly"]
+print amb [
+    all [
+        equal? last a first b
+        equal? last b first c
+        equal? last c first d
+    ]
+]
+print [a b c d]

Task/Amb/V-(Vlang)/amb.v

@@ -4,12 +4,12 @@ fn main() {
 				["walked", "treaded", "grows"],
 				["slowly", "quickly"]]
 	text := amb(word_set)
-	if text != "" {println("Correct answer is: \n ${text} \n")}
-	else {println("Failed to find a correct answer.")}
+	if text != "" { println("Correct answer is: \n ${text} \n") }
+	else { println("Failed to find a correct answer.") }
 }
 
 fn word_check(str_1 string, str_2 string) bool {
-	if str_1.substr_ni(str_1.len - 1, str_1.len) == str_2.substr_ni(0, 1) {return true}
+	if str_1.substr_ni(str_1.len - 1, str_1.len) == str_2.substr_ni(0, 1) { return true }
 	return false
 }
 
@@ -18,7 +18,8 @@ fn amb(arrays[][]string) string {
 		for words_1 in arrays[1] {
 			for words_2 in arrays[2] {
 				for words_3 in arrays[3] {
-					if word_check(words_0, words_1) && word_check(words_1, words_2) && word_check(words_2, words_3) {
+					if word_check(words_0, words_1) && word_check(words_1, words_2)
+					&& word_check(words_2, words_3) {
 						return "${words_0} ${words_1} ${words_2} ${words_3}"
 					}
 				}

Task/Amb/VBScript/amb-1.vbs

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

Task/Amb/VBScript/amb-2.vbs

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