WeixiangYan/CodeTransOcean huggingface dataset:
Task: Terminal control_Dimensions








VB: Module Module1

    Sub Main()
        Dim bufferHeight = Console.BufferHeight
        Dim bufferWidth = Console.BufferWidth
        Dim windowHeight = Console.WindowHeight
        Dim windowWidth = Console.WindowWidth

        Console.Write("Buffer Height: ")
        Console.WriteLine(bufferHeight)
        Console.Write("Buffer Width: ")
        Console.WriteLine(bufferWidth)
        Console.Write("Window Height: ")
        Console.WriteLine(windowHeight)
        Console.Write("Window Width: ")
        Console.WriteLine(windowWidth)
    End Sub

End Module
Task: Largest number divisible by its digits








VB: 
	s=7*8*9  	
	m=9876432   
	for i=(m\s)*s to 1 step -s
		if instr(i,"5")=0 and instr(i,"0")=0 then  
			b=false: j=1
			while j<=len(i)-1 and not b
				if instr(j+1,i,mid(i,j,1))<>0 then b=true  
				j=j+1
			wend
			if not b then
				j=1
				while j<=len(i) and not b
					if (i mod mid(i,j,1))<>0 then b=true  
					j=j+1
				wend
				if not b then exit for
			end if
		end if
	next
	wscript.echo i
Task: Determinant and permanent








VB: Module Module1

    Function Minor(a As Double(,), x As Integer, y As Integer) As Double(,)
        Dim length = a.GetLength(0) - 1
        Dim result(length - 1, length - 1) As Double
        For i = 1 To length
            For j = 1 To length
                If i < x AndAlso j < y Then
                    result(i - 1, j - 1) = a(i - 1, j - 1)
                ElseIf i >= x AndAlso j < y Then
                    result(i - 1, j - 1) = a(i, j - 1)
                ElseIf i < x AndAlso j >= y Then
                    result(i - 1, j - 1) = a(i - 1, j)
                Else
                    result(i - 1, j - 1) = a(i, j)
                End If
            Next
        Next
        Return result
    End Function

    Function Det(a As Double(,)) As Double
        If a.GetLength(0) = 1 Then
            Return a(0, 0)
        Else
            Dim sign = 1
            Dim sum = 0.0
            For i = 1 To a.GetLength(0)
                sum += sign * a(0, i - 1) * Det(Minor(a, 0, i))
                sign *= -1
            Next
            Return sum
        End If
    End Function

    Function Perm(a As Double(,)) As Double
        If a.GetLength(0) = 1 Then
            Return a(0, 0)
        Else
            Dim sum = 0.0
            For i = 1 To a.GetLength(0)
                sum += a(0, i - 1) * Perm(Minor(a, 0, i))
            Next
            Return sum
        End If
    End Function

    Sub WriteLine(a As Double(,))
        For i = 1 To a.GetLength(0)
            Console.Write("[")
            For j = 1 To a.GetLength(1)
                If j > 1 Then
                    Console.Write(", ")
                End If
                Console.Write(a(i - 1, j - 1))
            Next
            Console.WriteLine("]")
        Next
    End Sub

    Sub Test(a As Double(,))
        If a.GetLength(0) <> a.GetLength(1) Then
            Throw New ArgumentException("The dimensions must be equal")
        End If

        WriteLine(a)
        Console.WriteLine("Permanant  : {0}", Perm(a))
        Console.WriteLine("Determinant: {0}", Det(a))
        Console.WriteLine()
    End Sub

    Sub Main()
        Test({{1, 2}, {3, 4}})
        Test({{1, 2, 3, 4}, {4, 5, 6, 7}, {7, 8, 9, 10}, {10, 11, 12, 13}})
        Test({{0, 1, 2, 3, 4}, {5, 6, 7, 8, 9}, {10, 11, 12, 13, 14}, {15, 16, 17, 18, 19}, {20, 21, 22, 23, 24}})
    End Sub

