Data update

Task/Best-shuffle/Ada/best-shuffle.adb

@@ -0,0 +1,50 @@
+with Ada.Text_IO;
+with Ada.Strings.Unbounded;
+
+procedure Best_Shuffle is
+
+   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;
+            end if;
+         end loop;
+      end loop;
+      return T;
+   end Best_Shuffle;
+
+   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
+   for Test_Case in Test_Cases'Range loop
+      declare
+         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;
+            end if;
+         end loop;
+         Ada.Text_IO.Put_Line (Original & ", " & Shuffle & ", (" &
+                                Natural'Image (Score) & " )");
+      end;
+   end loop;
+end Best_Shuffle;

Task/Best-shuffle/Fortran/best-shuffle.f

@@ -0,0 +1,110 @@
+!
+! Best Shuffle
+! tested with Intel ifx (IFX) 2025.2.1 20250806             on Kubuntu 25.10
+!             GNU Fortran (Ubuntu 15.2.0-4ubuntu4) 15.2.0   on Kubuntu 25.10
+!
+! VSI Fortran on VMS does not compile this code because its current version
+! cannot handle allocatable character strings
+!
+! U.B., October 2025
+!==============================================================================
+
+program bestShuffle
+
+  implicit none
+
+  integer, parameter :: MAXLEN = 100                              ! Maximum length of strings to shuffle
+  character (len=MAXLEN), dimension(:),allocatable  :: wordsToShuffle               ! Test cases as in task description
+  character (len=MAXLEN) shuffledWord                             ! Result of a shuffle operation
+  integer ::  ii, nWords, scr                                     ! little helpers
+  integer:: longest                                               ! Length of longest test string
+  character (len=50)  :: vFormat                                  ! Variable format for printing
+
+  wordsToShuffle = &                                              ! Preset test cases
+  [character(len=MAXLEN) :: 'abcdefghijk', &                      ! all letters different -> always score 0
+                            'abracadabra', &                      ! The other test cases from task description
+                            'seesaw',      &
+                            'elk',         &
+                            'grrrrrrr',    &
+                            'up',          &
+                            'a']                                  ! This style makes both ifx AND gfortran happy.
+  nWords = size (wordsToShuffle)                                  ! Number of test cases
+  longest = 0
+  do ii=1, nWords                                                 ! Find length of longest test string
+    longest = max (longest, len_trim(wordsToShuffle(ii)))
+  end do
+
+  ! Create a variable format depending on the length of the longest test string,
+  ! to print the original string, the shuffled string and the score in three columns
+  write (vFormat,'("(A", i0, ", x, A, T", i0,", i0)"  )')   longest, 2*longest+3
+
+  ! Initialize random number generator once for the entire run-time of the program and all test cases
+  call random_seed()
+
+  do ii = 1, nWords
+    ! Using the Sattolo cycle guarantees that each and every letter will be moved from its original
+    ! position. However, duplicate letters within a word can lead to shuffled words that have a score >0
+    ! If all letters aof the string are different, score will be 0 each time this program is run.
+    call sattolo_cycle (wordsToShuffle(ii), shuffledWord, scr)
+    print vFormat, trim(wordsToShuffle(ii)), trim(shuffledWord), scr
+  end do
+
+  contains
+
+  !=============================================================
+  ! shuffle using the Sattolo algorithm, and calculate the score
+  ! @win: word to shuffle, @wout: resultant string
+  ! @resultantscore: with the obvious meaning
+  !=============================================================
+  subroutine sattolo_cycle (win, wout, resultantscore)
+
+  character (len=MAXLEN) , intent (in) :: win           ! The word to shuffle
+  character (len=MAXLEN) , intent (out) :: wout         ! The resultant word after shuffling
+  character :: tmp                                      ! for swapping single letters
+  integer, intent(out) :: resultantscore                ! the calculated score of the resultant string
+
+  integer :: j, k, l                                    ! Helper variables: indices into words, words' length
+
+  wout = win
+  l = len_trim (wout)
+  do j = l, 1, -1                                       ! For all letters from end down to begin
+    k = randominInterval (1, j-1)                       ! Select random letters between 1 and j-1
+    tmp = wout(j:j)                                     ! then swap letter at pos j with letter at pos k
+    wout (j:j) = wout (k:k)
+    wout(k:k) = tmp
+  end do
+
+  resultantscore = score (win,wout,l)                   ! Calculate score
+  end subroutine sattolo_cycle
+
+
+  ! ===========================================================
+  ! Generate random number between @lo and @hi (inclusive)
+  ! Assume Random Number Generator has been initialized before.
+  ! ===========================================================
+  function randominInterval (lo, hi) result (r)
+  integer, intent(in) :: lo, hi                         ! the interval
+  integer :: r                                          ! resultant (pseudo-)random number
+  real :: rnd                                           ! Fortran random number generator generates float values
+
+  call random_number (rnd)
+  r = lo + FLOOR((hi+1-lo)*rnd)                         ! We want to choose one between [lo,hi]
+
+  end function randominInterval
+
+  !===============================================================================
+  ! Calculate score: count positions that have the same letter as before shuffling
+  !===============================================================================
+  function score (win, wout, l) result (scr)
+  character (len=MAXLEN) , intent (in) :: win, wout     ! The two words to compare
+  integer , intent(in) :: l                             ! Length of the words to consider
+  integer :: scr                                        ! Resultant score
+  integer :: jj                                         ! Loop index
+
+  scr = 0
+  do jj=1,l
+    if (win(jj:jj) .eq. wout(jj:jj) )   scr = scr + 1
+  enddo
+  end function score
+
+end program bestShuffle

Task/Best-shuffle/Pluto/best-shuffle.pluto

@@ -0,0 +1,17 @@
+require "table2"
+local fmt = require "fmt"
+
+local tests = {"abracadabra", "seesaw", "elk", "grrrrrr", "up", "a"}
+for tests as s do
+    local t = s:split(""):shuffle()
+    for i = 1, #t do
+        for j = 1, #t do
+            if i != j and t[i] != s[j] and t[j] != s[i] then
+                t[i], t[j] = t[j], t[i]
+                break
+            end
+        end
+    end
+    local c = range(1, #s):count(|i| -> s[i] == t[i])
+    fmt.print("%s, %s, (%d)\n", s, t:concat(""), c)
+end

Task/Best-shuffle/PowerShell/best-shuffle-1.ps1

@@ -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
+    }

Task/Best-shuffle/PowerShell/best-shuffle-2.ps1

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

Task/Best-shuffle/V-(Vlang)/best-shuffle.v

@@ -0,0 +1,30 @@
+fn best_shuffle(s1 string) string {
+    mut s2 := s1.clone()
+    len_s2 := s2.len
+    mut s2_bytes := s2.bytes()
+    s1_bytes := s1.bytes()
+    for i in 0 .. len_s2 {
+        for j in 0 .. len_s2 {
+            if i != j && s2_bytes[i] != s1_bytes[j] && s2_bytes[j] != s1_bytes[i] {
+                i1 := if j < i { j } else { i }
+                j1 := if j < i { i } else { j }
+                // swap characters at i1 and j1 in s2_bytes
+                s2_bytes[i1], s2_bytes[j1] = s2_bytes[j1], s2_bytes[i1]
+            }
+        }
+    }
+    return s2_bytes.bytestr()
+}
+
+fn main() {
+    lista := ["abracadabra", "seesaw", "pop", "grrrrrr", "up", "a"]
+    mut puntos := 0
+    for palabra in lista {
+        bs := best_shuffle(palabra)
+        puntos = 0
+        for i := 0; i < palabra.len; i++ {
+            if palabra[i] == bs[i] { puntos++ }
+        }
+        println("$palabra ==> $bs  (puntuación: $puntos)")
+    }
+}

Task/Best-shuffle/VBScript/best-shuffle.vbs

@@ -0,0 +1,52 @@
+'Best Shuffle Task
+'VBScript Implementation
+
+Function bestshuffle(s)
+    Dim arr:Redim arr(Len(s)-1)
+
+    'The Following Does the toCharArray() Functionality
+    For i = 0 To Len(s)-1
+        arr(i) = Mid(s, i + 1, 1)
+    Next
+
+    arr = shuffler(arr)     'Make this line a comment for deterministic solution
+    For i = 0 To UBound(arr):Do
+        If arr(i) <> Mid(s, i + 1, 1) Then Exit Do
+        For j = 0 To UBound(arr)
+            If arr(i) <> arr(j) And arr(i) <> Mid(s, j + 1, 1) And arr(j) <> Mid(s, i + 1, 1) Then
+                tmp = arr(i)
+                arr(i) = arr(j)
+                arr(j) = tmp
+            End If
+        Next
+    Loop While False:Next
+
+    shuffled_word = Join(arr,"")
+
+    'This section is the scorer
+    score = 0
+    For k = 1 To Len(s)
+        If Mid(s,k,1) = Mid(shuffled_word,k,1) Then
+            score = score + 1
+        End If
+    Next
+
+    bestshuffle = shuffled_word & ",(" & score & ")"
+End Function
+
+Function shuffler(array)
+    Set rand = CreateObject("System.Random")
+    For i = UBound(array) to 0 Step -1
+       r = rand.next_2(0, i + 1)
+       tmp = array(i)
+       array(i) = array(r)
+       array(r) = tmp
+    Next
+    shuffler = array
+End Function
+
+'Testing the function
+word_list = Array("abracadabra","seesaw","elk","grrrrrr","up","a")
+For Each word In word_list
+    WScript.StdOut.WriteLine word & "," & bestshuffle(word)
+Next