Related
I have thousands of vectors that represent waveforms, each of those waveforms is representative of a particular sample. I would like to be able to perform an operation on each of those samples and have the output associated with the name of that sample. I have found some information about keys in Mathematica but I can't get them to work correctly. A very simplified example is below. Suppose I have three vectors with 5 elements in each. I could represent this as a matrix in Mathematica as follows:
InputSamples={{1,3,5,6,8}->"SampleA",{7,9,10,45,20}->"SampleB",{90,43,2,1,0}->"SampleC"};
Now suppose I want to do some calculation on each of the samples.
I might choose:
Map[Total,InputSamples]
Now I would want my output to be:
{{SampleA,23},{SampleB,91},{SampleC,136}}
But instead I get:
{{1+SampleA,3+SampleA,5+SampleA,6+SampleA,8+SampleA},{7+SampleB,9+SampleB,10+SampleB,45+SampleB,20+SampleB},{90+SampleC,43+SampleC,2+SampleC,1+SampleC,0+SampleC}}
How can I get this to give the output shown above that I would like or something similar to it?
You get what you ask for with this
InputSamples={{1,3,5,6,8}->"SampleA",{7,9,10,45,20}->"SampleB",{90,43,2,1,0}->"SampleC"};
Map[{#[[2]],Total[#[[1]]]}&,InputSamples]
which instantly returns
{{SampleA,23},{SampleB,91},{SampleC,136}}
Be careful with that and test this method before depending on it
It is not the usual "try to write everything as punctuation characters" style, but this
ruletotal[list_->name_]:={name,Total[list]};
Map[ruletotal,InputSamples]
accomplishes the same thing and might give you some ideas how to do similar tasks in the future.
Some other options
MapAt[Total, InputSamples, {All, 1}]
(* {23 -> "SampleA", 91 -> "SampleB", 136 -> "SampleC"} *)
List ### MapAt[Total, InputSamples, {All, 1}]
(* {{23, "SampleA"}, {91, "SampleB"}, {136, "SampleC"}} *)
InputSamples // Association // KeyMap[Total]
(* <|23 -> "SampleA", 91 -> "SampleB", 136 -> "SampleC"|> *)
InputSamples // Association // KeyMap[Total] // AssociationMap[Reverse]
(* <|"SampleA" -> 23, "SampleB" -> 91, "SampleC" -> 136|> *)
How can one extract the coordinates of all the points which make up the following graphics (here just an example)?
spl = BSplineCurve[{{-.4, -.3}, {0, -.6}, {.4, -.3}, {0, -1.2}},
SplineClosed -> True] ;
Graphics[{Red, Thick, spl}]
The problem is that if I add //FullForm to the last line there is no point coordinates in the output, so no pattern to use to make that extraction:
With a Plotor CoutourPlot output I would have coded Flatten[Cases[Normal#output, Line[x_] :> x, Infinity], 1]
which is not possible here.
The b-spline is itself a graphics primitive so you cant pull out the "line" like that.
You need to use the related BSplineFunction to generate your points:
pts=BSplineFunction[{{-.4, -.3}, {0, -.6}, {.4, -.3}, {0, -1.2}},
SplineClosed -> True] /# Range[0, 1, .01];
Graphics#Line#pts
If you need to extract from a graphic you can do this:
Cases[graphics, BSplineCurve[a__] :> BSplineFunction[a], Infinity]
but you still need to feed it a table of parameter values to get your points.
To extract just the control points you can go:
curveData=Cases[graphics, BSplineCurve[a__] :> a, Infinity]
how many BSplineCurves were found in the graphic?
Length[curveData]
here are the control points of one of them
curveData// First // MatrixForm
If you have a list of BSplineFunctions you can find out much more
so first convert the BSplineCurves to BSplineFunctions as the previous post
bfs =Cases[graphics, BSplineCurve[a__] :> BSplineFunction[a], Infinity]
then you could just go
Inputform[bfs]
and parse the result, but it is cleaner to go:
cdata = Cases[bfs, BSplineFunction[a__] :> a, Infinity];
d = Partition[cdata, 9];
This is Mathematica 11. other versions may need different partitioning
each element of d will be something like:
d[[1]] // MatrixForm
1
{{0.,1.}}
{3}
{False}
{{{0.,0.,0.},{0.,298.986,167.077},{0.,497.083,497.459},{0.,503.603,839.898}},Automatic}
{{0.,0.,0.,0.,1.,1.,1.,1.}}
{0}
MachinePrecision
Unevaluated
The 5th element contains the control point coordinates. The sixth corresponds to the knots. The other elements look familiar but let us not post our guesses!
I often have a list of pairs, as
data = {{0,0.0},{1,12.4},{2,14.6},{3,25.1}}
and I want to do something, for instance Rescale, to all of the second elements without touching the first elements. The neatest way I know is:
Transpose[MapAt[Rescale, Transpose[data], 2]]
There must be a way to do this without so much Transposeing. My wish is for something like this to work:
MapAt[Rescale, data, {All, 2}]
But my understanding is that MapAt takes Position-style specifications instead of Part-style specifications. What's the proper solution?
To clarify,
I'm seeking a solution where I don't have to repeat myself, so lacking double Transpose or double [[All,2]], because I consider repetition a signal I'm not doing something the easiest way. However, if eliminating the repetition requires the introduction of intermediate variables or a named function or other additional complexity, maybe the transpose/untranspose solution is already correct.
Use Part:
data = {{0, 0.0}, {1, 12.4}, {2, 14.6}, {3, 25.1}}
data[[All, 2]] = Rescale # data[[All, 2]];
data
Create a copy first if you need to. (data2 = data then data2[[All, 2]] etc.)
Amending my answer to keep up with ruebenko's, this can be made into a function also:
partReplace[dat_, func_, spec__] :=
Module[{a = dat},
a[[spec]] = func # a[[spec]];
a
]
partReplace[data, Rescale, All, 2]
This is quite general is design.
I am coming late to the party, and what I will describe will differ very little with what #Mr. Wizard has, so it is best to consider this answer as a complementary to his solution. My partial excuses are that first, the function below packages things a bit differently and closer to the syntax of MapAt itself, second, it is a bit more general and has an option to use with Listable function, and third, I am reproducing my solution from the past Mathgroup thread for exactly this question, which is more than 2 years old, so I am not plagiarizing :)
So, here is the function:
ClearAll[mapAt,MappedListable];
Protect[MappedListable];
Options[mapAt] = {MappedListable -> False};
mapAt[f_, expr_, {pseq : (All | _Integer) ..}, OptionsPattern[]] :=
Module[{copy = expr},
copy[[pseq]] =
If[TrueQ[OptionValue[MappedListable]] && Head[expr] === List,
f[copy[[pseq]]],
f /# copy[[pseq]]
];
copy];
mapAt[f_, expr_, poslist_List] := MapAt[f, expr, poslist];
This is the same idea as what #Mr. Wizard used, with these differences: 1. In case when the spec is not of the prescribed form, regular MapAt will be used automatically 2. Not all functions are Listable. The solution of #Mr.Wizard assumes that either a function is Listable or we want to apply it to the entire list. In the above code, you can specify this by the MappedListable option.
I will also borrow a few examples from my answer in the above-mentioned thread:
In[18]:= mat=ConstantArray[1,{5,3}];
In[19]:= mapAt[#/10&,mat,{All,3}]
Out[19]= {{1,1,1/10},{1,1,1/10},{1,1,1/10},{1,1,1/10},{1,1,1/10}}
In[20]:= mapAt[#/10&,mat,{3,All}]
Out[20]= {{1,1,1},{1,1,1},{1/10,1/10,1/10},{1,1,1},{1,1,1}}
Testing on large lists shows that using Listability improves the performance, although not so dramatically here:
In[28]:= largemat=ConstantArray[1,{150000,15}];
In[29]:= mapAt[#/10&,largemat,{All,3}];//Timing
Out[29]= {0.203,Null}
In[30]:= mapAt[#/10&,largemat,{All,3},MappedListable->True];//Timing
Out[30]= {0.094,Null}
This is likely because for the above function (#/10&), Map (which is used internally in mapAt for the MappedListable->False (default) setting, was able to auto-compile. In the example below, the difference is more substantial:
ClearAll[f];
f[x_] := 2 x - 1;
In[54]:= mapAt[f,largemat,{All,3}];//Timing
Out[54]= {0.219,Null}
In[55]:= mapAt[f,largemat,{All,3},MappedListable->True];//Timing
Out[55]= {0.031,Null}
The point is that, while f was not declared Listable, we know that its body is built out of Listable functions, and thus it can be applied to the entire list - but OTOH it can not be auto-compiled by Map. Note that adding Listable attribute to f would have been completely wrong here and would destroy the purpose, leading to mapAt being slow in both cases.
How about
Transpose[{#[[All, 1]], Rescale[#[[All, 2]]]} &#data]
which returns what you want (ie, it does not alter data)
If no Transpose is allowed,
Thread[Join[{#[[All, 1]], Rescale[#[[All, 2]]]} &#data]]
works.
EDIT: As "shortest" is now the goal, best from me so far is:
data\[LeftDoubleBracket]All, 2\[RightDoubleBracket] = Rescale[data[[All, 2]]]
at 80 characters, which is identical to Mr.Wizard's... So vote for his answer.
Here is another approach:
op[data_List, fun_] :=
Join[data[[All, {1}]], fun[data[[All, {2}]]], 2]
op[data, Rescale]
Edit 1:
An extension from Mr.Wizard, that does not copy it's data.
SetAttributes[partReplace, HoldFirst]
partReplace[dat_, func_, spec__] := dat[[spec]] = func[dat[[spec]]];
used like this
partReplace[data, Rescale, All, 2]
Edit 2:
Or like this
ReplacePart[data, {All, 2} -> Rescale[data[[All, 2]]]]
This worked for me and a friend
In[128]:= m = {{x, sss, x}, {y, sss, y}}
Out[128]= {{2, sss, 2}, {y, sss, y}}
In[129]:= function[ins1_] := ToUpperCase[ins1];
fatmap[ins2_] := MapAt[function, ins2, 2];
In[131]:= Map[fatmap, m]
Out[131]= {{2, ToUpperCase[sss], 2}, {y, ToUpperCase[sss], y}}
Some types of objects have special input/output formatting in Mathematica. This includes Graphics, raster images, and, as of Mathematica 8, graphs (Graph[]). Unfortunately large graphs may take a very long time to visualize, much longer than most other operations I'm doing on them during interactive work.
How can I prevent auto-layout of Graph[] objects in StandardForm and TraditionalForm, and have them displayed as e.g. -Graph-, preferably preserving the interpretability of the output (perhaps using Interpretation?). I think this will involve changing Format and/or MakeBoxes in some way, but I was unsuccessful in getting this to work.
I would like to do this in a reversible way, and preferably define a function that will return the original interactive graph display when applied to a Graph object (not the same as GraphPlot, which is not interactive).
On a related note, is there a way to retrieve Format/MakeBoxes definitions associated with certain symbols? FormatValues is one relevant function, but it is empty for Graph.
Sample session:
In[1]:= Graph[{1->2, 2->3, 3->1}]
Out[1]= -Graph-
In[2]:= interactiveGraphPlot[%] (* note that % works *)
Out[2]= (the usual interactive graph plot should be shown here)
Though I do not have Mathematica 8 to try this in, one possibility is to use this construct:
Unprotect[Graph]
MakeBoxes[g_Graph, StandardForm] /; TrueQ[$short] ^:=
ToBoxes#Interpretation[Skeleton["Graph"], g]
$short = True;
Afterward, a Graph object should display in Skeleton form, and setting $short = False should restore default behavior.
Hopefully this works to automate the switching:
interactiveGraphPlot[g_Graph] := Block[{$short}, Print[g]]
Mark's concern about modifying Graph caused me to consider the option of using $PrePrint. I think this should also prevent the slow layout step from taking place. It may be more desirable, assuming you are not already using $PrePrint for something else.
$PrePrint =
If[TrueQ[$short], # /. _Graph -> Skeleton["Graph"], #] &;
$short = True
Also conveniently, at least with Graphics (again I cannot test with Graph in v7) you can get the graphic with simply Print. Here, shown with Graphics:
g = Plot[Sin[x], {x, 0, 2 Pi}]
(* Out = <<"Graphics">> *)
Then
Print[g]
I left the $short test in place for easy switching via a global symbol, but one could leave it out and use:
$PrePrint = # /. _Graph -> Skeleton["Graph"] &;
And then use $PrePrint = . to reset the default functionality.
You can use GraphLayout option of Graph as well as graph-constructors to suppress the rendering. A graph can still be visualized with GraphPlot. Try the following
{gr1, gr2, gr3} = {RandomGraph[{100, 120}, GraphLayout -> None],
PetersenGraph[10, 3, GraphLayout -> None],
Graph[{1 -> 2, 2 -> 3, 3 -> 1}, GraphLayout -> None]}
In order to make working easier, you can use SetOptions to set GraphLayout option to None for all graph constructors you are interested in.
Have you tried simply suppressing the output? I don't think that V8's Graph command does any layout, if you do so. To explore this, we can generate a large list of edges and compare the timings of graph[edges];, Graph[edges];, and GraphPlot[edges];
In[23]:= SeedRandom[1];
edges = Union[Rule ### (Sort /#
RandomInteger[{1, 5000}, {50000, 2}])];
In[25]:= t = AbsoluteTime[];
graph[edges];
In[27]:= AbsoluteTime[] - t
Out[27]= 0.029354
In[28]:= t = AbsoluteTime[];
Graph[edges];
In[30]:= AbsoluteTime[] - t
Out[30]= 0.080434
In[31]:= t = AbsoluteTime[];
GraphPlot[edges];
In[33]:= AbsoluteTime[] - t
Out[33]= 4.934918
The inert graph command is, of course, the fastest. The Graph command takes much longer, but no where near as long as the GraphPlot command. Thus, it seems to me that Graph is not, in fact, computing the layout, as GraphPlot does.
The logical question is, what is Graph spending it's time on. Let's examine the InputForm of Graph output in a simple case:
Graph[{1 -> 2, 2 -> 3, 3 -> 1, 1 -> 4}] // InputForm
Out[123]//InputForm=
Graph[{1, 2, 3, 4},
{DirectedEdge[1, 2],
DirectedEdge[2, 3],
DirectedEdge[3, 1],
DirectedEdge[1, 4]}]
Note that the vertices of the graph have been determined and I think this is what Graph is doing. In fact, the amount of time it took to compute Graph[edges] in the first example, comparable to the fastest way that I can think to do this:
Union[Sequence ### edges]; // Timing
This took 0.087045 seconds.
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.