I am currently studying to improve my coding skills and I have been stuck at this problem. Under you may find the question, the example and my code.
Exercise:
"The pixels in the input image are represented as integers. The algorithm distorts the input image in the following way: Every pixel x in the output image has a value equal to the average value of the pixel values from the 3 × 3 square that has its center at x, including x itself. All the pixels on the border of x are then removed.
Return the blurred image as an integer, with the fractions rounded down."
Example:
"For
image = [[1, 1, 1],
[1, 7, 1],
[1, 1, 1]]
the output should be solution(image) = [[1]].
To get the value of the middle pixel in the input 3 × 3 square: (1 + 1 + 1 + 1 + 7 + 1 + 1 + 1 + 1) = 15 / 9 = 1.66666 = 1. The border pixels are cropped from the final result.
For
image = [[7, 4, 0, 1],
[5, 6, 2, 2],
[6, 10, 7, 8],
[1, 4, 2, 0]]
the output should be
solution(image) = [[5, 4],
[4, 4]]
There are four 3 × 3 squares in the input image, so there should be four integers in the blurred output. To get the first value: (7 + 4 + 0 + 5 + 6 + 2 + 6 + 10 + 7) = 47 / 9 = 5.2222 = 5. The other three integers are obtained the same way, then the surrounding integers are cropped from the final result."
My incorrect answer (so far):
Function solution(image As List(Of List(Of Integer))) As List(Of List(Of Integer))
dim lin,col,l,c as Integer
dim resp As new List(Of List(Of Integer))
Dim Aux as new list(of integer)
Aux.Add(0)
For lin=0 to image.count-3
resp.Add(Aux)
For col=0 to image(lin).count-3
If col>0 then
resp(lin).Add(0)
End If
For l=0 to 2
For c=0 to 2
resp(lin)(col)+=image(l+lin)(c+col)
Next c
Next l
resp(lin)(col) = Fix(resp(lin)(col)/9)
Next col
Next lin
Return resp
End Function
Extra info:
It went well for the tests where image = [[1,1,1],[1,7,1],[1,1,1]] or [[0,18,9],[27,9,0],[81,63,45]] or [[36,0,18,9],[27,54,9,0],[81,63,72,45]]. But failed the first time it had four lines, where image = [[7,4,0,1],[5,6,2,2],[6,10,7,8],[1,4,2,0]].
I can't figure out why.
At the end my error was quite simple. Adding the list "Aux" to my list of list i was making a bond between them. And everytime I add another item thru resp(lin).Add(0) I was also adding an item in "Aux" itself. When I used this "Aux" onde again to add a new list it already contained more than 1 element.
To solve it found in another post of stackoverflow (VB.NET: 2-dimensional list) with the following line of code arr2.Add(New List(Of Double)).
Here goes the working code:
Function solution(image As List(Of List(Of Integer))) As List(Of List(Of Integer))
dim lin,col,l,c as Integer
dim resp As new List(Of List(Of Integer))
For lin = 0 to image.count-3
resp.Add(New List(Of Integer))
For col=0 to image(lin).count-3
resp(lin).Add(0)
Next col
Next lin
For lin=0 to image.count-3
For col=0 to image(lin).count-3
For l=0 to 2
For c=0 to 2
resp(lin)(col)+=image(l+lin)(c+col)
Next c
Next l
resp(lin)(col) = resp(lin)(col)\9
Next col
Next lin
Return resp
End Function
Related
I need to sort a list of numbers but I need to keep their initial indexes.
I had previously just created an array of the numbers and then another array of the indexes which I sorted at the same time like so:
Dim AverageSuccess(23) As Decimal
Dim intervalList() As Integer = {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23}
x = 2
Do
Sorted = True
For i = 23 To x Step -1
If AverageSuccess(i) < AverageSuccess(i - 1) Then
TempNum = AverageSuccess(i)
AverageSuccess(i) = AverageSuccess(i - 1)
AverageSuccess(i - 1) = TempNum
TempIndex = intervalList(i)
intervalList(i) = intervalList(i - 1)
intervalList(i - 1) = TempIndex
Sorted = False
End If
Next
x += 1
Loop Until Sorted
however this is for a project and my teacher informed me that this is bad programming practise and I should be using a list instead.
I have struggled to find a simple example of how to use a list in VB.net for this purpose, so if someone could give me an example I would appreciate it.
I don't know how much you have covered about lists in class...
Let us create a list with some integers in:
Dim nums As New List(Of Integer) From {9, 8, 4, 5}
Now, we want to store the original indices of those numbers. We can do that with the Select method, which has an optional parameter that will give the index of the current item, and create a new entity with items which we can give names to, say "Num" and "Idx":
Dim numsWithIndex = nums.Select(Function(n, i) New With {.Num = n, .Idx = i})
Then we can use the LINQ method OrderBy to get those entities in the desired order:
Dim sortedNums = numsWithIndex.OrderBy(Function(nwi) nwi.Num)
And we can have a look at what we have constructed with
Console.WriteLine(String.Join(vbCrLf, sortedNums))
which outputs:
{ Num = 4, Idx = 2 }
{ Num = 5, Idx = 3 }
{ Num = 8, Idx = 1 }
{ Num = 9, Idx = 0 }
(It shows the names we gave to the properties of the anonymous type created with New earlier.)
Here is the whole thing as a console app you can copy-and-paste to investigate with on your computer:
Module Module1
Sub Main()
Dim nums As New List(Of Integer) From {9, 8, 4, 5}
Dim numsWithIndex = nums.Select(Function(n, i) New With {.Num = n, .Idx = i})
Dim sortedNums = numsWithIndex.OrderBy(Function(nwi) nwi.Num)
Console.WriteLine(String.Join(vbCrLf, sortedNums))
Console.ReadLine()
End Sub
End Module
i am a bit new to this but I'm trying to create a randomly generated 3d coordinate points with equal spacing, I've tried using for each loop but im confused on how to use in. the purpose is to generate sphere around that point but some sphere are overlapping each other. thanks in advance. the code below is to show how I'm generating the sphere
For i = 0 To noofsp - 1
x = Rnd(1) * maxDist
ws1.Cells(i + 5, 2) = x
y = Rnd(1) * maxDist
ws1.Cells(i + 5, 3) = y
z = Rnd(1) * maxDist
ws1.Cells(i + 5, 4) = z
centers.Add({x, y, z})
Next
You'll need to check the new point against all the other points to make sure that your new point is at a greater distance that the sum of the radii of your new sphere and each sphere you're checking against
You'll need to use pythagoras' theorem to check that the distances and I found the code below from this site. The code on the site is written in c#, but here is the vb.net version.
Public Function Distance3D(x1 As Double, y1 As Double, z1 As Double, x2 As Double, y2 As Double, z2 As Double) As Double
' __________________________________
'd = √ (x2-x1)^2 + (y2-y1)^2 + (z2-z1)^2
'
'Our end result
Dim result As Double
'Take x2-x1, then square it
Dim part1 As Double = Math.Pow((x2 - x1), 2)
'Take y2-y1, then square it
Dim part2 As Double = Math.Pow((y2 - y1), 2)
'Take z2-z1, then square it
Dim part3 As Double = Math.Pow((z2 - z1), 2)
'Add both of the parts together
Dim underRadical As Double = part1 + part2 + part3
'Get the square root of the parts
result = Math.Sqrt(underRadical)
'Return our result
Return result
End Function
To generate the spheres, you would need to expand your code to include checking the new point against all the previously generated points. That code is below with comments.
I have assumed the definition of a variable called minDistance to specify how far apart the centre of the spheres should be. I'm also assuming that all the spheres are the same size. The number should be twice the radius of the spheres
Private Sub GenerateSpheres()
Randomize
For i As Integer = 0 To noofsp - 1
Dim distanceOK As Boolean = False
Dim x, y, z As Integer
'keep generating points until one is found that is
'far enough away. When it is, add it to your data
While distanceOK = False
x = Rnd(1) * maxDist
y = Rnd(1) * maxDist
z = Rnd(1) * maxDist
'If no other points have been generated yet, don't bother
'checking your new point
If centers.Count = 0 Then
distanceOK = True
Else
'If other points exist, loop through the list and check distance
For j As Integer = 0 To centers.Count - 1
'if the point is too close to any other, stop checking,
'exit the For Loop and the While Loop will generate a new
'coordinate for checking, and so on
Dim dist As Integer = Distance3D(centers(j)(0), centers(j)(1), centers(j)(2), x, y, z)
If dist <= minDistance Then
distanceOK = False
'exit the For loop and start the next iteration of the While Loop
Continue While
End If
Next
'If all previous points have been checked none are too close
'flag distanceOK as true
distanceOK = True
End If
End While
'ws1.Cells(i + 5, 2) = x
'ws1.Cells(i + 5, 3) = y
'ws1.Cells(i + 5, 4) = z
centers.Add({x, y, z})
Next
End Sub
As an example. I want to randomly hand out 100 chocolates to 25 kids. I cannot give any kid more than 10 chocolates.
So here m = 100, n = 25, x = 1 and y = 12.
I have checked these questions.
Dividing a number into m parts uniformly randomly
Dividing a number into random unequal parts
They do give some idea but in these questions x and y are not specified.
So basically,
1) Total No. of Chocolates = 100
2) I can only give minimum 1 and maximum 12 chocolates to each kid
3) Chocolates should be distributed between 25 kids
4) I do not want any distribution (uniform or normal) - it should be purely random. (I am willing to exclude this condition if all else fails.)
Private Function divideUniformlyRandomly(n As Integer, m As Integer) As Integer()
Dim rRandom As New Random
Dim fences As Integer() = New Integer(m - 2) {}
For i As Integer = 0 To m - 3
fences(i) = rRandom.Next(0, n - 1)
Next
[Array].Sort(fences)
Dim result As Integer() = New Integer(m - 1) {}
result(0) = fences(0)
For i As Integer = 1 To m - 3
result(i) = fences(i + 1) - fences(i)
Next
result(m - 1) = n - 1 - fences(m - 2)
Return result
End Function
This does work but I get 0 and 13 as well. I cannot ensure x and y here.
Give each child x chocolate. This will leave you with m - (n * x) to distribute randomly. Keep distributing to children that have less than y chocolates, until there are no more chocolates.
Private Function divideUniformlyRandomly(n As Integer, m As Integer, x As Integer, y As Integer) As Integer()
Dim rRandom As New Random
Dim aResult As Integer() = New Integer(n - 1) {}
Dim i As Integer = 0
Dim remaining As Integer = m
' Every n must have a min of x.
For i = 0 To n - 1
aResult(i) = x
remaining -= x
Next
' distribute the remaining m over the children randomly
While remaining > 0
' pick a child randomly
i = rRandom.Next(0, n)
' if the child has less than y, give them one
If aResult(i) < y Then
aResult(i) += 1
remaining -= 1
End If
End While
' Debug
Dim sum As Integer = 0
For i = 0 To n - 1
Console.WriteLine("{0}: {1}", i, aResult(i))
sum += aResult(i)
Next
Console.WriteLine("Sum: {0}", sum)
divideUniformlyRandomly = aResult
End Function
I have 3 x one dimensional arrays of type integer, each array is the same length (between 5 - 20 million values) and I would like to sort them in parallel (ie keeping the relative position) by the second array, then the third array, then the first array. Does anyone have any ideas on the most efficient way to do this in vb.net?
If it helps, the first array is just a record of the initial position (the three arrays will be re-sorted to this order once various calculations are done). I need to sort them to determine the number of unique combinations of the second and third arrays (a combination is determined by the position in the array - in the example below the combinations are (0-1-4), (1-1-6) etc). Once that is determined I will resort them back based on the first array.
I looked at array.sort but that only covers 2 parallel arrays. I'm a bit wary of putting the values in tuples (or any other format), as it would (I assume - perhaps not) be a big overhead when converting 5 - 20 million records before processing.
For example:
Record Number Array: {0, 1, 2, 3, 4, 5, 6, 7, 8, 9}
Link Array: {1, 1, 2, 1, 1, 2, 2, 2, 1, 2}
Line Number Array: {4, 6, 3, 5, 6, 7, 3, 2, 3, 4}
Having sorted / ordered by the second, then third, then first array, the expected output would be:
Record Number (1st Array): {8, 0, 3, 1, 4, 7, 2, 6, 9, 5}
Link Array (2nd Array): {1, 1, 1, 1, 1, 2, 2, 2, 2, 2}
Line Number Array (3rd Array): {3, 4, 5, 6, 6, 2, 3, 3, 4, 7}
Array.sort only allows you to sort 2 arrays in parallel and i'm a little confused by the options available in LinQ.
Does anyone have any suggestions on the best way to solve this problem?
Cheers,
I think you can get a backup of your Link Array. Then sort Link Array with Record Array, then you can sort un-sorted Link Array with Line Number Array. Can you please try it?
You didn't say if you want efficient in terms of time or space, but this takes about 3 seconds to transfer 20 million records from arrays to a list, and then about 30 seconds to do the sort on them, using less than 1GB of RAM. On my computer.
Option Infer On
Module Module1
Class Grouped
Property RecNo As Integer
Property Link As Integer
Property LineNo As Integer
Public Overrides Function ToString() As String
Return String.Format("({0}, {1}, {2})", Me.RecNo, Me.Link, Me.LineNo)
End Function
End Class
Sub Main()
' First try with the test data to show the correct result is obtained
Dim recNos = {0, 1, 2, 3, 4, 5, 6, 7, 8, 9}
Dim links = {1, 1, 2, 1, 1, 2, 2, 2, 1, 2}
Dim lineNos = {4, 6, 3, 5, 6, 7, 3, 2, 3, 4}
' transfer the arrays to a List
Dim xs As New List(Of Grouped)
xs.Capacity = recNos.Length
For i = 0 To recNos.Length() - 1
xs.Add(New Grouped With {.RecNo = recNos(i), .Link = links(i), .LineNo = lineNos(i)})
Next
' sort the data
Dim ys = xs.OrderBy(Function(x) x.Link).ThenBy(Function(x) x.LineNo).ToList()
Console.WriteLine(String.Join(", ", ys))
' Now try with twenty million records
Dim rand = New Random()
Dim nRecs As Integer = 20000000
recNos = Enumerable.Range(0, nRecs - 1).ToArray()
ReDim links(nRecs - 1)
ReDim lineNos(nRecs - 1)
For i = 0 To nRecs - 1
links(i) = rand.Next(0, 9)
lineNos(i) = rand.Next(1, 9)
Next
Dim sw As New Stopwatch
sw.Start()
xs.Clear()
xs.Capacity = nRecs
For i = 0 To recNos.Length() - 1
xs.Add(New Grouped With {.RecNo = recNos(i), .Link = links(i), .LineNo = lineNos(i)})
Next
sw.Stop()
Console.WriteLine(sw.ElapsedMilliseconds.ToString())
sw.Restart()
ys = xs.OrderBy(Function(x) x.Link).ThenBy(Function(x) x.LineNo).ToList()
sw.Stop()
Console.WriteLine(sw.ElapsedMilliseconds.ToString())
Console.ReadLine()
End Sub
End Module
I'm trying to write vb.net code to return unique combinations for set
My set contains 3 different elements. I've found similar post this Post but couldn't find any VB solution to get this results
Example:
Elements: 1, 2, 3
{ 1, 2, 3}
Result must be
1
2
3
12
13
23
123
...........
>...................
i,m trying to achieve this by using following code
Function GetCombinations(ByVal depth As Integer, ByVal values As String()) As IEnumerable(Of String)
If depth > values.Count + 1 Then Return New List(Of String)
Dim result = New List(Of String)
For i = 0 To depth - 1
For y = 0 To values.Count - 1
If i = 0 Then
result.Add(values(y))
Else
result.Add(values(i - 1) + values(y))
End If
Next
Next
Return result
End Function
To Get the result
Dim reslt = GetCombinations(4, data_array)
?reslt
Count = 12
(0): "1"
(1): "2"
(2): "3"
(3): "11"
(4): "12"
(5): "13"
(6): "21"
(7): "22"
(8): "23"
(9): "31"
(10): "32"
(11): "33"
Hint:
I work with Mathematics and manage to calculate no of combinations. i can test the out with
this formula
Example
there is this formula called nCr. it means out of n number of element how many way of taking r number of elements with unique combinations of r.
nPr = n!/(n-r)!
n! = 1 * 2 * 3 * 4* ... (n-1) * n
Elements: 1, 2, 3
In this case n = 3 and r can be 1, 2, and 3 all
number of combinations = 3P1 + 3P2 + 3P3
= 3!/2! + 3!/1! + 3!/0!
= 6/2 + 6/1 + 6/1 (0!=1)
= 3+6+6
= 15
Knowing the term makes it easier to find existing algorithms. What you're looking for is a power set. Here's a quick VB.NET translation of a C# implementation I found on Rosetta Code:
Public Function GetPowerSet(Of T)(ByVal input As IEnumerable(Of T)) As IEnumerable(Of IEnumerable(Of T))
Dim seed As IEnumerable(Of IEnumerable(Of T)) = {Enumerable.Empty(Of T)()}
Return input.Aggregate(seed, Function(a, b) a.Concat(a.Select(Function(x) x.Concat({b}))))
End Function
Testing:
For Each x In GetPowerSet({1, 2, 3})
Console.WriteLine(String.Join(", ", x))
Next
Output:
1
2
1, 2
3
1, 3
2, 3
1, 2, 3
EDIT - Based on your latest explanation, I think you need a different approach. It seems you want combinations with repetitions / replacement, for all sizes up to the input size. You could simply call one of those algorithms with parameters (S, k) for each value of k from 1 to n and join all the results into a single set of results.
Translating Python's algorithm:
Public Iterator Function GetCombinationsWithReplacement(Of T)(source As IEnumerable(Of T), size As Integer) As IEnumerable(Of IEnumerable(Of T))
Dim pool = source.ToList()
Dim n = pool.Count
If n = 0 AndAlso size > 0 Then
Return
End If
Dim indices = Enumerable.Repeat(0, size).ToList()
Yield indices.Select(Function(i) pool.Item(i))
While True
Dim index As Nullable(Of Integer) = Nothing
For i = size - 1 To 0 Step -1
If indices.Item(i) <> n - 1 Then
index = i
Exit For
End If
Next
If Not index.HasValue Then
Return
End If
indices = indices.Take(index.Value).Concat(Enumerable.Repeat(indices.Item(index.Value) + 1, size - index.Value)).ToList()
Yield indices.Select(Function(i) pool.Item(i))
End While
End Function
(You will need to modify this if your VB.NET compiler doesn't support Yield.)
The results of calling this with different sizes are:
GetCombinationsWithReplacement({1, 2, 3}, 1):
{1}
{2}
{3}
GetCombinationsWithReplacement({1, 2, 3}, 2):
{1, 1}
{1, 2}
{1, 3}
{2, 2}
{2, 3}
{3, 3}
GetCombinationsWithReplacement({1, 2, 3}, 3):
{1, 1, 1}
{1, 1, 2}
{1, 1, 3}
{1, 2, 2}
{1, 2, 3}
{1, 3, 3}
{2, 2, 2}
{2, 2, 3}
{2, 3, 3}
{3, 3, 3}
We can join these into a single sequence with all 19 subsets:
Public Iterator Function GetCombinationsWithReplacementAllSizes(Of T)(source As IEnumerable(Of T)) As IEnumerable(Of IEnumerable(Of T))
Dim pool = source.ToList()
For size = 1 To pool.Count
For Each subset In GetCombinationsWithReplacement(pool, size)
Yield subset
Next
Next
End Function
Here is some pseudo code for any number of elements to help you (I make no claim this is the fastest way to do this, it is just a way to do it.)
Given elementList is a list of elements given
Given tempList is a list as a temporary holder
Given resultList is a list of the result
loop by # items in elementlist
{
if tempList is empty // special case for first iteration
add each element of elementList to tempList and resultlist
else
{
for each element in templist
for each element2 in elementlist
add combo to result list
copy elements added to result list for this iteration to templist
}
}