Mathematica 教學: BagPlot

<< ComputationalGeometry`


leq[ptstemp_List]:= Block[{pts=ptstemp,slope,x,y},

If[Abs[pts[[2,1]]-pts[[1,1]]]<10^-9,x==pts[[1,1]],

y==(pts[[2,2]]-pts[[1,2]])/(pts[[2,1]]-pts[[1,1]])*(x-pts[[1,1]])

+pts[[1,2]]]]

bagscheme[{sourcetemp_List,ptstemp_List}]:= 

Block[{source=sourcetemp,pts=ptstemp,ch,temp,newlineeq,

newpts,x,y,newch,newchpts},

ch=Quiet@ConvexHull@Flatten[{source,pts},1];

temp=source[[#]]&/@Select[ch,#<=Length@source&];

source=source[[#]]&/@Complement[Range[Length@source],

Select[ch,#<=Length@source&]];

newlineeq=Flatten[{{{#[[1]],#[[-2]]},{#[[-1]],#[[2]]}},

{{#[[1]],#[[3]]},{#[[-1]],#[[2]]}}}&/@

Table[RotateLeft[temp,i],{i,0,Length@temp-1}],1];

newpts={x,y}/.Solve[leq[#]&/@#,{x,y}][[1]]&/@newlineeq;

N@{source,newpts}]

car=Import["http://netstat.stat.tku.edu.tw/downfile.php?file=samples/car.csv"];

cardata=car[[All,{4, 6}]][[2;;61]];

mybag=NestWhileList[bagscheme,{cardata,{}},

Length@#[[1]]>Length[cardata]/2&,1];

mybagcontour[i_]:=Tally[Flatten[mybag[[-i]],1]][[All,1]][[#]]&/@

(Quiet@ConvexHull@Tally[Flatten[mybag[[-i]],1]][[All,1]]);

ListPlot[cardata,Axes->False,Frame->True,AspectRatio->1, 
PlotRange->All,
Epilog->{{Blue,Opacity[0.25],
Polygon[cardata[[#]]&/@Flatten[{##,
First@##}&/@{Quiet@ConvexHull@cardata}]]},
{Blue,Opacity[0.5],EdgeForm[Thick],
Polygon[Insert[mybagcontour[1],mybagcontour[1][[1]],-1]]},
Red,Opacity[1],PointSize[0.0125],Point@cardata,
Black,PointSize[0.0275],Point@Quiet@ConvexHullMedian@cardata}]

Tags: Mathematica

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