End Module
Task: Sattolo cycle








VB: Private Sub Sattolo(Optional ByRef a As Variant)
    Dim t As Variant, i As Integer
    If Not IsMissing(a) Then
        For i = UBound(a) To lbound(a)+1 Step -1
            j = Int((UBound(a) - 1 - LBound(a) + 1) * Rnd + LBound(a))
            t = a(i)
            a(i) = a(j)
            a(j) = t
        Next i
    End If
End Sub
Public Sub program()
    Dim b As Variant, c As Variant, d As Variant, e As Variant
    Randomize
    
    b = [{10}]
    c = [{10, 20}]
    d = [{10, 20, 30}]
    e = [{11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22}]
    f = [{"This ", "is ", "a ", "test"}]
    Debug.Print "Before:"
    Sattolo 
    Debug.Print "After: "
    Debug.Print "Before:";
    For Each i In b: Debug.Print i;: Next i: Debug.Print
    Sattolo b
    Debug.Print "After: ";
    For Each i In b: Debug.Print i;: Next i: Debug.Print
    Debug.Print "Before:";
    For Each i In c: Debug.Print i;: Next i: Debug.Print
    Sattolo c
    Debug.Print "After: ";
    For Each i In c: Debug.Print i;: Next i: Debug.Print
    Debug.Print "Before:";
    For Each i In d: Debug.Print i;: Next i: Debug.Print
    Sattolo d
    Debug.Print "After: ";
    For Each i In d: Debug.Print i;: Next i: Debug.Print
    Debug.Print "Before:";
    For Each i In e: Debug.Print i;: Next i: Debug.Print
    Sattolo e
    Debug.Print "After: ";
    For Each i In e: Debug.Print i;: Next i: Debug.Print
    Debug.Print "Before:";
    For Each i In f: Debug.Print i;: Next i: Debug.Print
    Sattolo f
    Debug.Print "After: ";
    For Each i In f: Debug.Print i;: Next i: Debug.Print
End Sub
Task: Table creation_Postal addresses








VB: Option Explicit

Dim objFSO, DBSource 

Set objFSO = CreateObject("Scripting.FileSystemObject")

DBSource = objFSO.GetParentFolderName(WScript.ScriptFullName) & "\postal_address.accdb"

With CreateObject("ADODB.Connection")
	.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBSource
	.Execute "CREATE TABLE ADDRESS (STREET VARCHAR(30) NOT NULL," &_
			"CITY VARCHAR(30) NOT NULL, STATE CHAR(2) NOT NULL,ZIP CHAR(5) NOT NULL)"
	.Close
End With
Task: Twin primes








VB: Function IsPrime(x As Long) As Boolean
    Dim i As Long
    If x Mod 2 = 0 Then
        Exit Function
    Else
        For i = 3 To Int(Sqr(x)) Step 2
            If x Mod i = 0 Then Exit Function
        Next i
    End If
    IsPrime = True
End Function

Function TwinPrimePairs(max As Long) As Long
    Dim p1 As Boolean, p2 As Boolean, count As Long, i As Long
    p2 = True
    For i = 5 To max Step 2
        p1 = p2
        p2 = IsPrime(i)
        If p1 And p2 Then count = count + 1
    Next i
    TwinPrimePairs = count
End Function

Sub Test(x As Long)
    Debug.Print "Twin prime pairs below" + Str(x) + ":" + Str(TwinPrimePairs(x))
End Sub

Sub Main()
    Test 10
    Test 100
    Test 1000
    Test 10000
    Test 100000
    Test 1000000
    Test 10000000
End Sub
Task: Recaman's sequence








VB: 
	nx=15
	h=1000
	Wscript.StdOut.WriteLine "Recaman
	Wscript.StdOut.WriteLine recaman("seq",nx)
	Wscript.StdOut.WriteLine "The first duplicate number is: " & recaman("firstdup",0)
	Wscript.StdOut.WriteLine "The number of terms to complete the range 0--->"& h &" is: "& recaman("numterm",h)
	Wscript.StdOut.Write vbCrlf&".../...": zz=Wscript.StdIn.ReadLine()
	
