Rosetta Code

Best shuffle: Difference between revisions

Page Discussion

Best shuffle (view source)

Revision as of 16:50, 3 April 2024

16,216 bytes added ,  1 month ago
no edit summary
m (Added indents to improve readability)
No edit summary
 
(9 intermediate revisions by 7 users not shown)
Line 75:
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!}}==
Line 229 ⟶ 456:
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}}==
Line 491 ⟶ 927:
 
The output might change if the <tt>for (c in set)</tt> loop iterates the array in a different order.
 
=={{header|BaCon}}==
=={{header|BASIC}}==
==={{header|BaCon}}===
<syntaxhighlight lang="bacon">DECLARE case$[] = { "tree", "abracadabra", "seesaw", "elk", "grrrrrr", "up", "a" }
 
Line 520 ⟶ 958:
a:1
</pre>
 
=={{header|BBC BASIC}}==
==={{header|BBC BASIC}}===
{{works with|BBC BASIC for Windows}}
<syntaxhighlight lang="bbcbasic"> a$ = "abracadabra" : b$ = FNshuffle(a$) : PRINT a$ " -> " b$ FNsame(a$,b$)
Line 552 ⟶ 991:
NEXT
= " (" + STR$(n%) + ")"</syntaxhighlight>
Output{{out}} (variesVaries between runs):.
<pre>
abracadabra -> daaracababr (0)
Line 1,765 ⟶ 2,204:
end.
</syntaxhighlight>
=={{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 :
<syntaxhighlight lang="elena">import system'routines;
import extensions;
Line 1,773 ⟶ 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()
}</syntaxhighlight>
{{out}}
Line 1,824 ⟶ 2,316:
The best shuffle of a is a(1)
</pre>
 
=={{header|Erlang}}==
Deterministic version.
Line 1,876 ⟶ 2,369:
"a" "a" 1
</pre>
=={{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|FreeBASIC}}==
{{trans|Liberty BASIC}}
Line 2,949 ⟶ 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.
Line 2,954 ⟶ 3,449:
<syntaxhighlight lang="perl">use strict;
use warnings;
use feature 'bitwise';
use List::Util qw(shuffle);
use Algorithm::Permute;
Line 2,972 ⟶ 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 3,007 ⟶ 3,503:
swaps which will improve the score.
 
{{trans|goGo}}
<syntaxhighlight lang="perl">use strict;
use warnings;
use feature 'bitwise';
use List::Util qw(shuffle);
 
Line 3,032 ⟶ 3,529:
my $word = join '', @t;
 
my $score = ($original_word ^. $word) =~ tr/\x00//;
print "$original_word, $word, $score\n";
}
Line 3,039 ⟶ 3,536:
The output has the same format as the first perl implementation,
but only takes quadratic time per word.
 
=={{header|Phix}}==
<!--<syntaxhighlight lang="phix">(phixonline)-->
Line 4,523 ⟶ 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}}
Line 4,751 ⟶ 5,316:
=={{header|Wren}}==
{{trans|Kotlin}}
<syntaxhighlight lang="ecmascriptwren">import "random" for Random
 
class BestShuffle {
Line 4,804 ⟶ 5,369:
a, a, (1)
</pre>
 
=={{header|XPL0}}==
<syntaxhighlight lang="xpl0">include c:\cxpl\codes; \'code' declarations
Bvbesouw
44

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/330920...363227"