WeixiangYan/CodeTransOcean huggingface dataset:
Task: Cipolla's algorithm








VB: Imports System.Numerics

Module Module1

    ReadOnly BIG = BigInteger.Pow(10, 50) + 151

    Function C(ns As String, ps As String) As Tuple(Of BigInteger, BigInteger, Boolean)
        Dim n = BigInteger.Parse(ns)
        Dim p = If(ps.Length > 0, BigInteger.Parse(ps), BIG)

        
        Dim ls = Function(a0 As BigInteger) BigInteger.ModPow(a0, (p - 1) / 2, p)

        
        If ls(n) <> 1 Then
            Return Tuple.Create(BigInteger.Zero, BigInteger.Zero, False)
        End If

        
        Dim a = BigInteger.Zero
        Dim omega2 As BigInteger
        Do
            omega2 = (a * a + p - n) Mod p
            If ls(omega2) = p - 1 Then
                Exit Do
            End If
            a += 1
        Loop

        
        Dim mul = Function(aa As Tuple(Of BigInteger, BigInteger), bb As Tuple(Of BigInteger, BigInteger))
                      Return Tuple.Create((aa.Item1 * bb.Item1 + aa.Item2 * bb.Item2 * omega2) Mod p, (aa.Item1 * bb.Item2 + bb.Item1 * aa.Item2) Mod p)
                  End Function

        
        Dim r = Tuple.Create(BigInteger.One, BigInteger.Zero)
        Dim s = Tuple.Create(a, BigInteger.One)
        Dim nn = ((p + 1) >> 1) Mod p
        While nn > 0
            If nn Mod 2 = 1 Then
                r = mul(r, s)
            End If
            s = mul(s, s)
            nn >>= 1
        End While

        
        If r.Item2 <> 0 Then
            Return Tuple.Create(BigInteger.Zero, BigInteger.Zero, False)
        End If

        
        If r.Item1 * r.Item1 Mod p <> n Then
            Return Tuple.Create(BigInteger.Zero, BigInteger.Zero, False)
        End If

        
        Return Tuple.Create(r.Item1, p - r.Item1, True)
    End Function

    Sub Main()
        Console.WriteLine(C("10", "13"))
        Console.WriteLine(C("56", "101"))
        Console.WriteLine(C("8218", "10007"))
        Console.WriteLine(C("8219", "10007"))
        Console.WriteLine(C("331575", "1000003"))
        Console.WriteLine(C("665165880", "1000000007"))
        Console.WriteLine(C("881398088036", "1000000000039"))
        Console.WriteLine(C("34035243914635549601583369544560650254325084643201", ""))
    End Sub

End Module
Task: Partition an integer x into n primes








VB: 
    dim p(),a(32),b(32),v,g: redim p(64)
    what="99809 1  18 2  19 3  20 4  2017 24  22699 1-4  40355 3"
    t1=split(what,"  ")
    for j=0 to ubound(t1)
        t2=split(t1(j)): x=t2(0): n=t2(1)
        t3=split(x,"-"): x=clng(t3(0))
        if ubound(t3)=1 then y=clng(t3(1)) else y=x
        t3=split(n,"-"): n=clng(t3(0))
        if ubound(t3)=1 then m=clng(t3(1)) else m=n
        genp y 
        for g=x to y
            for q=n to m: part: next 
        next 
    next 

sub genp(high)
    p(1)=2: p(2)=3: c=2: i=p(c)+2
    do 
        k=2: bk=false
        do while k*k<=i and not bk 
            if i mod p(k)=0 then bk=true
            k=k+1
        loop 
        if not bk then
            c=c+1: if c>ubound(p) then redim preserve p(ubound(p)+8)
            p(c)=i
        end if
        i=i+2
    loop until p(c)>high 
end sub 

sub getp(z)
    if a(z)=0 then w=z-1: a(z)=a(w)
    a(z)=a(z)+1: w=a(z): b(z)=p(w)
end sub 

function list()
    w=b(1)
    if v=g then for i=2 to q: w=w&"+"&b(i): next else w="(not possible)"
    list="primes: "&w
end function 