function recaman(op,nn)
	Dim b,d,h
	Set b = CreateObject("Scripting.Dictionary")
	Set d = CreateObject("Scripting.Dictionary")
    list="0" : firstdup=0
	if op="firstdup" then
		nn=1000 : firstdup=1
	end if
	if op="numterm" then
		h=nn : nn=10000000 : numterm=1
	end if
	ax=0  
	b.Add 0,1  
	s=0
	for n=1 to nn-1
        an=ax-n
		if an<=0 then 
			an=ax+n
		elseif b.Exists(an) then 
			an=ax+n
		end if
		ax=an  
		if not b.Exists(an) then b.Add an,1  
		if op="seq" then
			list=list&" "&an
		end if
		if firstdup then
			if d.Exists(an) then
				recaman="a("&n&")="&an
				exit function
			else
				d.Add an,1  
			end if
		end if
		if numterm then
			if an<=h then
				if not d.Exists(an) then
					s=s+1
					d.Add an,1  
				end if
				if s>=h then
					recaman=n
					exit function
				end if
			end if
		end if
	next 
	recaman=list
end function
Task: Factorions








VB: 
    Dim fact()
	nn1=9 : nn2=12
	lim=1499999
    ReDim fact(nn2)
	fact(0)=1
	For i=1 To nn2
		fact(i)=fact(i-1)*i
	Next
	For base=nn1 To nn2
		list=""
		For i=1 To lim
			s=0
			t=i
			Do While t<>0
				d=t Mod base
				s=s+fact(d)
				t=t\base
			Loop
			If s=i Then list=list &" "& i
		Next
		Wscript.Echo "the factorions for base "& right(" "& base,2) &" are: "& list
	Next
Task: Casting out nines








VB: Module Module1
    Sub Print(ls As List(Of Integer))
        Dim iter = ls.GetEnumerator
        Console.Write("[")
        If iter.MoveNext Then
            Console.Write(iter.Current)
        End If
        While iter.MoveNext
            Console.Write(", ")
            Console.Write(iter.Current)
        End While
        Console.WriteLine("]")
    End Sub

    Function CastOut(base As Integer, start As Integer, last As Integer) As List(Of Integer)
        Dim ran = Enumerable.Range(0, base - 1).Where(Function(y) y Mod (base - 1) = (y * y) Mod (base - 1)).ToArray()
        Dim x = start \ (base - 1)

        Dim result As New List(Of Integer)
        While True
            For Each n In ran
                Dim k = (base - 1) * x + n
                If k < start Then
                    Continue For
                End If
                If k > last Then
                    Return result
                End If
                result.Add(k)
            Next
            x += 1
        End While
        Return result
    End Function

    Sub Main()
        Print(CastOut(16, 1, 255))
        Print(CastOut(10, 1, 99))
        Print(CastOut(17, 1, 288))
    End Sub

End Module
Task: Tau function








VB: Public Sub Main()  
  
  Print "The tau functions for the first 100 positive integers are:\n" 
  For i As Integer = 1 To 100 
    Print Format$(numdiv(i), "####");  
    If i Mod 10 = 0 Then Print 
  Next 
  
End

Public Function numdiv(n As Integer) As Integer 

  Dim c As Integer = 1 
  For i As Integer = 1 To (n + 1) \ 2 
    If n Mod i = 0 Then c += 1 
  Next 
  If n = 1 Then c -= 1 
  Return c 

End Function
Task: Lah numbers








