WeixiangYan/CodeTransOcean huggingface dataset:
Task: Primes with digits in nondecreasing order








VB: Imports System.Linq
Imports System.Collections.Generic
Imports System.Console
Imports System.Math

Module Module1
    Dim ba As Integer
    Dim chars As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"

    Iterator Function Primes(ByVal lim As Integer) As IEnumerable(Of Integer)
        Dim flags(lim) As Boolean, j As Integer : Yield 2
        For j = 4 To lim Step 2 : flags(j) = True : Next : j = 3
        Dim d As Integer = 8, sq As Integer = 9
        While sq <= lim
            If Not flags(j) Then
                Yield j : Dim i As Integer = j << 1
                For k As Integer = sq To lim step i : flags(k) = True : Next
            End If
            j += 2 : d += 8 : sq += d : End While
        While j <= lim
            If Not flags(j) Then Yield j
            j += 2 : End While
    End Function

    
    Function from10(ByVal b As Integer) As String
        Dim res As String = "", re As Integer
        While b > 0 : b = DivRem(b, ba, re) : res = chars(CByte(re)) & res : End While : Return res
    End Function

    
    Function to10(ByVal s As String) As Integer
        Dim res As Integer = 0
        For Each i As Char In s : res = res * ba + chars.IndexOf(i) : Next : Return res
    End Function

    
    Function nd(ByVal s As String) As Boolean
        If s.Length < 2 Then Return True
        Dim l As Char = s(0)
        For i As Integer = 1 To s.Length - 1
            If chars.IndexOf(l) > chars.IndexOf(s(i)) Then Return False Else l = s(i)
        Next : Return True
    End Function

    Sub Main(ByVal args As String())
        Dim c As Integer, lim As Integer = 1000, s As String
        For Each b As Integer In New List(Of Integer) From { 2, 3, 4, 5, 6, 7, 8, 9, 10, 16, 17, 27, 31, 62 }
            ba = b : c = 0 : For Each a As Integer In Primes(lim)
                s = from10(a) : If nd(s) Then c += 1 : Write("{0,4} {1}", s, If(c Mod 20 = 0, vbLf, ""))
            Next
            WriteLine(vbLf & "Base {0}: found {1} non-decreasing primes under {2:n0}" & vbLf, b, c, from10(lim))
        Next
    End Sub
End Module
Task: Harmonic series








VB: Public Sub Main() 
  
  Dim h As Float = 0
  Dim n As Integer, i As Integer
  
  Print "The first twenty harmonic numbers are:" 
  For n = 1 To 20 
    h += 1 / n 
    Print n, h 
  Next 
  Print 
  
  h = 1
  n = 2 
  For i = 2 To 10 
    While h < i 
      h += 1 / n 
      n += 1 
    Wend 
    Print "The first harmonic number greater than "; i; " is "; h; ", at position "; n - 1 
  Next
  
End
Task: Cullen and Woodall numbers








VB: Dim As Uinteger n, num
Print "First 20 Cullen numbers:"

For n = 1 To 20
    num = n * (2^n)+1
    Print num; " ";
Next

Print !"\n\nFirst 20 Woodall numbers:"

For n = 1 To 20
    num = n * (2^n)-1
    Print num; " ";
Next n
Sleep
Task: Koch curve








VB: option explicit


