vb .net permutation of string. permutation or combination? - vb.net

i've got arary of string like this C - F - A - M. i want to create a combination from that with condition:
each other item beside last character has to be combined with last character
there's not allowed a same combination, even the order is different. for example
FC - M
CF - M
if the string array contains >=3 element it will generate 2 & 3 itemset, if 2 element then it will generate only 2 itemset
below is my code. my code generate the result like right part of the picture
my question is what method should i use? is it permutation, combination, or other things?
and in pseudocode, what is my case would be like?
here's my code
Public Class permute
Dim ItemUsed() As Boolean
Dim pno As Long, pString As String
Dim inChars() As Char = {"c", "f", "a", "m"}
Private Sub permute_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
End Sub
Sub Permute(ByVal K As Long)
ReDim ItemUsed(K)
pno = 0
Dim i As Integer
For i = 2 To K
Permutate(i, 1)
tb.Text = K
Next
End Sub
Private Sub Permutate(ByVal K As Long, ByVal pLevel As Long)
Dim i As Long, Perm As String
Perm = pString
For i = 0 To K - 1
If Not ItemUsed(i) Then
If pLevel = 1 Then
pString = inChars(i)
Else
pString += inChars(i)
End If
If pLevel = K Then
pno = pno + 1
Results.Text += _
pno & " " & " = " & " " & pString & vbCrLf
Exit Sub
End If
ItemUsed(i) = True
Permutate(K, pLevel + 1)
ItemUsed(i) = False
pString = Perm
End If
Next
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Permute(tb.Text)
End Sub
Private Sub tb_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tb.TextChanged
If tb.Text = "" Then
Results.Text = ""
Else
Permute(tb.Text)
End If
End Sub
End Class
here's the requirement screenshot
and here's the program screenshot

Add this class to your project:
Public NotInheritable Class Permutation
Public Shared Function Create(array As Char()) As List(Of String)
Return Permutation.Create(array, False)
End Function
Public Shared Function Create(array As Char(), sort As Boolean) As List(Of String)
If (array Is Nothing) Then
Throw New ArgumentNullException("array")
ElseIf ((array.Length < 0) OrElse (array.Length > 13)) Then
Throw New ArgumentOutOfRangeException("array")
End If
Dim list As New List(Of String)
Dim n As Integer = array.Length
Permutation.Permute(list, array, 0, array.Length)
If (sort) Then
list.Sort()
End If
Return list
End Function
Private Shared Sub Permute(list As List(Of String), array As Char(), start As Integer, n As Integer)
Permutation.Print(list, array, n)
If (start < n) Then
Dim i, j As Integer
For i = (n - 2) To start Step -1
For j = (i + 1) To (n - 1)
Permutation.Swap(array, i, j)
Permutation.Permute(list, array, (i + 1), n)
Next
Permutation.RotateLeft(array, i, n)
Next
End If
End Sub
Private Shared Sub Print(list As List(Of String), array As Char(), size As Integer)
If (array.Length <> 0) Then
Dim s As Char() = New Char(size - 1) {}
For i As Integer = 0 To (size - 1)
s(i) = array(i)
Next
list.Add(s)
End If
End Sub
Private Shared Sub RotateLeft(array As Char(), start As Integer, n As Integer)
Dim tmp As Char = array(start)
For i As Integer = start To (n - 2)
array(i) = array(i + 1)
Next
array(n - 1) = tmp
End Sub
Private Shared Sub Swap(array As Char(), i As Integer, j As Integer)
Dim tmp As Char
tmp = array(i)
array(i) = array(j)
array(j) = tmp
End Sub
End Class
Because of the Int32.MaxValue limit this class will support levels 1 through 13.
s=1, n=1
s=2, n=2
s=3, n=6
s=4, n=24
s=5, n=120
s=6, n=720
s=7, n=5040
s=8, n=40320
s=9, n=362880
s=10, n=3628800
s=11, n=39916800
s=12, n=479001600
s=13, n=6227020800
Usage:
Me.TextBox1.Text = String.Join(Environment.NewLine, Permutation.Create({"c"c, "f"c, "a"c, "m"c}, sort:=False))
Output:
cfam
cfma
cafm
camf
cmfa
cmaf
fcam
fcma
facm
famc
fmca
fmac
acfm
acmf
afcm
afmc
amcf
amfc
mcfa
mcaf
mfca
mfac
macf
mafc
The class is based on C++ code from the following link:
Calculating Permutations and Job Interview Questions

