dim sums(20000)

sub sum_proper_divisors(n)
	dim sum = 0
	dim i
	if n > 1 then
		for i = 1 to (n \ 2)
			if n %% i = 0 then
				sum = sum + i
			end if
		next
	end if
	return sum
end sub

dim i, j
for i = 1 to 20000
	sums(i) = sum_proper_divisors(i)
	for j = i-1 to 2 by -1
		if sums(i) = j and sums(j) = i then
			print "Amicable pair:";sums(i);"-";sums(j)
			exit for
		end if
	next
next


(import (scheme base)
        (scheme char)
        (scheme cxr)
        (scheme file)
        (scheme write)
        (srfi 1)    ; lists
        (srfi 132)) ; sorting library

;; read in word list, and sort into decreasing length
(define (read-ordered-words)
  (with-input-from-file
    "unixdict.txt"
    (lambda ()
      (do ((line (read-line) (read-line))
           (words '() (cons line words)))
        ((eof-object? line)
         (list-sort (lambda (a b) (> (string-length a) (string-length b)))
                    words))))))

(define (find-deranged-words word-list)
  (define (search words)
    (let loop ((word-chars (let ((chars (map string->list words)))
                             (zip chars
                                  (map (lambda (word) (list-sort char<? word))
                                       chars)))))
      (if (< (length word-chars) 2)
        #f ; failed to find any
        (let ((deranged-word ; seek a deranged version of the first word in word-chars
                (find (lambda (chars)
                        (and (equal? (cadar word-chars) (cadr chars)) ; check it's an anagram?
                             (not (any char=? (caar word-chars) (car chars))))) ; and deranged?
                      word-chars)))
          (if deranged-word ; if we got one, return it with the first word
            (map list->string (list (caar word-chars) (car deranged-word)))
            (loop (cdr word-chars)))))))
  ;
  (let loop ((rem word-list))
    (if (null? rem)
      '()
      (let* ((len (string-length (car rem)))
             (deranged-words (search ; look through group of equal sized words
                               (take-while (lambda (word) (= len (string-length word)))
                                           (cdr rem)))))
        (if deranged-words
          deranged-words
          (loop (drop-while (lambda (word) (= len (string-length word)))
                            (cdr rem))))))))

(display (find-deranged-words (read-ordered-words))) (newline)


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


println("Downloading...")
when (def wordText := <http://wiki.puzzlers.org/pub/wordlists/unixdict.txt> <- getText()) -> {
    def words := wordText.split("\n")

    def storage := [].asMap().diverge()
    def anagramTable extends storage {
        to get(key) { return storage.fetch(key, fn { storage[key] := [].diverge() }) }
    }

    println("Grouping...")
    var largestGroupSeen := 0
    for word in words {
        def anagramGroup := anagramTable[word.sort()]
        anagramGroup.push(word)
        largestGroupSeen max= anagramGroup.size()
    }

    println("Selecting...")
    for _ => anagramGroup ? (anagramGroup.size() == mostSeen) in anagramTable {
        println(anagramGroup.snapshot())
    }
}


proc properDivisors {n} {
    if {$n == 1} return
    set divs 1
    set sum 1
    for {set i 2} {$i*$i <= $n} {incr i} {
	if {!($n % $i)} {
	    lappend divs $i
	    incr sum $i
	    if {$i*$i < $n} {
		lappend divs [set d [expr {$n / $i}]]
		incr sum $d
	    }
	}
    }
    return [list $sum $divs]
}

proc amicablePairs {limit} {
    set result {}
    set sums [set divs {{}}]
    for {set n 1} {$n < $limit} {incr n} {
	lassign [properDivisors $n] sum d
	lappend sums $sum
	lappend divs [lsort -integer $d]
    }
    for {set n 1} {$n < $limit} {incr n} {
	set nsum [lindex $sums $n]
	for {set m 1} {$m < $n} {incr m} {
	    if {$n==[lindex $sums $m] && $m==$nsum} {
		lappend result $m $n [lindex $divs $m] [lindex $divs $n]
	    }
	}
    }
    return $result
}

foreach {m n md nd} [amicablePairs 20000] {
    puts "$m and $n are an amicable pair with these proper divisors"
    puts "\t$m : $md"
    puts "\t$n : $nd"
}


func find_deranged(Array a) {
    for i in (^a) {
        for j in (i+1 .. a.end) {
            overlaps(a[i], a[j]) || (
                printf("length %d: %s => %s\n", a[i].len, a[i], a[j])
                return true
            )
        }
    }
    return false
}

func main(File file) {

    file.open_r(\var fh, \var err) ->
        || die "Can't open file `#{file}' for reading: #{err}\n"

    var letter_list = Hash()

    # Store anagrams in hash table by letters they contain
    fh.words.each { |word|
        letter_list{word.sort} := [] << word
    }

    letter_list.keys                        \
         .grep {|k| letter_list{k}.len > 1} \     # take only ones with anagrams
         .sort {|a,b| b.len <=> a.len}      \     # sort by length, descending
         .each {|key|

        # If we find a pair, they are the longested due to the sort before
        find_deranged(letter_list{key}) && break
    }
}

main(%f'/tmp/unixdict.txt')


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") { }
}


(require 'struct)
(require 'hash)
(require 'sql)
(require 'words)
(require 'dico.fr.no-accent)

(define mots-français (words-select #:any null 999999))
(string-delimiter "")

(define (string-sort str)
	(list->string (list-sort string<?  (string->list str))))

(define (ana-sort H words) ;; bump counter for each word
	(for ((w words))
		#:continue (< (string-length w) 4)
		(let [(key (string-sort w))]  (hash-set H key (1+ (hash-ref! H key 0))))))

;; input w word
;; output : list of matching words
(define (anagrams w words)
	(set! w (string-sort w))
	(make-set
	(for/list (( ana words))
		#:when (string=? w (string-sort ana))
		ana)))

(define (task words)
(define H (make-hash))
	(ana-sort H words) ;; build counters key= sorted-string, value = count
	(hash-get-keys H   ;; extract max count values
	    (for/fold (hmax 0) ((h H) )
	    #:when (>= (cdr h) hmax)
	    (cdr h))
	))


#lang transd

MainModule : {
    _start: (lambda
        (with sum 0 d 0 f Filter( from: 1 to: 20000 apply: (lambda
                (= sum 1)
                (for i in Range(2 (to-Int (sqrt @it))) do
                    (if (not (mod @it i))
                        (= d (/ @it i)) (+= sum i)
                        (if (neq d i) (+= sum d))))
                (ret sum)))
            (with v (to-vector f)
                (for i in v do
                    (if (and (< i (size v))
                             (eq (+ @idx 1) (get v (- i 1)))
                             (< i (get v (- i 1))))
                        (textout (+ @idx 1) ", " i "\n")
                    )))))
}


Input "Limit: ";l
Print "Amicable pairs < ";l

For n = 1 To l
  m = FUNC(_SumDivisors (n))-n
  If m = 0 Then Continue               ' No division by zero, please
  p = FUNC(_SumDivisors (m))-m
  If (n=p) * (n<m) Then Print n;" and ";m
Next

End

_LeastPower Param(2)
  Local(1)

  [email protected] = [email protected]
  Do While ([email protected] % [email protected]) = 0
    [email protected] = [email protected] * [email protected]
  Loop

Return ([email protected])

' Return the sum of the proper divisors of [email protected]

_SumDivisors Param(1)
  Local(4)

  [email protected] = [email protected]
  [email protected] = 1

  ' Handle two specially

  [email protected] = FUNC(_LeastPower (2,[email protected]))
  [email protected] = [email protected] * ([email protected] - 1)
  b@ = [email protected] / ([email protected] / 2)

  ' Handle odd factors

  For [email protected] = 3 Step 2 While ([email protected]*[email protected]) < ([email protected]+1)
    [email protected] = FUNC(_LeastPower ([email protected],[email protected]))
    [email protected] = [email protected] * (([email protected] - 1) / ([email protected] - 1))
    [email protected] = [email protected] / ([email protected] / [email protected])
  Loop

  ' At this point, t must be one or prime

  If ([email protected] > 1) [email protected] = [email protected] * ([email protected]+1)
Return ([email protected])


! cim --memory-pool-size=512 deranged-anagrams.sim;
BEGIN

   CLASS TEXTVECTOR;
   BEGIN

      CLASS TEXTARRAY(N); INTEGER N;
      BEGIN TEXT ARRAY DATA(1:N);
      END TEXTARRAY;

      PROCEDURE EXPAND(N); INTEGER N;
      BEGIN
         INTEGER I;
         REF(TEXTARRAY) TEMP;
         TEMP :- NEW TEXTARRAY(N);
         FOR I := 1 STEP 1 UNTIL SIZE DO
            TEMP.DATA(I) :- ITEMS.DATA(I);
         ITEMS :- TEMP;
      END EXPAND;

      PROCEDURE APPEND(T); TEXT T;
      BEGIN
         IF SIZE + 1 > CAPACITY THEN
         BEGIN
            CAPACITY := 2 * CAPACITY;
            EXPAND(CAPACITY);
         END;
         SIZE := SIZE + 1;
         ITEMS.DATA(SIZE) :- T;
      END APPEND;

      TEXT PROCEDURE ELEMENT(I); INTEGER I;
      BEGIN
         IF I < 1 OR I > SIZE THEN ERROR("ELEMENT: INDEX OUT OF BOUNDS");
         ELEMENT :- ITEMS.DATA(I);
      END ELEMENT;

      INTEGER PROCEDURE FIND_INDEX(STR,INDEX); TEXT STR; INTEGER INDEX;
      BEGIN
         INTEGER I, FOUND;
         FOUND := -1;
         FOR I := INDEX STEP 1 UNTIL SIZE DO
            IF STR = ELEMENT(I) THEN
            BEGIN
               FOUND := I;
               GOTO L;
            END;
      L: FIND_INDEX := FOUND;
      END FIND_INDEX;

      INTEGER CAPACITY;
      INTEGER SIZE;
      REF(TEXTARRAY) ITEMS;

      CAPACITY := 20;
      SIZE := 0;
      EXPAND(CAPACITY);
   END TEXTVECTOR;

   BOOLEAN PROCEDURE DERANGE(S1,S2); TEXT S1,S2;
   BEGIN
      INTEGER I;
      BOOLEAN RESULT;
      RESULT := TRUE;
      I := 1;
      WHILE RESULT AND I <= S1.LENGTH DO
      BEGIN
         CHARACTER C1, C2;
         S1.SETPOS(I); C1 := S1.GETCHAR;
         S2.SETPOS(I); C2 := S2.GETCHAR;
         IF C1 = C2 THEN
            RESULT := FALSE
         ELSE
            I := I+1;
      END;
      DERANGE := RESULT;
   END DERANGE;

   PROCEDURE STRSORT(STR); NAME STR; TEXT STR;
   BEGIN
      INTEGER N, I;
      FOR N := STR.LENGTH STEP -1 UNTIL 2 DO
         FOR I := 1 STEP 1 UNTIL N-1 DO
         BEGIN
            CHARACTER CI1,CI2;
            STR.SETPOS(I); CI1 := STR.GETCHAR; CI2 := STR.GETCHAR;
            IF CI1 > CI2 THEN
            BEGIN
               STR.SETPOS(I); STR.PUTCHAR(CI2); STR.PUTCHAR(CI1);
            END;
         END;
   END STRSORT;

   REF(INFILE) FILE;
   INTEGER LEN, FOUNDLEN;
   REF(TEXTVECTOR) VECT, SVECT;
   INTEGER INDEX, P1, P2;
   TEXT STR;

   VECT :- NEW TEXTVECTOR;
   SVECT :- NEW TEXTVECTOR;
   FOUNDLEN := 1;
   FILE :- NEW INFILE("unixdict.txt");
   FILE.OPEN(BLANKS(132));
   WHILE NOT FILE.LASTITEM DO
   BEGIN
      STR :- FILE.INTEXT(132).STRIP;
      LEN := STR.LENGTH;
      IF LEN > FOUNDLEN THEN
      BEGIN
         VECT.APPEND(COPY(STR));
         STRSORT(STR);
         INDEX := 0;
         COMMENT Loop through anagrams by index in vector of sorted strings;
         INDEX := SVECT.FIND_INDEX(STR, INDEX + 1);
         WHILE INDEX > 0 DO
         BEGIN
            IF DERANGE(VECT.ELEMENT(VECT.SIZE), VECT.ELEMENT(INDEX)) THEN
            BEGIN
               P1 := VECT.SIZE;
               P2 := INDEX;
               FOUNDLEN := LEN;
            END IF;
            INDEX := SVECT.FIND_INDEX(STR, INDEX + 1);
         END WHILE;
         SVECT.APPEND(STR);
      END IF;
   END WHILE;
   FILE.CLOSE;
   OUTTEXT(VECT.ELEMENT(P1) & " " & VECT.ELEMENT(P2));
   OUTIMAGE;
END


package require Tcl 8.5
package require http

# Fetch the words
set t [http::geturl "http://www.puzzlers.org/pub/wordlists/unixdict.txt"]
set wordlist [split [http::data $t] \n]
http::cleanup $t

# Group by characters in word
foreach word $wordlist {
    dict lappend w [lsort [split $word ""]] [split $word ""]
}

# Deranged test
proc deranged? {l1 l2} {
    foreach c1 $l1 c2 $l2 {
	if {$c1 eq $c2} {return 0}
    }
    return 1
}

# Get a deranged pair from an anagram set, if one exists
proc getDeranged {words} {
    foreach l1 [lrange $words 0 end-1] {
	foreach l2 [lrange $words 1 end] {
	    if {[deranged? $l1 $l2]} {
		return [list $l1 $l2 1]
	    }
	}
    }
    return {{} {} 0}
}

# Find the max-length deranged anagram
set count 0
set candidates {}
set max 0
dict for {k words} $w {
    incr count [expr {[llength $words] > 1}]
    if {[llength $k] > $max && [lassign [getDeranged $words] l1 l2]} {
	set max [llength $l1]
	lappend candidates [join $l1 ""],[join $l2 ""]
    }
}

# Print out what we found
puts "[llength $wordlist] words"
puts "[dict size $w] potential anagram-groups"
puts "$count real anagram-groups"
foreach pair $candidates {
    puts "considered candidate pairing: $pair"
}
puts "MAXIMAL DERANGED ANAGRAM: LENGTH $max\n\t[lindex $candidates end]"


#include <iostream>
#include <string_view>
#include <boost/hana.hpp>
#include <boost/hana/experimental/printable.hpp>

using namespace std;
namespace hana = boost::hana;

// Define the Amb function.  The first parameter is the constraint to be
// enforced followed by the potential values.
constexpr auto Amb(auto constraint, auto&& ...params)
{
  // create the set of all possible solutions
  auto possibleSolutions = hana::cartesian_product(hana::tuple(params...));

  // find one that matches the constraint
  auto foldOperation = [constraint](auto a, auto b)
  {
    bool meetsConstraint = constraint(a);
    return meetsConstraint ? a : b;
  };

  return hana::fold_right(possibleSolutions, foldOperation);
}

void AlgebraExample()
{
  // use a tuple to hold the possible values of each variable
  constexpr hana::tuple x{1, 2, 3};
  constexpr hana::tuple y{7, 6, 4, 5};

  // the constraint enforcing x * y == 8
  constexpr auto constraint = [](auto t)
  {
    return t[hana::size_c<0>] * t[hana::size_c<1>] == 8;
  };

  // find the solution using the Amb function
  auto result = Amb(constraint, x, y);

  cout << "\nx = " << hana::experimental::print(x);
  cout << "\ny = " << hana::experimental::print(y);
  cout << "\nx * y == 8: " << hana::experimental::print(result);
}

void StringExample()
{
  // the word lists to choose from
  constexpr hana::tuple words1 {"the"sv, "that"sv, "a"sv};
  constexpr hana::tuple words2 {"frog"sv, "elephant"sv, "thing"sv};
  constexpr hana::tuple words3 {"walked"sv, "treaded"sv, "grows"sv};
  constexpr hana::tuple words4 {"slowly"sv, "quickly"sv};

  // the constraint that the first letter of a word is the same as the last
  // letter of the previous word
  constexpr auto constraint = [](const auto t)
  {
    auto adjacent = hana::zip(hana::drop_back(t), hana::drop_front(t));
    return hana::all_of(adjacent, [](auto t)
    {
      return t[hana::size_c<0>].back() == t[hana::size_c<1>].front();
    });
  };

  // find the solution using the Amb function
  auto wordResult = Amb(constraint, words1, words2, words3, words4);

  cout << "\n\nWords 1: " << hana::experimental::print(words1);
  cout << "\nWords 2: " << hana::experimental::print(words2);
  cout << "\nWords 3: " << hana::experimental::print(words3);
  cout << "\nWords 4: " << hana::experimental::print(words4);
  cout << "\nSolution: " << hana::experimental::print(wordResult) << "\n";
}

int main()
{
  AlgebraExample();
  StringExample();
}


class
	ANAGRAMS

create
	make

feature

	make
			-- Set of Anagrams, containing most words.
		local
			count: INTEGER
		do
			read_wordlist
			across
				words as wo
			loop
				if wo.item.count > count then
					count := wo.item.count
				end
			end
			across
				words as wo
			loop
				if wo.item.count = count then
					across
						wo.item as list
					loop
						io.put_string (list.item + "%T")
					end
					io.new_line
				end
			end
		end

	original_list: STRING = "unixdict.txt"

feature {NONE}

	read_wordlist
			-- Preprocessed wordlist for finding Anagrams.
		local
			l_file: PLAIN_TEXT_FILE
			sorted: STRING
			empty_list: LINKED_LIST [STRING]
		do
			create l_file.make_open_read_write (original_list)
			l_file.read_stream (l_file.count)
			wordlist := l_file.last_string.split ('%N')
			l_file.close
			create words.make (wordlist.count)
			across
				wordlist as w
			loop
				create empty_list.make
				sorted := sort_letters (w.item)
				words.put (empty_list, sorted)
				if attached words.at (sorted) as ana then
					ana.extend (w.item)
				end
			end
		end

	wordlist: LIST [STRING]

	sort_letters (word: STRING): STRING
			--Sorted in alphabetical order.
		local
			letters: SORTED_TWO_WAY_LIST [STRING]
		do
			create letters.make
			create Result.make_empty
			across
				1 |..| word.count as i
			loop
				letters.extend (word.at (i.item).out)
			end
			across
				letters as s
			loop
				Result.append (s.item)
			end
		end

	words: HASH_TABLE [LINKED_LIST [STRING], STRING]

end


···
http://rosettacode.org/wiki/Amicable_pairs
···
■ AmicablePairs
  § static
    ▶ main
    • args⦂ String[]
      ∀ n ∈ 1…20000
        m⦂ int: sumPropDivs n
        if m < n = sumPropDivs m
           System.out.println "⸨m⸩ ; ⸨n⸩"

    ▶ sumPropDivs⦂ int
    • n⦂ int
      m⦂ int: 1
      ∀ i ∈ √n ⋯> 1
        m +: n \ i = 0 ? i + (i = n / i ? 0 ! n / i) ! 0
      ⏎ m


Option Explicit

Public Sub AmicablePairs()
Dim a(2 To 20000) As Long, c As New Collection, i As Long, j As Long, t#
    t = Timer
    For i = LBound(a) To UBound(a)
        'collect the sum of the proper divisors
        'of each numbers between 2 and 20000
        a(i) = S(i)
    Next
    'Double Loops to test the amicable
    For i = LBound(a) To UBound(a)
        For j = i + 1 To UBound(a)
            If i = a(j) Then
                If a(i) = j Then
                     On Error Resume Next
                     c.Add i & " : " & j, CStr(i * j)
                     On Error GoTo 0
                     Exit For
                End If
            End If
        Next
    Next
    'End. Return :
    Debug.Print "Execution Time : " & Timer - t & " seconds."
    Debug.Print "Amicable pairs below 20 000 are : "
    For i = 1 To c.Count
        Debug.Print c.Item(i)
    Next i
End Sub

Private Function S(n As Long) As Long
'returns the sum of the proper divisors of n
Dim j As Long
    For j = 1 To n \ 2
        If n Mod j = 0 Then S = j + S
    Next
End Function


start = Now
Set nlookup = CreateObject("Scripting.Dictionary")
Set uniquepair = CreateObject("Scripting.Dictionary")

For i = 1 To 20000
	sum = 0
	For n = 1 To 20000
		If n < i Then
			If i Mod n = 0 Then
				sum = sum + n
			End If
		End If
	Next
	nlookup.Add i,sum
Next

For j = 1 To 20000
	sum = 0
	For m = 1 To 20000
		If m < j Then
			If j Mod m = 0 Then
				sum = sum + m
			End If
		End If
	Next
	If nlookup.Exists(sum) And nlookup.Item(sum) = j And j <> sum _
		And uniquepair.Exists(sum) = False Then
			uniquepair.Add j,sum
	End If
Next

For Each key In uniquepair.Keys
	WScript.Echo key & ":" & uniquepair.Item(key)
Next

WScript.Echo "Execution Time: " & DateDiff("s",Start,Now) & " seconds"


$$ MODE TUSCRIPT,{}
requestdata = REQUEST ("http://www.puzzlers.org/pub/wordlists/unixdict.txt")

DICT anagramm CREATE 99999

COMPILE
 LOOP word=requestdata
  -> ? : any character
  charsInWord=STRINGS (word," ? ")
  charString =ALPHA_SORT (charsInWord)

  DICT anagramm LOOKUP charString,num,freq,wordalt,wlalt
  IF (num==0) THEN
   WL=SIZE (charString)
   DICT anagramm APPEND/QUIET/COUNT charString,num,freq,word,wl;" "
  ELSE
   DICT anagramm APPEND/QUIET/COUNT charString,num,freq,word,"";" "
  ENDIF
 ENDLOOP

DICT anagramm UNLOAD charString,all,freq,anagrams,wl

index        =DIGIT_INDEX (wl)
reverseIndex =REVERSE (index)
wl           =INDEX_SORT (wl,reverseIndex)
freq         =INDEX_SORT (freq,reverseIndex)
anagrams     =INDEX_SORT (anagrams,reverseIndex)
charString   =INDEX_SORT (charString,reverseIndex)

LOOP fr=freq,a=anagrams,w=wl
 IF (fr==1) cycle
 asplit=SPLIT (a,": :")
 a1=SELECT (asplit,1,arest)
 a1split=STRINGS (a1," ? ")
 LOOP r=arest
  rsplit=STRINGS (r," ? ")
   LOOP v1=a1split,v2=rsplit
    IF (v1==v2) EXIT,EXIT
   ENDLOOP
    PRINT "Largest deranged anagram (length: ",w,"):"
    PRINT a
   STOP
 ENDLOOP
ENDLOOP
ENDCOMPILE


function get_words {
    typeset host=www.puzzlers.org
    typeset page=/pub/wordlists/unixdict.txt
    exec 7<>/dev/tcp/$host/80
    print -e -u7 "GET $page HTTP/1.1\r\nhost: $host\r\nConnection: close\r\n\r\n"
    # remove the http header and save the word list
    sed 's/\r$//; 1,/^$/d' <&7 >"$1"
    exec 7<&-
}

function is_deranged {
    typeset -i i
    for ((i=0; i<${#1}; i++)); do
        [[ ${1:i:1} == ${2:i:1} ]] && return 1
    done
    return 0
}

function word2key {
    typeset -a chars=( $(
        for ((i=0; i<${#word}; i++)); do
            echo "${word:i:1}"
        done | sort
    ) )
    typeset IFS=""
    echo "${chars[*]}"
}

[[ -f word.list ]] || get_words word.list

typeset -A words
typeset -i max=0

while IFS= read -r word; do
    key=$(word2key $word)
    if [[ -z "${words["$key"]}" ]]; then
        words["$key"]=$word
    else
        if (( ${#word} > max )); then
            if is_deranged "${words["$key"]}" "$word"; then
                max_deranged=("${words["$key"]}" "$word")
                max=${#word}
            fi
        fi
    fi
done <word.list
echo $max - ${max_deranged[@]}


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


open monad io list string

groupon f x y = f x == f y

lines = split "\n" << replace "\n\n" "\n" << replace "\r" "\n"

main = do
  fh <- readFile "c:\\test\\unixdict.txt" OpenMode
  f <- readLines fh
  closeFile fh
  let words = lines f
  let wix = groupBy (groupon fst) << sort $ zip (map sort words) words
  let mxl = maximum $ map length wix
  mapM_ (putLn << map snd) << filter ((==mxl) << length) $ wix


import system'routines;
import system'calendar;
import system'io;
import system'collections;
import extensions;
import extensions'routines;
import extensions'text;

extension op
{
     string normalized()
         = self.toArray().ascendant().summarize(new StringWriter());
}

public program()
{
    var start := now;

    auto dictionary := new Map<string,object>();

    File.assign("unixdict.txt").forEachLine:(word)
    {
        var key := word.normalized();
        var item := dictionary[key];
        if (nil == item)
        {
            item := new ArrayList();
            dictionary[key] := item
        };

        item.append:word
    };

    dictionary.Values
        .sort:(former,later => former.Item2.Length > later.Item2.Length )
        .top:20
        .forEach:(pair){ console.printLine(pair.Item2) };

    var end := now;

    var diff := end - start;

    console.printLine("Time elapsed in msec:",diff.Milliseconds);

    console.readChar()
}


fn pfac_sum(i int) int {
    mut sum := 0
    for p := 1;p <= i/2;p++{
        if i%p == 0 {
            sum += p
        }
    }
    return sum
}

fn main(){
    a := []int{len: 20000, init:pfac_sum(it)}
    println('The amicable pairs below 20,000 are:')
    for n in 2 .. a.len {
        m := a[n]
        if m > n && m < 20000 && n == a[m] {
            println('${n:5} and ${m:5}')
        }
    }
}


import "/fmt" for Fmt
import "/math" for Int, Nums

var a = List.filled(20000, 0)
for (i in 1...20000) a[i] = Nums.sum(Int.properDivisors(i))
System.print("The amicable pairs below 20,000 are:")
for (n in 2...19999) {
    var m = a[n]
    if (m > n && m < 20000 && n == a[m]) {
        System.print("  %(Fmt.d(5, n)) and %(Fmt.d(5, m))")
    }
}


#import std

anagrams = |=tK33lrDSL2SL ~=&& ==+ ~~ -<&

deranged = filter not zip; any ==

#cast %sW

main = leql$^&l deranged anagrams unixdict_dot_txt


Sub Main_DerangedAnagrams()
Dim ListeWords() As String, Book As String, i As Long, j As Long, tempLen As Integer, MaxLen As Integer, tempStr As String, IsDeranged As Boolean, count As Integer, bAnag As Boolean
Dim t As Single
t = Timer
    Book = Read_File("C:\Users\" & Environ("Username") & "\Desktop\unixdict.txt")
    ListeWords = Split(Book, vbNewLine)
    For i = LBound(ListeWords) To UBound(ListeWords) - 1
        For j = i + 1 To UBound(ListeWords)
            If Len(ListeWords(i)) = Len(ListeWords(j)) Then
                tempLen = 0
                IsDeranged = False
                bAnag = IsAnagram(ListeWords(i), ListeWords(j), IsDeranged, tempLen)
                If IsDeranged Then
                    count = count + 1
                    If tempLen > MaxLen Then
                        MaxLen = tempLen
                        tempStr = ListeWords(i) & ", " & ListeWords(j)
                    End If
                End If
            End If
        Next j
    Next i
    Debug.Print "There is : " & count & " deranged anagram, in unixdict.txt."
    Debug.Print "The longest is : " & tempStr
    Debug.Print "Lenght  : " & MaxLen
    Debug.Print "Time to compute : " & Timer - t & " sec."
End Sub
Private Function Read_File(Fic As String) As String
Dim Nb As Integer
    Nb = FreeFile
    Open Fic For Input As #Nb
        Read_File = Input(LOF(Nb), #Nb)
    Close #Nb
End Function
Function IsAnagram(str1 As String, str2 As String, DerangedAnagram As Boolean, Lenght As Integer) As Boolean
Dim i As Integer
    str1 = Trim(UCase(str1))
    str2 = Trim(UCase(str2))
    For i = 1 To Len(str1)
        If Len(Replace(str1, Mid$(str1, i, 1), vbNullString)) <> Len(Replace(str2, Mid$(str1, i, 1), vbNullString)) Then
            Exit Function
        End If
        If Mid$(str1, i, 1) = Mid$(str2, i, 1) Then
            Exit Function
        End If
    Next i
    IsAnagram = True
    DerangedAnagram = True
    Lenght = Len(str1)
End Function


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


defmodule Anagrams do
  def find(file) do
    File.read!(file)
    |> String.split
    |> Enum.group_by(fn word -> String.codepoints(word) |> Enum.sort end)
    |> Enum.group_by(fn {_,v} -> length(v) end)
    |> Enum.max
    |> print
  end

  defp print({_,y}) do
    Enum.each(y, fn {_,e} -> Enum.sort(e) |> Enum.join(" ") |> IO.puts end)
  end
end

Anagrams.find("unixdict.txt")


-module(anagrams).
-compile(export_all).

play() ->
    {ok, P} = file:read_file('unixdict.txt'),
    D = dict:new(),
    E=fetch(string:tokens(binary_to_list(P), "\n"), D),
    get_value(dict:fetch_keys(E), E).

fetch([H|T], D) ->
    fetch(T, dict:append(lists:sort(H), H, D));
fetch([], D) ->
    D.

get_value(L, D) -> get_value(L,D,1,[]).
get_value([H|T], D, N, L) ->
    Var = dict:fetch(H,D),
    Len = length(Var),
    if
        Len > N ->
            get_value(T, D, Len, [Var]);
        Len == N ->
            get_value(T, D, Len, [Var | L]);
        Len < N ->
            get_value(T, D, N, L)
    end;

get_value([], _, _, L) ->
    L.


func    SumDiv(Num);    \Return sum of proper divisors of Num
int     Num, Div, Sum, Quot;
[Div:= 2;
Sum:= 0;
loop    [Quot:= Num/Div;
        if Div > Quot then quit;
        if rem(0) = 0 then
            [Sum:= Sum + Div;
            if Div # Quot then Sum:= Sum + Quot;
            ];
        Div:= Div+1;
        ];
return Sum+1;
];

def Limit = 20000;
int Tbl(Limit), N, M;
[for N:= 0 to Limit-1 do
    Tbl(N):= SumDiv(N);
for N:= 1 to Limit-1 do
    [M:= Tbl(N);
    if M<Limit & N=Tbl(M) & M>N then
        [IntOut(0, N);  ChOut(0, 9\tab\);
         IntOut(0, M);  CrLf(0);
        ];
    ];
]


sub sumDivs(n)
    local sum, d

    sum = 1

    for d = 2 to sqrt(n)
        if not mod(n, d) then
            sum = sum + d
            sum = sum + n / d
        end if
    next
    return sum
end sub

for n = 2 to 20000
    m = sumDivs(n)
    if m > n then
        if sumDivs(m) = n print n, "\t", m
    end if
next

print : print peek("millisrunning"), " ms"


fcn properDivs(n){ [1.. (n + 1)/2 + 1].filter('wrap(x){ n%x==0 and n!=x }) }
const N=20000;
sums:=[1..N].pump(T(-1),fcn(n){ properDivs(n).sum(0) });
[0..].zip(sums).filter('wrap([(n,s)]){ (n<s<=N) and sums[s]==n }).println();


const MAXIMUM: u32 = 20_000;

// Fill up a given array with arr[n] = sum(propDivs(n))
pub fn calcPropDivs(divs: []u32) void {
    for (divs) |*d| d.* = 1;
    var i: u32 = 2;
    while (i <= divs.len/2) : (i += 1) {
        var j = i * 2;
        while (j < divs.len) : (j += i)
            divs[j] += i;
    }
}

// Are (A, B) an amicable pair?
pub fn amicable(divs: []const u32, a: u32, b: u32) bool {
    return divs[a] == b and a == divs[b];
}

pub fn main() !void {
    const stdout = @import("std").io.getStdOut().writer();

    var divs: [MAXIMUM + 1]u32 = undefined;
    calcPropDivs(divs[0..]);

    var a: u32 = 1;
    while (a < divs.len) : (a += 1) {
        var b = a+1;
        while (b < divs.len) : (b += 1) {
            if (amicable(divs[0..], a, b))
                try stdout.print("{d}, {d}\n", .{a, b});
        }
    }
}


import os

fn deranged(a string, b string) bool {
	if a.len != b.len {
		return false
	}
	for i in 0..a.len {
		if a[i] == b[i] { return false }
	}
	return true
}
fn main(){
    words := os.read_lines('unixdict.txt')?

    mut m := map[string][]string{}
    mut best_len, mut w1, mut w2 := 0, '',''

    for w in words {
		// don't bother: too short to beat current record
		if w.len <= best_len { continue }

		// save strings in map, with sorted string as key
		mut letters := w.split('')
		letters.sort()
		k := letters.join("")

		if k !in m {
			m[k] = [w]
			continue
		}

		for c in m[k] {
			if deranged(w, c) {
				best_len, w1, w2 = w.len, c, w
				break
			}
		}

		m[k] << w
	}

	println('$w1 $w2: Length $best_len')
}


import "io" for File
import "/sort" for Sort

// assumes w1 and w2 are anagrams of each other
var isDeranged = Fn.new { |w1, w2|
    for (i in 0...w1.count) {
        if (w1[i] == w2[i]) return false
    }
    return true
}

var words = File.read("unixdict.txt").split("\n").map { |w| w.trim() }
var wordMap = {}
for (word in words) {
    var letters = word.toList
    Sort.insertion(letters)
    var sortedWord = letters.join()
    if (wordMap.containsKey(sortedWord)) {
        wordMap[sortedWord].add(word)
    } else {
        wordMap[sortedWord] = [word]
    }
}

var deranged = []
for (key in wordMap.keys) {
    var ana = wordMap[key]
    var count = ana.count
    if (count > 1) {
        for (i in 0...count-1) {
            for (j in i + 1...count) {
                if (isDeranged.call(ana[i], ana[j])) deranged.add([ana[i], ana[j]])
            }
        }
    }
}

var most = deranged.reduce(0) { |max, words| (words[0].count > max) ? words[0].count : max }
for (words in deranged) {
    if (words[0].count == most) System.print([words[0], words[1]])
}


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


include sort.e

function compare_keys(sequence a, sequence b)
    return compare(a[1],b[1])
end function

constant fn = open("unixdict.txt","r")
sequence words, anagrams
object word
words = {}
while 1 do
    word = gets(fn)
    if atom(word) then
        exit
    end if
    word = word[1..$-1] -- truncate new-line character
    words = append(words, {sort(word), word})
end while
close(fn)

integer maxlen
maxlen = 0
words = custom_sort(routine_id("compare_keys"), words)
anagrams = {words[1]}
for i = 2 to length(words) do
    if equal(anagrams[$][1],words[i][1]) then
        anagrams[$] = append(anagrams[$], words[i][2])
    elsif length(anagrams[$]) = 2 then
        anagrams[$] = words[i]
    else
        if length(anagrams[$]) > maxlen then
            maxlen = length(anagrams[$])
        end if
        anagrams = append(anagrams, words[i])
    end if
end for
if length(anagrams[$]) = 2 then
    anagrams = anagrams[1..$-1]
end if

for i = 1 to length(anagrams) do
    if length(anagrams[i]) = maxlen then
        for j = 2 to length(anagrams[i]) do
            puts(1,anagrams[i][j])
            puts(1,' ')
        end for
        puts(1,"\n")
    end if
end for


10 LET limit=20000
20 PRINT "Amicable pairs < ";limit
30 FOR n=1 TO limit
40 LET num=n: GO SUB 1000
50 LET m=num
60 GO SUB 1000
70 IF n=num AND n<m THEN PRINT n;" ";m
80 NEXT n
90 STOP
1000 REM sumprop
1010 IF num<2 THEN LET num=0: RETURN
1020 LET sum=1
1030 LET root=SQR num
1040 FOR i=2 TO root-.01
1050 IF num/i=INT (num/i) THEN LET sum=sum+i+num/i
1060 NEXT i
1070 IF num/root=INT (num/root) THEN LET sum=sum+root
1080 LET num=sum
1090 RETURN


words:=Dictionary(25000);  //-->Dictionary(sorted word:all anagrams, ...)
File("unixdict.txt").read().pump(Void,'wrap(w){
   w=w.strip(); key:=w.sort(); words[key]=words.find(key,T).append(w);
});

nws:=words.values.pump(List,fcn(ws){ //-->( (len,words), ...)
   if(ws.len()>1){ // two or more anagrams
      r:=List(); n:=ws[0].len(); // length of these anagrams
      foreach idx,w in (ws.enumerate()){
	 foreach w2 in (ws[idx+1,*]){
	    if(Utils.zipWith('!=,w,w2).filter().len()==n)
	       r.write(T(w,w2));
	 }
      }
      if(r) return(r.insert(0,n));
   }
   Void.Skip
});

nws.filter(fcn(nws,max){ nws[0]==max },
   nws.reduce(fcn(p,nws){ p.max(nws[0]) },0) )
.println();


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


let xss = Seq.groupBy (Array.ofSeq >> Array.sort) (System.IO.File.ReadAllLines "unixdict.txt")
Seq.map snd xss |> Seq.filter (Seq.length >> ( = ) (Seq.map (snd >> Seq.length) xss |> Seq.max))


class Main
{
  // take given word and return a string rearranging characters in order
  static Str toOrderedChars (Str word)
  {
    Str[] chars := [,]
    word.each |Int c| { chars.add (c.toChar) }
    return chars.sort.join("")
  }

  // add given word to anagrams map
  static Void addWord (Str:Str[] anagrams, Str word)
  {
    Str orderedWord := toOrderedChars (word)
    if (anagrams.containsKey (orderedWord))
      anagrams[orderedWord].add (word)
    else
      anagrams[orderedWord] = [word]
  }

  public static Void main ()
  {
    Str:Str[] anagrams := [:] // map Str -> Str[]
    // loop through input file, adding each word to map of anagrams
    File (`unixdict.txt`).eachLine |Str word|
    {
      addWord (anagrams, word)
    }
    // loop through anagrams, keeping the keys with values of largest size
    Str[] largestKeys := [,]
    anagrams.keys.each |Str k|
    {
      if ((largestKeys.size < 1) || (anagrams[k].size == anagrams[largestKeys[0]].size))
        largestKeys.add (k)
      else if (anagrams[k].size > anagrams[largestKeys[0]].size)
        largestKeys = [k]
    }
    largestKeys.each |Str k|
    {
      echo ("Key: $k -> " + anagrams[k].join(", "))
    }
  }
}


; We don't need 'amb' in the code since pattern-matching of Egison automatically do backtracking.
(match-all {{"the" "that" "a"} {"frog" "elephant" "thing"} {"walked" "treaded" "grows"} {"slowly" "quickly"}} (list (multiset string))
  [<cons <cons (& <snoc $c_1 _> $w_1) _>
         (loop $i [2 $n]
           <cons <cons (& <cons ,c_(- i 1) <snoc $c_i _>> $w_i) _> ...>
           <nil>)>
   (map (lambda [$i] w_i) (between 1 n))])


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


!***************************************************************************************
	module anagram_routines
!***************************************************************************************
	implicit none

	!the dictionary file:
	integer,parameter :: file_unit = 1000
	character(len=*),parameter :: filename = 'unixdict.txt'

	!maximum number of characters in a word:
	integer,parameter :: max_chars = 50

	!maximum number of characters in the string displaying the anagram lists:
	integer,parameter :: str_len = 256

	type word
	  character(len=max_chars) :: str = repeat(' ',max_chars)    !the word from the dictionary
	  integer                  :: n = 0                          !length of this word
	  integer                  :: n_anagrams = 0	             !number of anagrams found
	  logical                  :: checked = .false.              !if this one has already been checked
	  character(len=str_len)   :: anagrams = repeat(' ',str_len) !the anagram list for this word
	end type word

	!the dictionary structure:
	type(word),dimension(:),allocatable,target :: dict

	contains
!***************************************************************************************

	!******************************************************************************
		function count_lines_in_file(fid) result(n_lines)
	!******************************************************************************
		implicit none

		integer             :: n_lines
		integer,intent(in)  :: fid
		character(len=1)    :: tmp
		integer             :: i
		integer             :: ios

		!the file is assumed to be open already.

		rewind(fid)	  !rewind to beginning of the file

		n_lines = 0
		do !read each line until the end of the file.
			read(fid,'(A1)',iostat=ios) tmp
			if (ios < 0) exit      !End of file
			n_lines = n_lines + 1  !row counter
		end do

		rewind(fid)   !rewind to beginning of the file

	!******************************************************************************
		end function count_lines_in_file
	!******************************************************************************

	!******************************************************************************
		pure elemental function is_anagram(x,y)
	!******************************************************************************
		implicit none
		character(len=*),intent(in) :: x
		character(len=*),intent(in) :: y
		logical :: is_anagram

		character(len=len(x)) :: x_tmp	!a copy of x
		integer :: i,j

		!a character not found in any word:
		character(len=1),parameter :: null = achar(0)

		!x and y are assumed to be the same size.

		x_tmp = x
		do i=1,len_trim(x)
			j = index(x_tmp, y(i:i)) !look for this character in x_tmp
			if (j/=0) then
				x_tmp(j:j) = null  !clear it so it won't be checked again
			else
				is_anagram = .false. !character not found: x,y are not anagrams
				return
			end if
		end do

		!if we got to this point, all the characters
		! were the same, so x,y are anagrams:
		is_anagram = .true.

	!******************************************************************************
		end function is_anagram
	!******************************************************************************

!***************************************************************************************
	end module anagram_routines
!***************************************************************************************

!***************************************************************************************
	program main
!***************************************************************************************
	use anagram_routines
	implicit none

	integer :: n,i,j,n_max
	type(word),pointer :: x,y
	logical :: first_word
	real :: start, finish

	call cpu_time(start)	!..start timer

	!open the dictionary and read in all the words:
	open(unit=file_unit,file=filename)      !open the file
	n = count_lines_in_file(file_unit)      !count lines in the file
	allocate(dict(n))                       !allocate dictionary structure
	do i=1,n                                !
		read(file_unit,'(A)') dict(i)%str   !each line is a word in the dictionary
		dict(i)%n = len_trim(dict(i)%str)   !saving length here to avoid trim's below
	end do
	close(file_unit)                        !close the file

	!search dictionary for anagrams:
	do i=1,n

		x => dict(i)	!pointer to simplify code
		first_word = .true.	!initialize

		do j=i,n

			y => dict(j)	!pointer to simplify code

			!checks to avoid checking words unnecessarily:
			if (x%checked .or. y%checked) cycle     !both must not have been checked already
			if (x%n/=y%n) cycle                     !must be the same size
			if (x%str(1:x%n)==y%str(1:y%n)) cycle   !can't be the same word

			! check to see if x,y are anagrams:
			if (is_anagram(x%str(1:x%n), y%str(1:y%n))) then
				!they are anagrams.
				y%checked = .true. 	!don't check this one again.
				x%n_anagrams = x%n_anagrams + 1
				if (first_word) then
					!this is the first anagram found for this word.
					first_word = .false.
					x%n_anagrams = x%n_anagrams + 1
					x%anagrams = trim(x%anagrams)//x%str(1:x%n)  !add first word to list
				end if
				x%anagrams = trim(x%anagrams)//','//y%str(1:y%n) !add next word to list
			end if

		end do
		x%checked = .true.  !don't check this one again

	end do

	!anagram groups with the most words:
	write(*,*) ''
	n_max = maxval(dict%n_anagrams)
	do i=1,n
		if (dict(i)%n_anagrams==n_max) write(*,'(A)') trim(dict(i)%anagrams)
	end do

	!anagram group containing longest words:
	write(*,*) ''
	n_max = maxval(dict%n, mask=dict%n_anagrams>0)
	do i=1,n
		if (dict(i)%n_anagrams>0 .and. dict(i)%n==n_max) write(*,'(A)') trim(dict(i)%anagrams)
	end do
	write(*,*) ''

	call cpu_time(finish)	!...stop timer
	write(*,'(A,F6.3,A)') '[Runtime = ',finish-start,' sec]'
	write(*,*) ''

!***************************************************************************************
	end program main
!***************************************************************************************


import system'routines;
import extensions;
import extensions'routines;

joinable(former,later) = (former[former.Length - 1] == later[0]);

dispatcher = new
{
    eval(object a, Func2 f)
    {
        ^ f(a[0],a[1])
    }

    eval(object a, Func3 f)
    {
        ^ f(a[0], a[1],a[2])
    }

    eval(object a, Func4 f)
    {
        ^ f(a[0],a[1],a[2],a[3])
    }

    eval(object a, Func5 f)
    {
        ^ f(a[0],a[1],a[2],a[3],a[4])
    }
};

class AmbValueCollection
{
    object theCombinator;

    constructor new(params object[] args)
    {
        theCombinator := SequentialEnumerator.new(params args)
    }

    seek(cond)
    {
        theCombinator.reset();

        theCombinator.seekEach:(v => dispatcher.eval(v,cond))
    }

    do(f)
    {
        var result := theCombinator.get();
        if (nil != result)
        {
            dispatcher.eval(result,f)
        }
        else
        {
            InvalidArgumentException.raise()
        }
    }
}

singleton ambOperator
{
    for(params object[] args)
        = AmbValueCollection.new(params args);
}

public program()
{
    try
    {
        ambOperator
            .for(
                new object[]{"the","that","a"},
                new object[]{"frog", "elephant", "thing"},
                new object[]{"walked", "treaded", "grows"},
                new object[]{"slowly", "quickly"})
            .seek:(a,b,c,d => joinable(a,b) && joinable(b,c) && joinable(c,d) )
            .do:(a,b,c,d) { console.printLine(a," ",b," ",c," ",d) }
    }
    catch(Exception e)
    {
        console.printLine:"AMB is angry"
    };

    console.readChar()
}


PROGRAM AMB

!
! for rosettacode.org
!

!$KEY

DIM SET1$[2],SET2$[2],SET3$[2],SET4$[2]

FUNCTION WORDS_OK(STRING1$,STRING2$)
  WORDS_OK=(RIGHT$(STRING1$,1)=LEFT$(STRING2$,1))
END FUNCTION

PROCEDURE AMB(SET1$[],SET2$[],SET3$[],SET4$[]->RESULT$)
  RESULT$="" ! Empty string, e.g. fail
  FOR A=0 TO 2 DO
    FOR B=0 TO 2 DO
      FOR C=0 TO 2 DO
        FOR D=0 TO 2 DO
          IF WORDS_OK(SET1$[A],SET2$[B]) AND WORDS_OK(SET2$[B],SET3$[C]) AND WORDS_OK(SET3$[C],SET4$[D]) THEN
            RESULT$=SET1$[A]+" "+SET2$[B]+" "+SET3$[C]+" "+SET4$[D]
            EXIT PROCEDURE
          END IF
        END FOR
      END FOR
    END FOR
  END FOR
END PROCEDURE

BEGIN
  PRINT(CHR$(12);)   ! CLS
  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"  SET4$[2]=""

  AMB(SET1$[],SET2$[],SET3$[],SET4$[]->TEXT$)
  IF TEXT$<>"" THEN
    PRINT("Correct sentence would be:")
    PRINT(TEXT$)
  ELSE
    PRINT("Failed to fine a correct sentence.")
  END IF
  PRINT
  PRINT("Press any key to exit.")
  REPEAT
    GET(Z$)
  UNTIL LEN(Z$)<>0
END PROGRAM


#APPTYPE CONSOLE

DIM gtc = GetTickCount()
Anagram()
PRINT "Done in ", (GetTickCount() - gtc) / 1000, " seconds"

PAUSE

DYNC Anagram()
	#include <windows.h>
	#include <stdio.h>

	char* sortedWord(const char* word, char* wbuf)
	{
		char* p1, *p2, *endwrd;
		char t;
		int swaps;

		strcpy(wbuf, word);
		endwrd = wbuf + strlen(wbuf);
		do {
			swaps = 0;
			p1 = wbuf; p2 = endwrd - 1;
			while (p1 < p2) {
				if (*p2 >* p1) {
					t = *p2; *p2 = *p1; *p1 = t;
					swaps = 1;
				}
				p1++; p2--;
			}
			p1 = wbuf; p2 = p1 + 1;
			while (p2 < endwrd) {
				if (*p2 >* p1) {
					t = *p2; *p2 = *p1; *p1 = t;
					swaps = 1;
				}
				p1++; p2++;
			}
		} while (swaps);
		return wbuf;
	}

	static short cxmap[] = {
		0x06, 0x1f, 0x4d, 0x0c, 0x5c, 0x28, 0x5d, 0x0e, 0x09, 0x33, 0x31, 0x56,
		0x52, 0x19, 0x29, 0x53, 0x32, 0x48, 0x35, 0x55, 0x5e, 0x14, 0x27, 0x24,
		0x02, 0x3e, 0x18, 0x4a, 0x3f, 0x4c, 0x45, 0x30, 0x08, 0x2c, 0x1a, 0x03,
		0x0b, 0x0d, 0x4f, 0x07, 0x20, 0x1d, 0x51, 0x3b, 0x11, 0x58, 0x00, 0x49,
		0x15, 0x2d, 0x41, 0x17, 0x5f, 0x39, 0x16, 0x42, 0x37, 0x22, 0x1c, 0x0f,
		0x43, 0x5b, 0x46, 0x4b, 0x0a, 0x26, 0x2e, 0x40, 0x12, 0x21, 0x3c, 0x36,
		0x38, 0x1e, 0x01, 0x1b, 0x05, 0x4e, 0x44, 0x3d, 0x04, 0x10, 0x5a, 0x2a,
		0x23, 0x34, 0x25, 0x2f, 0x2b, 0x50, 0x3a, 0x54, 0x47, 0x59, 0x13, 0x57,
	};
	#define CXMAP_SIZE (sizeof(cxmap) / sizeof(short))

	int Str_Hash(const char* key, int ix_max)
	{
		const char* cp;
		short mash;
		int hash = 33501551;
		for (cp = key; *cp; cp++) {
			mash = cxmap[*cp % CXMAP_SIZE];
			hash = (hash >>4) ^ 0x5C5CF5C ^ ((hash << 1) + (mash << 5));
			hash &= 0x3FFFFFFF;
		}
		return hash % ix_max;
	}

	typedef struct sDictWord* DictWord;
	struct sDictWord {
		const char* word;
		DictWord next;
	};

	typedef struct sHashEntry* HashEntry;
	struct sHashEntry {
		const char* key;
		HashEntry next;
		DictWord words;
		HashEntry link;
		short wordCount;
	};

	#define HT_SIZE 8192

	HashEntry hashTable[HT_SIZE];

	HashEntry mostPerms = NULL;

	int buildAnagrams(FILE* fin)
	{
		char buffer[40];
		char bufr2[40];
		char* hkey;
		int hix;
		HashEntry he, *hep;
		DictWord we;
		int maxPC = 2;
		int numWords = 0;

		while (fgets(buffer, 40, fin)) {
			for (hkey = buffer; *hkey && (*hkey != '\n'); hkey++);
			*hkey = 0;
			hkey = sortedWord(buffer, bufr2);
			hix = Str_Hash(hkey, HT_SIZE);
			he = hashTable[hix]; hep = &hashTable[hix];
			while (he && strcmp(he->key, hkey)) {
				hep = &he->next;
				he = he->next;
			}
			if (! he) {
				he = (HashEntry)malloc(sizeof(struct sHashEntry));
				he->next = NULL;
				he->key = strdup(hkey);
				he->wordCount = 0;
				he->words = NULL;
				he->link = NULL;
				*hep = he;
			}
			we = (DictWord)malloc(sizeof(struct sDictWord));
			we->word = strdup(buffer);
			we->next = he->words;
			he->words = we;
			he->wordCount++;
			if (maxPC < he->wordCount) {
				maxPC = he->wordCount;
				mostPerms = he;
				he->link = NULL;
			}
			else if (maxPC == he->wordCount) {
				he->link = mostPerms;
				mostPerms = he;
			}
			numWords++;
		}
		printf("%d words in dictionary max ana=%d\n", numWords, maxPC);
		return maxPC;
	}

	void main()
	{
		HashEntry he;
		DictWord we;
		FILE* f1;

		f1 = fopen("unixdict.txt", "r");
		buildAnagrams(f1);
		fclose(f1);

		f1 = fopen("anaout.txt", "w");

		for (he = mostPerms; he; he = he->link) {
			fprintf(f1, "%d: ", he->wordCount);
			for (we = he->words; we; we = we->next) {
				fprintf(f1, "%s, ", we->word);
			}
			fprintf(f1, "\n");
		}
		fclose(f1);
	}
END DYNC


// define the List "workflow" (monad)
type ListBuilder() =
   member o.Bind( lst, f ) = List.concat( List.map (fun x -> f x) lst )
   member o.Return( x ) = [x]
   member o.Zero() = []

let list = ListBuilder()

let amb = id

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

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

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

printfn "%s" (List.head example)


 "resource:unixdict.txt" utf8 file-lines
 [ [ natural-sort >string ] keep ] { } map>assoc sort-keys
 [ [ first ] compare +eq+ = ] monotonic-split
 dup 0 [ length max ] reduce '[ length _ = ] filter [ values ] map .


' FB 1.05.0 Win64

Type IndexedWord
  As String word
  As Integer index
End Type

' selection sort, quick enough for sorting small number of letters
Sub sortWord(s As String)
  Dim As Integer i, j, m, n = Len(s)
  For i = 0 To n - 2
    m = i
    For j = i + 1 To n - 1
      If s[j] < s[m] Then m = j
    Next j
    If m <> i Then Swap s[i], s[m]
  Next i
End Sub

' selection sort, quick enough for sorting small array of IndexedWord instances by index
Sub sortIndexedWord(iw() As IndexedWord)
  Dim As Integer i, j, m, n = UBound(iw)
  For i = 1 To n - 1
    m = i
    For j = i + 1 To n
      If iw(j).index < iw(m).index Then m = j
    Next j
    If m <> i Then Swap iw(i), iw(m)
  Next i
End Sub

' quicksort for sorting whole dictionary of IndexedWord instances by sorted word
Sub quicksort(a() As IndexedWord, first As Integer, last As Integer)
  Dim As Integer length = last - first + 1
  If length < 2 Then Return
  Dim pivot As String = a(first + length\ 2).word
  Dim lft As Integer = first
  Dim rgt As Integer = last
  While lft <= rgt
    While a(lft).word < pivot
      lft +=1
    Wend
    While a(rgt).word > pivot
      rgt -= 1
    Wend
    If lft <= rgt Then
       Swap a(lft), a(rgt)
       lft += 1
       rgt -= 1
    End If
  Wend
  quicksort(a(), first, rgt)
  quicksort(a(), lft, last)
End Sub

Dim t As Double = timer
Dim As String w()  '' array to hold actual words
Open "undict.txt" For Input As #1
Dim count As Integer = 0
While Not Eof(1)
  count +=1
  Redim Preserve w(1 To count)
  Line Input #1, w(count)
Wend
Close #1

Dim As IndexedWord iw(1 To count) '' array to hold sorted words and their index into w()
Dim word As String
For i As Integer = 1 To count
  word = w(i)
  sortWord(word)
  iw(i).word = word
  iw(i).index = i
Next
quickSort iw(), 1, count  '' sort the IndexedWord array by sorted word

Dim As Integer startIndex = 1, length = 1, maxLength = 1, ub = 1
Dim As Integer maxIndex(1 To ub)
maxIndex(ub) = 1
word = iw(1).word

For i As Integer = 2 To count
  If word = iw(i).word Then
    length += 1
  Else
    If length > maxLength Then
      maxLength = length
      Erase maxIndex
      ub = 1
      Redim maxIndex(1 To ub)
      maxIndex(ub) = startIndex
    ElseIf length = maxLength Then
      ub += 1
      Redim Preserve maxIndex(1 To ub)
      maxIndex(ub) = startIndex
    End If
    startIndex = i
    length = 1
    word = iw(i).word
  End If
Next

If length > maxLength Then
  maxLength = length
  Erase maxIndex
  Redim maxIndex(1 To 1)
  maxIndex(1) = startIndex
ElseIf length = maxLength Then
  ub += 1
  Redim Preserve maxIndex(1 To ub)
  maxIndex(ub) = startIndex
End If

Print Str(count); " words in the dictionary"
Print "The anagram set(s) with the greatest number of words (namely"; maxLength; ") is:"
Print
Dim iws(1 To maxLength) As IndexedWord  '' array to hold each anagram set
For i As Integer = 1 To UBound(maxIndex)
  For j As Integer = maxIndex(i) To maxIndex(i) + maxLength - 1
    iws(j - maxIndex(i) + 1) = iw(j)
  Next j
  sortIndexedWord iws()  '' sort anagram set before displaying it
  For j As Integer = 1 To maxLength
    Print w(iws(j).index); " ";
  Next j
  Print
Next i

Print
Print "Took ";
Print Using "#.###"; timer - t;
Print " seconds on i3 @ 2.13 GHz"

Print
Print "Press any key to quit"
Sleep


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


Function wordsOK(string1 As String, string2 As String) As boolean
    If Mid(string1, Len(string1), 1) = Mid(string2, 1, 1) Then
        Return True
    End If
    Return False
End Function

Function Amb(A() As String, B() As String, C() As String, D() As String) As String
    Dim As Integer a2, b2, c2, d2
    For a2 = 0 To Ubound(A)
        For b2 = 0 To Ubound(B)
            For c2 = 0 To Ubound(C)
                For d2 = 0 To Ubound(D)
                    If wordsOK(A(a2),B(b2)) And wordsOK(B(b2),C(c2)) And wordsOK(C(c2),D(d2)) Then
                        Return A(a2) + " " + B(b2) + " " + C(c2) + " " + D(d2)
                    End If
                Next d2
            Next c2
        Next b2
    Next a2
    Return "" 'Cadena vacía, por ejemplo, falla
End Function

Dim As String set1(2), set2(2), set3(2), set4(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"

Dim As String text = Amb(set1(), set2(), set3(), set4())

If text <> "" Then
    Print !"Correct sentence would be:\n" + text
Else
    Print "Failed to fine a correct sentence."
End If
Sleep


d = new dict
for w = lines["http://wiki.puzzlers.org/pub/wordlists/unixdict.txt"]
{
   sorted = sort[charList[w]]
   d.addToList[sorted, w]
}

most = sort[toArray[d], {|a,b| length[[email protected]] <=> length[[email protected]]}]
longest = length[[email protected]@1]

i = 0
while length[[email protected]@1] == longest
{
   println[[email protected]@1]
   i = i + 1
}


include "ConsoleWindow"

def tab 9

begin globals
dim dynamic gDictionary(_maxLong) as Str255
end globals

local fn IsAnagram( word1 as Str31, word2 as Str31 ) as Boolean
dim as long i, j, h, q
dim as Boolean result

if word1[0] != word2[0] then result = _false : exit fn

for i = 0 to word1[0]
  h = 0 : q = 0
  for j = 0 to word1[0]
    if word1[i] == word1[j] then h++
    if word1[i] == word2[j] then q++
  next
  if h != q then result = _false : exit fn
next
result = _true
end fn = result

local fn LoadDictionaryToArray
'~'1
dim as CFURLRef    url
dim as CFArrayRef  arr
dim as CFStringRef temp, cfStr
dim as CFIndex     elements
dim as Handle      h
dim as Str255      s
dim as long        fileLen, i

kill dynamic gDictionary
url = fn CFURLCreateWithFileSystemPath( _kCFAllocatorDefault, @"/usr/share/dict/words", _kCFURLPOSIXPathStyle, _false )
open "i", 2, url
  fileLen = lof(2, 1)
  h = fn NewHandleClear( fileLen )
    if ( h )
      read file 2, [h], fileLen
      cfStr = fn CFStringCreateWithBytes( _kCFAllocatorDefault, #[h], fn GetHandleSize(h), _kCFStringEncodingMacRoman, _false )
      if ( cfStr )
        arr = fn CFStringCreateArrayBySeparatingStrings( _kCFAllocatorDefault, cfStr, @"\n" )
        CFRelease( cfStr )
        elements = fn CFArrayGetCount( arr )
          for i = 0 to elements - 1
            temp = fn CFArrayGetValueAtIndex( arr, i )
            fn CFStringGetPascalString( temp, @s, 256, _kCFStringEncodingMacRoman )
            gDictionary(i) = s
          next
      CFRelease( arr )
      end if
    fn DisposeH( h )
   end if
close #2
CFRelease( url )
end fn

local fn FindAnagrams( whichWord as Str31 )
dim as long elements, i

print "Anagrams for "; UCase$(whichWord); ":",
elements = fn DynamicNextElement( dynamic( gDictionary ) )
for i = 0 to elements - 1
  if ( len( gDictionary(i) ) == whichWord[0] )
    if ( fn IsAnagram( whichWord, gDictionary(i) ) == _true )
      print gDictionary(i),
    end if
  end if
next
print
end fn

fn LoadDictionaryToArray

fn FindAnagrams( "bade"    )
fn FindAnagrams( "abet"    )
fn FindAnagrams( "beast"   )
fn FindAnagrams( "tuba"    )
fn FindAnagrams( "mace"    )
fn FindAnagrams( "scare"   )
fn FindAnagrams( "marine"  )
fn FindAnagrams( "antler"  )
fn FindAnagrams( "spare"   )
fn FindAnagrams( "leading" )
fn FindAnagrams( "alerted" )
fn FindAnagrams( "allergy" )
fn FindAnagrams( "research")
fn FindAnagrams( "hustle"  )
fn FindAnagrams( "oriental")
def tab 3
print
fn FindAnagrams( "creationism" )
fn FindAnagrams( "resistance"  )
fn FindAnagrams( "mountaineer" )


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


Anagrams := function(name)
  local f, p, L, line, word, words, swords, res, cur, r;
  words := [ ];
  swords := [ ];
  f := InputTextFile(name);
  while true do
    line := ReadLine(f);
    if line = fail then
      break;
    else
      word := Chomp(line);
      Add(words, word);
      Add(swords, SortedList(word));
    fi;
  od;
  CloseStream(f);
  p := SortingPerm(swords);
  L := Permuted(words, p);
  r := "";
  cur := [ ];
  res := [ ];
  for word in L do
    if SortedList(word) = r then
      Add(cur, word);
    else
      if Length(cur) > 0 then
        Add(res, cur);
      fi;
      r := SortedList(word);
      cur := [ word ];
    fi;
  od;
  if Length(cur) > 0 then
    Add(res, cur);
  fi;
  return Filtered(res, v -> Length(v) > 1);
end;

ana := Anagrams("my/gap/unixdict.txt");;

# What is the longest anagram sequence ?
Maximum(List(ana, Length));
# 5

# Which are they ?
Filtered(ana, v -> Length(v) = 5);
# [ [ "abel", "able", "bale", "bela", "elba" ],
#   [ "caret", "carte", "cater", "crate", "trace" ],
#   [ "angel", "angle", "galen", "glean", "lange" ],
#   [ "alger", "glare", "lager", "large", "regal" ],
#   [ "elan", "lane", "lean", "lena", "neal" ],
#   [ "evil", "levi", "live", "veil", "vile" ] ]


package main

import (
    "bytes"
    "fmt"
    "io/ioutil"
    "net/http"
    "sort"
)

func main() {
    r, err := http.Get("http://wiki.puzzlers.org/pub/wordlists/unixdict.txt")
    if err != nil {
        fmt.Println(err)
        return
    }
    b, err := ioutil.ReadAll(r.Body)
    r.Body.Close()
    if err != nil {
        fmt.Println(err)
        return
    }
    var ma int
    var bs byteSlice
    m := make(map[string][][]byte)
    for _, word := range bytes.Fields(b) {
        bs = append(bs[:0], byteSlice(word)...)
        sort.Sort(bs)
        k := string(bs)
        a := append(m[k], word)
        if len(a) > ma {
            ma = len(a)
        }
        m[k] = a
    }
    for _, a := range m {
        if len(a) == ma {
            fmt.Printf("%s\n", a)
        }
    }
}

type byteSlice []byte

func (b byteSlice) Len() int           { return len(b) }
func (b byteSlice) Swap(i, j int)      { b[i], b[j] = b[j], b[i] }
func (b byteSlice) Less(i, j int) bool { return b[i] < b[j] }


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"]
  guard (w1 `joins` w2)
  guard (w2 `joins` w3)
  guard (w3 `joins` w4)
  pure $ unwords [w1, w2, w3, w4]


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


def words = new URL('http://wiki.puzzlers.org/pub/wordlists/unixdict.txt').text.readLines()
def groups = words.groupBy{ it.toList().sort() }
def bigGroupSize = groups.collect{ it.value.size() }.max()
def isBigAnagram = { it.value.size() == bigGroupSize }
println groups.findAll(isBigAnagram).collect{ it.value }.collect{ it.join(' ') }.join('\n')


import Data.List

groupon f x y = f x == f y

main = do
  f <- readFile "./../Puzzels/Rosetta/unixdict.txt"
  let  words = lines f
       wix = groupBy (groupon fst) . sort $ zip (map sort words) words
       mxl = maximum $ map length wix
  mapM_ (print . map snd) . filter ((==mxl).length) $ wix


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


enum Color { R, B };
template<Color, class, auto, class> struct T;
struct E;

template<Color col, class a, auto x, class b> struct balance {
    using type = T<col, a, x, b>;
};
template<class a, auto x, class b, auto y, class c, auto z, class d>
struct balance<B, T<R, T<R, a, x, b>, y, c>, z, d> {
    using type = T<R, T<B, a, x, b>, y, T<B, c, z, d>>;
};
template<class a, auto x, class b, auto y, class c, auto z, class d>
struct balance<B, T<R, a, x, T<R, b, y, c>>, z, d> {
    using type = T<R, T<B, a, x, b>, y, T<B, c, z, d>>;
};
template<class a, auto x, class b, auto y, class c, auto z, class d>
struct balance<B, a, x, T<R, T<R, b, y, c>, z, d>> {
    using type = T<R, T<B, a, x, b>, y, T<B, c, z, d>>;
};
template<class a, auto x, class b, auto y, class c, auto z, class d>
struct balance<B, a, x, T<R, b, y, T<R, c, z, d>>> {
    using type = T<R, T<B, a, x, b>, y, T<B, c, z, d>>;
};

template<auto x, class s> struct insert {
    template<class, class = void> struct ins;
    template<class _> struct ins<E, _> { using type = T<R, E, x, E>; };
    template<Color col, class a, auto y, class b> struct ins<T<col, a, y, b>> {
        template<int, class = void> struct cond;
        template<class _> struct cond<-1, _> : balance<col, typename ins<a>::type, y, b> {};
        template<class _> struct cond<1, _> : balance<col, a, y, typename ins<b>::type> {};
        template<class _> struct cond<0, _> { using type = T<col, a, y, b>; };
        using type = typename cond<x < y ? -1 : y < x ? 1 : 0>::type;
    };
    template<class> struct repaint;
    template<Color col, class a, auto y, class b>
    struct repaint<T<col, a, y, b>> { using type = T<B, a, y, b>; };
    using type = typename repaint<typename ins<s>::type>::type;
};
template<auto x, class s> using insert_t = typename insert<x, s>::type;

template<class> void print();
int main() {
    print<insert_t<1, insert_t<2, insert_t<0, insert_t<4, E>>>>>();
}


procedure main(args)
    every writeSet(!getLongestAnagramSets())
end

procedure getLongestAnagramSets()
    wordSets := table()
    longestWSet := 0
    longSets := set()

    every word := !&input do {
        wChars := csort(word)
        /wordSets[wChars] := set()
        insert(wordSets[wChars], word)

        if 1 < *wordSets[wChars} == longestWSet then
            insert(longSets, wordSets[wChars])
        if 1 < *wordSets[wChars} > longestWSet then {
            longestWSet := *wordSets[wChars}
            longSets := set([wordSets[wChars]])
            }
        }

    return longSets
end

procedure writeSet(words)
    every writes("\t"|!words," ")
    write()
end

procedure csort(w)
    every (s := "") ||:= (find(c := !cset(w),w),c)
    return s
end


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"


using System;

class Tree
{
    public static void Main() {
        Tree tree = Tree.E;
        for (int i = 1; i <= 16; i++) {
            tree = tree.Insert(i);
        }
        tree.Print();
    }

    private const bool B = false, R = true;
    public static readonly Tree E = new Tree(B, null, 0, null);

    private Tree(bool c, Tree? l, int v, Tree? r) => (IsRed, Left, Value, Right) = (c, l ?? this, v, r ?? this);

    public bool IsRed { get; private set; }
    public int Value { get; }
    public Tree Left { get; }
    public Tree Right { get; }

    public static implicit operator Tree((bool c, Tree l, int v, Tree r) t) => new Tree(t.c, t.l, t.v, t.r);
    public void Deconstruct(out bool c, out Tree l, out int v, out Tree r) => (c, l, v, r) = (IsRed, Left, Value, Right);
    public override string ToString() => this == E ? "[]" : $"[{(IsRed ? 'R' : 'B')}{Value}]";
    public Tree Insert(int x) => Ins(x).MakeBlack();
    private Tree MakeBlack() { IsRed = false; return this; }

    public void Print(int indent = 0) {
        if (this != E) Right.Print(indent + 1);
        Console.WriteLine(new string(' ', indent * 4) + ToString());
        if (this != E) Left.Print(indent + 1);
    }

    private Tree Ins(int x) => Math.Sign(x.CompareTo(Value)) switch {
         _ when this == E => (R, E, x, E),
        -1 => new Tree(IsRed, Left.Ins(x) , Value, Right).Balance(),
         1 => new Tree(IsRed, Left , Value, Right.Ins(x)).Balance(),
         _ => this
    };

    private Tree Balance() => this switch {
        (B, (R, (R, var a, var x, var b), var y, var c), var z, var d) => (R, (B, a, x, b), y, (B, c, z, d)),
        (B, (R, var a, var x, (R, var b, var y, var c)), var z, var d) => (R, (B, a, x, b), y, (B, c, z, d)),
        (B, var a, var x, (R, (R, var b, var y, var c), var z, var d)) => (R, (B, a, x, b), y, (B, c, z, d)),
        (B, var a, var x, (R, var b, var y, (R, var c, var z, var d))) => (R, (B, a, x, b), y, (B, c, z, d)),
        _ => this
    };
}


import java.net.*;
import java.io.*;
import java.util.*;

public class WordsOfEqChars {
    public static void main(String[] args) throws IOException {
        URL url = new URL("http://wiki.puzzlers.org/pub/wordlists/unixdict.txt");
        InputStreamReader isr = new InputStreamReader(url.openStream());
        BufferedReader reader = new BufferedReader(isr);

        Map<String, Collection<String>> anagrams = new HashMap<String, Collection<String>>();
        String word;
        int count = 0;
        while ((word = reader.readLine()) != null) {
            char[] chars = word.toCharArray();
            Arrays.sort(chars);
            String key = new String(chars);
            if (!anagrams.containsKey(key))
                anagrams.put(key, new ArrayList<String>());
            anagrams.get(key).add(word);
            count = Math.max(count, anagrams.get(key).size());
        }

        reader.close();

        for (Collection<String> ana : anagrams.values())
            if (ana.size() >= count)
                System.out.println(ana);
    }
}


def amb: .[];

def joins:
  (.[0][-1:]) as $left
  | (.[1][0:1]) as $right
  | if $left == $right then true else empty end;


# This is a general purpose AMB function that takes a two-argument failure function and
# arbitrary number of iterable objects and returns the first solution found as an array
# this function is in essence an iterative backtracking solver

function amb(failure, itrs...)
    n = length(itrs)
    if n == 1 return end
    states = Vector(n)
    values = Vector(n)
    # starting point, we put down the first value from the first iterable object
    states[1] = start(itrs[1])
    values[1], states[1] = next(itrs[1], states[1])
    i = 1
    # main solver loop
    while true
        # test for failure
        if i > 1 && failure(values[i-1], values[i])
            # loop for generating a new value upon failure
            # in fact this would be way more readable using goto, but Julia doesn't seem to have that :(
            while true
                # if we failed, we must generate a new value, but first we must check whether there is any
                if done(itrs[i], states[i])
                    # backtracking step with sanity check in case we ran out of values from the current generator
                    if i == 1
                        return
                    else
                        i -= 1
                        continue
                    end
                else
                    # if there is indeed a new value, generate it
                    values[i], states[i] = next(itrs[i], states[i])
                    break
                end
            end
        else
            # no failure branch
            # if solution is ready (i.e. all generators are used) just return it
            if i == n return values end
            # else start up the next generator
            i += 1
            states[i] = start(itrs[i])
            values[i], states[i] = next(itrs[i], states[i])
        end
    end
end

# Call our generic AMB function according to the task description and
# form the solution sentence from the returned array of words
amb((s1,s2) -> s1[end] != s2[1], # failure function
    ["the", "that", "a"],
    ["frog", "elephant", "thing"],
    ["walked", "treaded", "grows"],
    ["slowly", "quickly"]) |>
    x -> join(x, " ") |>
    println


(mapc #'use-package '(#:toadstool #:toadstool-system))
(defstruct (red-black-tree (:constructor tree (color left val right)))
  color left val right)

(defcomponent tree (operator macro-mixin))
(defexpand tree (color left val right)
  `(class red-black-tree red-black-tree-color ,color
                         red-black-tree-left ,left
                         red-black-tree-val ,val
                         red-black-tree-right ,right))
(pushnew 'tree *used-components*)

(defun balance (color left val right)
  (toad-ecase (color left val right)
    (('black (tree 'red (tree 'red a x b) y c) z d)
     (tree 'red (tree 'black a x b) y
           (tree 'black c z d)))
    (('black (tree 'red a x (tree 'red b y c)) z d)
     (tree 'red (tree 'black a x b) y (tree 'black c z d)))
    (('black a x (tree 'red (tree 'red b y c) z d))
     (tree 'red (tree 'black a x b) y (tree 'black c z d)))
    (('black a x (tree 'red b y (tree 'red c z d)))
     (tree 'red (tree 'black a x b) y (tree 'black c z d)))
    ((color a x b)
     (tree color a x b))))

(defun %insert (x s)
  (toad-ecase1 s
    (nil (tree 'red nil x nil))
    ((tree color a y b)
     (cond ((< x y)
            (balance color (%insert x a) y b))
           ((> x y)
            (balance color a y (%insert x b)))
           (t s)))))

(defun insert (x s)
  (toad-ecase1 (%insert x s)
    ((tree t a y b) (tree 'black a y b))))


var fs = require('fs');
var words = fs.readFileSync('unixdict.txt', 'UTF-8').split('\n');

var i, item, max = 0,
    anagrams = {};

for (i = 0; i < words.length; i += 1) {
  var key = words[i].split('').sort().join('');
  if (!anagrams.hasOwnProperty(key)) {//check if property exists on current obj only
      anagrams[key] = [];
  }
  var count = anagrams[key].push(words[i]); //push returns new array length
  max = Math.max(count, max);
}

//note, this returns all arrays that match the maximum length
for (item in anagrams) {
  if (anagrams.hasOwnProperty(item)) {//check if property exists on current obj only
    if (anagrams[item].length === max) {
        console.log(anagrams[item].join(' '));
    }
  }
}


// version 1.2.41
import kotlin.coroutines.experimental.*
import kotlin.coroutines.experimental.intrinsics.*

fun main(args: Array<String>) = amb {
    val a = amb("the", "that", "a")
    val b = amb("frog", "elephant", "thing")
    val c = amb("walked", "treaded", "grows")
    val d = amb("slowly", "quickly")

    if (a[a.lastIndex] != b[0]) amb()
    if (b[b.lastIndex] != c[0]) amb()
    if (c[c.lastIndex] != d[0]) amb()

    println(listOf(a, b, c, d))

    val x = amb(1, 2, 3)
    val y = amb(7, 6, 4, 5)
    if (x * y != 8) amb()
    println(listOf(x, y))
}

class AmbException(): Exception("Refusing to execute")
data class AmbPair<T>(val cont: Continuation<T>, val valuesLeft: MutableList<T>)

@RestrictsSuspension
class AmbEnvironment {
    val ambList = mutableListOf<AmbPair<*>>()

    suspend fun <T> amb(value: T, vararg rest: T): T = suspendCoroutineOrReturn { cont ->
        if (rest.size > 0) {
            ambList.add(AmbPair(clone(cont), mutableListOf(*rest)))
        }

        value
    }

    suspend fun amb(): Nothing = suspendCoroutine<Nothing> { }
}

@Suppress("UNCHECKED_CAST")
fun <R> amb(block: suspend AmbEnvironment.() -> R): R {
    var result: R? = null
    var toThrow: Throwable? = null

    val dist = AmbEnvironment()
    block.startCoroutine(receiver = dist, completion = object : Continuation<R> {
        override val context: CoroutineContext get() = EmptyCoroutineContext
        override fun resume(value: R) { result = value }
        override fun resumeWithException(exception: Throwable) { toThrow = exception }
    })

    while (result == null && toThrow == null && !dist.ambList.isEmpty()) {
        val last = dist.ambList.run { this[lastIndex] }

        if (last.valuesLeft.size == 1) {
            dist.ambList.removeAt(dist.ambList.lastIndex)
            last.apply {
                (cont as Continuation<Any?>).resume(valuesLeft[0])
            }
        } else {
            val value = last.valuesLeft.removeAt(last.valuesLeft.lastIndex)
            (clone(last.cont) as Continuation<Any?>).resume(value)
        }
    }

    if (toThrow != null)
    {
        throw toThrow!!
    }
    else if (result != null)
    {
        return result!!
    }
    else
    {
        throw AmbException()
    }
}

val UNSAFE = Class.forName("sun.misc.Unsafe")
    .getDeclaredField("theUnsafe")
    .apply { isAccessible = true }
    .get(null) as sun.misc.Unsafe

@Suppress("UNCHECKED_CAST")
fun <T: Any> clone(obj: T): T {
    val clazz = obj::class.java
    val copy = UNSAFE.allocateInstance(clazz) as T
    copyDeclaredFields(obj, copy, clazz)
    return copy
}

tailrec fun <T> copyDeclaredFields(obj: T, copy: T, clazz: Class<out T>) {
    for (field in clazz.declaredFields) {
        field.isAccessible = true
        val v = field.get(obj)
        field.set(copy, if (v === obj) copy else v)
    }
    val superclass = clazz.superclass
    if (superclass != null) copyDeclaredFields(obj, copy, superclass)
}


def balance(tree) {
  return if (
    tree =~ term`tree(black, tree(red, tree(red, @a, @x, @b), @y, @c), @z, @d)` ||
    tree =~ term`tree(black, tree(red, @a, @x, tree(red, @b, @y, @c)), @z, @d)` ||
    tree =~ term`tree(black, @a, @x, tree(red, tree(red, @b, @y, @c), @z, @d))` ||
    tree =~ term`tree(black, @a, @x, tree(red, @b, @y, tree(red, @c, @z, @d)))`
  ) {
    term`tree(red, tree(black, $a, $x, $b), $y, tree(black, $c, $z, $d))`
  } else { tree }
}
def insert(elem, tree) {
  def ins(tree) {
    return switch (tree) {
      match term`empty` { term`tree(red, empty, $elem, empty)` }
      match term`tree(@color, @a, @y, @b)` {
        if (elem < y) {
          balance(term`tree($color, ${ins(a)}, $y, $b)`)
        } else if (elem > y) {
          balance(term`tree($color, $a, $y, ${ins(b)})`)
        } else {
          tree
        }
      }
    }
  }
  def term`tree(@_, @a, @y, @b)` := ins(tree)
  return term`tree(black, $a, $y, $b)`
}


def anagrams:
  (reduce .[] as $word (
      {table: {}, max: 0};   # state
      ($word | explode | sort | implode) as $hash
      | .table[$hash] += [ $word ]
      | .max   = ([ .max, ( .table[$hash] | length) ] | max ) ))
  | .max as $max
  | .table | .[] | select(length == $max) ;

# The task:
split("\n") | anagrams


/* Anagrams, in Jsish */
var datafile = 'unixdict.txt';
if (console.args[0] == '-more' && Interp.conf('maxArrayList') > 500000)
    datafile = '/usr/share/dict/words';

var words = File.read(datafile).split('\n');
puts(words.length, 'words');

var i, item, max = 0, anagrams = {};

for (i = 0; i < words.length; i += 1) {
    var key = words[i].split('').sort().join('');
    if (!anagrams.hasOwnProperty(key)) {
        anagrams[key] = [];
    }
    var count = anagrams[key].push(words[i]);
    max = Math.max(count, max);
}

// display all arrays that match the maximum length
for (item in anagrams) {
    if (anagrams.hasOwnProperty(item)) {
        if (anagrams[item].length === max) {
            puts(anagrams[item].join(' '));
        }
    }
}

/*
=!EXPECTSTART!=
25108 words
abel able bale bela elba
caret carte cater crate trace
angel angle galen glean lange
alger glare lager large regal
elan lane lean lena neal
evil levi live veil vile
=!EXPECTEND!=
*/


val .wordsets = [
    w/the that a/,
    w/frog elephant thing/,
    w/walked treaded grows/,
    w/slowly quickly/,
]

val .alljoin = f(.words) for[=true] .i of len(.words)-1 {
    if last(.words[.i]) != first(.words[.i+1]): break = false
}

# .amb expects 2 or more arguments
val .amb = f(...[2 to -1] .words) if(.alljoin(.words): join " ", .words)

writeln join "\n", where(mapX(.amb, .wordsets...))


;; This is the exception that will be thrown if an amb expression is
;; unsatisfiable.
AmbError ::= Exception clone tap {

  self message := "Amb expression failed".

  AmbError := self.

}.

;; The Amb object itself is primarily for internal use. It stores the
;; "next" backtracking point if an amb expression outright fails or
;; exhausts its possibilities at some point.
Amb ::= Object clone tap {

  ;; The default "next" point is to throw an exception. This will be
  ;; overridden in many cases, if there is an actual next handler to
  ;; jump to.
  self nextHandler := { AmbError clone throw. }.

  Amb := self.

}.

callAmb := {
  ;; We need an object which will be accessible from inside the
  ;; continuations that will store the next backtracking point which
  ;; will be called.
  backtracker := Amb clone.
  ;; We define the dynamically-scoped method $amb which will try each
  ;; possibility that it is given. If all of those possibilities fail,
  ;; it will call the next handler.
  $amb := {
    takes '[cases].
    ;; This is the return point. We're going to try each element of
    ;; the cases variable (probably an array, but it could feasibly be
    ;; any collection type). For each element, we'll jump to this
    ;; point (which will wind up being the end of the $amb method). If
    ;; it ends up failing, the backtrack point will get called and
    ;; we'll try the next one.
    callCC {
      escapable.
      ;; Get the current backtrack point from the toplevel object and
      ;; store it within this continuation. The backtrack object's
      ;; current backtrack point will change as we make new attempts,
      ;; but this prevHandler variable is stored locally in this scope
      ;; and will not change, so we can always use it later.
      prevHandler := #'(backtracker nextHandler).
      ;; We iterate over the collection to try each element.
      cases visit {
        takes '[curr].
        callCC {
          ;; This inner continuation will be our new backtrack point.
          ;; We store the continuation object itself in the backtrack
          ;; object so that future $amb calls know to return to this
          ;; point if something goes wrong.
          nextExit := #'$1.
          backtracker nextHandler := { nextExit call (Nil). }.
          ;; Now we actually try the value by jumping to the end of
          ;; the $amb method and returning control to the caller.
          return (curr).
        }.
      }.
      ;; If we exhaust each possibility, then that means every value
      ;; in the cases variable has been tried and has failed. So we
      ;; set the backtrack point back to what it was before we tried
      ;; all of these values, and then we jump back to that previous
      ;; backtrack point.
      backtracker nextHandler := #'(prevHandler).
      prevHandler.
      ;; prevHandler will always either perform a continuation jump
      ;; (if there is a new backtrack point to try) or throw an
      ;; exception (if we've exhausted all possibilities), so this
      ;; continuation block will never exit normally.
    }.
  }.
  ;; An instant failure at a point in an amb expression is equivalent
  ;; to an $amb call on an empty collection.
  $fail := { $amb (Nil). }.
  ;; Now that the dynamic variables are in place, let's call the
  ;; block.
  #'($1) call.
}.


;; code adapted from Racket and Common Lisp
;; Illustrates matching on structures
(require 'match)
(require 'struct)

(define (N-tostring n) (format "%s %d"  (N-color n) (N-value n)))
(struct N (color left value right) #:tostring N-tostring)

(define (balance t)
  (match t
    [(N '⚫ (N '🔴 (N '🔴 a x b) y c) z d) (N '🔴 (N '⚫ a x b) y (N '⚫ c z d))]
    [(N '⚫ (N '🔴 a x (N '🔴 b y c)) z d) (N '🔴 (N '⚫ a x b) y (N '⚫ c z d))]
    [(N '⚫ a x (N '🔴 (N '🔴 b y c) z d)) (N '🔴 (N '⚫ a x b) y (N '⚫ c z d))]
    [(N '⚫ a x (N '🔴 b y (N '🔴 c z d))) (N '🔴 (N '⚫ a x b) y (N '⚫ c z d))]
    [else t]))

    (define (ins value: x  tree: t)
    (match t
      ['empty (N '🔴 'empty x 'empty)]
      [(N c l v r) (cond [(< x v) (balance (N c (ins x l) v r))]
                         [(> x v) (balance (N c l v (ins x r)))]
                         [else t])]))

	(define (insert value: x tree: s)
  		(match (ins x s) [(N _ l v r) (N '⚫ l v r)]))


url = "http://wiki.puzzlers.org/pub/wordlists/unixdict.txt"
wordlist = open(readlines, download(url))

wsort(word::AbstractString) = join(sort(collect(word)))

function anagram(wordlist::Vector{<:AbstractString})
    dict = Dict{String, Set{String}}()
    for word in wordlist
        sorted = wsort(word)
        push!(get!(dict, sorted, Set{String}()), word)
    end
    wcnt = maximum(length, values(dict))
    return collect(Iterators.filter((y) -> length(y) == wcnt, values(dict)))
end

println.(anagram(wordlist))


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


defmodule RBtree do
  def find(nil, _), do: :not_found
  def find({ key, value, _, _, _ }, key), do: { :found, { key, value } }
  def find({ key1, _, _, left, _ }, key) when key < key1, do: find(left, key)
  def find({ key1, _, _, _, right }, key) when key > key1, do: find(right, key)

  def new(key, value), do: ins(nil, key, value) |> make_black

  def insert(tree, key, value), do: ins(tree, key, value) |> make_black

  defp ins(nil, key, value),
    do: { key, value, :r, nil, nil }
  defp ins({ key, _, color, left, right }, key, value),
    do: { key, value, color, left, right }
  defp ins({ ky, vy, cy, ly, ry }, key, value) when key < ky,
    do: balance({ ky, vy, cy, ins(ly, key, value), ry })
  defp ins({ ky, vy, cy, ly, ry }, key, value) when key > ky,
    do: balance({ ky, vy, cy, ly, ins(ry, key, value) })

  defp make_black({ key, value, _, left, right }),
    do: { key, value, :b, left, right }

  defp balance({ kx, vx, :b, lx, { ky, vy, :r, ly, { kz, vz, :r, lz, rz } } }),
    do: { ky, vy, :r, { kx, vx, :b, lx, ly }, { kz, vz, :b, lz, rz } }
  defp balance({ kx, vx, :b, lx, { ky, vy, :r, { kz, vz, :r, lz, rz }, ry } }),
    do: { kz, vz, :r, { kx, vx, :b, lx, lz }, { ky, vy, :b, rz, ry } }
  defp balance({ kx, vx, :b, { ky, vy, :r, { kz, vz, :r, lz, rz }, ry }, rx }),
    do: { ky, vy, :r, { kz, vz, :b, lz, rz }, { kx, vx, :b, ry, rx } }
  defp balance({ kx, vx, :b, { ky, vy, :r, ly, { kz, vz, :r, lz, rz } }, rx }),
    do: { kz, vz, :r, { ky, vy, :b, ly, lz }, { kx, vx, :b, rz, rx } }
  defp balance(t),
    do: t
end

RBtree.new(0,3)        |> IO.inspect
|> RBtree.insert(1,5)  |> IO.inspect
|> RBtree.insert(2,-1) |> IO.inspect
|> RBtree.insert(3,7)  |> IO.inspect
|> RBtree.insert(4,-3) |> IO.inspect
|> RBtree.insert(5,0)  |> IO.inspect
|> RBtree.insert(6,-1) |> IO.inspect
|> RBtree.insert(7,0)  |> IO.inspect
|> RBtree.find(4)      |> IO.inspect


(defun rbt-balance (tree)
  (pcase tree
    (`(B (R (R ,a ,x ,b) ,y ,c) ,z ,d) `(R (B ,a ,x ,b) ,y (B ,c ,z ,d)))
    (`(B (R ,a ,x (R ,b ,y ,c)) ,z ,d) `(R (B ,a ,x ,b) ,y (B ,c ,z ,d)))
    (`(B ,a ,x (R (R ,b ,y ,c) ,z ,d)) `(R (B ,a ,x ,b) ,y (B ,c ,z ,d)))
    (`(B ,a ,x (R ,b ,y (R ,c ,z ,d))) `(R (B ,a ,x ,b) ,y (B ,c ,z ,d)))
    (_                                 tree)))

(defun rbt-insert- (x s)
  (pcase s
    (`nil              `(R nil ,x nil))
    (`(,color ,a ,y ,b) (cond ((< x y)
                               (rbt-balance `(,color ,(rbt-insert- x a) ,y ,b)))
                              ((> x y)
                               (rbt-balance `(,color ,a ,y ,(rbt-insert- x b))))
                              (t
                               s)))
    (_                  (error "Expected tree: %S" s))))

(defun rbt-insert (x s)
  (pcase (rbt-insert- x s)
    (`(,_ ,a ,y ,b) `(B ,a ,y ,b))
    (_              (error "Internal error: %S" s))))

(let ((s nil))
  (dotimes (i 16)
    (setq s (rbt-insert (1+ i) s)))
  (pp s))


import java.io.BufferedReader
import java.io.InputStreamReader
import java.net.URL
import kotlin.math.max

fun main() {
    val url = URL("http://wiki.puzzlers.org/pub/wordlists/unixdict.txt")
    val isr = InputStreamReader(url.openStream())
    val reader = BufferedReader(isr)
    val anagrams = mutableMapOf<String, MutableList<String>>()
    var count = 0
    var word = reader.readLine()
    while (word != null) {
        val chars = word.toCharArray()
        chars.sort()
        val key = chars.joinToString("")
        if (!anagrams.containsKey(key)) anagrams[key] = mutableListOf()
        anagrams[key]?.add(word)
        count = max(count, anagrams[key]?.size ?: 0)
        word = reader.readLine()
    }
    reader.close()
    anagrams.values
        .filter { it.size == count }
        .forEach { println(it) }
}