Stats

Popular Posts

Followers

Mathematica 教學 BagPlot

戴忠淵 於 2011年8月5日星期五 下午7:10 發表
Bagplot(袋狀圖),又稱星形圖,是一種在強健統計學中用於視覺化二維或三維統計數據的方法,類似於一維的箱形圖。由Rousseuw等人於1999年推出,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}]  

SeedRandom[1234];
cardata =RandomReal[BinormalDistribution[{-1, 1}, {1, 2}, 0.5], 100];


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:

讀者回應 ( 0 意見 )

發佈留言

Please leave your name and tell me what you thought about this site. Comments, suggestions and views are welcomed.

如果這篇文章對你有幫助,那請留個訊息給我~