VB: 

    Function F(i,n)
        Dim c: c=CCur(i): If n>Len(c) Then F=Space(n-Len(c))&c Else F=c
    End Function 

    Function Fact(ByVal n)
        Dim res
        If n=0 Then
            Fact = 1
        Else
            res = 1
            While n>0
                res = res*n
                n = n-1
            Wend
            Fact = res
        End If
    End Function 
 
    Function Lah(n, k)
        If k=1 Then
            Lah = Fact(n)
        ElseIf k=n Then
            Lah = 1
        ElseIf k>n Then
            Lah=0
        ElseIf k < 1 Or n < 1 Then
            Lah = 0
        Else
            Lah = (Fact(n) * Fact(n-1)) / (Fact(k) * Fact(k-1)) / Fact(n-k)
        End If
    End Function 
 
    Sub Main()
        ns=12: p=10
        WScript.Echo "Unsigned Lah numbers: Lah(n,k):"
        buf = "n/k "
        For k=1 To ns
           buf = buf & F(k,p) & " "
        Next 
        WScript.Echo buf
        For n=1 To ns
           buf = F(n,3) & " "
            For k=1 To n
                l = Lah(n,k)
                buf = buf & F(l,p) & " "
            Next 
            WScript.Echo buf
        Next 
    End Sub 

    Main()
Task: Two sum








VB: Option Explicit
Function two_sum(a As Variant, t As Integer) As Variant
    Dim i, j As Integer
    i = 0
    j = UBound(a)
    Do While (i < j)
        If (a(i) + a(j) = t) Then
            two_sum = Array(i, j)
            Exit Function
        ElseIf (a(i) + a(j) < t) Then i = i + 1
        ElseIf (a(i) + a(j) > t) Then j = j - 1
        End If
    Loop
    two_sum = Array()
End Function
Sub prnt(a As Variant)
    If UBound(a) = 1 Then
        Selection.TypeText Text:="(" & a(0) & ", " & a(1) & ")" & vbCrLf
    Else
        Selection.TypeText Text:="()" & vbCrLf
    End If
End Sub
Sub main()
    Call prnt(two_sum(Array(0, 2, 11, 19, 90), 21))
    Call prnt(two_sum(Array(-8, -2, 0, 1, 5, 8, 11), 3))
    Call prnt(two_sum(Array(-3, -2, 0, 1, 5, 8, 11), 17))
    Call prnt(two_sum(Array(-8, -2, -1, 1, 5, 9, 11), 0))
End Sub
Task: Tau number








VB: print "The first 100 tau numbers are:"

n = 0
num = 0
limit = 100
while num < limit
    n = n +1
    tau = 0
    for m = 1 to n
        if n mod m = 0 then tau = tau +1
    next m
    if n mod tau = 0 then
        num = num +1
        if num mod 10 = 1 then print
        print using("######", n);
    end if
wend
end
Task: Numbers with prime digits whose sum is 13








VB: Imports System
Imports System.Console
Imports LI = System.Collections.Generic.SortedSet(Of Integer)

Module Module1 
    Function unl(ByVal res As LI, ByVal lst As LI, ByVal lft As Integer, ByVal Optional mul As Integer = 1, ByVal Optional vlu As Integer = 0) As LI
        If lft = 0 Then
            res.Add(vlu)
        ElseIf lft > 0 Then
            For Each itm As Integer In lst
                res = unl(res, lst, lft - itm, mul * 10, vlu + itm * mul)
            Next
        End If
        Return res
    End Function

    Sub Main(ByVal args As String())
        WriteLine(string.Join(" ",
            unl(new LI From {}, new LI From { 2, 3, 5, 7 }, 13)))
    End Sub
End Module
Task: Integer roots








VB: Imports System
Imports System.Numerics
Imports Microsoft.VisualBasic.Strings