const pi180= 0.01745329251994329576923690768489 
const pi=3.1415926535897932384626433832795 
class turtle
   
   dim fso
   dim fn
   dim svg
   
   dim iang  
   dim ori   
   dim incr
   dim pdown
   dim clr
   dim x
   dim y

   public property let orient(n):ori = n*pi180 :end property
   public property let iangle(n):iang= n*pi180 :end property
   public sub pd() : pdown=true: end sub 
   public sub pu()  :pdown=FALSE :end sub 
   
   public sub rt(i)  
     ori=ori - i*iang:
     if ori<0 then ori = ori+pi*2
   end sub 
   public sub lt(i):  
     ori=(ori + i*iang) 
     if ori>(pi*2) then ori=ori-pi*2
   end sub
   
   public sub bw(l)
      x= x+ cos(ori+pi)*l*incr
      y= y+ sin(ori+pi)*l*incr
   end sub 
   
   public sub fw(l)
      dim x1,y1 
      x1=x + cos(ori)*l*incr
      y1=y + sin(ori)*l*incr
      if pdown then line x,y,x1,y1
      x=x1:y=y1
   end sub
   
   Private Sub Class_Initialize()  
      setlocale "us"  
      initsvg
      pdown=true
   end sub
   
   Private Sub Class_Terminate()   
      disply
   end sub
   
   private sub line (x,y,x1,y1)
      svg.WriteLine "<line x1=""" & x & """ y1= """& y & """ x2=""" & x1& """ y2=""" & y1 & """/>"
   end sub 

   private sub disply()
       dim shell
       svg.WriteLine "</svg></body></html>"
       svg.close
       Set shell = CreateObject("Shell.Application") 
       shell.ShellExecute fn,1,False
   end sub 

   private sub initsvg()
     dim scriptpath
     Set fso = CreateObject ("Scripting.Filesystemobject")
     ScriptPath= Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\"))
     fn=Scriptpath & "SIERP.HTML"
     Set svg = fso.CreateTextFile(fn,True)
     if SVG IS nothing then wscript.echo "Can
     svg.WriteLine "<!DOCTYPE html>" &vbcrlf & "<html>" &vbcrlf & "<head>"
     svg.writeline "<style>" & vbcrlf & "line {stroke:rgb(255,0,0);stroke-width:.5}" &vbcrlf &"</style>"
     svg.writeline "</head>"&vbcrlf & "<body>"
     svg.WriteLine "<svg xmlns=""http://www.w3.org/2000/svg"" width=""800"" height=""800"" viewBox=""0 0 800 800"">" 
   end sub 
end class

sub koch (n,le)
  if n=0 then x.fw le :exit sub
  koch n-1, le/3
  x.lt 1
  koch n-1, le/3
  x.rt 2
  koch n-1, le/3
  x.lt 1
  koch n-1, le/3
end sub

 dim x,i
set x=new turtle
x.iangle=60
x.orient=0
x.incr=3
x.x=100:x.y=300
for i=0 to 3
  koch 7,100
  x.rt 2
next  
set x=nothing
Task: Longest substrings without repeating characters








VB: function nrls(byval s1)
  dim i,x
  if len(s1)<2 then nlrs=s :exit function
  s=lcase(replace(s1," ",""))
    redim a(127)
  dim ls:ls=len(s)
  start=1
  so=""
  ml=1
  a(asc(left(s,1)))=1
  for i=2 to ls+1
    if i>ls then
       rep=true
    else   
      x=asc(mid(s,i,1))
      rep=a(x)<>0
    end if
    if a(x)<>0 then 
      if (i-start)>ml then  
           so=  mid(s,start,i-start)  
           ml=(i-start)
      elseif   (i-start)=ml  then          
           so=so & " " & mid(s,start,i-start)
      end if  
      xx=a(x)
      for j= 96 to 122: 
        if a(j)<=x then a(j)=0
      next         
      start=xx+1
    end if
    a(x)=i
  next
  nrls=trim(so)
  erase a
end function

sub test (f)
  wscript.stdout.writeline "Original:   "&f
  wscript.stdout.writeline "Substrings: "&nrls(f)&vbcrlf  
end sub 

test "dabale arroz a la zorra el abad"
test "The quick brown fox jumps over the lazy dog"
test "ae"
test "aa"
test "abdefghij"
Task: Simple turtle graphics








VB: 




Declare Sub LEF (gradi As Integer)
Declare Sub SETCOL (C As Integer)
Declare Sub SETSIZE (C As Integer)
Declare Sub RIGH (gradi As Integer)
Declare Sub FORW (passi As Integer)
Declare Sub BACK (passi As Integer)
Declare Sub TURTLE (numero As Integer)
Declare Sub UP ()
Declare Sub DOWN ()
Declare Sub DTurtle ()

Dim Shared As Integer graph, dimen, angulo, N, dis, su, pasos
Dim Shared As Integer colore(10), figura(5000,10), figura2()
Dim Shared As Long X(10), Y(10)
Dim Shared As String comando

Sub BACK (passi As Integer)
    pasos = passi
    comando = "d " & Str(passi)
    DTurtle
    comando = ""
    pasos = 0
End Sub

Sub DOWN
    su = 0
End Sub

Sub DTurtle Static
    Dim As Integer rifa, lavora, XX, YY, scher(), FX, FY
    Dim As String R
    
    If rifa = 0 Then rifa = 1: Redim scher(5000)
    If lavora Then Put (XX - dimen * 4, YY - dimen * 2), scher, Pset
    
    If su Then comando = "b" & comando
    FX = X(N)
    FY = Y(N)
    R = "s" & Str(dimen) & "bm" & Str(FX) & "," & Str(FY) & "c" & Str(colore(N)) & "Ta" & Str(angulo) & comando
    Draw R
    X(N) = X(N) + Sin(angulo / 57.2957) * dimen / 4 * pasos
    Y(N) = Y(N) + Cos(angulo / 57.2957) * dimen / 4 * pasos
    XX = X(N)
    YY = Y(N)
    Get (X(N) - dimen * 4, Y(N) - dimen * 2)-(X(N) + dimen * 4, Y(N) + dimen * 2), scher: lavora = 1
    If dis = 0 Then
        R = "bm" & Str(XX) & "," & Str(YY) & "Ta" & Str(angulo) & "r1 ta " & Str(angulo + 15 + 360 * (angulo + 15 > 360)) & "u7 ta " & Str(angulo + 165 + 360 * (angulo + 165 > 360)) & "u7 ta" & Str(angulo) & " m" & Str(XX) & "," & Str(YY)
        Draw R
    Else
        Put (XX, YY), figura2, Or
    End If
End Sub

Sub FORW (passi As Integer)
    pasos = -passi
    comando = "u " & Str(passi)
    DTurtle
    comando = ""
    pasos = 0
End Sub

Sub LEF (gradi As Integer)
    angulo += gradi
    Do Until angulo <= 360
        angulo -= 360
    Loop
    DTurtle
End Sub

Sub RIGH (gradi As Integer)
    angulo -= gradi
    Do Until angulo >= 0
        angulo += 360
    Loop
    DTurtle
End Sub

Sub SETCOL (C As Integer)
    colore(N) = C
    DTurtle
End Sub

Sub SETSIZE (C As Integer)
    dimen = C
    DTurtle
End Sub

Sub TURTLE (numero As Integer) Static
    Dim As Integer i, NN, j
    Dim As Integer ang()
    
    Redim figura2(dis)
    If dis <> 0 And graph <> 0 Then
        For i = 0 To dis
            figura2(i) = figura(i, numero)
        Next i
    End If
    NN = N
    N = numero
    If j = 0 Then j = 1: Redim ang(10): dimen = 4
    If X(numero) = 0 Then X(numero) = 320
    If Y(numero) = 0 Then Y(numero) = 100: colore(numero) = 15
    ang(NN) = angulo
    angulo = ang(N)
    DTurtle
End Sub

Sub UP
    su = 1
End Sub
Task: Word wheel








VB: Const wheel="ndeokgelw"

Sub print(s): 
  On Error Resume Next
  WScript.stdout.WriteLine (s)  
  If  err= &h80070006& Then WScript.Echo " Please run this script with CScript": WScript.quit
End Sub 

Dim oDic
Set oDic = WScript.CreateObject("scripting.dictionary")
Dim cnt(127)
Dim fso
Set fso = WScript.CreateObject("Scripting.Filesystemobject")
Set ff=fso.OpenTextFile("unixdict.txt")
i=0
print "reading words of 3 or more letters"
While Not ff.AtEndOfStream
  x=LCase(ff.ReadLine) 
  If Len(x)>=3 Then 
    If  Not odic.exists(x) Then oDic.Add x,0
  End If  
Wend  
print "remaining words: "& oDic.Count & vbcrlf
ff.Close
Set ff=Nothing
Set fso=Nothing

Set re=New RegExp
print "removing words with chars not in the wheel" 
re.pattern="[^"& wheel &"]"
For Each w In oDic.Keys
  If  re.test(w) Then oDic.remove(w) 
Next
print "remaining words: "& oDic.Count & vbcrlf

print "ensuring the mandatory letter "& Mid(wheel,5,1) & " is present"
re.Pattern=Mid(wheel,5,1)
For Each w In oDic.Keys
  If  Not re.test(w) Then oDic.remove(w) 
Next
print "remaining words: "& oDic.Count & vbcrlf

print "checking number of chars"

Dim nDic
Set nDic = WScript.CreateObject("scripting.dictionary")
For i=1 To Len(wheel)
  x=Mid(wheel,i,1)
  If nDic.Exists(x) Then
    a=nDic(x)
    nDic(x)=Array(a(0)+1,0)
  Else
    nDic.add x,Array(1,0)
  End If  
Next

For Each w In oDic.Keys
  For Each c In nDic.Keys
    ndic(c)=Array(nDic(c)(0),0)
  Next
  For ii = 1 To len(w)
    c=Mid(w,ii,1) 
    a=nDic(c)
    If (a(0)=a(1)) Then  
      oDic.Remove(w):Exit For
    End If
    nDic(c)=Array(a(0),a(1)+1)
  Next
Next

print "Remaining words "& oDic.count
For Each w In oDic.Keys 
  print w  
Next
Task: Intersecting number wheels








VB: Imports System.Runtime.CompilerServices

Module Module1

    <Extension()>
    Iterator Function Loopy(Of T)(seq As IEnumerable(Of T)) As IEnumerable(Of T)
        While True
            For Each element In seq
                Yield element
            Next
        End While
    End Function

    Iterator Function TurnWheels(ParamArray wheels As (name As Char, values As String)()) As IEnumerable(Of Char)
        Dim data = wheels.ToDictionary(Function(wheel) wheel.name, Function(wheel) wheel.values.Loopy.GetEnumerator)
        Dim primary = data(wheels(0).name)

        Dim Turn As Func(Of IEnumerator(Of Char), Char) = Function(sequence As IEnumerator(Of Char))
                                                              sequence.MoveNext()
                                                              Dim c = sequence.Current
                                                              Return If(Char.IsDigit(c), c, Turn(data(c)))
                                                          End Function

        While True
            Yield Turn(primary)
        End While
    End Function

    <Extension()>
    Sub Print(sequence As IEnumerable(Of Char))
        Console.WriteLine(String.Join(" ", sequence))
    End Sub

    Sub Main()
        TurnWheels(("A", "123")).Take(20).Print()
        TurnWheels(("A", "1B2"), ("B", "34")).Take(20).Print()
        TurnWheels(("A", "1DD"), ("D", "678")).Take(20).Print()
        TurnWheels(("A", "1BC"), ("B", "34"), ("C", "5B")).Take(20).Print()
    End Sub

End Module
Task: Poker hand analyser








VB: option explicit
class playingcard
 dim suit
 dim pips
  
  
  public sub print
		dim s,p
		select case suit
		case "S":s=chrW(&h2660)
		case "D":s=chrW(&h2666)
		case "C":s=chrW(&h2663)
		case "H":s=chrW(&h2665)
		end select

		select case pips
		case 1:p="A"
		case 11:p="J"
		case 12:p="Q"
		case 13:p="K"
		case else: p=""& pips
		end select

		wscript.stdout.write  right("   "&p & s,3)&" "
  end sub
end class

sub printhand(byref h,start)
   dim i
   for i =start to ubound(h)
     h(i).print
   next
   
end sub

function checkhand(byval arr)
  dim ss,i,max,last,uses,toppip,j,straight, flush,used,ace
  redim nn(13)
  
  ss=arr(0).suit   
  straight=true:flush=true
  max=0:last=0:used=0:toppip=0:ace=0
  for i=0 to ubound(arr)
      j=arr(i).pips
      if arr(i).suit<>ss then flush=false
      if j>toppip then toppip=j
      if j=1 then ace=1
      nn(j)=nn(j)+1
      if nn(j)>max then max= nn(j) 
      if abs(j-toppip)>=4  then straight=0
   next
   for i=1 to ubound(nn)
      if nn(i) then used=used+1
   next   
   if max=1 then
      if nn(1) and nn(10) and nn(11) and nn(12) and nn(13) then straight=1
   end if
   if flush and straight and max=1 then
      checkhand= "straight-flush"
   elseif flush then  
      checkhand= "flush"
   elseif straight and max=1 then   
      checkhand= "straight"
   elseif max=4 then
     checkhand= "four-of-a-kind"
   elseif max=3 then
     if used=2 then
       checkhand= "full-house"
     else  
       checkhand= "three-of-a-kind"
     end if
  elseif max=2 then
     if used=3 then
       checkhand= "two-pair"
     else  
       checkhand= "one-pair"
     end if
  else
     checkhand= "Top "& toppip
  End If
end function


function readhand(h)
  dim i,b,c,p
  redim a(4)
  for i=0 to ubound(a)
    b=h(i)
    set c=new playingcard
    p=left(b,1)
    select case p
    case "j": c.pips=11
    case "q": c.pips=12
    case "k": c.pips=13
    case "t": c.pips=10
    case "a": c.pips=1
    case else c.pips=cint(p)
    end select
    c.suit=ucase(right(b,1))
    set a(i)=c
  next
  readhand=a
  erase a
end function

dim hands,hh,i
 hands = Array(_
Array("2h", "5h", "7d", "8c", "9s"),_ 
Array("2h", "2d", "2c", "kc", "qd"),_
Array("ah", "2d", "3c", "4c", "5d"),_
Array("2h", "3h", "2d", "3c", "3d"),_
Array("2h", "7h", "2d", "3c", "3d"),_
Array("th", "jh", "qh", "kh", "ah"),_
Array("4h", "4s", "ks", "5d", "ts"),_
Array("qc", "tc", "7c", "6c", "4c"),_
Array("ah", "ah", "7c", "6c", "4c"))

for i=1 to ubound(hands)
   hh=readhand(hands(i))
   printhand hh,0
   wscript.stdout.write vbtab & checkhand(hh)
   wscript.stdout.writeblanklines(1)
   
next
Task: Penney's game








VB: Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const HT As String = "H T"

Public Sub PenneysGame()
Dim S$, YourSeq$, ComputeSeq$, i&, Seq$, WhoWin$, flag As Boolean

    Do
        S = WhoWillBeFirst(Choice("Who will be first"))
        If S = "ABORT" Then Exit Do
        Debug.Print S; " start"
        YourSeq = Choice("Your sequence", 3)
        If YourSeq Like "*ABORT*" Then Exit Do
        Debug.Print "Your sequence : " & YourSeq
        ComputeSeq = vbNullString
        For i = 1 To 3
            ComputeSeq = ComputeSeq & Random
        Next i
        Debug.Print "Computer sequence : " & ComputeSeq
        Seq = vbNullString
        Do
            Seq = Seq & Random
            Debug.Print Seq
            Sleep 1000
        Loop While Not Winner(ComputeSeq, YourSeq, Seq, WhoWin)
        Debug.Print WhoWin; " win"
        If MsgBox(WhoWin & " win" & vbCrLf & "Play again?", vbYesNo) = vbNo Then flag = True
        Debug.Print ""
    Loop While Not flag
    Debug.Print "Game over"
End Sub

Private Function WhoWillBeFirst(YourChoice As String) As String
Dim S$
    S = Random
    Select Case YourChoice
        Case "ABORT": WhoWillBeFirst = YourChoice
        Case Else:
            WhoWillBeFirst = IIf(S = YourChoice, "You", "Computer")
    End Select
End Function

Private Function Choice(Title As String, Optional Seq As Integer) As String
Dim S$, i&, t$
    If Seq = 0 Then Seq = 1
    t = Title
    For i = 1 To Seq
        S = vbNullString
        Do
            S = InputBox("Choose between H or T : ", t)
            If StrPtr(S) = 0 Then S = "Abort"
            S = UCase(S)
        Loop While S <> "H" And S <> "T" And S <> "ABORT"
        Choice = Choice & S
        t = Title & " " & Choice
        If Choice Like "*ABORT*" Then Exit For
    Next i
End Function

Private Function Random() As String
Randomize Timer
    Random = Split(HT, " ")(CInt(Rnd))
End Function

Private Function Winner(Cs$, Ys$, S$, W$) As Boolean
    If Len(S) < 3 Then
        Winner = False
    Else
        If Right(S, 3) = Cs And Right(S, 3) = Ys Then
            Winner = True
            W = "Computer & you"
        ElseIf Right(S, 3) = Cs And Right(S, 3) <> Ys Then
            Winner = True
            W = "Computer"
        ElseIf Right(S, 3) = Ys And Right(S, 3) <> Cs Then
            Winner = True
            W = "You"
        End If
    End If
End Function
Task: Sailors, coconuts and a monkey problem








VB: Option Explicit
Public Sub coconuts()
    Dim sailors As Integer
    Dim share As Long
    Dim finalshare As Integer
    Dim minimum As Long, pile As Long
    Dim i As Long, j As Integer
    Debug.Print "Sailors", "Pile", "Final share"
    For sailors = 2 To 6
        i = 1
        Do While True
            pile = i
            For j = 1 To sailors
                If (pile - 1) Mod sailors <> 0 Then Exit For
                share = (pile - 1) / sailors
                pile = pile - share - 1
            Next j
            If j > sailors Then
                If share Mod sailors = 0 And share > 0 Then
                    minimum = i
                    finalshare = pile / sailors
                    Exit Do
                End If
            End If
            i = i + 1
        Loop
        Debug.Print sailors, minimum, finalshare
    Next sailors
End Sub
Task: Musical scale








VB: Option Explicit

Declare Function Beep Lib "kernel32" (ByVal Freq As Long, ByVal Dur As Long) As Long

Sub Musical_Scale()
Dim Fqs, i As Integer
   Fqs = Array(264, 297, 330, 352, 396, 440, 495, 528)
   For i = LBound(Fqs) To UBound(Fqs)
      Beep Fqs(i), 500
   Next
End Sub
Task: Update a configuration file








VB: Set objFSO = CreateObject("Scripting.FileSystemObject")


Set objParamLookup = CreateObject("Scripting.Dictionary")
With objParamLookup
	.Add "FAVOURITEFRUIT", "banana"
	.Add "NEEDSPEELING", ""
	.Add "SEEDSREMOVED", ""
	.Add "NUMBEROFBANANAS", "1024"
	.Add "NUMBEROFSTRAWBERRIES", "62000"
End With 


Set objInFile = objFSO.OpenTextFile(objFSO.GetParentFolderName(WScript.ScriptFullName) &_
	"\IN_config.txt",1)

Output = ""	
Isnumberofstrawberries = False
With objInFile
	Do Until .AtEndOfStream
		line = .ReadLine
		If Left(line,1) = "#" Or line = "" Then
			Output = Output & line & vbCrLf
		ElseIf Left(line,1) = " " And InStr(line,"#") Then
			Output = Output & Mid(line,InStr(1,line,"#"),1000) & vbCrLf
		ElseIf Replace(Replace(line,";","")," ","") <> "" Then
			If InStr(1,line,"FAVOURITEFRUIT",1) Then
				Output = Output & "FAVOURITEFRUIT" & " " & objParamLookup.Item("FAVOURITEFRUIT") & vbCrLf
			ElseIf InStr(1,line,"NEEDSPEELING",1) Then
				Output = Output & "; " & "NEEDSPEELING" & vbCrLf
			ElseIf InStr(1,line,"SEEDSREMOVED",1) Then
				Output = Output & "SEEDSREMOVED" & vbCrLf
			ElseIf InStr(1,line,"NUMBEROFBANANAS",1) Then
				Output = Output & "NUMBEROFBANANAS" & " " & objParamLookup.Item("NUMBEROFBANANAS") & vbCrLf
			ElseIf InStr(1,line,"NUMBEROFSTRAWBERRIES",1) Then
				Output = Output & "NUMBEROFSTRAWBERRIES" & " " & objParamLookup.Item("NUMBEROFSTRAWBERRIES") & vbCrLf
				Isnumberofstrawberries = True
			End If
		End If
	Loop
	If Isnumberofstrawberries = False Then
		Output = Output & "NUMBEROFSTRAWBERRIES" & " " & objParamLookup.Item("NUMBEROFSTRAWBERRIES") & vbCrLf
		Isnumberofstrawberries = True
	End If
	.Close
End With
	

Set objOutFile = objFSO.OpenTextFile(objFSO.GetParentFolderName(WScript.ScriptFullName) &_
	"\OUT_config.txt",2,True)
With objOutFile
	.Write Output
	.Close
End With

Set objFSO = Nothing
Set objParamLookup = Nothing
Task: I before E except after C








VB: Set objFSO = CreateObject("Scripting.FileSystemObject")
Set srcFile = objFSO.OpenTextFile(objFSO.GetParentFolderName(WScript.ScriptFullName) &_
	"\unixdict.txt",1,False,0)
	
cei = 0 : cie = 0 : ei = 0 : ie = 0

Do Until srcFile.AtEndOfStream
	word = srcFile.ReadLine
	If InStr(word,"cei") Then
		cei = cei + 1
	ElseIf InStr(word,"cie") Then
		cie = cie + 1
	ElseIf InStr(word,"ei") Then
		ei = ei + 1
	ElseIf InStr(word,"ie") Then
		ie = ie + 1
	End If
Loop

FirstClause = False
SecondClause = False
Overall = False


If  ie > ei*2 Then
	WScript.StdOut.WriteLine "I before E when not preceded by C is plausible."
	FirstClause = True
Else
	WScript.StdOut.WriteLine "I before E when not preceded by C is NOT plausible."
End If


If cei > cie*2 Then
	WScript.StdOut.WriteLine "E before I when not preceded by C is plausible."
	SecondClause = True
Else
	WScript.StdOut.WriteLine "E before I when not preceded by C is NOT plausible."
End If


If FirstClause And SecondClause Then
	WScript.StdOut.WriteLine "Overall it is plausible."
Else
	WScript.StdOut.WriteLine "Overall it is NOT plausible."
End If

srcFile.Close
Set objFSO = Nothing
Task: Spelling of ordinal numbers








VB: Private Function ordinal(s As String) As String
    Dim irregs As New Collection
    irregs.Add "first", "one"
    irregs.Add "second", "two"
    irregs.Add "third", "three"
    irregs.Add "fifth", "five"
    irregs.Add "eighth", "eight"
    irregs.Add "ninth", "nine"
    irregs.Add "twelfth", "twelve"
    Dim i As Integer
    For i = Len(s) To 1 Step -1
        ch = Mid(s, i, 1)
        If ch = " " Or ch = "-" Then Exit For
    Next i
    On Error GoTo 1
    ord = irregs(Right(s, Len(s) - i))
    ordinal = Left(s, i) & ord
    Exit Function
1:
    If Right(s, 1) = "y" Then
        s = Left(s, Len(s) - 1) & "ieth"
    Else
        s = s & "th"
    End If
    ordinal = s
End Function
Public Sub ordinals()
    tests = [{1, 2, 3, 4, 5, 11, 65, 100, 101, 272, 23456, 8007006005004003, 123, 00123.0, 1.23E2}]
    init
    For i = 1 To UBound(tests)
        Debug.Print ordinal(spell(tests(i)))
    Next i
End Sub
Task: Long stairs








VB: Option Explicit
Randomize Timer

Function pad(s,n) 
  If n<0 Then pad= right(space(-n) & s ,-n) Else  pad= left(s& space(n),n) End If 
End Function

Sub print(s)
  On Error Resume Next
  WScript.stdout.WriteLine (s)  
  If  err= &h80070006& Then WScript.Echo " Please run this script with CScript": WScript.quit
End Sub

Function Rounds(maxsecs,wiz,a)
  Dim mystep,maxstep,toend,j,i,x,d 
  If IsArray(a) Then d=True: print "seconds behind pending"   
  maxstep=100
  For j=1 To maxsecs
    For i=1 To wiz
      If Int(Rnd*maxstep)<=mystep Then mystep=mystep+1
      maxstep=maxstep+1  
    Next 
    mystep=mystep+1 
    If mystep=maxstep Then Rounds=Array(j,maxstep) :Exit Function
    If d Then
      If j>=a(0) And j<=a(1) Then print pad(j,-7) & pad (mystep,-7) & pad (maxstep-mystep,-8)
    End If     
  Next 
  Rounds=Array(maxsecs,maxstep)
End Function


Dim n,r,a,sumt,sums,ntests,t,maxsecs
ntests=10000
maxsecs=7000
t=timer
a=Array(600,609)
For n=1 To ntests
  r=Rounds(maxsecs,5,a)
  If r(0)<>maxsecs Then 
    sumt=sumt+r(0)
    sums=sums+r(1)
  End if  
  a=""
Next  

print vbcrlf & "Done " & ntests & " tests in " & Timer-t & " seconds" 
print "escaped in " & sumt/ntests  & " seconds with " & sums/ntests & " stairs"