sub part()
    for i=lbound(a) to ubound(a): a(i)=0: next 
    for i=1 to q: call getp(i): next 
    do while true: v=0: bu=false
        for s=1 to q
            v=v+b(s)
            if v>g then
                if s=1 then exit do
                for k=s to q: a(k)=0: next 
                for r=s-1 to q: call getp(r): next 
                bu=true: exit for
            end if
        next 
        if not bu then
            if v=g then exit do
            if v<g then call getp(q)
        end if    
    loop
    wscript.echo "partition "&g&" into "&q&" "&list
end sub
Task: Bilinear interpolation








VB: Imports System.Drawing

Module Module1

    Function Lerp(s As Single, e As Single, t As Single) As Single
        Return s + (e - s) * t
    End Function

    Function Blerp(c00 As Single, c10 As Single, c01 As Single, c11 As Single, tx As Single, ty As Single) As Single
        Return Lerp(Lerp(c00, c10, tx), Lerp(c01, c11, tx), ty)
    End Function

    Function Scale(self As Bitmap, scaleX As Single, scaleY As Single) As Image
        Dim newWidth = CInt(Math.Floor(self.Width * scaleX))
        Dim newHeight = CInt(Math.Floor(self.Height * scaleY))
        Dim newImage As New Bitmap(newWidth, newHeight, self.PixelFormat)

        For x = 0 To newWidth - 1
            For y = 0 To newHeight - 1
                Dim gx = CSng(x) / newWidth * (self.Width - 1)
                Dim gy = CSng(y) / newHeight * (self.Height - 1)
                Dim gxi = CInt(Math.Floor(gx))
                Dim gyi = CInt(Math.Floor(gy))
                Dim c00 = self.GetPixel(gxi, gyi)
                Dim c10 = self.GetPixel(gxi + 1, gyi)
                Dim c01 = self.GetPixel(gxi, gyi + 1)
                Dim c11 = self.GetPixel(gxi + 1, gyi + 1)

                Dim red = CInt(Blerp(c00.R, c10.R, c01.R, c11.R, gx - gxi, gy - gyi))
                Dim green = CInt(Blerp(c00.G, c10.G, c01.G, c11.G, gx - gxi, gy - gyi))
                Dim blue = CInt(Blerp(c00.B, c10.B, c01.B, c11.B, gx - gxi, gy - gyi))
                Dim rgb = Color.FromArgb(red, green, blue)

                newImage.SetPixel(x, y, rgb)
            Next
        Next

        Return newImage
    End Function

    Sub Main()
        Dim newImage = Image.FromFile("Lenna100.jpg")
        If TypeOf newImage Is Bitmap Then
            Dim oi As Bitmap = newImage
            Dim result = Scale(oi, 1.6, 1.6)
            result.Save("Lenna100_larger.jpg")
        Else
            Console.WriteLine("Could not open the source file.")
        End If
    End Sub

End Module
Task: Prime conspiracy








VB: Option Explicit

Sub Main()
Dim Dict As Object, L() As Long
Dim t As Single

   Init Dict
   L = ListPrimes(100000000)
t = Timer
   PrimeConspiracy L, Dict, 1000000
Debug.Print "----------------------------"
Debug.Print "Execution time : " & Format(Timer - t, "0.000s.")
Debug.Print ""
   Init Dict
t = Timer
   PrimeConspiracy L, Dict, 5000000
Debug.Print "----------------------------"
Debug.Print "Execution time : " & Format(Timer - t, "0.000s.")
End Sub

Private Function ListPrimes(MAX As Long) As Long()

Dim t() As Boolean, L() As Long, c As Long, s As Long, i As Long, j As Long
    ReDim t(2 To MAX)
    ReDim L(MAX \ 2)
    s = Sqr(MAX)
    For i = 3 To s Step 2
        If t(i) = False Then
            For j = i * i To MAX Step i
                t(j) = True
            Next
        End If
    Next i
    L(0) = 2
    For i = 3 To MAX Step 2
        If t(i) = False Then
            c = c + 1
            L(c) = i
        End If
    Next i
    ReDim Preserve L(c)
    ListPrimes = L
End Function

