Best shuffle: Difference between revisions

no edit summary
(added Version with random result)
No edit summary
 
(28 intermediate revisions by 18 users not shown)
Line 33:
{{Template:Strings}}
<br><br>
=={{header|11l}}==
{{trans|Python}}
 
<syntaxhighlight lang="11l">F count(w1, wnew)
R sum(zip(w1, wnew).map((c1, c2) -> Int(c1 == c2)))
 
F best_shuffle(w)
V wnew = Array(w)
V n = w.len
V rangei = Array(0 .< n)
V rangej = Array(0 .< n)
random:shuffle(&rangei)
random:shuffle(&rangej)
L(i) rangei
L(j) rangej
I i != j & wnew[j] != wnew[i] & w[i] != wnew[j] & w[j] != wnew[i]
swap(&wnew[j], &wnew[i])
L.break
V wnew_s = wnew.join(‘’)
R (wnew_s, count(w, wnew_s))
 
V test_words = [‘tree’, ‘abracadabra’, ‘seesaw’, ‘elk’, ‘grrrrrr’, ‘up’, ‘a’,
‘antidisestablishmentarianism’, ‘hounddogs’,
‘aardvarks are ant eaters’, ‘immediately’, ‘abba’]
L(w) test_words
V (wnew, c) = best_shuffle(w)
print(‘#29, #<29 ,(#.)’.format(w, wnew, c))</syntaxhighlight>
 
{{out}}
<pre>
tree, eert ,(0)
abracadabra, raacbbaraad ,(0)
seesaw, wsaees ,(0)
elk, kel ,(0)
grrrrrr, rrrrrrg ,(5)
up, pu ,(0)
a, a ,(1)
antidisestablishmentarianism, tsesidatbslmiansnitreiamihan ,(0)
hounddogs, ougdhosnd ,(0)
aardvarks are ant eaters, re aar anarsdtrsktaeav e ,(0)
immediately, ytidammeiel ,(0)
abba, baab ,(0)
</pre>
=={{header|AArch64 Assembly}}==
{{works with|as|Raspberry Pi 3B version Buster 64 bits <br> or android 64 bits with application Termux }}
<syntaxhighlight lang AArch64 Assembly>
/* ARM assembly AARCH64 Raspberry PI 3B */
/* program shuffleperf64.s */
/************************************/
/* Constantes */
/************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"
 
/************************************/
/* Initialized data */
/************************************/
.data
szMessString: .asciz "String :\n"
szString1: .asciz "abracadabra"
.equ LGSTRING1, . - szString1 - 1
szString2: .asciz "seesaw"
.equ LGSTRING2, . - szString2 - 1
szString3: .asciz "elk"
.equ LGSTRING3, . - szString3 - 1
szString4: .asciz "grrrrrr"
.equ LGSTRING4, . - szString4 - 1
szString5: .asciz "up"
.equ LGSTRING5, . - szString5 - 1
szString6: .asciz "a"
.equ LGSTRING6, . - szString6 - 1
szCarriageReturn: .asciz "\n"
szMessStart: .asciz "Program 64 bits start.\n"
.align 4
qGraine: .quad 123456789
/************************************/
/* UnInitialized data */
/************************************/
.bss
sZoneConv: .skip 24
sBuffer: .skip 80
/************************************/
/* code section */
/************************************/
.text
.global main
main:
ldr x0,qAdrszMessStart
bl affichageMess
ldr x0,qAdrszString1 // string address
mov x1,#LGSTRING1 // string length
ldr x2,qAdrsBuffer // result address
bl testshuffle // call test
ldr x0,qAdrszString2
mov x1,#LGSTRING2
ldr x2,qAdrsBuffer
bl testshuffle
ldr x0,qAdrszString3
mov x1,#LGSTRING3
ldr x2,qAdrsBuffer
bl testshuffle
ldr x0,qAdrszString4
mov x1,#LGSTRING4
ldr x2,qAdrsBuffer
bl testshuffle
ldr x0,qAdrszString5
mov x1,#LGSTRING5
ldr x2,qAdrsBuffer
bl testshuffle
ldr x0,qAdrszString6
mov x1,#LGSTRING6
ldr x2,qAdrsBuffer
bl testshuffle
100: // standard end of the program
mov x0, #0 // return code
mov x8, #EXIT // request to exit program
svc 0 // perform system call
qAdrszMessString: .quad szMessString
qAdrsBuffer: .quad sBuffer
qAdrszString1: .quad szString1
qAdrszString2: .quad szString2
qAdrszString3: .quad szString3
qAdrszString4: .quad szString4
qAdrszString5: .quad szString5
qAdrszString6: .quad szString6
qAdrszCarriageReturn: .quad szCarriageReturn
qAdrszMessStart: .quad szMessStart
/******************************************************************/
/* test shuffle strings */
/******************************************************************/
/* x0 contains the address of the string */
/* x1 contains string length */
/* x2 contains result area */
testshuffle:
stp x1,lr,[sp,-16]! // register save
stp x2,x3,[sp,-16]!
stp x4,x5,[sp,-16]!
stp x6,x7,[sp,-16]!
mov x3,x0 // display string
bl affichageMess
ldr x0,qAdrszCarriageReturn
bl affichageMess
mov x0,x3
bl shufflestrings
mov x0,x2 // display result string
bl affichageMess
ldr x0,qAdrszCarriageReturn
bl affichageMess
mov x4,#0 // string index
mov x0,#0 // score
1: // compute score loop
ldrb w6,[x3,x4]
ldrb w5,[x2,x4]
cmp x6,x5
add x6,x0,1
csel x0,x6,x0,eq // equal -> increment score
add x4,x4,#1
cmp x4,x1
blt 1b
ldr x1,qAdrsZoneConv
bl conversion10 // conversion score in decimal
ldr x0,qAdrsZoneConv
bl affichageMess
ldr x0,qAdrszCarriageReturn
bl affichageMess
ldr x0,qAdrszCarriageReturn
bl affichageMess
100:
ldp x6,x7,[sp],16
ldp x4,x5,[sp],16
ldp x2,x3,[sp],16
ldp x1,lr,[sp],16
ret
qAdrsZoneConv: .quad sZoneConv
/******************************************************************/
/* shuffle strings algorithme Fisher-Yates */
/******************************************************************/
/* x0 contains the address of the string */
/* x1 contains string length */
/* x2 contains address result string */
shufflestrings:
stp x1,lr,[sp,-16]! // TODO: save à completer
stp x2,x3,[sp,-16]!
stp x4,x5,[sp,-16]!
mov x3,#0
1: // loop copy string in result
ldrb w4,[x0,x3]
strb w4,[x2,x3]
add x3,x3,#1
cmp x3,x1
ble 1b
sub x1,x1,#1 // last element
2:
mov x0,x1
bl genereraleas // call random
ldrb w4,[x2,x1] // load byte string index loop
ldrb w3,[x2,x0] // load byte string random index
strb w3,[x2,x1] // and exchange
strb w4,[x2,x0]
subs x1,x1,#1
cmp x1,#1
bge 2b
 
100:
ldp x4,x5,[sp],16
ldp x2,x3,[sp],16
ldp x1,lr,[sp],16
ret
/***************************************************/
/* Generation random number */
/***************************************************/
/* x0 contains limit */
genereraleas:
stp x1,lr,[sp,-16]! // save registers
stp x2,x3,[sp,-16]! // save registers
ldr x1,qAdrqGraine
ldr x2,[x1]
ldr x3,qNbDep1
mul x2,x3,x2
ldr x3,qNbDep2
add x2,x2,x3
str x2,[x1] // maj de la graine pour l appel suivant
cmp x0,#0
beq 100f
udiv x3,x2,x0
msub x0,x3,x0,x2 // résult = remainder
100: // end function
ldp x2,x3,[sp],16 // restaur 2 registers
ldp x1,lr,[sp],16 // restaur 2 registers
ret // return to address lr x30
qAdrqGraine: .quad qGraine
qNbDep1: .quad 0x0019660d
qNbDep2: .quad 0x3c6ef35f
 
/***************************************************/
/* ROUTINES INCLUDE */
/***************************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeARM64.inc"
 
</syntaxhighlight>
{{Out}}
<pre>
Program 64 bits start.
abracadabra
braaadcarab
2
 
seesaw
essawe
0
 
elk
kel
0
 
grrrrrr
rgrrrrr
5
 
up
pu
0
 
a
a
1
</pre>
=={{header|Action!}}==
<syntaxhighlight lang="action!">PROC BestShuffle(CHAR ARRAY orig,res)
BYTE i,j,len
CHAR tmp
 
len=orig(0)
SCopy(res,orig)
FOR i=1 TO len
DO
FOR j=1 TO len
DO
IF i#j AND orig(i)#res(j) AND orig(j)#res(i) THEN
tmp=res(i) res(i)=res(j) res(j)=tmp
FI
OD
OD
RETURN
 
PROC Test(CHAR ARRAY orig)
CHAR ARRAY res(100)
BYTE i,score
 
BestShuffle(orig,res)
score=0
FOR i=1 TO orig(0)
DO
IF orig(i)=res(i) THEN
score==+1
FI
OD
PrintF("%S, %S, (%B)%E",orig,res,score)
RETURN
 
PROC Main()
Test("abracadabra")
Test("seesaw")
Test("elk")
Test("grrrrrr")
Test("up")
Test("a")
RETURN</syntaxhighlight>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Best_shuffle.png Screenshot from Atari 8-bit computer]
<pre>
abracadabra, caadrbabaar, (0)
seesaw, ewaess, (0)
elk, kel, (0)
grrrrrr, rgrrrrr, (5)
up, pu, (0)
a, a, (1)
</pre>
=={{header|Ada}}==
{{trans|AWK}}
<langsyntaxhighlight Adalang="ada">with Ada.Text_IO;
with Ada.Strings.Unbounded;
 
Line 85 ⟶ 405:
end;
end loop;
end Best_Shuffle;</langsyntaxhighlight>
 
Output:
Line 94 ⟶ 414:
up, pu, ( 0 )
a, a, ( 1 )</pre>
=={{header|ALGOL 68}}==
{{Trans|Action!}}
<syntaxhighlight lang="algol68">BEGIN # shuffle a string so as many as possible characters are moved #
PROC best shuffle = ( STRING orig )STRING:
BEGIN
STRING res := orig;
FOR i FROM LWB orig TO UPB orig DO
FOR j FROM LWB orig TO UPB orig DO
IF i /= j AND orig[ i ] /= res[ j ] AND orig[ j ] /= res[ i ] THEN
CHAR tmp = res[ i ]; res[ i ] := res[ j ]; res[ j ] := tmp
FI
OD
OD;
res
END # best shuffle # ;
PROC test = ( STRING orig )VOID:
BEGIN
STRING res := best shuffle( orig );
INT score := 0;
FOR i FROM LWB orig TO UPB orig DO
IF orig[ i ] = res[ i ] THEN
score +:= 1
FI
OD;
print( ( orig, ", ", res, ", (", whole( score, 0 ), ")", newline ) )
END # test # ;
 
test( "abracadabra" );
test( "seesaw" );
test( "elk" );
test( "grrrrrr" );
test( "up" );
test( "a" )
END</syntaxhighlight>
{{out}}
<pre>
abracadabra, caadrbabaar, (0)
seesaw, ewaess, (0)
elk, kel, (0)
grrrrrr, rgrrrrr, (5)
up, pu, (0)
a, a, (1)
</pre>
=={{header|ARM Assembly}}==
{{works with|as|Raspberry Pi <br> or android 32 bits with application Termux}}
<syntaxhighlight lang ARM Assembly>
/* ARM assembly Raspberry PI */
/* program shuffleperf.s */
/************************************/
/* Constantes */
/************************************/
/* for this file see task include a file in language ARM assembly*/
.include "../constantes.inc"
 
/************************************/
/* Initialized data */
/************************************/
.data
szMessString: .asciz "String :\n"
szString1: .asciz "abracadabra"
.equ LGSTRING1, . - szString1 - 1
szString2: .asciz "seesaw"
.equ LGSTRING2, . - szString2 - 1
szString3: .asciz "elk"
.equ LGSTRING3, . - szString3 - 1
szString4: .asciz "grrrrrr"
.equ LGSTRING4, . - szString4 - 1
szString5: .asciz "up"
.equ LGSTRING5, . - szString5 - 1
szString6: .asciz "a"
.equ LGSTRING6, . - szString6 - 1
szCarriageReturn: .asciz "\n"
.align 4
iGraine: .int 1234567
/************************************/
/* UnInitialized data */
/************************************/
.bss
sZoneConv: .skip 24
sBuffer: .skip 80
/************************************/
/* code section */
/************************************/
.text
.global main
main:
ldr r0,iAdrszString1 @ string address
mov r1,#LGSTRING1 @ string length
ldr r2,iAdrsBuffer @ result address
bl testshuffle @ call test
ldr r0,iAdrszString2
mov r1,#LGSTRING2
ldr r2,iAdrsBuffer
bl testshuffle
ldr r0,iAdrszString3
mov r1,#LGSTRING3
ldr r2,iAdrsBuffer
bl testshuffle
ldr r0,iAdrszString4
mov r1,#LGSTRING4
ldr r2,iAdrsBuffer
bl testshuffle
ldr r0,iAdrszString5
mov r1,#LGSTRING5
ldr r2,iAdrsBuffer
bl testshuffle
ldr r0,iAdrszString6
mov r1,#LGSTRING6
ldr r2,iAdrsBuffer
bl testshuffle
100: @ standard end of the program
mov r0, #0 @ return code
mov r7, #EXIT @ request to exit program
svc 0 @ perform system call
iAdrszMessString: .int szMessString
iAdrsBuffer: .int sBuffer
iAdrszString1: .int szString1
iAdrszString2: .int szString2
iAdrszString3: .int szString3
iAdrszString4: .int szString4
iAdrszString5: .int szString5
iAdrszString6: .int szString6
iAdrszCarriageReturn: .int szCarriageReturn
/******************************************************************/
/* test shuffle strings */
/******************************************************************/
/* r0 contains the address of the string */
/* r1 contains string length */
/* r2 contains result area */
testshuffle:
push {r1-r6,lr} @ save registers
mov r3,r0 @ display string
bl affichageMess
ldr r0,iAdrszCarriageReturn
bl affichageMess
mov r0,r3
bl shufflestrings
mov r0,r2 @ display result string
bl affichageMess
ldr r0,iAdrszCarriageReturn
bl affichageMess
mov r4,#0 @ string index
mov r0,#0 @ score
1: @ compute score loop
ldrb r6,[r3,r4]
ldrb r5,[r2,r4]
cmp r6,r5
addeq r0,r0,#1 @ equal -> increment score
add r4,r4,#1
cmp r4,r1
blt 1b
ldr r1,iAdrsZoneConv
bl conversion10 @ conversion score in decimal
ldr r0,iAdrsZoneConv
bl affichageMess
ldr r0,iAdrszCarriageReturn
bl affichageMess
ldr r0,iAdrszCarriageReturn
bl affichageMess
100:
pop {r1-r6,pc} @ restaur registers
iAdrsZoneConv: .int sZoneConv
/******************************************************************/
/* shuffle strings algorithme Fisher-Yates */
/******************************************************************/
/* r0 contains the address of the string */
/* r1 contains string length */
/* r2 contains address result string */
shufflestrings:
push {r1-r4,lr} @ save registers
mov r3,#0
1: @ loop copy string in result
ldrb r4,[r0,r3]
strb r4,[r2,r3]
add r3,r3,#1
cmp r3,r1
ble 1b
sub r1,r1,#1 @ last element
2:
mov r0,r1 @ limit random number
bl genereraleas @ call random
ldrb r4,[r2,r1] @ load byte string index loop
ldrb r3,[r2,r0] @ load byte string random index
strb r3,[r2,r1] @ and exchange
strb r4,[r2,r0]
subs r1,r1,#1
cmp r1,#1
bge 2b
 
100:
pop {r1-r4,pc} @ restaur registers
 
/***************************************************/
/* Generation random number */
/***************************************************/
/* r0 contains limit */
genereraleas:
push {r1-r4,lr} @ save registers
ldr r4,iAdriGraine
ldr r2,[r4]
ldr r3,iNbDep1
mul r2,r3,r2
ldr r3,iNbDep1
add r2,r2,r3
str r2,[r4] @ maj de la graine pour l appel suivant
cmp r0,#0
beq 100f
mov r1,r0 @ divisor
mov r0,r2 @ dividende
bl division
mov r0,r3 @ résult = remainder
100: @ end function
pop {r1-r4,pc} @ restaur registers
iAdriGraine: .int iGraine
iNbDep1: .int 0x343FD
iNbDep2: .int 0x269EC3
/***************************************************/
/* ROUTINES INCLUDE */
/***************************************************/
/* for this file see task include a file in language ARM assembly*/
.include "../affichage.inc"
 
</syntaxhighlight>
{{Out}}
<pre>
Program 32 bits start.
abracadabra
braaraacdab
2
 
seesaw
wsaese
0
 
elk
kel
0
 
grrrrrr
rrrrrgr
5
 
up
pu
0
 
a
a
1
 
</pre>
=={{header|Arturo}}==
 
<syntaxhighlight lang="rebol">
count: function [s1 s2][
res: 0
loop.with:'i s1 'c [
if c = s2\[i] -> res: res + 1
]
return res
]
 
shuff: function [str]->
join shuffle split str
 
bestShuffle: function [s][
shuffled: shuff s
loop 0..dec size shuffled 'i [
if shuffled\[i] <> s\[i] -> continue
loop 0..dec size shuffled 'j [
if all? @[
shuffled\[i] <> shuffled\[j]
shuffled\[i] <> s\[j]
shuffled\[j] <> s\[i]
] [
tmp: shuffled\[i]
shuffled\[i]: shuffled\[j]
shuffled\[j]: tmp
break
]
]
]
return shuffled
]
 
