'Visual Basic 2010 Recursie Procedures en Functies Module Example1 Sub Main() Console.WriteLine(GetFaculty(0)) Console.WriteLine(GetFaculty(1)) Console.WriteLine(GetFaculty(2)) Console.WriteLine(GetFaculty(3)) Console.WriteLine(GetFaculty(4)) Console.WriteLine(GetFaculty(5)) ' Console.ReadLine() End Sub Function GetFaculty(ByVal value As Integer) As Integer GetFaculty = 1 For factor As Integer = value To 2 Step -1 GetFaculty *= factor Next End Function End Module Module Example2 Sub Main() Console.WriteLine(GetFaculty(0)) Console.WriteLine(GetFaculty(1)) Console.WriteLine(GetFaculty(2)) Console.WriteLine(GetFaculty(3)) Console.WriteLine(GetFaculty(4)) Console.WriteLine(GetFaculty(5)) ' Console.ReadLine() End Sub Function GetFaculty(ByVal value As Integer) As Integer If value = 0 Then GetFaculty = 1 Else GetFaculty = value * GetFaculty(value - 1) End If End Function End Module Module Example3 Sub Main() Console.WriteLine(GetCommonDivisor(3, 9)) Console.WriteLine(GetCommonDivisor(3, -9)) Console.WriteLine(GetCommonDivisor(8, 3)) Console.WriteLine(GetCommonDivisor(-3, -8)) ' (1) Console.WriteLine(GetCommonDivisor(6, 0)) Console.WriteLine(GetCommonDivisor(0, 6)) Console.WriteLine(GetCommonDivisor(8, 12)) Console.WriteLine(GetCommonDivisor(9, 9)) ' Console.ReadLine() End Sub Function GetCommonDivisor(ByVal value1 As Integer, _ ByVal value2 As Integer) As Integer If value1 < 0 Then GetCommonDivisor = GetCommonDivisor( value1, value2) ElseIf value2 < 0 Then GetCommonDivisor = GetCommonDivisor(value1, value2) ElseIf value1 < value2 Then GetCommonDivisor = GetCommonDivisor(value2, value1) ElseIf value2 = 0 Then GetCommonDivisor = value1 Else GetCommonDivisor = GetCommonDivisor(value2, value1 Mod value2) End If End Function End Module Module Example4 Sub Main() Console.WriteLine(GetPower(2, 3)) Console.WriteLine(GetPower(2, 2)) Console.WriteLine(GetPower(2, 1)) Console.WriteLine(GetPower(2, 0)) Console.WriteLine(GetPower(2, -1)) Console.WriteLine(GetPower(2, -2)) Console.WriteLine(GetPower(2, -3)) ' Console.ReadLine() End Sub ' Function GetPower(ByVal base As Integer, _ ByVal exponent As Integer) As Integer If exponent = 0 Then GetPower = 1 ElseIf exponent > 0 Then GetPower = base * GetPower(base, exponent - 1) ElseIf exponent < 0 Then GetPower = 1 / GetPower(base, -exponent) End If End Function End Module Module Example5 Sub Main() Console.WriteLine(GetFibo(1)) Console.WriteLine(GetFibo(2)) Console.WriteLine(GetFibo(3)) Console.WriteLine(GetFibo(4)) Console.WriteLine(GetFibo(5)) Console.WriteLine(GetFibo(6)) Console.WriteLine(GetFibo(7)) Console.WriteLine(GetFibo(8)) Console.WriteLine(GetFibo(9)) Console.WriteLine(GetFibo(10)) ' Console.ReadLine() End Sub Function GetFibo(ByVal ordinal As Integer) As Integer If ordinal = 1 OrElse ordinal = 2 Then GetFibo = 1 ElseIf ordinal > 2 Then GetFibo = GetFibo(ordinal - 1) + GetFibo(ordinal - 2) End If End Function End Module Module Example6 Sub Main() Console.WriteLine(GetFibo(1)) Console.WriteLine(GetFibo(2)) Console.WriteLine(GetFibo(3)) Console.WriteLine(GetFibo(4)) Console.WriteLine(GetFibo(5)) Console.WriteLine(GetFibo(6)) Console.WriteLine(GetFibo(7)) Console.WriteLine(GetFibo(8)) Console.WriteLine(GetFibo(9)) Console.WriteLine(GetFibo(10)) ' Console.ReadLine() End Sub Function GetFibo(ByVal ordinal As Byte) As Integer GetFibo = 1 If ordinal > 2 Then Dim fibo1 As Short = 1 Dim fibo2 As Short = 1 Dim count As Byte = 2 Do Until count = ordinal Dim backup As Integer = fibo2 fibo2 += fibo1 fibo1 = backup count += 1 Loop GetFibo = fibo2 End If End Function End Module Module QuickSort Sub Main() Dim numbers As Integer() = {88, 75, 93, 81, 21, 74, 84, 35} PrintArray(numbers) ' QuickSort(numbers, 0, 7) PrintArray(numbers) ' Console.ReadLine() End Sub Sub PrintArray(ByVal values As Integer()) For Each value As Integer In values Console.Write(value & " ") Next Console.WriteLine() End Sub Sub QuickSort(ByVal array As Integer(), _ ByVal lowerbound As Integer, ByVal upperbound As Integer) Dim count As Integer = upperbound - lowerbound + 1 If count = 2 Then If array(lowerbound) > array(upperbound) Then Dim backup As Integer = array(lowerbound) array(lowerbound) = array(upperbound) array(upperbound) = backup End If ElseIf count > 2 Then Dim pivotIndex As Integer = (lowerbound + upperbound) \ 2 Dim pivot As Integer = array(pivotIndex) ' array(pivotIndex) = array(upperbound) array(upperbound) = pivot ' Dim smallerIndex As Integer = lowerbound Dim biggerIndex As Integer = upperbound ' Do While smallerIndex <> biggerIndex ' Do While array(smallerIndex) <= pivot AndAlso _ smallerIndex < biggerIndex smallerIndex += 1 Loop ' Do While array(biggerIndex) >= pivot AndAlso _ smallerIndex < biggerIndex biggerIndex -= 1 Loop ' If smallerIndex <> biggerIndex Then Dim backup As Integer = array(smallerIndex) array(smallerIndex) = array(biggerIndex) array(biggerIndex) = backup End If Loop ' array(upperbound) = array(biggerIndex) array(biggerIndex) = pivot ' QuickSort(array, lowerbound, biggerIndex - 1) QuickSort(array, smallerIndex + 1, upperbound) End If End Sub End Module Module NQueensProblem ' Problem : ' How to assign N queens to N positions on a N by N chessboard, so that no ' queen can attack any other queen on the board. ' ' Configuration : Const N As Integer = 8 ' Dim chessBoard(N - 1, N - 1) As Boolean ' elements contain True if queen is assigned to according position ' Sub Main() If CanSolve(N) Then Console.WriteLine("A solution is found :") DrawChessBoard() Else Console.WriteLine("No solution is found.") End If ' Console.ReadLine() End Sub Sub DrawChessBoard() Console.Write("+") For col As Integer = 0 To N - 1 Console.Write("---+") Next Console.WriteLine() For row As Integer = 0 To N - 1 Console.Write("|") For col As Integer = 0 To N - 1 If HasQueen(row, col) Then Console.Write(" Q |") Else Console.Write(" |") End If Next Console.WriteLine() Console.Write("+") For col As Integer = 0 To N - 1 Console.Write("---+") Next Console.WriteLine() Next Console.WriteLine() End Sub Function CanSolve(ByVal queens As Integer) As Boolean If queens = 0 Then CanSolve = True Else Dim col As Integer = N - queens Dim rowToTry As Integer = 0 Do If IsUnderAttack(rowToTry, col) Then rowToTry += 1 Else PlaceQueen(rowToTry, col) Console.WriteLine("Trying :") ' (*) DrawChessBoard() ' (*) CanSolve = CanSolve(queens - 1) If Not CanSolve Then RemoveQueen(rowToTry, col) Console.WriteLine("Backtracking to :") ' (*) DrawChessBoard() ' (*) rowToTry += 1 End If End If Loop Until CanSolve OrElse Not IsLegalPosition(rowToTry, col) End If ' (*) for debugging purposes End Function Function IsUnderAttack(ByVal row As Integer, ByVal col As Integer) As Boolean IsUnderAttack = IsUnderAttack(row, col, -1, -1) OrElse _ IsUnderAttack(row, col, +1, -1) OrElse _ IsUnderAttack(row, col, 0, -1) End Function Function IsUnderAttack(ByVal row As Integer, ByVal col As Integer, _ ByVal rowOffSet As Integer, ByVal colOffSet As Integer) As Boolean Do row += rowOffSet col += colOffSet Loop While IsLegalPosition(row, col) AndAlso Not HasQueen(row, col) IsUnderAttack = HasQueen(row, col) End Function Function HasQueen(ByVal row As Integer, ByVal col As Integer) As Boolean HasQueen = IsLegalPosition(row, col) AndAlso chessBoard(row, col) End Function Function IsLegalPosition(ByVal row As Integer, ByVal col As Integer) As Boolean IsLegalPosition = row >= 0 AndAlso row <= N - 1 AndAlso col >= 0 AndAlso col <= N - 1 End Function Sub PlaceQueen(ByVal row As Integer, ByVal col As Integer) chessBoard(row, col) = True End Sub Sub RemoveQueen(ByVal row As Integer, ByVal col As Integer) chessBoard(row, col) = False End Sub End Module Module Exercise1Task Sub Main() 'Console.WriteLine(GetRowToZero(5)) 'Console.WriteLine(GetRowToZero(-3)) 'Console.WriteLine(GetRowToZero(0)) ' Console.ReadLine() End Sub End Module Module Exercise1Solution Sub Main() Console.WriteLine(GetRowToZero(5)) Console.WriteLine(GetRowToZero(-3)) Console.WriteLine(GetRowToZero(0)) ' Console.ReadLine() End Sub Function GetRowToZero(ByVal value As Integer) As String If value = 0 Then GetRowToZero = 0 ElseIf value < 0 Then GetRowToZero = value & " " & GetRowToZero(value + 1) Else 'If value > 0 Then GetRowToZero = value & " " & GetRowToZero(value - 1) End If End Function End Module Module Exercise2Task Sub Main() 'Console.WriteLine(GetRow(2, -3)) 'Console.WriteLine(GetRow(0, 2)) 'Console.WriteLine(GetRow(-3, -4)) ' Console.ReadLine() End Sub End Module Module Exercise2Solution Sub Main() Console.WriteLine(GetRow(2, -3)) Console.WriteLine(GetRow(0, 2)) Console.WriteLine(GetRow(-3, -4)) ' Console.ReadLine() End Sub Function GetRow(ByVal value1 As Integer, _ ByVal value2 As Integer) As String If value1 > value2 Then GetRow = GetRow(value2, value1) ElseIf value2 - value1 < 2 Then GetRow = "" Else GetRow = (value1 + 1) & " " & GetRow(value1 + 1, value2) End If End Function End Module Module Exercise3Task Sub Main() 'PlaceSteps(2) Console.WriteLine() ' 'PlaceSteps(10) Console.WriteLine() ' 'PlaceSteps(11) Console.ReadLine() End Sub End Module Module Exercise3Solution Sub Main() PlaceSteps(2) Console.WriteLine() ' PlaceSteps(10) Console.WriteLine() ' PlaceSteps(11) Console.ReadLine() End Sub Sub PlaceSteps(ByVal distance As Integer) Dim stepDistance As Integer If distance = 1 Then stepDistance = 1 Console.WriteLine(stepDistance) Else If distance >= 3 Then stepDistance = 3 ElseIf distance >= 1 Then stepDistance = 1 End If Console.WriteLine(stepDistance) PlaceSteps(distance - stepDistance) End If End Sub End Module Module Exercise4Task Sub Main() Dim numbers As Integer() = {1, 3, 4, 7, 9, 10, 11, 15, 18, 20} ' Dim number, lowerbound, upperbound As Integer Dim found As Boolean ' number = 15 lowerbound = 0 upperbound = 9 'found = BinarySearch(number, numbers, lowerbound, upperbound) Console.WriteLine(found) ' number = 18 lowerbound = 0 upperbound = 7 'found = BinarySearch(number, numbers, lowerbound, upperbound) Console.WriteLine(found) ' Console.ReadLine() End Sub End Module Module Exercise4Solution Sub Main() Dim numbers As Integer() = {1, 3, 4, 7, 9, 10, 11, 15, 18, 20} ' Dim number, lowerbound, upperbound As Integer Dim found As Boolean ' number = 15 lowerbound = 0 upperbound = 9 found = BinarySearch(number, numbers, lowerbound, upperbound) Console.WriteLine(found) ' True ' number = 18 lowerbound = 0 upperbound = 7 found = BinarySearch(number, numbers, lowerbound, upperbound) Console.WriteLine(found) ' False ' Console.ReadLine() End Sub Function BinarySearch(ByVal number As Integer, _ ByVal array As Integer(), _ ByVal lowerbound As Integer, _ ByVal upperbound As Integer) As Boolean Dim middle As Integer = (lowerbound + upperbound) \ 2 If (number = array(middle)) Then BinarySearch = True Else If (upperbound <= lowerbound) Then BinarySearch = False Else If number > array(middle) Then lowerbound = middle + 1 Else upperbound = middle - 1 End If BinarySearch = BinarySearch(number, array, lowerbound, upperbound) End If End If End Function End Module Module Exercise5Task Sub Main() Dim diskCount As Integer = 5 Dim source As Integer = 1 Dim help As Integer = 2 Dim destination As Integer = 3 ' 'TowersOfHanoi(diskCount, source, destination, help) ' Console.ReadLine() End Sub End Module Module Exercise5Solution Sub Main() Dim diskCount As Integer = 5 Dim source As Integer = 1 Dim help As Integer = 2 Dim destination As Integer = 3 ' TowersOfHanoi(diskCount, source, destination, help) ' Console.ReadLine() End Sub Sub TowersOfHanoi(ByVal diskCount As Integer, _ ByVal source As Integer, ByVal destination As Integer, _ ByVal help As Integer) If diskCount = 1 Then Console.WriteLine("from " & source & " to " & destination) Else TowersOfHanoi(diskCount - 1, source, help, destination) Console.WriteLine("from " & source & " to " & destination) TowersOfHanoi(diskCount - 1, help, destination, source) End If End Sub End Module Module Exercise6Task Sub Main() Dim fiboNumbers As Integer() 'fiboNumbers = GetFiboNumbers(10) ' For Each fiboNumber As Integer In fiboNumbers Console.Write(fiboNumber & " ") Next ' Console.ReadLine() End Sub End Module Module Exercise6Solution Sub Main() Dim fiboNumbers As Integer() fiboNumbers = GetFiboNumbers(10) ' For Each fiboNumber As Integer In fiboNumbers Console.Write(fiboNumber & " ") Next ' Console.ReadLine() End Sub Function GetFiboNumbers(ByVal ordinal As Integer) As Integer() Dim fiboNumbers As Integer() If ordinal = 1 Then fiboNumbers = New Integer() {1} ElseIf ordinal = 2 Then fiboNumbers = New Integer() {1, 1} ElseIf ordinal > 2 Then fiboNumbers = GetFiboNumbers(ordinal - 1) ReDim Preserve fiboNumbers(ordinal - 1) fiboNumbers(ordinal - 1) = fiboNumbers(ordinal - 2) + _ fiboNumbers(ordinal - 3) End If GetFiboNumbers = fiboNumbers End Function End Module 'Bezoek www.vbvoorbeelden.be voor meer Visual Basic voorbeelden. 'Copyright - De Wolf / vbvoorbeelden - 2003-2011 - Alle rechten voorbehouden.