string combinations - vb.net

I would like to generate a combination of words. For example if I had the following list:
{cat, dog, horse, ape, hen, mouse}
then the result would be n(n-1)/2
cat dog horse ape hen mouse
(cat dog) (dog horse) (horse ape) (ape hen) (hen mouse)
(cat dog horse) (dog horse ape) (horse ape hen) etc
Hope this makes sense...everything I found involves permutations
The list I have would be a 500 long

Try this! :
Public Sub test()
Dim myAnimals As String = "cat dog horse ape hen mouse"
Dim myAnimalCombinations As String() = BuildCombinations(myAnimals)
For Each combination As String In myAnimalCombinations
'Look on the Output Tab for the results!
Console.WriteLine("(" & combination & ")")
Next combination
End Sub
Public Function BuildCombinations(ByVal inputString As String) As String()
'Separate the sentence into useable words.
Dim wordsArray As String() = inputString.Split(" ".ToCharArray)
'A plase to store the results as we build them
Dim returnArray() As String = New String() {""}
'The 'combination level' that we're up to
Dim wordDistance As Integer = 1
'Go through all the combination levels...
For wordDistance = 1 To wordsArray.GetUpperBound(0)
'Go through all the words at this combination level...
For wordIndex As Integer = 0 To wordsArray.GetUpperBound(0) - wordDistance
'Get the first word of this combination level
Dim combination As New System.Text.StringBuilder(wordsArray(wordIndex))
'And all all the remaining words a this combination level
For combinationIndex As Integer = 1 To wordDistance
combination.Append(" " & wordsArray(wordIndex + combinationIndex))
Next combinationIndex
'Add this combination to the results
returnArray(returnArray.GetUpperBound(0)) = combination.ToString
'Add a new row to the results, ready for the next combination
ReDim Preserve returnArray(returnArray.GetUpperBound(0) + 1)
Next wordIndex
Next wordDistance
'Get rid of the last, blank row.
ReDim Preserve returnArray(returnArray.GetUpperBound(0) - 1)
'Return combinations to the calling method.
Return returnArray
End Function
The first function is just something that shows you how to call the second function. It really depends on how you get your 500 list - you can copy and paste it over the animal names, or you can load a file with the words in it. If it doesn't fit on one line you can try:
Dim myAnimals As New StringBulder
myAnimals.Append("dog cat ... animal49 animal50")
myAnimals.Append(" ")
myAnimals.Append("animal51 ... animal99")
myAnimals.Append(" ")
myAnimals.Append("animal100 ... animal150")
etc.
then
Dim myAnimalCombinations As String() = BuildCombinations(myAnimals.ToString)

Say your list is arr = {cat, dog, horse, ape, hen, mouse}
Then you can do:
for i = 0; i < arr.size; i++)
for j = i; j < arr.size; j++)
print i,j;
The idea is basically - for each item, pair it with every other item on the list. However, to avoid the duplication (e.g. 1,2 and 2,1) you don't start the internal loop from the beginning every time but from your current index of the outer loop.

Related

How to get word between two specific character and list it in vb .NET

I have a string and I want to get the words in parentheses and list them:
I'm (Kid J)
From (Detroit), (Michigan)
I tried the cod below, but this code only lists two words :
For Each line As String In TextBox1.Lines
Dim i As Integer = line.IndexOf("(")
Dim f As String = line.Substring(i + 1, line.IndexOf(")", i - 1) - i - 1)
TextBox2.AppendText(f + vbCrLf)
Next
the result with this cod is this:
Kid J
Detroit
You can use Regex:
Dim text = "I'm (Kid J)
From (Detroit), (Michigan)"
Dim matches = From match In Regex.Matches(text, "\(([^)]*)\)")
Select match.Groups(1).Value
Console.Write(String.Join(",", matches))
outputs:
Kid J,Detroit,Michigan
Here's the regex with some explanations:
https://regex101.com/r/13ME3n/1

Split text into 80 character lines, issue with last line