words: ["abracadabra" "seesaw" "grrrrrr" "pop"
"up" "a" "antidisestablishmentarianism"]
 
loop words 'w [
sf: bestShuffle w
print [w "->" sf "| count:" count w sf]
]</syntaxhighlight>
 
{{out}}
 
<pre>abracadabra -> caabararadb | count: 0
seesaw -> esawse | count: 0
grrrrrr -> rgrrrrr | count: 5
pop -> opp | count: 1
up -> pu | count: 0
a -> a | count: 1
antidisestablishmentarianism -> mesansrntbiissmtailihdaneait | count: 0</pre>
=={{header|AutoHotkey}}==
<langsyntaxhighlight AutoHotkeylang="autohotkey">words := "abracadabra,seesaw,elk,grrrrrr,up,a"
Loop Parse, Words,`,
out .= Score(A_LoopField, Shuffle(A_LoopField))
Line 147 ⟶ 769:
r++
return a ", " b ", (" r ")`n"
}</langsyntaxhighlight>
Output:
<pre>abracadabra, caadarrbaab, (0)
Line 156 ⟶ 778:
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.
 
<langsyntaxhighlight lang="awk">{
scram = best_shuffle($0)
print $0 " -> " scram " (" unchanged($0, scram) ")"
Line 200 ⟶ 821:
}
return count
}</langsyntaxhighlight>
 
