The below algorithms I used to solve problems from https://projecteuler.net/ website
The following algorithm is used to add, subract, multiply and divide big numbers with n digits.
Private Sub Adding_BigNumbers(ByRef A As List(Of Integer), ByRef B As List(Of Integer), ByRef C As List(Of Integer))
'******* SIMPLE ADDITION ALGORITHM FOR ADDING ANY NUMBER OF DIGITS developed by Samson Mano ********
'**** Input variable A & B is readonly no changes made, c will have the result ****
'**** A (11253) should be stored as 3 5 2 1 1 and B (9825) should be stored as 5 2 8 9 and the result C (21078) will be given as 8 7 0 1 2 ****
'________________________________________________________________________________________________________________________________________________
'------ Step 1 -> Make both numbers have equal number of digits
If A.Count > B.Count Then
Do
If A.Count = B.Count Then
Exit Do
End If
B.Add(0)
Loop
Else
Do
If A.Count = B.Count Then
Exit Do
End If
A.Add(0)
Loop
End If
'----- Step 2 -> Normal addition A + B = C
C = New List(Of Integer)
Dim carry_over As Integer = 0
Dim interim_value As Integer = 0
For i As Integer = 0 To (A.Count - 1) Step +1
interim_value = A(i) + B(i) + carry_over '---- Adding both value with carry over
If interim_value > 9 Then '--- checking for double digit result
C.Add(interim_value - 10) '---- removing the double digit to single digit
carry_over = 1
Else
C.Add(interim_value)
carry_over = 0
End If
Next
If carry_over <> 0 Then
C.Add(1)
End If
End Sub
Private Function Compare_BigNumbers(ByRef A As List(Of Integer), ByRef B As List(Of Integer)) As Integer
'******* COMPARE ALGORITHM FOR ANY NUMBER OF DIGITS developed by Samson Mano *******
'**** Input variable A & B Return 1 if A is Bigger Return -1 if B is bigger and Return 0 if A = B ****
'__________________________________________________________________________________________________________________
If A.Count > B.Count Then
Return 1 '----- A is Bigger
Exit Function
ElseIf A.Count = B.Count Then
For i As Integer = (A.Count - 1) To 0 Step -1
If A(i) = B(i) Then
If i = 0 Then
Return 0 '----- A = B
Exit Function
End If
Continue For
Else
If A(i) > B(i) Then
Return 1 '----- A is Bigger
Exit Function
Else
Return -1 '----- B is Bigger
Exit Function
End If
End If
Next
ElseIf A.Count < B.Count Then
Return -1 '----- B is Bigger
Exit Function
End If
End Function
Private Sub Subracting_BigNumbers(ByRef A As List(Of Integer), ByRef B As List(Of Integer), ByRef C As List(Of Integer))
'******* SUBRACTION ALGORITHM FOR ANY NUMBER OF DIGITS developed by Samson Mano *******
'**** Input variable A & B if and only A>B is readonly no changes made, c will have the result ****
'**** A (1234) should be stored as 4 3 2 1 and B (56) should be stored as 6 5 and the result C (1178) will be given as 8 7 1 1 ****
'________________________________________________________________________________________________________________________________________________
'----- Step 0 -> Aligning values
If A.Count > B.Count Then
Do
If B.Count = A.Count Then Exit Do
B.Add(0)
Loop
ElseIf A.Count < B.Count Then
Do
If A.Count = B.Count Then Exit Do
A.Add(0)
Loop
Dim B_temp As New List(Of Integer)
B_temp = B
B = A
A = B_temp
ElseIf A.Count = B.Count Then
If A(0) < B(0) Then
Dim B_temp As New List(Of Integer)
B_temp = B
B = A
A = B_temp
End If
End If
'----- Step M -> Subraction Main Algorithm
C = New List(Of Integer)
Dim Diff As Integer
For i As Integer = 0 To (A.Count - 1) Step +1
Diff = A(i) - B(i)
If Diff < 0 Then
If i <> (A.Count - 1) Then
A(i + 1) = A(i + 1) - 1
End If
Diff = Diff + 10
End If
C.Add(Diff)
Next
'------ Final step -> remove prefix zeroes -----
Dim n As Integer = (C.Count - 1)
Do
If C(n) = 0 Then
C.RemoveAt(n)
Else
Exit Do
End If
n = n - 1
Loop
End Sub
Private Sub Multiplying_BigNumbers(ByRef A As List(Of Integer), ByRef B As List(Of Integer), ByRef C As List(Of Integer))
'******* MULTIPLICATION ALGORITHM FOR ANY NUMBER OF DIGITS developed by Samson Mano *******
'**** Input variable A & B is readonly no changes made, c will have the result ****
'**** A (1234) should be stored as 4 3 2 1 and B (56) should be stored as 6 5 and the result C (69104) will be given as 4 0 1 9 6 ****
'**** Algorithm works based on Lattice method of multiplication by Fibonacci's Liber Abaci ******
'________________________________________________________________________________________________________________________________________________
Dim Diag((A.Count + B.Count) - 1) As List(Of Integer)
'----- Step 0 -> Initializing Variables
For m As Integer = 0 To ((A.Count + B.Count) - 1) Step +1
Diag(m) = New List(Of Integer)
Next
C = New List(Of Integer)
'------ Step 1 -> Forming the lattice ------
Dim interim_V As Integer
Dim D_1s As Integer
Dim D_10s As Integer
For i As Integer = 0 To (A.Count - 1) Step +1
For j As Integer = (B.Count - 1) To 0 Step -1
interim_V = A(i) * B(j)
D_1s = interim_V Mod 10
D_10s = (interim_V - D_1s) / 10
Diag(i + j).Add(D_1s)
Diag(i + j + 1).Add(D_10s)
Next
Next
'------ Step 2 -> Summing the lattice ------
Dim Diag_Sum As New List(Of Integer)
For k As Integer = 0 To ((A.Count + B.Count) - 1) Step +1
Diag_Sum.Add(Diag(k).Sum)
Next
'------ Step 3 -> Fixing final values ------
Dim carry_over As Integer = 0
D_10s = 0
D_1s = 0
interim_V = 0
For Each DS In Diag_Sum
D_1s = DS Mod 10
interim_V = D_1s + D_10s + carry_over
If interim_V > 9 Then
interim_V = interim_V - 10
carry_over = 1
Else
carry_over = 0
End If
C.Add(interim_V)
D_10s = (DS - D_1s) / 10
Next
C.Add(D_10s + carry_over)
'------ Final step -> remove prefix zeroes -----
Dim n As Integer = (C.Count - 1)
Do
If C(n) = 0 Then
C.RemoveAt(n)
Else
Exit Do
End If
n = n - 1
Loop
End Sub
Private Sub NonEconomical_DivisionAlgor(ByRef A As List(Of Integer), ByRef B As List(Of Integer), ByRef ND As Integer, ByRef C As List(Of Integer), ByRef Dec_Loc As Integer, Optional ByRef C_Str As String = "")
'******* DIVISION ALGORITHM FOR ANY NUMBER OF DIGITS developed by Samson Mano *******
'**** Input variable A & B no changes made to A & B , ND as required number of digits ___ C will have the result, Dec_Loc contains the decimal point ****
'**** A (1234) should be stored as 4 3 2 1 and B (56) should be stored as 6 5, for ND = 8 the result C (22.035714) will be given as 2 2 0 3 5 7 1 4, Dec_Loc = 2 ****
'____________________________________________________________________________________________________________________________________________________________________
'--------- Make both digits equal --------- Initial step to find the decimal location and fixing the algorithm to work
Dec_Loc = 0
If A.Count > B.Count Then
Do Until A.Count = B.Count
B.Insert(0, 0) '--- Add zero at end of digits
Dec_Loc = Dec_Loc + 1
Loop
If Compare_BigNumbers(A, B) <= 0 Then '--- If we overshoot the adding zeroes, reduce one zero at the end
B.RemoveAt(0) '--- Remove only one zero
Dec_Loc = Dec_Loc - 1
End If
ElseIf A.Count <= B.Count Then
'C.Add(0)
Do Until A.Count = B.Count
A.Insert(0, 0) '--- Add zero at end of digits
C.Add(0)
Loop
If Compare_BigNumbers(A, B) <= 0 Then '--- If we didn't reach the exact zeroes, add onemore
A.Insert(0, 0) '--- Add zero at end of digits
C.Add(0)
End If
Dec_Loc = 0
End If
'--------------------------------------------- Now we have A and B in the form of B x TQ = A where 1= < TQ <= 9
Dim NumA As New List(Of Integer) '--- Changing A to temporary location to preserve A data
Dim DiffV As New List(Of Integer) '--- Stores difference between NumA and B
For Each A_V In A
NumA.Add(A_V)
Next
Dim i As Integer
Do Until C.Count > ND
If NumA.Count <= B.Count Then
Dim Z_Counter As Integer = -2
Do Until NumA.Count = B.Count
NumA.Insert(0, 0)
Z_Counter = Z_Counter + 1
Loop
If Compare_BigNumbers(NumA, B) <= 0 Then
NumA.Insert(0, 0)
Z_Counter = Z_Counter + 1
End If
For i = 0 To Z_Counter Step +1 '---- Amount of zeroes addded greater than 1 means decimal 0 to be added
C.Add(0)
Next
End If
Subracting_BigNumbers(NumA, B, DiffV) '--- Set the lower limit for multiplication cycle end
Dim MultA As New List(Of Integer)
For Each B_V In B
MultA.Add(B_V)
Next
Dim C_x As Integer = 1
Do
If Compare_BigNumbers(MultA, DiffV) > 0 Then
Dim Temp_NumA As New List(Of Integer)
Subracting_BigNumbers(NumA, MultA, Temp_NumA)
NumA.Clear()
For Each A_V In Temp_NumA
NumA.Add(A_V)
Next
If C_x > 9 Then
MsgBox("Error")
End If
C.Add(C_x)
If Temp_NumA.Count = 1 Then
If Temp_NumA(0) = 0 Then
GoTo Exit1
End If
End If
Exit Do
Else
C_x = C_x + 1
Dim Cx_asList As New List(Of Integer)
Cx_asList.Add(C_x)
MMultiplying_BigNumbers(B, Cx_asList, MultA)
End If
Loop
Loop
'-------- Printing Result to String ***** OPTIONAL VARIABLE
If C.Count > ND Then
C.RemoveRange(ND, C.Count - ND)
End If
Exit1:
Dim Decimal_counter As Integer = 0
For Each C_Val In C
C_Str = C_Str & C_Val
If Decimal_counter = Dec_Loc Then
C_Str = C_Str & "."
End If
Decimal_counter = Decimal_counter + 1
Next
End Sub
Addition Partition and Multiplication Partition of Numbers is quite interesting subjects and below is the code for the both.
Private Sub PartitionCount_Of_Numbers(ByRef N As Integer, ByRef Partition_Count As Integer)
'----------------------------------------------------------------------------------------
'---------------- Euler Pentagonal Theorem ----------------------------------------------
'-------- P(N) = P(N-1)+P(N-2)-P(N-5)-P(N-7)+P(N-12)+P(N-15)-P(N-22)-P(N-26)+....--------
'----------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------
Dim P_List As New List(Of Integer)
P_List.Add(1) '-- Number of Partition of 0 is 1
Dim T_Nstore As Integer
Dim Linear1 As Integer
Dim Odditive As Integer
Dim SignS As Integer
Dim Switcher As Integer
Dim NL As Integer
For i = 1 To N Step +1
Linear1 = 1
Odditive = 3
SignS = 1
Switcher = 1
NL = 1
T_Nstore = 0
Do While (i - NL >= 0)
'----- Main Operation
T_Nstore = T_Nstore + (SignS * (P_List(i - NL)))
If Switcher = 1 Then
Switcher = Switcher + 1
NL = NL + Linear1
Linear1 = Linear1 + 1 '--- Linear addition
ElseIf Switcher = 2 Then
Switcher = 1
NL = NL + Odditive
Odditive = Odditive + 2 '--- Odd Numbers
SignS = SignS * (-1) '--- Change sign after 2 operation
End If
Loop
P_List.Add(T_Nstore)
Next
Partition_Count = P_List(N)
End Sub
Private Sub Recursive_Additive_Partition_of_Numbers(ByVal n As Integer, ByVal k As Integer, _
ByVal s As Integer, ByVal Level As Integer, ByVal R() As Integer, ByVal PrincK As Integer, ByRef R_Str As String)
'----------------------------------------------------------------------------------------
'---- Recursive Algorithm for Generating Partitions of an Integer - Sung Hyuk Cha -------
'- http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.298.1707&rep=rep1&type=pdf---
'-------n = Number to be Partitioned, k = Number of term to be partitioned (k<n) --------
'-------s = (n-k) + 1 , Level = 0 (Always), PrincK = k (Always), R(k) is empty, R_str holds result
'----------------------------------------------------------------------------------------
If k = 1 Then
R(Level) = Math.Ceiling(n / k)
For j As Integer = 0 To (PrincK - 1) Step +1
R_Str = R_Str & R(j)
Next
R_Str = R_Str & vbNewLine
ElseIf k > 1 Then
For i As Integer = Math.Ceiling(n / k) To s Step +1
R(Level) = i
Recursive_Additive_Partition_of_Numbers((n - i), (k - 1), Min(i, n - i - k + 2), Level + 1, R, PrincK, R_Str)
Next
End If
End Sub
'-------------------------------------------------------------------------------------
'---- Recursive Algorithm for Generating Multiplicative Partitions of an Integer -----
'---------------- Algorithm by Samson Mano -------------------------------------------
'-------Num = Number to be Partitioned -----------------------------------------------
'-------------------------------------------------------------------------------------
Public Class Multiplicative_Partitions
Public Soln As New List(Of List(Of Integer))
Public Function Get_MRecursive(ByVal Num As Integer) As List(Of List(Of Integer))
Recursive_Multiplicative_Partition_of_Numbers(Num, New List(Of Integer))
Return Soln
End Function
Public Sub Recursive_Multiplicative_Partition_of_Numbers(ByVal Num As Integer, ByVal Recur_Soln As List(Of Integer))
For divisor As Integer = Num - 1 To 2 Step -1
If Num Mod divisor = 0 Then
Dim factor As Integer = Num / divisor
Dim Curr_Soln As New List(Of Integer)
Curr_Soln.AddRange(Recur_Soln) '--- Add values from previous recursion
Curr_Soln.Add(factor) '--- Add factor
Curr_Soln.Add(divisor) '--- Add Divisor
Curr_Soln.Sort() '--- Sorting asceding **Sorting keeps the comparision simple**
If Soln.Exists(Function(x) x.SequenceEqual(Curr_Soln)) = True Then '--- Check whether the solution exists **** Going Unefficient here **** (19 for 6 values)
GoTo ex1 '-- here exiting
End If
Soln.Add(Curr_Soln) '--- Adding the current solution which is not in the list
Curr_Soln = New List(Of Integer) '--- we repeat forming the curr soln -- to be sent to the recursion with out divisor
Curr_Soln.AddRange(Recur_Soln)
Curr_Soln.Add(factor)
Recursive_Multiplicative_Partition_of_Numbers(divisor, Curr_Soln) '--- divisor is sent as number now
ex1:
End If
Next
End Sub
End Class
The following algorithm converts a square root of non-square numbers to continued fraction. Another algorithm which follows converts continued fraction back to numerator and denominator.
Private Sub SquareRoot_ContinuedFraction(ByVal _n As Integer, ByRef a0 As Integer, ByRef a_list As List(Of Integer))
'<<<<<http://www.maths.surrey.ac.uk/hosted-sites/R.Knott/Fibonacci/cfINTRO.html>>>>>
'The steps in the algorithm for √n are:
'Step 1:
'Find the nearest square number less than n, let's call it m2, so that m2<n and n<(m+1)2.
'For example, if n=14 and we are trying to find the CF for √14, then 9 is the nearest square below 14, so m is 3 and n lies between m2=9 and (m+1)2=16.
'The whole number part starts off your list of numbers for the continued fraction.
'The easy way to find the largest square number below n is to use your calculator:
'Find √n and just ignore the part after the decimal point! The number showing is m.
'Now, √n = m + 1/x
'where n and m are whole numbers.
'Step 2:
'Rearrange the equation of Step 1 into the form of x equals an expression involving the square root which will appear as the denominator of a fraction: x = 1 / (√n - m)
'Step 3:
'We now have a fraction with a square-root in the denominator. Use the method above to convert it into a fraction with whole numbers in the denominator.
'In this case, multiply top and bottom by (√ n + m) and simplify.
'either Step 4A:
'stop if this expression is the original square root plus an integer.
'or Step 4B:
'start again from Step 1 but using the expression at the end of Step 3
'--------------------------------------------------------------------------------------------------------------
Dim N_in_Sqroot As Integer
Dim E_Nom As Integer
Dim D_Nom As Integer
Dim a As Integer
Dim t_alist As New List(Of Integer)
Dim t_1 As Integer
Dim Exit_Check As Boolean
N_in_Sqroot = _n
D_Nom = 1
E_Nom = 0
a = 0
If Math.Sqrt(N_in_Sqroot) Mod 1 = 0 Then
'------- Check for Square Numbers
a0 = Math.Sqrt(N_in_Sqroot)
Else
a0 = Math.Floor((Math.Sqrt(N_in_Sqroot) + E_Nom) / D_Nom)
E_Nom = (D_Nom * a0) - E_Nom
D_Nom = (N_in_Sqroot - (E_Nom ^ 2)) / D_Nom
Exit_Check = False
Do Until (Exit_Check = True)
a = Math.Floor((Math.Sqrt(N_in_Sqroot) + E_Nom) / D_Nom)
t_alist.Add(a)
E_Nom = (D_Nom * a) - E_Nom
D_Nom = (N_in_Sqroot - (E_Nom ^ 2)) / D_Nom
'---------- Exit the loop after finding the recoring numbers
t_1 = If(t_alist.Count Mod 15 = 0, Math.Floor(t_alist.Count / 15), (Math.Floor(t_alist.Count / 15) + 1))
Exit_Check = Check_Cycle(t_alist, t_1)
If Exit_Check = True Then
For u = 1 To t_1 Step +1
a_list.Add(t_alist(u - 1))
Next
End If
Loop
End If
End Sub
Private Function Check_Cycle(ByVal A As List(Of Integer), ByVal t_1 As Integer) As Boolean
If A.Count = (15 * t_1) Then
'---------- Cycle Detection ---- Hare and Tortoise algorithm
Dim L As New List(Of Integer)
For u = 1 To t_1
L.Clear()
For i = (u - 1) To (A.Count - 1) Step t_1
L.Add(A(i))
Next
If L.Distinct.Count > 1 Then
Return False
Exit Function
End If
Next
Return True
Else
Return False
End If
End Function
'------------------------------------------ Following sequence changes the Continued fraction to Numerator/Denominator
Dim Bot_V As New List(Of Integer) '--- Contiuously store Denominator (An * An-1) + Curr_1
Dim Temp_Multied As New List(Of Integer) '--- Stores Multiplied Variable
Dim Temp_Added As New List(Of Integer) '--- Stores Added Variable
Dim A_asList As New List(Of Integer) '--- Stores Current An-1 Variable
Dim Curr_1 As New List(Of Integer) '--- Constantly changes the supposedly one (ie, (An * An-1) + Prev_1
Bot_V.Clear()
Curr_1.Clear()
split_number(V_a1(V_a1.Count - 1), Bot_V) '--- Split number An and store in First BotV
Curr_1.Add(1) '--- Add one to current_1
For i = V_a1.Count - 2 To 0 Step -1
Temp_Multied.Clear()
Temp_Added.Clear()
split_number(V_a1(i), A_asList) '--- Split An-1 and store to multiply with An
MMultiplying_BigNumbers(Bot_V, A_asList, Temp_Multied) '--- Store after multiply An and An-1
Adding_BigNumbers(Temp_Multied, Curr_1, Temp_Added) '--- Add (An*An-1) with Curr_1
'----- Flip the Denominator to Numerator and add new denominator
Curr_1.Clear()
For Each B In Bot_V
Curr_1.Add(B)
Next
Bot_V.Clear()
For Each TB In Temp_Added
Bot_V.Add(TB) '--- Keeps the final denominator
Next
Next
'--------- Final Multiplication with A0
Temp_Multied.Clear()
Temp_Added.Clear()
split_number(V_a0, A_asList)
MMultiplying_BigNumbers(Bot_V, A_asList, Temp_Multied)
Adding_BigNumbers(Temp_Multied, Curr_1, Temp_Added)
Dim Top_V As New List(Of Integer)
For Each TA In Temp_Added
Top_V.Add(TA) '--- Stores the final Numerator
Next
My personnel code to solve any sudoku works based on combination of A* Search and Guess methods
Public Class SudoKo_Holding
Public PData(8, 8) As Integer
Public Sub New(ByVal T(,) As Integer)
For m = 0 To 8
For n = 0 To 8
PData(m, n) = T(m, n)
Next
Next
End Sub
End Class
Public Class Zeroes_Holder
Public m As Integer
Public n As Integer
Public Possib_Int As New List(Of Integer)
Public Sub New(ByVal _m As Integer, ByVal _n As Integer, ByVal PCo As List(Of Integer))
m = _m
n = _n
Possib_Int = New List(Of Integer)(PCo)
End Sub
End Class
Private Sub Solve_Sudoko(ByRef S_Problem As SudoKo_Holding)
'----- Finding the number of empty boxes in the puzzle
'------------- Loop Starts
Do
'-------- Checking for Solved Singles
Dim Zh As New List(Of Zeroes_Holder)
Dim Zh1T As New List(Of Zeroes_Holder)
Check_SolvedSolutions(Zh1T, S_Problem)
Zh = Zh1T.OrderBy(Function(X) X.Possib_Int.Count).ToList()
If Zh.Count = 0 Then
Exit Do
End If
If Zh(0).Possib_Int.Count = 1 Then '--- Check for Solved Singles
'--- Solved Single
For Each Zval In Zh
If Zval.Possib_Int.Count <> 1 Then
Exit For
Else
S_Problem.PData(Zval.m, Zval.n) = Zval.Possib_Int(0)
End If
Next
Else
'---- No Solved Singles
'---- So go for Hidden Singles
Dim RHidd_Sing As New List(Of Zeroes_Holder)
Check_HiddenSingles(Zh, RHidd_Sing)
If RHidd_Sing.Count <> 0 Then
'---- No Hidden Singles found
For Each RH_S In RHidd_Sing.Distinct
S_Problem.PData(RH_S.m, RH_S.n) = RH_S.Possib_Int(0)
Next
Else
'---- No solved Solutions and No Hidden singles
'---- So go for Naked Pairs/Triples
'Dim havNakedPair As Boolean = False
'Check_NakedPairs(Zh, havNakedPair)
'If havNakedPair = False Then
'---- No solved Solutions, No Hidden singles and No Naked Pairs
Dim yye As Integer
yye = 1
'End If
End If
End If
'---- Speciality check to Finsh Up the problem
If Check_SudokoSolution(S_Problem) = True Then
Exit Do
End If
Loop
End Sub
Private Sub Check_SolvedSolutions(ByRef TZh As List(Of Zeroes_Holder), ByVal TS_Problem As SudoKo_Holding)
Dim m, n As Integer
For m = 0 To 8 Step +1
For n = 0 To 8 Step +1
If TS_Problem.PData(m, n) = 0 Then
Dim Possib_C As New List(Of Integer)(New Integer() {1, 2, 3, 4, 5, 6, 7, 8, 9})
Dim Row_vals As New List(Of Integer)
Dim Col_vals As New List(Of Integer)
Dim Box_vals As New List(Of Integer)
'--------- Index which need fixing
For k As Integer = 0 To 8 Step +1
Row_vals.Add(TS_Problem.PData(m, k))
Col_vals.Add(TS_Problem.PData(k, n))
Next
Return_box(Box_vals, TS_Problem.PData, m, n, New List(Of Integer))
Dim combined_vals As New List(Of Integer)
combined_vals.AddRange(Row_vals)
combined_vals.AddRange(Col_vals)
combined_vals.AddRange(Box_vals)
TZh.Add(New Zeroes_Holder(m, n, Possib_C.Except(combined_vals).ToList))
End If
Next
Next
End Sub
Private Sub Check_HiddenSingles(ByVal TZh As List(Of Zeroes_Holder), ByRef TRHidd_Sing As List(Of Zeroes_Holder))
Dim Temp_Sing As New List(Of Zeroes_Holder)
Dim n, k As Integer
'--- Step 1A: Hidden Singles in Rows
TZh.OrderBy(Function(X) X.m)
For n = 0 To 8 Step +1
For k = 0 To (TZh.Count - 1) Step +1
If TZh(k).m = n Then
Temp_Sing.Add(New Zeroes_Holder(TZh(k).m, TZh(k).n, TZh(k).Possib_Int))
End If
Next
Dim HS_list As New List(Of Integer)
For Each TS In Temp_Sing
HS_list.AddRange(TS.Possib_Int)
Next
HS_list.Sort()
Dim NoRepeatL As New List(Of Integer)
Return_NonRepeatingInteger(HS_list, NoRepeatL)
If NoRepeatL.Count <> 0 Then
For Each TS In Temp_Sing
For Each NRList In NoRepeatL
If TS.Possib_Int.Contains(NRList) = True Then
Dim Soln11 As New List(Of Integer)
Soln11.Add(NRList)
TRHidd_Sing.Add(New Zeroes_Holder(TS.m, TS.n, Soln11)) '--- Back track the no repeat values and add in our required list
End If
Next
Next
End If
Temp_Sing.Clear()
Next
'--- Step 1B: Hidden Singles in Columns
TZh.OrderBy(Function(X) X.n)
Temp_Sing.Clear()
For n = 0 To 8 Step +1
For k = 0 To (TZh.Count - 1) Step +1
If TZh(k).n = n Then
Temp_Sing.Add(New Zeroes_Holder(TZh(k).m, TZh(k).n, TZh(k).Possib_Int))
End If
Next
Dim HS_list As New List(Of Integer)
'----- Here adding all the list of possib Int to one list
For Each TS In Temp_Sing
HS_list.AddRange(TS.Possib_Int)
Next
HS_list.Sort()
Dim NoRepeatL As New List(Of Integer)
Return_NonRepeatingInteger(HS_list, NoRepeatL) '--- Finding a list of No Repeat here
If NoRepeatL.Count <> 0 Then
For Each TS In Temp_Sing
For Each NRList In NoRepeatL
If TS.Possib_Int.Contains(NRList) = True Then
Dim Soln11 As New List(Of Integer)
Soln11.Add(NRList)
TRHidd_Sing.Add(New Zeroes_Holder(TS.m, TS.n, Soln11)) '--- Back track the no repeat values and add in our required list
End If
Next
Next
End If
Temp_Sing.Clear()
Next
'--- Step 1C: Hidden Singles in Box
Dim m, p, q As Integer
Temp_Sing.Clear()
For p = 0 To 6 Step +3
For q = 0 To 6 Step +3
For m = (p + 0) To (p + 2) Step +1
For n = (q + 0) To (q + 2) Step +1
For k = 0 To (TZh.Count - 1) Step +1
If TZh(k).m = m And TZh(k).n = n Then
Temp_Sing.Add(New Zeroes_Holder(TZh(k).m, TZh(k).n, TZh(k).Possib_Int))
Exit For
End If
Next
Next
Next
Dim HS_list As New List(Of Integer)
For Each TS In Temp_Sing
HS_list.AddRange(TS.Possib_Int)
Next
HS_list.Sort()
Dim NoRepeatL As New List(Of Integer)
Return_NonRepeatingInteger(HS_list, NoRepeatL)
If NoRepeatL.Count <> 0 Then
For Each TS In Temp_Sing
For Each NRList In NoRepeatL
If TS.Possib_Int.Contains(NRList) = True Then
Dim Soln11 As New List(Of Integer)
Soln11.Add(NRList)
TRHidd_Sing.Add(New Zeroes_Holder(TS.m, TS.n, Soln11)) '--- Back track the no repeat values and add in our required list
End If
Next
Next
End If
Temp_Sing.Clear()
Next
Next
End Sub
Private Sub Check_NakedPairs(ByRef TZh As List(Of Zeroes_Holder), ByRef havNakedpair As Boolean)
'----- Check Naked Pairs
Dim Temp_Sing As New List(Of Zeroes_Holder)
Dim n, k, u As Integer
'--- Step 1A: Hidden Singles in Rows
TZh.OrderBy(Function(X) X.m)
For u = 0 To 8 Step +1
For k = 0 To (TZh.Count - 1) Step +1
If TZh(k).m = u Then
Temp_Sing.Add(New Zeroes_Holder(TZh(k).m, TZh(k).n, TZh(k).Possib_Int))
End If
Next
Next
'--- Step 1B: Hidden Singles in Columns
'--- Step 1C: Hidden Singles in Box
Dim m, p, q As Integer
Temp_Sing.Clear()
For p = 0 To 6 Step +3
For q = 0 To 6 Step +3
For m = (p + 0) To (p + 2) Step +1
For n = (q + 0) To (q + 2) Step +1
For k = 0 To (TZh.Count - 1) Step +1
If TZh(k).m = m And TZh(k).n = n Then
Temp_Sing.Add(New Zeroes_Holder(TZh(k).m, TZh(k).n, TZh(k).Possib_Int))
Exit For
End If
Next
Next
Next
'--------------------------
Next
Next
End Sub
Private Sub Return_NonRepeatingInteger(ByVal RepeatList As List(Of Integer), ByRef NonRepeat As List(Of Integer))
Dim i As Integer
NonRepeat.Clear()
If RepeatList.Count > 1 Then
For i = 0 To (RepeatList.Count - 2)
If RepeatList(i) = RepeatList(i + 1) Then
Do
i = i + 1
If i >= (RepeatList.Count - 2) Then
Exit Do
ElseIf RepeatList(i) <> RepeatList(i + 1) Then
Exit Do
End If
Loop 'While (i < (RepeatList.Count - 2) And (RepeatList(i) = RepeatList(i + 1)))
Else
NonRepeat.Add(RepeatList(i))
End If
Next
If RepeatList(RepeatList.Count - 1) <> RepeatList(RepeatList.Count - 2) Then
NonRepeat.Add(RepeatList(RepeatList.Count - 1))
End If
End If
End Sub
Private Sub Return_box(ByRef BBoxVal As List(Of Integer), ByVal PData(,) As Integer, ByVal m_row As Integer, ByVal n_col As Integer, ByVal Box_ind As List(Of Integer))
Dim Curr_box As Integer
'----- Recurrsion switch from row to column here
If Box_ind.Count = 0 Then
Curr_box = m_row
Else
Curr_box = n_col
End If
Select Case Curr_box
Case 0 To 2
If Box_ind.Count <> 0 Then
For Each B In Box_ind
BBoxVal.Add(PData(B, 0))
BBoxVal.Add(PData(B, 1))
BBoxVal.Add(PData(B, 2))
Next
Exit Sub
Else
Box_ind.Add(0)
Box_ind.Add(1)
Box_ind.Add(2)
Return_box(BBoxVal, PData, m_row, n_col, Box_ind)
End If
Case 3 To 5
If Box_ind.Count <> 0 Then
For Each B In Box_ind
BBoxVal.Add(PData(B, 3))
BBoxVal.Add(PData(B, 4))
BBoxVal.Add(PData(B, 5))
Next
Exit Sub
Else
Box_ind.Add(3)
Box_ind.Add(4)
Box_ind.Add(5)
Return_box(BBoxVal, PData, m_row, n_col, Box_ind)
End If
Case 6 To 8
If Box_ind.Count <> 0 Then
For Each B In Box_ind
BBoxVal.Add(PData(B, 6))
BBoxVal.Add(PData(B, 7))
BBoxVal.Add(PData(B, 8))
Next
Exit Sub
Else
Box_ind.Add(6)
Box_ind.Add(7)
Box_ind.Add(8)
Return_box(BBoxVal, PData, m_row, n_col, Box_ind)
End If
End Select
End Sub
Private Function Check_SudokoSolution(ByVal S_Problem As SudoKo_Holding)
'------ Row Check
Dim Rchk As New List(Of Integer)
Dim CChk As New List(Of Integer)
Dim BChk As New List(Of Integer)
Dim Retun_bool As Boolean = True
'----- Check Zero Count
For m = 0 To 8 Step +1
For n = 0 To 8 Step +1
If S_Problem.PData(m, n) = 0 Then
Retun_bool = False
GoTo ex1
End If
Next
Next
'----- Checking Row and column
For m As Integer = 0 To 8 Step +1
For n As Integer = 0 To 8 Step +1
Rchk.Add(S_Problem.PData(m, n))
CChk.Add(S_Problem.PData(n, m))
Next
If Rchk.Sum <> 45 Or CChk.Sum <> 45 Or Rchk.Count <> Rchk.Distinct.Count Or CChk.Count <> CChk.Distinct.Count Then
'---- Checking whether the items are distinct and unique and the sume of 1 to 9 = 45 is attained otherwise return false
Retun_bool = False
GoTo ex1
Else
Rchk.Clear()
CChk.Clear()
End If
Next
'----- Checking Box
Dim k As Integer = 0
For m = 0 To 8 Step +3
For k = 0 To 8 Step +3
For n = 0 To 2 Step +1
BChk.Add(S_Problem.PData(m + 0, k + n))
BChk.Add(S_Problem.PData(m + 1, k + n))
BChk.Add(S_Problem.PData(m + 2, k + n))
Next
If BChk.Sum <> 45 Or BChk.Count <> BChk.Distinct.Count Then
'---- Checking whether the items are distinct and unique and the sume of 1 to 9 = 45 is attained otherwise return false
Retun_bool = False
GoTo ex1
Else
BChk.Clear()
End If
Next
Next
ex1:
Return Retun_bool
End Function