What is wrong with this perfect number function?
The method is supposed to decide whether the input number is/is not a perfect number. The answer is supposed to be all the perfect numbers from 1 to the input.
For example: 1 - 100 the answer would be 6 and 28
Public Function isPerfect(myInput As Integer) As Boolean
endCounter = myInput \ 2
sum = 1
For perfectCounter As Integer = 2 To endCounter
If myInput Mod perfectCounter = 0 Then
sum += perfectCounter
If sum = myInput Then
Return True
End If
End If
Next
Return False
End Function
Private Sub btnPerfect_Click(sender As Object, e As EventArgs) Handles btnPerfect.Click
input = Convert.ToInt32(txtNumber.Text)
msg = "The perfect numbers between 1 and " & input & " are : "
For inputCounter As Integer = 0 To input
If isPerfect(inputCounter) = True Then
msg += inputCounter & " "
End If
Next
MsgBox(msg, , "Perfect Number")
txtNumber.Focus()
txtNumber.Text = Nothing
End Sub
You have at least a couple of problems:
You are validating the perfect number inside the loop, before you've even finished summing the divisors.
For instance...
If sum = myInput Then
Return True
End If
The above should be checked after the loop.
More importantly, because you are setting endCounter to myInput \ 2, you are not summing all the divisors. Maybe you did this as an optimization. But if so, you forgot something along the way.
A quick fix is to change the endCounter assignment to:
endCounter = myInput - 1
Also, to avoid getting back 1 as a valid perfect number, I would initialize sum to 0, and would start the loop normally at 1 instead of 2.
So your function could look something like:
Public Function isPerfect(myInput As Integer) As Boolean
Dim endCounter As Integer = myInput - 1
Dim sum As Integer = 0
For perfectCounter As Integer = 1 To endCounter
If myInput Mod perfectCounter = 0 Then
sum += perfectCounter
End If
Next
Return sum = myInput
End Function
I'm sure you could optimize this further if you want to.
(*) Consider turning on Option Explicit as well.
Here is the correct implementation of isPerfect:
Public Function isPerfect(myInput As Integer) As Boolean
dim Sum as Integer = 1
For i as Integer = 2 To myInput / 2
If myInput Mod i = 0 Then Sum = Sum + i
Next
Return Sum = myInput
End Function
Related
Module PrimePairs
Public Function IsPrime(n As Long) As Boolean
Console.WriteLine("Please enter the value: ")
n = Console.ReadLine()
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
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("The result is:", count)
Return n
End Function
End Module
I want my code to calculate how many prime number twins can write the input I gave.
The problem is that your project actually does not contain a Sub Main(), as the error states.
You defined two functions in the Module Program, but console applications need a predefined entry point, which usually is the Main method.
The compiler is telling you that your project is not valid because it didn't find any entry point.
Just add a Sub Main() to get your project working, then call your functions from that method.
Example:
Option Strict On
Module Program
Sub Main(args As String())
Console.WriteLine("Please enter the value: ")
Dim input As String = Console.ReadLine()
Dim number As Long
If Long.TryParse(input, number) Then // More about this function in the answer below
Dim prime As Boolean = IsPrime(number)
If prime Then
Console.WriteLine(number & " is prime.")
Else
Console.WriteLine(number & " is not prime.")
End If
End If
Console.ReadLine()
End Sub
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 = 2
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
End Module
Also, I suggest you to enable Option Strict On as I added at the beginning of file. This prevents the compiler from doing implicit casts and forces you to explicitly declare your variables.
E.g., your line of code
n = Console.ReadLine()
is not valid with Option Strict On, because n is supposed to be a long, but Console.ReadLine() returns a string.
If you are a beginner, this will allow you to better understand how programming works and will help you to avoid errors - take good habits from the beginning, you can thank me later ;)
That's why I changed your code withLong.TryParse(input, number): this function returns true if provided input can be cast (=converted) to a long, and assigns the casted value to number variable.
There's a lot more I'd like to suggest you, but I would go off-topic.
I making matrix calculator. so, Textbox_A contains vbCrLf and tries to put it in Array_A.
and I would like to put Array_A in Result Matrix.
It's like
Textbox_a:
(1 2 3)
(4 5 6)
[Matrix to Array]
Array_a(0)(0) = 1
Array_a(0)(1) = 2
Array_a(0)(2) = 3
Array_a(1)(0) = 4
...
I have done string splits through several articles, but changing them to integers causes many problems.
This picture is Matrix_A and result Matrix
I don't know if the size of your initial matrix, formatted as text, is fixed, but here is some code to help you get started. The code tries to calculate the number of columns and rows.
The actual code is in the TextToArray function, that takes as input as string formatted as you described:
(1 2 3) (cr/lf)
(4 5 6)
and outputs a two dimensional array. The Main sub is just used to call TextToArray and display results.
So, in your example, you should pass TextBox_A.Text to TextToArray
There is minimal error checking here - you should add more to validate that data entered are numbers (check the Integer.TryParse function) and that the number of columns is the same across lines.
Sub Main(args As String())
Dim myInput As String = "(1 2 3)" & vbCrLf & "(4 5 6)"
Dim ret As Integer(,) = TextToArray(myInput)
If ret IsNot Nothing Then
For i As Integer = 0 To ret.GetUpperBound(0) - 1
For n As Integer = 0 To ret.GetUpperBound(1) - 1
Console.WriteLine(i & "," & n & "=" & ret(i, n))
Next
Next
Else
Console.WriteLine("No results - wrong input format")
End If
Console.ReadLine()
End Sub
Private Function TextToArray(matrix As String) As Integer(,)
Dim noOfRows As Integer = matrix.Split(vbCrLf).Count
Dim noOfColumns As Integer = 0
If noOfRows > 0 Then
noOfColumns = matrix.Split(vbCrLf)(0).Split(" ").Count
End If
If noOfColumns > 0 And noOfRows > 0 Then
Dim ret(noOfRows, noOfColumns) As Integer
Dim lines As String() = matrix.Split(vbCrLf)
Dim row As Integer = 0
For Each line As String In lines
Dim col As Integer = 0
line = line.Replace("(", "")
line = line.Replace(")", "")
For Each s As String In line.Split(" ")
ret(row, col) = Integer.Parse(s)
col += 1
Next
row += 1
Next
Return ret
Else
Return Nothing
End If
End Function
This outputs:
0,0=1
0,1=2
0,2=3
1,0=4
1,1=5
1,2=6
my code is working i tried it separately but the problem here is that when i'm putting them together , the readkey or readline don't stop the program and the do loop is not working too, can someone take a look please thank in advance
Dim count As Integer
Dim first(5) As Integer
Dim temp As Integer
Dim answer As String
Sub Main()
Do
Console.WriteLine("Please enter your first number")
first(0) = Console.ReadLine
Console.WriteLine("Please enter your second number")
first(1) = Console.ReadLine
Console.WriteLine("Please enter your third number")
first(2) = Console.ReadLine
Console.WriteLine("Please enter your fourth number")
first(3) = Console.ReadLine
Console.WriteLine("Please enter your fifth number")
first(4) = Console.ReadLine
Console.WriteLine("Please enter your sixth number")
first(5) = Console.ReadLine
randomnumber()
Console.WriteLine("do you want to continue?")
answer = Console.ReadLine
Loop Until (answer = "n" Or answer = "No")
Console.ReadKey()
End Sub
Sub randomnumber()
Dim r As New List(Of Integer)
Dim rg As New Random
Dim rn As Integer
Dim arraywinner(5) As Integer
Do
rn = rg.Next(1, 40)
If Not r.Contains(rn) Then
r.Add(rn)
End If
Loop Until r.Count = 6
'store bane random value in array'
arraywinner(0) = r(0)
arraywinner(1) = r(1)
arraywinner(2) = r(2)
arraywinner(3) = r(3)
arraywinner(4) = r(4)
arraywinner(5) = r(5)
'print random numbers
count = 0
While count <= 5
Console.WriteLine("the randoms numbers are : " & arraywinner(count))
count = count + 1
End While
'look for the amount of number
temp = 0
For count1 As Integer = 0 To 5
For count2 As Integer = 0 To 5
If arraywinner(count1) = first(count2) Then
temp = temp + 1
End If
Next
Next
If temp = 1 Or temp = 0 Then
Console.WriteLine("You have got " & temp & " number")
Else
Console.WriteLine("You have got " & temp & " numbers")
End If
money(temp)
End Sub
Sub money(ByVal t1 As Integer)
'prend cash'
If temp = 6 Then
Console.WriteLine("Jackpot $$$$$$$$$$$$$")
ElseIf temp = 3 Then
Console.WriteLine(" money = 120")
ElseIf temp = 4 Then
Console.WriteLine("money = 500")
ElseIf temp = 5 Then
Console.WriteLine("money= 10,000")
Else
Console.WriteLine(" try next time")
End
End If
End Sub
You have two problems in money():
Sub money(ByVal t1 As Integer)
'prend cash'
If temp = 6 Then
Console.WriteLine("Jackpot $$$$$$$$$$$$$")
ElseIf temp = 3 Then
Console.WriteLine(" money = 120")
ElseIf temp = 4 Then
Console.WriteLine("money = 500")
ElseIf temp = 5 Then
Console.WriteLine("money= 10,000")
Else
Console.WriteLine(" try next time")
End
End If
End Sub
Your parameter is t1, but you're using temp in all of your code. As written, it will still work since temp is global, but you should either change the code to use t1, or not pass in that parameter at all.
Secondly, you have End in the block for 0, 1, or 2 matches. The End statement Terminates execution immediately., which means the program just stops. Get rid of that line.
There are so many other things you could change, but that should fix your immediate problem...
I moved all the display code to Sub Main. This way your Functions with your business rules code can easily be moved if you were to change platforms. For example a Windows Forms application. Then all you would have to change is the display code which is all in one place.
Module Module1
Private rg As New Random
Public Sub Main()
'keep variables with as narrow a scope as possible
Dim answer As String = Nothing
'This line initializes and array of strings called words
Dim words = {"first", "second", "third", "fourth", "fifth", "sixth"}
Dim WinnersChosen(5) As Integer
Do
'To shorten your code use a For loop
For index = 0 To 5
Console.WriteLine($"Please enter your {words(index)} number")
WinnersChosen(index) = CInt(Console.ReadLine)
Next
Dim RandomWinners = GetRandomWinners()
Console.WriteLine("The random winners are:")
For Each i As Integer In RandomWinners
Console.WriteLine(i)
Next
Dim WinnersCount = FindWinnersCount(RandomWinners, WinnersChosen)
If WinnersCount = 1 Then
Console.WriteLine($"You have guessed {WinnersCount} number")
Else
Console.WriteLine($"You have guessed {WinnersCount} numbers")
End If
Dim Winnings = Money(WinnersCount)
'The formatting :N0 will add the commas to the number
Console.WriteLine($"Your winnings are {Winnings:N0}")
Console.WriteLine("do you want to continue? y/n")
answer = Console.ReadLine.ToLower
Loop Until answer = "n"
Console.ReadKey()
End Sub
'Too much happening in the Sub
'Try to have a Sub or Function do only one job
'Name the Sub accordingly
Private Function GetRandomWinners() As List(Of Integer)
Dim RandomWinners As New List(Of Integer)
Dim rn As Integer
'Good use of .Contains and good logic in Loop Until
Do
rn = rg.Next(1, 40)
If Not RandomWinners.Contains(rn) Then
RandomWinners.Add(rn)
End If
Loop Until RandomWinners.Count = 6
Return RandomWinners
End Function
Private Function FindWinnersCount(r As List(Of Integer), WinnersChosen() As Integer) As Integer
Dim temp As Integer
For count1 As Integer = 0 To 5
For count2 As Integer = 0 To 5
If r(count1) = WinnersChosen(count2) Then
temp = temp + 1
End If
Next
Next
Return temp
End Function
Private Function Money(Count As Integer) As Integer
'A Select Case reads a little cleaner
Select Case Count
Case 3
Return 120
Case 4
Return 500
Case 5
Return 10000
Case 6
Return 1000000
Case Else
Return 0
End Select
End Function
End Module
I'm a beginner in vb and I'm wondering why this code doesn't work.
I wrote the function which I can't seem to find why it doesn't. When I run the program, it seems to print out nothing.
I am supposed to find all the prime numbers between 1 and the input
Option Strict On
Public Class Lab4
Dim endCounter As Integer
Dim sum As Integer
Dim msg As String
Dim input As Integer
Public Function isPrime(input As Integer) As Boolean
endCounter = input - 1
For primeCounter As Integer = 1 To endCounter
If input Mod primeCounter <> 0 Then
Return True
Else
Return False
End If
Next
Return False
End Function
Private Sub btnExit_Click(sender As Object, e As EventArgs) Handles btnExit.Click
Me.Close()
End Sub
Private Sub btnPrime_Click(sender As Object, e As EventArgs) Handles btnPrime.Click
input = Convert.ToInt32(txtNumber.Text)
msg = "The prime numbers are: "
If input < 0 Then
msg = "Number cannot be negative!"
For inputCounter As Integer = 1 To input
If isPrime(inputCounter) = True Then
msg += inputCounter & " "
End If
Next
MsgBox(msg, , "Prime Number")
End Sub
End If
End Class
This test will always immediately return something on the very first test:
Public Function isPrime(input As Integer) As Boolean
endCounter = input - 1
For primeCounter As Integer = 1 To endCounter
If input Mod primeCounter <> 0 Then
Return True
Else
Return False
End If
Next
Return False
End Function
because you use Return immediately after the 'has modulus' line. Remove the Return True and else lines, so it only returns False if a modulus value is found. The very last line should be Return True – no modulus values are found, so it is a prime.
For this to work, you need to change your test to
If input Mod primeCounter == 0 Then
and change the start test from 1 to 2.
You don't need to test against 1, and you don't need to test all the way up to input or (you probably misunderstood something there) input - 1. The most logical endpoint is ceil(sqrt(input)), the next higher number of the square root of your starting value.
Which are the combinations that the sum of each digit is equal to 8 or less, from 1 to 88,888,888?
For example,
70000001 = 7+0+0+0+0+0+0+1 = 8 Should be on the list
00000021 = 0+0+0+0+0+0+2+1 = 3 Should be on the list.
20005002 = 2+0+0+0+5+0+0+2 = 9 Should not be on the list.
Sub Comb()
Dim r As Integer 'Row (to store the number)
Dim i As Integer 'Range
r = 1
For i = 0 To 88888888
If i = 8
'How can I get the sum of the digits on vba?
ActiveSheet.Cells(r, 1) = i
r = r + 1
End If
Else
End Sub
... Is this what you're looking for?
Function AddDigits(sNum As String) As Integer
Dim i As Integer
AddDigits = 0
For i = 1 To Len(sNum)
AddDigits = AddDigits + CInt(Mid(sNum, i, 1))
Next i
End Function
(Just remember to use CStr() on the number you pass into the function.
If not, can you explain what it is you want in a bit more detail.
Hope this helps
The method you suggest is pretty much brute force. On my machine, it ran 6.5min to calculate all numbers. so far a challenge I tried to find a more efficient algorithm.
This one takes about 0.5s:
Private Const cIntNumberOfDigits As Integer = 9
Private mStrNum As String
Private mRng As Range
Private Sub GetNumbers()
Dim dblStart As Double
Set mRng = Range("a1")
dblStart = Timer
mStrNum = Replace(Space(cIntNumberOfDigits), " ", "0")
subGetNumbers 8
Debug.Print (Timer - dblStart) / 10000000, (Timer - dblStart)
End Sub
Private Sub subGetNumbers(intMaxSum As Integer, Optional intStartPos As Integer = 1)
Dim i As Integer
If intStartPos = cIntNumberOfDigits Then
Mid(mStrNum, intStartPos, 1) = intMaxSum
mRng.Value = Val(mStrNum)
Set mRng = mRng.Offset(1)
Mid(mStrNum, intStartPos, 1) = 0
Exit Sub
End If
For i = 0 To intMaxSum
Mid(mStrNum, intStartPos, 1) = CStr(i)
subGetNumbers intMaxSum - i, intStartPos + 1
Next i
Mid(mStrNum, intStartPos, 1) = 0
End Sub
It can be sped up further by about factor 10 by using arrays instead of writing directly to the range and offsetting it, but that should suffice for now! :-)
As an alternative, You can use a function like this:
Function isInnerLowr8(x As Long) As Boolean
Dim strX As String, inSum As Long
isInnerLowr8 = False
strX = Replace(CStr(x), "0", "")
For i = 1 To Len(strX)
Sum = Sum + Val(Mid(strX, i, 1))
If Sum > 8 Then Exit Function
Next i
isInnerLowr8 = True
End Function
Now change If i = 8 to If isInnerLowr8(i) Then.