This program has the same output as the Icon and Unicon program.
Line 215 ⟶ 836:
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.
 
<langsyntaxhighlight lang="awk"># out["string"] = best shuffle of string _s_
# out["score"] = number of matching characters
function best_shuffle(out, s, c, i, j, k, klen, p, pos, set, rlen, slen) {
Line 293 ⟶ 914:
words[i], result["string"], result["score"]
}
}</langsyntaxhighlight>
 
Output:
 
<langsyntaxhighlight lang="bash">$ awk -f best-shuffle.awk
abracadabra, baarrcadaab, (0)
seesaw, essewa, (0)
Line 303 ⟶ 924:
grrrrrr, rgrrrrr, (5)
up, pu, (0)
a, a, (1)</langsyntaxhighlight>
 
The output might change if the <tt>for (c in set)</tt> loop iterates the array in a different order.
 
=={{header|BaConBASIC}}==
==={{header|BaCon}}===
<lang bacon>DECLARE case$[] = { "tree", "abracadabra", "seesaw", "elk", "grrrrrr", "up", "a" }
<syntaxhighlight lang="bacon">DECLARE case$[] = { "tree", "abracadabra", "seesaw", "elk", "grrrrrr", "up", "a" }
 
FOR z = 0 TO UBOUND(case$)-1
Line 325 ⟶ 947:
 
PRINT MERGE$(result$), ":", total
NEXT</langsyntaxhighlight>
{{output}}
<pre>
Line 337 ⟶ 959:
</pre>
 
==={{header|BBC BASIC}}===
{{works with|BBC BASIC for Windows}}
<langsyntaxhighlight lang="bbcbasic"> a$ = "abracadabra" : b$ = FNshuffle(a$) : PRINT a$ " -> " b$ FNsame(a$,b$)
a$ = "seesaw" : b$ = FNshuffle(a$) : PRINT a$ " -> " b$ FNsame(a$,b$)
a$ = "elk" : b$ = FNshuffle(a$) : PRINT a$ " -> " b$ FNsame(a$,b$)
Line 368 ⟶ 990:
IF MID$(s$,i%,1)=MID$(t$,i%,1) n% += 1
NEXT
= " (" + STR$(n%) + ")"</langsyntaxhighlight>
Output{{out}} (variesVaries between runs):.
<pre>
abracadabra -> daaracababr (0)
Line 378 ⟶ 1,000:
a -> a (1)
</pre>
 
=={{header|Bracmat}}==
Not optimized:
<langsyntaxhighlight lang="bracmat">
( shuffle
= m car cdr todo a z count string
Line 410 ⟶ 1,031:
)
& Done
</syntaxhighlight>
</lang>
 
Optimized (~100 x faster):
<langsyntaxhighlight lang="bracmat">
( shuffle
= m car cdr todo a z count M string tried
Line 448 ⟶ 1,069:
)
& Done
</syntaxhighlight>
</lang>
Output:
<pre>
Line 459 ⟶ 1,080:
{!} Done
</pre>
 
=={{header|C}}==
 
Line 466 ⟶ 1,086:
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.
 
<langsyntaxhighlight lang="c">#include <stdlib.h>
#include <stdio.h>
#include <string.h>
Line 576 ⟶ 1,196:
 
return EXIT_SUCCESS;
}</langsyntaxhighlight>
Output:
<pre>abracadabra, brabacadaar, (0)
Line 589 ⟶ 1,209:
 
===Version with random result===
<langsyntaxhighlight Clang="c">#include <stdio.h>
#include <stdlib.h>
#include <string.h>
Line 694 ⟶ 1,314:
do_string("");
return 0;
}</langsyntaxhighlight>Output<syntaxhighlight lang="text">abracadebra -> edbcarabaar, overlap 0
grrrrrr -> rrgrrrr, overlap 5
elk -> kel, overlap 0
seesaw -> ewsesa, overlap 0
-> , overlap 0</langsyntaxhighlight>
 
===Deterministic method===
<langsyntaxhighlight lang="c">#include <stdio.h>
#include <string.h>
 
Line 736 ⟶ 1,356:
}
return 0;
}</langsyntaxhighlight>
 
=={{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.:
<langsyntaxhighlight lang="csharp">ShuffledString[] array = {"cat", "dog", "mouse"};</langsyntaxhighlight>
Which will immediately shuffle each word.
 
A sequential solution, which always produces the same output for the same input.
<langsyntaxhighlight lang="csharp">
using System;
using System.Text;
Line 870 ⟶ 1,489:
}
}
</syntaxhighlight>
</lang>
 
And a randomized solution, which will produce a more or less different result on every run:
<langsyntaxhighlight lang="csharp">
using System;
using System.Text;
Line 999 ⟶ 1,618:
}
}
</syntaxhighlight>
</lang>
 
A sample output for the sequential shuffle:
Line 1,021 ⟶ 1,640:
a, a, (1)
</pre>
 
=={{header|C++}}==
{{works with|C++|11}}
{{trans|Java}}
<langsyntaxhighlight lang="cpp">#include <iostream>
#include <sstream>
#include <algorithm>
Line 1,069 ⟶ 1,687:
cout << bs(basic_string<char>(arguments[i])) << endl;
return 0;
}</langsyntaxhighlight>
{{out}}
<pre>abracadabra
Line 1,083 ⟶ 1,701:
a
a (1)</pre>
 
=={{header|Clojure}}==
Uses same method as J
 
<langsyntaxhighlight Clojurelang="clojure">(defn score [before after]
(->> (map = before after)
(filter true? ,)
Line 1,140 ⟶ 1,757:
["grrrrrr" "rgrrrrr" 5]
["up" "pu" 0]
["a" "a" 1]]</langsyntaxhighlight>
 
=={{header|Common Lisp}}==
<langsyntaxhighlight lang="lisp">(defun count-equal-chars (string1 string2)
(loop for c1 across string1 and c2 across string2
count (char= c1 c2)))
Line 1,165 ⟶ 1,781:
(count-equal-chars string shuffled)))))
 
