September 2017 Update

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

@@ -1,29 +1,52 @@
-Function shuffle(s)
-	Dim arr()
-	ReDim arr(Len(s)-1)
-	Set objrandom = CreateObject("System.Random")
-	For i = 1 To Len(s)
-		l = Mid(s,i,1)
-		Do
-			n = objrandom.Next_2(0,Len(s))
-			If arr(n) = "" Then
-				arr(n) = l
-				Exit Do
-			End If
-		Loop	
-	Next
-	shuffled_word = Join(arr,"")
-	score = 0
-	For j = 1 To Len(s)
-		If Mid(s,j,1) = Mid(shuffled_word,j,1) Then
-			score = score + 1
-		End If
-	Next
-	shuffle = shuffled_word & ",(" & score & ")"
+'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 & "," & shuffle(word)
+    WScript.StdOut.WriteLine word & "," & bestshuffle(word)
 Next