Public Module Module1

    Public Function IntSqRoot(v As BigInteger) As BigInteger
        Dim digs As Integer = Math.Max(0, v.ToString().Length / 2 - 1)
        IntSqRoot = BigInteger.Parse("3" & StrDup(digs, "0"))
        Dim term As BigInteger
        Do
            term = v / IntSqRoot
            If Math.Abs(CDbl(term - IntSqRoot)) < 2 Then Exit Do
            IntSqRoot = (IntSqRoot + term) / 2
        Loop Until False
    End Function

    Public Function IntNthRoot(n As Integer, v As BigInteger) As BigInteger
        Dim digs As Integer = Math.Max(0, v.ToString().Length / n - 1)
        IntNthRoot = BigInteger.Parse(If(digs > 1, 3, 2).ToString() & StrDup(digs, "0"))
        Dim va As BigInteger, dr As BigInteger
        Do
            va = v : For i As Integer = 2 To n : va /= IntNthRoot : Next
            va -= IntNthRoot
            dr = va / n : If dr = 0 Then Exit Do
            IntNthRoot += dr
        Loop Until False
    End Function

    Public Sub Main()
        Dim b As BigInteger = BigInteger.Parse("2" & StrDup(4008, "0"))
        Console.WriteLine("Integer Cube Root of 8:")
        Console.WriteLine(IntNthRoot(3, 8).ToString()) 
        Console.WriteLine("Integer Cube Root of 9:")
        Console.WriteLine(IntNthRoot(3, 9).ToString()) 
        Console.WriteLine("Integer Square Root of 2, (actually 2 * 10 ^ 4008, square root method):")
        Console.WriteLine(IntSqRoot(b).ToString()) 
        Console.WriteLine("Integer Square Root of 2, (actually 2 * 10 ^ 4008, nth root method):")
        Console.WriteLine(IntNthRoot(2, b).ToString()) 
        Console.WriteLine("Integer Cube Root of 2, (actually 2 * 10 ^ 4008):")
        Console.WriteLine(IntNthRoot(3, b).ToString()) 
        b /= 10000
        Console.WriteLine("Integer 7th Root of 2, (actually 2 * 10 ^ 4004):")
        Console.WriteLine(IntNthRoot(7, b).ToString()) 
        If Diagnostics.Debugger.IsAttached Then Console.Read()
    End Sub

End Module
Task: Fairshare between two and more








VB: Module Module1

    Function Turn(base As Integer, n As Integer) As Integer
        Dim sum = 0
        While n <> 0
            Dim re = n Mod base
            n \= base
            sum += re
        End While
        Return sum Mod base
    End Function

    Sub Fairshare(base As Integer, count As Integer)
        Console.Write("Base {0,2}:", base)
        For i = 1 To count
            Dim t = Turn(base, i - 1)
            Console.Write(" {0,2}", t)
        Next
        Console.WriteLine()
    End Sub

    Sub TurnCount(base As Integer, count As Integer)
        Dim cnt(base) As Integer
        For i = 1 To base
            cnt(i - 1) = 0
        Next

        For i = 1 To count
            Dim t = Turn(base, i - 1)
            cnt(t) += 1
        Next

        Dim minTurn = Integer.MaxValue
        Dim maxTurn = Integer.MinValue
        Dim portion = 0
        For i = 1 To base
            Dim num = cnt(i - 1)
            If num > 0 Then
                portion += 1
            End If
            If num < minTurn Then
                minTurn = num
            End If
            If num > maxTurn Then
                maxTurn = num
            End If
        Next

        Console.Write("  With {0} people: ", base)
        If 0 = minTurn Then
            Console.WriteLine("Only {0} have a turn", portion)
        ElseIf minTurn = maxTurn Then
            Console.WriteLine(minTurn)
        Else
            Console.WriteLine("{0} or {1}", minTurn, maxTurn)
        End If
    End Sub

    Sub Main()
        Fairshare(2, 25)
        Fairshare(3, 25)
        Fairshare(5, 25)
        Fairshare(11, 25)

        Console.WriteLine("How many times does each get a turn in 50000 iterations?")
        TurnCount(191, 50000)
        TurnCount(1377, 50000)
        TurnCount(49999, 50000)
        TurnCount(50000, 50000)
        TurnCount(50001, 50000)
    End Sub

