how to extract rows from matrix based on value in first entry? - wolfram-mathematica

This is another simple 'matrix' question in Mathematica. I want to show how I did this, and ask if there is a better answer.
I want to select all 'rows' from matrix based on value in the first column (or any column, I used first column here just as an example).
Say, find all rows where the entry in the first position is <=4 in this example:
list = {{1, 2, 3},
{4, 5, 8},
{7 , 8, 9}}
So, the result should be
{{1,2,3},
{4,5,8}}
Well, the problem is I need to use Position, since the result returned by Position can be used directly by Extract. (but can't be used by Part or [[ ]], so that is why I am just looking at Position[] ).
But I do not know how to tell Position to please restrict the 'search' pattern to only the 'first' column so I can do this in one line.
When I type
pos = Position[list, _?(# <= 4 &)]
it returns position of ALL entries which are <=4.
{{1, 1}, {1, 2}, {1, 3}, {2, 1}}
If I first get the first column, then apply Position on it, it works ofcourse
list = {{1, 2, 3},
{4, 5, 8},
{7 , 8, 9}};
pos = Position[list[[All, 1]], _?(# <= 4 &)]
Extract[list, pos]
--> {{1, 2, 3}, {4, 5, 8}}
Also I tried this:
pos = Position[list, _?(# <= 4 &)];
pos = Select[pos, #[[2]] == 1 &] (*only look at ones in the 'first' column*)
{{1, 1}, {2, 1}}--->
and this gives me the correct positions in the first column. To use that to find all rows, I did
pos = pos[[All, 1]] (* to get list of row positions*)
---> {1, 2}
list[[ pos[[1]] ;; pos[[-1]], All]]
{{1, 2, 3},
{4, 5, 8}}
So, to summarize, putting it all together, this is what I did:
method 1
list = {{1, 2, 3},
{4, 5, 8},
{7 , 8, 9}};
pos = Position[list[[All, 1]], _?(# <= 4 &)]
Extract[list, pos]
--> {{1, 2, 3}, {4, 5, 8}}
method 2
list = {{1, 2, 3},
{4, 5, 8},
{7 , 8, 9}}
pos = Position[list, _?(# <= 4 &)];
pos = Select[pos, #[[2]] == 1 &];
pos = pos[[All, 1]];
list[[ pos[[1]] ;; pos[[-1]], All]]
{{1, 2, 3},
{4, 5, 8}}
The above clearly is not too good.
Is method 1 above the 'correct' functional way to do this?
For reference, this is how I do the above in Matlab:
EDU>> A=[1 2 3;4 5 8;7 8 9]
A =
1 2 3
4 5 8
7 8 9
EDU>> A( A(:,1)<=4 , :)
1 2 3
4 5 8
I am trying to improve my 'functional' handling of working with matrices in Mathematica commands, this is an area I feel I am not good at working with lists. I find working with matrices easier for me.
The question is: Is there is a shorter/more functional way to do this in Mathematica?
thanks

You could use Pick[] as follows:
Pick[list, list[[All, 1]], _?(# <= 4 &)]

How about the following?
In[1]:= list = {{1, 2, 3}, {4, 5, 8}, {7, 8, 9}};
In[2]:= Select[list, First[#] <= 4 &]
Out[2]= {{1, 2, 3}, {4, 5, 8}}
Here's a loose translation of your matlab code:
list[[Flatten[Position[Thread[list[[All, 1]] <= 4], True]]]]
(of course, the Flatten would not be needed if I used Extract instead of Part).

There is a faster method than those already presented, using SparseArray. It is:
list ~Extract~
SparseArray[UnitStep[4 - list[[All, 1]]]]["NonzeroPositions"]
Here are speed comparisons with the other methods. I had to modify WReach's method to handle other position specifications.
f1[list_, x_] := Cases[list, {Sequence ## Table[_, {x - 1}], n_, ___} /; n <= 4]
f2[list_, x_] := Select[list, #[[x]] <= 4 &]
f3[list_, x_] := Pick[list, (#[[x]] <= 4 &) /# list]
f4[list_, x_] := Pick[list, UnitStep[4 - list[[All, x]]], 1]
f5[list_, x_] := Pick[list, Thread[list[[All, x]] <= 4]]
f6[list_, x_] := list ~Extract~
SparseArray[UnitStep[4 - list[[All, x]]]]["NonzeroPositions"]
For a table with few rows and many columns (comparing position 7):
a = RandomInteger[99, {250, 150000}];
timeAvg[#[a, 7]] & /# {f1, f2, f3, f4, f5, f6} // Column
0.02248
0.0262
0.312
0.312
0.2808
0.0009728
For a table with few columns and many rows (comparing position 7):
a = RandomInteger[99, {150000, 12}];
timeAvg[#[a, 7]] & /# {f1, f2, f3, f4, f5, f6} // Column
0.0968
0.1434
0.184
0.0474
0.103
0.002872

If you want the rows that meet the criteria, use Cases:
Cases[list, {n_, __} /; n <= 4]
(* {{1, 2, 3}, {4, 5, 8}} *)
If you want the positions within the list rather than the rows themselves, use Position instead of Cases (restricted to the first level only):
Position[list, {n_, __} /; n <= 4, {1}]
(* {{1}, {2}} *)

If you want to be very clever:
Pick[list, UnitStep[4 - list[[All, 1]]], 1]
This also avoids unpacking, which means it'll be faster and use less memory.

Related

binning an array to create sum domains array

In Mathematica - how do I bin an array to create a new array which consist from sum domains of the old array with a given size ???
Example:
thanks.
This is slightly simpler than #ChrisDegnen's solution. Given the same definition of array the expression
Map[Total, Map[Flatten, Partition[array, {2, 2}], {2}], {2}]
produces
{{4, 10}, {8, 10}}
If you prefer, this expression
Apply[Plus, Map[Flatten, Partition[array, {2, 2}], {2}], {2}]
uses Apply and Plus rather than Map and Total but is entirely equivalent.
This works for the example but a generalised version would need more work.
array =
{{1, 1, 1, 2},
{1, 1, 3, 4},
{2, 2, 2, 3},
{2, 2, 2, 3}};
Map[Total,
Map[Flatten,
Map[Transpose,
Map[Partition[#, 2] &, Partition[array, 2], 2],
2], {2}], {2}]
% // MatrixForm
4 10
8 10

How to insert a column into a matrix, the correct Mathematica way

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.

Add Constraints in a Conditional Query/Operation in Mathematica

I use the following function to perform a conditional operation on a List:
consider[data_, conditionCOL_, conditionVAL_, listOfCol_] :=
Select[data, (#[[conditionCOL]] == conditionVAL) &][[All, listOfCol]]
Considering the following example :
dalist = Join[Tuples[Range[4], 2]\[Transpose], {Range[16], Range[17, 32, 1]}
]\[Transpose];
I use the following to obtain the means of specific columns defined by the function.
This will output the means of entries of column 3 & 4 for which the corresponding entry in column 1 equals 2
Mean#consider[dalist, 1, 2, {3, 4}]
Now, I would like to add constraints/thresholds on the values to be averaged :
Average the values when they are:
Above minValue (e.g., 3)
Under maxValue (e.g., 25)
Below, an example is given of values the average value of which should be calculated under the above mentioned constraints.
Since it is not clear whether you want just to exclude the points outside of the limits from the averaging, or to decide whether or not to perform the averaging, I will address both questions. You can use the following functions to postprocess the results of your consider function (they are rather specific, based on your data format):
filter[data : {{_, _} ..}, {min_, max_}] :=
Select[data, min < #[[1]] < max && min < #[[2]] < max &]
dataWithinLimitsQ[data : {{_, _} ..}, {min_, max_}] :=
data == filter[data, {min, max}]
meanFiltered[data : {{_, _} ..}, {min_, max_}] :=
Mean#filter[data, {min, max}]
Here is how you can use them:
In[365]:= dalist=Join[Tuples[Range[4],2]\[Transpose],{Range[16],Range[17,32,1]}]\[Transpose]
Out[365]= {{1,1,1,17},{1,2,2,18},{1,3,3,19},{1,4,4,20},{2,1,5,21},{2,2,6,22},{2,3,7,23},
{2,4,8,24},{3,1,9,25},{3,2,10,26},{3,3,11,27},{3,4,12,28},{4,1,13,29},{4,2,14,30},{4,3,15,31},
{4,4,16,32}}
In[378]:= considered = consider[dalist,1,1,{3,4}]
Out[378]= {{1,17},{2,18},{3,19},{4,20}}
In[379]:= filter[considered,{2,21}]
Out[379]= {{3,19},{4,20}}
In[380]:= dataWithinLimitsQ[considered,{2,21}]
Out[380]= False
In[381]:= meanFiltered[considered,{2,21}]
Out[381]= {7/2,39/2}
I would use Cases:
inRange[data_, {min_, max_}] := Cases[data, {__?(min < # < max &)}, 1]
This form also accepts data with an arbitrary number of columns.
dat = {{1, 2, 0}, {6, 7, 4}, {6, 7, 7}, {4, 5, 6}, {4, 5, 3}, {9, 7, 1}, {0, 3, 7}, {6, 2, 1}}
inRange[dat, {2, 7}]
(* Out = {{4, 5, 6}, {4, 5, 3}} *)

Changing values in nested lists according to elements in the list

I have a list of pairs of values in mathematica, for example List= {{3,1},{5,4}}.
How do I change the first element (3 & 5) if the second element does not reach a threshold. For example, if the second parts are below 2 then i wish the first parts to go to zero. so that list then = {{0,1},{5,4}}. Some of these lists are extremely long so manually doing it is not an option, unfortunately.
Conceptually, the general way is to use Map. In your case, the code would be
In[13]:= lst = {{3, 1}, {5, 4}}
Out[13]= {{3, 1}, {5, 4}}
In[14]:= thr = 2
Out[14]= 2
In[15]:= Map[{If[#[[2]] < thr, 0, #[[1]]], #[[2]]} &, lst]
Out[15]= {{0, 1}, {5, 4}}
The # symbol here stands for the function argument. You can read more on pure functions here. Double square brackets stand for the Part extraction. You can make it a bit more concise by using Apply on level 1, which is abbreviated by ###:
In[27]:= {If[#2 < thr, 0, #], #2} & ### lst
Out[27]= {{0, 1}, {5, 4}}
Note however that the first method is several times faster for large numerical lists. An even faster, but somewhat more obscure method is this:
In[29]:= Transpose[{#[[All, 1]]*UnitStep[#[[All, 2]] - thr], #[[All, 2]]}] &[lst]
Out[29]= {{0, 1}, {5, 4}}
It is faster because it uses very optimized vectorized operations which apply to all sub-lists at once. Finally, if you want the ultimate performance, this procedural compiled to C version will be another factor of 2 faster:
fn = Compile[{{lst, _Integer, 2}, {threshold, _Real}},
Module[{copy = lst, i = 1},
For[i = 1, i <= Length[lst], i++,
If[copy[[i, 2]] < threshold, copy[[i, 1]] = 0]];
copy], CompilationTarget -> "C", RuntimeOptions -> "Speed"]
You use it as
In[32]:= fn[lst, 2]
Out[32]= {{0, 1}, {5, 4}}
For this last one, you need a C compiler installed on your machine.
Another alternative: Apply (###, Apply at level 1) and Boole (turns logical values in 1's and 0's):
lst = {{3, 1}, {5, 4}};
{#1 Boole[#2 >= 2], #2} & ### lst
An alternative approach might be to use substitution rules, and attach a condition (/;)
lst = {{3, 1}, {5, 4}};
lst /. {x_, y_ /; y < 2} -> {0, y}
output:
{{0, 1}, {5, 4}}
Assuming that your matrix is 2x2 and by second elemnt you mean the second row:
This should work:
If[A[[2, 1]] < 2 || A[[2, 2]] < 2, A[[2,1]] = 0 ]; A
You may have to change the variables, since your questions is kind of confusing. But that's the idea ;-)

Optimising the game of life

I'm writing a game of life program in mathematica however there is a caveat in that I need to be able to apply the reproduction rules to some percentage of the cells, I want to try a new method using MapAt but liveNeighbors doesn't work elementwise, and I can't think of a way of fixing it without doing exactly what I did before (lots of messy indexing), does anyone have any suggestions? (I am assuming this will be more efficient then the old method, which is listed below, if not please let me know, I am just a beginner!).
What I am trying to do:
Map[ArrayPlot,FixedPointList[MapAt[update[#,liveNeighbors[#]]&,#,coords]&,Board, 1]]
What I have done already:
LifeGame[ n_Integer?Positive, steps_] := Module [{Board, liveNeighbors, update},
Board = Table [Random [Integer], {n}, {n}];
liveNeighbors[ mat_] :=
Apply[Plus,Map[RotateRight[mat,#]&,{{-1,-1},{-1, 0},{-1,1}, {0, -1}, {0, 1}, {1, -1}, {1, 0}, {1, 1}}]];
update[1, 2] := 1;
update[_, 3] := 1;
update[ _, _] := 0;
SetAttributes[update, Listable];
Seed = RandomVariate[ProbabilityDistribution[0.7 UnitStep[x] + 0.3 UnitStep[x - 1], {x, 0, 1, 1}], {n, n}];
FixedPointList[Table[If[Seed[[i, j]] == 1,update[#[[i, j]], liveNeighbors[#][[i, j]]],#[[i, j]]], {i, n}, {j, n}]&, Board, steps]]]
Thanks!
In[156]:=
LifeGame2[n_Integer?Positive, steps_] :=
Module[{Board, liveNeighbors, update},
Board = RandomInteger[1, {n, n}];
liveNeighbors[mat_] :=
ListConvolve[{{1, 1, 1}, {1, 0, 1}, {1, 1, 1}},
ArrayPad[mat, 1, "Periodic"]];
SetAttributes[update, Listable];
Seed = RandomVariate[BernoulliDistribution[0.3], {n, n}];
update[0, el_, nei_] := el;
update[1, 1, 2] := 1;
update[1, _, 3] := 1;
update[1, _, _] := 0;
FixedPointList[MapThread[update, {Seed, #, liveNeighbors[#]}, 2] &,
Board, steps]
]
This implementation does the same as yours, except is quite a lot faster:
In[162]:= AbsoluteTiming[
res1 = BlockRandom[SeedRandom[11]; LifeGame[20, 100]];]
Out[162]= {6.3476347, Null}
In[163]:= Timing[BlockRandom[Seed[11]; LifeGame2[20, 100]] == res1]
Out[163]= {0.047, True}
Assuming you don't have to roll your own code for a homework problem, have you considered just using the built-in CellularAutomaton function?
Straight from the documentation, the 2D CA rule:
GameOfLife = {224, {2, {{2, 2, 2}, {2, 1, 2}, {2, 2, 2}}}, {1, 1}};
And iterate over a 100x100 grid for 100 steps:
ArrayPlot[CellularAutomaton[GameOfLife, RandomInteger[1, {100, 100}], {{{100}}}]]
It would at least give you a baseline for a speed comparison.
Instead of MapAt, you could use Part with the Span syntax to replace a whole subarray at once:
a = ConstantArray[0, {5, 5}];
a[[2 ;; 4, 2 ;; 4]] = {{1, 2, 3}, {4, 5, 6}, {7, 8, 9}}
HTH!
Here you have my golfed version.

Resources