Best shuffle: Difference between revisions

Shuffle the characters of a string in such a way that as many of the character values are in a different position as possible.

 

 

 

 

 

 

 

 

;Test cases:

 

 

*   [[Anagrams/Deranged anagrams]]

*   [[Permutations/Derangements]]

<br><br>

 

=={{header|Ada}}==

{{trans|AWK}}

 

procedure Best_Shuffle is

 

begin

for I in S'Range loop

for J in S'Range loop

end if;

end loop;

end Best_Shuffle;

 

 

begin -- main procedure

declare

begin

for I in Original'Range loop

end if;

end loop;

end;

end loop;

 

=={{header|AutoHotkey}}==

Loop Parse, Words,`,

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

r++

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

Output:

<pre>abracadabra, caadarrbaab, (0)

a, a, (1)

</pre>

=={{header|AWK}}==

{{trans|Icon}}

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.

 

 

* to sort an array,

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.

 

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

<pre>

abracadabra -> daaracababr (0)

a -> a (1)

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

{!} Done

</pre>

=={{header|C}}==

 

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:

a, a, (1)

</pre>

 

=={{header|Clojure}}==

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

 

=={{header|D}}==

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

, , (0)

xxxxx, xxxxx, (5)</pre>

 

=={{header|Elena}}==

 

{

 

}

 

 

 

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

"up" "pu" 0

"a" "a" 1

</pre>

 

=={{header|Go}}==

{{trans|Icon and Unicon}}

 

import (

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

}

{{out|Output of two runs}}

<pre>

a -> a (1)

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

a, a, (1)

</pre>

=={{header|Haskell}}==

 

 

 

 

 

 

 

 

 

=={{header|Icon}} and {{header|Unicon}}==

The approach taken requires 2n memory and will run in O(n^2) time swapping once per final changed character. The algorithm is concise and conceptually simple avoiding the lists of indices, sorting, cycles, groups, and special cases requiring rotation needed by many of the other solutions. It proceeds through the entire string swapping characters ensuring that neither of the two characters are swapped with another instance of themselves in the ''original'' string.

 

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.

->

</pre>

=={{header|J}}==

 

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:

up pu (0)

a a (1)</pre>

=={{header|JavaScript}}==

 

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:

up, pu, (0)

a, a, (1)</pre>

 

=={{header|Kotlin}}==

{{trans|Java}}

 

object BestShuffle {

}

 

 

{{out}}

up pu (0)

a a (1)</pre>

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

list$ = "abracadabra seesaw pop grrrrrr up a"

 

next i

bestShuffle$ = s2$

output

<pre>

up pu 0

a a 1</pre>

 

=={{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 :

up, pu,(0)

a, a,(1)</pre>

 

=={{header|OCaml}}==

 

Deterministic

 

let len = String.length s in

let r = String.copy s in

test "up";

test "a";

 

Run:

'up', 'pu' -> 0

'a', 'a' -> 1</pre>

=={{header|Pascal}}==

{{works with|Free_Pascal}}

function BestShuffle(s: string): string;

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

end;

Output:

<pre>% ./BestShuffle

up, pu, (0)

a, a, (1)</pre>

 

=={{header|Perl}}==

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

 

use warnings;

use List::Util qw(shuffle);

use Algorithm::Permute;

# there will be a \x00 in the "^" of the two words.

# The tr operator is then used to count the "\x00"s.

next if $score >= $best_score;

($best_word, $best_score) = ($word, $score);

}

 

{{out|Output of two runs}}

<pre>abracadabra, dabrabacaar, 0

swaps which will improve the score.

 

use warnings;

use List::Util qw(shuffle);

 

my $word = join '', @t;

 

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

}

 

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

but only takes quadratic time per word.

 

{{out}}

<pre>

</pre>

=={{header|PHP}}==

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

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

 

$cnt++;

return "($cnt)";

 

Output:

up pu (0)

a a (1)</pre>

 

=={{header|PicoLisp}}==

(let Lst NIL

(for C (setq Str (chop Str))

(setq Lst (delete @ Lst)) ) )

Str )

Output:

<pre>: (bestShuffle "abracadabra")

: (bestShuffle "a")

a a (1)</pre>

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

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

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

end search;

 

 

OUTPUT:

A 1

</pre>

=={{header|PowerShell}}==

=={{header|Prolog}}==

Works with SWI-Prolog

 

best_shuffle :-

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

dif(Var,Other).

 

output : <pre> ?- test.

a : a (1)

true .

</pre>

=={{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)

up, pu, (0)

a, a, (1)</pre>

=={{header|Python}}==

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

up, pu, (0)

a, a, (1)</pre>

=={{header|Racket}}==

#lang racket

 

(if (eq? c1 c2) 1 0)))

 

(define sh (best-shuffle s))

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

 

=={{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?*/

w=0; #=words($) /* [↑] finds the widest word in $ list*/

same=0; do m=1 for length(@.n)

same=same + (substr(@.n, m, 1) == substr(new, m, 1) )

end /*m*/

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*/

<pre>

</pre>

 

{{works with|Ruby|1.9}}

 

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

a, a, (1)

</pre>

 

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

next i

bestShuffle$ = s2$

 

Output:

up pu 0

a a 1</pre>

extern crate rand;

 

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

}

{{out}}

<pre>

a, a, (1)

</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:

a a (1)

</pre>

=={{header|Seed7}}==

 

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

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

end for;

 

Output:

a, a, (1)

</pre>

=={{header|Sidef}}==

{{trans|Go}}

 

var s = orig.chars

var t = s.shuffle

 

if (i!=j && t[i]!=s[j] && t[j]!=s[i]) {

}

}

}

 

}

 

var (sword, score) = best_shuffle(word)

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

{{out}}

<pre>abracadabra daabacarrab: 0

up pu: 0

a a: 1</pre>

 

=={{header|Tcl}}==

{{tcllib|struct::list}}

package require struct::list

 

set best [join $best ""]

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

Demonstration:

puts [bestshuffle $sample]

Output:

<pre>

a,a,(1)

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

up pu (0)

a a (1)</pre>

 

=={{header|VBScript}}==

End Function

 

word_list = Array("abracadabra","seesaw","elk","grrrrrr","up","a")

For Each word In word_list

 

{{Out}}

up,pu,(0)

</pre>

 

=={{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:

a, a, (1)

</pre>

=={{header|zkl}}==

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

--> (0)

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

up pu 0

a a 1</pre>

{{omit from|bc|No string operations.}}

{{omit from|dc|No string operations.}}