If I had the following pseudocode, would I need to add anything further onto it as mentioned below. Your help is much appreciated:
**repeat
swapped = false**
for i from 1 <- N
for j <- 0 to N - 1
if a[j] > a[j + 1]
swap( a[j], a[j + 1] )
**swapped = true
end if**
**end for
until not swapped**
Are the lines I have ** REQUIRED to be in there? For example, if a question asked 'write in pseudocode for the bubble sort algorithm' would I be required to write it out fully (including the ** items) or without them is OK?
We are required to 'rope learn' the code and obviously the smaller the code the better and the easier it is to remember.
Thanks!
Sub Main()
Dim Numlist() As Integer = {23435, 1, 433, 5234}
'here you can use any numbers in any order
Dim Count As Integer = 0
Dim Swapvalue As Integer
For ii = 0 To Numlist.Length - 2
For i = 0 To Numlist.Length - 2
Count += 1
If Numlist(i) > Numlist(i + 1) Then
Swapvalue = Numlist(i)
Numlist(i) = Numlist(i + 1)
Numlist(i + 1) = Swapvalue
End If
Next
Next
Console.WriteLine("Number of comparisons: {0}", Count)
For i = 0 To Numlist.Length - 1
Console.WriteLine(Numlist(i))
Next
End Sub
Related
Recently I am trying to get the permutation of undetermined number of variables. For undetermined I mean I was aiming to create an input box for users to put in the number.
Start from simple. Originally I was aiming to get a 4 digits permutations with each digit have different number of variables, i.e. 1st digit can only be A,B,C,D; 2nd digit be E,F; 3rd digit be G, H etc. Code are below:
Sub Permut()
Count = 1
For a = 1 To 4
For b = 1 To 2
For c = 1 To 2
For d = 1 To 2
For e = 1 To 2
'chr(97) is the alphabet "a"
Cells(Count, 1) = Chr(96 + a) & Chr(96 + Len(a) + b) & Chr(96 + Len(a) + Len(b) + c) & _
Chr(96 + Len(a) + Len(b) + Len(c) + d) & Chr(96 + Len(a) + Len(b) + Len(c) + Len(d) + e)
Count = Count + 1
Next
Next
Next
Next
Next
End Sub
This will give you 64 different combinations without repetition.
Just wondering is there a way to generalize this process so that people can choose how many variables in total as well as within each digit?
Thank you.
Here is a solution, where you would pass the Permut function the minimum value for each of the characters (digits) as one string, and the maximum characters also as a string. Both strings should have an equal number of characters of course:
Function Permut(min, max)
Dim str, nxt, count
str = min
count = 1
Do While str < max
Cells(count, 1) = str
count = count + 1
nxt = ""
For i = Len(str) To 1 Step -1
If Mid(str, i, 1) < Mid(max, i, 1) Then
nxt = ChrW(AscW(Mid(str, i, 1))+1) & nxt
Exit For
End If
nxt = Mid(min, i, 1) & nxt
Next
str = Left(str, Len(str) - Len(nxt)) & nxt
Loop
Cells(count, 1) = str
End Sub
You would call it like this:
Permut "abc", "bcf"
That example would produce this list on your sheet:
abc
abd
abe
abf
acc
acd
ace
acf
bbc
bbd
bbe
bbf
bcc
bcd
bce
bcf
How to Execute This with User Input and Button Click
If you want to call this code in response to an event, such as a button click, and want to pass it the contents of two cells where the user would first enter the min and max strings, then follow these steps:
Place an ActiveX command button on your sheet (put it somewhere in D1 to leave room for some other stuff)
Double click it to generate the empty click event handler. If that does not work, go to the code window and select the name of the button from the drop-down at the top of the window, and select Click from the next drop down.
Complete the code of that event handler as follows (I assume the button is called CommandButton1, but don't change the generated name):
Code:
Private Sub CommandButton1_Click()
Permut Range("B1"), Range("C1")
End Sub
This code assumes the user has to enter the min and max digits/characters in cells B1 and C1. The A column is of course reserved for the output of the code.
For a more complete explanation on how to add a command button and attach code to its click event, read "Add a command button (ActiveX control)" in the Office manual.
credit to the answer from trincot above.
I have tried to run the code with a bit modification coz I am not sure how to get set value into cells (0,1). It keeps saying error. But If I change the starting point to Cells(1,1) then I will miss the last permutation. So I just add an additional if statement to get the code work as I want.
Function Permut(min, max)
Dim str, nxt, count
str = min
count = 1
Do While str < max
Cells(count, 1) = str
count = count + 1
nxt = ""
For i = Len(str) To 1 Step -1
If Mid(str, i, 1) < Mid(max, i, 1) Then
'asc("a")=97; chr(97) ="a"
nxt = Chr(AscW(Mid(str, i, 1)) + 1) & nxt
Exit For
End If
nxt = Mid(min, i, 1) & nxt
Next
str = Left(str, Len(str) - Len(nxt)) & nxt
If str = max Then
Cells(count, 1) = str
End If
Loop
End Function
Trying to teach myself ruby - I'm working on Project Euler problem 14 in ruby.
n = 1000000
array = Array.new(n,0)
#array[x] will store the number of steps to get to one if a solution has been found and 0 otherwise. x will equal the starting number. array[0] will be nonsensical for these purposes
i = n-1#We will start at array[n-1] and work down to 1
while i > 1
if array[i] == 0
numstep = 0 #numstep will hold the number of loops that j makes until it gets to 1 or a number that has already been solved
j = i
while j > 1 && (array[j] == 0 || array[j] == nil)
case j%2
when 1 # j is odd
j = 3*j + 1
when 0 # j is even
j = j/2
end
numstep += 1
end
stop = array[j] #if j has been solved, array[j] is the number of steps to j = 1. If j = 1, array[j] = 0
j = i
counter = 0
while j > 1 && (array[j] == 0 || array[j] == nil)
if j < n
array[j] = numstep + stop - counter #numstep + stop should equal the solution to the ith number, to get the jth number we subtract counter
end
case j%2
when 1 #j is odd
j = 3*j+1
when 0 #j is even
j = j/2
end
counter += 1
end
end
i = i-1
end
puts("The longest Collatz sequence starting below #{n} starts at #{array.each_with_index.max[1]} and is #{array.max} numbers long")
This code works fine for n = 100000 and below, but when I go up to n = 1000000, it runs for a short while (until j = 999167 *3 + 1 = 2997502). When it tries access the 2997502th index of array, it throws the error
in '[]': bignum too big to convert into 'long' (RangeError)
on line 27 (which is the while statement:
while j > 1 && (array[j] == 0 || array[j] == nil)
How can I get this to not throw an error? Checking if the array is zero saves code efficiency because it allows you to not recalculate something that's already been done, but if I remove the and statement, it runs and gives the correct answer. I'm pretty sure that the problem is that the index of an array can't be a bignum, but maybe there's a way to declare my array such that it can be? I don't much care about the answer itself; I've actually already solved this in C# - just trying to learn ruby, so I'd like to know why my code is doing this (if I'm wrong about why) and how to fix it.
The code above runs happily for me for any input that produces output in acceptable time. I believe this is because you might experience problems being on 32bit arch, or like. Anyway, the solution of the problem stated would be simple (unless you might run out of memory, which is another possible glitch.)
Array indices are limited, as is follows from the error you got. Cool, let’s use hash instead!
n = 1000000
array = Hash.new(0)
#array[x] will store the number of steps to get to one if a solution has been found and 0 otherwise. x will equal the starting number. arr
i = n-1#We will start at array[n-1] and work down to 1
while i > 1
if array[i].zero?
numstep = 0 #numstep will hold the number of loops that j makes until it gets to 1 or a number that has already been solved
j = i
while j > 1 && array[j].zero?
case j%2
when 1 # j is odd
j = 3*j + 1
when 0 # j is even
j = j/2
end
numstep += 1
end
stop = array[j] #if j has been solved, array[j] is the number of steps to j = 1. If j = 1, array[j] = 0
j = i
counter = 0
while j > 1 && array[j].zero?
if j < n
array[j] = numstep + stop - counter #numstep + stop should equal the solution to the ith number, to get the jth number we
end
case j%2
when 1 #j is odd
j = 3*j+1
when 0 #j is even
j = j/2
end
counter += 1
end
end
i = i-1
end
puts("Longest Collatz below #{n} ##{array.sort_by(&:first).map(&:last).each_with_index.max[1]} is #{arr
Please note, that since I used the hash with initializer, array[i] can’t become nil, that’s why the check is done for zero values only.
This question has been asked before, but I can't find an answer that is easily applicable to Excel VBA.
Basically I want to do exactly what this poster has asked, but in VBA. I want to create an array, n x 2^n, where each line represents a different permutation of n variables which can be either 0 or 1.
I've played around with this for ages, and it's easy enough to do for a set n with loads of loops, but for a variable n I can't find anything that works.
Any code or just suggestions of ways of going about this would be much appreciated!
This will list the value in column A
Sub EasyAsCounting()
Dim N As Long, M As Long, K As Long
N = Application.InputBox(Prompt:="Enter N", Type:=1)
M = 2 ^ N - 1
For K = 0 To M
Cells(K + 1, 1) = "'" & Application.WorksheetFunction.Dec2Bin(K, N)
Next K
End Sub
EDIT#1
This stores the array in VBA only:
Sub EasyAsCounting()
Dim N As Long, M As Long, K As Long, ary, s As String
Dim J As Long
N = Application.InputBox(Prompt:="Enter N", Type:=1)
M = 2 ^ N - 1
ReDim ary(1 To M + 1, 1 To N)
For K = 0 To M
s = Application.WorksheetFunction.Dec2Bin(K, N)
For J = 1 To N
ary(K + 1, J) = Mid(s, J, 1)
Next J
Next K
'
'display the array
'
msg = ""
For K = 1 To M + 1
For J = 1 To N
msg = msg & " " & ary(K, J)
Next J
msg = msg & vbCrLf
Next K
MsgBox msg
End Sub
Here's one if you're not in Excel and don't have access to the functions. Or if you have a number greater than 511.
Sub MakePerms()
Dim i As Long, j As Long
Dim n As Long
Dim aPerms() As Byte
Dim lCnt As Long
Dim sOutput As String
Const lVar As Long = 4
ReDim aPerms(1 To 2 ^ lVar, 1 To lVar)
For i = 0 To UBound(aPerms, 1) - 1
n = i
lCnt = lVar
aPerms(i + 1, lCnt) = CByte(n Mod 2)
n = n \ 2
Do While n > 0
lCnt = lCnt - 1
aPerms(i + 1, lCnt) = CByte(n Mod 2)
n = n \ 2
Loop
Next i
For i = LBound(aPerms, 1) To UBound(aPerms, 1)
sOutput = vbNullString
For j = LBound(aPerms, 2) To UBound(aPerms, 2)
sOutput = sOutput & Space(1) & aPerms(i, j)
Next j
Debug.Print sOutput
Next i
End Sub
I'm developing a program in visual basic 6.0 to display magic square. I've developed the logic, but the values are not getting displayed in the magic square. Here's the code :
Private Sub Command1_Click()
Dim limit As Integer
Dim a(100, 100) As Integer
limit = InputBox("Enter the limit")
If limit Mod 2 = 0 Then ' Rows and columns must be
MsgBox "Can't be done", vbOKCancel, "Error"
Else ' set number of rows and columns to limit
mfgsquare.Rows = limit
mfgsquare.Cols = limit
j = (n + 1) / 2
i = 1
For c = 1 To n * n
mfgsquare.TextMatrix(i, j) = c
If c Mod n = 0 Then
i = i + 1
GoTo label
End If
If i = 1 Then
i = n
Else
i = i - 1
End If
If j = n Then
j = 1
Else
j = j + 1
End If
label:
Next c
End If
End Sub
Try this:
n = InputBox("Enter the limit")
If n Mod 2 = 0 Then ' Rows and columns must be
MsgBox "Can't be done"
Else ' set number of rows and columns to limit
mfgsquare.Rows = n + 1
mfgsquare.Cols = n + 1
For i = 1 To n
For j = 1 To n
mfgsquare.TextMatrix(i, j) = n * ((i + j - 1 + Int(n / 2)) Mod n) + ((i + 2 * j - 2) Mod n) + 1
Next j
Next i
End If
I have a list of 100 items. I'd like to randomly pair these items with each other. These pairs must be unique, so there are 4950 possibilities (100 choose 2) total.
Of all 4950 pairs, I'd like to have 1000 pairs randomly selected. But they key is, I'd like each item (of the 100 items) to overall appear the same amount of times (here, 20 times).
I tried to implement this with code a couple of times. And it worked fine when I tried with a lower amount of pairs chosen, but each time I try with the full 1000 pairs, I get stuck in a loop.
Does anyone have an idea for an approach? And what if I change the number of pairs I wish to select (e.g., 1500 rather than 1000 random pairs)?
My attempt (written in VBA):
Dim City1(4951) As Integer
Dim City2(4951) As Integer
Dim CityCounter(101) As Integer
Dim PairCounter(4951) As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
i = 1
While i < 101
CityCounter(i) = 0
i = i + 1
Wend
i = 1
While i < 4951
PairCounter(i) = 0
i = i + 1
Wend
i = 1
j = 1
While j < 101
k = j + 1
While k < 101
City1(i) = j
City2(i) = k
k = k + 1
i = i + 1
Wend
j = j + 1
Wend
Dim temp As Integer
i = 1
While i < 1001
temp = Random(1,4950)
While ((PairCounter(temp) = 1) Or (CityCounter( (City1(temp)) ) = 20) Or (CityCounter( (City2(temp)) ) = 20))
temp = Random(1,4950)
Wend
PairCounter(temp) = 1
CityCounter( (City1(temp)) ) = (CityCounter( (City1(temp)) ) + 1)
CityCounter( (City2(temp)) ) = (CityCounter( (City2(temp)) ) + 1)
i = i + 1
Wend
Take a list, scramble it, and mark every two elements off as a pair. Add these pairs to a list of pairs. Ensure that list of pairs is sorted.
Scramble the list of pairs, and add each pair to a "staged" pair list. Check if it's in the list of pairs. If it's in the list of pairs, scramble and start over. If you get the entire list without any duplicates, add the staged pair list to the pair list and start this paragraph over.
Since this involves a nondeterministic step at the end I'm not sure how slow it will be, but it should work.
This is old thread, but I was looking for something similar, and finaly did it myself.
The algorithm is not 100% random (after being a bit "tired" with unsuccessfull random trials starts systematic screening of the table :) - anyway for me - "random enough") but works reasonably fast, and returns required table (unfortunalety not always, but...) usually every second or third use (look in A1 if there is your reqired number of pairs for each item).
Here is VBA code to be run in Excel environment.
Output is directed to current sheet starting from A1 cell.
Option Explicit
Public generalmax%, oldgeneralmax%, generalmin%, alloweddiff%, i&
Public outtable() As Integer
Const maxpair = 100, upperlimit = 20
Sub generate_random_unique_pairs()
'by Kaper 2015.02 for stackoverflow.com/questions/14884975
Dim x%, y%, counter%
Randomize
ReDim outtable(1 To maxpair + 1, 1 To maxpair + 1)
Range("A1").Resize(maxpair + 1, maxpair + 1).ClearContents
alloweddiff = 1
Do
i = i + 1
If counter > (0.5 * upperlimit) Then 'try some systematic approach
For x = 1 To maxpair - 1 ' top-left or:' To 1 Step -1 ' bottom-right
For y = x + 1 To maxpair
Call test_and_fill(x, y, counter)
Next y
Next x
If counter > 0 Then
alloweddiff = alloweddiff + 1
counter = 0
End If
End If
' mostly used - random mode
x = WorksheetFunction.RandBetween(1, maxpair - 1)
y = WorksheetFunction.RandBetween(x + 1, maxpair)
counter = counter + 1
Call test_and_fill(x, y, counter)
If counter = 0 Then alloweddiff = WorksheetFunction.Max(alloweddiff, 1)
If i > (2.5 * upperlimit) Then Exit Do
Loop Until generalmin = upperlimit
Range("A1").Resize(maxpair + 1, maxpair + 1).Value = outtable
Range("A1").Value = generalmin
Application.StatusBar = ""
End Sub
Sub test_and_fill(x%, y%, ByRef counter%)
Dim temprowx%, temprowy%, tempcolx%, tempcoly%, tempmax%, j%
tempcolx = outtable(1, x + 1)
tempcoly = outtable(1, y + 1)
temprowx = outtable(x + 1, 1)
temprowy = outtable(y + 1, 1)
tempmax = 1+ WorksheetFunction.Max(tempcolx, tempcoly, temprowx, temprowy)
If tempmax <= (generalmin + alloweddiff) And tempmax <= upperlimit And outtable(y + 1, x + 1) = 0 Then
counter = 0
outtable(y + 1, x + 1) = 1
outtable(x + 1, y + 1) = 1
outtable(x + 1, 1) = 1 + outtable(x + 1, 1)
outtable(y + 1, 1) = 1 + outtable(y + 1, 1)
outtable(1, x + 1) = 1 + outtable(1, x + 1)
outtable(1, y + 1) = 1 + outtable(1, y + 1)
generalmax = WorksheetFunction.Max(generalmax, outtable(x + 1, 1), outtable(y + 1, 1), outtable(1, x + 1), outtable(1, y + 1))
generalmin = outtable(x + 1, 1)
For j = 1 To maxpair
If outtable(j + 1, 1) < generalmin Then generalmin = outtable(j + 1, 1)
If outtable(1, j + 1) < generalmin Then generalmin = outtable(1, j + 1)
Next j
If generalmax > oldgeneralmax Then
oldgeneralmax = generalmax
Application.StatusBar = "Working on pairs " & generalmax & "Total progress (non-linear): " & Format(1# * generalmax / upperlimit, "0%")
End If
alloweddiff = alloweddiff - 1
i = 0
End If
End Sub
Have an array appeared[] which keeps track of how many times each item already appeared in answer. Let's say each element has to appear k times. Iterate over the array, and while current element has its appeared value less than k, choose a random pair for it from that element who also have appeared less than k times. Add that pair to answer and increase appearance count for both.
create a 2-dimensional 100*100 matrix of booleans, all False
of these 10K booleans, set 1K of them to true, with the following constraints:
the diagonal should stay empty
no row or column should have more than 20 true values
at the end, every row and column should have 20 True values.
Now, there is the X=Y diagonal symmetry. Just add the following constraints:
the triangle at one side of the diagonal should stay empty
in the above constraints, the restrictions for rows&columns should be combined/added