[The Original Shootout]   [NEWS]   [FAQ]   [Methodology]   [Platform Details]   [Acknowledgements]   [Scorecard]
All Source For vbscript
Ackermann's Function
```Function Ack(M, N)
If M = 0 Then
Ack = N + 1
Else
If N = 0 Then
Ack = Ack(M-1, 1)
Else
Ack = Ack(M-1, Ack(M, N-1))
End If
End If
End Function

NUM = WScript.Arguments(0)
If NUM < 1 Then NUM = 1
nack = Ack(3, NUM)
WScript.Echo "Ack(3," & NUM & "): " & nack
```
Array Access
```
n = WScript.Arguments(0)
Redim X(n), Y(n)

If n < 1 Then n = 1
last = n - 1
For i = 0 To last
X(i) = i + 1
Next
For K = 0 To 999
For I = last To 0 Step -1
Y(i) = Y(i) + X(i)
Next
Next

WScript.Echo Y(0) & " " & Y(last)
```
Fibonacci Numbers
```Function Fib(N)
If N < 2 Then
Fib = 1
Else
Fib = Fib(N-2) + Fib(N-1)
End If
End Function

NUM = WScript.Arguments(0)
If NUM < 1 Then NUM = 1
nfib = Fib(NUM)
WScript.Echo nfib
```
Hash (Associative Array) Access
```n = WScript.Arguments(0)
If n < 1 Then n = 1

Set X = CreateObject("Scripting.Dictionary")
c = 0
For i = 1 To N
Next

For i = n To 1 step -1
If X.Exists(CStr(i)) Then c = c + 1
Next
WScript.Echo c
```
Hashes, Part II
```n = WScript.Arguments(0)
If n < 1 Then n = 1

Set hash1 = CreateObject("Scripting.Dictionary")
For i = 0 To 9999
Next

Set hash2 = CreateObject("Scripting.Dictionary")
For i = 1 To N
For Each k In hash1.Keys
If Not hash2.Exists(k) Then
End If
hash2.Item(k) = hash2.Item(k) + hash1.Item(k)
Next
Next

WScript.Echo hash1.Item("foo_1") & " " & hash1.Item("foo_9999") & " " & hash2.Item("foo_1") & " " & hash2.Item("foo_9999")
```
Heapsort
```Const IM = 139968
Const IA =   3877
Const IC =  29573

LAST = 42

Function gen_random(n)
LAST = (LAST * IA + IC) Mod IM
gen_random = n * LAST / IM
End Function

Sub heapsort(n, ra)
rra = 0
i = 0
j = 0
l = CLng((n / 2) + 1)
ir = n

While 1
If l > 1 Then
l = l - 1
rra = ra(l)
Else
rra = ra(ir)
ra(ir) = ra(1)
ir = ir - 1
If ir = 1 Then
ra(1) = rra
Exit Sub
End If
End If

i = l
j = l * 2

While  CLng(j) <= CLng(ir)
If CLng(j) < CLng(ir) Then
If ra(j) < ra(j+1) Then j = j + 1
End If

If rra < ra(j) Then
ra(i) = ra(j)
i = j
j = j + i
Else
j = ir + 1
End If
Wend
ra(i) = rra
Wend

End Sub

n = WScript.Arguments(0)
If n < 1 Then n = 1

Redim ary(N+1)

For i = 1 To N
ary(i) = gen_random(1)
Next

heapsort N, ary

WScript.Echo FormatNumber(ary(N), 10)

```
Hello World
```WScript.Echo( "hello world" )
```
List Operations
```Const SIZE = 10000

ITER = WScript.Arguments(0)
If ITER < 1 Then ITER = 1

result = 0
While ITER
result = test_lists
ITER = ITER - 1
Wend
WSCript.Echo result

Function test_lists()
' create a list of integers (Li1) from 1 to SIZE
Redim Li1(SIZE), Li2(SIZE), Li3(SIZE), Li4(SIZE)
For A = LBound(Li1) To UBound(Li1)
Li1(A) = A
Next
' copy the list to Li2 (not by individual items)
For A = LBound(Li1) To UBound(Li1)
Li2(A) = Li1(A)
Next
' remove each individual item from left side of Li2 and
' append to right side of Li3 (preserving order)
For A = LBound(Li2) To UBound(Li2)
Li3(A) = Li2(SIZE-A)
Next

' Li2 must now be empty
' remove each individual item from right side of Li3 and
' append to right side of Li2 (reversing list)

For A = LBound(Li2) To UBound(Li2)
Li2(A) = Li3(A)
Next

' Li3 must now be empty
' reverse Li1 in place
For A = LBound(Li1) To UBound(Li1)
Li4(A) = Li1(SIZE-A)
Next
For A = LBound(Li4) To UBound(Li4)
Li1(A) = Li4(A)
Next
' check that first item is now SIZE
If Li1(0) <> SIZE Then
test_lists = -1
Exit Function
End If

' compare Li1 and Li2 for equality
For i = LBound(Li1) To UBound(Li1)
'WScript.Echo "I=" & i & " Li1=" & Li1(i) & " Li2=" & Li2(i)
If Li1(i) <> Li2(i) Then
test_lists = 0
Exit Function
End If
Next
test_lists = UBound(Li1)
End Function
```
Matrix Multiplication
```Const size = 30

Function mkmatrix(rows, cols)
ReDim mx(size, size)
rows = rows - 1
cols = cols - 1
count = 1
For R = 0 To rows
For C = 0 To cols
mx(R, C) = count
count = count + 1
Next
Next
mkmatrix = mx
End Function

Function mmult(rows, cols, m1, m2)
ReDim m3(size, size)
rows = rows - 1
cols = cols - 1

For i = 0 To rows
For j = 0 To cols
val = 0
For k = 0 To cols
val = val + m1(i, k) * m2(k, j)
Next
m3(i, j) = val
Next
Next
mmult = m3
End Function

M1 = mkmatrix(size, size)
M2 = mkmatrix(size, size)

N = WScript.Arguments(0)
If N < 1 Then N = 1

For I = 0 To N
MM = mmult(size, size, M1, M2)
Next
WScript.Echo MM(0, 0) & " " & MM(2, 3) & " " & MM(3, 2) & " " & MM(4, 4)

```
Method Calls
```Class Toggle

Public Bool

Public Property Get value()
value = Bool
End Property

Public Property Let value(v)
Bool = v
End Property

Public Sub activate()
If Bool Then
Bool = False
Else
Bool = True
End If
End Sub

End Class

Class NthToggle

Public Bool
Private Counter
Public CountMax

Public Property Get value()
value = Bool
End Property

Public Property Let value(v)
Bool = v
End Property

Public Sub activate()
Counter = Counter + 1
If Counter >= CountMax Then
If Bool Then
Bool = False
Else
Bool = True
End If
Counter = 0
End If
End Sub

End Class

NUM = WScript.Arguments(0)
If NUM < 1 Then NUM = 1
val = 1
Set oToggle = New Toggle
oToggle.Bool = val
For I = 1 To NUM
oToggle.Activate
val = oToggle.Value
Next
If val Then
WScript.Echo "true"
Else
WScript.Echo "false"
End If

val = 1
Set onToggle = New NthToggle
onToggle.Bool = val
onToggle.CountMax = 3
For I = 1 To NUM
onToggle.Activate
val = onToggle.Value
Next
If val Then
WScript.Echo "true"
Else
WScript.Echo "false"
End If

```
Nested Loops
```n = WScript.Arguments(0)
If n < 1 Then n = 1
x = 0
a = n
While a
b = n
While b
c = n
While c
d = n
While d
e = n
While e
f = n
while f
x = x + 1
f = f - 1
Wend
e = e - 1
Wend
d = d - 1
Wend
c = c - 1
Wend
b = b - 1
Wend
a = a -1
Wend

WScript.Echo x
```
Object Instantiation
```Class Toggle

Public Bool

Public Property Get value()
value = Bool
End Property

Public Property Let value(v)
Bool = v
End Property

Public Sub activate()
If Bool Then
Bool = False
Else
Bool = True
End If
End Sub

End Class

Class NthToggle

Public Bool
Private Counter
Public CountMax

Public Property Get value()
value = Bool
End Property

Public Property Let value(v)
Bool = v
End Property

Public Sub activate()
Counter = Counter + 1
If Counter >= CountMax Then
If Bool Then
Bool = False
Else
Bool = True
End If
Counter = 0
End If
End Sub

End Class

NUM = WScript.Arguments(0)
If NUM < 1 Then NUM = 1

Set oToggle = New Toggle
oToggle.Bool = 1
For A = 1 To 5
oToggle.Activate
If oToggle.Value Then
WScript.Echo "true"
Else
WScript.Echo "false"
End If
Next
For A = 1 To NUM
Set oToggle = New Toggle
oToggle.Bool = 1
Next

WScript.Echo

Set onToggle = New NthToggle
onToggle.Bool = 1
onToggle.CountMax = 3
For A = 1 To 8
onToggle.Activate
If onToggle.Value Then
WScript.Echo "true"
Else
WScript.Echo "false"
End If
Next
For A = 1 To NUM
Set onToggle = New NthToggle
onToggle.Bool = 1
onToggle.CountMax = 3
Next
```
Random Number Generator
```Const IM = 139968
Const IA =   3877
Const IC =  29573

LAST = 42

Function gen_random(n)
LAST = (LAST * IA + IC) Mod IM
gen_random = n * LAST / IM
End Function

result = 0
n = WScript.Arguments(0)
If n < 1 Then n = 1
For i = 1 To N
result = gen_random(100)
Next

WScript.Echo FormatNumber(result, 9)
```
Regular Expression Matching
```Set regEx = new RegExp
regEx.Pattern = "^[^\d\(]*(\(\d\d\d\)|\d\d\d) (\d\d\d)[- ](\d\d\d\d)(\D|\$)"
regEx.Global = True

phones = Split(phonesBlob, Chr(10))

N = WScript.Arguments(0)
If N < 1 Then N = 1

While N > 0
For Each line in phones
Set Matches = regEx.Execute(line)
If Matches.Count > 0 Then
' WSCript.Echo "[" & Matches.Count & "]" & line
tel1 = Matches(0).Submatches(0)
If Left(tel1, 1) = "(" Then
tel1 = Mid(tel1, 2, Len(tel1)-2)
End If
tel2 = Matches(0).Submatches(1)
tel3 = Matches(0).Submatches(2)
num = "(" & tel1 & ") " & tel2 & "-" & tel3
If N = 1 Then
Count = Count + 1
WScript.Echo Count & ": " & num
End If
Else
' WScript.Echo "nomatch: " & line
End If
Next
N = N - 1
Wend
```
Reverse a File
```FileBlob = WScript.StdIn.ReadAll
Lines = Split(FileBlob, Chr(10))
For A = UBound(Lines) To LBound(Lines) Step -1
If Len(Lines(A)) > 0 Then WScript.Echo Lines(A)
Next
```
Sieve of Erathostenes
```NUM = WScript.Arguments(0)
If NUM < 1 Then NUM = 1
Dim Flags(8192)
count = 0

While NUM > 0
NUM = NUM - 1
count = 0
For A = 0 To 8192
Flags(A) = A
Next
For I = 2 To 8192
If Flags(I) <> -1 Then
For K = I+I To 8192 Step I
Flags(K) = -1
Next
Count = Count + 1
End If
Next
Wend
WScript.Echo "Count: " & Count
```
Statistical Moments
```<job>

<script language=JScript runat=server>

function SortNumeric(a, b) {
return ((+a > +b) ? 1 : ((+a < +b) ? -1 : 0));
}

function SortVBArray(arrVBArray) {
return arrVBArray.toArray().sort(SortNumeric).join('x');
}
</script>

<script language=VBScript>

Function SortArray(arrInput)
SortArray = Split(SortVBArray(arrInput), "x")
End Function

Sum = 0
N = 0
Num = Split(NumBlob, vbCrLf)
N = UBound(Num)

For A = 0 To N - 1
Sum = Sum + Num(A)
Next

mean = sum / N
average_deviation = 0
standard_deviation = 0
variance = 0
skew = 0
kurtosis = 0
For A = 0 To N - 1
deviation = Num(A) - mean
average_deviation = average_deviation + Abs(deviation)
variance = variance + deviation^2
skew = skew + deviation^3
kurtosis = kurtosis + deviation^4
Next
average_deviation = average_deviation / N
variance = variance / (N-1)
standard_deviation = Sqr(variance)
If variance Then
skew = skew / (N * variance * standard_deviation)
kurtosis = kurtosis / (n * variance * variance ) - 3.0
End If

SortNum = SortArray(Num)

middle = N/2 + 1

If (N Mod 2) Then
median = CInt(SortNum(middle))
Else
median = (CInt(SortNum(middle)) + CInt(SortNum(middle-1))) / 2
End If

WScript.Echo "n:                  " & N
WScript.Echo "median:             " & FormatNumber(median, 6, -1, 0, 0)
WScript.Echo "mean:               " & FormatNumber(mean, 6, -1, 0, 0)
WScript.Echo "average_deviation:  " & FormatNumber(average_deviation, 6, -1, 0, 0)
WScript.Echo "standard_deviation: " & FormatNumber(standard_deviation, 6, -1, 0, 0)
WScript.Echo "variance:           " & FormatNumber(variance, 6, -1, 0, 0)
WScript.Echo "skew:               " & FormatNumber(skew, 6, -1, 0, 0)
WScript.Echo "kurtosis:           " & FormatNumber(kurtosis, 6, -1, 0, 0)
</script>
</job>
```
String Concatenation
```NUM = WScript.Arguments(0)
If NUM < 1 Then NUM = 1
For A = 1 To NUM
str = str & "hello" & vbCr
Next
WScript.Echo Len(str)
```
Sum a Column of Integers
```On Error Resume Next
tot = 0
Nums = Split(Blob, Chr(10))
for each num in nums
tot = tot + CInt(num)
Next
WScript.Echo(tot)
```
Word Frequency Count
```<job>

<script language=JScript runat=server>

function Descending(a, b) {
return ((b > a) ? 1 : ((b < a) ? -1 : 0));
}

function SortVBArray(arrVBArray) {
return arrVBArray.toArray().sort(Descending).join('@');
}
</script>

<script language=VBScript>

Function SortArray(arrInput)
SortArray = Split(SortVBArray(arrInput), "@")
End Function

Set Count = CreateObject("Scripting.Dictionary")

Lines = Split(Blob, vbCrLf)

For Each L in Lines
Line = Trim(LCase(L))
For B = 1 To Len(Line)
C = Asc(Mid(Line, B, 1))
If C <> Asc(" ") And (C < Asc("a") Or C > Asc("z")) Then
'WSCript.Echo(Line)
'WScript.Echo(String(B-1, " ") & "^")
Line = Left(Line, B-1) & " " & Mid(Line, B+1)
'WSCript.Echo(Line)
'WScript.Echo(String(B-1, " ") & "^")
End If
Next

Words = Split(Line, " ")
For Each Word in Words
If Word <> " " And Word <> "" Then
If Count.Exists(Word) Then
Count.Item(Word) = Count.Item(Word) + 1
Else
Count.Item(Word) = 1
End If
End If
Next
Next

K = Count.Keys
Redim Lines(Count.Count-1)

For A = 0 To Count.Count-1
N = CStr(Count.Item(K(A)))
If Len(N) < 7 Then N = String(7-Len(N), " ") & N
Lines(A) = N & Chr(9) & K(A)
Next

SortedLines = SortArray(Lines)
For A = LBound(SortedLines) To UBound(SortedLines)
WScript.Echo(SortedLines(A))
Next

</script>
</job>
```