I'm trying to take a body of text and add line breaks around 80 characters on each line. The issue I'm having is on the last line it's adding an extra line break than would be desired. For instance this string should not have a line break on the second to last line:
Alice was beginning to get very tired of sitting by her sister on the bank, and
of having nothing to do: once or twice she had peeped into the book her sister
was reading, but it had no pictures or conversations in it, and what is the use
of a book, thought Alice without pictures or
conversations?
should look like this (note "conversations" has been moved up):
Alice was beginning to get very tired of sitting by her sister on the bank, and
of having nothing to do: once or twice she had peeped into the book her sister
was reading, but it had no pictures or conversations in it, and what is the use
of a book, thought Alice without pictures or conversations?
Here's the code:
Sub StringChop()
Dim OrigString As String
Dim NewString As String
Dim counter As Long
Dim length As Long
Dim LastSpace As Long
Dim LineBreak As Long
Dim TempString As String
Dim TempNum As Long
OrigString = "Alice was beginning to get very tired of sitting by her sister on the bank, and of having nothing to do: once or twice she had peeped into the book her sister was reading, but it had no pictures or conversations in it, and what is the use of a book, thought Alice without pictures or conversations?"
length = Len(OrigString)
counter = 1
Do While counter < length
'Extract next 80 characters from last position
TempString = Mid(OrigString, counter, 80)
'Determine last space in string
LastSpace = InStrRev(TempString, " ")
'Determine first line break in string
LineBreak = InStr(TempString, vbNewLine)
'If line break exists in sentence...
'only count characters up to line break, and set counter to that amount
Select Case LastSpace 'What to do if there are spaces in sentence
Case Is > 0 'There are spaces in sentence
Select Case LineBreak 'What to do if there are line breaks in sentence
Case Is = 0
'From last counter position,
NewString = NewString & Mid(OrigString, counter, LastSpace) & vbNewLine
counter = counter + LastSpace
Case Is <> 0
NewString = NewString & Mid(OrigString, counter, LineBreak)
counter = counter + LineBreak
End Select
Case Is = 0 'There are no more spaces left in remaining sentence
NewString = NewString & Mid(OrigString, counter)
counter = length
End Select
Loop
Debug.Print NewString
End Sub
Word wrapping is an interesting problem. I wrote the following code once as an experiment. You might find it helpful:
Option Explicit
'Implements a dynamic programming approach to word wrap
'assumes fixed-width font
'a word is defined to be a white-space delimited string which contains no
'whitespace
'the cost of a line is the square of the number of blank spaces at the end
'of a line
Const INFINITY As Long = 1000000
Dim optimalCost As Long
Function Cost(words As Variant, i As Long, j As Long, L As Long) As Long
'words is a 0-based array of strings, assumed to have no white spaces
'i, j are indices in range 0,...,n, where n is UBOUND(words)+1
'L is the maximum length of a line
'Cost returns the cost of a line which begins with words(i) and ends with
'words(j-1). It returns INFINITY if the line is too short to hold the words
'or if j <= i
Dim k As Long
Dim sum As Long
If j <= i Or Len(words(i)) > L Then
Cost = INFINITY
Exit Function
End If
sum = Len(words(i))
k = i + 1
Do While k < j And sum <= L
sum = sum + 1 + Len(words(k)) 'for space
k = k + 1
Loop
If sum > L Then
Cost = INFINITY
Else
Cost = (L - sum) ^ 2
End If
End Function
Function WordWrap(words As Variant, L As Long) As String
'returns string consisting of words with spaces and
'line breaks inserted at the appropriate places
Dim v() As Long, d() As Long
Dim n As Long
Dim i As Long, j As Long
Dim candidate As Long
n = UBound(words) + 1
ReDim v(0 To n)
ReDim d(0 To n)
v(0) = 0
d(0) = -1
For j = 1 To n
v(j) = INFINITY 'until something better is found
i = j - 1
Do
candidate = v(i) + Cost(words, i, j, L)
If candidate < v(j) Then
v(j) = candidate
d(j) = i
End If
i = i - 1
Loop While i >= 0 And candidate < INFINITY
If v(j) = INFINITY Then
MsgBox "Some words are too long for the given length"
Exit Function
End If
Next j
optimalCost = v(n)
'at this stage, optimal path has been found
'just need to follow d() backwards, inserting line breaks
i = d(n) 'beginning of current line
WordWrap = words(n - 1)
j = n - 2
Do While i >= 0
Do While j >= i
WordWrap = words(j) & " " & WordWrap
j = j - 1
Loop
If i > 0 Then WordWrap = vbCrLf & WordWrap
i = d(i)
Loop
End Function
The above function expects an array of words. You would have to split a string before using it as input:
Sub test()
Dim OrigString As String
OrigString = "Alice was beginning to get very tired of sitting by her sister on the bank, and of having nothing to do: once or twice she had peeped into the book her sister was reading, but it had no pictures or conversations in it, and what is the use of a book, thought Alice without pictures or conversations?"
Debug.Print WordWrap(Split(OrigString), 80)
End Sub
Output:
Alice was beginning to get very tired of sitting by her sister on the bank,
and of having nothing to do: once or twice she had peeped into the book
her sister was reading, but it had no pictures or conversations in it, and
what is the use of a book, thought Alice without pictures or conversations?