End Module
Task: RPG attributes generator








VB: Module Module1

    Dim r As New Random

    Function getThree(n As Integer) As List(Of Integer)
        getThree = New List(Of Integer)
        For i As Integer = 1 To 4 : getThree.Add(r.Next(n) + 1) : Next
        getThree.Sort() : getThree.RemoveAt(0)
    End Function

    Function getSix() As List(Of Integer)
        getSix = New List(Of Integer)
        For i As Integer = 1 To 6 : getSix.Add(getThree(6).Sum) : Next
    End Function

    Sub Main(args As String())
        Dim good As Boolean = False : Do
            Dim gs As List(Of Integer) = getSix(), gss As Integer = gs.Sum,
                hvc As Integer = gs.FindAll(Function(x) x > 14).Count
            Console.Write("attribs: {0}, sum={1}, ({2} sum, high vals={3})",
                          String.Join(", ", gs), gss, If(gss >= 75, "good", "low"), hvc)
            good = gs.Sum >= 75 AndAlso hvc > 1
            Console.WriteLine(" - {0}", If(good, "success", "failure"))
        Loop Until good
    End Sub
End Module
Task: Kolakoski sequence








VB: Imports System.Runtime.CompilerServices
Imports System.Text

Module Module1

    Class Crutch
        Public ReadOnly len As Integer
        Public s() As Integer
        Public i As Integer

        Public Sub New(len As Integer)
            Me.len = len
            s = New Integer(len - 1) {}
            i = 0
        End Sub

        Public Sub Repeat(count As Integer)
            For j = 1 To count
                i += 1
                If i = len Then
                    Return
                End If
                s(i) = s(i - 1)
            Next
        End Sub
    End Class

    <Extension()>
    Public Function NextInCycle(self As Integer(), index As Integer) As Integer
        Return self(index Mod self.Length)
    End Function

    <Extension()>
    Public Function Kolakoski(self As Integer(), len As Integer) As Integer()
        Dim c As New Crutch(len)

        Dim k = 0
        While c.i < len
            c.s(c.i) = self.NextInCycle(k)
            If c.s(k) > 1 Then
                c.Repeat(c.s(k) - 1)
            End If
            c.i += 1
            If c.i = len Then
                Return c.s
            End If
            k += 1
        End While

        Return c.s
    End Function

    <Extension()>
    Public Function PossibleKolakoski(self As Integer()) As Boolean
        Dim rle(self.Length) As Integer
        Dim prev = self(0)
        Dim count = 1
        Dim pos = 0
        For i = 2 To self.Length
            If self(i - 1) = prev Then
                count += 1
            Else
                rle(pos) = count
                pos += 1

                count = 1
                prev = self(i - 1)
            End If
        Next
        REM no point adding final 
        For i = 1 To pos
            If rle(i - 1) <> self(i - 1) Then
                Return False
            End If
        Next
        Return True
    End Function

    <Extension()>
    Public Function AsString(self As Integer()) As String
        Dim sb As New StringBuilder("[")
        Dim it = self.GetEnumerator()
        If it.MoveNext Then
            sb.Append(it.Current)
        End If
        While it.MoveNext
            sb.Append(", ")
            sb.Append(it.Current)
        End While
        Return sb.Append("]").ToString
    End Function

    Sub Main()
        Dim ias()() As Integer = {New Integer() {1, 2}, New Integer() {2, 1}, New Integer() {1, 3, 1, 2}, New Integer() {1, 3, 2, 1}}
        Dim lens() As Integer = {20, 20, 30, 30}

        For i = 1 To ias.Length
            Dim len = lens(i - 1)
            Dim kol = ias(i - 1).Kolakoski(len)

            Console.WriteLine("First {0} members of the sequence by {1}: ", len, ias(i - 1).AsString)
            Console.WriteLine(kol.AsString)
            Console.WriteLine("Possible Kolakoski sequence? {0}", kol.PossibleKolakoski)
            Console.WriteLine()
        Next
    End Sub

