the code to generate no. of arrays from one is working..I'm try to make some change to it like below
Function myarray(ByVal arra1() As Integer, ByVal arran() As Integer, ByVal arrNumber As Integer) As Integer()
arran = arra1.Clone()
For i As Integer = 0 To arra1.Length - 1
If i = (arrNumber - 1) Then ' IF arrNumber is 1 then +1 to index 0, If it is 2 then +1 to index 1
arran(i) = arra1(i) + 1
'If there are two duplicate value make on of them zero at a time
For k = 0 To arran.Length - 1
For j = k + 1 To arran.Length - 1
If arran(k) = arran(j) Then
arran(k) = 0
End If
'make any value great than 11 zero
If arran(i) > 11 Then
arran(i) = 0
End If
Next
Next
Else
arran(i) = arra1(i)
End If
Next
'Print the array
For i = 0 To arran.Length - 1
Console.Write(arran(i) & " ")
Next
Console.WriteLine()
Return arran
End Function
what I really need is to decompose for example {1,4,5,5} to be {1,4,0,5} and then {1,4,5,0} the above code generate only {1,4,0,5}
I haven't tested this, but I believe the following code will do what you want. Based on your comments, I've changed the function to return all resulting arrays as an array of arrays, rather than requiring the index to change as an input and returning one array. I also ignored matches of 0, as the conditions you describe don't seem designed to handle them. Because of it's recursion, I think this approach will successfully handle input such as {3, 3, 3, 3}.
Public Function jaggedArray(ByVal inputArray() As Integer) As Integer()()
If inputArray Is Nothing Then
Return Nothing
Else
Dim resultArrays()(), i, j As Integer
Dim arrayMax As Integer = inputArray.GetUpperBound(0)
If arrayMax = 0 Then 'prevents errors later if only one number passed
ReDim resultArrays(0)
If inputArray(0) > 11 Then
resultArrays(0) = {1}
ElseIf inputArray(0) = 11 Then
resultArrays(0) = {0}
Else
resultArrays(0) = {inputArray(0) + 1}
End If
Return resultArrays
End If
For i = 0 To arrayMax
Dim tempArray() As Integer = inputArray.Clone
For j = 0 To arrayMax
If tempArray(j) > 11 Then
tempArray(j) = 0
End If
Next
If tempArray(i) = 11 Then
tempArray(i) = 0
Else
tempArray(i) += 1
End If
splitArray(resultArrays, tempArray)
Next
Return resultArrays
End If
End Function
Private Sub splitArray(ByRef arrayList()() As Integer, ByVal sourceArray() As Integer)
Dim x, y As Integer 'positions of matching numbers
If isValid(sourceArray, x, y) Then
If arrayList Is Nothing Then
ReDim arrayList(0)
Else
ReDim Preserve arrayList(arrayList.Length)
End If
arrayList(arrayList.GetUpperBound(0)) = sourceArray
Else
Dim xArray(), yArray() As Integer
xArray = sourceArray.Clone
xArray(x) = 0
splitArray(arrayList, xArray)
yArray = sourceArray.Clone
yArray(y) = 0
splitArray(arrayList, yArray)
End If
End Sub
Private Function isValid(ByRef testArray() As Integer, ByRef match1 As Integer, ByRef match2 As Integer) As Boolean
For i As Integer = 0 To testArray.GetUpperBound(0) - 1
If testArray(i) > 11 Then
testArray(i) = 0
End If
For j As Integer = i + 1 To testArray.GetUpperBound(0)
If testArray(j) > 11 Then
testArray(j) = 0
End If
If testArray(i) = testArray(j) AndAlso testArray(i) > 0 Then 'added second test to prevent infinite recursion
match1 = i
match2 = j
Return False
End If
Next
Next
match1 = -1
match2 = -1
Return True
End Function
Related
I tried all possible solutions and they didn't work. Any help would be appreciated.
Function '' doesn't return a value on all code paths is my error
Public Function Isprime(n2 As Long)
Dim n, i As Integer
Dim b As Boolean
Console.WriteLine("enter a no : \")
n = Console.ReadLine()
i = 2
b = True
While i < n
If n Mod i = 0 Then
b = False
End If
i = i + 1
End While
If b Then
Console.WriteLine("prime no")
Else
Console.WriteLine("not prime no\")
End If
Console.ReadLine()
End Function
Public Function PrimePairs(ByVal n As Long, ByVal n2 As Long) As Integer
Dim count As Integer = 0
Console.ReadLine()
If n Mod 2 = 0 Then
For i = 1 To (n / 2) + 1
n2 = n - i
If Isprime(i) And Isprime(n2) = True Then
count += 1
End If
Next
Else
n2 = n - 2
If Isprime(n2) = True Then
count = +1
End If
End If
Console.WriteLine(count)
Return n
End Function
End Module
You function does not return a value and is quite convoluted. It does I/O and does a prime test at the same time. Separate logic from I/O.
Public Function IsPrime(n As Long) As Boolean
n = Math.Abs(n) ' Allows to consider negative prime numbers
If n < 2 Then ' Disallows -1, 0, 1
Return False
End If
Dim i As Long
i = 2
While i < n ' Note that for n = 2 we don't enter the loop and thus return True.
If n Mod i = 0 Then
Return False
End If
i += 1
End While
Return True
End Function
Also, it is missing a return type. Always work with Option Explicit On for better code quality.
Note that you can return when you hit the first prime factor. There is no point in continuing the loop then.
But there are ways to optimize this. For example we could test the divisibility by 2 separately and then test only odd divisors and it is enough to test divisors up to the square root of n.
Public Function IsPrime(n As Long) As Boolean
n = Math.Abs(n)
If n = 2 Then
Return True
End If
If n < 2 Or n Mod 2 = 0 Then
Return False
End If
Dim i As Long = 3
Dim limit As Long = CLng(Math.Sqrt(n))
While i <= limit
If n Mod i = 0 Then
Return False
End If
i += 2
End While
Return True
End Function
Not sure how to output the numbers, once they are in ascending order.
This is the task in the pseudocode that I am trying to move into VB.
Dim a() = {2,3,1,4}
Dim swapped = False
Output the values of a()
Do Swapped 🡨 False
For I = 1 to end of the array Compare a(i-1) with a(i) if they are not in ascending order pass them to swapped (from task 1)
Swapped(a(i-1),a(i)) assign the returned value to the
variable swapped.
While swapped = True
Output the values of a()
Dim num = New Integer() {2, 3, 1, 4}
Dim swapped As Boolean = False
While swapped = False
For i = 1 To 4
If num(i - 1) > num(i) Then
temp = num(i)
num(i) = num(i - 1)
num(i - 1) = temp
swapped = True
Else
swapped = False
End If
Next
End While
While swapped = True
Console.WriteLine(num)
End While
Console.ReadLine()
Here you go:
For Each n As Integer In num
Console.WriteLine(n.ToString)
Next
Btw there's a problem with your swapping algorithm: if they are already in the right you will enter an infinite loop, and if there's a swap on the last number you'll exit the loop even if they are not in the right order. If it puzzles you let me a comment and we'll sort this out.
Although, #laancelot showed you how to output the array, I thought I would show you a simple way to sort an array.
Private Sub OrderArray()
Dim num As Integer() = {2, 3, 1, 4}
Array.Sort(num)
Console.WriteLine("Ascending")
For Each i In num
Console.WriteLine(i.ToString)
Next
'If you want it the other way around
Array.Reverse(num)
Console.WriteLine("Descending")
For Each i In num
Console.WriteLine(i.ToString)
Next
Console.ReadLine()
End Sub
If you don't want to use vb net generic array order method, and you prefer use the swap concept, here you can try:
Private Sub TestOrderSwap()
Dim num = New Integer() {9, 7, 0, 11, 12, 10, 6, 2, 3, 1, 4}
If OrderSwap(num, "ASC") Then
For a = 0 To num.Length - 1
Debug.Print(num(a))
Next
End If
If OrderSwap(num, "DESC") Then
For a = 0 To num.Length - 1
Debug.Print(num(a))
Next
End If
End Sub
Private Function OrderSwap(ByRef myArray As Integer(), OrderType As String) As Boolean
Dim swp As Integer = 0
Dim swpFlg As Boolean = False
For a = 1 To myArray.Length - 1
swp = myArray(a)
For b = 0 To a - 1
If (myArray(b) > swp And OrderType = "ASC") Or (myArray(b) < swp And OrderType = "DESC") Then
For c = a - 1 To b Step -1
myArray(c + 1) = myArray(c)
Next
myArray(b) = swp
swpFlg = True
Exit For
End If
Next
Next
Return swpFlg
End Function
I want to calculate the amount in a multiline Textbox where the value 0 is not found.
If TxtListScanValue.Text = ("2") Then
TxtDrawR2.Text &= Environment.NewLine & lastDraw2
Dim ListScan = TxtNumberListScan.Lines.ToList.Select(Function(o, i) New With {.scan = o, .Index = i})
Dim DrawR2 = TxtDrawR2.Lines.ToList.Select(Function(o, i) New With {.draw = o, .Index = i})
Dim list2 = From a In ListScan From b In DrawR2 Where a.Index = b.Index Select LstScan = a.scan, DrwR2 = ("00" & b.draw).Substring(("00" & b.draw).Length - 2) Order By DrwR2 Descending
TxtListScanTxt.Text = String.Join(vbCrLf, list2)
End If
If TxtdrawR5 =
2
4
0
0
1
3
5
In output I want to display: 5 because:
I want to calculate the count lines where the value 0 is not found. Count lines no have 0 value :D (2+4+1+3+5 = 5) (5 lines no have 0 value).
You create function like this:
'For Counting
Private Function CountNonZero(ByVal TheCtrl As TextBox) As Integer
Dim myCnt As Integer = 0
For Each Content In TheCtrl.Lines
Dim ContentVal As Integer = 0
Integer.TryParse(Content, ContentVal)
If ContentVal <> 0 Then myCnt += 1
Next
Return myCnt
End Function
'For Counting
Private Function SummingNonZero(ByVal TheCtrl As TextBox) As Integer
Dim mySum As Integer = 0
For Each Content In TheCtrl.Lines
Dim ContentVal As Integer = 0
Integer.TryParse(Content, ContentVal)
If ContentVal <> 0 Then mySum += ContentVal
Next
Return mySum
End Function
And you can count or sum now:
dim TxtdrawR5Count as integer = CountNonZero(TxtdrawR5)
dim TxtdrawR5Sum as integer = SummingNonZero(TxtdrawR5)
I am currently making a highscore table - reading the times from a .csv file and sorting them from lowest to highest. The list only becomes partially sorted after the code runs.
All the data inputs correctly but when it goes to sort it sorts the data out incorrectly.
Private Sub BeginnerProcess(ByRef player() As pe_player, ByVal x As Integer)
Dim i As Integer
Dim j As Integer
Dim temp As Object
For i = x To 0 Step -1
For j = 0 To i - 1
If player(j).playerTime > player(j + 1).playerTime Then
temp = player(j)
player(j) = player(j + 1)
player(j + 1) = temp
End If
Next
Next
Dim k As Integer
For k = 1 To x
player(k).position = k
Next
End Sub
Here's the output
Leaderboard
Adapting the classic bubble-sort to your case, I think i should be something like the code below:
For i = 0 To x - 1
For j = i + 1 To x
If player(i).playerTime > player(j).playerTime Then
temp = player(i)
player(i) = player(j)
player(j) = temp
End If
Next
Next
I need some help with this function. I am trying to find the longest common string between 2 strings. Here is the function that I am currently using:
Public Shared Function LCS(str1 As Char(), str2 As Char())
Dim l As Integer(,) = New Integer(str1.Length - 1, str2.Length - 1) {}
Dim lcs__1 As Integer = -1
Dim substr As String = String.Empty
Dim [end] As Integer = -1
For i As Integer = 0 To str1.Length - 1
For j As Integer = 0 To str2.Length - 1
If str1(i) = str2(j) Then
If i = 0 OrElse j = 0 Then
l(i, j) = 1
Else
l(i, j) = l(i - 1, j - 1) + 1
End If
If l(i, j) > lcs__1 Then
lcs__1 = l(i, j)
[end] = i
End If
Else
l(i, j) = 0
End If
Next
Next
For i As Integer = [end] - lcs__1 + 1 To [end]
substr += str1(i)
Next
Return substr
End Function
This works great on strings of up to around 600 words or so. If I try to compare strings with a larger word count than that it starts to throw system.outofmemoryexception. Obviously, this is hitting the memory pretty hard. Is there any way to fine tune this function or is there possibly another way of doing this that is more streamlined?