(best-shuffle '("abracadabra" "seesaw" "elk" "grrrrrr" "up" "a"))</langsyntaxhighlight>
Output:
abracadabra caadrbabaar (0)
Line 1,175 ⟶ 1,791:
 
===Version 2===
<langsyntaxhighlight lang="lisp">(defun all-best-shuffles (str)
(let (tbl out (shortest (length str)) (s str))
 
Line 1,221 ⟶ 1,837:
(dolist (s (list "abracadabra" "seesaw" "elk" "grrrrrr" "up" "a"))
(format t "~A: ~A~%" s (best-shuffle s)))
</syntaxhighlight>
</lang>
 
The output is:
<langsyntaxhighlight lang="lisp">abracadabra: (caardrabaab 0)
seesaw: (ewsase 0)
elk: (kel 0)
Line 1,230 ⟶ 1,846:
up: (pu 0)
a: (a 1)
</syntaxhighlight>
</lang>
=={{header|Crystal}}==
 
== {{header|Crystal}} ==
{{trans|Ruby}}
 
<langsyntaxhighlight lang="ruby">def best_shuffle(s)
# Fill _pos_ with positions in the order
# that we want to fill them.
Line 1,275 ⟶ 1,890:
new, score = best_shuffle(word)
puts "%s, %s, (%d)" % [word, new, score]
end</langsyntaxhighlight>
 
{{out}}
Line 1,286 ⟶ 1,901:
a, a, (1)
</pre>
 
=={{header|D}}==
===Version with random result===
Translation of [[Best_shuffle#Icon_and_Unicon|Icon]] via [[Best_shuffle#AWK|AWK]]
<langsyntaxhighlight lang="d">import std.stdio, std.random, std.algorithm, std.conv, std.range,
std.traits, std.typecons;
 
Line 1,330 ⟶ 1,944:
writefln("%s : %s (%d)", entry, res[]);
}
}</langsyntaxhighlight>
 
===Deterministic approach===
<langsyntaxhighlight lang="d">import std.stdio, std.algorithm, std.range;
 
extern(C) pure nothrow void* alloca(in size_t size);
Line 1,435 ⟶ 2,049:
writefln("%s, %s, (%d)", txt, result, nEqual);
}
}</langsyntaxhighlight>
{{out}}
<pre>abracadabra, brabacadaar, (0)
Line 1,450 ⟶ 2,064:
{{libheader| System.Generics.Collections}}
{{Trans|C#}}
<syntaxhighlight lang="delphi">
<lang Delphi>
program Best_shuffle;
 
Line 1,589 ⟶ 2,203:
Readln;
end.
</syntaxhighlight>
</lang>
=={{header|EasyLang}}==
{{trans|C}} (deterministic)
<syntaxhighlight>
proc best_shuffle s$ . r$ diff .
l = len s$
for c$ in strchars s$
s[] &= strcode c$
.
len cnt[] 128
for i to l
cnt[s[i]] += 1
max = higher max cnt[s[i]]
.
for i to 128
while cnt[i] > 0
cnt[i] -= 1
buf[] &= i
.
.
r[] = s[]
for i to l
for j to l
if r[i] = buf[j]
r[i] = buf[(j + max) mod1 l] mod 128
if buf[j] <= 128
buf[j] += 128
.
break 1
.
.
.
diff = 0
r$ = ""
for i to l
diff += if r[i] = s[i]
r$ &= strchar r[i]
.
.
for s$ in [ "abracadabra" "seesaw" "elk" "grrrrrr" "up" "a" ]
best_shuffle s$ r$ d
print s$ & " " & r$ & " " & d
.
</syntaxhighlight>
{{out}}
<pre>
abracadabra brabacadaar 0
seesaw wssaee 0
elk kel 0
grrrrrr rgrrrrr 5
up pu 0
a a 1
</pre>
 
=={{header|Elena}}==
ELENA 56.0x :
<langsyntaxhighlight Elenalang="elena">import system'routines;
import extensions;
import extensions'text;
Line 1,598 ⟶ 2,265:
extension op
{
get Shuffled()
{
var original := self.toArray();
var shuffled := self.toArray();
for (int i := 0,; i < original.Length,; i += 1) {
for (int j := 0,; j < original.Length,; j += 1) {
if (i != j && original[i] != shuffled[j] && original[j] != shuffled[i])
{
shuffled.exchange(i,j)
}
}
};
^ shuffled.summarize(new StringWriter()).toString()
}
score(originalText)
{
var shuffled := self.toArray();
var original := originalText.toArray();
int score := 0;
 
for (int i := 0,; i < original.Length,; i += 1) {
if (original[i] == shuffled[i]) { score += 1 }
};
^ score
}
}
 
public program()
{
new string[]{"abracadabra", "seesaw", "grrrrrr", "pop", "up", "a"}.forEach::(s)
{
var shuffled_s := s.Shuffled;
 
console.printLine("The best shuffle of ",s," is ",shuffled_s,"(",shuffled_s.score(s),")")
};
 
console.readChar()
}</langsyntaxhighlight>
{{out}}
<pre>
Line 1,652 ⟶ 2,319:
=={{header|Erlang}}==
Deterministic version.
<syntaxhighlight lang="erlang">
<lang Erlang>
-module( best_shuffle ).
 
Line 1,691 ⟶ 2,358:
{_First_reversed_original, [Character_acc | First_part_acc]} = lists:unzip( First_reversed_zip ),
[Character_acc | Last_part_acc] ++ [Last_character_acc | First_part_acc].
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 1,701 ⟶ 2,368:
"up" "pu" 0
"a" "a" 1
</pre>
 
=={{header|FreeBASIC}}==
{{trans|Liberty BASIC}}
<syntaxhighlight lang="freebasic">
Dim As String*11 lista(6) => {"abracadabra","seesaw","pop","grrrrrr","up","a"}
 
Function bestShuffle(s1 As String) As String
Dim As String s2 = s1
Dim As Integer i, j, i1, j1
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
 
Dim As String palabra, bs
Dim As Integer puntos
For b As Integer = 0 To Ubound(lista)-1
palabra = lista(b)
bs = bestShuffle(palabra)
puntos = 0
For i As Integer = 1 To Len(palabra)
If Mid(palabra,i,1) = Mid(bs,i,1) Then puntos += 1
Next i
Print palabra; " ==> "; bs; " (puntuaci¢n:"; puntos; ")"
Next b
Sleep
</syntaxhighlight>
{{out}}
<pre>
abracadabra ==> caadrbabaar (puntuación: 0)
seesaw ==> ewaess (puntuación: 0)
pop ==> opp (puntuación: 1)
grrrrrr ==> rgrrrrr (puntuación: 5)
up ==> pu (puntuación: 0)
a ==> a (puntuación: 1)
</pre>
=={{header|FutureBasic}}==
<syntaxhighlight lang="futurebasic">
include "Tlbx GameplayKit.incl"
include "NSLog.incl"
 
local fn ShuffleString( string as CFStringRef ) as CFStringRef
NSInteger i
CFMutableArrayRef mutArr = fn MutableArrayWithCapacity( 0 )
for i = 0 to fn StringLength( string ) - 1
MutableArrayAddObject( mutArr, fn StringSubstringWithRange( string, fn CFRangeMake( i, 1 ) ) )
next
CFArrayRef shuffledArr = fn GKRandomSourceArrayByShufflingObjectsInArray( fn GKRandomSourceInit, mutArr )
end fn = fn ArrayComponentsJoinedByString( shuffledArr, @"" )
 
 
local fn StringDifferences( string1 as CFStringRef, string2 as CFStringRef ) as NSInteger
NSInteger i, unchangedPosition = 0
if fn StringLength( string1 ) != fn StringLength( string2 ) then NSLog( @"Strings must be of equal length." ) : exit fn
for i = 0 to fn StringLength( string1 ) -1
CFStringRef tempStr1 = fn StringSubstringWithRange( string1, fn CFRangeMake( i, 1 ) )
CFStringRef tempStr2 = fn StringSubstringWithRange( string2, fn CFRangeMake( i, 1 ) )
if fn StringIsEqual( tempStr1, tempStr2 ) == YES then unchangedPosition++
next
end fn = unchangedPosition
 
NSInteger i, j, count
CFArrayRef stringArr
CFStringRef originalStr, shuffledStr
 
stringArr = @[@"abracadabra", @"seesaw", @"elk", @"grrrrrr", @"up", @"a"]
count = fn ArrayCount( stringArr )
 
for i = 0 to 3
for j = 0 to count - 1
originalStr = stringArr[j]
shuffledStr = fn ShuffleString( stringArr[j] )
NSLog( @"%@, %@, (%ld)", originalStr, shuffledStr, fn StringDifferences( originalStr, shuffledStr ) )
next
NSLog( @"\n" )
next
 
HandleEvents
</syntaxhighlight>
Output with four shuffles:
<pre>
abracadabra, caaarrdabab, (4)
seesaw, eeswsa, (1)
elk, kle, (1)
grrrrrr, grrrrrr, (7)
up, pu, (0)
a, a, (1)
 
abracadabra, bcarradabaa, (5)
seesaw, sewsea, (3)
elk, ekl, (1)
grrrrrr, rgrrrrr, (5)
up, up, (2)
a, a, (1)
 
abracadabra, rababcdraaa, (3)
seesaw, seewsa, (3)
elk, ekl, (1)
grrrrrr, rrrrgrr, (5)
up, up, (2)
a, a, (1)
 
abracadabra, aababrrdcaa, (3)
seesaw, eeassw, (3)
elk, kel, (0)
grrrrrr, rrrrrgr, (5)
up, pu, (0)
a, a, (1)
</pre>
 
=={{header|Go}}==
{{trans|Icon and Unicon}}
<langsyntaxhighlight lang="go">package main
 
import (
Line 1,741 ⟶ 2,526:
fmt.Printf("%s -> %s (%d)\n", s, string(t), count)
}
}</langsyntaxhighlight>
{{out|Output of two runs}}
<pre>
Line 1,759 ⟶ 2,544:
a -> a (1)
</pre>
 
=={{header|Groovy}}==
<langsyntaxhighlight lang="groovy">def shuffle(text) {
def shuffled = (text as List)
for (sourceIndex in 0..<text.size()) {
Line 1,789 ⟶ 2,573:
def result = shuffle(text)
println "${result.original}, ${result.shuffled}, (${result.score})"
}</langsyntaxhighlight>
Output:
<pre>
Line 1,799 ⟶ 2,583:
a, a, (1)
</pre>
 
=={{header|Haskell}}==
 
We demonstrate several approaches here. In order to test the program we define a testing suite:
 
<langsyntaxhighlight Haskelllang="haskell">shufflingQuality l1 l2 = length $ filter id $ zipWith (==) l1 l2
 
printTest prog = mapM_ test texts
Line 1,815 ⟶ 2,598:
texts = [ "abba", "abracadabra", "seesaw", "elk" , "grrrrrr"
, "up", "a", "aaaaa.....bbbbb"
, "Rosetta Code is a programming chrestomathy site." ]</langsyntaxhighlight>
 
=== Deterministic List-based solution ===
Line 1,821 ⟶ 2,604:
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).
 
<langsyntaxhighlight Haskelllang="haskell">import Data.Vector ((//), (!))
import qualified Data.Vector as V
import Data.List (delete, find)
Line 1,840 ⟶ 2,623:
 
shuffle :: Eq a => [a] -> [a]
shuffle lst = swapShuffle lst lst</langsyntaxhighlight>
 
{{Out}}
Line 1,856 ⟶ 2,639:
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.
 
<langsyntaxhighlight Haskelllang="haskell">perfectShuffle :: [a] -> [a]
perfectShuffle [] = []
perfectShuffle lst | odd n = b : shuffle (zip bs a)
Line 1,866 ⟶ 2,649:
shuffleP :: Eq a => [a] -> [a]
shuffleP lst = swapShuffle lst $ perfectShuffle lst</langsyntaxhighlight>
 
{{Out}}
Line 1,888 ⟶ 2,671:
Additional import:
 
<syntaxhighlight lang Haskell="haskell">import Control.Monad.Random (getRandomR)</langsyntaxhighlight>
 
<langsyntaxhighlight Haskelllang="haskell">randomShuffle :: [a] -> IO [a]
randomShuffle [] = return []
randomShuffle lst = do
Line 1,899 ⟶ 2,682:
shuffleR :: Eq a => [a] -> IO [a]
shuffleR lst = swapShuffle lst <$> randomShuffle lst</langsyntaxhighlight>
 
{{Out}}
Line 1,919 ⟶ 2,702:
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.
 
<langsyntaxhighlight Haskelllang="haskell">{-# LANGUAGE TupleSections, LambdaCase #-}
import Conduit
import Control.Monad.Random (getRandomR)
Line 1,943 ⟶ 2,726:
 
shuffleW :: Eq a => Int -> [a] -> IO [a]
shuffleW k lst = yieldMany lst =$= shuffleC k $$ sinkList</langsyntaxhighlight>
 
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.
Line 1,965 ⟶ 2,748:
Additional imports
 
<langsyntaxhighlight Haskelllang="haskell">import Data.ByteString.Builder (charUtf8)
import Data.ByteString.Char8 (ByteString, unpack, pack)
import Data.Conduit.ByteString.Builder (builderToByteString)
import System.IO (stdin, stdout)</langsyntaxhighlight>
 
<syntaxhighlight lang="haskell">
<lang Haskell>
shuffleBS :: Int -> ByteString -> IO ByteString
shuffleBS n s =
Line 1,983 ⟶ 2,766:
sourceHandle stdin
=$ mapMC (shuffleBS 10)
$$ sinkHandle stdout</langsyntaxhighlight>
 
{{Out}}
Line 1,995 ⟶ 2,778:
$ cat input.txt | ./shuffle
aeotdR s aoiCtrpmmgi crn theemaysg srioT the tseo.dih psae re isltn ountstoeo tosmaetia es nssimhn ad kaeeinrlataffauytse g oanbs ,e ol e sio ttngdasmw esphut ro ganeemas g alsi arlaeefn,ranifddoii a drnp det r toi ahowgnutan n rgneanppi raohi d oaop blrcst imeioaer ngohrla.eRotn Cst n dce aenletya th8r3 n2ssout1 3dasktaft,rrk9as,a ss iewarf6 d2l ogu asga te g un oa hn4d enaodho(ctt)n, eha laovnsotusw oeinyetsakvn eo ienlrav ygtnu aer. g</pre>
 
=={{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
<langsyntaxhighlight lang="icon"># every !t :=: ?t # Uncomment to get a random best shuffling</langsyntaxhighlight> in <tt>bestShuffle</tt>.
<langsyntaxhighlight lang="icon">procedure main(args)
while scram := bestShuffle(line := read()) do
write(line," -> ",scram," (",unchanged(line,scram),")")
Line 2,018 ⟶ 2,800:
every (count := 0) +:= (s1[i := 1 to *s1] == s2[i], 1)
return count
end</langsyntaxhighlight>
 
The code works in both Icon and Unicon.
Line 2,034 ⟶ 2,816:
->
</pre>
 
=={{header|J}}==
 
Based on [http://rosettacode.org/mw/index.php?title=Best_shuffle&oldid=97419#J Dan Bron's approach]:
 
<langsyntaxhighlight lang="j">bestShuf =: verb define
yy=. <@({~ ?~@#)@I.@= y
y C.~ (;yy) </.~ (i.#y) |~ >./#@> yy
Line 2,048 ⟶ 2,829:
y,', ',b,' (',')',~":+/b=y
)
</syntaxhighlight>
</lang>
 
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).
Line 2,054 ⟶ 2,835:
Example:
 
<langsyntaxhighlight lang="j"> fmtBest&>;:'abracadabra seesaw elk grrrrrr up a'
abracadabra, bdacararaab (0)
seesaw, eawess (0)
Line 2,060 ⟶ 2,841:
grrrrrr, rrrrrrg (5)
up, pu (0)
a, a (1)</langsyntaxhighlight>
 
=={{header|Java}}==
Translation of [[Best_shuffle#Icon_and_Unicon|Icon]] via [[Best_shuffle#AWK|AWK]]
<langsyntaxhighlight lang="java">import java.util.Random;
 
public class BestShuffle {
Line 2,109 ⟶ 2,889:
return count;
}
}</langsyntaxhighlight>
 
Output:
Line 2,118 ⟶ 2,898:
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):
 
<langsyntaxhighlight lang="javascript">function raze(a) { // like .join('') except producing an array instead of a string
var r= [];
for (var j= 0; j<a.length; j++)
Line 2,169 ⟶ 2,948:
n+= ex.substr(j, 1) == r.substr(j,1) ?1 :0;
return ex+', '+r+', ('+n+')';
}</langsyntaxhighlight>
 
Example:
 
<langsyntaxhighlight lang="html"><html><head><title></title></head><body><pre id="out"></pre></body></html>
<script type="text/javascript">
/* ABOVE CODE GOES HERE */
Line 2,179 ⟶ 2,958:
for (var i= 0; i<sample.length; i++)
document.getElementById('out').innerHTML+= disp(sample[i])+'\r\n';
</script></langsyntaxhighlight>
 
Produced:
Line 2,188 ⟶ 2,967:
up, pu, (0)
a, a, (1)</pre>
 
=={{header|jq}}==
{{works with|jq|1.5}}
The implementation in this section uses the deterministic "swap" algorithm found in other entries on this page.
 
<langsyntaxhighlight lang="jq">def count(s): reduce s as $i (0;.+1);
 
def swap($i;$j):
Line 2,226 ⟶ 3,004:
| . as $s
| bestShuffleArray
| "\($in), \(implode), (\( length - score($s) ))" ;</langsyntaxhighlight>
 
'''Examples:'''
<langsyntaxhighlight lang="jq">"abracadabra", "seesaw", "elk", "grrrrrr", "up", "a", "antidisestablishmentarianism"
| bestShuffle</langsyntaxhighlight>
 
'''Invocation and Output'''
Line 2,241 ⟶ 3,019:
a, a, (1)
antidisestablishmentarianism, maaaadisesitblishmenttrninis, (0)</pre>
 
=={{header|Julia}}==
{{trans|Python}}
<langsyntaxhighlight lang="julia"># v0.6
 
function bestshuffle(str::String)::Tuple{String,Int}
Line 2,295 ⟶ 3,072:
shuffled, score = bestshuffle(word)
println("$word: $shuffled ($score)")
end</langsyntaxhighlight>
 
{{out}}
Line 2,304 ⟶ 3,081:
up: pu (0)
a: a (1)</pre>
 
=={{header|Kotlin}}==
{{trans|Java}}
<langsyntaxhighlight lang="scala">import java.util.Random
 
object BestShuffle {
Line 2,343 ⟶ 3,119:
}
 
fun main(words: Array<String>) = words.forEach { println(BestShuffle(it)) }</langsyntaxhighlight>
 
{{out}}
Line 2,352 ⟶ 3,128:
up pu (0)
a a (1)</pre>
 
=={{header|Liberty BASIC}}==
<langsyntaxhighlight lang="lb">'see Run BASIC solution
list$ = "abracadabra seesaw pop grrrrrr up a"
 
Line 2,379 ⟶ 3,154:
next i
bestShuffle$ = s2$
end function</langsyntaxhighlight>
output
<pre>
Line 2,388 ⟶ 3,163:
up pu 0
a a 1</pre>
 
 
=={{header|Lua}}==
<langsyntaxhighlight lang="lua">math.randomseed(os.time())
 
local function shuffle(t)
Line 2,431 ⟶ 3,204:
 
test(true)
test(false)</langsyntaxhighlight>
{{out}}
<pre>RANDOM:
Line 2,448 ⟶ 3,221:
up, pu, (0)
a, a, (1)</pre>
 
=={{header|Mathematica}} / {{header|Wolfram Language}}==
<langsyntaxhighlight Mathematicalang="mathematica">BestShuffle[data_] :=
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"}
</syntaxhighlight>
</lang>
 
Output :
Line 2,464 ⟶ 3,236:
up, pu,(0)
a, a,(1)</pre>
 
=={{header|Nim}}==
{{trans|Java}}
<langsyntaxhighlight Nimlang="nim">import times
import sequtils
import strutils
Line 2,501 ⟶ 3,272:
let shuffled = bestShuffle(w)
echo "$1 $2 $3" % [w, shuffled, $count(w, shuffled)]
</syntaxhighlight>
</lang>
 
Run:
Line 2,512 ⟶ 3,283:
a a 1
antidisestablishmentarianism mietnshieistrlaatbsdsnaiinma 0</pre>
 
=={{header|OCaml}}==
 
Deterministic
 
<langsyntaxhighlight lang="ocaml">let best_shuffle s =
let len = String.length s in
let r = String.copy s in
Line 2,553 ⟶ 3,323:
test "up";
test "a";
;;</langsyntaxhighlight>
 
Run:
Line 2,565 ⟶ 3,335:
'up', 'pu' -> 0
'a', 'a' -> 1</pre>
 
=={{header|Pascal}}==
{{works with|Free_Pascal}}
<langsyntaxhighlight lang="pascal">program BestShuffleDemo(output);
function BestShuffle(s: string): string;
Line 2,607 ⟶ 3,376:
writeln(original[i], ', ', shuffle, ', (', score, ')');
end;
end.</langsyntaxhighlight>
Output:
<pre>% ./BestShuffle
Line 2,616 ⟶ 3,385:
up, pu, (0)
a, a, (1)</pre>
=={{header|Pascal}}==
==={{header|Free Pascal}}===
<syntaxhighlight lang="pascal">
Program BestShuffle;
 
Const
arr : array[1..6] Of string = ('abracadabra','seesaw','elk','grrrrrr','up','a');
 
Function Shuffle(inp: String): STRING;
 
Var x,ReplacementDigit : longint;
ch : char;
Begin
If length(inp) > 1 Then
Begin
Randomize;
For x := 1 To length(inp) Do
Begin
Repeat
ReplacementDigit := random(length(inp))+1;
Until (ReplacementDigit <> x);
ch := inp[x];
inp[x] := inp[ReplacementDigit];
inp[ReplacementDigit] := ch;
End;
End;
shuffle := inp;
End;
 
 
Function score(OrgString,ShuString : String) : integer;
 
Var i : integer;
Begin
score := 0;
For i := 1 To length(OrgString) Do
If OrgString[i] = ShuString[i] Then inc(score);
End;
 
Var i : integer;
shuffled : string;
Begin
For i := low(arr) To high(arr) Do
Begin
shuffled := shuffle(arr[i]);
writeln(arr[i],' , ',shuffled,' , (',score(arr[i],shuffled),')');
End;
End.
</syntaxhighlight>
{{out}}
<pre>
abracadabra , baraadacbar , (3)
seesaw , esaews , (0)
elk , ekl , (1)
grrrrrr , rrgrrrr , (5)
up , up , (2)
a , a , (1)
</pre>
 
=={{header|Perl}}==
The Algorithm::Permute module does not ship with perl, but is freely available from CPAN.
 
<langsyntaxhighlight lang="perl">use strict;
use warnings;
use feature 'bitwise';
use List::Util qw(shuffle);
use Algorithm::Permute;
Line 2,640 ⟶ 3,468:
# there will be a \x00 in the "^" of the two words.
# The tr operator is then used to count the "\x00"s.
my $score = ($original_word ^. $word) =~ tr/\x00//;
next if $score >= $best_score;
($best_word, $best_score) = ($word, $score);
Line 2,649 ⟶ 3,477:
}
 
</syntaxhighlight>
</lang>
{{out|Output of two runs}}
<pre>abracadabra, dabrabacaar, 0
Line 2,675 ⟶ 3,503:
swaps which will improve the score.
 
{{trans|goGo}}
<langsyntaxhighlight lang="perl">use strict;
use warnings;
use feature 'bitwise';
use List::Util qw(shuffle);
 
Line 2,700 ⟶ 3,529:
my $word = join '', @t;
 
my $score = ($original_word ^. $word) =~ tr/\x00//;
print "$original_word, $word, $score\n";
}
</syntaxhighlight>
</lang>
 
The output has the same format as the first perl implementation,
Line 2,709 ⟶ 3,538:
 
=={{header|Phix}}==
<!--<syntaxhighlight lang="phix">(phixonline)-->
<lang Phix>constant tests = {"abracadabra", "seesaw", "elk", "grrrrrr", "up", "a"}
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
string s,t
<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>
for test=1 to length(tests) do
<span style="color: #008080;">for</span> <span style="color: #000000;">test</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tests</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
s = tests[test]
<span style="color: #004080;">string</span> <span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">tests</span><span style="color: #0000FF;">[</span><span style="color: #000000;">test</span><span style="color: #0000FF;">],</span>
t = shuffle(s)
<span style="color: #000000;">t</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">shuffle</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
for i=1 to length(t) do
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
for j=1 to length(t) do
<span style="color: #008080;">for</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
if i!=j and t[i]!=s[j] and t[j]!=s[i] then
<span style="color: #004080;">integer</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">ti</span><span style="color: #0000FF;">,</span><span style="color: #000000;">tj</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">],</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]}</span>
{t[i], t[j]} = {t[j], t[i]}
<span style="color: #008080;">if</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">j</span> <span style="color: #008080;">and</span> <span style="color: #000000;">ti</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">and</span> <span style="color: #000000;">tj</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">then</span>
exit
<span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">tj</span>
end if
<span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">ti</span>
end for
<span style="color: #008080;">exit</span>
end for
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
printf(1,"%s -> %s (%d)\n",{s,t,sum(sq_eq(t,s))})
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
end for</lang>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</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>
<!--</syntaxhighlight>-->
{{out}}
<pre>
Line 2,742 ⟶ 3,575:
a -> a (1)
</pre>
 
=={{header|PHP}}==
Translation of [[Best_shuffle#Icon_and_Unicon|Icon]] via [[Best_shuffle#AWK|AWK]]
<langsyntaxhighlight lang="php">foreach (split(' ', 'abracadabra seesaw pop grrrrrr up a') as $w)
echo bestShuffle($w) . '<br>';
 
Line 2,769 ⟶ 3,601:
$cnt++;
return "($cnt)";
}</langsyntaxhighlight>
 
Output:
Line 2,778 ⟶ 3,610:
up pu (0)
a a (1)</pre>
=={{header|Picat}}==
Using a CP (Constraint Programming) solver guarantees an optimal solution. This is deterministic since the solve heuristic ("split") always give the same first result.
 
<syntaxhighlight lang="picat">import cp.
 
go =>
Words = ["abracadabra",
"seesaw",
"elk",
"grrrrrr",
"up",
"a",
"shuffle",
"aaaaaaa"
],
foreach(Word in Words)
best_shuffle(Word,Best,_Score),
printf("%s, %s, (%d)\n", Word,Best,diff_word(Word, Best))
end,
nl.
 
best_shuffle(Word,Best,Score) =>
WordAlpha = Word.map(ord), % convert to integers
WordAlphaNoDups = WordAlpha.remove_dups(),
% occurrences of each character in the word
Occurrences = occurrences(WordAlpha),
Len = Word.length,
% Decision variables
WordC = new_list(Len),
WordC :: WordAlphaNoDups,
 
%
% The constraints
%
% Ensure that the shuffled word has the same
% occurrences for each character
foreach(V in WordAlphaNoDups)
count(V, WordC,#=, Occurrences.get(V))
end,
% The score is the number of characters
% in the same position as the origin word
% (to be minimized).
Score #= sum([WordC[I] #= WordAlpha[I] : I in 1..Len]),
 
if var(Score) then
% We don't have a score yet: minimize Score
solve([$min(Score),split], WordC)
else
% Get a solution for the given Score
solve([split], WordC)
end,
% convert back to alpha
Best = WordC.map(chr).
 
 
diff_word(W1,W2) = Diff =>
Diff = sum([1 : I in 1..W1.length, W1[I]==W2[I]]).
 
occurrences(L) = Occ =>
Occ = new_map(),
foreach(E in L)
Occ.put(E, Occ.get(E,0) + 1)
end.</syntaxhighlight>
 
{{out}}
<pre>abracadabra, baabacadrar, (0)
seesaw, assewe, (0)
elk, kel, (0)
grrrrrr, rgrrrrr, (5)
up, pu, (0)
a, a, (1)
shuffle, effhlsu, (0)
aaaaaaa, aaaaaaa, (7)</pre>
 
===All optimal solutions===
Using a constraint solver makes it quite easy to generate all optimal solutions.
<syntaxhighlight lang="picat">go2 ?=>
Words = ["abracadabra",
"seesaw",
"elk",
"grrrrrr",
"up",
"a",
"shuffle",
"aaaaaaa"
],
member(Word,Words),
println(word=Word),
best_shuffle(Word,_Best,Score),
println(best_score=Score),
% Find all optimal solutions
All = findall(Best2,best_shuffle(Word,Best2,Score)),
Len = All.len,
println(num_solutions=All.len),
if Len <= 10 then
println(solutions=All)
else
println("Only showing the first 10 solutions:"),
println(solutions=All[1..10])
end,
nl,
fail,
nl.
go2 => true.</syntaxhighlight>
 
{{out}}
<pre>word = abracadabra
best_score = 0
num_solutions = 780
Only showing the first 10 solutions:
solutions = [baabacadrar,baabacaradr,baabacardar,baabacarrad,baabacrdaar,baabacrraad,baabadacrar,baabadaracr,baabadarcar,baabadarrac]
 
word = seesaw
best_score = 0
num_solutions = 29
Only showing the first 10 solutions:
solutions = [assewe,asswee,aswees,aswese,awsees,awsese,easews,easwes,easwse,eawess]
 
word = elk
best_score = 0
num_solutions = 2
solutions = [kel,lke]
 
word = grrrrrr
best_score = 5
num_solutions = 6
solutions = [rgrrrrr,rrgrrrr,rrrgrrr,rrrrgrr,rrrrrgr,rrrrrrg]
 
word = up
best_score = 0
num_solutions = 1
solutions = [pu]
 
word = a
best_score = 1
num_solutions = 1
solutions = [a]
 
word = shuffle
best_score = 0
num_solutions = 640
Only showing the first 10 solutions:
solutions = [effhlsu,effhlus,effhsul,effhusl,efflhsu,efflhus,efflshu,efflsuh,effluhs,efflush]
 
word = aaaaaaa
best_score = 7
num_solutions = 1
solutions = [aaaaaaa]</pre>
=={{header|PicoLisp}}==
<langsyntaxhighlight PicoLisplang="picolisp">(de bestShuffle (Str)
(let Lst NIL
(for C (setq Str (chop Str))
Line 2,793 ⟶ 3,776:
(setq Lst (delete @ Lst)) ) )
Str )
(prinl Str " " Res " (" (cnt = Str Res) ")") ) ) )</langsyntaxhighlight>
Output:
<pre>: (bestShuffle "abracadabra")
Line 2,812 ⟶ 3,795:
: (bestShuffle "a")
a a (1)</pre>
 
=={{header|PL/I}}==
<langsyntaxhighlight lang="pli">shuffle: procedure options (main); /* 14/1/2011 */
declare (s, saves) character (20) varying, c character (1);
declare t(length(s)) bit (1);
Line 2,866 ⟶ 3,848:
end search;
 
end shuffle;</langsyntaxhighlight>
 
OUTPUT:
Line 2,882 ⟶ 3,864:
A 1
</pre>
 
=={{header|PowerShell}}==
{{works with|PowerShell|3}}
<langsyntaxhighlight PowerShelllang="powershell"># Calculate best possible shuffle score for a given string
# (Split out into separate function so we can use it separately in our output)
function Get-BestScore ( [string]$String )
Line 2,936 ⟶ 3,917:
$Shuffle = ( [string[]]$S2 -join '' )
return $Shuffle
}</langsyntaxhighlight>
<langsyntaxhighlight PowerShelllang="powershell">ForEach ( $String in ( 'abracadabra', 'seesaw', 'elk', 'grrrrrr', 'up', 'a' ) )
{
$Shuffle = Get-BestShuffle $String
$Score = Get-BestScore $String
"$String, $Shuffle, ($Score)"
}</langsyntaxhighlight>
{{out}}
<pre>abracadabra, craradabaab, (0)
Line 2,950 ⟶ 3,931:
up, pu, (0)
a, a, (1)</pre>
 
=={{header|Prolog}}==
Works with SWI-Prolog
<langsyntaxhighlight Prologlang="prolog">:- dynamic score/2.
 
best_shuffle :-
Line 3,027 ⟶ 4,007:
run(Var,[Other|RRest], [1,Var],[Other|RRest]):-
dif(Var,Other).
</syntaxhighlight>
</lang>
 
output : <pre> ?- test.
Line 3,041 ⟶ 4,021:
===Version with random result===
====solution====
<syntaxhighlight lang="prolog">
<lang Prolog>
:- system:set_prolog_flag(double_quotes,codes) .
 
Line 3,127 ⟶ 4,107:
.
 
</syntaxhighlight>
</lang>
 
====output====
Line 3,162 ⟶ 4,142:
*/
</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.
<langsyntaxhighlight PureBasiclang="purebasic">Structure charInfo
Char.s
List Position.i()
Line 3,274 ⟶ 4,253:
Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
CloseConsole()
EndIf</langsyntaxhighlight>
Sample output:
<pre>abracadabra, daabarbraac, (0)
Line 3,282 ⟶ 4,261:
up, pu, (0)
a, a, (1)</pre>
 
=={{header|Python}}==
===Swap if it is locally better algorithm===
With added randomization of swaps!
<langsyntaxhighlight lang="python">import random
 
def count(w1,wnew):
Line 3,313 ⟶ 4,291:
for w in test_words:
wnew, c = best_shuffle(w)
print("%29s, %-29s ,(%i)" % (w, wnew, c))</langsyntaxhighlight>
 
;Sample output
Line 3,349 ⟶ 4,327:
===Alternative algorithm #1===
 
<langsyntaxhighlight lang="python">#!/usr/bin/env python
 
def best_shuffle(s):
Line 3,398 ⟶ 4,376:
for s in "abracadabra", "seesaw", "elk", "grrrrrr", "up", "a":
shuffled, score = best_shuffle(s)
print("%s, %s, (%d)" % (s, shuffled, score))</langsyntaxhighlight>
 
Output: <pre>abracadabra, raabarabacd, (0)
Line 3,406 ⟶ 4,384:
up, pu, (0)
a, a, (1)</pre>
 
=={{header|Racket}}==
<syntaxhighlight lang="racket">
<lang Racket>
#lang racket
 
Line 3,429 ⟶ 4,406:
(define sh (best-shuffle s))
(printf " ~a, ~a, (~a)\n" s sh (count-same s sh)))
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 3,439 ⟶ 4,416:
a, a, (1)
</pre>
 
=={{header|Raku}}==
(formerly Perl 6)
{{trans|Sidef}}
{{works with|Rakudo Star|2015.12}}
 
<lang perl6>sub best-shuffle(Str $orig) {
 
<syntaxhighlight lang="raku" line>sub best-shuffle(Str $orig) {
my @s = $orig.comb;
my @t = @s.pick(*);
 
for flat ^@s X ^@s -> $\i,\j {
forif i != j and @t[i] ne ^@s[j] ->and $@t[j] ne @s[i] {
if $i != $j and @t[$i] ne @s[$,j] and= @t[$j,i] ne @s[$i]and {last
@t[$i, $j] = @t[$j, $i];
last;
}
}
}
Line 3,464 ⟶ 4,435:
}
 
return (@t.join, $count);
}
 
printf "%s, %s, (%d)\n", $_, best-shuffle $_ for <abracadabra seesaw elk grrrrrr up a>;</syntaxhighlight>
for <abracadabra seesaw elk grrrrrr up a>;</lang>
{{out}}
<pre>abracadabra, raacarabadb, (0)
<pre>
abracadabra, raacarabadb, (0)
seesaw, wssaee, (0)
elk, lke, (0)
grrrrrr, rrrgrrr, (5)
up, pu, (0)
a, a, (1)</pre>
</pre>
 
=={{header|Rascal}}==
{{incomplete|Rascal|No output given.}}
<langsyntaxhighlight Rascallang="rascal">import Prelude;
 
public tuple[str, str, int] bestShuffle(str s){
Line 3,493 ⟶ 4,461:
public int countSame(list[int] permutations, list[int] characters){
return (0 | it + 1 | n <- index(characters), permutations[n] == characters[n]);
}</langsyntaxhighlight>
 
=={{header|REXX}}==
<langsyntaxhighlight lang="rexx">/*REXX program determines and displays the best shuffle for any list of words or tokens.*/
parse arg $ /*get some words from the command line.*/
if $='' then $= 'tree abracadabra seesaw elk grrrrrr up a' /*use the defaults?*/
Line 3,525 ⟶ 4,492:
else x= left(x, k-1)substr(x, k+1, 1)a || substr(x,k+2)
end /*k*/
return x</langsyntaxhighlight>
{{out|output|text=&nbsp; (with a freebie thrown in):}}
<pre>
Line 3,536 ⟶ 4,503:
original: a new: a score: 1
</pre>
 
=={{header|Ring}}==
<langsyntaxhighlight lang="ring">
# Project : Best shuffle
 
Line 3,572 ⟶ 4,538:
bestshuffle = s2
return bestshuffle
</syntaxhighlight>
</lang>
Output:
<pre>
Line 3,582 ⟶ 4,548:
a -> a 1
</pre>
=={{header|Ruby}}==
 
== {{header|Ruby}} ==
{{works with|Ruby|1.9}}
{{trans|Raku}}
 
<langsyntaxhighlight lang="ruby">def best_shuffle(s)
# Fill _pos_ with positions in the order
# that we want to fill them.
Line 3,622 ⟶ 4,587:
%w(abracadabra seesaw elk grrrrrr up a).each do |word|
puts "%s, %s, (%d)" % [word, *best_shuffle(word)]
end</langsyntaxhighlight>
 
{{out}}
Line 3,633 ⟶ 4,598:
a, a, (1)
</pre>
=={{header|Run BASIC}}==
 
<syntaxhighlight lang="runbasic">list$ = "abracadabra seesaw pop grrrrrr up a"
== {{header|Run BASIC}} ==
<lang runbasic>list$ = "abracadabra seesaw pop grrrrrr up a"
 
while word$(list$,ii + 1," ") <> ""
Line 3,659 ⟶ 4,623:
next i
bestShuffle$ = s2$
end function</langsyntaxhighlight>
 
Output:
Line 3,669 ⟶ 4,633:
up pu 0
a a 1</pre>
=={{header|Rust}}==
 
== {{header|Rust}} ==
{{libheader|rand}}
<langsyntaxhighlight lang="rust">extern crate permutohedron;
extern crate rand;
 
Line 3,807 ⟶ 4,770:
w0.iter().zip(w1.iter()).filter(|z| z.0 == z.1).count()
}
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 3,817 ⟶ 4,780:
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.
<langsyntaxhighlight lang="scala">
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)
Line 3,855 ⟶ 4,817:
 
}
</syntaxhighlight>
</lang>
The test code:
<langsyntaxhighlight lang="scala">
def main(args: Array[String]): Unit = {
println(bestShuffle("abracadabra"));
Line 3,868 ⟶ 4,830:
BestShuffleSpecification.check
}
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 3,879 ⟶ 4,841:
</pre>
The ScalaCheck code
<langsyntaxhighlight lang="scala">
object BestShuffleSpecification extends Properties("BestShuffle") {
 
Line 3,898 ⟶ 4,860:
 
}
</syntaxhighlight>
</lang>
 
=={{header|Scheme}}==
<langsyntaxhighlight lang="scheme">
(define count
(lambda (str1 str2)
Line 3,967 ⟶ 4,928:
(number->string (count str shuffled)) ")\n"))))
'("abracadabra" "seesaw" "elk" "grrrrrr" "up" "a"))
</syntaxhighlight>
</lang>
 
