I have an array that can vary in size, with n columns and m rows, and I need to find all the combinations of one element for each row/column combination, but exclude any combinations where the element is zero. So, in practice, if I have:
Row
Item1
Item2
Item3
1
A
B
C
2
D
E
F
I will have 2^3 = 8 possible combinations: ABC, ABF, AEC, AEF, DBC, DBF, DEC, DEF.
But if instead of B I have a zero in row 1 Item2, I want to exclude that cell from the list of combinations (in bold above), so I would end up with: AEC, AEF, DEC and DEF.
I found some code that give me all the possible combinations on a fixed number of columns (Macro to make all possible combinations of data in various columns in excel sheet), but it doesn't account for an array that can change dimensions, or for the exclusion rule above.
I'm just going to post the code for the simple (no zeroes) case so you can see where I'm going with this (of course I have realised that Base switches over to letters for radix 11 onwards so this might not be the smartest approach :) )
Function ListCombos(r As Range)
Dim s As String, result As String
Dim arr()
Dim j As Integer, offset As Integer
Dim rows As Integer, cols As Integer
Dim nComb As Long, i As Long
rows = r.rows.Count
cols = r.Columns.Count
nComb = rows ^ cols
ReDim arr(1 To nComb)
For i = 1 To nComb
s = Application.Base(i - 1, rows, cols)
result = ""
For j = 1 To cols
offset = CInt(Mid(s, j, 1))
result = result & r.Cells(1, 1).offset(offset, j - 1)
Next j
arr(i) = result
Next i
ListCombos = arr
End Function
This is the version skipping combinations which contain zeroes. The method is to move non-zero values to the first rows of a holding array so effectively if you start with something like this
You make it look like this
So you don't have to generate or check all the combinations that contain zeroes.
Then use mixed radix to cycle through the combinations:
Option Explicit
Option Base 1
Function ListCombosWithZeroes(r As Range)
Dim s As String, result As String
Dim arr()
Dim i As Integer, j As Integer, offset As Integer, count As Integer, carry As Integer, temp As Integer
Dim rows As Integer, cols As Integer
Dim nComb As Long, iComb As Long
Dim holdingArr(20, 20) As String
Dim countArr(20) As Integer
Dim countUpArr(20) As Integer
rows = r.rows.count
cols = r.Columns.count
' Move non-zero cells to first rows of holding array and establish counts per column
For j = 1 To cols
count = 0
For i = 1 To rows
If r.Cells(i, j) <> 0 Then
count = count + 1
holdingArr(count, j) = r.Cells(i, j)
End If
Next i
countArr(j) = count
Next j
' Calculate number of combos
nComb = 1
For j = 1 To cols
nComb = nComb * countArr(j)
Next j
ReDim arr(1 To nComb)
'Loop through combos
For iComb = 1 To nComb
result = ""
For j = 1 To cols
offset = countUpArr(j)
result = result & holdingArr(offset + 1, j)
Next j
arr(iComb) = result
'Increment countup Array - this is the hard part.
j = cols
'Set carry=1 to force increment on right-hand column
carry = 1
Do
temp = countUpArr(j) + carry
countUpArr(j) = temp Mod countArr(j)
carry = temp \ countArr(j)
j = j - 1
Loop While carry > 0 And j > 0
Next iComb
ListCombosWithZeroes = arr
End Function
You don't have to have equal numbers of letters per column.
Here's a solution. Probably not most efficient, since it is O(n2), but it works.
Caveats
I put a '.' instead of zero to avoid dealing with numeric vs alphanumeric values, but you can easily change this
Since I build the strings incrementally I need indices to be predictable. Hence I fill all the possible combinations and then remove the ones containing a '.' in a second pass
Global aws As Worksheet
Global ur As Range
Global ccount, rcount, size, rptline, rptblock, iblk, iln, idx As Integer
Global tempcombos(), combos() As String
Public Sub Calc_combos()
Set aws = Application.ActiveSheet
Set ur = aws.UsedRange
ccount = ur.Columns.Count
rcount = ur.Rows.Count
size = (rcount - 1) ^ (ccount - 1)
ReDim tempcombos(size - 1)
ReDim combos(size - 1)
rptline = size / (rcount - 1)
rptblock = 1
For c = 2 To ccount
idx = 0
For iblk = 1 To rptblock
For r = 2 To rcount
For iln = 1 To rptline
tempcombos(idx) = tempcombos(idx) & Cells(r, c)
idx = idx + 1
Next iln
Next r
Next iblk
rptline = rptline / (rcount - 1)
rptblock = rptblock * (rcount - 1)
Next c
idx = 0
For iln = 0 To size - 1
If InStr(tempcombos(iln), ".") = 0 Then
combos(idx) = tempcombos(iln)
idx = idx + 1
End If
Next iln
End Sub
The Python way:
from dataclasses import dataclass, field
from itertools import product
from random import randint
from typing import Dict, List
#dataclass
class PriceComparison():
rows : int
cols : int
maxprice : int = 50
threshold : int = 0
itemcodes : List[List[str]] = field(init=False)
pricelist : Dict[str, int] = field(init=False)
def __post_init__(self):
##create sample data
self.itemcodes = [[f'A{r+self.cols*c:03d}' for c in range(self.rows)] for r in range(self.cols)]
print(self.itemcodes)
self.pricelist = {self.itemcodes[c][r]:randint(0,self.maxprice) for r in range(self.rows) for c in range(self.cols)}
##remove items with price = 0
for col in self.itemcodes:
for item in col[:]:
if self.pricelist[item] == 0:
print(f'removing {item} from {col}')
col.remove(item)
del self.pricelist[item]
def find_cheapest(self):
iterations = 1
for col in self.itemcodes:
iterations *= len(col)
print(f'this may require {iterations} iterations!')
cheapest = self.maxprice * self.cols + 1
for i, combo in enumerate(product(*self.itemcodes)):
##dummy price calculation
price = sum([self.pricelist[item] for item in combo]) * randint(1,10) // 10
if price < cheapest:
print(f'current cheapest is {price} at iteration {i}')
cheapest = price
if price < self.threshold:
print('under threshold: returning')
break
return cheapest
Some notes:
I assume the cheapest combo is not simply given by selecting the cheapest item in each column, otherwise we would not need all this complicated machinery; so I inserted a random coefficient while calculating the total price of a combo - this should be replaced with the actual formula
I also assume we have item codes in our input table, with prices for each item stored elsewhere. As sample data I create codes from 'A000' to 'Axxx', and assign a random price between 0 and a maxprice to each one
Items with price = 0 are removed immediately, before the search for the cheapest combo
For large input tables the search will take a very long time. So although it wasn't requested I also added an optional threshold parameter: if we find a total price under that value we consider it is cheap enough and stop the search
EDIT
The following is a Python 3.5 compatible version.
However it must be noted that with a 10x15 input table the number of required iterations will be somewhere near 1E+15 (something less actually, depending on how many cells we are able to ignore as "obvious outliers"). Even if we check 1 million combos per second it will still run for (something less than) 1E+09 seconds, or about 32 years.
So we need a way to improve our strategy. I integrated two options:
Setting a threshold, so that we don't search for the actual best price but stop as soon as we find an "acceptable" one
Splitting the tables in "zones" (subsets of columns), looking for the best partial solution for each zone and then combining them.
Sample runs:
##10 x 15, 5 zones, each 3 columns wide
this may require up to 1.000000e+03 iterations!
...
current best price is 1 at iteration 71 in 0.06 secs
this may require up to 1.000000e+03 iterations!
...
current best price is 2 at iteration 291 in 0.11 secs
this may require up to 1.000000e+03 iterations!
...
current best price is 1 at iteration 330 in 0.07 secs
this may require up to 8.100000e+02 iterations!
...
current best price is 4 at iteration 34 in 0.09 secs
this may require up to 1.000000e+03 iterations!
...
current best price is 1 at iteration 82 in 0.07 secs
['A000', 'A106', 'A017', 'A033', 'A139', 'A020', 'A051', 'A052', 'A008', 'A009', 'A055', 'A131', 'A147', 'A133', 'A044']
##10 x 15, no zones, threshold = 25
this may require up to 8.100000e+14 iterations!
...
current best price is 24 at iteration 267493282 in 1033.24 secs
under threshold: returning
['A000', 'A001', 'A002', 'A003', 'A004', 'A005', 'A051', 'A052', 'A008', 'A039', 'A055', 'A071', 'A042', 'A133', 'A044']
Code follows:
from itertools import product
from random import randint
from time import time
class PriceComparison():
def __init__(self, rows, cols, zones = [], maxprice = 50, threshold = 0):
self.rows = rows
self.cols = cols
if zones == []:
self.zones = [cols]
else:
self.zones = zones
self.maxprice = maxprice
self.threshold = threshold
self.__post_init__()
def __post_init__(self):
##create sample data
self.itemcodes = [['A%03d' % (r+self.cols*c) for c in range(self.rows)] for r in range(self.cols)]
print(self.itemcodes)
self.pricelist = {self.itemcodes[c][r]:randint(0,self.maxprice) for r in range(self.rows) for c in range(self.cols)}
##remove items with price = 0
for col in self.itemcodes:
for item in col[:]:
if self.pricelist[item] == 0:
print('removing %s from %s' % (item, col))
col.remove(item)
del self.pricelist[item]
def find_cheapest(self, lo, hi):
iterations = 1
for col in self.itemcodes[lo:hi]:
iterations *= len(col)
start = time()
print('\nthis may require up to %e iterations!' % (iterations))
bestprice = self.maxprice * self.cols + 1
for i, combo in enumerate(product(*self.itemcodes[lo:hi])):
##dummy price calculation
price = sum([self.pricelist[item] for item in combo]) * randint(1,10) // 10
if price < bestprice:
elapsed = time() - start
print('current best price is %d at iteration %d in %.2f secs' % (price, i, elapsed))
cheapest = combo
bestprice = price
if price < self.threshold:
print('under threshold: returning')
break
return cheapest
def find_by_zones(self):
print(self.zones)
fullcombo = []
lo = 0
for zone in self.zones:
hi = lo + zone
fullcombo += self.find_cheapest(lo, hi)
lo = hi
return fullcombo
The following code generates an cell array Index [1x29], where each cell is an array [29x6]:
for i = 1 : size(P1_cell,1)
for j = 1 : size(P1_cell,2)
[Lia,Lib] = ismember(P1_cell{i,j},PATTERNS_FOR_ERANOS_cell{1},'rows');
Index1(i,j) = Lib % 29x6
end
Index{i} = Index1; % 1x29
end
How can I find the nonzero values in Index array?, i.e. generate an array with the number of non-zero values in each row of the Index1 array. I tried the following loop, but it doesn't work, it creates conflict with the previous one:
for i = 1 : length(Index)
for j = 1 : length(Index)
Non_ceros = length(find(Index{:,i}(j,:))); %% I just need the length of the find function output
end
end
I need help, Thanks in advance.
The nnz() (number of non-zeros) function can be used to evaluate the number of non-zero elements. To obtain the specific positive values you can index the array by using the indices returned by the find() function. I used some random test data but it should work for 29 by 6 sized arrays as well.
%Random test data%
Index{1} = [5 2 3 0 zeros(1,25)];
Index{2} = [9 2 3 1 zeros(1,25)];
Index{3} = [5 5 5 5 zeros(1,25)];
%Initializing and array to count the number of zeroes%
Non_Zero_Counts = zeros(length(Index),1);
for Row_Index = 1: length(Index)
%Evaluating the number of positive values%
Array = Index{Row_Index};
Non_Zero_Counts(Row_Index) = nnz(Array);
%Retrieving the positive values%
Positive_Indices = find(Array);
PositiveElements{Row_Index} = Array(Positive_Indices);
disp(Non_Zero_Counts(Row_Index) + " Non-Zero Elements ");
disp(PositiveElements{Row_Index});
end
Ran using MATLAB R2019b
for i = 1 : length(Index)
for j = 1 : length(Index)
Non_ceros(i,j) = nnz(Index{:,i}(j,:));
end
end
first of all thanks for your time.
I have a program where I roll 2 dices 3 times, their values get stored in 2 arrays.
Dim Attacker(3) As Integer
Dim Defender(3) As Integer
Dim i As Integer = 0
For Each pb As PictureBox In New PictureBox() {Steen1, Steen2, Steen3}
i += 1
Select Case RandomNumber.Next(1, 7)
Case 1 : pb.Image = Game.My.Resources.Een
Attacker([i]) = 1
Case 2 : pb.Image = Game.My.Resources.Twee
Attacker([i]) = 2
Case 3 : pb.Image = Game.My.Resources.Drie
Attacker([i]) = 3
Case 4 : pb.Image = Game.My.Resources.Vier
Attacker([i]) = 4
Case 5 : pb.Image = Game.My.Resources.Vijf
Attacker([i]) = 5
Case 6 : pb.Image = Game.My.Resources.Zes
Attacker([i]) = 6
End Select
Next
i = 0
For Each pb As PictureBox In New PictureBox() {Steen4, Steen5, Steen6}
i += 1
Select Case RandomNumber.Next(1, 7)
Case 1 : pb.Image = Game.My.Resources.Een
Defender([i]) = 1
Case 2 : pb.Image = Game.My.Resources.Twee
Defender([i]) = 2
Case 3 : pb.Image = Game.My.Resources.Drie
Defender([i]) = 3
Case 4 : pb.Image = Game.My.Resources.Vier
Defender([i]) = 4
Case 5 : pb.Image = Game.My.Resources.Vijf
Defender([i]) = 5
Case 6 : pb.Image = Game.My.Resources.Zes
Defender([i]) = 6
End Select
Next
Now I would like to let the highest the second highest and the lowest value's 'fight' each other:
Highest value Attacker against highest value Defender,
Second highest value Attacker against second highest value Defender,
Lowest...
Is there a standard method to do this or do I have to work with 'a hundred' if statements?
Thanks again!
P.S: I am a 17 year old recreational programmer so I probably don't have all the basics yet.
You could order the lists, and then iterate through them together using Zip.
Attacker = Attacker.OrderByDescending(Function(x) x).ToArray()
Defender = Defender.OrderByDescending(Function(x) x).ToArray()
For Each pair In Attacker.Zip(Defender, Function(attack, defend) _
New With { attack, defend })
' have the numbers "fight"
Next
To break down the individual parts in the ordering line:
OrderByDescending
orders the array based on the elements selected by the given
function.
Function(x) x is a function that simply returns what is
passed into it. Since we want to order by the Integers that are in
the array (instead of, e.g. some property on the Integer), this is
the function we want to use.
Since OrderByDescending returns a new
IEnumerable(Of Integer) while we want to modify our array, we then
use ToArray to convert it
And then we store
it (the Attacker = part).
You can sort the array.
Array.Sort(Attacker)
Array.Sort(Defender)
Then you can compare index 0 of both array together and continue with index 1 and 2.
How do you read the data from a dynamic array out?
ReDim idx(1 To nItemsToPick)
ReDim varRandomItems(1 To nItemsToPick)
For i = 1 To nItemsToPick
Do
booIndexIsUnique = True
idx(i) = Int(nItemsTotal * Rnd + 1)
For j = 1 To i - 1
If idx(i) = idx(j) Then
booIndexIsUnique = False
Exit For
End If
Next j
If booIndexIsUnique = True Then
Exit Do
End If
Loop
varRandomItems(i) = rngList.Cells(idx(i), 1)
Next i
Thank you!
Somehow you have to get the user to input a starting cell and whether they want the data horizontally or vertically.
Then if the user inputs "A1", and there are 10 elements and the orientation is horizontal you need to turn that into a string -> "A1:A10"
Range("A1:J10") = varRandomItems
or
Range("A1:A10") = Application.Transpose(varRandomItems)
(apologies, I'm forgetting how to put the strings together at this point)
How can I find out the number of dimensions in an array in Classic ASP ( VBScript ) .
I am being passed an Array with multiple dimensions but I only want to look at the last. Seems easy in other languages.
Ubound(MySingleDimensionalArray, 2) ' Number of Array Elements
Ubound(MyMultiDimensionalArray, 1) ' Number of Columns
Ubound(MyMultiDimensionalArray, 2) ' Number of Rows
Similar approach to feihtthief's answer here as I assume this is what you want rather than the size of a specified dimension.
Function NumDimensions(arr)
Dim dimensions : dimensions = 0
On Error Resume Next
Do While Err.number = 0
dimensions = dimensions + 1
UBound arr, dimensions
Loop
On Error Goto 0
NumDimensions = dimensions - 1
End Function
Then calling it as so:
Dim test(9, 5, 4, 3, 9, 1, 3, 5)
NumDimensions(test)
will give you the value 8
It's a bit crappy but it'll do what you asked.
function ArrayDimensions( theArray )
dim Result,test
Result = 0
if isarray(theArray) then
on error resume next
do
test = -2
test = ubound(theArray,result+1)
if test > -2 then result = result + 1
loop until test=-2
on error goto 0
end if
ArrayDimensions = Result
end function