aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

2016 Update

Browse source
This commit is contained in:
Tina Müller 2016-12-05 22:15:40 +01:00
parent 948b86eafa
commit dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
Download patch file Download diff file Expand all files Collapse all files

32
Task/Best-shuffle/00DESCRIPTION
View file

@ -1,11 +1,29 @@
Shuffle the characters of a string in such a way that as many of the character values are in a different position as possible. Print the result as follows: original string, shuffled string, (score). The score gives the number of positions whose character value did ''not'' change.
For example: <code>tree, eetr, (0)</code>
;Task:
Shuffle the characters of a string in such a way that as many of the character values are in a different position as possible.
A shuffle that produces a randomized result among the best choices is to be preferred. A deterministic approach that produces the same sequence every time is acceptable as an alternative.
The words to test with are: <code>abracadabra</code>, <code>seesaw</code>, <code>elk</code>, <code>grrrrrr</code>, <code>up</code>, <code>a</code>
Display the result as follows:
;Cf.
* [[Anagrams/Deranged anagrams]]
* [[Permutations/Derangements]]
original string, shuffled string, (score)
The score gives the number of positions whose character value did ''not'' change.
;Example:
tree, eetr, (0)
;Test cases:
abracadabra
seesaw
elk
grrrrrr
up
a
;Related tasks
* &nbsp; [[Anagrams/Deranged anagrams]]
* &nbsp; [[Permutations/Derangements]]
<br><br>

46
Task/Best-shuffle/Ada/best-shuffle.ada
View file