Output:
Line 3,978 ⟶ 4,939:
a a (1)
</pre>
 
=={{header|Seed7}}==
<langsyntaxhighlight lang="seed7">$ include "seed7_05.s7i";
 
const func string: bestShuffle (in string: stri) is func
Line 4,020 ⟶ 4,980:
writeln(original <& ", " <& shuffled <& ", (" <& score <& ")");
end for;
end func;</langsyntaxhighlight>
 
Output:
Line 4,031 ⟶ 4,991:
a, a, (1)
</pre>
 
=={{header|Sidef}}==
{{trans|Go}}
<langsyntaxhighlight lang="ruby">func best_shuffle(String orig) -> (String, Number) {
 
var s = orig.chars
Line 4,054 ⟶ 5,013:
var (sword, score) = best_shuffle(word)
"%-12s %12s: %d\n".printf(word, sword, score)
}</langsyntaxhighlight>
{{out}}
<pre>abracadabra daabacarrab: 0
Line 4,062 ⟶ 5,021:
up pu: 0
a a: 1</pre>
 
=={{header|SparForte}}==
As a structured script.
<syntaxhighlight lang="ada">#!/usr/local/bin/spar
pragma annotate( summary, "best_shuffle" )
@( description, "Shuffle the characters of a string in such a" )
@( description, "way that as many of the character values are" )
@( description, "in a different position as possible. Print" )
@( description, "the result as follows: original string," )
@( description, "shuffled string, (score). The score gives the" )
@( description, "number of positions whose character value" )
@( description, "did not change." )
@( author, "Ken O. Burtch" )
@( see_also, "http://rosettacode.org/wiki/Best_shuffle" );
pragma license( unrestricted );
 
