Mathematica 教學 A broken heart

tt=Import["http://tinyurl.com/3m4awrv"];

ff[xx_]:=Cases[y/.NSolve[(y^2+xx^2-1)^3-y^2*xx^3==0, y], _Real][[-1]];

data={#, RandomReal[{-0.15, 0.25}]}&/@Range[-0.9, 0.9, 0.05];

m[de_]:={{Cos[de], -Sin[de]}, {Sin[de], Cos[de]}};

slope[pt_List]:=(pt[[2, 2]]-pt[[1, 2]])/(pt[[2, 1]]-pt[[1, 1]]);

pt=Partition[Flatten[{{#[[1]], Min[Max[#[[2]], -ff[#[[1]]]]*0.75, 
ff[#[[1]]]]*0.75}&/@data, {{1, 0}}}, 1], 2, 1];

eq=Piecewise[{slope[#]*(x-#[[1, 1]])+#[[1, 2]], #[[1, 1]]<=x<#[[2, 1]]}&/@pt];

bh1=RegionPlot[(y^2+x^2-1)^3-y^2x^3 < 0 && y < eq, {y, -1.5, 1.5}, {x, -1.5, 1.5}, 
PlotStyle->Texture[tt]];

bh2=RegionPlot[(y^2+x^2-1)^3-y^2x^3 < 0 && y > eq, {y, -1.5, 1.5}, {x, -1.5, 1.5}, 
PlotStyle->Texture[tt]];

Manipulate[Show[
bh1/.GraphicsComplex[a__, b__]:>GraphicsComplex[{-l, 0}+(#+{0, 1}).m[-z*Pi/10]&/@a, b], 
bh2/.GraphicsComplex[a__, b__]:>GraphicsComplex[{l, 0}+(#+{0, 1}).m[z*Pi/10]&/@a, b], 
PlotRange->{{-1.5, 1.5}, {-0.5, 2.5}}, Frame->False], 
{z, 0, 1, 0.1}, {l, 0, 0.3, 0.1}
]

Tags: Mathematica 教學

• 編輯文章
• 此文章網址
• 轉寄此文章
• 目前有0 意見