End Module
Task: Variable declaration reset








VB: Option Strict On
Option Explicit On

Imports System.IO

Module vMain

    Public Sub Main
        Dim s As Integer() = New Integer(){1, 2, 2, 3, 4, 4, 5}
        For i As Integer = 0 To Ubound(s)
            Dim curr As Integer = s(i)
            Dim prev As Integer
            If i > 1 AndAlso curr = prev Then
                  Console.Out.WriteLine(i)
            End If
            prev = curr
        Next i
    End Sub

End Module
Task: Longest increasing subsequence








VB: Sub Lis(arr() As Integer)
    Dim As Integer lb = Lbound(arr), ub = Ubound(arr)
    Dim As Integer i, lo, hi, mitad, newl, l = 0
	Dim As Integer p(ub), m(ub)
    
	For i = lb To ub
		lo = 1
		hi = l
		Do While lo <= hi
			mitad = Int((lo+hi)/2)
			If arr(m(mitad)) < arr(i) Then
				lo = mitad + 1
            Else
				hi = mitad - 1
            End If
        Loop
		newl = lo
		p(i) = m(newl-1)
		m(newl) = i
		If newL > l Then l = newl
    Next i
    
    Dim As Integer res(l)
	Dim As Integer k = m(l)
	For i = l-1 To 0 Step - 1
		res(i) = arr(k)
		k = p(k)
    Next i
	
    For i = Lbound(res) To Ubound(res)-1
        Print res(i); " ";
    Next i
End Sub

Dim As Integer arrA(5) => {3,2,6,4,5,1}
Lis(arrA())
Print
Dim As Integer arrB(15) => {0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15}
Lis(arrB())

Sleep
Task: Words from neighbour ones








VB: with createobject("ADODB.Stream")
  .charset ="UTF-8"
  .open
  .loadfromfile("unixdict.txt")
  s=.readtext
end with  
a=split (s,vblf)
set d=createobject("scripting.dictionary")
redim b(ubound(a))
i=0
for each x in a
  s=trim(x)
  if len(s)>=9 then 
    if len(s)= 9 then d.add s,""
    b(i)=s
    i=i+1   
  end if
next
redim preserve b(i-1)
wscript.echo i
j=1
for i=0 to ubound(b)-9
  s9=mid(b(i+0),1,1)& mid(b(i+1),2,1)& mid(b(i+2),3,1)& mid(b(i+3),4,1)& mid(b(i+4),5,1)&_
  mid(b(i+5),6,1)& mid(b(i+6),7,1)& mid(b(i+7),8,1)& mid(b(i+8),9,1)
  
  if d.exists(s9) then 
    wscript.echo j,s9
    d.remove(s9)
    j=j+1
  end if 
next
Task: Square root by hand








VB: Imports System.Math, System.Console, BI = System.Numerics.BigInteger

Module Module1

    Sub Main(ByVal args As String())
        Dim i, j, k, d As BI : i = 2
        j = CType(Floor(Sqrt(CDbl(i))), BI) : k = j : d = j
        Dim n As Integer = -1, n0 As Integer = -1,
            st As DateTime = DateTime.Now
        If args.Length > 0 Then Integer.TryParse(args(0), n)
        If n > 0 Then n0 = n Else n = 1
        Do
            Write(d) : i = (i - k * d) * 100 : k = 20 * j
            For d = 1 To 10
                If (k + d) * d > i Then d -= 1 : Exit For
            Next
            j = j * 10 + d : k += d : If n0 > 0 Then n = n - 1
        Loop While n > 0
        If n0 > 0 Then WriteLine (VbLf & "Time taken for {0} digits: {1}", n0, DateTime.Now - st)
    End Sub
End Module