Private Sub Init(d As Object)
   Set d = CreateObject("Scripting.Dictionary")
   d("1 to 1") = 0
   d("1 to 3") = 0
   d("1 to 7") = 0
   d("1 to 9") = 0
   d("2 to 3") = 0
   d("3 to 1") = 0
   d("3 to 3") = 0
   d("3 to 5") = 0
   d("3 to 7") = 0
   d("3 to 9") = 0
   d("5 to 7") = 0
   d("7 to 1") = 0
   d("7 to 3") = 0
   d("7 to 7") = 0
   d("7 to 9") = 0
   d("9 to 1") = 0
   d("9 to 3") = 0
   d("9 to 7") = 0
   d("9 to 9") = 0
End Sub

Private Sub PrimeConspiracy(Primes() As Long, Dict As Object, Nb)
Dim n As Long, temp As String, r, s, K
   For n = LBound(Primes) To Nb
      r = CStr((Primes(n)))
      s = CStr((Primes(n + 1)))
      temp = Right(r, 1) & " to " & Right(s, 1)
      If Dict.Exists(temp) Then Dict(temp) = Dict(temp) + 1
   Next
   Debug.Print Nb & " primes, last prime considered: " & Primes(Nb)
   Debug.Print "Transition  Count     Frequency"
   Debug.Print "==========  =======   ========="
   For Each K In Dict.Keys
      Debug.Print K & "      " & Right("      " & Dict(K), 6) & "    " & Dict(K) / Nb * 100 & "%"
   Next
End Sub
Task: Statistics_Normal distribution








VB: Public Sub standard_normal()
    Dim s() As Variant, bins(71) As Single
    ReDim s(20000)
    For i = 1 To 20000
        s(i) = WorksheetFunction.Norm_S_Inv(Rnd())
    Next i
    For i = -35 To 35
        bins(i + 36) = i / 10
    Next i
    Debug.Print "sample size"; UBound(s), "mean"; mean(s), "standard deviation"; standard_deviation(s)
            t = WorksheetFunction.Frequency(s, bins)
    For i = -35 To 35
        Debug.Print Format((i - 1) / 10, "0.00");
        Debug.Print "-"; Format(i / 10, "0.00"),
        Debug.Print String$(t(i + 36, 1) / 10, "X");
        Debug.Print
    Next i
End Sub
Task: Minimum positive multiple in base 10 using only 0 and 1








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