pragma restriction( no_external_commands );
 
procedure best_shuffle is
 
-- Shuffle the characters in a string. Do not swap identical characters
 
function shuffle( s : string ) return string is
t : string := s;
tmp : character;
begin
for i in 1..strings.length(s) loop
for j in 1..strings.length(s) loop
if i /= j and strings.element( s, i ) /= strings.element( t, j ) and strings.element( s, j ) /= strings.element( t, i ) then
tmp := strings.element( t, i );
t := strings.overwrite( t, i, strings.element( t, j ) & "" );
t := strings.overwrite( t, j, tmp & "" );
end if;
end loop;
end loop;
return t;
end shuffle;
 
stop : boolean := false;
 
begin
 
while not stop loop
declare
original : constant string := get_line;
shuffled : constant string := shuffle( original );
score : natural := 0;
begin
if original = "" then
stop;
end if;
 
-- determine the score for the shuffled string
 
for i in 1..strings.length( original ) loop
if strings.element( original, i ) = strings.element( shuffled, i ) then
score := @+1;
end if;
end loop;
put_line( original & ", " & shuffled & ", (" &
strings.image( score ) & " )" );
 
end;
end loop;
 
end best_shuffle;</syntaxhighlight>
 
=={{header|Tcl}}==
{{tcllib|struct::list}}
<langsyntaxhighlight lang="tcl">package require Tcl 8.5
package require struct::list
 
