Best shuffle: Difference between revisions

{{trans|Python}}

 

R sum(zip(w1, wnew).map((c1, c2) -> Int(c1 == c2)))

 

L(w) test_words

V (wnew, c) = best_shuffle(w)

 

{{out}}

 

=={{header|Action!}}==

BYTE i,j,len

CHAR tmp

Test("up")

Test("a")

{{out}}

[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Best_shuffle.png Screenshot from Atari 8-bit computer]

=={{header|Ada}}==

{{trans|AWK}}

with Ada.Strings.Unbounded;

 

end;

end loop;

 

Output:

=={{header|ALGOL 68}}==

{{Trans|Action!}}

PROC best shuffle = ( STRING orig )STRING:

BEGIN

test( "up" );

test( "a" )

{{out}}

<pre>

=={{header|Arturo}}==

 

count: function [s1 s2][

res: 0

sf: bestShuffle w

print [w "->" sf "| count:" count w sf]

 

{{out}}

 

=={{header|AutoHotkey}}==

Loop Parse, Words,`,

out .= Score(A_LoopField, Shuffle(A_LoopField))

r++

return a ", " b ", (" r ")`n"

Output:

<pre>abracadabra, caadarrbaab, (0)

The Icon and Unicon program uses a simple algorithm of swapping. This is relatively easy to translate to Awk.

 

scram = best_shuffle($0)

print $0 " -> " scram " (" unchanged($0, scram) ")"

}

return count

 

This program has the same output as the Icon and Unicon program.

If those built-in array functions seem strange to you, and if you can understand these for loops, then you might prefer this Awk program. This algorithm counts the letters in the string, sorts the positions, and fills the positions in order.

 

# out["score"] = number of matching characters

function best_shuffle(out, s, c, i, j, k, klen, p, pos, set, rlen, slen) {

words[i], result["string"], result["score"]

}

 

Output:

 

abracadabra, baarrcadaab, (0)

seesaw, essewa, (0)

grrrrrr, rgrrrrr, (5)

up, pu, (0)

 

The output might change if the <tt>for (c in set)</tt> loop iterates the array in a different order.

 

=={{header|BaCon}}==

 

FOR z = 0 TO UBOUND(case$)-1

 

PRINT MERGE$(result$), ":", total

{{output}}

<pre>

=={{header|BBC BASIC}}==

{{works with|BBC BASIC for Windows}}

a$ = "seesaw" : b$ = FNshuffle(a$) : PRINT a$ " -> " b$ FNsame(a$,b$)

a$ = "elk" : b$ = FNshuffle(a$) : PRINT a$ " -> " b$ FNsame(a$,b$)

IF MID$(s$,i%,1)=MID$(t$,i%,1) n% += 1

NEXT

Output (varies between runs):

<pre>

=={{header|Bracmat}}==

Not optimized:

( shuffle

= m car cdr todo a z count string

)

& Done

 

Optimized (~100 x faster):

( shuffle

= m car cdr todo a z count M string tried

)

& Done

Output:

<pre>

In essence: we form cyclic groups of character indices where each cyclic group is guaranteed to represent each character only once (two instances of the letter 'a' must have their indices in separate groups), and then we rotate each of the cyclic groups. We then use the before/after version of these cycles to shuffle the original text. The only way a character can be repeated, here, is when a cyclic group contains only one character index, and this can only happen when more than half of the text uses that character. This is C99 code.

 

#include <stdio.h>

#include <string.h>

 

return EXIT_SUCCESS;

Output:

<pre>abracadabra, brabacadaar, (0)

 

===Version with random result===

#include <stdlib.h>

#include <string.h>

do_string("");

return 0;

grrrrrr -> rrgrrrr, overlap 5

elk -> kel, overlap 0

seesaw -> ewsesa, overlap 0

 

===Deterministic method===

#include <string.h>

 

}

return 0;

 

=={{header|C sharp|C#}}==

For both solutions, a class is used to encapsulate the original string and to scrambling. A private function of the class does the actual sorting. An implicit conversion from string is also provided to allow for simple initialization, e.g.:

Which will immediately shuffle each word.

 

A sequential solution, which always produces the same output for the same input.

using System;

using System.Text;

}

}

 

And a randomized solution, which will produce a more or less different result on every run:

using System;

using System.Text;

}

}

 

A sample output for the sequential shuffle:

{{works with|C++|11}}

{{trans|Java}}

#include <sstream>

#include <algorithm>

