June 2018 Update

Task/Best-shuffle/Common-Lisp/best-shuffle-3.lisp

@@ -0,0 +1,6 @@
+abracadabra: (caardrabaab 0)
+seesaw: (ewsase 0)
+elk: (kel 0)
+grrrrrr: (rrrgrrr 5)
+up: (pu 0)
+a: (a 1)

Task/Best-shuffle/Elena/best-shuffle.elena

@@ -1,5 +1,6 @@
 import system'routines.
 import extensions.
+import extensions'text.
 
 extension op
 {
@@ -8,18 +9,18 @@ extension op
         var anOriginal := self toArray.
         var aShuffled := self toArray.
 
-        0 to(anOriginal length - 1) do(:i)
+        0 to:(anOriginal length - 1) do(:i)
         [
-            0 to(anOriginal length - 1) do(:j)
+            0 to:(anOriginal length - 1) do(:j)
             [
-                if ((i != j) && $(anOriginal[i] != aShuffled[j]) && $(anOriginal[j] != aShuffled[i]))
+                if ((i != j) && (anOriginal[i] != aShuffled[j]) && $(anOriginal[j] != aShuffled[i]))
                 [
                     aShuffled exchange(i,j)
                 ].
             ].
         ].
 
-        ^ aShuffled summarize(String new); literal
+        ^ aShuffled summarize(StringWriter new); toLiteral
     ]
 
     score : anOriginalText
@@ -35,7 +36,7 @@ extension op
     ]
 }
 