This seems to be a Combination problem rather than Permutation :
"In mathematics, a combination is a way of selecting several things out of a larger group, where (unlike permutations) order does not matter". [Wikipedia]
Try to solve this by doing Combination to all item in array except the last item. Or in other words, do Combination operations nCk for all k, with
n = size of input array minus the last item
k = size of the output itemset, minimum k is 1 and maximum is n
Then append each Combination result with the last item. Following is the pseudocode code, using C# syntax :p
var input = new char[] {'C', 'F', 'A', 'M'};
//save last char
var lastChar = input[input.Length - 1];
//combinationInput is input member without the last character
var combinationInput = new char[input.Length - 1];
Array.Copy(input, 0, combinationInput, 0, combinationInput.Length);
//generate output with itemset size 1 to combinationInput.Length
for (int i = 1; i <= combinationInput.Length; i++)
{
//generate combination with size i
var combinationOutput = combinationInput.Combinations(i);
foreach (var combinedChar in combinationOutput)
{
//print output as: combinationOutput item + lastChar
Console.WriteLine(string.Join(", ", combinedChar) + ", " + lastChar);
}
}
References :
Array.Copy(...). [How to copy part of an array to another array]
.Combinations(int outputSize) extension method. [How to Generate Combinations of Elements of a List in .NET 4.0]

Related

How do I assign a default property to a FunctionProcedureName() in VB.NET?