cout << bs(basic_string<char>(arguments[i])) << endl;

return 0;

{{out}}

<pre>abracadabra

Uses same method as J

 

(->> (map = before after)

(filter true? ,)

["grrrrrr" "rgrrrrr" 5]

["up" "pu" 0]

 

=={{header|Common Lisp}}==

(loop for c1 across string1 and c2 across string2

count (char= c1 c2)))

(count-equal-chars string shuffled)))))

 

Output:

abracadabra caadrbabaar (0)

 

===Version 2===

(let (tbl out (shortest (length str)) (s str))

 

(dolist (s (list "abracadabra" "seesaw" "elk" "grrrrrr" "up" "a"))

(format t "~A: ~A~%" s (best-shuffle s)))

 

The output is:

seesaw: (ewsase 0)

elk: (kel 0)

up: (pu 0)

a: (a 1)

 

=={{header|Crystal}}==

{{trans|Ruby}}

 

# Fill _pos_ with positions in the order

# that we want to fill them.

new, score = best_shuffle(word)

puts "%s, %s, (%d)" % [word, new, score]

 

{{out}}

===Version with random result===

Translation of [[Best_shuffle#Icon_and_Unicon|Icon]] via [[Best_shuffle#AWK|AWK]]

std.traits, std.typecons;

 

writefln("%s : %s (%d)", entry, res[]);

}

 

===Deterministic approach===

 

extern(C) pure nothrow void* alloca(in size_t size);

writefln("%s, %s, (%d)", txt, result, nEqual);

}

{{out}}

<pre>abracadabra, brabacadaar, (0)

{{libheader| System.Generics.Collections}}

{{Trans|C#}}

program Best_shuffle;

 

Readln;

end.

=={{header|Elena}}==

ELENA 5.0 :

import extensions;

import extensions'text;

 

console.readChar()

{{out}}

<pre>

=={{header|Erlang}}==

Deterministic version.

-module( best_shuffle ).

 

{_First_reversed_original, [Character_acc | First_part_acc]} = lists:unzip( First_reversed_zip ),

[Character_acc | Last_part_acc] ++ [Last_character_acc | First_part_acc].

{{out}}

<pre>

=={{header|FreeBASIC}}==

{{trans|Liberty BASIC}}

Dim As String*11 lista(6) => {"abracadabra","seesaw","pop","grrrrrr","up","a"}

 

Next b

Sleep

{{out}}

<pre>

 

=={{header|Free Pascal}}==

Program BestShuffle;

 

End.

 

{{out}}

<pre>

 

=={{header|FutureBasic}}==

 

include "Tlbx GameplayKit.incl"

 

HandleEvents

Output with four shuffles:

<pre>

=={{header|Go}}==

{{trans|Icon and Unicon}}

 

import (

fmt.Printf("%s -> %s (%d)\n", s, string(t), count)

}

{{out|Output of two runs}}

<pre>

 

=={{header|Groovy}}==

def shuffled = (text as List)

for (sourceIndex in 0..<text.size()) {

def result = shuffle(text)

println "${result.original}, ${result.shuffled}, (${result.score})"

Output:

<pre>

We demonstrate several approaches here. In order to test the program we define a testing suite:

 

 

printTest prog = mapM_ test texts

texts = [ "abba", "abracadabra", "seesaw", "elk" , "grrrrrr"

, "up", "a", "aaaaa.....bbbbb"

 

=== Deterministic List-based solution ===

The core of the algorithm is swapping procedure similar to those implemented in AWK and Icon examples. It could be done by a pure program with use of immutable vectors (though it is possible to use mutable vectors living in <tt>ST</tt> or <tt>IO</tt>, but it won't make the program more clear).

 

import qualified Data.Vector as V

import Data.List (delete, find)

 

shuffle :: Eq a => [a] -> [a]

 

{{Out}}

The program works but shuffling is not good in case of a real text, which was just shifted. We can make it better using [[Perfect shuffle]] (faro shuffle) before the swapping procedure.

 

perfectShuffle [] = []

perfectShuffle lst | odd n = b : shuffle (zip bs a)

shuffleP :: Eq a => [a] -> [a]

 

{{Out}}

Additional import:

 

 

randomShuffle [] = return []

randomShuffle lst = do

shuffleR :: Eq a => [a] -> IO [a]

 

{{Out}}

Using streaming technique it is possible to shuffle the sequence on the fly, using relatively small moving window (say of length k) for shuffling procedure. In that case the program will consume constant memory amount O[k] and require O[n*k] operations.

 

import Conduit

import Control.Monad.Random (getRandomR)

 

shuffleW :: Eq a => Int -> [a] -> IO [a]

 

Here we define a new conduit <code>shuffleC</code> which uses a moving window of length <tt>k</tt> and returns shuffled elements of upstream data.

Additional imports

 

import Data.ByteString.Char8 (ByteString, unpack, pack)

import Data.Conduit.ByteString.Builder (builderToByteString)

 

shuffleBS :: Int -> ByteString -> IO ByteString

shuffleBS n s =

sourceHandle stdin

=$ mapMC (shuffleBS 10)

 

{{Out}}

 

Additionally, this can be trivially modified to randomize the shuffle by uncommenting the line

while scram := bestShuffle(line := read()) do

write(line," -> ",scram," (",unchanged(line,scram),")")

every (count := 0) +:= (s1[i := 1 to *s1] == s2[i], 1)

return count

 

The code works in both Icon and Unicon.

Based on [http://rosettacode.org/mw/index.php?title=Best_shuffle&oldid=97419#J Dan Bron's approach]:

 

yy=. <@({~ ?~@#)@I.@= y

y C.~ (;yy) </.~ (i.#y) |~ >./#@> yy

y,', ',b,' (',')',~":+/b=y

)

 

yy is (a list of) boxes of (lists of) indices where all characters selected by indices in a box are the same, and where the first box is the biggest box (contains the most indices). The phrase <code>({~ ?~@#)</code> shuffles the indices going into each box which makes the (deterministic) rotate which follows produce differing results sometimes (but only when that is possible).

Example:

 

abracadabra, bdacararaab (0)

seesaw, eawess (0)

grrrrrr, rrrrrrg (5)

up, pu (0)

 

=={{header|Java}}==

Translation of [[Best_shuffle#Icon_and_Unicon|Icon]] via [[Best_shuffle#AWK|AWK]]

 

public class BestShuffle {

return count;

}

 

Output:

Based on the J implementation (and this would be a lot more concise if we used something like jQuery):

 

var r= [];

for (var j= 0; j<a.length; j++)

n+= ex.substr(j, 1) == r.substr(j,1) ?1 :0;

return ex+', '+r+', ('+n+')';

 

Example:

 

<script type="text/javascript">

/* ABOVE CODE GOES HERE */

for (var i= 0; i<sample.length; i++)

document.getElementById('out').innerHTML+= disp(sample[i])+'\r\n';

 

Produced:

The implementation in this section uses the deterministic "swap" algorithm found in other entries on this page.

 

 

def swap($i;$j):

| . as $s

| bestShuffleArray

 

'''Examples:'''

 

'''Invocation and Output'''

=={{header|Julia}}==

{{trans|Python}}

 

function bestshuffle(str::String)::Tuple{String,Int}

shuffled, score = bestshuffle(word)

println("$word: $shuffled ($score)")

 

{{out}}

=={{header|Kotlin}}==

{{trans|Java}}

 

object BestShuffle {

}

 

 

{{out}}

 

=={{header|Liberty BASIC}}==

list$ = "abracadabra seesaw pop grrrrrr up a"

 

next i

bestShuffle$ = s2$

output

<pre>

 

=={{header|Lua}}==

 

local function shuffle(t)

 

test(true)

{{out}}

<pre>RANDOM:

 

=={{header|Mathematica}} / {{header|Wolfram Language}}==

Flatten[{data,First[SortBy[

List[#, StringLength[data]-HammingDistance[#,data]] & /@ StringJoin /@ Permutations[StringSplit[data, ""]], Last]]}]

 

Print[#[[1]], "," #[[2]], ",(", #[[3]], ")"] & /@ BestShuffle /@ {"abracadabra","seesaw","elk","grrrrrr","up","a"}

 

Output :

=={{header|Nim}}==

{{trans|Java}}

import sequtils

import strutils

let shuffled = bestShuffle(w)

echo "$1 $2 $3" % [w, shuffled, $count(w, shuffled)]

 

Run:

Deterministic

 

let len = String.length s in

let r = String.copy s in

test "up";

test "a";

 

Run:

=={{header|Pascal}}==

{{works with|Free_Pascal}}

function BestShuffle(s: string): string;

writeln(original[i], ', ', shuffle, ', (', score, ')');

end;

Output:

<pre>% ./BestShuffle

The Algorithm::Permute module does not ship with perl, but is freely available from CPAN.

 

use warnings;

use List::Util qw(shuffle);

}

 

{{out|Output of two runs}}

<pre>abracadabra, dabrabacaar, 0

 

{{trans|go}}

use warnings;

use List::Util qw(shuffle);

print "$original_word, $word, $score\n";

}

 

The output has the same format as the first perl implementation,

 

=={{header|Phix}}==

<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>

<span style="color: #008080;">constant</span> <span style="color: #000000;">tests</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #008000;">"abracadabra"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"seesaw"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"elk"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"grrrrrr"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"up"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"a"</span><span style="color: #0000FF;">}</span>

<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%s -&gt; %s (%d)\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">s</span><span style="color: #0000FF;">,</span><span style="color: #000000;">t</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">sum</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">sq_eq</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">,</span><span style="color: #000000;">s</span><span style="color: #0000FF;">))})</span>

<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>

{{out}}

<pre>

=={{header|PHP}}==

Translation of [[Best_shuffle#Icon_and_Unicon|Icon]] via [[Best_shuffle#AWK|AWK]]

echo bestShuffle($w) . '<br>';

 

$cnt++;

return "($cnt)";

 

Output:

Using a CP (Constraint Programming) solver guarantees an optimal solution. This is deterministic since the solve heuristic ("split") always give the same first result.

 

 

go =>

foreach(E in L)

Occ.put(E, Occ.get(E,0) + 1)

 

{{out}}

===All optimal solutions===

Using a constraint solver makes it quite easy to generate all optimal solutions.

Words = ["abracadabra",

"seesaw",

fail,

nl.

 

{{out}}

 

=={{header|PicoLisp}}==

(let Lst NIL

(for C (setq Str (chop Str))

(setq Lst (delete @ Lst)) ) )

Str )

Output:

<pre>: (bestShuffle "abracadabra")

 

=={{header|PL/I}}==

declare (s, saves) character (20) varying, c character (1);

declare t(length(s)) bit (1);

end search;

 

 

OUTPUT:

=={{header|PowerShell}}==

{{works with|PowerShell|3}}

# (Split out into separate function so we can use it separately in our output)

function Get-BestScore ( [string]$String )

$Shuffle = ( [string[]]$S2 -join '' )

return $Shuffle

{

$Shuffle = Get-BestShuffle $String

$Score = Get-BestScore $String

"$String, $Shuffle, ($Score)"

{{out}}

<pre>abracadabra, craradabaab, (0)

=={{header|Prolog}}==

Works with SWI-Prolog

 

best_shuffle :-

run(Var,[Other|RRest], [1,Var],[Other|RRest]):-

dif(Var,Other).

 

output : <pre> ?- test.

===Version with random result===

====solution====

:- system:set_prolog_flag(double_quotes,codes) .

 

.

 

 

====output====

=={{header|PureBasic}}==

This solution creates cycles of letters of letters that are then rotated to produce the final maximal shuffle. It includes an extra sort step that ensures the original string to be returned if it is repeatedly shuffled.

Char.s

List Position.i()

Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()

CloseConsole()

Sample output:

<pre>abracadabra, daabarbraac, (0)

===Swap if it is locally better algorithm===

With added randomization of swaps!

 

def count(w1,wnew):

for w in test_words:

wnew, c = best_shuffle(w)

 

;Sample output

===Alternative algorithm #1===

 

 

def best_shuffle(s):

for s in "abracadabra", "seesaw", "elk", "grrrrrr", "up", "a":

shuffled, score = best_shuffle(s)

 

Output: <pre>abracadabra, raabarabacd, (0)

 

=={{header|Racket}}==

#lang racket

 

(define sh (best-shuffle s))

(printf " ~a, ~a, (~a)\n" s sh (count-same s sh)))

{{out}}

<pre>

{{works with|Rakudo Star|2015.12}}

 

 

my @s = $orig.comb;

 

printf "%s, %s, (%d)\n", $_, best-shuffle $_

{{out}}

<pre>

=={{header|Rascal}}==

{{incomplete|Rascal|No output given.}}

 

public tuple[str, str, int] bestShuffle(str s){

public int countSame(list[int] permutations, list[int] characters){

return (0 | it + 1 | n <- index(characters), permutations[n] == characters[n]);

 

=={{header|REXX}}==

parse arg $ /*get some words from the command line.*/

if $='' then $= 'tree abracadabra seesaw elk grrrrrr up a' /*use the defaults?*/

else x= left(x, k-1)substr(x, k+1, 1)a || substr(x,k+2)

end /*k*/

{{out|output|text=&nbsp; (with a freebie thrown in):}}

<pre>

 

=={{header|Ring}}==

# Project : Best shuffle

 

bestshuffle = s2

return bestshuffle

Output:

<pre>

{{trans|Raku}}

 

# Fill _pos_ with positions in the order

# that we want to fill them.

%w(abracadabra seesaw elk grrrrrr up a).each do |word|

puts "%s, %s, (%d)" % [word, *best_shuffle(word)]

 

{{out}}

 

=={{header|Run BASIC}}==

 

while word$(list$,ii + 1," ") <> ""

next i

bestShuffle$ = s2$

 

Output:

=={{header|Rust}}==

{{libheader|rand}}

extern crate rand;

 

w0.iter().zip(w1.iter()).filter(|z| z.0 == z.1).count()

}

{{out}}

<pre>

=={{header|Scala}}==

There are two implementations. One is simple but exponential and very inefficient. The second one is quadratic. Both are pure functional. Given quadratic solution has a bigger constant than the one used in the Python implementation, but doesn't use mutable datastructures.

def coincidients(s1: Seq[Char], s2: Seq[Char]): Int = (s1, s2).zipped.count(p => (p._1 == p._2))

def freqMap(s1: List[Char]) = s1.groupBy(_.toChar).mapValues(_.size)

 

}

The test code:

def main(args: Array[String]): Unit = {

println(bestShuffle("abracadabra"));

BestShuffleSpecification.check

}

{{out}}

<pre>

</pre>

The ScalaCheck code

object BestShuffleSpecification extends Properties("BestShuffle") {

 

 

}

 

=={{header|Scheme}}==

(define count

(lambda (str1 str2)

(number->string (count str shuffled)) ")\n"))))

'("abracadabra" "seesaw" "elk" "grrrrrr" "up" "a"))

 

Output:

 

=={{header|Seed7}}==

 

const func string: bestShuffle (in string: stri) is func

writeln(original <& ", " <& shuffled <& ", (" <& score <& ")");

end for;

 

Output:

=={{header|Sidef}}==

{{trans|Go}}

 

var s = orig.chars

var (sword, score) = best_shuffle(word)

"%-12s %12s: %d\n".printf(word, sword, score)

{{out}}

<pre>abracadabra daabacarrab: 0

=={{header|Tcl}}==

{{tcllib|struct::list}}

package require struct::list

 

set best [join $best ""]

return "$str,$best,($score)"

Demonstration:

puts [bestshuffle $sample]

Output:

<pre>

=={{header|Ursala}}==

An implementation based on the J solution looks like this.

#import nat

 

#show+

 

A solution based on exponential search would use this definition of <code>shuffle</code> (cf. Haskell and Tcl).

output:

<pre>abracadabra caarrbabaad (0)

=={{header|VBA}}==

 

Option Explicit

 

NbLettersDiff = C.Count

End Function

{{out}}

<pre>a ==> a (Score : 1)

=={{header|VBScript}}==

{{trans|Java}}

'VBScript Implementation

 

For Each word In word_list

WScript.StdOut.WriteLine word & "," & bestshuffle(word)

 

{{Out}}

=={{header|Wren}}==

{{trans|Kotlin}}

 

class BestShuffle {

 

var words = ["tree", "abracadabra", "seesaw", "elk", "grrrrrr", "up", "a"]

 

{{out}}

 

=={{header|XPL0}}==

string 0; \use zero-terminated string convention

 

[S:= ["abracadabra", "seesaw", "elk", "grrrrrr", "up", "a"];

for I:= 0 to 5 do Shuffle(S(I));

 

Output:

{{trans|D}}

{{trans|Common Lisp}}

s:=str.split("").shuffle(); // -->List

if(not s) return(str,str.len()); // can't shuffle "" or "a"

}

return(s.concat(), s.zipWith('==,str).sum(0));

foreach s in (ss){

ns,cnt:=bestShuffle(s);

println("%s --> %s (%d)".fmt(s,ns,cnt));

{{out}}

<pre>

=={{header|ZX Spectrum Basic}}==

{{trans|AWK}}

20 READ w$

30 GO SUB 1000

1130 RETURN

2000 DATA "abracadabra","seesaw","elk","grrrrrr","up","a"

{{out}}

<pre>abracadabra caadrbabaar 0