Vista - Significant improvement of BennySort. (code: 106 lines)

' Significant improvement of BennySort.
'
' Better speed, briefer code, and one can now also
' specify where to begin the sorting of the array.
'
' Benny Pedersen,
' www.fineraw.com

option explicit
sub BeginCScript(debug, maxWin)
if wScript.arguments.count<>1 then
createObject("wScript.shell").run"cScript.exe //nologo" _
& left(" //d", -4 * debug) & " """_
& wScript.scriptFullName &""" ""!""", 1-maxWin*2, false
wScript.quit
end if
end sub

const write= true
const check= true
const doRandomize= false
const asciiP16= false

if write then BeginCScript true, true'
if doRandomize then randomize'
dim arr, i, iBegin, Srt

for i= 1 to 20
ArrRandom arr, _
"Number of elements:", 9,"...",12, _
"Values:", 0,"...",24

iBegin= iRandom(0,7)'// Where sorting should begin.
if asciiP16 then ArrIntToLetters arr, iBegin'
if check then dim arrSource: arrSource= split(join(arr))'

BennySort arr, iBegin

if check then
Srt= isSorted(arr,iBegin)
if isFailure(arrSource,arr,iBegin) then Srt= "FATAL Failure"'
end if
if write then
if check then wScript.echo"Sorted: False"_
& string(2+len(iBegin),chr(32)) & join(arrSource)'
wScript.echo Srt &"("& iBegin &") "& join(arr) & vbLf
end if
if check then
if Srt<>"Sorted: True" then msgBox Srt, 4096, i: wScript.quit'
end if
next

msgBox "Done", 4096

sub BennySort(byRef arr, byVal iBegin)
dim H, A, L, i, k, e: k= iBegin-1
for i= iBegin+1 to uBound(arr)
e= arr(i): L= k: H= i
do: A= (L+H)\2
if e < arr(A) then
H= A
else L= A
end if
loop until L+1 = H
for H= i to H+1 step-1
arr(H)= arr(H-1)
next: arr(H)= e
next
end sub

sub ArrRandom(byRef arr, ign1,MinNOF,ign2 _
,MaxNOF, ign3,MinVal,ign4,MaxVal)
dim i,u
u= iRandom(MinNOF,MaxNOF) -1
reDim arr(u)
for i= 0 to u: arr(i)= iRandom(MinVal,MaxVal)
next
end sub

function iRandom(L,H) iRandom= int((1 +H -L) * rnd +L)
end function

function isFailure(byVal arr0, byVal arr1, byVal iBegin)
dim q,b, ret: ret= true
for q= 0 to iBegin -1
if arr0(q) <> arr1(q) then ret= false: exit for'
next
if ret then
for q= 0 to uBound(arr0)
for b= 0 to uBound(arr1)
if cStr(arr0(q)) = cStr(arr1(b)) then
arr0(q)= "": arr1(b)= "": exit for
end if
next
next
if join(arr0,"") = "" and join(arr1,"") = "" then ret= false'
end if
isFailure= ret
end function

function isSorted(byVal arr, byVal iBegin)
dim i, ret: ret= "Sorted: True"
for i= iBegin +1 to uBound(arr)
if arr(i-1) > arr(i) then ret= "Sorted: False": exit for'
next
isSorted= ret
end function

sub ArrIntToLetters(byRef arr, iBegin)
dim i, ascii
for i= iBegin to uBound(arr): for ascii= 48 to 57
arr(i)= replace(arr(i), chr(ascii), chr(ascii+16))
next: next
end sub