What is the simplest way to display an aligned table from an Array of Strings in a TextBox using just Tabs (not using Tabstops)

I have an array of strings with 5 entries, where each string consists of 7 fields separated by comma's.
Those fields are of different lengths. I'm using a monospace font, so I can align things with tabs.
I had build a loop that goes through the string array, splitting the strings in the array, to determine which string in each "column" is the longest.
Then another loop, where I assemble a string with fields followed by a vbTab, and if the current field is a multiple of 8 shorter than the maximum length I add extra vbTabs (so if it's 8 shorter, add an extra vbTab, 16 = 2 vbTabs, etc).
But I have trouble getting things properly aligned in some cases.
Code:
Sub WriteTidyBlockH_layoutissues(list As List(Of String))
'Takes a list of strings as argument
'Writes it out as a table
'Assumes first line is a header (will be bolded)
'Go through list, split table fields and determine their lengths
Dim strLineFields As String() 'string array to hold the fields in a single line
Dim strLineField As String 'an individual field in a line
Dim FieldMaxLengths As New List(Of Integer)() 'list that will hold max length of each column
Dim i, j, k, intLines, intColumns As Integer
Dim strLine As String 'string to build a tabbed line in
Dim Tabs As Byte
'determine number of lines
intLines = list.Count - 1
'determine number of columns by counting the commas
intColumns = list(0).Count(Function(c As Char) c = ",")
For i = 0 To intColumns
FieldMaxLengths.Add(0)
Next
Dim strFields(intLines, intColumns) As String '2 dimensional array of strings, containing ALL fields
i = 0
For Each strListElement As String In list
j = 0
strLineFields = Split(strListElement, ",")
For Each strLineField In strLineFields
strFields(i, j) = strLineFields(j)
If strLineFields(j).Length > FieldMaxLengths(j) Then
FieldMaxLengths(j) = strLineFields(j).Length
End If
j += 1
Next
i += 1
Next
For i = 0 To intLines
strLine = ""
For j = 0 To intColumns
If Not j = intColumns Then
strLine += strFields(i, j) + vbTab 'one tab is always needed for every field, except the last
If strFields(i, j).Length <= FieldMaxLengths(j) Then
'strLine += strFields(i, j) + vbTab
'figure out how many additional tabs necessary
Tabs = (FieldMaxLengths(j) - strFields(i, j).Length) \ 8 'Div
For k = 1 To Tabs
strLine += vbTab
Next
End If
Else
'last column, don't add tabs
strLine += strFields(i, j)
End If
Next
If i = 0 Then
WriteOut(strLine, 0, True)
Else
WriteOut(strLine)
End If
Next
End Sub
Output currently looks like this:
Bank Location Capacity Speed Manufacturer Part Number Serial Number
BANK 0 ChannelA-DIMM0 8GB 1600 Kingston 99U5471-066.A00LF 24E8D583
BANK 1 ChannelA-DIMM1 8GB 1600 Kingston 99U5471-054.A00LF 30269BB7
BANK 2 ChannelB-DIMM0 8GB 1600 Kingston 99U5471-058.A00LF 182C9113
BANK 3 ChannelB-DIMM1 8GB 1600 Kingston 99U5471-054.A00LF D63F4C11
N.B. I'm having some trouble with formatting. In the actual output, only Capacity and Serial Number are misaligned (too far left), while Spped, Manufacturer and Part Number are correctly aligned with the data under them.
N.B.: WriteOut is just a sub that writes a single string to the textbox and appends a vbCrLf. The other two arguments are optional (color and bold).

Adding items to a multidimensional array from a textfile in Visual Basic

I have this textfile:
Paul George|2.87|29
Stephen Curry|2.85|28
Jamal Murray|2.72|21
PJ Tucker|2.72|11
Kyle Lowry|2.61|15
Game
Paul George|g2d|g2p
Stephen Curry|g2d|g2p
Jamal Murray|g2d|g2p
PJ Tucker|g2d|g2p
Kyle Lowry|g2d|g2p
Game
Paul George|g3d|g3p
Stephen Curry|g3d|g3p
Jamal Murray|g3d|g3p
PJ Tucker|g3d|g3p
Kyle Lowry|g3d|g3p
Game
Paul George|g4d|g4p
Stephen Curry|g4d|g4p
Jamal Murray|g4d|g4p
PJ Tucker|g4d|g4p
Kyle Lowry|g4d|g4p
I want to add the items to the arrays
Names(name, gamenumber)
Distance(distance, gamenumber)
Points(Points, gamenumber)
with the first index being the data for the player, and the second being the game that data is from
For example,
distance(1, 0) = 2.87
distance(5, 0) = 2.61
distance(1, 1) = g2d
So that the indexes match up with the player for the given game number.
So far I have:
Private Sub openFile_Click(sender As Object, e As EventArgs) Handles openFile.Click
OpenFileDialog.ShowDialog()
Dim strFileName = OpenFileDialog.FileName
Dim objReader As New System.IO.StreamReader(strFileName)
Dim textline As String
Dim Names(100, 3) As String
Dim Distance(100, 3) As String
Dim Points(100, 3) As String
Dim Count As Integer = 0
Dim GameNumber As Integer = 0
Do While objReader.Peek() <> -1
textline = objReader.ReadLine() & vbNewLine
If textline = "Game" Then
GameNumber = GameNumber + 1
Else
Dim parts() As String = textline.Split("|")
Names(Count, GameNumber) = parts(0)
Distance(Count, GameNumber) = parts(1)
Points(Count, GameNumber) = parts(2)
Count = Count + 1
End If
Loop
End Sub
The parts of each line are split up by |, putting them into "parts", it then assigns the three parts it gets from the line (the player name, distance, and points) into there separate arrays as
Names(<Name>, 0)
Distance(<Distance>, 0)
Points(<Points>, 0)
It continues down the textfile but IF the line = "Game" it should, increment GameNumber, and then move to the next line, continuing to add the data, instead as
Names(<Name>, 1)
Distance(<Distance>, 1)
Points(<Points>, 1)
and so on, but it my code isn't working. After getting this working, I wont it to print the desired Game statistics for the players on the page in a listbox with something like:
For n = 0 To Count - 1
lstNames.Items.Add(Names(n, GameWanted))
lstNames.Items.Add(" ")
lstDistance.Items.Add(Distance(n, GameWanted) + " Miles")
lstDistance.Items.Add(" ")
lstPoints.Items.Add(Points(n, GameWanted))
lstPoints.Items.Add(" ")
Next
This would become a lot easier if you create a class representing your player and index them with a dictionary
Class Player
Public Property Distances as List(Of Decimal)
Public Property Points as List(Of Integer)
Public Property Name as String
Public Sub New(n as String)
Name = n
Distances = New List(of Decimal)
Points = New List(of Integer)
End sub
End class
And then in your method that reads your file:
Dim d as new Dictionary(of String, Person)
ForEach line as String in File.ReadAllLines(...)
Dim bits = line.Split("|"c)
If bits.Length < 3 Then Continue For
If Not d.ContainsKey Then d.Add(bits(0), New Person(bits(0))
Dim p = d(bits(0)) 'retrieve the old or just added person
p.Distances.Add(decimal.parse(bits(1)))
p.Points.Add(integer.parse(bits(2)))
Next line
Note; I'm a c# programmer and seldom do vb any more. I code with array indexes starting at 0, if you're on 1 base indexing, add one to the indexes above. This code should probably be treated as pseudocode; it was written on a cellphone from a 5 year old memory of what vb looks like and might have a raft of vb syntax errors(sorry) or take the long way round to do things that we have shorter sybtaxes for these days (list initializers etc)
At the end of this loop through all the file you will have a dictionary of your people, one per name encountered. Each person will have a list of scores and distances. If you want to add them up or average them add a Function to person class that iterates the list and returns the result, and to print them all out do a
foreach s as string in d.Keys
Console.Write(d(s).Name & " got avg distance " & d(s).GetAverageDist())
Or similar
To print out all their distances:
foreach s as string in d.Keys
foreach dis as decimal in d(s).Distances
Console.Write(d(s).Name & " got distance " & dis)
This is object oriented programming; we model the world using classes to represent things and do useful stuff. We don't try to collect data together in 20 different arrays and tie it all together with indexes etc - that's a very procedural code mindset and the opposite of what vb.net was invented for
It's likely actually that this falls short of a proper solution and is also somewhat hypocritical because I use two lists to track distance and points and assert that the list indexes are equal - the distance at index 3 and the points at index 3 are from game 4 (zero based indexing note)
What we really should do is also define a GameResult class and it have properties of distance, points and gamenumber, then each person class has a single List(of GameResult) - person could have a function that returns a nicely formatted score card for that person - that's proper OO :)

How do I count the number of times a word occurs using Visual Basic?

I have just started using visual basic and wanted to create a program that counted the number of times a word appeared. My plan was develop a program that analyses a sentence that contains several words without punctuation. When
a word in that sentence is input, the program identifies all of the positions where the word occurs in the sentence.
I started by making a code that counted the amount of spaces in a sentence but am now stuck.
Module Module1
Sub Main()
Dim Sentence As String
Dim SentenceLength As Integer
Dim Text As String
Console.WriteLine("ASK NOT WHAT YOUR COUNTRY CAN DO FOR YOU ASK WHAT YOU CAN DO FOR YOUR COUNTRY")
Console.WriteLine("Enter your word ") : Sentence = Console.ReadLine
Dim TextCounter As Integer = 0
Dim MainWord As String = Sentence
Dim CountChar As String = " "
Do While InStr(MainWord, CountChar) > 0
MainWord = Mid(MainWord, 1 + InStr(MainWord, CountChar), Len(MainWord))
TextCounter = TextCounter + 1
Text = TextCounter + 2
Console.WriteLine(Text)
Loop
Console.WriteLine(TextCounter)
Console.Write("Press Enter to Exit")
Console.ReadLine()
End Sub
End Module
A quick & dirty method is to split the string into an array of strings, then count how many times a word appears in it:
Dim words() As String = Sentence.Split(new char() {" ", ",", ".", ";"} ' add other punctuation as appropriate
Dim count = words.Count(Function(word) word = MainWord)
This uses the String.Split method to split the string each time a space is encountered. Then it uses the Enumerable.Count extension method to count the words that match a certain condition, that the word is equal to MainWord
To count substrings:
Dim count = UBound(Split("catty cat", "cat")) ' 2
To count words:
Dim countWords = Regex.Matches("catty cat", "\bcat\b").Count ' 1