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}} *)
Related
I have a matrix Inter[i,j] whose each element has a set of rows with 3 columns each.
for eg. Inter[15,40]= {{0,0,0},{1,1,3}}, Inter[32,64]={{0,0,0},{1,1,3},{2,2,3}} and so on
Now i want a matrix MaxGG[i,j] by picking a row from Inter[i,j] that has maximum value at the first place.
for eg MaxGG[15,40] should give me {1,1,3}. similarly MaxGG[32,64]={2,2,3}.
When i am giving this code,it does not give me the right answer:
MaxGG[i_, j_] := Cases[Inter[i, j], {Max#Inter[i, j][[All, 1]], _, _}];
Please suggest me what is wrong with this code and please provide me with the correct code for this.
Thanks in advance :)
The main problem is that Cases will return a list of all matching cases :-
Inter[15, 40] = {{0, 0, 0}, {1, 1, 3}};
Inter[32, 64] = {{0, 0, 0}, {1, 1, 3}, {2, 2, 3}};
MaxGG[i_, j_] := Cases[Inter[i, j], {Max#Inter[i, j][[All, 1]], _, _}]
MaxGG[32, 64]
{{2, 2, 3}}
You can lose the outer brackets by selecting the first match :-
MaxGG[i_, j_] := First#Cases[Inter[i, j], {Max#Inter[i, j][[All, 1]], _, _}]
MaxGG[32, 64]
{2, 2, 3}
The function can also be simplified :-
MaxGG[i_, j_] := First#Reverse#Sort#Inter[i, j]
MaxGG[32, 64]
{2, 2, 3}
Let
n=2^10 3^7 5^4...31^2...59^2 61...97
be the factorization of an integer such that the powers of primes are non-increasing.
I would like to write a code in Mathematica to find Min and Max of prime factor of n such that they have the same power.
for example I want a function which take r(the power) and give (at most two) primes in general. A specific answer for the above sample is
minwithpower[7]=3
maxwithpower[7]=3
minwithpower[2]=31
maxwithpower[2]=59
Any idea please.
Let n = 91065388654697452410240000 then
FactorInteger[n]
returns
{{2, 10}, {3, 7}, {5, 4}, {7, 4}, {31, 2}, {37, 2}, {59, 2}, {61, 1}, {97, 1}}
and the expression
Cases[FactorInteger[n], {_, 2}]
returns only those elements from the list of factors and coefficients where the coefficient is 2, ie
{{31, 2}, {37, 2}, {59, 2}}
Next, the expression
Cases[FactorInteger[n], {_, 2}] /. {{min_, _}, ___, {max_, _}} -> {min, max}
returns
{31, 59}
Note that this approach fails if the power you are interested in only occurs once in the output from FactorInteger, for example
Cases[FactorInteger[n], {_, 7}] /. {{min_, _}, ___, {max_, _}} -> {min, max}
returns
{{3, 7}}
but you should be able to fix that deficiency quite easily.
One solution is :
getSamePower[exp_, n_] := With[{powers =
Select[ReleaseHold[n /. {Times -> List, Power[a_, b_] -> {a, b}}], #[[2]] ==
exp &]},
If[Length[powers] == 1, {powers[[1, 1]], powers[[1, 1]]}, {Min[powers[[All, 1]]], Max[powers[[All, 1]]]}]]
to be used as :
getSamePower[7, 2^10 3^7 5^4 \[Pi]^1 31^2 E^1 59^2 61^1 I^1 97^1 // HoldForm]
(* {3, 3} *)
getSamePower[2, 2^10 3^7 5^4 \[Pi]^1 31^2 E^1 59^2 61^1 I^1 97^1 // HoldForm]
(* {31, 59} *)
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.
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.
I have a TSV file with many columns like so;
genename X1 X100 X103 X105 X115 X117 X120 X122 X123
Gene20728 0.415049 0.517868 0.820183 0.578081 0.30997 0.395181
I would like to import it into Mathematica, and then extract and sort a column.
i.e., I want to extract column ["X117"] and sort it, and output the sorted list.
table = Import["file.csv", "Table"];
x117 = Drop[table[[All, 7]], 1];
sorted = Sort[x117];
I do not think there is a built in method of achieving the smart structure you seem to be asking for.
Below is the what I think is the most straight forward implementation out of the various possible methods.
stringdata = "h1\th2\n1\t2\n3\t4\n5"
h1 h2
1 2
5 4
3
Clear[ImportColumnsByName];
ImportColumnsByName[filename_] :=
Module[{data, headings, columns, struc},
data = ImportString[filename, "TSV"];
headings = data[[1]];
columns = Transpose[PadRight[data[[2 ;; -1]]]];
MapThread[(struc[#1] = #2) &, {headings, columns}];
struc
]
Clear[test];
test = ImportColumnsByName[stringdata];
test["h1"]
test["h2"]
Sort[test["h1"]]
outputs:
{1, 3, 5}
{2, 4, 0}
{1, 3, 5}
Building on ragfield's solution, this is a more dynamic method, however every call to this structure makes a call to Position and Part.
Clear[ImportColumnsByName];
ImportColumnsByName[filename_] := Module[{data, temp},
data = PadRight#ImportString[filename, "Table"];
temp[heading_] :=
Rest[data[[All, Position[data[[1]], heading][[1, 1]]]]];
temp
]
Clear[test];
test = ImportColumnsByName[stringdata];
test["h1"]
test["h2"]
Sort[test["h1"]]
outputs:
{1, 3, 5}
{2, 4, 0}
{1, 3, 5}
Starting from ragfield's code:
table = Import["file.csv", "Table"];
colname = "X117"
x117 = Drop[table[[All, Position[tb[[1, All]], colname]//Flatten]],
1]//Flatten;
sorted = Sort[x117];
For processing Excel files from various sites I do variations on this:
data = {{"h1", "h2"}, {1, 2}, {3, 4}, {5, ""}};
find[x_String] := Cases[Transpose[data], {x, __}]
In[]=find["h1"]
Out[]={{"h1", 1, 3, 5}}
If it is ragged sort of data you can usually pad it readily enough to make it suitable for transposing. Additionally some of my sources are lazy with formatting, sometimes headers change case, sometimes there is an empty row before the header, and so on:
find2[x_String,data_List] :=
Cases[Transpose[data], {___,
y_String /;
StringMatchQ[StringTrim[y], x, IgnoreCase -> True], __}]
In[]=find2["H1",data]
Out[]={{"h1", 1, 3, 5}}
data2 = {{"", ""}, {"H1 ", "h2"}, {1, 2}, {3, 4}, {5, ""}};
In[]=find2["h1",data2]
Out[]={{,"H1 ", 1, 3, 5}}