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}
Given a character or a string s, generate a result string with n (an integer) repeats of s
Given a list of characters or strings, and a list of the frequencies of their appearance (in correspondence), generate a result string with each string in the list repeated with the desired times as specified in the second list and StringJoin them together. For example, given {"a", "b", "c"} and {1,0,3}, I want to have "accc".
I of course want to have the most efficient way of doing these. Otherwise, my own way is too ugly and slow.
Thank you for your help!
rep[s_String, n_] := StringJoin[ConstantArray[s, n]]
then
rep["f", 3]
(*fff*)
next
chars = {"a", "b", "c"};
freqs = {1, 0, 3};
StringJoin[MapThread[rep, {chars, freqs}]]
gives "accc"
For 1, Table will do what you need.
s = "samplestring";
StringJoin[Table[s, {3}]]
"samplestringsamplestringsamplestring"
But acl's answer using ContantArray is faster, if you care about the last 1/100th second.
Do[StringJoin[Table[s, {30}]];, {10000}] // Timing
{0.05805, Null}
Do[StringJoin[ConstantArray[s, 30]];, {10000}] // Timing
{0.033306, Null}
Do[StringJoin[Table[s, {300}]];, {10000}] // Timing
{0.39411, Null}
Do[StringJoin[ConstantArray[s, 300]];, {10000}] // Timing
{0.163103, Null}
For 2, MapThread will handle cases where the second list is known to be non-negative integers.
StringJoin #
MapThread[Table[#1, {#2}] &, {{"a", "b", "c"} , {1, 0, 3}}]
"accc"
If the second list contains negative integers, these are treated as zeros.
Non-integer elements in the second list are treated as if they are the integer part. I am not sure if this is what you want.
StringJoin #
MapThread[Table[#1, {#2}] &, {{"a", "b", "c"} , {1, 0, 3.7}}]
"accc"
Knowing your application I propose using Inner:
sets = {{0, 0, 0, 4}, {0, 0, 1, 3}, {0, 1, 0, 3}, {0, 1, 1, 2}, {0, 2, 0, 2},
{0, 2, 1, 1}, {1, 0, 0, 3}, {1, 0, 1, 2}, {1, 1, 0, 2}, {1, 1, 1, 1},
{1, 2, 0, 1}, {1, 2, 1, 0}, {2, 0, 0, 2}, {2, 0, 1, 1}, {2, 1, 0, 1},
{2, 1, 1, 0}, {2, 2, 0, 0}};
chars = {"a", "b", "c", "d"};
Inner[ConstantArray[#2, #] &, sets, chars, StringJoin]
{"dddd", "cddd", "bddd", "bcdd", "bbdd", "bbcd", "addd", "acdd",
"abdd", "abcd", "abbd", "abbc", "aadd", "aacd", "aabd", "aabc", "aabb"}
I would like your help on something,
I have a Table:
InitialMatrix[x_, y_, age_, disease_] :=
ReplacePart[Table[Floor[Divide[dogpopulation/cellsno,9]], {x}, {y}, {age}, {disease}],
{{_, _, 1, _} -> 0, {_, _, 3, _} -> 6}];
I was trying to set up a condition to change all the values inside the table to sumthing else, according to a value, I tried:
listInitial={};
For[a = 1, a < 4, a++,
For[b = 1, b < 4, b++,
For[x = 1, x < 4, x = x + 1,
For[z = 1, z < 4, z = z + 1,
listInitial =
If[Random[] > psurvival,
ReplacePart[ InitialMatrix[3, 3, 3, 3], {a, b, x, z} ->
InitialMatrix[3, 3, 3, 3][[a]][[b]][[x]][[z]] - 1],
InitialMatrix[3, 3, 3, 3], {a, b, x, z} ->
InitialMatrix[3, 3, 3, 3][[a]][[b]][[x]][[z]]]]]]]
but it only changes the last part of my table, finally I decided to use the following code instead of the for loop,
SetAttributes[myFunction, Listable]
myFunction[x_] :=
If[Random[] > psurvival, If [x - 1 < 0 , x , x - 1], x]
myFunction[InitialMatrix[3, 3, 3, 3]] // TableForm
but now I want to change specific parts inside the table, for example I want all the part
{__,__,3,_} to change I tried to choose the range with MapAt but again I think I need to do a loop, and I cannot, can any one please help me?
For[x = 1, x < 4, x++,
listab[MapAt[f, InitialMatrix[3, 3, 3, 3], {x, 3, 3}]//TableForm]]
If you check out the documentation for MapAt, you will see that you can address multiple elements at various depths of your tensor, using various settings of the third argument. Note also the use of Flatten's second argument. I think this is what you are looking for.
MapAt[g, InitialMatrix[3, 3, 3, 3],
Flatten[Table[{i, j, 3, k}, {i, 3}, {j, 3}, {k, 3}], 2]]
http://reference.wolfram.com/mathematica/ref/MapAt.html
http://reference.wolfram.com/mathematica/ref/Flatten.html
Since this seems to be your second attempt to ask a question involving a really complicated For loop, may I just emphasise that you almost never need a For or Do loop in Mathematica in the circumstances where you would use one in, say, Fortran or C. Certainly not for most construction of lists. Table works. So do things like Listable functions (which I know you know) and commands like NestList, FoldList and Array.
You will probably also find this tutorial useful.
http://reference.wolfram.com/mathematica/tutorial/SelectingPartsOfExpressionsWithFunctions.html
I used the following code as an answer, I am not sure whether is the best solution or not, but it works!!
InitialTable[x_, y_, z_, w_] :=
MapAt[g,ReplacePart[
InitialMatrix[3, 3, 3, 3] +
ReplacePart[
Table[If[RandomReal[] > psurvival, -1,
0], {3}, {3}, {3}, {3}], {{_, _, 1, _} -> 0, {_, _, 2, _} ->
0}], {{_, _, 1, 2} -> 0, {_, _, 1, 3} -> 0}],
Flatten[Table[{i, j, 3, l}, {i, x}, {j, y}, {l, w}], 2]];
g[x_] := If[x < 0, 0, x];
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}} *)
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.