Related
I 'am developing a technique for sorting a table that contains either 0 or 1 such as:
{{1, 1, 0, 1, 1, 1, 1, 1},
{1, 1, 0, 0, 0, 0, 1, 0},
{1, 1, 1, 1, 1, 1, 1, 0},
{1, 1, 1, 1, 1, 1, 1, 0},
{1, 1, 1, 0, 0, 0, 1, 0},
{1, 1, 1, 1, 1, 1, 1, 0},
{0, 0, 0, 0, 0, 1, 0, 1},
{1, 1, 1, 1, 1, 0, 0, 0},
{1, 1, 1, 1, 1, 1, 0, 1},
{0, 0, 0, 1, 0, 1, 0, 1},
{1, 1, 1, 1, 1, 0, 0, 0},
{1, 1, 1, 1, 1, 0, 0, 0}}
The objective is to count the total per column and sort the table:
I. Descending based on the total per column.
II. coverage. For instance, in the 1st row the 3rd value is 0. We'll have to find the 1st column that has 1 in the 3rd column and re-sort the columns. In other words, 1 stands for coverage and we have to make sure that we cover all within the 1st few columns.
I managed to get the total per column, as follows:
For (i=0; i<m; i++)
For (j=0; j< TS.Size(); j++)
if (tc.detected()==1)
TS_Detect[j][i]= 1
else
TS_Detect[j][i]= 0
TC_Sum=(2, TS.Size())
For (k=0; k<TS.Size(); k++)
TC_Sum(0, k)=k
For (l=0; l< m; l++)
Flag=TS_Detect[l][k]
If (flag == 1)
TC_Sum(1, k)= TC_Sum(1, k)+1
int temp
For (g=0; g<TC_Sum.length-1; g++)
For (b=1; b< TC_Sum.length-1; b++)
If (TC_Sum[b-1]< TC_Sum[b])
temp= TC_Sum[b-1]
TC_Sum[b-1]= TC_Sum[b]
TC_Sum[b]= temp
return TC_Sum
The problem now is that I couldn't sort the original array (TC_Detect) based on the column number from TC_Sum.
Consequently, I would like to re-sort the table so if a column has 0, the next one will be 1.
The expected output for the above example will look like:
{{1, 1, 0, 1, 1, 1, 1, 1},
{1, 1, 1, 1, 1, 1, 1, 0},
{1, 1, 0, 0, 0, 0, 1, 0},
{1, 1, 1, 1, 1, 1, 1, 0},
{0, 0, 0, 0, 0, 1, 0, 1},
{1, 1, 1, 0, 0, 0, 1, 0},
{1, 1, 1, 1, 1, 1, 1, 0},
{0, 0, 0, 1, 0, 1, 0, 1},
{1, 1, 1, 1, 1, 0, 0, 0},
{1, 1, 1, 1, 1, 1, 0, 1},
{1, 1, 1, 1, 1, 0, 0, 0},
{1, 1, 1, 1, 1, 0, 0, 0}}
Any suggestion, please.
I'm not sure what language you are using, but I think my answer is general enough.
I assume that you have a list of lists, let's call it A.
A = [ [0,1,0,0] , [1,0,1,1] , [0,0,0,0] ]
You've used your counting algorithm above to make another list, call it S for sum.
S = [ 3 , 1 , 0 ]
You now want to sort A based on the values of S.
To make things easy, let's define a third list that we'll call I for index.
I = [ 0 , 1 , 2 ]
I would continue up to 3,4,5,6,... depending on the number of elements in your list
What you need now is a sort function that allows you to sort based on a key. Such a sort function usually takes the thing you want to sort along with a function for comparing two items.
In this case, sort I. The sort function is then passed indices. Compare these indices based on the values in S. The result is a list I* containing indices sorted according to S. You can now reorder A based on I*.
I am not sure what language you are using, but the following Python code accomplishes this:
def MyComparison(i,j):
return S[j]-S[i]
A = [ [0,1,0,0] , [1,0,1,1], [0,0,0,0] ]
S = [ 1 , 3 , 0 ]
I = [ 0 , 1 , 2 ]
Istar = sorted(I, cmp=MyComparison)
#The above returns: [2, 0, 1]. If this is the wrong order, reverse the result.
[A[x] for x in Istar]
#The above returns: [[1, 0, 1, 1], [0, 1, 0, 0], [0, 0, 0, 0]]
Note that the comparison function returns -1, 0, or 1 depending on the relative ranking of the items compared.
Mathematica's Manipulate function takes as its final arguments separate lists of the parameters you want sliders for along with their value ranges. But why not a list of lists?
This way I could I easily generate all the sliders for this big list of transformation rules that I have, e.g.:
parms = {a -> 2, b -> 4, c -> 5};
Table[{{parms[[i]][[1]], parms[[i]][[2]]}, 0, 10}, {i, 1,Length[parms]}]
{{{a, 2}, 0, 10}, {{b, 4}, 0, 10}, {{c, 5}, 0, 10}}
What I would like to have, however, is:
{{a, 2}, 0, 10}, {{b, 4}, 0, 10}, {{c, 5}, 0, 10}
This I'm copy pasting now between cells, which is rather messy. I'm sure there's a better way to do this. Please help, thanks!
Please see this and this on similar questions.
What you need is Sequence## to get the list of lists to be treated as your desired output when used as input.
Perhaps something like:
ClearAll[a, b, c];
parms = {a -> 2, b -> 4, c -> 5};
With[{values = Table[parms[[i]][[1]], {i, 1, Length[parms]}],
controls = Sequence ##
Table[{{parms[[i]][[1]], parms[[i]][[2]],
Style[ToString[parms[[i]][[1]]], Red, Bold]}, 0, 10}, {i, 1,
Length[parms]}]},
Manipulate[values, controls]]
which gives
I think Mathematica is biased towards rows not columns.
Given a matrix, to insert a row seems to be easy, just use Insert[]
(a = {{1, 2, 3}, {4, 0, 8}, {7 , 8, 0}}) // MatrixForm
1 2 3
4 0 8
7 8 0
row = {97, 98, 99};
(newa = Insert[a, row, 2]) // MatrixForm
1 2 3
97 98 99
4 0 8
7 8 0
But to insert a column, after some struggle, I found 2 ways, I show below, and would like to ask the experts here if they see a shorter and more direct way (Mathematica has so many commands, and I could have overlooked one that does this sort of thing in much direct way), as I think the methods I have now are still too complex for such a basic operation.
First method
Have to do double transpose:
a = {{1, 2, 3}, {4, 0, 8}, {7 , 8, 0}}
column = {97, 98, 99}
newa = Transpose[Insert[Transpose[a], column, 2]]
1 97 2 3
4 98 0 8
7 99 8 0
Second method
Use SparseArray, but need to watch out for index locations. Kinda awkward for doing this:
(SparseArray[{{i_, j_} :> column[[i]] /; j == 2, {i_, j_} :> a[[i, j]] /; j == 1,
{i_, j_} :> a[[i, j - 1]] /; j > 1}, {3, 4}]) // Normal
1 97 2 3
4 98 0 8
7 99 8 0
The question is: Is there a more functional way, that is little shorter than the above? I could ofcourse use one of the above, and wrap the whole thing with a function, say insertColumn[...] to make it easy to use. But wanted to see if there is an easier way to do this than what I have.
For reference, this is how I do this in Matlab:
EDU>> A=[1 2 3;4 0 8;7 8 0]
A =
1 2 3
4 0 8
7 8 0
EDU>> column=[97 98 99]';
EDU>> B=[A(:,1) column A(:,2:end)]
B =
1 97 2 3
4 98 0 8
7 99 8 0
Your double Transpose method seems fine. For very large matrices, this will be 2-3 times faster:
MapThread[Insert, {a, column, Table[2, {Length[column]}]}]
If you want to mimic your Matlab way, the closest is probably this:
ArrayFlatten[{{a[[All, ;; 1]], Transpose[{column}], a[[All, 2 ;;]]}}]
Keep in mind that insertions require making an entire copy of the matrix. So, if you plan to build a matrix this way, it is more efficient to preallocate the matrix (if you know its size) and do in-place modifications through Part instead.
You can use Join with a level specification of 2 along with Partition in subsets of size 1:
a = {{1, 2, 3}, {4, 0, 8}, {7 , 8, 0}}
column = {97, 98, 99}
newa = Join[a,Partition[column,1],2]
I think I'd do it the same way, but here are some other ways of doing it:
-With MapIndexed
newa = MapIndexed[Insert[#1, column[[#2[[1]]]], 2] &, a]
-With Sequence:
newa = a;
newa[[All, 1]] = Transpose[{newa[[All, 1]], column}];
newa = Replace[a, List -> Sequence, {3}, Heads -> True]
Interestingly, this would seem to be a method that works 'in place', i.e. it wouldn't really require a matrix copy as stated in Leonid's answer and if you print the resulting matrix it apparently works as a charm.
However, there's a big catch. See the problems with Sequence in the mathgroup discussion "part assigned sequence behavior puzzling".
I usually just do like this:
In: m0 = ConstantArray[0, {3, 4}];
m0[[All, {1, 3, 4}]] = {{1, 2, 3}, {4, 0, 8}, {7, 8, 0}};
m0[[All, 2]] = {97, 98, 99}; m0
Out:
{{1, 97, 2, 3}, {4, 98, 0, 8}, {7, 99, 8, 0}}
I don't know how it compare in terms of efficiency.
I originally posted this as a comment (now deleted)
Based on a method given by user656058 in this question (Mathematica 'Append To' Function Problem) and the reply of Mr Wizard, the following alternative method of adding a column to a matrix, using Table and Insert, may be gleaned:
(a = {{1, 2, 3}, {4, 0, 8}, {7, 8, 0}});
column = {97, 98, 99};
Table[Insert[a[[i]], column[[i]], 2], {i, 3}] // MatrixForm
giving
Similarly, to add a column of zeros (say):
Table[Insert[#[[i]], 0, 2], {i, Dimensions[#][[1]]}] & # a
As noted in the comments above, Janus has drawn attention to the 'trick' of adding a column of zeros by the ArrayFlatten method (see here)
ArrayFlatten[{{Take[#, All, 1], 0, Take[#, All, -2]}}] & #
a // MatrixForm
Edit
Perhaps simpler, at least for smaller matrices
(Insert[a[[#]], column[[#]], 2] & /# Range[3]) // MatrixForm
or, to insert a column of zeros
Insert[a[[#]], 0, 2] & /# Range[3]
Or, a little more generally:
Flatten#Insert[a[[#]], {0, 0}, 2] & /# Range[3] // MatrixForm
May also easily be adapted to work with Append and Prepend, of course.
I have the following problem.
I need to build a very large number of definitions(*) such as
f[{1,0,0,0}] = 1
f[{0,1,0,0}] = 2
f[{0,0,1,0}] = 3
f[{0,0,0,1}] = 2
...
f[{2,3,1,2}] = 4
...
f[{n1,n2,n3,n4}] = some integer
...
This is just an example. The length of the argument list does not need to be 4 but can be anything.
I realized that the lookup for each value slows down with exponential complexity when the length of the argument list increases. Perhaps this is not so strange, since it is clear that in principle there is a combinatorial explosion in how many definitions Mathematica needs to store.
Though, I have expected Mathematica to be smart and that value extract should be constant time complexity. Apparently it is not.
Is there any way to speed up lookup time? This probably has to do with how Mathematica internally handles symbol definition lookups. Does it phrases the list until it finds the match? It seems that it does so.
All suggestions highly appreciated.
With best regards
Zoran
(*) I am working on a stochastic simulation software that generates all configurations of a system and needs to store how many times each configuration occurred. In that sense a list {n1, n2, ..., nT} describes a particular configuration of the system saying that there are n1 particles of type 1, n2 particles of type 2, ..., nT particles of type T. There can be exponentially many such configurations.
Could you give some detail on how you worked out that lookup time is exponential?
If it is indeed exponential, perhaps you could speed things up by using Hash on your keys (configurations), then storing key-value pairs in a list like {{key1,value1},{key2,value2}}, kept sorted by key and then using binary search (which should be log time). This should be very quick to code up but not optimum in terms of speed.
If that's not fast enough, one could think about setting up a proper hashtable implementation (which I thought was what the f[{0,1,0,1}]=3 approach did, without having checked).
But some toy example of the slowdown would be useful to proceed further...
EDIT: I just tried
test[length_] := Block[{f},
Do[
f[RandomInteger[{0, 10}, 100]] = RandomInteger[0, 10];,
{i, 1, length}
];
f[{0, 0, 0, 0, 1, 7, 0, 3, 7, 8, 0, 4, 5, 8, 0, 8, 6, 7, 7, 0, 1, 6,
3, 9, 6, 9, 2, 7, 2, 8, 1, 1, 8, 4, 0, 5, 2, 9, 9, 10, 6, 3, 6,
8, 10, 0, 7, 1, 2, 8, 4, 4, 9, 5, 1, 10, 4, 1, 1, 3, 0, 3, 6, 5,
4, 0, 9, 5, 4, 6, 9, 6, 10, 6, 2, 4, 9, 2, 9, 8, 10, 0, 8, 4, 9,
5, 5, 9, 7, 2, 7, 4, 0, 2, 0, 10, 2, 4, 10, 1}] // timeIt
]
with timeIt defined to accurately time even short runs as follows:
timeIt::usage = "timeIt[expr] gives the time taken to execute expr,
repeating as many times as necessary to achieve a total time of \
1s";
SetAttributes[timeIt, HoldAll]
timeIt[expr_] := Module[{t = Timing[expr;][[1]], tries = 1},
While[t < 1.,
tries *= 2;
t = Timing[Do[expr, {tries}];][[1]];
];
Return[t/tries]]
and then
out = {#, test[#]} & /# {10, 100, 1000, 10000, 100000, 100000};
ListLogLogPlot#out
(also for larger runs). So it seems constant time here.
Suppose you enter your information not like
f[{1,0,0,0}] = 1
f[{0,1,0,0}] = 2
but into a n1 x n2 x n3 x n4 matrix m like
m[[2,1,1,1]] = 1
m[[1,2,1,1]] = 2
etc.
(you could even enter values not as f[{1,0,0,0}]=1, but as f[{1,0,0,0},1] with
f[li_List, i_Integer] := Part[m, Apply[Sequence, li + 1]] = i;
f[li_List] := Part[m, Apply[Sequence, li + 1]];
where you have to initialize m e.g. by m = ConstantArray[0, {4, 4, 4, 4}];)
Let's compare timings:
testf[z_] :=
(
Do[ f[{n1, n2, n3, n4}] = RandomInteger[{1,100}], {n1,z}, {n2,z}, {n3,z},{n4,z}];
First[ Timing[ Do[ f[{n2, n4, n1, n3}], {n1, z}, {n2, z}, {n3, z}, {n4, z} ] ] ]
);
Framed[
ListLinePlot[
Table[{z, testf[z]}, {z, 22, 36, 2}],
PlotLabel -> Row[{"DownValue approach: ",
Round[MemoryInUse[]/1024.^2],
" MB needed"
}],
AxesLabel -> {"n1,n2,n3,n4", "time/s"},ImageSize -> 500
]
]
Clear[f];
testf2[z_] :=
(
m = RandomInteger[{1, 100}, {z, z, z, z}];
f2[ni__Integer] := m[[Sequence ## ({ni} + 1)]];
First[ Timing[ Do[ f2[{n2, n4, n1, n3}], {n1, z}, {n2, z}, {n3, z}, {n4, z}] ] ]
)
Framed[
ListLinePlot[
Table[{z, testf2[z]}, {z, 22, 36, 2}],
PlotLabel -> Row[{"Matrix approach: ",
Round[MemoryInUse[]/1024.^2],
" MB needed"
}],
AxesLabel -> {"n1,n2,n3,n4", "time/s"}, ImageSize -> 500
]
]
gives
So for larger sets up information a matrix approach seems clearly preferrable.
Of course, if you have truly large data, say more GB than you have RAM, then you just
have to use a database and DatabaseLink.
Given a list of integers like {2,1,1,0} I'd like to list all permutations of that list that are not equivalent under given group. For instance, using symmetry of the square, the result would be {{2, 1, 1, 0}, {2, 1, 0, 1}}.
Approach below (Mathematica 8) generates all permutations, then weeds out the equivalent ones. I can't use it because I can't afford to generate all permutations, is there a more efficient way?
Update: actually, the bottleneck is in DeleteCases. The following list {2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 0, 0, 0} has about a million permutations and takes 0.1 seconds to compute. Apparently there are supposed to be 1292 orderings after removing symmetries, but my approach doesn't finish in 10 minutes
removeEquivalent[{}] := {};
removeEquivalent[list_] := (
Sow[First[list]];
equivalents = Permute[First[list], #] & /# GroupElements[group];
DeleteCases[list, Alternatives ## equivalents]
);
nonequivalentPermutations[list_] := (
reaped = Reap#FixedPoint[removeEquivalent, Permutations#list];
reaped[[2, 1]]
);
group = DihedralGroup[4];
nonequivalentPermutations[{2, 1, 1, 0}]
What's wrong with:
nonequivalentPermutations[list_,group_]:= Union[Permute[list,#]& /# GroupElements[group];
nonequivalentPermutations[{2,1,1,0},DihedralGroup[4]]
I don't have Mathematica 8, so I can't test this. I just have Mathematica 7.
I got an elegant and fast solution from Maxim Rytin, relying on ConnectedComponents function
Module[{gens, verts, edges},
gens = PermutationList /# GroupGenerators#DihedralGroup[16];
verts =
Permutations#{2, 2, 2, 2, 2, 2, 2, 1, 1, 0, 0, 0, 0, 0, 0, 0};
edges = Join ## (Transpose#{verts, verts[[All, #]]} &) /# gens;
Length#ConnectedComponents#Graph[Rule ### Union#edges]] // Timing