Module Module1

    Dim fmt As String = "{0,4} * {1,31:n0} = {2,-28}" & vbLf

    Sub B10(ByVal n As Integer)
        If n <= 1 Then Return
        Dim pow As Integer() = New Integer(n) {},
            val As Integer() = New Integer(n) {},
            count As Integer = 0, ten As Integer = 1, x As Integer = 1
        While x <= n : val(x) = ten : For j As Integer = 0 To n
                If pow(j) <> 0 AndAlso pow((j + ten) Mod n) = 0 AndAlso _
                   pow(j) <> x Then pow((j + ten) Mod n) = x
            Next : If pow(ten) = 0 Then pow(ten) = x
            ten = (10 * ten) Mod n : If pow(0) <> 0 Then
                x = n : Dim s As String = "" : While x <> 0
                    Dim p As Integer = pow(x Mod n)
                    If count > p Then s += New String("0"c, count - p)
                    count = p - 1 : s += "1"
                    x = (n + x - val(p)) Mod n : End While
                If count > 0 Then s += New String("0"c, count)
                Write(fmt, n, Decimal.Parse(s) / n, s) : Return
            End If : x += 1 : End While : Write("Can
    End Sub

    Sub Main(ByVal args As String())
        Dim st As DateTime = DateTime.Now
        Dim m As List(Of Integer) = New List(Of Integer) From _
            {297,576,594,891,909,999,1998,2079,2251,2277,2439,2997,4878}
        Write(fmt, "n", "multiplier", "B10")
        WriteLine(New String("-"c, 69)) : Write(fmt, 1, 1, 1)
        For n As Integer = 1 To m.Last()
            If n <= 10 OrElse n >= 95 AndAlso n <= 105 OrElse m.Contains(n) Then B10(n)
        Next : WriteLine(vbLf & "Took {0}ms", (DateTime.Now - st).TotalMilliseconds)
    End Sub
End Module
Task: Print debugging statement








VB: #if __FB_DEBUG__ <> 0
    #print Debug mode 
    Dim err_command_line As Ubyte
    err_command_line = __fb_err__
    Select Case err_command_line
    Case 0
        Print "No Error Checking enabled on the Command Line!"
    Case 1
        Print "Some Error Checking enabled on the Command Line!"
    Case 3
        Print "QBasic style Error Checking enabled on the Command Line!"
    Case 7
        Print "Extreme Error Checking enabled on the Command Line!"
    Case Else
        Print "Some Unknown Error level has been set!"
    End Select
#else 
    #print Release mode 
#endif

Sleep
Task: Zumkeller numbers








VB: Module Module1
    Function GetDivisors(n As Integer) As List(Of Integer)
        Dim divs As New List(Of Integer) From {
            1, n
        }
        Dim i = 2
        While i * i <= n
            If n Mod i = 0 Then
                Dim j = n \ i
                divs.Add(i)
                If i <> j Then
                    divs.Add(j)
                End If
            End If
            i += 1
        End While
        Return divs
    End Function

    Function IsPartSum(divs As List(Of Integer), sum As Integer) As Boolean
        If sum = 0 Then
            Return True
        End If
        Dim le = divs.Count
        If le = 0 Then
            Return False
        End If
        Dim last = divs(le - 1)
        Dim newDivs As New List(Of Integer)
        For i = 1 To le - 1
            newDivs.Add(divs(i - 1))
        Next
        If last > sum Then
            Return IsPartSum(newDivs, sum)
        End If
        Return IsPartSum(newDivs, sum) OrElse IsPartSum(newDivs, sum - last)
    End Function

    Function IsZumkeller(n As Integer) As Boolean
        Dim divs = GetDivisors(n)
        Dim sum = divs.Sum()
        REM if sum is odd can
        If sum Mod 2 = 1 Then
            Return False
        End If
        REM if n is odd use 
        If n Mod 2 = 1 Then
            Dim abundance = sum - 2 * n
            Return abundance > 0 AndAlso abundance Mod 2 = 0
        End If
        REM if n and sum are both even check if there
        Return IsPartSum(divs, sum \ 2)
    End Function

    Sub Main()
        Console.WriteLine("The first 220 Zumkeller numbers are:")
        Dim i = 2
        Dim count = 0
        While count < 220
            If IsZumkeller(i) Then
                Console.Write("{0,3} ", i)
                count += 1
                If count Mod 20 = 0 Then
                    Console.WriteLine()
                End If
            End If
            i += 1
        End While
        Console.WriteLine()

        Console.WriteLine("The first 40 odd Zumkeller numbers are:")
        i = 3
        count = 0
        While count < 40
            If IsZumkeller(i) Then
                Console.Write("{0,5} ", i)
                count += 1
                If count Mod 10 = 0 Then
                    Console.WriteLine()
                End If
            End If
            i += 2
        End While
        Console.WriteLine()

        Console.WriteLine("The first 40 odd Zumkeller numbers which don
        i = 3
        count = 0
        While count < 40
            If i Mod 10 <> 5 AndAlso IsZumkeller(i) Then
                Console.Write("{0,7} ", i)
                count += 1
                If count Mod 8 = 0 Then
                    Console.WriteLine()
                End If
            End If
            i += 2
        End While
    End Sub
End Module
Task: Commatizing numbers








VB: Public Sub commatize(s As String, Optional sep As String = ",", Optional start As Integer = 1, Optional step As Integer = 3)
    Dim l As Integer: l = Len(s)
        For i = start To l
            If Asc(Mid(s, i, 1)) >= Asc("1") And Asc(Mid(s, i, 1)) <= Asc("9") Then
                For j = i + 1 To l + 1
                    If j > l Then
                        For k = j - 1 - step To i Step -step
                            s = Mid(s, 1, k) & sep & Mid(s, k + 1, l - k + 1)
                            l = Len(s)
                        Next k
                        Exit For
                    Else
                        If (Asc(Mid(s, j, 1)) < Asc("0") Or Asc(Mid(s, j, 1)) > Asc("9")) Then
                            For k = j - 1 - step To i Step -step
                                s = Mid(s, 1, k) & sep & Mid(s, k + 1, l - k + 1)
                                l = Len(s)
                            Next k
                            Exit For
                        End If
                    End If
                Next j
                Exit For
            End If
        Next i
        Debug.Print s
    End Sub
Public Sub main()
    commatize "pi=3.14159265358979323846264338327950288419716939937510582097494459231", " ", 6, 5
    commatize "The author has two Z$100000000000000 Zimbabwe notes (100 trillion).", "."
    commatize """-in Aus$+1411.8millions"""
    commatize "===US$0017440 millions=== (in 2000 dollars)"
    commatize "123.e8000 is pretty big."
    commatize "The land area of the earth is 57268900(29% of the surface) square miles."
    commatize "Ain
    commatize "James was never known as 0000000007"
    commatize "Arthur Eddington wrote: I believe there are 15747724136275002577605653961181555468044717914527116709366231425076185631031296 protons in the universe."
    commatize "   $-140000±100 millions."
    commatize "6/9/1946 was a good year for some."
End Sub
Task: Kosaraju








VB: Module Module1

    Function Kosaraju(g As List(Of List(Of Integer))) As List(Of Integer)
        Dim size = g.Count
        Dim vis(size - 1) As Boolean
        Dim l(size - 1) As Integer
        Dim x = size

        Dim t As New List(Of List(Of Integer))
        For i = 1 To size
            t.Add(New List(Of Integer))
        Next

        Dim visit As Action(Of Integer) = Sub(u As Integer)
                                              If Not vis(u) Then
                                                  vis(u) = True
                                                  For Each v In g(u)
                                                      visit(v)
                                                      t(v).Add(u)
                                                  Next
                                                  x -= 1
                                                  l(x) = u
                                              End If
                                          End Sub

        For i = 1 To size
            visit(i - 1)
        Next
        Dim c(size - 1) As Integer

        Dim assign As Action(Of Integer, Integer) = Sub(u As Integer, root As Integer)
                                                        If vis(u) Then
                                                            vis(u) = False
                                                            c(u) = root
                                                            For Each v In t(u)
                                                                assign(v, root)
                                                            Next
                                                        End If
                                                    End Sub

        For Each u In l
            assign(u, u)
        Next

        Return c.ToList
    End Function

    Sub Main()
        Dim g = New List(Of List(Of Integer)) From {
            New List(Of Integer) From {1},
            New List(Of Integer) From {2},
            New List(Of Integer) From {0},
            New List(Of Integer) From {1, 2, 4},
            New List(Of Integer) From {3, 5},
            New List(Of Integer) From {2, 6},
            New List(Of Integer) From {5},
            New List(Of Integer) From {4, 6, 7}
        }

        Dim output = Kosaraju(g)
        Console.WriteLine("[{0}]", String.Join(", ", output))
    End Sub

End Module
Task: Word break problem








VB: Module Module1

    Structure Node
        Private ReadOnly m_val As String
        Private ReadOnly m_parsed As List(Of String)

        Sub New(initial As String)
            m_val = initial
            m_parsed = New List(Of String)
        End Sub

        Sub New(s As String, p As List(Of String))
            m_val = s
            m_parsed = p
        End Sub

        Public Function Value() As String
            Return m_val
        End Function

        Public Function Parsed() As List(Of String)
            Return m_parsed
        End Function
    End Structure

    Function WordBreak(s As String, dictionary As List(Of String)) As List(Of List(Of String))
        Dim matches As New List(Of List(Of String))
        Dim q As New Queue(Of Node)
        q.Enqueue(New Node(s))
        While q.Count > 0
            Dim node = q.Dequeue()
            REM check if fully parsed
            If node.Value.Length = 0 Then
                matches.Add(node.Parsed)
            Else
                For Each word In dictionary
                    REM check for match
                    If node.Value.StartsWith(word) Then
                        Dim valNew = node.Value.Substring(word.Length, node.Value.Length - word.Length)
                        Dim parsedNew As New List(Of String)
                        parsedNew.AddRange(node.Parsed)
                        parsedNew.Add(word)
                        q.Enqueue(New Node(valNew, parsedNew))
                    End If
                Next
            End If
        End While
        Return matches
    End Function

    Sub Main()
        Dim dict As New List(Of String) From {"a", "aa", "b", "ab", "aab"}
        For Each testString In {"aab", "aa b"}
            Dim matches = WordBreak(testString, dict)
            Console.WriteLine("String = {0}, Dictionary = {1}. Solutions = {2}", testString, dict, matches.Count)
            For Each match In matches
                Console.WriteLine(" Word Break = [{0}]", String.Join(", ", match))
            Next
            Console.WriteLine()
        Next

        dict = New List(Of String) From {"abc", "a", "ac", "b", "c", "cb", "d"}
        For Each testString In {"abcd", "abbc", "abcbcd", "acdbc", "abcdd"}
            Dim matches = WordBreak(testString, dict)
            Console.WriteLine("String = {0}, Dictionary = {1}. Solutions = {2}", testString, dict, matches.Count)
            For Each match In matches
                Console.WriteLine(" Word Break = [{0}]", String.Join(", ", match))
            Next
            Console.WriteLine()
        Next
    End Sub

End Module
Task: Double Twin Primes








VB: #include "isPrime.kbs"

num = 3
while num < 992
	if isPrime(num) then
		if isPrime(num+2) then
			if isPrime(num+6) then
				if isPrime(num+8) then print num; " "; num+2; " "; num+6; " "; num+8
			end if
		end if
	end if
	num += 2
end while
end
Task: Factorial primes








VB: #include "isprime.bas"
#include "factorial.bas"

Print "First 10 factorial primes:"
Dim As Integer found = 0, i = 1
While found < 10
    Dim As Integer fct = factorial (i)
    
    If isprime(fct-1) Then
        found += 1
        Print Using "##: ##_! - 1 = &"; found; i; fct-1
    End If
    If isprime(fct+1) Then
        found += 1
        Print Using "##: ##_! + 1 = &"; found; i; fct+1
    End If
    i += 1
Wend
Sleep
Task: Ormiston pairs








VB: #include "isprime.bas"

Function GetSig(Byval N As Integer) As Integer
    Dim As Integer Sig = 0
    Do While N > 0
        Sig += 1 Shl (N Mod 10)
        N \= 10
    Loop
    Return Sig
End Function

Dim As Integer Cnt = 0, N0 = 0, Sig0 = 0, N = 3, Sig
Do
    If isPrime(N) Then
        Sig = GetSig(N)
        If Sig = Sig0 Then
            Cnt += 1
            If Cnt <= 30 Then
                Print Using "##### #####"; N0; N;
                If Cnt Mod 3 = 0 Then Print Else Print "   ";
            End If
        End If
        Sig0 = Sig
        N0 = N
    End If
    If N = 1e5 -1 Then Print !"\nOrmiston pairs up to one hundred thousand: "; Cnt
    If N = 1e6 -1 Then Print "Ormiston pairs up to one million: "; Cnt
    If N = 1e7 -1 Then Print "Ormiston pairs up to ten million: "; Cnt: Exit Do
    N += 2      
Loop

Sleep
Task: Gauss-Jordan matrix inversion








VB: Private Function inverse(mat As Variant) As Variant
    Dim len_ As Integer: len_ = UBound(mat)
    Dim tmp() As Variant
    ReDim tmp(2 * len_ + 1)
    Dim aug As Variant
    ReDim aug(len_)
    For i = 0 To len_
        If UBound(mat(i)) <> len_ Then Debug.Print 9 / 0 
        aug(i) = tmp
        For j = 0 To len_
            aug(i)(j) = mat(i)(j)
        Next j
        
        aug(i)(i + len_ + 1) = 1
    Next i
    aug = ToReducedRowEchelonForm(aug)
    Dim inv As Variant
    inv = mat
    
    For i = 0 To len_
        For j = len_ + 1 To 2 * len_ + 1
            inv(i)(j - len_ - 1) = aug(i)(j)
        Next j
    Next i
    inverse = inv
End Function
 
Public Sub main()
    Dim test As Variant
    test = inverse(Array( _
        Array(2, -1, 0), _
        Array(-1, 2, -1), _
        Array(0, -1, 2)))
    For i = LBound(test) To UBound(test)
        For j = LBound(test(0)) To UBound(test(0))
            Debug.Print test(i)(j),
        Next j
    Debug.Print
    Next i
End Sub