How should I go about generating lists of combinations of n parents and m children in VBA without having n number of nested loops? I will end up with a total of m^n combinations.
Here's an example. Let's say I have n=3 parents (1 to 3) and m=2 children (1 to 2). I would like to generate the following arrays:
1 1 1 2 1 1 1 2 1 1 and so forth...(total of 8)
2 1 2 1 2 2 2 2 2 1
3 1 3 1 3 1 3 1 3 2
These arrays would in turn be used to index another array of data, so I would end up selecting a child of every parent branch and have all the combinations of those. I figured out how I can do this if the number of parents is constant with nested loops, however that is a problem as number of parents, n, is variable.
Fun Puzzle.
Sub KJK()
Dim parent As Long, child As Long
parent = 3
child = 2
Dim oarr As Variant
ReDim oarr(1 To parent, 1 To child ^ parent)
Dim i As Long, j As Long
For i = 1 To parent
For j = 1 To child ^ parent
oarr(i, j) = i & " " & Int(((j - 1) Mod (child ^ i)) / (child ^ i) * child) + 1
Next j
Next i
'Output the array
Worksheets("Sheet1").Range("A1").Resize(parent, child ^ parent).Value = oarr
End Sub
produces:
One note: Child^Parent cannot exceed the column count of 16384 if pasting to the sheet.
Related
My English is not good, so please forgive me if what I describle is not clear for you.
I want to create 2 dimension Array with 0 and 1
when I input n, it should create: Array01(1 to 2^n as long, n as long), and 0 and 1 is combination like this:
n = 1 ==> Arr (2 rows x 1 column)
0 |
1 |
n = 2 ==> Arr (4 rows x 2 columns)
0 0 |
0 1 |
1 0 |
1 1 |
n = 3 ==> Array (8 rows x 3 columns)
0 0 0 |
0 0 1 |
0 1 0 |
1 0 0 |
1 1 0 |
1 0 1 |
0 1 1 |
1 1 1 |
You can use a function like below
Option Explicit
Public Function CreateMatrix(ByVal n As Long) As Variant
Dim Matrix() As Long
ReDim Matrix(1 To 2 ^ n, 1 To n)
Dim i As Long
For i = 0 To 2 ^ n - 1
Dim BinaryString As String
BinaryString = DecToBin(i, n)
Dim c As Long
For c = 1 To n
Matrix(i + 1, c) = CLng(Mid$(BinaryString, c, 1))
Next c
Next i
CreateMatrix = Matrix
End Function
Public Function DecToBin(ByVal DecimalIn As Variant, Optional ByVal NumberOfBits As Variant) As String
Dim Result As String
DecimalIn = CDec(DecimalIn)
Do While DecimalIn <> 0
Result = Trim$(Str$(DecimalIn - 2 * Int(DecimalIn / 2))) & Result
DecimalIn = Int(DecimalIn / 2)
Loop
If Not IsMissing(NumberOfBits) Then
If Len(Result) > NumberOfBits Then
Result = "Error - Number too large for bit size"
Else
Result = Right$(String$(NumberOfBits, "0") & Result, NumberOfBits)
End If
End If
DecToBin = Result
End Function
and call it like
' generate the matrix
Dim MyMatrix() As Long
MyMatrix = CreateMatrix(n:=3)
' and write it to a sheet
Worksheets("Sheet1").Range("A1").Resize(UBound(MyMatrix, 1), UBound(MyMatrix, 2)).Value = MyMatrix
How does this work?
If we look at the matrix below we can see each row as a binary number that can be converted into a decimal number. So binary 000 is decimal 0, then binary 001 is decimal 1 and binary 010 is decimal 2 and so on:
0 0 0 | 'decimal 0
0 0 1 | 'decimal 1
0 1 0 | 'decimal 2
1 0 0 | 'decimal 3
1 1 0 | 'decimal 4
1 0 1 | 'decimal 5
0 1 1 | 'decimal 6
1 1 1 | 'decimal 7
So we know if we want to create that matrix we need to convert the decimal numbers 1 to 7 into binary numbers. Each of this binary numbers then represents one row of the matrix.
Since the only number to define the martix is n (in the example n = 3) we can use that to calculate the dimensions of the matrix:
rows: 2 ^ n (in the example 2^3 = 8)
columns: n
So we define a matrix of that size ReDim Matrix(1 To 2 ^ n, 1 To n).
Then we need to generatate the decimal numbers from 1 to 7 to be able to convert them into binaries. We do that with a loop: For i = 0 To 2 ^ n - 1 (in the example this means For i = 0 To 7).
In that loop we convert each decimal number i into a binary string of the length n. We do that using BinaryString = DecToBin(i, n).
Finally we just need to split that string into the columns of our matrix. Therefore we use another loop that loops through the characters of that BinaryString For c = 1 To n (which means start with character 1 until character n). And fill the matrix:
Matrix(i + 1, c) = CLng(Mid$(BinaryString, c, 1))
Here Mid$(BinaryString, c, 1) picks the character out of the string and CLng converts it into a Long number so it is numeric and writes it into the correct position of the matrix Matrix(i + 1, c).
Fanally we return that matix as result of our function CreateMatrix = Matrix.
This post is 10 months old. But I saw a new post by the OP which led me here, so I thought I'd share another solution.
This can be solved by formula instead of script.
Suppose in cell A1 of some sheet you place the number for n.
In some other cell (say, A3 or C1), you could use the following formula to generate the list in question:
=FILTER(TEXT(SEQUENCE(10^A1,1,0),REPT("0",A1)),NOT(REGEXMATCH(SEQUENCE(10^A1,1,0)&"","[2-9]")))
Essentially, this formula creates a SEQUENCE of all possible numbers between 0 and 10 to the nth, formatted to contain n digits; then it FILTERs out any elements of that sequence that contain any digits from 2 to 9 (i.e., anything other than elements containing only 1s and 0s).
I'm trying to write a function that shuffles an array, which contains repeating elements, but ensures that repeating elements are not too close to one another.
This code works but seems inefficient to me:
function shuffledArr = distShuffle(myArr, myDist)
% this function takes an array myArr and shuffles it, while ensuring that repeating
% elements are at least myDist elements away from on another
% flag to indicate whether there are repetitions within myDist
reps = 1;
while reps
% set to 0 to break while-loop, will be set to 1 if it doesn't meet condition
reps = 0;
% randomly shuffle array
shuffledArr = Shuffle(myArr);
% loop through each unique value, find its position, and calculate the distance to the next occurence
for x = 1:length(unique(myArr))
% check if there are any repetitions that are separated by myDist or less
if any(diff(find(shuffledArr == x)) <= myDist)
reps = 1;
break;
end
end
end
This seems suboptimal to me for three reasons:
1) It may not be necessary to repeatedly shuffle until a solution has been found.
2) This while loop will go on forever if there is no possible solution (i.e. setting myDist to be too high to find a configuration that fits). Any ideas on how to catch this in advance?
3) There must be an easier way to determine the distance between repeating elements in an array than what I did by looping through each unique value.
I would be grateful for answers to points 2 and 3, even if point 1 is correct and it is possible to do this in a single shuffle.
I think it is sufficient to check the following condition to prevent infinite loops:
[~,num, C] = mode(myArr);
N = numel(C);
assert( (myDist<=N) || (myDist-N+1) * (num-1) +N*num <= numel(myArr),...
'Shuffling impossible!');
Assume that myDist is 2 and we have the following data:
[4 6 5 1 6 7 4 6]
We can find the the mode , 6, with its occurence, 3. We arrange 6s separating them by 2 = myDist blanks:
6 _ _ 6 _ _6
There must be (3-1) * myDist = 4 numbers to fill the blanks. Now we have five more numbers so the array can be shuffled.
The problem becomes more complicated if we have multiple modes. For example for this array [4 6 5 1 6 7 4 6 4] we have N=2 modes: 6 and 4. They can be arranged as:
6 4 _ 6 4 _ 6 4
We have 2 blanks and three more numbers [ 5 1 7] that can be used to fill the blanks. If for example we had only one number [ 5] it was impossible to fill the blanks and we couldn't shuffle the array.
For the third point you can use sparse matrix to accelerate the computation (My initial testing in Octave shows that it is more efficient):
function shuffledArr = distShuffleSparse(myArr, myDist)
[U,~,idx] = unique(myArr);
reps = true;
while reps
S = Shuffle(idx);
shuffledBin = sparse ( 1:numel(idx), S, true, numel(idx) + myDist, numel(U) );
reps = any (diff(find(shuffledBin)) <= myDist);
end
shuffledArr = U(S);
end
Alternatively you can use sub2ind and sort instead of sparse matrix:
function shuffledArr = distShuffleSparse(myArr, myDist)
[U,~,idx] = unique(myArr);
reps = true;
while reps
S = Shuffle(idx);
f = sub2ind ( [numel(idx) + myDist, numel(U)] , 1:numel(idx), S );
reps = any (diff(sort(f)) <= myDist);
end
shuffledArr = U(S);
end
If you just want to find one possible solution you could use something like that:
x = [1 1 1 2 2 2 3 3 3 3 3 4 5 5 6 7 8 9];
n = numel(x);
dist = 3; %minimal distance
uni = unique(x); %get the unique value
his = histc(x,uni); %count the occurence of each element
s = [sortrows([uni;his].',2,'descend'), zeros(length(uni),1)];
xr = []; %the vector that will contains the solution
%the for loop that will maximize the distance of each element
for ii = 1:n
s(s(:,3)<0,3) = s(s(:,3)<0,3)+1;
s(1,3) = s(1,3)-dist;
s(1,2) = s(1,2)-1;
xr = [xr s(1,1)];
s = sortrows(s,[3,2],{'descend','descend'})
end
if any(s(:,2)~=0)
fprintf('failed, dist is too big')
end
Result:
xr = [3 1 2 5 3 1 2 4 3 6 7 8 3 9 5 1 2 3]
Explaination:
I create a vector s and at the beggining s is equal to:
s =
3 5 0
1 3 0
2 3 0
5 2 0
4 1 0
6 1 0
7 1 0
8 1 0
9 1 0
%col1 = unique element; col2 = occurence of each element, col3 = penalities
At each iteration of our for-loop we choose the element with the maximum occurence since this element will be harder to place in our array.
Then after the first iteration s is equal to:
s =
1 3 0 %1 is the next element that will be placed in our array.
2 3 0
5 2 0
4 1 0
6 1 0
7 1 0
8 1 0
9 1 0
3 4 -3 %3 has now 5-1 = 4 occurence and a penalities of -3 so it won't show up the next 3 iterations.
at the end every number of the second column should be equal to 0, if it's not the minimal distance was too big.
I have an array that looks something like...
1 0 0 1 2 2 1 1 2 1 0
2 1 0 0 0 1 1 0 0 2 1
1 2 2 1 1 1 2 0 0 1 0
0 0 0 1 2 1 1 2 0 1 2
however my real array is (50x50).
I am relatively new to MATLAB and need to be able to count the amount of unique values in each row and column, for example there is four '1's in row-2 and three '0's in column-3. I need to be able to do this with my real array.
It would help even more if these quantities of unique values were in arrays of their own also.
PLEASE use simple language, or else i will get lost, for example if representing an array, don't call it x, but perhaps column_occurances_array... for me please :)
What I would do is iterate over each row of your matrix and calculate a histogram of occurrences for each row. Use histc to calculate the occurrences of each row. The thing that is nice about histc is that you are able to specify where the bins are to start accumulating. These correspond to the unique entries for each row of your matrix. As such, use unique to compute these unique entries.
Now, I would use arrayfun to iterate over all of your rows in your matrix, and this will produce a cell array. Each element in this cell array will give you the counts for each unique value for each row. Therefore, assuming your matrix of values is stored in A, you would simply do:
vals = arrayfun(#(x) [unique(A(x,:)); histc(A(x,:), unique(A(x,:)))], 1:size(A,1), 'uni', 0);
Now, if we want to display all of our counts, use celldisp. Using your example, and with the above code combined with celldisp, this is what I get:
vals{1} =
0 1 2
3 5 3
vals{2} =
0 1 2
5 4 2
vals{3} =
0 1 2
3 5 3
vals{4} =
0 1 2
4 4 3
What the above display is saying is that for the first row, you have 3 zeros, 5 ones and 3 twos. The second row has 5 zeros, 4 ones and 2 twos and so on. These are just for the rows. If you want to do these for columns, you have to modify your code slightly to operate along columns:
vals = arrayfun(#(x) [unique(A(:,x)) histc(A(:,x), unique(A(:,x)))].', 1:size(A,2), 'uni', 0);
By using celldisp, this is what we get:
vals{1} =
0 1 2
1 2 1
vals{2} =
0 1 2
2 1 1
vals{3} =
0 2
3 1
vals{4} =
0 1
1 3
vals{5} =
0 1 2
1 1 2
vals{6} =
1 2
3 1
vals{7} =
1 2
3 1
vals{8} =
0 1 2
2 1 1
vals{9} =
0 2
3 1
vals{10} =
1 2
3 1
vals{11} =
0 1 2
2 1 1
This means that in the first column, we see 1 zero, 2 ones and 1 two, etc. etc.
I absolutely agree with rayryeng! However, here is some code which might be easier to understand for you as a beginner. It is without cell arrays or arrayfuns and quite self-explanatory:
%% initialize your array randomly for demonstration:
numRows = 50;
numCols = 50;
yourArray = round(10*rand(numRows,numCols));
%% do some stuff of what you are asking for
% find all occuring numbers in yourArray
occVals = unique(yourArray(:));
% now you could sort them just for convinience
occVals = sort(occVals);
% now we could create a matrix occMat_row of dimension |occVals| x numRows
% where occMat_row(i,j) represents how often the ith value occurs in the
% jth row, analoguesly occMat_col:
occMat_row = zeros(length(occVals),numRows);
occMat_col = zeros(length(occVals),numCols);
for k = 1:length(occVals)
occMat_row(k,:) = sum(yourArray == occVals(k),2)';
occMat_col(k,:) = sum(yourArray == occVals(k),1);
end
I'm trying to figure out how to put values from a [N x 2] matrix to cells on the same row on a different worksheet.
The matrix, which changes, is something like:
1 0
1 2
1 3
2 0
2 1
2 2
... so on.
On a different sheet, using the items in the matrix, I want to create a vector that omits the zero, such as:
A B
1 1 1
2 1 2
3 1 3
4 2 1
5 2 2
... so on.
I already have an array filled with the values from the matrix. I am having problems trying to extract values from the array.
Eventually, there will be certain criteria and some combinations, so # of columns and rows will increase. So, I need to do this in VBA. Can anyone guide me in the right direction or provide some example code that I can reference?
Please let me know if I need to clarify anything.
A sample for your reference
Sub testArr()
'Declare a 4-by-2 matrix
Dim Data(3, 1) As Variant
Dim i As Long, j As Long
For i = 0 To UBound(Data, 1)
For j = 0 To UBound(Data, 2)
Data(i, j) = Int((10 - 1 + 1) * Rnd + 1)
Next j
Next i
'You extract a value from the array like this
MsgBox "data(2,1) = " & Data(2, 1)
End Sub
In my Excel worksheet users can enter 1 to 5 rows of data in the form of minimum, maximum and step size values. I want to create an multidimensional array that has all the combinations of the data.
Is there a way to code this in VBA to dynamically size the array and loop through the cell values without knowing how many data items beforehand?
Example data of 3 rows of inputs (can be more or less)
Min, Max, Step
Data 1: 1, 10, 1
Data 2: 10, 50, 10
Data 3: 5, 25, 5
Total combinations is 250 (10 x 5 x 5)
Combo 1: 1, 10, 5
Combo 2: 1, 10, 10
Combo 3: 1, 10, 15
...
Thanks!
I found your question a little unclear but I believe the macro below does what you want.
If you have a variant Result, you can set Result to an array. You can then, in turn, set Result(1), Result(1)(1), Result(1)(1)(1) and so on to nested arrays. With suitable recursive routines I believe you could create the sort of array you seek of any size within the limits Excel. However, I think this approach would be very difficult to understand.
I do not believe there is a simpler way of creating an array with a variable number of dimensions. Changing the size of the dimensions is, however, not a problem.
Since you have a maximum of five dimensions, I have decided to go for a fixed number of dimensions with trailing, unused dimensions having a width of one. With your example (1 to 10 step 1, 10 to 50 step 10, 5 to 25 step 5), this would require:
Dim Result(1 To 10, 1 To 5, 1 To 5, 1 To 1, 1 To 1)
The first three dimensions have 10, 5 and 5 elements, ready to hold a range of values. The final two dimensions are just place holders.
You are getting your users to enter dimension details. I have loaded details from worksheet "Dyn Dims". For the test that matches your example, I set this worksheet to:
Min Max Step
1 10 1
10 50 10
5 25 5
I load this information to long array Requirements(1 To 3, 1 To 5). The columns are minimum, maximum and step. The rows allow for a maximum of five dimensions. If column 3 (step) is zero, the dimension is not used. I do not allow for negative step values but indicate where changes would be required if this was necessary.
You will need to initialise this array from the data entered by your users.
From array Requirements, the macro calculates the number of elements in each dimension. I have tested this calculation with values, such as 1 step 2 to 10, where there is no value for N such that Min + N * Step = Max.
The macro then dimensions array Result as necessary.
You do not say what values you want within the array so I have set them to values of the form "N:N:N" where the Ns are the values from the Min-To-Max-Step calculation. I have explained this in the macro and will not repeat myself here.
Finally, I output the contents of the array to a file named for the date and time. With your example the output is:
Dimensions
1 2 3 Value
1 1 1 1:10:5
2 1 1 2:10:5
3 1 1 3:10:5
4 1 1 4:10:5
5 1 1 5:10:5
6 1 1 6:10:5
7 1 1 7:10:5
8 1 1 8:10:5
9 1 1 9:10:5
10 1 1 10:10:5
1 2 1 1:20:5
: : : :
5 5 5 5:50:25
6 5 5 6:50:25
7 5 5 7:50:25
8 5 5 8:50:25
9 5 5 9:50:25
10 5 5 10:50:25
I believe I have included enough comments to explain the macro but come back with questions if necessary.
Option Explicit
Sub DD()
Const ColReqMin As Long = 1
Const ColReqMax As Long = 2
Const ColReqStep As Long = 3
Dim DimCrnt As Long
Dim Entry(1 To 5) As Long
Dim EntryStepped As Boolean
Dim FileOutNum As Long
Dim Index(1 To 5) As Long
Dim IndexStepped As Boolean
Dim NumEntries(1 To 5) As Long
Dim Requirements(1 To 3, 1 To 5) As Long
Dim Result() As String
Dim RowDDCrnt As Long
Dim Stg As String
Dim Value As String
' Load Requirements with the required ranges
With Worksheets("Dyn Dims")
RowDDCrnt = 2 ' First data row of worksheet Dyn Dims
' Note this macro does not check for blank lines in the middle
' of the table.
For DimCrnt = 1 To 5
If IsEmpty(.Cells(RowDDCrnt, ColReqStep)) Then
' No step value so this dimension not required for this run
Requirements(ColReqStep, DimCrnt) = 0
Else
Requirements(ColReqMin, DimCrnt) = .Cells(RowDDCrnt, ColReqMin)
Requirements(ColReqMax, DimCrnt) = .Cells(RowDDCrnt, ColReqMax)
Requirements(ColReqStep, DimCrnt) = .Cells(RowDDCrnt, ColReqStep)
End If
RowDDCrnt = RowDDCrnt + 1
Next
End With
' Calculate number of entries for each dimension
For DimCrnt = 1 To 5
If Requirements(ColReqStep, DimCrnt) = 0 Then
' Dummy dimension
NumEntries(DimCrnt) = 1
Else
NumEntries(DimCrnt) = (Requirements(ColReqMax, DimCrnt) - _
Requirements(ColReqMin, DimCrnt) + _
Requirements(ColReqStep, DimCrnt)) \ _
Requirements(ColReqStep, DimCrnt)
End If
Next
' Size array
ReDim Result(1 To NumEntries(1), _
1 To NumEntries(2), _
1 To NumEntries(3), _
1 To NumEntries(4), _
1 To NumEntries(5))
' Initialise entry for each dimension to minimum value, if any,
' and index for each dimension to 1
For DimCrnt = 1 To 5
Index(DimCrnt) = 1
If Requirements(ColReqStep, DimCrnt) <> 0 Then
Entry(DimCrnt) = Requirements(ColReqMin, DimCrnt)
End If
Next
' Starting with Entry(1), this loop steps the entry if the dimension is used.
' If the stepped entry is not greater than the maximum, then this repeat of
' the loop has finished. If the stepped entry is greater than the maximum,
' it is reset to its minimum and the next entry stepped and checked in the
' same way. If no entry is found that can be stepped, the loop is finished.
' If the dimensions after all 1 to 3 step 1, the values created by this loop
' are:
' 1 1 1 1 1
' 2 1 1 1 1
' 3 1 1 1 1
' 1 2 1 1 1
' 2 2 1 1 1
' 3 2 1 1 1
' 1 3 1 1 1
' 2 3 1 1 1
' 3 3 1 1 1
' 1 1 2 1 1
' 2 1 2 1 1
' 3 1 2 1 1
' : : : : :
' 3 3 3 3 3
Do While True
' Concatenate entries to create value for initial element
' or for element identified by last loop
Value = Entry(1)
For DimCrnt = 2 To 5
If Requirements(ColReqStep, DimCrnt) = 0 Then
Exit For
End If
Value = Value & ":" & Entry(DimCrnt)
Next
Result(Index(1), Index(2), Index(3), Index(4), Index(5)) = Value
' Find an entry to step
EntryStepped = False
For DimCrnt = 1 To 5
If Requirements(ColReqStep, DimCrnt) = 0 Then
Exit For
End If
Index(DimCrnt) = Index(DimCrnt) + 1
Entry(DimCrnt) = Entry(DimCrnt) + _
Requirements(ColReqStep, DimCrnt)
' ### Changes required her if a negative step value is allow
If Entry(DimCrnt) <= Requirements(ColReqMax, DimCrnt) Then
' This stepped entry is within permitted range
EntryStepped = True
Exit For
End If
' This entry past its maximum so reset to minimum
' and let for loop step entry for next dimension
Index(DimCrnt) = 1
Entry(DimCrnt) = Requirements(ColReqMin, DimCrnt)
Next
If Not EntryStepped Then
' All elements of Result initialised
Exit Do
End If
Loop
' All elements of Result initialised
' Output values as test.
FileOutNum = FreeFile
Open ActiveWorkbook.Path & "\" & Format(Now(), "yymmdd hhmmss") & ".txt" _
For Output As #FileOutNum
' Initialise Index
For DimCrnt = 1 To 5
Index(DimCrnt) = 1
Next
' Create header line for table
Print #FileOutNum, "Dimensions"
Stg = ""
For DimCrnt = 1 To 5
If Requirements(ColReqStep, DimCrnt) = 0 Then
Exit For
End If
Stg = Stg & Right(" " & DimCrnt, 4)
Next
Stg = Stg & " Value"
Print #FileOutNum, Stg
' Similar logic to loop that intialised Result but using Index and UBound.
Do While True
' Output initial element or element identified by previous loop
Stg = ""
For DimCrnt = 1 To 5
If Requirements(ColReqStep, DimCrnt) = 0 Then
Exit For
End If
Stg = Stg & Right(" " & Index(DimCrnt), 4)
Next
Stg = Stg & " " & Result(Index(1), Index(2), Index(3), Index(4), Index(5))
Print #FileOutNum, Stg
' Identify next element, if any
IndexStepped = False
For DimCrnt = 1 To 5
If Requirements(ColReqStep, DimCrnt) = 0 Then
Exit For
End If
Index(DimCrnt) = Index(DimCrnt) + 1
If Index(DimCrnt) <= UBound(Result, DimCrnt) Then
IndexStepped = True
Exit For
Else
Index(DimCrnt) = 1
End If
Next
If Not IndexStepped Then
' All entries output
Exit Do
End If
Loop
Close #FileOutNum
End Sub