I have done extensive research on using recursion in VB.NET (I am using 2015) in order complete a homework assignment. In my desperation, I even asked my professor for help!
I am trying to write a program that will calculate 1! through 12!, and post the results in a list box. The method I am using is based on the following example (sent to me by my prof):
var integer n, result
n = 0
For 1 to 12 do
n = n + 1
write (n, ‘! equals ‘, Fact(n)
End For
Function Fact (ByVal n as Integer)
if (n = 0) then Fact = 1
else Fact = n * Fact (n-1)
End If
End Function
http://www.softwareandfinance.com/VB/Factorial_Recursion.html
My issue is with my call statement for the function (I named it Factorial). Here is the section of the code where I am getting the error message:
For intN = 1 To 12
intFact = Factorial()
lstFactorialsAnswers.Items.Add(intN & "! = " & intFact)
Next
Thank you for your insights.
In response, I removed the "Dim Factorial as Int64" declaration. I also added "intN" as a parameter in the function call. The new error message is "Argument not specified for parameter 'intFact' of 'Public Function Factorial(intN As Integer, intFact As Integer) As Long'.
Here is the revised code:
Public Class frmFactorialMath
Private Sub btnCalculate_Click(sender As Object, e As EventArgs) Handles btnCalculate.Click
Dim intN As Integer
Dim intFact As Integer
intN = Convert.ToInt32(txtN)
For intN = 1 To 12
If intN = 1 Then
lstFactorialsAnswers.Items.Add(intN & "! = " & 1)
Else
intFact = Factorial(intN)
lstFactorialsAnswers.Items.Add(intN & "! = " & intFact)
End If
Next
End Sub
Function Factorial(ByVal intN As Integer, intFact As Integer) As Long
If (intN = 0) Then
Return 1
Else
intFact = intN * Factorial(intN - 1)
Return intFact
End If
End Function
Here is the solution to the issue(s) I was having:
Option Strict On
Public Class frmFactorialMath
' This event handler calculates the factorials for numbers 1 through 12.
' A list showing the answers is compiled and displayed.
Private Sub btnCalculate_Click(sender As Object, e As EventArgs) Handles btnCalculate.Click
Dim intN, intFact As Integer
For intN = 1 To 12
intFact = Factorial(intN)
lstFactorialsAnswers.Items.Add(intN.ToString() & "! = " & intFact.ToString())
Next
End Sub
' This Function performs the calculations using recursion.
Function Factorial(ByVal intFact As Integer) As Integer
If intFact = 1 Then
Return 1
Else
' This "Do While" loop ends the recursion, eliminating an infinite loop.
Do While intFact > 1
Return intFact * Factorial(intFact - 1)
Loop
End If
End Function

Visual basic : Calculate Average function returning infinity

I am supposed to calculate the average number of words and then convert them into a percentage, however they are displaying infinity. The code I am using is below .
Public Class Form1
Private Structure advertisements
Public name As String
Public words As Integer
Public font() As fonts
Public mostLegible As String
End Structure
Private Structure fonts
Public name As String
Public NoWords() As Integer
Public aveWords As Double
Public percent As Double
End Structure
Private noAdverts As Integer
Private noFonts As Integer
Private noReaders As Integer
Private advert() As advertisements
Private Sub GridPlacement(ByVal r As Integer, ByVal c As Integer, ByVal t As String)
grdDisplay.Row = r
grdDisplay.Col = c
grdDisplay.Text = t
End Sub
Private Sub gridAndArraySettings()
Dim x, y As Integer
ReDim advert(noAdverts)
For x = 1 To noAdverts
ReDim advert(x).font(noFonts)
For y = 1 To noFonts
ReDim advert(x).font(y).NoWords(noReaders)
'GridPlacement(0, y, "font " & CStr(y))
Next
Next
grdDisplay.Cols = noFonts + 2
grdDisplay.Rows = noAdverts + 1
GridPlacement(0, 0, "Name of advert")
End Sub
Private Sub btnSubmit_Click(sender As Object, e As EventArgs) Handles btnSubmit.Click
noAdverts = CInt(txtadverts.Text)
noReaders = CInt(txtReaders.Text)
noFonts = CInt(txtFonts.Text)
gridAndArraySettings()
End Sub
Private Sub btnInput_Click(sender As Object, e As EventArgs) Handles btnInput.Click
Dim x, y, z As Integer
Dim total(,) As Integer
ReDim total(noAdverts, noFonts)
For x = 1 To noAdverts
advert(x).name = InputBox("please enter the name of advert " & CStr(x))
advert(x).words = CInt(InputBox("please enter the number of words for " & advert(x).name))
GridPlacement(x, 0, advert(x).name)
For y = 1 To noFonts
advert(x).font(y).name = InputBox("please enter the name of font " & CStr(y) & " Used in advert " & CStr(x))
For z = 1 To noReaders
advert(x).font(y).NoWords(z) = CInt(InputBox("please enter the number of words understood by reader " & CStr(z) & " for font " & advert(x).font(y).name & " in advert " & advert(x).name))
total(x, y) += advert(x).font(y).NoWords(z)
Next
advert(x).font(y).aveWords = calcAve(total(x, y))
advert(x).font(y).percent = advert(x).font(y).aveWords * 100
GridPlacement(x, y, CStr(advert(x).font(y).aveWords)) 'Format(advert(x).font(y).percent, "###%")
Next
Next
End Sub
Private Function calcAve(ByVal elements As Integer) As Double
Dim x, y As Integer
Dim placeholder As Double = 1
Select Case elements
Case Is > 0
For x = 1 To noAdverts
For y = 1 To noFonts
advert(x).font(y).aveWords = (elements / noReaders) / advert(x).words
placeholder = advert(x).font(y).aveWords
MsgBox(CStr(placeholder))
Next y
Next x
Case Is = 0
MsgBox("There is incorrect values ")
End Select
Return placeholder
End Function
End Class
The textboxes are called txtadverts, txtfonts and txtreaders
The button btnsubmit gets the input from the textboxes and stores them in variables. btninput allows input from user.
GrdDisplay is a custom extension used by my university which is a 2D grid used to diplay values.

Convert 1DPointArray into 2DPointArray

I started a new project which loads and saves tilesets in style of ini-datas.
The problem is now, that it loads the tiles into a 1d- list, which got copied sorted into a 1d-array.
Now I am trying to convert this sorted 1d-array into a 2d-array.
My try:
LoadedTiles.Sort(Function(p1, p2) (p1.Position.X.CompareTo(p2.Position.X)))
LoadedTiles.Sort(Function(p1, p2) (p1.Position.Y.CompareTo(p2.Position.Y)))
Dim currentArray(AmountTiles) As Tile
currentArray = LoadedTiles.ToArray
Dim lengthX, lengthY As Integer
Dim yAxis As Integer = currentArray(0).Position.Y
For Each p In currentArray
If Not p.Position.Y = yAxis Then
lengthX = (p.Position.X / p.Size.Width)
lengthY = (currentArray(currentArray.Length - 1).Position.Y / p.Size.Width)
Else
lengthX = (currentArray(currentArray.Length - 1).Position.X / p.Size.Width)
lengthY = 0
End If
Next
MapTiles = New Tile(lengthX, lengthY) {}
Dim ii As Integer
For x = 0 To lengthX
For y = 0 To lengthY
MapTiles(x, y) = currentArray(ii)
If Not ii >= currentArray.Length - 1 Then
ii += 1
End If
Next
Next
This gives a wrong output.
See picture below:
http://www.directupload.net/file/d/3690/pz8x98jr_png.htm
Is it possible to do it right?
Thanks alot!
The k-th element in a 1D array can correspond to row i=k/N and column j=k%N where N is the number of columns. The reverse is k=i*N+j
Ok guys, I got it ( =
Public Class Form1
Dim List As New List(Of Point)
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
List.Add(New Point(180, 360))
List.Add(New Point(180, 180))
List.Add(New Point(180, 540))
'Convert 1d to 2d
Dim count As Point = countXYAxis(List, 180)
MsgBox(count.ToString)
Dim p(count.X - 1, List.Count - 1) As Point
MsgBox(p.Length)
Dim rofl As Integer
For i = 0 To p.GetUpperBound(0)
For j = 0 To p.GetUpperBound(1)
p(i, j) = List(rofl)
If Not rofl >= List.Count - 1 Then
rofl += 1
End If
Next
Next
For Each t In p
MsgBox(t.ToString)
Next
End Sub
Private Function countXYAxis(ByVal pt As List(Of Point), ByVal size As Integer) As Point
Dim bufferY As New List(Of Integer)
Dim cP As New Point
For Each pts In pt
If Not bufferY.Contains(pts.Y) Then
bufferY.Add(pts.Y)
End If
Next
For i = 0 To pt.Count - 1
If pt(i).Y = bufferY(0) Then
Else
cP = New Point(pt(i).X / size, bufferY.Count)
End If
Next
Return cP
End Function
End Class

Count number of characters after specific character in textbox

using winforms / vb.net
I am trying to count how many characters exist in "textbox3" after a specific character "." in a textbox.
examples:
2adf = 0 (no "." exists)
2adf. = 0
2adf.2 = 1
2adf.2a = 2
2adf.2af = 3
2adf.2afe = 4
I already have a function to search if there is a "."
if (CountCharacter(TextBox3.Text, ".") = 1) then
'a "." exists so count number of characters after "."
end if
Public Function CountCharacter(ByVal value As String, ByVal ch As Char) As Integer
Dim cnt As Integer = 0
For Each c As Char In value
If c = ch Then cnt += 1
Next
Return cnt
End Function
I am not sure how to check the count after the "." though
You could use the string.IndexOf method for this task
Sub Main
Dim test = "2adf.2afe"
Dim result = CountCharsAfter(test, "."c)
Console.WriteLine(result)
End Sub
Public Function CountCharsAfter(input as string, charToSearch as Char) as Integer
DIm pos = input.LastIndexOf(charToSearch)
if pos = -1 then
return 0
else
return input.Length - (pos + 1)
End if
End Function
Try this
Dim NoChar As Integer = CalculateChra("12adf.2afe", ".")
Private Function CalculateChra(ByVal V_String As String, ByVal LastChar As Char) As Integer
Dim Start As String = Split(V_String, LastChar)(0) & "."
Dim M As String = V_String.Substring(Start.Length)
Return M.Length
End Function
dim n,cnt as integer
n=0
cnt=0
Private Sub TextBox1_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles TextBox1.KeyPress
If e.KeyChar = Chr(46) Then
n = Len(TextBox1.Text)
End If
If n <> 0 Then
cnt += 1
End If
MsgBox(" no.of charectors after '.' is/are : " & cnt - 1)
End Sub

Bubble Sort logical error VB.NET

This program suppose to sort records(in arySort) in ascending order by last name(index 1 in aryTemp and aryTemp2) and place the result in the list box over the old, preloaded, unsorted records.
It sorts them strangely, I have to click multiple times the Ascending button to get the actual sort result that I suppose to get from clicking the button once.
Why doesn't it sort items with a single mouse click?
The source:
Public Class Form1
Dim FILE_NAME As String = "Students.txt"
Dim numberOfRecords As Integer 'total number of records
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
If System.IO.File.Exists(FILE_NAME) = True Then
Dim objReader As New System.IO.StreamReader(FILE_NAME)
Do While objReader.Peek() <> -1
lstBox.Items.Add(objReader.ReadLine)
numberOfRecords += 1
Loop
objReader.Close()
End If
End Sub
Private Sub btnAscending_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnAscending.Click
'load all students into array
Dim arySort(numberOfRecords - 1) As String
Dim aryTemp() As String 'holds first record's last name
Dim aryTemp2() As String 'holds second record's last name
For i = 0 To numberOfRecords - 1
arySort(i) = lstBox.Items(i)
Next
Dim temp As String 'holds temporary record
Dim k As Integer
For i = 0 To arySort.Length - 2
aryTemp = Split(arySort(i), " ")
For k = i + 1 To arySort.Length - 1
aryTemp2 = Split(arySort(k), " ")
If aryTemp(1) < aryTemp2(1) Then
temp = arySort(k)
arySort(k) = arySort(i)
arySort(i) = temp
End If
Next
Next
lstBox.Items.Clear()
numberOfRecords = 0
For i = 0 To arySort.Length - 1
lstBox.Items.Add(arySort(i))
numberOfRecords += 1
Next
End Sub
End Class
If you just need to sort your list (as you say in the comment), don't implement your own sort mechanism but use the one of .NET:
' Define how we want to compare items '
Function compareByLastName(ByVal item1 As String, ByVal item2 As String) As Integer
Return String.Compare(item1.Split(" ")(1), item2.Split(" ")(1))
End Function
Private Sub btnAscending_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnAscending.Click
' load all students into array '
Dim arySort(numberOfRecords - 1) As String
For i = 0 To numberOfRecords - 1
arySort(i) = lstBox.Items(i)
Next
' Use built-in .NET magic '
Array.Sort(arySort, AddressOf compareByLastName)
' Write the values back into your list box '
lstBox.Items.Clear()
numberOfRecords = 0
For i = 0 To arySort.Length - 1
lstBox.Items.Add(arySort(i))
numberOfRecords += 1
Next
End Sub
This uses the built-in quicksort algorithm of the .NET class library. Here's the documentation of the method we are using: Array.Sort(T(), Comparison(Of T)).
compare with my working bubble sort:
Public Sub BubbleSort(ByVal arr() As Integer)
Dim flag As Boolean = False
For i As Integer = 0 To arr.Length - 1
For j As Integer = 0 To arr.Length - 2 - i
If arr(j + 1) < arr(j) Then
flag = True
Dim temp As Integer = arr(j)
arr(j) = arr(j + 1)
arr(j + 1) = temp
End If
Next
If flag = False Then Return ' no swaps =>already sorted
Next
End Sub
I see a two major issues with your algorithm:
It's not bubble sort. Bubble sort swaps adjacent elements, i.e., it swaps i with i+1. You, on the other hand, swap some element i with the first j > i where name(i) < name(j). Maybe you should show us, in pseudo code, which algorithm you are actually trying to implement?
aryTemp contains element i and aryTemp2 contains some element j > i. Why do you swap the elements if aryTemp(1) < aryTemp2(1)? Isn't that already the correct order if you want your elements to be sorted ascending?