-program =
+public program =
 [
     ("abracadabra", "seesaw", "grrrrrr", "pop", "up", "a") forEach(:aWord)
     [

Task/Best-shuffle/REXX/best-shuffle.rexx

@@ -0,0 +1,30 @@
+/*REXX program determines and displays the best shuffle for any list of words/characters*/
+parse arg $                                      /*get some words from the command line.*/
+if $=''  then $= 'tree abracadabra seesaw elk grrrrrr up a'          /*use the defaults?*/
+w=0;                #=words($)                   /* [↑]  finds the widest word in $ list*/
+        do i=1  for #;  @.i=word($,i);  w=max(w, length(@.i)  );     end  /*i*/
+w=w+9                                            /*add 9 blanks for output indentation. */
+        do n=1  for #;  new=bestShuffle(@.n)     /*process the examples in the @ array. */
+        same=0;                    do m=1  for length(@.n)
+                                   same=same  +  (substr(@.n, m, 1) == substr(new, m, 1) )
+                                   end   /*m*/
+        say 'original:'  left(@.n, w)   'new:'   left(new,w)    'count:'   same
+        end   /*n*/
+exit                                             /*stick a fork in it,  we're all done. */
+/*──────────────────────────────────────────────────────────────────────────────────────*/
+bestShuffle: procedure; parse arg x 1 ox;    L=length(x);   if L<3  then return reverse(x)
+                                                             /*[↑] fast track short strs*/
+                do j=1  for L-1;  parse var x =(j) a +1 b +1 /*get A,B at Jth & J+1 pos.*/
+                if a\==b  then iterate                       /*ignore any replicates.   */
+                c=verify(x,a);    if c==0  then iterate      /*   "    "      "         */
+                x=overlay( substr(x,c,1), overlay(a,x,c), j) /*swap the  x,c  characters*/
+                rx=reverse(x)                                /*obtain the reverse of X. */
+                y=substr(rx, verify(rx,a), 1)                /*get 2nd replicated char. */
+                x=overlay(y, overlay(a,x, lastpos(y,x)),j+1) /*fast swap of 2 characters*/
+                end   /*j*/
+                             do k=1  for L;  a=substr(x,k,1) /*handle a possible rep.   */
+                             if a\==substr(ox,k,1)  then iterate /*skip non-replications*/
+                             if k==L  then x=left(x,k-2)a || substr(x,k-1,1) /*last case*/
+                                      else x=left(x,k-1)substr(x,k+1,1)a || substr(x, k+2)
+                             end   /*k*/
+             return x

Task/Best-shuffle/Ring/best-shuffle-1.ring

@@ -0,0 +1,36 @@
+# Project : Best shuffle
+# Date    : 2018/02/15
+# Author : Gal Zsolt (~ CalmoSoft ~)
+# Email   : <calmosoft@gmail.com>
+
+test = ["abracadabra", "seesaw", "elk", "grrrrrr", "up", "a"]
+
+for n = 1 to len(test)
+     bs   = bestshuffle(test[n])
+     count = 0
+     for p = 1 to len(test[n])
+          if substr(test[n],p,1) = substr(bs,p,1)
+             count = count + 1
+          ok
+      next
+      see test[n] + " -> " + bs + " " + count + nl
+next
+
+func bestshuffle(s1)
+       s2 = s1
+       for i = 1 to len(s2)
+            for j =  1 to len(s2)
+                 if (i != j) and (s2[i] != s1[j]) and (s2[j] != s1[i])
+                    if j < i
+                       i1 = j
+                       j1 = i
+                    else
+                       i1 = i
+                       j1 = j
+                    ok
+                    s2 = left(s2,i1-1) + substr(s2,j1,1) + substr(s2,i1+1,(j1-i1)-1) + substr(s2,i1,1) + substr(s2,j1+1)
+                 ok
+            next
+       next
+       bestshuffle = s2
+       return bestshuffle

Task/Best-shuffle/Ring/best-shuffle-2.ring

@@ -0,0 +1,36 @@
+def best_shuffle(s)
+  # Fill _pos_ with positions in the order
+  # that we want to fill them.
+  pos = []
+  # g["a"] = [2, 4] implies that s[2] == s[4] == "a"
+  g = s.length.times.group_by { |i| s[i] }
+
+  # k sorts letters from low to high count
+  k = g.sort_by { |k, v| v.length }.map { |k, v| k }
+
+  until g.empty?
+    k.each do |letter|
+      g[letter] or next
+      pos.push(g[letter].pop)
+      g[letter].empty? and g.delete letter
+    end
+  end
+
+  # Now fill in _new_ with _letters_ according to each position
+  # in _pos_, but skip ahead in _letters_ if we can avoid
+  # matching characters that way.
+  letters = s.dup
+  new = "?" * s.length
+  until letters.empty?
+    i, p = 0, pos.pop
+    i += 1 while letters[i] == s[p] and i < (letters.length - 1)
+    new[p] = letters.slice! i
+  end
+
+  score = new.chars.zip(s.chars).count { |c, d| c == d }
+  [new, score]
+end
+
+%w(abracadabra seesaw elk grrrrrr up a).each do |word|
+  puts "%s, %s, (%d)" % [word, *best_shuffle(word)]
+end

Task/Best-shuffle/Ring/best-shuffle-3.ring

@@ -0,0 +1,25 @@
+list$ = "abracadabra seesaw pop grrrrrr up a"
+
+while word$(list$,ii + 1," ") <> ""
+ ii    = ii + 1
+ w$    = word$(list$,ii," ")
+ bs$   = bestShuffle$(w$)
+ count = 0
+ for i = 1 to len(w$)
+  if mid$(w$,i,1) = mid$(bs$,i,1) then count = count + 1
+ next i
+ print  w$;" ";bs$;" ";count
+wend
+
+function bestShuffle$(s1$)
+   s2$   = s1$
+   for i = 1 to len(s2$)
+        for j =  1 to len(s2$)
+            if (i <> j) and (mid$(s2$,i,1) <> mid$(s1$,j,1)) and (mid$(s2$,j,1) <> mid$(s1$,i,1)) then
+            if j < i then i1 = j:j1 = i else i1 = i:j1 = j
+            s2$ = left$(s2$,i1-1) + mid$(s2$,j1,1) + mid$(s2$,i1+1,(j1-i1)-1) + mid$(s2$,i1,1) + mid$(s2$,j1+1)
+            end if
+        next j
+   next i
+bestShuffle$ = s2$
+end function

Task/Best-shuffle/Ring/best-shuffle-4.ring

@@ -0,0 +1,135 @@
+extern crate permutohedron;
+extern crate rand;
+
+use std::cmp::{min, Ordering};
+use std::env;
+use rand::{thread_rng, Rng};
+use std::str;
+
+const WORDS: &'static [&'static str] = &["abracadabra", "seesaw", "elk", "grrrrrr", "up", "a"];
+
+#[derive(Eq)]
+struct Solution {
+    original: String,
+    shuffled: String,
+    score: usize,
+}
+
+// Ordering trait implementations are only needed for the permutations method
+impl PartialOrd for Solution {
+    fn partial_cmp(&self, other: &Solution) -> Option<Ordering> {
+        match (self.score, other.score) {
+            (s, o) if s < o => Some(Ordering::Less),
+            (s, o) if s > o => Some(Ordering::Greater),
+            (s, o) if s == o => Some(Ordering::Equal),
+            _ => None,
+        }
+    }
+}
+
+
+impl PartialEq for Solution {
+    fn eq(&self, other: &Solution) -> bool {
+        match (self.score, other.score) {
+            (s, o) if s == o => true,
+            _ => false,
+        }
+    }
+}
+
+impl Ord for Solution {
+    fn cmp(&self, other: &Solution) -> Ordering {
+        match (self.score, other.score) {
+            (s, o) if s < o => Ordering::Less,
+            (s, o) if s > o => Ordering::Greater,
+            _ => Ordering::Equal,
+        }
+    }
+}
+
+fn _help() {
+    println!("Usage: best_shuffle <word1> <word2> ...");
+}
+
+fn main() {
+    let args: Vec<String> = env::args().collect();
+    let mut words: Vec<String> = vec![];
+
+    match args.len() {
+        1 => {
+            for w in WORDS.iter() {
+                words.push(String::from(*w));
+            }
+        }
+        _ => {
+            for w in args.split_at(1).1 {
+                words.push(w.clone());
+            }
+        }
+    }
+
+    let solutions = words.iter().map(|w| best_shuffle(w)).collect::<Vec<_>>();
+
+    for s in solutions {
+        println!("{}, {}, ({})", s.original, s.shuffled, s.score);
+    }
+}
+
+// Implementation iterating over all permutations
+fn _best_shuffle_perm(w: &String) -> Solution {
+    let mut soln = Solution {
+        original: w.clone(),
+        shuffled: w.clone(),
+        score: w.len(),
+    };
+    let w_bytes: Vec<u8> = w.clone().into_bytes();
+    let mut permutocopy = w_bytes.clone();
+    let mut permutations = permutohedron::Heap::new(&mut permutocopy);
+    while let Some(p) = permutations.next_permutation() {
+        let hamm = hamming(&w_bytes, p);
+        soln = min(soln,
+                   Solution {
+                       original: w.clone(),
+                       shuffled: String::from(str::from_utf8(p).unwrap()),
+                       score: hamm,
+                   });
+        // Accept the solution if score 0 found
+        if hamm == 0 {
+            break;
+        }
+    }
+    soln
+}
+
+// Quadratic implementation
+fn best_shuffle(w: &String) -> Solution {
+    let w_bytes: Vec<u8> = w.clone().into_bytes();
+    let mut shuffled_bytes: Vec<u8> = w.clone().into_bytes();
+
+    // Shuffle once
+    let sh: &mut [u8] = shuffled_bytes.as_mut_slice();
+    thread_rng().shuffle(sh);
+
+    // Swap wherever it doesn't decrease the score
+    for i in 0..sh.len() {
+        for j in 0..sh.len() {
+            if (i == j) | (sh[i] == w_bytes[j]) | (sh[j] == w_bytes[i]) | (sh[i] == sh[j]) {
+                continue;
+            }
+            sh.swap(i, j);
+            break;
+        }
+    }
+
+    let res = String::from(str::from_utf8(sh).unwrap());
+    let res_bytes: Vec<u8> = res.clone().into_bytes();
+    Solution {
+        original: w.clone(),
+        shuffled: res,
+        score: hamming(&w_bytes, &res_bytes),
+    }
+}
+
+fn hamming(w0: &Vec<u8>, w1: &Vec<u8>) -> usize {
+    w0.iter().zip(w1.iter()).filter(|z| z.0 == z.1).count()
+}

Task/Best-shuffle/VBA/best-shuffle.vba

@@ -0,0 +1,94 @@
+Option Explicit
+
+Sub Main_Best_shuffle()
+Dim S() As Long, W, b As Byte, Anagram$, Count&, myB As Boolean, Limit As Byte, i As Integer
+
+    W = Array("a", "abracadabra", "seesaw", "elk", "grrrrrr", "up", "qwerty", "tttt")
+    For b = 0 To UBound(W)
+        Count = 0
+        Select Case Len(W(b))
+            Case 1: Limit = 1
+            Case Else
+                i = NbLettersDiff(W(b))
+                If i >= Len(W(b)) \ 2 Then
+                    Limit = 0
+                ElseIf i = 1 Then
+                    Limit = Len(W(b))
+                Else
+                    Limit = Len(W(b)) - i
+                End If
+        End Select
+RePlay:
+        Do
+            S() = ShuffleIntegers(Len(W(b)))
+            myB = GoodShuffle(S, Limit)
+        Loop While Not myB
+        Anagram = ShuffleWord(CStr(W(b)), S)
+        Count = Nb(W(b), Anagram)
+        If Count > Limit Then GoTo RePlay
+        Debug.Print W(b) & " ==> " & Anagram & " (Score : " & Count & ")"
+    Next
+End Sub
+
+Function ShuffleIntegers(l As Long) As Long()
+Dim i As Integer, ou As Integer, temp() As Long
+Dim C As New Collection
+
+    ReDim temp(l - 1)
+    If l = 1 Then
+        temp(0) = 0
+    ElseIf l = 2 Then
+        temp(0) = 1: temp(1) = 0
+    Else
+        Randomize
+        Do
+            ou = Int(Rnd * l)
+            On Error Resume Next
+            C.Add CStr(ou), CStr(ou)
+            If Err <> 0 Then
+                On Error GoTo 0
+            Else
+                temp(ou) = i
+                i = i + 1
+            End If
+        Loop While C.Count <> l
+    End If
+    ShuffleIntegers = temp
+End Function
+
+Function GoodShuffle(t() As Long, Lim As Byte) As Boolean
+Dim i&, C&
+
+    For i = LBound(t) To UBound(t)
+        If t(i) = i Then C = C + 1
+    Next i
+    GoodShuffle = (C <= Lim)
+End Function
+
+Function ShuffleWord(W$, S() As Long) As String
+Dim i&, temp, strR$
+
+    temp = Split(StrConv(W, vbUnicode), Chr(0))
+    For i = 0 To UBound(S)
+        strR = strR & temp(S(i))
+    Next i
+    ShuffleWord = strR
+End Function
+
+Function Nb(W, A) As Integer
+Dim i As Integer, l As Integer
+
+    For i = 1 To Len(W)
+        If Mid(W, i, 1) = Mid(A, i, 1) Then l = l + 1
+    Next i
+    Nb = l
+End Function
+
+Function NbLettersDiff(W) As Integer
+Dim i&, C As New Collection
+    For i = 1 To Len(W)
+        On Error Resume Next
+        C.Add Mid(W, i, 1), Mid(W, i, 1)
+    Next i
+    NbLettersDiff = C.Count
+End Function