@ -1,42 +1,50 @@
with Ada.Text_IO;
with Ada.Strings.Unbounded;
procedure Best_Shuffle is
function Best_Shuffle(S: String) return String is
T: String(S'Range) := S;
Tmp: Character;
function Best_Shuffle (S : String) return String;
function Best_Shuffle (S : String) return String is
T : String (S'Range) := S;
Tmp : Character;
begin
for I in S'Range loop
for J in S'Range loop
if I /= J and S(I) /= T(J) and S(J) /= T(I) then
Tmp := T(I);
T(I) := T(J);
T(J) := Tmp;
if I /= J and S (I) /= T (J) and S (J) /= T (I) then
Tmp := T (I);
T (I) := T (J);
T (J) := Tmp;
end if;
end loop;
end loop;
return T;
end Best_Shuffle;
Stop : Boolean := False;
Test_Cases : constant array (1 .. 6)
of Ada.Strings.Unbounded.Unbounded_String :=
(Ada.Strings.Unbounded.To_Unbounded_String ("abracadabra"),
Ada.Strings.Unbounded.To_Unbounded_String ("seesaw"),
Ada.Strings.Unbounded.To_Unbounded_String ("elk"),
Ada.Strings.Unbounded.To_Unbounded_String ("grrrrrr"),
Ada.Strings.Unbounded.To_Unbounded_String ("up"),
Ada.Strings.Unbounded.To_Unbounded_String ("a"));
begin -- main procedure
while not Stop loop
for Test_Case in Test_Cases'Range loop
declare
Original: String := Ada.Text_IO.Get_Line;
Shuffle: String := Best_Shuffle(Original);
Score: Natural := 0;
Original : constant String := Ada.Strings.Unbounded.To_String
(Test_Cases (Test_Case));
Shuffle : constant String := Best_Shuffle (Original);
Score : Natural := 0;
begin
for I in Original'Range loop
if Original(I) = Shuffle(I) then
Score := Score + 1;
if Original (I) = Shuffle (I) then
Score := Score + 1;
end if;
end loop;
Ada.Text_Io.Put_Line(Original & ", " & Shuffle & ", (" &
Natural'Image(Score) & " )");
if Original = "" then
Stop := True;
end if;
Ada.Text_IO.Put_Line (Original & ", " & Shuffle & ", (" &
Natural'Image (Score) & " )");
end;
end loop;
end Best_Shuffle;

43
Task/Best-shuffle/Haskell/best-shuffle-1.hs
View file

@ -1,33 +1,12 @@
import Data.Function (on)
import Data.List
import Data.Maybe
import Data.Array
import Text.Printf
shufflingQuality l1 l2 = length $ filter id $ zipWith (==) l1 l2
main = mapM_ f examples
where examples = ["abracadabra", "seesaw", "elk", "grrrrrr", "up", "a"]
f s = printf "%s, %s, (%d)\n" s s' $ score s s'
where s' = bestShuffle s
score :: Eq a => [a] -> [a] -> Int
score old new = length $ filter id $ zipWith (==) old new
bestShuffle :: (Ord a, Eq a) => [a] -> [a]
bestShuffle s = elems $ array bs $ f positions letters
where positions =
concat $ sortBy (compare `on` length) $
map (map fst) $ groupBy ((==) `on` snd) $
sortBy (compare `on` snd) $ zip [0..] s
letters = map (orig !) positions
f [] [] = []
f (p : ps) ls = (p, ls !! i) : f ps (removeAt i ls)
where i = fromMaybe 0 $ findIndex (/= o) ls
o = orig ! p
orig = listArray bs s
bs = (0, length s - 1)
removeAt :: Int -> [a] -> [a]
removeAt 0 (x : xs) = xs
removeAt i (x : xs) = x : removeAt (i - 1) xs
printTest prog = mapM_ test texts
where
test s = do
x <- prog s
putStrLn $ unwords $ [ show s
, show x
, show $ shufflingQuality s x]
texts = [ "abba", "abracadabra", "seesaw", "elk" , "grrrrrr"
, "up", "a", "aaaaa.....bbbbb"
, "Rosetta Code is a programming chrestomathy site." ]

22
Task/Best-shuffle/Haskell/best-shuffle-2.hs
View file

@ -1,2 +1,20 @@
bestShuffle :: Eq a => [a] -> [a]
bestShuffle s = minimumBy (compare `on` score s) $ permutations s
import Data.Vector ((//), (!))
import qualified Data.Vector as V
import Data.List (delete, find)
swapShuffle :: Eq a => [a] -> [a] -> [a]
swapShuffle lref lst = V.toList $ foldr adjust (V.fromList lst) [0..n-1]
where
vref = V.fromList lref
n = V.length vref
adjust i v = case find alternative [0.. n-1] of
Nothing -> v
Just j -> v // [(j, v!i), (i, v!j)]
where
alternative j = and [ v!i == vref!i
, i /= j
, v!i /= vref!j
, v!j /= vref!i ]
shuffle :: Eq a => [a] -> [a]
shuffle lst = swapShuffle lst lst

11
Task/Best-shuffle/Haskell/best-shuffle-3.hs Normal file
View file

@ -0,0 +1,11 @@
perfectShuffle :: [a] -> [a]
perfectShuffle [] = []
perfectShuffle lst | odd n = b : shuffle (zip bs a)
| even n = shuffle (zip (b:bs) a)
where
n = length lst
(a,b:bs) = splitAt (n `div` 2) lst
shuffle = foldMap (\(x,y) -> [x,y])
shuffleP :: Eq a => [a] -> [a]
shuffleP lst = swapShuffle lst $ perfectShuffle lst

1
Task/Best-shuffle/Haskell/best-shuffle-4.hs Normal file
View file

@ -0,0 +1 @@
import Control.Monad.Random (getRandomR)

10
Task/Best-shuffle/Haskell/best-shuffle-5.hs Normal file
View file

@ -0,0 +1,10 @@
randomShuffle :: [a] -> IO [a]
randomShuffle [] = return []
randomShuffle lst = do
i <- getRandomR (0,length lst-1)
let (a, x:b) = splitAt i lst
xs <- randomShuffle $ a ++ b
return (x:xs)
shuffleR :: Eq a => [a] -> IO [a]
shuffleR lst = swapShuffle lst <$> randomShuffle lst

25
Task/Best-shuffle/Haskell/best-shuffle-6.hs Normal file
View file

@ -0,0 +1,25 @@
{-# LANGUAGE TupleSections, LambdaCase #-}
import Conduit
import Control.Monad.Random (getRandomR)
import Data.List (delete, find)
shuffleC :: Eq a => Int -> Conduit a IO a
shuffleC 0 = awaitForever yield
shuffleC k = takeC k .| sinkList >>= \v -> delay v .| randomReplace v
delay :: Monad m => [a] -> Conduit t m (a, [a])
delay [] = mapC $ \x -> (x,[x])
delay (b:bs) = await >>= \case
Nothing -> yieldMany (b:bs) .| mapC (,[])
Just x -> yield (b, [x]) >> delay (bs ++ [x])
randomReplace :: Eq a => [a] -> Conduit (a, [a]) IO a
randomReplace vars = awaitForever $ \(x,b) -> do
y <- case filter (/= x) vars of
[] -> pure x
vs -> lift $ (vs !!) <$> getRandomR (0, length vs - 1)
yield y
randomReplace $ b ++ delete y vars
shuffleW :: Eq a => Int -> [a] -> IO [a]
shuffleW k lst = yieldMany lst =$= shuffleC k $$ sinkList

4
Task/Best-shuffle/Haskell/best-shuffle-7.hs Normal file
View file

@ -0,0 +1,4 @@
import Data.ByteString.Builder (charUtf8)
import Data.ByteString.Char8 (ByteString, unpack, pack)
import Data.Conduit.ByteString.Builder (builderToByteString)
import System.IO (stdin, stdout)

13
Task/Best-shuffle/Haskell/best-shuffle-8.hs Normal file
View file

@ -0,0 +1,13 @@
shuffleBS :: Int -> ByteString -> IO ByteString
shuffleBS n s =
yieldMany (unpack s)
=$ shuffleC n
=$ mapC charUtf8
=$ builderToByteString
$$ foldC
main :: IO ()
main =
sourceHandle stdin
=$ mapMC (shuffleBS 10)
$$ sinkHandle stdout

2
Task/Best-shuffle/Java/best-shuffle.java
View file

@ -1,6 +1,7 @@
import java.util.Random;
public class BestShuffle {
private final static Random rand = new Random();
public static void main(String[] args) {
String[] words = {"abracadabra", "seesaw", "grrrrrr", "pop", "up", "a"};
@ -27,7 +28,6 @@ public class BestShuffle {
}
public static void shuffle(char[] text) {
Random rand = new Random();
for (int i = text.length - 1; i > 0; i--) {
int r = rand.nextInt(i + 1);
char tmp = text[i];

5
Task/Best-shuffle/Kotlin/best-shuffle.kotlin
View file

@ -31,10 +31,9 @@ object BestShuffle {
private fun CharArray.count(s1: String) : Int {
var count = 0
for (i in indices)
if (s1[i] == this[i])
count++
if (s1[i] == this[i]) count++
return count
}
}
fun main(words: Array<String>) = words forEach { println(BestShuffle(it)) }
fun main(words: Array<String>) = words.forEach { println(BestShuffle(it)) }

40
Task/Best-shuffle/Perl-6/best-shuffle.pl6
View file

@ -1,37 +1,23 @@
sub best-shuffle (Str $s) {
my @orig = $s.comb;
sub best-shuffle(Str $orig) {
my @pos;
# Fill @pos with positions in the order that we want to fill
# them. (Once Rakudo has &roundrobin, this will be doable in
# one statement.)
{
my %pos = classify { @orig[$^i] }, keys @orig;
my @k = map *.key, sort *.value.elems, %pos;
while %pos {
for @k -> $letter {
%pos{$letter} or next;
push @pos, %pos{$letter}.pop;
%pos{$letter}.elems or %pos.delete: $letter;
my @s = $orig.comb;
my @t = @s.pick(*);
for ^@s -> $i {
for ^@s -> $j {
if $i != $j and @t[$i] ne @s[$j] and @t[$j] ne @s[$i] {
@t[$i, $j] = @t[$j, $i];
last;
}
}
@pos .= reverse;
}
my @letters = @orig;
my @new = Any xx $s.chars;
# Now fill in @new with @letters according to each position
# in @pos, but skip ahead in @letters if we can avoid
# matching characters that way.
while @letters {
my ($i, $p) = 0, shift @pos;
++$i while @letters[$i] eq @orig[$p] and $i < @letters.end;
@new[$p] = splice @letters, $i, 1;
my $count = 0;
for @t.kv -> $k,$v {
++$count if $v eq @s[$k]
}
my $score = elems grep ?*, map * eq *, do @new Z @orig;
@new.join, $score;
return (@t.join, $count);
}
printf "%s, %s, (%d)\n", $_, best-shuffle $_

52
Task/Best-shuffle/PowerShell/best-shuffle-1.psh Normal file
View file

@ -0,0 +1,52 @@
# 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 )
{
# Convert to array of characters, group identical characters,
# sort by frequecy, get size of first group
$MostRepeats = $String.ToCharArray() |
Group |
Sort Count -Descending |
Select -First 1 -ExpandProperty Count
# Return count of most repeated character minus all other characters (math simplified)
return [math]::Max( 0, 2 * $MostRepeats - $String.Length )
}
function Get-BestShuffle ( [string]$String )
{
# Convert to arrays of characters, one for comparison, one for manipulation
$S1 = $String.ToCharArray()
$S2 = $String.ToCharArray()
# Calculate best possible score as our goal
$BestScore = Get-BestScore $String
# Unshuffled string has score equal to number of characters
$Length = $String.Length
$Score = $Length
# While still striving for perfection...
While ( $Score -gt $BestScore )
{
# For each character
ForEach ( $i in 0..($Length-1) )
{
# If the shuffled character still matches the original character...
If ( $S1[$i] -eq $S2[$i] )
{
# Swap it with a random character
# (Random character $j may be the same as or may even be
# character $i. The minor impact on speed was traded for
# a simple solution to guarantee randomness.)
$j = Get-Random -Maximum $Length
$S2[$i], $S2[$j] = $S2[$j], $S2[$i]
}
}
# Count the number of indexes where the two arrays match
$Score = ( 0..($Length-1) ).Where({ $S1[$_] -eq $S2[$_] }).Count
}
# Put it back into a string
$Shuffle = ( [string[]]$S2 -join '' )
return $Shuffle
}

6
Task/Best-shuffle/PowerShell/best-shuffle-2.psh Normal file
View file

@ -0,0 +1,6 @@
ForEach ( $String in ( 'abracadabra', 'seesaw', 'elk', 'grrrrrr', 'up', 'a' ) )
{
$Shuffle = Get-BestShuffle $String
$Score = Get-BestScore $String
"$String, $Shuffle, ($Score)"
}

10
Task/Best-shuffle/PowerShell/best-shuffle.psh
View file

@ -1,10 +0,0 @@
function Best-Shuffle($strings){
foreach($string in $strings){
$sa1 = $string.ToCharArray()
$sa2 = Get-Random -InputObject $sa1 -Count ([int]::MaxValue)
$string = [String]::Join("",$sa2)
echo $string
}
}
Best-Shuffle "abracadabra", "seesaw", "pop", "grrrrrr", "up", "a"

69
Task/Best-shuffle/REXX/best-shuffle-1.rexx
View file

@ -1,41 +1,30 @@
/*REXX program finds the best shuffle (for any list of words (characters). */
parse arg @ /*get some words from the command line.*/
if @='' then @ = 'tree abracadabra seesaw elk grrrrrr up a' /*use default? */
w=0 /*width of the longest word; for output*/
do i=1 for words(@) /* [↓] process all the words in list. */
w=max(w, length(word(@, i))) /*set the maximum word width (so far). */
end /*i*/ /* [↑] ··· finds the widest word in @.*/
w=w+9 /*add 9 blanks, the output looks nicer.*/
do n=1 for words(@) /*process all the words in the @ list. */
$=word(@,n) /*get the original word in the @ list. */
new=bestShuffle($) /*get a shufflized version of the word.*/
say 'original:' left($,w) 'new:' left(new,w) 'count:' kSame($,new)
/*REXX program determines and displays the best shuffle for any list of words/characters*/
parse arg $ /*get some words from the command line.*/
if $='' then $= 'tree abracadabra seesaw elk grrrrrr up a' /*use the defaults?*/
w=0; #=words($) /* [↑] finds the widest word in $ list*/
do i=1 for #; @.i=word($,i); w=max(w, length(@.i) ); end /*i*/
w=w+9 /*add 9 blanks for output indentation. */
do n=1 for #; new=bestShuffle(@.n) /*process the examples in the @ array. */
same=0; do m=1 for length(@.n)
same=same + (substr(@.n, m, 1) == substr(new, m, 1) )
end /*m*/
say 'original:' left(@.n, w) 'new:' left(new,w) 'count:' same
end /*n*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────BESTSHUFFLE subroutine────────────────────*/
bestShuffle: procedure; parse arg x 1 ox; Lx=length(x)
if Lx<3 then return reverse(x) /*fast track these small # of puppies. */
do j=1 for Lx-1; jp=j+1 /* [↓] handle any possible replicates.*/
a=substr(x,j ,1)
b=substr(x,j+1,1); if a\==b then iterate /*ignore replicates.*/
_=verify(x,a); if _==0 then iterate /*switch 1st replicate with some char. */
y=substr(x,_,1); x=overlay(a,x,_)
x=overlay(y,x,j)
rx=reverse(x); _=verify(rx,a); if _==0 then iterate /*¬enough uniqueness*/
y=substr(rx,_,1); _=lastpos(y,x) /*switch 2nd replicate with later char.*/
x=overlay(a,x,_); x=overlay(y,x,jp) /*OVERLAYs: a fast way to swap chars. */
end /*j*/
do k=1 for Lx /*handle cases of possible replicates. */
a=substr( x,k,1)
b=substr(ox,k,1); if a\==b then iterate /*skip replicate. */
if k==Lx then x=left(x,k-2)a || substr(x,k-1,1) /*handle last case*/
else x=left(x,k-1)substr(x,k+1,1)a || substr(x,k+2)
end /*k*/
return x
/*──────────────────────────────────KSAME procedure───────────────────────────*/
kSame: procedure; parse arg x,y; k=0
do m=1 for min(length(x), length(y)); k=k + (substr(x,m,1) == substr(y,m,1))
end /*m*/
return k
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
bestShuffle: procedure; parse arg x 1 ox; L=length(x); if L<3 then return reverse(x)
/*[↑] fast track short strs*/
do j=1 for L-1; parse var x =(j) a +1 b +1 /*get A,B at Jth & J+1 pos.*/
if a\==b then iterate /*ignore any replicates. */
c=verify(x,a); if c==0 then iterate /* " " " */
x=overlay( substr(x,c,1), overlay(a,x,c), j) /*swap the x,c characters*/
rx=reverse(x) /*obtain the reverse of X. */
y=substr(rx, verify(rx,a), 1) /*get 2nd replicated char. */
x=overlay(y, overlay(a,x, lastpos(y,x)),j+1) /*fast swap of 2 characters*/
end /*j*/
do k=1 for L; a=substr(x,k,1) /*handle a possible rep. */
if a\==substr(ox,k,1) then iterate /*skip non-replications*/
if k==L then x=left(x,k-2)a || substr(x,k-1,1) /*last case*/
else x=left(x,k-1)substr(x,k+1,1)a || substr(x, k+2)
end /*k*/
return x

135
Task/Best-shuffle/REXX/best-shuffle-4.rexx Normal file
View file

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

2
Task/Best-shuffle/Racket/best-shuffle.rkt
View file

@ -15,6 +15,6 @@
(for/sum ([c1 (in-string s1)] [c2 (in-string s2)])
(if (eq? c1 c2) 1 0)))
(for ([s (in-list '("tree" "abracadabra" "seesaw" "elk" "grrrrrr" "up" "a"))])
(for ([s (in-list '("abracadabra" "seesaw" "elk" "grrrrrr" "up" "a"))])
(define sh (best-shuffle s))
(printf " ~a, ~a, (~a)\n" s sh (count-same s sh)))

19
Task/Best-shuffle/ZX-Spectrum-Basic/best-shuffle.zx Normal file
View file

@ -0,0 +1,19 @@
10 FOR n=1 TO 6
20 READ w$
30 GO SUB 1000
40 LET count=0
50 FOR i=1 TO LEN w$
60 IF w$(i)=b$(i) THEN LET count=count+1
70 NEXT i
80 PRINT w$;" ";b$;" ";count
90 NEXT n
100 STOP
1000 REM Best shuffle
1010 LET b$=w$
1020 FOR i=1 TO LEN b$
1030 FOR j=1 TO LEN b$
1040 IF (i<>j) AND (b$(i)<>w$(j)) AND (b$(j)<>w$(i)) THEN LET t$=b$(i): LET b$(i)=b$(j): LET b$(j)=t$
1110 NEXT j
1120 NEXT i
1130 RETURN
2000 DATA "abracadabra","seesaw","elk","grrrrrr","up","a"