I'm hoping someone might be able to show me a more efficient way of writing my code in mathematica.
I've got a table which has a column of (absolute) times and a second column containing a string associated with that the period of time between the time on the same row and the time on the row below. These times are all regularly spaced. I also have a second list of irregular times and I want to have a list of the strings that would be associated with that time period.
I've done it using this code:
regulartime={{1800,a},{3600,b},{5400,b}}
irregtime={2054,2817,3060,4594, 5123}
flooredtimes=Floor[irregtime,1800]
position=Table[Position[regulartime,flooredtimes[[i]]],{i,Length[flooredtimes]}]
lastlist=Table[regulartime[[position[[i,1,1]],2]],{i,Length[flooredtimes]}]
This outputs a list {a,a,a,b,b} which I can then combine with my list of irregular times. My problem is that I am trying to do it for long (~500 000) lists and it takes a long time, is there a better way to do this?? Thanks in advance for any help!
here are two ideas..
Function[ ireg,
Last#Last#
Select[regulartime, #[[1]] == Floor[ireg, 1800] &]] /# irregtime
(*{a, a, a, b, b}*)
Last#regulartime[[Floor[#, 1800]/1800]] & /# irregtime
(*{a, a, a, b, b}*)
Here is a variation on george's second method:
regulartime[[Quotient[#, 1800], 2]] & /# irregtime
{a, a, a, b, b}
Be aware that you will get an error with values less than 1800; you may want to handle that separately:
time[x_ /; x >= 1800] := regulartime[[Quotient[x, 1800], 2]]
time[else_] := Missing[]
time /# {356, 3060, 4594}
{Missing[], a, b}
Related
I have got a list
list = Row[{#}] & /# Range[100]
and I want to apply function f to the following elements:
sublist = Row[{5 #}] & /# Range[20]
It is easy when I specify indexes I want to transform. For instance,
MapAt[f, list, {{1}, {5}}]
works OK. As soon as I create a new list and use it as "Part":
h = Row[{5 #}] & /# Range[20];
MapAt[f, list, h]
it fails. I suppose that the crux of the problem is using # simultaneously in two arrays - list and h, but I am new to Mathematica and can't figure it out. Is there any way to work with arrays of arbitrary length?
MapAt needs a plain list, not items wrapped in Row. If you omit Row from h it works. Note your function f is applied to Row[{5}], not just {5}. Are you sure you need to use Row at all?
I have a defined function and a set of points I am looking to get numerical results from when applied to my function. I have looked around online and not seen a method that will run my code and give decimal answers.
P0:= 3000
t0:= 63072000
Pd[t_]:=0.0622*P0*(t^-0.02 - (t0 + t)^-0.02)
pts = {86400, 604800, 2678400, 31536000}
For context I am trying to calculate the decay heat from a nuclear system following its shutdown at various times.
What you are searching for is the Map function
Map[f,expr] or f/#expr
applies f to each element on the first level in expr.
Thus:
In[1]:= Map[f, {a, b, c, d, e}]
Out[1]= {f[a], f[b], f[c], f[d], f[e]}
or alternatively:
In[1]:= f /# {a, b, c, d, e}
Out[1]= {f[a], f[b], f[c], f[d], f[e]}
I aim to calculate and preserve the results from the maximization of a function with two arguments and one exogenous parameter, when the maximum can not be derived (in closed form) by maximize. For instance, let
f[x_,y_,a_]=Max[0,Min[a-y,1-x-y]
be the objective function where a is positive. The maximization shall take place over [0,1]^2, therefore I set
m[a_]=Maximize[{f[x, y, a], 0 <= x <= 1 && 0 <= y <= 1 && 0 <= a}, {x,y}]
Obviously m can be evaluated at any point a and it is therefore possible to plot the maximizing x by employing
Plot[x /. m[a][[2]], {a, 0.01, 1}]
As I need to do several plots and further derivations containing the optimal solutions x and y (which of course are functions of a), i would like to preserve/save the results from the optimization for further use. Is there an elegant way to do this, or do I have to write some kind of loop to extract the values myself?
Now that I've seen the full text of your comment on my original comment, I suspect that you do understand the differences between Set and SetDelayed well enough. I think what you may be looking for is memoisation, sometimes implemented a bit like this;
f[x_,y_] := f[x,y] = Max[0,Min[a-y,1-x-y]]
When you evaluate, for example f[3,4] for the first time it will evaluate to the entire expression to the right of the :=. The rhs is the assignment f[3,4] = Max[0,Min[a-y,1-x-y]]. Next time you evaluate f[3,4] Mathematica already has a value for it so doesn't need to recompute it, it just recalls it. In this example the stored value would be Max[0,Min[a-4,-6]] of course.
I remain a little uncertain of what you are trying to do so this answer may not be any use to you at all.
Simple approach
results = Table[{x, y, a} /. m[a][[2]], {a, 0.01, 1, .01}]
ListPlot[{#[[3]], #[[1]]} & /# results, Joined -> True]
(The Set = is ok here so long as 'a' is not previosly defined )
If you want to utilise Plot[]s automatic evaluation take a look at Reap[]/Sow[]
{p, data} = Reap[Plot[x /. Sow[m[a]][[2]], {a, 0.01, 1}]];
Show[p]
(this takes a few minutes as the function output is a mess..).
hmm try this again: assuming you want x,y,a and the minimum value:
{p, data} = Reap[Plot[x /. Sow[{a, m[a]}][[2, 2]], {a, 0.01, .1}]];
Show[p]
results = {#[[1]], x /. #[[2, 2]], y /. #[[2, 2]], #[[2, 1]]} & /# data[[1]]
BTW Your function appears to be independent of x over some ranges which is why the plot is a mess..
I spend a lot of time looking at larger matrices (10x10, 20x20, etc) which usually have some structure, but it is difficult to quickly determine the structure of them as they get larger. Ideally, I'd like to have Mathematica automatically generate some representation of a matrix that will highlight its structure. For instance,
(A = {{1, 2 + 3 I}, {2 - 3 I, 4}}) // StructureForm
would give
{{a, b}, {Conjugate[b], c}}
or even
{{a, b + c I}, {b - c I, d}}
is acceptable. A somewhat naive implementation
StructureForm[M_?MatrixQ] :=
MatrixForm # Module[
{pos, chars},
pos = Reap[
Map[Sow[Position[M, #1], #1] &, M, {2}], _,
Union[Flatten[#2, 1]] &
][[2]]; (* establishes equality relationship *)
chars = CharacterRange["a", "z"][[;; Length # pos ]];
SparseArray[Flatten[Thread /# Thread[pos -> chars] ], Dimensions[M]]
]
works only for real numeric matrices, e.g.
StructureForm # {{1, 2}, {2, 3}} == {{a, b}, {b, c}}
Obviously, I need to define what relationships I think may exist (equality, negation, conjugate, negative conjugate, etc.), but I'm not sure how to establish that these relationships exist, at least in a clean manner. And, once I have the relationships, the next question is how to determine which is the simplest, in some sense? Any thoughts?
One possibility that comes to mind is for each pair of elements generate a triple relating their positions, like {{1,2}, Conjugate, {2,1}} for A, above, then it becomes amenable to graph algorithms.
Edit: Incidentally, my inspiration is from the Matrix Algorithms series (1, 2) by Stewart.
We can start by defining the relationships that we want to recognize:
ClearAll#relationship
relationship[a_ -> sA_, b_ -> sB_] /; b == a := b -> sA
relationship[a_ -> sA_, b_ -> sB_] /; b == -a := b -> -sA
relationship[a_ -> sA_, b_ -> sB_] /; b == Conjugate[a] := b -> SuperStar[sA]
relationship[a_ -> sA_, b_ -> sB_] /; b == -Conjugate[a] := b -> -SuperStar[sA]
relationship[_, _] := Sequence[]
The form in which these relationships are expressed is convenient for the definition of structureForm:
ClearAll#structureForm
structureForm[matrix_?MatrixQ] :=
Module[{values, rules, pairs, inferences}
, values = matrix // Flatten // DeleteDuplicates
; rules = Thread[Rule[values, CharacterRange["a", "z"][[;; Length#values]]]]
; pairs = rules[[#]]& /# Select[Tuples[Range[Length#values], 2], #[[1]] < #[[2]]&]
; inferences = relationship ### pairs
; matrix /. inferences ~Join~ rules
]
In a nutshell, this function checks each possible pair of values in the matrix inferring a substitution rule whenever a pair matches a defined relationship. Note how the relationship definitions are expressed in terms of pairs of substitution rules in the form value -> name. Matrix values are assigned letter names, proceeding from left-to-right, top-to-bottom. Redundant inferred relationships are ignored assuming a precedence in that same order.
Beware that the function will run out of names after it finds 26 distinct values -- an alternate name-assignment strategy will be needed if that is an issue. Also, the names are being represented as strings instead of symbols. This conveniently dodges any unwanted bindings of the single-letter symbols names. If symbols are preferred, it would be trivial to apply the Symbol function to each name.
Here are some sample uses of the function:
In[31]:= structureForm # {{1, 2 + 3 I}, {2 - 3 I, 4}}
Out[31]= {{"a", "b"}, {SuperStar["b"], "d"}}
In[32]:= $m = a + b I /. a | b :> RandomInteger[{-2, 2}, {10, 10}];
$m // MatrixForm
$m // structureForm // MatrixForm
Have you tried looking at the eigenvalues? The eigenvalues reveal a great deal of information on the structure and symmetry of matrices and are standard in statistical analysis of datasets. For e.g.,
Hermitian/symmetric eigenvalues have
real eigenvalues.
Positive semi-definite matrices have
non-negative eigenvalues and vice versa.
Rotation matrices have complex eigenvalues.
Circulant matrices have eigenvalues that are simply the DFT of the first row. The beauty of circulant matrices is that every circulant matrix has the same set of eigenvectors. In some cases, these results (circulant) can be extended to Toeplitz matrices.
If you're dealing with matrices that are random (an experimental observation can be modeled as a random matrix), you could also read up on random matrix theory, which relates the distributions of eigenvalues to the underlying symmetries in the matrix and the statistical distributions of elements. Specifically,
The eigenvalue distribution of symmetric/hermitian Gaussian matrices is a [semicircle]
Eigenvalue distributions of Wishart matrices (if A is a random Gaussian matrix, W=AA' is a Wishart matrix) are given by the Marcenko-Pastur distribution
Also, the differences (spacings) between the eigenvalues also convey information about the matrix.
I'm not sure if the structure that you're looking for is like a connected graph within the matrix or something similar... I presume random matrix theory (which is more general and vast than those links will ever tell you) has some results in this regard.
Perhaps this is not really what you were looking for, but afaik, there is no one stop solution to getting the structure of a matrix. You'll have to use multiple tools to nail it down, and if I were to do it, eigenvalues would be my first pick.
What is the simplest way to map an arbitrarily funky nested list expr to a function unflatten so that expr==unflatten##Flatten#expr?
Motivation:
Compile can only handle full arrays (something I just learned -- but not from the error message), so the idea is to use unflatten together with a compiled version of the flattened expression:
fPrivate=Compile[{x,y},Evaluate#Flatten#expr];
f[x_?NumericQ,y_?NumericQ]:=unflatten##fPrivate[x,y]
Example of a solution to a less general problem:
What I actually need to do is to calculate all the derivatives for a given multivariate function up to some order. For this case, I hack my way along like so:
expr=Table[D[x^2 y+y^3,{{x,y},k}],{k,0,2}];
unflatten=Module[{f,x,y,a,b,sslot,tt},
tt=Table[D[f[x,y],{{x,y},k}],{k,0,2}] /.
{Derivative[a_,b_][_][__]-> x[a,b], f[__]-> x[0,0]};
(Evaluate[tt/.MapIndexed[#1->sslot[#2[[1]]]&,
Flatten[tt]]/. sslot-> Slot]&) ]
Out[1]= {x^2 y + y^3, {2 x y, x^2 + 3 y^2}, {{2 y, 2 x}, {2 x, 6 y}}}
Out[2]= {#1, {#2, #3}, {{#4, #5}, {#5, #7}}} &
This works, but it is neither elegant nor general.
Edit: Here is the "job security" version of the solution provided by aaz:
makeUnflatten[expr_List]:=Module[{i=1},
Function#Evaluate#ReplaceAll[
If[ListQ[#1],Map[#0,#1],i++]&#expr,
i_Integer-> Slot[i]]]
It works a charm:
In[2]= makeUnflatten[expr]
Out[2]= {#1,{#2,#3},{{#4,#5},{#6,#7}}}&
You obviously need to save some information about list structure, because Flatten[{a,{b,c}}]==Flatten[{{a,b},c}].
If ArrayQ[expr], then the list structure is given by Dimensions[expr] and you can reconstruct it with Partition. E.g.
expr = {{a, b, c}, {d, e, f}};
dimensions = Dimensions[expr]
{2,3}
unflatten = Fold[Partition, #1, Reverse[Drop[dimensions, 1]]]&;
expr == unflatten # Flatten[expr]
(The Partition man page actually has a similar example called unflatten.)
If expr is not an array, you can try this:
expr = {a, {b, c}};
indexes = Module[{i=0}, If[ListQ[#1], Map[#0, #1], ++i]& #expr]
{1, {2, 3}}
slots = indexes /. {i_Integer -> Slot[i]}
{#1, {#2, #3}}
unflatten = Function[Release[slots]]
{#1, {#2, #3}} &
expr == unflatten ## Flatten[expr]
I am not sure what you are trying to do with Compile. It is used when you want to evaluate procedural or functional expressions very quickly on numerical values, so I don't think it is going to help here. If repeated calculations of D[f,...] are impeding your performance, you can precompute and store them with something like
Table[d[k]=D[f,{{x,y},k}],{k,0,kk}];
Then just call d[k] to get the kth derivative.
I just wanted to update the excellent solutions by aaz and Janus. It seems that, at least in Mathematica 9.0.1.0 on Mac OSX, the assignment (see aaz's solution)
{i_Integer -> Slot[i]}
fails. If, however, we use
{i_Integer :> Slot[i]}
instead, we succeed. The same holds, of course, for the ReplaceAll call in Janus's "job security" version.
For good measure, I include my own function.
unflatten[ex_List, exOriginal_List] :=
Module[
{indexes, slots, unflat},
indexes =
Module[
{i = 0},
If[ListQ[#1], Map[#0, #1], ++i] &#exOriginal
];
slots = indexes /. {i_Integer :> Slot[i]};
unflat = Function[Release[slots]];
unflat ## ex
];
(* example *)
expr = {a, {b, c}};
expr // Flatten // unflatten[#, expr] &
It might seem a little like a cheat to use the original expression in the function, but as aaz points out, we need some information from the original expression. While you don't need it all, in order to have a single function that can unflatten, all is necessary.
My application is similar to Janus's: I am parallelizing calls to Simplify for a tensor. Using ParallelTable I can significantly improve performance, but I wreck the tensor structure in the process. This gives me a quick way to reconstruct my original tensor, simplified.