ProjectEuler
The below algorithms I used to solve problems from https://projecteuler.net/ website
BIG NUMBER ARITHMETIC
BIG NUMBER ARITHMETIC
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 FunctionPrivate 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 IfExit1: 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 SubPARTITION OF NUMBERS
PARTITION OF NUMBERS
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 nowex1: End If Next End SubEnd ClassSQUARE ROOT TO CONTINUED FRACTION
SQUARE ROOT TO CONTINUED FRACTION
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 NextSUDOKU SOLVER
SUDOKU SOLVER
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 Nextex1: Return Retun_bool End Function