I occasionally use Mathematica to create animated graphs with parameters that I can change in real time as the animation runs. I find this is particularly effective to demonstrate the behavior of physical systems for students. An example Mathematica for one of the simpler animations is:
freq = 100*^6
lambda = 3*^8/freq
alpha = 0
TLineLength = 10*lambda
AmplitudePlus = 2
PhasePlus = (2*Pi/180)*0
AmplitudeMinus = AmplitudePlus*0.5
PhaseMinus = (2*Pi/180)*0
GammaL = 0
Manipulate[Plot[AmplitudePlus*Cos[2*Pi*freq *t - (2*Pi/lambda)*z + PhasePlus]*
Exp[-alpha*(TLineLength + z)], {z, -TLineLength, 0},
PlotRange -> AmplitudePlus, AxesLabel -> {z [m], SuperPlus[V]}], {t,
0, 10/freq}, {PhasePlus, 0, 2*Pi}, {alpha, 0, 1/(2*lambda)}]
I would love to do this in ipython notebooks instead of Mathematica. I have tried using interact similar to the answers to this question, but interact does not support animations as far as I've been able to determine. Also, generated graphs have a lot of flicker as you move a slider widget to control a parameter. I've also tried FuncAnimate, but have been entirely unsuccessful getting this to run inline in an ipython notebook (which I'm running on mac OS X 10.9). Even if I could get it to run, I wouldn't be able to change any parameters in real time as the animation runs. I would welcome advice or suggestions.
Related
I'm trying to get a Mathematica example working. It's the one on Theo Gray's blog. In Mathematica 9.0 It doesn't work. I already have search the answer on stackoverflow in mathematica 8.0 . I use the code that heike gave.
imagePool =Map[With[{i = Import[#]}, {i, N#Mean[Flatten[ImageData[i], 1]]}] &,FileNames["/Users/xunyanan/Desktop/webwx_img/*.jpg"]];
closeMatch[c_] :=RandomChoice[Nearest[imagePool[[All, 2]] -> imagePool[[All, 1]], c, 20]]
ImageAssemble[Map[closeMatch, ImageData[Import["/Users/xunyanan/Desktop/me.tif"]], {2}]]
I think it almost run successfully。
The response screenshot:
when I clicked “Show Full Output”. I would get the result as below or Mathematica 9.0 exit off-normal
The screenshot:
I use Mathematica 9.0 right now, have not the experience.so Can anyone suggest a version of this code that works for Mathematica 9? I am appreciated that you can give me some suggest.
Thanks you guys to edit this question.
My PC ENV : mac OS X version 10.9 and Mathematica 9.0
As the comments note, your problem is because the images you're using for the imagePool are not all the same number of channels, and that's upsetting the Nearest function. Probably the easy way to fix this is:
imagePool = Map[With[{i = Import[#]}, {i,
N#Mean[Flatten[ImageData[RemoveAlphaChannel[i]], 1]]}] &,
FileNames["*.png", "/tmp"]]
i.e. to apply RemoveAlphaChannel when you import the images. It would be sensible to apply the same precaution to your source image as well.
Spot the difference:
Before (without RemoveAlphaChannel):
After:
Occasionally it would be preferable to have some initialization code for palettes (of buttons). For example, it could define some functions that are used by palette buttons.
What is the easiest and preferable way to define/run initialization code for a palette?
The initialization can run either when the palette is loaded or when any button is pressed for the first time (possible issue: what if the kernel is restarted after the palette was loaded?)
The definitions should be somehow localized (i.e. in their own context -- do unique notebook contexts help here?)
If possible, I'd prefer a minimal effort solution (i.e. extra code at the fewest possible places, self contained palette file with no extra package files, palette creation using the existing convenience tools of palettes menu or CreatePalette, etc.)
(You can assume that the initialization code runs fast, e.g. it consists of definitions only)
You're right to be concerned about the visibility of the Dynamic being an issue. The way to absolutely guarantee a Dynamic expression to be evaluated regardless of the visibility of any of the individual cells is to use NotebookDynamicExpression. Here's an example that illustrates NotebookDynamicExpression working while a Dynamic fails because it's hidden within a closed cell group:
cell1 = First # MakeBoxes[
TextCell["Click to open", "Title",
CellMargins -> 0, System`WholeCellGroupOpener -> True],
StandardForm];
cell2 = First # MakeBoxes[
ExpressionCell[DynamicWrapper["hidden cell", Print["DynamicWrapper"]]],
StandardForm];
CreatePalette[
Notebook[{Cell[CellGroupData[{cell1, cell2}, Closed]]},
NotebookDynamicExpression :>
Dynamic[Refresh[Print["NotebookDynamicExpression"], None]]]]
When you evaluate this, note that the Dynamic in NotebookDynamicExpression evaluates immediately. The DynamicWrapper never evaluates until you open the cell group, which you can do by clicking on the "Click to open" text.
In this example, incidentally, notice that I wrapped the NotebookDynamicExpression with Refresh. The function Refresh[#, None]& will make sure that the code evaluates only once -- when the notebook is first opened. Otherwise, the code would obey the standard properties of Dynamic and evaluate whenever any of the dependencies change.
NotebookDynamicExpression has been around since v6, but was only documented in v8. Also documented are its related cousins, CellDynamicExpression and FrontEndDynamicExpression.
A DynamicBox with Initialization is capable of the basic function. You can size the palette such that the object is not visible, and it will still operate.
Here is code for a small sample palette. It sets a value for var. The active code is offset with whitespace.
(* Beginning of Notebook Content *)
Notebook[{
Cell[BoxData[{
TagBox[GridBox[{
{
ButtonBox["\<\"TSV\"\>",
Appearance->Automatic,
ButtonFunction:>None,
Evaluator->Automatic,
Method->"Preemptive"]},
{
ButtonBox["\<\"CSV\"\>",
Appearance->Automatic,
ButtonFunction:>None,
Evaluator->Automatic,
Method->"Preemptive"]},
{
ButtonBox["\<\"Table\"\>",
Appearance->Automatic,
ButtonFunction:>None,
Evaluator->Automatic,
Method->"Preemptive"]}
},
GridBoxAlignment->{"Columns" -> {{Left}}},
GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
"Column"], "\[IndentingNewLine]",
DynamicBox[Null,
Initialization :> ($CellContext`var = "It is done, Master.")
]
}], NotebookDefault,
CellMargins->{{0, 0}, {0, 0}},
CellBracketOptions->{"Color"->RGBColor[0.269993, 0.308507, 0.6]},
CellHorizontalScrolling->True,
PageBreakAbove->True,
PageBreakWithin->False,
ShowAutoStyles->True,
LineSpacing->{1.25, 0},
AutoItalicWords->{},
ScriptMinSize->9,
ShowStringCharacters->False,
FontFamily:>CurrentValue["PanelFontFamily"],
FontSize:>CurrentValue["PanelFontSize"]]
},
WindowSize->{55, 105},
WindowMargins->{{Automatic, 583}, {Automatic, 292}},
WindowFrame->"Palette",
WindowElements->{},
WindowFrameElements->{"CloseBox", "MinimizeBox"},
StyleDefinitions->"Palette.nb"
]
(* End of Notebook Content *)
I am trying to fix the Phase plot part of BodePlot, as it does not wrap correctly. And there is no option that I can use to tell it to wrap.
So, instead of doing the full plot myself, (I can do that if I have to) I am thinking of first making the BodePlot, grab the data points, do the wrapping on the data (once I get the x,y data, the rest is easy), then I need to put the new list of points back into the plot, and then use Show to display it.
The part I am stuck at, is extracting the points from FullForm. I can't get the correct Pattern to do that.
This is what I go to so far:
hz=z/(z^2-z+0.3);
tf=TransferFunctionModel[hz,z,SamplingPeriod->2];
phasePlot=BodePlot[tf,{0.001,2 Pi},
ScalingFunctions->{Automatic,{"Linear","Degree"}},PlotLayout->"List"][[2]]
You see how it does not wrap at 180 degrees. It is more common in dsp that Bode phase plot wraps. Here is what it 'should' look like:
So, this is what I did:
FullForm[phasePlot]
Graphics[List[
List[List[], List[],
List[Hue[0.67, 0.6, 0.6],
Line[List[List[0.0010000243495554542, -0.2673870119911639],
List[0.0013659538057574799, -0.36521403872250247],
List[0.0017318832619595053, -0.46304207336414027],
....
I see the data there (the x,y) But how to pull them out? I tried this:
Cases[FullForm[phasePlot], List[x_, y_] -> {x, y}, Infinity];
But the above matches in addition to the list of point, other stuff that I do not need.
I tried many other things, but can't get only the list of points out.
I was wondering if someone knows how to pull only the (x,y) points from the above plot. Is there a better way to do this other than using FullForm?
Thanks
Update:
I just find a post here which shows how to extract data from plot. So I used it:
points = Cases[Normal#phasePlot, Line[pts_] -> pts, Infinity]
You could do try nesting the replacement rules, for example
phase2 = phasePlot /.
Line[a_] :> (Line[a] /. {x_?NumericQ, y_?NumericQ} :> {x, Mod[y, 360, -180]});
Show[phase2, PlotRange -> {Automatic, {-180, 180}}, FrameTicks -> Automatic]
Output:
The list you are looking for appears to be wrapped by Line[], and it seems to be the only case in your plot. So you could use
Cases[phasePlot, Line[list_] :> list, Infinity]
Edit:
When I posted my response, the page refreshed and I saw that you came across precisely what I had proposed. I'll leave my response posted here anyway.
Edit2:
Szabolics pointed out that FullForm[] has no effect, so I removed it from my original posting.
According to the documentation AbsoluteOptions[expr,name] "gives the absolute setting for the option name".
"AbsoluteOptions gives the actual settings for options used internally by Mathematica when the setting given is Automatic or All."
Here is an example they show:
<< AbsoluteOptions[Plot[Sin[x], {x, 0, 2 Pi},
PlotRange -> Automatic], PlotRange]
>> {PlotRange -> {{0., 6.28319}, {-1., 1.}}}
Here I use << to denote Input and >> to denote output.
This seems to work fine. However, when I try to obtain the AspectRatio of a plot it simply gives me Automatic. Try this,
AbsoluteOptions[
ListPlot3D[{{1, 1, 1, 1}, {1, 2, 1, 2}, {1, 1, 3, 1}, {1, 2, 1, 4}},
AspectRatio -> Automatic],
AspectRatio
]
Similar format as the example they show but the output I get is simply
{AspectRatio->Automatic}
Does this mean that the argument expr can only be a Graphics object and not Graphics3D? This doesn't make sense because it works fine if I try to obtain the PlotRange of a Graphics3D object. Is this a bug or my mathematica is broken? Another thing could be that the documentation is not being very specific. Which one is it?
Here is a link to the documentation:
http://reference.wolfram.com/mathematica/ref/AbsoluteOptions.html
I'm using Mathematica 7.0.1.0.
You can apply ImageDimensions directly to Graphics3D to get its ImageSize.
It seems that AbsoluteOptions just was not modified since Mathematica 4 (see bottom of the corresponding documentation page). This function is very buggy (often gives wrong value for PlotRange for 2D graphics generated by Show, for example) and sometimes does not work at all as you pointed in your question. Compare it with FullOptions and FullGraphics those are seemed to be not modified since version 2... Sometimes FullOptions gives right value when AbsoluteOptions gives wrong or does not work at all.
Maybe, BoxRatios is the one you are looking for. HTH.
Is there a way to create Notebook in which each Initialization Cell will be auto-saved in its own .m-file with arbitrary name?
P.S. The question is related to the Mathematica program developed by Wolfram Research Inc. It is not about Mathematics or math.
I'm not sure if the following approach would satisfy you: I once wanted a way of generating compact notebooks containing only the initialisation cells found in my development notebook; the following code writes the initialization cells of the current notebook into a single new notebook and autosaves a .m file as a side-effect but it could easily be adapted to generate a separate notebook and .m file for each initialization cell.
In[162]:= nbToExtract = SelectedNotebook[]
In[163]:=
extractInitializationCells[nb_] :=
Block[{nbNew = CreateDocument[], count = 0},
(SelectionMove[nb, Next, Cell];
While[NotebookRead[nb] =!= {}, (If[InitializationCell /.
Options[NotebookSelection[nb], InitializationCell],
(count++;
NotebookWrite[nbNew, NotebookRead[nb]]), {}]; SelectionMove[nb, Next, Cell])];
Print[ToString[count] <> " initialization cell(s) found"];
CurrentValue[nbNew, AutoGeneratedPackage] = Automatic;
NotebookSave[nbNew, fn];
NotebookClose[nbNew];
Clear[nbNew](* just in case *))]
extractInitializationCells[nbToExtract]
This only extracts the initialisation cells below the cell in which the function extractInitializationCells is called. And I'd agree with the previous caveats about using the auto generation package mechanism. Also, CurrentValue is not protected indefinitely from backwards incompatibility but it has survived several major Mathematica versions so far.