TOC notebooku

ListPlot - puntíky a spojnice

Vyplnění polárního grafu

Graf s legendou

Pěkná 3 D kostka

Jinak udělané obrázkování

Tvorba paletky

Definování funkce z tabulky bodů

Úprava velikosti ticků na osách

Tvary čísel a exponentů

Černobílý density plot

Otevírání souborů

Manipulace s prvky matice

Průniky ploch ve 3 D

Otevření webové stránky

TOCForNotebook[]

TOC notebooku

Clear[TOCForNotebook];
TOCForNotebook[]:=Module[{nbr,data,cells,nb},nb=EvaluationNotebook[];
SetOptions[nb,System`CreateCellID->True];
SelectionMove[nb,All,Notebook,AutoScroll->False];
NotebookWrite[nb,NotebookRead[nb]];
NotebookFind[nb,"Section",All,CellStyle];
nbr=NotebookRead[nb];
data=nbr/.{Cell[x_,"Section",___,z:(CellID->w_),___]:>{x,w}};
cells=TextCell[Button[TextCell[#[[1]],"Hyperlink"],NotebookFind[EvaluationNotebook[],#[[2]],All,CellID],Appearance->"Frameless"],"Text"]&/@data;
cells=First[ToBoxes[#]]&/@cells;
SelectionMove[EvaluationNotebook[],Before,Notebook,AutoScroll->True];
NotebookWrite[nb,cells];]

ListPlot - puntíky a spojnice

points={1,2,3};
g1=ListPlot[points,PlotMarkers->{Automatic,Large}];g2=ListPlot[points,Joined->True];Show[{g1,g2}]

Vyplnění polárního grafu

formula[m_,n1_,n2_,n3_]=Function[{x},(Cos[(m x)/4]^n2+Sin[(m x)/4]^n3)^(-1/n1)];vals={{3,5,18,18},{2,1,4,8},{3,3,14,2},{7,2,8,4}};Table[PolarPlot[(formula@@v)[x],{x,-Pi,Pi},PlotRange->All,Axes->None,PlotStyle->Directive[{Lighter[Green,.6],EdgeForm[Gray]}],ImageSize->{100,100}]/.Line->Polygon,{v,vals}]//GraphicsColumn

http://demonstrations.wolfram.com/SuperellipseShapes/

Graf s legendou

Je tam ale nějaká chybka

n=2
YourList=Table[{x,x^2},{x,0,8,1}]
ShowLegend[ListPlot[{YourList},Joined->True,InterpolationOrder->n,PlotStyle->{Directive[Blue,Dashed]},Frame->True,FrameLabel->{"X Axis Label (in Units)","Y Axis Label (in Units)"},GridLines->{Automatic,Automatic},GridLinesStyle->{Directive[Black],Directive[Green,Dashed]},Background->LightYellow,ImageSize->400,BaseStyle->{FontSize->12,FontWeight->"Bold"}],{{{Graphics[{Directive[Blue,Dashed],Line[{{0,0},{3,0}}]}],"Legend Description"}},LegendSize->{1,0.2},LegendPosition->{-0.4,-0.2},BaseStyle->{FontSize->12,FontWeight->"Bold"},LegendTextOffset->{-0.5,0}}]

Pěkná 3 D kostka

txt[myText_,position_]:=Text[Style[myText,FontFamily->"Times",FontSize->28,FontWeight->"Bold",FontSlant->"Italic",FontColor->Black],position]

With[{y=0.85},Graphics3D[{EdgeForm[{Thick,Black}],LightGray,Opacity[0.7],Polygon[{{0,0,0},{1,0,0},{1,y,0},{0,y,0},{0,0,0}}],Opacity[0.7],Polygon[{{1,0,0},{1,y,0},{1,y,1},{1,0,1},{1,0,0}}],Polygon[{{0,0,1},{1,0,1},{1,y,1},{0,y,1},{0,0,1}}],Polygon[{{0,y,0},{1,y,0},{1,y,1},{0,1 y,1},{0,y,0}}],Polygon[{{0,0,0},{0,y,0},{0,y,1},{0,0,1},{0,0,0}}],{Thick,Dashed,Line[{{1,y,0},{0.75,y,0}}],Line[{{0,y,1},{0,y,0.8}}]},txt["y",{1,0.35,0.95}],txt["y",{1.105,0.35,0.1}],txt["x",{0.6,0.7,1.1}],txt["x",{1.12,0.6,0.65}]},Boxed->False,Lighting->"Neutral",ViewPoint->{1,-2,0.75}]]

Jinak udělané obrázkování

img=Import["http://www.informatik.uni-ulm.de/ni/Lehre/WS01/CV2/bilder/lena.tif"];

ipgray=ListInterpolation[img[[1,1]]];grayData[p1_,p2_]:=Module[{rMax,t},rMax=Sqrt[#.#]&[p1-p2];
Table[{t*rMax,ipgray@@(p1*(1-t)+p2*t)},{t,0,1,1/rMax}]//N]

Manipulate[DynamicModule[{dta,xr,yr,ny,nx,orig},{ny,nx}=Dimensions[img[[1,1]]];
{xr,yr}=Transpose[{p1,p2}];
xr=Min[Max[#,1],nx]&/@xr;
yr=Min[Max[#,1],ny]&/@yr;
{p1,p2}=Transpose[{xr,yr}];
dta=grayData[p1,p2];
orig=dta[[1,1]];
dta=#-orig&/@dta;
Graphics[{img[[1]],{RGBColor[1,0,0],Line[{p1,p2}]},{RGBColor[0,1,0],GeometricTransformation[Line[dta],AffineTransform[{RotationMatrix[ArcTan@@(p2-p1)],p1}]]}}]],{{p1,{1,1}},Locator},{{p2,{64,64}},Locator}]

Tvorba paletky

I have created buttons that simultaneously change the Evaluatable option and a visible attribute of the cell and put the buttons in a palette that is always on my screen.Of course, if you change Evaluatable from the menu, the cells appearance will change in sync, so you always have to use the buttons to turn it on or off.I have found that changing the Opacity of the cell to 50 % works well when I set Evaluatable -> False.It lets me see the syntax highlighting and the dim appearance makes it clear that it does nothing (well, it looks dim on a Mac.On Windows XP, it just looks a little foggy.) Here is the code for creating the two buttons : EvaluateButton = Button["Cell Evaluatable", SelectionMove[SelectedNotebook[], All, Cell]; SetOptions[NotebookSelection[InputNotebook[]], Evaluatable -> True, Opacity -> 1];, Appearance -> "Palette", ImageSize -> Small];

NotEvaluateButton = Button["Cell Not Evaluatable", SelectionMove[SelectedNotebook[], All, Cell]; SetOptions[NotebookSelection[InputNotebook[]], Evaluatable -> False, Opacity -> 0.5];, Appearance -> "Palette", ImageSize -> Small];

In both cases, the button function makes sure that the whole cell is selected, then sets Evaluatable and Opacity.Put these buttons in a Grid[] and use CreatePalette[], then save the resulting palette.

Definování funkce z tabulky bodů

y={14,18.7,9,4.1,6.7,6,6.3,8.4,4,2.9};x=Range[0,Length@y];
f[z_]:=Piecewise[Table[{y[[i]],x[[i]]<z<x[[i+1]]},{i,Length@y}]];

T=(-First@x+Last@x);
co[n_]=2 Integrate[f[t] Cos[n 2 π t/T],{t,First@x,Last@x}]/T;
si[n_]=2 Integrate[f[t] Sin[n 2 π t/T],{t,First@x,Last@x}]/T;
A0=Integrate[f[t],{t,First@x,Last@x}]/T;approx[t_]:=A0+Sum[co[k] Cos[k 2 π t/T]+si[k] Sin[k 2 π t/T],{k,10}];
Plot[{f[t],approx[t]},{t,First@x,Last@x}]

Úprava velikosti ticků na osách

Vyžaduje package CustomTicks

<<"CustomTicks`"

ticksize:=0.02
smallticksize:=0.01
aspectratio:=0.8
padratio:=1.5

XTicks[a_,b_,opts___]:=LinTicks[a,b,MajorTickLength->{ticksize,0},MinorTickLength->{smallticksize,0},opts]
YTicks[a_,b_,opts___]:=LinTicks[a,b,MajorTickLength->{ticksize/aspectratio,0},MinorTickLength->{smallticksize/aspectratio,0},opts]

EmptyXTicks[a_,b_]:=XTicks[a,b,ShowTickLabels->False] EmptyYTicks[a_,b_]:=YTicks[a,b,ShowTickLabels->False]

SetOptions[Plot,Frame->True,AspectRatio->aspectratio,FrameTicks->{{XTicks,EmptyXTicks},{YTicks,EmptyYTicks}},PlotRangePadding->{Scaled[padratio*ticksize],Scaled[padratio*ticksize/aspectratio]}];
Plot[x,{x,0,π}]

Tvary čísel a exponentů

p = {22026.465794806718`,4.851651954097903`*^8,1.0686474581524463`*^13,2.3538526683702`*^17,5.184705528587072`*^21,173845955435493737/50000}
(*číslo bez vědeckého tvaru*)
NumberForm[N[p[[6]],20],Infinity,ExponentFunction->(Null&)]

(*čísla s exponenty v násobcích 3 *) 
NumberForm[p,5,ExponentFunction->(3Quotient[#,3]&)]

(*totéž jinak*)
myNumberForm[x_,decimalPlaces_: 2]:=If[decimalPlaces<1,Round[x],ToString[IntegerPart[x]]<>"."<>ToString[Round[FractionalPart[x]*10^decimalPlaces]]];

x=173845955435493737/50000;

myNumberForm[x,5]

Černobílý density plot

f[x_,y_]:=Sin[x*y];

Plot3D[f[x,y],{x,-Pi,Pi},{y,-Pi,Pi}]

DensityPlot[Boole[f[x,y]<0],{x,-Pi,Pi},{y,-Pi,Pi},ColorFunction->GrayLevel]

Otevírání souborů

{FileNameSetter[Dynamic[f]],Dynamic[f]}

nebo

Button["Open notebook",NotebookOpen[SystemDialogInput["FileOpen","C:\\Dokumenty\\"]]]

nebo

filename="*.*";

Button["Load...",If[#=!=$Canceled,filename=#;]&[SystemDialogInput["FileOpen",filename,WindowTitle->"Load..."]],Method->"Queued"]

Manipulace s prvky matice

data={{1,2,3},{2,3,4},{3,4,5}};
Most/@data
data[[All,{1,2}]]
Part[#,{1,2}]&/@data
Delete[#,-1]&/@data
Take[#,2]&/@data
Last/@data
data[[All,3]]
Part[#,3]&/@data
Drop[#,2]&/@data
Take[#,-1]&/@data
Delete[#,{{1},{2}}]&/@data

Průniky ploch ve 3 D

plot1=RegionPlot3D[x y z<1,{x,-5,5},{y,-5,5},{z,-5,5},PlotStyle->Directive[Yellow,Opacity[0.5]],Mesh->None];
slice1=ContourPlot3D[y==2*x-4,{x,-5,5},{y,-5,5},{z,-5,5},Mesh->False,BoxRatios->{1,1,1},AspectRatio->1];Show[plot1,slice1]

teleso=RegionPlot3D[x+ y+ z<1,{x,-5,5},{y,-5,5},{z,-5,5},PlotStyle->Directive[Yellow,Opacity[0.5]],Mesh->None];
rez1=ContourPlot3D[y==2*x-4+3z,{x,-5,5},{y,-5,5},{z,-5,5},Mesh->False,BoxRatios->{1,1,1},AspectRatio->1];Show[teleso,rez1]

Otevření webové stránky

FrontEndExecute[{FrontEnd`NotebookLocate[{URL["www.panska.cz"],None}]}]

nebo

NotebookLocate[{URL["www.panska.cz"],None}]