Line 4,085 ⟶ 5,110:
set best [join $best ""]
return "$str,$best,($score)"
}</langsyntaxhighlight>
Demonstration:
<langsyntaxhighlight lang="tcl">foreach sample {abracadabra seesaw elk grrrrrr up a} {
puts [bestshuffle $sample]
}</langsyntaxhighlight>
Output:
<pre>
Line 4,099 ⟶ 5,124:
a,a,(1)
</pre>
 
=={{header|Ursala}}==
An implementation based on the J solution looks like this.
<langsyntaxhighlight Ursalalang="ursala">#import std
#import nat
 
Line 4,111 ⟶ 5,135:
#show+
 
main = ~&LS <.~&l,@r :/` ,' ('--+ --')'+ ~&h+ %nP+ length@plrEF>^(~&,shuffle)* words</langsyntaxhighlight>
A solution based on exponential search would use this definition of <code>shuffle</code> (cf. Haskell and Tcl).
<langsyntaxhighlight Ursalalang="ursala">shuffle = ~&r+ length@plrEZF$^^D/~& permutations</langsyntaxhighlight>
output:
<pre>abracadabra caarrbabaad (0)
Line 4,121 ⟶ 5,145:
up pu (0)
a a (1)</pre>
 
=={{header|VBA}}==
 
<syntaxhighlight lang="vb">
<lang vb>
Option Explicit
 
Line 4,219 ⟶ 5,242:
NbLettersDiff = C.Count
End Function
</syntaxhighlight>
</lang>
{{out}}
<pre>a ==> a (Score : 1)
Line 4,229 ⟶ 5,252:
qwerty ==> eytwrq (Score : 0)
tttt ==> tttt (Score : 4)</pre>
 
=={{header|VBScript}}==
{{trans|Java}}
<langsyntaxhighlight lang="vb">'Best Shuffle Task
'VBScript Implementation
 
Line 4,283 ⟶ 5,305:
For Each word In word_list
WScript.StdOut.WriteLine word & "," & bestshuffle(word)
Next</langsyntaxhighlight>
 
{{Out}}
Line 4,292 ⟶ 5,314:
up,pu,(0)
a,a,(1)</pre>
=={{header|Wren}}==
{{trans|Kotlin}}
<syntaxhighlight lang="wren">import "random" for Random
 
class BestShuffle {
static shuffle_(ca) {
var rand = Random.new()
var i = ca.count - 1
while (i >= 1) {
var r = rand.int(i + 1)
var tmp = ca[i]
ca[i] = ca[r]
ca[r] = tmp
i = i - 1
}
}
 
static count_(ca, s1) {
var count = 0
for (i in 0...ca.count) if (s1[i] == ca[i]) count = count + 1
return count
}
 
static invoke(s1) {
var s2 = s1.toList
shuffle_(s2)
for (i in 0...s2.count) {
if (s2[i] == s1[i]) {
for (j in 0...s2.count) {
if (s2[i] != s2[j] && s2[i] != s1[j] && s2[j] != s1[i]) {
var tmp = s2[i]
s2[i] = s2[j]
s2[j] = tmp
break
}
}
}
}
return s1 + ", " + s2.join() + ", (" + "%(count_(s2, s1))" + ")"
}
}
 
var words = ["tree", "abracadabra", "seesaw", "elk", "grrrrrr", "up", "a"]
words.each { |w| System.print(BestShuffle.invoke(w)) }</syntaxhighlight>
 
{{out}}
<pre>
tree, eert, (0)
abracadabra, baarabacadr, (0)
seesaw, aswese, (0)
elk, lke, (0)
grrrrrr, rgrrrrr, (5)
up, pu, (0)
a, a, (1)
</pre>
 
=={{header|XPL0}}==
<langsyntaxhighlight XPL0lang="xpl0">include c:\cxpl\codes; \'code' declarations
string 0; \use zero-terminated string convention
 
Line 4,328 ⟶ 5,405:
[S:= ["abracadabra", "seesaw", "elk", "grrrrrr", "up", "a"];
for I:= 0 to 5 do Shuffle(S(I));
]</langsyntaxhighlight>
 
Output:
Line 4,339 ⟶ 5,416:
a, a, (1)
</pre>
 
=={{header|zkl}}==
{{trans|D}}
{{trans|Common Lisp}}
<langsyntaxhighlight lang="zkl">fcn bestShuffle(str){
s:=str.split("").shuffle(); // -->List
if(not s) return(str,str.len()); // can't shuffle "" or "a"
Line 4,357 ⟶ 5,433:
}
return(s.concat(), s.zipWith('==,str).sum(0));
}</langsyntaxhighlight>
<langsyntaxhighlight lang="zkl">ss:=T("abracadabra","immediately","grrrrrr","seesaw","pop","up","a","");
foreach s in (ss){
ns,cnt:=bestShuffle(s);
println("%s --> %s (%d)".fmt(s,ns,cnt));
}</langsyntaxhighlight>
{{out}}
<pre>
Line 4,374 ⟶ 5,450:
--> (0)
</pre>
 
=={{header|ZX Spectrum Basic}}==
{{trans|AWK}}
<langsyntaxhighlight lang="zxbasic">10 FOR n=1 TO 6
20 READ w$
30 GO SUB 1000
Line 4,396 ⟶ 5,471:
1130 RETURN
2000 DATA "abracadabra","seesaw","elk","grrrrrr","up","a"
</syntaxhighlight>
</lang>
{{out}}
<pre>abracadabra caadrbabaar 0
Line 4,404 ⟶ 5,479:
up pu 0
a a 1</pre>
 
{{omit from|bc|No string operations.}}
{{omit from|dc|No string operations.}}
44

edits