I have to write an isDup function to compare two tweets based on their similar word counts to determine if the tweets are duplicate, based on a decimal threshold chosen (0-1).
My process is to write a sub with two hardcoded tweets my prof has provided (just to get an understanding before converting to a function). I encountered a run time error 5.
Option Explicit
Sub isDup()
Dim tweet1 As String
Dim tweet2 As String
Dim threshold As Double
threshold = 0.7
tweet1 = "Hours of planning can save weeks of coding"
tweet2 = "Weeks of programming can save you hours of planning"
Dim tweet1Split() As String
tweet1Split = Split(tweet1, " ")
Dim tweet2Split() As String
tweet2Split = Split(tweet2, " ")
Dim i As Integer
Dim j As Integer
Dim sameCount As Integer
'my thought process below was to compare strings i and j to see if equal, and if true add 1 to sameCount,
'but the If StrComp line is where the error is
For i = LBound(tweet1Split) To UBound(tweet1Split) Step 1
For j = LBound(tweet2Split) To UBound(tweet2Split) Step 1
If StrComp(i, j, vbDatabaseCompare) = 0 Then
sameCount = sameCount + 1
Exit For
End If
Next j
Next i
End Sub
'here i wanted to get a total count of the first tweet to compare, the duplicate tweet is true based on the number of
'similar words
Function totalWords(tweet1 As String) As Integer
totalWords = 0
Dim stringLength As Integer
Dim currentCharacter As Integer
stringLength = Len(tweet1)
For currentCharacter = 1 To stringLength
If (Mid(tweet1, currentCharacter, 1)) = " " Then
totalWords = totalWords + 1
End If
Next currentCharacter
End Function
'this is where i compute an "isDup score" based on similar words compared to total words in tweet1, in this
'example the threshold was stated above at 0.7
Dim score As Double
score = sameCount / totalWords
If score > threshold Then
MsgBox "isDup Score: " & score & " ...This is a duplicate"
Else
MsgBox "isDup Score: " & score & " ...This is not a duplicate"
End If
End Sub
First issue:
i and j are just indexes. You want to compare the string that your index relates to so:
If StrComp(tweet1Split(i), tweet2Split(j), vbDatabaseCompare) = 0 Then
Second issue:
As noted in Microsoft documentation for StrComp, vbDatabaseCompare is reserved for Access, which you are not using, hence the source of your second error. You need to switch to a different comparison
I have two arrays: TempSubject(), which carries a list of subjects, and friRoutine(), which indicates when subjects are taught.
I need to enforce a rule that no particular subject can not be taught twice on a specific day. I have a function named DetectDuplicate(friRoutine, Tempsubject(i)), which checks friRoutine() with TempSubject() and finds whether friRoutine already contains a particular subject. If No, then add that unique subject to friRoutine. Otherwise continue through the loop for next subject. My code is furnished below as follows-
Dim TempSubject() As String = {"Maths","English","Sanskrit","Sanskrit","Urdu","Urdu","Urdu","French","French","French","Physical Education","Physical Education","Game","Game", "Science"}
dim c4 as integer = 0
dim limitcounter = 0
dim friRoutine() as string
reedim friRoutine(6)
While c4 < TempSubject.Length
If DetectDuplicate(friRoutine, TempSubject(c4)) = False And limitcounter4 < 7 Then
friRoutine(limitcounter4) = TempSubject(c4)
'MessageBox.Show(c1 & ": " & limitcounter1 & ": " & tueRoutine(limitcounter1))
Debug.WriteLine("Friday: " & c4 & ": " & limitcounter4 & ": " & friRoutine(limitcounter4))
TempSubject.RemoveAt(c4)
limitcounter4 = limitcounter4 + 1
End If
c4 = c4 + 1
End While
Private Function DetectDuplicate(ByVal arr As Array, ByVal str As String) As Boolean
Dim numcount As Integer = 0
For numcount = 0 To arr.Length - 1
If arr(numcount) = str Then
Return True
End If
Next
Return False
End Function
The Output is supposed to be
friRoutine = Math, english, sanskrit, Urdu, French, Physical education, game
but unfortunately, English is missing.
the output is:
friRoutine = Math, sanskrit, Urdu, French, Physical education, game, science
I'm afraid of using my code as it may spoil the entire process at any point of time.
I think the problem is with Function DetectDuplicate()
Edit (From a comment)
I have to remove the used elements. My original program will have 42 subjects and 6 days. 7 periods everyday. For example if i picked up 7 unique subjects for Monday then for the next 6 days i must have only 35 subjects to be adjusted for rest of the 5 days.
The first thing I would do is convert the arrays to generic Lists. So this:
Dim TempSubject() As String = {"Maths","English","Sanskrit","Sanskrit","Urdu","Urdu","Urdu","French","French","French","Physical Education","Physical Education","Game","Game", "Science"}
Dim friRoutine() As String
Becomes this:
Dim TempSubject As New List(Of String) From {"Maths","English","Sanskrit","Sanskrit","Urdu","Urdu","Urdu","French","French","French","Physical Education","Physical Education","Game","Game", "Science"}
Dim friRoutine As New List(Of String)(6)
You can access items in these lists by index, just like with arrays, but now it becomes MUCH easier to do things like add or remove entries. At least, I would do this for the friRoutine collection; there is some argument to made for an array in way TempSubject is used in this code, but even there the data likely came form somewhere that would justify a List(Of String) instead.
That done, you can greatly simplify the code:
friRoutine.AddRange(TempSubject)
friRoutine = friRoutine.Distinct().Take(7).ToList()
Or, to show the entire sample:
Dim TempSubject = {"Maths","English","Sanskrit","Sanskrit","Urdu","Urdu","Urdu","French","French","French","Physical Education","Physical Education","Game","Game", "Science"}
Dim friRoutine As New List(Of String)(TempSubject.Distinct().Take(7))
For i As Integer = 0 to friRoutine.Count - 1
Debug.WriteLine($"Friday: {i} : {friRoutine(i)}")
Next
And now that we see the data for friRoutine can be computed from a single line of code, one wonders if we really need the separate collection at all.
As for the original code, the big problem was this line:
TempSubject.RemoveAt(c4)
This modified the collection while still looping through it. Everything would shift forward, causing some items to be skipped.
Just use Enumerable.Distinct<T>()
Dim TempSubject = {"Maths","English","Sanskrit","Sanskrit","Urdu","Urdu","Urdu","French","French","French","Physical Education","Physical Education","Game","Game", "Science"}
Dim friRoutine = TempSubject.Distinct().ToArray()
If you want a List output instead, then it's simply
Dim friRoutine = TempSubject.Distinct().ToList()
Since both array and List are Enumerable, TempSubject can be either an array or List.
I am trying to write a VB.NET program that reads data from a file and does a count for each column as shown in the format below and also writes to an output file.
I am able to do the count but I am unable to write the output per restaurant and day.
From what I have, I can only write the total sum from the array index.
Here is the code I have so far:
Dim IntSubjectArray(23) As String
OpenFileDialog1.ShowDialog()
strInputPath = OpenFileDialog1.FileName
FileOpen(IntInputFileName, strInputPath, OpenMode.Input)
Do While Not EOF(IntInputFileName)
Dim StrReadLine As String = LineInput(IntInputFileName)
Dim StrSplitRecord() As String = Split(StrReadLine, ",")
IntRestaurant = StrSplitRecord(0)
IntDay = StrSplitRecord(1)
Meal1 = StrSplitRecord(2)
Meal2 = StrSplitRecord(3)
Meal3 = StrSplitRecord(4)
If SaveDay <> IntDay Then
IntMealArray(meal1) += 1
IntMealArray(meal2) += 1
IntMealArray(meal3) += 1
SaveDay = IntDay
SaveDay = 0
End If
savetown = IntExamTown
Loop
Call WriteOutputArray()
FileClose(IntInputFileName)
MessageBox.Show("File written to specified location")
Public Sub WriteOutputArray()
IntOutputFileName = FreeFile()
For Each Array As String In IntMealArray
FileOpen(IntOutputFileName, "C:\Users\ireport\foodCount.txt", OpenMode.Append)
WriteLine(IntOutputFileName, IntMealArray(Array))
FileClose(IntOutputFileName)
Next
End Sub
File format is
001,1,5,6,21
001,1,5,6,21
001,1,5,6,21
001,1,10,12,18
001,2,5,6,19
001,2,8,9,19
001,2,6,19,21
001,2,5,6,21
001,3,7,12,18
001,3,8,12,19
001,3,7,12,18
040,4,7,12,18
040,4,7,12,18
040,4,7,12,18
040,4,9,12,19
Key:
The format is 001 is restaurant 1, then day 1, then foods eaten by a particular customer (there are to 23 different kinds of food), with each kind of meal represented by a code 1 to 23 as in the file.
Expected output is count of food eaten in each resturant in each day by a customer e.g.:
Rest day Rice Beans Yam Meat Snack coke Burger Meal8 Meal9 Meal10 M11 M12
001 1 0 0 0 0 3 3 0 0 0 1 0 1
001 2 0 0 0 0 2 3 0 1 1 0 0 0
001 3 0 0 0 0 0 0 2 1 0 0 0 3
040 4 0 0 0 0 0 0 3 0 1 0 0 4
First you need to get your data into some format which will make it easier to see in the code which part is which. An easy way to do that is create a Class with properties which have meaningful names.
Then you can group the data by restaurant, and for each restaurant you can group the data for each date.
As the output is in columns of the widths of the names of the foods, you need to take those names into account when formatting the output.
For simplicity, I created a console app instead of a Windows Forms app. Also, I would split it up into more methods if I was doing this for more than a proof-of-concept.
Imports System.IO
Imports System.Text
Module Module1
Dim Foods As Dictionary(Of String, String)
Class Datum
Property Restaurant As String
Property Day As Integer
Property FoodCodes As List(Of String)
Public Overrides Function ToString() As String
' Useful for debugging.
Return $"{Restaurant} {Day} " & String.Join(",", FoodCodes)
End Function
End Class
Sub LoadFoods()
' Generate some food names. The first food name has a code of "1".
Foods = New Dictionary(Of String, String)
Dim names = {"Rice", "Beans", "Banana", "Meat", "Snacks", "Potato", "Spinach",
"Fish", "Aubergine", "Peas", "Egg", "Chicken", "Cheese", "Onion",
"Carrots", "Brocolli", "Asparagus", "Garlic", "Cabbage", "Coconut", "Yam",
"Naan", "Lentils"}
For i = 1 To names.Count
Foods.Add(i.ToString(), names(i - 1))
Next
End Sub
Sub Main()
LoadFoods()
Dim src = "C:\temp\FoodRecords.txt"
Dim dest = "C:\temp\meals.txt"
Dim data As New List(Of Datum)
For Each line In File.ReadLines(src)
Dim parts = line.Split({","c})
If parts.Count = 5 Then
Dim d As New Datum With {.Restaurant = parts(0),
.Day = Integer.Parse(parts(1)),
.FoodCodes = parts.Skip(2).OrderBy(Function(s) s).ToList()}
data.Add(d)
End If
Next
' Prepare information on the widths of the columns to be output...
Dim colWidths As New List(Of Integer)
colWidths.Add(-("Restaurant".Length))
colWidths.Add(-("Day".Length))
For Each food In Foods
colWidths.Add(food.Value.Length)
Next
' Group the data by restaurant...
Dim restaurantData = From d In data
Group By RestCode = d.Restaurant
Into RestData = Group
Using sw As New StreamWriter(dest)
sw.Write("Restaurant Day ")
sw.WriteLine(String.Join(" ", Foods.Select(Function(f) f.Value)))
For Each x In restaurantData
'Console.WriteLine(x.RestCode & " " & String.Join(",", x.RestData))
' Get each day of data for this restaurant
Dim restaurantDay = From y In x.RestData
Group By Day = y.Day
Into DayData = Group
For Each rd In restaurantDay
' Count the occurrences of food codes for this day...
Dim dayFoodCounts As New Dictionary(Of String, Integer)
For Each fd In rd.DayData
For Each fc In fd.FoodCodes
If dayFoodCounts.ContainsKey(fc) Then
dayFoodCounts(fc) += 1
Else
dayFoodCounts.Add(fc, 1)
End If
Next
Next
' Generate the first two columns
Dim sb As New StringBuilder()
Dim fmt = "{0," & colWidths(0) & "}"
sb.AppendFormat(fmt, x.RestCode)
sb.Append(" ")
fmt = "{0," & colWidths(1) & "}"
sb.AppendFormat(fmt, rd.Day)
sb.Append(" ")
' Generate the columns with food consumption counts
Dim n = 0
For Each kvp In Foods
If dayFoodCounts.ContainsKey(kvp.Key) Then
sb.Append(String.Format("{0," & colWidths(n + 2) & "}", dayFoodCounts(kvp.Key)) & " ")
Else
' no count for this food item, so fill it with spaces
sb.Append(New String(" "c, colWidths(n + 2) + 1))
End If
n += 1
Next
sw.WriteLine(sb.ToString())
Next
Next
End Using
Console.WriteLine("Done.")
Console.ReadLine()
End Sub
End Module
Given the sample data from the question, the above code generates a file with this content:
Restaurant Day Rice Beans Banana Meat Snacks Potato Spinach Fish Aubergine Peas Egg Chicken Cheese Onion Carrots Brocolli Asparagus Garlic Cabbage Coconut Yam Naan Lentils
001 1 3 3 1 1 1 3
001 2 2 3 1 1 3 2
001 3 2 1 3 2 1
040 4 3 1 4 3 1
(In my previous solution I had wrongly assumed that the numbers are counts and each column represents an article, which was not the case. Here my new solution.)
I would separate reading the file from writing the table. To be able to represent the content of the file easily, let's create a class to represent food.
Public Class Food
Public Property Restaurant As String
Public Property Day As Integer
Public Property ArticleNo As Integer
Public Property Quantity As Integer
End Class
The Quantity property is not strictly necessary, since it will always be 1. But it seems logical to have it in case the file format evolves in future.
Now we can read the file like this
Public Function ReadFoodFile(inputPath As String) As List(Of Food)
Dim foodList = New List(Of Food)
For Each line As String In File.ReadLines(inputPath)
Dim parts As String() = line.Split(",")
If parts.Length > 2 Then 'Make sure we don't try to read an empty line,
' e.g.at the end of the file.
Dim dayNo As Integer = CInt(parts(1))
For i = 2 To parts.Length - 1
Dim articleNo As Integer
If Int32.TryParse(parts(i), articleNo) AndAlso articleNo <> 0 Then
Dim food = New Food()
food.Restaurant = parts(0)
food.Day = dayNo
food.ArticleNo = articleNo
food.Quantity = 1
foodList.Add(food)
End If
Next
End If
Next
Return foodList
End Function
The function for reading the file has the input path as parameter and returns a list of food where each entry corresponds to one restaurant, one day and one food article.
This was the easy part. Writing the table is complicated as we must group by restaurants and days as well as by article for each row. Then we must be able to look up the article by its article number. We need a class representing an article:
Public Class Article
Public Property ArticleNo As Integer
Public Property Name As String
Public Sub New(articleNo As Integer, name As String)
Me.ArticleNo = articleNo
Me.Name = name
End Sub
Private Shared _allArticles = New Article() {
New Article(1, "Rice"), New Article(2, "Beans"), New Article(3, "Yam"), New Article(4, "Meat"),
New Article(5, "Snack"), New Article(6, "Coke"), New Article(7, "Burger"), New Article(8, "Meal8"),
New Article(9, "Meal9"), New Article(10, "Meal10"), New Article(11, "M11"), New Article(12, "M12"),
New Article(13, "M13"), New Article(14, "M14"), New Article(15, "M15"), New Article(16, "M16"),
New Article(17, "M17"), New Article(18, "M18"), New Article(19, "M19"), New Article(20, "M20"),
New Article(21, "M21"), New Article(22, "M22"), New Article(23, "M23")
}
Shared ReadOnly Property AllArticles() As Article()
Get
Return _allArticles
End Get
End Property
End Class
Besides article no. and name, it contains a shared property returning a list of articles. In a real-life application, the list of articles should probably be read from a file or a database instead of being hard-coded.
Now, we can formulate the Sub writing the table. It makes heavy use of LINQ and uses the new ValueTuple type available since VB/VS 2017.
Public Sub WriteFoodTable(outputPath As String, foods As IEnumerable(Of Food))
Const ColumnSize = 8
'Create an IEnumerable(Of (Restaurant As String,
' Day As Integer,
' Articles As Dictionary(Of Integer, Integer))
' )
' )
' where the dictionary stores article quantities using the article no. as key.
Dim groupedFood = From food In foods
Group By food.Restaurant, food.Day Into g1 = Group
Select (
Restaurant:=Restaurant, Day:=Day,
Articles:=
(From x In g1
Group By x.ArticleNo Into g2 = Group
Select (ArticleNo:=ArticleNo,
Quantity:=g2.Sum(Function(f) f.Quantity))
).ToDictionary(Function(a) a.ArticleNo, Function(a) a.Quantity)
)
Using writer As New StreamWriter(outputPath)
' Write header
writer.Write("Rest Day")
For Each art In Article.AllArticles
writer.Write(art.Name.PadLeft(ColumnSize))
Next
writer.WriteLine()
' Write rows
For Each row In groupedFood
writer.Write(row.Restaurant.PadRight(5))
writer.Write(row.Day.ToString().PadLeft(4))
For Each art In Article.AllArticles
Dim quantity As Integer
row.Articles.TryGetValue(art.ArticleNo, quantity) ' yields 0 if not found.
writer.Write(quantity.ToString().PadLeft(ColumnSize))
Next
writer.WriteLine()
Next
End Using
End Sub
Putting things together
Dim foods As List(Of Food) = ReadFoodFile(inputPath)
WriteFoodTable(outputPath, foods)
See also:
Tuples (Visual Basic)
LINQ in Visual Basic
I am currently in an IT curriculum in college. Advance Visual Basic 2010 is a requirement however, I am not a programmer. I have been struggling to find my way through VB but this last assignment has me stumped.I am able to get the first name into the array and the 5 grades for that name . At that point, the loop will continue to ask for the next name and that names 5 grades and so on until the 4th name and grades are entered and then it should display all 4 names and grade averages in the listbox.
Here is the assignment...
Write a program that will input four students’ names and average five test grades for each student. The program should have an array for the students name and then a two-dimensional array for all their grades.
Your program should ask for the students name and then five test scores for that student.
Create a method that does the averaging and pass the arrays to that method. That method can also output the student name and average in a list box.
Call a method to figure up the average once you get all the grades. Do not figure it up as you get the information!! You’ll get a big ole zero if you do! Then have that same method output the results into the list box:
After 4 days of struggling with this, here is what I have come up with so far. Any guidance is greatly appreciated. Thank you in advance.
Public Class Form1
Private Sub btnNames_Click(sender As System.Object, e As System.EventArgs) Handles btnNames.Click
Dim NamesList(3) As String
Dim GradeArray(4) As Integer
Dim x As Integer
Dim y As Integer
Dim Sum As Integer
Dim Avg As Integer
For y = 0 To NamesList(3)
NamesList(x) = InputBox("Enter student number " & y + 1 & "'s name:", "Enter a name")
Next
For y = 0 To GradeArray.Length - 1
GradeArray(y) = InputBox("Enter grade number " & y + 1 & " for " & NamesList(0) & " in the box:", "Enter the grades")
Next
For Each item In GradeArray
Sum = Sum + item
Next
Avg = Sum / 5
lstAverages.Text = Avg.ToString
End Sub
Private Sub btnExit_Click(sender As System.Object, e As System.EventArgs) Handles btnExit.Click
Me.Close()
End Sub
End Class
I had nothing else better to do, so I took up giving it a try... Also this includes per as you stated: 4 students - 5 grades each, array for students names and a 2D array to hold all their grades. There's a method that passes these to it and performs the averaging of the students grades and then spits them to a listbox as requested ... Happy Coding!
P.S. I didn't do any error handling either, you may want to add that or at least implement something to handle such cases ...
Public Class Form1
Private arrStudents(3) As String 'Student's name array (4)
Private arrScores(3, 4) As Integer 'Students scores (5 each)
'Start getting the data we need
Private Sub btnGetStudents_Click(sender As Object, e As EventArgs) Handles btnGetStudents.Click
Dim strStudent As String = String.Empty
Dim intScore As Integer = 0
Dim intPlace As Integer = 0
'Get the students name...
For i As Integer = 0 To arrStudents.Length - 1
Do Until strStudent <> String.Empty
strStudent = InputBox("Please enter student's name: ", "Gather Student Grades")
Loop
arrStudents(i) = strStudent
'Reset our variable...
strStudent = String.Empty
'Get the students grades...
For s As Integer = 0 To arrScores.Length - 1
Do Until intScore > 0
intScore = CInt(InputBox("Please enter student's scores: ", "Gather Student Scores"))
Loop
If (intPlace = 4 AndAlso i = arrStudents.Length) Then
intPlace = 0
arrScores(i, s) = intScore
intScore = 0
ElseIf intPlace = 4 Then
intPlace = 0
arrScores(i, s) = intScore
intScore = 0
Exit For
Else
arrScores(i, intPlace) = intScore
intPlace += 1
End If
'Reset our variables...
intScore = 0
Next
Next
'Calculate and output the data to the listbox...
GetStudentAverages(arrStudents, arrScores)
End Sub
'Function to average per student grades and then display them all in the listbox...
Private Sub GetStudentAverages(ByVal arStudent As Array, ByVal arScore As Array)
Dim strStudentData As String = String.Empty
Dim intAverage As Integer = 0
Dim intPlace As Integer = 0
'Start averaging the students scores and then add them to the listbox...
For i As Integer = 0 To arStudent.Length - 1
For g As Integer = 0 To arScore.Length - 1
If intPlace = arStudent.Length Then
intAverage += arScore(i, intPlace)
Exit For
Else
intAverage += arScore(i, intPlace)
intPlace += 1
End If
Next
intAverage = CInt(intAverage / 5)
intPlace = 0
'Output the student information...
ListBox1.Items.Add("Student: " & arStudent(i).ToString & " Average: " & intAverage.ToString)
intAverage = 0
Next
End Sub
End Class
My problem is when I input scores for four tests: 1 2 3 3, it calculates total and average everything is working great, but if I put scores for tests bigger than 3, which is bigger than my array it gives me error in this function
Public Function TotalScore(studentScore() As Integer, intTotalScore As Integer) As Integer
For Each i As Integer In studentScore
intTotalScore += studentScore(i)
Next
Return intTotalScore
End Function
the error message is that index is out of range array.
I am sorry I don't know how to explain it better if you need additional code or some more details I will be more than happy to provide. Thank you for your time
Public g_intTotalScore As Integer 'total score
Public g_decAverageScore As Decimal 'average score
Public g_strLetterScore As String
Public Const intMAX_SUBSCRIPT_STUDENTS_NAMES As Integer = 4 'max subscript for students names
Public Const intMAX_SUBSCRIPT_SCORE As Integer = 3 'max subscript for student numeric scores on 4 test
Public strStudentsNames(intMAX_SUBSCRIPT_STUDENTS_NAMES) As String 'array that holds students names
Public strLetterGrades() As String = {"A", "B", "C", "D", "F"} 'array that hold letter grades
Public intStudent1(intMAX_SUBSCRIPT_SCORE) As Integer 'hold test scores for student1
I create function that accepts two parameters to calculate total score of 4 tests
Public Function TotalScore(studentScore() As Integer, intTotalScore As Integer) As Integer
For Each i As Integer In studentScore
intTotalScore += studentScore(i)
Next
Return intTotalScore
End Function
Here is input for Student Name and than 4 test scores
Do While intCount < strStudentsNames.Length
'input data for student number1
If intCount = 0 Then
intCounter = 0
strStudentsNames(intCount) = InputBox("Enter Student Name number" & intCount + 1, "Enter Data")
Do While intCounter < intStudent1.Length
intStudent1(intCounter) = CInt(InputBox("Student Name: " & strStudentsNames(intCount) & vbCrLf &
"Enter Score for test number " & intCounter + 1, "Enter Data"))
intCounter += 1
Loop
End If
intCount += 1
Loop
here is display data to list
'student1: calculate total , avaerage score, display average score, reset total score
g_intTotalScore = TotalScore(intStudent1, g_intTotalScore)
g_decAverageScore = Average(g_decAverageScore)
lstOutPut.Items.Add("Student Name: " & strStudentsNames(0) & " => The average score is: " & g_decAverageScore.ToString & " => Grade: ")
g_intTotalScore = 0
The error means that you are trying to get something from the array index that doesn't exists in the array. For example the array has 10 elements from 0 - 9 index and your calling the index number 11.
Try to use the for each like this:
For Each i As Integer In studentScore
intTotalScore += i
Next