ddalpha/0000755000176200001440000000000014550251762011656 5ustar liggesusersddalpha/NAMESPACE0000644000176200001440000000411014213423775013072 0ustar liggesusersexport(ddalpha.train, ddalpha.classify, ddalpha.test, ddalpha.getErrorRateCV, ddalpha.getErrorRatePart, ddalphaf.train, ddalphaf.classify, ddalphaf.test, ddalphaf.getErrorRateCV, ddalphaf.getErrorRatePart, compclassf.train, compclassf.classify, depth., depth.space., depth.zonoid, depth.halfspace, depth.Mahalanobis, depth.projection, depth.spatial, depth.simplicial, depth.simplicialVolume, depth.potential, depth.qhpeeling, depth.L2, depth.betaSkeleton, depth.space.zonoid, depth.space.halfspace, depth.space.Mahalanobis, depth.space.projection, depth.space.spatial, depth.space.simplicial, depth.space.simplicialVolume, depth.space.potential, is.in.convex, dknn.train, dknn.classify, dknn.classify.trained, resetPar, depth.graph, draw.ddplot, depth.contours, depth.contours.ddalpha, getdata, dataf.geneexp, dataf.growth, dataf.medflies, dataf.tecator, dataf.sim.1.CFF07, dataf.sim.2.CFF07, plot.functional, lines.functional, points.functional, dataf, depthf.simplicialBand ) export(FKS, shape.fd.analysis, shape.fd.outliers, depthf., depthf.BD, depthf.ABD, depthf.fd1, depthf.fd2, depthf.HR, depthf.hM, depthf.hM2, depthf.RP1, depthf.RP2, derivatives.est, L2metric, Cmetric, depth.sample, infimalRank, dataf.population, dataf.population2010, dataf2rawfd, rawfd2dataf ) useDynLib(ddalpha, .registration = TRUE) S3method(predict, ddalpha) S3method(predict, ddalphaf) S3method(predict, compclassf) S3method(plot, ddalpha) S3method(plot, ddalphaf) S3method(plot, functional) S3method(lines, functional) S3method(points, functional) S3method(print, ddalpha) S3method(print, ddalphaf) S3method(summary, ddalpha) S3method(summary, ddalphaf) S3method(print, ddalpha.pattern) S3method(print, ddalpha.alpha) S3method(print, ddalpha.polynomial) S3method(print, ddalpha.knnlm) S3method(print, ddalpha.maxD) import(stats) import(utils) import(graphics) import(grDevices) import(MASS) import(class) import(robustbase) import(Rcpp) import(geometry) import(sfsmisc)ddalpha/data/0000755000176200001440000000000014550246302012561 5ustar liggesusersddalpha/data/tae.txt.gz0000644000176200001440000000100214550246302014503 0ustar liggesusersTq@+ BXSo'#1Рqr?+\ azBO% 1mOUx5YVnP($QQ<ͽ[iXsM3nyXՒ]nqHi-4ZQt r؂8#ob5rWptKk&N'$l:6 5-`M}ȿ>>Vm "%#/D2Tn#0 āŐ璺kI2, yr eD9CSo- ֈgؠ9 xI"-C~j0I5?tTQ@p8# 5FVXHD u# nwQ h<%{?ʜ5 ON=r@T>I p+[+տe!oE=;u-eUk6tFcna<<]Uz2%7>dx|C* dOF U:w##/cNe/#1l+޴0W`ZӉh0i$JeW2*kHns7)B݄jX-e161I1ro 9· I;)3iN{NWz)$)2`Rc!L+\ GsP+YaF<78vcR[V:y͈F K15 jJi1/;+`IqRXF!GxavMh KNLՎNWK}ufuNL.hA ᏢEuWjLmd!c!KOo쏼CURjOv[szs'z'Rt#m*5sQ07Vt#Z\jZ?W'+tzgk bC;/]ۍ^NO2?2=@(0D`3vq"7#K!ja U ˲4W#<-PdLRfq]mmrTEqW&--ɮұDԗ矄]V?8 lQGG2ڍdٽt ZHV:?w~=Fd\#ӞB{(d3W`i^ p5oƾa[_zG-ḇFqa4g!Ibv횔:oT[BG0H7i-O,Mr[y*@4rue>JUR;Bk(Pr !6kZGiжSwRX2րs'gw| ]?9b)kڮW[[p'$FWbś{t)Pti;x>42 [^4ZO# Zmw@L-\;-xknyQ&T͏7'z>eQ F- `hؗf*p-{9ٽC'aPuyrڊDNܻܴ0Hr-LV\o&4ٴgr:۝mij|qV4V0PL} NPLy*mP="fuD卮Lٽl}?4l ^fU@Ԛ _QFF:lbwwm@D@J98z)Shmպ3[*蘫ZvdK WXIP#SObi%r8#JVZ9 :[͍HaĨބqgSޮ\y pC({앴 AF o;E)}[(δ} +:yqSsh0JbV٤W޻1e0p"&Am(dGޜVS2HWs fPA4y=D |4!}Aj=8|R=4v%Q$ 3 KnѼ*y)BbnV}q;fb![*buƾ9G-!mɝ,I\S4C9խ$ǵtBm{m7u[)ɭB |=6q-k *0أ͓.45$ibэԈٳms6+"I$;t*a)gH[Zk@~1In3xхJhCH a`OC5d^;%P>*Beޕ!!QOt'd(t^\1IUe]l|<x@])RG\)/ަJec3;%{L-uJ)\~|7û狻.Z[[O;̉tUԹ{|B i]!$\;;NmB(ۂ|[ TrWi׵ܾ˸WY'=%?U@W ziHKTs9\j5˧uc"}LI Fo#u2TFhd k?~'A&{nKf1 p@Jh%,Dkn$9G=4ȇveeWIc1:u~w9zְ+P\m%e |V)o "d V^C!1,U ZVf"/6?WrSytW:7ƊyUWg|)5,/F4tFA%~JwOq3F渆uQF[~+3#fD`T:6:k)D~[Xe*B`kgitNڏK(δKؗ%FjCzfUtPxbC;Cc46-O|C+,&}١ko GfԓZЧ`_csT=D2Ar.շb]}{< |)}k1)s8}dyN No=Vz ߝX}+DcLZ`4ߥzpQ5H] _fpCeU Fa;G~H}L}IJ (%Ӊ?55\Iy^2Yy.I>"} DîD1GDToe,A9z[|C29J$|L8D~KZ#FW8'/]TgKxe к _P\3ka]Ȋ$#[Ki;鿮 `tympv}5o @~VϦU߿Vbh_>OF+'8DohMaDHn4 <=?իCy,~b}j [bw QYkߛI}mgW {ck4u2" E[f$0 AEUdڻH}=ZOzK6j!֯‚AۜWLPiv̎.A֢q>53J<]50۲!o*yjm_anKġ t:Ȓ rÿ(pц<|3qT]io)ّc'= S{t OuF>Am,#寥K-AeZR)DFNWqq`݂Է!;!6\Ok|2?7o "* 8vTx?B5708R7_JׇmZc/rRZJi5%vȠUƧ. bUf!v m|_NnjzCh clqּ.v eRedGѨIӷ-_Z@:2 BCX*d=~-(0HBmK]WH+܂?Λ&-pnUzm-aPxwe!o1M{z e8Ybˁ\aVڧz}r'7>6j L UH]+y3Y"=PPdUu\Y0x*S tP ssMF:EiOA}hdmAHã(U)a%| Xш #MM~g~l`DsAsF`6lY(8n茡[u9?NY@ȏEN _waR(MNˣ;'|k#ӀMmaeuT[ : znj@_'yPJ~9h;Ӿ휠* +-)6%s'^6lE%b_>]B;>&\_Ϡ?RѲ]gLhڷL7tzMX E3-Z&V LZn.%Sg+"غo+,TtN¥bmkS Z87dy?:cV!,]lp"ܳJ4{C~T 56,SwN DReHn0+xF2td겷&x/f6ibugܜ~IVOIztre+@$WDnoP͖j0ŻLXB&C58TY)xa71#d6 S{e-|o^>v[a9S- @˸bfs8ޘ꼵Ů}c?;OuA R#-iP>u8Qb?׽r7\pA0PD's.{8>]b@9pckο絢j(Y85wA#lS^8rVZ1UhlK\ ?-JG~t(Meԇ8Xl'! /d5s}uԗJ)W9BlP#㧺."DhVO('jG U4UW."fj=/bE E*"J2>1,*;땀Ym0,n}ugA7u IgA\tB G}zPwO},&OO]O`$mh@ZxR:ZT Q+U1N8S6$<-_}@Q?3J5+YcSJBew.b64GVƏNYnQ˜4 0B:㩝Z{!2GgL>7aGo)mGɅƕ#-r$NZډ*"!/w=զJb)"rJҘK:ülP[(7ЎtCs$B9}Dp8s0YprZ6^"ҪgvI dS 1F4A#R~Ll #$χxP^ӦN*< r_*#L8 5KVET/j2҃䚴Y'+L叔&1KfgwȶDE-|:Op ͨ' |?]_mV>u_@(2\?4W8 n̹] I[_+  >M_{S/I<%c3@IgrY[b}NA?-JW .)^x]n<- 'k\M,ana:B͆d`W0epkA6#,lu0<}oWL# %J&&`a;EVMb#;wbڕJ(?Ha=b܃җn  rVzPO3ku(AOw>:TEh he EZcWJ}_ :S)9k,=~JR'p5r SЌL$?.׿pmQLrmYuZ": BMuT,-ZV2jH4ڊQMՕk ƨ}q A߰߹#}*JWBgdI؉4fLX9lмĄ|pXܓ_tvۖ١y]J_b25mށ*:5|JAE`)$&Im |L`1xAD 2E[H+n]Q`JiۜKq?@C(rs J0u 7*Kqyp) z41 Y ΎmK˨<@O^9 6$0݊.J:@M [F[_w\9vy1QSs3[t f Ykq-Xxg|בV38oZɈ \suMn6~mi[({1/$fAn㳋s,k хV2$: h=ыMu_p_H)JrjĄcnoqx-egbX}:V8U@DY5:ާyPx W.z^mL' 2c^[r{۵红pI~9GSNnvd `QaHZG%![=j$.u `'MGN^)b_ Wp-e&cʧ]_Z{<ºz~qRyZO@#A[+xeZu2L)U;[,ij xƫ Y)k6 wt1n>Z<e\5zH_5C`''ĶLNl˱J f`)c'~H̑r.-iڠ&39sQ voTC FUbЏȷ\]=#G̑)3tvDLq蛐!FjbDcqa&%BI}K KaaW%l{F|aɇI9K9Ms3$0ͷ;FwC}~b_ZPĦŔ)Z+<1 N&@&P"<=N|eZA5HvQlUVƛql!v%ȗ 5- }Bk9oև09^c$G_ ~NsHWNI;Yk=n GX^~ai㯧( pݡy[-h?mx$$qL`TNii@[aPHMMNN Y l"/ NnjÉ6q+·ɂlvWø>7T)W7jƽeH5 ggˋs[=zi9"JfeZ1A:5x^ɍ969R!Rbl /Kɭ @FV}~W 7<ߴgp&}W{!XLrA]<8FG~<rqnչnMץ*>Nůqd./atU ahM)8.[UP'c.@R5^0E p?‹C4(NS[aWt..)nײp}ۛU+3)\2LJ@l㉮;r($ݖF) (*:_fEN*L ҽ7qx廮Nς U6wOהx9xID|;jB έ \KK^ODA+WdOvptƲc˵ ~d&f?ۖ]*r2y>UT`T4iDGhIly2``w1grѻ!qN]9Xl"T/@}\cd k'M.v@ΰ/Lm%`Ȣ=J؈Fn*}~A#; S;ni='Ng -ˤl23YkU[U]-=wfN,$Ç[Y*̓Ax8WL@T?C*&G>M֚hO|۶ذ$I>'LIF*]\>Zv J Rx4ك@Z2*c{v`wq CHl!f*su-}PDbbUMcVVcDNhH?9A?/1s"MHզ TL۲_mtI_]=88WG͍8orMo=FJQ(Q*QTrUF~=&gq Ɔ͓ ˄\ iY_%VߞGqCSjϼuC'ggmeJpMܭ1nbJ\Mv+g ָɛ?b؝A 1:c"$&e0ʤbF뉱v/w?QœGqKT+-h#uusEbS4ֲ 3'L;x+uI,,`;2C8!9C#R_.Wc${?Pe4a<)%h6MD}vQEB`o8dfK8/GL+gp7B4+q+F/vIEO؆3~Τ7 3W sب= [IVM-{9^l t񁐀= 8:dCcCؙ괰\-ɂFM1'_Փ"^w3/op9D P<._6nw& oЄ];뜗@k\e&hG fhb7 &HAꔿjˎ|U֍M}(eXEbGUCR!xNS j@fGyBOݦ|2i[#a=?l,F1یҮ$:+X=4^J{Ow|N]ض/l^!$ʆ^bdV;?bD8^FmH Lǁ-}~?(J!mtW#Mnxm8t"ӧی|'DXX{+J*TAoVP Gly][`+X&34ҤEaf[eic);&N'U5b]hO}3CA%.0rDph]hρhz)LnO@JI5ܬhYN"-Bؙ]Ykc.Fy{x *'Q 6i45x3G#n܆Q[ZV 睞$oY<+T:sЌh5}H2qW$6,'sKۦC|!&y(=?<*ڂs6 _ #a+Wl2c jҲe/LDDV\̦TEEW辛NDDSkM ,cM+t/=DȏxE>\<@4@Be0 r~ Odfr,K3O@IfB85# Xô\B8zD$2Tlltm鉦7su&!yd[S ͭ\J̌"[Jd`'? DF,@4hʕ0G bjP 7$I:ze,`ʧ[aq*e}g>s9BDjnKjɨ K&> |TiPеHS׎#+ 9x7u~iNooi-A)^;\S+ O|gPȦH~hHOlz!K,^OS%>fڦxbQ63CO@u9?wcWJ7_99# nye3J Rj{׮՚7YK q #eɊCb0uV$YY/#D&܏g[ $>ȸY4+bՀ- 6Qk+]`ƨ:E;Ѝh%AdL-֐rat[u1;j8[L-1сW) P!6~J.R{k:o(4[eѯa]X?hV/dZ.}k%Kxqc>O&y$b|zYhXTÔ?n?żZ[׀[5{#}] |?0X`V1\2b]^肦gǹl\]QGe|חO)d @*3nXf)6q)O+?NԵ\ یs:u: 8*}Kz 6z-Ta@5P 0[rg;@tNE?B>=|ݒפ:jcP~ S%x0ST̳,Z^gJ}݌V3%& ?! '}bmƂf섪ҡ]khLt&~>TwY"&_'Hy+CsJuSsg2̑u*(ײ ʱI m8eG[%zJud:dϱyB]3%wao/P89ggkmcQA;W[oaa6np9>԰Σ]]6o6}ǛsG+\Ā}vt"ౘfn%ܹL9Tв ˳ӓXn Ҍ%BF'ץıV"ziVm1״H(@Μ?aJuҦ>$h0*ɅxwcP*Q-Yr|+ ŤVhi0hu~1-&qܸzU:iOX)U]w_rq0bS%+nzN1! AxRW()txͥ.1N3>4A=\+鏯f 2e3YّI]ڡL~tmFg[ZyB<SoEWPJP;1a O9LoyNZIѯu`^xB︩N  >I%֫B6, :7d@;@yKeoHb=.#<χၳGIϊJbETVr 0U0^X[`7+~k%y~MI 5{"詻0>aP #uD}Q`~ "jRs+1NŽƳ^Bq V"2)ԮMx]:k,{χ z6B2$(lNycem)J-f1Nwh{ Q `؊9(`X ۈUli_Ҙv)QZRڔ*7ȭMjnaY<,IH qnapL`"H7$3{" qU,Tm-aL`lA?2XuDu4qC@%UBHPwCŗhVa°M9!t]JY)Ko)8k 8SI~譱 RPi ? ۘN hWʔOph <&[*f#e;gbTAI `*0f;ܝq)ס -$#y>:yU !P,YL!ME:˱370I#O]f(O%I@G5չXrA_+jWC-3+}q@^f`5 ft@{.܏RɋY |27u ޝ9չUvaÙ-Fl&UT m§O^(֜TQ7@^#TѬA+aVeh-\~uE~U^c, 331X`# rY*͸lT5Bs1qK>nȜBӄ֗NS;:ݧ/jMV.ÂF|/n E3XNǧ੍ƻr ,]BQ$e }cgDԌʭkO?RI  !2y&Vmw]Z>ɐ&VŠ9jRTRqui!Hbh`g̅Law#f7.?`|' S0`DKa[HV/m8DUc^-^ńga%k>NQ^ _]Bb͑В6Bb6S@"׹HW=MZNS}:Kk q-7rLLV>fđ/YXFX&Uc>ut"[7g)VP/^eC}*:쓊8#uUP_'JTۚGy|O&HE)&6d"`'H-[ (U>7ˁh:8W-FOmYlεBgokѽ]Ls ^aap_Xy<..̺^SB2XSr-a[eT Isюi)^{&$~-)Quf^N鿪Bѷar, mDT53fylj"n eiptCWゃO-(Q,t= } +@LBxvЌvyhϭj2ʸ˂kUi J)946߬5Oخ@ʍ(eK5[drh fei5*H[?:<C)4o#OWXG7 YDF* `4/lд.K fy| * AE^M9 ^;lgIzU|4J)kZV9mGn¥\¯ V4;N|<9FQ^D덚2%.p`h&)DR|$)R34<`!=z.m BO^GrPʡCwѴ?oCs+ SNӓs.ΐflo=` _w(ւ[b\P!ADɟvmXs3u=568??׾ޱzo_9t/D O)ieÉV6 tbyCGTI4 Cu3OT+,OStG h6? pNrrׯg9ѬD@o$*ET4 J_oM~TizpBS>W4T5=To Q!vw*@NIG~lY*7 5m21G:&\EY} 46IyI ?ה[ÿZ !|<+ۋ~r9 SdXt  `dKc-ʀ4 Dpղ$+-S<}>]/^Z5u"8 ]:)Ѫ$S{ּ(s7˝IVFrJ0[Z7W?2#2&?ࠤ=GC2pJy"U~ tZA7<40~G}p-)V_ɉ!ɳvd]p*a,S[IEnnDw)eq8T%z9A><_-wRA`AsdHd8iR%EBm^^[Ά[r @ @,ϖZ}H!|7bd6ߦt uɊ'/6;{ 1=6#dkJR.KcWϓѻ E~وH[ g $?U͜jxmz2l hO6 A ZGLkrVޑP3`Բ}T2HB(+e:u?q#*y.x#Fb+ >6FDrQ.Xtlo)rh6)T/wSS@iQN>I(mEќ\pc@yrO#H#5 o&<|4,}2Ml>}i9kk6 VƔ>_Kht'\Is1ugtbN\Pb(M,="HwHߋ=1*8׼ɒ{Tqwz} B&I6)̂1Bb1|HA X@:utE.3uk?ԏrmg?)VG ɡe~1Z-O%uH7.b3 TtEгlxoKdH pyxB wFƒBkXYe`%3ʫr!mKTDtkm Uחo 3HbPFM%k];ťuE s[AayWD,%jëoFy]'N PcbJ@ p~ KZsIWCyT~;q\ᎏ9( GLX'&`dtl?K&,Fr $0\nbKr1IHvgeߖ,a):mUNJi\4^n93k _8^8L1 D{JZϜCkq)0-jF++Rv>R/o+K0,oκa% ƇTHS} AvxnW\\2nO}c]SA3L C|5fp^`:/\EJǯez1B\!toePMF $EoB'JHwK{†C0gZa Tx՜p3|̉|}R'r-x[u?jhě2Te5z ltdi̖5} ln혗PtO2~'D_ϗE{^wJ> !cU0tJ%KG7$=58&˭O(ꆍ6irUٖBn)XX5Eg6}zG|@(rb-0O E/BDDU[ɹY<@J;3 y؆{6(O `+7k<EMpZ811 BO 3Do.1Z$ѭ5f'/(V+%H=_^bv7Ynϸuw_Ki!K |+2ߥh4[|*]xc|9.c!ѫa OhQ<˚F"t8ڤ}Z@kBW[hit,ފ))a cFv M9cB diAlo6b e;FT c=HCIUVR =ɓzVZZHJLblA~# }+{&Rޔ L'mDv~'-C}yEdg-9JִĽV<.LAO7hU98MI2O\x3^~vwK0ܪ"9 h6b6c)(Rhu7JDsŽe}_)UbK=Ip*=em-d}Wߚ4Sk(=p ytFT4ָ H./CW3&nA sR XvhI\8сR$jˡ2I-ROѰ 0tI; vCX#2 :TH}~ݦ ]b>ڲXcCe(^3>W[ܭ#c1x Rgl4H5?wc2fAb$B7R"o3hn:E aEmaZu"$@7p)l1fS/A]ʤm\hh IWbȃ*`L x@݋l)ԅ*.{'u 7ᜉo00ۮǤ az' FDX(rPz뚝cduz t[D.4TOsAJQRF|lW6D%򆏇a2@xdEi{롴8v#VZlc^ɈyfĮu5#`&o!MֽkE@,[9*F2c0P<+p~ʕs{\$=u\.¦ԥ /OyB^9P.(b,LU$`K1o"Zpd/M=郞"aN\&\.@N"y|Nj?ⶾ-?hVv'RM4$Mj)7H( &(s IGL._BzZ!`FQ?uЈ/]Eìo|| QC=F[OAy0Hs8d_s`Ѱt fO8c̞o3_ n 8Pл۽OwάᴲѨJ֌NFf꒛NaH/βVe@C1Ma(㾮Srbt?ڊɥBeH q J4QT%ixr:'2'q㘔SJݣ@13kR`z饑 '7(be`"2/y=xoCMA쇙fEzN~eVR): ħ錘z4R0'D:Xi+=QfnU%S@9S0>ZD!Sꢊ:%&,$0tXte)eZ!$!i7*Ii-0$`x5 OEw,Bdz+xg8M8ڋBCNkEӏ5-X=0%lU`NyxNr\=8w ޗͨti "~g\GRjC~Ȳ=@ˈAI&Ghv[n7*ENȈW"e`Bw[]ln!aT I](Ox%3kWj'-:積| X $WE)RRE T5Gi>kqx!<+t5[?sp})Q{].NJp,F vPfZb[N+ӹhgBk'DWPB@7YwMiĐJ VeƂʏM~?).,ס}eGa`B S0xw4>0uN ck4+q$.fNU=`7t`y/sy@ٽOo;݀)YqhM)ن'E5 !2&:VI_5SAQYd*D)Xh io5ZsLaLs(lƣ^}RF!-^ٷtEn2`(SJJt=ۮʤX)׌a+aB.WWJ[o[m4SRZ*OcEKt1UϩKJ#*H y(&Iq冪Ѕ,UMT囖ɣKGdH|ۺѽÊ_'X>XgI n*>BfRЍ;Tf6 Gco@f։Sܪ$e7җ(6FĺU K.Pf_ʰ/^R"/%vqBD^\}ʻ86jNGQJ cB o(SI_`y4PJRt)/͚n=0Q_,f/M@C#`3gqs演)Bd`0Q?k| eI*MKʤGA,kY6j7 ܨ->VtExAi}_kM5 +pIHԗJj' J:j 0Phh'^*e3Ӡ܃Yȗ"҂7ooHOK&Co݃I^ǂ,_E;3hG9]Tk-.9|MET'}̜E'kv9hBja>aFQK~%Q`%"44FnZno ?j}䄴L ֈokmz] us]3QxgZ{ ԉB6_LR3C'„}GH_TK}#ꮫUB$+j0zE?;4D9.ܐ }o{!Őf6o[s5Y,v4D3^|*fO5c=,̔'m`@V9hM[ -U|b4 ~)7}3)ȓMV\UrQ#݀am =pɤ ZKY BBBHoqdzsKɟR/]$0 KXSPZjo@0i;zbn =iD8jK!6

3᠙rzvОŴ ֦UB\ iy=W+ewv;G^SZbj<[oc7{ v쒕]zVS5ODt$KY &iV5V2i(tZA1tYnF|,*4PZ2XGՈln_[RP9u&ܓ[e8!3|XyCR<&C` d0O"p,{C$ZDߡ=5T&pjsR/3=^yKGc{[ġ>K핇3I|"WE UG "$@o~;ҽNq 9b> *k,&Al|V{MW8,-KLwu1UapS70.]&sVҪ߽{ 7 ªrV4e~fG+`GX열= RgR35Nqo*nk G:gA=kv.XMBF1H{˵uy3(Fdv0%b@%Gyq\)^4(m`_$OvU/ W2R"º&:U\;LFSRHs mjS{CjĄ!cfT=Lw@fbP70L4H3ceuAFZkfg r$F5Ccxly9 ߱yэ߬=';Ձx:i/m襨gjkZ3! "V!z$)I͐([cֹ*TgJzFx^ZC5AS͇ڳֶ^pN,LKonW;}r}$ž:E7mOC)fecF37]q!hbK3H %3g֪˻Wwj}5uyrѺ \B\ZmptFlD Z-@)4ͫ1%F`el\ B烶c5~tr=&Br:72,"eN2*$m2ԧ + {6owX-zHG!֮aO/:pEe!%ޮ5HYVyOzZpϨ]1fl52_$C7y&ZjXR=plW@\6$>@I,,6NUR4&)/ 4;u!6XÜi%d"XL6[TW?c t1}dwYӐ H%uZt+!xhVQMt!way!]!(/;JyV$fhd!3bD'Dn'H uˌՖ`)z 0xE`h+ FֳJ7| Ld@4w _]s+J6B+">Kn@{ F_#ư s+Blz>Fk~I`qQ4XjsH[{ Ӄ (cAoe^,n_^{{8hpH!k4b`O\fp3b5+ 蠭I5 AˆtzP紟18:&Ôd?@߿;3H?,(;¬a\|}Sk}$W<@RF$\>_ #>"ltn"l(F=T_Z݆ȫ]gFJ Tm3ה#k-h<!N&[*Gvev0y`05/ҡT \{)|zmN(^9/>p HWߡ+1UѤ8]mF~zujݞV6܉5N?1/R<((Ȗ됫9϶ S=$ķsEyu_4\(Ml͝vBT|\{ۍ]`A%EoF'fh~R㏊?,)*Z-HU?7LdBZ=5AC@uK@C:sB[cG˕!]|罛 Åi~J) 9͓JzC aAwZM#+C*v\8?R<(~.侲=y3Mr$]?asX,]7 *Wlژ FN#G}yužJ8lxE9bή 7G 80n' f向s-8$5vJ_\>*v,uvрuz!]&go0gK~\j-,P :E[.^Ѝ{+\"TR"n7klD .CԘgP:%$b94U$CeR~顑 fQOI-a+½"h[AY߰©e3Gغۗcl8(jZẌ"~/<~wtTZ #!{diX 4u^ű`I|ҳ1+hڤӢ$ +{u2̥UA9.8ٮ6{C9Ôi9mx*$8Z5.uDkxI.:KCoRZ:b8D$}V4@xZGRю'KVeJGQ,*{eKf.IbxpjXg}dlAލ4횵jN>.2Bn⫅F_M;]qI5pi__Ž 3@B`bvƢ. ȏpzC5M50 >v0)~T y/CaʍQ:!h6T \H@[e.Qp])yaXyx,δU~=L^2{i:> ڽE nbU٪2ྫbp֤&=մܕvJ އsX'/auQ FH Y K;EG8IV?vSNFHMc4Hgv]ۙ:[p_vrp2!=C ס.ORQ隮Ai Ij ^5YxIs3^lq<}y4r DASN\1VA)xerA~$J 4q.AUP WkiyBkS;:@j&?`0p- "1ѩ+ Wk \'Ʀy):~b%(IśEšECpXO=ʰF֦dkzzX^!]GK ̉|_;$؛uJڃG؟W⯵eQ:^}Ap~޿:FY G6^g#ϤZ Ξ@؊P\YAD2z MZ ie Y)5c(kZQB/>EVհct#YNWɲ|_6Q'+ΘPO *4Hz} pl)ѯq58cSjWU5o*꽁MTv&e;oF}0\2O׼Ԯ4s d.>ɮTT ;rھ(-/qspGg|+LFF7|fV.|YXEdZR E V%srq3SCHrZiHL'瀩 :=^>%BWǶCv`2쐨,?eh*n2PpkNh:XvLB/(WdjJsϓu[@ZJ:Zd=yQTd&8n ^Uo9s6@[_ $/.c~V[Fh ˶)TjV¬e4prևMs~uKhܔz\2'Xeoc֝ph=\PsYHJp]AIk+Oxo!Nha lxhvO_1wMzA$}Y:P2 nT|LZs&yژNcugN;9`\[^ۍng* T :;p\Mna4@dƑlMui X%&S<,f% &bSܪ$75C=^\V?o4PBblL~bā&5x@Kҗ#TgԪCT!{,SQzWcGucIR[%xrJ`ʟ yn% RPsK]C4 #̖.5^4lF)1(ed8zSEBUU^VJ_)DCO"l4v H%\ZKVKaJpNWvyLk|4J!:්᩷zv {} It'96@BT6+/2/m;{M{E..-s[:nw$bYt5 @"0UYV \G3obA!o#i=۩# ]}.xZ`?ۥ~suq"ʪbE%moG}[E9OKX&%_oC6X zfA4ܮj?; !J%v O|[\P=F)TeңuÚfJ٦Y҇nޫQ{ : v^FN-)ᯮNqۜM;aնBNĠxl1|F#4;QP#g!&Jq݅3;4ĵ+^]Sg+;TgȓHW|9dh&O$-ɮqow3uՄ F2Ͼ`.ceނPwB)DJ'bZ!1V+7\2˨?LR/CzTN"R%lbޢ5 +XW{q*}hB^!.S$KYI/Ri,qZm@4i3@owҰD-`q 헽BLS zJ)RXl[ -lĿ"N\c| ڳAGH'D4FPY6fZXo1C;FCmNyaDa*ޕc;py*^.l: kƑ"S3ʦw%o9x_Qx;| \'BΌW^y6Y-  5V0raؕ.QJaQplfs*1MY5sPxA)HFV)XGFEqIjsU~8۶[E7v~  DXfSw= TCԆ gl %F0)ȶ7Hl[Ly^ln>aXه7@ZN"`ZSZ Mn݊rܹb *78,@% sR,%Ќi*c!5R RŨm_f c?:pR!jDUܡ(̹ w,^;?^D4R$r :7(%whPmWfrFe6|ޓ{Kw _}FBdKt Íanf_RUUY6?ka {3dOxp0YW,f H qYUPW Mfw oQ-#r zt8YX&P+_Fɘcf{WVPEpp\jpQ3h8 gu[t;8=~z{r =)+Y1[-IbNMt150 U Vz=G콊6{v=W n>0kM앍唺_8S_`%m3d3rܒivmJhMKw$KC0DU^;֥:g1e,nGz_.L%y0ma+вgS[WK! وe9/~(>Q^ú")fXr7mhs?`YKCiZۚw z@牙v _K&Dǥ\2~_Vi4|K𓑪$h١*̳ZH]Yf4@5Llw*}wh ]RW~:`v:V:+: LC݋!fcpfW%ܸ[#|3C\>;X K7@#;e^h]DU\~/ڮ]`Z^p2vHpD=t.@un /D?2u-`VrWkI>Wc!|?Q*nY l^T? :pgǜc/M?hFZW;c#DzMڬnGL߈](J C8ՓvP/P#8gB+NI$Ӝe<dQ49KB/e.*uzZ/3 .JWT7|t%Vy7wz+YElk%X`զZK!^z\5 mq klݙ+M,Gb:3d6r8bT$l(LݜtF+HyBC~j"N#JgWb4-g#xg'3ʾ^G@"O' K܅O(z_1|X$Y$w!& e8 hmmi5>ǐ)X<`xWlgFE[nF(v;mJh^79 #,+1xi@!6G`i_$;cЋ?G*Svj9<_+K#‰[auPvdI'LNK[}&(/5 tkL7]7m޸bJ.owTV:ti=J<7>3G.ة4#H/NB|>[ʩ [5 R2|TA#.(uҢ*d:bwDk~ai>aNIy=ya/]\fl3Y69rv`k.tux$ ugKNK<7f Uq|)}Y=cQ8 Snԝn&<i₼n}vG[$ΗnN$>OaNL9'~htYokĞ5T4!*Zj" vȤSy'~^G)[gBG:Gg>IdFj, b3l@EķfWHT]v?tQ٢OJxB@!hSc&|RBt}z' 'A& k&#q8}'EmgR=](> фX\흋ކ&%qQSԮ>U}#vUCՏZ8۱4<'i; ܆y!k ˗>N!8x!P dQ]"챝Fx@|WZNX EòI)'b74Џ+_Ws獑1(K]YeyoE^'BmTI|LČt^ݙc8आoP7=}C6|'ܻnw;D5~bJ{;W#X IwTx"dHfȼ $)CpG )gПZd b!4;Ӄ`_<\Z- :3)ӯ.GHj Z뿊]Ipݗ6jXk~|IyDxPs^JһCl;X "Zveh 4L'=ZY?\/>0SM$($Ew^>0cgǡo|NcWL c B0ewIg3WT9G'kٚu[ />2P$O.i@N]%-tiѯ9=ˎ#KxD2}Y\}T|K4_^k]y\.W@ J)%qf jInyȋн(7fC0gc"KkzrjmtchQ}ѫ7h4/u:fBre\1)iApGl4Ѫ⮠UKZFg V<Z=/DaO C 7ւڂ5nAמ`aB{rueŃ0+!۬}_&,Tz$Hz< 3)UN u闈ݗ=9,Eeʛ6>,}]> bD,f~8զ1r̠vAJ>VT}O:4U ,!Bۜ 8Ã))]:^jDϔ2>1 J )@tziposה/Vg?}!g^ 8f{1ػzr=>jjm| xår CA|Z$EE5[>q3#9F7G",VPCWą^ ۻQ}!NSWäy.sxzVy e)l]}5}}> 1*&ʸ3|\p`b+<#,xmdЭa1ǩBM+E0"\t^έҘ^-#Prpuyl$pj]OnFyڌFM쯤,LӁiC!pcOΰ% 4E1ÔJDO>u_F.j.8.*nG!ByNȸ|m>b:ҡ^VIrtZ>YS`N@Pѽ,/lC]ƹFh!)MӝP,T -Jg:aοMOupSc6D]3AMmv JAWz+q଴.g0he rˈ4 ڷZsR/gQA5榗bWa6~{tD h-t p ٩+y2WbYMU8ૉBnQ gzdR'm XĖ4zLB9=ڂ7l4kL\#ԘwjH۴oiތ?& ]Gr͊8/FO64P؟FR!WpjqSØ+,\Uؖɬ S |vR`xњijӻSN!y1_@oc2@׀aE/MBtGo5& N)ʫvP,aF?xhzmÂc36,t\Eɒ26F />yK; &LnvY B7fћNQ?ixs~^nGGcK)ݎ >Bc=jmY EY]I8kn16$Y?SQg4/Hu] ;؏_HA^vRH4 tdoiȵfd* =[o>d _Q'y|:0@k1^kF4p%S8x}}=A=jd &b\/@ rqz,7EUO`?jy$8xew$#vCPOb6h~F} ]zA# ictaRfiJrZIDŜPm[V˃=IZn"7U/ DEv&QhoRf\ s"<3O+DBHe{ '?ȥ6җWj=UWofAYG7nS!nKĥG XpG=`ȪB+/LX,/u.Z&JuBQsr73ܣ.N*l;loAvoĹ0g o;/]) 39껀R ;-Z\TQ"iw톘m߇mL†U]QJ&!Vfunb, qgM+R~#"A;N |Sc;$,"}n&3PUvkߑRNp97&m}!:K%nFa!$%HE5x;K!ti'l#aK9d*MܛRz*ovݓK#45&6g{Nو`*E@pXȌ^RQTcw(x,hGhۂ w~[ˣv׈<5_B}L9VM͑nȗ77;~._8/_ vH'wion 1n,T\(| !*vNVɄ-ua,jYt<Ha;)M(-HeBfp mаe`u/\s#\,`bg2^*$G-+Jo O/̒t׉as<3shl( a/+$'66$5ˣe` ~{w)BuV V/qgG5LVQL'+{ /M? oJد$,dZn[TkLڸ!MjY]>_t5LwCBq8]AMϡŘ-KU̍J͂1.0"fx*nsai]X8YeɰA`s9DfAe%; ^Ul>),1I2 :n'e8ZȄfԆ8 wOGWvǸ,{N(ci.H6kW7H:*pht K#j`ʝ,~>cl_hiy~XHfVBxKd.,bV ½מQ H+5L<:Hl,ܔ:^BڂaqzQDp]ma]\/DBĿĶ|YbnufNǙn~۽xc#_\nG}R*.KB#mI{,1CƋ∗ 63+0B3)-)i~K3Q2ʐq4ӹ5= ' rny%n34u7(>8ӋqKRC Cag[. `9W/<]l<7dZS1 g/cZ% p-.qjt'>b~TɢN~ ĐCO0¶f\+c,yNhK;RUx \ L(6rZ+阙R8XcDءg>;WnYbOzOX\,{^ PC9Gcѱ9e&ɽYC|l봶7pMyTE}&GfŸHSZ!(q; m[; |E NfwPKta7ܣ "+)}\N!6>p/Q+r{Р.9L]";võ=O {9g{"ͪ(N[1=p\"*ԒXTe 4ѽPX3e鳖 !¡'0iݦ%Zh*avZ.miDN>œ1wYNpXpA]Y!`*u~ 7x !OH)Ӡ(tϖb]_-H^q)MahV,B} cx7k𛃻Qދ-QP9fs0?']KPZia|s`bl_p}&5T?]{V(%Θͫ*S<+h} V؁בȾEݦMcB_K]orH􇗕 J>(1YyRn5Bpz3G8`IqLS\&[Pihe_&M".ζU߶usߙl qُ,MIClE5. -N~BZWM!όeڜ ʚ/_3;{3ХWVb8| @Asn*C֠GUifT~"xCwZS;6Gold/őaCDsBnȽVOX4ހ)qm8QTP(q70hpzGK}.<Ês3]>tU+BYeͼGFǞU2<3#VmtT6n|}#/`-gnZy` p-.ѥJkN#Plo{_v6{X@f'JD{g$-,ޮJRf[Ry$W-LkLo3p2&-mnf<f~b$-X"ơQ42IkZp:ҋǼ [Ir7JC9F !0! <0v՝1Z@dL&+0 Lƥ]#N"(a_jS-er/<ѾO 6#f?9Y~vM_ -O bi_jZEVK  M]nedĕm;M]8%IW ƢIº\(zԯ~Ҏ*n>ZĸQ{z%BU+RLv=oiP Rr69.֒>l <8s;k$`A7L8"g˨+SzV6 u4 '`ƃ6ąD1rD)(8鄢l?3>T6%ɑZFiVRELez^'F}Dl,KƘYǽrAKۋ8v 'Mhe0v ND}2,*' y`hAtà5x #sVuzFL:=܁=['2%9 !j:8, ewш*?C>1s^D3%vu[mGD8FM۱;BXs%Y!ϼz$#=eZ;MJ)҅I8e(vUr^r]FpOW!xx4l?WˏNZ|L6yU/YC=ARou/rՔ-p꤂d[^UYiy57i!ⵂ! Wۙ4Y bZ73wqV-|S`I j}AH:fPdi7L JZL,ij;j(ZtA?olЋr3{`ґ_ cC/k{ƯC%{a:N'2ꓴ\~ іNv`f5t]LӔ33wʈ8Y媯Lf6nz|ʸx Xj.YQ|^gß#N!ȈɑBP/1v(puj*$KMEY#@S*`VCd;FZ/eg|^8`+ 3q;C|TZ|#/{MQ]KtvKK%gv Dul>&r:PKFJbE]HZ.V7q,yfBe9agJcYTctg,asQ2jkvvi}Ây#Ryä ֌"D uJCc_sEAQsxҶa#q=t\lyO-|xݧr1Lg ٛӼƖd)!_+O>QV(PEbT4e?m061A,x*MSM݃0y+1 =LǵÓr⅔殶()`(ǁ!|Go|j80@yG.Ź,r,\{a͍ƉnL޴ XRq8qKU9ћ=@AO1yek-5d<72-ْ.~+>f,Ga|ޤYx1IsqvۊT2}Q1ZrJeJPm\&> |PHBO TA+70pZvsw g^Jae_51+Ѝ^68DmMކY"-iH4Oq"Lʬ 5bmdF 5ƈcww 6eDO=}Q3 N6j&\R0{Vww}4uKA;TȫSQVi`yii_\i͕$&A{J SD4{DY"Mu63c`܈]Al$qӔbi.x\шTypĽ]bq^Yl#_16rz#Ƕ(S %,?!wjz7巵C1F[;x DH\1m$萤F`ݪklaG,J<;KRGu!֖RM`L @ 6J6wH.@}K9>n /OMvyiG>QI]Tr"ϟ4u-vd<].r)g 5Ҷ[v^]>g"%rqe;nh8:1LշIa Ĥ/TL>׃tr՟cs;Y fQ?idGrjc8XEB0D+m4NStrwƺP[!6*J?ohKZU5ƛ)MC%xs]vp}_lc$=^ync@cѣ`’z19>PCUM h.0OdsyRtp$$Hri< 6R7_d1m`]vWѳh'W ||zLN kZ|V&lxkQPS3̏ze *22ycoAf"OW32hKoN6NMb^G:MkI7 (foܼI_~F,v~p:J$ܬ:E4ܬ%Zt]u=g7BءlGFKAi7D|>T^Xp6!p%1I/ ^7ːB7Uv+Ul˝zȱUJ)Kւjeꭢ>l?wgT2 d8% @Ww":c7=+غInZICS: I^kЃ?MoX̰IE4O ̅+.d”pӪ^>Z?/2BD70¬`GVGf3?eVXXK)[S \0O7V;ct%ԽĮ x hŵsa\ }Pm@K ">͡hGGv#R_&>]ճ:S %Eeg^M0K@l+47ʈyɨG5~;$=B%5?Ж93U @!(jDd]-"F<&[ _6ld. v| avN#4sXU7ڟQTʷg {΢j-#1~ ׅaC $r+ˁ[k 1z-@w ƭ{VB4F 8Xfy*+63d߻JwVmL}x~~ l8-W? VRb+@\kv߫[3J13Td %8԰3zmhމp*zLϣ{a(1aŅ;X7ć7hbVPiZNvR.ʁJ~ rgt}fDe.2i;ė ȊT _p>K()dVR;X1O E?u'nG3V}o_ߥ8oK9}vgKꈓG;-IY ]2Mݛҧ1ǃ5jק[5r7/In{E5"I EIYYˀ"Ɨa uܱ kĕ6uUw.\ ͠ c@2=WMmPؔ^adc"2ZkJl N_9UCVx/3VIW2byrSE4]ՖNzA!eʵ.Ue^[h7]|71Mv׍v<{n(i}.JNB~~.G"xDLhQ- +w#n!lox#E}&~:;PUtP-z:\|hI&JTHȱ+ үN%lhBsė5$(uC__I9gꝈ|_kBL4בȌ )xR͈E@M Pob'#^AB~o媭}0>2 _eٚ02) ;ۈBX#ptQ;wRRޖY4 c0d]feK,23kd9kYu쇤uO`iQ%?)01<32tu97ž[ƛC&3fGa}.8b"8cbFk&4iYM@`rsָ%v~o5H*܄ad6iI뭸Ige+AkQ hI[(O1''.N@g Z7B@y$ߡ[mQDt6ًdy GGusJL./U7.sɻcsY6qF@RiꡈI@x]d.7lPRYXy+w?zzF?5S?3[T{IJFѸ@Mg# So'"jrڲR?hM6#ۀ̡)}ɍoy6jOppOyq%ϑ{MKB۸J7!^R&(zK|3'e_3OG}^S2 {±h^l[rSz 9^x7 x'tzks̱Z,\aQl5(%c#-K -,ucQU=7`fҌJϣ=j_Q[mL~?s_wHrӿ o%BR6N✈Oc6G0u>ꑫV2U=rjSDW쯟Q>s],v`)Ik K>={EJ46BC68r|c1en kSN~mNƴ컹C8KF8F jl Xo| v٧IRQ "h ^QKQhm5 h( ~ؼ9Q'cV&*iVYQƝo1܀JENrO:Vd+p&% |Z2W,j?B`YBs7v"ւmDDM9lYYD}r-<iU_Iʣ֩'{,-| \H=F8ё̐`P m0F* 2Q5Isqo#1Pe;S`pehkWҔ";W-YtUQ-:7`ַ){7T}"Tѩz!#kRNʽ& ˶iT6G`K3£{XOY/U|-%9B$OIVl/wrhA8] #Zgoq6&8\ `@vKBwm=Jwx&/ X6 86msX o{jsS 1/|->BS¥l=S҆8CI>ODVw"<\p(^@RyT '֋1/dp◖ kd:khm:@-:"{x `[׺o9X;h'L]wN_/-eA{:TwTX} :&N7Mv C,:OҋUVH81~`Jdr,B 3_5fΖ)s ep]*ԔҗmDe%!4t!j NiQDkSTz>'3rP$rvqF7.Сz\kKc(tEsR ͒,i&XKX~ c㞐^v "DWݘ+y17gM`zϪVfO[hFQ'm;& ̵OHQS3Ȍ]qUAgMn=<P:S\8-wn@Ţ=ҚbBlv.wp a/EUN vEHlש)'?E[.ZzqS :q⟽--RU/3_>tϦ,U9MGGR1ŞPaHU_o~upn4=υ=cՌ d^a{]AJ<:oq6xPl]B2\~i–Q(NdtKEcXa3N*p {$y`\JoT;HtOf;*cʜHt}bHQ~b1P;D֬<|_$r/@ckr5+ T!D1kE\KZV{еZ ] [϶pE# HW9$G$KѺi&kWX}!i&V+7?;x\`9 {T_jc1Eq:@Pn3\0­"FW.\i%lrLRRfEtͥ=϶[/{Q<Z؇iYWGF|?*sե5\,+vXVK~Dg6XQ.qV2"!N4eƛQYORYm./Պ^I [NX!h߼k./NdZ~foԐ~3Wͼ̰Jk挀awoyt{T|ߪv:h_UIXI.z!YU)J^"R{i)- А>HQuz,CRZG6.05SmA(ب`$xia6'|--Ok'MX5#BF}UjYjj:T iY򸶄RhH|Cw'8LMqRlNn@&X3d!)M]/r"%Z||/[ßV?xSI`ďŵoL*N ӁKBL叽[/7 +<W)i]]@~i]<ՠkJ8zλ*<@cJNԕ^O5Zp\ªHfj"#΋l#v]0l JO NB>c<(0ICMv)+ Q jVdtX D!gQr \O6{t ޶rmSWo׮ޠCŖ@F/nbnەTі'H"ET2g2VKÚ7> qK]K`q5w 阜Oy[<\W Q[52~O׹/gձԕX2ŠT5F$U]Z [w0]vs$Zn)AhB[[Y4ɔşr_aͅ9PtTPkc꒫/bHzER<ߧ{}ehn-Ttډȣ0fF`kBa{D 81O:wjiX<=%jeTl'h g\I!qǴSeS/Uw#m kBsfЎ`si޸ѣ!&BB-~ON֏.1>JqњPD@`4vKL2)!?J:K+,L~LLx| ;>Pu2f1>ί+U3Bh,u30r0L5yE_?;e;7MnߟO|1.t2)(  B5,}!V;7x߼d 8y``zZ͍Z~À)yj2bX$.f}tZ4}fVvgBZ31U!BopNDEܬ;U$d Զr(mv^ }ẹWd 9jI_8hÕ{'g\ nj.׶9KAzm3|3.c3r#'y1SS>OʧSJ?u)` ށ BUkgZy]i;8Pj>I-`9;^Ŝg[jO3_&8wڰ3d_Jjڧ߷0mfY-) 4#D}נY5cRzexnS=E}(xp6]ȋ>0PlW&Gn^ŠWTڏdB0T@OTcIᶥWLtN X3llµL6"T85gjd0Jt\D:氄Ӑ*}6oJw^WKfūPSW]z!ÄkガJ/dUUB`C<%)bũk4x/Zrz} ;Hx5˭R$~x*9 GB1m[+J4q{:bοL__z! Hڅ5{D[$˫ƾXU2QjUs=4GP|ÀFqtҦ1$S qޑ:pÞJXsg ~{' JE_H[%PpQgEr7[$&fڈO_{/ɚVhC On7c!'&7xq}u(mz7G”фBkP{qrֿܖ4PO+o/%o3Qy#st_ѮҵPo^~!lNRxeGׁ6%tוY03Rg_pl7?V=WA9"2S&pϲk4KX^[״Pc]_؉Wh~Wϝ=#aԲ0PZKrNLxP~؄kR!NώSbc0m \(31Ih8 axRxj+p(|aW>ΜI?vv^](㗦Q7z.Q@&aX\%ˏW޹9z'^ۡ{GUz;xCa|1AIh0Wf+3s+-&KBB5(\ ;AM㐍vA-. CBǠc;n4/* d"s^e)rz¬%F%E#)("? \tf/7""ZE\z5hVGtAZM.!L ;@lP+IfRop;hf`P֊;m']DVv5u(6Jqb;3: C_(%Os :As F@Ih> _qqn,}m\Tt_jAm 0y'0}!\Qp{0{ z9 \8U ^T?FjLM[<2hEMZ|dí l AG Y4UE|ܻ gKng`{ G>SD귎ny͈HTZA_ cp" C2kd4HJ.rOWga((ZW2m\׶42t-7hH {\eiӵ`R:91x)%NSK؋tDu_F/a 5~[DF`nlJ .Qa&'&mѺ-e H$D:9U{X%ߕS#bz-.MZP]IgU,2%PpG庫pMP "'F4(yI*-/BQzԫ?D-*vwMtwi}IjrE4"nM>ۥR'+*4z?9cne- _2]\T!kKzi8%ݍ=b_pXEĊޔ[@z Ŕymg:7Y,*`>^1 ֻ1d'kzoYerVs~$o+غLb,Q5FWŎbB[T΢ؗ 3٤M.J a{q!yfp7(!:R? Bi=ةmc ic^U5<5ɇ1%6Lì'Et' 9ƱxƋhU (9O<)- n\=xONӔU]r ݏGTF]~=ːXȂ;?M҉LIyzl)FxWąρJ r}i7hӒAjɬo M-]|t@";zჺgTPoSVǮ2TD8j _S: ѥo}ב4cz3@GsUGJwiL`)`f45|x-uQv![ây)k(\Knq`7fxğeCX]y%o`+ @5Aԓs_K?@"~q[pJ| 3B#8Uoyipe#VcaBX>pEI}-Pd8 g|11H;2t6nkѥ&>^P PDnO/%&9x/k NjoX~$i-av2ą+Ռ__ GQ3uT\PY_P"{A>OBnW^m;t_}q{j+`ボr|+@d2o ھl> U)bPY@8l2I<\AsJmM{%y~wx#R~tQ \F:l'pW ؽ ' @ i-&F.(DRp5>3SS":bUHOjmXH~N1y5Ifì| _?ސGR6& w !NVz9"x=HCȵB@bdқE &&`պ[Jwxk*K#sXnGmP^n1Ꟑ yN9?cAf{SCο3+l-g[Q:y[S{Ο ao4㹄X%*x1&Ջ(U&HF˶FVſp$j0h:R-4mڰKOc)`5۞F E9f&avP8۾WgvpRL`(II]ƹXj\lտ=#AP2"%p5*X[03gogO)QDs-Ox.0dFEg-^M1Ό~XnR ɱ`:nI2;s 1(ZӬRxE) V? S#5'!V,º/f3x܅wrG~5&cl#fWo 5%Miu2 g$AqUTf}E$E\cc6LY_/&8/Ra*pm_M lcY"'5`x'Gj<|Oυ;ǡpe+qꃲL0hBHѬ7j_wG&bKG5SZhq5BӁBW/E)@ns0n,q|% …Sac#@rU 5Йb Eu dQ\͚OgۈYDEnQ DSkhG^"~ 7`YNMŪFN`=rzB\ȊߎWz%QSW y1!#9 ~0}9s+៴X'"*y$Xh0w*󆛜pǹX'Օ[ { i?tbD}-}vd/S K)wZ=xfP;Z[%VY5nf{{=EyrN!ȴm;|ӾBN_Aj̺Qʑ˰痘xy}Y6", ࠵MYx40˼?6&.Mg=]P 5Z6UE_3AW b`G!ջ5rv*wt4C$W <0_[Cㅍ7}j1uXnf%,mՖͮM͂_'Jn[avMu.zb3iaEٚ 2zVt>iV<]goM>ٽS'ŧ^TR{/RȽ,.>ZE-RUiB~m8r(PV"!?|;WlS᮵%h*qs CG:_57B}^[7HUk^k ݵW?Ӓ F9'`"IbyV<^*?٨z[Kp&6WsINT[aza5(j̞h{*HuT8(qGѬ? $p-[Y 9I;f+ĉJN(_J[G]p=Pg犟ZȀ^ 5I*L5`6H쮔9y.Tx\/'Vg洔^Ig,fQ.Go./axv>ٽvnĂHZoRy 550'ZJ\ZOCO b[p?irFug/T][tdf8dSH'tO iPz2¯T Hdpfr7K 8WSc:btӮSo FhOκ?bǺa㿟^ߥgHܽJH$c/HmQS&ʝrOyWor)٘}O_g߲˧Cma4 U>l&.6}_bWRD 򝯡]eO׌g*(,Tv"yI{kQ=3UkLV^&0'Cyġ~?rMcIqe0(nU?1E֖Gijlb.-qXNDEf aP5\c}oXTX݉P"=+B#x "a%Ap^3PJd'P$")fWWE0t0)CyM͎k5@H%NBv£Ιs2kxӠl7С_aXhD3Q RX]YkM+n=`*NqҧzLKyVYBJ^DBٚ.J0ۑ+ͥΌEA86.NVWW3niEhD`F Cm(C @Ӽ懼KP^|ʣJK%c4䍠$&ZgyQOB.%C9끤 {@=TbNV:c1.x[3NG9".n4{p{q6 d71R {x&-JfgyERnlUJP؍tנ9,] 96[7\EdY 6"o14vv긨Or1zYD+R% c4J^*( ކlYz,b5,b?ѤJ]%V{.⛍y9>0 YZddalpha/data/medflies.rda0000644000176200001440000002776414213423775015070 0ustar liggesusers7zXZi"6!X/])TW"nRʟu,=!zէr$4fEZmnip%uUlcڬb:8: #Q埅N1r y8лN1u$ ,J2 Iͨ B5X4$֡tuPNDSbVoYd/smC?G^^;ŖX*s, 㚪BSN0CV9"Nw/lɇ" 94,FXa6 oRoz[¹wc&wSMuVzC$6+=YO e[2p),Q - fu'ֵrXv̰ /_2SD >H9͕SȠy" iٸ"0{3+m,_xaYLZIXZf!g?LWuy59#v6:uz /^r9-h..276Cv/Ky2bsňkVg;#P/}l<e Ac.(4g dXű7P07BsSq\+Mka&us:r41dOʑxIܜ/k$%8'uUD(g}WL=F[cbZ˰#j yNa(<+P3g.A JJ~Hgk 3N׻"B? UHe+_לI*#CM鷋߯)R?N ;riW-RvZp>eV10Vxy`` 5 "@ȗ˕mԡ$szΙ4aXZfir@ΚW;_$TCs\>m Z 2jJԾ.5yҢNLז 7LNϐɖ3y mB Đar2er"w ොըޛ?4諎ӎ{x%[d }">Q?Ϫ3~wD).ّJ>Taƶ޺dx_7CP4HŅa&d |jn}IH*C­52BޖW7,W9=>;R MwYz}v\lA -,H}s]Փ hT&0 K71wi-֓v џ{F ?NXyA n ŽĨH? {Pr>wH0ީ~I ɺVccha8ϾV8:7Svk6 yT+|qǧ-2y27Bt4Q > %ږ?܄+ $iA %KNbfnM%z`/XFDFfY 俛?/-i#,X, ?Ԍo4F`;sSb>^Rh]_f`bGzm܍T^j!c"9&vFbCZify]NH9\@'!/jΩ$IQ}B?;q3,CXlUVfw,¢y+PaId0^o9$˚{dfK SfCsOshj 1B3,Pu ǜ⍮O,Bj'xOf"ZqU4_fqjVG Ez. ^s([,齖h%yIOm8S HIm@:p C vPҘP+},槻5RL5@^9娋nK=kc\zRbR/t#dĻ(Mej˅Oz]^LS+}p b$L\JdF˲ξV  (os2߽LQ ?,(Lb]]a @є& &qb)#6U!7G DO>}$ {nN Gc"jq.-V.3&g&١9V&.1l+DTlEJ70O$73+$P'R#q5ƟQf7bKJ R-!ܹ:ⰨFI}vk"ԄZX=\<>oyԙ =L|:PӷA^aS$'IQ&ƑԶ99 h~ k` ^dh4}c01ŮXz&z?-2z5h?O~Tk)<4%LFgV.Lf}4IŴ"󧎻_I%&QZ8z&_=mI@VP7)1eؽ|At*Q`F\ifENNV12l<ųX$ټMB£|r9ira^syA5t3"&ړ4<0}T֘.y^wpN%Ujys=MQ(yWLhթ'O.)$@>D*LH*J #R/_* j(ɬ@ Lc {_J{HJ>%2DDt>HRѥv1{az]jI(1Z(^ r!J4pMv&r(!u­e9 #R%DD)5[0,эe>eC Oi b✨MgkQBAj4 !ʗ? >?Yt^js `wW2L᫪hޒ⳦ qS:*;2M?_ӯp#C4\{IѶbvCp ӀLA  Hr1%V{KVp(^0tG;G`s;7g٢{}T}N 1E-?7ܞ)xXZy{L6+@bC$tqF'sOʰ⥸Y e``ްjYLG6HRqQ,N"> ]qcqB.VycӘbv9Sy@#"́v~~.{MwycGc%yuS325HFԂ=I:MzU5vdG!RBYdTRo1t\Xӄ6B&}e"NF!š|`m̊ U1bQlȗD6#b mUH RƋLTv x)7q% /ˈj0$ l}m!ɽX~o0.ΪTq{V˙ o_d=fCO?]Ċ, :Jjh:ް(ڟrwn׈3S}TmpN/ [Pu)8U55Sq P(<H|}. ]W rmX⌦MOUT|>R-65HhEm yy%Rx|p}?jPML6 >FMOE)?e2dv:7x oSP K)+3 ߰m2cOTQ#}Vxf6}{)Cv8Aq NǃdϦܾ|)dnP}P yLG/*ִ| jC_U9`_aO' ŧ4`8sUќ9TXP= @j4/w6EuLianfY-,r3 `6E8hG(h#H9u۹RO>gpDjE'!$0 J2L$'<93̫/eݞڛϐyDB =f2/0vNw?OP"RF0aOdf<; _@pRw K+/jAyxzvebB׉_<\@ޡpk덧]VwC-E ۋ8qmXTx(躪+(hU;5٧Fɀ4kFjdsP #7 ٌ>"]QFV14f4HqU{:k %bɽY"RH[ϘM<˩jn>+Y?FTX\7]Vs?|k  ĦuC]@]G+RyɼI51i2MfYJ Rkծ_yy s"apƏ:+::x샣ң㥱}jCڠ㦐 Rs(-@qj(zd^R,W&AP;j2jB<ҍ~;ЅʬG XU E8qv2㦏x eyu\r%km}F>m3Oo~k`Uߕew6bClt Lso==< 3m̵1)H9F!&Y UIcxß,G4v*NQ:ُ68cGGq<4(!NT&)7`їs3}؄k/t#RXEi fI5#o2Vw47xяmiz d=O\_µӂW.P("%'P{FlBo ˟A|h=GM+d :o޵Bc7){{usN MҖXz~SAlCfKIףiCi@G{ѱLi9v\%jWQ( QL.UdSsT]ܛe}0&qxpmB77t:R2ru_F&d 괂'_ cZ` dgrQ^Apߞ%e|>~ecTؘո'\tFrC -u$)oThyxZJU8HNJ 'ܻR.[⟉&m0zf'{]\NBsQ͐$rf/ H-5nTsXS9Sޯ TK]#Gؔo9 V)' q& DoAԂt3Y |sIxD,5 \JҴN*ct-`wnX&MyN0/Yr8QqfK=MVWD'YB3Fk20~ <)GdmZ9\Y~Ta#PzU vem v$]Si+\ɾH~_o'8)-QOXG pJT} E f+l=?uud^|~LǾݎX#:SI#p_Xf㢗Ncl%,aCJ0L{fW ~*kzMuUr'yLs<&6IҸdK icd&BWҨ ^IfY7o䅱9(1+BHwJyz˵Ԏ5H n-B q@ 91y(f.y;}gB:Ws#yҭՠeDR8z/0GDHX=%ꀽS[#]lvbݱ _Ҏ0!*t<ÐycmqDž?z.f?i1ySإ hS |.IO*ωSKWvJ?~A 5˝][ Eb4iVlbQgҧ98u ʝG81&M<:fbٰꬌKJ7uAE)8P1.plfA樂p-Ur:>y4T78赐e0ue{^]poC%VA/`n!g<$|# 8Q/].Y0pBKnG>͟ ]/J!?ThTqusw- s#'ĩ. Y@ m~rsȕX\p]Za,͎_}.t(@P#@.]?W[yCIud%!8@5Gd.Ү$0Wbu(~J-KCeԧ8H `𡨼pp):B`(vcJ,i>P"拇:UYrOSY}9?QDk b<[?p ;?DAADDsN%BE(.к m_>cKP |,xg|۠^DAFKnmVI'|g3fl~b@o(ڵN'\9b sMw$0Ɂ`1'ONN (n"LM-^1lE&RڅN:z>}o<5>YSQW-۲vBه * &;sK"i -5 -yXc9V #%4Zy@Љ(҉Gs;uР9FUGhX<a䑿WQ@x$ t%mۄvZ<樎r67h PSqe0@ Xʩ7}hc qQdZk߿:E zJܹ@>hZTRa=eYݲqE2!6HKj:VC0";%~qEا>n;JgżtU.`wˡ``B/NoZ)`w 4 ~^lU׌#r%) D(:Te_G@LV0}`4@=WslNlqĶ:*3A.3˲vz+U JHN+XI 1>f㏒& ÜD:~X=yFX5\ hZ^%/н@^;dy#r;FD&;+t\ -h8Cik,^p0|>pzQ[ {BD`ysBnAp{s듃߮`Vp[$)yDV:SMgTeiuvT9@ hSXH( !3 1%7`0e:P"sѷl\n᪤w>JSUCRgJ>쫔z!ϔGLfKk]cmNʳ8F㰸)grBmmQ멨`g:(HLTPսX팁15fȖx( }Ìῧ](Y,Lֆv|ILS\jp.b6#ѲRFs<.Ѣ~=:1I}T|Ek>Y]I0%1pk;s Yjߔ/LKP9p>5 +˱KLA:IVA&*^V-Y<чX}=3R^8C)jпcXaد('U|$V"nTeВ@*=ginPV8i:*%7Tn%AE=;8O:+*d+#uJ[D(ՁL:,@^~5೛gK/~N k;ZOR:2-+^q`{bi4nQ:$ϺIAӉ3j>g3A50su͔D<7Jdnn'vÔ>d}3Wai'=];֬Y@+6d_auu"`x: k%@+/; 3-tT|'m?S'`h.D.)<Ƿ+vr)luk r^ޢ6m6yoh y6ިWoKǔ&r罼2> B fmxwgC wd0PV4,M =,QkQB7U !$Uo+7c?.JMdq'(}*lEIdSh%|k +8ӓz^1M=G1xyY 7uñX'SߡDuRR8sI,|?9 ~EE@ݣ9uVa.3~ihicP!w.?0^ouhU[nE6 hBi4)fi%c]akx[RY["/@_MU'V o℟GaE8+sV/h/lf̈j3]s+z92)(w+ ̂|6rAkm40{p^jѷCnmIs3CJs#DI"1oncD4Rve?\jQ)uT5h0Sqd}ܚg^(:U3T ~M&lW- Zj)`fK0mayTntW +5R?}m=;A~%`]mq;g#e@:fN [AjEUxH7ѕD^ꓩ`Y^IE;$\Ӗ l7$|:5MeQ\U/nL4L O`a<|ל|E2b`Oa5+fr_y1FYk؄q>̟Bh]Zq8Ӈ˟~鿠w9gwJFvb=gSE(z{glm5tLZv,N2MR61[lM]kكxEڕqlg綝5-sK*RA+>lCSlO>:Ǐxu`WR*=急EG7ھt@I^QL-=}mtG˪֚ZHD&pLN%QA%.xܝ;ZxKU2\,ϵ[5(*%t<&,^]7wBE|I !FO8Ԑ:'BhNKKQtb("GTKbhW )9eutT < ᙛF_ްbid,}4.{š%@M#qѯvmQY`4&F2=6h2 WpPVv[0_Ǿ^A>?V[ i2il6Q&Z(tμb@I zM'ҏ)'_ Ф>0 YZddalpha/data/vowel_MvsF.txt.gz0000644000176200001440000006031114550246302016031 0ustar liggesusersm˙$9y"L4C~Qs {3UiST;|3OKQ_O'g3Q<E̦}F'O~/?VzҨI9JhߧxRO.OO/c4O]/|[jTh |%ec?zi3I]yUӆ4Bs|?udr_L{"oZ*Yprλ=ԪN{ڏXOTo@h{jɥ'Wk?OTMo|^ҵ~k~*wl4>U>$]hcԷ{|[示zV|q@Sy\ѫPg1`E^c_2 I &[;`ǖu3xEv„Wi1}t3wT|\=i}jOҧ-#Y5I%hzR*}?eEj(*0:aRA;t-XqJtS0I }2]zY}@^~`7LqprN0F:; =aBj}dU.*PZ]RkBI4d84Y0)_hDp|g,*Irdtb}'4! W~ڀo|s?$l"^dfFqNkNOhR2s/w݆v &|ޱIԿǵsN&k-w$Y,J|ċsGdfr%OPod.ӣ[G5SxOo/:ʱ>~U.guwPmʲPF@h(I۲d~s9RR46^]Z+4md ~*lj:.e>S%9`2dGN gUw ܎sʺU?,,pnuY𷮐˛|oP4M#ML l8i/Hʊ{XƢIvddce|cn(w3ODB_ڈudI%cm.׻ƾڭ-GV.DPex 7x>2((8JҎ9QxGzOa!g t>>"ue&Gdx ΊݷOnqN,P`cuQ%$bFR  }92u+$Jzc.zٷjOnp/i8_:$9&:yŦzwobN.[WJH9ۤ)G0UFPre,A1.K?@!CjY(VRPYwwGoCj ,@e(&S{'7Im /ԟKk_Fd.hJ%O% QyN+71r(^b_3Rbwt_{nkɫE=L3(S8yl!qdtTUUدM P]iy9]OߙV󹾏;aR¤J). M2P2JsBk v~-ԁGz7J/7!`mBc;N$'C0q6IiKireן}F9Rj:˪d)*N%syߞ1& Qi:s J6' 2r_MڦOۖW/ @v,qWB<>|QXAED _&_SR_`sS{-Y~}F #SOM9yt J%9 [kxf<Ap,Y $G>언q"'5K/6/brbjӧcK536[~"dq UP?qeO?)Ey8aE1e;iY묿*'@a>K}e{ ~qG\~(oSEd$P<]=G8[V#U'ʈ##èt\ɷ^p&9QMW_J]Eg:"0WSK{s+%.Ŗ~"˥Qtjv [-c2P̵}$-[X{%SH0pMex^ɾn͢| v1IIНrx^)=(E4qc2['1RA"tnȵ,Oyޅv}̸@)ʠrSAvJiU}&'K[Wj;:ZFK%9h\'Su|DGeNЦmB[s⮪a-9Ξ4d~g#ч (џƵksTzjW_ĵħov5UgM\ #;dܕ6WqQEE N|Q[]oJuū=*r; :D]kӞjwCQ}~!ϳ "?z|9z$~1q!oy MK|_A1_+Kju}=NyULvwˎt9ndPXrwAH?o ~٨}Qvvz:qgI'D >H#dۄy;v=S5k&w5?%W~޹FƾnSa'Jgnj&emNp_ - &j7MIuxfp=m+g }mr ?}"m=sAdp_ k}Ki D% kUy0bZ%ӵ#zW6I^,z݋*JQ Pu1<t_ߓ R7lJdU Zp> RsG<ޓd91uJ":ļ?b#:Y%-\P91]mբ7(>D`/Ҥ3κyt@4/H|e95/NT HR.l #nFGWBש"USM;Üsk0sy _?>Y*ڻFh'D@ p`CJt_d#M:NTMd͒K@9Vpz+kTO /+{/B /ʠLGQp*!/5š 2!1nU)s_duB8ÉE";sȲw,|?FO"? Rq{QB?B>8> VA'@qu,Vy xkg$@*N>1+Gίu@0?,ɬ2iGW+<*Q Sט,APTp ++A1[1@ !C5>Ҏl+tRMm !us%9)OS"(^e[$;Cܾ悛9lK&k>QdqeE@S ž$*nGU-߉q)g|NǻHص (|6AG9UlNEj>49PkÞ`b,".6Q;# Gw3no)ouT, EgDMbnzz >eE5kߊl$;A0}|X*QR{R*P%)ŸfB,OT]U8єjlkf&]8L%yf8g?Ͷ81/xVԸ&vurϺej<;>.E*\΄#.J+L5h-E\~oZ'4]п˥<~q˄;O@NJI^"ED\5mEԎ +nJھɉE{#fgu</Tc8pMh!t 9'bWBBy܀V|B:<=< tLe\i-6u(RRAr=y)Z' ӓ7߫{pGO2XLP)qs_A>(Nu^=eT/ȴG%Mu~[t PcvK0j Tt]~@l Y=:ȆL<<8 :ێEi(JEaP|'$Od H!,a1uCe8Q pTAVU85bdWPt0:7c:@JCUgxGJB=+ieEBO7/S%.8>MZ!c_u 2J{8)tL-L/qbXmcH2B-+LR0)8d[/7.Tx 偋̛`^ 4g|a~ zGv1.c,]O޸y Rv_ÚT3]A N|Q&VO毶~D9qQtg#Eg6\(<18O JM1AȪ]q,ywv(UaIIA+F e޽b,kyŜB2A59W_kD4.Ĥ=;~Tb:_REE|e~g绞4_C̾DW:0{!pߵ*5 &l ;D.%۱ԡtCn ge C^/>˺L:㱟?RZGw2b#P&*])W|GmfEUl KjetC ƈ0|Ac2(/cADn4zA8JEr7a>Bk1 \d];xm@'4`>C \$ۼ0I8/Je6s7 rpΗ 8N)Oz.ԄŨ _ȠHHX/BN*nfP|U5RJ#ꏻGn7@ 8_C7D W!| Ȓe=.P00LUHk^.# C)lxPUCA ʯi03%j$D<*DąEɲ4( Ru8qA(W&C>s `~1D~LSh}(-4 ;Z}iʼŶYI?y5fX:qTB5l8:6Ra/X@6r2r6L_Ծ͟>=*MٽJu ҝωyy>FYx!ʺY̅%xiXz2:+j.*s \fv'u&\r1EuR3˓:O9"3;=CQJ߼! $a9@篡"CV~d(9ڂ/ƛ-o0غgO#焅 8{r:mוx0 O3y,=a!k؂%D&B#4EzX15tBxނw*]YLn`x'*dY&jt2f]" &QygHd*- @]ww9*.i?U<ץ2:aZ~KD?I#0ac<_#ݘj@Mg5)w, Ne!1[s{)-&* R11 i JK<(fx*'"uvULDX9 /,yʇBǮ->itpf '"\ vw]㪮11ylFݿWG}&!(Dz`oQIpȌ'5B=x^Ÿֆ^ϫ?|E8:IA̪\|,u~x:oFA>WJDQ3Q=2)MuOE;Ck=jwD(X!5$G"w9ahRjrR1aa vYvcNGfj3֕%Բ`.lWje(3?Gg΍T %^mD&L;cFa%&2~LP)'%(p(:rP](crPBc[Z}Ibe*H]<7 iredb?*TwÕP!&J[)k)PҬig!_.iBJQz{ ZV.P~.Ju&vy`nnζXvy.4*-!ԐB-g1\/I4P<3J_}wKn<98.xϫpJP#zTq$6ж}D\2n;Ujs"l"qT$LD !9P@5+=n~s5CB 5yp7ۓ(7B2?Z㱣&F҇GRiҹ.?'eNg˜NlCsfw(j [B7]K7 qIJ Io0ijR\F!lȤK`cθLV< 'KwPX_w]%xȔWQOGȼ)=R[a:b'"q Mf=Fq3;3r>*)1+9֍oGFhD^AsPAa vbkll/H .=-^k[:ABnyyg3VG&` U('u4ڱ.&'xC%aSC.rU۟}&j{bR|#:ǃ)x陓05,70QP킸~ڌ˕x<hAL *%=Idٌ@d[B5_˼0EAsyg^l<4G"9>o-c>@h3]oUX(Gs0]5JVdi^Aq4Q֞نӒ(eˑH~6`uW-NJ9G l-LՁR ܘzvn>0R5c! Lo^DBbވwxjQ1$o6툈 v8sK-xލg@tf=0xeCʞ ʑ=ʰ,{~5"Ad l  э"JODIvxNJ}nHn W(nxJx1X'bޒq x -%C&ɻ_0ZbueJLp f݂g8=bKj&t=;."ǔ=ܹNYevo2ܣ(}?RO3V콘AHD_܍5zY=jicElҮ sXwJؼΒ%[I;d >So%@"o5r 4Jig%Y9ЯQBCbB$ۆXcqP~4gC!@p8+'P9WijD^.l G]`\.t>ӖmT\n7 S7R$؅ͱ\6JDDR"oܺuxSZPݴ9Hiz\ ~9$] iYԦ,Pb]ND l )8ؾ@P}RuUVՠPЁnu`%G{"ȱϺy47]A4:V %yzˡ΅In[4 ,4 ځ9&dҹV]?a2t6ϯ3yN:LI0 s߶ UJRt7ReoTY]t\{4ԁɷvQh`fGʳ[w<ҽǃD0 $BbASOMS-܅ua$N%`[l\ {<._2 Da t;Q~Y Lb&ʫ IHgϲ%;.pf.?_B!p8THtߧIJl8m OQ˷ZIH4y '1(5#ӎ1ĠT8TulƻlWZ9%1k1(K j [i9TQ$t`f\4p#,-ч[Nuc$zvA݄νelrBD`o%'뚍hɽ)<h+*72Zjnavw`dZ=*۱HDz N Z?kk VD t{h.Oڲ;`R(5)ЍtrK=\~dw\rLoK2)(X*Jd rPaJ=e:Ny7"m,15G!ZojbRvΉNN>{L!-P~1ǭ?lJl pθߓD^RL4cjM}N ղ\axAqg#MZAk\S9HSWD'k7Khi";LhVx2MߩI1:ҫpB "anJe`r55H)5wX>:&l0¶#Em;+ oEpDT5ywHhSsGV F8"u?Yԛ* L{'7˥Nvn[AlI̒ {;YѲ%܊ۅ/|ŠgX$LR(yfKL%Q'{KaBNthͱop7"D !}ie`B+(mlt,(Bx8bQ{;"=)+oh' Kmuњf+8TC͓uWTՓ)* )DtIDr cٔܗ^Łxv> *.\g+v Y @mƊ(gOxO='jBc\=0S@{݆-4nސweoEoY)R~4GD;lMtlWIƄzH2?I*N J%d*YIA9 1g.1J/ç[~ĉa’i҉MeԷ5ad&gH|~u‰sl֢̯?uVw!;$M=Rw?Av@سK'Pͦ௽ 9׍~0ډ]᪱,#=jC[pQ2XLH`VĨ"9T{˨R$@)'rk՝&Eolkyqa,I͍V~@VSSB樝PܲlN ~CH?zE5y.O b打BV)-]h{24d?>tʼnƩ>˫L ~Wb'ň zؿH`fLGuB^#XbNXLś67 (* 1Q}QhoZ8Cbqv D4[;U!O^Y4 ]-m1O㙌Jн2﨎ItΡ]7:X&t#M}B:Λ¡(ʙ(!,Eyja6ԉ%Hq;2 b"h~M72c )]?}ֈ>RHcW RGD!yz1)4~^@ձ eG1@El((E|30.ԃc- W(D05R1L1oH@H'U4Z=Ծܮ,\.*9wY1ۥ]F!bc6F2k\>EC,QOP`EN-]Ǡęct&iÐ1{v)@GO x2T["OĹ|EdxҘAV)sOīuvtGcTt?),RVn jR +vE\)+WJ)wɪ 5b;χkQXQʯ/?3@*}AMoM^9JaCT!)EB=Ho?θ>RP0 Rc|ڕN,-q1S.e7XYƿ<v% `ڐj$QnhödjY&K#XW\oo.wBF8AnuR )j+z?&r.MiGG(|$MpTUgYԔ/&18\(zNi."&+ ?Q yz+bGDVx9ᮢ%/BCRVHGKPɎ؋\2?'U}[ɒnNy=9 'bHh)[|#YZ<4!'K ҁPeI:GI,0Q!NPy!1F ,I~VFՓHuzfnpL/H9{=e)SR&ȇMjiӻ?s2BH0|4?7L;vx#L\1i^2'x[ʞyEw }$k O ;L`#czzET;vRtDuB* 0P]JƄnd"["ICa6 U&@L #) iQ!BJݑ2ƉRn@LW\Tj\s׻+G:xm[S^eW9$M㳈'W൤=N3`.L;e'@*W9#s'T{2cO{bzBŬӑ[|_oo@R"/g  F/-v ^/i;k&e\ߔM OBE)l-1yDeW% B慁t'`^CjeYHR5a}O^`6cb* dBZW#3!nhⱥ'0+tww_!z^ա&侖c_J^a,6:ti=T-doDG XPwlo[>P3otLVxzHCx/Kp. d TmF[zȮ~W:xVᩲ9 bATqhS];4ubaE1̧$"<p2Z%1Ho;2J[#H]!N̅V:Z2GZ5IMȱN`KJv;_ǧJZ i(/@,T 1{m!vǣҊ"R̟Yb׸~(I\Gu1Cb<"G. d%?$:M*G/0-w$r.oX).k󆍦lc5n+01H̻0,7ǣ%Z(٭Dv!ˈѧ熍(6&= +`yEwzfuWѱ?)V.-+C۞D{ZMӊ48[{3v矋˅=Lw\oU,oi˜nԌ)渙`p[:?{FiͰ=A)]\KALMW#F._4Xv@LOqMXteJoHx)4SQ pvyСy 72S 9/Jkf4ib0W燒 ZtOzW-zC_ȔR򚝨_C FP)Y$r*ij=^]#3;ͧd_z5vɆnU;_GDrins+f\0fmVjB$;?-T p7{J 3RLu=͖z/v*gyƴ*;<Ԩa](3H%߸G:Ӑb_9=QlT)k\E ף@޸a'5h~1[i9; ް%/0eY ɏR]5{@K923%t5X,2fi$75Pw7jdևqb ̵?n;;V͎O{O 7>e]5`z'5]FyzY~׍ps)@D&Ÿԫ2qq6*@ujw>QJ'2k={u_wG~TؽR)゙JD,>XĢ+9Uʙ)'> h{cn'-;P5йnJAL>cӔiп􎟒X7;xԢj/ !~Ч3LqWAіTB5$<(7thU5δP%&֓?4B/034Us0 Rw9c[#V3STj=qlF/H^N9܋0˰S!rNzQGϪ r(BWB\\TckUޭ، 1"&xJ" F=Sk˅m(+͎q(3lV]!Al_tdKJ]f\mC+bt9-VSTX;I`RbUWPy}q!Q?.,E3 ۩0-dٍuhXr8S%LT İɤ'Ei).ĘH g˼ީ?mβp ,;(uE:=#pb$d3|W6* IqߘZ752L=i5Vϱ࢙v o/g>gEPprfuOLtg Y}T,>AeXI랖tC3Dwi<>`Bk3Ma ʶ[Cd5G-a-^(Vk]"wx? 0 („zd9! 7hˊ?Btђq}F*6`6Pr9+Xi_4)fvDŽT55 f6]D}YLqYs3퉙w="9 (b`kŽ.Gq}nf@~GY]oA\^Vx3%1}(/lr-`>$f}yM!a'yAF{[7E/ω}q3‹͸AE2V"DqU90ay 3 a\&m^s{;!a9[2͖.BH^Df__LF>$;&b`횜kb u!h>5AvLSo- ^,5f]ꐭizZ( .[جtV T6:pɗ^.f߬j0C[)7^6CV eB7ʨӑ+T*,h[NƒO2[&BLe +mära_L1T$pvH>W`N̈ ȃћ@Ιi%>N|W~A&I[i̊w#3!e|C+sC9؋R_NT3oL%3Y`2<Wbe!}g2r1cF<_JD H4nz&׹7E 'f6 !KⲿTdJ']t5 4TBxֱeM_u筐ʠfZ h褝sE,-xX0Fyqkͣ#ַzB4b$Hg -L;sz.Q0o Cg [N5Qe\R]Cn)f:iԙŤbc A{6'L# p˓.ɖe͙OP~Hɒ>4@ZFo.Mu$ ȴ)H޽A9ykw+h_W3~2qHֵE9ݳDU_QdS?D1 ۬ "F–$E[x^`)J)U[n$Euua8qTpYuWr"-C?@ȥPDōWh ,^NT;J##O3}g,pcqH,q.9~|vY`WJkoId+ Vw{Ϩ˟,Лxr}t^X)c"o+R3MeeycE X%6(|+ fdFKVcב6Lz^^KPRu43&"N5.͉rK{Q`忷GYJ(dDZ`Oddalpha/data/heart.txt.gz0000644000176200001440000000554514550246302015055 0ustar liggesusersuZ[r#*z.zuMd+9" PlgnMMeׯ\~}Z~ jU~V&rKZ}{gv:1/eϼC?c7dnE{ɽ5_Tpu3v;qܶi};Nӎ?;mHqMpi!OE]{?Eԕ+>8l8lo,怸Y~3geKy~f5g}Lm]^,c; ^>U}IU-)O;ǔѣRT ǹyS}`Ӻmщ\""#?/GZ`q ^5E8nI m?52m/q0i},/=}7 ?[?T5'Ɉ_X!s$o^`9F!I#i]qlRB}XF}hb7A!  (Ꚓvњj]?ʺ!#{=KpKr&֋6ܥ\lxkY|>3@4ۗ>Pe(K`ݣR $}&*wj-vHiR̍e# J@wO`; ӝ,i~80dT-ύ߯e&kIel؜X~z)hշ|[KJiX3m+T2k'lfL&]TU%><=9n$C_l,ʳP=bun,H܅+ OHMQ»+ jLN(r`,񢀂y"2H3FtM"ܴZ8xJH'4NvԋB\mT1j=PԅN(QvV=K4XУm*p& Kassޛ dP1_'"^4rגWbTG7<̍{^Avǻv%xFj l(2{ob[9A3r7Hsߑ<(AH6˫_P48s\mwl&کIqnM^+SjXy8\Pde:Fˠ8 QQmʈg5WR)i홀F5ΚbP҅18 䗼tvRUO)Qɫǣ [}i-  転v9Oj9ͲDDɈt }=Y-vE[D>@v<>VHI<ԷڱKRͽ'6Ǐjpc/xf-AKزiq&O*<$N&u}w9s,Yk>` W)dXa2sdĸΗ M`J0] FI5bCmՂ;7F-#Į5 )Ul5 &i&6])ZF#Y؅e| Z9/k-FQHiVPhE[dIWT'ph`SwG8K4;Յ?pd>!]7+1$LLQnt 褄fLw7áy r˙V-`*n=8<ؘ⌒0$p·htsϒEAslu=fq#"3|"ڮ< ޽UGNe$Hb!h'H"ь4oFf9J +)IqTqW~IVAڐ@=vwb@XRqvc`x$KfjmLqp$J;aС;bլG8/q(vJ{0tiemRim8W)G5 Fʢ-X2/VL+RDWOKjz0a%EfDi$XdZF9GG=ۄ KƤACW:sŇ)`#xw pt;_o>"j%c;$"PAJS-Gыvb8^Dȟdkm@wאQ|$5˕k~7E {K3 )xf)(_/@ jBߒHUƧӞOINq ~`6tN"::86&/Re}f,SeIGswiLU4LYҷ+49/vwHP: }Zʡh;ggӕEXTn8[v X6n!F㫑.Pk(SjS# }%<%K7$&w Eݮ<qYbHQ*zyd$W@l׻FU05tzq]͂Y݃#p$rnwǺW`%S&JWd$w"iV"*',,5X֒1sEӆL3[b-{D}o!xS>T?91(]iwK<HMF XMPVn@5шDvX ^+6nQIaC54 _-͙W&pc |CuC3;4.}tf6cI:DϞ9892O[.YlG9遀ͧM3]D`XS住~+mcAaf)%A.׺'7MZڽkj<:G$1nr*Fb$gr܀4Ƞ8tkQ4A*Ԋ?(0YS;BEP9FozQ4(Y'ecgm*F}Ձi@ D f4hm4SJ-3v-"q6VoI% O5t$,;XbĪí10籠&lػ<+:HVUs,h1Q(ֺ&®E>*SdbGNO2]ՊJmH:ƭ&D@=۪?EL8gt:oxSkظ%rXeRo% &h`jMwƽͤQomt 5].7(MOWwSGttrsim<[x\b3.*L٠ć::LT!̗w[ U[4tDh`>X e .ɏf; ۿu"?*骬97)(gPW!3b>u l1"*hc&/,P/Kh'`\gO%ևrgdnQ\qX 9 yYv'nh‚dߺ`|E9vwT,TR$}0[EK̪ڮWh)ߣ$wc!jT^Li~!8cv'v2vJUԾpI(fVrЙA2/8zCv_Z;ddalpha/data/crab_BvsO.txt.gz0000644000176200001440000000334214550246302015603 0ustar liggesusersUM%' !jV72SP5z$ !Ї~+~_.>맖3KQwh[e }ˣ}X|-t3_w?+}V1o?K41C6+1Gg[pKOByB 0StPvXp!$ _ha%E ?d #&h zM߆tcs2-F 1&KoaChcL:!8X}BX~LǞ ]܊ ;|3EαԪl5I]N4{KˣcmoFshO m7%LEgX3*#(3puC[(SCárshK _8L`^8)OtH\vb|A%߂xI cԆ|0X}C@|h1$ ]h."{8UtnooqxK`m_6/KG~h09{j#,F mp<]hUsD&j1ci8`M„N&%Z! Yf2ųD p>$׼V.|ÒW6/v\%H<@6]λd[ɐuDI)k) D;3W<3hA %⠼#J@lvI  C,@ i8V5 }DܔjV"]~n-H&7hbk2 ?5pҎT5Ź6J90we|Zt@"<'0bA )&ք}aI=4j+MN'ialD.>&ZsT|]LD4=|n;ThȼiY 1%nsu$όB]ҝAa]a<4>y<z E<ƇYޜjUi}F]熧m뀾%?^GOTTs-$J˩_D-i^ɷ c_ѯ^`|5UXbP0"⦊`+K0eKזk>dj０؂b$D^&#U:"ii*ӻ.YOЋRtb6Oi <׎ jm .8zIŰVI/[ dK. ea"o-;&q',U#XH7%qddalpha/data/crabM_BvsO.txt.gz0000644000176200001440000000165214550246302015722 0ustar liggesusersUV91 zԈr'&z6R<@J_._ʯZZk:PwSV7%pa/56ѸЍ-,q0̜uq,!H Qy.N>pF)X+֭J%Ѥ}" ̌'µ a 8*T4>1r-ѥ]LU@3}8!Ichc{.yKbץ"UQӶW;b)Ef:D;uh8QLluO늙cwkuޱSs۵:qS]g !ܖVdJ@bJ q:5E|' D X'RY |rď%[Rp^ؕJ}HgEDyCY0=pOTު sQB@PZxO/W|] 8a@/:H b*ݮ  ddalpha/data/vertebral_column.txt.gz0000644000176200001440000001176514550246302017316 0ustar liggesusersMIl D*ju'T_3_"A4U?_폿:ߌ?e9OvY>}OO靟k[?|JO1fgUӧ7,x|3ΣeӊήeK>xY?*eu?Z0dOY*$,?JiMyў_gO[@_NA@6|ͥk:W(R27 ۳Օz}*BnmҖX#|v_Sa2c{ezHU} H+m로LKIu:WතC>٥sZU+Td[2]t8{"kݖOF1; 2?ӤnSW_N6mVTζ|n}Vyէ}bI ]Nm<aEKn5䊲T3V%X2v.6<ԑ/ձmN+A[;lt,YEфy=к$C[qҏ.7io_l&I%xL HfI;!;Ԅz^NSP6) YrXm=lͱEFf|ign*bI.6WGl+˾15(  Nwt+$m]ؑHT_; o=#KcxODOwtS#ܥ~r>ZpIVvf:ȫCrCbؑ"v C [a (uv~ǢT4a28yhhy@TⳆGYۇ[v;S3kl";s,O-V>ldC _͏`F^el;|'nK[q{/|T@-NuG#F6Bc0[ mXxvq[4l?lXa)BGh(mm/l7Ֆ>E:8!\[i r-l7TWDIQБJBYd3ZeYEVutZw/VPa^ Er026@kW@6"KY iB~vۈ쳸{I*O-h=Uy2t*H.pr }taHE<#D@IWd-ΧJcpcAב9lYh}_kKy2" fX /LEv.\7{CDvYTCڝPETF E:wt6v:ٹ_TH_ff,ö4*t: l2'#j9tWk Qm"1v%`;A3rylY;eVs85>G]l6t|BivHA̼e2&ߡhne dP 1VʬdcD2%$ҦE!e4PDa\npӫ\(6Oִ& rs 7xL[?gh Ǫc㏀4W^ɺ 6B7f3~-NF't=\W`d @=#MVn=ZІ.1P99|6%us7iBR*Q~՘Nߠ羛sѴ8H&Y ڛ_t?%O_}ʄ ' ~ FPiIF ١Aуy , d{Ȍj1$|o>##7eM8ۂ0Zߛ ^#pbE{HOwx̑ vP 6r>WQ|H&IN;-'=-݌PAce.sFNIDĒ6=#C, ^"?u;a|^q7" 8t~N VFj!ϊR9Yʴtұz QЃIo:,A'\خGMx#m*J W[Ѩ*L:»'M8E8tS-3#d3I]/ WZ$#;  ۠e,ZbgJZ״HH`ַID@!, l=y}r]J+GDs2x 36׍zhSt:dUI7mj]?vA*U);&LBN]g&Tk=XX/0 #Xη/TR:$4ugG:MR( :r~_]mts6As:56m_qvw~d/G"faXiD%w[M[+ǭUt!U.ȡ֟SbA bm.,", ?{{X\t= ho `b˴&'h.Mv͓{r ({Ρz]Bwv-֋r= {EFq=t + #T;3\_#c8 }:;bF@5"h@_-k)KhrprB5p}"FM07hn>Ѥ!!;{7s_T<4,).$G^!Oo !>O"I徒kIKZ8MM;G|4Qt*7B*WyAF hyJ"AɜvB ވ8!45QƼ9ŕ~Os=;5cĄov6j:aJY wF@׬wVl80Aq/jT]dy(d8*.};гC~@3XƤ;!6330gPڦ{&W.1vP}NK@ {7f] Yt'0-y3F1,WI vwsI>ђf}3gPW'#{@F}}/[T/,k$1`F!-F|@A)2^2Ѣ}$ RBőuY1c?1@0a40iqL̥H=Ϙq * vF ׭kp7>߬Kф(Bf|p> gЅzY 7Oc PAߕG{#j'^×"X5)d*7{ 2Qϝ蟾~r=YzH6),v4'Cj> >>`y/^d0v+8g&x}8&~|1uPƞ45D΀B3tuqʁ M =~" 6:>hc2VD5-% |aML02iNhE}" {qocZ@6^Fs#InbVt49#u">N { / gY1'ƾdPYPZZ(۔ -z*^+/؇[ԑp'xiu@ `l9~;a[eKw3nb#1^Mh2;T N} |QFd4GMaWa,ss@q ~aRϗ<߼M+D'|yYtIĨEaF3U&^V(~e˦oA4'V?&G&ZO7,70/?HCہIvK=i;j5Zl- ɾW7# 9x_Dt)ڰVxUQ/g#j^3@J KV}ilnE8_a{懫=uLVWp9.ddalpha/data/ecoli_cpvsim.txt.gz0000644000176200001440000000274214550246302016422 0ustar liggesusersmXK*Ud"joXHA7IE(-׷^_ߟv_u=y_u|~5Ht}nnۿj]okz__u}'An[M8'59 yzst "⮚Ozԙ0V|>[$o~jo!j[P9$N堲n+zp ?D!'Gg*3 ވR ˳wtu3#\+qۀvMwT^|} \dB?*=nj)J.'$2$0}@ndAB܀`nGH"KG @#Y pH#m2۶?kNg`";o<ƑIڮ]6}yyd6~_&eQLV]r9OZFEs)Rۡ([tg] %Ĝ4v5mfbujb-c8lSԯDga_$[`n$R }e+a۔Vi^djݹ0J#<>N @lru2.\"ŁUQXW̄D(؀M5r?:SIh6$}?4QP+hs[dGqB*@,mpZ#B-.=M)(m;1h?_a+]r7 WQ|uF}FT(>=}IT_%=RLJ9їӾ>сўi[VV0/PND[uN&I&8ddalpha/data/ecoli_cpvspp.txt.gz0000644000176200001440000000246014550246302016431 0ustar liggesusersmX˕0o`^KϛDZ(f/< ([or}Ϗ秮ד>?Ү>y^KMb-]$UYm[ok 7}~f4n^Ԃ`#&ﵻ hN,5 >ȖNW?)ÇS]blIō(W $%8 G֐o3@WGACIOz 糾(b5=&Ex|0IqQ ^C d[|5@ԑ59 M{%mP-@Wm4CĆr(%h@U7 7*,0su~f~c\v\6Gn#6@ڑ^{ \qU\lB}SQPl(hTr99$y 1ڏ(w;vpxMMb7Y%A:tH#)@xtV6Q+jdG& ݊Hu8]ggf2X7$l0ɋ%Qed;?OM9E7+)^=HLrAS1T&0*1BobN[3fywiN$&XwF^o,7~z4.  ٽ&- 4`y;Y窱{OԼ jcUt:\_Fj .N]Tmx=I1+ rv+QsKo !͕$0sAUD6f8/ds u̿k3hіO| elB%2;n,]\%4HtsK>{bFre\|r"؏&+PbARť!wj Zk}Fthikaҝ޹L_s+yw;y[FHsSD!CCeډ BR,o'$v?,w <l*KtmV b^LNp-I@^4{{:D{YZ 2FɌ.:1c*lk~]2%w1XTۻʢ~c<5YaA|aucAiЙqs^wCJl{0ɫh6o]зR4K¹֋ιnRW7<omosk!vָxyμjJ:~xSXfADqu NJBZHQ4NY3%eصT/sc\Uq^+}cĵ9I7Z]e\+Addalpha/data/glass.txt.gz0000644000176200001440000000451314550246302015055 0ustar liggesusersYK4 )MJ^c}aavspF(SYY1|̣zBۏ_~q^OV rItO|$\U>]>5㟂`bZpO,WOC])Ҁq`r}|(1_v 0*ifX\TOLRb*0 ̰?>O&ag ;FۉÊif#y O:0qKXWA~bxa'g~kIY1 *3AD`3 ?nwUL[`73 l;:@~ΈmQ;Q䗸Ơ`'ivψӨMAvTPo YMwGL*P:`uĺ"n.FNEWE]}ʸ]o@W&s 9~4q^ba~knA#vw4̨`)di=FU0yv/P$䪴yO]z i %bX1|rk㕵7SGY1ҟ&'j]Y2 F^qۙqc4awl;F?9a':5'5OTv#WvXS٨*=zkhj_`l* շ9ǜV{;,a/' ;œ=aoWh51ctw/5{CϬsJ;#v;BXzIfjzFˊ;ms@70&@1{ә@Fgmi|{$]Maj't0ķi!5 1[dƷp;C/UZیGʚ@oH2ȀmW/*fl%vXqљ'z 4='ުgS+Z[QYRprTOT%-{IztfnΊ#A nG) _94#0P  ')"oSΊ[B3>۾PI:ۦI9cQ,L;꟪#4bFb!2n7Y,L"澭3W`SSǨ Vةu3ZskŅ&;s\MMÔHӒkSVԧ\^vʖeSc '&l ;S*RCmϒx-RZk&_wNV_12)#[%դ/-w?KccRԗ^F&2v-nOLjq~Oڵrua>1@m^GlN~9J̵* +6,OEf턅|5}»sAK6].adz;HfܦTܽKHI)=Ў[kNpCK)cǚ)i崻xI}*s͌A ^vޠ(YsML󓚰BͳCvJWo;rQj^rZ.Yt]qTܴ3?DRcoAHa}Z1셦P5G#"D_h>Ɋ;`1nbd{F"a*+WXi -4勢"fO)PG(ڊ?#؆w1bJIArKGHM]zBjhsG´} (-u_Jv ;$x~~09XV;;OT?㸢6sl S/̞^m/-fs4gGJo[V"0 16xړHwVbY |ZJ>kkZVx`M/,l\N;b8r{81sE)P} HպP-֐k;.Kw ?e%[,,jשHf,@SO01`a@@D" y1GȻ@3pH y VnM$sѨ)ۡN7hwglRl^zRBv;pD/qk_wU۾cxGCE)~Xop!nש/CB9iiԗ!ܔehbxUlJF#o-$ńYmmGL{[˲ ՗!}~+Bwf( <|{"n5/7uz.jB%G٬0k۸H+;6Hddalpha/data/hemophilia.txt.gz0000644000176200001440000000106214550246302016057 0ustar liggesusersmUKjcA =e6\Ä0& LpY=RJRrԎ^=?С[f-cʱ*J93OvI-? Ǘv\_܉*Y&$ωt];_lG#4 %Ia^nX:QZ@Sar_>mJb*L/ծd~#R\ 0^'"_TrDܡV[۰r>LE~O^ƌ&ȒiR354U{",nV2^r!-~>[w?x?aEʋݱ:yScS l/ jz28mMS o#)$|hT׿i0>z&XWDŽCi˟XcJ%*TA+ BYv!4Ci4ȍcX|bd\쵇/ ʷs#zOC7]adv8.RH*N%,I|23; '<}Mغ1&Z\[4WFB^bdSLݗnj"J> u'k,kU<0u)(B$P/KVŹ« x%FRo DrMCô. SlAR5ES˜XJ]8 T: #vO`i}tPI$B^q%/'陈&6ؖw34pՁbG W>8 QaRޝXNIlRn'-Y33~r]^:QLt$AB8^Ӹ?{`G0n < h6~D B\,lhZ-&.k= hX"Ez9czd3?e-Uuun(ΘեNi2J7D`l/Hg #ɕgq\.&zb.h#X9Fϟѫqģ ˉ`{Xew/V$PE =x q؉ąɪ1n+웧]_/n, |sBrY~ݠ0$`s7B=Gp֍Xc<+ˌk ,t6 sk2<fl0Ȝi`S+^D QZzUNq>9daɦ$zճW?sH[,ooIc)ʄIʒ>ZMi kTjm8,&=DyGl4a`PjnrwUu.|qI8/~?TNn- cr{ȋP!WA5+WZn2_R-va]‘gCB <ۜ*Gn.loz64~ iih}* "{*ܒ_Jj9g Vx|8_g蒬`Ƚ"`W,̧0\1ZSd\ i+; Y eȶәNNfaTiy@|4?3>|)4`1.b3N8xGFۡ2H ߎnMT43 Y7%7LjmxuZ, =Hq7_{XD>_g961jX'2mO elY+<K J7(p;SѝvCg:L=2*v[?/9f:]@)gGfuH../ LHsEz9}Y[ey'[+8p][aMOK"9#n?kFrQH@6*모=w-Blqd% .b~5ZQ3A>Bdo =@Z>MFLN H5Vz*j;!7-$͒Wʪ 9E}48Ŭ\{n{xf<Ul#s7E1݋UF]$ e=oOYW pD} p4^%tjL#|@^%] T&6 䙿n3x 7 9meǁb&@ B.ۏ'rM!el~r$]`QeK#{AtLo$'xsi>躥^jxuV]{W6Ͳ1Ў J Cz khʗS3(@EչuD8M`x'CC\mx&́TD 7E:|bRjlvfH#r>W(=yZsyz[ 廲+% LCHK\fCo"G7#c5A: h8#\EרP _ѣJuyL ]cY4$BLR=!W',zmә2ߍsjx٬yq$P=GBD8BEhIUCbjg,a6=őM2 axm]=5 X8B}™Мi(QJ(zi~VVg2R'|R-%@9 3K=L 7q Hpiقv[ ?">쓆W<g2Dה섽ltw_prQ$Sp*y5[l*^#8~2Iq-~rJ2߲iҗ`T-t{hweI}Vg*rPQʚW3()q/`lHq:(ͽ1 IWNHIK#~˅7%!J. v MsO"^V`Whb >ꪲS̟s|H"9 tiB!ǚP" [Pa1U׶\9,P&~୐WDL+eH_?O.ݶ>O20퓖{zAF"bp, kzlHgxYZEOq˿m웏vO CƷt~8xLzbܠi_WLP`xi@ 7͈f|aZOdbfNiunz})wqȍ_7"QP/Âu ]=GkA5~56Qf HSDYF*c4n+n}`=5q#\<1mK|H.Xٸ0 È?%I $Ƽa8qߛRfҢ |73@nU5ʡf]_ymR;8n>s*_,yz"z/`X n~&vsgF/o rmrPYx ͞e 0%|t\4LߑQ#1Ys˅(T xyd5n=zn|ϲjonۓ4~>;[ Zz+m񖴐}$;&&cw7HnP)=ٱmP1^11Q3T%qɇ=3^; _Hk_n}C #F85F怀۱L׻8iԽ,xXVax^q_)ҧ78Dfa%*߫+ש[D~ {%g3ӄ0)&10!jaT馳=‘X ViCe@"vػvsc}giP:Wْհ[tiSRWiNA0e啨cs=HSwr5Cȃe%1& p#1[qj{0l/ ^r/Z#|CLi ?~d6$5V,Eq&1ZMF38R6B(̴H\p?#ˇ_&#& 1煀)r]u)ԗ:>P[YEXfa{̟*kUjk/{_~|G w#F]PCCš쟄<:>Rޢqm08HhRuSrIT ~`ȤpO8©( Ν͔2Z%u}Xu0n) MqDMD b9 ,&ոğb텳?oE $cJuG~`KbZ#Y 5ME{YdD,)шT4T1HA38;䒼3>D[7ie%/[Dl'z̝UYN`j" cT a[N#i?k94Di 1heS9q"jj&!祇;Mli*bJ ‡eTb" Vv%Tlȶ[ ߼*6#tgGs-3i6kyAbpbNe uH"gI9Kf|09lGR8}gB\&D EYiSTl9 Nl$ hbMSNjwp?Mo~"{8~QFYiewf![wbTVxz2{R87:b>^1%AŎ~= aRjootbfu$.'8q{ٔWWu2%+}"-?g\*&eE\wݷ wtb|T^0.С{w 2TtC$>ŹcD0vQz-tkP|ŀ k6v,@0,$Ha>y2L̚b;\YHSLi#*QQSbpabv Ϫo{ ڴ.u=,Mb XLnһL] Zd` >&?;W0S;@ra0ZQ=` ]fMFѰ8;O7)gԋRՐ:׆Lh9hvL |Zi8:+#d1\>a15ʳZmJԊVsdxESZ8uVDCړ(z2:O軛somFjp?UBnl)xp6͜:?C;걮v"!E9o膭L>?gXO93C}TDn\)0ҏ12ju͛iHɅ o2"%.)*,Gc3ꎶR2g'1G7@H@iuL^#INUu]v[2M b?CRv47) 8Kj#2 wW)t幗8ixB9  7u\<aFG8a iwlaR {Gػ*s`CSwT&ld{!}GڌGW9@e0g_BhpNx"N}݇Etvt{*iN2\l/@ƞIh &l@4~AK:97܁H%x0wH] F=5 85(qrz,_L툰hr,*z8}c/סV83\hSպm6j BQ g?+6m=1+¯b22- ®:|6jhNxj)L/CHl}1QYFk"CpyRr(fz&τOXmYӝ*o#Ox}Ąڭ#jMUGJG9uo,ާ ܌˒E%Ujb2d 4A#ھQd3h&)>n-ݽt)GJA4"@ bV|a,W$mR! Nx#r.ß52ϘTۚݧǶYIvEe,nqCIt(r}?:P.=ޤR+A`T,}&=xfчxf}&UiGCc޳:rCfUkunnCP%I_{ى#*xhiwTS&r@{ o>~ PG^#!;6S2,Ti)#hLpCUg}EWu %=TNa0艠sjrI|EFsسDY\ @!$Х|d/|SdgBH!&A*wU0y> L> 7%#?Uʹcp̴̤K^?%07$T3Iw5o_'0#t2NqP)xWJ+F4$hh)&x=$l/>A+]?A${b >/ZGaEAaȤ6TAv(2Rzݏxԋܫ/5@d<8,NDn\t$3RJ{L^e*Wb2S@i雿}#tWȰáÇJcAWOU1ٟym8e{D1)(ry] Jz3[Twj8CI']Z %#72tjf oEw@s؞49T,Ɏlj>_7;TZ VX2V+ZOf#ްl}}!ս?s.$W V+ʠ3(y,D=Z%IWUh_,K 9qy/6EM:xTC7ӼzRpg >3[/kY(S{eD D΋g8wMQg3Ŏt|ia@Jo>XӴ,cٻw"G$\/R^6e$A:Fkp:՝jWMOw }~Bh5q=]{%R("Թ#蘫n\2#H5G!zHgUg!;:x."bms9O5 B!1uu¡}\Jv&aI@]J0>V>NL YbUV A-/nG0*1~xabI2ܚ LX犵[zo l)ZNHJ` ؞V]Og9C F$e4""V8Eږf ˨2R+M1.ɍ-l7 v؛b"'1ky`>+,*ۥWhSn/bQ?&8k6] Hī]GT,)K<% ^,]Qm/aS/h$ˍ»>WV$gcK\Ϲ5>kJe|w[vz<xE}Ej@I1c+-Lhr@H8 CCl3ι+!SxyqOC2F# `@:ItLiux=0l$4$szN0b,#R{ ѓj|kNl{ SpPJsV1;01h_P^yh "r %1^/{MO _8l۾^-F`B6'JBȄg_X~RҌk!B_cqn^^N ,0hP\yrb|L-x*ۆa(Z'&yl*۞fA={PWCj&Y,}2ډ+2 OaR#f{ʥ y[y=P%/E'u1+AUp6[T]R\CmژSegj'_&0X7M\nKU Y%6cB Q }^R)m#XY58NdX۵ ;[W%]l)Q $/1#JwQv>fsR3P w"54#d <2hG# 8"zJc&,U_)9h%Ç%)֮S&4 ^H˪?Xzr:2Xҥq~[v,+WfmK%bE_HBp٭$Gpp&Is#ޱMm,g|p6}k%Ho3 *efc5>RRbH$ݍz ?LO]9<-VKiZqEX];c9;zpk_ǹv4t}!FTu/wn:p1i,^F-ٌlۚg%/:+iU-WoM* _ UWBi\ΫO%~0 2W y;^}D&"msA $2}5u[~HQAu8Srՙj'Sz ɭ0+[@\Gۖz+0:k}jDӱ.mQ67sB hkL40 !D7R[߄ .e>)0MER՝lDf I#6/} 8+Q.]0X ޺HB# yP|[4B ǘ'U`vP!(hut2v=A["dž*1Y߅;ҔYCk&KIQƛW;LRB\y`d?L׆1AQUkO %ߑfa(52~K_6WI9Q7&j$0@Je1W/\@8rcu ڍ.{ 05%`6nXJ$!*(n!xIW Goc5'r'$9GUHX 7p{Cun|D̡gk|) 6b; ejy"ޭ"JL.ӜcM9 # %Ga;>ygԘK^CvOvi)H+*HRQoe7SR;L*7 gEb~;hKP>SݖxmG{OSɊO` BA#Y̢IgmʩNiy4"{-@wܿm(oR%hj,cV˶X1< k F{2]B'=+H~\0C_:!X0^IQ! -ЃGyK`n-͞zGn9مnx۹-TZN}>QvARc+ў̮f 뜫?w E>ksA& :coPZp0RۖP\3`b,^S/d^)O:йc63ZĥNO0~WH76t"M*f4ϰ%C>/vK>ryc=01W4egޤ;D Vb'f#P{y N:kleH dDC?6F$#YB! ,V,Yty5+/<EKVj _GPAM8Ho$fd էܱnpsx)$=ehjFk)m2i&Hm\xs4Hy9YźHHs%bnM\\{`1CSB*2SM`l1&]syDC"ɞ4n=Q-ӟW"SI d2|_XDϲ2yAgn"AJVO}1i&Cd 'ˏ$:A9k8y{9G"gP;-.4X5o)HaFTh)G[rJmgDwMr1 -{αbhOeҜr!m|QSL(Q΍L Nb6ߔ6vw#ȱh+|$n,5X{\W7W/ }YAF8)/T͛Ue(T *mv=ر~QT# ٺTEg ҆_^8'&$[ٟO¬Sxk쳎/@389o[ړr֋<WMͦ|vi!:>N @ 3\J%9s.y?~,}RԪvaBdr+ d$sZ; jÈLKޗR3_wr-=v#ۡmr3}s> Ǹ];*n@5iuNCO6׏_^[jl%Jϙ$(lp;rMu)T4!!9W.6IGm|ۀپa4aaRz \VRJTj2a6ڎ=;jV ɺOQ`h L2T(A톮6xӔ͌]GsoK[ V•m`"-~;7M%~ wlKm8 e̻e1Iܙ: zgA>sER<\տÖա 5saVZ)ۘ5{V U*<){NlMwEd@A3A.8op"*ƃSQo~@Rg3ݑOgK*ȱzigVk5_#rTi 3]]/5&ְ՘NLDm[̖prt.W:h7)cbv饒^x( 5qL2"׏9ى cu'Pq~5ncLH]M09 _zAfuZ :hEi5Zz| Y 9M|tYmq6CfzUٖu6%sh&}pP/4S h}(gg/^ױW_(c> P&S9zC2Xb;/M:׆>3= .ڹ߬=VM&y-Ao]hY܉$0#'4LZC{[~SrWvA`taba >H!Qgw?h5M]­]u84X j2Šm֫}˃RR0,J$5B=8cmiH.ZSNչVGyMZDߥ*uI%I ,^dg Ho*{> <.U@WEFոq^vm(6])f)kbX NQI5ELUs>J* AcDჾ{0/Ǜnxc)PG@ᝧY8̢eF[+֮/I2ā5e8W^Fز.G)3_]/Hw{k4xW3 dƤ&k͂V9"1$%h*U2y>6JQdBnUt>C͎W4d7#@,9Ӳ1 xpi'cȄZ'&ǡ.B1=TʶU=4DaNHd7ؖy|>*WQO]U0!9vnիߞSf‡٣/I* ]k/F џrhp7fyo w9ZU'ѷ?罻bΓSe#/c/V}-B>} `N3׶˴zxWqf$ zZD0dK$X79po͓5D[3ZU& fLek u{j3*z7E޲hK*rMlxt^'=<ڴ*sF|]"P3Aۼ@8uqa+,_Zɷ4heC|)ѐ he 5"9ꔝ8ܜ(+%?TXp^T|gMW='q份'a1T><8 ihT÷C†HUUn~dc["xZ^F}m DpZ~ c(@"Żiޱ82mGJ |1'''tԅH-蘓/"/дAGR+?9啢WRiF7م+&foel|B2#nWú J`A]m˴DZb@.JB޷5IQpr/OIf/ykoBf#z\䲾zw TNZ`%BHbCOU.Nt tw+I=Ov:ZIAV0zǴf=jc+'M54u*>tWvݯ OQ&*$ZW',Ȋ?>nR޾TEj:(`.%~fF%(~ saxwA4>NsjEm_ 44;hIS}s?m3_ ںr{^; UZ2!0@v .(݄3_&ZZsQxdu݅] L و3Ӏ(|$G^~Li'S6YI˻`W {ُt v {r5`"'k7c:iA>~pChV;_3XŲ^6-wۦĠ_bbc0FbF Yi`aP@X:8[šR'%[/=8XIf퀠@H1| ؼ$2ZH]w\[-_SIZW@Mfst fWƓ -ZHt,^??N$ЖhNƂq>}D6 ^QOm¶A{m0 s(l:MC[Q:uG%Dg 1419pJWeFL)SY-ǙfOUL#v=cTwu !J~K>B~yp@Kg{0-֕\K{G I}nG=W}x# m.5Pp3 #pcXxRFm3OFbݒ`Vj?Gx(yKHHKEj%Q@s]i4y2| 9#!v *fU|z=^DZǶk{XoMye0؄/4/* /6  cw29`m)$ZBІŐ @K5Dcи d2TAkt~aU{䑃7m\~G:qS)yvL3R3''ڹcISDFu8:)x:Q̃HC"%ltä*! ? @P܎2_Y&煃vVPν~Qei`wѴ^{4rvE!nQ_:˃;"*.Л腣XC3_2ہW _KU%A)VR_xU?o0ԓqQhHYw ,jX?qڍB11?) kd]9,;%,rcƆ&cǴ6KB/0 szܼWB_2? 5S__5VxF92O߆4Cl:Pr*"D8s Eav1WĔn: 9ԵBG2C w"2gL(1Ru>:ym *VeU3!(bhRTh*}ʛr8@D< EQxX2[t/tdO#)g"7ϳ8xꋚIꂡz2$z9}t5Ȅ9iy5{ #tW%y2RmܹH F2(ֽndasg)Ed75͎E. Ο*ƩV#t&pQh hЂ8%gda2P8s{bw'z7Z K!V{c"]Kǫ՗HhNo/ D<>,-B^%{Ufqb(bW76!j͓*N31 ӳg"_'ky2K w ܉VuG2\RC)^_ݦnw+i78q;6ΐ`Pgƾ^ zM`k ڵ>lxw?< |%9yC^j^8/]뀮!fU[Y0ygo-ǰ'-n VxzYBi h$#dIͦBPQ%jkٯuNIHs" J@noC𭎒ie-*)dɜ0i ;%a:'6'+K%vJi11=ҚnCYݍp]&QMNgK|:45Z^KS<1дY? g:ܑbA8.?q|Ƥ N0oj7/*-t|Ңa]? :B!4,_y#~ԯO%s^(]-43N@pσ+i:}x_r/h?/;Y{5hkd!t P7^AxZ $ :ޙq⯧m^wP׸"zP\[Xf/𥞯/݇V%I~a? pzt"Q1zMZ(.K2ݘޅvߒg=n۬t̰)@EB[tMѪ{KNn|q]|'1U8saQ%eW֥`*C{[_Gic$ay+YlQOlCX]#ɲBR(F\%AE'pL2T&g"F'JQmhD)xpTFOgU>v١+%c3J ptxWGʱry%Ԋ ek9=٭jh@='\Qj=ng=_Mۉ[Gz. i5 m2En<6b,`q=U]xDyj sCƇ鈣%^ђHE3@?a^w\Ժ7/u0w [8kW?g 0qF#ߩˈ^ڧX1%5aJ$f$FZ΍eM PذǘX:пhMsvyIH.yn75J Ll pC]Vu#\,PIfߖ  P٧!IL<}wp*k_T)wذ8wb^ٳnhʶWQC"QHry+Bmȑ\3P7o4~99hEE$ O% ]=垴4w+aJd#(w0P'MS5/-N)&yg CXi@sxnz^ `ׅ B }aR%(ʂg1q+J;N e;H((QT?S {:g^#{$l(1whǏ!m a~`BU}ߞ߿>0 YZddalpha/data/diabetes.txt.gz0000644000176200001440000002105714550246302015526 0ustar liggesusers]\8 Z}9%Xꃺ$_37WZ/e~=}OV>?k__7XV\;]yev{ .=k Oc}߲Y¹<[w>7w&zޢ <;w^sU6Ÿ=ֿߎ!{^o]v~;νwэ'הׄcm^SҢqdzWoEa>ڌk؏sH?) km56c~|{Zw6.<wNq琸Ŗƫh>9sB=9yL,&goʋsw\s;knXمͤɞEFEht$loarXP}u<ƫV1sh}`O-yT) ekEM' ;Y1Gӊ; =t>/[ 0Ҹkexesy Wz_ I?Ic#qG-έ}ApvcޒqeOZ1f] Nopi?O;&"˰|X*ϩ>db NyV A&=B1M:YҢgb+8Y8g)#9FגuYVv:VÃ<*#k bh֞/GS=y!6vKp6aXpdJ_='w nWO7j`)n.><|V>iF7>ud=X3WcxZm(Q{Js@٠[lpm)a;o?hY^,.@sQ"w%:"';6mqe6/ n_MƾyY/eeZV~laK&V/0D+n,ĝU(s-Ic1UإV97+VW"3^Gu7++ <_7L02UV$KjO(3g_Oٞ=/{l#WEY8 QK]<lN'd@+'h[2P&ZfNָ8D;LZ|7#z*"&O z7V\ 1`rqc։WGB3 8I8AAcdE@ ={2'c=0H.fGs- k vpU{L kW:ԀKR -fhªdw}#E#!hR86Bf)OesGzG+d3pfUB3ۮvL$xr<2eL85+|dSDE|XLgٹfgSZ`s؀΍ +YHm`tHG8«Ωq]r`Ẏϝ3Z|2BmCݸ#zfҳ`:%)wZ =M/~=6_8  &9w>!h[#u\Tiˆ,ZeE~t҅+yLtSmCa%RRF,3tqs :q#?չ Ȇ B?{1|dwܜi"+L:?}2b^lB'V# ӳs<"5FoqnItֺ@)%" } &@ky[LUs1A xߩ.=y1[uQKSG S*'OK/+`w՛tX`stpцS)dytnRF N; 'X:>Vzoq32`|=?46#%\j$1{5R;55r2`J!AL?ţ)UMī?H_ȍ(7VHc CHmDܐL|Yl1gr Ia'f+7/Bs gV%"d_xN܅3Icܟ}r7"wkR@UIz.f蔌²M;K!׍ 䘤r|n^n4#*pdQYrL(_NZMi5brdi .I m$5~3cf('%}o ekH~ 2q!q!lsVb}_6t9,>za̚&eHUlST[Jz_3t/UE` s.#PJvA_ ʪRv겺&&\FΪɉ1B@ 9CF \ݠ Y*C9Չ/x}[ 5Yߏ/`>p$/LDSbvaK\#>wynĠ1G2wS F$x.V .XEo]NS0Yf T`00 |fvd>݈xC4:Ys&^-C!>:$Zն9eB2f*X#R~N+D08fd%* 9n jeB{JE|#Pp>|2F_AГ8hg Оq28Ptt^"WKGEƞ[4&Em!1j:%@SaGLU"1P;=``͉RjqyJi%Kk~|jk6ySk97pr#h$D"Ƌ#^nEϾtE)G)d$';jZ1D 6:*)^ξq _WR*X@[ BϚI']aMx"Gi-[@Y(V0xb\e.RM݅O#F6DL@h0KRD̞=L2W.[/ f g8)`Q'G,)TPۊC)?фnjڛ$Il`ŊMgWW BQBY2EiidSA*D#UmI0E qV& pʕɣ6ӍȨf+pho뜨Diƒ Z2W(Kz*xH.{\`tŽ(tJ*eŰrb51j{Z/l\Bb7,7e*S#/ (!{K@-;ӴBF} KU /󐻍_a%n|iS,2ߤ|H_Zax54nH; O`J2> `%%/*cU9=qO{=`So|e6&@z;TS5z(;2^\چf'k`.1x#@{Q@u<*Iv V ޺'Yc8Bڹ[C{X8U褝eW&d{T~BDpigKprGu~~&#٥޶`11Z.,ڵᔮ!'uTO2mi+iq^튛ʦMzRըl-]FTYV'D8ՓZ<4_.b @ =TX$2.}vHZ!XeSAJtS} *_gZޝvkmgELArK,ZoSzΛU,< ku|ˍ#e_IPez)B6g86}R[VO6F%ؔ%3|)dpY\>ޑ( iM6 H<Dlۑb=LEXvlJ{WqӖԎ4 _ǔ;E,,Kڶ<?c6fTȪ.R W*%J*~zG+HH`/UhIjYC*^ɱd /XZLԂӉW*l[NzUd^i/A_!>[bBCn 6E2Dw?CEZQy OS( 'Y@ssJW+h2 Z$]|eVDmBf&| %iGyv0[i_)鷩" jkybWU9@ov҉G~r^HbR]Vsv%-;%{xIز|?=ZxL3)B%nwO!ٝ"}kp]h &h36LnZ{;iWO#LS'Nrx^2\io* 32ڏG'+ .M .ԡKѩF-!C]+J\n c+;,z!z!Xc-q1Yy*W'jfn^u V~mYWlGpyIP;GY i:d)I3ff'yTco9$BsVC4s3 $;|fQ0s݂}ٻ%'&PH,7fIXSUk0v(g8szS |ZO>DJ.a?wg+ol 'ȂxEFau;LJ zF4 vm0v@K$y])dߢ0",&qTB&(_dV,(2/;QapNnͫRo+_>U(.Z 0mX9` g|0|AbSpQ,l/~H7*Qoq /Z vbRP"/bQ)toBD[=^ p֚.qX`' Teu;6*:IpzU%8FCU~ͻ,/567f*9;W{=ijvnW/UG̣ȢY\R`5;Q]!nuơNGt:5&\R?JpgoKeWI*TJm;xŤLyRa>Z#@L[OD.HX?8:S6Wr.n0R3 S_gˆ3>Z")iiJ/!^57zVbwr˭dj.5hK}_ _c krԚ T4p|;g}0n ,]'WmxOqSC6 &ԎsB/rǾ4|`2i %,SKGsw6 :POFnlAB=mˇPf|)}۹`Q|ymH&C<r˾ެGQ!D#=e+y(;dJhCgR+#oSIc1$?MGwSzd{U%W4:{(q"oj(`7ƃ2f(sR$w)Bˬ9HAqUKhNF*Ģv9/$۩1C9#jYI i!9[NދyA$B'yhDݮz~AKN\zUQӭe98x3k6xҞC*sD^xhЉ2"Qbh zVRn4,*qer`0Ǐ)mt„bTnc[=^Itl3aguv.'9$Q+ueKY0Sx][k>ur;PDq3^wpߵ'gTԃuy2J<[[2lTV0g3+E"GxʬD9qvq脘VY l2p]MbI69t&=UVGy*]sڌ 'ByHCQ;Jd_g~tpnPvxJhV5KXs+?5ˇjn4኱OFx}={fUT vJf:;2+b!֥,(I5k yN90fex9؜[hJ&T%< ,<\`D>oΈ-]3-ⷷcxf1 EV0ؙ-FB -`VoZV(Pfe7O3 8mveIJn13u7L[3 &nj=&)w{OZ\V׾@nrUFOjDƴpPSbqoA_V~ec⬴ m2eYw!HIä,2 vQߢrݒ1kˍIq/g"2fGm3mz#hmߩbúh'hnҹ]'f+³S#%w*YcgsW%""z t~`*|"-7UBYABQzD[bDM㍳Y@+pm5[bxtO7#ҋ0Y\HtO}xߐYV DOO#ͅI7*К;JmjQG~_:(1Ԟc0# >2:S;P똜ͼ=V3& 4@#&Zi7>^0Qє)c"Qyx5pp[TNJƄ_;:Ն룑[\i~('a|mD.5vnUCoorlsB캽&l5ݱ͏eg~KbkPB ԘV|Ds=-ً2jh2 nM="2ںxqj;.33g9MF pJՅPk/]bk,@񕯻@1L *2hwqu^S3e5Y߹~I8s>t QU1! Ltf1rKmwzL$>&RW "vPEQ..k0GsJTrf5$UģQoK imVLi4j(EQuhI?]cj *Mx[D䖞[\mg$Gi.l5Nx95I E}Դ}L9-ds?͸iWd}4M|Y*CEè]r1d=KGhV\,!.k8>7H~>U+Znqvs>T4pC_~N}@N)RըmDE1,ӝ)W ֘ȱ nT)EvL!0^m*߁il~q2rXA4Ӥ_' 5DC@<}v53"g K6nO脆l4z,2|Ipm%Hd7N m 3yqZgBkϑ){}7JKJg:yC=n8_HVFjz4MQw߯'!&>'$ [m;D);ݘPqEˎ_UuLT-[Kd 7B[[{0& ܢx&62r{>nS3V1 }|6_U sn#]u!4$@1Nj~ HfOJΦvɬu>ó+M怩_~BmJW%Ga( "֤ōxͭse"W$V9_~ZD!ҿr/V'nˏߠM”R]~P?uob'S3B$ӸI%y~-6K#ş%^ 㥔<` Ư-nn/¦na %ln}7^H횭_RY^U DmTCb?m|0 [ddalpha/data/indian_liver_patient_FvsM.txt.gz0000644000176200001440000001562614550246302021075 0ustar liggesusers\e;n */"߮wL$ι51S,. D<O?g|ϟ?ϔ?!?S?1'?chsL>S~Ʉmϐgtk렾>Y~9>%ٚ7:bi_w&K7?Cyd4Gs$e',PteY!qG9ˎ0 kqy>lOVl(eL ;N\G g)"*׫mx;{2Xmr-x H@"Y"q>έcM&؞ U?;";QuȱL(ZdU?fe2MU&Ӗ"٣J5s;ߏUd>req;. 6"qRѰ!ᖸ>'ȘHv@]֫}z`VUd/bNkτ^k̐X-^].4GF#?~h3ծ,y4s%(}S!Yr~aHVKWBĄlv'63rT~D110q$75j_JTj>A\_ZE"WKe_)CkP*|1%v3ct=ߌj0_r}Nk\b43BL!*KT,t T$UVf b5zh(fV>)dD נ 0JiEk\HG.1r(>-'&B>O.[׏q7UF#GU:*Bf`^ wjbD) ZK㸇D30WǺ(ԥ~e1"vl1Gq`3Yg`ɲ[3i̋;!"4!yhw[J. 6 cwAZ n:;9fO^`'YrG ,Á uP~*cC]ۦy5Udm@Md oWRME+1RRgHIT@U\EKn 8=a:м$@zG1g䤁;nvtݮ(+: U󮗯mAoNxC}5d<7y |=1Gf4x M;(:ގbBg#Ob/_yĻ 2 ,sȀmtGn@1D0qSM$rn(/_dS[;Bujb$`مc蠫mȅC-ȼry!Yol<򲻶2( cٚSpae0Qj'[:Ve>, K{@jT ;1Ko33jG\G[^YWt ʉ h;WxqZ=uv'30Qk$6@5ġf\:Qav%Z(B9x-+Wq4/v?rW _tqv1$!iߞqjR ةeLU#sOeW;d4) o ;E5׾^095/7c8B⺪E*1NcJ8my9iqa"{\%iA J' Cca D ⯌ mǪ`(/fKeR$Hog QE[u1cj[E%Zx^hiu610%k?$b3H*EᒓUt88S2(3 E Z3aV=ib[(¢4s4/6xbh,_L϶w|YBz\#`J +J ?e]ꅤ·gbfqڒՏ9rדh4QQC7(mkx @l65kH D D<~-$BQ%f5Wn:mTn3$N2`,Mdg"U27UOkTӹ &#%7rg>6[EH[#> ,)ޘ gٙ]:B] @Z+@K?L=-ޤy)Zzt꘧YaG6 6"1.U&8zG)vW+6v8[2˷EߛDXXQ cRӪHO9DԶG_*RiT|MX' aw#/:A<죭/\q I4 ,0*fIz:=x0ՈF1Ot=>b34kxOxZ)܁k!ѬႥf8N_Ol,UB~r]Q=4r!GуN3bvkޡUfhHJSc1-U1_%*(/ eH Gt>!2}5^ڂGrs|+3bc{0<ۥ#t zϴ@]ϳ&١dNKs~,eh`( Jh~sUʦ 6-+Â;ᘙUcgoH\C/' xL"Sl{}=bp1r)Q \ 3[3\,Ȗ s5,_ A~5n14xZ0g<b>rʹOv'T*T6OyA :HٴA۽oo8*l䷕l)"r|f]{w{Vm'+JsݻkG hV2u~EtKnmy=CN}-xkbj *΅6ҭ׏ m'7뮤jswz`ׇK9?^KE }f|yL#yXS֭7%(s$Ͱz_T5)];<ہo9 ^+iQjkpwE-Pb)6ń_# ^ 3OFG4`gyLk-0xO%{[)$:"jοնc[U1 MnġL¡53@<{VzX .t !^,5GzUKH\^|x(ky>_;\_\É*_{=Z^+emѩ(m8҃ LJ9JBFY;ڣdQ +޽B:??7?lqz~8Apq"UFDԉZ[Os*Bc1fd>r{u#՟H:[9hoKIvk,dP.xE؜<܏%bs'`tU90*H13PsAk$Vk٢A&Ko}jsCc2P9^\8M$ѣF-x*b{TKz|}M$MZ?Dez.kx Gi>m,we,h1ƖsT/.fu_2-4֥]c DiԺ3fY|~gf 9'~ªTR=]{'y~R=w;R)ȯ!PX 1^P2J9Iׁps=>+٦kG,-s܏O)q*^D{aho+>2_L7NSj IT+M5xAc>Ȑ {$!YK7 iӁy 6(jwv,7mBd'z|M3(C-tZ=eCcnFp N3#4VO~l wcWEYiNQ?tq?jbFW/'K~+|7LTZ@՝qfGjnT[.猷CKjN]g~؝_{RNUuܬcYδ/AkUii;E_gd iFjVJblAoswمӟmCs ob8{1ֵ*C?ljfT]c> ˜>SGWF*|"ݿX}G|y<_ rC6K~fI?q^kZu~G,Vિ*XC>_hȶK5q-^e>ahibmJ>i!,2LXW)4T@qy7a"Ukt5_Kjlx @ уWdևeޗ6g !c`~?z-G@J6WPO7+sAk,JQ3kHG2P0[ ˘0h:h#p ^WUC j }zt<өd 7!<3A0*Z>G$oq@DHְ-h=}_7@a6K?#q9苎*XŲ 3v1Pkj)9{fFe%tH3֏B/%&E]++1ן%9utkۦkt& , he)U BUddalpha/data/gemsen_MvsF.txt.gz0000644000176200001440000001252714550246302016161 0ustar liggesusersmS'5NxT$Nҕr@04;NYHB0O_/__ϿW=~߯ +B?O,fftpMiDOi/O?>^.4_i?OKt0`|Ot_khoɺ>Tr_jf"?Z?>+h4OIJQڢt).?24F?>XQ&oČG#4"[C.~*[8Ƽz{)k/Myi5>%%f<D㵆4s_Gy?ip̲='`\ZZQx4k"( EbWC3P/>5:7srtaoc-5f栥:Ly(.jo2)_Α6KGЦC2|I%}mn'p2V˓x`mdJ#Lʈμ2EM6JR V>}^}4 L]yOԒ"*60?҅e.1:&3M99-:"YqrRIJ-eE!9Vh45//^;3xTUb8Ջ0QMW8KٷUU\c4vFcM!Xr&[4YGJ]jQ'VĎL;;zY4'&KD)|}S_;]RVjf} -w1kZ.1Xbxgk\iߑf31xڥt+@flduf]j+nX2Z}̬bL51񌢾1kӇgӸ\yh z wKaV92~_d aƀe%zQ6x!8'(:08rZ[%mk ZCʾ,;jMF-w$dXdڴYf|ߢd4ok0 &bwNqQgdM6c&31tDZJfX8ͫG쵩x] sbs ,yVdrF":9i)׳5zhʾo#e,$[{1SfK˰B 9v4=F|uXGQwN4|,!d;Ljpe̴B`Gv)Co7>+}Cz~-"i篒=Hz 9_%.(Nnq 3^Pa 4:%pv0[ "u<4 7B_w^pE GfSC+fH"-ztbchx_Q:Lx`;(&@ N-1/ڬUZ\"6%(lr‰S䋷E< JDLqhc(Gz pLM(Tt X|ow#k[ 1.y;ñ9M8O^bwaO#ڍskWK66* Ȟr/JgX< d%IF901f[jߩNy5v5[鸉J,-XyiF/Gϰ9 V9P.G=+SIU8N<@5V8"2߮@W,3LTZxHTRUpAT06QSmgkJe?`ZHҞ:10Γ)g^XTWz\vQObP+q;0W?5#uK/s 4({b>h/d[ _+i0јdA,ve{fM{LIj@ؓbVڳ-P*h+4Ң[`)Y[xd4aV4°ב fDe,t!݉\+c$ 4j; iv/j>oB_&}-дnaҥWw޳TchaJPl۳fN:m:RfmB%Yk+0=nTܚ >o:~3ϹhY -P샙$re}*WѨ㬯( ::4X,sbO̹JڡO+ G ե/֫.kMNNB}ZWWNp2 jjh$SgIXyq2L?cZFEx^Ι HwdWKJ#XYZ9<Y`6A |k9k>ٰ3P!'a엷MÎ9UVhآh(ikwCe-sɱUj3!w=tūp,OwGgYǸm$,:.ےFgvtܥmTԲ /('?F3gulF-p*,80~BU@rodz@f=AO;%꜇H3t_g2iu"h9M[#_@]`>yul&o%zc~Nn,R_#ZY][:\ӲV7/|G}g4 U'aՙ֗r æ攸;*~(_%;!]͵qp/v?sY|7njgHC 52`UkA+nv>B[] ]:·o8.$KZVg$W ju Dj!5gxO'tr,,9i>To#VB2) Ǘf7ϧm;B)FY}+[WYP^?nEkĢn}+vf#̰jEtEVtoi SKDUli-_tU7Yc`Xn ź5cI,[O-an FTlfj ~m ~h]?KWЖVeHv0Y1kZ!25R]'MՕ C՟ru5Lxp'Hܩ$x@_k[=( qfڲg"R߻n -?]pX`bYq;l1 ϣxaY͛v, cnbjq!c1&hB4q*dGg,[?jYebـ'Gۊrm_cw ̒m^ɳbփ"; cG}J_/0B8o[wG;0={dEq;,}qiiMfCzix}v>P>/юGZQ#ӷs.veI4Wlqe3CuP/r\M.Ƹt3vis˭w\zYff[o_GW^:̪՚\ ţc= I6VA,fVuyQgpxXI̮RuFH+Ȫkm0xjiw$ycǮFr+e t;L7`^Gm8=j^ #߽x'&`cNnddalpha/data/groessen_MvsF.txt.gz0000644000176200001440000000261314550246302016523 0ustar liggesusers]W[e5 U#A0h@HTO8v\oǟ|?OʺvXc?1NƉkw|>=>7h 9M>Nx|%N7hݑWam>l{u$q~Xv!\&b ϪWmU87}m Ø>(P EY0h9D+C^5wo(+^*|$|E[BEq6׳KKMNgt@.!r#RP-&3{ҧj8b(*"8o`:`"+02nO:UޏQ>b BU^&b)gCXҠRfa?, D9+YA80Pإ-od=^bޤ$8> V u #< Di!vPўgU9wa:SqXڹ2 VL.=i# A6D͎:}/Ƕr%GT!!FTJ'y׳Asujfʇ%4Volhc͓҇8/q?1vQxhA-ҭex~ɠޮB1XNu;NeJ}SS@8m [㝦F| PוyFҖS' ʧ+2%9R0[_BS25F=GpH!]Kx:whm* 9ZEmʠ&^X_jr?#:JS``Eg4^'.A6ЮU!z[=:[MH prYu%T-&q,T -**uFiϬ?&Ue WFm[w-yj|5Y4o90ÙBCBU9%$YZZj΋imQ >9'ig1CTh"@ǬqXV+9)yCv-rE,P Â!Yal2;{1N~^UJ:jz{v: 5>n݃iݠՅ>F !q$-WZ8fjSϊ#jjgՄyȽf>5D~I3l+=Ъ#1h//- 2-XϭZX.$~֞y4Hg p} P!ygmb2~0Tů)ƭ-? ;^ddalpha/data/growth.rda0000644000176200001440000001351014213423775014572 0ustar liggesusers7zXZi"6!XR ])TW"nRʟu,=!z4i9K`^$RUo^PM.C; &W".Pa݊ѦTs*%i07ܚ;ʇf$8zٕ&ܟi=} 6;{^ k>\j~~䀨Fµ Bsl[c͡,qx Vkh3}[8xhUn0T{:P_~e C3z"q6Fᢿ+8Ɯ-4,7O,k`9O21t15 h.i's{>0} ԯPP}2~{Mm#GPB.~֙B2b]4jߎIl&-awJw5)soJK+VP0Ɵc=`M; s)6d;UVd1pgJ#oz.?_A ?ɿo-VfЍp^Y%sE߃Ttݱi"!G31ܫq#Uߠ@s?9pv2bC;?- 1?U}Pwm jFg&9vp_ڃƗ%C )5(A*AhkeJ (R[N o$Sjveۗ(d'7D'`@䒪r2"8S42nFo_f,LqSr"#<d<Ǿv`9<5VD#^R/$Ig 8_B:̆ܽߡFcc0"o{)Rh> tAsFtLخAcS!!. ƕ.l-=KZ;eo۠rٳ |{@w6fc(X^R7¬G\0i qOt)@% AIsFΚcpE&b=ڐ*X3,EZ`~c7uC8iϠV#)O\*oAJp.qgMRϫUM}hx# -OkS 9p5!‡Tًh,Q WVnRWC7PD' zQ*<9 Hų +iȱ?i 8Ւog"{to5aobYrx lB'x8Fp߸iQ:"ٔ1vsե$l\:lrz.`-A)mӠttAc{bOtY=BY9a#o7J%ADԞU+M+s*iw)zEe䚺U*$ﹰ`Bg+\ы䐵r\8u`tpN -; n6A Ȼ3Xk ڸU SN+NYC{ӃؔѽUn0twdy1 N=C$X}Mե\0MS9ϥ@eI$Geg>2YV`l怰!M"b%<V W Z|j_iHBx~LF]ߊHhM/oWg j6(Jv #x,r2 G'4K$lfڋV 17횁zm\ 8˞~8͐GQ$So`ΗDOѳ7=6C5`ƥsW8CV}GɌW|4W|N)%*¦R{ X_nkR aliշu [4]m@+NČ8^3(#/|.e.Z/+PBg.&cV~2o)_JLjT=LLH^f3KH)}2 HTD8,&(2p3}x@jn [X,LץJ9C<șu,K#R^Mt0}ƭ{O1g!%fuuX6jn#p9L_bӁ@H1 ZL4Ur+LQl̴PȇuW-bc(cuQCC3ƒ~O~=HpضPE(L2hݞ50@9|T6ʞJ;1{ߞg)C=ǹDE5IvًB; ;YYb7mu%Qx,陿9FFlD9dꔒҺ-Y(q^CEZ"Q "d} :+6V 6h sv/N*`v5+3緥dK^) E5/[:O][rS|2+bzU"W}9B4JqD7d0t ٣w/"nmr\)eO2@7UCAS,'|^C 68𧂺2$L[Myn`eIaI gQF/Q.*ω]~$$ɛ5DP<=I|GșMJaaZuJrh:4IݥpKsW$H{?=pvy<[c~yE3uo] h^숳1vѺ It#['WOr\"i6jWu| ItY8.yR#z0ڰC?+J<;M{ZO~1Д,,t`ΪA.~# /3[ȭxY@@3XV":(kk O!W :aP1Ye<\$Q03'v`Hc&}u2bz 2hPJLY@+A#9R١bx\u9p(=:v:9 /'lke" ~~ -#K$ /駞^N}#G{ e^w\縅ي); FMNiޒsOmØgt>xY+|ֽ.*|ecRO<7PZ ۹3OF|nğ39тp|fgko[k\imoAJM#N3&ƃ%j5 ښRz)*jٳ=>۝NP,NOaW=b PR]臲8NzvsE7򇅩hCS}1cc$ /פT%㩁(f]΅hңn ^%J2fm29W3=Pg"]xŷ9]&񐻡{&ق6z_9oVt5R͏A-LQ _cC d4G@H.VfOF%VRkiN:=xbf}lDPIN [5$١E>%HFKDIPxg?s%sq7T`X]~젳 GEIsjU Zx^Y͚AR\54ZyCLaz!cd<,ed%&JRO(g=;nMa x^^_u?LINsrAs#a^~É4 s{a o {ҡ:N(ܞM폚 ?\bU%?zfBPz k"bTh*>Q<5Ey=AK֒r\]L֟||?Y8O]q5%nbtT,c=Pk _[\LuTLuB$ſG -W,tн]=5ֲ:HưI! Hp^] 9G4 Lpk3:)(`OoKtA̓*߉`<ڪş5CmO/ZGPq+@r56RcRph4n/I7hom]l+Mv'ɜTՀubK-ۥ":0C5kY_< rءxȖ+׈j YKK]7,nj.+4RR62dN!'-tг{@#'l5[r&#g0莡|~ľ(aCƊ*+1g(gߕ)vк A}|rsR.#ρ @ ?-XDB^sV"ɥxF\S CCs 3ডfzE1> Uj Y ?C3l-B;z(S21Ya=\ݹpմGvH2d(8'J",b><%۰(͓]Z` ɧDk{ԄQ(OS#(jjI?61jqmG56ˠ=d^uj cM:hw9S<4KUקBA8;y̆šતxP7D}>OD3=syoQXe*4L.~PŨtCE'9?lK((^=Kk \=5n,,>p-Ia R'~ja[Rc|a1*6+ %'.Mt'4؉m aEK E]vB@YVY( q$H:_hmo xd>5B ;#.DL}^F;R,Vn?JFx9~d-G, C@,[>+ROq)Q yJ@CR-!+3qzԬ;"hn34.2ᎉH(WHܵ.CE'̈́^= $#.7 >0 YZddalpha/data/chemdiab_2vs3.txt.gz0000644000176200001440000000175114550246302016356 0ustar liggesusersUVK\1>AʀgKOIدYt I~7O?mm9hڹ~QpdG=[Blޫ|o T#3ura"ogW-i{Ge6ԍ {83oSTYFw9{~!Mκ HS_<>AX$U`o^5CGBh?Ii XpQ3qR}XWIqI`! 5 SPGQ2orWj\PltOY*?pj;`"I]O$C!>!ʺbW^@KERꚺg $Ir VR7(CT_%[ҩ.}\CucѣvCSל+CCV5ؠixb48(° xcp;VpEWQBpB:ɷWdQ,qGKSݛ5:$!9 O-Dn$0Wƃy"_ڱ? f>Y1D*)@ݟ.4zwZR'WvAKVgwL$.o*={$aÆ<1St}(уT rrE aY,vA'aiD7`I ٕd`Iq` _7J<oǃG*/D^7Gᢀ99?8|ED)R8ax8c\X OH`Ȯ_1A$!Ԅ,B8t _z nAvIMX2&S?W 8RdDa#wžutvX$AUD@L A ^< ۤiW Ƕ:ν8v-X#PZOFW ddalpha/data/segmentation.txt.gz0000644000176200001440000003601314550246302016441 0ustar liggesusers]Yr$;r~}hؗo]Də'Ȯ$c[^o{;;?W+JvY^Ze-eW*_Y{?y׬:}^&xWϫeϴRo{']TϒW/mm|9ARx5KxVC_\5|hx!. O+,;J4x~U2emˍmz/.(Q[¯Z{m.e Zvh,yRZ<)ߎdn7ۣpcr#Q,j޸rϯZ_U}9>H^T\fImE֛Li+i6o~E>r³/eS=ܞne"X\ ;v7w:D,m;-YZŖ-0Cg O&jѾx׫چO ĂU%XVjySu137ߡ0r 8E۴+޷wVRbsgSe/6C[˳CDvǶT6S%o2=X"xE[L5B|dj5,qUG[9b@<56-hp)[MY`},.~0> nj% (촚..6yt)l%v}<|@ּjC1Rq`P'`ok1-;( |t/.ND.;͇*!@'F|Z~*}BͧA6WRTUJ&b~l]Fj`ݦ=VwX];13YAkf^x iya.Հ\8蟽bOxL{_c U87 <{ح}T"X)]%>-r1k_q+M JYCO?2 IT*%xiyU{wsMf~ KAm0}yrrtnR]f;в[Yaiq] \ ,WPA%ZP%}ϭ@ g. Bye 5aGr:E 64t_'tOĿ`=S5VR/j#L#Au1)ZxUd XlNw *(2Qޔ0Qm1р9f7i,15ذ!&> s]'!B2zXPO>i`|2mXEݽ/_zeu;0 ŽQf 4 Ql;UI"I@;Y0uh:17l(:$J;e5"Qz/_SqiRc5 #!hW+ `*GC=\,?&M@UCH?:`m9О;0~j7 K=PVb/c>b^Ў7d5@Jv6Pu10f)aCXea+f rl BxS#qʸ!6}Nct1eKTG%!^ DSɌb4 D[8qmCfWG2E#jq:h/K%dܖs+v5ۺ0xEeXfsIpn3쑣HFQa><ɒn4p1y::< j=c^iDm`ŝh;L@#y jv (+ꪞqȲgkd8' MJ1RMhr09r1}X,N9gjPxJVأ c)N]pGF4|Ȝ20mlo) 0N0 r9^C Gn(uO+)AMWY'I;*`=rY3b+9訮h䘰] 䫜+e+{ sS(y-yT鹚@;nTI&@[\wVAiM*x9*ߌst*0m b9n+ystk@ f `@"e51~dը9͔lMqadf-v3[tTy>j H``^" gr!p&.X\M9ha;O.u%ڔkaQiGA44\\51Q2#-@D@ՇlH} =Pbfil+{AkeD|.&4\O{: HȀ"")nޒLH  4V6tY8aK& ٮTJ I{ }7jI)M,’ᘚtS;Xto;,-CPTwCN)vS{7},KM P;{]s IA9c,u3ГsŜ<bqk0Q˕"ؕ@HWCWNpfx!pi+;&*K4)-nKܫRUd geNUK,7j&1' JSt;3IQQ@oWsz:2QV1N\4K@)0]\ Z/*8Z",œ|{F! &L QR3MƊ2F2o89rHk4qцSzzt *dY'#ќR=u[!dnfQSh~R$UfR"71؆"tʱiS-{A{ KTdR<,aűq !mRb=<b$\7+B뢆(@.gc ɼqE ץ٘Ԓ!XU\kmkɻmx=J1=J`[/͹\_Wi-T =5/IbQ[H5ǰS,j*DsS!ABAkꥵI}r/bfbg9\?hd BHcvty:ReaHGM+ Ek,FQd4JGbK+(E?0*Y^Y'g4y R[nzfcws/.%&p%t#-؃%V v3dsN L%=)R*B~,(k2|ϽĞ倻#lS,Vk!Ϊ]FM,=3`TTaN_-:㠻 nvK6gV_íܭ -n$)3yAH◽PBhGQZajJu\sejb7)nn\f PpHMr 6'<N/Z,\jٽ0n'iH|vUUr֩f0Cix5<˜KNYDCܚC\G+$|)X׳*$" 0N0Y ڴfK۫㉭  K!c-^T@Yv҈z:m0 z-k7ƒ5 VBn|FX:!lWwN.oz I7YtJ *im`i/t`:R#y;|ꮺ]o1*Bb:,9)t%өIrWvՅc0;+}K"]|$]mޒ@˼?YR#pnZ&^O*&,nه:Cq$Pд=H'/r}8ƒo dtiyOqH*$2|I}\(RheӲ%4U\QY$hIL&:[-q+a ;0q-[)b=%T7ɟQMиU24胙DfT"M&vrʊeAYҏm}YCQ.,ݳahG\jr/n6&lBf_z oDT>n۪$, aGff?Ad w 5 .oҝQG:d%VᲆD>"'EE>X*ulVDǵ7#~P"Jw/ARvպ'6P*GU0N Tc!1$럽D"adЌ.U/ 5VglB؍8JA]K4+zN-֝ReEPtx)"$90s67hBOSyDSDRl^U],S~R jyYDI$u 4UQyGX)Li=c0EdӡR r{Ї֖YD^+VA9 i}L*LaL$PD@,,StE@EqOiLX\JW`(czeVόPd)+!ET8eҴD'qdE&~3㱲lBM泫P<(~]2mI?tKX-;ȳY&a^_e&xjh. t8eOfoY]'bn_,9>$ҷlԛu+l!ql>jݼѩ*A֭.p*k?9E04x#hS zILgirG@y d~ $DYnc\hFeq@:#E^ĴG\$3Mj8Bj񤥵b(wHk ٢۝`uuUYM.ATwǢ$uw[吽,cbӥSJ}kg`FҮC 2x{c$kX-\l'7e+=.V+nZ.7Oݢ[ڴ]:&3XJOy;LZԓ`oimC|q+(ʝH?L=ցO}`<| zzYe 86ԖOJ5yB5ޔfqnd5"o?,l8^Ql@= 0r.@큠=2IIJ ]$N2TrPZ.]Sz8!͚3%)t%{kރ\)c*# ?'""NxfMY PTe$4V.,]L M& .:hpwRWʳDM8ikz{n-jA8fPˉkXFAClf]#@lJ :( d/5 tm@<a~+\,yļ"A+f3 ]ۤh^jS>|_6MaސOφ"EV$}1'_}'jֈ+n9-K8LI^VA;bŨ܂,- zRQmf[\kRpw()3Y__& Qv]kS &:X#fjz4Qb@jhЧV &zv]/Qk^v%Hj o= !|݄Zn8ĬAyYKJ,T77ep|VO9N)osEjZk yH>7EC "mNn||uutX˻lvJD$Jg-*oq,hY6SRsGvLI!)^cA6f~DLw|LːCug2Cj vdsw+d%}Mm$T4X?|k`IpDыl;CQzޟ9U]^t=G>s8%ً7\X{K o.mߡ19jPF?;-r~g͌5)Odc?aH@0''K s,6E5 -Ҳ}Mg2Bjɥ!fJzTkhg>͊;녭);o`9<}aE;!I(Xaa ^m|Q /MWʑg~U)f}SȜn/ZR7'JHE2VJQ WaIȉ8ݏ4ȱi֟Pƻ,]VXTZK]zi2sQǤC0;| c5N%?#@L>mdx] .c9Y-6()3kZ.Z/7vyF)IՊY{, |'b# USO'XCe?U.ً2!_=)cGO3ЅA|&9ZTO+sf~n E)},/. rSu6ITؘ55Y4*8j>?sP4rFT[g]{+!y7fɤZ$ܢ YuY-pF80A7xdKRۡuI-bDzXU+u1y.6 BN/4nX%1v~gE0֩˓rQmT_YqP9W.O'OD܀DXU c63b}.g, {HR 7pq2Y){'KI\pl%){GBT6}bc`=S"%8N$R,I6~,7ǙsKpg,uQVo]PP+&V|\gUA)fS3lEu׽IH7sbh_C/U8?fI&#^-<%Ƴ76[4Pmԓ )ݚS`'o'*7[넜p)ԭoQ#>qfE4oer3%D1՟2nchdD#6r}+Bmitʾ }ñ B6WscDnZrץt=f Υ`,>F4܋StU 3RٖMz)O_!uDg-)Rw r_(jNEq% IE]|UO;elab{!Y4t  h>uǑ} 2ט2?5WP?9 %Kw,2ѯqS9/GĀGdIs-_s6P#΋UHq0@}0L+ڮXr-#H 8QP :1uZ՘Ǽ.Vz\7O,SĮcOG#c</vY.xe_\K>QzO&ȡyoAh b 4ouE*PMʛy Mڝhm;zekÛQ;,dt:Vf{]t4\RL-ZC]/.Mq-3'Yk f'~C]U $Po~P|zWl덻->ɡg 0 -ҵߦ`JX' 6Z ({I:Z5YVxR*Iob2kJwƹmMj^XvmlfS[}M׻rG17&k֗dt_S e}Nχ6137}y6D%f穓5Ïr&Dv tsURjhFᝯ̓;~}ʄ}۳2֒DtY~6 ZJU[<ѝBF:0y(Ko7:K6/ϭy;`y-rchuarEݔF+h.s %8x \O4p#5J*dG1Cv-Te H{`h(S>x RW͈ɗ'lwYadMR]D]- H;[ Myc﷏{d,6^G3#<T܊ ƺ;ޞd@‘i mSwsӐ'F\7bm(75ǯlTWrdM`Keo$ߜ* a+BT(u cʧq7i*YAd"q$9@]N5P8AzoJۺ87>=pQ492˫x)^Ѿ)B GO*baJ pU5"W)0d&\r'eMzQbZjI)r0YEyȅ$V֜6G=ogjt]:rP-m. nJ[F [í8Vo|sRxߺe 57V8[8s8?|kJW/,Oֿd·́>i U/,sWxG鮅z_gT8BN86(3J@NS |1̛6׺QdiT9A^k}-:+!5g4` v'3 xEEe614=?o=EXZ|Ik}AtMlm[,"\|%o0D>bW􃍆1oIEx`-h׼Km>HY׶ݤ"6\{8{*6,YR%uGRmWKs+19ڐnG`Ma.n+Lżbgh9@_PX2u8É0zv+]WgpnRkUVsXd*lZ3yfuvj%MIjIPT9ϛ^6t|9QIM&LKKYQȊCOm1 %NԳJY) S½trٶ{aF1`(o %8jk2@MUC fS(2T*/U[ SmA}"Bb[t.gW$> dzBΗ}޸&} O농yY(J>xGWHV#֓[9Fu=N93*.Ӌu$^|[ ko#Ӡg Q n^I'+b952/ooMZYf$>EsfEte]*WGsC 1Ʌ@BpفCp ۀJKyr{4n8닝6SŠ{ISҞ?Ņn Dzv8-n'uz0K,(A%?|)x PQ-,x]^>,{ ;@J:/{R5:  #SR[hϛ$Gn<@1j%Փjڲ?Sܴͬe(Dt\g7NL'bY%n &iI.,u&\ 6ߩ i2[`Ϫ]ȱz}x޳4+V=0!䠑znGh9FWupzQB81ӷ`U|}p8ٞ S)),SMon!o`*V;k/~nfeE<nj\mo;&+jC(Zu~K-tH`SC8[!5Sc26HdCLGa.cYmRbP Q&|@cJE1~+lN4j`߻owF=ړT #2kW'S q! e h S)љW.mdaGO*iQ|GkE3mW3~i+ܬ!,Z,jJO TcN8^~P6,8b[M';&ǮJFw>Y,{C 3"YvhchW}8ؐzi7Q0O 5˝Q6܆ĿC`צ +:5˂s|d0ӜIUU}R!:엟h>K1)ޗ<*G:ƀ)kfyW˒|"Y'}=Z8-kh9mz/lt&.ٝ`4 g̨MZh[˜rQ5X]n+3R,&ZOE39ZRp͍?劬l'jIկ5D"TA.oOD]DP37X>ɼl?uX˹UaGRgv+c@@RR"/x̲w^%: {GĚs}!mf}.meɶYkFjJ:J"%7V6}Q Fz-PXʁ{U9}~Ѵ!lXˀjebCO,7u!FWe NѲyr}z~{,ѰGTi+# %{ocEZ+7Tu@y'@@+HFέBYxkulreY2y!2W GZSD2:.͕br\a3^Żʥg 8 %!{!o/.]g"Qrb3hs3Sro#.*%M!ɻ 5T|7Ӕ7}dm01/Fn{Q]dYؠt9Ӛ+GpjkVi(d>M?7#kdz>:sS`>W7PS}d9χavddalpha/data/chemdiab_1vs3.txt.gz0000644000176200001440000000127614550246302016357 0ustar liggesusersEq,1D7 " Il܃Ќ\eAMwO_ȿO-{IK4TLfkK-ښt0ɻnx9L,f!lavGEU6Ł*u H݆_tΧ Sj!{H!),RD?#̬xz֠MvNyT`fCylydð/m֮hUwTHQMPoE PpqŸ` / th>Y~5TP|hr^q)AẋbcBaqlغ0r#쪆9#pT[oqX!KwZ`@4Sδ/(Qp̀f{N=L2]NCʩem딴Zk;T4vyh{ʩο=18l-K{?'l;O̎u챛FG;YyzwsC=oBn年<8qny0  8?bl'ddalpha/data/socmob_WvsB.txt.gz0000644000176200001440000001352514550246302016172 0ustar liggesusers]\ٱQ(S$$$On@Ҕ!6q_vׯ.s]};gמqW_oSuu5_/g5~7zݳf̻WEFϾ v8~*;G;:U٣ÉNk\nNkA*&ھhsI~ON'9clBZ%w^6 d9; 9Ϫl }ZRwމζQb~-?ndvs(N~ rYh+aB^]Gw:~z.[4sdY\to^w[: ﵆+fKWqH 4wi`3GC }~ge@źt5y) s:RNuYr\S$LؠRؚ[Xx{9]E,(p3r3!RV\*9=c-ҡ4ۮx>)I&L=tcToшq^^ܯ} 5JKs&4)F˙NƚTRن՛["D&vP乵EFDLȵk;y<4p:w,.r5 t24.Wڽfv++$ `;FҴ-r PĆy"{,rҷ ܫ WpFtG m2l\%W}gDy G[Ƕ1[%;(eOt)bb-G",Ӗί MBc _q^mZbvf׆A3g5>] bJ4@\xCE"F<uDҍc c3]l؃Mb*.b !U'sjnL3L-/A7bW>h{t 4wb%%Ni ) )(pûbL"/sx!pE4E*c)Ym CeQRDC j8UŴTHA14a'2oh˅WRC2Hƕ|PQ!(wc֩ŽRG;tAa!"gp30wx5tExPDg/% ZspEUY 4je ݏ t7~D.MiFUȦppi :%6٢*FeyhӻXA`oj1 ͕ޘbI),inM$[pс~~Z9'D P:ɗr/ngl( -^j'cDw3H% XZ,a"$F  1DqSkLLB $th̷:*&Wt-v&z0z?ĺՍޯȠma@KCZ[oidNl=#hHOJx!BܥR' T*@!ժǵE5>`cJk|j\ @n'7p n^3z CINFU,I@5hc{vN -F@!|:0{ Y6U"+CD < Vۈ.MOM=76$X$UcIb1%ΠutRqY ͽ/uC3sJBz*auY|Դ`#$+5muWN3r0E; ]BᤴʒЄIOπN1mh5?֨}Yq)nĥAf<92ȵ'A80h]ٸSa$|MIv_ǂb.Ge@\ƈK_0?GIJXf6AgMxq p5g$ xkΖ۟d^4>b̩pu4˿4{zypEȃZУ BwoG_yƐ*= 7*[tW8j0h˫&C0 -9`keBJ+ / lB7(raB!=FӾ s•c 9F9 e\]-`7FgpcaS4 Z0PC !⿈3RRLB@\/vfv{?; 0oec  nip~*%1y(j+LIz%xd w$& f?P\)Pyt+X÷ak 5O2xpB-- Z`u2|ܡ3F]QB[< 2f%aa/kap,_Ԧ(V. #gHY- ˹1 TKa2?|،% M0oroF=ڛPQA(4' ̨\'|Q.d(k;ez9wkbv j[=L \zm$DE_EL:P-&Pq@Lv*$x`$&bCS6gMR/ }zfxekX!.s{ {2 a놰QCa`e VvlR1i%BJL(D*ZJrrrRE엵a")K謆z+b[|':_icHZ`Jy>}jm9$a0 Q3?Dهq,tg^U2$! z sC"h[%Kf@{-> gF{?9t{zg|l#a fy+q{nw=ҳSTv# EZi3fF{3.lO) !C GLOq^˽- CIkXLo3&0 e+*$5Vz|[Q ,k̞ӊ}کQ!PC BC}šɷ@P,(;Wh(Dq,+ C!ςk}MâEҡ|[! E*_ )/MBZ{AIj3;XJ`QU C1jb? #)TrF!yS!WGd*ʃ_UqoNPT1` RШE(S(b1:{~\ޢK[@$TMY?6\^e*(0Udy^X%Ns֋JA/4:{LƢ(X-a.` $OZtsLUWE?;e$v *hLWL5WE]7-YF(LkF ɢeկj(/nI^=ȁ-êȲo7t-H3MU3SC 򔨪B(M[ޱ%CKvwYPS=BDBXL'T`0GX`EGd* -\5@@TI ,(3UIAȗN~hcoex}(40MF[OYS¥5/H>+$Tŷ jFmBLuP5^TEa5KW xBO0F'': bËp-X<9ll1z[GcЉGC:cPٽ#˓ 8)UFt@txXdʢ"?bf3]*Ϙ~B,,Kͽ-ϣUciq{?6yJ@7Y*sp9N,})sDdAjGbGNOcx6)45,jPČ#FitTX3jQrI|\ε׃oY$1 lg|O}ZiO[Ƈn P!KW)3Y|yH|=0jEHqWY{:3>7?Ӳ?ݭ[9;fI*Q$uGM蟣iOZӲO뻃R߇;ׇ%B>tP6t<9hTA:aIf7;8Jᡕ6=X,Є]Z-Hϗ|HO>, i({yλߍL̎Ύ!^%ՑSZ0aޔ<fg{W_vnVwX [_͢&'gQ>^9px|[¬Ж=Ga7՜\Pf7IJ>fO 􉲀t5[̏2C}-/Om_'vRsv3/>b}ϾA8/lOI*$. $t|V :G( Ҝ31 MD=ø*ݸz˲j+.;aqU1*,e,eZbs [~Y rXB2T&_Z> A4?DL4Cɪ3ur xÌN.d&-uho>ďf8pMr~sDY@'O=({ jP`(g S]L)5,%^%51oc|~=Zdx+Ћ#UجK`haD3[_XOЏx)'D{`/b7Tǩ|Q92d_ *Qo";NZ;;`U"ȣ}R!닇Dd& @$c.~M~XͥҖxMոr!$!DYyfЧȀo>=dL(>C; lBFY@KY1T _4а .~*h*bY5Nڌ?PD=A| I#EEu@_2|*Zh8cevnz8LE"R!osJddalpha/data/iris_versicolorvsvirginica.txt.gz0000644000176200001440000000103014550246302021415 0ustar liggesusers]T˱$! ODUؘy#Yej0BȲ跖mo~gBQWVV*bkv"z"*VM]+G~j-XYH+pArJ/KѴu*LsUpݙva\)*X)*P32S˼b?sL%L!s m-4qffE)lQj{g*ߕļ'p"OP }'E qxdyZ8p8Ap:{͝@NNP:.Dv_|B:j绖ot/LOw2"2;aĻbGGw1#ȟaSwqV+_7hehtͲY/^1ӋY } N1΁sM%8jAxN;Jp4to8}ݠzv99։|5?Ɇg㌽`9xMz|9+%ٜs] 8B+`ddalpha/data/breast_cancer_wisconsin.txt.gz0000644000176200001440000000573614550246302020643 0ustar liggesusers[Yv*﷉%PHr{I'  _N%_Ogw߫>w߱hL)~_E'f~\ J+ӆoZ_ֹY#htN1N7<6k1}[BG=K%~yǰ!mu﷕~[_=y|>kۋN\RAOi"LyψD ѻcvN%}$8_-$oT.  sDNvy!~FOn*`0TJ;hXI¹y;C<3|y!{𯹍, Rh5o׳u_)L=c'UA5pHaDʡowMdF gE |g+_Vߋ'0k<:yjY ,Gw(|rvjlYBKtQ<7136纜ބ?f.ȼ'y&3gw/3-)Id32b묄Wؠe i$T"D8nP@*t3@!O>,GC[y7Zc4gr"3@ 0-~GzDo(|Ƀ ؄BD-uN^]|E!, 4ʾ<f< vZ*Ln$*^*Yƒ|RL&ary'YoXCMdNZrm? & Lؑ"Ch $[3V>m~?okXlLעwϯέd2 }`,A!NfҧD厌,d_d γN&k!ApCjYN/_s6rngȰ@K_>7Jmcv%SGΑ(|bBAK dz.MT/5 . (ks3?B!NhhBTtY*"F0<ɜ$[D/RV,u!ݑl潹S`f|(!=Nc,tT&̗ÓW_g !lH"[T4vy5H9r;Ld9ykrod 2йmԤR%QP33YG z$8svgZ IUGZ%EJ]ᏸhdEC7Uy:HV:Ro-$b(ސ'%٨ &\ N/Tp=v" c7T덪 ֿ|IuHʪ\@b Y&I,ݣ/;DE <ҋZ !N:hEU>'k)?Ź ֤z}sViʘdߵ LS8çv(֚ =бA0 0+tH;@Qי,EnP SZjlnJ4G~Q1-5 4# 熚-T_p\(7Rڀ0n{9LX}LB*\w1{DDJnް 6\\,w2y&j_i։ RgΘ=l+lf89)+Y*Yd[%vi##=HЭ;Zž2=D4TʆDzp_uY% %ɢ]İRT_Yܟax^d|0nsln0?=*t5Ij=Ʉ-{&`H%̮km3-M<6jY9g'?;4wJ&K3885f>#JMqBz$Cc0vj+zsuא q' фm}TW Đʉ? ݝ {Jg.<$@;~h^NemVW3p%8D,Vvq]M&(HU6y^v/ӷ3M8ʆ=MdHl }>7SA9MSGqc޺8<q>CH)aG4Z\cך]/h$[q2wZn hhnPR:^I)#sukQ~P11eE+vW=L6ݼ_z[*xH`[]^>`lJk_6.EG(䂵#,ZCtjXe[܌758-!ĝ'("=L/R]~ykvLǦ[& 4/\fQwnÄ CJLs"quJ;Ni}L@ï- QߟTUe<EAg姜pDD c};Q2Y/W<-SSyv@e1*IBB)߉ۨbyML[O)yyXhr~ʛ}}Gp#];q/6+EOt4]Hk'`d .u,28鸶w_'Gp8\㓐QVnj1ɸ}IКm 1@_MGh.c牟na9 ěB"=Ώ9>5ȲL$R6y& >h>)x-w0*̙~IiR. ce h3g%a?#CT\$#< R5{b0b6x2M~TDN[k:_0k{T6+FclT,O $v%ۣF8Gm;yʳpnD{?g׬OzHIױEkasM 3(3ZlX/д<{$Q28gN 8ddalpha/data/kidney.txt.gz0000644000176200001440000000070614550246302015227 0ustar liggesusers]Tn +9KVjTn~~=j !#=_3=|yxc$WIP1_ҚruO}_ien j~@hDt¯Jㄡ1+p LȨbyEU>C#aNYanp/o7UQ"AՈ/H 2(A H(ѕB[I9%i&XBḩ7H>ko3;\=Ld;q w EWO;V9*(yaYbt%F) m?;V@e`]#)o[hs7wwÏ*dSNx|y[swGwF)Dx-߅im\6 DfOHsTm?ˌ]<'i3`j iddalpha/data/iris_setosavsversicolor.txt.gz0000644000176200001440000000076514550246302020756 0ustar liggesusers}TQv!Sxy:߽$E CʇʇKZR/.𥉉.t"뢨tT*zDHy{00Nf=8&xzڙ\cou%|d]L>!fi.E;9&Ӽw Z#Sgf[YyPB+y[2YQ{{քH493}|`}v~ p0eV`ۺUæ!Y7ޙ#*6cnoYXV}Sn~]Tl[k%``\656{H*P e&z?ajRp]#Nw>DzrO 2Q/+̛boőU,qhp%:{ٿnޛ 9gW޺mlMddalpha/data/haberman.txt.gz0000644000176200001440000000154214550246302015520 0ustar liggesusersmɑ E!Idmw6@ʏ^(4')=hj` 1gbV*:sz3ș:dާ7H}k<hoռ*h, m_UR$_\Fђ#\c-]ڹwϟ * ddalpha/data/tips_DvsN.txt.gz0000644000176200001440000000307714550246302015661 0ustar liggesusersmXI7 uAH b/ 5P48=>R߾|Ƿ|?˿÷_ zS/Cf" PAP 3M!'UX֝ uiBBO 1%4\I)zqA3e/!Uլޣ#0DNTzvP䒤X鶞32W&9Nvi {tCSf Ma2M3* 5OM0+#ZBj;MhjP[ Q̗ffM؃ہ+6DdO#I0+t6 {vD:W5F3K 3|:sՍ "b ÐrGQI9֛͐t7(œp8N ם4NWk!%6 hRBWY8d$W6c+-0N"\qW&PjvH~Q|b :wCo^8 Mȇ.@h3lJnfx 7:7(M7=գX}IihV#ňNFҪ 6')U䅤I@g-^z ybO٧` eiFK]3V:j;K:OḂ,-LcIhSoxA4M(W5LJƧOWi23!G†xh}9RAf|IWmMe/X${kN$&"-fH{],h-X!vYOwjxНrA^$#hR=POX:=f n͎#Q6M &%x/L#i s8khVhsi %SwxË,u´1мMZdzqƖ;ҟ277wmsc{f[8fmzO+-mosRƼ+Jd5~&BWo9֋YgP ]' ,$lv,T*RUAwlZk ^sÀ[s BaO/?:p4L{ًKRކFK[>Y@>~p <ɇ.!wɹqRAq]6bP"\\N6m<[_Xo^ tbo̗vvk껢؏7noanw3 Vs6S:k6b4iViHW+rK|?UU`5=gG]+kR/9F#NK.LE45-) >M$u`P)`k0"U!pS?0ddalpha/data/wine_2vs3.txt.gz0000644000176200001440000000540714550246302015566 0ustar liggesusers]Y[,;=A.?$j#i$Ad=k:aAϿ?{7=ϟ?cz;~e9'>_;~<~48Ǹ/cxc ηڍk`yv|gxN._i:քMZOX^`?+L7֜'cPl?Xg#QcqǷ>gǛ`9>Y3?ۛkXGX >\հ9C7Ãc/'l `x!"q7o|G8dIFtRfK9d#?>D8M>z1S1&^Fl 3C;8:㤤;: 3Ƨg`"G؊ tHն۳_8vzR O<$@2+0n}z?nOa>߹3 P2~ar6|jr4wg`S*WܭXvLl;-Aא_fc1ȰMqMYށͽ_o_i jAxE98Ұ>"(uJ*2j_و{Zo,Ϧ"Mx7WM [EkU_ W߮v7ז c*JXՍSE$bʔ3 P&Mߗ~VK3Ҏ3J.FbQXGGd@xu3ĿVmypƜ} -g99HUa/f"4T[\Rg_gOsZy:q?KR2$,%c>G1YW{;݋^2VMX#߿&BqN4>M,a[ ``_#8GPH!ΝD5lE 6/v ޔM26q^ $biv%Xn1%&אlfUGͨz|,8Sf[/qFbf*dLuA߽ ""牷,zV LʇQ97ɜmV'۷:0BeF{bc̚127) DOXվ'vvX06gqbxͤwVjVzb#oWK(I59O& kRp#$*^G/b8tSC@(fdyz`q11嬓Q!~C4/bX3-smrkX͢?r5\Xo̓$OPzKSYbb94lmߌ KXt KOv 7(c %ruBv6iէ! ԧUc}0yFZˌM̎DwttJˑ9%0^8_3sd %VU TnyReQ|0< Ĕs0j~̼(BUva[9ph⟘9F4؛@F<(qyd)qEv*WShd˙''MCL(β9q7)@EfkـӦZE0\k*}r[K|Hvne#\ђrYzK獡J|a{fzˏJ (lq ~U)?\5T13f@M7\ݢ$4˞$B$ v՟D㫭N%9B2Hf-]r<Y[D5o8_GԮul9qBNȲx1#Byx˄Nx|JNM$5Gʜ'KSJbWlGޕ!|wkgX ;3MG=oZ wQ* |˼;K+,oXu'  ]NڸxWȦ!s3sB/KC=6zs;;TO?UyC󠸀Oy܊ۇ"Qs KL5`>FeŎl:cӍ,K߬0_ޢu]YCZvTŐUv\-*0EíT4/>X֫X2쁏{{P)5X+.Pqʍ!\a]u/MMzAx*x›ik$=T&|&gRlScw=.t%2Te d{&1ۇL?Mr8@JGs V8GnL6y{xA;+$Ws!?,\xgn%n D,P[DsB[z(W|P8"/Ͱ&e@*7Y"VuHi'|e]3>65W՝\Q6{ v]rɣCs+}Kv^_} tÙF욏Ʃɳ*R=CCJAmk4νw8ڵ &I{9/aM k/kw,qZ^\x?Gkߩ9SGaJ'x  J_H9Fl\IXi)t1ҕSj/*hWNX*Cts9f8K0od%hm}owYJJBݠ."$L߁j-"Ϳs2=Qf<XEfx)&2zؽcMw[  a!(#&љ:}GveI "})lI'-$`tjթZٙJFpn5(Wݑ01Y*Z (j[I{Qgx*9&U]4&tTtHﰁ}W{1WubHD(# Qer4&S}96ա*ZiȊ& 5-M}]fn`l78_@9цHerpy!ΡtԱV7~~esb2YyB^c+bEdu8kO%Аg6БY4^ddalpha/data/pima.txt.gz0000644000176200001440000000440014550246302014665 0ustar liggesusersMX;% }>DQع; dd'"A;_~9YcO_~n͟ž3;~=ޟ1?=}a}=>?6c+~VÙˏs'o\h.Ƴ3MWzD+gpq,b73X^id<9X0]i=KWz26űǰ N_؏ÔpD]Cq񘫭ݞkϲgzE~cQeY|wvXe*yeӕI;Z"q+ ϞWv u#ۛh-dSDEPŒ)8oXt<)((^ڿ+qILصѐzٌ?<Ǐب vOv"1DPoĩ^%c A)@(LPVQ{&2 eL ..-Eo9,5u.i;Nj؉-y842Q# 4t)2?/3\Ax i@.bH^ڄ"p 0D+:2c+bSyhPV} @zf[«ƒ婳va_^! &Ÿ!2%髭K)$*|zRic0CPB:fzz V>=[ -,ITY JQ^U0v^[)8HtpΈv=[jm;BR!c2g.v.VR:ELq|d\FZdv/FI0lYؕUAp(jRrDg,Ɨs7 .8 TǡD,'($584$u'ϸzX6*f 7,$y߯)#ѱV~=1E8 W7f1WXD,^&WyG,A̭Tӯ-Gy'@z,Jԗ(x[%Z*>@ߎG ;ߞYmiiEj+)3\i"G0!0c1.tv|㡜?7EpaxMx@4QuôOS &Х ׏Wq7ؖ,sOFo3dC YOs @Rǰo ؁Pp]z{H7~C+Qm?ٞSz%:wI=IE9&֯[^a Xg|82^ aN 1jEU]9JI"=lc05UM7е[,&e93WX*9rΪM1JǕ"Q#$?y}l kŀ8֟U$qSʋ s~Pʮs[|W,()t.~JMp=I Z5qܹLqzo6F]q'M=8u4Vc ,(:( c k^kJO'.k)@)NKm"^X+<_2F/*hx~F2fg}76}I s@_ K/]nH5SK ΰ<"`|ddalpha/data/uscrime_SvsN.txt.gz0000644000176200001440000000221214550246302016356 0ustar liggesusers=KG Ds @hYfb/ 9~^'$H36YbQ헿/ڗo~;n?~嶜dޭ7~kۆ[?br4yӄ꫇խ3sT.sۓ볉 F1~PW&˙~SEeGwL\$43ɊjGEYT4'QRis>pw M W/vI1n;lX_NEgY6s M8oM$g( #xuҭ>`?;?f39 >Ev si$4҃;V(Sbí6 k{%A홳sJt jjDQJhP9屭N1=YR "t)Lg[LER% I 0?* sP/Z=iQ shA _3|]KT?a> Y"bI~uU![KSWtzEd1`B$>ΖC]nܑ$,Ky,R`F=䳭]4/˰3q]gW}Cwp0 YjI-#T?5@(:r ٛCRG\.Y=Y{S5k(p ͠[v"b(lȶzg5xףtI}-Ҕ4[ƢĉZqA5o]8+t18ZͰ@K1裗ݭ.G3+~`v~8]Eت&k2Sk f_ȺZ7́3/vy֐r T^ ddalpha/data/baby.txt.gz0000644000176200001440000000265514550246302014666 0ustar liggesuserseXI]! Sp`X};j)R<㡪l^~F3O .>|\fY2VVOU.Qʹ?_hӼ)C>5skcSLD״ԹC^9q, {H<%MЯ/|h NNPO ‡+PMҁ Yb6g״-R]+ze@XYW-͌ fћ OKCnב')|oWiE us6(S[pxw:Q!Uuu \ \/ z3ҙSbꈀԓf{b£ ANI> +Pq>4j897(SRb_@u!=MQ=&ɜC|Vºn~vjjto*ivp_: Z{@ŠVeDL= sNA= k{^U+ Usw]?ʰ讯@P_ْ(?pyY `$G{bgKҝaa=b4u\_#V{b"iYI'+vQ]⧢\QYH1 Fw*kf[) V}L,nBPK l %C Vmj!pli9[B4,c {M"1/=&D $v{eBgD%<9u@5PӫwRlkyk0^93Sر=E>ɖ*}(. T4&25.5Hji,g'2'"`Zm6LӪġ -m/7ൽpRY.;e};k.ENݲA-=n(E9\M}YrR.2b}Jv%.ADt,[0%גeÕ}jXnιyvΥ0X )֓fCp倅<9H9o$`s$FEכJUݢ aIMn:} _VBVCDeTF(ˁ#'#U۲Y:n3㍖> u3b7]w݅=$Z<$<7V6e!#-imbPǻ >t-CzCA_r :vB'0*9s1}">zgd5eZOFS6'ZJ,c#ooSe\mԑЂ_uY> 66 i{]{rHpij.X}^u!t11Ff?;L~3zEǐi4L,ve Kt"*E8Rz-1{b'` $pԫZc]2W9(DLj#^(>@= ѥe7 + Q o .6iUXwtkEyF*zWD*@^fqB^J@U1<& >ܶ1X<M1ԷQ >F!^Y-AbCrf]I d׷m!Vgf76jXc8JXeZR1c 2DH8>Ir2To4֗(`AX>4?i*xTJr8(bU;}1Ig{SM(C*HA; `VD̪Ѿ|q3I~zx挮!:M-ʴ Kbv;~&~LgcUu2J.s{<[et1doORBH'DY=Q.>(#tn?gW~rc'r*J\q՛<~̑sLlxݽÔʺuz Óuk?UMHfK/t<{8(yW;VޢƓ[Nj}Sm!JBP>{XdtP`h]- ]* [kJ҂4:"4 /eaz^ϪjC, S"a z\ Rg_Om.`A-ۚ"w5OCATP*33o%R,F& J$t:THM|;|(uD,{'lT㓒kH*fLN x7^Y]Kiz"$W|'d8~ؓ#gB(ɬ%tIO0ebfh{B#J7 i,Cy9~Ǣbʜzqt/mCZyY3mG.S]#h.J#f[o~w)ChZ ^~:ëN p 2J_r\ elJp/pz1y)bW%K7ˢRni7iXe'r]lA(t}-M5wd`f(^dE\@\֛iH/C PҪZ Jc\wn7N魕6_p[u~t3TiNkCmXg Ͳ'miҽԊĻ Nw\1AU xaa/<@>*2 Ǫ(|ol$QZ"Zzrͥ@2Б)KlHBXc DRV^5F=V/^jv!⍦|g}$8ĜfY~w@^xBmRx}h' <%mNOK&rJsty2l>"y;X]LAA˘1^R5ЍTӕC*P/YGeY9LdEE $WtU2:#;s#j˩S.Rp!ʉ~xdHq͐^j\&0`zΉ*)JWJ)J `BT2 Jf`߆vȯ/ qH6$ ?uCd Vwr֏MAe!TSm@å3BfH3TO zsd*ܩI"≟v)ZC?$ WYTPOVSgZ1P 8;L8pG2641e#'g=F5qf*F5OF$4a_ hW:;}MosD6/32Ȏ1̔%<.P.+Y*H'=|<Џ{L<5 E;tE^=T!O@*q3L#2,nF)aI"4YIq'ro:ޣ0$V45<vG)%>8FZ֜56!بb^> ULCQ0z39}6LNPomc_[%Cupgl )^1!lSjP-Ç 6v"Fsg^ D 1uZJ(N Ra|iY{|I G+ʶ4tnVD}KE%])W7챁”Bg-/W&(T'a ] jx('*/zzϏ7*Xv㉌ xu)a*p;Dq8Y88[+B,C烟eE.~ !~!Xo>gB' (*XP_ז nauX/|ɋ-H{hZ&g`Oi_KW u["˱ I+, )T;O)}&* $\bN[b l 6 s (UDg#"@gEL cs.'CF窳=)jJеO%9c9 (d CgـBjZD0ץSc}eݨ\gP?KQjC{MgloۺRO[(K̰+j;M(S4(jpbӞs*#@xs-'4M m@v;j\ʥe_P^x%EA[,Ep x>_ 5Oխ#p""˄.G7u>1.ڞ[,ܨ$X2NUZbD s:0D@ )a P#,^װ~49~Q8ۭW k ;JB{%U~uN4 %,Zw'V^7aZl+UgCx/q~6xF>.Vi!C!x:"<|ۦcœL(S$Q$H /xon)'G_t7NhT?gtG{ރ3=2ȗgqCSw볲n?&~,\/iw>kDxG(=r<͋p _~_">M|PبWQ˫9Tā.}mR|skRg>g==ȇ IpE7:3 `3f~[߅FldK,SvBe߇Vk72<Ňg9]_?#Yqs~x9X"({]zm ϫ\Ɯ曗0,|aaeg;s;Pˎ$p/UÌMx[e/2RzX5 <.R<97WhB4ǃrYףr1"{aDʦҽڳ]Y[ dq] Lu|L# >QW'kCIwT='0u;B`Jӟ A@rA?7ʨ|Zef9DS;q[vA<OֺOd2`3[PE%Ξ.E-6S"275yC8 !e-Sb>e+5;F$^5y&7V c7 rh? _Q[m?ne_jx!N5nz:o*oI&?A ސrH1<0v ::7GB4H-*pj=?2t EC-OC}'-7!Dٟ\(Ojw翟ϕck݇:]2t B 4# ضv`#_ר sJddalpha/data/crabF_BvsO.txt.gz0000644000176200001440000000162414550246302015712 0ustar liggesusersUV9A 4ɾRˑ#'OLD9 5~?پ|Z_z6,iMl_h5 mG7;ٕ&ޯLĚHt`)@$a7:*2&2}WȞsiN'{qZ@e F ǜQ_S(Z/20;P@:fLU?-mUL< EIu]S|Q>XdvQG Sgv#1QEcMzT@[[j:lG(UyapRS]4KC)UzCk`Y~) J6xk>oD]|/J)!;,,QCܭ)M770/J;$XBΥy7N7G+4kC ϭѬYy\rJ— ll\)BC s"ag x!Z>Lsj;5$"5~O܎jhYo*R  .#:-< YG̸H5.C`kۢ~ Ck RP|+bǔlr_8XkS3m=gd$r2ķ;rg Eei6j"L-Ԉ4%a68kBhdj4ś]Bo$E3_"r1Bu|W>$>l {vF :W5m .!q$qED"a@h" #)r Iwh- ԑx x vtйZ G(bF˷@>H!͆zp\ڍi#PZ` DHNM sd" ) NHs3[W] ErパxnyEdؖZ&m(M7=ţ|( qn9B*+ՑDDp:φζ[y؋P[X124)DuG5 (xV:/-Y[tЋROaJ"ӮhUX@uld|zI)?[5#b&jLߏqTh9MErKHLER̃{ٝ^+"sNX <֮ &Od #Sxu`Mgh>Nݚ:=iSٔ;L![¤IKlZV(yC0S$L4> Y L;iR-|th:2It`I'(oEKmEާM/`m͆9o7K)Lk4Ӿլ3 (RמBwk:W}6*)iH W |m Bs-Jh[0LX35wOԦn9; YKRކ4gWyS^~+9vvFv KSn"BDuNC%%C>SދӢSvkʻb,[8[$錊ռ\=+򈍍3zM.l6aEB)Z]8_ń#w.TlQyk,Fk2$ TtXcOJئEҙ0&+a}ȋnZkҋTx{ !s~o?b ]J`)[Չ(F"_W6+)0_ VOBK:+OiSG#g/h ~ӘnͬKm&GX dL [6XE{mޭ |L5QVddalpha/data/bloodtransfusion.txt.gz0000644000176200001440000000367514550246302017347 0ustar liggesusersYM5 s񿽦n@"K- AHBxlْZrK_~?}o~㗏ךWzw_\FJ*m6۸Rlmj]9vjs}s~%N>زh[>U&VۓuwI}mS[$z+-x ?G[Sw5-ԭVA]4L (H7yۿ/*Xm^ܷ݊[:cJk9IHt{^ԗ VK2;cs:m^jIKs5Ldz^U'>_sA.gkǸuk_Su=вua:Kao<īs}o{mX%qW\J(+II_`ii`iɅhtM !sx% I{mdg%xev)=TKmSgR6gykpN!C>CzH}[{ DF sTSg 1 sVioXٖ8dސy[kSq%fH#sp[A׌*%7l 6]ί[f֍6F8[r۫fcq_j ?G~$36C{#p1 x,ҋbU*Ë$xOn`[gȑ6עR23%̏ 6,yUAE3(i:N_rݠ 4ּZځG[g3&5qJVW3}N$x O߁%^o39P$em^aǕS <ԏLHT;&&=v 7Hy/U{cr}ČwT.,l)PUiMϵ9c,P\[2ֈB_QhɧqUBm*XS z073b=o" *hi(\Hj Hf7 Vv5zܴ=-`Q(9628 OJ>g%[P|<[0ye&`F!Цz0d'cϘs]= MvWIJd$o\h/.ôF#pSk ːŗddalpha/data/bupa.txt.gz0000644000176200001440000000467514550246302014704 0ustar liggesusers}Yٍd7 w/Cԭo'1GbVXh,zx~?~_{|~}|u}MwٿqVH ȷWf\g^_M=V@9J`U#ʳ Z>_7~H+$v@Giqr~k@r@T\)j.,WOdf~XB#=|X1zTEH^W\́6hExk05*PS;=~4Qw;H4շ?'7ЈD):"\Da&d/=lo)Ckq!2G,[~qZdPf7h'J:/еd'Ts!=+55A7OԽ3 =9 $~Nz.!ҟ4fT2~N+UŪaa 8HNš`I!3Q7CJF .V #H=jY==M8'af>$Ԛ.Ƀ :5]PETJ |0!9Q0Q-"(˪¤Y>VPfxi~ #;h< Y`䵌J@  LMh$Қr͹_dSjN3ɁnT+''Myj QGD_v^ʯ B-orIr ᤚî2L$K 9IbL#f6fZj&hwt| c8YQzxLdÜD(L-5(3k{1 **0_VQۯǪ tޟ/zߏe'7B>YiGf9*1]/CvA8''kGH5,#gn LQMacyx_j|QQڼ>sdGd4!*9/ U5rŨlYOIhs"J5YPEVYB7'=#X˪xP9g‹:Ć,IiQB#o>lg&wX^9,8̷^vjz>2s; f"ljR٬t~ѩYwDCސ;@$ 98#{Pqcd w:Cc '|y7O#QNX(R3/je0Qu mge6fTf,d28Cl12 †PuFk(̿]X{s LF!R[Ek݋tBjᆀYV7Ax2/P6 {M&l6cZϵ{zqvA{>w8wk`ZmDu&K{ ěH +x`%P#Q|q0ߋV5ٲ16q#fFNZ]L&^_ tM";`$a'V#Eg+|A4/@`By~U㖅7&(1pWB^\wS08vs h$׻3.Fn-b*4W/u0k':KFf3 cTsp*S#b:-V\ , NTsЙm_L ;Dٗ8 Xf6 _C=' c[[iMmo՞ 't>֭rDu\hG9EN~nGW+RiZrLJ~2b_ʼ'+sვ+Ҷ_tB;-շF.Ah,, K9ͬEXx\r\18oxb8hG$f`dx` KXUd#`,&[W.ƸHvUӅMFn?4'o՗+3uD+-f3n-Pfܩelڼ:k!=qh ࠿K^G & U8qd[/L"5D}K{RLq+ {>70zD"?J^9XO!vKL dUPE~Bk c txF " ~ᰳpC)ws3~@4Wȸh/YEy; K-Ȳ !?<@B ّԯRLw#!yT8Y%f6~JQ˗op(F<7+ݥ /V5F;^]ME.OA]s _S Toʅ,vc["C)-=71~Pl oK5-d4r ʅnO//;WOW& fӠ?/dS8˂k.w''tXY4ug{~j'/Pk<]`*nDJΉ!+8, ^hph́b.vDCo` H'}]-)5dy !^)bU{,%+C-_޴G陑=y98.bbTwd&tv"Q;؀\Pkw2z /d:U1\X$dH.!pt0u9ؖSK. =ZםO&FLž#ȥ[(sΦ ;Apbb;x*#0D6Z*eajʓ{kL$`Sny=ͻXjp%JjS^a$.5ߡǙH f(Vm*QGw &[0g].YT~ي(…ܤb ߡpyw;l1'f 5w_z``# ='V6˱,? [_3-7`g}6+v8c=X]y12td}sB/CCa5-{j81t+/xL7<]/$ ήh_{6Y;"KjcmSw~FKTX?IWt-1ː-kZ^oа}' lˈ8G `q1VK)h3^mgCzO)f' ̚p˟.qϝ!f7H2/EIz@x#ʳx[Hzu^U*L"Ǹ(؆օ`S R#YG`{:6חLߙMr8 //ؗ|{S2~#su,AۿIg8ī [84ߪ2)fr"יFP3%qszJ깃FרT?~ ;RnPi1{IsG1tAXb{0To@} pKm*!c{B կX~T1a9Ql\;Kzl)rPrJ'hlLz4(Z%. ΣaY;YB( oTRd7H&?h7I"Ϳl^oQxxծơ"gLFSY^YBɜZe$2XݬWREܠEī-" Hn8g ˗x'Ǣ=-Z:c[ނ.|& W g!5;YTm^tڣad|\ejUjrt zC+D^tav*<ϖiwPڥ \<$K,3UZѭ 5p /50QD?q~R%ZfX_9(x~¾ HUᐧ6/ 7`#=(5=1TfIO"?*%1߾$aƞ%3'W'E.M3iP  |4֝%_V;M߶[=ߑA ? r`6혎!'˜=DQD5ʇk|w8AM"^ָ.(`W9݊΀h| %flDPaW`ףIvhSc겓,Ev]<*sTkv(kgQȧEиCd^! Z5e\NFׂ Y{$;WSP֔0ՙٍ[T0gz*8SS<'l㦗ۙ%ʹF%>3NcH)v  {4RN'#**-wE{_}gO_9,4F :8< 4efZ 뉹;z|' 7:Zv@\M]>QxTpc޷kSgHzO [~m;z&Emm!4k=$d7ŃڷQ7#j+qNmOnڔHvrnԐ)vz$˦QKtL -0o<Ưi33*fP-~Xʇ)-51{Ċw!ĝoMwfAѼOǘ3Y]Dn a_?;pE-^MNfP6FCfT%(%MI:]$~׹ޟ$Ӆ֫Б튇eO*?E4Iߎ uy?p7(W_5tD&G#t5`6\ÃqH3鶿ەs ddalpha/data/banknoten.txt.gz0000644000176200001440000000323014550246302015716 0ustar liggesusers}XYrF )x`9b++**rr[$=KǷߟ?o_ 8] YrqD.|2:(Jjnozq NMQ.2;Fx*ke+4ɐ<VhXF q|;%"uƒR)NVyZrv_,jN[,{0 3Azq-= [Cn]fFnY3%|[5_$U#7ȊoLm*̹ܻ^a tݦ xnhe=b* :ҷ4OAw )ʺY Wԭ^8u_75Y,7ʯL$;oT* X3tGy;=C+l̡Go4k4ITAWZN<nD*J"6"%SѵԷ`cD6*{825Av 6B`;zU>/伸;em.wpQȭUHa`(߇$ ۿ vˍߝhxƷUְ;Z"Nq/r/ddalpha/data/tennis_MvsF.txt.gz0000644000176200001440000000150414550246302016174 0ustar liggesusersVY ` 7AD$E}7p'3w d f+B oy+!C&iȐ)' C"]5v&fH 2u.8T/NCprt@":h3$]ڴ( 0r״x×@hqNa9"BR %!#G3g*~%󡫧qԒ?I@hzv6zJ _ݶ;Ѵ$ѥ9=BG$ d%EʛT#ZާN4)LQM78 - j0Wa*ָ۰ǥp44ɐsۍ Uf+҄Q][P RO4ވٍgԒgIpic.$0RZ iZR~b\_iAհa rziꥥ5*qpq\G5V[\,.V9a`9 5. Qzq:I \udCT2`ˆnrK~2<:Lg gHE32md9R̐ѵ%y֮JY 髏&uAw8e:{4T"^eCލʝӧ9*KW"^YۯV= (>lU'r34$\0d=}ҭѣld7`WtiyiJdx]=*<R|dW06ݘX]u:h{ %nVc.Z߰.lZ nq@⿧7*{zy&^J7lXwӌ_G ddalpha/data/geneexp.rda0000644000176200001440000004753414213423775014730 0ustar liggesusers7zXZi"6!X0O])TW"nRʟu,=!z1 gZ{XN oAqW x-x^r țj&{ª%&[%9ld',ۄ^~6㾶5@pMA WbPl7fHL H ėas?y\㻍't[ KgyQl]X5]Y]O!Jxe;)M1vH w$̻͑-j %4÷0a1c=L#L~D%ËD`9紭S`8ǯ>[& kcU冱fEOGT3=T 2$zg<[K:pEX^1c~0 Zm; _ \uqHTo\(%F;ğļ/);B_kޒc5-]Si;&d-r\p='Ged`MWvI<܍-9Dp3C&j$:Ǝ<䥡/Q5;n154ȯH~ɣưU- Ax8-+{p31Շ&]cui+_*$ ՍW_{P\ Pg/Ao*aGa:Q5Fev3;*V9 J_-a(&CŔ[L>ߧuKn é2:.9%n$Ru鼵JʵjĞz 7#'U|-p97yVDa.(OG$`Vʸwm,)l/} #ʺwDmL.\Ul3|N1-eҰ¯Ե-2ڄD)fD{Y~b נMcEK]ߊJ!GѮ=y=YgZ& ]u)yqeo'X!9_9٭9+2&`d׵:v(T+4"ڨf-1ga7i Xݸĝ C*]M2|.Wo1?]xZ9$V8XO^ -4/fl:&L$?49EZuHхnԛey>%ȼ"KiJ.v; ISv<ґ-|:mUoͲF`#׉96Y@τ?WCTu"ye qf3+ʮgy9”[wSUgr'anXO\O+cvYrEEK̾Z]]u.@cσym% 1t~칢uR/ew+'&8CXtS9m D]ǻYt.KmAFM]5us;HSR؞TH/גR̽5ߥpA~_~'9X4f+e:H0]5?4Z+r Vm XP-94H-}psy.MnCIySRw*ENU<X $ת1Ip.Ν>pF|"hcȰZs*2ʕ&sعAVUSvN^Χ`"0{KylIHs\uԦOʟ^WYG'']YjJZYeX$W:MTi)7'PMȮoB]|ŷ ~9֮nTJK1ĪRl{dmt]"d҅IzL ){T5fgdt'H1g|~|=}YQ;[MpxO )DCȞ'Ieig25[E*8V>Qib$$}U`OJu"PC(uxW$8p/Ƕک Arqn77%¢$$?Ci/t\y.YSBƞWZ^0݋߭ي"|@,٤ŝg /:t"g%"|8s~Q/@)ǭ-UC_W<6p; # p) 8ŏCɐ'(Ce 3뭿W&_ @J!4Q~C8reV.s" kjh8;Wr Fܨ r"2z\U>蓓KU$nCi 4BV+L<*Ho{;WWyzh)¢N&n;g cQ+W=&hĥ;V lHۓ\@B| Soxm]ص %?.D{)<&i/o50 H@ۮwN$!pp'5V i+gQ\g9ϑxZLp:U0W{P1E^N3<'jj**ʆLBS&tABw\! 6!~_|Jb?_1r7F$VYsŋHA#7`Aޖ)Ebze.]qꞽ=jb<-j8'䢽{?K$(R5 A68*ߜP,>tWo ɀW&n JI\hYĹc1)?>Un]nps/3d!RTyl)Jn8(H4Xg1ESƧ*!+j~ +su-7boO!Hp"X6ɻP7i2hWfR5m:f<ڋH9jո4S#?NWbrgE|`PXbX>s/{ݫܘ5a~d/F!qjijѩz2AM oqBmKJw;;7\WFTShPh uP$Hkzp'`n='+02H0:6lo _OC%+IPl8!r'=3Faە,WLkBB7D* KlziW71Eg,-KA*~*d~.jd U/XgEۭf$s}ZD@c\ }Uh|߬(pm{Ǥ69K/TBhnEQfT#3c=(i9shQyu*h"ܩ;{)1POZ=f%6%F4{P mAQ$eV.RM䠱 9i r`rb]P@՟j<3~,ԣj$Vcو[(XƓ'{9AŐtfz\w,Z$nSߜ~ 18쩶pɽwbCl:X@䍮Ctl^·{G>@'@1VV":W4\C4)0 ;EfsY&fq p\bU$ZK=0a&B¿9˕׻jjS)*I"/,3p)D}; ]/Smf`-tZ8CIr&sW;ywKrCzBX&Mg-Dl1FA#ehGrFee> ODłcËӿI+I}68:η y*) ݨMڑ"],xSK ~3!m_Y 9F|a00qX (h\>{O+gL:p  нъ;Pz]:{=faکJ,HY?%o f14&;?oٕł *ѻ.૓Fj1F[Ei($#mU^WJ`} cP"z~U lt5tλ X xu XljQnU'ipc.҄2q_XJLDuCGI4m,?6i@wvN"l2r/kcp>178娶@f5\ltO}=Ʒ.O*'...lr&@Eq1݋r>pk @6b !Mv 7KB0GZw:z&w6ug}g_oa2WsuRKn|A]ѴceEŬdaBX-@{4;$Q,:GTbǢ]KX;[c$)-|Y4ǵP yTȻ0F/EYJxUk.SqNs=>6?AYq/Czy2piS$6&|Ʋ!S޺{`xzg;2GX҃NOfRBOI 7o'p_رTPnSkfG+dE5=(`Jy]@W:с9t"MGR0$l}GPnyЄs3ecw$15suL2Q?vo#,T3TH v̀u`E,bu%x씕 2P`n"K\E"Jh` -8ecW1з滻].̈4**Pe?W?b@\@Go  z"q0FY ա2v %7yI W0i6'_t=|/5?#*I"yAO dz2ʐx*!oN 璉ޙ. b9708bυ SPS`%%9GDp#if͢ tD*gY'5ìYE,\ k|]ٕm)+0 WQ_@P_jM\fs~/62O}AYjsEЀKwMj7\0:4phNVE$4{w3ޝXO"NwhF5ժg> V]8x<áj]5(?x(CvnnX\ּB-Nu)#dO2많 :|T$t]W}h_#r i(qI=o۔NwPPFݩ9i"D\ wڤ\ԟG"ͽÊ ,-RlbtXJNe8l0 :ssUh=>qrddVjA9kIB ږMsZFꅏ;| Snnz'הC~wX?'4(6Ux_;BuXQU@r\9$g4Кvn"weU'Q/ 7PX#@G|D*z*:^,IӴ!͂Z)=+]FDvE mcfOx[(zR!EٍyZ(x;J"XLu@IXNl6d!z]Bvt+N?S~*q%hd@6Eeoͪ!,}1OQp_R9ڀرʇyaS r%s˅Dh +x`:p\oz-<6N8('{xk :b1#:4א5lȪ3<2=M~@щxH`9od.,CS̄l[j E븄c]-, ]@m7R"fg$k:urKjC~dڧhKMù=q*Y-gÛ,]<=彋u JV.^֤-Lok{˲Tj1ƶ,;sN.5a fjP˲ˊH '}5 A!,_Rul)b Vly%]ŚYҖfܥ{'jީiL{L54 /E`|{P32xv2X}n [</Q՜'C |ϓj!0t$cMLh>BivѢl 6C^aUְTTkٵ_`4a;Xo /:GL ? ^OpXɥ%g~ WP@#͗jaU){:$_:g~S oF2.MP_.W$#' A/dΩ jqi"ӭmZR$\.+tSl!M0O1E|bw7%6Ȏ?ALcl̝C2Ɠ3@>*H&R?ךƒoz/E(w@pw!f1rq+ N o#!%sTPW~zjlR(WGE֖ (ՂP^g)J/(D$^Օ= ÙMɐV^X,밒/#7W㈃S9 w留,kQXV}j&WunQlg/7UW *w=w9\Cb7ԁ;(v2EkMPmxz\-Ck/1tQIchf.ŇjJ 4RE4f) m!v9g҉prJ:8ah/3y$P O]t(!⎸zRm8 r.Xlpn;4D%wi=oݾGWy-7B>?upay(^G>ŕn"x?k}\NQɡ{ _>FMŊ_AiY!I8v dz4:%f:[?L`LR|FqEOA|l8̑V&W ?ۅ-D6of kckW]ݱ9]D3v_ *^i "ֿ#H+pKduy3uI#6'=$ !C$C'oTbs*e -A~ i}V!gǀe!ټ0Piރ_O$JChdg I޹Cv^cEΨ&Dbu3pqBS8ZףTo.v1HD"sU+ 礧S#=g·4%ڋp-Vۖ>V~%Og*3c}^͔S*ѰԍN ʊS6.'ՠ<{3oRΌ(@hIA+EDOf>`EcUT.B!c3j7kGz`j0:6[5yvN*oU1zzK Ի#6mdxͲ;&tU@DMo K(`)bΪݪψU?4:4(|s([c S8n'dA1ɄY*<_WD/xFyZtaX,3QT-V>DAҭ*9aT3ȺZF3qdHd1mݞDkv0Sq5b4B􋒵ES9_B>5 d<-`%H;["A|vK,^C'NLU pVߛ.dzhg8q{0yR,uҫZ} EN2'Hq-b4񣫌#?e,Al;Qp)d8kKd w 1- ?s$Gj Kv{}åDLj7tU=&Wzb玈b +Ce2ĂtB`Y = 8_;J9͓7'X$؞!^a鄻Ljjo#Om`%14 &&?b n2GF}9% Ib5>}EUI~.b+E>V}1#9+ܥ'~+(J9sk[D!y@;Ve*dd5*!2=b:@+Ǚ]ͭBZ9Jz|BZ%.k"4A#N/l@=9N`'݋%e]e8kqъiMNGp&\SA[YPDH s|@GTpZ>RϞJ~V`q)qֵ[>ܚhђb؉WPQ$mZ hE5a ?FyS}{syW īe|Ѡ.MVIҝFjܭ~ˆS'OnbHzvt+fWZL~O;@5 ZvPHlt?#C$rW#!@]_L7hZ3'!qa ԗGKǿbP(yvԉ%VsqW`8\=ۧ?j42hdؐ%G=.5I~@Kd{M}:Zh|0 A7`rZt%-dEeUeTހJ=!^\)UqqW0TzCp9h:~7*"Zr@t録,Sz8ptcvptF@ _,'KgKtZA~ag 4r)'=tr𶞯 (*NQ<7ѕ#*(y _LL/bSI6/qzړiBDD]xTJI|$i ~KcTCv2IG:=8Sj'*,4zjwPi3뉿 ׵Yu /tKGN5 o,k ̪ph8znycQi/bs]2LU7UM 7p>#Y?Uk}%hJl 7YgX;ش4a% / 7S vANc`B0R9])se{t^TcJe6kh%{#\~ϓK( ʦi 8;%pcAXu1#ZAívkXp8#mu˜I`V~Ҍ!PdkZ$ubeU \R)cꝏvK&͡x0vZ;ďM;Hz&-eGV3btPn[8RA}nFu;ܹ$]q;C9 8^I;!+OR(@)#_h \VF_q8-=F\/%ba]RYG8cٻJ9OEzRb1ykSayiSj4 8z= wr9 \ٗxz=6"g$n5[R4#dƯCD5n9c FQK"wM/EfY~eIVl*eT {H Z7 Z;zN.]ku.cѬove8/$܄?ΆQYL j8ji涴 |H$6r QYJI~fN jc5F>vw.UN՟UBe̿PcVc1"zq!,uAce ɼӭ#8cmg'mDqE{A#Y'.\SA:@pʪZ0nCd陼G-\/6Y뉣kDõYCbat. aƹ.U8FQt@WHӘs&a(sM5<.ӯC^\OȹO]"~`*Nr<1f.>lƯʫ(ЭCQtz7n(9% Y7ZvnCtY#|xLW=R"&CO[\n"9MJ8-_ds+k3Ad5 ;DyLD HL?\Z\]ݰ^>o$p4|wU!@Cx24+D PTGA%dPZ5s+*Wwޙٞ"Ěd) B (%mzAy+n~VmC85 Tb@u,XVrm% JĈ<^"=B$߀wY$HM~qY{Ӻw&n ᳹7)m+f"%zȄbUaL4&@8֍L29WnQVGT,rE.(zTQGC |DHvj/zs.$X%x?aٌ1ܩjIlu]i2BC(8_8;A[^R+if81Lu=MKH&l>1Xsu)LPj@vVm"0<5C{O 6]gF@\iM/uŽ|_NDժWz@ߪ~xh; 莋;!.vu U(Ki!F-cF/+;;w;?v-5E#aw?W֟9Qt< !ɩvwxŖۡnlFќoIpUfe}r%/?A :gޠlgE(lh^XBL zϓ'>ɓRwA82OIud y^ﭤړL$pZ'ZEh>y2&HwRMnLPĵxP1ԱQ&ڽ1Z5o%;kQchbJ&~ΏQQF`>A|ó@OW2[^ZV.-a%GES_38arL45  ¡9/oS+UY-Bᐝe%TxHAՑc9y5X:p~xBa`Ǟf/`*茬IA +1OVY4#Ar.:w>޺`nV{fW>I}rK4x j>#7m%&U%Do2q^!*FW$ ۋ==DKqDu޸]r)2qJt(0=qDzepoC{򹶯<,>0@9@Շ/|PEA`BIRK&u{۞5't1m.bx0<`;2M5s WdnVuC̔-kN8u0}H̰/&a+ah3ѵv$/g2f;6>R'}(I9 PAuNj<; 2j2U_ f/Uze5\UBXl>kH, E!l8'r t#/.i/ .5B bMuhᦝhԖ 9%"Pp +8AXXD)uWCx(]Pf21 a<.ͼRTM5ٛ6D@t8;.|!ʷ5v3)\9 hƝF8F/&urwLmwYnFi5V,jd^:ʰFmAZ2bݢ~5cN6 4 Mn IuyF-ef?u)x,|1Ew9՝qT9[IzKpVWl{ex|Y)-A5yz$*~ QNys|FN칰|O21:";=,=HTmIm;)iҋly7$nWyoºH:;WwvzK,eSb^&tl4^~''ig?|N9;-P{:h~cԩ!iodek}_!B0&H6)oIGJO5#EgฐW#| Se2.b0q?i+OطtU^| EUw{>4*C2*M h)ĦT.Pqt,BȦQ25: ]pR( v_{}e;Zϖ2{n3JR+8#eƬbT1zؙ3 E@qD |i?gS#/udN֡>f˭g )…Zv=x`'BXs[Lux:j$<Sͻs߻?RJ909ʇLBpc7C(y):Kd[r7fWy7PKvgb3в(T서ɣh?`Ș162W1:çE2>t{2.7Ӟn;; =Kz꾁ȀngO9fr)_ߴHPHbSP5hI XKݹk]bIͲpFv'Q,?X 9 u'bpPl($ Nk @Uk֨mz¼[UI3CΜW3*pnY'o6,[p P)xx3CcgLV@~+Kϻ`+xS RF膴!"t# t1Rl.dI]C2PL1C)`;8Zq"P$(r#U㍲W$jeWְp4CQr|Y/pոWUu5~Ӄul.pEسKMP&Z0 YZddalpha/data/population2010.rda0000644000176200001440000005516414213423775015770 0ustar liggesusers7zXZi"6!XZ7])TW"nRʟu,=!zC6j,r ҄ů=/hMU'TDQIC 99t:r[UFeDZ ԖMQT) i*+ۈ[kF*2ꑷIf‰8IHsW54E[`4 Iޥ㍉?;zEHxm;T!'nշF;[YoQh`yAf`5npi&G|e+GPV ws\r1"4  WrzVںy,(kÎ*$b| .ugyV|3#BfA15.:IR 2dE߅aR;]2EQmIV zގ1o{<91^uyI\Nҋc;.fr8tvP|!9jьu\: ][ɐ8a b3ka7m&_ܑdsC}dE7yG4 dt}d$|I+Fsq˗~ a,Ns|ˎ׹AѾAPo]{+7\~g5/XTguKa J5: X > zY%!&^1.=z^-wI7fU (vƾ9v܏)'0\?jGR' ~,ocOz.zekalY*Gʰ'QK줐-Α(rVT 8YO_zUFv|ov9*vJ,;5袚Q&:xUH,dBTS d %(bcDluTfiYŻ V\&âdH8Guz> ;g2y9UFBեrXF޺NUC,*evbn&?4| f(H;GHJpB[C|r9dT- }`q'V|U]џKM-Yu5?L`3f}.qnBGTh ũ5uG^QoT9?ҵcxa "jk]*A=*o){<=D`by 2ܳ*dӊJ=B jˆkXD,H&G[r.W1C/:A91*G*dqRdJ *bd4]Cq\n?Ϻb>W%-k2fXUD;W;^GH⺿x<6,oFH_~Xg?7mBr]hj o?XM3)b0{ JwHS&κg&g]%iE3랚ZO1U]R 7*N|.$' G\Z$у[+=& cB L 3U b۞P wr~yWi=nD1^QD ˙Q'm%!H6ɒn({iK8| (5NJhkVtme㬻qN@2O!tCz爢$Hd ϳ61jG-Ȩm>:TgPGA vIBy=PŚpBy+:;^~NG#V / %v G'5h=DECl{MyqYɓQ$#GU4d/`c>s1 w ,<lꑦR|9f1oS+|ҶL`74E<ϖ+m7S9ez7/{%ֳltCA>XR\eWOӠJVBy%䎲O+6Ӯ7Aϼu@߃|nf˹y8dɞnCsOdE6ng4Kf )ɞ\ -u8J4X5MWY\0|^"Dl fU=2inz 8:~km|W9pRX M@,҈YЋ)6eKKGYMҍgE-]dk5oɮ3-R^s 4i\oXMe"0sW\ PAQm X$f&2UeTהm_LQx͏V`Ik[tX`n,3ئ_oH9|] ;!p u6!; ?s\1r2{EPL\. Kj6W?еm{bò3bxs>dfhfxK)^^n?&6XKtVq]\lzkEynЬ/ZҏT<0 6ڊp%F _&Q+I-f2TxqPϟ{eJec&R2Hz_*ܤ:.kp24}1iW {TuTN'Wjxjc'mG`Pd!j<̂Tl4)R[Vlf9X23]1|^V/6]J$P?l[\;'VĴ!cuGVBHd!tgqZ-w LJ06քQ^`OKNf㺪n1̚XJT_6ݥ@fy_#~U 7~q=/@gm";BoXnZҊ+ 0JT]Q]{:(kI}>ݐP bn#CQT 5ԷJRR%NM(S`00u ;Cx:Ç."Cё}>~"9a/ Ro`jT6ZR*Z[^[`L).C$C|C>#mP^s>|6ȬIBy?W=zu f)mVqzsdFC支0UG(|q G+;mʠv}aX- @@-w<}yQJbN!}GR/Si6A&'uFfI.y~SnyX0 5Io ЉV6T&Rڷ9̰nZ%g:aWP\;&^ S¹04L|mZ*DE+Q79qV < > PUP3 c֣_"4\-Yu (:YTg\f b|p< #93]S uh)ZQbF N %c#U/El;_g[b˞w`q'Gfܗu\A{NVxHe Q 13Xg.;-8JPWMler}GvA1M 8'@Y˘A/kEJ& JtEeo|{m_8ϋj1UQzTyﺃn# [ʼ;/y~>6:!Γǝ嶎#__0 c7|^:z@6Q]/dBWe AR'lŬSHd>Լkj `rѰ:.W"jwޣ-Zf{ңg.|a1 \oWxxC.#!1mHC/uaezH6.C*%hIYn?6{}SKyT%Wm߯ ?^"Ƀ 0I!q# |[b Y GfFI!2bRSP8CwgҵźFɣ<6pQy*4FQAH rf6Pڿvx_V^{IvD9AVەjwP'g T~ mLRHBrIJ< hVdPˀXޖNj0RQ1"v^0GVc=.2_0\}q&F aN7f.K&t; TT;Dޘ7ʤ6ʶY+0OKёno6rwKe"=7b}=GUZ^"]ݓ\Uޒ,m>exRkRZUh~RԂײHgpnYE/SƛT_ȹ0rHr`R,H(R( bژ5iRhy'ZJ}|&u)? e]{. 뉁kP"qAΕi-Hr aXLvFq59zDȔ+Z'fO3d-Wt[ǃQ% XPH&5W5ʫn'ٳAAXq@oAoj=phQGT8p&͑Af-tLMGM=wn/1Nov)= 2 (W #a=L!4KR;_Kwa JVLU )172XE,Vih*r AmS~MaK}͍ VzARNT~g|X4ۻ6Ubd4ͥ =cc)?d\텿 SC=S1)N I 5dטKZe2JG\BQ¬ޘ |oG >ԭ*\zM(=9c+xhDD UM^S?{Wd|*uxvGLp/Q^]69Z3Xv,dbKEt4[y+;9Ԫe~R;-4q.un!rEJuI]-ܺ1߯;d^g[I3FY(LtY*x姏O ~E).FyA`h1PřvM\Hx_AhV [W Mԓy/Pk\UxU|1MΊ‹J"-xhC@, ^dWs[#\U°mf`9o4H[xtr.ʨ=IݤPAC}C2Vcoo [=0T7| Uf!c"9ۂ8cBʗr.ߵAU]T<4茆=8?~:@Nռ)Gh6&li GT t^(Uw}ܻ42TJV|&Ļ @Fk2mw*O `;m_`Mt]9kXEϐ6<5Q<^Vz_2FM.uҝ^wB9^}Houʓ/ݟRdg4W0њ`ਮI&xE;Ц-/aʼkzZA DA?P}Xfai@CeQ&@3s㴅WL!B) IcoynEL/Jv˪km NTں ~*5+U X!1Y^YI`r U_`8JG:ǙԜ<'?ɓHT.Pˇ%x&9-{`ى [8U?&[& d{f_֐XFw} EX,LF~{Zu:"{/g_kqNZrϯ|tegDYu2IǀginYo2oOQس1jV]FGO{EqR8QZ/1vGW#]Y&HZWw̎|ӿkJbi:BA$sIvrs~9&ۼ ဆ-}A6#hd98YՉnLIhl|?L`/qmTFJմwbH5KrHQ'(Իs{0 0Z~.aM;j]&]%,25X(=ZwpfT>R_QN%\-C(nSE9ư{Ԫ=6^iuQOo }Q#s$Y>_5I%]!~S۰,wNjbKN@ϻԐL]>cī0Dq~` ,+ e)M*l4nW9 ޑ1}j}ӌ #,^GjBS6.d:T1j{u쩯qDaP.CQAZwjL]ۍ.3A lc0K']-gJ%JֽV^3tf!: v$!,#\؛>* p*:tكFzڐ!>c0$ȖyMϺ8SV3B͘$K$C +΂VI8QQ^.]S:t>?k͓afg9ږ j?UG _mtU͠:XהX=d9,CMCW>6wna[01 }\=1R,U4|/_ 5fa1`:A'?41k L1~MfiPFl գxl2t ؙV1z` *sJAЕ"0_‰kRB4Vt>M*{$e!>2o3m|,׎gX0(Wuu3'egFkr*T6u [mǶUF<ATn뤬u$˂O|-3Kt䢯 U:.cz!k\7>ՈsǬ|31狾4)3ǎZ)cop- ǹDu7V=KGծm4Xnwжc!)|njtQiHA*oQ+Sap 0eJ0)M{o!toܝ@A2Iv074BamnR{nkb";d};x5<<&3}Vw@ȅؠ羘W'B^x!dQF),*siZKK*qekKIS{_|9I^,`[0A$Mz |+f6w:XY )m^"lU@ӷ6Iٓ| @{9pC!6v>)O`OczBbedb.*1$/uQxŤs5ڬ9޾( FAW@S%,hwL*ףldh+X3S P)3 i\h(kʒnNo!եB`"_p#5NpA3/km F #v~ke:ܿN:S);]&!^lj:El[ʵLQjsSk\<3@t՗Qƒzn%?{s1 m9^xr<*pպinzĊ,V=N,[0/DO䟛Y-9ru:Qq;noiR\ކS!Unc­bdB,5u(0$aٗ &5m4 T^?2`;llI9Ob.M/Y䟎b:ZG>aNE(+5?l?S*]r*:=Hd/Bܒ}uLsÈ]DgY@9cAРbW؈6j .rnmS\%Аu 5"2:9KlxqzAyz@rE<&=sXe1Ȁ`(o"pݕG86-ɀ]o"sYD2%Ve"z#ZA7vُ' Yꘃ6]u)!fH;%;|)J F8͂5U2X+[Y~P^l1淏r|#秺+.%g)xd{W؝s j`ޱ~1`1{\hn (ա9s>ohWFc"כ74ofb\<"W".&Zm=0mcCaZaG Üzj/he}ӧ@ʝAڐgZ1i`tRk~ >%] ,U/XD`4EfE#$ڻk˷|yIER<:bb7 *j>ܿ>Ⱦg M8)} $VmHQ̊w6A=GKh= 2傗7Rӭ:? rg>w̃lRā FKdt6A(lL/k,y %.Z*tkkyƺ9ET4j\х(XݱzDi; [4os/"ZmE*@YK%7aI+`_-k~ѦC&V:.0あ^uUGE= hoi-x:}ʵl@,e(!O< ؙ\%4s CI颽hQcglDf`4]d5^stAYL#$6O% I.%,ar &mqZUrh/Ӻ / q|샵ǣ'd\l"J9 pl^oDԕ"3nkչSDΩz䇥tWKɘrqh|C&A:ĘpcnHZz *7Wn)Xw)^%{,+Ï`h^FXFsx&vyaeEzpӚNĸ G*S432 luu0:O.np''ZOot +5̢CRHH_8ZCu5ae DZj&d Ky+^'O*78=CO^t+1:A-=Zbe:84$}!8}uvT_66H*fyAeA[ɪDǐL!tQ_vEy50v+5 UN20 kr l͇/=3 e%X7#Ge]>+ ]ܛj6'f^ bHnJJN.+, ŗ [DJReZ,ewT_-V#w[ᒄ5c4y:s}NKK֑xxIIF2ƾغ{1pi{W KP㒢Țڧ,7" eLK8;3Z05g}+s^Zr[=U5n6 z1wrwWY3:%Um>"P{vۛ V۫"raDW8ڮShc3?7r_ṿhP .0_]lY\ t"c?ph&bA%!v8Ҡtڽ!i¡Mt?zœQ:g֐ C-_θVx Pu$Tt?vi%Etc`LEMQfȉ+R1QbU 3⟀\[.+!:ENDX8Ŋo˔V'(z~\ 4,(?r]۾AԱdb!S?LCffqM ?dKq +E#RJirRTUHyrb/WZZm'H@[`%WRF$ѮLDӶFUZFe|aIG%Tj%hUgF܊k}3nݩ3Ήе<&BAn ݔfF@軣O;!H't"/Y~ Ҋ$2$Rej ;xAl8Xy3~2 7,ҵϒovhO݇V={Ì.vE9<ʤ9Sli}ScHR4blqyF"Ձ&#@I@3jbLk%2y@Nb wt^aDM\ 8ScIw,= Ϲ _f̈ȫ!R'}k(`2}\ ""M|zfl,O H[l]:H+ wu MܭUzKv4, i;Hbob [}xΊ^Y  \_ XT3@. Nd5⊱SQAaiD H-iʪ"seyp8ꀇ蔰ɚ ހmDr}]-ő^kN#ܓ: k<ҕ";L658[0-aAbc͞^Pݐ gEƬ 6*sJd3Y6_в0P^/hCQR;P3|kn"p-] ?\tIx^I31Gb1*G(QsnتTɆ0oS6a(5F؂!$=nxo|}|Og 'F5{ں!wwؠ2͗64kYI2|NߪguoH g5Qݷpa`p&b7 uI?GZUߨB]X!Wt6#O8ܘZ'f߉C,Pz+QxN3%n)f`%OWzcF[U;{ُ-6 ?@ѩNsvu 4X:oȵ3eQ` 㜝`6#K{kϮ:+ii7A(65*X$z(§}RC7V7Om3{50e6£ v䋰OG:uԟ3|2o2%5g>Q#K+رH-J9^q d$5В 9.y9Xtְp7-`ӌ\QX>9Qұ&uxfUG0}DͫOFqF`5D?|[ڴVj >zcwL(WA`T>чF^<E鲫N<~}ae83ͽ鑕(0!{[X`J[҂{ qlݍ!j=;{| GwƵQZxA,GQȄ9ЂY sSKN͈ QF1_+d0˃[{9`#Jg }Hp7rE8]I爫$I2_IKݷG+;?Uc{]ou߮MZ>:b!kpPҤk 6gp܍+ȣ ςEe }N][Qk<~wo:| 6Swc-&Ӫ΃yZ/v>` I-Ϗl 4@d{h/ku%/&/ Pwma`T7YJ"ieW]cK%쀚aok^&E=q s2=]QpCԯkI ^?iw%Z;Is^gԦQd) W9D\͈fpYy)(4iB jS#RE J,',j4HIQM*3l̄'l"VX{9a,zrs$rWԛ1OK;>AoXIĉyֹU"W/ K1 IY >Y4!/"B!}|) k}Kmޭ_?Iƈ2\O*E)1d)8j[?0螠F]5qIpg$p^oDCğIQ.UQz)xl6" nsHNUQכU>\w^jWGv|H-K9-mCǡQg'ɔZ=9sOw`8]zQ, Hd4g=wQ9N7ۘ9$b@jAd$ʳ!{*ݥeƌ%W|ZȪ5NHrQ>05}uMq 1bp~۪Mu|؇0vnV o.#[+EwĉMhķϳd1d^GޓhbQ\DxmL>dGc8XX#FͿ.ijj<\]Y!{DxCZ.D,F&l|ok PMkXݹ4B+`iwYǛو'YxnRIDF-([tw:ݸMM(S^ S ps3H Ҝt'n1 D5u٘n>#K#q4}*[BOsSs=ãy#}Z[&\Ŵ?sdf=a7yuEɯKv-q¨CU;O6ٰ<^1N(=?I%ģbl s?N5MK`>c_EG*y2>5:vs5nQ׀KcL_Qc﷽}IyR`s i*7;ȉIPvA t^kp1c1rſBpa+'Kш4.P궗^ g6q3H3eZ M;ML2}n?by}*ZQBy2Ij8!9`Qs@fP9vx7f!d\x֧j@ X>г8^3=kn@ݼ Œv-uI.ѵ}=Seڰa`3B}v7JOKt 8x TҘ90sl*,۽%_KFSh#Ǫ9$ v|rz!=-^TƏϝGCy+?۔<8dS@Y?KON &!utP&o(Ś o;,J2窋Ҟ˚ZQew2l'Gٓ.fEq&Jj?bH ]uՖ1ty#ZLɈV#Չk ' ^{V+z3Hƪa,JXUΧKUgQ3YA6n {ax:u(sViu|ymJ_#vӵqMKR˗ fZ2,xPe,,FoL">EO\6GaǿO`WW"aA-*G5;e'8;~(E^VWE"m)CeVCr.|Ր q~!¿d@`jAK.ٵ:~,z+(,H] )~CWѲ3ڠ퓭<o'6: X={w/6n6̠&V!#i ZCZdG-J{vE$+#@m C|3u>j"'j Glf}~-n,Jރ0lI)37ٍ_>ҏr)$J9VL,^~$ŶapeHhvQ `Hb qor0{]o݃kum eHt: RN/6s:Z}x&B0pGz`LTk[5Vכǰ9~pEJB*ˤDKe]\rU.?'9#V1l硨rFq *X2DvH8s+>nЛO"sݼJ>aҐMM<RMd͙o9$u_?`B=ۼ"%Sz\maJ%1`]|8wv_%/*fxMƈE (v,8|iY`"LkB-iSiK -9t=}FmXHƜi8\pD4{ ł{?=s/K>5eh.%Y!pʣ1/۳$کmP[1m4C9*/4p/T^zrGBA V`N6A4ՑcIJŗ!c~߶!(N(DjγL' WOא1yL/Dk98 iMRhj],E6hܦP5\`VUZrqqRZ~'酘U).A<ۗGf{&FÐдM"37oxdYD+]ǩֳS9 M,/&S%V70grM@d'A^,Ցc)51.\ߤˊ(>b`A@k+trkhj^#-JWkHc,8?^'Mb 7La&`otL@#WtA60jAsƸMJJTy.BDݧN#׼.-rOsy"PLzJP#Ԫ4(ihIgǷ 0 <8/xMaކ ԃU x,Hq2ITuJ")tJfp#;,er]8^CND4FiPؖ*f8" bbƫS Vi<}Et0͚!>:3ʸ[T<ŦgH}qc!82)]E.1:pZnъASٍacfN%SCi}?C/fw܈ U ? *-ƨJ\ntO&y"7 8Hdb߯1YxZ8FnjᳯSOY+Cd3O,]]aaZ}T;ŪY[_#zVヽt@*~*"T|+*SH_X>B(ކBܠ>|+FFV(:|&a=C%I_~#,h?v-怷qSΚrts[h4q%.6u; fɒ;^lv.ݪ#ɐP5=@ nj:\_av1uf6:Oz꾛00uFs-U.y3*dEgJZIU<ÐDP̌TdJŘ{܎@NB0yͽ\)_{,eĿB&n6UQ$8C5xtS%?C6Xs*b_9n`pg8b;",2M;d>A^o6a)hQJOiA GTMdX/"V+tyO)ͣ!j<ÍVKή\Xă@[!UXM"Ɵ0䕪fT`8*|<~,ƞ`5ah67!Tm{e{&O9׮f -"9bnKÔ`X3*lX+~gy.@MF4|eDӎϯ޹ c&1\ٺeȬӍ 4)J|*е?[$@vn H:hVjZl^Z ʁǯ#ZΩ=!cizs&S%yy%jOԍOnF) ѷ|i>M]y 'iڰ! ^'eVN-q=rJ&8 Tk!/ϴO$1>0 YZddalpha/data/crabB_MvsF.txt.gz0000644000176200001440000000164514550246302015713 0ustar liggesusersUV;#9 } e/Don$HI~~??߽j}G?-Ҷۂ }׆YZ֙_6ֲu$;X|49๶U3?3kmI"'D !X Ht@NVG%9JRȅ:,n#Y}Vo:W2 -#&zd  cQg:zڛ Cn27vM4傆H8^Hq̉a> Luboي#f<ոvf<:Y~c6q@6#3Yjr'h*ƫȌQ#:0lVo1(nh&`icH,籘WTM>eY1.wM_}<8UpSn58K} ؋ m3& \v5ǁ)őHı aX='̇y0/4Ed1R:tn7m}^ziO]^$` 8hP<ގ:30Wp[6κUDF3 ^!;5)&$iRf!auH `ƅSRhxI^ &]唲e"+5v^\Lnp*H\oɖvZi6pD g:=_RN3禧f ,EJgL4^$|BeI2juѿШwd)րD 0]]G?+Io+G[ J&۹;:z.nqD*IB? y4CqDkԕ:lb%d$72( ,1gSH^ ddalpha/data/biomed.txt.gz0000644000176200001440000000300514550246302015176 0ustar liggesusersUWM4+)*~#m&bl'O?}g㝏GZǩt>Z/m'.C7N\tZ^4MA}@X.BTNy͑36E+Wb8{֋VdJD/đ}4vB[N{M>gr,#,33}gaM\INTώ侳)ECswldkםo'joC=a<ɭZ-R?侂Ƚ|dr֡sPH ytuл<~&ys/Y͏ζa>̧Qo~\%ǘͮ3avOG/ _MVl/)C{--AˊkD핏$<ddalpha/data/ecoli_imvspp.txt.gz0000644000176200001440000000170214550246302016432 0ustar liggesuserseWK0Ud6d6wA}]wv5(qU`]Ѣ´i\m05m:V~p+8antK_I9n{X7zݑ:VaUd_`<|Gkj;߾Bxi`BxFmN 8#|#gwqQHutk ‚V⍼'<ҎPI %Nj:oE~% /f>8*e bLTL$}אP,IVõ 4+_BA3鬟Й4=k21Y4^ L([ iVzQJ+˹-T+*@zMV!PkpgQ[jZ[:`{HwF, 4|zΧCJgP'ApnR$ʇ+I«PW~^Xg6ZW4Bq*cCj;DϯEMIkj+|0܀X;tr BF}38o\)S=&9AU5o@6ߧZL.L p9 $9ӣ&谩M)"a]4CH#F;{iFS1At'[Fʮ@ykq6@X6`0ʚf05[A\t؈9Cv ;Lq59oH[Hj:D5]2UWC xV?j1ju DudޜjEjJ IjonW;(@ơ*ؽV }HBMѫ[Q'#gy0!/pO]Z~:Q.;Y!Ф8$ѤE)t;/IJ/^ ddalpha/data/crabO_MvsF.txt.gz0000644000176200001440000000165214550246302015726 0ustar liggesusers]VA9+BBHz6^,I>LO5) Alj?u>sg5۟hm|m_Cqd^ :ҼI(K#Kny`G8gnS3}#PW Q|xF v X11G<|gO!^ ^ 4u@@ $ Z4C`X42PU[o3p_T8\nxLU UW[C7gyTQ=cn/}fW)x`rPj(bوu,Ğ s R& y.x`5Gd!nΡ]ƜCh x4k7QNBCx,\Mp/ BB>ptǰg DŽ9I Ì#3?s~) Wz8*Tp9&>UJ  Elivc8R2ScJ@$pC.KN:2Gמ8Һ3:µ2fR,*.iKY(O0/)U70#TI\R(6>+=/!*y~zw{ -IPs(Kf?772/j,U\І%8ENG۱ †dfR WXЪ )0QM)^u.m/0N"NsڿxvT#;}CGYİ<ВTo_ $$^F.3!4HyvS0]3vdɷHj !m#B:b/ Ǥhlp,aV[+AHlxpB^y`8#۶l*nl@;,f8%fJtH+jYQBj_{ JdRRS!j{ ==}| //2)%hʃLu1B]9m^qH*2eK2+Yj^HWd4u$ bFn4q{rvg-up[ccgPmwҊE[2R")Ӕ6Mh%OM9.YĒ2ZVQ[LªU$?R^dňKM3Ia-oW@Gu]50Ksu/-eG|\=`AQ!NKjr|{tAӸH5 p;m1MnlΔq aD{]2ځTXѮQSWޗ)s[z7u1?Gkmy]P,;c:9{W]R2BNv6iC#3tl|Yo?hB8Gz`QMg2z n5OU3'A6-Bgk4jYXX9=e zx𰪞dyVu8H\{w*U]>zGt5_ߺߐgy*U걫LiqU{8E9K^C:&(, s_rRCŖ"advȒcdDv;/䦾BdD &#jmZGmYczN7Ç^8]UM<"3NcGH2g829 N%üOPHޟK,Lv'EGIْ `L.hM8 +TG>eif'/mddalpha/data/veteran_lung_cancer.txt.gz0000644000176200001440000000174014550246302017747 0ustar liggesusersUVn[G+2110`DFdɠhE7{}u}_^_?}}vmkktrzv]~/| qnGb6mPnX W8vnm`:,l&Fаax 1-Jו/9,L>U'RaA["-|n1o pb1r~>[ CRd_,QK'nTs\J|OT:XR+boϞрgŸޝnwe}G>LYA$|x\|:ߐ3;q[QBfbK)l;G# Ia Q;"F&#yd'gѝuzfl 4I3ghK :SK^; SmxuJN&5԰Ձv@*!YӾ"aDl:HV=ʥpEpbd8s`C>RG >y5^33dz0pρ9xs@K.wsٞxQ=b!LGL tK&J.*p(Ո9-rVX=F[mt7eKKoPg/򮙶\'A 4еL$"RO񖞅$=_,aJ  m(?4LM4Sqj?ݮ$~LXdn ksu>@ZPyLF ֳL>K| q~8@O~g JX#~Z)(ljh9*l2v>Ev ddalpha/data/plasma_retinol_MvsF.txt.gz0000644000176200001440000002061114550246302017705 0ustar liggesusers]]d9nc?XII}T:=UW2x=QQq `0~ׯ?o??_?~M_~oz쟿oo_ƫZ}j;_3^_UڧZ)S}Oޱz{fy(?mOhG"K-G;v#}i3zʫ_|QV{W'-})ӵ}ZYê5\vc},e_vu}r^ϛVқuisOc9.&:_kMYkM۴:mq}Mm5{h1 nY''(,3Z6³n^C߳>J,qdٍ t1|G6zaWi#^}:7N V-qtڀ^ݮ<3<6e+M`QU:}뫯Ug]'t`YٜcL;ze":8~Ecgkk~W S"GBH-ڕ7Kf+nvCO|NE><չ =-xFz6m=_([u y-6XAY1.>Qo_ 6 T} N)f[Qzl9>LXB[^7cxֆWcݱ1Vj:2}t 2k~rhǵvJsokukDc7N.kWwPD+›߬Vhp$0^]v[ag,^\,Ǒ  r@nC1uO#z18hzTu8ްl}|ZӴzGpZ)2ro[qxrX%a.qs' P8In+\6o y -fLc뭧~@r 6ήrX"ևWv!jzxom{3q|+[p85|B R]CKN3ء"^'Y։/z\/ hX>3rKt5T9tzױzŃ KaiC~(&>4j`MC5F79 zv0*&N8IioOɧ` d ǒ[IO敡ﻊpbhކ^GI`U*.VCQa 'yOO e'XOyg: S>A?Wsjˬ_Ѝ;|YJ!![/ܑw:q ѪSIOr~ɈH: .NTɉmӍZdIGWa]YۗM\J8 9`1٨Sc\\naZzsnOZE.I@jvv-WlVU43&K:\0̧{;9v:{??oD@IGbV5f :Hvb eegV'/ו,u.{!# Ȫȶ+JbPHcl:% hɳU9f8(dͯ;zb S?~|X84wH:C%z(rFk 5͎>5rGo^c? T!A N2iIrb~$!:d ['rC>l2{qiBUJZz^D FY͙K|!˕fΠ薔G#Ph8հ"|  J8gD`xB;)~ZÆfL^etc; f#+Ri\B>ōL>9m6:NLʌuԔ+-PGuM;oG$ڇ|g۫F D,#]24FkW܈uLAuu:k~#')<޻w r`?0F+\0gzeE*8~Ff1%;#(TOs\B ,d##GB#0W 0k ‘9L\@hkrRd ld,j$N0A#ӧ/tDguLz{7=H X\4*-<̰,% ϵ!vfBSR5R-gj ?HA8[Q%'瓕 ҹE; +B$jIM~ЁTM(ϰB39cb5j00R /frDo3=g AXqD9ȤXWJ-.gTZMB} 4Ć8)&L*0 $x+%2 rLպ9\rYZKQHQ2Bt>+0CL*&JDY!Y)8:wNJ3ASk%!˱3azXl" /( Modzk^ԿY|:l<댗ًJY<0ZLp־+Zχ5[)\"M_W;.wQ¥T: 3JB"10PN_"&;:$% ѐsV|>c$KƮ<x$ʇ.ĕ\+ a|+ȄسKYY{6 K[2Ga4)@LxkY/l3/x6[R)X9U46RWFF1ĎCti&,Iٲ18yyB'r-CC-D{-_]O:b&05TR/jD#=Oh{3~x.䈜y<ޯJpLa[z,3BU $4mʾf7/E!^OvE(< Vrܮ k׬wv ^TvkEry2_v& 9/DFdn8VΛuviԲ ct>nl%LK") 8Tq)f43i:VJ%h!%z>:Br6.7W(gDgO"QsjO6i:84 XKaΧǢF :ǣ\^sIЇ9 ~ΕDVN5D?TR۵`exlła :a:"&RSF D7|z)=x?9g3&镕lɷ[o&SN?ڮ6>i@ENb@B.gQ/JhqLF uÙ]yg\lfj#<%bT)ƺK]Tu,аmo݋3v&R%ۥh*VTc:\\(]3pAkgSi'%n= 9[GUOh?qInȺUg(PV6^#9;2 U tn!G5}eO,NApUj+ ȏDӣ @vw /NUV$I!Z2Xw\hY)#2Jr6ϊv% XY%/Y KɅ΃kOҭDnَY!4̔"hQ772J/4)Y)nȬ:VHNC4N±yg9 >A]lդͧ^Jz]{f̧5/7vj;~ڮ_ƃ^ҙ%#7FW7y2/ѐ?[%r4=N5ܵfM3PhH Ԝip~qų&C胮RM `WUmo`Ϩ9:2JmmñfթHW{DÏt~)kļ5J2wKͶEuG;¡z.~zw^BU78Ж1 U;jJ LOerPD9Tw"ev ~emHޯ55p(}|2YO !?Wzjxt;`V=r VO}ye8zGJo-eBKxCwvaVW+<3S"c(1zFiGox30An% GF+hX܎-EGn{٢moUs%3v)׻2iRd o3xp@Cb'z왗ث0i("ʁWg؊ $8pZ($;-eE(-rCjP~ x+sK=7Z!@©ݼO![jߕpMX⩯v0T-' JF*Jl+U֙=fNb (¿֘*ZZ 'ehx h"V J^c%DKnAC"Sz'g|>L/EFsFyFJ"\trZ\lϐonTGY6`Ѫqn̸ymZ)@ۏx7:D,T!ٲLvj`J+؟'m1X t+!ԤZ;;f"/-EZ0R?fT7XJ3 POԂsng®%0"or⬐YP `f;B,: #UҕpE3eТ3u`P,}?̥*veqRdX@`ϑ*}̼,dJ#$쑨0>2+DWX|qLr)ppe^CPm7t+0سOT+JBw=>Xg KJ\=A{Ş6uP$|m~}_΂\R ޼<=6G9`2l$P>gv= #/sU5llِ9ĝ"xwozN?%w-Mt}6L50@:y}Rm r[yG6tIYQ4˹f-3;N,zpC`rPm侯mwxȐhw(KӃqbG(1ۗي}Un yE q5ݭ1Ø^x'/4jlGO=9o0rvI58+k\;c'Ṩ5kBB{u2Εe'/'/zط$IOU8S6*)iֿ@5eHṺ' lcT9x6ZM֢ry W|^k1V>?O|R):iWMA8u-d;QL8-U4Ļ=̜Sy(k )BhڝWh73MLƓu{5cۤ(b|&҂JdO>]z1-e2kŀq;.ȻP*<ڬw`Ph*Śи[wV}El4҂^4j v gf5s&A{^c.kb|\drkw}7Fc|x$vS0+Fp_A+۲ݝm᱄vS+11Gt FV6|:d~x.n${VOe8WO(^;|q%vlHaER %"%~_%>BɺMu;7G[1f9 2XP&":b,]-wd2KҸJEj1--zq,[^>…NiW|}6bKR3}C۷rnAGs8,0W~i|bX\+=5WJ6z,2pz_a5b*K\}=^=Kr~⢌ss ̅p:A>q.\<@2fɜ6l z[}UR6 F6|5GJxe0 ~NN19Mdg2 +] /l婜J!0sI9VpR^lq'9ng[Iκ2žq7Xy?F.%cZш{8nj5$b w_Y`6 seTGXOζET]<<:q$8GJ?4K ,#zi#<4PA$шO$н^vTH0kWyblUO:ż%o\lkgKWW;v kSYoE~:֬t[xMig*F 28.z#++>B6}AH5le:/C+|n̽#s=}]0vh^JPGK)+4hX_/w rG|gڊ̕sLoXn[WVg.d3B[.TnJxD sW#/<$|Ͻd8>JNeERSnBmM`*噅gZͽecA/Bn>؅HLUq[,1ʮ̴ TסӇE-gH0LouHUܶH%s s s^r愇T4yg\oM8q~۸[G0%sR *;[P̮ŕe}?#"1(ӐyR\w7Z~Ət\.!SeU<]5c:NJV#jHB/@\' NgP4O%[: ̑;]=b3l떧5Þxhn f= +f]F~% shXe^tVr-t4N7E~cS]q$v0A=RJ'R(yMse6kdg-L\!vG|_w=P;3[^`W0ݬ0~ ~^YΖ);)R5Fwe4sԼ&GR<í,еӉd/Jddalpha/data/indian_liver_patient_1vs2.txt.gz0000644000176200001440000001570114550246302021007 0ustar liggesusers|q$[QTp_%L$X'&^Oѽ--o-}>]]73'wW5?y}w}O'S>{Fgʷ[0AqSdmϐgT s;%jl9 Z?e~E_`%-w2@?ep-_27p3 }{Y!2'ϠmR2w;M.Uܽ~zNu{.r=\.?: \^AU\q 2Xjr!\w\pr l:6d"مfzs^3O&W(P9ӟ,M-o2+Z9 sCdJBs\dKQ$[XWqXϼNې(imEVQ%ӶZ͙?=f!#UDh2Dfo89T}z`u˄t!$YReS _ YEVU%VKV7r/Q 2zɥʔ{ֿ.M./'w^E\ h7Lm!Eu-SxĂ?O_qrsy^pB;<іptK`2jp2}bz9)ڪҨE@ 6OẸH9bibW"C'BMv֎RW""l= 2eD-zS V&ͅj>߫Z֭lqkeXj[lT duҒ3, 3ɷoSm-,Iv맇 r(qk (?[/bTؖQxQ3#aTWNuEc[cƊSDV4cR͖lU@u2˹1QUa9^eY3FgQQQ=fQ9"NCtm j {AD#֢sA:ͣWV??r3̒ epm\ՄTJA @u *LJ1UWG!,-~/;3$b8}]̄Kabc̆5#Xf NVs+]/a`-Tp+/N/d=h= n|:-B)Vlf'::.*pdLSu @OYs;F6ԑxjRxZ+{ufV⺩뵢.J\`>H"mr; tuyZv3PV\*`o]O1rI .΢Z3\k Uu%]-@Dô$ 0x<(ylW7mp"A U"ǖeaBT]LFH4w !7])|ӁJ7L5v{e[%`Cp/aᶀ ``o9\EbLr5 2GTnc1ʤ<0+"4p֢LǍj1H?0JG TmY*[+M%%Ħ'Խ37 !7ٲK͊]1tp1R/?=y(qRDc21#V⠢q1>(r-.Պ%ypb kF]=D}A{Ӭa8 6u(Sj\#J`խH# .6ʃgSjrb %R4.L%Lrv5 5%: iUv|!엿Tcϣ衛{P dq6c(aKGi AɂP<Ԑt-TvˋNh;>T $ u#)0Qz+@%FQ d2'΃&$j]dlՑxz#Q8h,fURti<E)Ï@fxo|H'Hz&M[7i Nե0d8U| T ƧpE=ʖ/$mR\sOd"9kO[ "r Cj^YY)Z\RjTftX<'|("rnHXENs-C;6ZSu%Z[Fk9_6ܲi+9~HdR)_a O͹vkQT?X7+q[:)4!i߸Ȍ#uWb#U*eOĶ9p?=-` #/_ 2ַf ad&pŪ"1Ȫ*ũh  [*O 6&#zljj Re&Pz {UihZHyK190V5AhQTO6Il:W \La'2`-0F9UYc)R ~s8|VbSyq\,n6qq.ÕPYɏQvJi N/TzS9֘)k%Gy>sKF''ݪACR·HDFz 9. =FgkX8xf:j-2r~Gs`S~R/48Sϰl-褊nPS\3x!hLͪzg, YN]eʓmuF;#Gܝl!:Ɂ%.YY[t喟/H1yKթb4uRUN6+EwT XkXRRbFb+~N;úETbGt v97V+ȣl~46 Qs<T ɩS{3C6r_n c3/1jxٛY$* ` w(\|?}52P!YycjY{64ݩN^JvO`9 Ai):ߎ6edR;>ò!qxGD-Jyi;=xG~y#^@}"6Z= ~nvmꎺ]@n^0Gn2H1\ы1Fwgt̯#KDC|pl=rӮ(W#ql*1gQ8쀀T{'2n9k-k0zkEX!4JVVmyAD}qZ;hA;q9pj$Wꈩ%rM ANu,aHVm  z76 "TqbU|68j<#]jO6v$f%$L(wY],/Xx5iu?fSS5F-W֞YD?~wu=C܆*t**T6@lz#^g{|-KSFZFcV̬]W"ĮI?3 :D+9FgUiJ]{lF`cxlWxE+6g9a_iy+-qh*N3tH&н2xJs`< /wM2Y (dEvR8^f4^?55;MIi[>4.rgfAMHMT{du%{s,#ƛFF ذ2ܷ'ŭ_PKdŞrePC`ltcu=O+wj+y\ԆV"qM}\Oz{3X ڜxfn p4-|kqTLBq SOJ?XU ZkFl8WYIt6_?U7jpǓyyoSNM{ʉOsDRtE{m /&]63 v`2?doMݨ Ш T5}BԮd)kF?=%ʳJ]ɳexi>:s޴k@bve #ܝ'{ӵp/L[YN3czAb6 H,,8[/ܦky卧xLc sxL1CN4M DZ|]42M!qkLԍ7`-*Oˊ89/ztJ6q l3#S+o2[{rڮ 1mArL*[/3oimyFe&ggqS tL}Motu>@4G6[EnB|o0SYv4F̉*!j+ 渘8U9nź#KH'(٣"3)m>sxiE' t5޻85}}ȫO#5v]REchb8j?qvlY4=۽O6sʸ6H3x}C׹~+d*j 3+F|U1Mr9Ʌw֬P#`LcnekfEٙ`}:D KU+󷑨*u;r-/O,:>=E&p퓰hdvex̍cOG: 5F{ 4jCdJgᦦqŠ~P- ej`r*ە g۷NEqђ`lh?LnK#v뛓9e~ 1z?|MmFOR51m=2i*˜]ƥXm&6MT‡5/}jф +G-0lX1L^?>U (VpqPeZ?w ]ư>ͬ"+@PV}>(uuVYFcf>gH32SHPԕ`b| D2<>5-[fxVNG(ٿYM0d_*~ Pi8ljG?iG/9jHg>A-sd޼AY;*DU{3 Wa_y/fh-ɕj(Ufz׻yPn|aFOC+JoP?Uж/Rddalpha/man/0000755000176200001440000000000014550244104012421 5ustar liggesusersddalpha/man/depth.contours.Rd0000644000176200001440000000331514213423775015702 0ustar liggesusers\name{depth.contours} \alias{depth.contours} \title{ Depth Contours } \description{ Builds the data depth contours for 2-dimensional data. } \usage{ depth.contours(data, depth, main = "", xlab="", ylab = "", drawplot = T, frequency=100, levels = 10, col = "red", ...) } \arguments{ \item{data}{ 2-dimensional numeric data frame or matrix } \item{depth}{ the name of the depth function. The list of the supported depths and described in the topic \code{\link{depth.}}. } \item{main}{ an overall title for the plot: see \code{\link{title}} } \item{xlab, ylab}{ labels of the axes } \item{drawplot}{ if set to false, the contours are built on the existing plot. } \item{frequency}{ number of points on each direction, x and y. Impacts the smoothness of the contours. } \item{levels}{ numeric vector of levels at which to draw contour lines. If the vector contains only ONE element, the levels are generated automatically as \code{seq(0, max(depth), length.out = levels)}. } \item{col}{ color, used to draw points and contours } \item{\dots}{ additional parameters passed to the depth functions and to \code{\link{plot}} } } \seealso{ \code{\link{depth.}}, \code{\link{depth.contours.ddalpha}}, \code{\link{depth.graph}}. } \examples{ \dontrun{ par(mfrow = c(2,2)) data(hemophilia) depth.contours(hemophilia[,1:2], depth = "none", main = "data") for (depth in c("zonoid", "Mahalanobis", "projection", "spatial")){ depth.contours(hemophilia[,1:2], depth = depth, main = depth) } for (depth in c("halfspace", "simplicial", "simplicialVolume")){ depth.contours(hemophilia[,1:2], depth = depth, main = depth, exact = T) } } } \keyword{ visualization } ddalpha/man/depth.space.projection.Rd0000644000176200001440000000704714213423775017302 0ustar liggesusers\name{depth.space.projection} \alias{depth.space.projection} \title{ Calculate Depth Space using Projection Depth } \description{ Calculates the representation of the training classes in depth space using projection depth. } \usage{ depth.space.projection(data, cardinalities, method = "random", num.directions = 1000, seed = 0) } \arguments{ \item{data}{ Matrix containing training sample where each row is a \eqn{d}-dimensional object, and objects of each class are kept together so that the matrix can be thought of as containing blocks of objects representing classes. } \item{cardinalities}{ Numerical vector of cardinalities of each class in \code{data}, each entry corresponds to one class. } \item{method}{ to be used in calculations. \code{"random"} Here the depth is determined as the minimum univariate depth of the data projected on lines in several directions. The directions are distributed uniformly on the \eqn{(d-1)}-sphere; the same direction set is used for all points. \code{"linearize"} The Nelder-Mead method for function minimization, taken from Olsson, Journal of Quality Technology, 1974, 6, 56. R-codes of this function were written by Subhajit Dutta. } \item{num.directions}{ Number of random directions to be generated for \code{method = "random"}. With the growth of n the complexity grows linearly for the same number of directions. } \item{seed}{ the random seed. The default value \code{seed=0} makes no changes. } } \details{ The depth representation is calculated in the same way as in \code{\link{depth.projection}}, see 'References' for more information and details. } \value{ Matrix of objects, each object (row) is represented via its depths (columns) w.r.t. each of the classes of the training sample; order of the classes in columns corresponds to the one in the argument \code{cardinalities}. } \references{ Donoho, D.L. (1982). \emph{Breakdown properties of multivariate location estimators}. Ph.D. qualifying paper. Department of Statistics, Harvard University. Liu, R.Y. (1992). Data depth and multivariate rank tests. In: Dodge, Y. (ed.), L1-Statistics and Related Methods, North-Holland (Amsterdam), 279--294. Liu, X. and Zuo, Y. (2014). Computing projection depth and its associated estimators. \emph{Statistics and Computing} \bold{24} 51--63. Stahel, W.A. (1981). \emph{Robust estimation: infinitesimal optimality and covariance matrix estimators}. Ph.D. thesis (in German). Eidgenossische Technische Hochschule Zurich. Zuo, Y.J. and Lai, S.Y. (2011). Exact computation of bivariate projection depth and the Stahel-Donoho estimator. \emph{Computational Statistics and Data Analysis} \bold{55} 1173--1179. } \seealso{ \code{\link{ddalpha.train}} and \code{\link{ddalpha.classify}} for application, \code{\link{depth.projection}} for calculation of projection depth. } \examples{ # Generate a bivariate normal location-shift classification task # containing 20 training objects class1 <- mvrnorm(10, c(0,0), matrix(c(1,1,1,4), nrow = 2, ncol = 2, byrow = TRUE)) class2 <- mvrnorm(10, c(2,2), matrix(c(1,1,1,4), nrow = 2, ncol = 2, byrow = TRUE)) data <- rbind(class1, class2) # Get depth space using projection depth depth.space.projection(data, c(10, 10), method = "random", num.directions = 1000) depth.space.projection(data, c(10, 10), method = "linearize") data <- getdata("hemophilia") cardinalities = c(sum(data$gr == "normal"), sum(data$gr == "carrier")) depth.space.projection(data[,1:2], cardinalities) } \keyword{ robust } \keyword{ multivariate } \keyword{ nonparametric } ddalpha/man/ddalphaf.classify.Rd0000644000176200001440000000340114213423775016276 0ustar liggesusers\name{ddalphaf.classify} \alias{ddalphaf.classify} \alias{predict.ddalphaf} \title{ Classify using Functional DD-Classifier } \description{ Classifies data using the functional DD-classifier. } \usage{ ddalphaf.classify(ddalphaf, objectsf, subset, ...) \method{predict}{ddalphaf}(object, objectsf, subset, ...) } \arguments{ \item{ddalphaf, object}{ Functional DD-classifier (obtained by \code{\link{ddalphaf.train}}). } \item{objectsf}{list containing lists (functions) of two vectors of equal length, named "args" and "vals": arguments sorted in ascending order and corresponding them values respectively } \item{subset}{ an optional vector specifying a subset of observations to be classified. } \item{\dots}{ additional parameters, passed to the classifier, selected with parameter \code{classifier.type} in \code{\link{ddalphaf.train}}. } } \value{ List containing class labels. } \references{ Mosler, K. and Mozharovskyi, P. (2017). Fast DD-classification of functional data. \emph{Statistical Papers} \bold{58} 1055--1089. Mozharovskyi, P. (2015). \emph{Contributions to Depth-based Classification and Computation of the Tukey Depth}. Verlag Dr. Kovac (Hamburg). } \seealso{ \code{\link{ddalphaf.train}} to train the functional DD\eqn{\alpha}-classifier. } \examples{ \dontrun{ ## load the Growth dataset dataf = dataf.growth() learn = c(head(dataf$dataf, 49), tail(dataf$dataf, 34)) labels= c(head(dataf$labels, 49), tail(dataf$labels, 34)) test = tail(head(dataf$dataf, 59), 10) # elements 50:59. 5 girls, 5 boys c = ddalphaf.train (learn, labels, classifier.type = "ddalpha") classified = ddalphaf.classify(c, test) print(unlist(classified)) } } \keyword{ functional } \keyword{ robust } \keyword{ multivariate } \keyword{ nonparametric } \keyword{ classif }ddalpha/man/depth..Rd0000644000176200001440000000571614213423775014114 0ustar liggesusers\name{depth.} \alias{depth.} \title{ Calculate Depth } \description{ Calculates the depth of points w.r.t. a multivariate data set. The detailed descriptions are found in the corresponding topics. } \usage{ depth.(x, data, notion, ...) ## beta-skeleton depth # depth.betaSkeleton(x, data, beta = 2, distance = "Lp", Lp.p = 2, # mah.estimate = "moment", mah.parMcd = 0.75) ## Tukey depth # depth.halfspace(x, data, exact, method, num.directions = 1000, seed = 0) ## L2-depth # depth.L2(x, data, mah.estimate = "moment", mah.parMcd = 0.75) ## Mahalanobis depth # depth.Mahalanobis(x, data, mah.estimate = "moment", mah.parMcd = 0.75) ## projection depth # depth.projection(x, data, method = "random", num.directions = 1000) ## simplicial depth # depth.simplicial(x, data, exact = F, k = 0.05, seed = 0) ## simplicial volume depth # depth.simplicialVolume(x, data, exact = F, k = 0.05, seed = 0) ## spatial depth # depth.spatial(x, data) ## zonoid depth # depth.zonoid(x, data) ## potential # depth.potential (x, data, pretransform = "1Mom", # kernel = "GKernel", kernel.bandwidth = NULL, mah.parMcd = 0.75) ## convex hull peeling depth # depth.qhpeeling(x, data) } \arguments{ \item{x}{ Matrix of objects (numerical vector as one object) whose depth is to be calculated; each row contains a \eqn{d}-variate point. Should have the same dimension as \code{data}. } \item{data}{ Matrix of data where each row contains a \eqn{d}-variate point, w.r.t. which the depth is to be calculated. } \item{notion}{ The name of the depth notion (shall also work with a user-defined depth function named \code{"depth."}). } \item{\dots}{ Additional parameters passed to the depth functions. } } \seealso{ \code{\link{depth.betaSkeleton}} \code{\link{depth.halfspace}} \code{\link{depth.L2}} \code{\link{depth.Mahalanobis}} \code{\link{depth.projection}} \code{\link{depth.simplicial}} \code{\link{depth.simplicialVolume}} \code{\link{depth.spatial}} \code{\link{depth.zonoid}} \code{\link{depth.potential}} \code{\link{depth.qhpeeling}} \code{\link{depth.graph}} for building the depth surfaces of the two dimensional data. } \value{ Numerical vector of depths, one for each row in \code{x}; or one depth value if \code{x} is a numerical vector. } \examples{ # 5-dimensional normal distribution data <- mvrnorm(1000, rep(0, 5), matrix(c(1, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 1), nrow = 5)) x <- mvrnorm(10, rep(1, 5), matrix(c(1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1), nrow = 5)) depths <- depth.(x, data, notion = "zonoid") cat("Depths: ", depths, "\n") } \keyword{ robust } \keyword{ multivariate } \keyword{ nonparametric } ddalpha/man/getdata.Rd0000644000176200001440000001324214550237317014333 0ustar liggesusers\name{getdata} \alias{getdata} \alias{data} \alias{baby} \alias{banknoten} \alias{biomed} \alias{bloodtransfusion} \alias{breast_cancer_wisconsin} \alias{bupa} \alias{chemdiab_1vs2} \alias{chemdiab_1vs3} \alias{chemdiab_2vs3} \alias{cloud} \alias{crabB_MvsF} \alias{crabF_BvsO} \alias{crabM_BvsO} \alias{crabO_MvsF} \alias{crab_BvsO} \alias{crab_MvsF} \alias{cricket_CvsP} \alias{diabetes} \alias{ecoli_cpvsim} \alias{ecoli_cpvspp} \alias{ecoli_imvspp} \alias{gemsen_MvsF} \alias{glass} \alias{groessen_MvsF} \alias{haberman} \alias{heart} \alias{hemophilia} \alias{indian_liver_patient_1vs2} \alias{indian_liver_patient_FvsM} \alias{iris_setosavsversicolor} \alias{iris_setosavsvirginica} \alias{iris_versicolorvsvirginica} \alias{irish_ed_MvsF} \alias{kidney} \alias{pima} \alias{plasma_retinol_MvsF} \alias{segmentation} \alias{socmob_IvsNI} \alias{socmob_WvsB} \alias{tae} \alias{tennis_MvsF} \alias{tips_DvsN} \alias{tips_MvsF} \alias{uscrime_SvsN} \alias{vertebral_column} \alias{veteran_lung_cancer} \alias{vowel_MvsF} \alias{wine_1vs2} \alias{wine_1vs3} \alias{wine_2vs3} \title{ Data for Classification } \description{ 50 multivariate data sets for binary classification. For more details refer {\url{https://wisostat.uni-koeln.de/de/forschung/software-und-daten/data-for-classification/}} The \code{getdata} function gets the data set from the package, and returns it. The dataset itself does not appear in the global environment and the existing variables with the same name remain unchanged. } \usage{ # load the data set # data(name) # load the data set by name # data(list = "name") # load the data set by name to a variable # getdata("name") } \arguments{ \item{name}{ the data set name. } } \format{ A data frame with \code{n} observations on the \code{d} variables. The last \code{d+1} column is the class label. \describe{ \item{\code{x[,1:d]}}{numeric values} \item{\code{x[,d+1]}}{the numeric class label (0 or 1) or (1 or 2)} } } \details{ The package contains data sets used in the joint project of the University of Cologne and the Hochschule Merseburg "Classifying real-world data with the DDalpha-procedure". Comprehensive description of the methodology, and experimental settings and results of the study are presented in the work: Mozharovskyi, P., Mosler, K., and Lange, T. (2015). Classifying real-world data with the DD\eqn{\alpha}-procedure. \emph{Advances in Data Analysis and Classification} \bold{9} 287--314. For a more complete explanation of the technique and further experiments see: Lange, T., Mosler, K., and Mozharovskyi, P. (2014). Fast nonparametric classification based on data depth. \emph{Statistical Papers} \bold{55} 49--69. 50 binary classification tasks have been obtained from partitioning 33 freely accessible data sets. Multiclass problems were reasonably split into binary classification problems, some of the data set were slightly processed by removing objects or attributes and selecting prevailing classes. Each data set is provided with a (short) description and brief descriptive statistics. The name reflects the origination of the data. A letter after the name is a property filter, letters (also their combinations) in brackets separated by "vs" are the classes opposed. The letters (combinations or words) stand for labels of classes (names of properties) and are intuitive. Each description contains a link to the original data. The data have been collected as open source data in January 2013. Owners of the package decline any responsibility regarding their correctness or consequences of their usage. If you publish material based on these data, please quote the original source. Special requests regarding citations are found on data set's web page. } \references{ Lange, T., Mosler, K., and Mozharovskyi, P. (2014). Fast nonparametric classification based on data depth. \emph{Statistical Papers} \bold{55} 49--69. Mozharovskyi, P., Mosler, K., and Lange, T. (2015). Classifying real-world data with the DD\eqn{\alpha}-procedure. \emph{Advances in Data Analysis and Classification} \bold{9} 287--314. The general list of sources consists of: UCI Machine Learning Repository {\url{https://archive.ics.uci.edu/ml/}}\cr R-packages {\url{https://CRAN.R-project.org/}} \cr {\url{https://www.cmu.edu/dietrich/statistics-datascience/}} \cr {\url{https://stat.ethz.ch/Teaching/Datasets/}} \cr {\url{https://www.stats.ox.ac.uk/pub/PRNN/}} } \seealso{ \code{\link[utils:data]{utils:data}} } \note{ List of the datasets: baby\cr banknoten\cr biomed\cr bloodtransfusion\cr breast_cancer_wisconsin\cr bupa\cr chemdiab_1vs2\cr chemdiab_1vs3\cr chemdiab_2vs3\cr cloud\cr crabB_MvsF\cr crabF_BvsO\cr crabM_BvsO\cr crabO_MvsF\cr crab_BvsO\cr crab_MvsF\cr cricket_CvsP\cr diabetes\cr ecoli_cpvsim\cr ecoli_cpvspp\cr ecoli_imvspp\cr gemsen_MvsF\cr glass\cr groessen_MvsF\cr haberman\cr heart\cr hemophilia\cr indian_liver_patient_1vs2\cr indian_liver_patient_FvsM\cr iris_setosavsversicolor\cr iris_setosavsvirginica\cr iris_versicolorvsvirginica\cr irish_ed_MvsF\cr kidney\cr pima\cr plasma_retinol_MvsF\cr segmentation\cr socmob_IvsNI\cr socmob_WvsB\cr tae\cr tennis_MvsF\cr tips_DvsN\cr tips_MvsF\cr uscrime_SvsN\cr vertebral_column\cr veteran_lung_cancer\cr vowel_MvsF\cr wine_1vs2\cr wine_1vs3\cr wine_2vs3\cr Also functional data sets can be loaded: geneexp\cr growth\cr medflies\cr population\cr population2010\cr tecator } \examples{ # load a dataset using data() data(hemophilia) data(list = "hemophilia") rm(hemophilia) # load data set using getdata() hemophilia = "This is some existing object called 'hemophilia'. It remains unchanged" d = getdata("hemophilia") head(d) print(hemophilia) #get the list of all data sets names = data(package = "ddalpha")$results[,3] } \keyword{datasets}ddalpha/man/ddalphaf.getErrorRatePart.Rd0000644000176200001440000000460614213423775017725 0ustar liggesusers\name{ddalphaf.getErrorRatePart} \alias{ddalphaf.getErrorRatePart} \title{ Test Functional DD-Classifier } \description{ Performs a benchmark procedure by partitioning the given data. On each of \code{times} steps \code{size} observations are removed from the data, the functional DD-classifier is trained on these data and tested on the removed observations. } \usage{ ddalphaf.getErrorRatePart(dataf, labels, size = 0.3, times = 10, disc.type = c("LS", "comp"), ...) } \arguments{ \item{dataf}{ list containing lists (functions) of two vectors of equal length, named "args" and "vals": arguments sorted in ascending order and corresponding them values respectively } \item{labels}{ list of output labels of the functional observations } \item{size}{ the excluded sequences size. Either an integer between \eqn{1} and \eqn{n}, or a fraction of data between \eqn{0} and \eqn{1}. } \item{times}{ the number of times the classifier is trained. } \item{disc.type}{ type of the used discretization scheme. "LS" for \code{\link{ddalphaf.train}}, "comp" for for \code{\link{compclassf.train}} } \item{\dots}{ additional parameters passed to \code{\link{ddalphaf.train}} } } \value{ \item{errors}{ the part of incorrectly classified data (mean) } \item{errors_sd}{ the standard deviation of errors } \item{errors_vec}{ vector of errors } \item{time}{ the mean training time } \item{time_sd}{ the standard deviation of training time } } \seealso{ \code{\link{ddalphaf.train}} to train the functional DD\eqn{\alpha}-classifier, \code{\link{ddalphaf.classify}} for classification using functional DD\eqn{\alpha}-classifier, \code{\link{ddalphaf.test}} to test the functional DD-classifier on particular learning and testing data, \code{\link{ddalphaf.getErrorRateCV}} to get error rate of the functional DD-classifier on particular data. } \examples{ # load the fdata df = dataf.growth() stat <- ddalphaf.getErrorRatePart(dataf = df$dataf, labels = df$labels, size = 0.3, times = 5, adc.args = list(instance = "avr", numFcn = 2, numDer = 2)) cat("Classification error rate: ", stat$errors, ".\n", sep = "") } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ benchmark } ddalpha/man/dataf.sim.1.CFF07.Rd0000644000176200001440000000413714213423775015477 0ustar liggesusers\name{dataf.sim.1.CFF07} \alias{dataf.sim.1.CFF07} \title{ Model 1 from Cuevas et al. (2007) } \description{ Model 1 from Cuevas et al. (2007) Processes: \cr X(t) = m_0(t) + e(t), m_0(t) = 30*(1-t)*t^1.2 \cr Y(t) = m_1(t) + e(t), m_1(t) = 30*(1-t)^1.2*t \cr e(t): Gaussian with mean = 0, cov(X(s), X(t)) = 0.2*exp(-abs(s - t)/0.3)\cr the processes are discretized at \code{numDiscrets} equally distant points on [0, 1]. The functions are smooth and differ in mean only, which makes the classification task rather simple. } \usage{ dataf.sim.1.CFF07(numTrain = 100, numTest = 50, numDiscrets = 51, plot = FALSE) } \arguments{ \item{numTrain}{ number of objects in the training sample } \item{numTest}{ number of objects in the test sample } \item{numDiscrets}{ number of points for each object } \item{plot}{ if TRUE the training sample is plotted } } \format{ A data strusture containing \code{$learn} and \code{$test} functional data. The functional data are given as data structures. \describe{ \item{\code{dataf}}{ The functional data as a list of objects. Each object is characterized by two coordinates. \describe{ \item{\code{args}}{a numeric vector} \item{\code{vals}}{a numeric vector} } } \item{\code{labels}}{The classes of the objects: 0 for X(t), 1 for Y(t)} } } \source{ Cuevas, A., Febrero, M. and Fraiman, R. (2007). Robust estimation and classification for functional data via projection-based depth notions. Computational Statistics 22 481-496. } \seealso{ \code{\link{dataf.*}} for other functional data sets \code{\link{plot.functional}} for building plots of functional data } \examples{ ## load the dataset dataf = dataf.sim.1.CFF07(numTrain = 100, numTest = 50, numDiscrets = 51) learn = dataf$learn test = dataf$test ## view the classes unique(learn$labels) ## access the 5th point of the 2nd object learn$dataf[[2]]$args[5] learn$dataf[[2]]$vals[5] \dontrun{ ## plot the data plot(learn) plot(test) ## or dataf = dataf.sim.1.CFF07(numTrain = 100, numTest = 50, numDiscrets = 51, plot = TRUE) } } \keyword{datasets} \keyword{functional} ddalpha/man/ddalphaf.getErrorRateCV.Rd0000644000176200001440000000432214213423775017322 0ustar liggesusers\name{ddalphaf.getErrorRateCV} \alias{ddalphaf.getErrorRateCV} \title{ Test Functional DD-Classifier } \description{ Performs a cross-validation procedure over the given data. On each step every \code{numchunks} observation is removed from the data, the functional DD-classifier is trained on these data and tested on the removed observations. } \usage{ ddalphaf.getErrorRateCV (dataf, labels, numchunks = 10, disc.type = c("LS", "comp"), ...) } \arguments{ \item{dataf}{ list containing lists (functions) of two vectors of equal length, named "args" and "vals": arguments sorted in ascending order and corresponding them values respectively } \item{labels}{ list of output labels of the functional observations } \item{numchunks}{ number of subsets of testing data. Equals to the number of times the classifier is trained. } \item{disc.type}{ type of the used discretization scheme. "LS" for \code{\link{ddalphaf.train}}, "comp" for for \code{\link{compclassf.train}} } \item{\dots}{ additional parameters passed to \code{\link{ddalphaf.train}} } } \value{ \item{errors}{ the part of incorrectly classified data } \item{time}{ the mean training time } \item{time_sd}{ the standard deviation of training time } } \seealso{ \code{\link{ddalphaf.train}} to train the functional DD\eqn{\alpha}-classifier, \code{\link{ddalphaf.classify}} for classification using functional DD\eqn{\alpha}-classifier, \code{\link{ddalphaf.test}} to test the functional DD-classifier on particular learning and testing data, \code{\link{ddalphaf.getErrorRatePart}} to perform a benchmark study of the functional DD-classifier on particular data. } \examples{ # load the fdata df = dataf.growth() stat <- ddalphaf.getErrorRateCV(dataf = df$dataf, labels = df$labels, numchunks = 5, adc.args = list(instance = "avr", numFcn = 2, numDer = 2)) cat("Classification error rate: ", stat$errors, ".\n", sep = "") } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ benchmark } ddalpha/man/shape.fd.analysis.Rd0000644000176200001440000001422314216410624016225 0ustar liggesusers\name{shape.fd.analysis} \alias{shape.fd.analysis} \title{Diagnostic Plot for First and Second Order Integrated and Infimal Depths} \usage{ shape.fd.analysis(datafA, datafB, range = NULL, d = 101, order = 1, method = c("halfspace", "simplicial"), approx = 0, title = "", nfun = 10, plot = TRUE) } \arguments{ \item{datafA}{A single function whose depth is computed, represented by a \code{dataf} object of arguments and functional values.} \item{datafB}{Functional dataset with respect to which the depth of \code{datafA} is computed. \code{datafB} is represented by a \code{dataf} object of arguments and functional values. \code{n} stands for the number of functions. The grid of observation points for the functions in \code{datafA} and \code{datafB} may not be the same.} \item{range}{The common range of the domain where the functions \code{datafA} and \code{datafB} are observed. Vector of length 2 with the left and the right end of the interval. Must contain all arguments given in \code{datafA} and \code{datafB}.} \item{d}{Grid size to which all the functional data are transformed. For depth computation, all functional observations are first transformed into vectors of their functional values of length \code{d} corresponding to equi-spaced points in the domain given by the interval \code{range}. Functional values in these points are reconstructed using linear interpolation, and extrapolation.} \item{order}{The order of the depth to be used in the plot, for \code{order=1} produces the plot of univariate marginal depth of \code{A} and \code{nfun} functions from \code{B} over the domain of the functions. For \code{order=2} produces the bivariate contour plot of the bivariate depths of \code{A} at couples of points from the domain.} \item{method}{The depth that is used in the diagnostic plot. possible values are \code{halfspace} for the halfspace depth, or \code{simplicial} for the simplicial depth.} \item{approx}{For \code{order=2}, the number of approximations used in the computation of the order extended depth. By default this is set to \code{0}, meaning that the depth is computed at all possible \code{d^2} combinations of the points in the domain. When set to a positive integer, \code{approx} bivariate points are randomly sampled in unit square, and at these points the bivariate depths of the corresponding functional values are computed.} \item{title}{The title of the diagnostic plot.} \item{nfun}{For \code{order=1}, the number of functions from \code{B} whose coordinate-wise univariate depths of functional values should be displayed with the depth of \code{A}. The depth of \code{A} is displayed in solid red line, the depths of the functions from \code{B} in dashed black.} \item{plot}{Logical: should the function by plotted?} } \value{ For \code{order=1} two depth values, and two vectors of pointwise depths: \itemize{ \item \code{Simpl_FD} the first order integrated depth based on the simplicial depth, \item \code{Half_FD} the first order integrated depth based on the halfspace depth, \item \code{Simpl_ID} the first order infimal depth based on the simplicial depth, \item \code{Half_ID} the first order infimal depth based on the halfspace depth, \item \code{PSD} the vector of length \code{d} containing the computed pointwise univariate simplicial depths used for the computation of \code{Simpl_FD} and \code{Simpl_ID}, \item \code{PHD} the vector of length \code{d} containing the computed pointwise univariate halfspace depths used for the computation of \code{Half_FD} and \code{Half_ID}. } In addition, the first order integrated / infimal depth diagnostic plot of the function \code{A} with respect to the random sample given by the functions corresponding to the rows of the matrix \code{B} is produced. For \code{order=2} four depth values, and two matrices of pointwise depths: \itemize{ \item \code{Simpl_FD} the second order integrated depth based on the simplicial depth, \item \code{Half_FD} the second order integrated depth based on the halfspace depth, \item \code{Simpl_ID} the second order infimal depth based on the simplicial depth, \item \code{Half_ID} the second order infimal depth based on the halfspace depth, \item \code{PSD} the matrix of size \code{d*d} containing the computed pointwise bivariate simplicial depths used for the computation of \code{Simpl_FD} and \code{Simpl_ID}, \item \code{PHD} the matrix of size \code{d*d} containing the computed pointwise bivariate halfspace depths used for the computation of \code{Half_FD} and \code{Half_ID}. } In addition, the second order integrated / infimal depth diagnostic plot of the function \code{A} with respect to the random sample given by the functions corresponding to the rows of the matrix \code{B} is produced. } \description{ Produce the diagnostic plot based on the fist or second order extended integrated / infimal depths. } \details{ Plots a diagnostic plot of pointwise univariate (or bivariate) depths for all possible points (or couples of points) from the domain of the functional data. From such a plot it is possible to infer into the first order (or second order) properties of a single function \emph{x} with respect to the given set of functional data. For \code{order=1}, the integral of the displayed function is the integrated depth of \emph{x}, the smallest value of the function is the infimal depth of \emph{x}. For \code{order=2}, the bivariate integral of the displayed surface gives the second order extended integrated depth of \emph{x}, the infimum of this bivariate function gives the second order infimal depth of \emph{x}. For details see Nagy et al. (2016) and \code{\link{depthf.fd1}}. } \examples{ datafA = dataf.population()$dataf[1] dataf = dataf.population()$dataf[2:20] shape.fd.analysis(datafA,dataf,order=1) shape.fd.analysis(datafA,dataf,order=2,approx=0) } \references{ Nagy, S., Gijbels, I. and Hlubinka, D. (2017). Depth-based recognition of shape outlying functions. \emph{Journal of Computational and Graphical Statistics}, \bold{26} (4), 883--893. } \seealso{ \code{\link{depthf.fd1}} } \author{ Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} } \keyword{depth} \keyword{functional} \keyword{outlier} \keyword{plot} \keyword{shape} ddalpha/man/depth.sample.Rd0000644000176200001440000000262714216410625015305 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/depth.fd.R \name{depth.sample} \alias{depth.sample} \title{Fast Depth Computation for Univariate and Bivariate Random Samples} \usage{ depth.sample(A, B) } \arguments{ \item{A}{Univariate or bivariate points whose depth is computed, represented by a matrix of size \code{m*2}. \code{m} stands for the number of points, \code{d} is 1 for univariate and 2 for bivariate data.} \item{B}{Random sample points with respect to which the depth of \code{A} is computed. \code{B} is represented by a matrix of size \code{n*2}, where \code{n} is the sample size.} } \value{ Vector of length \code{m} of depth halfspace depth values is returned. } \description{ Faster implementation of the halfspace and the simplicial depth. Computes the depth of a whole random sample of a univariate or a bivariate data in one run. } \details{ The function returns vectors of sample halfspace and simplicial depth values. } \examples{ n = 100 m = 150 A = matrix(rnorm(2*n),ncol=2) B = matrix(rnorm(2*m),ncol=2) depth.sample(A,B) system.time(D1<-depth.halfspace(A,B)) system.time(D2<-depth.sample(A,B)) max(D1-D2$Half) A = rnorm(100) B = rnorm(150) depth.sample(A,B) # depth.halfspace(matrix(A,ncol=1),matrix(B,ncol=1)) } \seealso{ \code{\link{depth.halfspace}} \code{\link{depth.simplicial}} } \author{ Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} } \keyword{depth} ddalpha/man/infimalRank.Rd0000644000176200001440000000331114216410625015143 0ustar liggesusers\name{infimalRank} \alias{infimalRank} \title{Adjusted Ranking of Functional Data Based on the Infimal Depth} \usage{ infimalRank(ID, IA, ties.method = "max") } \arguments{ \item{ID}{The vector of infimal depths of the curves of length \code{n}.} \item{IA}{The vector of the infimal areas corresponding to the infimal depths from \code{ID} of length \code{n}.} \item{ties.method}{Parameter for breaking ties in infimal area index. By default \code{max}, see \code{rank}.} } \value{ A vector of length \code{n}. Low depth values mean high ranks, i.e. potential outlyingness. If some of the infimal depths are identical, the ranking of these functions is made according to the values of the infimal area. There, higher infimal area index means higher rank, i.e. non-centrality. } \description{ Returns a vector of adjusted depth-based ranks for infimal depth for functional data. } \details{ Infimal depths for functional data tend to give to many functional observations the same value of depth. Using this function, the data whose depth is the same is ranked according to the infimal area indicator. This indicator is provided in functions \code{depthf.fd1} along the value of the infimal depth. } \examples{ datafA = dataf.population()$dataf[1:20] datafB = dataf.population()$dataf[21:50] D = depthf.fd1(datafA,datafB) infimalRank(D$Half_ID,D$Half_IA) ID = c(0,1,0,0,0,1,1) IA = c(2,3,1,0,2,4,1) infimalRank(ID,IA) } \references{ Nagy, S., Gijbels, I. and Hlubinka, D. (2017). Depth-based recognition of shape outlying functions. \emph{Journal of Computational and Graphical Statistics}, \bold{26} (4), 883--893. } \author{ Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} } \keyword{depth} \keyword{functional} \keyword{rank} ddalpha/man/depth.space.halfspace.Rd0000644000176200001440000001036014213423775017044 0ustar liggesusers\name{depth.space.halfspace} \alias{depth.space.halfspace} \title{ Calculate Depth Space using Halfspace Depth } \description{ Calculates the representation of the training classes in depth space using the halfspace depth. } \usage{ depth.space.halfspace(data, cardinalities, exact, method, num.directions = 1000, seed = 0) } \arguments{ \item{data}{ Matrix containing training sample where each row is a \eqn{d}-dimensional object, and objects of each class are kept together so that the matrix can be thought of as containing blocks of objects representing classes. } \item{cardinalities}{ Numerical vector of cardinalities of each class in \code{data}, each entry corresponds to one class. } \item{exact}{ The type of the used method. The default is \code{exact=F}, which leads to approximate computation of the halfspace depth. For \code{exact=F}, \code{method="Sunif.1D"} is used by default. If \code{exact=T}, the halfspace depth is computed exactly, with \code{method="recursive"} by default.} \item{method}{ For \code{exact=F}, if \code{method="Sunif.1D"} (by default), the halfspace depth is computed approximately by being minimized over univariate projections (see details). For \code{exact=T}, the halfspace depth is calculated as the minimum over all combinations of \eqn{k} points from \code{data} (see details). In this case parameter \code{method} specifies \eqn{k}, with possible values \eqn{1} for \code{method="recursive"} (by default), \eqn{d-2} for \code{method="plane"}, \eqn{d-1} for \code{method="line"}. The name of the method may be given as well as just parameter \code{exact}, in which case the default method will be used. } \item{num.directions}{ Number of random directions to be generated. As the same direction set is used for all observations, the algorithmic complexity of calculating the depth of each single point in \code{data} is logarithmic in the number of observations in \code{data}, given the number of directions, see Mozharovskyi et al. (2015), Section 2.3 for discussion. } \item{seed}{ The random seed. The default value \code{seed=0} makes no changes. } } \details{ The depth representation is calculated in the same way as in \code{\link{depth.halfspace}}, see References below for more information and details. } \value{ Matrix of objects, each object (row) is represented via its depths (columns) w.r.t. each of the classes of the training sample; order of the classes in columns corresponds to the one in the argument \code{cardinalities}. } \references{ Cuesta-Albertos, J.A. and Nieto-Reyes, A. (2008). The random Tukey depth. \emph{Computational Statistics and Data Analysis} \bold{52} 4979--4988. Dyckerhoff, R. and Mozharovskyi, P. (2016). Exact computation of the halfspace depth. \emph{Computational Statistics and Data Analysis} \bold{98} 19--30. Mozharovskyi, P., Mosler, K., and Lange, T. (2015). Classifying real-world data with the DD\eqn{\alpha}-procedure. \emph{Advances in Data Analysis and Classification} \bold{9} 287--314. Rousseeuw, P.J. and Ruts, I. (1996). Algorithm AS 307: Bivariate location depth. \emph{Journal of the Royal Statistical Society. Series C (Applied Statistics)} \bold{45} 516--526. Tukey, J.W. (1974). Mathematics and the picturing of data. In: \emph{Proceeding of the International Congress of Mathematicians}, Vancouver, 523--531. } \seealso{ \code{\link{ddalpha.train}} and \code{\link{ddalpha.classify}} for application, \code{\link{depth.halfspace}} for calculation of the Tukey depth. } \examples{ # Generate a bivariate normal location-shift classification task # containing 20 training objects class1 <- mvrnorm(10, c(0,0), matrix(c(1,1,1,4), nrow = 2, ncol = 2, byrow = TRUE)) class2 <- mvrnorm(10, c(1,1), matrix(c(1,1,1,4), nrow = 2, ncol = 2, byrow = TRUE)) data <- rbind(class1, class2) plot(data, col = c(rep(1,10), rep(2,10))) # Get depth space using the random Tukey depth dhA = depth.space.halfspace(data, c(10, 10)) (dhA) # Get depth space using default exact method - "recursive" dhE = depth.space.halfspace(data, c(10, 10), exact = TRUE) (dhE) data <- getdata("hemophilia") cardinalities = c(sum(data$gr == "normal"), sum(data$gr == "carrier")) depth.space.halfspace(data[,1:2], cardinalities) } \keyword{ robust } \keyword{ multivariate } \keyword{ nonparametric } ddalpha/man/dataf.tecator.Rd0000644000176200001440000000374414550237276015453 0ustar liggesusers\name{dataf.tecator} \alias{dataf.tecator} \alias{tecator} \docType{data} \title{ Functional Data Set Spectrometric Data (Tecator) } \description{ This dataset is a part of the original one which can be found at \url{https://www.cmu.edu/dietrich/statistics-datascience/}. For each peace of finely chopped meat we observe one spectrometric curve which corresponds to the absorbance measured at 100 wavelengths. The peaces are split according to Ferraty and Vieu (2006) into two classes: with small (<20) and large fat content obtained by an analytical chemical processing. } \usage{ dataf.tecator() } \format{ The functional data as a data structure. \describe{ \item{\code{dataf}}{ The functional data as a list of objects. Each object is characterized by two coordinates. \describe{ \item{\code{args}}{\bold{wavelength} - a numeric vector of discretization points from 850 to 1050mm } \item{\code{vals}}{\bold{absorbance} - a numeric vector of absorbance values} } } \item{\code{labels}}{The classes of the objects: "small" (<20) and "large" fat content} } } \author{ Febrero-Bande, M and Oviedo de la Fuente, Manuel } \source{ \url{https://www.cmu.edu/dietrich/statistics-datascience/} } \references{ Ferraty, F. and Vieu, P. (2006). \emph{Nonparametric functional data analysis: theory and practice}. Springer. } \seealso{ \code{\link{dataf.*}} for other functional data sets \code{\link{plot.functional}} for building plots of functional data } \examples{ ## load the dataset dataf = dataf.tecator() ## view the classes unique(dataf$labels) ## access the 5th point of the 2nd object dataf$dataf[[2]]$args[5] dataf$dataf[[2]]$vals[5] ## plot the data \dontrun{ labels = unlist(dataf$labels) plot(dataf, xlab="Wavelengths", ylab="Absorbances", main=paste("Tecator: < 20 red (", sum(labels == "small"), "),", " >= 20 blue (", sum(labels == "large"), ")", sep=""), colors = c("blue", "red")) } } \keyword{datasets} \keyword{functional} ddalpha/man/depthf.hM2.Rd0000644000176200001440000000665014216410624014617 0ustar liggesusers\name{depthf.hM2} \alias{depthf.hM2} \title{Bivariate h-Mode Depth for Functional Data Based on the \eqn{L^2} Metric} \usage{ depthf.hM2(datafA, datafB, range = NULL, d = 101, q = 0.2) } \arguments{ \item{datafA}{Bivariate functions whose depth is computed, represented by a multivariate \code{dataf} object of their arguments (vector), and a matrix with two columns of the corresponding bivariate functional values. \code{m} stands for the number of functions.} \item{datafB}{Bivariate random sample functions with respect to which the depth of \code{datafA} is computed. \code{datafB} is represented by a multivariate \code{dataf} object of their arguments (vector), and a matrix with two columns of the corresponding bivariate functional values. \code{n} is the sample size. The grid of observation points for the functions \code{datafA} and \code{datafB} may not be the same.} \item{range}{The common range of the domain where the functions \code{datafA} and \code{datafB} are observed. Vector of length 2 with the left and the right end of the interval. Must contain all arguments given in \code{datafA} and \code{datafB}.} \item{d}{Grid size to which all the functional data are transformed. For depth computation, all functional observations are first transformed into vectors of their functional values of length \code{d} corresponding to equi-spaced points in the domain given by the interval \code{range}. Functional values in these points are reconstructed using linear interpolation, and extrapolation.} \item{q}{The quantile used to determine the value of the bandwidth \eqn{h} in the computation of the h-mode depth. \eqn{h} is taken as the \code{q}-quantile of all non-zero distances between the functions \code{B}. By default, this value is set to \code{q=0.2}, in accordance with the choice of Cuevas et al. (2007).} } \value{ Three vectors of length \code{m} of h-mode depth values are returned: \itemize{ \item \code{hM} the unscaled h-mode depth, \item \code{hM_norm} the h-mode depth \code{hM} linearly transformed so that its range is [0,1], \item \code{hM_norm2} the h-mode depth \code{FD} linearly transformed by a transformation such that the range of the h-mode depth of \code{B} with respect to \code{B} is [0,1]. This depth may give negative values. } } \description{ The h-mode depth of functional bivariate data (that is, data of the form \eqn{X:[a,b] \to R^2}, or \eqn{X:[a,b] \to R} and the derivative of \eqn{X}) based on the \eqn{L^2} metric of functions. } \details{ The function returns the vectors of sample h-mode depth values. The kernel used in the evaluation is the standard Gaussian kernel, the bandwidth value is chosen as a quantile of the non-zero distances between the random sample curves. } \examples{ datafA = dataf.population()$dataf[1:20] datafB = dataf.population()$dataf[21:50] datafA2 = derivatives.est(datafA,deriv=c(0,1)) datafB2 = derivatives.est(datafB,deriv=c(0,1)) depthf.hM2(datafA2,datafB2) depthf.hM2(datafA2,datafB2)$hM # depthf.hM2(cbind(A2[,,1],A2[,,2]),cbind(B2[,,1],B2[,,2]))$hM # the two expressions above should give the same result } \references{ Cuevas, A., Febrero, M. and Fraiman, R. (2007). Robust estimation and classification for functional data via projection-based depth notions. \emph{Computational Statistics} \bold{22} (3), 481--496. } \seealso{ \code{\link{depthf.hM}} } \author{ Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} } \keyword{depth} \keyword{derivatives} \keyword{functional} ddalpha/man/depth.betaSkeleton.Rd0000644000176200001440000001010714213423775016443 0ustar liggesusers\name{depth.betaSkeleton} \alias{depth.betaSkeleton} \title{ Calculate Beta-Skeleton Depth } \description{ Calculates the beta-skeleton depth of points w.r.t. a multivariate data set. } \usage{ depth.betaSkeleton(x, data, beta = 2, distance = "Lp", Lp.p = 2, mah.estimate = "moment", mah.parMcd = 0.75) } \arguments{ \item{x}{Matrix of objects (numerical vector as one object) whose depth is to be calculated; each row contains a \eqn{d}-variate point. Should have the same dimension as \code{data}. } \item{data}{Matrix of data where each row contains a \eqn{d}-variate point, w.r.t. which the depth is to be calculated. } \item{beta}{The paremeter defining the positionning of the balls' centers, see Yang and Modarres (2017) for details. By default (together with other arguments) equals \code{2}, which corresponds to the lens depth, see Liu and Modarres (2011). } \item{distance}{A character string defining the distance to be used for determining inclusion of a point into the lens (influence region), see Yang and Modarres (2017) for details. Possibilities are \code{"Lp"} for the Lp-metric (default) or \code{"Mahalanobis"} for the Mahalanobis distance adjustment. } \item{Lp.p}{A non-negative number defining the distance's power equal \code{2} by default (Euclidean distance); is used only when \code{distance = "Lp"}. } \item{mah.estimate}{A character string specifying which estimates to use when calculating sample covariance matrix; can be \code{"none"}, \code{"moment"} or \code{"MCD"}, determining whether traditional moment or Minimum Covariance Determinant (MCD) (see \code{\link{covMcd}}) estimates for mean and covariance are used. By default \code{"moment"} is used. Is used only when \code{distance = "Mahalanobis"}. } \item{mah.parMcd}{The value of the argument \code{alpha} for the function \code{\link{covMcd}}; is used when \code{distance = "Mahalanobis"} and \code{mah.estimate = "MCD"}. } } \details{ Calculates the beta-skeleton depth, see Yang and Modarres (2017). Its particular case, lens depth, see Liu and Modarres (2011), is obtained when \code{beta = 2}, \code{distance = "Lp"} and \code{Lp.p = 2} (default settings). For tne example of the lens depth, the depth of an observation \code{x} is calculated as the portion of lens containing \code{x}, with lens being an intersection of two closed balls centered at two sample's points each having radius equal to the distance between these two points. } \value{ Numerical vector of depths, one for each row in \code{x}; or one depth value if \code{x} is a numerical vector. } \references{ Liu, Z. and Modarres, R. (2011). Lens data depth and median. \emph{Journal of Nonparametric Statistics} \bold{23}(4) 1063--1074. Yang, M. and Modarres, R. (2017). \eqn{\beta}-skeleton depth functions and medians. \emph{Commmunications in Statistics - Theory and Methods} to appear. } \seealso{ \code{\link{depth.halfspace}} for calculation of the Tukey depth. \code{\link{depth.Mahalanobis}} for calculation of Mahalanobis depth. \code{\link{depth.projection}} for calculation of projection depth. \code{\link{depth.simplicial}} for calculation of simplicial depth. \code{\link{depth.simplicialVolume}} for calculation of simplicial volume depth. \code{\link{depth.spatial}} for calculation of spatial depth. \code{\link{depth.zonoid}} for calculation of zonoid depth. \code{\link{depth.potential}} for calculation of data potential. } \examples{ # 5-dimensional normal distribution data <- mvrnorm(1000, rep(0, 5), matrix(c(1, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 1), nrow = 5)) x <- mvrnorm(10, rep(1, 5), matrix(c(1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1), nrow = 5)) depths <- depth.betaSkeleton(x, data) cat("Depths:", depths, "\n") } \keyword{ robust } \keyword{ multivariate } \keyword{ nonparametric } ddalpha/man/plot.ddalpha.Rd0000644000176200001440000000241714213423775015277 0ustar liggesusers\name{plot.ddalpha} \alias{plot.ddalpha} \title{ Plots for the "ddalpha" Class } \description{ \code{\link{depth.contours.ddalpha}} -- builds the data depth contours for multiclass 2-dimensional data using the trained classifier. \code{\link{draw.ddplot}} -- draws the \emph{DD}-plot of the existing DD\eqn{\alpha}-classifier. } \usage{ \method{plot}{ddalpha}(x, type = c("ddplot", "depth.contours"), ...) } \arguments{ \item{x}{ DD\eqn{\alpha}-classifier (obtained by \code{\link{ddalpha.train}}). } \item{type}{ type of the plot for \code{\link{draw.ddplot}} or \code{\link{depth.contours.ddalpha}} } \item{\dots}{ additional parameters passed to the depth functions and to \code{\link{plot}} } } \seealso{ \code{\link{depth.}} \code{\link{depth.contours}} \code{\link{depth.graph}} } \examples{ \dontrun{ par(mfrow = c(2,2)) data(hemophilia) ddalpha = ddalpha.train(hemophilia, depth = "none") plot(ddalpha, type = "depth.contours", main = "data") plot(ddalpha, type = "ddplot", main = "data", drawsep = F) for (depth in c("zonoid", "Mahalanobis", "projection", "spatial")){ ddalpha = ddalpha.train(hemophilia, depth = depth) plot(ddalpha, type = "depth.contours", main = depth, drawsep = T) plot(ddalpha, type = "ddplot", main = depth) } } } \keyword{ visualization } ddalpha/man/depthf.RP2.Rd0000644000176200001440000000731314216410625014572 0ustar liggesusers\name{depthf.RP2} \alias{depthf.RP2} \title{Bivariate Random Projection Depths for Functional Data} \usage{ depthf.RP2(datafA, datafB, range = NULL, d = 101, nproj = 51) } \arguments{ \item{datafA}{Bivariate functions whose depth is computed, represented by a multivariate \code{dataf} object of their arguments (vector), and a matrix with two columns of the corresponding bivariate functional values. \code{m} stands for the number of functions.} \item{datafB}{Bivariate random sample functions with respect to which the depth of \code{datafA} is computed. \code{datafB} is represented by a multivariate \code{dataf} object of their arguments (vector), and a matrix with two columns of the corresponding bivariate functional values. \code{n} is the sample size. The grid of observation points for the functions \code{datafA} and \code{datafB} may not be the same.} \item{range}{The common range of the domain where the functions \code{datafA} and \code{datafB} are observed. Vector of length 2 with the left and the right end of the interval. Must contain all arguments given in \code{datafA} and \code{datafB}.} \item{d}{Grid size to which all the functional data are transformed. For depth computation, all functional observations are first transformed into vectors of their functional values of length \code{d} corresponding to equi-spaced points in the domain given by the interval \code{range}. Functional values in these points are reconstructed using linear interpolation, and extrapolation.} \item{nproj}{Number of projections taken in the computation of the double random projection depth. By default taken to be \code{51}.} } \value{ Five vectors of length \code{m} are returned: \itemize{ \item \code{Simpl_FD} the double random projection depth RP2 based on the bivariate simplicial depth, \item \code{Half_FD} the double random projection depth RP2 based on the bivariate halfspace depth, \item \code{hM_FD} the double random projection depth RP2 based on the bivariate h-mode depth, \item \code{Simpl_DD} the double random projection depth RPD based on the univariate simplicial depth, \item \code{Half_DD} the random projection depth RPD based on the univariate halfspace depth, } } \description{ Double random projection depths of functional bivariate data (that is, data of the form \eqn{X:[a,b] \to R^2}, or \eqn{X:[a,b] \to R} and the derivative of \eqn{X}). } \details{ The function returns the vectors of sample double random projection depth values. The double random projection depths are described in Cuevas et al. (2007). They are of two types: RP2 type, and RPD type. Both types of depths are based on bivariate projections of the bivariate functional data. These projections are taken randomly as a sample of standard normal \code{d}-dimensional random variables, where \code{d} stands for the dimensionality of the internally represented discretized functional data. For RP2 type depths, the average bivariate depth of the projected quantities is assessed. For RPD type depths, further univariate projections of these bivariate projected quantities are evaluated, and based on these final univariate quantities, the average univariate depth is computed. } \examples{ datafA = dataf.population()$dataf[1:20] datafB = dataf.population()$dataf[21:50] dataf2A = derivatives.est(datafA,deriv=c(0,1)) dataf2B = derivatives.est(datafB,deriv=c(0,1)) depthf.RP2(dataf2A,dataf2B) } \references{ Cuevas, A., Febrero, M. and Fraiman, R. (2007). Robust estimation and classification for functional data via projection-based depth notions. \emph{Computational Statistics} \bold{22} (3), 481--496. } \seealso{ \code{\link{depthf.RP1}} } \author{ Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} } \keyword{depth} \keyword{derivatives} \keyword{functional} ddalpha/man/depthf..Rd0000644000176200001440000000461414213423775014256 0ustar liggesusers\name{depthf.} \alias{depthf.} \title{ Calculate Functional Depth } \description{ Calculates the depth of functions w.r.t. a functional data set. The detailed descriptions are found in the corresponding topics. } \usage{ depthf.(datafA, datafB, notion, ...) ## Adjusted band depth # depthf.ABD(datafA, datafB, range = NULL, d = 101, norm = c("C", "L2"), # J = 2, K = 1) ## Band depth # depthf.BD(datafA, datafB, range = NULL, d = 101) ## Univariate integrated and infimal depth # depthf.fd1(datafA, datafB, range = NULL, d = 101, order = 1, approx = 0) ## Bivariate integrated and infimal depth # depthf.fd2(datafA, datafB, range = NULL, d = 101) ## h-mode depth # depthf.hM(datafA, datafB, range = NULL, d = 101, norm = c("C", "L2"), # q = 0.2) ## Bivariate h-mode depth # depthf.hM2(datafA, datafB, range = NULL, d = 101, q = 0.2) ## Half-region depth # depthf.HR(datafA, datafB, range = NULL, d = 101) ## Univariate random projection depths # depthf.RP1(datafA, datafB, range = NULL, d = 101, nproj = 50, nproj2 = 5) # Bivariate random projection depths # depthf.RP2(datafA, datafB, range = NULL, d = 101, nproj = 51) } \arguments{ \item{datafA}{ Functions whose depth is computed, represented by a \code{dataf} object of their arguments and functional values. } \item{datafB}{ Random sample functions with respect to which the depth of \code{datafA} is computed. \code{datafB} is represented by a \code{dataf} object of their arguments and functional values. } \item{notion}{ The name of the depth notion (shall also work with a user-defined depth function named \code{"depthf."}). } \item{\dots}{ Additional parameters passed to the depth functions. } } \seealso{ \code{\link{depthf.ABD}} \code{\link{depthf.BD}} \code{\link{depthf.fd1}} \code{\link{depthf.fd2}} \code{\link{depthf.hM}} \code{\link{depthf.hM2}} \code{\link{depthf.HR}} \code{\link{depthf.RP1}} \code{\link{depthf.RP2}} } \value{ Numerical vector of depths, one for each function in \code{datafA}; or one depth value if \code{datafA} is a single function. } \examples{ # real data example datafA = dataf.population()$dataf[1:20] datafB = dataf.population()$dataf[21:50] depthf.(datafA, datafB, notion = "HR") dataf2A = derivatives.est(datafA,deriv=c(0,1)) dataf2B = derivatives.est(datafB,deriv=c(0,1)) depthf.(dataf2A, dataf2B, notion = "fd2") } \keyword{ robust } \keyword{ functional } \keyword{ nonparametric } ddalpha/man/depth.Mahalanobis.Rd0000644000176200001440000000741614213423775016252 0ustar liggesusers\name{depth.Mahalanobis} \alias{depth.Mahalanobis} \title{ Calculate Mahalanobis Depth } \description{ Calculates the Mahalanobis depth of points w.r.t. a multivariate data set. } \usage{ depth.Mahalanobis(x, data, mah.estimate = "moment", mah.parMcd = 0.75) } \arguments{ \item{x}{ Matrix of objects (numerical vector as one object) whose depth is to be calculated; each row contains a \eqn{d}-variate point. Should have the same dimension as \code{data}. } \item{data}{ Matrix of data where each row contains a \eqn{d}-variate point, w.r.t. which the depth is to be calculated. } \item{mah.estimate}{ is a character string specifying which estimates to use when calculating the Mahalanobis depth; can be \code{"moment"} or \code{"MCD"}, determining whether traditional moment or Minimum Covariance Determinant (MCD) (see \code{\link{covMcd}}) estimates for mean and covariance are used. By default \code{"moment"} is used. } \item{mah.parMcd}{ is the value of the argument \code{alpha} for the function \code{\link{covMcd}}; is used when \code{mah.estimate =} \code{"MCD"}. } } \details{ Calculates Mahalanobis depth. Mahalanobis depth is based on an outlyingness measure (Zuo & Serfling, 2000), \emph{viz.} the Mahalanobis distance between the given point and the center of the data (Mahalanobis, 1936). \emph{Moment estimates} may be used i.e. traditional \emph{mean} and \emph{covariance matrix}, the corresponding depth may be sensitive to outliers. A more robust depth is obtained with \emph{minimum volume ellipsoid} (MVE) or \emph{minimum covariance determinant} (MCD) estimators, see Rousseeuw & Leroy (1987) and Lopuhaa & Rousseeuw (1991). } \value{ Numerical vector of depths, one for each row in \code{x}; or one depth value if \code{x} is a numerical vector. } \references{ Mahalanobis, P. (1936). On the generalized distance in statistics. \emph{Proceedings of the National Academy India} \bold{12} 49--55. Liu, R.Y. (1992). Data depth and multivariate rank tests. In: Dodge, Y. (ed.), \emph{L1-Statistics and Related Methods}, North-Holland (Amsterdam), 279--294. Lopuhaa, H.P. and Rousseeuw, P.J. (1991). Breakdown points of affine equivariant estimators of multivariate location and covariance matrices. \emph{The Annals of Statistics} \bold{19} 229--248. Rousseeuw, P.J. and Leroy, A.M. (1987). Robust Regression and Outlier Detection. John Wiley & Sons (New York). Zuo, Y.J. and Serfling, R. (2000). General notions of statistical depth function. \emph{The Annals of Statistics} \bold{28} 461--482. } \seealso{ \code{\link{depth.halfspace}} for calculation of the Tukey depth. \code{\link{depth.projection}} for calculation of projection depth. \code{\link{depth.simplicial}} for calculation of simplicial depth. \code{\link{depth.simplicialVolume}} for calculation of simplicial volume depth. \code{\link{depth.spatial}} for calculation of spatial depth. \code{\link{depth.zonoid}} for calculation of zonoid depth. \code{\link{depth.potential}} for calculation of data potential. } \examples{ # 5-dimensional normal distribution data <- mvrnorm(1000, rep(0, 5), matrix(c(1, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 1), nrow = 5)) x <- mvrnorm(10, rep(1, 5), matrix(c(1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1), nrow = 5)) depths <- depth.Mahalanobis(x, data) cat("Depths moment: ", depths, "\n") depths <- depth.Mahalanobis(x, data, mah.estimate = "MCD", mah.parMcd = 0.75) cat("Depths MCD: ", depths, "\n") } \keyword{ robust } \keyword{ multivariate } \keyword{ nonparametric } ddalpha/man/compclassf.train.Rd0000644000176200001440000000503314213423775016170 0ustar liggesusers\name{compclassf.train} \alias{compclassf.train} \title{ Functional Componentwise Classifier } \description{ Trains the functional componentwise classifier } \usage{ compclassf.train (dataf, labels, subset, to.equalize = TRUE, to.reduce = TRUE, classifier.type = c("ddalpha", "maxdepth", "knnaff", "lda", "qda"), ...) } \arguments{ \item{dataf}{ list containing lists (functions) of two vectors of equal length, named "args" and "vals": arguments sorted in ascending order and corresponding them values respectively } \item{labels}{ list of output labels of the functional observations } \item{subset}{ an optional vector specifying a subset of observations to be used in training the classifier. } \item{to.equalize}{ Adjust the data to have equal (the largest) argument interval. } \item{to.reduce}{ If the data spans a subspace only, project on it (by PCA). } \item{classifier.type}{ the classifier which is used on the transformed space. The default value is 'ddalpha'. } \item{\dots}{ additional parameters, passed to the classifier, selected with parameter \code{classifier.type}. } } \details{ The finite-dimensional space is directly constructed from the observed values. Delaigle, Hall and Bathia (2012) consider (almost) all sets of discretization points that have a given cardinality. The usual classifiers are then trained on the constructed finite-dimensional space. } \value{ Trained functional componentwise classifier %% If it is a LIST, use %% \item{comp1 }{Description of 'comp1'} %% \item{comp2 }{Description of 'comp2'} %% ... } \references{ Delaigle, A., Hall, P., and Bathia, N. (2012). Componentwise classification and clustering of functional data. \emph{Biometrika} \bold{99} 299--313. } \seealso{ \code{\link{compclassf.classify}} for classification using functional componentwise classifier, \code{\link{ddalphaf.train}} to train the functional DD-classifier, \code{\link{dataf.*}} for functional data sets included in the package. } \examples{ \dontrun{ ## load the Growth dataset dataf = dataf.growth() learn = c(head(dataf$dataf, 49), tail(dataf$dataf, 34)) labels =c(head(dataf$labels, 49), tail(dataf$labels, 34)) test = tail(head(dataf$dataf, 59), 10) # elements 50:59. 5 girls, 5 boys c = compclassf.train (learn, labels, classifier.type = "ddalpha") classified = compclassf.classify(c, test) print(unlist(classified)) } } \keyword{ functional } \keyword{ robust } \keyword{ multivariate } \keyword{ nonparametric } \keyword{ classif } ddalpha/man/rawfd2dataf.Rd0000644000176200001440000000266514216410624015107 0ustar liggesusers\name{rawfd2dataf} \alias{rawfd2dataf} \title{Transform Raw Functional Data to a \code{dataf} Object} \usage{ rawfd2dataf(X, range) } \arguments{ \item{X}{Either a matrix of size \code{n*d}, or an array of dimension \code{n*d*k} of functional values. Here \code{n} stands for the number of functions, \code{d} is the number of equi-distant points in the domain where the functional values are evaluated, and if applicable, \code{k} is the dimensionality of the (vector-valued) functional data.} \item{range}{A vector of size two that represents the endpoints of the common domain of all functions \code{X}.} } \value{ A (possibly multivariate) \code{dataf} object corresponding to the functional data \code{X} evaluated at an equi-distant grid of points. } \description{ Constructs a (possibly multivariate) functional data object given by an array of its functional values evaluated at an equi-distant grid of points, and transforms it into a \code{dataf} object more suitable for work in the \code{ddalpha} package. } \examples{ ## transform a matrix into a functional data set n = 5 d = 21 X = matrix(rnorm(n*d),ncol=d) rawfd2dataf(X,range=c(0,1)) ## transform an array into a multivariate functional data set k = 3 X = array(rnorm(n*d*k),dim=c(n,d,k)) rawfd2dataf(X,range=c(-1,1)) } \seealso{ \code{\link{dataf2rawfd}} \code{\link{depthf.fd1}} \code{\link{depthf.fd2}} } \author{ Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} } \keyword{functional} ddalpha/man/depth.space..Rd0000644000176200001440000000451614213423775015203 0ustar liggesusers\name{depth.space.} \alias{depth.space.} \title{ Calculate Depth Space using the Given Depth } \description{ Calculates the representation of the training classes in depth space. The detailed descriptions are found in the corresponding topics. } \usage{ depth.space.(data, cardinalities, notion, ...) ## Mahalanobis depth # depth.space.Mahalanobis(data, cardinalities, mah.estimate = "moment", mah.parMcd = 0.75) ## projection depth # depth.space.projection(data, cardinalities, method = "random", num.directions = 1000) ## Tukey depth # depth.space.halfspace(data, cardinalities, exact, alg, num.directions = 1000) ## spatial depth # depth.space.spatial(data, cardinalities) ## zonoid depth # depth.space.zonoid(data, cardinalities) # Potential # depth.space.potential(data, cardinalities, pretransform = "NMom", # kernel = "GKernel", kernel.bandwidth = NULL, mah.parMcd = 0.75) } \arguments{ \item{data}{ Matrix containing training sample where each row is a \eqn{d}-dimensional object, and objects of each class are kept together so that the matrix can be thought of as containing blocks of objects representing classes. } \item{cardinalities}{ Numerical vector of cardinalities of each class in \code{data}, each entry corresponds to one class. } \item{notion}{ The name of the depth notion (shall also work with \code{\link{Custom Methods}}). } \item{\dots}{ Additional parameters passed to the depth functions. } } \value{ Matrix of objects, each object (row) is represented via its depths (columns) w.r.t. each of the classes of the training sample; order of the classes in columns corresponds to the one in the argument \code{cardinalities}. } \seealso{ \code{\link{depth.space.Mahalanobis}} \code{\link{depth.space.projection}} \code{\link{depth.space.halfspace}} \code{\link{depth.space.spatial}} \code{\link{depth.space.zonoid}} } \examples{ # Generate a bivariate normal location-shift classification task # containing 20 training objects class1 <- mvrnorm(10, c(0,0), matrix(c(1,1,1,4), nrow = 2, ncol = 2, byrow = TRUE)) class2 <- mvrnorm(10, c(2,2), matrix(c(1,1,1,4), nrow = 2, ncol = 2, byrow = TRUE)) data <- rbind(class1, class2) # Get depth space using zonoid depth depth.space.(data, c(10, 10), notion = "zonoid") } \keyword{ robust } \keyword{ multivariate } \keyword{ nonparametric } ddalpha/man/depthf.RP1.Rd0000644000176200001440000000676614216410624014603 0ustar liggesusers\name{depthf.RP1} \alias{depthf.RP1} \title{Univariate Random Projection Depths for Functional Data} \usage{ depthf.RP1(datafA, datafB, range = NULL, d = 101, nproj = 50, nproj2 = 5) } \arguments{ \item{datafA}{Functions whose depth is computed, represented by a \code{dataf} object of their arguments and functional values. \code{m} stands for the number of functions.} \item{datafB}{Random sample functions with respect to which the depth of \code{datafA} is computed. \code{datafB} is represented by a \code{dataf} object of their arguments and functional values. \code{n} is the sample size. The grid of observation points for the functions \code{datafA} and \code{datafB} may not be the same.} \item{range}{The common range of the domain where the functions \code{datafA} and \code{datafB} are observed. Vector of length 2 with the left and the right end of the interval. Must contain all arguments given in \code{datafA} and \code{datafB}.} \item{d}{Grid size to which all the functional data are transformed. For depth computation, all functional observations are first transformed into vectors of their functional values of length \code{d} corresponding to equi-spaced points in the domain given by the interval \code{range}. Functional values in these points are reconstructed using linear interpolation, and extrapolation.} \item{nproj}{Number of projections taken in the computation of the random projection depth. By default taken to be \code{51}.} \item{nproj2}{Number of projections taken in the computation of the random functional depth. By default taken to be \code{5}. \code{nproj2} should be much smaller than \code{d}, the dimensionality of the discretized functional data.} } \value{ Three vectors of depth values of length \code{m} are returned: \itemize{ \item \code{Simpl_FD} the random projection depth based on the univariate simplicial depth, \item \code{Half_FD} the random projection depth based on the univariate halfspace depth, \item \code{RHalf_FD} the random halfspace depth. } } \description{ Random projection depth and random functional depth for functional data. } \details{ The function returns the vectors of sample random projection, and random functional depth values. The random projection depth described in Cuevas et al. (2007) is based on the average univariate depth of one-dimensional projections of functional data. The projections are taken randomly as a sample of standard normal \code{d}-dimensional random variables, where \code{d} stands for the dimensionality of the discretized functional data. The random functional depth (also called random Tukey depth, or random halfspace depth) is described in Cuesta-Albertos and Nieto-Reyes (2008). The functional data are projected into the real line in random directions as for the random projection depths. Afterwards, an approximation of the halfspace (Tukey) depth based on this limited number of univariate projections is assessed. } \examples{ datafA = dataf.population()$dataf[1:20] datafB = dataf.population()$dataf[21:50] depthf.RP1(datafA,datafB) } \references{ Cuevas, A., Febrero, M. and Fraiman, R. (2007). Robust estimation and classification for functional data via projection-based depth notions, \emph{Computational Statistics} \bold{22} (3), 481--496. Cuesta-Albertos, J.A. and Nieto-Reyes, A. (2008). The random Tukey depth. \emph{Computational Statistics & Data Analysis} \bold{52} (11), 4979--4988. } \seealso{ \code{\link{depthf.RP2}} } \author{ Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} } \keyword{depth} \keyword{functional} ddalpha/man/depthf.ABD.Rd0000644000176200001440000000650014216410625014552 0ustar liggesusers\name{depthf.ABD} \alias{depthf.ABD} \title{Adjusted Band Depth for Functional Data} \usage{ depthf.ABD(datafA, datafB, range = NULL, d = 101, norm = c("C", "L2"), J = 2, K = 1) } \arguments{ \item{datafA}{Functions whose depth is computed, represented by a \code{dataf} object of their arguments and functional values. \code{m} stands for the number of functions.} \item{datafB}{Random sample functions with respect to which the depth of \code{datafA} is computed. \code{datafB} is represented by a \code{dataf} object of their arguments and functional values. \code{n} is the sample size. The grid of observation points for the functions \code{datafA} and \code{datafB} may not be the same.} \item{range}{The common range of the domain where the functions \code{datafA} and \code{datafB} are observed. Vector of length 2 with the left and the right end of the interval. Must contain all arguments given in \code{datafA} and \code{datafB}.} \item{d}{Grid size to which all the functional data are transformed. For depth computation, all functional observations are first transformed into vectors of their functional values of length \code{d} corresponding to equi-spaced points in the domain given by the interval \code{range}. Functional values in these points are reconstructed using linear interpolation, and extrapolation, see Nagy et al. (2016).} \item{norm}{The norm used for the computation of the depth. Two possible choices are implemented: \code{C} for the uniform norm of continuous functions, and \code{L2} for the \eqn{L^2} norm of integrable functions.} \item{J}{The order of the adjusted band depth, that is the maximal number of functions taken in a band. Acceptable values are \code{2}, \code{3},... By default this value is set to \code{2}. Note that this is NOT the order as defined in the order-extended version of adjusted band depths in Nagy et al. (2016), used for the detection of shape outlying curves.} \item{K}{Number of sub-samples of the functions from \code{B} taken to speed up the computation. By default, sub-sampling is not performed. Values of \code{K} larger than \code{1} result in an approximation of the adjusted band depth.} } \value{ A vectors of length \code{m} of the adjusted band depths. } \description{ The adjusted band depth of functional real-valued data based on either the \eqn{C} (uniform) norm, or on the \eqn{L^2} norm of functions. } \details{ The function returns the vector of the sample adjusted band depth values. The kernel used in the evaluation is the function \eqn{K(u) = exp(-u)}. } \examples{ datafA = dataf.population()$dataf[1:20] datafB = dataf.population()$dataf[21:50] depthf.ABD(datafA,datafB) depthf.ABD(datafA,datafB,norm="L2") } \references{ Gijbels, I., Nagy, S. (2015). Consistency of non-integrated depths for functional data. \emph{Journal of Multivariate Analysis} \bold{140}, 259--282. Nagy, S., Gijbels, I. and Hlubinka, D. (2016). Weak convergence of discretely observed functional data with applications. \emph{Journal of Multivariate Analysis}, \bold{146}, 46--62. Nagy, S., Gijbels, I. and Hlubinka, D. (2017). Depth-based recognition of shape outlying functions. \emph{Journal of Computational and Graphical Statistics}, \bold{26} (4), 883--893. } \seealso{ \code{\link{depthf.BD}} } \author{ Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} } \keyword{depth} \keyword{functional} ddalpha/man/ddalpha.test.Rd0000644000176200001440000000540614213423775015301 0ustar liggesusers\name{ddalpha.test} \alias{ddalpha.test} \title{ Test DD-Classifier } \description{ Trains DD-classifier on the learning sequence of the data and tests it on the testing sequence. } \usage{ ddalpha.test(learn, test, ...) } \arguments{ \item{learn}{ the learning sequence of the data. Matrix containing training sample where each of \eqn{n} rows is one object of the training sample where first \eqn{d} entries are inputs and the last entry is output (class label). } \item{test}{ the testing sequence. Has the same format as \code{learn} } \item{\dots}{ additional parameters passed to \code{\link{ddalpha.train}} } } \value{ \item{error}{ the part of incorrectly classified data } \item{correct}{ the number of correctly classified objects } \item{incorrect}{ the number of incorrectly classified objects } \item{total}{ the number of classified objects } \item{ignored}{ the number of ignored objects (outside the convex hull of the learning data) } \item{n}{ the number of objects in the testing sequence } \item{time}{ training time } } \seealso{ \code{\link{ddalpha.train}} to train the DD-classifier, \code{\link{ddalpha.classify}} for classification using DD-classifier, \code{\link{ddalpha.getErrorRateCV}} and \code{\link{ddalpha.getErrorRatePart}} to get error rate of the DD-classifier on particular data. } \examples{ # Generate a bivariate normal location-shift classification task # containing 200 training objects and 200 to test with class1 <- mvrnorm(200, c(0,0), matrix(c(1,1,1,4), nrow = 2, ncol = 2, byrow = TRUE)) class2 <- mvrnorm(200, c(2,2), matrix(c(1,1,1,4), nrow = 2, ncol = 2, byrow = TRUE)) trainIndices <- c(1:100) testIndices <- c(101:200) propertyVars <- c(1:2) classVar <- 3 trainData <- rbind(cbind(class1[trainIndices,], rep(1, 100)), cbind(class2[trainIndices,], rep(2, 100))) testData <- rbind(cbind(class1[testIndices,], rep(1, 100)), cbind(class2[testIndices,], rep(2, 100))) data <- list(train = trainData, test = testData) # Train 1st DDalpha-classifier (default settings) # and get the classification error rate stat <- ddalpha.test(data$train, data$test) cat("1. Classification error rate (defaults): ", stat$error, ".\n", sep = "") # Train 2nd DDalpha-classifier (zonoid depth, maximum Mahalanobis # depth classifier with defaults as outsider treatment) # and get the classification error rate stat2 <- ddalpha.test(data$train, data$test, depth = "zonoid", outsider.methods = "depth.Mahalanobis") cat("2. Classification error rate (depth.Mahalanobis): ", stat2$error, ".\n", sep = "") } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ benchmark } ddalpha/man/depth.space.Mahalanobis.Rd0000644000176200001440000000624614213423775017344 0ustar liggesusers\name{depth.space.Mahalanobis} \alias{depth.space.Mahalanobis} \title{ Calculate Depth Space using Mahalanobis Depth } \description{ Calculates the representation of the training classes in depth space using Mahalanobis depth. } \usage{ depth.space.Mahalanobis(data, cardinalities, mah.estimate = "moment", mah.parMcd = 0.75) } \arguments{ \item{data}{ Matrix containing training sample where each row is a \eqn{d}-dimensional object, and objects of each class are kept together so that the matrix can be thought of as containing blocks of objects representing classes. } \item{cardinalities}{ Numerical vector of cardinalities of each class in \code{data}, each entry corresponds to one class. } \item{mah.estimate}{ is a character string specifying which estimates to use when calculating the Mahalanobis depth; can be \code{"moment"} or \code{"MCD"}, determining whether traditional moment or Minimum Covariance Determinant (MCD) (see \code{\link{covMcd}}) estimates for mean and covariance are used. By default \code{"moment"} is used. } \item{mah.parMcd}{ is the value of the argument \code{alpha} for the function \code{\link{covMcd}}; is used when \code{mah.estimate =} \code{"MCD"}. } } \details{ The depth representation is calculated in the same way as in \code{\link{depth.Mahalanobis}}, see 'References' for more information and details. } \value{ Matrix of objects, each object (row) is represented via its depths (columns) w.r.t. each of the classes of the training sample; order of the classes in columns corresponds to the one in the argument \code{cardinalities}. } \references{ Mahalanobis, P. (1936). On the generalized distance in statistics. \emph{Proceedings of the National Academy India} \bold{12} 49--55. Liu, R.Y. (1992). Data depth and multivariate rank tests. In: Dodge, Y. (ed.), \emph{L1-Statistics and Related Methods}, North-Holland (Amsterdam), 279--294. Lopuhaa, H.P. and Rousseeuw, P.J. (1991). Breakdown points of affine equivariant estimators of multivariate location and covariance matrices. \emph{The Annals of Statistics} \bold{19} 229--248. Rousseeuw, P.J. and Leroy, A.M. (1987). Robust Regression and Outlier Detection. John Wiley & Sons (New York). Zuo, Y.J. and Serfling, R. (2000). General notions of statistical depth function. \emph{The Annals of Statistics} \bold{28} 461--482. } \seealso{ \code{\link{ddalpha.train}} and \code{\link{ddalpha.classify}} for application, \code{\link{depth.Mahalanobis}} for calculation of Mahalanobis depth. } \examples{ # Generate a bivariate normal location-shift classification task # containing 20 training objects class1 <- mvrnorm(10, c(0,0), matrix(c(1,1,1,4), nrow = 2, ncol = 2, byrow = TRUE)) class2 <- mvrnorm(10, c(2,2), matrix(c(1,1,1,4), nrow = 2, ncol = 2, byrow = TRUE)) data <- rbind(class1, class2) # Get depth space using Mahalanobis depth depth.space.Mahalanobis(data, c(10, 10)) depth.space.Mahalanobis(data, c(10, 10), mah.estimate = "MCD", mah.parMcd = 0.75) data <- getdata("hemophilia") cardinalities = c(sum(data$gr == "normal"), sum(data$gr == "carrier")) depth.space.Mahalanobis(data[,1:2], cardinalities) } \keyword{ robust } \keyword{ multivariate } \keyword{ nonparametric } ddalpha/man/depth.spatial.Rd0000644000176200001440000000657214213423775015473 0ustar liggesusers\name{depth.spatial} \alias{depth.spatial} \title{ Calculate Spatial Depth } \description{ Calculates the spatial depth of points w.r.t. a multivariate data set. } \usage{ depth.spatial(x, data, mah.estimate = "moment", mah.parMcd = 0.75) } \arguments{ \item{x}{ Matrix of objects (numerical vector as one object) whose depth is to be calculated; each row contains a \eqn{d}-variate point. Should have the same dimension as \code{data}. } \item{data}{ Matrix of data where each row contains a \eqn{d}-variate point, w.r.t. which the depth is to be calculated. } \item{mah.estimate}{ is a character string specifying which estimates to use when calculating sample covariance matrix; can be \code{"none"}, \code{"moment"} or \code{"MCD"}, determining whether traditional moment or Minimum Covariance Determinant (MCD) (see \code{\link{covMcd}}) estimates for mean and covariance are used. By default \code{"moment"} is used. With \code{"none"} the non-affine invariant version of Spatial depth is calculated } \item{mah.parMcd}{ is the value of the argument \code{alpha} for the function \code{\link{covMcd}}; is used when \code{mah.estimate =} \code{"MCD"}. } } \details{ Calculates spatial depth. Spatial depth (also L1-depth) is a distance-based depth exploiting the idea of spatial quantiles of Chaudhuri (1996) and Koltchinskii (1997), formulated by Vardi & Zhang (2000) and Serfling (2002). } \value{ Numerical vector of depths, one for each row in \code{x}; or one depth value if \code{x} is a numerical vector. } \references{ Chaudhuri, P. (1996). On a geometric notion of quantiles for multivariate data. \emph{Journal of the Americal Statistical Association} \bold{91} 862--872. Koltchinskii, V.I. (1997). M-estimation, convexity and quantiles. \emph{The Annals of Statistics} \bold{25} 435--477. Serfling, R. (2006). Depth functions in nonparametric multivariate inference. In: Liu, R., Serfling, R., Souvaine, D. (eds.), \emph{Data Depth: Robust Multivariate Analysis, Computational Geometry and Applications}, American Mathematical Society, 1--16. Vardi, Y. and Zhang, C.H. (2000). The multivariate L1-median and associated data depth. \emph{Proceedings of the National Academy of Sciences, U.S.A.} \bold{97} 1423--1426. } \seealso{ \code{\link{depth.halfspace}} for calculation of the Tukey depth. \code{\link{depth.Mahalanobis}} for calculation of Mahalanobis depth. \code{\link{depth.projection}} for calculation of projection depth. \code{\link{depth.simplicial}} for calculation of simplicial depth. \code{\link{depth.simplicialVolume}} for calculation of simplicial volume depth. \code{\link{depth.zonoid}} for calculation of zonoid depth. \code{\link{depth.potential}} for calculation of data potential. } \examples{ # 5-dimensional normal distribution data <- mvrnorm(1000, rep(0, 5), matrix(c(1, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 1), nrow = 5)) x <- mvrnorm(10, rep(1, 5), matrix(c(1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1), nrow = 5)) depths <- depth.spatial(x, data) cat("Depths: ", depths, "\n") } \keyword{ robust } \keyword{ multivariate } \keyword{ nonparametric } ddalpha/man/shape.fd.outliers.Rd0000644000176200001440000001155314216410624016253 0ustar liggesusers\name{shape.fd.outliers} \alias{shape.fd.outliers} \title{Functional Depth-Based Shape Outlier Detection} \usage{ shape.fd.outliers(dataf, range = NULL, d = 101, q = 0.05, method = c("halfspace", "simplicial"), approx = 100, print = FALSE, plotpairs = FALSE, max.order = 3, exclude.out = TRUE, output = c("matrix", "list"), identifiers = NULL) } \arguments{ \item{dataf}{Functional dataset, represented by a \code{dataf} object of their arguments and functional values. \code{n} stands for the number of functions.} \item{range}{The common range of the domain where the fucntions \code{dataf} are observed. Vector of length 2 with the left and the right end of the interval. Must contain all arguments given in \code{dataf}.} \item{d}{Grid size to which all the functional data are transformed. For depth computation, all functional observations are first transformed into vectors of their functional values of length \code{d} corresponding to equi-spaced points in the domain given by the interval \code{range}. Functional values in these points are reconstructed using linear interpolation, and extrapolation.} \item{q}{The quantile presenting a threshold for the first order outlier detection. Functions with first order integrated depth smaller than the \code{q} quantile of this sample of depths are flagged as potential outliers. If set to \code{NULL}, the the outliers are detected from the first order integrated depth after the log-transformation, as for higher order outliers.} \item{method}{The depth that is used in the diagnostic plot. possible values are \code{halfspace} for the halfspace depth, or \code{simplicial} for the simplicial depth.} \item{approx}{For the computation of the third order integrated depth, the number of approximations used in the computation of the order extended depth. By default this is set to \code{100}, meaning that \code{100} trivariate points are randomly sampled in unit cube, and at these points the trivariate depths of the corresponding functional values. May be set to \code{0} to compute the depth at all possible \code{d^3} combinations of the points in the domain. This choice may result in very slow computation, see also \code{\link{depthf.fd1}}.} \item{print}{If the rows of \code{X} are named, \code{print=TRUE} enables a graphical output when the names of the outlying curves are displayed.} \item{plotpairs}{If set to \code{TRUE}, the scatter plot of the computed depths for orders \code{1}, \code{2} and \code{3} is is displayed. Here, the depths corresponding to the flagged outliers are plotted in colour.} \item{max.order}{Maximal order of shape outlyingness to be computed, can be set to \code{1}, \code{2}, or \code{3}.} \item{exclude.out}{Logical variable; exclude the detected lower order outliers in the flagging process? By default \code{TRUE}.} \item{output}{Output method, can be set to \code{matrix} for a matrix with logical entries (\code{TRUE} for outliers), or \code{list} for a list of outliers.} \item{identifiers}{A vector of names for the data observations. Facilitates identification of outlying functions.} } \value{ A matrix of logical values of size \code{n*4}, where \code{n} is the sample size. In the first three rows indicators of outlyingness of the corresponding functions for orders \code{1}, \code{2} and \code{3} are given, in the fourth row the indicator of outlyingness with respect to the comparison of the first, and third order depths is given. That is, the fist row corresponds to the first order outliers, the second row to the second order outliers, and the last two rows formally to the third order outliers. Please consult Nagy et al. (2016) to interpret the notion of shape outlyingness. } \description{ Detects functional outliers of first three orders, based on the order extended integrated depth for functional data. } \details{ Using the procedure described in Nagy et al. (2016), the function uses the order extended integrated depths for functions, see \code{\link{depthf.fd1}} and \code{\link{shape.fd.analysis}}, to perform informal functional shape outlier detection. Outliers of the first order (horizontal shift outliers) are found as the functions with \code{q} \% of smallest (first order) integrated depth values. Second and third order outliers (shape outliers) are found using the extension of the boxplot method for depths as described in the paper Nagy et al. (2016). } \examples{ n = 30 dataf = dataf.population()$dataf[1:n] shape.fd.outliers(dataf,print=TRUE,plotpairs=TRUE, identifiers=unlist(dataf.population()$identifier)[1:n]) } \references{ Nagy, S., Gijbels, I. and Hlubinka, D. (2017). Depth-based recognition of shape outlying functions. \emph{Journal of Computational and Graphical Statistics}, \bold{26} (4), 883--893. } \seealso{ \code{\link{depthf.fd1}}, \code{\link{shape.fd.analysis}} } \author{ Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} } \keyword{depth} \keyword{functional} \keyword{outlier} ddalpha/man/dknn.classify.trained.Rd0000644000176200001440000000542714213423775017124 0ustar liggesusers\name{dknn.classify.trained} \alias{dknn.classify.trained} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Depth-Based kNN } \description{ The implementation of the affine-invariant depth-based kNN of Paindaveine and Van Bever (2015). } \usage{ dknn.classify.trained(objects, dknn) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{objects}{ Matrix containing objects to be classified; each row is one \eqn{d}-dimensional object. } \item{dknn}{ Dknn-classifier (obtained by \code{\link{dknn.train}}). } } %\details{ %% ~~ If necessary, more details than the description above ~~ %} \value{ List containing class labels, or character string "Ignored" for the outsiders if "Ignore" was specified as the outsider treating method. } \references{ Paindaveine, D. and Van Bever, G. (2015). Nonparametrically consistent depth-based classifiers. \emph{Bernoulli} \bold{21} 62--82. } %\note{ %% ~~further notes~~ %} %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{dknn.train}} to train the Dknn-classifier. \code{\link{dknn.classify}} to classify with the Dknn-classifier. \code{\link{ddalpha.train}} to train the DD\eqn{\alpha}-classifier. \code{\link{ddalpha.getErrorRateCV}} and \code{\link{ddalpha.getErrorRatePart}} to get error rate of the Dknn-classifier on particular data (set \code{separator = "Dknn"}). } \examples{ # Generate a bivariate normal location-shift classification task # containing 200 training objects and 200 to test with class1 <- mvrnorm(200, c(0,0), matrix(c(1,1,1,4), nrow = 2, ncol = 2, byrow = TRUE)) class2 <- mvrnorm(200, c(2,2), matrix(c(1,1,1,4), nrow = 2, ncol = 2, byrow = TRUE)) trainIndices <- c(1:100) testIndices <- c(101:200) propertyVars <- c(1:2) classVar <- 3 trainData <- rbind(cbind(class1[trainIndices,], rep(1, 100)), cbind(class2[trainIndices,], rep(2, 100))) testData <- rbind(cbind(class1[testIndices,], rep(1, 100)), cbind(class2[testIndices,], rep(2, 100))) data <- list(train = trainData, test = testData) # Train the classifier # and get the classification error rate cls <- dknn.train(data$train, kMax = 20, depth = "Mahalanobis") cls$k classes1 <- dknn.classify.trained(data$test[,propertyVars], cls) cat("Classification error rate: ", sum(unlist(classes1) != data$test[,classVar])/200) # Classify the new data based on the old ones in one step classes2 <- dknn.classify(data$test[,propertyVars], data$train, k = cls$k, depth = "Mahalanobis") cat("Classification error rate: ", sum(unlist(classes2) != data$test[,classVar])/200) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ multivariate } \keyword{ nonparametric } \keyword{ classif }ddalpha/man/dataf.Rd0000644000176200001440000000446114213423775014005 0ustar liggesusers\name{dataf} \alias{dataf} \docType{data} \title{ Converts data from fdata class to the functional class. } \description{ \pkg{fda.usc} contains a handy function \code{\link[fda.usc:fdata]{fdata}} that converts varios types of functional data to the \code{fdata} class. To use these data in \code{\link{ddalphaf.train}} it must first be converted with \code{dataf}. The function may be used either to convert a fdata object that contains multiple classes, or to convert multiple fdata objects, each of which contains one class. Note that \code{fdata$fdata2d = TRUE} is not supported. } \usage{ dataf(fdatas, labels) } \arguments{ \item{fdatas}{ an \code{fdata} object with curves belonging to multiple classes, or a list of \code{fdata} objects, each of which contains curves of the same class } \item{labels}{ a list of labels of the functional observations. If \code{fdatas} is a single \code{fdata} object, the list contains labels for each curve. If \code{fdatas} is a list of \code{fdata} objects, the list labels for each of these \code{fdata} objects. } } \format{ The functional data as a data structure (see \code{\link{dataf.*}}). \describe{ \item{\code{dataf}}{ The functional data as a list of objects. Each object is characterized by two coordinates \describe{ \item{\code{args}}{The arguments vector} \item{\code{vals}}{The values vector} } } \item{\code{labels}}{The classes of the objects} } } \seealso{ \code{\link{dataf.*}} for the functional data format. \code{\link{ddalphaf.train}} to train the functional DD\eqn{\alpha}-classifier \code{\link{compclassf.train}} to train the functional componentwise classifier \code{\link{plot.functional}} for building plots of functional data } \examples{ \dontrun{ library(fda.usc) data(phoneme) # 1. convert a fdata object that contains multiple classes. # labels are defined for each curve converted = dataf(phoneme$learn, phoneme$classlearn) plot.functional(converted) # 2. convert multiple fdata objects, each of which contains one class # the same label is applied to all curves of each fdata object converted = dataf(list(phoneme$learn, phoneme$test), c("1 red", "2 blue")) converted$name = "Phoneme learn (red) and test (blue)" plot.functional(converted) } } \keyword{fdata} \keyword{functional} ddalpha/man/dataf.geneexp.Rd0000644000176200001440000000410614213423775015433 0ustar liggesusers\name{dataf.geneexp} \alias{dataf.geneexp} \alias{geneexp} \docType{data} \title{ Gene Expression Profile Data } \description{ A subet of the Drosophila life cycle gene expression data of Arbeitman et al. (2002). The original data set contains 77 gene expression profiles during 58 sequential time points from the embryonic, larval, and pupal periods of the life cycle. The gene expression levels were obtained by a cDNA microarray experiment. } \usage{ dataf.geneexp() } \format{ The functional data as a data structure. \describe{ \item{\code{dataf}}{ The functional data as a list of objects. Each object is characterized by two coordinates. \describe{ \item{\code{args}}{\bold{Time} - a numeric vector of time periods} \item{\code{vals}}{\bold{Gene Expression Level} - a numeric vector} } } \item{\code{labels}}{ Biological classifications identified in Arbeitman et al.(2002) (1 = transient early zygotic genes; 2 = muscle-specific genes; 3 = eye-specific genes. )} } } \source{ Chiou, J.-M. and Li, P.-L. Functional clustering and identifying substructures of longitudinal data, J. R. Statist. Soc. B, Volume 69 (2007), 679-699 Arbeitman, M.N., Furlong, E.E.M., Imam,F., Johnson, E., Null,B.H., Baker,B.S., Krasnow, M.A., Scott,M.P., Davis,R.W. and White,K.P. (2002) Gene expression during the life cycle of Drosophila melanogaster. Science, 297, 2270-2274. } \seealso{ \code{\link{dataf.*}} for other functional data sets \code{\link{plot.functional}} for building plots of functional data } \examples{ ## load the dataset dataf = dataf.geneexp() ## view the classes unique(dataf$labels) ## access the 5th point of the 2nd object dataf$dataf[[2]]$args[5] dataf$dataf[[2]]$vals[5] ## plot the data \dontrun{ labels = unlist(dataf$labels) plot(dataf, xlab="Time", ylab="Gene Expression Level", main=paste0("Gene Expression: 1 red (", sum(labels == 1), "), ", "2 green (", sum(labels == 2), "), ", "3 blue (", sum(labels == 3), ")"), colors = c("red", "green", "blue")) } } \keyword{datasets} \keyword{functional} ddalpha/man/dataf.growth.Rd0000644000176200001440000000365214213423775015317 0ustar liggesusers\name{dataf.growth} \alias{dataf.growth} \alias{growth} \docType{data} \title{ Berkeley Growth Study Data } \description{ The data set contains the heights of 39 boys and 54 girls from age 1 to 18 and the ages at which they were collected. } \usage{ dataf.growth() } \format{ The functional data as a data structure. \describe{ \item{\code{dataf}}{ The functional data as a list of objects. Each object is characterized by two coordinates \describe{ \item{\code{args}}{\bold{age} - a numeric vector of length 31 giving the ages at which the heights were measured} \item{\code{vals}}{\bold{height} - a numeric vector of heights in centimeters of 39 boys and 54 girls} } } \item{\code{labels}}{The classes of the objects: boy, girl} } } \details{ The ages are not equally spaced. } \source{ Ramsay, James O., and Silverman, Bernard W. (2006), Functional Data Analysis, 2nd ed., Springer, New York. Ramsay, James O., and Silverman, Bernard W. (2002), Applied Functional Data Analysis, Springer, New York, ch. 6. Tuddenham, R. D., and Snyder, M. M. (1954) "Physical growth of California boys and girls from birth to age 18", University of California Publications in Child Development, 1, 183-364. } \seealso{ \code{\link{dataf.*}} for other functional data sets \code{\link{plot.functional}} for building plots of functional data } \examples{ ## load the Growth dataset dataf = dataf.growth() ## view the classes unique(dataf$labels) ## access the 5th point of the 2nd object dataf$dataf[[2]]$args[5] dataf$dataf[[2]]$vals[5] ## plot the data \dontrun{ labels = unlist(dataf$labels) plot(dataf, main = paste("Growth: girls red (", sum(labels == "girl"), "),", " boys blue (", sum(labels == "boy"), ")", sep=""), xlab="Year", ylab="Height, cm", colors = c("blue", "red") # in alphabetical order of class labels ) } } \keyword{datasets} \keyword{functional} ddalpha/man/plot.functional.Rd0000644000176200001440000000453514213423775016047 0ustar liggesusers\name{plot.functional} \alias{plot.functional} \alias{lines.functional} \alias{points.functional} \title{ Plot functions for the Functional Data } \description{ Plots the functional data given in the form which is described in the topic \code{\link{dataf.*}}. } \usage{ \method{plot}{functional}(x, main = "Functional data", xlab = "args", ylab = "vals", colors = c("red", "blue", "green", "black", "orange", "pink"), ...) \method{lines}{functional}(x, colors = c("red", "blue", "green", "black", "orange", "pink"), ...) \method{points}{functional}(x, colors = c("red", "blue", "green", "black", "orange", "pink"), ...) } \arguments{ \item{x}{ The functional data as in the topic \code{\link{dataf.*}}. Note, that the in order to use s3 methods the data must be of class "functional". } \item{main}{ an overall title for the plot: see \code{\link{title}} } \item{xlab}{ a title for the x axis: see \code{\link{title}} } \item{ylab}{ a title for the y axis: see \code{\link{title}} } \item{colors}{ the colors for the classes of the data. The colors are applied to the classes sorted in alphabetical order. Use the same set of classes to ensure that the same colours are selected in \code{lines} and \code{points} as in \code{plot} (do not remove entire classes). } \item{\dots}{ additional parameters } } \seealso{ \code{\link{dataf.*}} for functional data description } \examples{ \dontrun{ ## load the Growth dataset dataf = dataf.growth() labels = unlist(dataf$labels) plot(dataf, main = paste("Growth: girls red (", sum(labels == "girl"), "),", " boys blue (", sum(labels == "boy"), ")", sep=""), xlab="Year", ylab="Height, cm", colors = c("blue", "red") # in alphabetical order of class labels ) # plot an observation as a line observation = structure(list(dataf = list(dataf$dataf[[1]])), class = "functional") lines(observation, colors = "green", lwd = 3) # plot hight at the age of 14 indexAge14 = which(observation$dataf[[1]]$args == 14) hightAge14 = observation$dataf[[1]]$vals[indexAge14] atAge14 = structure(list( dataf = list(dataf = list(args = 14, vals = hightAge14)) ), class = "functional") points(atAge14, colors = "yellow", pch = 18) } } \keyword{ visualization } \keyword{ functional } ddalpha/man/depth.L2.Rd0000644000176200001440000000572514213423775014312 0ustar liggesusers\name{depth.L2} \alias{depth.L2} \title{ Calculate L2-Depth } \description{ Calculates the L2-depth of points w.r.t. a multivariate data set. } \usage{ depth.L2(x, data, mah.estimate = "moment", mah.parMcd = 0.75) } \arguments{ \item{x}{ Matrix of objects (numerical vector as one object) whose depth is to be calculated; each row contains a \eqn{d}-variate point. Should have the same dimension as \code{data}. } \item{data}{ Matrix of data where each row contains a \eqn{d}-variate point, w.r.t. which the depth is to be calculated. } \item{mah.estimate}{ is a character string specifying which estimates to use when calculating sample covariance matrix; can be \code{"none"}, \code{"moment"} or \code{"MCD"}, determining whether traditional moment or Minimum Covariance Determinant (MCD) (see \code{\link{covMcd}}) estimates for mean and covariance are used. By default \code{"moment"} is used. With \code{"none"} the non-affine invariant version of the L2-depth is calculated } \item{mah.parMcd}{ is the value of the argument \code{alpha} for the function \code{\link{covMcd}}; is used when \code{mah.estimate =} \code{"MCD"}. } } \details{ Calculates L2-depth (Mosler, 2013). L2-depth is based on the oultyingness distance calculated as the average L2-distance from (a row of) \code{x} to each point in \code{data}. } \value{ Numerical vector of depths, one for each row in \code{x}; or one depth value if \code{x} is a numerical vector. } \references{ Mosler, K. (2013). Depth statistics. In: Becker, C., Fried, R. and Kuhnt, S. (eds), \emph{Robustness and Complex Data Structures: Festschrift in Honour of Ursula Gather}, Springer-Verlag (Berlin, Heidelberg), 17--34. } \seealso{ \code{\link{depth.halfspace}} for calculation of the Tukey depth. \code{\link{depth.Mahalanobis}} for calculation of Mahalanobis depth. \code{\link{depth.projection}} for calculation of projection depth. \code{\link{depth.qhpeeling}} for calculation of convex hull peeling depth. \code{\link{depth.simplicial}} for calculation of simplicial depth. \code{\link{depth.simplicialVolume}} for calculation of simplicial volume depth. \code{\link{depth.spatial}} for calculation of spatial depth. \code{\link{depth.potential}} for calculation of data potential. \code{\link{depth.zonoid}} for calculation of zonoid depth. } \examples{ # 5-dimensional normal distribution data <- mvrnorm(1000, rep(0, 5), matrix(c(1, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 1), nrow = 5)) x <- mvrnorm(10, rep(1, 5), matrix(c(1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1), nrow = 5)) depths <- depth.spatial(x, data) cat("Depths:", depths, "\n") } \keyword{ robust } \keyword{ multivariate } \keyword{ nonparametric } ddalpha/man/depth.space.zonoid.Rd0000644000176200001440000000453014213423775016422 0ustar liggesusers\name{depth.space.zonoid} \alias{depth.space.zonoid} \title{ Calculate Depth Space using Zonoid Depth } \description{ Calculates the representation of the training classes in depth space using zonoid depth. } \usage{ depth.space.zonoid(data, cardinalities, seed = 0) } \arguments{ \item{data}{ Matrix containing training sample where each row is a \eqn{d}-dimensional object, and objects of each class are kept together so that the matrix can be thought of as containing blocks of objects representing classes. } \item{cardinalities}{ Numerical vector of cardinalities of each class in \code{data}, each entry corresponds to one class. } \item{seed}{ the random seed. The default value \code{seed=0} makes no changes. } } \details{ The depth representation is calculated in the same way as in \code{\link{depth.zonoid}}, see 'References' for more information and details. } \value{ Matrix of objects, each object (row) is represented via its depths (columns) w.r.t. each of the classes of the training sample; order of the classes in columns corresponds to the one in the argument \code{cardinalities}. } \references{ Dyckerhoff, R., Koshevoy, G., and Mosler, K. (1996). Zonoid data depth: theory and computation. In: Prat A. (ed), \emph{COMPSTAT 1996. Proceedings in computational statistics}, Physica-Verlag (Heidelberg), 235--240. Koshevoy, G. and Mosler, K. (1997). Zonoid trimming for multivariate distributions \emph{Annals of Statistics} \bold{25} 1998--2017. Mosler, K. (2002). \emph{Multivariate dispersion, central regions and depth: the lift zonoid approach} Springer (New York). } \seealso{ \code{\link{ddalpha.train}} and \code{\link{ddalpha.classify}} for application, \code{\link{depth.zonoid}} for calculation of zonoid depth. } \examples{ # Generate a bivariate normal location-shift classification task # containing 20 training objects class1 <- mvrnorm(10, c(0,0), matrix(c(1,1,1,4), nrow = 2, ncol = 2, byrow = TRUE)) class2 <- mvrnorm(10, c(2,2), matrix(c(1,1,1,4), nrow = 2, ncol = 2, byrow = TRUE)) data <- rbind(class1, class2) # Get depth space using zonoid depth depth.space.zonoid(data, c(10, 10)) data <- getdata("hemophilia") cardinalities = c(sum(data$gr == "normal"), sum(data$gr == "carrier")) depth.space.zonoid(data[,1:2], cardinalities) } \keyword{ robust } \keyword{ multivariate } \keyword{ nonparametric } ddalpha/man/compclassf.classify.Rd0000644000176200001440000000327514213423775016676 0ustar liggesusers\name{compclassf.classify} \alias{compclassf.classify} \alias{predict.compclassf} \title{ Classify using Functional Componentwise Classifier } \description{ Classifies data using the functional componentwise classifier. } \usage{ compclassf.classify(compclassf, objectsf, subset, ...) \method{predict}{compclassf}(object, objectsf, subset, ...) } \arguments{ \item{compclassf, object}{ Functional componentwise classifier (obtained by \code{\link{compclassf.train}}). } \item{objectsf}{list containing lists (functions) of two vectors of equal length, named "args" and "vals": arguments sorted in ascending order and corresponding them values respectively } \item{subset}{ an optional vector specifying a subset of observations to be classified. } \item{\dots}{ additional parameters, passed to the classifier, selected with parameter \code{classifier.type} in \code{\link{compclassf.train}}. } } \value{ List containing class labels. } \references{ Delaigle, A., Hall, P., and Bathia, N. (2012). Componentwise classification and clustering of functional data. \emph{Biometrika} \bold{99} 299--313. } \seealso{ \code{\link{compclassf.train}} to train the functional componentwise classifier. } \examples{ \dontrun{ ## load the Growth dataset dataf = dataf.growth() learn = c(head(dataf$dataf, 49), tail(dataf$dataf, 34)) labels =c(head(dataf$labels, 49), tail(dataf$labels, 34)) test = tail(head(dataf$dataf, 59), 10) # elements 50:59. 5 girls, 5 boys c = compclassf.train (learn, labels, classifier.type = "ddalpha") classified = compclassf.classify(c, test) print(unlist(classified)) } } \keyword{ functional } \keyword{ robust } \keyword{ multivariate } \keyword{ nonparametric } \keyword{ classif }ddalpha/man/dataf..Rd0000644000176200001440000000263414213423775014063 0ustar liggesusers\name{dataf.*} \alias{dataf.*} \docType{data} \title{ Functional Data Sets } \description{ The functions generate data sets of functional two-dimensional data of two or more classes. } \usage{ # dataf.[name]() # load the data set by name # data(list = "name") # load the data set by name to a variable # getdata("name") } \format{ The functional data as a data structure. \describe{ \item{\code{dataf}}{ The functional data as a list of objects. Each object is characterized by two coordinates \describe{ \item{\code{args}}{The arguments vector} \item{\code{vals}}{The values vector} } } \item{\code{labels}}{The classes of the objects} } } \details{ More details about the datasets in the topics: \code{\link{dataf.geneexp}} \code{\link{dataf.growth}} \code{\link{dataf.medflies}} \code{\link{dataf.population}} \code{\link{dataf.population2010}} \code{\link{dataf.tecator}} \code{\link{dataf.tecator}} The following datasets provide simulated data: \code{\link{dataf.sim.1.CFF07}} \code{\link{dataf.sim.2.CFF07}} } \seealso{ \code{\link{plot.functional}} for building plots of functional data } \examples{ ## load the Growth dataset dataf = dataf.growth() ## view the classes unique(dataf$labels) ## access the 5th point of the 2nd object dataf$dataf[[2]]$args[5] dataf$dataf[[2]]$vals[5] \dontrun{plot.functional(dataf)} } \keyword{datasets} \keyword{functional} ddalpha/man/ddalphaf.test.Rd0000644000176200001440000000426714213423775015453 0ustar liggesusers\name{ddalphaf.test} \alias{ddalphaf.test} \title{ Test Functional DD-Classifier } \description{ Trains functional DD-classifier on the learning sequence of the data and tests it on the testing sequence. } \usage{ ddalphaf.test(learn, learnlabels, test, testlabels, disc.type = c("LS", "comp"), ...) } \arguments{ \item{learn}{ list containing lists (functions) of two vectors of equal length, named "args" and "vals": arguments sorted in ascending order and corresponding them values respectively } \item{learnlabels}{ list of output labels of the functional observations } \item{test}{ the testing sequence. Has the same format as \code{learn} } \item{disc.type}{ type of the used discretization scheme. "LS" for \code{\link{ddalphaf.train}}, "comp" for for \code{\link{compclassf.train}} } \item{testlabels}{ list of output labels of the functinal observations } \item{\dots}{ additional parameters passed to \code{\link{ddalphaf.train}} } } \value{ \item{error}{ the part of incorrectly classified data } \item{correct}{ the number of correctly classified objects } \item{incorrect}{ the number of incorrectly classified objects } \item{total}{ the number of classified objects } \item{ignored}{ the number of ignored objects (outside the convex hull of the learning data) } \item{n}{ the number of objects in the testing sequence } \item{time}{ training time } } \seealso{ \code{\link{ddalphaf.train}} to train the functional DD\eqn{\alpha}-classifier, \code{\link{ddalphaf.classify}} for classification using functonal DD\eqn{\alpha}-classifier, \code{\link{ddalphaf.getErrorRateCV}} and \code{\link{ddalphaf.getErrorRatePart}} to get error rate of the functional DD-classifier on particular data. } \examples{ # load the fdata df = dataf.growth() samp = c(35:70) ddalphaf.test(learn = df$dataf[-samp], learnlabels = df$labels[-samp], test = df$dataf[samp], testlabels = df$labels[samp], adc.args = list(instance = "avr", numFcn = 2, numDer = 2)) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ benchmark } ddalpha/man/L2metric.Rd0000644000176200001440000000346514550236314014405 0ustar liggesusers\name{L2metric} \alias{L2metric} \title{Fast Computation of the \eqn{L^2} Metric for Sets of Functional Data} \usage{ L2metric(A, B) } \arguments{ \item{A}{Functions of the first set, represented by a matrix of their functional values of size \code{m*d}. \code{m} stands for the number of functions, \code{d} is the number of the equi-distant points \{1,...,d\} in the domain of the data [1,d] at which the functional values of the \code{m} functions are evaluated.} \item{B}{Functions of the second set, represented by a matrix of their functional values of size \code{n*d}. \code{n} stands for the number of functions, \code{d} is the number of the equi-distant points \{1,...,d\} in the domain of the data [1,d] at which the functional values of the \code{n} functions are evaluated. The grid of observation points for the functions \code{A} and \code{B} must be the same.} } \value{ A symmetric matrix of the distances of the functions of size \code{m*n}. } \description{ Returns the matrix of \eqn{L^2} distances between two sets of functional data. } \details{ For two sets of functional data of sizes \code{m} and \code{n} represented by matrices of their functional values on the common domain \{1,...,d\}, this function returns the symmetric matrix of size \code{m*n} whose entry in the \code{i}-th row and \code{j}-th column is the approximated \eqn{L^2} distance of the \code{i}-th function from the first set, and the \code{j}-th function from the second set. This function is utilized in the computation of the h-mode depth. } \examples{ datapop = dataf2rawfd(dataf.population()$dataf,range=c(1950,2015),d=66) A = datapop[1:20,] B = datapop[21:50,] L2metric(A,B) } \seealso{ \code{\link{depthf.hM}} \code{\link{dataf2rawfd}} } \author{ Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} } \keyword{functional} \keyword{metric} ddalpha/man/dataf.population2010.Rd0000644000176200001440000000356514213423775016505 0ustar liggesusers\docType{data} \name{dataf.population2010} \alias{dataf.population2010} \alias{population2010} \title{World Historical Population-by-Country Dataset (2010 Revision)} \format{ The functional data as a data structure. \describe{ \item{\code{dataf}}{ The functional data as a list of objects. Each object is characterized by two coordinates \describe{ \item{\code{args}}{\bold{year} - a numeric vector of years 1950-2010 (61 years)} \item{\code{vals}}{\bold{population} - a numeric vector of the estimated total population in thousands in 233 countries and regions} } } \item{\code{labels}}{The geographic region of the country} \item{\code{identifier}}{The name of country or region} } } \source{ United Nations, Department of Economic and Social Affairs, Population Division, \url{https://esa.un.org/unpd/wpp/Download/Standard/Population/}, file \code{Total population - Both sexes} } \usage{ dataf.population2010() } \description{ Historical world population data by countries. } \details{ World population data by a country, area or region as of 1 July of the year indicated. Figures are presented in thousands. } \examples{ ## load the Population dataset dataf = dataf.population2010() ## view the classes unique(dataf$labels) ## access the 5th point of the 2nd object dataf$dataf[[2]]$args[5] dataf$dataf[[2]]$vals[5] ## plot the data ## Not run: labels = unlist(dataf$labels) plot(dataf, main = "World population data", xlab="Year", ylab="Population (in thousands)" ) ## End(Not run) ## compute the integrated and infimal depths of the data curves ## with respect to the same set of curves depthf.fd1(dataf$dataf, dataf$dataf) } \seealso{ \code{\link{dataf.population}} \code{\link{dataf.*}} for other functional data sets \code{\link{plot.functional}} for building plots of functional data } \keyword{datasets} \keyword{functional} ddalpha/man/depthf.HR.Rd0000644000176200001440000000356714216410624014506 0ustar liggesusers\name{depthf.HR} \alias{depthf.HR} \title{Half-Region Depth for Functional Data} \usage{ depthf.HR(datafA, datafB, range = NULL, d = 101) } \arguments{ \item{datafA}{Functions whose depth is computed, represented by a \code{dataf} object of their arguments and functional values. \code{m} stands for the number of functions.} \item{datafB}{Random sample functions with respect to which the depth of \code{datafA} is computed. \code{datafB} is represented by a \code{dataf} object of their arguments and functional values. \code{n} is the sample size. The grid of observation points for the functions \code{datafA} and \code{datafB} may not be the same.} \item{range}{The common range of the domain where the functions \code{datafA} and \code{datafB} are observed. Vector of length 2 with the left and the right end of the interval. Must contain all arguments given in \code{datafA} and \code{datafB}.} \item{d}{Grid size to which all the functional data are transformed. For depth computation, all functional observations are first transformed into vectors of their functional values of length \code{d} corresponding to equi-spaced points in the domain given by the interval \code{range}. Functional values in these points are reconstructed using linear interpolation, and extrapolation.} } \value{ A vector of length \code{m} of the half-region depth values. } \description{ The half-region depth for functional real-valued data. } \details{ The function returns the vector of the sample half-region depth values. } \examples{ datafA = dataf.population()$dataf[1:20] datafB = dataf.population()$dataf[21:50] depthf.HR(datafA,datafB) } \references{ Lopez-Pintado, S. and Romo, J. (2011). A half-region depth for functional data. \emph{Computational Statistics & Data Analysis} \bold{55} (4), 1679--1695. } \author{ Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} } \keyword{depth} \keyword{functional} ddalpha/man/depth.space.simplicialVolume.Rd0000644000176200001440000000660114213423775020437 0ustar liggesusers\name{depth.space.simplicialVolume} \alias{depth.space.simplicialVolume} \title{ Calculate Depth Space using Simplicial Volume Depth } \description{ Calculates the representation of the training classes in depth space using simplicial volume depth. } \usage{ depth.space.simplicialVolume(data, cardinalities, exact = F, k = 0.05, mah.estimate = "moment", mah.parMcd = 0.75, seed = 0) } \arguments{ \item{data}{ Matrix containing training sample where each row is a \eqn{d}-dimensional object, and objects of each class are kept together so that the matrix can be thought of as containing blocks of objects representing classes. } \item{cardinalities}{ Numerical vector of cardinalities of each class in \code{data}, each entry corresponds to one class. } \item{exact}{ \code{exact=F} (by default) implies the approximative algorithm, considering \code{k} simplices, \code{exact=T} implies the exact algorithm. } \item{k}{ Number (\eqn{k>1}) or portion (if \eqn{01}, then the algorithmic complexity is polynomial in \eqn{d} but is independent of the number of observations in \code{data}, given \eqn{k}. If \eqn{01}) or portion (if \eqn{01}, then the algorithmic complexity is polynomial in \eqn{d} but is independent of the number of observations in \code{data}, given \eqn{k}. If \eqn{0 Pavlo Mozharovskyi, Rainer Dyckerhoff, Stanislav Nagy, } \references{ Pokotylo, O., Mozharovskyi, P., Dyckerhoff, R. (2019). Depth and depth-based classification with R-package ddalpha. \emph{Journal of Statistical Software} \bold{91} 1--46. Lange, T., Mosler, K., and Mozharovskyi, P. (2014). Fast nonparametric classification based on data depth. \emph{Statistical Papers} \bold{55} 49--69. Lange, T., Mosler, K., and Mozharovskyi, P. (2014). DD\eqn{\alpha}-classification of asymmetric and fat-tailed data. In: Spiliopoulou, M., Schmidt-Thieme, L., Janning, R. (eds), \emph{Data Analysis, Machine Learning and Knowledge Discovery}, Springer (Berlin), 71--78. Mosler, K. and Mozharovskyi, P. (2017). Fast DD-classification of functional data. \emph{Statistical Papers} \bold{58} 1055--1089. Mozharovskyi, P. (2015). \emph{Contributions to Depth-based Classification and Computation of the Tukey Depth}. Verlag Dr. Kovac (Hamburg). Mozharovskyi, P., Mosler, K., and Lange, T. (2015). Classifying real-world data with the DD\eqn{\alpha}-procedure. \emph{Advances in Data Analysis and Classification} \bold{9} 287--314. Nagy, S., Gijbels, I. and Hlubinka, D. (2017). Depth-based recognition of shape outlying functions. \emph{Journal of Computational and Graphical Statistics}. To appear. } \keyword{ package } \keyword{ robust } \keyword{ multivariate } \keyword{ functional } \keyword{ nonparametric } \keyword{ classif } \seealso{ \code{\link{ddalpha.train}}, \code{\link{ddalpha.classify}}, \code{\link{ddalphaf.train}}, \code{\link{ddalphaf.classify}}, \code{\link{compclassf.train}}, \code{\link{compclassf.classify}} \code{\link{depth.}}, \code{\link{depthf.}}, \code{\link{depth.space.}}, \code{\link{is.in.convex}}, \code{\link{getdata}}, \code{\link{dataf.*}}, \code{\link{plot.ddalpha}}, \code{\link{plot.ddalphaf}}, \code{\link{plot.functional}}, \code{\link{depth.graph}}, \code{\link{draw.ddplot}}. } \examples{ # Generate a bivariate normal location-shift classification task # containing 200 training objects and 200 to test with class1 <- mvrnorm(200, c(0,0), matrix(c(1,1,1,4), nrow = 2, ncol = 2, byrow = TRUE)) class2 <- mvrnorm(200, c(2,2), matrix(c(1,1,1,4), nrow = 2, ncol = 2, byrow = TRUE)) trainIndices <- c(1:100) testIndices <- c(101:200) propertyVars <- c(1:2) classVar <- 3 trainData <- rbind(cbind(class1[trainIndices,], rep(1, 100)), cbind(class2[trainIndices,], rep(2, 100))) testData <- rbind(cbind(class1[testIndices,], rep(1, 100)), cbind(class2[testIndices,], rep(2, 100))) data <- list(train = trainData, test = testData) # Train the DDalpha-classifier ddalpha <- ddalpha.train(data$train) # Classify by means of DDalpha-classifier classes <- ddalpha.classify(ddalpha, data$test[,propertyVars]) cat("Classification error rate:", sum(unlist(classes) != data$test[,classVar])/200, "\n") # Calculate zonoid depth of top 10 testing objects w.r.t. 1st class depths.zonoid <- depth.zonoid(data$test[1:10,propertyVars], data$train[trainIndices,propertyVars]) cat("Zonoid depths:", depths.zonoid, "\n") # Calculate the random Tukey depth of top 10 testing objects w.r.t. 1st class depths.halfspace <- depth.halfspace(data$test[1:10,propertyVars], data$train[trainIndices,propertyVars]) cat("Random Tukey depths:", depths.halfspace, "\n") # Calculate depth space with zonoid depth dspace.zonoid <- depth.space.zonoid(data$train[,propertyVars], c(100, 100)) # Calculate depth space with the exact Tukey depth dspace.halfspace <- depth.space.halfspace(data$train[,propertyVars], c(100, 100), exact = TRUE) # Count outsiders numOutsiders = sum(rowSums(is.in.convex(data$test[,propertyVars], data$train[,propertyVars], c(100, 100))) == 0) cat(numOutsiders, "outsiders found in the testing sample.\n") } ddalpha/man/ddalpha.getErrorRateCV.Rd0000644000176200001440000000472414213423775017162 0ustar liggesusers\name{ddalpha.getErrorRateCV} \alias{ddalpha.getErrorRateCV} \title{ Test DD-Classifier } \description{ Performs a cross-validation procedure over the given data. On each step every \code{numchunks} observation is removed from the data, the DD-classifier is trained on these data and tested on the removed observations. } \usage{ ddalpha.getErrorRateCV (data, numchunks = 10, ...) } \arguments{ \item{data}{ Matrix containing training sample where each of \eqn{n} rows is one object of the training sample where first \eqn{d} entries are inputs and the last entry is output (class label). } \item{numchunks}{ number of subsets of testing data. Equals to the number of times the classifier is trained. } \item{\dots}{ additional parameters passed to \code{\link{ddalpha.train}} } } \value{ \item{errors}{ the part of incorrectly classified data } \item{time}{ the mean training time } \item{time_sd}{ the standard deviation of training time } } \seealso{ \code{\link{ddalpha.train}} to train the DD\eqn{\alpha}-classifier, \code{\link{ddalpha.classify}} for classification using DD\eqn{\alpha}-classifier, \code{\link{ddalpha.test}} to test the DD-classifier on particular learning and testing data, \code{\link{ddalpha.getErrorRatePart}} to perform a benchmark study of the DD-classifier on particular data. } \examples{ # Generate a bivariate normal location-shift classification task # containing 200 training objects and 200 to test with class1 <- mvrnorm(150, c(0,0), matrix(c(1,1,1,4), nrow = 2, ncol = 2, byrow = TRUE)) class2 <- mvrnorm(150, c(2,2), matrix(c(1,1,1,4), nrow = 2, ncol = 2, byrow = TRUE)) propertyVars <- c(1:2) classVar <- 3 data <- rbind(cbind(class1, rep(1, 150)), cbind(class2, rep(2, 150))) # Train 1st DDalpha-classifier (default settings) # and get the classification error rate stat <- ddalpha.getErrorRateCV(data, numchunks = 5) cat("1. Classification error rate (defaults): ", stat$error, ".\n", sep = "") # Train 2nd DDalpha-classifier (zonoid depth, maximum Mahalanobis # depth classifier with defaults as outsider treatment) # and get the classification error rate stat2 <- ddalpha.getErrorRateCV(data, depth = "zonoid", outsider.methods = "depth.Mahalanobis") cat("2. Classification error rate (depth.Mahalanobis): ", stat2$error, ".\n", sep = "") } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ benchmark } ddalpha/man/depth.simplicialVolume.Rd0000644000176200001440000000741214213423775017346 0ustar liggesusers\name{depth.simplicialVolume} \alias{depth.simplicialVolume} \title{ Calculate Simplicial Volume Depth } \description{ Calculates the simpicial volume depth of points w.r.t. a multivariate data set. } \usage{ depth.simplicialVolume(x, data, exact = F, k = 0.05, mah.estimate = "moment", mah.parMcd = 0.75, seed = 0) } \arguments{ \item{x}{ Matrix of objects (numerical vector as one object) whose depth is to be calculated; each row contains a \eqn{d}-variate point. Should have the same dimension as \code{data}. } \item{data}{ Matrix of data where each row contains a \eqn{d}-variate point, w.r.t. which the depth is to be calculated. } \item{exact}{ \code{exact=F} (by default) implies the approximative algorithm, considering \code{k} simplices, \code{exact=T} implies the exact algorithm. } \item{k}{ Number (\eqn{k>1}) or portion (if \eqn{01}, then the algorithmic complexity is polynomial in \eqn{d} but is independent of the number of observations in \code{data}, given \eqn{k}. If \eqn{00}, and smaller than the total number of points in the two smallest classes when \code{aggregation.method =} \code{"majority"} and smaller than the total number of points in the training sample when \code{aggregation.method =} \code{"sequent"}. The default value is 10. } } } \subsection{polynomial}{ Trains the polynomial DD-classifier (Li, Cuesta-Albertos and Liu, 2012). The DD-classifier constructs a polynomial separating rule in the depth space; the degree of the polynomial is determined via cross-validation (in the depth space). The additional parameters: \describe{ \item{max.degree}{ Maximum of the range of degrees of the polynomial over which the separator is to be cross-validated; can be in [1:10], the default value is 3. } \item{num.chunks}{ Number of chunks to split data into when cross-validating the separator; should be \eqn{>0}, and smaller than the total number of points in the two smallest classes when \code{aggregation.method =} \code{"majority"} and smaller than the total number of points in the training sample when \code{aggregation.method =} \code{"sequent"}. The default value is 10. } } } \subsection{knnlm}{ Trains the \code{k}-nearest neighbours classifier in the depth space. The additional parameters: \describe{ \item{knnrange}{ The maximal number of neighbours for kNN separation. The value is bounded by \eqn{2} and \eqn{n/2}. \code{NULL} for the default value \eqn{10*(n^{1/q})+1}, where \eqn{n} is the number of objects, \eqn{q} is the number of classes. \code{"MAX"} for the maximum value \eqn{n/2} } } } \subsection{maxD}{ The \code{maximum depth} separator classifies an object to the class that provides it the largest depth value. } } \subsection{Outsider treatment}{ An outsider treatment is a supplementary classifier for data that lie outside the convex hulls of all \eqn{q} training classes. Available methods are: Linear Discriminant Analysis (referred to as "LDA"), see \code{\link{lda}}; \eqn{k}-Nearest-Neighbor Classifier ("kNN"), see \code{\link{knn}}, \code{\link{knn.cv}}; Affine-Invariant kNN ("kNNAff"), an affine-invariant version of the kNN, suited only for binary classification (some aggregation is used with multiple classes) and not accounting for ties (at all), but very fast by that; Maximum Mahalanobis Depth Classifier ("depth.Mahalanobis"), the outsider is referred to a class w.r.t. which it has the highest depth value scaled by (approximated) priors; Proportional Randomization ("RandProp"), the outsider is referred to a class randomly with probability equal to it (approximated) prior; Equal Randomization ("RandEqual"), the outsider is referred to a class randomly, chances for each class are equal; Ignoring ("Ignore"), the outsider is not classified, the string "Ignored" is returned instead. An outsider treatment is specified by a list containing a name and parameters: \code{name} is a character string, name of the outsider treatment to be freely specified; should be unique; is obligatory. \code{method} is a character string, name of the method to use, can be \code{"LDA"}, \code{"kNN"}, \code{"kNNAff"}, \code{"depth.Mahalanobis"}, \code{"RandProp"}, \code{"RandEqual"} and \code{"Ignore"}; is obligatory. \code{priors} is a numerical vector specifying prior probabilities of classes; class portions in the training sample are used by the default. \code{priors} is used in methods "LDA", "depth.Mahalanobis" and "RandProp". \code{knn.k} is the number of the nearest neighbors taken into account; can be between \eqn{1} and the number of points in the training sample. Set to \eqn{-1} (the default) to be determined by the leave-one-out cross-validation. \code{knn.k} is used in method "kNN". \code{knn.range} is the upper bound on the range over which the leave-one-out cross-validation is performed (the lower bound is \eqn{1}); can be between \eqn{2} and the number of points in the training sample \eqn{-1}. Set to \eqn{-1} (the default) to be calculated automatically accounting for number of points and dimension. \code{knn.range} is used in method "kNN". \code{knnAff.methodAggregation} is a character string specifying the aggregation technique for method "kNNAff"; works in the same way as the function argument \code{aggregation.method}. \code{knnAff.methodAggregation} is used in method "kNNAff". \code{knnAff.k} is the number of the nearest neighbors taken into account; should be at least \eqn{1} and up to the number of points in the training sample when \code{knnAff.methodAggregation =} \code{"sequent"}, and up to the total number of points in the training sample when \code{knnAff.methodAggregation =} \code{"majority"}. Set to \eqn{-1} (the default) to be determined by the leave-one-out cross-validation. \code{knnAff.k} is used in method "kNNAff". \code{knnAff.range} is the upper bound on the range over which the leave-one-out cross-validation is performed (the lower bound is \eqn{1}); should be \eqn{>1} and smaller than the total number of points in the two smallest classes when \code{knnAff.methodAggregation =} \code{"majority"}, and \eqn{>1} and smaller than the total number of points in the training sample when \code{knnAff.methodAggregation =} \code{"sequent"}. Set to \eqn{-1} to be calculated automatically accounting for number of points and dimension. \code{knnAff.range} is used in method "kNNAff". \code{mah.estimate} is a character string specifying which estimates to use when calculating the Mahalanobis depth; can be \code{"moment"} or \code{"MCD"}, determining whether traditional moment or Minimum Covariance Determinant (MCD) (see \code{\link{covMcd}}) estimates for mean and covariance are used. \code{mah.estimate} is used in method "depth.Mahalanobis". \code{mcd.alpha} is the value of the argument \code{alpha} for the function \code{\link{covMcd}}; is used in method "depth.Mahalanobis" when \code{mah.estimate =} \code{"MCD"}. } } \value{ Trained DD\eqn{\alpha}-classifier containing following - rather informative - fields: \item{num.points}{Total number of points in the training sample.} \item{dimension}{Dimension of the original space.} \item{depth}{Character string determining which depth notion to use.} \item{methodAggregation}{Character string determining which method to apply to aggregate binary classification results.} \item{num.chunks}{Number of chunks data has been split into when cross-validating the \eqn{\alpha}-procedure.} \item{num.directions}{Number of directions used for approximating the Tukey depth (when it is used).} \item{use.convex}{Logical variable indicating whether outsiders should be determined exactly when classifying.} \item{max.degree}{Maximum of the range of degrees of the polynomial depth space extension over which the \eqn{\alpha}-procedure has been cross-validated.} \item{patterns}{Classes of the training sample.} \item{num.classifiers}{Number of binary classifiers trained.} \item{outsider.methods}{Treatments to be used to classify outsiders.} } \references{ Dyckerhoff, R., Koshevoy, G., and Mosler, K. (1996). Zonoid data depth: theory and computation. In: Prat A. (ed), \emph{COMPSTAT 1996. Proceedings in computational statistics}, Physica-Verlag (Heidelberg), 235--240. Lange, T., Mosler, K., and Mozharovskyi, P. (2014). Fast nonparametric classification based on data depth. \emph{Statistical Papers} \bold{55} 49--69. Li, J., Cuesta-Albertos, J.A., and Liu, R.Y. (2012). DD-classifier: Nonparametric classification procedure based on DD-plot. \emph{Journal of the American Statistical Association} \bold{107} 737--753. Mozharovskyi, P. (2015). \emph{Contributions to Depth-based Classification and Computation of the Tukey Depth}. Verlag Dr. Kovac (Hamburg). Mozharovskyi, P., Mosler, K., and Lange, T. (2015). Classifying real-world data with the DD\eqn{\alpha}-procedure. \emph{Advances in Data Analysis and Classification} \bold{9} 287--314. Vasil'ev, V.I. (2003). The reduction principle in problems of revealing regularities I. \emph{Cybernetics and Systems Analysis} \bold{39} 686--694. } \seealso{ \code{\link{ddalpha.classify}} for classification using DD-classifier, \code{\link{depth.}} for calculation of depths, \code{\link{depth.space.}} for calculation of depth spaces, \code{\link{is.in.convex}} to check whether a point is not an outsider. } \examples{ # Generate a bivariate normal location-shift classification task # containing 200 training objects and 200 to test with class1 <- mvrnorm(200, c(0,0), matrix(c(1,1,1,4), nrow = 2, ncol = 2, byrow = TRUE)) class2 <- mvrnorm(200, c(2,2), matrix(c(1,1,1,4), nrow = 2, ncol = 2, byrow = TRUE)) trainIndices <- c(1:100) testIndices <- c(101:200) propertyVars <- c(1:2) classVar <- 3 trainData <- rbind(cbind(class1[trainIndices,], rep(1, 100)), cbind(class2[trainIndices,], rep(2, 100))) testData <- rbind(cbind(class1[testIndices,], rep(1, 100)), cbind(class2[testIndices,], rep(2, 100))) data <- list(train = trainData, test = testData) # Train 1st DDalpha-classifier (default settings) # and get the classification error rate ddalpha1 <- ddalpha.train(data$train) classes1 <- ddalpha.classify(ddalpha1, data$test[,propertyVars]) cat("1. Classification error rate (defaults): ", sum(unlist(classes1) != data$test[,classVar])/200, ".\n", sep = "") # Train 2nd DDalpha-classifier (zonoid depth, maximum Mahalanobis # depth classifier with defaults as outsider treatment) # and get the classification error rate ddalpha2 <- ddalpha.train(data$train, depth = "zonoid", outsider.methods = "depth.Mahalanobis") classes2 <- ddalpha.classify(ddalpha2, data$test[,propertyVars], outsider.method = "depth.Mahalanobis") cat("2. Classification error rate (depth.Mahalanobis): ", sum(unlist(classes2) != data$test[,classVar])/200, ".\n", sep = "") # Train 3rd DDalpha-classifier (100 random directions for the Tukey depth, # adjusted maximum Mahalanobis depth classifier # and equal randomization as outsider treatments) # and get the classification error rates treatments <- list(list(name = "mahd1", method = "depth.Mahalanobis", mah.estimate = "MCD", mcd.alpha = 0.75, priors = c(1, 1)/2), list(name = "rand1", method = "RandEqual")) ddalpha3 <- ddalpha.train(data$train, outsider.settings = treatments, num.direction = 100) classes31 <- ddalpha.classify(ddalpha3, data$test[,propertyVars], outsider.method = "mahd1") classes32 <- ddalpha.classify(ddalpha3, data$test[,propertyVars], outsider.method = "rand1") cat("3. Classification error rate (by treatments):\n") cat(" Error (mahd1): ", sum(unlist(classes31) != data$test[,classVar])/200, ".\n", sep = "") cat(" Error (rand1): ", sum(unlist(classes32) != data$test[,classVar])/200, ".\n", sep = "") # Train using some weird formula ddalpha = ddalpha.train( I(mpg >= 19.2) ~ log(disp) + I(disp^2) + disp + I(disp * drat), data = mtcars, subset = (carb!=1), depth = "Mahalanobis", separator = "alpha") print(ddalpha) # make sure that the resulting table is what you wanted CC = ddalpha.classify(ddalpha, mtcars) sum((mtcars$mpg>=19.2)!= unlist(CC))/nrow(mtcars) # error rate #Use the pre-calculated DD-plot data = cbind(rbind(mvrnorm(n = 50, mu = c(0,0), Sigma = diag(2)), mvrnorm(n = 50, mu = c(5,10), Sigma = diag(2)), mvrnorm(n = 50, mu = c(10,0), Sigma = diag(2))), rep(c(1,2,3), each = 50)) plot(data[,1:2], col = (data[,3]+1)) ddplot = depth.space.Mahalanobis(data = data[,1:2], cardinalities = c(50,50,50)) ddplot = cbind(ddplot, data[,3]) ddalphaD = ddalpha.train(data = ddplot, depth = "ddplot", separator = "alpha") c = ddalpha.classify(ddalphaD, ddplot[,1:3]) errors = sum(unlist(c) != data[,3])/nrow(data) print(paste("Error rate: ",errors)) ddalpha = ddalpha.train(data = data, depth = "Mahalanobis", separator = "alpha") c = ddalpha.classify(ddalpha, data[,1:2]) errors = sum(unlist(c) != data[,3])/nrow(data) print(paste("Error rate: ",errors)) } \keyword{ robust } \keyword{ multivariate } \keyword{ nonparametric } \keyword{ classif } ddalpha/man/ddalpha.classify.Rd0000644000176200001440000001023414213423775016132 0ustar liggesusers\name{ddalpha.classify} \alias{ddalpha.classify} \alias{predict.ddalpha} \title{ Classify using DD-Classifier } \description{ Classifies data using the DD-classifier and a specified outsider treatment. } \usage{ ddalpha.classify(ddalpha, objects, subset, outsider.method = NULL, use.convex = NULL) \method{predict}{ddalpha}(object, objects, subset, outsider.method = NULL, use.convex = NULL, ...) } \arguments{ \item{ddalpha, object}{ DD\eqn{\alpha}-classifier (obtained by \code{\link{ddalpha.train}}). } \item{objects}{ Matrix containing objects to be classified; each row is one \eqn{d}-dimensional object. } \item{subset}{ an optional vector specifying a subset of observations to be classified. } \item{outsider.method}{ Character string, name of a treatment to be used for outsiders; one of those trained by \code{\link{ddalpha.train}}. If the treatment was specified using the argument \code{outsider.methods} then use the name of the method. } \item{use.convex}{ Logical variable indicating whether outsiders should be determined as the points not contained in any of the convex hulls of the classes from the training sample (\code{TRUE}) or those having zero depth w.r.t. each class from the training sample (\code{FALSE}). For \code{depth =} \code{"zonoid"} both values give the same result. If \code{NULL} the value specified in DD\eqn{\alpha}-classifier (in \code{\link{ddalpha.train}}) is used. } \item{\dots}{ additional parameters are ignored } } \details{ Only one outsider treatment can be specified. See Lange, Mosler and Mozharovskyi (2014) for details and additional information. } \value{ List containing class labels, or character string "Ignored" for the outsiders if "Ignore" was specified as the outsider treating method. } \references{ Dyckerhoff, R., Koshevoy, G., and Mosler, K. (1996). Zonoid data depth: theory and computation. In: Prat A. (ed), \emph{COMPSTAT 1996. Proceedings in computational statistics}, Physica-Verlag (Heidelberg), 235--240. Lange, T., Mosler, K., and Mozharovskyi, P. (2014). Fast nonparametric classification based on data depth. \emph{Statistical Papers} \bold{55} 49--69. Li, J., Cuesta-Albertos, J.A., and Liu, R.Y. (2012). DD-classifier: Nonparametric classification procedure based on DD-plot. \emph{Journal of the American Statistical Association} \bold{107} 737--753. Mozharovskyi, P. (2015). \emph{Contributions to Depth-based Classification and Computation of the Tukey Depth}. Verlag Dr. Kovac (Hamburg). Mozharovskyi, P., Mosler, K., and Lange, T. (2015). Classifying real-world data with the DD\eqn{\alpha}-procedure. \emph{Advances in Data Analysis and Classification} \bold{9} 287--314. Vasil'ev, V.I. (2003). The reduction principle in problems of revealing regularities I. \emph{Cybernetics and Systems Analysis} \bold{39} 686--694. } \seealso{ \code{\link{ddalpha.train}} to train the DD-classifier. } \examples{ # Generate a bivariate normal location-shift classification task # containing 200 training objects and 200 to test with class1 <- mvrnorm(200, c(0,0), matrix(c(1,1,1,4), nrow = 2, ncol = 2, byrow = TRUE)) class2 <- mvrnorm(200, c(2,2), matrix(c(1,1,1,4), nrow = 2, ncol = 2, byrow = TRUE)) trainIndices <- c(1:100) testIndices <- c(101:200) propertyVars <- c(1:2) classVar <- 3 trainData <- rbind(cbind(class1[trainIndices,], rep(1, 100)), cbind(class2[trainIndices,], rep(2, 100))) testData <- rbind(cbind(class1[testIndices,], rep(1, 100)), cbind(class2[testIndices,], rep(2, 100))) data <- list(train = trainData, test = testData) # Train the DDalpha-Classifier (zonoid depth, maximum Mahalanobis depth # classifier with defaults as outsider treatment) ddalpha <- ddalpha.train(data$train, depth = "zonoid", outsider.methods = "depth.Mahalanobis") # Get the classification error rate classes <- ddalpha.classify(data$test[,propertyVars], ddalpha, outsider.method = "depth.Mahalanobis") cat("Classification error rate: ", sum(unlist(classes) != data$test[,classVar])/200, ".\n", sep="") } \keyword{ robust } \keyword{ multivariate } \keyword{ nonparametric } \keyword{ classif } ddalpha/man/draw.ddplot.Rd0000644000176200001440000000361214213423775015145 0ustar liggesusers\name{draw.ddplot} \alias{draw.ddplot} \title{ Draw \emph{DD}-Plot } \description{ The function draws the \emph{DD}-plot either of the existing DD\eqn{\alpha}-classifier of the depth space. Also accessible from \code{\link{plot.ddalpha}}. } \usage{ draw.ddplot(ddalpha, depth.space, cardinalities, main = "DD plot", xlab = "C1", ylab = "C2", xlim, ylim, classes = c(1, 2), colors = c("red", "blue", "green"), drawsep = T) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{ddalpha}{ DD\eqn{\alpha}-classifier (obtained by \code{\link{ddalpha.train}}). } \item{depth.space}{ The ready depth space obtained by \code{\link{depth.space.}}} \item{cardinalities}{ Numerical vector of cardinalities of each class in \code{data}, each entry corresponds to one class. } \item{main}{ an overall title for the plot: see \code{\link{title}} } \item{xlab, ylab}{ class labels } \item{xlim, ylim}{ range of axis } \item{classes}{ vector of numbers of two classes used for depth calculation } \item{colors}{ vector of the classes' colors } \item{drawsep}{ draws the separation on the DD-plot (currently for 2 classes and not for knn) } } \seealso{ \code{\link{ddalpha.train}} \code{\link{depth.space.}} } \examples{ data = getdata("kidney") #1. using the existing ddalpha classifier ddalpha = ddalpha.train(data, depth = "spatial") draw.ddplot(ddalpha, main = "DD-plot") #2. using depth.space. # Sort the data w.r.t. classes data = rbind(data[data$C == 1,], data[data$C == 2,]) cardinalities = c(sum(data$C == 1), sum(data$C == 2)) dspace = depth.space.spatial(data[,-6], cardinalities = cardinalities) draw.ddplot(depth.space = dspace, cardinalities = cardinalities, main = "DD-plot", xlab = 1, ylab = 2) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ visualization } ddalpha/man/is.in.convex.Rd0000644000176200001440000000534614213423775015252 0ustar liggesusers\name{is.in.convex} \alias{is.in.convex} \title{ Check Outsiderness } \description{ Checks the belonging to at least one of class convex hulls of the training sample. } \usage{ is.in.convex(x, data, cardinalities, seed = 0) } \arguments{ \item{x}{ Matrix of objects (numerical vector as one object) whose belonging to convex hulls is to be checked; each row contains a \eqn{d}-variate point. Should have the same dimension as \code{data}. } \item{data}{ Matrix containing training sample where each row is a \eqn{d}-dimensional object, and objects of each class are kept together so that the matrix can be thought of as containing blocks of objects, representing classes. } \item{cardinalities}{ Numerical vector of cardinalities of each class in \code{data}, each entry corresponds to one class. } \item{seed}{ the random seed. The default value \code{seed=0} makes no changes. } } \details{ Checks are conducted w.r.t. each separate class in \code{data} using the simplex algorithm, taken from the C++ implementation of the zonoid depth calculation by Rainer Dyckerhoff. } \value{ Matrix of \code{number of objects} rows and \code{number of classes} columns, containing \code{1} if an object belongs to the convex hull of the corresponding class, and \code{0} otherwise. } \references{ Dyckerhoff, R., Koshevoy, G., and Mosler, K. (1996). Zonoid data depth: theory and computation. In: Prat A. (ed), \emph{COMPSTAT 1996. Proceedings in computational statistics}, Physica-Verlag (Heidelberg), 235--240. } \author{ Implementation of the simplex algorithm is taken from the algorithm for computation of zonoid depth (Dyckerhoff, Koshevoy and Mosler, 1996) that has been implemented in C++ by Rainer Dyckerhoff. } \seealso{ \code{\link{ddalpha.train}} and \code{\link{ddalpha.classify}} for application. } \examples{ # Generate a bivariate normal location-shift classification task # containing 400 training objects and 1000 to test with class1 <- mvrnorm(700, c(0,0), matrix(c(1,1,1,4), nrow = 2, ncol = 2, byrow = TRUE)) class2 <- mvrnorm(700, c(2,2), matrix(c(1,1,1,4), nrow = 2, ncol = 2, byrow = TRUE)) trainIndices <- c(1:200) testIndices <- c(201:700) propertyVars <- c(1:2) classVar <- 3 trainData <- rbind(cbind(class1[trainIndices,], rep(1, 200)), cbind(class2[trainIndices,], rep(2, 200))) testData <- rbind(cbind(class1[testIndices,], rep(1, 500)), cbind(class2[testIndices,], rep(2, 500))) data <- list(train = trainData, test = testData) # Count outsiders numOutsiders = sum(rowSums(is.in.convex(data$test[,propertyVars], data$train[,propertyVars], c(200, 200))) == 0) cat(numOutsiders, "outsiders found in the testing sample.\n") } \keyword{ multivariate } ddalpha/man/depthf.fd1.Rd0000644000176200001440000001122014216410625014631 0ustar liggesusers\name{depthf.fd1} \alias{depthf.fd1} \title{Univariate Integrated and Infimal Depth for Functional Data} \usage{ depthf.fd1(datafA, datafB, range = NULL, d = 101, order = 1, approx = 0) } \arguments{ \item{datafA}{Functions whose depth is computed, represented by a \code{dataf} object of their arguments and functional values. \code{m} stands for the number of functions.} \item{datafB}{Random sample functions with respect to which the depth of \code{datafA} is computed. \code{datafB} is represented by a \code{dataf} object of their arguments and functional values. \code{n} is the sample size. The grid of observation points for the functions \code{datafA} and \code{datafB} may not be the same.} \item{range}{The common range of the domain where the functions \code{datafA} and \code{datafB} are observed. Vector of length 2 with the left and the right end of the interval. Must contain all arguments given in \code{datafA} and \code{datafB}.} \item{d}{Grid size to which all the functional data are transformed. For depth computation, all functional observations are first transformed into vectors of their functional values of length \code{d} corresponding to equi-spaced points in the domain given by the interval \code{range}. Functional values in these points are reconstructed using linear interpolation, and extrapolation, see Nagy et al. (2016).} \item{order}{The order of the order extended integrated and infimal depths. By default, this is set to \code{1}, meaning that the usual univariate depths of the functional values are computed. For \code{order=2} or \code{3}, the second and the third order extended integrated and infimal depths are computed, respectively.} \item{approx}{Number of approximations used in the computation of the order extended depth for \code{order} greater than \code{1}. For \code{order=2}, the default value is set to \code{0}, meaning that the depth is computed at all possible \code{d^order} combinations of the points in the domain. For \code{order=3}, the default value is set to \code{101}. When \code{approx} is a positive integer, \code{approx} points are randomly sampled in \code{[0,1]^order} and at these points the \code{order}-variate depths of the corresponding functional values are computed.} } \value{ Four vectors of length \code{m} of depth values are returned: \itemize{ \item \code{Simpl_FD} the integrated depth based on the simplicial depth, \item \code{Half_FD} the integrated depth based on the halfspace depth, \item \code{Simpl_ID} the infimal depth based on the simplicial depth, \item \code{Half_ID} the infimal depth based on the halfspace depth. } In addition, two vectors of length \code{m} of the relative area of smallest depth values is returned: \itemize{ \item \code{Simpl_IA} the proportions of points at which the depth \code{Simpl_ID} was attained, \item \code{Half_IA} the proportions of points at which the depth \code{Half_ID} was attained. } The values \code{Simpl_IA} and \code{Half_IA} are always in the interval [0,1]. They introduce ranking also among functions having the same infimal depth value - if two functions have the same infimal depth, the one with larger infimal area \code{IA} is said to be less central. For \code{order=2} and \code{m=1}, two additional matrices of pointwise depths are also returned: \itemize{ \item \code{PSD} the matrix of size \code{d*d} containing the computed pointwise bivariate simplicial depths used for the computation of \code{Simpl_FD} and \code{Simpl_ID}, \item \code{PHD} the matrix of size \code{d*d} containing the computed pointwise bivariate halfspace depths used for the computation of \code{Half_FD} and \code{Half_ID}. } For \code{order=3}, only \code{Half_FD} and \code{Half_ID} are provided. } \description{ Usual, and order extended integrated and infimal depths for real-valued functional data based on the halfspace and simplicial depth. } \details{ The function returns vectors of sample integrated and infimal depth values. } \examples{ datafA = dataf.population()$dataf[1:20] datafB = dataf.population()$dataf[21:50] depthf.fd1(datafA,datafB) depthf.fd1(datafA,datafB,order=2) depthf.fd1(datafA,datafB,order=3,approx=51) } \references{ Nagy, S., Gijbels, I. and Hlubinka, D. (2016). Weak convergence of discretely observed functional data with applications. \emph{Journal of Multivariate Analysis}, \bold{146}, 46--62. Nagy, S., Gijbels, I. and Hlubinka, D. (2017). Depth-based recognition of shape outlying functions. \emph{Journal of Computational and Graphical Statistics}, \bold{26} (4), 883--893. } \seealso{ \code{\link{depthf.fd2}}, \code{\link{infimalRank}} } \author{ Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} } \keyword{depth} \keyword{functional} ddalpha/man/dknn.train.Rd0000644000176200001440000000621514213423775014773 0ustar liggesusers\name{dknn.train} \alias{dknn.train} \title{ Depth-Based kNN } \description{ The implementation of the affine-invariant depht-based kNN of Paindaveine and Van Bever (2015). } \usage{ dknn.train(data, kMax = -1, depth = "halfspace", seed = 0) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{data}{ Matrix containing training sample where each of \eqn{n} rows is one object of the training sample where first \eqn{d} entries are inputs and the last entry is output (class label). } \item{kMax}{ the maximal value for the number of neighbours. If the value is set to -1, the default value is calculated as n/2, but at least 2, at most n-1. } \item{depth}{ Character string determining which depth notion to use; the default value is \code{"halfspace"}. Currently the method supports the following depths: "halfspace", "Mahalanobis", "simplicial". } \item{seed}{ the random seed. The default value \code{seed=0} makes no changes. } } %\details{ %% ~~ If necessary, more details than the description above ~~ %} \value{ The returned object contains technical information for classification, including the found optimal value \code{k}. } \references{ Paindaveine, D. and Van Bever, G. (2015). Nonparametrically consistent depth-based classifiers. \emph{Bernoulli} \bold{21} 62--82. } %\note{ %% ~~further notes~~ %} %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{dknn.classify}} and \code{\link{dknn.classify.trained}} to classify with the Dknn-classifier. \code{\link{ddalpha.train}} to train the DD\eqn{\alpha}-classifier. \code{\link{ddalpha.getErrorRateCV}} and \code{\link{ddalpha.getErrorRatePart}} to get error rate of the Dknn-classifier on particular data (set \code{separator = "Dknn"}). } \examples{ # Generate a bivariate normal location-shift classification task # containing 200 training objects and 200 to test with class1 <- mvrnorm(200, c(0,0), matrix(c(1,1,1,4), nrow = 2, ncol = 2, byrow = TRUE)) class2 <- mvrnorm(200, c(2,2), matrix(c(1,1,1,4), nrow = 2, ncol = 2, byrow = TRUE)) trainIndices <- c(1:100) testIndices <- c(101:200) propertyVars <- c(1:2) classVar <- 3 trainData <- rbind(cbind(class1[trainIndices,], rep(1, 100)), cbind(class2[trainIndices,], rep(2, 100))) testData <- rbind(cbind(class1[testIndices,], rep(1, 100)), cbind(class2[testIndices,], rep(2, 100))) data <- list(train = trainData, test = testData) # Train the classifier # and get the classification error rate cls <- dknn.train(data$train, kMax = 20, depth = "Mahalanobis") cls$k classes1 <- dknn.classify.trained(data$test[,propertyVars], cls) cat("Classification error rate: ", sum(unlist(classes1) != data$test[,classVar])/200) # Classify the new data based on the old ones in one step classes2 <- dknn.classify(data$test[,propertyVars], data$train, k = cls$k, depth = "Mahalanobis") cat("Classification error rate: ", sum(unlist(classes2) != data$test[,classVar])/200) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ multivariate } \keyword{ nonparametric } \keyword{ classif } ddalpha/man/depth.potential.Rd0000644000176200001440000000766314213423775016037 0ustar liggesusers\name{depth.potential} \alias{depth.potential} \title{ Calculate Potential of the Data } \description{ Calculate the potential of the points w.r.t. a multivariate data set. The potential is the kernel-estimated density multiplied by the prior probability of a class. Different from the data depths, a density estimate measures at a given point how much mass is located around it. } \usage{ depth.potential (x, data, pretransform = "1Mom", kernel = "GKernel", kernel.bandwidth = NULL, mah.parMcd = 0.75) } \arguments{ \item{x}{ Matrix of objects (numerical vector as one object) whose depth is to be calculated; each row contains a \eqn{d}-variate point. Should have the same dimension as \code{data}. } \item{data}{ Matrix of data where each row contains a \eqn{d}-variate point, w.r.t. which the depth is to be calculated. } \item{pretransform}{ The method of data scaling. \code{NULL} to use the original data, \code{1Mom} or \code{NMom} for scaling using data moments, \code{1MCD} or \code{NMCD} for scaling using robust data moments (Minimum Covariance Determinant (MCD) ). } \item{kernel}{ \code{"EDKernel"} for the kernel of type 1/(1+kernel.bandwidth*EuclidianDistance2(x, y)), \code{"GKernel"} [default and recommended] for the simple Gaussian kernel, \code{"EKernel"} exponential kernel: exp(-kernel.bandwidth*EuclidianDistance(x, y)), %\code{"TriangleKernel"}, \code{"VarGKernel"} variable Gaussian kernel, where \code{kernel.bandwidth} is proportional to the \code{depth.zonoid} of a point. } \item{kernel.bandwidth}{ the single bandwidth parameter of the kernel. If \code{NULL} - the Scott's rule of thumb is used. } \item{mah.parMcd}{ is the value of the argument \code{alpha} for the function \code{\link{covMcd}}; is used when \code{pretransform = "*MCD"}. } } \details{ The potential is the kernel-estimated density multiplied by the prior probability of a class. The kernel bandwidth matrix is decomposed into two parts, one of which describes the form of the data, and the other the width of the kernel. Then the first part is used to transform the data using the moments, while the second is employed as a parameter of the kernel and tuned to achieve the best separation. For details see Pokotylo and Mosler (2015). } \value{ Numerical vector of potentials, one for each row in \code{x}; or one potential value if \code{x} is a numerical vector. } \references{ Aizerman, M.A., Braverman, E.M., and Rozonoer, L.I. (1970). \emph{The Method of Potential Functions in the Theory of Machine Learning}. Nauka (Moscow). Pokotylo, O. and Mosler, K. (2015). Classification with the pot-pot plot. \emph{Mimeo}. } \seealso{ \code{\link{depth.halfspace}} for calculation of the Tukey depth. \code{\link{depth.Mahalanobis}} for calculation of Mahalanobis depth. \code{\link{depth.projection}} for calculation of projection depth. \code{\link{depth.simplicial}} for calculation of simplicial depth. \code{\link{depth.simplicialVolume}} for calculation of simplicial volume depth. \code{\link{depth.spatial}} for calculation of spatial depth. \code{\link{depth.zonoid}} for calculation of zonoid depth. } \examples{ # 3-dimensional normal distribution data <- mvrnorm(200, rep(0, 3), matrix(c(1, 0, 0, 0, 2, 0, 0, 0, 1), nrow = 3)) x <- mvrnorm(10, rep(1, 3), matrix(c(1, 0, 0, 0, 1, 0, 0, 0, 1), nrow = 3)) # potential with rule of thumb bandwidth pot <- depth.potential(x, data) cat("Potentials: ", pot, "\n") # potential with bandwidth = 0.1 pot <- depth.potential(x, data, kernel.bandwidth = 0.1) cat("Potentials: ", pot, "\n") # potential with robust MCD scaling pot <- depth.potential(x, data, kernel.bandwidth = 0.1, pretransform = "NMCD", mah.parMcd = 0.6) cat("Potentials: ", pot, "\n") } \keyword{ robust } \keyword{ multivariate } \keyword{ nonparametric } ddalpha/man/dataf.sim.2.CFF07.Rd0000644000176200001440000000401514213423775015473 0ustar liggesusers\name{dataf.sim.2.CFF07} \alias{dataf.sim.2.CFF07} \title{ Model 2 from Cuevas et al. (2007) } \description{ Model 2 from Cuevas et al. (2007) Processes: \cr X(t) = m_0(t) + e(t), m_0(t) = 30*(1-t)*t^2 + 0.5*abs(sin(20*pi*t)) \cr Y(t) = an 8-knot spline approximation of X \cr e(t): Gaussian with mean = 0, cov(X(s), X(t)) = 0.2*exp(-abs(s - t)/0.3)\cr the processes are discretized at \code{numDiscrets} equally distant points on [0, 1]. } \usage{ dataf.sim.2.CFF07(numTrain = 100, numTest = 50, numDiscrets = 51, plot = FALSE) } \arguments{ \item{numTrain}{ number of objects in the training sample } \item{numTest}{ number of objects in the test sample } \item{numDiscrets}{ number of points for each object } \item{plot}{ if TRUE the training sample is plotted } } \format{ A data strusture containing \code{$learn} and \code{$test} functional data. The functional data are given as data structures. \describe{ \item{\code{dataf}}{ The functional data as a list of objects. Each object is characterized by two coordinates. \describe{ \item{\code{args}}{a numeric vector} \item{\code{vals}}{a numeric vector} } } \item{\code{labels}}{The classes of the objects: 0 for X(t), 1 for Y(t)} } } \source{ Cuevas, A., Febrero, M. and Fraiman, R. (2007). Robust estimation and classification for functional data via projection-based depth notions. Computational Statistics 22 481-496. } \seealso{ \code{\link{dataf.*}} for other functional data sets \code{\link{plot.functional}} for building plots of functional data } \examples{ ## load the dataset dataf = dataf.sim.2.CFF07(numTrain = 100, numTest = 50, numDiscrets = 51) learn = dataf$learn test = dataf$test ## view the classes unique(learn$labels) ## access the 5th point of the 2nd object learn$dataf[[2]]$args[5] learn$dataf[[2]]$vals[5] \dontrun{ ## plot the data plot(learn) plot(test) ## or dataf = dataf.sim.2.CFF07(numTrain = 100, numTest = 50, numDiscrets = 51, plot = TRUE) } } \keyword{datasets} \keyword{functional} ddalpha/man/dataf2rawfd.Rd0000644000176200001440000000442614216410625015105 0ustar liggesusers\name{dataf2rawfd} \alias{dataf2rawfd} \title{Transform a \code{dataf} Object to Raw Functional Data} \usage{ dataf2rawfd(dataf, range = NULL, d = 101) } \arguments{ \item{dataf}{Functions to be transformed, represented by a (possibly multivariate) \code{dataf} object of their arguments and functional values. \code{m} stands for the number of functions. The grid of observation points for the functions in \code{dataf} may not be the same.} \item{range}{The common range of the domain where the functions \code{dataf} are observed. Vector of length 2 with the left and the right end of the interval. Must contain all arguments given in \code{dataf}. If the range is not provided, the smallest interval in which all the arguments from the data functions are contained is chosen as the domain.} \item{d}{Grid size to which all the functional data are transformed. All functional observations are transformed into vectors of their functional values of length \code{d} corresponding to equi-spaced points in the domain given by the interval \code{range}. Functional values in these points are reconstructed using linear interpolation, and extrapolation, see Nagy et al. (2016).} } \value{ If the functional data are univariate (scalar-valued), a matrix of size \code{m*d} is given, with each row corresponding to one function. If the functional data are \code{k}-variate with k>1, an array of size \code{m*d*k} of the functional values is given. } \description{ From a (possibly multivariate) functional data object \code{dataf} constructs an array of the functional values evaluated at an equi-distant grid of points. } \examples{ ## transform a matrix into a functional data set and back n = 5 d = 21 X = matrix(rnorm(n*d),ncol=d) R = rawfd2dataf(X,range=c(0,1)) R2 = dataf2rawfd(R,range=c(0,1),d=d) all.equal(X,R2) ## transform a functional dataset into a raw matrix of functional values dataf = dataf.population()$dataf dataf2rawfd(dataf,range=c(1950,2015),d=66) ## transform an array into a multivariate functional data set and back k = 3 X = array(rnorm(n*d*k),dim=c(n,d,k)) R = rawfd2dataf(X,range=c(-1,1)) dataf2rawfd(R,range=c(-1,1),d=50) } \seealso{ \code{\link{rawfd2dataf}} \code{\link{depthf.fd1}} \code{\link{depthf.fd2}} } \author{ Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} } \keyword{functional} ddalpha/man/Cmetric.Rd0000644000176200001440000000337214216410625014305 0ustar liggesusers\name{Cmetric} \alias{Cmetric} \title{Fast Computation of the Uniform Metric for Sets of Functional Data} \usage{ Cmetric(A, B) } \arguments{ \item{A}{Functions of the first set, represented by a matrix of their functional values of size \code{m*d}. \code{m} stands for the number of functions, \code{d} is the number of the equi-distant points in the domain of the data at which the functional values of the \code{m} functions are evaluated.} \item{B}{Functions of the second set, represented by a matrix of their functional values of size \code{n*d}. \code{n} stands for the number of functions, \code{d} is the number of the equi-distant points in the domain of the data at which the functional values of the \code{n} functions are evaluated. The grid of observation points for the functions \code{A} and \code{B} must be the same.} } \value{ A symmetric matrix of the distances of the functions of size \code{m*n}. } \description{ Returns the matrix of \eqn{C} (uniform) distances between two sets of functional data. } \details{ For two sets of functional data of sizes \code{m} and \code{n} represented by matrices of their functional values, this function returns the symmetric matrix of size \code{m*n} whose entry in the \code{i}-th row and \code{j}-th column is the approximated \eqn{C} (uniform) distance of the \code{i}-th function from the first set, and the \code{j}-th function from the second set. This function is utilized in the computation of the h-mode depth. } \examples{ datapop = dataf2rawfd(dataf.population()$dataf,range=c(1950,2015),d=66) A = datapop[1:20,] B = datapop[21:50,] Cmetric(A,B) } \seealso{ \code{\link{depthf.hM}} \code{\link{dataf2rawfd}} } \author{ Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} } \keyword{functional} \keyword{metric} ddalpha/man/dataf.medflies.Rd0000644000176200001440000000610114213423775015565 0ustar liggesusers\name{dataf.medflies} \alias{dataf.medflies} \alias{medflies} \docType{data} \title{ Relationship of Age Patterns of Fecundity to Mortality for Female Medflies. } \description{ The data set consists of number of eggs laid daily for each of 1000 medflies (Mediterranean fruit flies, Ceratitis capitata) until time of death. Data were obtained in Dr. Carey's laboratory. The main questions are to explore the relationship of age patterns of fecundity to mortality, longevity and lifetime reproduction. A basic finding was that individual mortality is associated with the time-dynamics of the egg-laying trajectory. An approximate parametric model of the egg laying process was developed and used in Muller et al. (2001). Non-parametric approaches which extend principal component analysis for curve data to the situation when covariates are present have been developed and discussed in Chiou, Muller and Wang (2003) and Chiou et al. (2003). } \usage{ dataf.medflies() } \format{ The functional data as a data structure. \describe{ \item{\code{dataf}}{ The functional data as a list of objects. Each object is characterized by two coordinates. \describe{ \item{\code{args}}{\bold{day} - a numeric vector of the days numbers} \item{\code{vals}}{\bold{#eggs} - a numeric vector of numbers of eggs laid daily} } } \item{\code{labels}}{The classes of the objects: long-lived, short-lived} } } \source{ Carey, J.R., Liedo, P., Muller, H.G., Wang, J.L., Chiou, J.M. (1998). Relationship of age patterns of fecundity to mortality, longevity, and lifetime reproduction in a large cohort of Mediterranean fruit fly females. J. of Gerontology --Biological Sciences 53, 245-251. Muller, H.G., Carey, J.R., Wu, D., Liedo, P., Vaupel, J.W. (2001). Reproductive potential predicts longevity of female Mediterranean fruit flies. Proceedings of the Royal Society B 268, 445-450. Chiou, J.M., Muller, H.G., Wang, J.L. (2003). Functional quasi-likelihood regression models with smooth random effects. J. Royal Statist. Soc. B65, 405-423. Chiou, J.M., Muller, H.G., Wang, J.L., Carey, J.R. (2003). A functional multiplicative effects model for longitudinal data, with application to reproductive histories of female medflies. Statistica Sinica 13, 1119-1133. Chiou, J.M., Muller, H.G., Wang, J.L. (2004).Functional response models. Statistica Sinica 14,675-693. } \seealso{ \code{\link{dataf.*}} for other functional data sets \code{\link{plot.functional}} for building plots of functional data } \examples{ ## load the dataset dataf = dataf.medflies() ## view the classes unique(dataf$labels) ## access the 5th point of the 2nd object dataf$dataf[[2]]$args[5] dataf$dataf[[2]]$vals[5] ## plot the data \dontrun{ labels = unlist(dataf$labels) plot(dataf, xlab="Day", ylab="# eggs", main=paste("Medflies (training time):\n short-lived red (", sum(labels == "short-lived"), "),", " long-lived blue (", sum(labels == "long-lived"), ")", sep=""), colors = c("blue", "red") # in alphabetical order of class labels ) } } \keyword{datasets} \keyword{functional} ddalpha/man/depth.space.simplicial.Rd0000644000176200001440000000573214213423775017253 0ustar liggesusers\name{depth.space.simplicial} \alias{depth.space.simplicial} \title{ Calculate Depth Space using Simplicial Depth } \description{ Calculates the representation of the training classes in depth space using simplicial depth. } \usage{ depth.space.simplicial(data, cardinalities, exact = F, k = 0.05, seed = 0) } \arguments{ \item{data}{ Matrix containing training sample where each row is a \eqn{d}-dimensional object, and objects of each class are kept together so that the matrix can be thought of as containing blocks of objects representing classes. } \item{cardinalities}{ Numerical vector of cardinalities of each class in \code{data}, each entry corresponds to one class. } \item{exact}{ \code{exact=F} (by default) implies the approximative algorithm, considering \code{k} simplices, \code{exact=T} implies the exact algorithm. } \item{k}{ Number (\eqn{k>1}) or portion (if \eqn{01}, then the algorithmic complexity is polynomial in \eqn{d} but is independent of the number of observations in \code{data}, given \eqn{k}. If \eqn{0_validate}{ validates parameters passed to \code{\link{ddalpha.train}} and passes them to the \code{ddalpha} object. \tabular{ll}{IN:\cr \code{ddalpha} \tab {the ddalpha object, containing the data and settings (mandatory)}\cr \code{} \tab {parameters that are passed to the user-defined method}\cr \code{...} \tab {other parameters (mandatory)} %} \tabular{ll}{ \cr OUT:\cr \code{list()} \tab {list of output parameters, after the validation is finished, these parameters are stored in the \code{ddalpha} object} } } \item{._learn}{ trains the depth \tabular{ll}{IN:\cr \code{ddalpha} \tab {the ddalpha object, containing the data and settings} %} \tabular{ll}{ \cr MODIFIES:\cr \code{ddalpha} \tab store the calculated statistics in the \code{ddalpha} object \cr depths \tab calculate the depths of each pattern, e.g. \cr \tab \code{for (i in 1:ddalpha$numPatterns) ddalpha$patterns[[i]]$depths = ._depths(ddalpha, ddalpha$patterns[[i]]$points)} %} \tabular{ll}{ \cr OUT:\cr \code{ddalpha} \tab {the updated \code{ddalpha} object} } } \item{._depths}{ calculates the depths \tabular{ll}{IN:\cr \code{ddalpha} \tab {the ddalpha object, containing the data and settings} \cr \code{objects} \tab {the objects for which the depths are calculated} \cr \cr OUT:\cr \code{depths} \tab {the calculated depths for each object (rows), with respect to each class (cols)} } } } Usage: \code{ddalpha.train(data, depth = "", , ...)} \verb{ #### Custom depths #### .MyDepth_validate <- function(ddalpha, mydepth.parameter = "value", ...){ print("MyDepth validating") # validate the parameters if (!is.valid(mydepth.parameter)){ warning("Argument \"mydepth.parameter\" not specified correctly. Default value is used") mydepth.parameter = "value" # or stop("Argument \"mydepth.parameter\" not specified correctly.") } # the values from the return list will be stored in the ddalpha object return (list(mydepthpar = mydepth.parameter)) } .MyDepth_learn <- function(ddalpha){ print("MyDepth learning") #1. Calculate any statistics based on data that .MyDepth_depths needs # and store them to the ddalpha object: ddalpha$mydepth.statistic = "some value" #2. Calculate depths for each pattern for (i in 1:ddalpha$numPatterns){ ddalpha$patterns[[i]]$depths = .MyDepth_depths(ddalpha, ddalpha$patterns[[i]]$points) } return(ddalpha) } .MyDepth_depths <- function(ddalpha, objects){ print("MyDepth calculating") depths <- NULL # The depth parameters are accessible in the ddalpha object: mydepth.parameter = ddalpha$mydepth.parameter mydepth.statistic = ddalpha$mydepth.statistic #calculate the depths of the objects w.r.t. each pattern for (i in 1:ddalpha$numPatterns){ depth_wrt_i = #calculate depths of the objects, as vector depths <- cbind(depths, depth_wrt_i) } return (depths) } ddalpha.train(data, depth = "MyDepth", ...) } \bold{To define a classifier:} \describe{ \item{._validate}{ validates parameters passed to \code{\link{ddalpha.train}} and passes them to the \code{ddalpha} object \tabular{ll}{IN:\cr \code{ddalpha} \tab {the ddalpha object, containing the data and settings (mandatory)}\cr \code{} \tab {parameters that are passed to the user-defined method}\cr \code{...} \tab {other parameters (mandatory)} \cr OUT:\cr \code{list()} \tab {list of output parameters, after the validation is finished, these parameters are stored in the \code{ddalpha} object. In case of a multiclass classifier the validator must return \code{methodSeparatorBinary = F} and/or pass \code{aggregation.method = "none"} to \code{ddalpha.train}} } } \item{._learn}{ trains the classifier. Is different for binnary and mylticlass classifiers. \tabular{ll}{IN:\cr \code{ddalpha} \tab {the ddalpha object, containing the data and settings}\cr \code{index1} \tab {(only for binary) index of the first class}\cr \code{index2} \tab {(only for binary) index of the second class}\cr \code{depths1} \tab {(only for binary) depths of the first class w.r.t. all classes}\cr \code{depths2} \tab {(only for binary) depths of the second class w.r.t. all classes}\cr\cr \tab depths w.r.t. only given classes are received by \code{depths1[,c(index1, index2)]}\cr\cr \tab for the multiclass classifiers the depths are accessible via \code{ddalpha$patterns[[i]]$depths} \cr OUT:\cr \code{classifier} \tab { the trained \code{classifier} object} } } \item{._classify}{ classifies the objects \tabular{ll}{IN:\cr \code{ddalpha} \tab {the ddalpha object, containing the data and global settings} \cr \code{classifier} \tab {the previously trained classifier}\cr \code{objects} \tab {the objects (depths) that are classified} \cr \cr OUT:\cr \code{result} \tab { a vector with classification results}\cr \tab {(binary) the objects from class \code{"classifier$index1"} get positive values} \cr \tab {(multiclass) the objects get the numbers of patterns in \code{ddalpha}} } } } Usage: \code{ddalpha.train(data, separator = "", ...)} \verb{ #### Custom classifiers #### .MyClassifier_validate <- function(ddalpha, my.parameter = "value", ...){ print("MyClassifier validating") # validate the parameters ... # always include methodSeparatorBinary. # TRUE for the binary classifier, FALSE otherwise return(list(methodSeparatorBinary = T, my.parameter = my.parameter )) } # a binary classifier # the package takes care of the voting procedures. Just train it as if there are only two classes .MyClassifier_learn <- function(ddalpha, index1, index2, depths1, depths2){ print("MyClassifier (binary) learning") # The parameters are accessible in the ddalpha object: my.parameter = ddalpha$my.parameter #depths w.r.t. only given classes are received by depths1[,c(index1, index2)] depths2[,c(index1, index2)] # train the classifier classifier <- ... #return the needed values in a list, e.g. return(list( coefficients = classifier$coefficients, ... )) } # a multiclass classifier .MyClassifier_learn <- function(ddalpha){ print("MyClassifier (multiclass) learning") # access the data through the ddalpha object, e.g. for (i in 1:ddalpha$numPatterns){ depth <- ddalpha$patterns[[i]]$depths number <- ddalpha$patterns[[i]]$cardinality ... } # train the classifier classifier <- ... # return the classifier return(classifier) } # the interface of the classify function is equal for binary and multiclass classifiers .MyClassifier_classify <- function(ddalpha, classifier, depths){ print("MyClassifier classifying") # The global parameters are accessible in the ddalpha object: my.parameter = ddalpha$my.parameter # The parameters generated by .MyClassifier_learn are accessible in the classifier object: classifier$coefficients # here are the depths w.r.t. the first class depths[,classifier$index1] # here are the depths w.r.t. the second class depths[,classifier$index2] # fill results in a vector, so that: # (binary) the objects from class "classifier$index1" get positive values # (multiclass) the objects get the numbers of patterns in ddalpha result <- ... return(result) } ddalpha.train(data, separator = "MyClassifier", ...) } } %\value{ %% ~Describe the value returned %% If it is a LIST, use %% \item{comp1 }{Description of 'comp1'} %% \item{comp2 }{Description of 'comp2'} %% ... %} %\references{ %% ~put references to the literature/web site here ~ %} %\author{ %% ~~who you are~~ %} %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{ddalpha.train}} } \examples{ \dontrun{ #### example: Euclidean depth #### #.Euclidean_validate is basically not needed .Euclidean_learn <- function(ddalpha){ print("Euclidean depth learning") #1. Calculate any statistics based on data that .MyDepth_depths needs # and store them to the ddalpha object: for (i in 1:ddalpha$numPatterns){ ddalpha$patterns[[i]]$center <- colMeans(ddalpha$patterns[[i]]$points) } #2. Calculate depths for each pattern for (i in 1:ddalpha$numPatterns){ ddalpha$patterns[[i]]$depths = .Euclidian_depths(ddalpha, ddalpha$patterns[[i]]$points) } return(ddalpha) } .Euclidean_depths <- function(ddalpha, objects){ print("Euclidean depth calculating") depths <- NULL #calculate the depths of the objects w.r.t. each pattern for (i in 1:ddalpha$numPatterns){ # The depth parameters are accessible in the ddalpha object: center = ddalpha$patterns[[i]]$center depth_wrt_i <- 1/(1 + colSums((t(objects) - center)^2)) depths <- cbind(depths, depth_wrt_i) } return (depths) } #### example: binary decision tree #### library(rpart) .tree_validate <- function(ddalpha, ...){ print("tree validating") return(list(methodSeparatorBinary = T)) } # a binary classifier # the package takes care of the voting procedures. Just train it as if there are only two classes .tree_learn <- function(ddalpha, index1, index2, depths1, depths2){ print("tree learning") # prepare the data data = as.data.frame(cbind( (rbind(depths1, depths2)), c(rep(1, times = nrow(depths1)), rep(-1, times = nrow(depths1))))) names(data) <- paste0("V",seq_len(ncol(data))) names(data)[ncol(data)] <- "O" # train the classifier classifier <- rpart(O~., data = data) #return the needed values in a list, e.g. return(classifier) } # the interface of the classify function is equal for binary and multiclass classifiers .tree_classify <- function(ddalpha, classifier, depths){ print("tree classifying") # fill results in a vector, so that the objects from class "classifier$index1" get positive values data = as.data.frame(depths) names(data) <- paste0("V",seq_len(ncol(data))) result <- predict(classifier, as.data.frame(depths), type = "vector") return(result) } #### checking #### library(ddalpha) data = getdata("hemophilia") ddalpha = ddalpha.train(data = data, depth = "Euclidean", separator = "tree") c = ddalpha.classify(ddalpha, data[,1:2]) errors = sum(unlist(c) != data[,3])/nrow(data) print(paste("Error rate: ",errors)) # building the depth contours using the custom depth depth.contours.ddalpha(ddalpha, asp = T, levels = seq(0.5, 1, length.out = 10)) } } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ depth } \keyword{ classif } \keyword{ custom } ddalpha/man/depth.graph.Rd0000644000176200001440000000346114213423775015131 0ustar liggesusers\name{depth.graph} \alias{depth.graph} \title{ Depth Graph } \description{ Builds the data depth graphs for 2-dimensional data. The graph is built using \code{\link{persp}}. } \usage{ depth.graph(data, depth_f = c("halfspace", "Mahalanobis", "projection", "simplicial", "simplicialVolume", "spatial", "zonoid", "none"), apoint = NULL, main = depth_f, xlim = c(min(data[, 1]), max(data[, 1])), ylim = c(min(data[, 2]), max(data[, 2])), zlim = c(0, max(z)), xnum = 250, ynum = 250, theta=15, phi=60, bold = F, ...) } \arguments{ \item{data}{ 2-dimensional numeric data frame or matrix } \item{depth_f}{ the name of the depth function. The list of the supported depths and described in the topic \code{\link{depth.}}. } \item{apoint}{ a 2-dimensional point which is shown in black color. } \item{main}{ an overall title for the plot: see \code{\link{title}} } \item{xlim, ylim, zlim}{ numeric vectors of length 2, giving the x, y and z coordinates ranges: see \code{\link{plot.window}} } \item{xnum, ynum}{ number of points on each direction, x and y. Impacts the smoothness of the surface. } \item{theta, phi}{ rotation angles } \item{bold}{ draws bold points } \item{\dots}{ additional parameters passed to \code{\link{persp}} } } \seealso{ \code{\link{depth.}} \code{\link{persp}} } \examples{ \dontrun{ par(mfrow = c(2,3), mar = c(0,0,0,0), mai = c(0,0,0.2,0)) data(hemophilia) depth.graph(hemophilia, "none", xnum = 100, ynum = 100) depth.graph(hemophilia, "Mahalanobis", xnum = 100, ynum = 100) depth.graph(hemophilia, "halfspace", xnum = 100, ynum = 100) depth.graph(hemophilia, "projection", xnum = 100, ynum = 100) depth.graph(hemophilia, "zonoid", xnum = 100, ynum = 100) depth.graph(hemophilia, "spatial", xnum = 100, ynum = 100) } } \keyword{ visualization } ddalpha/man/depth.qhpeeling.Rd0000644000176200001440000000443014213423775016001 0ustar liggesusers\name{depth.qhpeeling} \alias{depth.qhpeeling} \title{ Calculate Convex Hull Peeling Depth } \description{ Calculates the convex hull peeling depth of points w.r.t. a multivariate data set. } \usage{ depth.qhpeeling(x, data) } \arguments{ \item{x}{ Matrix of objects (numerical vector as one object) whose depth is to be calculated; each row contains a \eqn{d}-variate point. Should have the same dimension as \code{data}. } \item{data}{ Matrix of data where each row contains a \eqn{d}-variate point, w.r.t. which the depth is to be calculated. } } \details{ Calculates the convex hull peeling depth (Eddy, 1982; see also Cascos, 2009). } \value{ Numerical vector of depths, one for each row in \code{x}; or one depth value if \code{x} is a numerical vector. Each depth value equals the number of the convex hulls to be peeled from \code{data} so that (the corresponding row of) \code{x} is not contained in the convex hull of the rest of the data; the depths are normalized by the number of points in \code{data}. } \references{ Eddy, W.F. (1982). Convex hull peeling. In: Caussinus, H., Ettinger, P. and Tomassone, R. (eds), \emph{COMPSTAT 1982. Proceedings in computational statistics}, Physica-Verlag (Vienna), 42--47. Cascos, I. (2009). Data depth: multivariate statistics and geometry. In: Kendall, W.S. and Molchanov, I. (eds) \emph{New Perspectives in Stochastic Geometry}, Clarendon/Oxford University Press (Oxford). } \seealso{ \code{\link{depth.halfspace}} for calculation of the Tukey depth. \code{\link{depth.L2}} for calculation of L2-depth. \code{\link{depth.Mahalanobis}} for calculation of Mahalanobis depth. \code{\link{depth.projection}} for calculation of projection depth. \code{\link{depth.simplicial}} for calculation of simplicial depth. \code{\link{depth.simplicialVolume}} for calculation of simplicial volume depth. \code{\link{depth.spatial}} for calculation of spatial depth. \code{\link{depth.potential}} for calculation of data potential. \code{\link{depth.zonoid}} for calculation of zonoid depth. } \examples{ # Mixture of 3-variate normal distributions data <- mvrnorm(25, rep(0, 3), diag(3)) x <- rbind(mvrnorm(10, rep(1, 3), diag(3)), data) depths <- depth.qhpeeling(x, data) cat("Depths:", depths, "\n") } \keyword{ robust } \keyword{ multivariate } \keyword{ nonparametric } ddalpha/man/depthf.simplicialBand.Rd0000644000176200001440000000416314213423775017111 0ustar liggesusers\name{depthf.simplicialBand} \alias{depthf.simplicialBand} \title{ Calculate Simplicial Band Depth } \description{ Calculate the simplicial band depth defined by Lopez-Pintado, Sun, Lin, Genton (2014). } \usage{ depthf.simplicialBand(objectsf, dataf, modified = TRUE, J = NULL, range = NULL, d = 101) } \arguments{ \item{objectsf}{ Functoins for which the depth should be computed; a list containing lists (functions) of two vectors of equal length, named \code{args} and \code{vals}: arguments sorted in ascending order and corresponding them values respectively. } \item{dataf}{ Data sample of functoins w.r.t. which the depth should be computed; structure as for \code{objectsf}. } \item{modified}{ Whether modified simplicial band depth should be computed; logical, \code{TRUE} by default. } \item{J}{ How many functions to consider in each tuple of the U-statistics; integer, \code{d+1} by default. } \item{range}{ The common range of the domain where the functions of objectsf and dataf are observed. Vector of length \code{2} with the left and the right end of the interval. Must contain all arguments given in objectsf and dataf. } \item{d}{ Grid size to which all the functional data are transformed. For depth computation, all functional observations are first transformed into vectors of their functional values of length d corresponding to equi-spaced points in the domain given by the interval range. Functional values in these points are reconstructed using linear interpolation, and extrapolation. } } \value{ A vector of depths of each of \code{objectsf} w.r.t. \code{dataf}. } \references{ Lopez-Pintado, Sun, Lin, Genton (2014). Simplicial band depth for multivariate data. \emph{Advances in Data Analysis and Classification} \bold{8}(3) 321--338. } \seealso{ \code{\link{depthf.BD}}, \code{\link{depthf.ABD}}. } \examples{ datafA = dataf.population()$dataf[1:20] datafB = dataf.population()$dataf[21:50] dataf2A = derivatives.est(datafA,deriv=c(0,1)) dataf2B = derivatives.est(datafB,deriv=c(0,1)) depthf.simplicialBand(dataf2A,dataf2B) } \keyword{ robust } \keyword{ functional } \keyword{ nonparametric } ddalpha/DESCRIPTION0000644000176200001440000000341614550251762013370 0ustar liggesusersPackage: ddalpha Type: Package Title: Depth-Based Classification and Calculation of Data Depth Version: 1.3.15 Date: 2024-01-12 Authors@R: c(person("Oleksii", "Pokotylo", role=c("aut", "cre"), email = "alexey.pokotylo@gmail.com"), person("Pavlo", "Mozharovskyi", role=c("aut"), email = "pavlo.mozharovskyi@telecom-paris.fr"), person("Rainer", "Dyckerhoff", role=c("aut"), email = "rainer.dyckerhoff@statistik.uni-koeln.de"), person("Stanislav", "Nagy", role=c("aut"), email = "nagy@karlin.mff.cuni.cz")) Depends: R (>= 2.10), stats, utils, graphics, grDevices, MASS, class, robustbase, sfsmisc, geometry Imports: Rcpp (>= 0.11.0) LinkingTo: BH, Rcpp Description: Contains procedures for depth-based supervised learning, which are entirely non-parametric, in particular the DDalpha-procedure (Lange, Mosler and Mozharovskyi, 2014 ). The training data sample is transformed by a statistical depth function to a compact low-dimensional space, where the final classification is done. It also offers an extension to functional data and routines for calculating certain notions of statistical depth functions. 50 multivariate and 5 functional classification problems are included. (Pokotylo, Mozharovskyi and Dyckerhoff, 2019 ). License: GPL-2 NeedsCompilation: yes Packaged: 2024-01-12 14:29:22 UTC; alexis Author: Oleksii Pokotylo [aut, cre], Pavlo Mozharovskyi [aut], Rainer Dyckerhoff [aut], Stanislav Nagy [aut] Maintainer: Oleksii Pokotylo Repository: CRAN Date/Publication: 2024-01-12 15:00:02 UTC ddalpha/src/0000755000176200001440000000000014550246301012436 5ustar liggesusersddalpha/src/AlphaProcedure.cpp0000644000176200001440000002722214213423775016055 0ustar liggesusers/* File: AlphaProcedure.cpp Created by: Pavlo Mozharovskyi First published: 28.02.2013 Last revised: 13.11.2015 Contains the modified alpha-procedure for the DDalpha-classifier. For a description of the algorithm, see: Lange, T., Mosler, K. and Mozharovskyi, P. (2012). Fast nonparametric classification based on data depth. Statistical Papers. Mozharovskyi, P., Mosler, K. and Lange, T. (2013). Classifying real-world data with the DDalpha-procedure. Mimeo. */ #include "stdafx.h" #define PI2 1.5707963267948966192313216916398 /* Definition of static variables*/ static TMatrix x; static TVariables y; static unsigned int numLess; static unsigned int numMore; static int difference; static unsigned int n; static unsigned int d; static TVariables properties; static Features features; static TPoint curFeature; static int numStartFeatures; static int GetProducts(TPoint values, unsigned int power, TPoint *output){ int d = values.size(); if (power == 1){ output->resize(d); for (int i = 0; i < d; i++){(*output)[i] = values[i];} return 0; } output->resize(0); TVariables indices(power); unsigned int counter = 0; while(indices[0] < d){ output->push_back(1); for (unsigned int i = 0; i < power; i++){ (*output)[counter] *= values[indices[i]]; } counter++; int lastArray = power - 1; while(lastArray > 0 && indices[lastArray] == d - 1){lastArray--;} indices[lastArray]++; for (unsigned int i = lastArray; i < power; i++){ indices[i] = indices[lastArray]; } } return 0; } static int Compare(UPoint p1, UPoint p2){ return (p1.value < p2.value); } static int UpdateCurFeature(){ double angle = -features[features.size() - 1].angle; unsigned int yAxisNumber = features[features.size() - 1].number; for (unsigned int i = 0; i < n; i++){ curFeature[i] = curFeature[i]*cos(angle) - x[yAxisNumber][i]*sin(angle); } return 0; } static unsigned int DGetMinError(unsigned int yAxisNumber, Feature *yFeature){ /* Calculate angle of each point to the xAxis and sort them */ UPoints angles(n); for (unsigned int i = 0; i < n; i++){ angles[i] = UPoint((x[yAxisNumber][i] == 0 && curFeature[i] == 0) ? 0 : y[i] , atan2(x[yAxisNumber][i], curFeature[i])); } sort(angles.begin(), angles.end(), Compare); /* for (unsigned i = 0; i < n; i++){ cout << (angles[i].pattern > 0 ? 1 : angles[i].pattern < 0 ? 0 : 3); } cout << endl; */ /* Look for the optimal threshold */ int leftDiff = 0; unsigned int optThreshold = 0; int maxCorr = 0; double nextValue = angles[0].value; for (unsigned i = 0; i < n - 1; i++){ leftDiff += angles[i].pattern; if (angles[i + 1].value == nextValue){ continue; } nextValue = angles[i].value; int corr = max(numMore - leftDiff, numLess + leftDiff); //int corr = abs(leftDiff) + abs(difference - leftDiff); if (corr > maxCorr){ maxCorr = corr; optThreshold = i; } // cout << i << " " << corr << "; "; } // cout << endl; /* Determine the angle of the separating direction */ yFeature->angle = (angles[optThreshold].value + angles[optThreshold + 1].value) / 2. - PI2; yFeature->error = n - maxCorr; yFeature->number = yAxisNumber; return yFeature->error; } static unsigned int GetRay(TPoint *ray){ ray->resize(d); double drivingAxis = 1; for (unsigned int i = features.size() - 1; i > 0; i--){ (*ray)[features[i].number] = drivingAxis*sin(features[i].angle); drivingAxis = drivingAxis*cos(features[i].angle); } (*ray)[features[0].number] = drivingAxis; UPoints points(n); for (unsigned int i = 0; i < n; i++){ points[i].pattern = y[i]; for (unsigned int j = 0; j < d; j++){ points[i].value += (*ray)[j]*x[j][i]; } #ifdef DEF_OUT_ALPHA if (OUT_ALPHA) Rcout << points[i].value << ", "; #endif } #ifdef DEF_OUT_ALPHA if (OUT_ALPHA) Rcout << endl; #endif sort(points.begin(), points.end(), Compare); unsigned int numLeftLess = 0; unsigned int numLeftMore = 0; for (unsigned int i = 0; i < n; i++){ if (points[i].value > 0){break;} if (points[i].pattern > 0){numLeftMore++;}else{numLeftLess++;} } unsigned int errorLeftLess = numLeftMore + numLess - numLeftLess; unsigned int errorLeftMore = numLeftLess + numMore - numLeftMore; if (errorLeftLess > errorLeftMore){ for (unsigned int i = 0; i < d; i++){ (*ray)[i] *= -1.; } } #ifdef DEF_OUT_ALPHA if (OUT_ALPHA){ Rcout << errorLeftLess << " " << errorLeftMore << " "; } #endif return 0; } int Initialization(TMatrix input, TVariables output, unsigned int minFeatures){ n = input.size(); if (n == 0){return -1;} // number of points if (output.size() != n){return -1;} d = input[0].size(); if (d == 0){return -1;} // space dimension if (minFeatures == 0 || minFeatures > 2){return -1;}else{numStartFeatures = minFeatures;} /* Filling static variables x and y with input and output (transposing x) */ x.resize(d); for (unsigned int i = 0; i < d; i++){ x[i] = TPoint(n); for (unsigned int j = 0; j < n; j++){ x[i][j] = input[j][i]; } } y.resize(n); numLess = 0; numMore = 0; difference = 0; for (unsigned int i = 0; i < n; i++){ y[i] = output[i]; difference += y[i]; if (y[i] > 0){numMore++;}else{numLess++;} } return 0; } int Alpha(TPoint *ray){ /* 0. Subinitialization - clear auxiliary variables and empty and nonsignificant input axes */ properties.resize(d); for (unsigned int i = 0; i < d; i++){properties[i] = i;} // initialize properties: all available features.clear(); outMatrix(x); /* 1. Null-cycle */ if (numStartFeatures == 2){ // start with two features? Feature optFeatureX; Feature optFeatureY; for (unsigned int i = 0; i < properties.size() - 1; i++){ for (unsigned int j = i + 1; j < properties.size(); j++){ /* Calculating minimal error on the plane of the i-th and the j-th properties */ Feature tmpFeature; curFeature = x[properties[i]]; unsigned int error = DGetMinError(properties[j], &tmpFeature); #ifdef DEF_OUT_ALPHA if (OUT_ALPHA){ Rcout << properties[i] << ", " << properties[j] << ", " << tmpFeature.angle << ", " << error << ", " << endl; } #endif if (error < optFeatureY.error){optFeatureX.number = properties[i]; optFeatureY = tmpFeature;} } } features.push_back(optFeatureX); features.push_back(optFeatureY); for (unsigned int i = 0; i < properties.size(); i++){ // delete recently found X and Y properties if (properties[i] == optFeatureX.number){properties.erase(properties.begin() + i);} if (properties[i] == optFeatureY.number){properties.erase(properties.begin() + i);} } curFeature = x[features[0].number]; UpdateCurFeature(); outString("Feature 1:"); outVector(curFeature); } /* 2. Main cycle */ /* Searching an optimal feature space while empirical error rate decreases */ while(features[features.size() - 1].error > 0 && properties.size() > 0){ Feature optFeature; for (unsigned int i = 0; i < properties.size(); i++){ /* Calculating minimal error on the plane of the curFeature and the j-th properties */ Feature tmpFeature; unsigned int error = DGetMinError(properties[i], &tmpFeature); #ifdef DEF_OUT_ALPHA if (OUT_ALPHA){ Rcout << properties[i] << ", " << tmpFeature.angle << ", " << error << ", " << endl; } #endif if (error < optFeature.error){optFeature = tmpFeature;} } if (optFeature.error < features[features.size() - 1].error){ features.push_back(optFeature); for (unsigned int i = 0; i < properties.size(); i++){ // delete recently found property if (properties[i] == optFeature.number){properties.erase(properties.begin() + i);} } UpdateCurFeature(); outString("Feature :"); outVector(curFeature); }else{break;} } outString("Features:"); outFeatures(features); /* Restoring the projection vector */ GetRay(ray); return features[features.size() - 1].error; } int Classify(TMatrix input, TPoint weights, TVariables *output){ /* 0. Initialization */ unsigned int l = input.size(); if (l == 0){return -1;} unsigned int p = weights.size(); if (p == 0){return -1;} if (p > input[0].size()){return -1;} output->resize(l); /* 1. Classification of each point by comparison of their projections to 0 */ for (unsigned int i = 0; i < l; i++){ double curSum = 0; for (unsigned int j = 0; j < p; j++){curSum += weights[j]*input[i][j];} (*output)[i] = (curSum > 0) ? 1 : -1; } return 0; } int ExtendWithProducts(TMatrix input, unsigned int upToPower, TMatrix *output){ unsigned int n = input.size(); output->resize(n); for (unsigned int i = 0; i < n; i++){ for(unsigned int j = 1; j <= upToPower; j++){ TPoint extension; GetProducts(input[i], j, &extension); TPoint::iterator it; it = (*output)[i].end(); (*output)[i].insert(it, extension.begin(), extension.end()); } } return 0; } int Learn(TMatrix input, TVariables output, unsigned int minFeatures, TPoint *ray){ if (Initialization(input, output, minFeatures) != 0){return -1;} return Alpha(ray); } int LearnCV(TMatrix input, TVariables output, unsigned int minFeatures, unsigned int upToPower, unsigned int folds, TPoint *ray, unsigned int *power){ bool oldOUT_ALPHA = OUT_ALPHA; OUT_ALPHA = false; unsigned int optDegree = 0; unsigned int optError = INT_MAX; unsigned int shortFolds = folds - 1; /* Get the optimal degree (outer cross-validation loop) */ vector spaceExtensions(upToPower); for (unsigned int i = 0; i < upToPower; i++){ ExtendWithProducts(input, i + 1, &spaceExtensions[i]); // get the (i + 1)-th space extention Initialization(spaceExtensions[i], output, minFeatures); // initialize /* Prepare slider and start to cut data */ unsigned sliderSize = (unsigned)ceil((double)n / folds); unsigned chSizeVal = n%folds - 1; TMatrix xSlider(sliderSize); TVariables ySlider(sliderSize); for (unsigned int j = 0; j < sliderSize; j++){ xSlider[j] = TPoint(d); for (unsigned int k = 0; k < d; k++){xSlider[j][k] = x[k][j*shortFolds]; x[k].erase(x[k].begin() + j*shortFolds);} ySlider[j] = y[j*shortFolds]; y.erase(y.begin() + j*shortFolds); difference -= ySlider[j]; if (ySlider[j] > 0){numMore--;}else{numLess--;} } n -= sliderSize; /* Cross-validation for the (i + 1)-th space extension (inner cross-validation loop) */ unsigned int error = 0; TPoint p(0); double tmpXSliderVal; int tmpYSliderVal; for (unsigned int j = 0; j < folds; j++){ /* Estimate the current cut */ Alpha(&p); TVariables res(0); Classify(xSlider, p, &res); for (unsigned int k = 0; k < sliderSize; k++){error += abs(res[k] - ySlider[k])/2;} /* Increment the pointer */ if (j == shortFolds){break;} /* Replace the slider */ if (j == chSizeVal){ for (unsigned int l = 0; l < d; l++){x[l].push_back(xSlider[sliderSize - 1][l]);} y.push_back(ySlider[sliderSize - 1]); n++; difference += ySlider[sliderSize - 1]; if (ySlider[sliderSize - 1] > 0){numMore++;}else{numLess++;} sliderSize--; xSlider.erase(xSlider.begin() + sliderSize); ySlider.erase(ySlider.begin() + sliderSize); // for (unsigned int j = 0; j < d; j++){x[j].shrink_to_fit();} y.shrink_to_fit(); - IT IS TOO DANGEROUS } for (unsigned int k = 0; k < sliderSize; k++){ for (unsigned int l = 0; l < d; l++){tmpXSliderVal = x[l][k*shortFolds + j]; x[l][k*shortFolds + j] = xSlider[k][l]; xSlider[k][l] = tmpXSliderVal;} difference += ySlider[k]; if (ySlider[k] > 0){numMore++;}else{numLess++;} tmpYSliderVal = y[k*shortFolds + j]; y[k*shortFolds + j] = ySlider[k]; ySlider[k] = tmpYSliderVal; difference -= ySlider[k]; if (ySlider[k] > 0){numMore--;}else{numLess--;} } } /* Check if we've got a better result */ if (error < optError){optError = error; optDegree = i + 1; if (optError == 0){break;}} } OUT_ALPHA = oldOUT_ALPHA; /* Eventually get the classification ray */ Initialization(spaceExtensions[optDegree - 1], output, minFeatures); // initialize power[0] = optDegree; return Alpha(ray); } ddalpha/src/TukeyDepth.cpp0000644000176200001440000001151114213423775015237 0ustar liggesusers/* File: TukeyDepth.cpp Created by: Pavlo Mozharovskyi First published: 28.02.2013 Last revised: 13.11.2015 Computation of the random Tukey data depth. For a description of the algorithm, see: Cuesta-Albertos, J. A. and Nieto-Reyes, A. (2008). The random Tukey depth. Computational Statistics & Data Analysis 52, 11 (July 2008), 4979-4988. Mozharovskyi, P., Mosler, K. and Lange, T. (2013). Classifying real-world data with the DDalpha-procedure. Mimeo. */ #include "stdafx.h" static int CompareAsc(OrderRec x, OrderRec y) { return (x.value < y.value); } static int CompareDec(OrderRec x, OrderRec y) { return (x.value > y.value); } void GetPrjDepths(double* projection, int n, TVariables& cardinalities, unsigned curClass, TVariables *prjDepths){ //Collecting basic statistics int beginIndex = 0; for (unsigned i = 0; i < cardinalities.size(); i++){ if (i >= curClass){break;} beginIndex += cardinalities[i]; } int endIndex = beginIndex + cardinalities[curClass] - 1; //Preparing structures vector prjSort(n); for (int i = 0; i < n; i++){ prjSort[i].order = i; prjSort[i].value = projection[i]; } //Calculating projection depths TVariables depthsForwards(n); TVariables depthsBackwards(n); //Forwards sort(prjSort.begin(), prjSort.end(), CompareAsc); int curDepth = 0; for (int i = 0; i < n; i++){ if ((prjSort[i].order >= beginIndex) && (prjSort[i].order <= endIndex)){curDepth++;} depthsForwards[prjSort[i].order] = curDepth; } //Backwards sort(prjSort.begin(), prjSort.end(), CompareDec); curDepth = 0; for (int i = 0; i < n; i++){ if ((prjSort[i].order >= beginIndex) && (prjSort[i].order <= endIndex)){curDepth++;} depthsBackwards[prjSort[i].order] = curDepth; } //Merge for (int i = 0; i < n; i++){ if (depthsForwards[i] < depthsBackwards[i]){ (*prjDepths)[i] = depthsForwards[i]; }else{ (*prjDepths)[i] = depthsBackwards[i]; } } } inline void GetPtPrjDepths(double* projection, int n, double point, TVariables& cardinalities, double* ptPrjDepths){ int q = cardinalities.size(); for (int i = 0; i < q; i++){ int beginIndex = 0; for (int j = 0; j < q; j++){ if (j >= i){break;} beginIndex += cardinalities[j]; } int endIndex = beginIndex + cardinalities[i]; int nPtsBelow = 0; int nPtsAbove = 0; for (int j = beginIndex; j < endIndex; j++){ if (projection[j] <= point){nPtsBelow++;} if (projection[j] >= point){nPtsAbove++;} } ptPrjDepths[i] = (nPtsBelow <= nPtsAbove)?(double)nPtsBelow:(double)nPtsAbove; } } //Indexing from zero void GetDSpace(TDMatrix points, int n, int d, TVariables& cardinalities, int k, bool atOnce, TDMatrix dSpace, TDMatrix directions, TDMatrix projections){ //1. Collecting basic statistics int q = cardinalities.size(); if (!atOnce){ TDMatrix ptPrjDepths = newM(k, q); for (int i = 0; i < n; i++){ /* TMatrix dir(k, TPoint(d)); TMatrix proj(k, TPoint(q));*/ GetDepths(points[i], points, n, d, cardinalities, k, false, directions, projections, dSpace[i], ptPrjDepths); } deleteM(ptPrjDepths); return; } GetDirections(directions, k, d); GetProjections(points, n, d, directions, k, projections); //2. Calculate projection depths vector > prjDepths(k, vector(q, TVariables(n))); for (int i = 0; i < k; i++){ for (int j = 0; j < q; j++){ GetPrjDepths(projections[i], n, cardinalities, j, &prjDepths[i][j]); } } //3. Merge depths for (int i = 0; i < n; i++){ for (int j = 0; j < q; j++){ dSpace[i][j] = cardinalities[j] + 1; } } for (int i = 0; i < k; i++){ for (int j = 0; j < q; j++){ for (int l = 0; l < n; l++){ if (prjDepths[i][j][l] < dSpace[l][j]){ dSpace[l][j] = prjDepths[i][j][l]; } } } } for (int i = 0; i < q; i++){ for (int j = 0; j < n; j++){ dSpace[j][i] /= cardinalities[i]; } } } void GetDepths(double* point, TDMatrix points, int n, int d, TVariables& cardinalities, int k, bool atOnce, TDMatrix directions, TDMatrix projections, double* depths, TDMatrix ptPrjDepths /*accu, k*q */){ //1. Collecting basic statistics int q = cardinalities.size(); if (!atOnce){ GetDirections(directions, k, d); GetProjections(points, n, d, directions, k, projections); } //2. Calculate projection depths TPoint pointProjections(k); for (int i = 0; i < k; i++){ double curPrj = 0; for (int j = 0; j < d; j++){ curPrj += point[j]*directions[i][j]; } pointProjections[i] = curPrj; } for (int i = 0; i < k; i++){ GetPtPrjDepths(projections[i], n, pointProjections[i], cardinalities, ptPrjDepths[i]); } //3. Merge depths for (int i = 0; i < q; i++){ depths[i] = cardinalities[i] + 1; } for (int i = 0; i < k; i++){ for (int j = 0; j < q; j++){ if (ptPrjDepths[i][j] < depths[j]){ depths[j] = ptPrjDepths[i][j]; } } } for (int i = 0; i < q; i++){ depths[i] /= (double)cardinalities[i]; } } ddalpha/src/DataStructures.h0000644000176200001440000000357214213423775015603 0ustar liggesusers/* File: DataStructures.cpp Created by: Pavlo Mozharovskyi First published: 28.02.2013 Last revised: 28.02.2013 Defines the data structures used in the package. */ #pragma once #ifndef PI2 #define PI2 1.5707963267948966192313216916398 #endif #ifndef PI #define PI (PI2*2) #endif typedef vector TPoint; typedef vector > TMatrix; typedef vector > TIntMatrix; typedef vector TVariables; typedef double** TDMatrix; typedef double*** T3DMatrix; // by rows TDMatrix asMatrix(double* arr, int n, int d); T3DMatrix as3DMatrix(double* arr, int n, int t, int d); double** newM(int n, int d); void deleteM(TDMatrix X); TDMatrix copyM(TDMatrix X, int n, int d); void printMatrix(TDMatrix mat, int n, int d); namespace bnu = boost::numeric::ublas; typedef boost::numeric::ublas::matrix bMatrix; typedef boost::numeric::ublas::vector bVector; typedef boost::numeric::ublas::permutation_matrix bPM; struct UPoint{ int pattern; double value; UPoint(int pattern = 0, double value = 0){ this->pattern = pattern; this->value = value; } }; struct Feature{ unsigned int order; int number; double angle; unsigned int error; Feature(unsigned int order = 0, int number = 0, double angle = 0, unsigned int error = INT_MAX){ this->order = order; this->number = number; this->angle = angle; this->error = error; } }; struct OrderRec { int order; double value; OrderRec(int order = -1, double value = 0) { this->order = order; this->value = value; } }; struct SortRec { double v; TPoint* p; SortRec(double v = 0, TPoint* p = NULL) { this->v = v; this->p = p; } }; struct SortRecClassified { int c; double v; SortRecClassified(int c = 0, double v = 0, int p = 0) { this->c = c; this->v = v; } }; typedef vector Features; typedef vector UPoints; ddalpha/src/SimplicialDepth.cpp0000644000176200001440000001230414213423775016225 0ustar liggesusers #include "stdafx.h" /* -------------------------------------------------------------------------- */ /* Calculates multivariate Liu (=simplicial) depth going through all */ /* possible simplices */ /* -------------------------------------------------------------------------- */ void SimplicialDepthsEx(TDMatrix X, TDMatrix x, int d, int n, int nx, double *depths){ double* b = new double[d + 1]; b[d] = 1; double* z = new double[d + 1]; int* counters = new int[d + 1]; TDMatrix A = newM(d + 1, d + 1); unsigned long long div0 = choose(n, d + 1); for (int obs = 0; obs < nx; obs++){ unsigned long long theCounter = 0; unsigned long long numSimplicesChecked = 0; for (int i = 0; i < d; i++){ counters[i] = i; }counters[d] = d - 1; while (counters[0] != n - (d + 1)){ int i = d; while (i > 0 && counters[i] == n - (d + 1) + i){ i--; } counters[i]++; int j = i + 1; while (j < d + 1){ counters[j] = counters[j - 1] + 1; j++; } for (int j = 0; j < d; j++){ for (int k = 0; k < d + 1; k++){ A[j][k] = X[counters[k]][j]; } } for (int k = 0; k < d + 1; k++){ A[d][k] = 1; } memcpy(b, x[obs], d*sizeof(double)); b[d] = 1; if (solveUnique(A, b, z, d + 1)){ bool isInside = true; for (int j = 0; j < d + 1; j++){ if (z[j] < 0){ isInside = false; break; } } if (isInside){ theCounter++; } } (numSimplicesChecked) ++; } bool sc = numSimplicesChecked == div0; double depth = (double)theCounter / div0; depths[obs] = depth; } delete[] b; delete[] z; delete[] counters; deleteM(A); } /* -------------------------------------------------------------------------- */ /* Estimates multivariate Liu (=simplicial) depth based on 'k' randomly */ /* drawn simplices */ /* -------------------------------------------------------------------------- */ void SimplicialDepthsApx(TDMatrix X, TDMatrix x, int d, int n, int nx, unsigned long long k, double *depths){ double* b = new double[d + 1]; b[d] = 1; double* z = new double[d + 1]; int* counters = new int[d + 1]; double* a = new double[(d + 1)*(d + 1)]; TDMatrix A = asMatrix(a, d + 1, d + 1); for (int obs = 0; obs < nx; obs++){ unsigned long long theCounter = 0; for (unsigned long long i = 0; i < k; i++){ // Generate a combination of indices for (int j = 0; j < d + 1; j++){ bool _new = false; do{ _new = true; counters[j] = random(n); for (int l = 0; l < j; l++){ if (counters[l] == counters[j]){ _new = false; break; } } } while (!_new); } // Construct the simplex out of it for (int j = 0; j < d; j++){ for (int l = 0; l < d + 1; l++){ A[j][l] = X[counters[l]][j]; } } for (int l = 0; l < d + 1; l++){ A[d][l] = 1; } memcpy(b, x[obs], d*sizeof(double)); b[d] = 1; // Check whether 'x' lies inside of this simplex solveUnique(A, b, z, d + 1); bool isInside = true; for (int j = 0; j < d + 1; j++){ if (z[j] < 0){ isInside = false; break; } } if (isInside){ theCounter++; } } double depth = (double)theCounter / k; depths[obs] = depth; } delete[] b; delete[] z; delete[] counters; delete[] A; delete[] a; } //#include /******************************************************************************************************************************************************* * * intSD2 * ******************************************************************************************************************************************************/ unsigned long long intSD2(double** x, int n) { const double eps = 1e-10; double* alpha = new double[n]; int nt = 0; // Wie oft ist 0 in Points enthalten ? int nh = 0; // Wie viele Punkte im Halbraum ? // Winkel alpha berechnen und array initialisieren for (int i = 0; i < n; i++) { if (hypot(x[i][0], x[i][1]) <= eps) nt++; else { alpha[i - nt] = atan2(x[i][1], x[i][0]); // alpha in (-pi,pi] if (alpha[i - nt] < -M_PI + eps) alpha[i - nt] = M_PI; // Korrektur f?r Zahlen wie (-1, -1e-16) if (alpha[i - nt] <= eps) nh++; } } unsigned long long nn = n - nt; // Winkel sortieren sort(alpha, alpha + nn); // Simpliziale Tiefe berechnen unsigned long long result = nn * (nn - 1) * (nn - 2) / 6; unsigned long long j = nh; for (int i = 0; i < nh; i++) { while ((j <= nn - 1) && (alpha[j] - M_PI <= alpha[i] - eps)) j++; result -= (j - i - 1) * (j - i - 2) / 2; } j = 0; for (int i = nh; i < nn; i++) { while ((j <= nh - 1) && (alpha[j] + M_PI <= alpha[i] - eps)) j++; result -= (nn + j - i - 1) * (nn + j - i - 2) / 2; } delete[] alpha; result += choose(nt, 1)*choose(nn, 2) + choose(nt, 2)*choose(nn, 1) + choose(nt, 3); return result; } void SimplicialDepths2(TDMatrix X, TDMatrix x, int n, int nx, double *depths) { if (n <= 0) throw invalid_argument("n <= 0"); double c = (double)(n * (n - 1) * (n - 2) / 6); // Anzahl aller Simplizes double** xz = newM(n, 2); for (int zi = 0; zi < nx; zi++){ // z in Ursprung verschieben for (int i = 0; i < n; i++) for (int j = 0; j < 2; j++) xz[i][j] = X[i][j] - x[zi][j]; unsigned long long result = intSD2(xz, n); depths[zi] = result / c; } deleteM(xz); } ddalpha/src/ZonoidDepth.cpp0000644000176200001440000003261214213423775015405 0ustar liggesusers/* File: depth.cpp Created by: Rainer Dyckerhoff Last revised: 15.05.2013 Computation of the zonoid data depth. For a description of the algorithm, see: Dyckerhoff, R., Koshevoy, G., and Mosler, K. (1996) Zonoid Data Depth: Theory and Computation, in: A. Compstat - Proceedings in Computational Statistics (Albert Prat, ed.), Physica-Verlag, Heidelberg, pp. 235--240. */ #include "stdafx.h" /* Definition of constants */ static const double eps = 1e-8; static const double accuracy = 1e-10; static const int MaxIt = 1000; /* Definition of types */ typedef vector > TMatrix; //typedef double TRevSimplexTableau[MaxD + 2][MaxD + 3]; typedef vector TVariablen; // typedef int TVariablen[MaxD + 1]; /* Definition of static variables */ static int n, d, ItCount; static double lowerbound; static TMatrix rs; static TVariablen bv; static vector x_sort; static vector RowInverted; /* Definition of static functions */ static void RSInit(TPoint& z) /* Initialize the revised simplex tableau. */ { int i, j; /* Basis = Identity matrix. */ rs.resize(d+2); for (i = 0; i < d+2; i++) rs[i].resize(d+3); for (i = 1; i <= d + 1; i++) for (j = 1; j <= d + 1; j++) rs[i][j] = (i == j); /* All simplex multipliers are equal to unity. */ for (j = 1; j <= d + 1; j++) rs[0][j] = 1; /* RHS = z,1 */ /* Objective = 1 + sum of the z_i */ rs[0][d + 2] = rs[d + 1][d + 2] = 1; for (i = 1; i <= d; i++) rs[0][d + 2] += rs[i][d + 2] = z[i-1]; /* Initially all basis variables are artificial variables. */ bv.resize(d+1); for (i = 0; i <= d; i++) bv[i] = -1; } static void MakeCanonical(vector& x, TPoint& z) /* Convert master problem to canonical form. */ { int i, j; RowInverted.resize(d); for (j = 0; j < d; j++) { RowInverted[j] = z[j] < 0; // PM(2018-06-22) if (RowInverted[j]) { for (i = 0; i < n; i++) x[i][j] = -x[i][j]; z[j] = -z[j]; } } } static void MakeOriginal(vector& x, TPoint& z) /* Reconstruct the original data. */ { int i, j; for (j = 0; j < d; j++) if (RowInverted[j]) { for (i = 0; i < n; i++) x[i][j] = -x[i][j]; z[j] = -z[j]; } } static void CancelRow(int ip) /* Delete a zero row from the RS tableau. */ { int i, j; for (i = 0; i <= d + 1; i++) rs[i][ip] = 0; for (j = 1; j <= d + 2; j++) rs[ip][j] = 0; } static int Compare(SortRec a, SortRec b) /* This routine is passed to the sort routine. */ { return (a.v > b.v) ; } static bool AddColumn(vector& x) /* Solve the subproblem, generate the pivot column and adjoin it to the to the RS tableau. */ { int card, i, j, k; double max, sum, rtmp; /* Generate the coefficient of the subproblem's objective. */ for (k = 0; k < n; k++) { for (x_sort[k].v = 0, j = 0; j < d; j++) x_sort[k].v += rs[0][j + 1] * x[k][j]; x_sort[k].p = &x[k]; } /* Sort the coefficients in decreasing order. */ sort(x_sort.begin(), x_sort.end(), Compare); /* Find the maximum of the subproblem as well as the extreme point at which it is assmed. */ card = 0; max = -rs[0][d + 1]; sum = -1; for (k = 1; k <= n; k++) if ((rtmp = (sum += x_sort[k-1].v) / k) > max) { max = rtmp; card = k; } max += rs[0][d + 1]; /* If the maximum is less than zero, the value of the objective of the MP cannot be decreased. */ if (max < eps) return false; /* Solution found. */ /* If the relative error is less than 'accuracy', the iteration is stopped as well. */ if (rs[0][d + 2] - max > lowerbound) lowerbound = rs[0][d + 2] - max; if ((rs[0][d + 2] - lowerbound) / lowerbound < accuracy) return false; /* If the number of iterations exceeds 'MaxIt', the iteration is stopped. */ if ( ++ItCount > MaxIt ) return false; /* Generate the new pivot column for the MP. */ rs[0][0] = max; for (i = 1; i <= d + 1; i++) rs[i][0] = rs[i][d + 1]; for (j = 0; j < d; j++) { for (sum = 0, k = 0; k < card; k++) sum += x_sort[k].p->operator[](j); for (sum /= card, i = 1; i <= d + 1; i++) rs[i][0] += rs[i][j + 1] * sum; } return true; } static bool NonBasis(int v) /* Check whether 'v' is a basis variable. */ { int i; for (i = 0; i <= d; i++) if (bv[i] == v) return false; return true; } static bool PhaseIGeneratePivotColumn(vector& x, int *PivotColumn) /* Generate the new pivot column in phase I of the simplex algorithm. */ { int i, j, k; double rtmp; /* Find the pivot column */ rs[0][0] = -rs[0][d + 1]; *PivotColumn = 0; for (k = 1; k <= n; k++) if (NonBasis(k)) { for (rtmp = 0, j = 1; j <= d; j++) rtmp += rs[0][j] * x[k-1][j-1]; if (rtmp > rs[0][0]) { rs[0][0] = rtmp; *PivotColumn = k; } } if ((rs[0][0] += rs[0][d + 1]) < eps) return false; /* Generate the pivot column */ for (i = 1; i <= d + 1; i++) { rs[i][0] = rs[i][d + 1]; for (j = 1; j <= d; j++) rs[i][0] += rs[i][j] * x[*PivotColumn-1][j-1]; } return true; } static int FindPivotRow() /* Find the pivot row. */ { int i; double min, quot; vector I; I.resize(d+1); min = DBL_MAX; for (i = 1; i <= d + 1; i++) if (rs[i][0] > eps) { quot = rs[i][d + 2] / rs[i][0]; if (quot <= min+eps) { if (quot < min-eps) { I.clear(); min = quot; } I.push_back(i); } } if (I.size() <= 1) return I[0]; else return I[random(I.size())]; } static void RSStep(int PivotRow, int PivotColumn) /* Update the revised simplex tableau. */ { int i, j; double pivot; /* Calculate the new tableau. */ pivot = rs[PivotRow][0]; for (j = 1; j <= d + 2; j++) { rs[PivotRow][j] /= pivot; for (i = 0; i <= d + 1; i++) if (i != PivotRow) rs[i][j] -= rs[PivotRow][j] * rs[i][0]; } /* 'PivotColumn' goes into the basis. */ bv[PivotRow - 1] = PivotColumn; } static bool NoZeroRow(vector& x, int * PivotRow, int * PivotColumn) /* Check if a given row of the is a zero row. If a nonzero element is found, it is returned in '*PivcotColumn'. */ { int i, j, k; double rtmp; /* Find a non-zero element. */ *PivotColumn = 0; for (k = n; k > 0; k--) if (NonBasis(k)) { rtmp = rs[*PivotRow][d + 1]; for (j = 1; j <= d; j++) rtmp += rs[*PivotRow][j] * x[k-1][j-1]; if (fabs(rtmp) > eps) { *PivotColumn = k; for (i = 0; i <= d + 1; i++) { rs[i][0] = rs[i][d + 1]; for (j = 1; j <= d; j++) rs[i][0] += rs[i][j] * x[*PivotColumn-1][j-1]; } return true; } } return false; } /* Standardizing functions */ int GetMeansSds(vector& x, TPoint *means, TPoint *sds){ /* Get means and standard deviations, coordinatewise */ int _n = x.size();int _d = x[0].size();means->resize(_d);sds->resize(_d); for (int j = 0; j < _d; j++){ double tmpMean = 0;double tmpVar = 0; for (int i = 0; i < _n; i++){ tmpMean += x[i][j]; } (*means)[j] = tmpMean/_n; for (int i = 0; i < _n; i++){ tmpVar += std::pow(x[i][j] - (*means)[j], 2); } (*sds)[j] = sqrt(tmpVar/(_n - 1)); } return 0; } int Standardize(vector &x, TPoint& means, TPoint& sds){ /* Standardize data cloud, coordinatewise */ int _n = x.size();int _d = x[0].size(); for (int i = 0; i < _n; i++){ for (int j = 0; j < _d; j++){ x[i][j] = (x[i][j] - means[j])/sds[j]; } } return 0; } int GetMeansSds(TDMatrix& x, int n, int d, TPoint *means, TPoint *sds){ /* Get means and standard deviations, coordinatewise */ for (int j = 0; j < d; j++){ double tmpMean = 0; double tmpVar = 0; for (int i = 0; i < n; i++){ tmpMean += x[i][j]; } (*means)[j] = tmpMean / n; for (int i = 0; i < n; i++){ tmpVar += std::pow(x[i][j] - (*means)[j], 2); } (*sds)[j] = sqrt(tmpVar / (n - 1)); } return 0; } int Standardize(TDMatrix &x, int n, int d, TPoint& means, TPoint& sds){ /* Standardize data cloud, coordinatewise */; for (int i = 0; i < n; i++){ for (int j = 0; j < d; j++){ x[i][j] = (x[i][j] - means[j]) / sds[j]; } } return 0; } int Standardize(TPoint &x, TPoint& means, TPoint& sds){ /* Standardize point, coordinatewise */ int _d = x.size(); for (int i = 0; i < _d; i++){ x[i] = (x[i] - means[i])/sds[i]; } return 0; } int Unstandardize(vector &x, TPoint& means, TPoint& sds){ /* Unstandardize data cloud, coordinatewise */ int _n = x.size();int _d = x[0].size(); for (int i = 0; i < _n; i++){ for (int j = 0; j < _d; j++){ x[i][j] = x[i][j]*sds[j] + means[j]; } } return 0; } int Unstandardize(TPoint &x, TPoint& means, TPoint& sds){ /* Unstandardize point, coordinatewise */ int _d = x.size(); for (int i = 0; i < _d; i++){ x[i] = x[i]*sds[i] + means[i]; } return 0; } /* Definition of public functions */ double ZonoidDepth(vector& x, TPoint& z, int& Error) /* Calculate the zonoid data depth of the point 'z' with respect to the data points 'x'. The number of data points is passed in 'NoPoints', the dimension in 'Dimension'. If an error occurs, the error code is stored in '*Error'. Possible error codes are: 0: no error, 1: simplex algorithm did not terminate within 'MaxIt' iterations. 2: not enough memory available, If no error occured, the return value is the zonoid data depth of 'z'. If the error code is 1, the return value is an lower bound to the zonoid data depth of 'z'. If the error code is 2, the return value is -1. */ { int j, k, row, PivotColumn; n = x.size(); d = z.size(); Error = 0; MakeCanonical(x,z); /* Convert tableau to canonical form. */ /* Phase I */ RSInit(z); /* Initialize tableau und basis variables. */ /* Try to eliminate the artificial variables from the basis to get a basic feasible solution. */ while (PhaseIGeneratePivotColumn(x, &PivotColumn)) RSStep(FindPivotRow(), PivotColumn); /* If the maximum objective is greater than zero, no basic feasible solution exists. Thus, 'z' lies outside the convex hull of 'x' and the zonoid data depth is 0. */ if (fabs(rs[0][d + 2]) > eps) { MakeOriginal(x,z); /* Reconstruct the original data. */ return 0; /* Return zonoid data depth. */ } /* Check if there are still artificial variables on zero level in the basis and remove them from the basis. */ for (row = 1; row <= d + 1; row++) if (bv[row - 1] < 0) { if (NoZeroRow(x, &row, &PivotColumn)) RSStep(row, PivotColumn); else CancelRow(row); } /* Phase II */ /* Try to allocate memory for 'x_sort'. */ x_sort.resize(n); if (x_sort.size() == n) { /* Allocation successful. */ lowerbound = 1.0 / n; /* Lower bound for the objective of the MP. */ /* Reinitialize the objective of the MP. */ for (j = 1; j <= d + 2; j++) for (rs[0][j] = 0, k = 1; k <= d + 1; k++) rs[0][j] += rs[k][j]; /* Revised simplex algorithm */ ItCount = 0; while (AddColumn(x)) RSStep(FindPivotRow(), 0); if ( ItCount > MaxIt ) Error = 1; // free(x_sort); /* Free the memory allocated for 'x_sort'. */ MakeOriginal(x,z); /* Reconstruct the original data. */ return 1 / (n * rs[0][d + 2]); /* Return zonoid data depth. */ } else { /* Memory for 'x_sort' could not be allocated. */ Error = 2; MakeOriginal(x,z); /* Reconstruct original data. */ return -1; } } int InConvexes(TMatrix& points, TVariables& cardinalities, TMatrix& objects, int& Error, TIntMatrix *areInConvexes) /* Check if the points are inside of the convex hull. 1: Point lies inside of the convex hull of the data 0: Point lies beyond the convex hull of the data */ { d = points[0].size(); // Prepare a structure indicating if each point lies inside the convex hull of each class int m = objects.size(); int q = cardinalities.size(); areInConvexes->resize(m); for (int i = 0; i < m; i++){(*areInConvexes)[i].resize(q);} TIntMatrix &separateAnswers = (*areInConvexes); // a link to output. just not to rewrite all occurances of separateAnswers // Split into separate data sets and // check if each point lies inside each of the convex hulls int startIndex = 0; for (int i = 0; i < q; i++){ // Cycling through data sets n = cardinalities[i]; TMatrix x(n); for (int j = 0; j < cardinalities[i]; j++){ x[j] = points[startIndex + j]; } /* Standardize */ TPoint means(d);TPoint sds(d); GetMeansSds(x, &means, &sds); Standardize(x, means, sds); for (int j = 0; j < m; j++){ // Cycling through points int PivotColumn; TPoint z = objects[j]; /* Standardize */ Standardize(z, means, sds); /* Rainer's codes (slightly modified) */ Error = 0; MakeCanonical(x,z); /* Convert tableau to canonical form. */ /* Phase I */ RSInit(z); /* Initialize tableau und basis variables. */ /* Try to eliminate the artificial variables from the basis to get a basic feasible solution. */ while (PhaseIGeneratePivotColumn(x, &PivotColumn)) RSStep(FindPivotRow(), PivotColumn); /* If the maximum objective is greater than zero, no basic feasible solution exists. Thus, 'z' lies outside the convex hull of 'x'. */ if (fabs(rs[0][d + 2]) > eps) { MakeOriginal(x,z); /* Reconstruct the original data. */ Unstandardize(z, means, sds); separateAnswers[j][i] = 0; /* Point lies outside the convex hull. */ }else{ MakeOriginal(x,z); /* Reconstruct the original data. */ Unstandardize(z, means, sds); separateAnswers[j][i] = 1; /* Point lies inside of the convex hull of the data. */ } } startIndex+=cardinalities[i]; } return 0; } ddalpha/src/Polynomial.cpp0000644000176200001440000002764314213423775015311 0ustar liggesusers/* File: Polynomial.cpp Created by: Oleksii Pokotylo First published: 07.05.2014 Last revised: 07.05.2014 Contains the polynomial classifier the DD-plot classification. For a description of the algorithm, see: Li, J., Cuesta-Albertos, J. A. and Liu, R. Y. (2012). DD-classifier: Nonparametric classification procedure based on DD-plot, Journal of the American Statistical Association 107(498): 737 - 753. */ #include "stdafx.h" #include #include #include "asa047.h" #ifndef _MSC_VER #include using namespace Rcpp; #endif /** Calculates the empirical risk for two classes on the basis of given depths @param polynomial : Polynomial as a vector of coefficients starting with the first degree(a0 = 0 always) @param points : nx2 matrix of depths, where each column contains the depths against the corresponding class @param numClass1: Number of points belonging to the first class @return polynomial as a vector of coefficients starting with the first degree (a0 = 0 always) @throws empirical risk */ double GetEmpiricalRisk(TPoint& polynomial, TDMatrix points, unsigned numClass1, unsigned numClass2){ unsigned degree = polynomial.size(); unsigned n = numClass1 + numClass2; double risk = 0; int sign = 1; for (unsigned i = 0; i < n; i++){ if (i >= numClass1) sign = -1; double val = points[i][0]; double res = 0; for (unsigned j = 0; j 0){ // for class1 depths[i,2] > res, for class 2 < risk++; } } return risk / n; } /** Calculates the coefficients of the polynomial of a given degree going through given points and the origin @param degree : degree of the polynomial, should be equal the number of points @param points : degreex2 points for the polynomial to path through @return polynomial as a vector of coefficients starting with the first degree (a0 = 0 always) @throws runtime_error in case of singularity */ bool GetPolynomial(unsigned degree, TDMatrix points, TPoint& polynomial) { bMatrix A(degree, degree); for (unsigned i = 0; i < degree; i++){ for (unsigned j = 0; j < degree; j++){ A(i, j) = (std::pow(points[i][0], j + 1)); } } bVector b(degree); for (unsigned i = 0; i < degree; i++){ b[i] = points[i][1]; } bPM pm(A.size1()); bPM::size_type singular = boost::numeric::ublas::lu_factorize(A, pm); if (singular != 0) return false; boost::numeric::ublas::lu_substitute(A, pm, b); for (unsigned i = 0; i < degree; i++){ if (!(b[i] < std::numeric_limits::max()) || b[i] < -std::numeric_limits::max()){ return false; } polynomial[i] = b[i]; } return true; } /** Chooses the best in classification sense polynomial among "cardinality" randomly chosen polynomials, passing through "degree" arbitrary points @param points: nx2 matrix of points where first column is an absciss, n = numClass1 + numClass2 @param numClass1: Number of points belonging to the first class @param degree: Degree of the polynomial @param n_polynomials: Number of randomly chosen polynomials @return polynomial as a vector of coefficients starting with the first degree (a0 = 0 always) */ TPoint GetRandomMinPolynomial(TDMatrix points, int numClass1, int numClass2, int degree, int n_polynomials){ int n = numClass1 + numClass2; vector usedIndexesX(n); vector usedIndexesY(n); int nx = 0, ny = 0; for (int i = 0; i(nx - 1, degree - 1) * ny * 0.3; int numCandidates = (numOfCombinations > n_polynomials ? n_polynomials : numOfCombinations); TPoint minPolynomial(degree); double minEmpRisk = 1; TDMatrix sample = new double*[degree]; for (int i = 0; i < numCandidates; i++){ // generate sample set smp; smp.insert(usedIndexesY[random(ny)]); while ((int)smp.size() < degree){ smp.insert(usedIndexesX[random(nx)]); } set ::const_iterator s = smp.begin(); for (int j = 0; j < degree; j++, s++) { sample[j] = points[*s]; } try{ TPoint pol(degree); if(!GetPolynomial(degree, sample, pol)) continue; double rsk = GetEmpiricalRisk(pol, points, numClass1, numClass2); if (rsk < minEmpRisk) { minPolynomial = pol; minEmpRisk = rsk; } } catch (runtime_error &e){ /* singular matrix*/ } catch (...){ /* NA or inf */ } } delete[] sample; return minPolynomial; } static int _degree; static TDMatrix _points; static int _numClass1; static int _numClass2; /** Calculates the empirical risk for two classes on the basis of given depths and approximates it to get continuous derivative @param polynomial : Polynomial as a vector of coefficients starting with the first degree(a0 = 0 always) @param _points : nx2 matrix of depths, where each column contains the depths against the corresponding class @param _numClass1: Number of points belonging to the first class @param _numClass2: Number of points belonging to the first class @return polynomial as a vector of coefficients starting with the first degree (a0 = 0 always) */ double GetEmpiricalRiskSmoothed(double polynomial[]){ const float smoothingConstant = 100; double risk = 0; int sign = 1; for (int i = 0; i < _numClass1 + _numClass2; i++){ if (i >= _numClass1) sign = -1; double val = (_points)[i][0]; double res = 0; for (int j = 0; j < _degree; j++){ res += polynomial[j] * std::pow(val, j+1); } risk += 1 / (1 + exp(-smoothingConstant*((_points)[i][1] - res)*sign)); } return risk / _numClass1 + _numClass2; } TPoint nlm_optimize(TDMatrix points, TPoint& minCandidate, int numClass1, int numClass2){ /* static variables for GetEmpiricalRiskSmoothed */ _points = points; _numClass1 = numClass1; _numClass2 = numClass2; _degree = minCandidate.size(); double* start = new double[_degree]; std::copy(minCandidate.begin(), minCandidate.end(), start); int icount; int ifault; int kcount; int konvge; int n = _degree; int numres; double reqmin; double *step; double *xmin; double ynewlo; step = new double[n]; xmin = new double[n]; reqmin = 1.0E-06; for (int i = 0; i < n; i++) { // determines the size and shape of the initial simplex. // The relative magnitudes of its elements should reflect the units of the variables. step[i] = 1.0; } konvge = 10; kcount = 500; /* cout << "\n"; cout << " Starting point X:\n"; cout << "\n"; for (i = 0; i < n; i++) { cout << " " << start[i] << ""; } cout << "\n"; ynewlo = GetEmpiricalRiskSmoothed(start); cout << "\n"; cout << " F(X) = " << ynewlo << "\n"; */ nelmin(GetEmpiricalRiskSmoothed, n, start, xmin, &ynewlo, reqmin, step, konvge, kcount, &icount, &numres, &ifault); /* cout << "\n"; cout << " Return code IFAULT = " << ifault << "\n"; cout << "\n"; cout << " Estimate of minimizing value X*:\n"; cout << "\n"; for (i = 0; i < n; i++) { cout << " " << setw(14) << xmin[i] << "\n"; } cout << "\n"; cout << " F(X*) = " << ynewlo << "\n"; cout << "\n"; cout << " Number of iterations = " << icount << "\n"; cout << " Number of restarts = " << numres << "\n"; */ TPoint minpol = TPoint(xmin, xmin + _degree); delete[] start; delete[] step; delete[] xmin; return minpol; } /** Chooses the best in classification sense polynomial @param points: nx2 matrix of points where first column is an abscissa, n = numClass1 + numClass2 @param numClass1: Number of points belonging to the first class @param degree: Degree of the polynomial @param presize: if true - run evaluation 5 times @return polynomial as a vector of coefficients starting with the first degree (a0 = 0 always) */ TPoint GetOptPolynomial(TDMatrix points, unsigned numClass1, unsigned numClass2, unsigned degree, bool presize /*default = FALSE*/){ double minError = 100.1; TPoint minPol; for (int i = 0; i < (presize ? 3 : 1); i++){ TPoint minCandidate = GetRandomMinPolynomial(points, numClass1, numClass2, degree, 10 ^ degree); double err = GetEmpiricalRisk(minCandidate, points, numClass1, numClass2); if (err < minError){ minPol = minCandidate; minError = err; } //#define DEBUG #ifdef DEBUG Rcpp::Rcout << "candminPol: "; for (int i = 0; i< degree; i++){ Rcpp::Rcout << minCandidate[i] << " "; } Rcpp::Rcout << " ; error = "<< err << " \n"; #endif TPoint optPolynomial = nlm_optimize(points, minCandidate, numClass1, numClass2); err = GetEmpiricalRisk(optPolynomial, points, numClass1, numClass2); if (err <= minError){ minPol = optPolynomial; minError = err; } #ifdef DEBUG Rcpp::Rcout << "minPol: "; for (int i = 0; i< minPol.size(); i++){ Rcpp::Rcout << minPol[i] << " "; } Rcpp::Rcout << " ; error = "<< minError << " \n"; #endif } return(minPol); } /** Calculates classification error of "degree" - degree polynomial using cross - validation approach @param points: nx2 matrix of points where first column is an absciss, n = numClass1 + numClass2 @param numClass1: Number of points belonging to the first class @param degree: Degree of the polynomial @param chunkNumber: Number of chunks in which data set should be splitted, chunkNumber should be a divider of n(n%%chunkNumber = 0) @return Number of errors */ double GetCvError(TDMatrix points, int numClass1, int numClass2, int degree, int chunkNumber){ int n = numClass1 + numClass2; int chunkSize = ceil((double)n / chunkNumber); TDMatrix learnpoints = new double*[n - chunkSize+1]; TDMatrix checkpoints = new double*[chunkSize]; int chunk = 0; int n1 = 0; // number of Class1 points in checkpoints for (int j = 0, l = 0, c = 0; j < n; j++){ if (j%chunkNumber) learnpoints[l++] = points[j]; else checkpoints[c++] = points[j]; if (j < numClass1 && (j%chunkNumber == 0)) n1++; } double err = 0; bool bigch = true; for (; chunk < chunkNumber; chunk++){ if (chunk > 0){ if (bigch && (chunkNumber)*(chunkSize - 1) + chunk == n){ bigch = false; chunkSize--; //checkpoints.resize(chunkSize); //learnpoints.resize(n - chunkSize); learnpoints[n - chunkSize - 1] = points[n - 1]; } for (int i = 0; i < chunkSize; i++){ checkpoints[i] = learnpoints[(chunkNumber - 1)*i + chunk - 1]; learnpoints[(chunkNumber - 1)*i + chunk - 1] = points[chunkNumber*i + chunk - 1]; if (chunkNumber*i + chunk == numClass1) n1--; } } TPoint minPolynomial = GetOptPolynomial(learnpoints, numClass1 - n1, numClass2 - chunkSize + n1, degree, false); double curErr = GetEmpiricalRisk(minPolynomial, checkpoints, n1, chunkSize - n1); err += curErr;// chunkSize; } delete[] learnpoints; delete[] checkpoints; return err/n; } TPoint PolynomialLearnCV(TDMatrix input, int numClass1, int numClass2, int maxDegree, int chunkNumber, int *degree, int *axis){ int numPoints = numClass1 + numClass2; int polOptDegree = 0; double polOptError = numPoints; int polOptAxis = 0; TDMatrix input2 = newM(numPoints, 2); // copy for (int i = 0, tmp; i < numPoints; i++){ input2[i][0] = input[i][1]; input2[i][1] = input[i][0]; } // swap columns for (int degree = 1; degree <= maxDegree; degree++){ double polError = GetCvError(input, numClass1, numClass2, degree, chunkNumber); //cout << degree << " " << polError << "\n"; if (polError < polOptError){ polOptAxis = 0; polOptDegree = degree; polOptError = polError; } polError = GetCvError(input2, numClass1, numClass2, degree, chunkNumber); //cout << degree << " " << polError << "\n"; if (polError < polOptError){ polOptAxis = 1; polOptDegree = degree; polOptError = polError; } } //cout << polOptDegree << " " << polOptError << "\n"; TPoint polynomial = polOptAxis == 0 ? GetOptPolynomial(input, numClass1, numClass2, polOptDegree, true) : GetOptPolynomial(input2, numClass1, numClass2, polOptDegree, true); deleteM(input2); *axis = polOptAxis; *degree = polOptDegree; return polynomial; } ddalpha/src/OjaDepth.h0000644000176200001440000000040614213423775014315 0ustar liggesusers void OjaDepthsEx(TDMatrix X, TDMatrix x, int d, int n, int nx, int useCov, TDMatrix covEst, double *depths); void OjaDepthsApx(TDMatrix X, TDMatrix x, int d, int n, int nx, unsigned long long k, int useCov, TDMatrix covEst, double *depths); ddalpha/src/ProjectionDepth.cpp0000644000176200001440000000621714213423775016261 0ustar liggesusers/* File: ProjectionDepth.cpp Created by: Pavlo Mozharovskyi First published: 17.05.2013 Last revised: 13.11.2015 Computation of the projection depth using random sampling. For a description of the method, see: Zuo, Y.J. and Serfling, R. (2000). General notions of statistical depth function. Annals of Statistics 28, 461-482. */ #include "stdafx.h" static int CompareAsc(OrderRec x, OrderRec y) { return (x.value < y.value); } static int CompareDec(OrderRec x, OrderRec y) { return (x.value > y.value); } static void GetMedMad(TPoint &points, double &median, double &mad){ /* First, determine median */ int n = points.size(); //sort(points.begin(), points.end()); //median = (points[(n + 1)/2 - 1] + points[(n + 2)/2 - 1])/2.; nth_element(points.begin(), points.begin() + n/2, points.end()); median = points[n/2]; /* Obtain median absolute deviation (from median) (MAD) */ TPoint deviations(n); for (int i = 0; i < n; i++){deviations[i] = abs(points[i] - median);} //sort(deviations.begin(), deviations.end()); //median = (deviations[(n + 1)/2 - 1] + deviations[(n + 2)/2 - 1])/2.; nth_element(deviations.begin(), deviations.begin() + n/2, deviations.end()); mad = deviations[n/2]; } void GetPtsPrjDepths(double* projection, int n, double* objectsProjection, int m, TVariables cardinalities, TMatrix *ptsPrjDepths){ /* Collect basic statistics */ int q = cardinalities.size(); for (int i = 0; i < q; i++){ /* Prepare data and obtain median and mad*/ int beginIndex = 0; for (int j = 0; j < q; j++){ if (j >= i){break;} beginIndex += cardinalities[j]; } int endIndex = beginIndex + cardinalities[i]; TPoint curClassProjection(projection + beginIndex, projection + endIndex); double median, mad;GetMedMad(curClassProjection, median, mad); /* Calculate i-class projectional univariate depths */ for (int j = 0; j < m; j++){ (*ptsPrjDepths)[i][j] = (objectsProjection[j] - median)/mad; } } } int GetDepthsPrj(TDMatrix points, int n, int d, TDMatrix objects, int m, TVariables cardinalities, int k, bool newDirs, TDMatrix depths, TDMatrix directions, TDMatrix projections){ /* 1. Collecting basic statistics */ int q = cardinalities.size(); TDMatrix objectsProjections = newM(k,m); if (newDirs){ GetDirections(directions, k, d); GetProjections(points, n, d, directions, k, projections); } GetProjections(objects, m, d, directions, k, objectsProjections); /* 2. Calculate projection depths */ vector > > prjDepths(k, vector >(q, vector (m))); for (int i = 0; i < k; i++){ GetPtsPrjDepths(projections[i], n, objectsProjections[i], m, cardinalities, &prjDepths[i]); } /* 3. Merge depths */ for (int i = 0; i < m; i++){ for (int j = 0; j < q; j++){ depths[i][j] = DBL_MIN; } } for (int i = 0; i < k; i++){ for (int j = 0; j < q; j++){ for (int l = 0; l < m; l++){ if (prjDepths[i][j][l] > depths[l][j]){ depths[l][j] = prjDepths[i][j][l]; } } } } for (int i = 0; i < m; i++){ for (int j = 0; j < q; j++){ depths[i][j] = 1/(1 + depths[i][j]); } } deleteM(objectsProjections); return 0; } ddalpha/src/Knn.cpp0000644000176200001440000002076214213423775013707 0ustar liggesusers/* File: Knn.cpp Created by: Pavlo Mozharovskyi First published: 28.02.2013 Last revised: 13.11.2015 The realization of the fast binary affine-invariante KNN classifier. */ #include "stdafx.h" #define DISTTYPE_EUCLIDEAN 1 #define DISTTYPE_MAXIMUM 2 #define DISTTYPE_STANDARDIZE 64 static TMatrix Sigma; static int CompareValue(UPoint a, UPoint b) /* This routine is passed to the sort routine. */ { return (a.value < b.value); } static int GetMean(TMatrix x, TPoint *mean){ unsigned int n = x.size();if (n <= 0){return -1;} unsigned int d = x[0].size();if (d <= 0){return -1;} mean->resize(d); for (unsigned int i = 0; i < n; i++){ for (unsigned int j = 0; j < d; j++){ (*mean)[j] += x[i][j]; } } for (unsigned int j = 0; j < d; j++){ (*mean)[j] /= (double)n; } return 0; } static int GetCov(TMatrix x, TMatrix *cov){ unsigned int n = x.size();if (n <= 0){return -1;} unsigned int d = x[0].size();if (d <= 0){return -1;} TPoint mean;GetMean(x, &mean); cov->resize(d); for (unsigned int i = 0; i < d; i++){(*cov)[i].resize(d);} for (unsigned int i = 0; i < n; i++){ for (unsigned int j = 0; j < d; j++){ for (unsigned int k = 0; k < d; k++){ (*cov)[j][k] += (x[i][j] - mean[j])*(x[i][k] - mean[k]); } } } for (unsigned int j = 0; j < d; j++){ for (unsigned int k = 0; k < d; k++){ (*cov)[j][k] /= (double)(n - 1); } } return 0; } static int GetInverted(TMatrix x, TMatrix *inv){ unsigned int d = x.size();if (d <= 0){return -1;} unsigned int _d = x[0].size();if (_d != d){return -1;} boost::numeric::ublas::matrix A(d, d);A.clear(); for (unsigned int i = 0; i < d; i++){ for (unsigned int j = 0; j < d; j++){ A(i,j) = x[i][j]; } } typedef boost::numeric::ublas::permutation_matrix pmatrix; boost::numeric::ublas::matrix Inv(d, d);Inv.clear(); pmatrix pm(A.size1()); int res = lu_factorize(A, pm); if (res != 0){return -1;} Inv.assign(boost::numeric::ublas::identity_matrix (A.size1())); boost::numeric::ublas::lu_substitute(A, pm, Inv); inv->resize(d); for (unsigned int i = 0; i < d; i++){ (*inv)[i].resize(d); } for (unsigned int i = 0; i < d; i++){ for (unsigned int j = 0; j < d; j++){ (*inv)[i][j] = Inv(i,j); } } return 0; } static double GetNormalized(TPoint dif){ unsigned int d = dif.size(); TPoint tmp(d); for (unsigned int i = 0; i < d; i++){ for (unsigned int j = 0; j < d; j++){ tmp[i] += dif[j]*Sigma[j][i]; } } double res = 0; for (unsigned int i = 0; i < d; i++){ res += tmp[i]*dif[i]; } return res; } static double GetDistance(TPoint x, TPoint y, int d, int distType){ double dist = 0.; if ((distType & DISTTYPE_EUCLIDEAN) == DISTTYPE_EUCLIDEAN){ TPoint distVector(d); for (int i = 0; i < d; i++){distVector[i] = x[i] - y[i];} if ((distType & DISTTYPE_STANDARDIZE) == DISTTYPE_STANDARDIZE){ dist = GetNormalized(distVector); }else{ for (int i = 0; i < d; i++){dist += std::pow(x[i] - y[i],2);} } } if ((distType & DISTTYPE_MAXIMUM) == DISTTYPE_MAXIMUM){ for (int i = 0; i < d; i++){ if (abs(x[i] - y[i]) > dist){dist = abs(x[i] - y[i]);} } } return dist; } static int GetDistances(TMatrix x, TMatrix *dist, int distanceType){ unsigned int n = x.size();if (n <= 0){return -1;} unsigned int d = x[0].size();if (d <= 0){return -1;} TMatrix cov;GetCov(x, &cov);GetInverted(cov, &Sigma); dist->resize(n); for (unsigned int i = 0; i < n; i++){(*dist)[i].resize(n);} for (unsigned int i = 0; i < n - 1; i++){ for (unsigned int j = i + 1; j < n; j++){ (*dist)[i][j] = (*dist)[j][i] = GetDistance(x[i], x[j], d, distanceType); } } return 0; } static int GetMaxIndex(TVariables v){ int index = 0;int maxValue = v[0];int d = v.size(); for (int i = 1; i < d; i++){ if (v[i] > maxValue){index = i; maxValue = v[i];} } return index; } int KnnCv(TMatrix points, TVariables labels, int kMax, int distType, int numFolds){ // Collect basic statistics (and check it) int n = (int) points.size(); int q = labels[GetMaxIndex(labels)] + 1; if (labels.size() != points.size()){return -1;} // Prepare indicator array for Jack-Knifing TMatrix dist;GetDistances(points, &dist, distType); vector > indicators(n, vector(n)); for (int i = 0; i < n; i++){ for (int j = 0; j < n; j++){ indicators[i][j] = UPoint(labels[j], dist[i][j]); } } for (int i = 0; i < n; i++){indicators[i][i].value = -1;} for (int i = 0; i < n; i++){ sort(indicators[i].begin(), indicators[i].end(), CompareValue); } // Jack-knifing vector decisions(kMax + 1, TVariables(n)); for (int i = 0; i < n; i++){decisions[0][i] = labels[i];} for (int i = 0; i < n; i++){ TVariables locVotes(q); for (int j = 1; j < kMax + 1; j++){ locVotes[indicators[i][j].pattern]++; decisions[j][i] = GetMaxIndex(locVotes); } } TVariables guessed(kMax + 1); for (int i = 1; i < kMax + 1; i++){ for (int j = 0; j < n; j++){ if (decisions[i][j] == decisions[0][j]){guessed[i]++;} } } return GetMaxIndex(guessed); } int Knn(TMatrix objects, TMatrix points, TVariables labels, int k, int distType, TVariables *output){ int n = (int) points.size(); if (n <= 0){return -1;} int d = (int) points[0].size(); if (d <= 0){return -1;} int q = labels[GetMaxIndex(labels)] + 1; int nobjects = (int) objects.size(); if (nobjects <= 0){return -1;} if ((int)labels.size() != n || (int)objects[0].size() != d){return -1;} output->resize(nobjects); if ((distType & DISTTYPE_STANDARDIZE) == DISTTYPE_STANDARDIZE){ TMatrix cov;GetCov(points, &cov);GetInverted(cov, &Sigma); } for (int i = 0; i < nobjects; i++){ vector indicators(n); for (int j = 0; j < n; j++){ indicators[j] = UPoint(labels[j], GetDistance(objects[i], points[j], d, distType)); } sort(indicators.begin(), indicators.end(), CompareValue); TVariables locVotes(q); for (int j = 0; j < k; j++){ locVotes[indicators[j].pattern]++; } (*output)[i] = GetMaxIndex(locVotes); } return 0; } int GetK_JK_Binary(TMatrix points, TVariables cardinalities, int maxk){ // Collect basic statistics (and check it) int n = (int) points.size(); int q = (int) cardinalities.size(); if (q != 2){return -1;} // Prepare indicator array for Jack-Knife TMatrix dist;GetDistances(points, &dist, DISTTYPE_EUCLIDEAN | DISTTYPE_STANDARDIZE); vector > indicators; indicators.resize(n); for (int i = 0; i < n; i++){ indicators[i].resize(n); for (int j = 0; j < cardinalities[0]; j++){indicators[i][j] = UPoint(0, dist[i][j]);} for (int j = cardinalities[0]; j < n; j++){indicators[i][j] = UPoint(1, dist[i][j]);} } for (int i = 0; i < n; i++){indicators[i][i].value = -1;} for (int i = 0; i < n; i++){sort(indicators[i].begin(), indicators[i].end(), CompareValue);} // Jack-knifing vector decisions(maxk); decisions[0].resize(n);for (int j = 0; j < n; j++){decisions[0][j] = indicators[j][1].pattern;} for (int i = 1; i < maxk; i++){ decisions[i].resize(n); for (int j = 0; j < n; j++){ decisions[i][j] = decisions[i - 1][j] + indicators[j][i + 1].pattern; } } for (int i = 0; i < maxk; i++){ for (int j = 0; j < n; j++){ decisions[i][j] = (decisions[i][j] > (i + 1)/2 ? 1 : 0); } } TVariables errors(maxk); for (int i = 0; i < maxk; i++){ for (int j = 0; j < cardinalities[0]; j++){errors[i] += decisions[i][j];} for (int j = cardinalities[0]; j < n; j++){errors[i] += 1 - decisions[i][j];} } int k = -1; int minErr = n + 1; for (int i = 0; i < maxk; i++){if (errors[i] < minErr){k = i + 1; minErr = errors[i];}} return k; } int Knn_Classify_Binary(TMatrix objects, TMatrix points, TVariables cardinalities, int k, TVariables *output){ int n = points.size();if (n <= 0){return -1;} int d = points[0].size();if (d <= 0){return -1;} int nobjects = objects.size();if (nobjects <= 0){return -1;} if ((int)objects[0].size() != d){return -1;} output->resize(nobjects); TMatrix cov;GetCov(points, &cov); GetInverted(cov, &Sigma); for (int i = 0; i < nobjects; i++){ TPoint point = objects[i]; TPoint tmp(d); TPoint dist(n); for (int j = 0; j < n; j++){ for (int l = 0; l < d; l++){tmp[l] = point[l] - points[j][l];} dist[j] = GetNormalized(tmp); } vector indicators(n); for (int j = 0; j < cardinalities[0]; j++){indicators[j] = UPoint(0, dist[j]);} for (int j = cardinalities[0]; j < n; j++){indicators[j] = UPoint(1, dist[j]);} sort(indicators.begin(), indicators.end(), CompareValue); int decision = 0; for(int j = 0; j < k; j++){decision += indicators[j].pattern;} (*output)[i] = (decision > k/2 ? 1 : 0); } return 0; } ddalpha/src/BandDepth.h0000644000176200001440000000017114213423775014447 0ustar liggesusersvoid BandDepth(T3DMatrix x, T3DMatrix X, int m, int n, int t, int d, bool modif, int J, double* depths); ddalpha/src/Common.cpp0000644000176200001440000001422514213423775014406 0ustar liggesusers/* File: Common.cpp Created by: Pavlo Mozharovskyi First published: 17.05.2013 Last revised: 13.11.2015 Commonly used functions. */ #include "stdafx.h" extern boost::random::rand48 rEngine; extern boost::random::normal_distribution normDist; // 3D-array structures T3DMatrix as3DMatrix(double* arr, int n, int t, int d){ T3DMatrix mat = new double**[n]; for (int i = 0; i < n; i++){ mat[i] = new double*[t]; for (int j = 0; j < t; j++) { mat[i][j] = arr + i*t*d + j*d; } } return mat; } // by rows TDMatrix asMatrix(double* arr, int n, int d){ TDMatrix mat = new double*[n]; for (int i = 0; i < n; i++) mat[i] = arr + i*d; return mat; } double** newM(int n, int d){ double* a = new double[n*d]; return asMatrix(a, n, d); } void deleteM(TDMatrix X){ delete[] X[0]; delete[] X; } TDMatrix copyM(TDMatrix X, int n, int d){ double* a = new double[n*d]; memcpy(a, X[0], n*d*sizeof(double)); return asMatrix(a, n, d); } void printMatrix(TDMatrix mat, int n, int d){ for (int i = 0; i < n; i++){ for (int j = 0; j < d; j++) Rcout << mat[i][j] << "\t"; Rcout << endl; } Rcout << endl; } unsigned long long choose(unsigned long long n, unsigned long long k){ unsigned long long r = n--; unsigned long long d = 2; while (d <= k){ r *= n--; r /= d++; } return r; } unsigned long long fact(unsigned long long n){ unsigned long long r = 1; unsigned long long i = 2; while (i <= n){ r *= i++; } return r; } /* -------------------------------------------------------------------------- */ /* By Rainer Dyckerhoff, modified by Pavlo Mozharovskyi */ /* Solves a uniquely solvable system of linear equations */ /* -------------------------------------------------------------------------- */ bool solveUnique(TDMatrix A, double* b, double* x, int d){ int imax, jmax; int* colp = new int[d]; double amax; for (int k = 0; k < d - 1; k++) { imax = k; jmax = k; amax = abs(A[k][k]); colp[k] = k; // Spaltenmaximum finden for (int i = k + 1; i < d; i++) { if (abs(A[i][k]) > amax) { amax = abs(A[i][k]); imax = i; } } // Spaltenmaximum gleich null => complete pivoting if (amax < eps_pivot) { for (int j = k + 1; j < d; j++) { for (int i = k; i < d; i++) { if (abs(A[i][j]) > amax) { amax = abs(A[i][j]); imax = i; jmax = j; } } } if (amax < eps_pivot) { delete[] colp; return false; } // Spaltentausch for (int i = 0; i < d; i++) { double tmp = A[i][k]; A[i][k] = A[i][jmax]; A[i][jmax] = tmp; } colp[k] = jmax; } // Zeilentausch if (imax != k) { for (int j = k; j < d; j++) { double tmp = A[k][j]; A[k][j] = A[imax][j]; A[imax][j] = tmp; } double tmp = b[k]; b[k] = b[imax]; b[imax] = tmp; } // Elimination for (int i = k + 1; i < d; i++) { double factor = A[i][k] / A[k][k]; for (int j = k + 1; j < d; j++){ A[i][j] -= factor * A[k][j]; } b[i] -= factor * b[k]; } } // R?cksubstituition colp[d - 1] = d - 1; for (int k = d - 1; k >= 0; k--) { x[k] = b[k] / A[k][k]; for (int i = k - 1; i >= 0; i--) b[i] -= x[k] * A[i][k]; } // Spaltenvertauschungen r?ckg?ngig machen for (int k = d - 1; k >= 0; k--) { if (colp[k] != k) { double temp = x[k]; x[k] = x[colp[k]]; x[colp[k]] = temp; } } delete[] colp; return true; } double determinant(bMatrix& m) { bMatrix mLu(m); bPM pivots(m.size1()); if (bnu::lu_factorize(mLu, pivots)) return 0; double det = 1; for (int i = 0; i < pivots.size(); ++i) { if (pivots(i) != i) det *= -1; det *= mLu(i, i); } return det; } double* means(TDMatrix X, int n, int d) { double* ms = new double[d]; for (int i = 0; i < d; i++) { ms[i] = 0.0; for (int j = 0; j < n; j++) ms[i] += X[j][i]; ms[i] /= n; } return ms; } TDMatrix cov(TDMatrix X, int n, int d) { double* means = new double[d]; double* dev = new double[d]; // zeroing TDMatrix TDMatrix covX = newM(d, d); for (int k = 0; k < d; k++) for (int j = 0; j < d; j++) covX[k][j] = 0; // means for (int i = 0; i < d; i++) { means[i] = 0.0; for (int j = 0; j < n; j++) means[i] += X[j][i]; means[i] /= n; } for (int i = 0; i < n; i++) { // deviations for (int k = 0; k < d; k++) { dev[k] = X[i][k] - means[k]; } // add to cov for (int k = 0; k < d; k++) { for (int j = 0; j < d; j++) { covX[k][j] += dev[k] * dev[j]; } } } //scale for (int i = 0; i < d; i++) { for (int j = 0; j < d; j++) { covX[i][j] /= n - 1; } } delete[] means; delete[] dev; return covX; } void GetDirections(TDMatrix directions, int k, int d){ for (int i = 0; i < k; i++){ double* direction = directions[i]; double sqrSum = 0; for (int j = 0; j < d; j++){ direction[j] = normDist(rEngine); sqrSum += direction[j]*direction[j]; } sqrSum = sqrt(sqrSum); for (int j = 0; j < d; j++){ direction[j] = direction[j]/sqrSum; } } } void GetProjections(TDMatrix points, int n, int d, TDMatrix directions, int k, TDMatrix projections){ for (int i = 0; i < k; i++){ double* projection = projections[i]; for (int j = 0; j < n; j++){ double sum = 0; for (int l = 0; l < d; l++){ sum += points[j][l]*directions[i][l]; } projection[j] = sum; } } } void outVector(TVariables& point){ } bool OUT_ALPHA = false; void outString(char const * str){ #ifdef DEF_OUT_ALPHA if (!OUT_ALPHA) return; Rcout << str << endl; #endif } //template void outVector(TPoint& point){ #ifdef DEF_OUT_ALPHA if (!OUT_ALPHA) return; for (int j = 0; j < point.size(); j++){ Rcout << point[j] << ", "; } Rcout << endl; #endif } void outMatrix(TMatrix& points){ #ifdef DEF_OUT_ALPHA if (!OUT_ALPHA) return; for (int i = 0; i < points.size(); i++){ //Rcout << i << ": "; for (int j = 0; j < points[i].size(); j++){ Rcout << points[i][j] << ", "; } Rcout << endl; } #endif } void outFeatures(Features fs){ #ifdef DEF_OUT_ALPHA if (!OUT_ALPHA) return; Rcout << "order\t number\t angle\t error" << endl; for (int i = 0; i < fs.size(); i++){ Rcout << fs[i].order << ",\t " << fs[i].number << ",\t " << fs[i].angle << ",\t " << fs[i].error << endl; } #endif } ddalpha/src/DKnn.h0000644000176200001440000000064714213423775013460 0ustar liggesusers/* File: DKnn.h Created by: Oleksii Pokotylo First published: Last revised: The realization of the Depth-based KNN classifier of Paindaveine and Van Bever (2015). */ int DKnnCv(TDMatrix points, int n, int d, int* labels, int kMax, int depthType, int chunkNumber); void DKnnClassify(TDMatrix points, int n, int d, int* labels, TDMatrix objects, int nobjects, int k, int depthType, int* classes); ddalpha/src/BandDepth.cpp0000644000176200001440000000541714213423775015012 0ustar liggesusers#include "stdafx.h" const double eps_band = 1e-10; void BandDepth(T3DMatrix x, T3DMatrix X, int m, int n, int t, int d, bool modif, int J, double* depths){ //Rcout << "m = " << m << endl; //Rcout << "n = " << n << endl; //Rcout << "t = " << t << endl; //Rcout << "d = " << d << endl; //Rcout << "modif = " << modif << endl; //Rcout << "J = " << J << endl; // Prepare data structures for the loop through all J combinations double* b = new double[d + 1]; b[d] = 1; double* z = new double[d + 1]; int* counters = new int[d + 1]; TDMatrix A = newM(d + 1, d + 1); unsigned long long div0 = choose(n, d + 1); // num simplices // Loop for all observations to compute depth for for (int iObs = 0; iObs < m; iObs++){ unsigned long long theCounter = 0; //unsigned long long numSimplicesChecked = 0; // Loop to check all combinations of J functions out of n for (int i = 0; i < d; i++){ counters[i] = i; } counters[d] = d - 1; while (counters[0] != n - (d + 1)){ int i = d; while (i > 0 && counters[i] == n - (d + 1) + i){ i--; } counters[i]++; int j = i + 1; while (j < d + 1){ counters[j] = counters[j - 1] + 1; j++; } // Execute logic for a single (d+1)-tuple of functoins: bool isInBand = true; // Loop for all time points for (int iTime = 0; iTime < t; iTime++){ // Check whether current function is inside simplex for this time point for (int j = 0; j < d; j++){ for (int k = 0; k < d + 1; k++){ A[j][k] = X[counters[k]][iTime][j]; } } for (int k = 0; k < d + 1; k++){ A[d][k] = 1; } memcpy(b, x[iObs][iTime], d * sizeof(double)); b[d] = 1; if (solveUnique(A, b, z, d + 1)){ bool isInside = true; for (int j = 0; j < d + 1; j++){ if (z[j] < -eps_band){ isInside = false; break; } } if (isInside){ // if inside simplex if (modif){ theCounter++; } }else{ // if outside simplex if (!modif){ isInBand = false; break; } } } //Rcout << " " << isInBand; } if (!modif){ // if not modified version theCounter += isInBand; // add 1 once only (not each time point) } //Rcout << " = " << theCounter << endl; //if (modif){ // if modified version // numSimplicesChecked += t; //}else{ // numSimplicesChecked++; //} } if (modif){ // if modified version depths[iObs] = (double)theCounter / (div0 * t); }else{ // if not modified version depths[iObs] = (double)theCounter / div0; } } // Release memory delete[] b; delete[] z; delete[] counters; deleteM(A); } ddalpha/src/LensDepth.cpp0000644000176200001440000000664414213423775015052 0ustar liggesusers/* File: LensDepth.cpp Created by: Pavlo Mozharovskyi First published: 08.03.2018 Last revised: 08.03.2018 A procedure for computing the beta-skeleton depth, a generalization of the lens depth. For a description of the algorithm, see: Liu, Z. and Modarres, R. (2011). Lens data depth and median. Journal of Nonparametric Statistics, 23(4), 1063-1074. Yang, M. and Modarres, R. (2017). Beta-skeleton depth functions and medians. Commmunications in Statistics - Theory and Methods, to appear. */ #include "stdafx.h" #define DISTTYPE_L1 1 #define DISTTYPE_L2 2 #define DISTTYPE_MAX 3 #define DISTTYPE_Lp 4 #define DISTTYPE_MAHALANOBIS 5 void LensDepth(TDMatrix X, TDMatrix x, int d, int n, int nx, double beta, int distType, double p, TDMatrix sigma, double* depths){ // The centers of the two balls double* ci = new double[d]; double* cj = new double[d]; double b = beta / 2; double dist = 0; double disti = 0; double distj = 0; int counts = 0; for (int obs = 0; obs < nx; obs++){ // loop through observations counts = 0; // Loop(s) through pairs of points for (int i = 0; i < n - 1; i++){ for (int j = i + 1; j < n; j++){ dist = 0; disti = 0; distj = 0; // Calculate centres for (int k = 0; k < d; k++){ ci[k] = X[i][k] * b + X[j][k] * (1 - b); cj[k] = X[i][k] * (1 - b) + X[j][k] * b; } // Calculate distances switch (distType){ case DISTTYPE_L1: for (int k = 0; k < d; k++){ dist += abs(X[i][k] - X[j][k]); disti += abs(x[obs][k] - ci[k]); distj += abs(x[obs][k] - cj[k]); } break; case DISTTYPE_L2: for (int k = 0; k < d; k++){ dist += pow(X[i][k] - X[j][k], 2); disti += pow(x[obs][k] - ci[k], 2); distj += pow(x[obs][k] - cj[k], 2); } dist = sqrt(dist); disti = sqrt(disti); distj = sqrt(distj); break; case DISTTYPE_MAX: for (int k = 0; k < d; k++){ dist = max(dist, abs(X[i][k] - X[j][k])); disti = max(disti, abs(x[obs][k] - ci[k])); distj = max(distj, abs(x[obs][k] - cj[k])); } break; case DISTTYPE_Lp: for (int k = 0; k < d; k++){ dist += pow(abs(X[i][k] - X[j][k]), p); disti += pow(abs(x[obs][k] - ci[k]), p); distj += pow(abs(x[obs][k] - cj[k]), p); } dist = pow(dist, 1/p); disti = pow(disti, 1/p); distj = pow(distj, 1/p); break; case DISTTYPE_MAHALANOBIS: for (int k = 0; k < d; k++){ for (int l = 0; l < d; l++){ dist += (X[i][l] - X[j][l]) * sigma[l][k] * (X[i][k] - X[j][k]); disti += (x[obs][l] - ci[l]) * sigma[l][k] * (x[obs][k] - ci[k]); distj += (x[obs][l] - cj[l]) * sigma[l][k] * (x[obs][k] - cj[k]); } } dist = sqrt(dist); disti = sqrt(disti); distj = sqrt(distj); break; } // Deside whether the point is in the lens (influene region) dist *= b; if (disti < dist && distj < dist){ counts++; } } } depths[obs] = counts / (double)(n * (n - 1) / 2); // return } // Release memory delete[] ci; delete[] cj; } ddalpha/src/Common.h0000644000176200001440000000177714213423775014063 0ustar liggesusers/* File: Common.h Created by: Pavlo Mozharovskyi First published: 17.05.2013 Last revised: 13.11.2015 Commonly used functions. */ #pragma once const double eps_pivot = 1e-10; //#define DEF_OUT_ALPHA extern bool OUT_ALPHA; #ifndef _MSC_VER #define DEF_OUT_ALPHA #endif #ifdef DEF_OUT_ALPHA using namespace Rcpp; #endif void outString(char const * str); //template void outVector(TPoint& point); void outMatrix(TMatrix& points); void outFeatures(Features fs); #ifndef M_PI #define M_PI 3.14159265358979323846 #endif unsigned long long choose(unsigned long long n, unsigned long long k); unsigned long long fact(unsigned long long n); bool solveUnique(TDMatrix A, double* b, double* x, int d); double determinant(bMatrix& m); double* means(TDMatrix X, int n, int d); TDMatrix cov(TDMatrix X, int n, int d); void GetDirections(TDMatrix directions, int k, int d); void GetProjections(TDMatrix points, int n, int d, TDMatrix directions, int k, TDMatrix projections); ddalpha/src/SimplicialDepth.h0000644000176200001440000000043214213423775015671 0ustar liggesusers void SimplicialDepthsEx(TDMatrix X, TDMatrix x, int d, int n, int nx, double *depths); void SimplicialDepthsApx(TDMatrix X, TDMatrix x, int d, int n, int nx, unsigned long long k, double *depths); void SimplicialDepths2(TDMatrix X, TDMatrix x, int n, int nx, double *depths); ddalpha/src/init.c0000644000176200001440000001471514213423775013565 0ustar liggesusers#include #include // for NULL #include /* FIXME: Check these declarations against the C/Fortran source code. */ /* .C calls */ extern void AlphaLearn(double *, int *, int *, int *, int *, int *, double *); extern void AlphaClassify(void *, void *, void *, void *, void *, void *); extern void AlphaLearnCV(void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void DKnnClassify(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void DKnnLearnCv(void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void HDepth(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void HDepthEx(void *, void *, void *, void *, void *, void *, void *); extern void HDepthSpaceEx(void *, void *, void *, void *, void *, void *, void *, void *); extern void HDSpace(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void IsInConvexes(void *, void *, void *, void *, void *, void *, void *, void *); extern void KnnAffInvClassify(void *, void *, void *, void *, void *, void *, void *); extern void KnnAffInvLearnJK(void *, void *, void *, void *, void *); extern void KnnClassify(void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void KnnLearnJK(void *, void *, void *, void *, void *, void *, void *); extern void MahalanobisDepth(void *, void *, void *, void *, void *, void *, void *); extern void OjaDepth(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void PolynomialLearnCV(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void PotentialDepthsCount(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void ProjectionDepth(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void SimplicialDepth(void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void ZDepth(void *, void *, void *, void *, void *, void *, void *); extern void BetaSkeletonDepth(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void SimplicialBandDepthF(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); /* .Fortran calls */ extern void F77_NAME(adjc)(void *, void *, void *, void *, void *, void *, void *, void *); extern void F77_NAME(adjlp)(void *, void *, void *, void *, void *, void *, void *, void *); extern void F77_NAME(bd)(void *, void *, void *, void *, void *, void *); extern void F77_NAME(cvkernsm)(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void F77_NAME(diffd)(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void F77_NAME(dpth1)(void *, void *, void *, void *, void *, void *); extern void F77_NAME(dpth2)(void *, void *, void *, void *, void *, void *, void *, void *); extern void F77_NAME(fund1)(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void F77_NAME(fund2)(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void F77_NAME(funmd)(void *, void *, void *, void *, void *, void *, void *); extern void F77_NAME(funrpd1)(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void F77_NAME(funrpd2)(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void F77_NAME(hrd)(void *, void *, void *, void *, void *, void *); extern void F77_NAME(metrc)(void *, void *, void *, void *, void *, void *); extern void F77_NAME(metrl2)(void *, void *, void *, void *, void *, void *); static const R_CMethodDef CEntries[] = { {"AlphaLearn", (DL_FUNC) &AlphaLearn, 7}, {"AlphaClassify", (DL_FUNC) &AlphaClassify, 6}, {"AlphaLearnCV", (DL_FUNC) &AlphaLearnCV, 9}, {"DKnnClassify", (DL_FUNC) &DKnnClassify, 10}, {"DKnnLearnCv", (DL_FUNC) &DKnnLearnCv, 9}, {"HDepth", (DL_FUNC) &HDepth, 12}, {"HDepthEx", (DL_FUNC) &HDepthEx, 7}, {"HDepthSpaceEx", (DL_FUNC) &HDepthSpaceEx, 8}, {"HDSpace", (DL_FUNC) &HDSpace, 10}, {"IsInConvexes", (DL_FUNC) &IsInConvexes, 8}, {"KnnAffInvClassify", (DL_FUNC) &KnnAffInvClassify, 7}, {"KnnAffInvLearnJK", (DL_FUNC) &KnnAffInvLearnJK, 5}, {"KnnClassify", (DL_FUNC) &KnnClassify, 9}, {"KnnLearnJK", (DL_FUNC) &KnnLearnJK, 7}, {"MahalanobisDepth", (DL_FUNC) &MahalanobisDepth, 7}, {"OjaDepth", (DL_FUNC) &OjaDepth, 11}, {"PolynomialLearnCV", (DL_FUNC) &PolynomialLearnCV, 10}, {"PotentialDepthsCount", (DL_FUNC) &PotentialDepthsCount, 11}, {"ProjectionDepth", (DL_FUNC) &ProjectionDepth, 12}, {"SimplicialDepth", (DL_FUNC) &SimplicialDepth, 9}, {"ZDepth", (DL_FUNC) &ZDepth, 7}, {"BetaSkeletonDepth", (DL_FUNC) &BetaSkeletonDepth, 10}, {"SimplicialBandDepthF", (DL_FUNC) &SimplicialBandDepthF, 10}, {NULL, NULL, 0} }; static const R_FortranMethodDef FortranEntries[] = { {"adjc", (DL_FUNC) &F77_NAME(adjc), 8}, {"adjlp", (DL_FUNC) &F77_NAME(adjlp), 8}, {"bd", (DL_FUNC) &F77_NAME(bd), 6}, {"cvkernsm", (DL_FUNC) &F77_NAME(cvkernsm), 15}, {"diffd", (DL_FUNC) &F77_NAME(diffd), 15}, {"dpth1", (DL_FUNC) &F77_NAME(dpth1), 6}, {"dpth2", (DL_FUNC) &F77_NAME(dpth2), 8}, {"fund1", (DL_FUNC) &F77_NAME(fund1), 11}, {"fund2", (DL_FUNC) &F77_NAME(fund2), 13}, {"funmd", (DL_FUNC) &F77_NAME(funmd), 7}, {"funrpd1", (DL_FUNC) &F77_NAME(funrpd1), 11}, {"funrpd2", (DL_FUNC) &F77_NAME(funrpd2), 15}, {"hrd", (DL_FUNC) &F77_NAME(hrd), 6}, {"metrc", (DL_FUNC) &F77_NAME(metrc), 6}, {"metrl2", (DL_FUNC) &F77_NAME(metrl2), 6}, {NULL, NULL, 0} }; void R_init_ddalpha(DllInfo *dll) { R_registerRoutines(dll, CEntries, NULL, FortranEntries, NULL); R_useDynamicSymbols(dll, FALSE); } ddalpha/src/LensDepth.h0000644000176200001440000000022214213423775014501 0ustar liggesusersvoid LensDepth(TDMatrix X, TDMatrix x, int d, int n, int nx, double beta, int distType, double p, TDMatrix sigma, double* depths); ddalpha/src/TukeyDepth.h0000644000176200001440000000153414213423775014710 0ustar liggesusers/* File: TukeyDepth.h Created by: Pavlo Mozharovskyi First published: 28.02.2013 Last revised: 13.11.2015 Computation of the random Tukey data depth. For a description of the algorithm, see: Cuesta-Albertos, J. A. and Nieto-Reyes, A. (2008). The random Tukey depth. Computational Statistics & Data Analysis 52, 11 (July 2008), 4979-4988. Mozharovskyi, P., Mosler, K. and Lange, T. (2013). Classifying real-world data with the DDalpha-procedure. Mimeo. */ void GetDSpace(TDMatrix points, int n, int d, TVariables& cardinalities, int k, bool atOnce, TDMatrix dSpace, TDMatrix directions, TDMatrix projections); void GetDepths(double* point, TDMatrix points, int n, int d, TVariables& cardinalities, int k, bool atOnce, TDMatrix directions, TDMatrix projections, double* depths, TDMatrix ptPrjDepths /*accu, k*q */); ddalpha/src/ddalpha.cpp0000644000176200001440000004500414213423775014552 0ustar liggesusers/* File: ddalpha.cpp Created by: Pavlo Mozharovskyi, Oleksii Pokotylo First published: 28.02.2013 Last revised: 20.02.2019 Defines the exported functions for the 'ddalpha'-package. For a description of the algorithm, see: Lange, T., Mosler, K. and Mozharovskyi, P. (2012). Fast nonparametric classification based on data depth. Statistical Papers. Mozharovskyi, P., Mosler, K. and Lange, T. (2013). Classifying real-world data with the DDalpha-procedure. Mimeo. */ #include "stdafx.h" #define EOF (-1) #ifdef __cplusplus extern "C" { #endif boost::random::rand48 rEngine; boost::random::normal_distribution normDist; void Sum(double *a, double *b, double *res){ res[0] = a[0] + b[0]; } void setSeed(int random_seed){ if (random_seed != 0) { setseed(random_seed); rEngine.seed(random_seed); } else { setseed(time(NULL)); rEngine.seed(time(NULL)); } } void IsInConvexes(double *points, int *dimension, int *cardinalities, int *numClasses, double *objects, int *numObjects, int *seed, int *isInConvexes){ setSeed(*seed); int numPoints = 0;for (int i = 0; i < numClasses[0]; i++){numPoints += cardinalities[i];} TMatrix x(numPoints); for (int i = 0; i < numPoints; i++){x[i] = TPoint(dimension[0]);} for (int i = 0; i < numPoints; i++){ for (int j = 0; j < dimension[0]; j++){ x[i][j] = points[i * dimension[0] + j]; } } TMatrix o(numObjects[0]); for (int i = 0; i < numObjects[0]; i++){o[i] = TPoint(dimension[0]);} for (int i = 0; i < numObjects[0]; i++){ for (int j = 0; j < dimension[0]; j++){ o[i][j] = objects[i * dimension[0] + j]; } } TVariables cars(numClasses[0]); for (int i = 0; i < numClasses[0]; i++){ cars[i] = cardinalities[i]; } TIntMatrix answers(o.size()); int error = 0; InConvexes(x, cars, o, error, &answers); for (int i = 0; i < numObjects[0]; i++) for (int j = 0; j < numClasses[0]; j++){ isInConvexes[numClasses[0]*i+j] = answers[i][j]; } } void ZDepth(double *points, double *objects, int *numPoints, int *numObjects, int *dimension, int *seed, double *depths){ setSeed(*seed); TMatrix x(numPoints[0]); for (int i = 0; i < numPoints[0]; i++){x[i] = TPoint(dimension[0]);} for (int i = 0; i < numPoints[0]; i++){ for (int j = 0; j < dimension[0]; j++){ x[i][j] = points[i * dimension[0] + j]; } } TPoint means(*dimension); TPoint sds(*dimension); GetMeansSds(x, &means, &sds); Standardize(x, means, sds); TMatrix z(numObjects[0]); for (int i = 0; i < numObjects[0]; i++){z[i] = TPoint(dimension[0]);} for (int i = 0; i < numObjects[0]; i++){ for (int j = 0; j < dimension[0]; j++){ z[i][j] = objects[i * dimension[0] + j]; } Standardize(z[i], means, sds); int error; depths[i] = ZonoidDepth(x, z[i], error); } } void HDepth(double *points, double *objects, int *numObjects, int *dimension, int *cardinalities, int *numClasses, double *directions, double *projections, int *k, int *sameDirs, int *seed, double *depths){ setSeed(*seed); int numPoints = 0;for (int i = 0; i < numClasses[0]; i++){numPoints += cardinalities[i];} TDMatrix x = asMatrix(points, numPoints, dimension[0]); TDMatrix z = asMatrix(objects, numObjects[0], dimension[0]); TVariables cars(numClasses[0]); for (int i = 0; i < numClasses[0]; i++){ cars[i] = cardinalities[i]; } TDMatrix dirs = asMatrix(directions, k[0], *dimension); TDMatrix prjs = asMatrix(projections,k[0], numPoints); TDMatrix ptPrjDepths = newM(*k, *numClasses); for (int i = 0; i < numObjects[0]; i++){ GetDepths(z[i], x, numPoints, *dimension, cars, k[0], i == 0 ? 0 : sameDirs[0] /*at the first step fill the matrices*/, dirs, prjs, depths + i * numClasses[0], ptPrjDepths); /* for (int j = 0; j < numClasses[0]; j++){ depths[i * numClasses[0] + j] = dps[j]; }*/ } deleteM(ptPrjDepths); /* if (*sameDirs){ for (int i = 0; i < k[0] * dimension[0]; i++){ directions[i] = dirs[i / dimension[0]][i%dimension[0]]; } for (int i = 0; i < k[0] * numPoints; i++){ projections[i] = prjs[i / numPoints][i%numPoints]; } } deleteM(dirs); deleteM(prjs); */ delete[] x; delete[] z; delete[] dirs; delete[] prjs; } void HDSpace(double *points, int *dimension, int *cardinalities, int *numClasses, int *k, int *sameDirs, int *seed, double *dSpace, double *directions, double *projections){ setSeed(*seed); int numPoints = 0;for (int i = 0; i < numClasses[0]; i++){numPoints += cardinalities[i];} TDMatrix x = asMatrix(points, numPoints, *dimension); TVariables cars(numClasses[0]); for (int i = 0; i < numClasses[0]; i++){ cars[i] = cardinalities[i]; } TDMatrix dsps = asMatrix(dSpace, numPoints, *numClasses); TDMatrix dirs = asMatrix(directions, k[0], (*dimension)); TDMatrix prjs = asMatrix(projections, k[0], (numPoints)); GetDSpace(x, numPoints, *dimension, cars, k[0], sameDirs[0], dsps, dirs, prjs); /* for (int i = 0; i < numPoints*numClasses[0]; i++){ dSpace[i] = dsps[i/numClasses[0]][i%numClasses[0]]; } */ /* if (*sameDirs){ for (int i = 0; i < k[0] * dimension[0]; i++){ directions[i] = dirs[i / dimension[0]][i%dimension[0]]; } for (int i = 0; i < k[0] * numPoints; i++){ projections[i] = prjs[i / numPoints][i%numPoints]; } } deleteM(dirs); deleteM(prjs); */ delete[] x; delete[] dsps; delete[] dirs; delete[] prjs; } void HDepthSpaceEx(double *points, double *objects, int *cardinalities, int *numClasses, int *numObjects, int *dimension, int *algNo, double *depths){ double(*func)(double *z, double **xx, int n, int d); switch ((HDalgs)*algNo) { case recursive: func = &HD_Rec; break; case plane: func = &HD_Comb2; break; case line: func = &HD_Comb; break; default: func = 0; break; } TDMatrix x = asMatrix(objects, *numObjects, *dimension); int classBegin = 0; if (func) for (int c = 0; c < *numClasses; c++){ TDMatrix X = asMatrix(points+classBegin, cardinalities[c], *dimension); // printMatrix(X, cardinalities[c], *dimension); for (int i = 0; i < *numObjects; i++){ depths[c * (*numObjects) + i] = func(x[i], X, cardinalities[c], *dimension); } classBegin += cardinalities[c]* *dimension; delete[] X; } delete[] x; } void HDepthEx(double *points, double *objects, int *numPoints, int *numObjects, int *dimension, int *algNo, double *depths){ double(*func)(double *z, double **xx, int n, int d); switch ((HDalgs)*algNo) { case recursive: func = &HD_Rec; break; case plane: func = &HD_Comb2; break; case line: func = &HD_Comb; break; default: func = 0; break; } TDMatrix X = asMatrix(points, *numPoints, *dimension); TDMatrix x = asMatrix(objects, *numObjects, *dimension); if (func) for (int i = 0; i < *numObjects; i++){ depths[i] = func(x[i], X, *numPoints, *dimension); } delete[] X; delete[] x; } void MahalanobisDepth(double *points, double *objects, int *numPoints, int *numObjects, int *dimension, double* MCD, double *depths){ TDMatrix X = asMatrix(points, *numPoints, *dimension); TDMatrix x = asMatrix(objects, *numObjects, *dimension); MahalanobisDepth(X, x, *dimension, *numPoints, *numObjects, *MCD, depths); delete[] X; delete[] x; } void OjaDepth(double *points, double *objects, int *numPoints, int *numObjects, int *dimension, int *seed, int* exact, int *k, int *useCov, double *covEst, double *depths){ setSeed(*seed); TDMatrix X = asMatrix(points, *numPoints, *dimension); TDMatrix x = asMatrix(objects, *numObjects, *dimension); TDMatrix cov = asMatrix(covEst, *dimension, *dimension); if (*exact) OjaDepthsEx(X, x, *dimension, *numPoints, *numObjects, *useCov, cov, depths); else{ long long K = ((long long)2000000000)*k[0] + k[1]; OjaDepthsApx(X, x, *dimension, *numPoints, *numObjects, K, *useCov, cov, depths); } delete[] X; delete[] x; delete[] cov; } void SimplicialDepth(double *points, double *objects, int *numPoints, int *numObjects, int *dimension, int *seed, int* exact, int *k, double *depths){ setSeed(*seed); TDMatrix X = asMatrix(points, *numPoints, *dimension); TDMatrix x = asMatrix(objects, *numObjects, *dimension); if (*dimension == 2) SimplicialDepths2(X, x, *numPoints, *numObjects, depths); else if (*exact) SimplicialDepthsEx(X, x, *dimension, *numPoints, *numObjects, depths); else { long long K = ((long long)2000000000)*k[0] + k[1]; SimplicialDepthsApx(X, x, *dimension, *numPoints, *numObjects, K, depths); } delete[] X; delete[] x; } void AlphaLearn(double *points, int *numPoints, int *dimension, int *cardinalities, int *degree, int *minFeatures, double *ray){ TMatrix x(numPoints[0]); for (int i = 0; i < numPoints[0]; i++){x[i] = TPoint(dimension[0]);} for (int i = 0; i < numPoints[0]; i++){ for (int j = 0; j < dimension[0]; j++){ x[i][j] = points[i * dimension[0] + j]; } } TVariables y(numPoints[0]); for (int i = 0; i < cardinalities[0]; i++){y[i] = 1;} for (int i = cardinalities[0]; i < numPoints[0]; i++){y[i] = -1;} TMatrix _x; ExtendWithProducts(x, degree[0], &_x); TPoint direction; OUT_ALPHA = true; Learn(_x, y, minFeatures[0], &direction); ray[0] = degree[0]; for (int i = 0; i < direction.size(); i++){ ray[i + 1] = direction[i]; } } void AlphaLearnCV(double *points, int *numPoints, int *dimension, int *cardinalities, int *upToPower, int *numFolds, int *minFeatures, int *debug, double *ray){ TMatrix x(numPoints[0],TPoint(dimension[0])); for (int i = 0; i < numPoints[0]; i++){ for (int j = 0; j < dimension[0]; j++){ x[i][j] = points[i * dimension[0] + j]; } } TVariables y(numPoints[0]); for (int i = 0; i < cardinalities[0]; i++){y[i] = 1;} for (int i = cardinalities[0]; i < numPoints[0]; i++){y[i] = -1;} TPoint direction; unsigned int power; OUT_ALPHA = (debug[0])!=0; LearnCV(x, y, minFeatures[0], upToPower[0], numFolds[0], &direction, &power); ray[0] = power; for (int i = 0; i < direction.size(); i++){ ray[i + 1] = direction[i]; } } void AlphaClassify(double *points, int *numPoints, int *dimension, int *degree, double *ray, int *output){ TMatrix x(numPoints[0]); for (int i = 0; i < numPoints[0]; i++){x[i] = TPoint(dimension[0]);} for (int i = 0; i < numPoints[0]; i++){ for (int j = 0; j < dimension[0]; j++){ x[i][j] = points[i * dimension[0] + j]; } } TMatrix _x; ExtendWithProducts(x, degree[0], &_x); TPoint direction(_x[0].size()); for (int i = 0; i < _x[0].size(); i++){ direction[i] = ray[i + 1]; } TVariables y; Classify(_x, direction, &y); for (int i = 0; i < numPoints[0]; i++){ output[i] = y[i]; } } void KnnAffInvLearnJK(double *points, int *dimension, int *cardinalities, int *maxk, int *k){ int numPoints = cardinalities[0] + cardinalities[1]; TMatrix x(numPoints); for (int i = 0; i < numPoints; i++){x[i] = TPoint(dimension[0]);} for (int i = 0; i < numPoints; i++){ for (int j = 0; j < dimension[0]; j++){ x[i][j] = points[i * dimension[0] + j]; } } TVariables cars(2);cars[0] = cardinalities[0];cars[1] = cardinalities[1]; k[0] = GetK_JK_Binary(x, cars, maxk[0]); } void KnnAffInvClassify(double *objects, int *numObjects, double *points, int *dimension, int *cardinalities, int *k, int *output){ int numPoints = cardinalities[0] + cardinalities[1]; TMatrix x(numPoints); for (int i = 0; i < numPoints; i++){x[i] = TPoint(dimension[0]);} for (int i = 0; i < numPoints; i++){ for (int j = 0; j < dimension[0]; j++){ x[i][j] = points[i * dimension[0] + j]; } } TVariables cars(2);cars[0] = cardinalities[0];cars[1] = cardinalities[1]; TMatrix y(numObjects[0]); for (int i = 0; i < numObjects[0]; i++){y[i] = TPoint(dimension[0]);} for (int i = 0; i < numObjects[0]; i++){ for (int j = 0; j < dimension[0]; j++){ y[i][j] = objects[i * dimension[0] + j]; } } TVariables result; Knn_Classify_Binary(y, x, cars, k[0], &result); for (int i = 0; i < numObjects[0]; i++){ output[i] = result[i]; } } void KnnLearnJK(double *points, int *labels, int *numPoints, int *dimension, int *kmax, int *distType, int *k){ TMatrix x(numPoints[0]);TVariables y(numPoints[0]); for (int i = 0; i < numPoints[0]; i++){ x[i] = TPoint(dimension[0]); for (int j = 0; j < dimension[0]; j++){ x[i][j] = points[i * dimension[0] + j]; } y[i] = labels[i]; } k[0] = KnnCv(x, y, kmax[0], distType[0], 0); } void KnnClassify(double *objects, int *numObjects, double *points, int *labels, int *numPoints, int *dimension, int *k, int *distType, int *output){ TMatrix x(numPoints[0]);TVariables y(numPoints[0]); for (int i = 0; i < numPoints[0]; i++){ x[i] = TPoint(dimension[0]); for (int j = 0; j < dimension[0]; j++){ x[i][j] = points[i * dimension[0] + j]; } y[i] = labels[i]; } TMatrix z(numObjects[0]); for (int i = 0; i < numObjects[0]; i++){ z[i] = TPoint(dimension[0]); for (int j = 0; j < dimension[0]; j++){ z[i][j] = objects[i * dimension[0] + j]; } } TVariables result; Knn(z, x, y, k[0], distType[0], &result); for (int i = 0; i < numObjects[0]; i++){ output[i] = result[i]; } } void DKnnLearnCv(double *points, int *labels, int *numPoints, int *dimension, int *kmax, int *depthType, int *k, int* chunkNumber, int *seed){ setSeed(*seed); TDMatrix x = asMatrix(points, *numPoints, *dimension); *k = DKnnCv(x, *numPoints, *dimension, labels, *kmax, *depthType, *chunkNumber); delete[] x; } void DKnnClassify(double *objects, int *numObjects, double *points, int *labels, int *numPoints, int *dimension, int *k, int *depthType, int *seed, int *output){ setSeed(*seed); TDMatrix x = asMatrix(points, *numPoints, *dimension); TDMatrix z = asMatrix(objects, *numObjects, *dimension); DKnnClassify(x, *numPoints, *dimension, labels, z, *numObjects, *k, *depthType, output); delete[] x; delete[] z; } void PolynomialLearnCV(double *points, int *numPoints, int *dimension, int *cardinalities, int *maxDegree, int *chunkNumber, int *seed, /*OUT*/ int *degree, /*OUT*/ int *axis, /*OUT*/ double *polynomial){ setSeed(*seed); TDMatrix x = asMatrix(points, numPoints[0], dimension[0]); TVariables y(numPoints[0]); for (int i = 0; i < cardinalities[0]; i++){ y[i] = 1; } for (int i = cardinalities[0]; i < numPoints[0]; i++){ y[i] = -1; } TPoint pol = PolynomialLearnCV(x, cardinalities[0], cardinalities[1], *maxDegree, *chunkNumber, degree, axis); for (unsigned i = 0; i < pol.size(); i++){ polynomial[i] = pol[i]; } delete[] x; } /* everything implemented in R void PolynomialClassify(double *points, int *numPoints, int *dimension, int *degree, double *ray, int *output){ TMatrix x(numPoints[0]); for (int i = 0; i < numPoints[0]; i++){ x[i] = TPoint(dimension[0]); } for (int i = 0; i < numPoints[0]; i++){ for (int j = 0; j < dimension[0]; j++){ x[i][j] = points[i * dimension[0] + j]; } } TMatrix _x; ExtendWithProducts(x, degree[0], &_x); TPoint direction(_x[0].size()); for (unsigned i = 0; i < _x[0].size(); i++){ direction[i] = ray[i + 1]; } TVariables y; Classify(_x, direction, &y); for (int i = 0; i < numPoints[0]; i++){ output[i] = y[i]; } } */ void ProjectionDepth(double *points, double *objects, int *numObjects, int *dimension, int *cardinalities, int *numClasses, double *directions, double *projections, int *k, int *newDirs, int *seed, double *depths){ setSeed(*seed); TVariables cars(numClasses[0]); int numPoints = 0; for (int i = 0; i < numClasses[0]; i++){ numPoints += cardinalities[i]; cars[i] = cardinalities[i]; } TDMatrix x = asMatrix(points, numPoints, *dimension); TDMatrix z = asMatrix(objects, *numObjects, *dimension); TDMatrix dirs = asMatrix(directions, k[0], *dimension); TDMatrix prjs = asMatrix(projections, k[0], numPoints); TDMatrix _depths = asMatrix(depths, *numObjects, *numClasses); GetDepthsPrj(x, numPoints, *dimension, z, *numObjects, cars, *k, *newDirs, _depths, dirs, prjs); /* for (int i = 0; i < numObjects[0]; i++){ for (int j = 0; j < numClasses[0]; j++){ depths[i * numClasses[0] + j] = _depths[i][j]; } } if (newDirs[0]){ for (int i = 0; i < k[0]*dimension[0]; i++){ directions[i] = dirs[i/dimension[0]][i%dimension[0]]; } for (int i = 0; i < k[0]*numPoints; i++){ projections[i] = prjs[i/numPoints][i%numPoints]; } } */ delete[] x; delete[] z; delete[] dirs; delete[] prjs; delete[] _depths; } void PotentialDepthsCount(double *points, int *numPoints, int *dimension, int *classes, int *cardinalities, double *testpoints, int *numTestPoints, int* kernelType, double *a, int* ignoreself, double *depths){ TMatrix x(numPoints[0]); for (int i = 0; i < numPoints[0]; i++){ TPoint& curPoint = x[i]; curPoint.resize(dimension[0]); for (int j = 0; j < dimension[0]; j++){ curPoint[j] = points[i * dimension[0] + j]; } } TMatrix xt(numTestPoints[0]); for (int i = 0; i < numTestPoints[0]; i++){ TPoint& curPoint = xt[i]; curPoint.resize(dimension[0]); for (int j = 0; j < dimension[0]; j++){ curPoint[j] = testpoints[i * dimension[0] + j]; } } TMatrix d(numTestPoints[0]); for (int i = 0; i < numTestPoints[0]; i++){ d[i].resize(classes[0]); } TVariables car(classes[0]); for (int i = 0; i < classes[0]; i++){ car[i] = cardinalities[i]; } double (*Kernel) (TPoint& x, TPoint& y, double a) = 0; switch (*kernelType){ case 1: Kernel = EDKernel; break; case 2: Kernel = GKernel; break; case 3: Kernel = EKernel; break; case 4: Kernel = TriangleKernel; break; case 5: Kernel = VarGKernel; break; default: throw "Unsupported kernel type"; } PotentialDepths(x, car, xt, d, Kernel, *a, *ignoreself); for (int i = 0; i < numTestPoints[0]; i++){ for (int j = 0; j < classes[0]; j++){ // depths[i * classes[0] + j] = d[i][j]; depths[j * numTestPoints[0] + i] = d[i][j]; } } } void BetaSkeletonDepth(double *points, double *objects, int *numPoints, int *numObjects, int *dimension, double* beta, int* distCode, double* p, double* sigma, double *depths){ TDMatrix X = asMatrix(points, *numPoints, *dimension); TDMatrix x = asMatrix(objects, *numObjects, *dimension); TDMatrix s = asMatrix(sigma, *dimension, *dimension); LensDepth(X, x, *dimension, *numPoints, *numObjects, *beta, *distCode, *p, s, depths); delete[] X; delete[] x; delete[] s; } void SimplicialBandDepthF(double *objectsf, double *dataf, double *args, int *numObjects, int *numPoints, int *numArgs, int *dimension, int *modified, int *J, double *depths){ // Structure the input data T3DMatrix x = as3DMatrix(objectsf, *numObjects, *numArgs, *dimension); T3DMatrix X = as3DMatrix(dataf, *numPoints, *numArgs, *dimension); // Delegate calculation of depths BandDepth(x, X, *numObjects, *numPoints, *numArgs, *dimension, (bool)*modified, *J, depths); // Clean the memory for (int i = 0; i < *numPoints; i++){ delete[] X[i]; } delete[] X; for (int i = 0; i < *numObjects; i++){ delete[] x[i]; } delete[] x; } #ifdef __cplusplus } #endif ddalpha/src/Polynomial.h0000644000176200001440000000110014213423775014732 0ustar liggesusers/* File: Polynomial.h Created by: Oleksii Pokotylo First published: 07.05.2014 Last revised: 07.05.2014 Contains the polynomial classifier the DD-plot classification. For a description of the algorithm, see: Li, J., Cuesta-Albertos, J. A. and Liu, R. Y. (2012). DD-classifier: Nonparametric classification procedure based on DD-plot, Journal of the American Statistical Association 107(498): 737 - 753. */ TPoint PolynomialLearnCV(TDMatrix input, int numClass1, int numClass2, int maxDegree, int chunkNumber, int *degree, int *axis); ddalpha/src/DKnn.cpp0000644000176200001440000001350114213423775014004 0ustar liggesusers/* File: DKnn.cpp Created by: Oleksii Pokotylo First published: Last revised: The realization of the Depth-based KNN classifier of Paindaveine and Van Bever (2015). */ #include "stdafx.h" // compare UPoints descending static int Compare(UPoint p1, UPoint p2){ return (p1.value > p2.value); } void CountDepths(TDMatrix learnpoints, int* learnlabels, int nlearn, int d, TDMatrix checkpoints, int ncheck, int depthType, vector& depths, double* tempDepths, TVariables car, TDMatrix dirs, TDMatrix prjs, TDMatrix ptPrjDepths, int ndir // halfspace ){ if (depthType == 1){ for (int i = 0; i < ncheck; i++){ GetDepths(checkpoints[i], learnpoints, nlearn, d, car, ndir, i != 0, dirs, prjs, &(depths[i].value), ptPrjDepths); depths[i].pattern = learnlabels[i]; } return; } if (depthType == 2) MahalanobisDepth(learnpoints, checkpoints, d, nlearn, ncheck, 1, tempDepths); if (depthType == 3) SimplicialDepthsApx(learnpoints, checkpoints, d, nlearn, ncheck, choose(nlearn, d)*0.05, tempDepths); for (int i = 0; i < ncheck; i++){ depths[i].value = tempDepths[i]; depths[i].pattern = learnlabels[i]; } } /*parameter cv: true - return classes for each k, false - return classes for kMax only*/ void knnGetClasses(TDMatrix learnpoints, int* learnlabels, int nlearn, int d, int nClasses, TDMatrix checkpoints, int ncheck, int kMax, bool cv, int depthType, int* classes /*for cv matrix [ncheck*kMax], for classification vector [ncheck]*/ ){ // create the data structure for the reflected points double* arr = new double[nlearn*d]; TDMatrix reflected = new double*[nlearn * 2]; for (int i = 0; i < nlearn; i++){ reflected[2 * i] = learnpoints[i]; reflected[2 * i + 1] = arr + i*d; } vector depths(nlearn); double* tempDepths = new double[nlearn]; int ndir = 1000; TVariables car(1, nlearn * 2); TDMatrix dirs; if (depthType == 1) dirs = newM(ndir, d); TDMatrix prjs; if (depthType == 1) prjs = newM(ndir, nlearn * 2); TDMatrix ptPrjDepths; if (depthType == 1) ptPrjDepths = newM(ndir, 1); for (int p = 0; p < ncheck; p++){ double* point = checkpoints[p]; // reflect for (int i = 0; i < nlearn; i++){ for (int j = 0; j < d; j++){ reflected[2 * i + 1][j] = 2 * point[j] - reflected[2 * i][j]; } } // count depths of learn in reflected CountDepths(reflected, learnlabels, nlearn * 2, d, learnpoints, nlearn, depthType, depths, tempDepths, car, dirs, prjs, ptPrjDepths, ndir // halfspace ); /* for (int i = 0; i < nlearn; i++){ GetDepths(learnpoints[i], reflected, nlearn * 2, d, car, ndir, i != 0, dirs, prjs, &(depths[i].value), ptPrjDepths); depths[i].pattern = learnlabels[i]; }*/ sort(depths.begin(), depths.end(), Compare); TVariables counts(nClasses+1, 0); for (int i = 1; i <= nClasses; i++) counts[i] = 0; int prevmax = 0, prevclass = -1; for (int k = 1; k <= kMax; k++){ counts[depths[k - 1].pattern]++; int max = -1, clmax = -1; for (int cl = 1; cl <= nClasses; cl++){ if (counts[cl]>max){ max = counts[cl]; clmax = cl; } else if (max == counts[cl] && max == prevmax){ // if the same number of neighbors, use the prev rule clmax = prevclass; } } if (cv) classes[p*kMax + k - 1] = clmax; prevclass = clmax; prevmax = max; } if (!cv) classes[p] = prevclass; } delete[] tempDepths; if (depthType == 1){ deleteM(dirs); deleteM(prjs); deleteM(ptPrjDepths); } delete[] reflected; delete[] arr; } int DKnnCv(TDMatrix points, int n, int d, int* labels, int kMax, int depthType, int chunkNumber){ set unique_labels; unique_labels.insert(labels, labels + n - 1); int nClasses = unique_labels.size(); int chunkSize = ceil((double)n / chunkNumber); TDMatrix learnpoints = new double*[n - chunkSize + 1]; TDMatrix checkpoints = new double*[chunkSize]; int* learnlabels = new int[n - chunkSize + 1]; int* checklabels = new int[chunkSize]; int* testlabels = new int[n]; int* classes = new int[n*kMax]; int chunk = 0; for (int j = 0, l = 0, c = 0; j < n; j++){ if (j%chunkNumber){ learnpoints[l] = points[j]; learnlabels[l++] = labels[j]; } else{ checkpoints[c] = points[j]; checklabels[c++] = labels[j]; } } bool bigch = true; int hadObjects = 0; for (; chunk < chunkNumber; chunk++){ if (chunk > 0){ if (bigch && (chunkNumber)*(chunkSize - 1) + chunk == n){ bigch = false; chunkSize--; learnpoints[n - chunkSize - 1] = points[n - 1]; learnlabels[n - chunkSize - 1] = labels[n - 1]; } for (int i = 0; i < chunkSize; i++){ checkpoints[i] = learnpoints[(chunkNumber - 1)*i + chunk - 1]; checklabels[i] = learnlabels[(chunkNumber - 1)*i + chunk - 1]; learnpoints[(chunkNumber - 1)*i + chunk - 1] = points[chunkNumber*i + chunk - 1]; learnlabels[(chunkNumber - 1)*i + chunk - 1] = labels[chunkNumber*i + chunk - 1]; } } knnGetClasses(learnpoints, learnlabels, n - chunkSize, d, nClasses, checkpoints, chunkSize, kMax, true, depthType, classes + hadObjects*kMax); //store checklabels memcpy(testlabels + hadObjects, checklabels, chunkSize*sizeof(int)); hadObjects += chunkSize; } // run over k, count errors int kopt = 1, opterr = n; for (int k = 1; k <= kMax; k++){ int err = 0; for (int p = 0; p < n; p++){ if (classes[p*kMax + k - 1] != testlabels[p]) err++; } if (err < opterr){ opterr = err; kopt = k; } } delete[] learnpoints; delete[] checkpoints; delete[] learnlabels; delete[] checklabels; delete[] testlabels; delete[] classes; return kopt; } void DKnnClassify(TDMatrix points, int n, int d, int* labels, TDMatrix objects, int nobjects, int k, int depthType, int* classes){ set unique_lasbels; unique_lasbels.insert(labels, labels + n - 1); int nClasses = unique_lasbels.size(); knnGetClasses(points, labels, n, d, nClasses, objects, nobjects, k, false, depthType, classes); } ddalpha/src/PotentialDepth.h0000644000176200001440000000174714213423775015554 0ustar liggesusers#ifndef PotentialDepth_h #define PotentialDepth_h // Kernel constant: 1 // alpha - kernel sharpness. sharp - a more double EDKernel (TPoint& x, TPoint& y, double a); // Kernel constant: 2 // ss - sigma squared. sharp - a less double GKernel (TPoint& x, TPoint& y, double ss); // Kernel constant: 5 // ss - sigma squared. sharp - a less double VarGKernel(TPoint& x, TPoint& y, double ss); // Kernel constant: 3 // alpha - kernel sharpness. sharp - a more double EKernel (TPoint& x, TPoint& y, double a); // Kernel constant: 4 // alpha - triangle sharpness. sharp - a more. a in (0..pi/2) double TriangleKernel (TPoint& x, TPoint& y, double a); void PotentialDepths(TMatrix& points, TVariables& cardinalities, /*OUT*/ TMatrix& depths, double (*Kernel) (TPoint& x, TPoint& y, double a), double a); void PotentialDepths(TMatrix& points, TVariables& cardinalities, TMatrix& testpoints, /*OUT*/ TMatrix& depths, double (*Kernel) (TPoint& x, TPoint& y, double a), double a, int ignoreself); #endif ddalpha/src/Mahalanobis.cpp0000644000176200001440000000243014213423775015367 0ustar liggesusers #include "stdafx.h" void MahalanobisDepth(TDMatrix X, TDMatrix x, int d, int n, int nx, double MCD, double *depths){ double* ms = means(X, n, d); bMatrix A(d, d); if (MCD == 1){ TDMatrix covXtemp = cov(X, n, d); for (int k = 0; k < d; k++) for (int j = 0; j < d; j++) A(k, j) = covXtemp[k][j]; deleteM(covXtemp); } else{ #ifndef _MSC_VER Environment env("package:robustbase"); Function covMcd = env["covMcd"]; NumericMatrix X2(n,d); for (int i = 0; i < n; i++) for (int j = 0; j < d; j++) X2(i, j) = X[i][j]; List ret = covMcd(X2, false, false, MCD); NumericMatrix covXtemp = ret["cov"]; for (int k = 0; k < d; k++) for (int j = 0; j < d; j++) A(k, j) = covXtemp(k, j); #endif } using namespace boost::numeric::ublas; bMatrix s(d, d); s.assign(identity_matrix(d)); permutation_matrix pm(A.size1()); int res = lu_factorize(A, pm); // if (res != 0) return false; lu_substitute(A, pm, s); double *a = new double[d]; for (int i = 0; i < nx; i++){ depths[i] = 0; for (int k = 0; k < d; k++){ a[k] = 0; for (int j = 0; j < d; j++){ a[k] += (x[i][j] - ms[j])*s(j, k); } } for (int j = 0; j < d; j++){ depths[i] += (x[i][j] - ms[j])*a[j]; } depths[i] = 1.0 / ((depths[i]) + 1); } delete[] a; delete[] ms; } ddalpha/src/depth.fd.f0000644000176200001440000011202014216410625014276 0ustar liggesusersc---------------------------------------------------------------------- c Stanislav Nagy c nagy@karlin.mff.cuni.cz c 27/06/2016 c c Fortran implementation of functional depths and kernel smoothing c - Nagy, Ferraty: Depth for Noisy Random Functions c - Nagy, Gijbels, Hlubinka: Depth-Based Recognition of Shape c Outlying Functions c c---------------------------------------------------------------------- c---------------------------------------------------------------------- c kernel smoothing of a set of functions c---------------------------------------------------------------------- SUBROUTINE KERNSM(T,X,G,M,N,H,K,R) c kernel smoothing of a single function c T vector of observation points (M) c X vector of observed values (M) c G grid to evaluate (N) c H bandwidth c K kernel code to use, see below c R resulting estimate (N) integer M,N,K integer I,J double precision T(M),X(M),G(N),R(N),H double precision DEN,P DO 10 I=1,N R(I)=0.0 DEN = 0.0 DO 5 J=1,M CALL KERN((G(I)-T(J))/H,P,K) R(I) = R(I) + X(J)*P DEN = DEN + P 5 CONTINUE IF (DEN.GT.0) THEN R(I) = R(I)/DEN ELSE R(I) = 10**6 ENDIF 10 CONTINUE RETURN END c---------------------------------------------------------------------- SUBROUTINE KERN(T,R,K) c kernel functions double precision T,R INTEGER K IF(K.EQ.1) THEN c uniform kernel IF (ABS(T).LE.1.0) THEN R = .5 ELSE R = 0.0 ENDIF ENDIF IF(K.EQ.2) THEN c triangular kernel IF (ABS(T).LE.1.0) THEN R = 1-ABS(T) ELSE R = 0.0 ENDIF ENDIF IF(K.EQ.3) THEN c Epanechnikov kernel IF (ABS(T).LE.1.0) THEN R = 3.0/4.0*(1.0-T**2.0) ELSE R = 0.0 ENDIF ENDIF IF(K.EQ.4) THEN c biweight kernel IF (ABS(T).LE.1.0) THEN R = 15.0/16.0*(1.0-T**2.0)**2 ELSE R = 0.0 ENDIF ENDIF IF(K.EQ.5) THEN c triweight kernel IF (ABS(T).LE.1.0) THEN R = 35.0/32.0*(1.0-T**2.0)**3 ELSE R = 0.0 ENDIF ENDIF IF(K.EQ.6) THEN c Gaussian kernel R = (2*4.D0*DATAN(1.D0))**(-0.5)*EXP(-0.5*T**2) ENDIF RETURN END c---------------------------------------------------------------------- SUBROUTINE CVKERNSM(T,X,G,M,N,H,NH,KER,TRE,XRE,TNRE,XNRE,NR,NT,R) c as in KERNSM, but with automated BW seletction c from the vector H(NH) c KER kernel code c TRE,XRE vectors from T,X for omission for the CV (NR*NT) c TNRE,XNRE supplementary vectors to TRE,NRE ((M-NR)*NT) c NR no of random elements for each H choice c NT no of random trials for each H choice c for each H we choose NR random points from X c compute the kernel smoother without these points c and evaluate the error. repeat NT times, then average c the errors to get the CV estimate integer M,N,NH,NR,NT,KER integer I,J,K,OM(NR),L double precision T(M),X(M),G(N),R(N),H(NH),TRE(NR*NT),XRE(NR*NT) double precision TNRE((M-NR)*NT),XNRE((M-NR)*NT) double precision TOM(NR),XOM(NR),TNOM(M-NR),XNOM(M-NR) double precision CV(NH),SR(NR),MCV DO 30 I=1,NH CV(I) = 0.0 DO 20 J=1,NT DO 5 K=1,NR TOM(K) = TRE((J-1)*NR+K) XOM(K) = XRE((J-1)*NR+K) 5 CONTINUE DO 6 K=1,(M-NR) TNOM(K) = TNRE((J-1)*(M-NR)+K) XNOM(K) = XNRE((J-1)*(M-NR)+K) 6 CONTINUE CALL KERNSM(TNOM,XNOM,TOM,(M-NR),NR,H(I),KER,SR) DO 10 K=1,NR CV(I) = CV(I) + (XOM(K)-SR(K))**2 10 CONTINUE 20 CONTINUE 30 CONTINUE K = 0 MCV = CV(1)+1 DO 40 I=1,NH IF (CV(I).LT.MCV) THEN K = I MCV = CV(I) ENDIF 40 CONTINUE CALL KERNSM(T,X,G,M,N,H(K),KER,R) RETURN END c---------------------------------------------------------------------- c fucntional data depth computation c---------------------------------------------------------------------- SUBROUTINE funD1(A,B,M,N,D,funSDEP,funHDEP,fIsdep,fIhdep,IAsdep, +IAhdep) c univariate integrated depth INTEGER N,M,D INTEGER IAsdep(M),IAhdep(M) double precision A(M*D),B(N*D),funSDEP(M),funHDEP(M), +fIsdep(M),fIhdep(M) double precision BH(N) double precision hSDEP,hHDEP INTEGER I,J,K c initializing DO 5 I=1,M funSDEP(I) = 0.0 funHDEP(I) = 0.0 fISDEP(I) = 2.0 fIHDEP(I) = 2.0 IAsdep(I) = 0 IAhdep(I) = 0 5 CONTINUE c essential loop, computing 1D depths at each point DO 30 I=1,D DO 10 K=1,N BH(K) = B((I-1)*N+K) 10 CONTINUE DO 20 J=1,M hSDEP = 0.0 hHDEP = 0.0 CALL fD1(A((I-1)*M+J),N,BH,hSDEP,hHDEP) c integrated depth evaluation funSDEP(J) = funSDEP(J) + hSDEP funHDEP(J) = funHDEP(J) + hHDEP c counting the area of the smallest depth for each function IF (hSDEP.EQ.fISDEP(J)) THEN IAsdep(J) = IAsdep(J)+1 ELSEIF (hSDEP.LT.fISDEP(J)) THEN IAsdep(J) = 1 ENDIF IF (hHDEP.EQ.fIHDEP(J)) THEN IAhdep(J) = IAhdep(J)+1 ELSEIF (hHDEP.LT.fIHDEP(J)) THEN IAhdep(J) = 1 ENDIF c infimal depth evaluation fISDEP(J) = min(fISDEP(J),hSDEP) fIHDEP(J) = min(fIHDEP(J),hHDEP) 20 CONTINUE 30 CONTINUE c dividing the resulting depths by number of points d DO 40 I=1,M funSDEP(I) = funSDEP(I)/(D+0.0) funHDEP(I) = funHDEP(I)/(D+0.0) 40 CONTINUE RETURN END c---------------------------------------------------------------------- SUBROUTINE fD1(U,N,X,SDEP,HDEP) c computes 1D simplicial and halfspace depth of U wrt X of size N c used in the univariate integrated depth double precision U,X(N),SDEP,HDEP INTEGER N,RB,RA,I RB = 0 RA = 0 DO 10 I=1,N IF (U .LE. X(I)) THEN RB = RB + 1 ENDIF IF (U .GE. X(I)) THEN RA = RA + 1 ENDIF 10 CONTINUE HDEP = min(RA+0.0,RB+0.0)/(N+0.0) SDEP = (RA+0.0)*(RB+0.0)/(K(N,2)+0.0) RETURN END c---------------------------------------------------------------------- INTEGER FUNCTION K(M,J) c combination number (m choose j) integer m,j IF (M.LT.J) THEN K=0 ELSE IF (J.EQ.1) K=M IF (J.EQ.2) K=(M*(M-1))/2 IF (J.EQ.3) K=(M*(M-1)*(M-2))/6 ENDIF RETURN END c---------------------------------------------------------------------- SUBROUTINE metrl2(A,B,M,N,D,METR) c computes a fast approximation of the L2 metric between A and B c supporting functions on regular grids only c used in the h-mode depth INTEGER N,M,D double precision A(M*D),B(N*D),METR(M*N) INTEGER I,J,K DO 15 I=1,M DO 10 J=1,N METR((J-1)*M+I) = 0.0 DO 5 K=1,D METR((J-1)*M+I) = METR((J-1)*M+I) + (A((K-1)*M+I)- +B((K-1)*N+J))**2 5 CONTINUE METR((J-1)*M+I) = sqrt(METR((J-1)*M+I) - +((A((0)*M+I)-B((0)*N+J))**2+(A((D-1)*M+I)-B((D-1)*N+J))**2) +/(2.0)) 10 CONTINUE 15 CONTINUE RETURN END c---------------------------------------------------------------------- SUBROUTINE metrC(A,B,M,N,D,METR) c computes a fast approximation of the C metric between A and B c supporting functions on regular grids only c used in the h-mode depth INTEGER N,M,D double precision A(M*D),B(N*D),METR(M*N) INTEGER I,J,K DO 15 I=1,M DO 10 J=1,N METR((J-1)*M+I) = 0.0 DO 5 K=1,D METR((J-1)*M+I) = MAX(METR((J-1)*M+I),A((K-1)*M+I)- +B((K-1)*N+J)) METR((J-1)*M+I) = MAX(METR((J-1)*M+I),-A((K-1)*M+I)+ +B((K-1)*N+J)) 5 CONTINUE 10 CONTINUE 15 CONTINUE RETURN END c---------------------------------------------------------------------- double precision FUNCTION MAX(A,B) c maximum of two numbers A and B double precision A,B IF (A.LE.B) THEN MAX = B ELSE MAX = A ENDIF RETURN END double precision FUNCTION AdjLPindicator(EVAL,J,B,V) c adjusted band depth core function, smoothing (exp(-u)), L2 metric c b is a vector of length eval c v is a matrix j*eval INTEGER EVAL, J double precision B(EVAL), V(J*EVAL) double precision MINI, MAXI, DIST, POWER INTEGER I, II DIST = 0.0 POWER = 1.0 c power in exp(-power*dist) for weighting DO 10 I=1,EVAL MINI = V((I-1)*J+1) MAXI = V((I-1)*J+1) DO 5 II=1,J IF (MINI.GT.V((I-1)*J+II)) THEN MINI = V((I-1)*J+II) ENDIF IF (MAXI.LT.V((I-1)*J+II)) THEN MAXI = V((I-1)*J+II) ENDIF 5 CONTINUE IF ((B(I).GE.MINI).AND.(B(I).LE.MAXI)) THEN DIST = DIST + 0.0 ELSE IF(B(I).GT.MAXI) THEN DIST = DIST + (B(I)-MAXI)**2 ENDIF IF(B(I).LT.MINI) THEN DIST = DIST + (MINI-B(I))**2 ENDIF ENDIF 10 CONTINUE DIST = DIST/(EVAL+0.0) DIST = EXP(-POWER*DIST) AdjLPindicator = DIST RETURN END SUBROUTINE AdjLP(EVAL,J,M,KOMB,COM,B,V,DJ) c adjusted band depth function, smoothing (exp(-u)), L2 metric c eval no of time points for each functions c J order of the depth c m sample size c komb m choose J number c com vector of all the combinations of J elements from m c b functional values of the x function, length eval c v matrix of sample funct. values, dimension [m x eval] INTEGER EVAL,J,M,KOMB,COM(KOMB*J) double precision B(EVAL),V(M*EVAL),DJ double precision VPOM(J*EVAL) INTEGER C,I,II double precision ADJLPINDICATOR DJ = 0.0 DO 10 C=1,KOMB DO 5 I=1,J DO 3 II=1,EVAL VPOM((II-1)*J+I) = V((II-1)*M+COM((C-1)*J+I)) 3 CONTINUE 5 CONTINUE DJ = DJ + AdjLPindicator(EVAL,J,B,VPOM) 10 CONTINUE DJ = DJ/(KOMB+0.0) RETURN END c---------------------------------------------------------------------- double precision FUNCTION AdjCindicator(EVAL,J,B,V) c adjusted band depth core function, smoothing (exp(-u)), C metric c b is a vector of length eval c v is a matrix j*eval INTEGER EVAL, J double precision B(EVAL), V(J*EVAL) double precision MINI, MAXI, DIST, POWER, MAX INTEGER I, II DIST = 0.0 POWER = 1.0 c power in exp(-power*dist) for weighting DO 10 I=1,EVAL MINI = V((I-1)*J+1) MAXI = V((I-1)*J+1) DO 5 II=1,J IF (MINI.GT.V((I-1)*J+II)) THEN MINI = V((I-1)*J+II) ENDIF IF (MAXI.LT.V((I-1)*J+II)) THEN MAXI = V((I-1)*J+II) ENDIF 5 CONTINUE IF ((B(I).GE.MINI).AND.(B(I).LE.MAXI)) THEN DIST = DIST + 0.0 ELSE IF(B(I).GT.MAXI) THEN DIST = MAX(DIST,(B(I)-MAXI)) ENDIF IF(B(I).LT.MINI) THEN DIST = MAX(DIST,(MINI-B(I))) ENDIF ENDIF 10 CONTINUE DIST = EXP(-POWER*DIST) AdjCindicator = DIST RETURN END SUBROUTINE AdjC(EVAL,J,M,KOMB,COM,B,V,DJ) c adjusted band depth function, smoothing (exp(-u)), C metric c eval no of time points for each functions c J order of the depth c m sample size c komb m choose J number c com vector of all the combinations of J elements from m c b functional values of the x function, length eval c v matrix of sample funct. values, dimension [m x eval] INTEGER EVAL,J,M,KOMB,COM(KOMB*J) double precision B(EVAL),V(M*EVAL),DJ double precision VPOM(J*EVAL) INTEGER C,I,II double precision ADJCINDICATOR DJ = 0.0 DO 10 C=1,KOMB DO 5 I=1,J DO 3 II=1,EVAL VPOM((II-1)*J+I) = V((II-1)*M+COM((C-1)*J+I)) 3 CONTINUE 5 CONTINUE DJ = DJ + AdjCindicator(EVAL,J,B,VPOM) 10 CONTINUE DJ = DJ/(KOMB+0.0) RETURN END c----------------------------------- c DiffDepth.f c----------------------------------- c------------------------------------- c first Difference Depth for 1D functions c for 1d functions, halfspace and simplicial depth c------------------------------------- SUBROUTINE DiffD(A,B,M,N,D,REP,RN,funSDEP,funHDEP,funSDEPm, +funHDEPm,PSDEP,PHDEP,IAsdep,IAhdep) c using fdepth computes 2dimensional diff depth of functions in A c with respect to the functions in B c M size of functions in A c N size of functions in B c D dimensionality of functions c REP is the number of simulations to approximate the real value c of depth, if set to 0 full comutation is made c RN random numbers, arrray of randoms from 1:D of size 2*REP c funSDEPm DiffDepth when taking infimum of projected depths c funSDEP DiffDepth when taking integral of projected depths c P.DEP pointwise depth, depth at each point of domain x domain c P.DEP is computed only if M=1, for simplicity INTEGER N,M,D,REP INTEGER IAsdep(M),IAhdep(M) double precision A(M*D),B(N*D),funSDEP(M),funHDEP(M),PSDEP(D*D), +PHDEP(D*D) double precision funSDEPm(M),funHDEPm(M),B1H(N),B2H(N) double precision hSDEP,hHDEP double precision hALPHA(N) INTEGER hF(N),I,J,K,RN(2*REP) DO 5 I=1,M funSDEP(I) = 0.0 funHDEP(I) = 0.0 funSDEPm(I) = 2.0 funHDEPm(I) = 2.0 IAsdep(I) = 0 IAhdep(I) = 0 5 CONTINUE c initialization for easier recognition of unfilled elements IF (M.EQ.1) THEN DO 8 I=1,(D*D) PSDEP(I) = -1.0 PHDEP(I) = -1.0 8 CONTINUE ENDIF c essential loop, computing 2D depths at each point IF (REP.EQ.0) THEN c if we compute the complete, non-approximated depth DO 30 I=1,D DO 25 J=(I+1),D c not taking into account diagonal elements, there is 0 depth DO 10 K=1,N B1H(K) = B((I-1)*N+K) B2H(K) = B((J-1)*N+K) 10 CONTINUE DO 20 L=1,M hSDEP = 0.0 hHDEP = 0.0 hALPHA(1) = N+0.0 hF(1) = N CALL fD2(A((I-1)*M+L),A((J-1)*M+L),N,B1H,B2H,hALPHA,hF, +hSDEP,hHDEP) funSDEP(L) = funSDEP(L) + hSDEP funHDEP(L) = funHDEP(L) + hHDEP c counting the area of the smallest depth for each function IF (hSDEP.EQ.funSDEPm(L)) THEN IAsdep(L) = IAsdep(L)+1 ELSEIF (hSDEP.LT.funSDEPm(L)) THEN IAsdep(L) = 1 ENDIF IF (hHDEP.EQ.funHDEPm(L)) THEN IAhdep(L) = IAhdep(L)+1 ELSEIF (hHDEP.LT.funHDEPm(L)) THEN IAhdep(L) = 1 ENDIF funSDEPm(L) = min(funSDEPm(L),hSDEP) funHDEPm(L) = min(funHDEPm(L),hHDEP) IF (M.EQ.1) THEN PSDEP((I-1)*D+J) = hSDEP PHDEP((I-1)*D+J) = hHDEP ENDIF 20 CONTINUE 25 CONTINUE 30 CONTINUE c dividing the resulting depths by number of points d c for infimal area, the result is *2+D because the diagonal c has zero depth by default, and only the lower triangle c of the matrix is actually computed DO 40 I=1,M funSDEP(I) = 2.0*funSDEP(I)/(D*(D-1.0)) c diagonals are always zero, do not count into the sum c ((D+0.0)*(D+1.0)/2+0.0-D) funHDEP(I) = 2.0*funHDEP(I)/(D*(D-1.0)) c ((D+0.0)*(D+1.0)/2+0.0-D) IAhdep(I) = IAhdep(I)*2+D IAsdep(I) = IAsdep(I)*2+D 40 CONTINUE ELSE c else of if(REP.EQ.0), that is if we approximate DO 70 I=1,REP c going through random elements DO 50 K=1,N B1H(K) = B((RN(2*I-1)-1)*N+K) B2H(K) = B((RN(2*I)-1)*N+K) 50 CONTINUE DO 60 L=1,M hSDEP = 0.0 hHDEP = 0.0 hALPHA(1) = N+0.0 hF(1) = N CALL fD2(A((RN(2*I-1)-1)*M+L),A((RN(2*I)-1)*M+L),N, +B1H,B2H,hALPHA,hF,hSDEP,hHDEP) funSDEP(L) = funSDEP(L) + hSDEP funHDEP(L) = funHDEP(L) + hHDEP c counting the area of the smallest depth for each function IF (hSDEP.EQ.funSDEPm(L)) THEN IAsdep(L) = IAsdep(L)+1 ELSEIF (hSDEP.LT.funSDEPm(L)) THEN IAsdep(L) = 1 ENDIF IF (hHDEP.EQ.funHDEPm(L)) THEN IAhdep(L) = IAhdep(L)+1 ELSEIF (hHDEP.LT.funHDEPm(L)) THEN IAhdep(L) = 1 ENDIF funSDEPm(L) = min(funSDEPm(L),hSDEP) funHDEPm(L) = min(funHDEPm(L),hHDEP) IF (M.EQ.1) THEN PSDEP((RN(2*I-1)-1)*D+RN(2*I)) = hSDEP PHDEP((RN(2*I-1)-1)*D+RN(2*I)) = hHDEP ENDIF 60 CONTINUE 70 CONTINUE DO 80 I=1,M funSDEP(I) = funSDEP(I)/(REP+0.0) funHDEP(I) = funHDEP(I)/(REP+0.0) 80 CONTINUE ENDIF RETURN END c---------------------------------------------------------------------- SUBROUTINE fD2(U,V,N,X,Y,ALPHA,F,SDEP,HDEP) c Rousseuw, P.J., and Ruts, I. (1996), AS 307 : Bivariate location c depth, Applied Statistics (JRRSS-C), vol.45, 516-526 double precision U,V,X(n),Y(n),ALPHA(n) double precision P,P2,EPS,D,XU,YU,ANGLE,ALPHK,BETAK,SDEP,HDEP INTEGER F(N),GI integer n,nums,numh,nt,i,nn,nu,ja,jb,nn2,nbad,nf,j,ki,k NUMS=0 NUMH=0 SDEP=0.0 HDEP=0.0 IF (N.LT.1) RETURN P=ACOS(-1.0) P2=P*2.0 EPS=0.00000001 NT=0 C C Construct the array ALPHA. C DO 10 I=1,N D=SQRT((X(I)-U)*(X(I)-U)+(Y(I)-V)*(Y(I)-V)) IF (D.LE.EPS) THEN NT=NT+1 ELSE XU=(X(I)-U)/D YU=(Y(I)-V)/D IF (ABS(XU).GT.ABS(YU)) THEN IF (X(I).GE.U) THEN ALPHA(I-NT)=ASIN(YU) IF(ALPHA(I-NT).LT.0.0) THEN ALPHA(I-NT)=P2+ALPHA(I-NT) ENDIF ELSE ALPHA(I-NT)=P-ASIN(YU) ENDIF ELSE IF (Y(I).GE.V) THEN ALPHA(I-NT)=ACOS(XU) ELSE ALPHA(I-NT)=P2-ACOS(XU) ENDIF ENDIF IF (ALPHA(I-NT).GE.(P2-EPS)) ALPHA(I-NT)=0.0 ENDIF 10 CONTINUE NN=N-NT IF (NN.LE.1) GOTO 60 C C Sort the array ALPHA. C CALL SORT(ALPHA,NN) C C Check whether theta=(U,V) lies outside the data cloud. C ANGLE=ALPHA(1)-ALPHA(NN)+P2 DO 20 I=2,NN ANGLE=MAX(ANGLE,(ALPHA(I)-ALPHA(I-1))) 20 CONTINUE IF (ANGLE.GT.(P+EPS)) GOTO 60 C C Make smallest alpha equal to zero, C and compute NU = number of alpha < pi. C ANGLE=ALPHA(1) NU=0 DO 30 I=1,NN ALPHA(I)=ALPHA(I)-ANGLE IF (ALPHA(I).LT.(P-EPS)) NU=NU+1 30 CONTINUE IF (NU.GE.NN) GOTO 60 C C Mergesort the alpha with their antipodal angles beta, C and at the same time update I, F(I), and NBAD. C JA=1 JB=1 ALPHK=ALPHA(1) BETAK=ALPHA(NU+1)-P NN2=NN*2 NBAD=0 I=NU NF=NN DO 40 J=1,NN2 IF ((ALPHK+EPS).LT.BETAK) THEN NF=NF+1 IF (JA.LT.NN) THEN JA=JA+1 ALPHK=ALPHA(JA) ELSE ALPHK=P2+1.0 ENDIF ELSE I=I+1 IF (I.EQ.(NN+1)) THEN I=1 NF=NF-NN ENDIF F(I)=NF NBAD=NBAD+K((NF-I),2) IF (JB.LT.NN) THEN JB=JB+1 IF ((JB+NU).LE.NN) THEN BETAK=ALPHA(JB+NU)-P ELSE BETAK=ALPHA(JB+NU-NN)+P ENDIF ELSE BETAK=P2+1.0 ENDIF ENDIF 40 CONTINUE NUMS=K(NN,3)-NBAD C C Computation of NUMH for halfspace depth. C GI=0 JA=1 ANGLE=ALPHA(1) NUMH=MIN(F(1),(NN-F(1))) DO 50 I=2,NN IF(ALPHA(I).LE.(ANGLE+EPS)) THEN JA=JA+1 ELSE GI=GI+JA JA=1 ANGLE=ALPHA(I) ENDIF KI=F(I)-GI NUMH=MIN(NUMH,MIN(KI,(NN-KI))) 50 CONTINUE C C Adjust for the number NT of data points equal to theta: C 60 NUMS=NUMS+K(NT,1)*K(NN,2)+K(NT,2)*K(NN,1)+K(NT,3) IF (N.GE.3) SDEP=(NUMS+0.0)/(K(N,3)+0.0) NUMH=NUMH+NT HDEP=(NUMH+0.0)/(N+0.0) RETURN END c---------------------------------------------------------------------- c INTEGER FUNCTION K(M,J) c integer m,j c IF (M.LT.J) THEN c K=0 c ELSE c IF (J.EQ.1) K=M c IF (J.EQ.2) K=(M*(M-1))/2 c IF (J.EQ.3) K=(M*(M-1)*(M-2))/6 c ENDIF c RETURN c END c---------------------------------------------------------------------- SUBROUTINE SORT(B,N) C Sorts an array B (of length N<=1000) in O(NlogN) time. double precision B(N),x(n) integer q(n),i,n call indexx(n,b,q) do 10 i=1,n x(i)=b(i) 10 continue do 20 i=1,n b(i)=x(q(i)) 20 continue end c---------------------------------------------------------------------- SUBROUTINE INDEXX(N,ARRIN,INDX) integer INDX(N) integer n,j,l,ir,indxt,i double precision arrin(n),q DO 11 J=1,N INDX(J)=J 11 CONTINUE L=N/2+1 IR=N 10 CONTINUE IF(L.GT.1)THEN L=L-1 INDXT=INDX(L) Q=ARRIN(INDXT) ELSE INDXT=INDX(IR) Q=ARRIN(INDXT) INDX(IR)=INDX(1) IR=IR-1 IF(IR.EQ.1)THEN INDX(1)=INDXT RETURN ENDIF ENDIF I=L J=L+L 20 IF(J.LE.IR)THEN IF(J.LT.IR)THEN IF(ARRIN(INDX(J)).LT.ARRIN(INDX(J+1)))J=J+1 ENDIF IF(Q.LT.ARRIN(INDX(J)))THEN INDX(I)=INDX(J) I=J J=J+J ELSE J=IR+1 ENDIF GO TO 20 ENDIF INDX(I)=INDXT GO TO 10 END cccccccccccccccccc c c newdepth c cccccccccccccccccc c---------------------------------------------------------------------- SUBROUTINE funMD(A,B,M,N,D,Q,funDEP) INTEGER N,M,D,I,J double precision A(M*D),B(N*D),METR1(N*N),METR2(N*M),funDEP(M) double precision Q,H,PI c Q is quantile, default 0.15, Cuevas 0.2 CALL metrl2(B,B,N,N,D,METR1) CALL metrl2(A,B,M,N,D,METR2) CALL SORT(METR1,N*N) H = METR1(INT(Q*(N*N+0.0))) PI=4.D0*DATAN(1.D0) DO 10 I=1,M*N METR2(I) = EXP(-(METR2(I)/H)**2/2.0)/SQRT(2.0*PI) 10 CONTINUE DO 20 I=1,M funDEP(I)=0.0 DO 15 J=1,N funDEP(I) = funDEP(I)+METR2((J-1)*M+I) 15 CONTINUE 20 CONTINUE RETURN END c---------------------------------------------------------------------- SUBROUTINE funRPD1(A,B,M,N,D,NPROJ,NPROJ2,V,funSDEP, +funHDEP,funRDEP) c computes fast random projection depth for 1D functions using c NPROJ simple iid gaussian processes projection and then 1D c simplicial or halfspace depth c RDEP random halfspace depth (Cuesta-Albertos, Nieto-Reyes 2008) c NPROJ2 nr of projections for RDEP INTEGER M,N,D,NPROJ,NPROJ2 double precision A(M*D),B(N*D),funSDEP(M),funHDEP(M),funRDEP(M) double precision V(D*NPROJ),AP,BP(N),VNORM INTEGER I,J,K double precision hSDEP,hHDEP DO 5 I=1,M funSDEP(I) = 0.0 funHDEP(I) = 0.0 funRDEP(I) = 2.0 5 CONTINUE c main loop DO 40 K=1,NPROJ c generating a single gaussian processes VNORM = 0.0 DO 10 I=1,D Vnorm = VNORM + V((K-1)*D+I)**2 10 CONTINUE VNORM = sqrt(VNORM - (V((K-1)*D+1)**2+V((K-1)*D+D)**2)/(2.0)) c loop projecting j-th function of the random sample B on v DO 18 J=1,N BP(J) = 0.0 DO 15 I=1,D BP(J) = BP(J)+ B((I-1)*N+J)*V((K-1)*D+I)/VNORM 15 CONTINUE BP(J) = BP(J)/(D+0.0) 18 CONTINUE c loop with projecting j-th function of the random sample A on v DO 30 J=1,M AP = 0.0 c compute projection of j-th function A DO 20 I=1,D AP = AP + A((I-1)*M+J)*V((K-1)*D+I)/VNORM 20 CONTINUE AP = AP/(D+0.0) hSDEP = 0.0 hHDEP = 0.0 CALL fD1(AP,N,BP,hSDEP,hHDEP) funSDEP(J) = funSDEP(J) + hSDEP funHDEP(J) = funHDEP(J) + hHDEP IF (K .LE. NPROJ2) THEN funRDEP(J) = min(funRDEP(J),hHDEP) ENDIF 30 CONTINUE 40 CONTINUE c averaging projection depth over all projections DO 50 I=1,M funSDEP(I) = funSDEP(I)/(NPROJ+0.0) funHDEP(I) = funHDEP(I)/(NPROJ+0.0) 50 CONTINUE RETURN END c------------------------------------- c Fraiman Muniz type integrated depths c for 1 and 2d functions, halfspace and simplicial depth c------------------------------------- SUBROUTINE funD2(A1,A2,B1,B2,M,N,D,funSDEP,funHDEP, +fIsdep,fIhdep,IAsdep,IAhdep) c using fdepth computes 2dimensional depth of functions in A1,A2 c with respect to the functions in B1,B2 c M size of functions in A c N size of functions in B c D dimensionality of functions INTEGER N,M,D INTEGER IAsdep(M),IAhdep(M) double precision A1(M*D),A2(M*D),B1(N*D),B2(N*D),funSDEP(M), +funHDEP(M),fIsdep(M),fIhdep(M) double precision B1H(N),B2H(N) double precision hSDEP,hHDEP double precision hALPHA(N) INTEGER hF(N),I,J,K DO 5 I=1,M funSDEP(I) = 0.0 funHDEP(I) = 0.0 fISDEP(I) = 2.0 fIHDEP(I) = 2.0 IAsdep(I) = 0 IAhdep(I) = 0 5 CONTINUE c essential loop, computing 2D depths at each point DO 30 I=1,D DO 10 K=1,N B1H(K) = B1((I-1)*N+K) B2H(K) = B2((I-1)*N+K) 10 CONTINUE DO 20 J=1,M hSDEP = 0.0 hHDEP = 0.0 hALPHA(1) = N+0.0 hF(1) = N CALL fD2(A1((I-1)*M+J),A2((I-1)*M+J),N,B1H,B2H,hALPHA,hF, +hSDEP,hHDEP) funSDEP(J) = funSDEP(J) + hSDEP funHDEP(J) = funHDEP(J) + hHDEP c counting the area of the smallest depth for each function IF (hSDEP.EQ.fISDEP(J)) THEN IAsdep(J) = IAsdep(J)+1 ELSEIF (hSDEP.LT.fISDEP(J)) THEN IAsdep(J) = 1 ENDIF IF (hHDEP.EQ.fIHDEP(J)) THEN IAhdep(J) = IAhdep(J)+1 ELSEIF (hHDEP.LT.fIHDEP(J)) THEN IAhdep(J) = 1 ENDIF c infimal depth evaluation fISDEP(J) = min(fISDEP(J),hSDEP) fIHDEP(J) = min(fIHDEP(J),hHDEP) 20 CONTINUE 30 CONTINUE c dividing the resulting depths by number of points d DO 40 I=1,M funSDEP(I) = funSDEP(I)/(D+0.0) funHDEP(I) = funHDEP(I)/(D+0.0) 40 CONTINUE RETURN END c---------------------------------------------------------------------- c 2D RANDOM PROJECTION DEPTH c PROJECTIONS ON WHITE NOISE c DEPENDS ON THE RANDOM NUMBER GENERATOR VERSION c---------------------------------------------------------------------- SUBROUTINE funRPD2(A1,A2,B1,B2,M,N,D,NPROJ,V,Q,funSDEP, +funHDEP,funMDEP,funSDDEP,funHDDEP) c computes fast random projection depth for 2D functions using c NPROJ simple iid gaussian processes projection and then 2D c simplicial or halfspace depth c Q is quantile used in MDEP c funDDEP is double random projection (2*D-dim)->(2-dim)->(1-dim) c and then appying Halfspace depth (equiv to quantile as Cuevas 2007) INTEGER M,N,D,NPROJ double precision A1(M*D),A2(M*D),B1(N*D),B2(N*D),funSDEP(M), +funHDEP(M),funMDEP(M),Q,funSDDEP(M),funHDDEP(M) double precision V(D*NPROJ+2*NPROJ),A1P,A2P,B1P(N),B2P(N), +VNORM,VNORMF,AP(2*M),BP(2*N),VF(2),AFP,BFP(N) c last 2*NPROJ of V are for the second random projection 2d->1d c VF(2) is the final projection INTEGER I,J,K double precision hSDEP,hHDEP,hMDEP(M),hHDDEP,hSDDEP double precision hALPHA(N) INTEGER hF(N) DO 5 I=1,M funSDEP(I) = 0.0 funHDEP(I) = 0.0 funMDEP(I) = 0.0 funSDDEP(I) = 0.0 funHDDEP(I) = 0.0 5 CONTINUE c main loop DO 40 K=1,NPROJ c generating a single gaussian processes VNORM = 0.0 VNORMF = sqrt(V(NPROJ*D+(K-1)*2+1)**2+V(NPROJ*D+(K-1)*2+2)**2) VF(1) = V(NPROJ*D+(K-1)*2+1)/VNORMF VF(2) = V(NPROJ*D+(K-1)*2+2)/VNORMF c final projection is now normed DO 10 I=1,D VNORM = VNORM + V((K-1)*D+I)**2 10 CONTINUE VNORM = sqrt(VNORM - (V((K-1)*D+1)**2+V((K-1)*D+D)**2)/(2.0)) c loop projecting j-th function of the random sample B on v DO 18 J=1,N B1P(J) = 0.0 B2P(J) = 0.0 DO 15 I=1,D B1P(J) = B1P(J)+ B1((I-1)*N+J)*V((K-1)*D+I)/VNORM B2P(J) = B2P(J)+ B2((I-1)*N+J)*V((K-1)*D+I)/VNORM 15 CONTINUE BFP(J) = B1P(J)*VF(1)+B2P(J)*VF(2) 18 CONTINUE DO 19 I=1,N BP(I)=B1P(I) BP(N+I)=B2P(I) 19 CONTINUE c loop with projecting j-th function of the random sample A on v DO 30 J=1,M A1P = 0.0 A2P = 0.0 c compute projection of j-th function A DO 20 I=1,D A1P = A1P + A1((I-1)*M+J)*V((K-1)*D+I)/VNORM A2P = A2P + A2((I-1)*M+J)*V((K-1)*D+I)/VNORM 20 CONTINUE AP(J) = A1P AP(J+M) = A2P hSDEP = 0.0 hHDEP = 0.0 hMDEP(J) = 0.0 hALPHA(1) = N+0.0 hF(1) = N CALL fD2(A1P,A2P,N,B1P,B2P,hALPHA,hF, +hSDEP,hHDEP) funSDEP(J) = funSDEP(J) + hSDEP funHDEP(J) = funHDEP(J) + hHDEP c and now the second projection of A AFP = A1P*VF(1)+A2P*VF(2) hHDDEP = 0.0 hSDDEP = 0.0 CALL fD1(AFP,N,BFP,hSDDEP,hHDDEP) funSDDEP(J) = funSDDEP(J) + hSDDEP funHDDEP(J) = funHDDEP(J) + hHDDEP 30 CONTINUE CALL funMD(AP,BP,M,N,2,Q,hMDEP) DO 35 I=1,M funMDEP(I) = funMDEP(I) + hMDEP(I) 35 CONTINUE 40 CONTINUE c averaging projection depth over all projections DO 50 I=1,M funSDEP(I) = funSDEP(I)/(NPROJ+0.0) funHDEP(I) = funHDEP(I)/(NPROJ+0.0) funMDEP(I) = funMDEP(I)/(NPROJ+0.0) funSDDEP(I) = funSDDEP(I)/(NPROJ+0.0) funHDDEP(I) = funHDDEP(I)/(NPROJ+0.0) 50 CONTINUE RETURN END c c c halfregiondepth.f c c SUBROUTINE HRD(A,B,M,N,D,FD) c computes fast half-region depth of Lopez-Pintado and Romo 2011 INTEGER M,N,D double precision A(M*D),B(N*D),FD(M) INTEGER I,J,K, U, L, UI, LI DO 30 I=1,M FD(I) = 0.0 U = 0 L = 0 DO 20 J=1,N UI = 0 LI = 0 K = 0 DO 10 WHILE ((K .LT. D) + .AND. (UI .EQ. 0 .OR. LI .EQ. 0)) K = K + 1 IF(A((K-1)*M+I) .GT. B((K-1)*N+J)) UI = UI + 1 IF(A((K-1)*M+I) .LT. B((K-1)*N+J)) LI = LI + 1 10 CONTINUE IF (UI .EQ. 0) U = U+1 IF (LI .EQ. 0) L = L+1 20 CONTINUE FD(I) = (MIN(U,L)+0.0)/(N+0.0) 30 CONTINUE RETURN END c---------------------------------------------------------------------- SUBROUTINE BD(A,B,M,N,D,FD) c computes fast 2nd order band depth of Lopez-Pintado and Romo 2009 INTEGER M,N,D double precision A(M*D),B(N*D),FD(M),L,U INTEGER I,J,JJ,K,W,WI DO 30 I=1,M FD(I) = 0.0 W = 0 DO 20 J=1,(N-1) DO 15 JJ=(J+1),N WI = 0 K = 0 DO 10 WHILE ( WI .GE. 0) c -1 means TRUE, the function is in the band of J and JJ c -2 means FALSE, the function crosses WI = WI + 1 K = K+1 L = MIN(B((K-1)*N+J),B((K-1)*N+JJ)) U = MAX(B((K-1)*N+J),B((K-1)*N+JJ)) IF (A((K-1)*M+I) .LT. L .OR. + A((K-1)*M+I) .GT. U) WI = -2 IF (WI .NE. -2 .AND. WI .EQ. D) WI = -1 10 CONTINUE IF (WI .EQ. -1) W = W+1 15 CONTINUE 20 CONTINUE FD(I) = (W+0.0)/((N*(N-1))/2 + 0.0) 30 CONTINUE RETURN END c------------------------------------- c bivariate halfspace and simplicial depth c------------------------------------- SUBROUTINE DPTH2(A1,A2,B1,B2,M,N,SDEP,HDEP) c computes 2dimensional depth of A1,A2 c with respect to B1,B2 c M size of A c N size of B INTEGER N,M double precision A1(M),A2(M),B1(N),B2(N),SDEP(M),HDEP(M) double precision hSDEP,hHDEP double precision hALPHA(N) INTEGER hF(N),I,J,K DO 5 I=1,M SDEP(I) = 0.0 HDEP(I) = 0.0 5 CONTINUE DO 10 J=1,M hSDEP = 0.0 hHDEP = 0.0 hALPHA(1) = N+0.0 hF(1) = N CALL fD2(A1(J),A2(J),N,B1,B2,hALPHA,hF, +hSDEP,hHDEP) SDEP(J) = hSDEP HDEP(J) = hHDEP 10 CONTINUE RETURN END c------------------------------------- c univariate halfspace and simplicial depth c------------------------------------- SUBROUTINE DPTH1(A1,B1,M,N,SDEP,HDEP) c computes 1dimensional depth of A1 c with respect to B1 c M size of A c N size of B INTEGER N,M double precision A1(M),B1(N),SDEP(M),HDEP(M) double precision hSDEP,hHDEP double precision hALPHA(N) INTEGER hF(N),I,J,K DO 5 I=1,M SDEP(I) = 0.0 HDEP(I) = 0.0 5 CONTINUE DO 10 J=1,M hSDEP = 0.0 hHDEP = 0.0 hALPHA(1) = N+0.0 hF(1) = N CALL fD1(A1(J),N,B1,hSDEP,hHDEP) SDEP(J) = hSDEP HDEP(J) = hHDEP 10 CONTINUE RETURN END ddalpha/src/asa047.cpp0000644000176200001440000002361714213423775014162 0ustar liggesusers# include # include # include # include # include using namespace std; # include "asa047.h" //****************************************************************************80 void nelmin ( double fn ( double x[] ), int n, double start[], double xmin[], double *ynewlo, double reqmin, double step[], int konvge, int kcount, int *icount, int *numres, int *ifault ) //****************************************************************************80 // // Purpose: // // NELMIN minimizes a function using the Nelder-Mead algorithm. // // Discussion: // // This routine seeks the minimum value of a user-specified function. // // Simplex function minimisation procedure due to Nelder+Mead(1965), // as implemented by O'Neill(1971, Appl.Statist. 20, 338-45), with // subsequent comments by Chambers+Ertel(1974, 23, 250-1), Benyon(1976, // 25, 97) and Hill(1978, 27, 380-2) // // The function to be minimized must be defined by a function of // the form // // function fn ( x, f ) // double fn // double x(*) // // and the name of this subroutine must be declared EXTERNAL in the // calling routine and passed as the argument FN. // // This routine does not include a termination test using the // fitting of a quadratic surface. // // Licensing: // // This code is distributed under the GNU LGPL license. // // Modified: // // 27 February 2008 // // Author: // // Original FORTRAN77 version by R ONeill. // C++ version by John Burkardt. // // Reference: // // John Nelder, Roger Mead, // A simplex method for function minimization, // Computer Journal, // Volume 7, 1965, pages 308-313. // // R ONeill, // Algorithm AS 47: // Function Minimization Using a Simplex Procedure, // Applied Statistics, // Volume 20, Number 3, 1971, pages 338-345. // // Parameters: // // Input, double FN ( double x[] ), the name of the routine which evaluates // the function to be minimized. // // Input, int N, the number of variables. // // Input/output, double START[N]. On input, a starting point // for the iteration. On output, this data may have been overwritten. // // Output, double XMIN[N], the coordinates of the point which // is estimated to minimize the function. // // Output, double YNEWLO, the minimum value of the function. // // Input, double REQMIN, the terminating limit for the variance // of function values. // // Input, double STEP[N], determines the size and shape of the // initial simplex. The relative magnitudes of its elements should reflect // the units of the variables. // // Input, int KONVGE, the convergence check is carried out // every KONVGE iterations. // // Input, int KCOUNT, the maximum number of function // evaluations. // // Output, int *ICOUNT, the number of function evaluations // used. // // Output, int *NUMRES, the number of restarts. // // Output, int *IFAULT, error indicator. // 0, no errors detected. // 1, REQMIN, N, or KONVGE has an illegal value. // 2, iteration terminated because KCOUNT was exceeded without convergence. // { double ccoeff = 0.5; double del; double dn; double dnn; double ecoeff = 2.0; double eps = 0.001; int i; int ihi; int ilo; int j; int jcount; int l; int nn; double *p; double *p2star; double *pbar; double *pstar; double rcoeff = 1.0; double rq; double x; double *y; double y2star; double ylo; double ystar; double z; // // Check the input parameters. // if ( reqmin <= 0.0 ) { *ifault = 1; return; } if ( n < 1 ) { *ifault = 1; return; } if ( konvge < 1 ) { *ifault = 1; return; } p = new double[n*(n+1)]; pstar = new double[n]; p2star = new double[n]; pbar = new double[n]; y = new double[n+1]; *icount = 0; *numres = 0; jcount = konvge; dn = ( double ) ( n ); nn = n + 1; dnn = ( double ) ( nn ); del = 1.0; rq = reqmin * dn; // // Initial or restarted loop. // for ( ; ; ) { for ( i = 0; i < n; i++ ) { p[i+n*n] = start[i]; } y[n] = fn ( start ); *icount = *icount + 1; for ( j = 0; j < n; j++ ) { x = start[j]; start[j] = start[j] + step[j] * del; for ( i = 0; i < n; i++ ) { p[i+j*n] = start[i]; } y[j] = fn ( start ); *icount = *icount + 1; start[j] = x; } // // The simplex construction is complete. // // Find highest and lowest Y values. YNEWLO = Y(IHI) indicates // the vertex of the simplex to be replaced. // ylo = y[0]; ilo = 0; for ( i = 1; i < nn; i++ ) { if ( y[i] < ylo ) { ylo = y[i]; ilo = i; } } // // Inner loop. // for ( ; ; ) { if ( kcount <= *icount ) { break; } *ynewlo = y[0]; ihi = 0; for ( i = 1; i < nn; i++ ) { if ( *ynewlo < y[i] ) { *ynewlo = y[i]; ihi = i; } } // // Calculate PBAR, the centroid of the simplex vertices // excepting the vertex with Y value YNEWLO. // for ( i = 0; i < n; i++ ) { z = 0.0; for ( j = 0; j < nn; j++ ) { z = z + p[i+j*n]; } z = z - p[i+ihi*n]; pbar[i] = z / dn; } // // Reflection through the centroid. // for ( i = 0; i < n; i++ ) { pstar[i] = pbar[i] + rcoeff * ( pbar[i] - p[i+ihi*n] ); } ystar = fn ( pstar ); *icount = *icount + 1; // // Successful reflection, so extension. // if ( ystar < ylo ) { for ( i = 0; i < n; i++ ) { p2star[i] = pbar[i] + ecoeff * ( pstar[i] - pbar[i] ); } y2star = fn ( p2star ); *icount = *icount + 1; // // Check extension. // if ( ystar < y2star ) { for ( i = 0; i < n; i++ ) { p[i+ihi*n] = pstar[i]; } y[ihi] = ystar; } // // Retain extension or contraction. // else { for ( i = 0; i < n; i++ ) { p[i+ihi*n] = p2star[i]; } y[ihi] = y2star; } } // // No extension. // else { l = 0; for ( i = 0; i < nn; i++ ) { if ( ystar < y[i] ) { l = l + 1; } } if ( 1 < l ) { for ( i = 0; i < n; i++ ) { p[i+ihi*n] = pstar[i]; } y[ihi] = ystar; } // // Contraction on the Y(IHI) side of the centroid. // else if ( l == 0 ) { for ( i = 0; i < n; i++ ) { p2star[i] = pbar[i] + ccoeff * ( p[i+ihi*n] - pbar[i] ); } y2star = fn ( p2star ); *icount = *icount + 1; // // Contract the whole simplex. // if ( y[ihi] < y2star ) { for ( j = 0; j < nn; j++ ) { for ( i = 0; i < n; i++ ) { p[i+j*n] = ( p[i+j*n] + p[i+ilo*n] ) * 0.5; xmin[i] = p[i+j*n]; } y[j] = fn ( xmin ); *icount = *icount + 1; } ylo = y[0]; ilo = 0; for ( i = 1; i < nn; i++ ) { if ( y[i] < ylo ) { ylo = y[i]; ilo = i; } } continue; } // // Retain contraction. // else { for ( i = 0; i < n; i++ ) { p[i+ihi*n] = p2star[i]; } y[ihi] = y2star; } } // // Contraction on the reflection side of the centroid. // else if ( l == 1 ) { for ( i = 0; i < n; i++ ) { p2star[i] = pbar[i] + ccoeff * ( pstar[i] - pbar[i] ); } y2star = fn ( p2star ); *icount = *icount + 1; // // Retain reflection? // if ( y2star <= ystar ) { for ( i = 0; i < n; i++ ) { p[i+ihi*n] = p2star[i]; } y[ihi] = y2star; } else { for ( i = 0; i < n; i++ ) { p[i+ihi*n] = pstar[i]; } y[ihi] = ystar; } } } // // Check if YLO improved. // if ( y[ihi] < ylo ) { ylo = y[ihi]; ilo = ihi; } jcount = jcount - 1; if ( 0 < jcount ) { continue; } // // Check to see if minimum reached. // if ( *icount <= kcount ) { jcount = konvge; z = 0.0; for ( i = 0; i < nn; i++ ) { z = z + y[i]; } x = z / dnn; z = 0.0; for ( i = 0; i < nn; i++ ) { z = z + pow ( y[i] - x, 2 ); } if ( z <= rq ) { break; } } } // // Factorial tests to check that YNEWLO is a local minimum. // for ( i = 0; i < n; i++ ) { xmin[i] = p[i+ilo*n]; } *ynewlo = y[ilo]; if ( kcount < *icount ) { *ifault = 2; break; } *ifault = 0; for ( i = 0; i < n; i++ ) { del = step[i] * eps; xmin[i] = xmin[i] + del; z = fn ( xmin ); *icount = *icount + 1; if ( z < *ynewlo ) { *ifault = 2; break; } xmin[i] = xmin[i] - del - del; z = fn ( xmin ); *icount = *icount + 1; if ( z < *ynewlo ) { *ifault = 2; break; } xmin[i] = xmin[i] + del; } if ( *ifault == 0 ) { break; } // // Restart the procedure. // for ( i = 0; i < n; i++ ) { start[i] = xmin[i]; } del = eps; *numres = *numres + 1; } delete [] p; delete [] pstar; delete [] p2star; delete [] pbar; delete [] y; return; } ddalpha/src/AlphaProcedure.h0000644000176200001440000000155614213423775015524 0ustar liggesusers/* File: AlphaProcedure.h Created by: Pavlo Mozharovskyi First published: 28.02.2013 Last revised: 28.02.2013 Contains the modified alpha-procedure for the DDalpha-classifier. For a description of the algorithm, see: Lange, T., Mosler, K. and Mozharovskyi, P. (2012). Fast nonparametric classification based on data depth. Statistical Papers. Mozharovskyi, P., Mosler, K. and Lange, T. (2013). Classifying real-world data with the DDalpha-procedure. Mimeo. */ int ExtendWithProducts(TMatrix x, unsigned int upToPower, TMatrix *_x); int Learn(TMatrix input, TVariables output, unsigned int minFeatures, TPoint *ray); int LearnCV(TMatrix input, TVariables output, unsigned int minFeatures, unsigned int upToPower, unsigned int folds, TPoint *ray, unsigned int *power); int Classify(TMatrix input, TPoint weights, TVariables *output); ddalpha/src/Mahalanobis.h0000644000176200001440000000014214213423775015032 0ustar liggesusers void MahalanobisDepth(TDMatrix X, TDMatrix x, int d, int n, int nx, double MCD, double *depths); ddalpha/src/OjaDepth.cpp0000644000176200001440000000542114213423775014652 0ustar liggesusers#include "stdafx.h" void OjaDepthsEx(TDMatrix X, TDMatrix x, int d, int n, int nx, int useCov, TDMatrix covEst, double *depths){ int* counters = new int[d + 1]; bMatrix A (d + 1, d + 1); unsigned long long div0 = choose(n, d); double S = 1; if (useCov > 0){ // TDMatrix covXtemp = cov(X, n, d); // no need to compute anymore bMatrix covX(d, d); for (int k = 0; k < d; k++) for (int j = 0; j < d; j++) covX(k,j) = covEst[k][j]; // deleteM(covXtemp); // no need to compute anymore S = pow(abs(determinant(covX)),-0.5); } for (int obs = 0; obs < nx; obs++){ long double sumVolume = 0; unsigned long long numSimplicesChecked = 0; int p = d - 1; for (int i = 0; i < p; i++){ counters[i] = i; }counters[p] = p - 1; while (counters[0] != n - (p + 1)){ int i = p; while (i > 0 && counters[i] == n - (p + 1) + i){ i--; } counters[i]++; int j = i + 1; while (j < p + 1){ counters[j] = counters[j - 1] + 1; j++; } for (int j = 0; j < d; j++){ for (int k = 0; k < d; k++){ A(j + 1, k) = X[counters[k]][j]; } } for (int j = 0; j < d; j++){ A(j + 1, d) = x[obs][j]; } for (int k = 0; k < d + 1; k++){ A(0,k) = 1; } double volume = abs(determinant(A)); sumVolume += volume; numSimplicesChecked ++; } double O = sumVolume / fact(d) / div0; double depth = 1/(1+O*S); depths[obs] = depth; } delete[] counters; } void OjaDepthsApx(TDMatrix X, TDMatrix x, int d, int n, int nx, unsigned long long k, int useCov, TDMatrix covEst, double *depths){ int* counters = new int[d + 1]; bMatrix A(d + 1, d + 1); double S = 1; if (useCov > 0){ // TDMatrix covXtemp = cov(X, n, d); // no need to compute anymore bMatrix covX(d, d); for (int l = 0; l < d; l++) for (int j = 0; j < d; j++) covX(l, j) = covEst[l][j]; // deleteM(covXtemp); // no need to compute anymore S = pow(abs(determinant(covX)), -0.5); } for (int obs = 0; obs < nx; obs++){ long double sumVolume = 0; for (unsigned long long i = 0; i < k; i++){ // Generate a combination of indices for (int j = 0; j < d; j++){ bool _new = false; do{ _new = true; counters[j] = random(n); for (int l = 0; l < j; l++){ if (counters[l] == counters[j]){ _new = false; break; } } } while (!_new); } // Construct the simplex out of it for (int j = 0; j < d; j++){ for (int l = 0; l < d; l++){ A(j + 1, l) = X[counters[l]][j]; } } for (int j = 0; j < d; j++){ A(j + 1, d) = x[obs][j]; } for (int l = 0; l < d + 1; l++){ A(0, l) = 1; } double volume = abs(determinant(A)); sumVolume += volume; } double O = sumVolume / fact(d) / k; double depth = 1 / (1 + O*S); depths[obs] = depth; } delete[] counters; } ddalpha/src/asa047.h0000644000176200001440000000104314213423775013614 0ustar liggesusers/******************************************************************************* Author: Original FORTRAN77 version by R ONeill; C++ version by John Burkardt. http://people.sc.fsu.edu/~jburkardt/cpp_src/asa047/asa047.html *******************************************************************************/ #ifndef ASA047 #define ASA047 void nelmin(double fn(double x[]), int n, double start[], double xmin[], double *ynewlo, double reqmin, double step[], int konvge, int kcount, int *icount, int *numres, int *ifault); void timestamp(); #endif ddalpha/src/stdafx.h0000644000176200001440000000222214213423775014106 0ustar liggesusers/* File: stdafx.h Created by: Oleksii Pokotylo First published: 28.02.2013 Last revised: 28.02.2013 Defines the Includes needed. */ #pragma once #define BOOST_UBLAS_NO_STD_CERR #include #include #include #include #include #include #include #include #include #include #include #include #ifndef _MSC_VER #include using namespace Rcpp; #endif using namespace std; #include "DataStructures.h" #include "Common.h" #include "AlphaProcedure.h" #include "TukeyDepth.h" #include "HD.h" #include "ZonoidDepth.h" #include "Mahalanobis.h" #include "SimplicialDepth.h" #include "OjaDepth.h" #include "Knn.h" #include "Polynomial.h" #include "PotentialDepth.h" #include "ProjectionDepth.h" #include "DKnn.h" #include "LensDepth.h" #include "BandDepth.h" // global rEngine is defined in ddalpha.cpp, extern rEngine defined in stdafx.h #define ran(x) rEngine()%x #define setseed(x) rEngine.seed(x) int random(int x); ddalpha/src/ZonoidDepth.h0000644000176200001440000000317014213423775015047 0ustar liggesusers#ifndef __ZonoidDepth__ #define __ZonoidDepth__ /* File: depth.h Created by: Rainer Dyckerhoff Last revised: 15.05.2013 Computation of the zonoid data depth. For a description of the algorithm, see: Dyckerhoff, R., Koshevoy, G., and Mosler, K. (1996) Zonoid Data Depth: Theory and Computation, in: Compstat - Proceedings in Computational Statistics, (Albert Prat, ed.), Physica-Verlag, Heidelberg, p. 235--240. */ double ZonoidDepth(vector& x, TPoint& z, int& Error); /* Calculate the zonoid data depth of the point 'z' with respect to the data points 'x'. The number of data points is passed in 'NoPoints', the dimension in 'Dimension'. If an error occurs, the error code is stored in '*Error'. Possible error codes are: 0: no error, 1: simplex algorithm did not terminate within 'MaxIt' iterations, 2: not enough memory available, If no error occured, the return value is the zonoid data depth of 'z'. If the error code is 1, the return value is an lower bound to the zonoid data depth of 'z'. If the error code is 2, the return value is -1. */ int IsInConvex(vector& x, TPoint& z, int& Error); int InConvexes(TMatrix& points, TVariables& cardinalities, TMatrix& objects, int& Error, TIntMatrix *areInConvexes); int GetMeansSds(vector& x, TPoint *means, TPoint *sds); int Standardize(vector &x, TPoint& means, TPoint& sds); int Standardize(TPoint &x, TPoint& means, TPoint& sds); int GetMeansSds(TDMatrix &x, int n, int d, TPoint *means, TPoint *sds); int Standardize(TDMatrix &x, int n, int d, TPoint& means, TPoint& sds); #endif ddalpha/src/PotentialDepth.cpp0000644000176200001440000000637314213423775016107 0ustar liggesusers#include "stdafx.h" double EuclidianDistance(TPoint& x, TPoint& y){ double accu = 0; for (int i = 0; i < x.size(); i++){ accu += pow(x[i] - y[i], 2); } return sqrt(accu); } double EuclidianDistance2(TPoint& x, TPoint& y){ double accu = 0; for (int i = 0; i< x.size(); i++){ accu += pow(x[i] - y[i], 2); } return (accu); } // alpha - kernel sharpness. sharp - a more double EDKernel (TPoint& x, TPoint& y, double a){ return 1/(1+a*EuclidianDistance2(x, y)); } // ss - sigma squared. sharp - a less double GKernel (TPoint& x, TPoint& y, double ss){ int d = x.size(); return pow((2*PI*ss), - d/2) * exp(-EuclidianDistance2(x, y) / (2*ss)); //04.04.2014 added power d } // ss - sigma squared. sharp - a less double VarGKernel(TPoint& x, TPoint& y, double ss){ int d = x.size(); return pow((2 * PI*ss), -d / 2) * exp(-EuclidianDistance2(x, y) / (2 * ss)); //04.04.2014 added power d } // alpha - kernel sharpness. sharp - a more double EKernel (TPoint& x, TPoint& y, double a){ return exp(-a*EuclidianDistance(x, y)); } // alpha - triangle sharpness. sharp - a more. a in (0..pi/2) double TriangleKernel (TPoint& x, TPoint& y, double a){ return 1/(EuclidianDistance(x, y)+0.000001)*tan(a); } void PotentialDepths(TMatrix& points, TVariables& cardinalities, /*OUT*/ TMatrix& depths, double (*Kernel) (TPoint& x, TPoint& y, double a), double a){ PotentialDepths(points, cardinalities, points, depths, Kernel, a, 0); } void PotentialDepths(TMatrix& points, TVariables& cardinalities, TMatrix& testpoints, /*OUT*/ TMatrix& depths, double (*Kernel) (TPoint& x, TPoint& y, double ss), double ss, int ignoreself){ int classBeginning = 0; bool var = Kernel == VarGKernel; double weight = 1; TMatrix* classPoints; TPoint* classPointsDepths; int error; // loop classes for (int i = 0; i < cardinalities.size(); classBeginning += cardinalities[i], i++){ if (var){ if (classPoints) delete[] classPoints; classPoints = new TMatrix(points.begin() + classBeginning, points.begin() + classBeginning + cardinalities[i]); if (!classPointsDepths) classPointsDepths = new TPoint(cardinalities[i]); else if (classPointsDepths->size() < cardinalities[i]) classPointsDepths->resize(cardinalities[i]); for (int c = 0; c < cardinalities[i]; c++){ (*classPointsDepths)[c] = 1 - ZonoidDepth(*classPoints, points[classBeginning + c], error); } } // loop all the points, find their potential relatively to class i for (int p = 0; p < testpoints.size(); p++){ double pointDepth = 0; // loop the points of i-th class, find the point's potential for (int c = 0; c < cardinalities[i]; c++){ // if (ignoreself && p == classBeginning + c) // ignore the potential created by this point // continue; if (var) weight = (*classPointsDepths)[c]; pointDepth += Kernel(testpoints[p], points[classBeginning + c], ss*weight); } depths[p][i] = pointDepth; } if (false) { //28.05.2014 no normalization int n = ignoreself ? points.size() - 1 : points.size(); // normalize for (int p = 0; p < testpoints.size(); p++){ depths[p][i] *= 1.0 / n; //04.04.2014 1.0*cardinalities[i]/points.size()/Kernel(points[0], points[0], a); } } } if (var){ delete[] classPoints; delete[] classPointsDepths; } } ddalpha/src/stdafx.cpp0000644000176200001440000000071314213423775014444 0ustar liggesusers// stdafx.cpp : source file that includes just the standard includes // ddalpha.pch will be the pre-compiled header // stdafx.obj will contain the pre-compiled type information #include "stdafx.h" // TODO: reference any additional headers you need in STDAFX.H // and not in this file extern boost::random::rand48 rEngine; extern boost::random::normal_distribution normDist; int random(int x){ int c = ran(x); return c == x ? random(x) : c; } ddalpha/src/HD.h0000644000176200001440000001140314213423775013111 0ustar liggesusers/******************************************************************************/ /* File: HD.h */ /* Created by: Rainer Dyckerhoff, Pavlo Mozharovskyi */ /* First published: 19.06.2015 */ /* Last revised: 19.06.2015 */ /* */ /* Contains declarations of functions that compute the exact halfspace depth */ /* of a point w.r.t. a data cloud. */ /* */ /******************************************************************************/ enum HDalgs{ // random = 0, recursive = 1, // HD_DRS plane = 2, // HDc2 line = 3 //HD_Cmb }; /****************************************************************************/ /* HD_Comb computes the halfspace depth of a point z in d-space w.r.t. */ /* n data points passed in xx. */ /* HD_Comb implements the combinatorial algorithm (k = d-1) as described */ /* in Section 3.1 of "Exact computation of the halfspace depth" by */ /* Rainer Dyckerhoff and Pavlo Mozharovskyi (arXiv:1411:6927) */ /* */ /* Args: */ /* z - the point to calculate the depth for (vector of dimension d), */ /* xx - the data w.r.t. which the depth has to be computed, (matrix of */ /* dimension n x d) */ /* n - number of the data points, */ /* d - dimension of the Euclidean space. */ /* Returns: */ /* depth of z w.r.t. xx in the interval [0,1]. */ /****************************************************************************/ double HD_Comb(double* z, double** xx, int n, int d); /****************************************************************************/ /* HD_Comb2 computes the halfspace depth of a point z in d-space w.r.t. */ /* n data points passed in xx. */ /* HD_Comb2 implements the combinatorial algorithm (k = d-2) as described */ /* in Section 3.2 of "Exact computation of the halfspace depth" by */ /* Rainer Dyckerhoff and Pavlo Mozharovskyi (arXiv:1411:6927) */ /* */ /* Args: */ /* z - the point to calculate the depth for (vector of dimension d), */ /* xx - the data w.r.t. which the depth has to be computed, (matrix of */ /* dimension n x d) */ /* n - number of the data points, */ /* d - dimension of the Euclidean space. */ /* Returns: */ /* depth of z w.r.t. xx in the interval [0,1]. */ /****************************************************************************/ double HD_Comb2(double* z, double** xx, int n, int d); /****************************************************************************/ /* HD_Rec computes the halfspace depth of a point z in d-space w.r.t. */ /* n data points passed in xx. */ /* HD_Rec implements the recursive algorithm (k = 1) as described in */ /* Section 3.3 of "Exact computation of the halfspace depth" by */ /* Rainer Dyckerhoff and Pavlo Mozharovskyi (arXiv:1411:6927) */ /* */ /* Args: */ /* z - the point to calculate the depth for (vector of dimension d), */ /* xx - the data w.r.t. which the depth has to be computed, (matrix of */ /* dimension n x d) */ /* n - number of the data points, */ /* d - dimension of the Euclidean space. */ /* Returns: */ /* depth of z w.r.t. xx in the interval [0,1]. */ /****************************************************************************/ double HD_Rec(double* z, double** xx, int n, int d); ddalpha/src/ProjectionDepth.h0000644000176200001440000000105514213423775015721 0ustar liggesusers/* File: ProjectionDepth.h Created by: Pavlo Mozharovskyi First published: 17.05.2013 Last revised: 13.11.2015 Computation of the projection depth using random sampling. For a description of the method, see: Zuo, Y.J. and Serfling, R. (2000). General notions of statistical depth function. Annals of Statistics 28, 461-482. */ int GetDepthsPrj(TDMatrix points, int n, int d, TDMatrix objects, int m, TVariables cardinalities, int k, bool newDirs, TDMatrix depths, TDMatrix directions, TDMatrix projections); ddalpha/src/HD.cpp0000644000176200001440000007077414213423775013464 0ustar liggesusers/******************************************************************************/ /* File: HD.cpp */ /* Created by: Rainer Dyckerhoff, Pavlo Mozharovskyi */ /* First published: 19.06.2015 */ /* Last revised: 03.07.2015 */ /* */ /* Contains functions that compute the exact halfspace depth of a point z */ /* w.r.t. n data points x[1],...x[n]. */ /* */ /******************************************************************************/ #include "stdafx.h" #define _USE_MATH_DEFINES #include #include using namespace std; /* Definition of constants */ const double eps_HD1 = 1e-8; const double eps_HD2 = 1e-8; const double eps_HDx = 1e-8; const double eps_Cmb1 = 1e-8; //const double eps_pivot = 1e-8; /****************************************************************************/ /* */ /* 'norm2' computes the Euclidean norm of a vector x in d-space. */ /* */ /****************************************************************************/ double norm2(double* x, int d) { double result = 0; for (int i = 0; i < d; i++) result += x[i] * x[i]; return sqrt(result); } /****************************************************************************/ /* */ /* 'intHD1' computes the integer hafspace depth of 0 w.r.t n data points */ /* in R^1. */ /* */ /****************************************************************************/ int intHD1(double** x, int n) { int cnt1 = 0, cnt2 = 0; for (int i = 0; i < n; i++, x++) { if (**x < eps_HD1) cnt1++; if (**x > -eps_HD1) cnt2++; } return min(cnt1, cnt2); } /****************************************************************************/ /* */ /* 'intHD2' computes the integer hafspace depth of 0 w.r.t n data points */ /* in R^2. */ /* */ /* This is an implemetation of the algorithm of */ /* Rousseeuw, P.J.and Ruts, I. (1996). Algorithm AS 307: bivariate */ /* location depth. Journal of the Royal Statistical Society. Series C: */ /* Applied Statistics 45, 516?526. */ /* */ /****************************************************************************/ int intHD2(double** x, int n) { double* alpha = new double[n]; int nt = 0; // how many zeros in in x ? int nh = 0; // how many points in the halfspace ? // compute angles alpha[i] and initilize array angle for (int i = 0; i < n; i++) { if (hypot(x[i][0], x[i][1]) <= eps_HD2) nt++; else { alpha[i - nt] = atan2(x[i][1], x[i][0]); // alpha in (-pi,pi] // correction for points like (-1, -1e-16) if (alpha[i - nt] < -M_PI + eps_HD2) alpha[i - nt] = M_PI; if (alpha[i - nt] <= eps_HD2) nh++; } } int nn = n - nt; // sort angles sort(alpha, alpha + nn); // compute halfspace depth int result = nh; if (result > 0) { int j = nh; for (int i = 0; i < nh; i++) { while ((j <= nn - 1) && (alpha[j] - M_PI <= alpha[i] + eps_HD2)) j++; if (j - i <= result) result = j - i - 1; } j = 0; for (int i = nh; i < nn; i++) { while ((j <= nh - 1) && (alpha[j] + M_PI <= alpha[i] + eps_HD2)) j++; if (j - (i - nn) <= result) result = j - (i - nn) - 1; } } delete[] alpha; return result + nt; } /****************************************************************************/ /* */ /* 'nHD_Rec' computes the integer halfspace depth of 0 w.r.t n data points */ /* in R^d. */ /* */ /* 'nHD_Rec' implements the recursive algorithm (k = 1) as described in */ /* Section 3.3 of "Exact computation of the halfspace depth" by */ /* Rainer Dyckerhoff and Pavlo Mozharovskyi (arXiv:1411:6927) */ /* */ /****************************************************************************/ int nHD_Rec(double** xx, int n, int d) { if (d == 1) return intHD1(xx, n); if (d == 2) return intHD2(xx, n); double* y = new double[d - 1]; double* z = new double[d]; double** x = new double*[n]; for (int k = 0; k < n; k++) x[k] = new double[d - 1]; int result = n; for (int i = 0; i < n; i++) { int kmax = d; double xmax = 0; for (int k = 0; k < d; k++) if (fabs(xx[i][k]) > xmax) { xmax = fabs(xx[i][k]); kmax = k; } if (xmax > eps_HDx) { int nNull = 0, nPos = 0, nNeg = 0, m = 0; for (int k = 0; k < d; k++) z[k] = xx[i][k] / xx[i][kmax]; // project data points for (int j = 0; j < n; j++){ double alpha = -xx[j][kmax]; for (int k = 0; k < kmax; k++) y[k] = xx[j][k] + alpha * z[k]; for (int k = kmax; k < d - 1; k++) y[k] = xx[j][k + 1] + alpha * z[k + 1]; if (norm2(y, d - 1) > eps_HDx) { for (int k = 0; k < d - 1; k++) x[m][k] = y[k]; m++; } else { // in this case alpha = -sign(x_i*x_j) if (alpha > eps_HDx) nPos++; else if (alpha < -eps_HDx) nNeg++; else nNull++; } } result = min(result, nHD_Rec(x, m, d - 1) + nNull + min(nPos, nNeg)); if (result == 0) break; } } for (int k = 0; k < n; k++) delete[] x[k]; delete[] x; delete[] z; delete[] y; return result; } /****************************************************************************/ /* */ /* 'HD_Rec' computes the halfspace depth of a point z w.r.t n data */ /* points in R^d. */ /* */ /* 'HD_Rec' does some preprocessing of the data and then calls */ /* 'nHD_Rec'. */ /* */ /* See also the description in the header file. */ /* */ /* HD_Rec calls the following routines: */ /* norm2 */ /* intHD1 */ /* intHD2 */ /* nHD_Rec */ /* */ /****************************************************************************/ double HD_Rec(double* z, double** xx, int n, int d) { if (n <= 0) throw invalid_argument("n <= 0"); if (d <= 0) throw invalid_argument("d <= 0"); // preprocess data // subtract z from all data points x[i] int m = 0; double** x = new double*[n]; bool create = true; for (int i = 0; i < n; i++) { if (create) x[m] = new double[d]; for (int j = 0; j < d; j++) x[m][j] = xx[i][j] - z[j]; create = norm2(x[m], d) >= eps_HDx; if (create) m++; } int result = nHD_Rec(x, m, d) + (n - m); // deallocate array x if (!create) m++; for (int i = 0; i < m; i++) delete[] x[i]; delete[] x; return result / (double)n; } /****************************************************************************/ /* 'getRank' computes the rank of the matrix x */ /* */ /* 'getRank' is used in preprocessing the data in HD_comb and HD_Comb2. */ /* 'getRank' detects if the data points are contained in a lower */ /* dimensional space, by computing the rank of the matrix formed by the */ /* data points x[i]. */ /* */ /****************************************************************************/ int getRank(double** x, int n, int d, int* piv) { int imax; int pc = 0, rank = 0; double amax; // copy x to A double** A = new double*[d]; for (int i = 0; i < d; i++) { A[i] = new double[n]; for (int j = 0; j < n; j++) A[i][j] = x[j][i]; } rank = 0; for (int k = 0; k < min(n, d); k++) { // k-th elimination step do { imax = k; amax = fabs(A[k][pc]); // find maximum element in column for (int i = k + 1; i < d; i++) { if (fabs(A[i][pc]) > amax) { amax = fabs(A[i][pc]); imax = i; } } if (amax < eps_pivot) pc++; } while ((amax < eps_pivot) && (pc < n)); if (pc < n) { rank++; piv[k] = pc; // exchange rows if (imax != k) { for (int j = pc; j < n; j++) { double tmp = A[k][j]; A[k][j] = A[imax][j]; A[imax][j] = tmp; } } // elimination for (int i = k + 1; i < d; i++) { double factor = A[i][pc] / A[k][pc]; for (int j = pc + 1; j < n; j++) A[i][j] -= factor * A[k][j]; } if (++pc >= n) break; } else break; } for (int i = 0; i < d; i++) delete[] A[i]; delete[] A; return rank; } /****************************************************************************/ /* 'project' projects the data points on a lower dimensional subspace. */ /* */ /* 'project' is used in preprocessing the data in HD_comb and HD_Comb2. */ /* If the data points x[i] are contained in a subspace of dimension 'rank' */ /* (as detected by a call to getRank), the representation of the data */ /* points w.r.t. a basis of this subspace is computed. This gives a */ /* representation of the data points in the Euclidean space of dimension */ /* rank. */ /* */ /****************************************************************************/ void project(double** x, int n, int d, int rank, int indices[]) { double** z = new double*[n]; for (int k = 0; k < n; k++) { z[k] = new double[rank]; for (int i = 0; i < rank; i++) { z[k][i] = 0; for (int l = 0; l < d; l++) z[k][i] += x[k][l] * x[indices[i]][l]; } } for (int k = 0; k < n; k++) { delete[] x[k]; x[k] = z[k]; } delete[] z; } /****************************************************************************/ /* */ /* 'getNormal' computes the normal vector to the d-1 vectors passed */ /* in A. */ /* */ /* If the rank of A is equal to d-1, then the function returns 'true' and */ /* the normal vector is passed to the calling routine in 'normal[]'. */ /* If the rank of A is less than d-1, then the function returns 'false' */ /* and the value of 'normal[]' is undefined. */ /* */ /****************************************************************************/ bool getNormal(double** A, int d, double* normal) { int imax, jmax; int* colp = new int[d]; double amax; for (int k = 0; k < d - 1; k++) { imax = k; jmax = k; amax = fabs(A[k][k]); colp[k] = k; // find maximum element in column for (int i = k + 1; i < d - 1; i++) { if (fabs(A[i][k]) > amax) { amax = fabs(A[i][k]); imax = i; } } // maximum equal to zero => complete pivoting if (amax < eps_pivot) { for (int j = k + 1; j < d; j++) { for (int i = k; i < d - 1; i++) { if (fabs(A[i][j]) > amax) { amax = fabs(A[i][j]); imax = i; jmax = j; } } } if (amax < eps_pivot) { delete[] colp; return false; } // exchange columns for (int i = 0; i < d - 1; i++) { double tmp = A[i][k]; A[i][k] = A[i][jmax]; A[i][jmax] = tmp; } colp[k] = jmax; } // exchange rows if (imax != k) { for (int j = k; j < d; j++) { double tmp = A[k][j]; A[k][j] = A[imax][j]; A[imax][j] = tmp; } } // elimination for (int i = k + 1; i < d - 1; i++) { double factor = A[i][k] / A[k][k]; for (int j = k + 1; j < d; j++) A[i][j] -= factor * A[k][j]; } } // back substitution colp[d - 1] = d - 1; normal[d - 1] = -1; for (int k = d - 2; k >= 0; k--) { normal[k] = A[k][d - 1] / A[k][k]; for (int i = k - 1; i >= 0; i--) A[i][d - 1] -= normal[k] * A[i][k]; } // reverse column permutations for (int k = d - 1; k >= 0; k--) { if (colp[k] != k) { double temp = normal[k]; normal[k] = normal[colp[k]]; normal[colp[k]] = temp; } } delete[] colp; return true; } int nHD_Comb(double** xx, int n, int d); /****************************************************************************/ /* */ /* 'HD1proj' performs the following steps: */ /* */ /* 1) All data points x[i] are projected in the direction p, */ /* i.e., z[i] = p'x[i] is computed. */ /* 2) The univariate integer halfspace depth of 0 is computed w.r.t. all */ /* the z[i] that are not equal to 0. */ /* 3) If there are more than d-1 values z[i] that are equal to zero, */ /* the respective points are projected on the orthogonal complement */ /* of p. Then, the integer halfspace depth of 0 w.r.t. these */ /* projected points is computed. */ /* 4) The sum of the values from step 2) and 3) is returned. */ /* */ /****************************************************************************/ int HD1proj(double** x, int n, int d, double* p, int indices[]) { int cnt0 = 0, cnt1 = 0, cnt2 = 0, HDproj = 0; int* plane = new int[n]; for (int i = 0; i < n; i++) { double sum = 0; for (int j = 0; j < d; j++) sum += p[j] * x[i][j]; if (sum > eps_HD1) cnt1++; else if (sum < -eps_HD1) cnt2++; else plane[cnt0++] = i; } if (cnt0 > d - 1) { // recursion double** z = new double*[cnt0]; for (int i = 0; i < cnt0; i++) { z[i] = new double[d - 1]; for (int j = 0; j < d - 1; j++) { z[i][j] = 0; for (int k = 0; k < d; k++) z[i][j] += x[indices[j]][k] * x[plane[i]][k]; } } HDproj = nHD_Comb(z, cnt0, d - 1); for (int i = 0; i < cnt0; i++) delete[] z[i]; delete[] z; } delete[] plane; return min(cnt1, cnt2) + HDproj; } /****************************************************************************/ /* */ /* 'nHD_Comb' computes the integer halfspace depth of 0 w.r.t n data points */ /* in R^d. */ /* */ /* 'nHD_Comb' implements the combinatorial algorithm (k = d-1) as described */ /* in Section 3.1 of "Exact computation of the halfspace depth" by */ /* Rainer Dyckerhoff and Pavlo Mozharovskyi (arXiv:1411:6927) */ /* */ /****************************************************************************/ int nHD_Comb(double** xx, int n, int d) { if (d == 1) return intHD1(xx, n); if (d == 2) return intHD2(xx, n); int result = n + 1; double** a = new double*[d - 1]; for (int i = 0; i < d - 1; i++) a[i] = new double[d]; double* p = new double[d]; int* indices = new int[d - 1]; indices[0] = -1; int pos = 0; while (pos >= 0) { indices[pos]++; for (pos++; pos < d - 1; pos++) indices[pos] = indices[pos - 1] + 1; pos--; do { for (int i = 0; i < d - 1; i++) for (int j = 0; j < d; j++) a[i][j] = xx[indices[i]][j]; if (getNormal(a, d, p)) result = min(result, HD1proj(xx, n, d, p, indices)); indices[pos]++; } while (indices[pos] < n - d + pos + 2); do pos--; while (pos >= 0 && indices[pos] >= n - d + pos + 1); } for (int i = 0; i < d - 1; i++) delete[] a[i]; delete[] a; delete[] p; delete[] indices; return result; } /****************************************************************************/ /* */ /* 'HD_Comb' computes the halfspace depth of a point z w.r.t n data */ /* points in R^d. */ /* */ /* 'HD_Comb' does some preprocessing of the data and then calls */ /* 'nHD_Comb'. */ /* */ /* See also the description in the header file. */ /* */ /* HD_Comb calls the following routines: */ /* norm2 */ /* intHD1 */ /* intHD2 */ /* getRank */ /* project */ /* getNormal */ /* HD1proj */ /* nHD_Rec */ /* */ /****************************************************************************/ double HD_Comb(double* z, double** xx, int n, int d) { if (n <= 0) throw invalid_argument("n <= 0"); if (d <= 0) throw invalid_argument("d <= 0"); // preprocess data // subtract z from all data points x[i] // check whether the data points are concentrated on a lower // dimensional space int m = 0, rank; int* indices = new int[d]; double** x = new double*[n]; for (int i = 0; i < n; i++) { x[m] = new double[d]; for (int j = 0; j < d; j++) x[m][j] = xx[i][j] - z[j]; if (norm2(x[m], d) >= eps_HDx) m++; else delete[] x[m]; } if (m == 0) return 1.0; rank = getRank(x, m, d, indices); if (rank < d) project(x, m, d, rank, indices); int result = nHD_Comb(x, m, rank) + (n - m); // deallocate array x for (int i = 0; i < m; i++) delete[] x[i]; delete[] x; delete[] indices; return result / (double)n; } /****************************************************************************/ /* */ /* 'getBasisComplement' computes a basis of the orthogonal complement of */ /* the d-2 vectors passed in A. */ /* */ /* If the rank of A is equal to d-2, then the function returns 'true' and */ /* the two basis vectors are passed to the calling routine in 'basis[][]'. */ /* If the rank of A is less than d-2, then the function returns 'false' */ /* and the value of 'basis[]' is undefined. */ /* */ /****************************************************************************/ bool getBasisComplement(double** A, int d, double** basis) { int imax, jmax; int* colp = new int[d]; double amax; for (int k = 0; k < d - 2; k++) { imax = k; jmax = k; amax = fabs(A[k][k]); colp[k] = k; // find maximum element in column for (int i = k + 1; i < d - 2; i++) { if (fabs(A[i][k]) > amax) { amax = fabs(A[i][k]); imax = i; } } // maximum equal to zero => complete pivoting if (amax < eps_pivot) { for (int j = k + 1; j < d; j++) { for (int i = k; i < d - 2; i++) { if (fabs(A[i][j]) > amax) { amax = fabs(A[i][j]); imax = i; jmax = j; } } } if (amax < eps_pivot) { delete[] colp; return false; } // exchange columns for (int i = 0; i < d - 2; i++) { double tmp = A[i][k]; A[i][k] = A[i][jmax]; A[i][jmax] = tmp; } colp[k] = jmax; } // exchange rows if (imax != k) { for (int j = k; j < d; j++) { double tmp = A[k][j]; A[k][j] = A[imax][j]; A[imax][j] = tmp; } } // elimination for (int i = k + 1; i < d - 2; i++) { double factor = A[i][k] / A[k][k]; for (int j = k + 1; j < d; j++) A[i][j] -= factor * A[k][j]; } } // back substitution colp[d - 2] = d - 2; colp[d - 1] = d - 1; basis[0][d - 2] = -1; basis[0][d - 1] = 0; basis[1][d - 2] = 0; basis[1][d - 1] = -1; for (int k = d - 3; k >= 0; k--) { basis[0][k] = A[k][d - 2] / A[k][k]; basis[1][k] = A[k][d - 1] / A[k][k]; for (int i = k - 1; i >= 0; i--) { A[i][d - 2] -= basis[0][k] * A[i][k]; A[i][d - 1] -= basis[1][k] * A[i][k]; } } // reverse column permutations for (int k = d - 1; k >= 0; k--) { if (colp[k] != k) { for (int l = 0; l < 2; l++) { double temp = basis[l][k]; basis[l][k] = basis[l][colp[k]]; basis[l][colp[k]] = temp; } } } delete[] colp; return true; } int nHD_Comb2(double** xx, int n, int d); /****************************************************************************/ /* */ /* 'HD2proj' performs the following steps: */ /* */ /* 1) All data points x[i] are projected on the space spanned by the */ /* two vectors passed in p, i.e., y[i,1] = p[1]'x[i] and */ /* y[i,2] = p[2]'x[i] are computed. */ /* 2) The bivariate integer halfspace depth of 0 is computed w.r.t. all */ /* the y[i] that are not equal to (0,0). */ /* 3) If there are more than d-2 values y[i] that are equal to (0,0), */ /* the respective points are projected on the orthogonal complement */ /* of p. Then, the integer halfspace depth of 0 w.r.t. these */ /* projected points is computed. */ /* 4) The sum of the values from step 2) and 3) is returned. */ /* */ /****************************************************************************/ int HD2proj(double** x, int n, int d, double** p, int* indices) { double** y = new double*[n]; for (int i = 0; i < n; i++) y[i] = new double[2]; int cnt0 = 0, cnt1 = 0, HDproj = 0; int* plane = new int[n]; for (int i = 0; i < n; i++) { y[cnt1][0] = y[cnt1][1] = 0; for (int j = 0; j < d; j++) for (int k = 0; k < 2; k++) y[cnt1][k] += p[k][j] * x[i][j]; if (norm2(y[cnt1], 2) > eps_HD2) cnt1++; else plane[cnt0++] = i; } if (cnt0 > d - 2) { double** z = new double*[cnt0]; for (int i = 0; i < cnt0; i++) { z[i] = new double[d - 2]; for (int j = 0; j < d - 2; j++) { z[i][j] = 0; for (int k = 0; k < d; k++) z[i][j] += x[indices[j]][k] * x[plane[i]][k]; } } HDproj = nHD_Comb2(z, cnt0, d - 2); for (int i = 0; i < cnt0; i++) delete[] z[i]; delete[] z; } int result = intHD2(y, cnt1) + HDproj; delete[] plane; for (int i = 0; i < n; i++) delete[] y[i]; delete[] y; return result; } /****************************************************************************/ /* */ /* 'nHD_Comb2' computes the integer halfspace depth of 0 w.r.t n data */ /* points in R^d. */ /* */ /* 'nHD_Comb2' implements the combinatorial algorithm (k = d-2) as */ /* described in Section 3.2 of "Exact computation of the halfspace depth" */ /* by Rainer Dyckerhoff and Pavlo Mozharovskyi (arXiv:1411:6927) */ /* */ /****************************************************************************/ int nHD_Comb2(double** xx, int n, int d) { if (d == 1) return intHD1(xx, n); if (d == 2) return intHD2(xx, n); int result = n + 1; double** a = new double*[d - 2]; for (int i = 0; i < d - 2; i++) a[i] = new double[d]; double** p = new double*[2]; for (int i = 0; i < 2; i++) p[i] = new double[d]; int* indices = new int[d - 2]; indices[0] = -1; int pos = 0; while (pos >= 0) { indices[pos]++; for (pos++; pos < d - 2; pos++) indices[pos] = indices[pos - 1] + 1; pos--; do { for (int i = 0; i < d - 2; i++) for (int j = 0; j < d; j++) a[i][j] = xx[indices[i]][j]; if (getBasisComplement(a, d, p)) result = min(result, HD2proj(xx, n, d, p, indices)); indices[pos]++; } while (indices[pos] < n - d + pos + 3); do pos--; while (pos >= 0 && indices[pos] >= n - d + pos + 2); } for (int i = 0; i < d - 2; i++) delete[] a[i]; delete[] a; for (int i = 0; i < 2; i++) delete[] p[i]; delete[] p; delete[] indices; return result; } /****************************************************************************/ /* */ /* 'HD_Comb2' computes the halfspace depth of a point z w.r.t. n data */ /* points in R^d. */ /* */ /* 'HD_Comb2' does some preprocessing of the data and then calls */ /* 'nHD_Comb2'. */ /* */ /* See also the description in the header file. */ /* */ /* HD_Comb2 calls the following routines: */ /* norm2 */ /* intHD1 */ /* intHD2 */ /* getRank */ /* project */ /* getBasisComplement */ /* HD2proj */ /* nHD_Rec */ /* */ /****************************************************************************/ double HD_Comb2(double* z, double** xx, int n, int d) { if (n <= 0) throw invalid_argument("n <= 0"); if (d <= 0) throw invalid_argument("d <= 0"); int m = 0, rank; int* indices = new int[d]; double** x = new double*[n]; // preprocess data // subtract z from all data points x[i] // check whether the data points are concentrated on a lower // dimensional spcae for (int i = 0; i < n; i++) { x[m] = new double[d]; for (int j = 0; j < d; j++) x[m][j] = xx[i][j] - z[j]; if (norm2(x[m], d) >= eps_HDx) m++; else delete[] x[m]; } if (m == 0) return 1.0; rank = getRank(x, m, d, indices); if (rank < d) project(x, m, d, rank, indices); int result = nHD_Comb2(x, m, rank) + (n - m); // deallocate array x for (int i = 0; i < m; i++) delete[] x[i]; delete[] x; delete[] indices; return result / (double)n; } ddalpha/src/Knn.h0000644000176200001440000000147714213423775013356 0ustar liggesusers/* File: Knn.h Created by: Pavlo Mozharovskyi First published: 28.02.2013 Last revised: 28.02.2013 The realization of the KNN classifier. */ int GetK_JK_Binary(TMatrix points, TVariables cardinalities, int maxk); int Knn_ClassifyOne_Binary(TPoint point, TMatrix points, TVariables cardinalities, int k); int Knn_Classify_Binary(TMatrix objects, TMatrix points, TVariables cardinalities, int k, TVariables *output); int GetDDK_JK_Binary(TMatrix points, TVariables cardinalities, int maxk); int DDKnn_ClassifyOne(TPoint point, TMatrix points, TVariables cardinalities, int k); int KnnCv(TMatrix points, TVariables labels, int kMax, int distType, int numFolds); int Knn(TMatrix objects, TMatrix points, TVariables labels, int k, int distType, TVariables *output); ddalpha/R/0000755000176200001440000000000014550243636012060 5ustar liggesusersddalpha/R/depth.spatial.r0000644000176200001440000000671614213423775015015 0ustar liggesusersdepth.spatial.local <- function(x, data, mah.estimate = "moment", mah.parMcd = 0.75, kernel.bandwidth = 1){ if (!is.matrix(x) && is.vector(x)){ x <- matrix(x, nrow=1) } mean <- colMeans(data) if(mah.estimate == "none"){ lambda = diag(ncol(data)) } else { if(mah.estimate == "moment"){ cov <- cov(data) } else if(mah.estimate == "MCD"){ cov <- covMcd(data, mah.parMcd)$cov } else {stop("Wrong parameter 'mah.estimate'")} cov.eig <- eigen(cov) B <- cov.eig$vectors %*% diag(sqrt(cov.eig$values)) lambda <- solve(B) } if (kernel.bandwidth>1){ k <- function(x){ return(sqrt(2*pi)^(-ncol(x))*exp(-rowSums(x^2)/2/kernel.bandwidth)) } }else{ #1/kernel.bandwidth^d k <- function(x){ return((sqrt(2*pi)*kernel.bandwidth)^(-ncol(x))*exp(-rowSums(x^2)/2/kernel.bandwidth)) } } depths <- apply(x, 1, function(x){ n = nrow(data) t1 = t(lambda %*% (x - t(data))) t1 <- t1[which(rowSums(t1) != 0),] return (sum(k(t1))/n - sqrt(sum((colSums( k(t1)*( t1/sqrt(rowSums(t1^2)) ) )/n)^2))) } ) return (depths) } depth.spatial <- function(x, data, mah.estimate = "moment", mah.parMcd = 0.75){ if (!(is.matrix(data) && is.numeric(data) || is.data.frame(data) && prod(sapply(data, is.numeric))) || ncol(data) < 2){ stop("Argument \"data\" should be a numeric matrix of at least 2-dimensional data") } if(is.data.frame(data)) data = data.matrix(data) if (!is.matrix(x)){ if(is.vector(x)) x <- matrix(x, nrow=1) if(is.data.frame(x)) x = data.matrix(x) } mean <- colMeans(data) if(mah.estimate == "none"){ lambda = diag(ncol(data)) } else { if(mah.estimate == "moment"){ cov <- cov(data) } else if(mah.estimate == "MCD"){ cov <- covMcd(data, mah.parMcd)$cov } else {stop("Wrong parameter 'mah.estimate'")} if(sum(is.na(cov)) == 0){ cov.eig <- eigen(cov) B <- cov.eig$vectors %*% diag(sqrt(cov.eig$values)) lambda <- solve(B) } else{ lambda = diag(ncol(data)) } } depths <- rep(-1, nrow(x)) for (i in 1:nrow(x)){ tmp1 <- t(lambda %*% (x[i,] - t(data))) tmp1 <- tmp1[which(rowSums(tmp1) != 0),] tmp2 <- 1/sqrt(rowSums(tmp1^2)) depths[i] <- 1 - sqrt(sum((colSums(tmp2*tmp1)/nrow(data))^2)) } return (depths) } depth.space.spatial <- function(data, cardinalities, mah.estimate = "moment", mah.parMcd = 0.75){ if (!(is.matrix(data) && is.numeric(data) || is.data.frame(data) && prod(sapply(data, is.numeric))) || ncol(data) < 2){ stop("Argument \"data\" should be a numeric matrix of at least 2-dimensional data") } if (!is.vector(cardinalities, mode = "numeric") || is.na(min(cardinalities)) || sum(.is.wholenumber(cardinalities)) != length(cardinalities) || min(cardinalities) <= 0 || sum(cardinalities) != nrow(data)){ stop("Argument \"cardinalities\" should be a vector of cardinalities of the classes in \"data\" ") } if (sum(cardinalities < ncol(data) + 1) != 0){ stop("Not in all classes sufficiently enough objetcs") } depth.space <- NULL for (i in 1:length(cardinalities)){ pattern <- data[(1 + sum(cardinalities[0:(i - 1)])):sum(cardinalities[1:i]),] pattern.depths <- depth.spatial (data, pattern, mah.estimate, mah.parMcd) depth.space <- cbind(depth.space, pattern.depths, deparse.level = 0) } return (depth.space) }ddalpha/R/dataf.tecator.r0000644000176200001440000000007014213423775014757 0ustar liggesusersdataf.tecator <- function() return (getdata("tecator")) ddalpha/R/plot.functional.r0000644000176200001440000000343614213423775015370 0ustar liggesusersplot.functional <- function(x, main = "Functional data", xlab = "args", ylab = "vals", colors = c("red", "blue", "green", "black", "orange", "pink"), ...) { if(main == "Functional data" && !is.null(x$name)) main = x$name if(xlab == "args" && !is.null(x$args)) xlab = x$args if(ylab == "vals" && !is.null(x$vals)) ylab = x$vals ylims = matrix(unlist(lapply(x$dataf, function(e) (range(e$vals)))), ncol = 2, byrow = TRUE) plot(0, type="n", xlim=range(x$dataf[[1]]$args), ylim=c(min(ylims[,1]), max(ylims[,2])), xlab=xlab, ylab=ylab, main = main, ...) grid() if (!is.null(x$labels)) labs = sort(unlist(unique(unlist(x$labels)))) # second unlist removes factors, other else labs = NULL for (i in 1:length(x$dataf)){ if (!is.null(labs)) ind = match(x$labels[[i]],labs) else ind = 1 lineColor <- colors[ind] lines(x$dataf[[i]]$args, x$dataf[[i]]$vals, col=lineColor) } } lines.functional <- function(x, colors = c("red", "blue", "green", "black", "orange", "pink"), ...) { if (!is.null(x$labels)) labs = sort(unlist(unique(x$labels))) else labs = NULL for (i in 1:length(x$dataf)){ if (!is.null(labs)) ind = match(x$labels[[i]],labs) else ind = 1 lineColor <- colors[ind] lines(x$dataf[[i]]$args, x$dataf[[i]]$vals, col=lineColor, ...) } } points.functional <- function(x, colors = c("red", "blue", "green", "black", "orange", "pink"), ...) { if (!is.null(x$labels)) labs = sort(unlist(unique(x$labels))) else labs = NULL for (i in 1:length(x$dataf)){ if (!is.null(labs)) ind = match(x$labels[[i]],labs) else ind = 1 pointColor <- colors[ind] points(x$dataf[[i]]$args, x$dataf[[i]]$vals, col=pointColor, ...) } }ddalpha/R/ddalpha.train.r0000644000176200001440000004530514213423775014763 0ustar liggesusers################################################################################ # File: ddalpha.train.r # Created by: Pavlo Mozharovskyi, Oleksii Pokotylo # First published: 28.02.2013 # Last revised: 20.02.2019 # # Contains the training function of the DDalpha-classifier. # # For a description of the algorithm, see: # Lange, T., Mosler, K. and Mozharovskyi, P. (2012). Fast nonparametric # classification based on data depth. Statistical Papers. # Mozharovskyi, P., Mosler, K. and Lange, T. (2013). Classifying real-world # data with the DDalpha-procedure. Mimeo. ################################################################################ ddalpha.train <- function(formula, data, subset, depth = "halfspace", separator = "alpha", outsider.methods = "LDA", outsider.settings = NULL, aggregation.method = "majority", pretransform = NULL, use.convex = FALSE, seed = 0, ... # # knn # knnrange = NULL, # # alpha # num.chunks = 10, # max.degree = 3, # # # halfspace depth # num.directions = 1000, # # Mahalanobis depth # mah.estimate = "moment", # mah.parMcd = 0.75, # mah.priors = NULL ){ # Raw data processing ddalpha <- .ddalpha.create.structure(formula, data, subset, ...) # Check for data consistency #1 (moved to .ddalpha.create.structure) #if (!(is.matrix(data) && is.numeric(data) # || is.data.frame(data) && prod(sapply(data[,-ncol(data)], is.numeric)))){ # stop("Argument data has unacceptable format. Classifier can not be trained!!!") #} # Check for data consistency #2 if (ddalpha$numPatterns < 2){ stop("Number of patterns is < 2. Classifier can not be trained!!!") } # TODO ddalpha$numPatterns should be restricted from above as well if (ddalpha$dimension < 2){ stop("Data dimension is < 2. Classifier can not be trained!!!") } if(separator == "Dknn"){ dknn = dknn.train(ddalpha$raw, depth = depth, seed = seed, ...) dknn$call = ddalpha$call dknn$colnames = ddalpha$colnames dknn$classif.formula = ddalpha$classif.formula return(dknn) } for (i in 1:ddalpha$numPatterns){ if (ddalpha$patterns[[i]]$cardinality < ddalpha$dimension + 1){ stop("At least in one patern number of the points < (dimension + 1). Classifier can not be trained!!!") } } if (seed != 0){ set.seed(seed) } ddalpha$seed = seed ## Validating the properties depthsThatNeedNoScaling = c("zonoid", "halfspace", "Mahalanobis", "projection", "spatial", "spatialLocal", "simplicial", "simplicialVolume", "ddplot") # note: "spatialLocal" thansforms the data inside, by itself supportedDepths = c(depthsThatNeedNoScaling, "potential") if (is.null(depth) || toupper(depth) %in% c("", "NULL", "NONE")){ ddalpha$methodDepth <- NULL warning("Argument \"depth\" specified as NULL.") } else if (!is.character(depth) || length(depth) != 1){ stop("Argument \"depth\" not specified correctly.") } else if(!(depth %in% supportedDepths)){ .check.depth.exists(depth) ddalpha$methodDepth <- depth }else{ ddalpha$methodDepth <- depth } if (!is.character(separator) || length(separator) != 1){ stop("Argument \"separator\" not specified correctly.") } else if(!(separator %in% c("alpha", "polynomial", "knnlm", "maxD"))){ fname = paste0(".", separator, "_validate") f <- try(match.fun(fname), silent = T) if (!is.function(f)) warning(paste0("No validator function: ", fname, ". Cannot set 'methodSeparatorBinary'.")) fname = paste0(".", separator, "_learn") f <- (match.fun(fname)) if (!is.function(f)) stop(paste0("No function: ", fname)) fname = paste0(".", separator, "_classify") f <- (match.fun(fname)) if (!is.function(f)) stop(paste0("No function: ", fname)) ddalpha$methodSeparator <- separator }else{ ddalpha$methodSeparator <- separator } if (!is.character(aggregation.method) || length(aggregation.method) != 1 || !(aggregation.method %in% c("majority", "sequent", "none"))){ ddalpha$methodAggregation <- "majority" warning("Argument \"aggregation.method\" not specified correctly. \"majority\" is used as a default value") }else{ ddalpha$methodAggregation <- aggregation.method ddalpha$methodSeparatorBinary = (aggregation.method !="none") } ddalpha$needtransform = 0 if (!is.null(pretransform)) if (ddalpha$methodDepth %in% depthsThatNeedNoScaling){ warning("The used depth method is affine-invariant and pretransform doesn't influence the result. The data won't be transformed.") } else if (pretransform == "1Mom" || pretransform == "1MCD"){ ddalpha$needtransform = 1 if (pretransform == "1Mom") mm <- mah.moment(data[,-ncol(data)]) else # "1MCD" mm <- mah.mcd(data[,-ncol(data)], .mah.parMcd.fromDots(...)) for (i in 1:ddalpha$numPatterns){ ddalpha$patterns[[i]]$transformer <- MahMomentTransformer(mm$mu, mm$b) ddalpha$patterns[[i]]$points <- ddalpha$patterns[[i]]$transformer(ddalpha$patterns[[i]]$points) } } else if (pretransform == "NMom" || pretransform == "NMCD"){ ddalpha$needtransform = 2 for (i in 1:ddalpha$numPatterns){ if (pretransform == "NMom") mm <- mah.moment(ddalpha$patterns[[i]]$points) else # "NMCD" mm <- mah.mcd(ddalpha$patterns[[i]]$points, .mah.parMcd.fromDots(...)) ddalpha$patterns[[i]]$transformer <- MahMomentTransformer(mm$mu, mm$b) } } else { warning("Argument pretransform has unacceptable format. The data won't be transformed.") } # appends ddalpha with the values from the given list (lst) ddalpha.append <- function(lst){ if(is.list(lst)) for(k in names(lst)) ddalpha[[k]] <<- lst[[k]] } # calls the validation method for the selected separator || depth # NO errors or warnings if the function doesn't exist!! # ddalpha is READONLY inside the validators validate <- function(method_name){ f <- try(match.fun(paste0(".", method_name, "_validate")), silent = T) if (is.function(f)){ lst <- f(ddalpha, ...) ddalpha.append(lst) } } ## Separator parameters validation if (!is.null(ddalpha$methodDepth)) validate(ddalpha$methodSeparator) ## Depth parameters validation if (!is.logical(use.convex) || length(use.convex) != 1 || !(use.convex %in% c(TRUE, FALSE))){ ddalpha$useConvex <- FALSE warning("Argument \"use.convex\" not specified correctly. FALSE is used as a default value") }else{ ddalpha$useConvex <- use.convex } if (!is.null(ddalpha$methodDepth)) validate(ddalpha$methodDepth) ## The learning procedures if (!is.null(ddalpha$methodDepth)){ # Calculate depths if(ddalpha$methodDepth == "ddplot"){ for(i in 1:ddalpha$numPatterns) ddalpha$patterns[[i]]$depths <- ddalpha$patterns[[i]]$points } else{ ddalpha <- .ddalpha.learn.depth(ddalpha) if(is.null(ddalpha)) stop("The depth method did not return the 'ddalpha' object.") } # Learn classification machine if (ddalpha$methodSeparatorBinary){ ddalpha <- .ddalpha.learn.binary(ddalpha) } else { ddalpha <- .ddalpha.learn.multiclass(ddalpha) } if(is.null(ddalpha)) stop("The separator method did not return the 'ddalpha' object.") # if (ddalpha$methodSeparator == "alpha"){ # ddalpha <- .ddalpha.learn.alpha(ddalpha) # } else # if (ddalpha$methodSeparator == "polynomial"){ # ddalpha <- .ddalpha.learn.polynomial(ddalpha) # } else # if (ddalpha$methodSeparator == "knnlm"){ # ddalpha <- .ddalpha.learn.knnlm(ddalpha) # } else # stop("Define custom classifier") } else { ddalpha$numClassifiers = 0 } # Learn outsider treatments if needed if (is.null(ddalpha$methodDepth) || !(ddalpha$methodDepth %in% c("Mahalanobis", "projection", "spatial", "simplicialVolume", "potential"))){#, "simplicial" (may obtain too small values) ddalpha <- .ddalpha.learn.outsiders(ddalpha = ddalpha, methodsOutsider = outsider.methods, settingsOutsider = outsider.settings) } class(ddalpha) <- "ddalpha" return (ddalpha) } ################################################################################ # Validation functions ################################################################################ .mah.parMcd.fromDots <- function(mah.parMcd = 0.75, ...) { return(mah.parMcd) } .alpha_validate <- function(ddalpha, num.chunks = 10, max.degree = 3, debug = F,...){ if (ddalpha$methodAggregation == "majority"){ maxChunks <- ddalpha$patterns[[ddalpha$numPatterns]]$cardinality + ddalpha$patterns[[ddalpha$numPatterns - 1]]$cardinality }else{ maxChunks <- ddalpha$numPoints } if (is.character(num.chunks) && toupper(num.chunks)=="MAX") num.chunks <- maxChunks else if (!is.numeric(num.chunks) || is.na(num.chunks) || length(num.chunks) != 1 || !.is.wholenumber(num.chunks) || !(num.chunks > 0 && num.chunks <= maxChunks)){ if (!missing(num.chunks)) warning("Argument \"num.chunks\" not specified correctly. ", maxChunks, " is used instead") num.chunks <- maxChunks } if(!is.numeric(max.degree) || is.na(max.degree) || length(max.degree) != 1 || !.is.wholenumber(max.degree) || !(max.degree %in% 1:10)){ max.degree <- 3 warning("Argument \"max.degree\" not specified correctly. 3 is used as a default value") } return (list(numChunks = num.chunks, maxDegree = max.degree, debug = (debug == T), methodSeparatorBinary = T)) } .polynomial_validate <- .alpha_validate # the same .knnlm_validate <- function(ddalpha, knnrange = 10*( (ddalpha$numPoints)^(1/ddalpha$numPatterns) ) + 1,...){ isnull = missing(knnrange) || is.null(knnrange) if (is.character(knnrange) && toupper(knnrange)=="MAX") knnrange = ceiling(ddalpha$numPoints/2) else if(is.null(knnrange) || !is.numeric(knnrange) || is.na(knnrange) || length(knnrange) != 1 || !.is.wholenumber(knnrange) || !(knnrange >=2 && knnrange <= ceiling(ddalpha$numPoints/2))){ knnrange <- 10*( (ddalpha$numPoints)^(1/ddalpha$numPatterns) ) + 1 # Default knnrange <- min(knnrange, ceiling(ddalpha$numPoints/2)) knnrange <- max(knnrange, 2) if (!isnull) warning("Argument \"knnrange\" not specified correctly. ", knnrange, " is used instead") } return (list(knnrange = knnrange, methodSeparatorBinary = F)) } .maxD_validate <- function(ddalpha,...){ return(list(methodSeparatorBinary = F)) } .ddplot_validate <- function(ddalpha, ...){ if(ddalpha$dimension!=ddalpha$numPatterns) stop("You must pass a DD-plot, with the number of columns equal to the number of classes as data.") } .halfspace_validate <- function(ddalpha, exact, method, num.directions = 1000,...){ method = .parse_HSD_pars(exact, method) if(method == 0) if(!is.numeric(num.directions) || is.na(num.directions) || length(num.directions) != 1 || !.is.wholenumber(num.directions) || !(num.directions > 1 && num.directions < 10000000) ){ num.directions <- 1000 warning("Argument \"num.directions\" not specified correctly. 1000 is used as a default value") } return (list(dmethod = method, numDirections = num.directions)) } .projection_validate <- function(ddalpha, method = "random", num.directions = 1000,...){ if (!(method %in% c("random","linearize"))) stop("Wrong method") if(method == "random") if(!is.numeric(num.directions) || is.na(num.directions) || length(num.directions) != 1 || !.is.wholenumber(num.directions) || !(num.directions > 1 && num.directions < 10000000) ){ num.directions <- 1000 warning("Argument \"num.directions\" not specified correctly. 1000 is used as a default value") } return (list(dmethod = method, numDirections = num.directions)) } .simplicial_validate <- function(ddalpha, exact = F, k = 0.05, ...){ if (exact) return(list(d_exact = exact)) if (k <= 0) stop("k must be positive") else if (k < 1) k = choose(ddalpha$numPoints, ddalpha$dimension)*k return(list(d_exact = exact, d_k = k)) } .simplicialVolume_validate <- function(ddalpha, exact = F, k = 0.05, mah.estimate = "moment", mah.parMcd = 0.75, ...){ if (toupper(mah.estimate) == "NONE"){ useCov <- 0 } else if (toupper(mah.estimate) == "MOMENT"){ useCov <- 1 } else if (toupper(mah.estimate) == "MCD"){ useCov <- 2 } else {stop("Wrong argument \"mah.estimate\", should be one of \"moment\", \"MCD\", \"none\"")} if (exact){ return(list(d_exact = exact, d_k = k, d_useCov = useCov, d_parMcd = mah.parMcd)) } if (k <= 0) stop("k must be positive") else if (k < 1) k = choose(ddalpha$numPoints, ddalpha$dimension)*k return(list(d_exact = exact, d_k = k, d_useCov = useCov, d_parMcd = mah.parMcd)) } .Mahalanobis_validate <- function(ddalpha, mah.estimate = "moment", mah.priors = NULL, mah.parMcd = 0.75, ...){ if (!is.character(mah.estimate) || length(mah.estimate) != 1 || !(mah.estimate %in% c("moment", "MCD"))){ mah.estimate <- "moment" warning("Argument \"mah.estimate\" not specified correctly. \"moment\" is used as a default value") } if (!is.vector(mah.priors, mode = "double") || is.na(min(mah.priors)) || length(mah.priors) != ddalpha$numPatterns || min(mah.priors) <= 0 || max(mah.priors) <= 0){ if (!is.null(mah.priors)){ warning("Argument \"mah.priors\" not specified correctly. Defaults in the form of class portions are applied") } mah.priors <- NULL }else{ mah.priors <- mah.priors/sum(mah.priors) } ret <- list(mahEstimate = mah.estimate, mahPriors = mah.priors) if (mah.estimate == "MCD"){ if (is.null(mah.parMcd) || !is.vector(mah.parMcd, mode = "double") || is.na(min(mah.parMcd)) || length(mah.parMcd) != 1 || mah.parMcd < 0.5 || mah.parMcd > 1){ mah.parMcd <- 0.75 warning("Argument \"mah.parMcd\" not specified correctly. 0.75 is used as a default value") } ret$mahParMcd = mah.parMcd } return (ret) } .spatial_validate <- function(ddalpha, mah.estimate = "moment", mah.parMcd = 0.75, ...){ if(mah.estimate == "none") return(list(mahEstimate = "none")) return(.Mahalanobis_validate(ddalpha, mah.estimate = mah.estimate, mah.parMcd = mah.parMcd, ...)) } .spatialLocal_validate <- function(ddalpha, kernel = "GKernel", kernel.bandwidth = 1, ...) { # validate paraameters mah.estimate, mah.parMcd spatial_val = .spatial_validate(ddalpha, ...) if (is.null(kernel) || suppressWarnings ( !((kernel %in% .potentialKernelTypes) || !is.na(as.numeric(kernel))&&(as.numeric(kernel) %in% c(1:length(.potentialKernelTypes)))) )){ stop("Argument \"Kernel\" has invaid format.") } if (is.null(kernel.bandwidth) || !is.numeric(kernel.bandwidth)){ stop("Argument \"kernel.bandwidth\" has invaid format.") } if (length(kernel.bandwidth) == 1){ if (length(kernel.bandwidth) || is.na(kernel.bandwidth) || kernel.bandwidth == 0){ stop("Argument \"kernel.bandwidth\" is Zero or NA.") } kernel.bandwidth = rep(kernel.bandwidth, ddalpha$numPatterns) } else { if (sum(!is.na(kernel.bandwidth)) != ddalpha$numPatterns || sum(kernel.bandwidth != 0) != ddalpha$numPatterns){ stop("Argument \"kernel.bandwidth\" has invaid length, Zero or NA elements.") } # order bandwidths the same as the classes names = sapply(ddalpha$patterns, FUN=function(X) X$name) kernel.bandwidth = kernel.bandwidth[order(names)] } spatial_val$kernel = kernel spatial_val$kernel.bandwidth = kernel.bandwidth return(spatial_val) } .potential_validate <- function(ddalpha, kernel = "GKernel", kernel.bandwidth = NULL, ignoreself = FALSE, ...) { # if kernel.bandwidth is a vector - the values are given in the alphabetical order of the classes nemes if (ddalpha$needtransform == 0) stop("'pretransform' must be set for depth = 'potential'") if (is.null(kernel) || suppressWarnings ( !((kernel %in% .potentialKernelTypes) || !is.na(as.numeric(kernel))&&(as.numeric(kernel) %in% c(1:length(.potentialKernelTypes)))) )){ stop("Argument \"Kernel\" has invaid format.") } if (is.null(kernel.bandwidth)) { # use the rule of thumb if (ddalpha$needtransform == 2){ kernel.bandwidth = sapply(ddalpha$patterns, FUN=function(X) nrow(X$points)) ^ (-2/(ddalpha$dimension+4)) } else { kernel.bandwidth = ddalpha$numPoints ^ (-2/(ddalpha$dimension+4)) } } else{ if (#is.null(kernel.bandwidth) || !is.numeric(kernel.bandwidth) ||!(is.vector(kernel.bandwidth) || is.list(kernel.bandwidth))){ stop("Argument \"kernel.bandwidth\" has invaid format.") } if (ddalpha$needtransform == 2){ if (length(kernel.bandwidth) == 1) kernel.bandwidth = rep(kernel.bandwidth, ddalpha$numPatterns) if (sum(!is.na(kernel.bandwidth)) != ddalpha$numPatterns || sum(kernel.bandwidth != 0) != ddalpha$numPatterns){ stop("Argument \"kernel.bandwidth\" has invaid length, Zero or NA elements.") } # order bandwidths the same as the classes names = sapply(ddalpha$patterns, FUN=function(X) X$name) kernel.bandwidth = kernel.bandwidth[order(names)] } else if (length(kernel.bandwidth) != 1 || is.na(kernel.bandwidth) || kernel.bandwidth == 0){ stop("Argument \"kernel.bandwidth\" has invaid length, Zero or NA elements.") } } if (is.null(ignoreself) || !is.logical(ignoreself)) warning ("Argument \"ignoreself\" has invaid format. FALSE used.") return(list("kernel" = kernel, "kernel.bandwidth" = kernel.bandwidth, "ignoreself" = ignoreself)) } ddalpha/R/ddalphaf.r0000644000176200001440000010265114550243636014013 0ustar liggesusersddalphaf.train <- function(dataf, labels, subset, adc.args = list(instance = "avr", numFcn = -1, numDer = -1), classifier.type = c("ddalpha", "maxdepth", "knnaff", "lda", "qda"), cv.complete = FALSE, maxNumIntervals = min(25, ceiling(length(dataf[[1]]$args)/2)), seed = 0, ...){ # Trains the functional DDalpha-classifier # Args: # dataf: list containing lists (functions) of two vectors of equal length, # named "args" and "vals": arguments sorted in ascending order and # corresponding them values respectively # labels: output labels of the functinal observations # other arguments: TODO # Returns: # Functional DDalpha-classifier # Check "dataf" if (!is.list(dataf)) stop("Argument 'dataf' must be a list") for (df in dataf) if (!(is.list(df) && length(df) == 2 && !is.null(df$args) && !is.null(df$vals) && is.vector(df$args) && is.vector(df$vals) && is.numeric(df$args) && is.numeric(df$vals) && length(df$args) == length(df$vals) && is.sorted(df$args))) stop("Argument 'dataf' must be a list containing lists (functions) of two vectors of equal length, named 'args' and 'vals': arguments sorted in ascending order and corresponding them values respectively") if(!missing(subset)) { dataf = dataf[subset] labels = labels[subset] } # Check "labels" if (!(length(dataf)==length(labels) && length(unique(labels))>=2)) stop("Argument 'labels' has wrong format") # Check classifier.type classifier.type = match.arg(classifier.type) # Check "adc.method" adc.method = 'equalCover' if (seed != 0) set.seed(seed) # Check "adc.args" if(!is.null(names(adc.args))){ if (!(adc.args$instance %in% c("val", "avr") && ((adc.args$numFcn >= 0 && adc.args$numDer >= 0 && (adc.args$numFcn + adc.args$numDer >= 2)) || (adc.args$numFcn == -1 && adc.args$numDer == -1)))) stop("Argument 'adc.args' has wrong format") } else { if(!is.list(adc.args)) stop("Argument 'adc.args' has wrong format") for(.adc.args in adc.args){ if (!(.adc.args$instance %in% c("val", "avr") && ((.adc.args$numFcn >= 0 && .adc.args$numDer >= 0 && (.adc.args$numFcn + .adc.args$numDer >= 2)) || (.adc.args$numFcn == -1 && .adc.args$numDer == -1)))) stop("Argument 'adc.args' has wrong format") } } # CV if (is.null(names(adc.args)) || adc.args$numFcn == -1 && adc.args$numDer == -1){ if (cv.complete){ res <- getBestSpaceCV(dataf, labels, adc.method, adc.args, classifier.type, num.chunks=10, numMax = maxNumIntervals, ...) }else{ res <- getBestSpace(dataf, labels, adc.method, adc.args, classifier.type, num.chunks=10, numMax = maxNumIntervals, ...) } the.args <- res$args num.cv <- res$num.cv }else{ the.args <- adc.args num.cv <- 0 } # Pointize points <- GetPoints(dataf, labels, adc.method, the.args) if(any(!is.finite(points$data))) { warning("infinite or missing values in 'points$data'") return (NA) } # Apply chosen classifier to train the data if (classifier.type == "ddalpha"){ classifier <- ddalpha.train(points$data, seed = seed, ...) } if (classifier.type == "maxdepth"){ classifier <- ddalpha.train(points$data, separator = "maxD", seed = seed, ...) } if (classifier.type == "knnaff"){ classifier <- knnaff.train(points$data, i = 0, ...) } if (classifier.type == "lda"){ classifier <- lda_train(points$data, ...) } if (classifier.type == "qda"){ classifier <- qda_train(points$data, ...) } # Create the eventual output structure ddalphaf <- list(dataf = points$dataf, #labels_orig = labels, labels = points$labels, adc.method = adc.method, adc.args = the.args, adc.num.cv = num.cv, adc.transmat = points$adc.transmat, data = points$data, classifier.type = classifier.type, classifier = classifier) class(ddalphaf) <- "ddalphaf" return (ddalphaf) } ddalphaf.classify <- function(ddalphaf, objectsf, subset, ...){ # Classifies functions # Args: # objectsf: sample to classify, a list containing lists (functions) of # two vectors of equal length, named "args" and "vals": # arguments sorted in ascending order and corresponding them # values respectively # ddalphaf: functional DDalpha-classifier # Returns: # List of labels assigned to the functions from "objectsf" # Check "objectsf" if (!is.list(objectsf)) stop("Argument 'objectsf' must be a list") if (!is.null(objectsf$args)){ objectsf = list(objectsf) # there was a single element } if(!missing(subset)) { objectsf = objectsf[subset] } for (df in objectsf) if (!(is.list(df) && length(df) == 2 && !is.null(df$args) && !is.null(df$vals) && is.vector(df$args) && is.vector(df$vals) && is.numeric(df$args) && is.numeric(df$vals) && length(df$args) == length(df$vals) && is.sorted(df$args))) stop("Argument 'objectsf' must be a list containing lists (functions) of two vectors of equal length, named 'args' and 'vals': arguments sorted in ascending order and corresponding them values respectively") # Prepare to multivariate classification objectsf.equalized <- equalize(objectsf) if (ddalphaf$adc.method == "equalCover"){ if (ddalphaf$adc.args$instance == "val"){ input <- getValGrid(objectsf.equalized, ddalphaf$adc.args$numFcn, ddalphaf$adc.args$numDer) } if (ddalphaf$adc.args$instance == "avr"){ input <- getAvrGrid(objectsf.equalized, ddalphaf$adc.args$numFcn, ddalphaf$adc.args$numDer) } if (!is.null(ddalphaf$adc.transmat)){ input <- input%*%ddalphaf$adc.transmat } } # Classify and assign class labels if (ddalphaf$classifier.type == "ddalpha" || ddalphaf$classifier.type == "maxdepth"){ output <- ddalpha.classify(objects = input, ddalpha = ddalphaf$classifier, ...) } if (ddalphaf$classifier.type == "knnaff"){ output <- knnaff.classify(input, ddalphaf$classifier, ...) } if (ddalphaf$classifier.type == "lda"){ output <- lda_classify(input, ddalphaf$classifier, ...) } if (ddalphaf$classifier.type == "qda"){ output <- qda_classify(input, ddalphaf$classifier, ...) } classes <- list() for (i in 1:length(output)){ # if (is.numeric(output[[i]])){ classes[[i]] <- ddalphaf$labels[[ output[[i]] ]] # }else{ # classes[[i]] <- output[[i]] # } } return (classes) } predict.ddalphaf <- function(object, objectsf, subset, ...){ return(ddalphaf.classify(object, objectsf, subset, ...)) } is.in.convexf <- function(objectsf, dataf, cardinalities, adc.method = "equalCover", adc.args = list(instance = "val", numFcn = 5, numDer = 5), seed = 0){ # Checks if the function(s) lie(s) inside convex hulls of the # functions from the sample in the projection space # Args: # objectsf: list containing lists (functions) of two vectors of equal # length, named "args" and "vals": arguments sorted in # ascending order and corresponding them values # respectively. These functions are supposed to be checked # for 'outsiderness' # dataf: list containing lists (functions) of two vectors of equal # length, named "args" and "vals": arguments sorted in # ascending order and corresponding them values respectively # cardinalities: cardinalities of the classes in "dataf" # other arguments: TODO # Returns: # Vector with 1s for those lying inside of at least one of the convex hulls # of the classes and 0s for those lying beyond them # Data-consistency checks # TODO # Project "objectsf" into a multivariate space objectsf.equalized <- equalize(objectsf) if (adc.method == "equalCover"){ if (adc.args$instance == "val"){ objects <- getValGrid(objectsf.equalized, adc.args$numFcn, adc.args$numDer) } if (adc.args$instance == "avr"){ objects <- getAvrGrid(objectsf.equalized, adc.args$numFcn, adc.args$numDer) } } # Project "dataf" into a multivariate space dataf.equalized <- equalize(dataf) if (adc.method == "equalCover"){ if (adc.args$instance == "val"){ data <- getValGrid(dataf.equalized, adc.args$numFcn, adc.args$numDer) } if (adc.args$instance == "avr"){ data <- getAvrGrid(dataf.equalized, adc.args$numFcn, adc.args$numDer) } } in.convex <- is.in.convex(objects, data, cardinalities, seed) return (in.convex) } print.ddalphaf <- function(x, ...){ cat("ddalphaf:\n") cat("\t num.functions = ", length(x$dataf), ", num.patterns = ", length(unique(x$labels)), "\n", sep="") # cat("\t adc.method", x$adc.method, "\"\n", sep="") cat("\t adc: \"", x$adc.args$instance, "; numFcn:", x$adc.args$numFcn, "; numDer:", x$adc.args$numDer, "\"\n", sep="") cat("\t adc.num.cv \"", x$adc.num.cv, "\"\n", sep="") cat("\t adc.transmat \"", x$adc.transmat, "\"\n", sep="") cat("\t classifier.type \"", x$classifier.type, "\"\n", sep="") cat("classifier: ") print(x$classifier) } summary.ddalphaf <- function(object, ...) print.ddalphaf(object, ...) ################################################################################ # Functions below are used for intermediate computations # ################################################################################ equalize <- function(dataf){ # 1. Adjusts the data to have equal (the largest) argument interval # 2. Calclates - numerically - derivative # Args: # dataf: list containing lists (functions) of two vectors # of equal length, named "args" and "vals": arguments # sorted in ascending order and corresponding them # values respectively # Returns: # The list of lists of the same structure, 'equalized', # contating derivatives as 3rd vector named "der1" # Check whether every function contains fields "args" and "vals", # whether they are numerical and of equal length, have no NAs or # ties and are sorted in ascending order # TODO # 1. # Get argument bounds min <- Inf max <- -Inf for (i in 1:length(dataf)){ if (dataf[[i]]$args[1] < min){min <- dataf[[i]]$args[1]} if (dataf[[i]]$args[length(dataf[[i]]$args)] > max){ max <- dataf[[i]]$args[length(dataf[[i]]$args)] } } # and apply them to equalize functions timely for (i in 1:length(dataf)){ if (dataf[[i]]$args[1] > min){ dataf[[i]]$args <- c(min, dataf[[i]]$args) dataf[[i]]$vals <- c(dataf[[i]]$vals[1], dataf[[i]]$vals) } if (dataf[[i]]$args[length(dataf[[i]]$args)] < max){ dataf[[i]]$args <- c(dataf[[i]]$args, max) dataf[[i]]$vals <- c(dataf[[i]]$vals, dataf[[i]]$vals[length(dataf[[i]]$vals)]) } # Computational trick - add "-1" to the "left" #dataf[[i]]$args <- c(min - 1, dataf[[i]]$args) #dataf[[i]]$vals <- c(dataf[[i]]$vals[1], dataf[[i]]$vals) } # 2. for (i in 1:length(dataf)){ dataf[[i]] <- derive(dataf[[i]]) } return (dataf) } derive <- function(fcn){ # Adds 1st derivative to the function: a vector named "der1" # Args: # fcn: function, a list of two vectors of equal length, named "args" # and "vals": arguments sorted in ascending order and corresponding # them values respectively # Returns: # The list of of the same structure contating derivative as 3rd # vector named "der1" fcn$der1 <- rep(0, length(fcn$args)) fcn$der1[1] = 0 for (i in 2:length(fcn$der1)){ fcn$der1[i] <- (fcn$vals[i] - fcn$vals[i - 1])/ (fcn$args[i] - fcn$args[i - 1]) } return (fcn) } getValue <- function(fcn, arg, fcnInstance){ # Gets the value of the function or its derivative for the given argument # value # Args: # fcn: function, a list of vectors of equal length, named "args" # (arguments), "vals" (function values) [and it's # derivatives of order "I", named derI]; arguments (and # corresponding values) sorted in ascending order # arg: argument value at which the function (derivative) value # is to be taken # fcnInstance: inctance to be evaluated; "vals" for the function values, # "der1" for the first derivative # Returns: # Value of the function (derivative) # Check "arg", evt. "fcnInstance" # TODO # Find corresponding interval index <- 2 while (arg > fcn$args[index]){ index <- index + 1 } # Get the function value(s) by linear approximation if (fcnInstance == "vals"){ value <- fcn$vals[index - 1] + (fcn$vals[index] - fcn$vals[index - 1])* ((arg - fcn$args[index - 1])/(fcn$args[index] - fcn$args[index - 1])) } if (fcnInstance == "der1"){ value <- fcn$der1[index] } return (value) } getAvrValue <- function(fcn, argFrom, argTo, fcnInstance){ # Gets the average value of the function or its derivative on the given # interval # Args: # fcn: function, a list of vectors of equal length, named "args" # (arguments), "vals" (function values) [and it's # derivatives of order "I", named derI]; arguments (and # corresponding values) sorted in ascending order # argFrom: argument value from which the function (derivative) value # is to be averaged # argTo: argument value to which the function (derivative) value # is to be averaged # fcnInstance: inctance to be evaluated; "vals" for the function values, # "der1" for the first derivative # Returns: # Average value of the function (derivative) on the interval # (argFrom, argTo) # Check "argFrom" and "argTo", evt. "fcnInstance" # TODO # Define 'from' and 'to' interval indexFrom <- 2 while (argFrom > fcn$args[indexFrom]){ indexFrom <- indexFrom + 1 } indexTo <- 2 while (argTo > fcn$args[indexTo]){ indexTo <- indexTo + 1 } average <- 0 valTo <- getValue(fcn, argTo, fcnInstance) # Integrate curArgFrom <- argFrom if (fcnInstance == "vals"){ valFrom <- getValue(fcn, curArgFrom, "vals") while(indexFrom < indexTo){ average <- average + (valFrom + fcn$vals[indexFrom])* (fcn$args[indexFrom] - curArgFrom)/2 valFrom <- fcn$vals[indexFrom] curArgFrom <- fcn$args[indexFrom] indexFrom <- indexFrom + 1 } average <- average + (valFrom + valTo)*(argTo - curArgFrom)/2 } if (fcnInstance == "der1"){ while(indexFrom < indexTo){ average <- average + (fcn$der1[indexFrom])* (fcn$args[indexFrom] - curArgFrom) curArgFrom <- fcn$args[indexFrom] indexFrom <- indexFrom + 1 } average <- average + valTo*(argTo - curArgFrom) } average <- average/(argTo - argFrom) return (average) } getValGrid <- function(dataf, numFcn, numDer){ # Represents a function sample as a multidimensional (d="numFcn"+"numDer") # one averaging for that each function and it derivative on "numFcn" # (resp. "numDer") equal nonoverlapping covering intervals # Args: # dataf: list containing lists (functions) of vectors of equal length, # first two named "args" and "vals" are arguments sorted in # ascending order and having same bounds for all functions and # corresponding them values respectively # numFcn: number of function intervals # numDer: number of first-derivative intervals # Returns: # Matrix - a multidimensional presentation of the functional sample # Get argument bounds ("dataf" is equalized) min <- dataf[[1]]$args[1] max <- dataf[[1]]$args[length(dataf[[1]]$args)] # Get argument grid args <- dataf[[1]]$args argsFcn <- min + 0:numFcn*(max - min)/(numFcn - 1) argsDer <- min + 0:numDer*(max - min)/(numDer - 1) # Get function/derivative grid fcnGrid <- matrix(nrow = length(dataf), ncol = numFcn) derGrid <- matrix(nrow = length(dataf), ncol = numDer) if (numFcn > 0){ for (i in 1:length(dataf)){ # Set merging algorithm (Novikoff, Piter) cArgs <- 1 cArgsFcn <- 1 fcnGrid[i,1] <- dataf[[i]]$vals[1] while (cArgsFcn != numFcn){ # print(argsFcn) # print(fcnGrid[i,]) # cat(cArgs, " and ", cArgsFcn, "\n") # cat(args[cArgs + 1], " and ", argsFcn[cArgsFcn + 1], "\n") if (args[cArgs + 1] < argsFcn[cArgsFcn + 1]){ cArgs <- cArgs + 1 }else{ nextArg <- argsFcn[cArgsFcn + 1] fcnGrid[i,cArgsFcn + 1] <- dataf[[i]]$vals[cArgs] + (nextArg - args[cArgs])*dataf[[i]]$der1[cArgs + 1] if (args[cArgs + 1] == argsFcn[cArgsFcn + 1]){ cArgs <- cArgs + 1 } cArgsFcn <- cArgsFcn + 1 } } } } if (numDer > 0){ for (i in 1:length(dataf)){ # Again, set merging algorithm (Novikoff, Piter) cArgs <- 1 cArgsDer <- 1 derGrid[1] <- dataf[[i]]$ders[2] while (cArgsDer != numDer){ # print(argsDer) # print(derGrid[i,]) # cat(cArgs, " and ", cArgsDer, "\n") # cat(args[cArgs + 1], " and ", argsDer[cArgsDer + 1], "\n") if (args[cArgs + 1] < argsDer[cArgsDer + 1]){ cArgs <- cArgs + 1 }else{ derGrid[i,cArgsDer + 1] <- dataf[[i]]$der1[cArgs + 1] if (args[cArgs + 1] == argsDer[cArgsDer + 1]){ cArgs <- cArgs + 1 } cArgsDer <- cArgsDer + 1 } } } } mvX <- cbind(fcnGrid, derGrid) return (mvX) } getAvrGrid <- function(dataf, numFcn, numDer){ # Represents a function sample as a multidimensional (d="numFcn"+"numDer") # one averaging for that each function and it derivative on "numFcn" # (resp. "numDer") equal nonoverlapping covering intervals # Args: # dataf: list containing lists (functions) of vectors of equal length, # first two named "args" and "vals" are arguments sorted in # ascending order and having same bounds for all functions and # corresponding them values respectively # numFcn: number of function intervals # numDer: number of first-derivative intervals # Returns: # Matrix - a multidimensional presentation of the functional sample # Get argument bounds ("dataf" is equalized) min <- dataf[[1]]$args[1] max <- dataf[[1]]$args[length(dataf[[1]]$args)] # Get argument grid args <- dataf[[1]]$args argsFcn <- min + 0:numFcn*(max - min)/numFcn argsDer <- min + 0:numDer*(max - min)/numDer # Get function/derivative grid fcnGrid <- matrix(nrow = length(dataf), ncol = numFcn) derGrid <- matrix(nrow = length(dataf), ncol = numDer) if (numFcn > 0){ for (i in 1:length(dataf)){ # Set merging algorithm (Novikoff, Piter) cArgs <- 1 cArgsFcn <- 1 curArg <- min curFcn <- dataf[[i]]$vals[1] curAvr <- 0 while (cArgsFcn != numFcn + 1){ # print(argsFcn) # print(fcnGrid[i,]) # cat(cArgs, " and ", cArgsFcn, "\n") # cat(args[cArgs + 1], " and ", argsFcn[cArgsFcn + 1], "\n") if (args[cArgs + 1] < argsFcn[cArgsFcn + 1]){ nextArg <- args[cArgs + 1] nextFcn <- dataf[[i]]$vals[cArgs + 1] curAvr <- curAvr + (nextArg - curArg)*(nextFcn + curFcn)/2 cArgs <- cArgs + 1 }else{ nextArg <- argsFcn[cArgsFcn + 1] nextFcn <- dataf[[i]]$vals[cArgs] + (nextArg - args[cArgs])*dataf[[i]]$der1[cArgs + 1] fcnGrid[i,cArgsFcn] <- curAvr + (nextArg - curArg)*(nextFcn + curFcn)/2 curAvr <- 0 if (args[cArgs + 1] == argsFcn[cArgsFcn + 1]){ cArgs <- cArgs + 1 } cArgsFcn <- cArgsFcn + 1 } curArg <- nextArg curFcn <- nextFcn } } } fcnGrid <- fcnGrid/(argsFcn[2] - argsFcn[1]) if (numDer > 0){ for (i in 1:length(dataf)){ # Again, set merging algorithm (Novikoff, Piter) cArgs <- 1 cArgsDer <- 1 curArg <- min curAvr <- 0 while (cArgsDer != numDer + 1){ # print(argsDer) # print(derGrid[i,]) # cat(cArgs, " and ", cArgsDer, "\n") # cat(args[cArgs + 1], " and ", argsDer[cArgsDer + 1], "\n") if (args[cArgs + 1] < argsDer[cArgsDer + 1]){ nextArg <- args[cArgs + 1] curAvr <- curAvr + (nextArg - curArg)*dataf[[i]]$der1[cArgs + 1] cArgs <- cArgs + 1 }else{ nextArg <- argsDer[cArgsDer + 1] derGrid[i,cArgsDer] <- curAvr + (nextArg - curArg)*dataf[[i]]$der1[cArgs + 1] curAvr <- 0 if (args[cArgs + 1] == argsDer[cArgsDer + 1]){ cArgs <- cArgs + 1 } cArgsDer <- cArgsDer + 1 } curArg <- nextArg } } } derGrid <- derGrid/(argsDer[2] - argsDer[1]) mvX <- cbind(fcnGrid, derGrid) return (mvX) } getVapnikBound <- function(points, dim = NULL){ n <- nrow(points) d <- ncol(points) - 1 lda <- lda_train(points) result <- lda_classify(points[,1:d], lda) empRisk <- sum(result != points[,d + 1])/n # Calculate the deviation from the empirical risk nu <- 1/n C <- 0 for (k in 0:d){ C <- C + 2*choose(n - 1, k) } epsilon <- sqrt( (log(C) - log(nu)) / (2*n) ) return (empRisk + epsilon) } GetPoints <- function(dataf, labels, adc.method, adc.args){ # Numerize labels names <- unique(labels) output <- rep(0, length(labels)) for (i in 1:length(labels)){ for (j in 1:length(names)){ if (labels[[i]] == names[[j]]){ output[i] = j break } } } # Pointize data dataf.equalized <- equalize(dataf) if (adc.method == "equalCover"){ if (adc.args$instance == "val"){ input <- getValGrid(dataf.equalized, adc.args$numFcn, adc.args$numDer) } if (adc.args$instance == "avr"){ input <- getAvrGrid(dataf.equalized, adc.args$numFcn, adc.args$numDer) } # Reduce dimension if needed princomps <- NULL newDim <- ncol(input) for (i in 1:length(names)){ classi <- input[output == i,1:ncol(input)] if(any(!is.finite(classi))) { warning("infinite or missing values in 'classi'") next } princompsi <- prcomp(x=classi, tol=sqrt(.Machine$double.eps)) #print(princompsi$sdev) newDimi <- sum(princompsi$sdev > sqrt(.Machine$double.eps)) if (newDimi < newDim){ newDim <- newDimi princomps <- princompsi } } #print(newDim) transmat <- NULL if (newDim < ncol(input)){ transmat <- matrix(as.vector(princomps$rotation[,1:newDim]), ncol=newDim) input <- input%*%transmat } # Combine data data <- cbind(input, output, deparse.level=0) } return (list(data = data, dataf = dataf.equalized, labels = names, adc.transmat = transmat)) } GetPointsAll <- function(dataf, labels, adc.method = "equalCover", adc.args = list(instance = "avr", numFcn = -1, numDer = -1), numMax){ # Numerize labels names <- unique(labels) output <- rep(0, length(labels)) for (i in 1:length(labels)){ for (j in 1:length(names)){ if (labels[[i]] == names[[j]]){ output[i] = j break } } } # Prepare values min <- dataf[[1]]$args[1] max <- dataf[[1]]$args[length(dataf[[1]]$args)] args <- dataf[[1]]$args fcnsAll <- list("") dersAll <- list("") dataf.equalized <- equalize(dataf) # Generate all one-type-argument ("fcn" or "der") for all num(Fcn,Der)-values for (numFcn in 1:numMax){ numDer <- numFcn argsFcn <- min + 0:numFcn*(max - min)/numFcn argsDer <- min + 0:numDer*(max - min)/numDer # Get function/derivative grid fcnGrid <- matrix(nrow = length(dataf.equalized), ncol = numFcn) derGrid <- matrix(nrow = length(dataf.equalized), ncol = numDer) for (i in 1:length(dataf.equalized)){ # Set merging algorithm (Novikoff, Piter) cArgs <- 1 cArgsFcn <- 1 curArg <- min curFcn <- dataf.equalized[[i]]$vals[1] curAvr <- 0 while (cArgsFcn != numFcn + 1){ if (args[cArgs + 1] < argsFcn[cArgsFcn + 1]){ nextArg <- args[cArgs + 1] nextFcn <- dataf.equalized[[i]]$vals[cArgs + 1] curAvr <- curAvr + (nextArg - curArg)*(nextFcn + curFcn)/2 cArgs <- cArgs + 1 }else{ nextArg <- argsFcn[cArgsFcn + 1] nextFcn <- dataf.equalized[[i]]$vals[cArgs] + (nextArg - args[cArgs])*dataf.equalized[[i]]$der1[cArgs + 1] fcnGrid[i,cArgsFcn] <- curAvr + (nextArg - curArg)*(nextFcn + curFcn)/2 curAvr <- 0 if (args[cArgs + 1] == argsFcn[cArgsFcn + 1]){ cArgs <- cArgs + 1 } cArgsFcn <- cArgsFcn + 1 } curArg <- nextArg curFcn <- nextFcn } } fcnsAll[[numFcn]] <- fcnGrid/(argsFcn[2] - argsFcn[1]) for (i in 1:length(dataf.equalized)){ # Again, set merging algorithm (Novikoff, Piter) cArgs <- 1 cArgsDer <- 1 curArg <- min curAvr <- 0 while (cArgsDer != numDer + 1){ if (args[cArgs + 1] < argsDer[cArgsDer + 1]){ nextArg <- args[cArgs + 1] curAvr <- curAvr + (nextArg - curArg)*dataf.equalized[[i]]$der1[cArgs + 1] cArgs <- cArgs + 1 }else{ nextArg <- argsDer[cArgsDer + 1] derGrid[i,cArgsDer] <- curAvr + (nextArg - curArg)*dataf.equalized[[i]]$der1[cArgs + 1] curAvr <- 0 if (args[cArgs + 1] == argsDer[cArgsDer + 1]){ cArgs <- cArgs + 1 } cArgsDer <- cArgsDer + 1 } curArg <- nextArg } } dersAll[[numDer]] <- derGrid/(argsDer[2] - argsDer[1]) } pointsAll <- list("") counter <- 1 # Construct the spaces, reducing dimension if needed for (dim in 2:numMax){ for(nDer in 0:dim){ nFcn <- dim - nDer tmp.args <- list(instance=adc.args$instance, numFcn=nFcn, numDer=nDer) if (nFcn == 0){ input <- dersAll[[nDer]] }else{ if (nDer == 0){ input <- fcnsAll[[nFcn]] }else{ input <- cbind(fcnsAll[[nFcn]], dersAll[[nDer]]) } } # Reduce dimension if needed princomps <- NULL newDim <- ncol(input) for (i in 1:length(names)){ classi <- input[output == i,1:ncol(input)] princompsi <- prcomp(x=classi, tol=sqrt(.Machine$double.eps)) newDimi <- sum(princompsi$sdev > sqrt(.Machine$double.eps)) if (newDimi < newDim){ newDim <- newDimi princomps <- princompsi } } transmat <- NULL if (newDim < ncol(input)){ transmat <- matrix(as.vector(princomps$rotation[,1:newDim]), ncol=newDim) input <- input%*%transmat } # Combine data tmp.points <- cbind(input, output, deparse.level=0) # Save to the list pointsAll[[counter]] <- list(data = tmp.points, adc.args = tmp.args, adc.transmat = transmat) counter <- counter + 1 } } return (pointsAll) } # adc.args is a list of args GetPointsArgs <- function(dataf, labels, adc.method = "equalCover", adc.args){ pointsAll = list() counter = 1 for(tmp.args in adc.args){ dat = GetPoints(dataf, labels, adc.method, tmp.args) pointsAll[[counter]] <- list(data = dat$data, adc.args = tmp.args, adc.transmat = dat$adc.transmat) counter <- counter + 1 } return (pointsAll) } getBestSpace <- function(dataf, labels, adc.method = "equalCover", adc.args = list(instance = "avr", numFcn = -1, numDer = -1), classifier.type = "ddalpha", num.chunks = 10, numMax, ...){ # First, get Vapnik bounds for all plausible spaces if(!is.null(names(adc.args))){ pointsAll <- GetPointsAll(dataf, labels, adc.method, adc.args, numMax) numTries <- numMax * (numMax + 1) / 2 + numMax + 1 - 3 } else { pointsAll <- GetPointsArgs(dataf, labels, adc.method, adc.args) numTries <- length(adc.args) } Vapnik.bounds <- rep(Inf, numTries) curTry <- 1 for (i in 1:length(pointsAll)){ tmp.args <- pointsAll[[i]]$adc.args tmp.points <- pointsAll[[i]]$data Vapnik.bounds[curTry] <- getVapnikBound(tmp.points, ncol(tmp.points) - 1) curTry <- curTry + 1 } # Second, get 5 best (i.e. lowest) Vapnik bounds # etalons <- sort(Vapnik.bounds)[1:5] # best.indices <- c() # while (length(best.indices) < 5 && length(etalons) > 0){ # best.indices <- c(best.indices, which(Vapnik.bounds == etalons[1])) # etalons <- etalons[-1] # } # best.indices <- best.indices[1:5] best.indices <- which(Vapnik.bounds %in% sort(Vapnik.bounds)[1:min(5, numTries)]) # Third, cross-validate over these best spaces errors <- rep(0, length(best.indices)) for (i in 1:length(best.indices)){ tmp.args <- pointsAll[[best.indices[i]]]$adc.args points.all <- pointsAll[[best.indices[i]]]$data d <- ncol(points.all) - 1 # Actually CV num.points <- nrow(points.all) indices.off <- num.chunks*(0:(ceiling(num.points/num.chunks) - 1)) for (j in 1:num.chunks){ # Determine points to be taken off take.off <- (indices.off + j)[(indices.off + j) <= num.points] # Apply chosen classifier if (classifier.type == "ddalpha"){ classifier <- ddalpha.train(points.all[-take.off,], ...) results <- ddalpha.classify(objects = points.all[take.off,1:d], ddalpha = classifier) } if (classifier.type == "maxdepth"){ classifier <- ddalpha.train(points.all[-take.off,], separator = "maxD", ...) results <- ddalpha.classify(objects = points.all[take.off,1:d], ddalpha = classifier) } if (classifier.type == "knnaff"){ classifier <- knnaff.train(points.all[-take.off,], i = i, ...) results <- knnaff.classify(points.all[take.off,1:d], classifier) } if (classifier.type == "lda"){ classifier <- lda_train(points.all[-take.off,], ...) results <- lda_classify(points.all[take.off,1:d], classifier) } if (classifier.type == "qda"){ classifier <- qda_train(points.all[-take.off,], ...) results <- qda_classify(points.all[take.off,1:d], classifier) } # Collect errors errors[i] <- errors[i] + sum( unlist(results) != points.all [take.off,d + 1]) } } best.i <- which.min(errors) new.args <- pointsAll[[best.indices[best.i]]]$adc.args return (list(args = new.args, num.cv = length(best.indices))) } getBestSpaceCV <- function(dataf, labels, adc.method = "equalCover", adc.args = list(instance = "val", numFcn = -1, numDer = -1), classifier.type = "ddalpha", num.chunks = 10, numMax, ...){ if(!is.null(names(adc.args))){ pointsAll <- GetPointsAll(dataf, labels, adc.method, adc.args, numMax) numTries <- numMax * (numMax + 1) / 2 + numMax + 1 - 3 } else { pointsAll <- GetPointsArgs(dataf, labels, adc.method, adc.args) numTries <- length(adc.args) } curTry <- 1 errors <- rep(0, length(pointsAll)) for (i in 1:length(pointsAll)){ points.all <- pointsAll[[i]]$data d <- ncol(points.all) - 1 # Actually CV num.points <- nrow(points.all) indices.off <- num.chunks*(0:(ceiling(num.points/num.chunks) - 1)) for (j in 1:num.chunks){ # Determine points to be taken off take.off <- (indices.off + j)[(indices.off + j) <= num.points] # Apply chosen classifier if (classifier.type == "ddalpha"){ classifier <- ddalpha.train(points.all[-take.off,], ...) results <- ddalpha.classify(objects = points.all[take.off,1:d], ddalpha = classifier) } if (classifier.type == "maxdepth"){ classifier <- ddalpha.train(points.all[-take.off,], separator = "maxD", ...) results <- ddalpha.classify(objects = points.all[take.off,1:d], ddalpha = classifier) } if (classifier.type == "knnaff"){ classifier <- knnaff.train(points.all[-take.off,], i = i, ...) results <- knnaff.classify(points.all[take.off,1:d], classifier) } if (classifier.type == "lda"){ classifier <- lda_train(points.all[-take.off,], ...) results <- lda_classify(points.all[take.off,1:d], classifier) } if (classifier.type == "qda"){ classifier <- qda_train(points.all[-take.off,], ...) results <- qda_classify(points.all[take.off,1:d], classifier) } # Collect errors errors[i] <- errors[i] + sum( unlist(results) != points.all [take.off,d + 1]) } } best.i <- which.min(errors) new.args <- pointsAll[[best.i]]$adc.args return (list(args = new.args, num.cv = length(pointsAll))) } ddalpha/R/knnaff.r0000644000176200001440000002063414213423775013513 0ustar liggesusersknnaff.train <- function(data, aggregation.method = "majority", range = -1, k = -1, i = 0){ knnaff <- knaff.create.structure(data) # Checks if (!is.character(aggregation.method) || length(aggregation.method) != 1 || !(aggregation.method %in% c("majority", "sequent"))){ warning("In treatment number ", i, ": Argument \"aggregation.method\" not specified correctly. \"majority\" is used as a default value") knnaff$methodAggregation <- "majority" }else{ knnaff$methodAggregation <- aggregation.method } if (!is.numeric(range) || is.na(range) || length(range) != 1 || !.is.wholenumber(range) || !(range >= 2 && range <= (knnaff$patterns[[knnaff$numPatterns]]$cardinality + knnaff$patterns[[knnaff$numPatterns - 1]]$cardinality - 1) || range == -1)){ warning("In treatment number ", i, ": Argument \"range\" not specified correctly. Defaults are applied") knnaff$range <- -1 }else{ knnaff$range <- range } if (!is.numeric(k) || is.na(k) || length(k) != 1 || !.is.wholenumber(k) || !(k >= 1 && k <= (knnaff$patterns[[knnaff$numPatterns]]$cardinality + knnaff$patterns[[knnaff$numPatterns - 1]]$cardinality) || k == -1)){ warning("In treatment number ", i, ": Argument \"k\" not specified correctly. Defaults are applied") knnaff$k <- -1 }else{ knnaff$k <- k } # Do leave-one-out cross-validation knnaff <- knnaff.docv(knnaff) return (knnaff) } knaff.create.structure <- function(data){ # Elemantary statistics dimension <- ncol(data) - 1 numOfPoints <- nrow(data) classNames <- unique(data[,dimension + 1]) numOfClasses <- length(classNames) # Ordering patterns according to their cardinalities classCardinalities <- rep(0, numOfClasses) for (i in 1:numOfClasses){ classCardinalities[i] <- nrow(data[data[,dimension + 1] == classNames[i],]) } # Creating pattern templates patterns <- as.list("") for (i in 1:numOfClasses){ maxCarIndex <- which.max(classCardinalities) # Creating a single template pattern.index <- i pattern.points <- data[data[,dimension + 1] == classNames[maxCarIndex], 1:dimension] pattern.name <- classNames[maxCarIndex] pattern.cardinality <- classCardinalities[maxCarIndex] pattern.votes <- 0 pattern <- structure( list(index = pattern.index, points = pattern.points, name = pattern.name, cardinality = pattern.cardinality, votes = pattern.votes), .Names = c("index", "points", "name", "cardinality", "votes")) # Adding pattern template to the list of patterns patterns[[i]] <- pattern # Deleting processed pattern classCardinalities[maxCarIndex] <- -1 } # Creating overall structure knnaff <- structure( list(raw <- data, dimension = dimension, numPatterns = numOfClasses, numPoints = numOfPoints, patterns = patterns, classifiers = list(), numClassifiers = 0, methodAggregation = "majority", range = -1, k = -1), .Names = c("raw", "dimension", "numPatterns", "numPoints", "patterns", "classifiers", "numClassifiers", "methodAggregation", "range", "k")) return (knnaff) } knnaff.docv <- function(knnaff){ counter <- 1 # Determining multi-class behaviour if (knnaff$methodAggregation == "majority"){ for (i in 1:(knnaff$numPatterns - 1)){ for (j in (i + 1):knnaff$numPatterns){ # Creating a classifier classifier.index <- counter classifier.index1 <- i classifier.index2 <- j classifier.points <- as.double(t(rbind(knnaff$patterns[[i]]$points, knnaff$patterns[[j]]$points))) classifier.cardinalities <- as.integer(c(knnaff$patterns[[i]]$cardinality, knnaff$patterns[[j]]$cardinality)) if (knnaff$k < 1 || knnaff$k > (knnaff$patterns[[i]]$cardinality + knnaff$patterns[[j]]$cardinality - 1)) { if (knnaff$range < 2 || knnaff$range > (knnaff$patterns[[i]]$cardinality + knnaff$patterns[[j]]$cardinality - 1)){ maxk <- 10*( (knnaff$numPoints)^(1/knnaff$dimension) ) + 1 }else{ maxk <- knnaff$range } maxk <- min(maxk, knnaff$patterns[[i]]$cardinality + knnaff$patterns[[j]]$cardinality - 1) maxk <- max(maxk, 2) classifier.range <- maxk classifier.k <- as.integer(.C("KnnAffInvLearnJK", classifier.points, as.integer(knnaff$dimension), classifier.cardinalities, as.integer(maxk), k=integer(1))$k) }else{ classifier.range <- knnaff$range classifier.k <- as.integer(knnaff$k) } # Adding the classifier to the list of classifiers knnaff$classifiers[[counter]] <- list(index = classifier.index, index1 = classifier.index1, index2 = classifier.index2, points = classifier.points, cardinalities = classifier.cardinalities, k = classifier.k, range = classifier.range) counter <- counter + 1 } } } if (knnaff$methodAggregation == "sequent"){ for (i in 1:knnaff$numPatterns){ anotherClass <- NULL for (j in 1:knnaff$numPatterns){ if (j != i){ anotherClass <- rbind(anotherClass, knnaff$patterns[[j]]$points) } } classifier.index <- counter classifier.index1 <- i classifier.index2 <- -1 classifier.points <- as.double(t(rbind(knnaff$patterns[[i]]$points, anotherClass))) classifier.cardinalities <- as.integer(c(knnaff$patterns[[i]]$cardinality, nrow(anotherClass))) if (knnaff$k < 1 || knnaff$k > knnaff$numPoints) { if (knnaff$range < 2 || knnaff$range > (knnaff$numPoints - 1)){ maxk <- 10*( (knnaff$numPoints)^(1/knnaff$dimension) ) + 1 }else{ maxk <- knnaff$range } maxk <- min(maxk, knnaff$numPoints - 1) maxk <- max(maxk, 2) classifier.range <- maxk classifier.k <- as.integer(.C("KnnAffInvLearnJK", classifier.points, as.integer(knnaff$dimension), classifier.cardinalities, as.integer(maxk), k=integer(1))$k) }else{ classifier.range <- knnaff$range classifier.k <- as.integer(knnaff$k) } # Adding the classifier to the list of classifiers knnaff$classifiers[[counter]] <- list(index = classifier.index, index1 = classifier.index1, index2 = classifier.index2, points = classifier.points, cardinalities = classifier.cardinalities, k = classifier.k, range = classifier.range) counter <- counter + 1 } } return (knnaff) } knnaff.classify <- function(objects, knnaff){ # Correct input data if (!is.matrix(objects)){ objects <- matrix(objects, nrow=1) } # Initialization of the vote array votes <- matrix(rep(0, nrow(objects)*knnaff$numPatterns), nrow=nrow(objects), ncol=knnaff$numPatterns) for (i in 1:length(knnaff$classifiers)){ res <- .C("KnnAffInvClassify", as.double(t(objects)), as.integer(nrow(objects)), knnaff$classifiers[[i]]$points, as.integer(knnaff$dimension), knnaff$classifiers[[i]]$cardinalities, knnaff$classifiers[[i]]$k, output=integer(nrow(objects)))$output for (j in 1:nrow(objects)){ if (res[j] == 0){ votes[j,knnaff$classifiers[[i]]$index1] <- votes[j,knnaff$classifiers[[i]]$index1] + 1 }else{ votes[j,knnaff$classifiers[[i]]$index2] <- votes[j,knnaff$classifiers[[i]]$index2] + 1 } } } # Collect results results <- list() for (i in 1:nrow(objects)){ results[[i]] <- knnaff$patterns[[which.max(votes[i,])]]$name } return (results) } ddalpha/R/dataf.medflies.r0000644000176200001440000000007014213423775015106 0ustar liggesusersdataf.medflies <- function() return(getdata("medflies"))ddalpha/R/ddalpha-internal.r0000644000176200001440000017605514213444062015460 0ustar liggesusers################################################################################ # File: ddalpha-internal.r # Created by: Pavlo Mozharovskyi, Oleksii Pokotylo # First published: 28.02.2013 # Last revised: 20.02.2019 # # Contains the internal functions of the DDalpha-classifier. # # For a description of the algorithm, see: # Lange, T., Mosler, K. and Mozharovskyi, P. (2014). Fast nonparametric # classification based on data depth. Statistical Papers. # Mozharovskyi, P., Mosler, K. and Lange, T. (2015). Classifying real-world # data with the DDalpha-procedure. Mimeo. ################################################################################ .ddalpha.create.structure <- function(formula, data, subset, ...){ # if the user calls ddalpha(data, , ...) # for backward compatibility if(!missing(formula) && missing(data) && (is.data.frame(formula) || is.matrix(formula))){ data = formula formula = NULL } # formula is present if(!missing(formula) && !is.null(formula)){ needed.frame <- 1 # PM(2018-06-22) cl <- match.call(call = sys.call(sys.parent(n = needed.frame))) mf <- match.call(expand.dots = FALSE, call = sys.call(sys.parent(n = needed.frame))) m <- match(c("formula", "data", "subset"#, "weights", "na.action", "offset" ), names(mf), 0L) mf <- mf[c(1L, m)] mf$drop.unused.levels <- TRUE mf[[1L]] <- quote(stats::model.frame) mf <- eval(mf, parent.frame()) clres = colnames(mf) cat("Selected columns: ", paste(clres, collapse = ", "), "\n") classif.formula = delete.response(terms(mf)) data = cbind(mf[,-1,drop=F], mf[,1,drop=F]) # y = model.response(mf) # mm = model.matrix(formula, data = mf) # mm = as.data.frame(mm[,-1,drop=F]) # colnames(mm) <- paste0("P_",1:ncol(mm)) # data = cbind(mm, y) #colnames(mf) <- paste0("P_",1:ncol(mm)) } else { # no formula # Check for data consistency if (!(is.matrix(data) && is.numeric(data) || is.data.frame(data) && prod(sapply(data[,-ncol(data)], is.numeric)))){ stop("Argument data has unacceptable format. Classifier can not be trained!!!") } cl = NULL classif.formula = NULL clres = colnames(data) if(!is.data.frame(data)) data = as.data.frame(data) if(!missing(subset)) data = data[subset,] } names(data)[ncol(data)] <- "CLASS" # Elemantary statistics dimension <- ncol(data) - 1 numOfPoints <- nrow(data) classNames <- unique(data[,dimension + 1]) numOfClasses <- length(classNames) if(!is.data.frame(data)) data = as.data.frame(data) names(data)[ncol(data)] <- "CLASS" # Creating overall structure ddalpha <- list( call = cl, colnames = clres, # colnames after formula is applied classif.formula = classif.formula, # for classification raw = data, # after formula is applied dimension = dimension, numPatterns = numOfClasses, numPoints = numOfPoints, patterns = list(), needtransform = 0, # 0 - no transform, 1 - transform new points before classification, all classes the same, 2 - transform differently w.r.t. to classes. classifiers = list(), # numClassifiers = 0, # methodDepth = "halfspace", # methodSeparator = "alpha", # methodAggregation = "majority", # methodsOutsider = NULL, # numDirections = 1000, # directions = NULL, # projections = NULL, sameDirections = TRUE, useConvex = FALSE, maxDegree = 3, numChunks = numOfPoints, # knnrange = NULL, # mahEstimate = "moment", # mahParMcd = 0.75, # mahPriors = NULL, # knnK = 1, # knnX = NULL, # knnY = NULL, # knnD = NULL, treatments = c("LDA", "KNNAFF", "KNN", "DEPTH.MAHALANOBIS", "RANDEQUAL", "RANDPROP", "IGNORE")) # Ordering patterns according to their cardinalities classCardinalities <- rep(0, numOfClasses) for (i in 1:numOfClasses){ classCardinalities[i] <- nrow(data[data[,dimension + 1] == classNames[i],]) } # Creating pattern templates patterns <- as.list("") for (i in 1:numOfClasses){ maxCarIndex <- which.max(classCardinalities) # Creating a single template ddalpha$patterns[[i]] <- list( index = i, points = data[data[,dimension + 1] == classNames[maxCarIndex],1:dimension], name = classNames[maxCarIndex], cardinality = classCardinalities[maxCarIndex], depths = matrix(rep(0, numOfClasses*classCardinalities[maxCarIndex]), nrow = classCardinalities[maxCarIndex], ncol = numOfClasses), votes = 0#, # center = 0, # cov = 0, # sigma = 0, # centerMcd = 0, # covMcd = 0, # sigmaMcd = 0 ) # Adding pattern template to the list of patterns class(ddalpha$patterns[[i]])<-"ddalpha.pattern" # Deleting processed pattern classCardinalities[maxCarIndex] <- -1 } return (ddalpha) } .check.depth.exists <- function(depth) { fname = paste0(".", depth, "_validate") f <- try(match.fun(fname), silent = T) if (!is.function(f)) warning(paste0("No validator function: ", fname)) fname = paste0(".", depth, "_learn") f <- (match.fun(fname)) if (!is.function(f)) stop(paste0("No function: ", fname)) fname = paste0(".", depth, "_depths") f <- (match.fun(fname)) if (!is.function(f)) stop(paste0("No function: ", fname)) } .ddalpha.learn.depth <- function(ddalpha){ # try to find a custom depth fname = paste0(".", ddalpha$methodDepth, "_learn") f <- try(match.fun(fname), silent = T) if (is.function(f)){ ddalpha = f(ddalpha) return(ddalpha) } # If it's the random Tukey depth, compute it first if (ddalpha$methodDepth == "halfspace"){ dSpaceStructure <- .halfspace_space(ddalpha) ddalpha$directions <- dSpaceStructure$directions ddalpha$projections <- dSpaceStructure$projections tmpDSpace <- dSpaceStructure$dspace } if (ddalpha$methodDepth == "projection"){ dSpaceStructure <- .projection_space(ddalpha) tmpDSpace <- dSpaceStructure$dspace if (ddalpha$dmethod == "random"){ ddalpha$directions <- dSpaceStructure$directions ddalpha$projections <- dSpaceStructure$projections } } classBegin = 1 if (ddalpha$methodDepth == "potential"){ tmpDSpace <- .ddalpha.count.depths(ddalpha, NULL) } # Calculating depths in each pattern for (i in 1:ddalpha$numPatterns){ if ( ddalpha$methodDepth == "halfspace" || ddalpha$methodDepth == "projection" || ddalpha$methodDepth == "potential"){ # Random depth is already calculated, just distribute ddalpha$patterns[[i]]$depths <- tmpDSpace[classBegin:(classBegin+ddalpha$patterns[[i]]$cardinality-1),] classBegin = classBegin+ddalpha$patterns[[i]]$cardinality } else if (ddalpha$methodDepth == "zonoid"){ # Calculate depths for the class w.r.t all classes, saying to which of the classes the chunk belongs ddalpha$patterns[[i]]$depths <- .zonoid_depths(ddalpha, ddalpha$patterns[[i]]$points, i) } else if (ddalpha$methodDepth == "Mahalanobis"){ ddalpha$patterns[[i]]$depths <- .Mahalanobis_depths(ddalpha, ddalpha$patterns[[i]]$points) } else if (ddalpha$methodDepth == "spatial"){ # Calculate depths for the class w.r.t all classes, saying to which of the classes the chunk belongs ddalpha$patterns[[i]]$depths <- .spatial_depths(ddalpha, ddalpha$patterns[[i]]$points) } else if (ddalpha$methodDepth == "spatialLocal"){ # Calculate depths for the class w.r.t all classes, saying to which of the classes the chunk belongs ddalpha$patterns[[i]]$depths <- .spatialLocal_depths(ddalpha, ddalpha$patterns[[i]]$points) } else if (ddalpha$methodDepth == "simplicial"){ # Calculate depths for the class w.r.t all classes, saying to which of the classes the chunk belongs ddalpha$patterns[[i]]$depths <- .simplicial_depths(ddalpha, ddalpha$patterns[[i]]$points) } else if (ddalpha$methodDepth == "simplicialVolume"){ # Calculate depths for the class w.r.t all classes, saying to which of the classes the chunk belongs ddalpha$patterns[[i]]$depths <- .simplicialVolume_depths(ddalpha, ddalpha$patterns[[i]]$points) } else stop("Unknown depth ", ddalpha$methodDepth) } return (ddalpha) } .getFunction <- function(fname) { f <- try(match.fun(fname), silent = T) if (!is.function(f)) stop("Wrong or absent function: ", fname) f } .ddalpha.learn.binary <- function(ddalpha){ fname = paste0(".", ddalpha$methodSeparator, "_learn") learn <- try(match.fun(fname), silent = T) if (!is.function(learn)) stop("Wrong or absent function: ", fname) # Separating (calculating extensions and normals) counter <- 1 # Determining multi-class behaviour if (ddalpha$methodAggregation == "majority"){ for (i in 1:(ddalpha$numPatterns - 1)){ for (j in (i + 1):ddalpha$numPatterns){ # Creating a classifier classifier <- learn(ddalpha, i, j, ddalpha$patterns[[i]]$depths, ddalpha$patterns[[j]]$depths) classifier$index = counter classifier$index1 = i classifier$index2 = j if(inherits(classifier, "list")) class(classifier) <- paste0("ddalpha.", ddalpha$methodSeparator) else class(classifier) <- c(class(classifier), paste0("ddalpha.", ddalpha$methodSeparator)) # Adding the classifier to the list of classifiers ddalpha$classifiers[[counter]] <- classifier counter <- counter + 1 } } ddalpha$numClassifiers <- counter - 1 } if (ddalpha$methodAggregation == "sequent"){ for (i in 1:ddalpha$numPatterns){ anotherClass <- NULL for (j in 1:ddalpha$numPatterns){ if (j != i){ anotherClass <- rbind(anotherClass, ddalpha$patterns[[j]]$depths) } } classifier <- learn(ddalpha, i, -i, ddalpha$patterns[[i]]$depths, anotherClass) classifier$index = counter classifier$index1 = i classifier$index2 = -i if(inherits(classifier, "list")) class(classifier) <- paste0("ddalpha.", ddalpha$methodSeparator) else class(classifier) <- c(class(classifier), paste0("ddalpha.", ddalpha$methodSeparator)) # Adding the classifier to the list of classifiers ddalpha$classifiers[[i]] <- classifier } ddalpha$numClassifiers <- ddalpha$numPatterns } return (ddalpha) } .alpha_learn <- function(ddalpha, index1, index2, depths1, depths2){ points <- as.vector(t(rbind(depths1, depths2))) numClass1 <- nrow(depths1) numClass2 <- nrow(depths2) numPoints <- numClass1 + numClass2 dimension <- ncol(depths1) cardinalities <- c(numClass1, numClass2) upToPower <- ddalpha$maxDegree minFeatures <- 2 maxExtDimension <- (factorial(dimension + upToPower) / (factorial(dimension)*factorial(upToPower))) - 1; p <- .C("AlphaLearnCV", as.double(points), as.integer(numPoints), as.integer(dimension), as.integer(cardinalities), as.integer(upToPower), as.integer(ddalpha$numChunks), as.integer(minFeatures), as.integer(ddalpha$debug), portrait=double(maxExtDimension + 1))$portrait degree <- p[1]; extDimension <- (factorial(dimension + degree) / (factorial(dimension)*factorial(degree))) - 1; d <- 0 for (i in 2:(extDimension + 1)){ if (p[i] != 0){ d <- d + 1 } } return(list( hyperplane = p, degree = degree, dimProperties = length(p) - 1, dimFeatures = d )) } .alpha_classify <- function(ddalpha, classifier, depths){ toClassify <- as.double(as.vector(t(depths))) m = as.integer(nrow(depths)) q = as.integer(ncol(depths)) result <- .C("AlphaClassify", toClassify, m, q, as.integer(classifier$degree), as.double(classifier$hyperplane), output=integer(m))$output return(result) } .polynomial_learn <- function(ddalpha, index1, index2, depths1, depths2){ polynomial <- .polynomial_learn_C(ddalpha$maxDegree, rbind(depths1[,c(index1, index2)], depths2[,c(index1, index2)]), nrow(depths1), nrow(depths2), ddalpha$numChunks, ddalpha$seed) return(list( polynomial = polynomial$coefficients, degree = polynomial$degree, axis = polynomial$axis)) } .polynomial_classify <- function(ddalpha, classifier, depths){ x = ifelse(classifier$axis == 0, classifier$index1, classifier$index2) y = ifelse(classifier$axis == 0, classifier$index2, classifier$index1) result <- (- depths[,y]) for (obj in 1:nrow(depths)){ val <- depths[obj,x] for(j in 1:classifier$degree){ result[obj] <- result[obj] + classifier$polynomial[j]*val^j } } return(result) } .ddalpha.learn.multiclass <- function(ddalpha){ fname = paste0(".", ddalpha$methodSeparator, "_learn") learn <- try(match.fun(fname), silent = T) if (!is.function(learn)) stop("Wrong or absent function: ", fname) classifier <- learn(ddalpha) if(inherits(classifier, "list")) class(classifier) <- paste0("ddalpha.", ddalpha$methodSeparator) else class(classifier) <- c(class(classifier), paste0("ddalpha.", ddalpha$methodSeparator)) ddalpha$classifiers[[1]] <- classifier ddalpha$numClassifiers <- 1 return (ddalpha) } #.ddalpha.learn.knnlm .knnlm_learn <- function(ddalpha){ x <- NULL y <- NULL for (i in 1:ddalpha$numPatterns){ x <- rbind(x, ddalpha$patterns[[i]]$depths) y <- c(y, rep(i - 1, ddalpha$patterns[[i]]$cardinality)) } x <- as.vector(t(x)) y <- as.vector(y) k <- .C("KnnLearnJK", as.double(x), as.integer(y), as.integer(ddalpha$numPoints), as.integer(ddalpha$numPatterns), as.integer(ddalpha$knnrange), as.integer(2), k=integer(1))$k return (list(knnK = k, knnX = x, knnY = y)) } .knnlm_classify <- function(ddalpha, classifier, depths){ z <- as.vector(t(depths)) output <- .C("KnnClassify", as.double(z), as.integer(nrow(depths)), as.double(classifier$knnX), as.integer(classifier$knnY), as.integer(ddalpha$numPoints), as.integer(ddalpha$numPatterns), as.integer(classifier$knnK), as.integer(2), output=integer(nrow(depths)))$output return(output+1) } .maxD_learn <- function(ddalpha) return(list()) .maxD_classify <- function(ddalpha, classifier, depths) apply(depths, 1, which.max) .ddalpha.learn.outsiders <- function(ddalpha, methodsOutsider = "LDA", settingsOutsider = NULL){ # Refine treatments if (is.null(settingsOutsider)){ ddalpha$methodsOutsider <- .parse.methods(methodsOutsider) }else{ ddalpha$methodsOutsider <- .parse.settings(ddalpha, settingsOutsider) } # Train treatments treatments = list(LDA = .lda_learn, QDA = .qda_learn, KNN = .knn_learn, KNNAff = .knnAff_learn, depth.Mahalanobis = .mah_learn, Ignore = NA, Mark = NA, RandEqual = NA, RandProp = NA) for (i in 1:length(ddalpha$methodsOutsider)){ .treatment = treatments[[ddalpha$methodsOutsider[[i]]$method]] if(is.null(.treatment)) stop("Unknown outsiders treatment method ", ddalpha$methodsOutsider[[i]]$method) if(!is.function(.treatment)) next; # need no training ddalpha$methodsOutsider[[i]] <- .treatment(ddalpha, ddalpha$methodsOutsider[[i]]) } return(ddalpha) } .ddalpha.count.depths <- function(ddalpha, objects, ...){ fname = paste0(".", ddalpha$methodDepth, "_depths") f <- (match.fun(fname)) if (!is.function(f)) stop(paste0("Wrong function for ", ddalpha$methodDepth)) # Count for all data if (is.null(objects)) for (i in 1:ddalpha$numPatterns){ objects <- rbind(objects, ddalpha$patterns[[i]]$points) } else ## if needtransform == 1 the data is already scaled # Transform the data once if (ddalpha$needtransform == 1){ objects <- ddalpha$patterns[[1]]$transformer(objects) } # Calculate depths for all classes together if (ddalpha$needtransform != 2){ res <- f(ddalpha, objects, ...) return(res) } # Calculate depths w.r.t. each class else { d <- NULL # w.r.t. each class for (cls in 1:ddalpha$numPatterns){ depth <- f(ddalpha, objects, class = cls, ...) d = cbind(d, depth) } return(d) } } .ddalpha.classify.outsiders<- function (objects, ddalpha, settings){ if (settings$method == "Ignore"){ return (.ignore_classify(nrow(objects))) } if (settings$method == "Mark"){ return (.right_classify(nrow(objects))) } if (settings$method == "RandEqual"){ return (.randequal_classify(nrow(objects), ddalpha)) } if (settings$method == "RandProp"){ return (.randprop_classify(nrow(objects), ddalpha, settings)) } treatments = list(LDA = .lda_classify, QDA = .qda_classify, KNN = .knn_classify, KNNAff = .knnAff_classify, depth.Mahalanobis = .mah_classify) .treatment = treatments[[settings$method]] if(is.null(.treatment)) stop("Unknown outsiders treatment method ", settings$method) classified = .treatment(objects, ddalpha, settings) return(classified) } ################################################################################ # Functions used for intermediate calculations and checks are presented below ################################################################################ .are_classifiable <- function(objects, points, cardinalities){ convexes <- .count_convexes(objects, points, cardinalities) return (ifelse(rowSums(convexes)>0,1,0)) } .count_convexes <- function(objects, points, cardinalities, seed = 0){ if (is.na(seed)) seed = 0 x <- as.vector(t(points)) dimension <- ncol(points) numClasses <- length(cardinalities) o <- as.vector(t(objects)) numObjects <- nrow(objects) result <- .C("IsInConvexes", as.double(x), as.integer(dimension), as.integer(cardinalities), as.integer(numClasses), as.double(o), as.integer(numObjects), as.integer(seed), isInConvexes=integer(numObjects*numClasses))$isInConvexes result <- matrix(result, byrow = T, ncol = numClasses) return (result) } .halfspace_space <- function(ddalpha){ points <- NULL cardinalities <- NULL for (i in 1:ddalpha$numPatterns){ points <- rbind(points, ddalpha$patterns[[i]]$points) cardinalities <- c(cardinalities, ddalpha$patterns[[i]]$cardinality) } x <- as.vector(t(points)) c <- as.vector(cardinalities) k <- ddalpha$numDirections method = ddalpha$dmethod if (method == 0){ if (ddalpha$sameDirections){ rez <- .C("HDSpace", as.double(x), as.integer(ncol(points)), as.integer(c), as.integer(ddalpha$numPatterns), as.integer(k), as.integer(1), as.integer(ddalpha$seed), dspc=double(nrow(points)*ddalpha$numPatterns), dirs=double(k*ncol(points)), prjs=double(k*nrow(points))) return (list(dspace=matrix(rez$dspc, nrow=nrow(points), ncol=ddalpha$numPatterns, byrow=TRUE), directions=rez$dirs, projections=rez$prjs)) }else{ rez <- .C("HDSpace", as.double(x), as.integer(ncol(points)), as.integer(c), as.integer(ddalpha$numPatterns), as.integer(k), as.integer(0), as.integer(ddalpha$seed), dspc=double(nrow(points)*ddalpha$numPatterns), dirs=double(k*ncol(points)), prjs=double(k*nrow(points))) return (list(dspace=matrix(rez$dspc, nrow=nrow(points), ncol=ddalpha$numPatterns, byrow=TRUE), directions=0, projections=0)) } } else if (method %in% 1:3){ ds <- .C("HDepthSpaceEx", as.double(x), as.double(x), as.integer(c), as.integer(length(cardinalities)), as.integer(nrow(points)), as.integer(ncol(points)), as.integer(method), depths=double(nrow(points)*length(cardinalities)))$depths return (list(dspace=matrix(ds, nrow=nrow(points), ncol=ddalpha$numPatterns, byrow=F))) } else stop("wrong choise of the algorithm, method = ", method) } .halfspace_depths <- function(ddalpha, objects){ points <- NULL cardinalities <- NULL for (i in 1:ddalpha$numPatterns){ points <- rbind(points, ddalpha$patterns[[i]]$points) cardinalities <- c(cardinalities, ddalpha$patterns[[i]]$cardinality) } x <- as.vector(t(points)) y <- as.vector(t(objects)) c <- as.vector(cardinalities) k <- ddalpha$numDirections method <- ddalpha$dmethod if (method == 0){ if (ddalpha$sameDirections){ result <- .C("HDepth", as.double(x), as.double(y), as.integer(nrow(objects)), as.integer(ncol(points)), as.integer(c), as.integer(ddalpha$numPatterns), as.double(ddalpha$directions), as.double(ddalpha$projections), as.integer(k), as.integer(1), as.integer(ddalpha$seed), depths=double(ddalpha$numPatterns*nrow(objects))) }else{ result <- .C("HDepth", as.double(x), as.double(y), as.integer(nrow(objects)), as.integer(ncol(points)), as.integer(c), as.integer(ddalpha$numPatterns), dirs=double(k*ncol(points)), prjs=double(k*nrow(points)), as.integer(k), as.integer(0), as.integer(ddalpha$seed), depths=double(ddalpha$numPatterns*nrow(objects))) } } else if (method %in% 1:3){ ds <- .C("HDepthSpaceEx", as.double(x), as.double(y), as.integer(c), as.integer(length(cardinalities)), as.integer(nrow(objects)), as.integer(ncol(points)), as.integer(method), depths=double(nrow(objects)*length(cardinalities)))$depths depths <- matrix(ds, nrow=nrow(objects), ncol=length(cardinalities), byrow=F) return (depths) } else stop("wrong choise of the algorithm, method = ", method) return (matrix(result$depths, nrow=nrow(objects), ncol=ddalpha$numPatterns, byrow=TRUE)) } .zonoid_depths <- function(ddalpha, objects, ownPattern = 0){ depths <- NULL for (i in 1:ddalpha$numPatterns){ pattern <- ddalpha$patterns[[i]]$points x <- as.vector(t(pattern)) y <- as.vector(t(objects)) ds <- .C("ZDepth", as.double(x), as.double(y), as.integer(nrow(pattern)), as.integer(nrow(objects)), as.integer(ncol(pattern)), as.integer(ddalpha$seed), depths=double(nrow(objects)))$depths if (i == ownPattern){ ds <- replace(ds, which(ds < 1/nrow(pattern) - sqrt(.Machine$double.eps)), 1/nrow(pattern)) }else{ ds <- replace(ds, which(ds < 1/nrow(pattern) - sqrt(.Machine$double.eps)), 0) } depths <- cbind(depths, ds) } return (depths) } .estimate_moments <- function(ddalpha){ for (i in 1:ddalpha$numPatterns){ if (ddalpha$mahEstimate == "moment"){ ddalpha$patterns[[i]]$center <- colMeans(ddalpha$patterns[[i]]$points) ddalpha$patterns[[i]]$cov <- cov(ddalpha$patterns[[i]]$points) try( ddalpha$patterns[[i]]$sigma <- solve(ddalpha$patterns[[i]]$cov) ) } if (ddalpha$mahEstimate == "MCD"){ try( estimate <- covMcd(ddalpha$patterns[[i]]$points, ddalpha$mahParMcd) ) try( ddalpha$patterns[[i]]$center <- estimate$center ) try( ddalpha$patterns[[i]]$cov <- estimate$cov ) try( ddalpha$patterns[[i]]$sigma <- solve(estimate$cov) ) } } return(ddalpha) } .Mahalanobis_learn <- function(ddalpha){ if (is.null(ddalpha$mahPriors)){ ddalpha$mahPriors <- c() for (i in 1:ddalpha$numPatterns){ ddalpha$mahPriors[i] <- ddalpha$patterns[[i]]$cardinality/ddalpha$numPoints } } ddalpha <- .estimate_moments(ddalpha) for (i in 1:ddalpha$numPatterns){ ddalpha$patterns[[i]]$depths <- .Mahalanobis_depths(ddalpha, ddalpha$patterns[[i]]$points) } return(ddalpha) } .Mahalanobis_depths <- function(ddalpha, objects){ depths <- NULL for (j in 1:ddalpha$numPatterns){ depths <- cbind(depths, .Mahalanobis_depth (objects, center = ddalpha$patterns[[j]]$center, sigma = ddalpha$patterns[[j]]$sigma)) } return (depths) } .Mahalanobis_depth <- function(points, center = colMeans(points), sigma = solve(cov(points))){ if (is.data.frame(points)) points <- as.matrix(points, drop = F) if(is.vector(points)) points <- t(as.matrix(points, drop = F)) if (!is.matrix(points)) stop("Wrong format of 'points'") i = 1; step = 200 d <- NULL while (i<=nrow(points)){ tmp1 <- t(t(points[i:min(i+step, nrow(points)),, drop = F]) - center) dd <- diag(tmp1 %*% sigma %*% t(tmp1)) d <- c(d,1/(1 + dd)) i = i+1+step } # d <- 1/(1 + (points - center) %*% sigma %*% t(points - center)) return (d) } .projection_space <- function(ddalpha){ points <- NULL cardinalities <- NULL for (i in 1:ddalpha$numPatterns){ points <- rbind(points, ddalpha$patterns[[i]]$points) cardinalities <- c(cardinalities, ddalpha$patterns[[i]]$cardinality) } if (ddalpha$dmethod == "random"){ x <- as.vector(t(points)) y <- as.vector(t(points)) c <- as.vector(cardinalities) k <- ddalpha$numDirections result <- .C("ProjectionDepth", as.double(x), as.double(y), as.integer(nrow(points)), as.integer(ncol(points)), as.integer(c), as.integer(ddalpha$numPatterns), dirs=double(k*ncol(points)), prjs=double(k*nrow(points)), as.integer(k), as.integer(1), as.integer(ddalpha$seed), dspc=double(ddalpha$numPatterns*nrow(points))) return (list(dspace=matrix(result$dspc, nrow=nrow(points), ncol=ddalpha$numPatterns, byrow=TRUE), directions=result$dirs, projections=result$prjs)) } if (ddalpha$dmethod == "linearize"){ depths <- NULL for (i in 1:ddalpha$numPatterns){ ds <- .zdepth(ddalpha$patterns[[i]]$points, points) depths <- cbind(depths, ds) } return (list(dspace=depths)) } } .projection_depths <- function(ddalpha, objects){ points <- NULL cardinalities <- NULL for (i in 1:ddalpha$numPatterns){ points <- rbind(points, ddalpha$patterns[[i]]$points) cardinalities <- c(cardinalities, ddalpha$patterns[[i]]$cardinality) } if (ddalpha$dmethod == "random"){ x <- as.vector(t(points)) y <- as.vector(t(objects)) c <- as.vector(cardinalities) k <- ddalpha$numDirections result <- .C("ProjectionDepth", as.double(x), as.double(y), as.integer(nrow(objects)), as.integer(ncol(points)), as.integer(c), as.integer(ddalpha$numPatterns), as.double(ddalpha$directions), as.double(ddalpha$projections), as.integer(k), as.integer(0), as.integer(ddalpha$seed), depths=double(ddalpha$numPatterns*nrow(objects))) return (matrix(result$depths, nrow=nrow(objects), ncol=ddalpha$numPatterns, byrow=TRUE)) } if (ddalpha$dmethod == "linearize"){ depths <- NULL for (i in 1:ddalpha$numPatterns){ ds <- .zdepth(ddalpha$patterns[[i]]$points, objects) depths <- cbind(depths, ds) } return (depths) } } .simplicialVolume_depths <- function(ddalpha, objects){ if (is.data.frame(objects)) objects = as.matrix(objects) depths <- NULL for (i in 1:ddalpha$numPatterns){ pattern <- ddalpha$patterns[[i]]$points points <- as.vector(t(pattern)) x <- as.vector(t(objects)) if (ddalpha$d_useCov == 0){ covEst <- diag(ncol(pattern)) } else if (ddalpha$d_useCov == 1){ covEst <- cov(pattern) } else if (ddalpha$d_useCov == 2){ covEst <- covMcd(pattern, ddalpha$d_parMcd)$cov } ds <- .C("OjaDepth", as.double(points), as.double(x), as.integer(nrow(pattern)), as.integer(nrow(objects)), as.integer(ncol(pattern)), as.integer(ddalpha$seed), as.integer(ddalpha$d_exact), as.integer(.longtoint(ddalpha$d_k)), as.integer(ddalpha$d_useCov), as.double(as.vector(t(covEst))), depths=double(nrow(objects)))$depths depths <- cbind(depths, ds, deparse.level = 0) } return (depths) } .simplicial_depths <- function(ddalpha, objects){ if (is.data.frame(objects)) objects = as.matrix(objects) depths <- NULL for (i in 1:ddalpha$numPatterns){ pattern <- ddalpha$patterns[[i]]$points points <- as.vector(t(pattern)) x <- as.vector(t(objects)) ds <- .C("SimplicialDepth", as.double(points), as.double(x), as.integer(nrow(pattern)), as.integer(nrow(objects)), as.integer(ncol(pattern)), as.integer(ddalpha$seed), as.integer(ddalpha$d_exact), as.integer(.longtoint(ddalpha$d_k)), depths=double(nrow(objects)))$depths depths <- cbind(depths, ds, deparse.level = 0) } return (depths) } .spatial_learn <- function(ddalpha){ if (ddalpha$mahEstimate == "none"){ for (i in 1:ddalpha$numPatterns){ ddalpha$patterns[[i]]$center <- colMeans(ddalpha$patterns[[i]]$points) ddalpha$patterns[[i]]$cov <- NA } }else{ ddalpha <- .estimate_moments(ddalpha) } for (i in 1:ddalpha$numPatterns){ ddalpha$patterns[[i]]$depths <- .spatial_depths(ddalpha, ddalpha$patterns[[i]]$points) } return(ddalpha) } .spatialLocal_learn <- function(ddalpha){ ddalpha <- .estimate_moments(ddalpha) for (i in 1:ddalpha$numPatterns){ ddalpha$patterns[[i]]$depths <- .spatialLocal_depths(ddalpha, ddalpha$patterns[[i]]$points) } return(ddalpha) } .spatial_depths <- function(ddalpha, objects){ if (is.data.frame(objects)) objects = as.matrix(objects) depths <- NULL for (i in 1:ddalpha$numPatterns){ pattern <- ddalpha$patterns[[i]]$points mean <- ddalpha$patterns[[i]]$center cov <- ddalpha$patterns[[i]]$cov #suppressWarnings( if(sum(is.na(cov)) == 0){ cov.eig <- eigen(cov) B <- cov.eig$vectors %*% diag(sqrt(cov.eig$values)) lambda <- solve(B) } else{ lambda = diag(ncol(pattern)) }#) ds <- rep(-1, nrow(objects)) for (i in 1:nrow(objects)){ tmp1 <- t(lambda %*% (objects[i,] - t(pattern))) tmp1 <- tmp1[which(rowSums(tmp1) != 0),] tmp2 <- 1/sqrt(rowSums(tmp1^2)) ds[i] <- 1 - sqrt(sum((colSums(tmp2*tmp1)/nrow(pattern))^2)) } depths <- cbind(depths, ds) } return (depths) } .spatialLocal_depths <- function(ddalpha, objects){ depths <- NULL for (i in 1:ddalpha$numPatterns){ depths <- cbind(depths, depth.spatial.local(objects, ddalpha$patterns[[i]]$points, ddalpha$kernel.bandwidth[i])) } return (depths) } .NONE_depths <- function(ddalpha, objects){ depths <- matrix(0, ncol = ddalpha$numPatterns, nrow = nrow(objects)) return (depths) } #========================================================== .alpha_learnOLD <- function(maxDegree, data, numClass1, numClass2, numChunks, debug = F){ points <- as.vector(t(data)) numPoints <- numClass1 + numClass2 dimension <- ncol(data) cardinalities <- c(numClass1, numClass2) upToPower <- maxDegree minFeatures <- 2 maxExtDimension <- (factorial(dimension + maxDegree) / (factorial(dimension)*factorial(maxDegree))) - 1; p <- .C("AlphaLearnCV", as.double(points), as.integer(numPoints), as.integer(dimension), as.integer(cardinalities), as.integer(upToPower), as.integer(numChunks), as.integer(minFeatures), as.integer(debug), portrait=double(maxExtDimension + 1))$portrait degree <- p[1]; extDimension <- (factorial(dimension + degree) / (factorial(dimension)*factorial(degree))) - 1; d <- 0 for (i in 2:(extDimension + 1)){ if (p[i] != 0){ d <- d + 1 } } return(list(por=p,dim=d,deg=degree)) } .parse.methods <- function(methods){ if (!is.vector(methods) || length(methods) <= 0){return(list())} methods.refined <- unique(toupper(methods)) treatments.settings <- list() counter <- 1 for (i in 1:length(methods.refined)){ supported <- FALSE if (methods.refined[i] == "LDA"){ supported <- TRUE treatment.settings <- structure( list(name = "LDA", method = "LDA", priors = NULL, lda = NULL), .Names = c("name", "method", "priors", "lda")) } if (methods.refined[i] == "QDA"){ supported <- TRUE treatment.settings <- structure( list(name = "QDA", method = "QDA", priors = NULL, qda = NULL)) } if (methods.refined[i] == "KNNAFF"){ supported <- TRUE treatment.settings <- structure( list(name = "KNNAff", method = "KNNAff", knnAff.methodAggregation = "majority", knnAff.range = -1, knnAff.k = -1, knnAff.classifiers = NULL), .Names = c("name", "method", "knnAff.methodAggregation", "knnAff.range", "knnAff.k", "knnAff.classifiers")) } if (methods.refined[i] == "KNN"){ supported <- TRUE treatment.settings <- structure( list(name = "KNN", method = "KNN", knn.range = -1, knn.k = -1, knn.train = NULL, knn.cl = NULL), .Names = c("name", "method", "knn.range", "knn.k", "knn.train", "knn.cl")) } if (methods.refined[i] == "DEPTH.MAHALANOBIS"){ supported <- TRUE treatment.settings <- structure( list(name = "depth.Mahalanobis", method = "depth.Mahalanobis", mah.estimate = "moment", priors = NULL, mah.classes = NULL, mcd.alpha = 0.5), .Names = c("name", "method", "mah.estimate", "priors", "mah.classes", "mcd.alpha")) } if (methods.refined[i] == "RANDEQUAL"){ supported <- TRUE treatment.settings <- structure( list(name = "RandEqual", method = "RandEqual"), .Names = c("name", "method")) } if (methods.refined[i] == "RANDPROP"){ supported <- TRUE treatment.settings <- structure( list(name = "RandProp", method = "RandProp", priors = NULL), .Names = c("name", "method", "priors")) } if (methods.refined[i] == "IGNORE"){ supported <- TRUE treatment.settings <- structure( list(name = "Ignore", method = "Ignore"), .Names = c("name", "method")) } if (supported){ treatments.settings[[counter]] <- treatment.settings counter <- counter + 1 } } return(treatments.settings) } .parse.settings <- function(ddalpha, settings){ if (!is.list(settings) || length(settings) <= 0){return(list())} treatments.names <- c() treatments.settings <- list() counter <- 1 for (i in 1:length(settings)){ supported <- FALSE if (!is.list(settings[[i]]) || is.null(settings[[i]]$name) || is.null(settings[[i]]$method)){ warning("In treatment number ", i, ": The treatment has unacceptable format. The treatment will be ignored") next } if (!is.character(settings[[i]]$method) || length(settings[[i]]$method) != 1 || !(toupper(settings[[i]]$method) %in% ddalpha$treatments)){ warning("In treatment number ", i, ": The method name of the treatment is not acceptable. The treatment will be ignored") next } if (!is.character(settings[[i]]$name) || length(settings[[i]]$name) != 1){ warning("In treatment number ", i, ": The name of the treatment is not acceptable. The treatment will be ignored") next } if (settings[[i]]$name %in% treatments.names){ warning("In treatment number ", i, ": Treatment with the name ", settings[[i]]$name, " already exists. The treatment will be ignored") next }else{ treatments.names <- c(treatments.names, settings[[i]]$name) } if (toupper(settings[[i]]$method) == "LDA"){ tmp.name <- settings[[i]]$name if (!is.vector(settings[[i]]$priors, mode = "double") || is.na(min(settings[[i]]$priors)) || length(settings[[i]]$priors) != ddalpha$numPatterns || min(settings[[i]]$priors) <= 0 || max(settings[[i]]$priors) <= 0){ warning("In treatment number ", i, ": Argument \"priors\" not specified correctly. Defaults in the form of class portions are applied") tmp.priors <- NULL }else{ tmp.priors <- settings[[i]]$priors/sum(settings[[i]]$priors) } treatment.settings <- structure( list(name = tmp.name, method = "LDA", priors = tmp.priors, lda = NULL), .Names = c("name", "method", "priors", "lda")) supported <- TRUE } if (toupper(settings[[i]]$method) == "KNNAFF"){ tmp.name <- settings[[i]]$name if (!is.character(settings[[i]]$knnAff.methodAggregation) || length(settings[[i]]$knnAff.methodAggregation) != 1 || !(settings[[i]]$knnAff.methodAggregation %in% c("majority", "sequent"))){ warning("In treatment number ", i, ": Argument \"knnAff.methodAggregation\" not specified correctly. \"majority\" is used as a default value") tmp.knnAff.methodAggregation <- "majority" }else{ tmp.knnAff.methodAggregation <- settings[[i]]$knnAff.methodAggregation } if (!is.numeric(settings[[i]]$knnAff.range) || is.na(settings[[i]]$knnAff.range) || length(settings[[i]]$knnAff.range) != 1 || !.is.wholenumber(settings[[i]]$knnAff.range) || !(settings[[i]]$knnAff.range >= 2 && settings[[i]]$knnAff.range <= (ddalpha$patterns[[ddalpha$numPatterns]]$cardinality + ddalpha$patterns[[ddalpha$numPatterns - 1]]$cardinality - 1) || settings[[i]]$knnAff.range == -1)){ warning("In treatment number ", i, ": Argument \"knnAff.range\" not specified correctly. Defaults are applied") tmp.knnAff.range <- -1 }else{ tmp.knnAff.range <- settings[[i]]$knnAff.range } if (!is.numeric(settings[[i]]$knnAff.k) || is.na(settings[[i]]$knnAff.k) || length(settings[[i]]$knnAff.k) != 1 || !.is.wholenumber(settings[[i]]$knnAff.k) || !(settings[[i]]$knnAff.k >= 1 && settings[[i]]$knnAff.k <= (ddalpha$patterns[[ddalpha$numPatterns]]$cardinality + ddalpha$patterns[[ddalpha$numPatterns - 1]]$cardinality) || settings[[i]]$knnAff.k == -1)){ warning("In treatment number ", i, ": Argument \"knnAff.k\" not specified correctly. Defaults are applied") tmp.knnAff.k <- -1 }else{ tmp.knnAff.k <- settings[[i]]$knnAff.k } treatment.settings <- structure( list(name = tmp.name, method = "KNNAff", knnAff.methodAggregation = tmp.knnAff.methodAggregation, knnAff.range = tmp.knnAff.range, knnAff.k = tmp.knnAff.k, knnAff.classifiers = NULL), .Names = c("name", "method", "knnAff.methodAggregation", "knnAff.range", "knnAff.k", "knnAff.classifiers")) supported <- TRUE } if (toupper(settings[[i]]$method) == "KNN"){ tmp.name <- settings[[i]]$name if (!is.numeric(settings[[i]]$knn.range) || is.na(settings[[i]]$knn.range) || length(settings[[i]]$knn.range) != 1 || !.is.wholenumber(settings[[i]]$knn.range) || !(settings[[i]]$knn.range >= 2 && settings[[i]]$knn.range <= (ddalpha$numPoints - 1) || settings[[i]]$knn.range == -1)){ warning("In treatment number ", i, ": Argument \"knn.range\" not specified correctly. Defaults are applied") tmp.knn.range <- -1 }else{ tmp.knn.range <- settings[[i]]$knn.range } if (!is.numeric(settings[[i]]$knn.k) || is.na(settings[[i]]$knn.k) || length(settings[[i]]$knn.k) != 1 || !.is.wholenumber(settings[[i]]$knn.k) || !(settings[[i]]$knn.k >= 1 && settings[[i]]$knn.k <= (ddalpha$numPoints) || settings[[i]]$knn.k == -1)){ warning("In treatment number ", i, ": Argument \"knn.k\" not specified correctly. Defaults are applied") tmp.knn.k <- -1 }else{ tmp.knn.k <- settings[[i]]$knn.k } treatment.settings <- structure( list(name = tmp.name, method = "KNN", knn.range = tmp.knn.range, knn.k = tmp.knn.k, knn.train = NULL, knn.cl = NULL), .Names = c("name", "method", "knn.range", "knn.k", "knn.train", "knn.cl")) supported <- TRUE } if (toupper(settings[[i]]$method) == "DEPTH.MAHALANOBIS"){ tmp.name <- settings[[i]]$name if (!is.character(settings[[i]]$mah.estimate) || length(settings[[i]]$mah.estimate) != 1 || !(settings[[i]]$mah.estimate %in% c("moment", "MCD"))){ warning("In treatment number ", i, ": Argument \"mah.estimate\" not specified correctly. \"moment\" is used as a default value") tmp.mah.estimate <- "moment" }else{ tmp.mah.estimate <- settings[[i]]$mah.estimate } if (!is.vector(settings[[i]]$priors, mode = "double") || is.na(min(settings[[i]]$priors)) || length(settings[[i]]$priors) != ddalpha$numPatterns || min(settings[[i]]$priors) <= 0 || max(settings[[i]]$priors) <= 0){ warning("In treatment number ", i, ": Argument \"priors\" not specified correctly. Defaults in the form of class portions are applied") tmp.priors <- NULL }else{ tmp.priors <- settings[[i]]$priors/sum(settings[[i]]$priors) } if (!is.vector(settings[[i]]$mcd.alpha, mode = "double") || is.na(min(settings[[i]]$mcd.alpha)) || length(settings[[i]]$mcd.alpha) != 1 || settings[[i]]$mcd.alpha < 0.5 || settings[[i]]$mcd.alpha > 1){ if (tmp.mah.estimate == "MCD"){ warning("In treatment number ", i, ": Argument \"mcd.alpha\" not specified correctly. 0.75 is used as a default value") } tmp.mcd.alpha <- 0.75 }else{ tmp.mcd.alpha <- settings[[i]]$mcd.alpha } treatment.settings <- structure( list(name = tmp.name, method = "depth.Mahalanobis", mah.estimate = tmp.mah.estimate, priors = tmp.priors, mah.classes = NULL, mcd.alpha = tmp.mcd.alpha), .Names = c("name", "method", "mah.estimate", "priors", "mah.classes", "mcd.alpha")) supported <- TRUE } if (toupper(settings[[i]]$method) == "RANDEQUAL"){ tmp.name <- settings[[i]]$name treatment.settings <- structure( list(name = tmp.name, method = "RandEqual"), .Names = c("name", "method")) supported <- TRUE } if (toupper(settings[[i]]$method) == "RANDPROP"){ tmp.name <- settings[[i]]$name if (!is.vector(settings[[i]]$priors, mode = "double") || is.na(min(settings[[i]]$priors)) || length(settings[[i]]$priors) != ddalpha$numPatterns || min(settings[[i]]$priors) <= 0 || max(settings[[i]]$priors) <= 0){ warning("In treatment number ", i, ": Argument \"priors\" not specified correctly. Defaults in the form of class portions are applied") tmp.priors <- NULL }else{ tmp.priors <- settings[[i]]$priors/sum(settings[[i]]$priors) } treatment.settings <- structure( list(name = tmp.name, method = "RandProp", priors = NULL), .Names = c("name", "method", "priors")) supported <- TRUE } if (toupper(settings[[i]]$method) == "IGNORE"){ tmp.name <- settings[[i]]$name treatment.settings <- structure( list(name = tmp.name, method = "Ignore"), .Names = c("name", "method")) supported <- TRUE } if (supported){ treatments.settings[[counter]] <- treatment.settings counter <- counter + 1 } } return (treatments.settings) } .lda_learn <- function(ddalpha, settings){ settings$lda <- MASS::lda(formula=as.formula("CLASS ~ ."), data=ddalpha$raw, priors=settings$priors) settings$priors <- settings$lda$prior return (settings) } .lda_classify <- function(objects, ddalpha, settings){ if (!is.data.frame(objects)) objects = as.data.frame(objects) names(objects) <- names(ddalpha$raw)[1:ncol(objects)] return (as.list(predict(settings$lda, objects)$class)) } .qda_learn <- function(ddalpha, settings){ settings$qda <- MASS::qda(formula=as.formula("CLASS ~ ."), data=ddalpha$raw, priors=settings$priors) settings$priors <- settings$qda$prior return (settings) } .qda_classify <- function(objects, ddalpha, settings){ if (!is.data.frame(objects)) objects = as.data.frame(objects) names(objects) <- names(ddalpha$raw)[1:ncol(objects)] return (as.list(predict(settings$qda, objects)$class)) } .knnAff_learn <- function(ddalpha, settings){ counter <- 1 # Determining multi-class behaviour if (settings$knnAff.methodAggregation == "majority"){ for (i in 1:(ddalpha$numPatterns - 1)){ for (j in (i + 1):ddalpha$numPatterns){ # Creating a classifier classifier.index <- counter classifier.index1 <- i classifier.index2 <- j classifier.points <- as.double(t(rbind(ddalpha$patterns[[i]]$points, ddalpha$patterns[[j]]$points))) classifier.cardinalities <- as.integer(c(ddalpha$patterns[[i]]$cardinality, ddalpha$patterns[[j]]$cardinality)) if (settings$knnAff.k < 1 || settings$knnAff.k > (ddalpha$patterns[[i]]$cardinality + ddalpha$patterns[[j]]$cardinality - 1)) { if (settings$knnAff.range < 2 || settings$knnAff.range > (ddalpha$patterns[[i]]$cardinality + ddalpha$patterns[[j]]$cardinality - 1)){ maxk <- 10*( (ddalpha$numPoints)^(1/ddalpha$dimension) ) + 1 }else{ maxk <- settings$knnAff.range } maxk <- min(maxk, ddalpha$patterns[[i]]$cardinality + ddalpha$patterns[[j]]$cardinality - 1) maxk <- max(maxk, 2) classifier.range <- maxk classifier.k <- as.integer(.C("KnnAffInvLearnJK", classifier.points, as.integer(ddalpha$dimension), classifier.cardinalities, as.integer(maxk), k=integer(1))$k) }else{ classifier.range <- settings$knnAff.range classifier.k <- as.integer(settings$knnAff.k) } # Adding the classifier to the list of classifiers settings$knnAff.classifiers[[counter]] <- list(index = classifier.index, index1 = classifier.index1, index2 = classifier.index2, points = classifier.points, cardinalities = classifier.cardinalities, k = classifier.k, range = classifier.range) counter <- counter + 1 } } } if (settings$knnAff.methodAggregation == "sequent"){ for (i in 1:ddalpha$numPatterns){ anotherClass <- NULL for (j in 1:ddalpha$numPatterns){ if (j != i){ anotherClass <- rbind(anotherClass, ddalpha$patterns[[j]]$points) } } classifier.index <- counter classifier.index1 <- i classifier.index2 <- -1 classifier.points <- as.double(t(rbind(ddalpha$patterns[[i]]$points, anotherClass))) classifier.cardinalities <- as.integer(c(ddalpha$patterns[[i]]$cardinality, nrow(anotherClass))) if (settings$knnAff.k < 1 || settings$knnAff.k > ddalpha$numPoints) { if (settings$knnAff.range < 2 || settings$knnAff.range > (ddalpha$numPoints - 1)){ maxk <- 10*( (ddalpha$numPoints)^(1/ddalpha$dimension) ) + 1 }else{ maxk <- settings$knnAff.range } maxk <- min(maxk, ddalpha$numPoints - 1) maxk <- max(maxk, 2) classifier.range <- maxk classifier.k <- as.integer(.C("KnnAffInvLearnJK", classifier.points, as.integer(ddalpha$dimension), classifier.cardinalities, as.integer(maxk), k=integer(1))$k) }else{ classifier.range <- settings$knnAff.range classifier.k <- as.integer(settings$knnAff.k) } # Adding the classifier to the list of classifiers settings$knnAff.classifiers[[counter]] <- list(index = classifier.index, index1 = classifier.index1, index2 = classifier.index2, points = classifier.points, cardinalities = classifier.cardinalities, k = classifier.k, range = classifier.range) counter <- counter + 1 } } return (settings) } .knnAff_classify <- function(objects, ddalpha, settings){ # Correct input data if (!is.matrix(objects)){ objects <- matrix(objects, nrow=1) } # Initialization of the vote array votes <- matrix(rep(0, nrow(objects)*ddalpha$numPatterns), nrow=nrow(objects), ncol=ddalpha$numPatterns) for (i in 1:length(settings$knnAff.classifiers)){ res <- .C("KnnAffInvClassify", as.double(t(objects)), as.integer(nrow(objects)), settings$knnAff.classifiers[[i]]$points, as.integer(ddalpha$dimension), settings$knnAff.classifiers[[i]]$cardinalities, settings$knnAff.classifiers[[i]]$k, output=integer(nrow(objects)))$output for (j in 1:nrow(objects)){ if (res[j] == 0){ votes[j,settings$knnAff.classifiers[[i]]$index1] <- votes[j,settings$knnAff.classifiers[[i]]$index1] + 1 }else{ votes[j,settings$knnAff.classifiers[[i]]$index2] <- votes[j,settings$knnAff.classifiers[[i]]$index2] + 1 } } } # Collect results results <- list() for (i in 1:nrow(objects)){ results[[i]] <- ddalpha$patterns[[which.max(votes[i,])]]$name } return (results) } .knn_learn <- function(ddalpha, settings){ settings$knn.train <- ddalpha$raw[,1:ddalpha$dimension] settings$knn.cl <- ddalpha$raw[,ddalpha$dimension + 1] if (settings$knn.k < 1 || settings$knn.k > ddalpha$numPoints){ if (settings$knn.range < 1 || settings$knn.range > ddalpha$numPoints - 1){ settings$knn.range <- 10*( (ddalpha$numPoints)^(1/ddalpha$dimension) ) + 1 settings$knn.range <- min(settings$knn.range, ddalpha$numPoints - 1) settings$knn.range <- max(settings$knn.range, 2) } cv.err <- c() ks <- 1:settings$knn.range for (i in ks){ newpre <- as.vector(class::knn.cv(settings$knn.train, settings$knn.cl, k = i)) cv.err <- c(cv.err, sum(settings$knn.cl != newpre)) } settings$knn.k <- ks[which.min(cv.err)] } return (settings) } .knn_classify <- function(objects, ddalpha, settings){ return (class::knn(settings$knn.train, objects, settings$knn.cl, settings$knn.k)) } .mah_learn <- function(ddalpha, settings){ settings$mah.classes <- list() if (is.null(settings$priors)){ settings$priors <- c() for (i in 1:ddalpha$numPatterns){ settings$priors[i] <- ddalpha$patterns[[i]]$cardinality/ddalpha$numPoints } } for (i in 1:ddalpha$numPatterns){ class.prior <- NULL class.mean <- NULL class.cov <- NULL class.sigma <- NULL class.prior <- settings$priors[i] if (settings$mah.estimate == "moment"){ class.mean <- colMeans(ddalpha$patterns[[i]]$points) class.cov <- cov(ddalpha$patterns[[i]]$points) class.sigma <- solve(class.cov) } if (settings$mah.estimate == "MCD"){ estimate <- robustbase::covMcd(ddalpha$patterns[[i]]$points, alpha=settings$mcd.alpha) class.mean <- estimate$center class.cov <- estimate$cov class.sigma <- solve(class.cov) } settings$mah.classes[[i]] <- structure( list(index = i, prior = class.prior, mean = class.mean, cov = class.cov, sigma = class.sigma), .Names = c("index", "prior", "mean", "cov", "sigma")) } return (settings) } .mah_classify <- function(objects, ddalpha, settings){ # Correct input data if (!is.matrix(objects)){ objects <- matrix(objects, nrow=1) } # Initialization of the vote array votes <- matrix(rep(0, nrow(objects)*ddalpha$numPatterns), nrow=nrow(objects), ncol=ddalpha$numPatterns) for (i in 1:nrow(objects)){ for (j in 1:length(settings$mah.classes)){ votes[i,j] <- settings$mah.classes[[j]]$prior*.Mahalanobis_depth(objects[i,], settings$mah.classes[[j]]$mean, settings$mah.classes[[j]]$sigma) } } # Collect results results <- list() for (i in 1:nrow(objects)){ results[[i]] <- ddalpha$patterns[[which.max(votes[i,])]]$name } return (results) } .ignore_classify <- function(nobjects){ return (as.list(rep("Ignored", nobjects))) } .right_classify <- function(nobjects){ return (as.list(rep("Outsider", nobjects))) } .randequal_classify <- function(nobjects, ddalpha){ results <- list() for (i in 1:nobjects){ results[[i]] <- ddalpha$patterns[[sample(1:ddalpha$numPatterns,1)]]$name } return (results) } .randprop_classify <- function(nobjects, ddalpha, settings){ priors <- settings$priors if (is.null(priors)){ priors <- c() for (i in 1:ddalpha$numPatterns){ priors[i] <- ddalpha$patterns[[i]]$cardinality/ddalpha$numPoints } } results <- list() for (i in 1:nobjects){ results[[i]] <- ddalpha$patterns[[sample(1:ddalpha$numPatterns,1,prob = priors)]]$name } return (results) } # Function is taken from the R-documentation, "Examples" to the function "is.integer" .is.wholenumber <- function(x, tol = .Machine$double.eps^0.5) abs(x - round(x)) < tol summary.ddalpha <- function(object, printseparators = T, ...){ x = object if(!is.null(x$call)){ cat("Call: ", format(x$call), "\nResulting table: ", paste(x$colnames, collapse = ", "),"\n") } cat("ddalpha:\n") cat("\t num.points = ", x$numPoints, ", dimension = ", x$dimension, ", num.patterns = ", x$numPatterns, "\n", sep="") cat("\t depth = \"", x$methodDepth, "\"\n", sep="") cat("\t separator = \"", x$methodSeparator, "\"\n", sep="") cat("\t aggregation.method = \"", x$methodAggregation, "\"\n", sep="") if (is.numeric(x$numChunks)) cat("\t num.chunks =", x$numChunks, "\n") if (is.numeric(x$numDirections)) cat("\t num.directions =", x$numDirections, "\n") cat("\t use.convex =", x$useConvex, "\n") if (is.numeric(x$maxDegree)) cat("\t max.degree =", x$maxDegree, "\n") cat("patterns:\n") for (i in 1:length(x$patterns)){ cat("\t ");print(x$patterns[[i]]) } cat("num.classifiers = ", x$numClassifiers, "\n") if(x$numClassifiers == 1 || printseparators) for (i in 1:x$numClassifiers){ print(x$classifiers[[i]], prefix = "\t ") } cat("outsider.methods:\n") if (is.null(x$methodsOutsider)){ cat ("\t Absent\n", sep="") }else{ for (i in 1:length(x$methodsOutsider)){ cat ("\t \"",x$methodsOutsider[[i]]$name, "\":\n", sep="") cat("\t\t method = \"", x$methodsOutsider[[i]]$method, "\"\n", sep="") if ( x$methodsOutsider[[i]]$method == "LDA" || x$methodsOutsider[[i]]$method == "RandProp" || x$methodsOutsider[[i]]$method == "depth.Mahalanobis"){ cat("\t\t priors =", x$methodsOutsider[[i]]$priors, "\n") } if (x$methodsOutsider[[i]]$method == "KNNAff"){ cat("\t\t aggregation.method = \"", x$methodsOutsider[[i]]$knnAff.methodAggregation, "\"\n", sep="") for (j in 1:length(x$methodsOutsider[[i]]$knnAff.classifiers)){ cat("\t\t k.range = ", format(paste("1:", x$methodsOutsider[[i]]$knnAff.classifiers[[j]]$range, sep=""), justify="right", width=10), sep="") } cat("\n") for (j in 1:length(x$methodsOutsider[[i]]$knnAff.classifiers)){ cat("\t\t k = ", format( x$methodsOutsider[[i]]$knnAff.classifiers[[j]]$k, justify="right", width=10), sep="") } cat("\n") } if (x$methodsOutsider[[i]]$method == "KNN"){ cat("\t\t k.range = 1:", x$methodsOutsider[[i]]$knn.range, "\n", sep="") cat("\t\t k =", x$methodsOutsider[[i]]$knn.k, "\n") } if (x$methodsOutsider[[i]]$method == "depth.Mahalanobis"){ cat("\t\t estimate = \"", x$methodsOutsider[[i]]$mah.estimate, "\"\n", sep="") if (x$methodsOutsider[[i]]$mah.estimate == "MCD"){ cat("\t\t mcd.alpha = ", x$methodsOutsider[[i]]$mcd.alpha, "\n") } } } } invisible(x) } print.ddalpha <- function(x, printseparators = F, ...){ if(!is.null(x$call)){ cat("Call: ", format(x$call), "\nResulting table: ", paste(x$colnames, collapse = ", "),"\n") } cat("depth = \"", x$methodDepth, "\"\n", sep="") cat("separator = \"", x$methodSeparator, "\"\n", sep="") cat("aggregation.method = \"", x$methodAggregation, "\"\n", sep="") cat("patterns:\n") for (i in 1:length(x$patterns)){ cat("\t ");print(x$patterns[[i]]) } cat("num.classifiers = ", x$numClassifiers, "\n") if(x$numClassifiers == 1 || printseparators) for (i in 1:x$numClassifiers){ print(x$classifiers[[i]], prefix = "\t ", full = F) } cat("outsider.methods:\n") if (is.null(x$methodsOutsider)){ cat ("\t Absent\n", sep="") }else{ for (i in 1:length(x$methodsOutsider)){ cat("\t method = \"", x$methodsOutsider[[i]]$method, "\"\n", sep="") if ( x$methodsOutsider[[i]]$method == "LDA" || x$methodsOutsider[[i]]$method == "RandProp" || x$methodsOutsider[[i]]$method == "depth.Mahalanobis"){ cat("\t priors =", x$methodsOutsider[[i]]$priors, "\n") } if (x$methodsOutsider[[i]]$method == "KNNAff"){ cat("\t aggregation.method = \"", x$methodsOutsider[[i]]$knnAff.methodAggregation, "\"\n", sep="") for (j in 1:length(x$methodsOutsider[[i]]$knnAff.classifiers)){ cat("\t k.range = ", format(paste("1:", x$methodsOutsider[[i]]$knnAff.classifiers[[j]]$range, sep=""), justify="right", width=10), sep="") } cat("\n") for (j in 1:length(x$methodsOutsider[[i]]$knnAff.classifiers)){ cat("\t k = ", format( x$methodsOutsider[[i]]$knnAff.classifiers[[j]]$k, justify="right", width=10), sep="") } cat("\n") } if (x$methodsOutsider[[i]]$method == "KNN"){ cat("\t k.range = 1:", x$methodsOutsider[[i]]$knn.range, "\n", sep="") cat("\t k =", x$methodsOutsider[[i]]$knn.k, "\n") } if (x$methodsOutsider[[i]]$method == "depth.Mahalanobis"){ cat("\t estimate = \"", x$methodsOutsider[[i]]$mah.estimate, "\"\n", sep="") if (x$methodsOutsider[[i]]$mah.estimate == "MCD"){ cat("\t mcd.alpha = ", x$methodsOutsider[[i]]$mcd.alpha, "\n") } } } } invisible(x) } print.ddalpha.pattern <- function(x, ...){ cat("pattern[", x$index, "]:", sep="") cat("\t ", x$cardinality, " points, label = \"", x$name, "\"\n", sep="") invisible(x) } print.ddalpha.alpha <- function(x, prefix = "", full = T, ...){ if(full){ cat(prefix,x$index, ". alpha:\n", sep="") cat(prefix," degree: ", x$degree,"; axes: ", x$index1, ", ", x$index2, "\n", sep="") cat(prefix," hyperplane: ", paste(x$hyperplane, collapse = ", "), "\n", sep="") } else{ cat(prefix, x$index, ". degree: ", x$degree,"; axes: ", x$index1, ", ", x$index2, "\n", sep="") cat(prefix," hyperplane: ", paste(x$hyperplane, collapse = ", "), "\n", sep="") } invisible(x) } print.ddalpha.polynomial <- function(x, prefix = "", full = T,...){ if(full){ cat(prefix,x$index, ". polynomial:\n", sep="") cat(prefix," degree: ", x$degree,"; axes: ", x$index1, ", ", x$index2, ifelse(x$axis!=0, ", invert", ""), "\n", sep="") cat(prefix," polynomial: ", paste(x$polynomial, collapse = ", "), "\n", sep="") } else { cat(prefix,x$index, ". degree: ", x$degree,"; axes: ", x$index1, ", ", x$index2, ifelse(x$axis!=0, ", invert", ""), "\n", sep="") cat(prefix," polynomial: ", paste(x$polynomial, collapse = ", "), "\n", sep="") } invisible(x) } print.ddalpha.knnlm <- function(x, prefix = "", full = T,...){ if(full) cat(prefix,"knnlm: k = ", x$knnK, "\n", sep="") else cat(prefix,"k = ", x$knnK, "\n", sep="") invisible(x) } print.ddalpha.maxD <- function(x, prefix = "", full = T,...){ if(full) cat(prefix,"maximum depth separator\n") invisible(x) } # .ddalpha.learn.knnlm <- function(ddalpha){ # # # Prepare outputs and distance matrix # y <- NULL # allPoints <- NULL # for (i in 1:ddalpha$numPatterns){ # allPoints<- rbind(allPoints, ddalpha$patterns[[i]]$depths) # y <- c(y, rep(ddalpha$patterns[[i]]$name, ddalpha$patterns[[i]]$cardinality)) # } # # print(y) # dists <- knn.dist(allPoints, dist.meth="maximum") # # plot(ddalpha$patterns[[1]]$depths, col = "red", xlim=c(0,1), ylim=c(0,1)) # # points(ddalpha$patterns[[2]]$depths, col = "blue", xlim=c(0,1), ylim=c(0,1)) # # Cross-validate knn # cvErr <- c() # allIndices <- 1:ddalpha$numPoints # krange <- 10*( (ddalpha$numPoints)^(1/ddalpha$numPatterns) ) + 1 # krange <- min(krange, ceiling(ddalpha$numPoints/2)) # if (ddalpha$numPatterns == 2){krange <- min(krange, 50)} # krange <- max(krange, 2) # # cat("Range: 1:", krange, ".\n", sep="") # for (i in 1:krange){ # curPreErr <- 0 # for (j in 0:(ddalpha$numChunks - 1)){ # testSel <- allIndices[allIndices%%ddalpha$numChunks == j] # test <- allIndices[testSel] # train <- allIndices[-test] # # cat("1. Train: ", train, ", test: ", test, ".\n") # curPreErr <- curPreErr + sum(knn.predict(train, test, y, dists, k=i, agg.meth="majority", ties.meth="first") != y[test]) # } # cvErr <- c(cvErr, curPreErr) # # cat("i = ", i, "done.\n") # # print(cvErr) # } # # Collect results # ddalpha$knnK <- (1:krange)[which.min(cvErr)] # ddalpha$knnX <- allPoints # ddalpha$knnY <- y # ddalpha$knnD <- dists # # # print(ddalpha$knnK) # # return (ddalpha) # } ddalpha/R/draw.ddplot.r0000644000176200001440000000673014550224255014467 0ustar liggesusersdraw.ddplot <- function(ddalpha, depth.space, cardinalities, main = "DD plot", xlab = "C1", ylab = "C2", xlim, ylim, classes = c(1,2), colors = c("red", "blue", "green"), drawsep = T){ if(!missing(ddalpha)){ col = c() points = NULL for (c in classes){ points = rbind(points, ddalpha$patterns[[c]]$depths[,classes]) col = c(col, rep(colors[c], ddalpha$patterns[[c]]$cardinality)) } if (!inherits(xlab, "expression") && !inherits(ylab, "expression") && xlab == "C1" && ylab == "C2"){ xlab = ddalpha$patterns[[1]]$name ylab = ddalpha$patterns[[2]]$name } if (missing(xlim)) xlim = c(0, max(points[,])) if (missing(ylim)) ylim = c(0, max(points[,])) plot(points, col = col, main = main, xlab = xlab, ylab = ylab, asp = T, xlim = xlim, ylim = ylim) if(drawsep && ddalpha$methodSeparator %in% c("alpha", "polynomial")) { gx <- seq(-0.1, 1.2*max(points[,1]), length=100) gy <- seq(0, 1.2*max(points[,2]), length=100) y <- as.matrix(expand.grid(x = gx, y = gy)) if (ddalpha$methodSeparator == "alpha") { ray = ddalpha$classifiers[[1]]$hyperplane[-1] funcs = list(function(x) x[1], function(x) x[2], function(x) x[1]^2, function(x) x[1]*x[2], function(x) x[2]^2, function(x) x[1]^3, function(x) x[1]^2*x[2], function(x) x[1]*x[2]^2, function(x) x[2]^3) depthcontours = apply(y, 1, function(xx) { res = 0 for(i in 1:ddalpha$classifiers[[1]]$dimProperties)(res = res+funcs[[i]](xx)*ray[i]) res }) } else if (ddalpha$methodSeparator == "polynomial"){ if (ddalpha$classifiers[[1]]$axis == 0){ xAxis <- ddalpha$classifiers[[1]]$index1 yAxis <- ddalpha$classifiers[[1]]$index2 }else{ xAxis <- ddalpha$classifiers[[1]]$index2 yAxis <- ddalpha$classifiers[[1]]$index1 } depthcontours = apply(y, 1, function(xx) { res = 0 for(j in 1:ddalpha$classifiers[[1]]$degree){res <- res + ddalpha$classifiers[[1]]$polynomial[j]*xx[xAxis]^j} res = res-xx[yAxis] }) } contour(gx, gy, matrix(depthcontours, nrow=length(gx), ncol=length(gy)), add=TRUE, levels=0, drawlabels=FALSE, col = "black") } } else if(!missing(depth.space)){ col = c() for (c in classes){ col = c(col, rep(colors[c], cardinalities[c])) } if (missing(xlim)) xlim = c(0, max(depth.space[,classes])) if (missing(ylim)) ylim = c(0, max(depth.space[,classes])) plot(depth.space[,classes], col = col, main = main, xlab = xlab, ylab = ylab, xlim = xlim, ylim = ylim) } else stop("Both 'ddalpha' and 'depth.space' area missing") } plot.ddalpha <- function(x, type = c("ddplot", "depth.contours"), ...){ type = match.arg(type) if(type == "ddplot") draw.ddplot(x, ...) if(type == "depth.contours") depth.contours.ddalpha(x, ...) } plot.ddalphaf <- function(x, type = c("functional.data", "ddplot", "depth.contours"), ...){ type = match.arg(type) if(type == "functional.data") plot.functional(list(dataf = x$dataf, labels = lapply(x$data[,ncol(x$data)], function(o){x$labels[[o]]})), ...) if(!inherits(x$classifier, "ddalpha")) stop(type, " is available only for the ddalpha classifier") if(type == "ddplot") draw.ddplot(x$classifier, ...) if(type == "depth.contours") depth.contours.ddalpha(x$classifier, ...) } ddalpha/R/depth.simplicial.r0000644000176200001440000000513414213423775015477 0ustar liggesusers################################################################################ # File: depth.simplicial.r # Created by: Oleksii Pokotylo # First published: 15.06.2015 # Last revised: 15.06.2015 # # Computation of the simplicial data depth. ################################################################################ depth.simplicial <- function(x, data, exact = F, k = 0.05, seed = 0){ if (seed!=0) set.seed(seed) if (!is.matrix(x) && is.vector(x)){ x <- matrix(x, nrow=1) } if (!(is.matrix(data) && is.numeric(data) || is.data.frame(data) && prod(sapply(data, is.numeric))) || ncol(data) < 2){ stop("Argument \"data\" should be a numeric matrix of at least 2-dimensional data") } if (!is.numeric(x)){ stop("Argument \"x\" should be numeric") } if (ncol(x) != ncol(data)){ stop("Dimensions of the arguments \"x\" and \"data\" should coincide") } if (ncol(data) + 1 > nrow(data)){ #? stop("To few data points") } if (!exact) if (k <= 0) stop("k must be positive") else if (k < 1) k = choose(nrow(data), ncol(data))*k points <- as.vector(t(data)) objects <- as.vector(t(x)) ds <- .C("SimplicialDepth", as.double(points), as.double(objects), as.integer(nrow(data)), as.integer(nrow(x)), as.integer(ncol(data)), as.integer(seed), as.integer(exact), as.integer(.longtoint(k)), depths=double(nrow(x)))$depths return (ds) } depth.space.simplicial <- function(data, cardinalities, exact = F, k = 0.05, seed = 0){ if (!(is.matrix(data) && is.numeric(data) || is.data.frame(data) && prod(sapply(data, is.numeric))) || ncol(data) < 2){ stop("Argument \"data\" should be a numeric matrix of at least 2-dimensional data") } if (!is.vector(cardinalities, mode = "numeric") || is.na(min(cardinalities)) || sum(.is.wholenumber(cardinalities)) != length(cardinalities) || min(cardinalities) <= 0 || sum(cardinalities) != nrow(data)){ stop("Argument \"cardinalities\" should be a vector of cardinalities of the classes in \"data\" ") } if (sum(cardinalities < ncol(data) + 1) != 0){ stop("Not in all classes sufficiently enough objetcs") } depth.space <- NULL for (i in 1:length(cardinalities)){ pattern <- data[(1 + sum(cardinalities[0:(i - 1)])):sum(cardinalities[1:i]),] pattern.depths <- depth.simplicial (data, pattern, exact, k, seed) depth.space <- cbind(depth.space, pattern.depths, deparse.level = 0) } return (depth.space) } ddalpha/R/depth.potential.r0000644000176200001440000002265514213423775015357 0ustar liggesusers.potentialKernelTypes <- c("EDKernel", "GKernel", "EKernel", "TriangleKernel", "VarGKernel") .potential_depths <- function(ddalpha, objects, class = 0){ if (ddalpha$ignoreself) stop("ignoreself not supported") # todo ignore only if objects were NULL, @ what class do the points belong to? when seperately scaled # count all potential on the untransformed data if (class == 0) { a = ddalpha$kernel.bandwidth data <- NULL cardinalities <- c() for (i in 1:ddalpha$numPatterns){ data <- rbind(data, ddalpha$patterns[[i]]$points) cardinalities <- c(cardinalities, ddalpha$patterns[[i]]$cardinality) } if (is.null(objects)) objects = data } # count potential w.r.t the given class else { a = ddalpha$kernel.bandwidth[class] data <- ddalpha$patterns[[class]]$transformer( ddalpha$patterns[[class]]$points ) cardinalities <- c(ddalpha$patterns[[class]]$cardinality) objects <- ddalpha$patterns[[class]]$transformer(objects) # if (is.null(objects)){ # for (i in (1:ddalpha$numPatterns)){ # objects <- rbind(objects, ddalpha$patterns[[i]]$points) # } # objects <- ddalpha$patterns[[class]]$transformer(objects) # } else { # ignoreself = F # } } kernelType = ddalpha$kernel if (is.character(kernelType)) kernelType = switch (kernelType, EDKernel = 1, GKernel = 2, EKernel = 3, TriangleKernel = 4, 1) points <- as.vector(t(data)) numPoints <- sum(cardinalities) dimension <- ncol(data) points2 <- as.vector(t(objects)) numPoints2 <- nrow(objects) classes <- length(cardinalities) depth <- .C("PotentialDepthsCount", as.double(points), as.integer(numPoints), as.integer(dimension), as.integer(classes), as.integer(cardinalities), as.double(points2), as.integer(numPoints2), as.integer(kernelType), as.double(a), as.integer(ddalpha$ignoreself), depth=double(numPoints2*classes))$depth d = as.matrix(depth) dim(d)<-c(numPoints2,classes) return(d) } .potential_depths_wrt <- function(ddalpha, objects_){ d <- NULL # w.r.t. each class for (cls in 1:ddalpha$numPatterns){ data <- ddalpha$patterns[[cls]]$transformer( ddalpha$patterns[[cls]]$points ) cardinalities <- c(ddalpha$patterns[[cls]]$cardinality) objects = objects_ if (is.null(objects_)) # count for all data for (i in 1:ddalpha$numPatterns){ objects <- rbind(objects, ddalpha$patterns[[i]]$points) } objects <- ddalpha$patterns[[cls]]$transformer(objects) kernelType = ddalpha$kernel if (is.character(kernelType)) kernelType = switch (kernelType, EDKernel = 1, GKernel = 2, EKernel = 3, TriangleKernel = 4, 1) points <- as.vector(t(data)) numPoints <- sum(cardinalities) dimension <- ncol(data) points2 <- as.vector(t(objects)) numPoints2 <- nrow(objects) classes <- length(cardinalities) depth <- .C("PotentialDepthsCount", as.double(points), as.integer(numPoints), as.integer(dimension), as.integer(classes), as.integer(cardinalities), as.double(points2), as.integer(numPoints2), as.integer(kernelType), as.double(ddalpha$kernel.bandwidth[cls]), as.integer(ddalpha$ignoreself), depth=double(numPoints2*classes))$depth d = cbind(d, depth) } return(d) } depth.potential <- function(x, data, pretransform = "1Mom", kernel = "GKernel", kernel.bandwidth = NULL, mah.parMcd = 0.75){ if (!is.numeric(x)){ stop("Argument \"x\" should be numeric") } if (!is.matrix(x)) { if(is.vector(x)) x <- matrix(x, nrow=1) if(is.data.frame(x)) x <- data.matrix(x) } if (!(is.matrix(data) && is.numeric(data) || is.data.frame(data) && prod(sapply(data, is.numeric))) || ncol(data) < 2){ stop("Argument \"data\" should be a numeric matrix of at least 2-dimensional data") } if(is.data.frame(data)) data <- data.matrix(data) if (ncol(x) != ncol(data)){ stop("Dimensions of the arguments \"x\" and \"data\" should coincide") } if (ncol(data) + 1 > nrow(data)){ #? stop("To few data points") } if(!is.null(pretransform)){ if (pretransform == "1Mom" || pretransform == "NMom") mm <- mah.moment(data) else if (pretransform == "1MCD" || pretransform == "NMCD") mm <- mah.mcd(data, mah.parMcd) transformer <- MahMomentTransformer(mm$mu, mm$b) data <- transformer(data) x <- transformer(x) } kernelType = kernel if (is.character(kernelType)) kernelType = switch (kernelType, EDKernel = 1, GKernel = 2, EKernel = 3, TriangleKernel = 4, 1) if (is.null(kernel.bandwidth)) { # use the rule of thumb kernel.bandwidth = nrow(data) ^ (-2/(ncol(data)+4)) } else{ if (length(kernel.bandwidth) != 1 || is.na(kernel.bandwidth) || kernel.bandwidth == 0) stop("Argument \"kernel.bandwidth\" has invaid format.") } points <- as.vector(t(data)) numPoints <- nrow(data) dimension <- ncol(data) points2 <- as.vector(t(x)) numPoints2 <- nrow(x) cardinalities = numPoints classes <- 1 ignoreself = F depth <- .C("PotentialDepthsCount", as.double(points), as.integer(numPoints), as.integer(dimension), as.integer(classes), as.integer(cardinalities), as.double(points2), as.integer(numPoints2), as.integer(kernelType), as.double(kernel.bandwidth), as.integer(ignoreself), depth=double(numPoints2*classes))$depth return(depth) } depth.space.potential <- function(data, cardinalities, pretransform = "NMom", kernel = "GKernel", kernel.bandwidth = NULL, mah.parMcd = 0.75){ if (!(is.matrix(data) && is.numeric(data) || is.data.frame(data) && prod(sapply(data, is.numeric))) || ncol(data) < 2){ stop("Argument \"data\" should be a numeric matrix of at least 2-dimensional data") } if(is.data.frame(data)) data <- data.matrix(data) if (!is.vector(cardinalities, mode = "numeric") || is.na(min(cardinalities)) || sum(.is.wholenumber(cardinalities)) != length(cardinalities) || min(cardinalities) <= 0 || sum(cardinalities) != nrow(data)){ stop("Argument \"cardinalities\" should be a vector of cardinalities of the classes in \"data\" ") } if (sum(cardinalities < ncol(data) + 1) != 0){ stop("Not in all classes sufficiently enough objetcs") } d <- NULL needtransform = F if (pretransform == "1Mom" || pretransform == "1MCD"){ if (pretransform == "1Mom") mm <- mah.moment(data) else # "1MCD" mm <- mah.mcd(data, mah.parMcd) transformer <- MahMomentTransformer(mm$mu, mm$b) data <- transformer(data) if (is.null(kernel.bandwidth)) { # use the rule of thumb kernel.bandwidth = nrow(data) ^ (-2/(ncol(data)+4)) } else{ if (length(kernel.bandwidth) != 1 || is.na(kernel.bandwidth) || kernel.bandwidth == 0) stop("Argument \"kernel.bandwidth\" has invaid length, Zero or NA elements.") } } else if (pretransform == "NMom" || pretransform == "NMCD"){ needtransform = T if (is.null(kernel.bandwidth)) { # use the rule of thumb #separately calculated later } else{ if (!is.numeric(kernel.bandwidth) ||!(is.vector(kernel.bandwidth) || is.list(kernel.bandwidth))){ stop("Argument \"kernel.bandwidth\" has invaid format.") } if (length(kernel.bandwidth) == 1) kernel.bandwidth = rep(kernel.bandwidth, length(cardinalities)) if (sum(!is.na(kernel.bandwidth)) != length(cardinalities) || sum(kernel.bandwidth != 0) != length(cardinalities)){ stop("Argument \"kernel.bandwidth\" has invaid length, Zero or NA elements.") } } } if(needtransform) # w.r.t. each class for (cls in 1:length(cardinalities)){ pattern <- data[(1 + sum(cardinalities[0:(cls - 1)])):sum(cardinalities[1:cls]),] if(is.null(kernel.bandwidth)) band <- NULL else band <- kernel.bandwidth[cls] depth <- depth.potential(data, pattern, pretransform, kernel, band, mah.parMcd) d <- cbind(d, depth) } else # not w.r.t. { points <- as.vector(t(data)) numPoints <- sum(cardinalities) dimension <- ncol(data) points2 <- as.vector(t(data)) numPoints2 <- nrow(data) classes <- length(cardinalities) kernelType = kernel if (is.character(kernelType)) kernelType = switch (kernelType, EDKernel = 1, GKernel = 2, EKernel = 3, TriangleKernel = 4, 1) ignoreself = F depth <- .C("PotentialDepthsCount", as.double(points), as.integer(numPoints), as.integer(dimension), as.integer(classes), as.integer(cardinalities), as.double(points2), as.integer(numPoints2), as.integer(kernelType), as.double(kernel.bandwidth), as.integer(ignoreself), depth=double(numPoints2*classes))$depth d = as.matrix(depth) dim(d)<-c(numPoints2,classes) } return(d) } ddalpha/R/dataf.geneexp.r0000644000176200001440000000006614213423775014756 0ustar liggesusersdataf.geneexp <- function() return(getdata("geneexp"))ddalpha/R/ddalpha.classify.r0000644000176200001440000001601514213423775015457 0ustar liggesusers################################################################################ # File: ddalpha.classify.r # Created by: Pavlo Mozharovskyi # First published: 28.02.2013 # Last revised: 15.05.2013 # # Contains the classification function of the DDalpha-classifier. # # For a description of the algorithm, see: # Lange, T., Mosler, K. and Mozharovskyi, P. (2012). Fast nonparametric # classification based on data depth. Statistical Papers. # Mozharovskyi, P., Mosler, K. and Lange, T. (2013). Classifying real-world # data with the DDalpha-procedure. Mimeo. ################################################################################ ddalpha.classify <- function(ddalpha, objects, subset, outsider.method = NULL, use.convex = NULL){ # Checks if (!is.matrix(objects) && !is.data.frame(objects)){ objects <- matrix(objects, nrow=1) } if (!(is.matrix(objects) && is.numeric(objects) || is.data.frame(objects) && prod(sapply(objects, is.numeric)))){ warning("Argument \"objects\" has unacceptable format. Classification can not be performed!!!") return (NULL) } # convert using formula if(!is.null(ddalpha$classif.formula)){ objects = model.frame(ddalpha$classif.formula, data = objects) } if(!missing(subset)) objects = objects[subset,] if (ncol(objects) != ddalpha$dimension){ warning("Dimension of the objects to be classified does not correspond to the dimension of the trained classifier. Classification can not be performed!!!") return (NULL) } if (ddalpha$methodSeparator == "Dknn") return(dknn.classify.trained(objects, ddalpha)) # if (!is.character(outsider.method) # || length(outsider.method) != 1){ # warning("Argument \"outsidet.method\" not specified correctly. Outsiders will be ignored!!!") # outsider.method <- NULL # } if (is.null(use.convex)){ use.convex <- ddalpha$useConvex } depths <- matrix(nrow=0, ncol=ddalpha$numPatterns) #? freePoints <- matrix(nrow=0, ncol=ncol(objects)) #? if (is.null(ddalpha$methodDepth)){ #use only outsiders treatment classifiableIndices <- c() resultsDepths <- list() freePoints <- objects } else { # Define points that can be classified by the DD-Alpha and the outsiders if (use.convex){ points <- ddalpha$patterns[[1]]$points cardinalities <- c(ddalpha$patterns[[1]]$cardinality) for (i in 2:ddalpha$numPatterns){ points <- rbind(points, ddalpha$patterns[[i]]$points) cardinalities <- c(cardinalities, ddalpha$patterns[[i]]$cardinality) } classifiable <- .are_classifiable(objects, points, cardinalities) classifiableIndices <- which(classifiable == 1) if (length(classifiableIndices) == 0){ depths <- matrix(nrow=0, ncol=ddalpha$numPatterns) freePoints <- objects }else{ depths <- .ddalpha.count.depths(ddalpha, objects[classifiableIndices,]) freePoints <- matrix(objects[-classifiableIndices,,drop=F], nrow=nrow(objects)-length(classifiableIndices)) } }else{ ifelse(ddalpha$methodDepth == "ddplot", depths <- objects, depths <- .ddalpha.count.depths(ddalpha, objects) ) classifiableIndices <- c() for (i in 1:nrow(depths)){ if (sum(depths[i,]) > 0){ classifiableIndices <- c(classifiableIndices, i) } } if (length(classifiableIndices) == 0){ depths <- matrix(nrow=0, ncol=ddalpha$numPatterns) freePoints <- objects }else{ depths <- suppressWarnings( as.matrix(depths[classifiableIndices,,drop=F], nrow=length(classifiableIndices), ncol=ddalpha$numPatterns)) freePoints <- # objects[-classifiableIndices,,drop=F]# suppressWarnings( as.matrix(objects[-classifiableIndices,,drop=F], nrow=nrow(objects)-length(classifiableIndices), ncol=ncol(objects))) } } # Classify with the pure DD classifiers resultsDepths <- list() if (nrow(depths) > 0){ fname = paste0(".", ddalpha$methodSeparator, "_classify") classify <- .getFunction(fname) resultsDepths1 <- list() if (ddalpha$methodSeparatorBinary){ #### Binary classifiers votes <- matrix(rep(0, nrow(depths)*ddalpha$numPatterns), nrow=nrow(depths), ncol=ddalpha$numPatterns) for (i in 1:ddalpha$numClassifiers){ xAxis <- ddalpha$classifiers[[i]]$index1 yAxis <- ddalpha$classifiers[[i]]$index2 result <- classify(ddalpha, ddalpha$classifiers[[i]], depths) for (obj in 1:nrow(depths)){ if (result[obj] > 0){ votes[obj,xAxis] <- votes[obj,xAxis] + 1 }else{ votes[obj,yAxis] <- votes[obj,yAxis] + 1 } } } for (i in 1:nrow(depths)){ resultsDepths[[i]] <- ddalpha$patterns[[which.max(votes[i,])]]$name } } else { #### Multiclass classifiers indexes <- classify(ddalpha, ddalpha$classifiers[[1]], depths) for (i in 1:nrow(depths)){ resultsDepths[[i]] <- ddalpha$patterns[[indexes[i]]]$name } } } } # end if(!is.null(ddalpha$methodDepth)) # Classify Outsiders resultsOutsiders <- as.list(rep("Ignored", nrow(freePoints))) freePoints if (is.null(outsider.method) && length(ddalpha$methodsOutsider) == 1) outsider.method = ddalpha$methodsOutsider[[1]]$name if (length(resultsOutsiders) > 0 && !is.null(outsider.method)){ for (i in 1:length(ddalpha$methodsOutsider)){ if (toupper(ddalpha$methodsOutsider[[i]]$name) == toupper(outsider.method)){ resultsOutsiders <- .ddalpha.classify.outsiders(freePoints, ddalpha, ddalpha$methodsOutsider[[i]]) break } } } # Merge classifiable and outsiders if (length(resultsOutsiders) == 0) results <- resultsDepths else if(length(resultsDepths) == 0) results <- resultsOutsiders else{ if(is.factor(resultsOutsiders[[1]]) && !is.factor(resultsDepths[[1]])) resultsOutsiders = lapply(resultsOutsiders, as.character) if(is.numeric(resultsDepths[[1]]) && !is.numeric(resultsOutsiders[[1]])) resultsOutsiders = as.numeric(resultsOutsiders) results <- list() counterDepths <- 1 counterOutsiders <- 1 for (i in 1:nrow(objects)){ if (i %in% classifiableIndices){ results[[i]] <- resultsDepths[[counterDepths]] counterDepths <- counterDepths + 1 }else{ results[[i]] <- resultsOutsiders[[counterOutsiders]] counterOutsiders <- counterOutsiders + 1 } } } if (length(results) == 1) return(results[[1]]) else return (results) } predict.ddalpha <- function(object, objects, subset, outsider.method = NULL, use.convex = NULL, ...){ return(ddalpha.classify(object, objects, subset, outsider.method, use.convex)) } ddalpha/R/depth.projection.r0000644000176200001440000001777114213423775015537 0ustar liggesusers################################################################################ # File: depth.projection.r # Created by: Pavlo Mozharovskyi # First published: 28.02.2013 # Last revised: 13.11.2015 # # Computation of the projection data depth. ################################################################################ # Conrains R-codes written by Subhajit Dutta, # taken from http://www.isical.ac.in/~tijahbus/GAM/r_wilcox.txt. ################################################################################ depth.projection <- function(x, data, method = "random", num.directions = 1000, seed = 0){ if (seed!=0) set.seed(seed) if (!(is.matrix(data) && is.numeric(data) || is.data.frame(data) && prod(sapply(data, is.numeric))) || ncol(data) < 2){ stop("Argument \"data\" should be a numeric matrix of at least 2-dimensional data") } if (!is.matrix(x) && is.vector(x)){ x <- matrix(x, nrow=1) } if (method == "random"){ dt <- as.vector(t(data)) z <- as.vector(t(x)) m <- nrow(x) d <- ncol(data) n <- nrow(data) q <- 1 k <- num.directions newDirs <- 1 rez <- .C("ProjectionDepth", as.double(dt), as.double(z), as.integer(m), as.integer(d), as.integer(n), as.integer(q), dirs=double(k*d), prjs=double(k*n), as.integer(k), as.integer(1), as.integer(seed), dps=double(m*q)) return (rez$dps) } if (method == "linearize"){ depths <- .zdepth(data, x) return (1/(1 + depths)) } } depth.space.projection <- function(data, cardinalities, method = "random", num.directions = 1000, seed = 0){ if (!(is.matrix(data) && is.numeric(data) || is.data.frame(data) && prod(sapply(data, is.numeric))) || ncol(data) < 2){ stop("Argument \"data\" should be a numeric matrix of at least 2-dimensional data") } if (!is.vector(cardinalities, mode = "numeric") || is.na(min(cardinalities)) || sum(.is.wholenumber(cardinalities)) != length(cardinalities) || min(cardinalities) <= 0 || sum(cardinalities) != nrow(data)){ stop("Argument \"cardinalities\" should be a vector of cardinalities of the classes in \"data\" ") } if (sum(cardinalities < ncol(data) + 1) != 0){ stop("Not in all classes sufficiently enough objetcs") } depth.space <- NULL for (i in 1:length(cardinalities)){ pattern <- data[(1 + sum(cardinalities[0:(i - 1)])):sum(cardinalities[1:i]),] pattern.depths <- depth.projection (data, pattern, method, num.directions, seed) depth.space <- cbind(depth.space, pattern.depths, deparse.level = 0) } return (depth.space) } ################################################################################ # R-codes of this function written by Subhajit Dutta, # taken from http://www.isical.ac.in/~tijahbus/GAM/r_wilcox.txt. ################################################################################ .zdepth<-function(m,pts=m,zloc=median,zscale=mad){ # # Compute depth of points as in Zuo, Annals, 2003 # if(!is.matrix(m))stop("argument m should be a matrix") if(!is.matrix(pts))stop("argument pts should be a matrix") if(ncol(m)!=ncol(pts))stop("Number of columns for m and pts are not equal") np<-ncol(m) val<-NA for(i in 1:nrow(pts)){ pval<-pts[i,] START<-rep(1,np)/sqrt(np) temp<-.nelderv2(m,np,FN=.zdepth.sub,START=START,zloc=zloc,zscale=zscale,pts=pval) temp<-temp/sqrt(sum(temp^2)) y<-t(t(m)*temp) y<-apply(y,1,sum) ppro<-sum(pval*temp) val[i]<-abs(ppro-zloc(y))/zscale(y) } val } ################################################################################ # R-codes of this function written by Subhajit Dutta, # taken from http://www.isical.ac.in/~tijahbus/GAM/r_wilcox.txt. ################################################################################ .zdepth.sub<-function(x,theta,zloc=median,zscale=mad,pts=NA){ theta<-theta/sqrt(sum(theta^2)) temp<-t(t(x)*theta) ppro<-sum(t(t(pts)*theta)) yhat<-apply(temp,1,sum) val<-0-abs(ppro-zloc(yhat))/zscale(yhat) val } ################################################################################ # R-codes of this function written by Subhajit Dutta, # taken from http://www.isical.ac.in/~tijahbus/GAM/r_wilcox.txt. ################################################################################ .nelderv2<-function(x,N,FN,START=c(rep(1,N)),STEP=c(rep(1,N)), XMIN=c(rep(0,N)),XSEC=c(rep(0,N)),...){ # NELDER-MEAD method for minimzing a function # # TAKEN FROM OLSSON, J QUALITY TECHNOLOGY, 1974, 6, 56. # # x= n by p matrix containing data; it is used by # function to be minimized. # N= number of parameters # # FN=the function to be minimized # FORM: FN(x,theta), theta is vector containing # values for N parameters. # # START = starting values. # STEP=initial step. # This function returns the N values for theta that minimize FN # ICOUNT<-500 REQMIN<-.0000001 NN<-N+1 P<-matrix(NA,nrow=N,ncol=NN) P[,NN]<-START PBAR<-NA RCOEFF<-1 ECOEFF<-2 CCOEFF<-.5 KCOUNT<-ICOUNT ICOUNT<-0 DABIT<-2.04067e-35 BIGNUM<-1.e38 KONVGE<-5 XN<-N DN<-N Y<-rep(0,NN) Y[NN]<-FN(x,START,...) ICOUNT<-ICOUNT+1 for(J in 1:N){ DCHK<-START[J] START[J]<-DCHK+STEP[J] for(I in 1:N){ P[I,J]<-START[I] } Y[J]<-FN(x,START,...) ICOUNT<-ICOUNT+1 START[J]<-DCHK } I1000<-T while(I1000){ YLO<-Y[1] YNEWLO<-YLO ILO<-1 IHI<-1 for(I in 2:NN){ if(Y[I] < YLO){ YLO<-Y[I] ILO<-I} if(Y[I] > YNEWLO){ YNEWLO<-Y[I] IHI<-I} } DCHK<-(YNEWLO+DABIT)/(YLO+DABIT)-1 if(abs(DCHK) < REQMIN){ I1000<-F next } KONVGE<-KONVGE-1 if(KONVGE == 0){ KONVGE<-5 for(I in 1:N){ COORD1<-P[I,1] COORD2<-COORD1 for(J in 2:NN){ if(P[I,J] < COORD1)COORD1<-P[I,J] if(P[I,J] > COORD2)COORD2<-P[I,J] } # 2010 CONTINUE DCHK<-(COORD2+DABIT)/(COORD1+DABIT)-1 if(abs(DCHK) > REQMIN)break } } if(ICOUNT >= KCOUNT){ I1000<-F next } for(I in 1:N){ Z<-0.0 Z<-sum(P[I,1:NN]) # 6 Z<-Z-P[I,IHI] PBAR[I]<-Z/DN } PSTAR<-(1.+RCOEFF)*PBAR-RCOEFF*P[,IHI] YSTAR<-FN(x,PSTAR,...) ICOUNT<-ICOUNT+1 if(YSTAR < YLO && ICOUNT >= KCOUNT){ P[,IHI]<-PSTAR Y[IHI]<-YSTAR next } IFLAG<-T if(YSTAR < YLO){ P2STAR<-ECOEFF*PSTAR+(1-ECOEFF)*PBAR Y2STAR<-FN(x,P2STAR,...) ICOUNT<-ICOUNT+1 if(Y2STAR >= YSTAR){ P[,IHI]<-PSTAR Y[IHI]<-YSTAR next #In essence, go to 19 which goes to 1000 } IFLAG<-T while(YSTAR < Y[IHI]){ P[,IHI]<-P2STAR Y[IHI]<-Y2STAR IFLAG<-F break L<-sum(Y[1:NN] > YSTAR) if(L > 1){ P[,IHI]<-PSTAR Y[IHI]<-YSTAR IFLAG<-T break } if(L > 1)break # go to 19 if(L != 0){ P[1:N,IHI]<-PSTAR[1:N] Y[IHI]<-YSTAR } I1000<-F break if(ICOUNT >= KCOUNT){ I1000<-F next } P2STAR[1:N]<-CCOEFF*P[1:N,IHI]+(1-CCOEFF)*PBAR[1:N] Y2STAR<-FN(x,P2STAR,...) ICOUNT<-ICOUNT+1 } # END WHILE } if(IFLAG){ for(J in 1:NN){ P[,J]=(P[,J]+P[,ILO])*.5 XMIN<-P[,J] Y[J]<-FN(x,XMIN,...) } ICOUNT<-ICOUNT+NN if(ICOUNT < KCOUNT)next I1000<-F next } P[1:N,IHI]<-PSTAR[1:N] Y[IHI]<-YSTAR } for(J in 1:NN){ XMIN[1:N]<-P[1:N,J] } Y[J]<-FN(x,XMIN,...) YNEWLO<-BIGNUM for(J in 1:NN){ if (Y[J] < YNEWLO){ YNEWLO<-Y[J] IBEST<-J }} Y[IBEST]<-BIGNUM YSEC<-BIGNUM for(J in 1:NN){ if(Y[J] < YSEC){ YSEC<-Y[J] ISEC<-J }} XMIN[1:N]<-P[1:N,IBEST] XSEC[1:N]<-P[1:N,ISEC] XMIN }ddalpha/R/dataf.r0000644000176200001440000000317714550224255013326 0ustar liggesusersdataf <- function(fdatas, labels) { .split_data_matrix <-function(fdata) { funcs = split(fdata$data, row(fdata$data)) dataf = lapply(funcs, function(func) list(args = fdata$argvals, vals = func)) } if (inherits(fdatas, "fdata")) { if (nrow(fdatas$data) != length(labels)) stop("the length of 'labels' must correspond to the number of functions in 'fdatas'") if (!is.null(fdatas$fdata2d) && fdatas$fdata2d) stop("fdata2d = TRUE is not supported") dataf.labels = as.list(labels) dataf.dataf = .split_data_matrix(fdatas) res = list( dataf = dataf.dataf, labels = dataf.labels, name = fdatas$names$main, args = fdatas$names$xlab, vals = fdatas$names$ylab ) class(res) <- "functional" return (res) } if (length(fdatas) != length(labels)) stop("'fdatas' and 'labels' must be vectors of the same length") dataf.dataf = list() dataf.labels = c() for (i in range(1:length(fdatas))) { fdata = fdatas[[i]] lab = labels[[i]] if (!inherits(fdata, "fdata")) stop("elements of 'fdatas' must be of the 'fdata' class") if (!is.null(fdata$fdata2d) && fdata$fdata2d) stop("fdata2d = TRUE is not supported") dataf.labels = c(dataf.labels, rep(lab, nrow(fdata$data))) dataf.dataf = c(dataf.dataf, .split_data_matrix(fdata)) } res = list( dataf = as.list(dataf.dataf), labels = dataf.labels, # just take the names from the first data set name = fdatas[[1]]$names$main, args = fdatas[[1]]$names$xlab, vals = fdatas[[1]]$names$ylab ) class(res) <- "functional" return (res) } ddalpha/R/getdata.R0000644000176200001440000000152114213423775013613 0ustar liggesusers#all_datasets = c("baby","banknoten","biomed","bloodtransfusion","breast_cancer_wisconsin","bupa","chemdiab_1vs2","chemdiab_1vs3","chemdiab_2vs3","cloud","crabB_MvsF","crabF_BvsO","crabM_BvsO","crabO_MvsF","crab_BvsO","crab_MvsF","cricket_CvsP","diabetes","ecoli_cpvsim","ecoli_cpvspp","ecoli_imvspp","gemsen_MvsF","glass","groessen_MvsF","haberman","heart","hemophilia","indian_liver_patient_1vs2","indian_liver_patient_FvsM","iris_setosavsversicolor","iris_setosavsvirginica","iris_versicolorvsvirginica","irish_ed_MvsF","kidney","pima","plasma_retinol_MvsF","segmentation","socmob_IvsNI","socmob_WvsB","tae","tennis_MvsF","tips_DvsN","tips_MvsF","uscrime_SvsN","vertebral_column","veteran_lung_cancer","vowel_MvsF","wine_1vs2","wine_1vs3","wine_2vs3") getdata <- function (name){ data(list = name, envir = environment()) return(get(name)) } ddalpha/R/dataf.sim.r0000644000176200001440000000755114213423775014121 0ustar liggesusersdataf.sim.1.CFF07 <- function(numTrain = 100, numTest = 50, numDiscrets = 51, plot = FALSE){ # Processes: # X(t) = m_0(t) + e(t), m_0(t) = 30*(1-t)*t^1.2 # Y(t) = m_1(t) + e(t), m_1(t) = 30*(1-t)^1.2*t # e(t): Gaussian with mean = 0, cov(X(s), X(t)) = 0.2*exp(-abs(s - t)/0.3) t <- 0:(numDiscrets - 1)/(numDiscrets - 1) mean0 <- 30*(1-t)*t^1.2 mean1 <- 30*(1-t)^1.2*t cov <- matrix(nrow=numDiscrets, ncol=numDiscrets) for (i in 1:numDiscrets){ for (j in 1:numDiscrets){ cov[i,j] <- 0.2*exp(-abs(t[i] - t[j])/0.3) } } X <- mvrnorm(n=numTrain+numTest, mu=mean0, Sigma=cov) Y <- mvrnorm(n=numTrain+numTest, mu=mean1, Sigma=cov) datafX <- list() datafY <- list() labelsX <- as.list(rep(0,numTrain+numTest)) labelsY <- as.list(rep(1,numTrain+numTest)) for (i in 1:(numTrain + numTest)){ datafX[[i]] <- list(args = t, vals = X[i,]) datafY[[i]] <- list(args = t, vals = Y[i,]) } learn <- list(dataf = c(head(datafX, numTrain), head(datafY, numTrain)), labels = c(head(labelsX, numTrain), head(labelsY, numTrain))) class(learn) = "functional" test <- list(dataf = c(tail(datafX, numTest), tail(datafY, numTest)), labels = c(tail(labelsX, numTest), tail(labelsY, numTest))) class(test) = "functional" if (plot){ plot(0, type="n", xlim=c(0,1), ylim=c(0, 9), main=paste("Model 1 from CuevasFF07: ", "0 red (", sum(unlist(learn$labels) == 0), "), ", "1 blue (", sum(unlist(learn$labels) == 1), "), ", sep="")) grid() for (i in 1:length(learn$dataf)){ if (learn$labels[[i]] == 0){ lineColor <- "red" lineType <- 1 } if (learn$labels[[i]] == 1){ lineColor <- "blue" lineType <- 2 } lines(learn$dataf[[i]]$args, learn$dataf[[i]]$vals, col=lineColor, lty=lineType) } } return (list(learn = learn, test = test)) } dataf.sim.2.CFF07 <- function(numTrain = 100, numTest = 50, numDiscrets = 51, plot = FALSE){ # Processes # X(t) = m_0(t) + e(t), m_0(t) = 30*(1-t)*t^2 + 0.5*abs(sin(20*pi*t)) # Y(t) = smooth.spline with 8 knots # e(t): Gaussian with mean = 0, cov(X(s), X(t)) = 0.2*exp(-abs(s - t)/0.3) t <- 0:(numDiscrets - 1)/(numDiscrets - 1) mean0 <- 30*(1 - t)*t^2 + 0.5*abs(sin(20*pi*t)) cov <- matrix(nrow=numDiscrets, ncol=numDiscrets) for (i in 1:numDiscrets){ for (j in 1:numDiscrets){ cov[i,j] <- 0.2*exp(-abs(t[i] - t[j])/0.3) } } X <- mvrnorm(n=numTrain+numTest, mu=mean0, Sigma=cov) Y <- NULL for (i in 1:nrow(X)){ Y <- rbind(Y, smooth.spline(t, X[i,], nknots = 8)$y) } datafX <- list() datafY <- list() labelsX <- as.list(rep(0,numTrain+numTest)) labelsY <- as.list(rep(1,numTrain+numTest)) for (i in 1:(numTrain + numTest)){ datafX[[i]] <- list(args = t, vals = X[i,]) datafY[[i]] <- list(args = t, vals = Y[i,]) } learn <- list(dataf = c(head(datafX, numTrain), head(datafY, numTrain)), labels = c(head(labelsX, numTrain), head(labelsY, numTrain))) class(learn) = "functional" test <- list(dataf = c(tail(datafX, numTest), tail(datafY, numTest)), labels = c(tail(labelsX, numTest), tail(labelsY, numTest))) class(test) = "functional" if (plot){ plot(0, type="n", xlim=c(0,1), ylim=c(0, 7), main=paste("Model 2 from CuevasFF07: ", "0 red (", sum(unlist(learn$labels) == 0), "), ", "1 blue (", sum(unlist(learn$labels) == 1), "), ", sep="")) grid() for (i in 1:length(learn$dataf)){ if (learn$labels[[i]] == 0){ lineColor <- "red" lineType <- 1 } if (learn$labels[[i]] == 1){ lineColor <- "blue" lineType <- 2 } lines(learn$dataf[[i]]$args, learn$dataf[[i]]$vals, col=lineColor, lty=lineType) } } return (list(learn = learn, test = test)) }ddalpha/R/compclassf.r0000644000176200001440000004026614550243636014405 0ustar liggesuserscompclassf.train <- function(dataf, labels, subset, to.equalize = TRUE, to.reduce = TRUE, classifier.type = c("ddalpha", "maxdepth", "knnaff", "lda", "qda"), ...){ # Trains the functional componentwise classifier # Args: # dataf: list containing lists (functions) of two vectors of equal length, # named "args" and "vals": arguments sorted in ascending order and # corresponding them values respectively # labels: output labels of the functinal observations # other arguments: TODO # Returns: # Functional componentwise clasifier # Check "dataf" if (!is.list(dataf)) stop("Argument 'dataf' must be a list") for (df in dataf) if (!(is.list(df) && length(df) == 2 && !is.null(df$args) && !is.null(df$vals) && is.vector(df$args) && is.vector(df$vals) && is.numeric(df$args) && is.numeric(df$vals) && length(df$args) == length(df$vals) && is.sorted(df$args))) stop("Argument 'dataf' must be a list containing lists (functions) of two vectors of equal length, named 'args' and 'vals': arguments sorted in ascending order and corresponding them values respectively") if(!missing(subset)) { dataf = dataf[subset] labels = labels[subset] } # Check "labels" if (!(length(dataf)==length(labels) && length(unique(labels)>=2))) stop("Argument 'labels' has wrong format") # Check classifier.type classifier.type = match.arg(classifier.type) # Bring to finite dimension # Pointize points <- GetPointsDHB12(dataf, labels, to.equalize, to.reduce) # CV arg.indices <- getBestSpaceDHB12(points$data, classifier.type, num.chunks=10, ...) data <- points$data[,c(arg.indices,ncol(points$data))] # Apply chosen classifier to train the data if (classifier.type == "ddalpha"){ classifier <- ddalpha.train(data, separator = "alpha", ...) } if (classifier.type == "maxdepth"){ classifier <- ddalpha.train(data, separator = "maxD", ...) } if (classifier.type == "knnaff"){ classifier <- knnaff.train(data, i = 0, ...) } if (classifier.type == "lda"){ classifier <- lda_train(data, ...) } if (classifier.type == "qda"){ classifier <- qda_train(data, ...) } # Create the eventual output structure compclassf <- structure( list(dataf = points$dataf, labels = points$labels, adc.method = "equalCover", adc.args = list(instance = "val", numFcn = ncol(points$data) - 1, numDer = 0), adc.transmat = points$transmat, the.args = arg.indices, data = points$data, classifier.type = classifier.type, classifier = classifier), .Names = c("dataf", "labels", "adc.method", "adc.args", "adc.transmat", "the.args", "data", "classifier.type", "classifier")) class(compclassf) <- "compclassf" return (compclassf) } compclassf.classify <- function(compclassf, objectsf, subset, ...){ # Classifies functions # Args: # objectsf: sample to classify, a list containing lists (functions) of # two vectors of equal length, named "args" and "vals": # arguments sorted in ascending order and corresponding them # values respectively # compclassf: functional DDalpha-classifier # Returns: # List of labels assigned to the functions from "objectsf" # Check "objectsf" if (!is.list(objectsf)) stop("Argument 'objectsf' must be a list") if (!is.null(objectsf$args)){ objectsf = list(objectsf) # there was a single element } if(!missing(subset)) { objectsf = objectsf[subset] } for (df in objectsf) if (!(is.list(df) && length(df) == 2 && !is.null(df$args) && !is.null(df$vals) && is.vector(df$args) && is.vector(df$vals) && is.numeric(df$args) && is.numeric(df$vals) && length(df$args) == length(df$vals) && is.sorted(df$args))) stop("Argument 'objectsf' must be a list containing lists (functions) of two vectors of equal length, named 'args' and 'vals': arguments sorted in ascending order and corresponding them values respectively") # Prepare to multivariate classification objectsf.equalized <- equalize(objectsf) if (compclassf$adc.method == "equalCover"){ if (compclassf$adc.args$instance == "val"){ input <- getValGrid(objectsf.equalized, compclassf$adc.args$numFcn, compclassf$adc.args$numDer) } if (compclassf$adc.args$instance == "avr"){ input <- getAvrGrid(objectsf.equalized, compclassf$adc.args$numFcn, compclassf$adc.args$numDer) } if (!is.null(compclassf$adc.transmat)){ input <- input%*%compclassf$adc.transmat } } input <- input[,compclassf$the.args] # Classify and assign class labels if (compclassf$classifier.type == "ddalpha" || compclassf$classifier.type == "maxdepth"){ output <- ddalpha.classify(objects = input, ddalpha = compclassf$classifier, ...) } if (compclassf$classifier.type == "knnaff"){ output <- knnaff.classify(objects = input, compclassf$classifier, ...) } if (compclassf$classifier.type == "lda"){ output <- lda_classify(objects = input, compclassf$classifier, ...) } if (compclassf$classifier.type == "qda"){ output <- qda_classify(objects = input, compclassf$classifier, ...) } classes <- list() for (i in 1:length(output)){ # if (is.numeric(output[[i]])){ classes[[i]] <- compclassf$labels[[ output[[i]] ]] # }else{ # classes[[i]] <- output[[i]] # } } return (classes) } predict.compclassf <- function(object, objectsf, subset, ...){ compclassf.classify(object, objectsf, subset, ...) } print.compclassf <- function(x, ...){ cat("compclassf:\n") cat("\t num.functions = ", length(x$dataf), ", num.patterns = ", length(unique(x$labels)), "\n", sep="") # cat("\t adc.method", x$adc.method, "\"\n", sep="") cat("\t adc:", x$adc.args$instance, "; numFcn:", x$adc.args$numFcn, "; numDer:", x$adc.args$numDer, "\"\n", sep="") cat("\t adc.transmat", x$adc.transmat, "\"\n", sep="") cat("\t classifier.type", x$classifier.type, "\"\n", sep="") cat("\t classifier:\n") print(x$classifier) } ################################################################################ # Functions below are used for intermediate computations # ################################################################################ GetPointsDHB12 <- function(dataf, labels, to.equalize=T, to.reduce=F){ # Numerize labels names <- unique(labels) output <- rep(0, length(labels)) for (i in 1:length(labels)){ for (j in 1:length(names)){ if (labels[[i]] == names[[j]]){ output[i] = j break } } } # Prepare data if (to.equalize){ num.times = length(dataf[[1]]$args) dataf.equalized <- equalize(dataf) adc.args = list(instance = "val", numFcn = num.times, numDer = 0) input <- getValGrid(dataf.equalized, adc.args$numFcn, adc.args$numDer) }else{ input <- NULL for (i in 1:length(dataf)){ input <- rbind(input, dataf[[i]]$vals) } } transmat <- NULL if (to.reduce){# Reduce dimension if needed princomps <- NULL newDim <- ncol(input) for (i in 1:length(names)){ classi <- input[output == i,1:ncol(input)] princompsi <- prcomp(x=classi, tol=sqrt(.Machine$double.eps)) newDimi <- sum(princompsi$sdev > sqrt(.Machine$double.eps)) if (newDimi < newDim){ newDim <- newDimi princomps <- princompsi } } transmat <- NULL if (newDim < ncol(input)){ transmat <- matrix(as.vector(princomps$rotation[,1:newDim]), ncol=newDim) input <- input%*%transmat } } # Combine data data <- cbind(input, output, deparse.level=0) return (list(data = data, dataf = dataf.equalized, labels = names, transmat = transmat)) } getBestSpaceDHB12 <- function(data, classifier.type = "ddalpha", num.chunks = 10, ...){ indices.num <- ncol(data) - 1 indices.avlbl <- rep(TRUE, indices.num) indices.best <- c() error.last <- nrow(data) + 1 r <- 0 while (sum(indices.avlbl) > 0){ # If this is the first iteration search through all possible pairs if (r == 0){ # Generate all combinations with smallest distance 2 combinations <- combn((1:indices.num)[indices.avlbl], 2) tmp.cmb <- rbind(combinations[-1,], rep(-1000000, ncol(combinations))) tmp.cmb <- (tmp.cmb - combinations)==T combinations <- combinations[,apply(tmp.cmb, 2, sum)==0] # Choose the best combination errors <- c() for (i in 1:ncol(combinations)){ cat("r = ", r, ": ", i, "/", ncol(combinations), ".\n", sep="") errors <- c(errors, 0) # Actually CV num.points <- nrow(data) indices.off <- num.chunks*(0:(ceiling(num.points/num.chunks) - 1)) for (j in 1:num.chunks){ # Determine points to be taken off take.off <- (indices.off + j)[(indices.off + j) <= num.points] # Apply chosen classifier if (classifier.type == "ddalpha"){ classifier <- ddalpha.train(data[-take.off,c(combinations[,i], indices.num + 1)], separator = "alpha", ...) results <- ddalpha.classify(objects = data[take.off,combinations[,i]], ddalpha = classifier) } if (classifier.type == "maxdepth"){ classifier <- ddalpha.train(data[-take.off,c(combinations[,i], indices.num + 1)], separator = "maxD", ...) results <- ddalpha.classify(objects = data[take.off,combinations[,i]], ddalpha = classifier) } if (classifier.type == "knnaff"){ classifier <- knnaff.train(data[-take.off,c(combinations[,i], indices.num + 1)], i = i, ...) results <- knnaff.classify(data[take.off,combinations[,i]], classifier) } if (classifier.type == "lda"){ classifier <- lda_train(data[-take.off,c(combinations[,i], indices.num + 1)], ...) results <- lda_classify(data[take.off,combinations[,i]], classifier) } if (classifier.type == "qda"){ classifier <- qda_train(data[-take.off,c(combinations[,i], indices.num + 1)], ...) results <- qda_classify(data[take.off,combinations[,i]], classifier) } # Collect errors errors[i] <- errors[i] + sum(unlist(results) != data[take.off,indices.num + 1]) } } # Collect results error.last <- min(errors) indices.best <- combinations[,which.min(errors)] indices.avlbl <- rep(TRUE, indices.num) indices.to.dsbl <- unique(c(indices.best, indices.best - 1, indices.best + 1)) indices.to.dsbl <- indices.to.dsbl[indices.to.dsbl >= 1 && indices.to.dsbl <= indices.num] indices.avlbl[indices.to.dsbl] <- FALSE r <- 2 next } # First, sequential approach errors <- c() variants <- c() for (i in 1:indices.num){ if (indices.avlbl[i]){ errors <- c(errors, 0) variants <- c(variants, i) indices.cur <- c(indices.best, i) # Actually CV num.points <- nrow(data) indices.off <- num.chunks*(0:(ceiling(num.points/num.chunks) - 1)) for (j in 1:num.chunks){ # Determine points to be taken off take.off <- (indices.off + j)[(indices.off + j) <= num.points] # Apply chosen classifier if (classifier.type == "ddalpha"){ classifier <- ddalpha.train(data[-take.off,c(indices.cur, indices.num + 1)], separator = "alpha", ...) results <- ddalpha.classify(objects = data[take.off,indices.cur], ddalpha = classifier) } if (classifier.type == "maxdepth"){ classifier <- ddalpha.train(data[-take.off,c(indices.cur, indices.num + 1)], separator = "maxD", ...) results <- ddalpha.classify(objects = data[take.off,indices.cur], ddalpha = classifier) } if (classifier.type == "knnaff"){ classifier <- knnaff.train(data[-take.off,c(indices.cur, indices.num + 1)], i = i, ...) results <- knnaff.classify(data[take.off,indices.cur], classifier) } if (classifier.type == "lda"){ classifier <- lda_train(data[-take.off,c(combinations[,i], indices.num + 1)], ...) results <- lda_classify(data[take.off,combinations[,i]], classifier) } if (classifier.type == "qda"){ classifier <- qda_train(data[-take.off,c(combinations[,i], indices.num + 1)], ...) results <- qda_classify(data[take.off,combinations[,i]], classifier) } # Collect errors errors[i] <- errors[i] + sum(unlist(results) != data[take.off,indices.num + 1]) } } } error.best <- min(errors) best.i <- variants[which.min(errors)[1]] indices.new <- c(indices.best, best.i) # Refinements for r=2, 3 and 4 if (r %in% 2:3){ # Define the grid if (r == 2){step <- 10} if (r == 3){step <- 5} grid.one <- c(-(1:step*2), 0, 1:step*2) grid <- c() for (i in 1:length(indices.new)){ grid <- c(grid, indices.new[i] + grid.one) } grid <- unique(grid) grid <- sort(grid[(grid >= 1) & (grid <= indices.num)]) # Generate all combinations with smallest distance 2 combinations <- combn(grid, r + 1) tmp.cmb <- rbind(combinations[-1,], rep(-1000000, ncol(combinations))) tmp.cmb <- (tmp.cmb - combinations)==T combinations <- combinations[,apply(tmp.cmb, 2, sum)==0] # Choose the best combination #indices.grid <- (1:indices.num)[indices.avlbl & ((1:induces.num) %in% grid)] # Go through the combinations errors <- c() #combinations <- combn(indices.grid, r + 1) for (i in 1:ncol(combinations)){ cat("r = ", r, ": ", i, "/", ncol(combinations), ".\n", sep="") errors <- c(errors, 0) # Actually CV num.points <- nrow(data) indices.off <- num.chunks*(0:(ceiling(num.points/num.chunks) - 1)) for (j in 1:num.chunks){ # Determine points to be taken off take.off <- (indices.off + j)[(indices.off + j) <= num.points] # Apply chosen classifier if (classifier.type == "ddalpha"){ classifier <- ddalpha.train(data[-take.off,c(combinations[,i], indices.num + 1)], separator = "alpha", ...) results <- ddalpha.classify(objects = data[take.off,combinations[,i]], ddalpha = classifier) } if (classifier.type == "maxdepth"){ classifier <- ddalpha.train(data[-take.off,c(combinations[,i], indices.num + 1)], separator = "maxD", ...) results <- ddalpha.classify(objects = data[take.off,combinations[,i]], ddalpha = classifier) } if (classifier.type == "knnaff"){ classifier <- knnaff.train(data[-take.off,c(combinations[,i], indices.num + 1)], i = i, ...) results <- knnaff.classify(data[take.off,combinations[,i]], classifier) } if (classifier.type == "lda"){ classifier <- lda_train(data[-take.off,c(combinations[,i], indices.num + 1)], ...) results <- lda_classify(data[take.off,combinations[,i]], classifier) } if (classifier.type == "qda"){ classifier <- qda_train(data[-take.off,c(combinations[,i], indices.num + 1)], ...) results <- qda_classify(data[take.off,combinations[,i]], classifier) } # Collect errors errors[i] <- errors[i] + sum(unlist(results) != data[take.off,indices.num + 1]) } } error.best <- min(errors) indices.cur <- combinations[,which.min(errors)] }else{ indices.cur <- indices.new } if (error.best < error.last){ indices.best <- indices.cur error.last <- error.best indices.avlbl <- rep(TRUE, indices.num) indices.to.dsbl <- unique(c(indices.best, indices.best - 1, indices.best + 1)) indices.to.dsbl <- indices.to.dsbl[indices.to.dsbl >= 1 && indices.to.dsbl <= indices.num] indices.avlbl[indices.to.dsbl] <- FALSE r <- r + 1 }else{ break } } return (indices.best) } ddalpha/R/depthf.r0000644000176200001440000000270514213423775013521 0ustar liggesusers.depthf <- function(fname, funcargs, ...){ f <- try(match.fun(fname), silent = T) if (is.function(f)){ args = list(...) fcnArgs <- names(formals(f)) fcnArgs <- unlist(fcnArgs, use.names=FALSE) keep <- intersect(names(args), fcnArgs) unused <- setdiff(names(args), fcnArgs) args <- args[keep] args <- c(args, funcargs) res <- do.call(fname, args=args) if(length(unused)>0) warning("Unused by '", fname, "' arguments: ", paste(unused, collapse = ', ')) #res <- f(x, data, ...) return(res) } else { warning("There is no depth function ", fname) } } depthf. <- function(datafA, datafB, notion = c("ABD", "BD", "fd1", "fd2", "hM", "hM2", "HR", "RP1", "RP2"), ...){ if(is.null(notion)) stop("Parameter 'notion' must be set") t <- notion try(t <- match.arg(notion), silent = T) fname = paste0("depthf.", t) funcargs = list(datafA = datafA, datafB = datafB) return(.depthf(fname, funcargs, ...)) } #depthf.space. <- function(dataf, cardinalities, notion = c("ABD", "BD", "fd1", "fd2", "hM", "hM2", "HR", "RP1", "RP2"), ...){ # # if(is.null(notion)) # stop("Parameter 'notion' must be set") # t <- notion # try(t <- match.arg(notion), silent = T) # # # try to find a depth # fname = paste0("depth.space.", t) # funcargs = list(cardinalities = cardinalities, data = data) # return(.depth(fname, funcargs, ...)) #} # d = depth(data$train, data$train, exact = T) ddalpha/R/dataf.growth.r0000644000176200001440000000006414213423775014633 0ustar liggesusersdataf.growth <- function() return(getdata("growth"))ddalpha/R/separator.polynomial.r0000644000176200001440000001423614213423775016433 0ustar liggesusers .ddalpha.learn.polynomial <- function(ddalpha){ # Separating (calculating extensions and normals) counter <- 1 # Determining multi-class behaviour if (ddalpha$methodAggregation == "majority"){ for (i in 1:(ddalpha$numPatterns - 1)){ for (j in (i + 1):ddalpha$numPatterns){ # Creating a classifier polynomial <- .polynomial_learn_C(ddalpha$maxDegree, rbind(ddalpha$patterns[[i]]$depths, ddalpha$patterns[[j]]$depths), ddalpha$patterns[[i]]$cardinality, ddalpha$patterns[[j]]$cardinality, ddalpha$numChunks, ddalpha$seed) # DEBUG if (F){ print(polynomial$coefficients) print(GetEmpiricalRisk (polynomial$coefficients, rbind(ddalpha$patterns[[i]]$depths, ddalpha$patterns[[j]]$depths), ddalpha$patterns[[i]]$cardinality, ddalpha$patterns[[j]]$cardinality)) } # Adding the classifier to the list of classifiers ddalpha$classifiers[[counter]] <- list( index = counter, index1 = i, index2 = j, polynomial = polynomial$coefficients, degree = polynomial$degree, axis = polynomial$axis) counter <- counter + 1 } } ddalpha$numClassifiers <- counter - 1 } if (ddalpha$methodAggregation == "sequent"){ for (i in 1:ddalpha$numPatterns){ anotherClass <- NULL for (j in 1:ddalpha$numPatterns){ if (j != i){ anotherClass <- rbind(anotherClass, ddalpha$patterns[[j]]$depths) } } polynomial <- .polynomial_learn_C(ddalpha$maxDegree, rbind(ddalpha$patterns[[i]]$depths, anotherClass), ddalpha$patterns[[i]]$cardinality, nrow(anotherClass), ddalpha$numChunks, ddalpha$seed) # Adding the classifier to the list of classifiers ddalpha$classifiers[[i]] <- list(index = counter, index1 = i, index2 = -1, polynomial = polynomial$coefficients, degree = polynomial$degree, axis = polynomial$axis) } ddalpha$numClassifiers <- ddalpha$numPatterns } return (ddalpha) } ################################################################################ # Functions for intermediate calculations are presented below ################################################################################ .polynomial_learn_C <- function(maxDegree, data, numClass1, numClass2, numChunks, seed){ points <- as.vector(t(data)) numPoints <- numClass1 + numClass2 dimension <- ncol(data) cardinalities <- c(numClass1, numClass2) upToPower <- maxDegree minFeatures <- 2 maxExtDimension <- (factorial(dimension + maxDegree) / (factorial(dimension)*factorial(maxDegree))) - 1; res <- .C("PolynomialLearnCV", as.double(points), as.integer(numPoints), as.integer(dimension), as.integer(cardinalities), as.integer(upToPower), as.integer(numChunks), as.integer(seed), degree = integer(1), axis = integer(1), polynomial=double(upToPower)) degree <- res$degree axis <- res$axis polynomial <- res$polynomial[1:degree] return(list(coefficients = polynomial, axis = axis, degree = degree)) } GetNumsErrors <- function(polynomial, depths, numClass1, numClass2){ # Calculates the number of classification error for two classes on the # basis of given depths # # Args: # polynomial: Polynomial as a vector of coefficients starting with the # first degree (a0 = 0 always) # depths: nx2 matrix of depths, where each column contains the depths # against the corresponding class # numClass1: Number of points belonging to the first class # numClass2: Number of points belonging to the second class # Returns: # Vector containing number of errors of the points from the firts and # the second class degree <- length(polynomial) numErrors1 <- 0 if(numClass1 != 0){ for(i in 1:numClass1){ val <- depths[i,1] res <- 0 for(j in 1:degree){res <- res + polynomial[j]*val^j} if(depths[i,2] > res){ numErrors1 <- numErrors1 + 1 } } } numErrors2 <- 0 if(numClass2 != 0){ for(i in (numClass1 + 1):(numClass1 + numClass2)){ val <- depths[i,1] res <- 0 for(j in 1:degree){res <- res + polynomial[j]*val^j} if(depths[i,2] < res){ numErrors2 <- numErrors2 + 1 } } } return(c(numErrors1, numErrors2)) } GetEmpiricalRiskSmoothed <- function(polynomial, depths, numClass1, numClass2){ res = (colSums(sapply(depths[,1], '^', (1:length(polynomial)))*polynomial) - depths[,2])*c(rep(-1, numClass1), rep(1, numClass2)) risk = sum(1/(1 + exp(-100*(res)))) return (risk/(numClass1 + numClass2)) } GetEmpiricalRisk <- function(polynomial, depths, numClass1, numClass2){ # Calculates the empirical risk for two classes on the basis of given depths # # Args: # polynomial: Polynomial as a vector of coefficients starting with the # first degree (a0 = 0 always) # depths: nx2 matrix of depths, where each column contains the depths # against the corresponding class # numClass1: Number of points belonging to the first class # numClass2: Number of points belonging to the second class # Returns: # Empirical risk risk1 <- 0 degree <- length(polynomial) for(i in 1:numClass1){ val <- depths[i,1] res <- 0 for(j in 1:degree){res <- res + polynomial[j]*val^j} if(depths[i,2] > res){ risk1 <- risk1 + 1 } } risk2 <- 0 for(i in (numClass1 + 1):(numClass1 + numClass2)){ val <- depths[i,1] res <- 0 for(j in 1:degree){res <- res + polynomial[j]*val^j} if(depths[i,2] < res){ risk2 <- risk2 + 1 } } risk <- (risk1 + risk2)/(numClass1 + numClass2) return(risk) } ddalpha/R/depth.simplicialVolume.r0000644000176200001440000000710114213423775016663 0ustar liggesusers################################################################################ # File: depth.simplicialVolume.r # Created by: Oleksii Pokotylo, Pavlo Mozharovskyi # First published: 15.06.2015 # Last revised: 20.02.2019 # # Computation of the simplicial volume data depth. ################################################################################ .longtoint <- function(k){ limit = 2000000000 k1 = as.integer(k/limit) k2 = k - k1*limit return(c(k1, k2)) } depth.simplicialVolume <- function(x, data, exact = F, k = 0.05, mah.estimate = "moment", mah.parMcd = 0.75, seed = 0){ if (seed!=0) set.seed(seed) if (!is.matrix(x) && is.vector(x)){ x <- matrix(x, nrow=1) } if (!(is.matrix(data) && is.numeric(data) || is.data.frame(data) && prod(sapply(data, is.numeric))) || ncol(data) < 2){ stop("Argument \"data\" should be a numeric matrix of at least 2-dimensional data") } if (!is.numeric(x)){ stop("Argument \"x\" should be numeric") } if (ncol(x) != ncol(data)){ stop("Dimensions of the arguments \"x\" and \"data\" should coincide") } if (ncol(data) + 1 > nrow(data)){ #? stop("To few data points") } if (!exact) if (k <= 0) stop("k must be positive") else if (k < 1) k = choose(nrow(data), ncol(data))*k if(toupper(mah.estimate) == "NONE"){ useCov <- 0 covEst <- diag(ncol(data)) } else if(toupper(mah.estimate) == "MOMENT"){ useCov <- 1 covEst <- cov(data) } else if(toupper(mah.estimate) == "MCD"){ useCov <- 2 covEst <- covMcd(data, mah.parMcd)$cov } else {stop("Wrong argument \"mah.estimate\", should be one of \"moment\", \"MCD\", \"none\"")} points <- as.vector(t(data)) objects <- as.vector(t(x)) ds <- .C("OjaDepth", as.double(points), as.double(objects), as.integer(nrow(data)), as.integer(nrow(x)), as.integer(ncol(data)), as.integer(seed), as.integer(exact), as.integer(.longtoint(k)), as.integer(useCov), as.double(as.vector(t(covEst))), depths=double(nrow(x)))$depths return (ds) } depth.space.simplicialVolume <- function(data, cardinalities, exact = F, k = 0.05, mah.estimate = "moment", mah.parMcd = 0.75, seed = 0){ if (!(is.matrix(data) && is.numeric(data) || is.data.frame(data) && prod(sapply(data, is.numeric))) || ncol(data) < 2){ stop("Argument \"data\" should be a numeric matrix of at least 2-dimensional data") } if (!is.vector(cardinalities, mode = "numeric") || is.na(min(cardinalities)) || sum(.is.wholenumber(cardinalities)) != length(cardinalities) || min(cardinalities) <= 0 || sum(cardinalities) != nrow(data)){ stop("Argument \"cardinalities\" should be a vector of cardinalities of the classes in \"data\" ") } if (sum(cardinalities < ncol(data) + 1) != 0){ stop("Not in all classes sufficiently enough objetcs") } if (toupper(mah.estimate) == "NONE"){ useCov <- 0 } else if (toupper(mah.estimate) == "MOMENT"){ useCov <- 1 } else if (toupper(mah.estimate) == "MCD"){ useCov <- 2 } else {stop("Wrong argument \"mah.estimate\", should be one of \"moment\", \"MCD\", \"none\"")} depth.space <- NULL for (i in 1:length(cardinalities)){ pattern <- data[(1 + sum(cardinalities[0:(i - 1)])):sum(cardinalities[1:i]),] pattern.depths <- depth.simplicialVolume(data, pattern, exact, k, mah.estimate, mah.parMcd, seed) depth.space <- cbind(depth.space, pattern.depths, deparse.level = 0) } return (depth.space) } ddalpha/R/depthf.simplicialBand.R0000644000176200001440000001104314213423775016366 0ustar liggesusersdepthf.simplicialBand <- function(objectsf, dataf, modified = TRUE, J = NULL, range = NULL, d = 101){ # Calculate the simplicial band depth # Follows the article: # Lopez-Pintado, Sun, Lin, Genton (2014). # "Simplicial band depth for multivariate data", # Advances in Data Analysis and Classification, 8(3), 321-338. # Args: # objectsf: functoins for which the depth should be computed; a list # containing lists (functions) of two vectors of equal length, # named "args" and "vals": arguments sorted in ascending order # and corresponding them values respectively. # dataf: data sample of functoins w.r.t. which the depth should be # computed; structure as for "objectsf". # modified: whether modified simplicial band depth should be computed; # logical, TRUE by default. # J: how many functions to consider in each tuple of the # U-statistics; integer, d+1 by default. # range: The common range of the domain where the functions of objectsf # and dataf are observed. Vector of length 2 with the left and # the right end of the interval. Must contain all arguments given # in objectsf and dataf. # d: Grid size to which all the functional data are transformed. For # depth computation, all functional observations are first # transformed into vectors of their functional values of # length d corresponding to equi-spaced points in the domain # given by the interval range. Functional values in these points # are reconstructed using linear interpolation, and extrapolation. # Returns: # A vector of depths of each of "objectsf" w.r.t. "dataf". # Check input data for consistency: if (length(objectsf) < 1){ stop("Number of functions for which the depth should be computed is < 1.") } #if (J < 2){ # stop("Impossible to calculate depth with 'J' < 2.") #} p <- ifelse(is.null(dim(objectsf[[1]]$vals)), 1, dim(objectsf[[1]]$vals)[2]) J <- p + 1 if (length(dataf) < J){ stop("Number of functions w.r.t. which the depth should be computed is < dimension + 1.") } m <- length(objectsf) n <- length(dataf) objArgs <- unique(unlist(lapply(objectsf, function(x){return(x$args)}))) datArgs <- unique(unlist(lapply(dataf, function(x){return(x$args)}))) if (length(objArgs) != length(datArgs) || sum(objArgs == datArgs) != length(objArgs)){ stop("Not the same arguments for 'objectsf' and 'dataf'.") } l <- length(objArgs) numObjArgs <- unlist(lapply(objectsf, function(x){return(length(x$args))})) if (sum(numObjArgs == length(objArgs)) != m){ stop("Not the same arguments for all functions in 'objectsf'.") } numDatArgs <- unlist(lapply(dataf, function(x){return(length(x$args))})) if (sum(numDatArgs == length(datArgs)) != n){ stop("Not the same arguments for all functions in 'dataf'.") } if (p == 1){ numObjVals <- unlist(lapply(objectsf, function(x){return(length(x$vals))})) numDatVals <- unlist(lapply(dataf, function(x){return(length(x$vals))})) }else{ numObjVals <- unlist(lapply(objectsf, function(x){return(nrow(x$vals))})) numDatVals <- unlist(lapply(dataf, function(x){return(nrow(x$vals))})) } if (sum(numObjVals == numObjArgs) != m){ stop("Number of arguments and values for (some) functions in 'objectsf' differ.") } if (sum(numDatVals == numDatArgs) != n){ stop("Number of arguments and values for (some) functions in 'dataf' differ.") } # Interpolate the data and prepare it for the C++ transfer A <- dataf2rawfd(objectsf, range = range, d = d) B <- dataf2rawfd(dataf, range = range, d = d) At <- apply(A, 1, function(x) t(x)) Bt <- apply(B, 1, function(x) t(x)) fArgs <- approx(dataf[[1]]$args, n = d)$x # fArgs <- objectsf[[1]]$args #fObjVals <- unlist(lapply(A, function(x){return(t(x$vals))})) #fDatVals <- unlist(lapply(B, function(x){return(t(x$vals))})) # Call the C++ routine #print(as.double(fObjVals)) #print(as.double(fDatVals)) #print(as.integer(m)) #print(as.integer(n)) #print(as.integer(l)) #print(as.integer(d)) ds <- .C("SimplicialBandDepthF", as.double(At), as.double(Bt), as.double(fArgs), as.integer(m), as.integer(n), as.integer(d), as.integer(p), as.integer(modified), as.integer(J), depths = double(m))$depths return(ds) } ddalpha/R/is.in.convex.r0000644000176200001440000000257214213423775014572 0ustar liggesusers################################################################################ # File: is.in.convex.r # Created by: Pavlo Mozharovskyi # First published: 28.02.2013 # Last revised: 28.02.2013 # # Check if points lie in the convex hulls of the data clouds. ################################################################################ is.in.convex <- function(x, data, cardinalities, seed = 0){ if (!is.numeric(data) || !is.matrix(data) || ncol(data) < 2){ stop("Argument \"data\" should be a numeric matrix of at least 2-dimensional data") } if (!is.vector(cardinalities, mode = "numeric") || is.na(min(cardinalities)) || sum(.is.wholenumber(cardinalities)) != length(cardinalities) || min(cardinalities) <= 0 || sum(cardinalities) != nrow(data)){ stop("Argument \"cardinalities\" should be a vector of cardinalities of the classes in \"data\" ") } if (sum(cardinalities < ncol(data) + 1) != 0){ stop("Not in all classes sufficiently enough objetcs") } if (!is.matrix(x) && is.vector(x)){ x <- matrix(x, nrow=1) } if (!is.numeric(x)){ stop("Argument \"x\" should be numeric") } if (ncol(x) != ncol(data)){ stop("Dimensions of the arguments \"x\" and \"data\" should coincide") } is.in.convex <- .count_convexes(x, data, cardinalities, seed) return (is.in.convex) } ddalpha/R/depth.L2.r0000644000176200001440000000671214213423775013631 0ustar liggesusers################################################################################ # File: depth.L2.r # Created by: Pavlo Mozharovskyi # First published: 08.03.2018 # Last revised: 08.03.2018 # # Computation of the L2-depth. ################################################################################ .L2_validate <- function(ddalpha, mah.estimate = "moment", mah.parMcd = 0.75, ...) { # only validate and stop if anything is wrong if( !(toupper(mah.estimate) %in% c("NONE", "MOMENT", "MCD"))){ stop("Wrong argument \"mah.estimate\", should be one of \"moment\", \"MCD\", \"none\"") } return (list(mah.estimate = mah.estimate, mah.parMcd = mah.parMcd)) } .L2_learn <- function(ddalpha) { #1. Calculate statistics based on data if(toupper(ddalpha$mah.estimate) == "NONE"){ for (i in 1:ddalpha$numPatterns){ ddalpha$patterns[[i]]$sigma <- diag(ddalpha$dimension) } } else { for (i in 1:ddalpha$numPatterns){ if(toupper(ddalpha$mah.estimate) == "MOMENT"){ cov <- cov(as.matrix(ddalpha$patterns[[i]]$points)) } else if(toupper(ddalpha$mah.estimate) == "MCD"){ cov <- covMcd(as.matrix(ddalpha$patterns[[i]]$points), ddalpha$mah.parMcd)$cov } else {stop("Wrong argument \"mah.estimate\", should be one of \"moment\", \"MCD\", \"none\"")} if(sum(is.na(cov)) == 0){ ddalpha$patterns[[i]]$sigma <- solve(cov) } else{ ddalpha$patterns[[i]]$sigma <- diag(ddalpha$dimension) warning("Covariance estimate not found for pattern ", ddalpha$patterns[[i]]$name, ", no affine-invariance-adjustment") } } } #2. Calculate depths for each pattern for (i in 1:ddalpha$numPatterns){ ddalpha$patterns[[i]]$depths = .L2_depths(ddalpha, ddalpha$patterns[[i]]$points) } return (ddalpha) } .L2_depths <- function(ddalpha, objects){ depths <- NULL objects = data.matrix(objects) for (j in 1:ddalpha$numPatterns){ pattern <- as.matrix(ddalpha$patterns[[j]]$points) sigma = ddalpha$patterns[[j]]$sigma ds <- rep(-1, nrow(objects)) for (i in 1:nrow(objects)){ tmp1 <- t(objects[i,] - t(pattern)) tmp2 <- tmp1 %*% sigma ds[i] <- 1/(1 + mean(sqrt(rowSums(tmp2 * tmp1)))) } depths <- cbind(depths, ds) } return (depths) } depth.L2 <- function(x, data, mah.estimate = "moment", mah.parMcd = 0.75){ if (!(is.matrix(data) && is.numeric(data) || is.data.frame(data) && prod(sapply(data, is.numeric))) || ncol(data) < 2){ stop("Argument \"data\" should be a numeric matrix of at least 2-dimensional data") } if(is.data.frame(data)) data = data.matrix(data) if (!is.matrix(x)){ if(is.vector(x)) x <- matrix(x, nrow=1) if(is.data.frame(x)) x = data.matrix(x) } if(toupper(mah.estimate) == "NONE"){ sigma = diag(ncol(data)) } else { if(toupper(mah.estimate) == "MOMENT"){ cov <- cov(data) } else if(toupper(mah.estimate) == "MCD"){ cov <- covMcd(data, mah.parMcd)$cov } else {stop("Wrong argument \"mah.estimate\", should be one of \"moment\", \"MCD\", \"none\"")} if(sum(is.na(cov)) == 0){ sigma <- solve(cov) } else{ sigma = diag(ncol(data)) warning("Covariance estimate not found, no affine-invariance-adjustment") } } depths <- rep(-1, nrow(x)) for (i in 1:nrow(x)){ tmp1 <- t(x[i,] - t(data)) tmp2 <- tmp1 %*% sigma depths[i] <- 1/(1 + mean(sqrt(rowSums(tmp2 * tmp1)))) } return (depths) } ddalpha/R/ddalphaf.test.r0000644000176200001440000000606414213423775014772 0ustar liggesusersddalphaf.test <- function(learn, learnlabels, test, testlabels, disc.type = c("LS", "comp"), ...){ ops <- options(warn = -1) on.exit(options(ops)) disc.type <- match.arg(disc.type) ftrain = switch(disc.type, "LS" = ddalphaf.train, "comp" = compclassf.train ) fclassify = switch(disc.type, "LS" = ddalphaf.classify, "comp" = compclassf.classify ) tryCatch({ time <- system.time( ddalpha <- ftrain(learn, learnlabels, ...) ) cc = fclassify(objectsf = test,ddalphaf = ddalpha) if (is.numeric(testlabels[[1]])){ if(is.factor(cc[[1]]) || is.character(cc[[1]])){ cc <- unlist(lapply(cc, as.character)) cc[cc == "Ignored"] <- NA } equal = (cc == testlabels) } else { cc <- unlist(lapply(cc, as.character)) equal = (cc == as.character(testlabels)) } if(!(T %in% equal) && !(F %in% equal)) { return(NA)} error = sum(!equal,na.rm = T)/(sum(!equal,na.rm = T)+sum(equal,na.rm = T)) return(list(error = error, correct = sum(equal,na.rm = T), incorrect = sum(!equal,na.rm = T), total = length(cc)-sum(is.na(equal)), ignored = sum(is.na(equal)), n = length(cc), time = time[1])) } # tryCatch({} , error = function(e) { print ("ERROR T") print (e) }, finally = { }) return (NA) } ddalphaf.getErrorRateCV <- function(dataf, labels, numchunks = 10, disc.type = c("LS", "comp"), ...){ n = length(dataf) numchunks = min(n, numchunks) chunksize = ceiling(n/numchunks) sample = seq(from = 1, by = numchunks, length.out = chunksize) errors = 0 total = 0 times = c() for (i in 1:numchunks){ sample = sample[sample<=n] learn = dataf[-sample] test = dataf[sample] learnlabels = labels[-sample] testlabels = labels[sample] el = ddalphaf.test(learn, learnlabels, test, testlabels, disc.type, ...) if(is.list(el)){ errors = errors + el$incorrect total = total + el$total times = c(times,el$time) } sample = sample+1 } return (list(errors = errors/total, time = mean(times), time_sd = sd(times))) } ddalphaf.getErrorRatePart <- function(dataf, labels, size = 0.3, times = 10, disc.type = c("LS", "comp"), ...){ if (!is.numeric(size) || size <=0 || size >= length(dataf)) stop("Wrong size of excluded sequences") if(size < 1) size = max(1, size*length(dataf)) # at least 1 point size = as.integer(size) indexes = 1:length(dataf) errors = c() total = 0 time = c() for (i in 1:times){ samp = sample(indexes, size) learn = dataf[-samp] test = dataf[samp] learnlabels = labels[-samp] testlabels = labels[samp] el = ddalphaf.test(learn, learnlabels, test, testlabels, disc.type, ...) if(is.list(el)){ errors = c(errors,el$incorrect/el$total) time = c(time,el$time) } } return (list(errors = mean(errors), errors_sd = sd(errors), errors_vec = errors, time = mean(time), time_sd = sd(time))) }ddalpha/R/depth.qhpeeling.r0000644000176200001440000000446614213423775015334 0ustar liggesusers################################################################################ # File: depth.qhpeeling.r # Created by: Pavlo Mozharovskyi # First published: 08.03.2018 # Last revised: 08.03.2018 # # Computation of the convex hull peeling depth. ################################################################################ .qhpeeling_validate <- function(ddalpha, ...) { return (list()) } .qhpeeling_learn <- function(ddalpha) { # Calculate depths for each pattern for (i in 1:ddalpha$numPatterns){ ddalpha$patterns[[i]]$depths = .qhpeeling_depths(ddalpha, ddalpha$patterns[[i]]$points) } # Return the updated structure return (ddalpha) } .qhpeeling_depths <- function(ddalpha, objects){ depths <- NULL objects = data.matrix(objects) for (j in 1:ddalpha$numPatterns){ pattern <- as.matrix(ddalpha$patterns[[j]]$points) ds <- rep(0, nrow(objects)) tmpData <- pattern for (i in 1:nrow(pattern)){ if (length(tmpData) < ncol(pattern) * (ncol(pattern) + 1) + 0.5){ break } ds <- ds + as.vector(is.in.convex(objects, tmpData, nrow(tmpData))) tmpData <- tmpData[-unique(as.vector(convhulln(tmpData))),] } ds = ds / nrow(pattern) depths <- cbind(depths, ds) } return (depths) } depth.qhpeeling <- function(x, data){ if (!is.matrix(x) && is.vector(x)){ x <- matrix(x, nrow=1) } if (!(is.matrix(data) && is.numeric(data) || is.data.frame(data) && prod(sapply(data, is.numeric))) || ncol(data) < 2){ stop("Argument \"data\" should be a numeric matrix of at least 2-dimensional data") } if (!is.numeric(x)){ stop("Argument \"x\" should be numeric") } if (ncol(x) != ncol(data)){ stop("Dimensions of the arguments \"x\" and \"data\" should coincide") } if (ncol(data) + 1 > nrow(data)){ #? stop("Too few data points") } if (is.data.frame(x)){ x <- as.matrix(x) } if (is.data.frame(data)){ data <- as.matrix(data) } depths <- rep(0, nrow(x)) tmpData <- data for (i in 1:nrow(data)){ if (length(tmpData) < ncol(data) * (ncol(data) + 1) + 0.5){ break } depths <- depths + as.vector(is.in.convex(x, tmpData, nrow(tmpData))) tmpData <- tmpData[-unique(as.vector(convhulln(tmpData))),] } return (depths / nrow(data)) } ddalpha/R/dataf.population.r0000644000176200001440000000007414213423775015514 0ustar liggesusersdataf.population <- function() return(getdata("population"))ddalpha/R/mahalanobis.scaling.r0000644000176200001440000000715014213423775016143 0ustar liggesusers mah.moment <- function(x){ mu <- colMeans(x) scale.eig <- eigen(cov(x)) B <- scale.eig$vectors %*% diag(sqrt(scale.eig$values)) B_inv <- solve(B) return (list(mu = as.numeric(mu), b = B_inv, s = cov(x))) } mah.mcd <- function(x, alpha = 1/2){ #library(robustbase) estimate <- covMcd(x, alpha = alpha) mu <- estimate$center scale.eig <- eigen(estimate$cov) B <- scale.eig$vectors %*% diag(sqrt(scale.eig$values)) B_inv <- solve(B) return (list(mu = as.numeric(mu), b = B_inv, s = estimate$cov)) } mah.transform <- function (x, mu, B_inv, inv = F) { if (inv) return (t(solve(B_inv) %*% (t(x))+mu)) return (t(B_inv %*% (t(x)-mu))) } mah.transform.back <- function (x, mu, B_inv) { return (t(solve(B_inv) %*% (t(x))+mu)) } MahMomentTransformer <- function(mu, b){ f <- function(points, inv = F){ return(mah.transform(points, mu, b, inv)) } environment(f) <- new.env() environment(f)$mu = mu environment(f)$b = b return (f) } # mahalanobisRegionsX <- function(x, depths = c(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1), col = "black"){ # c <- c(0,0) # for (i in 1:nrow(x)){ # c <- c + x[i,] # } # mu <- c / nrow(x) # # mahalanobisRegions(mu, cov(x), col) # } # # mahalanobisRegions <- function(mu, s, depths = c(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1), col = "black"){ # sigma.inv <- solve(s) # for (i in 1:length(depths)){ # ellipsem(mu = mu, amat = sigma.inv, c2 = 1/depths[i] - 1, showcentre = F, col = col) # } # } depth.Mahalanobis <- function(x, data, mah.estimate = "moment", mah.parMcd = 0.75){ if (mah.estimate == "moment") s = solve(cov(data)) else if (mah.estimate == "MCD") s = solve(covMcd(data, alpha = mah.parMcd)$cov) else stop ("Wrong parameter 'estimate'") if (is.matrix(x) || is.data.frame(x)) { nx = nrow(x) if (ncol(x) != ncol(data)) stop("Wrong dimension of x") } else if (is.vector(x)) { nx = 1 if (length(x) != ncol(data)) stop("Wrong dimension of x") } else stop("Wrong type of x") # if (mah.estimate == "MCD"){ # MCD in c++ is much slower depths <- .Mahalanobis_depth(x, center = colMeans(data), sigma = s) return (depths) # } points <- as.vector(t(data)) objects <- as.vector(t(x)) depths <- .C("MahalanobisDepth", as.double(points), as.double(objects), as.integer(nrow(data)), as.integer(nx), as.integer(ncol(data)), as.double(mah.parMcd), depths=double(nx))$depths return (depths) } depth.space.Mahalanobis <- function(data, cardinalities, mah.estimate = "moment", mah.parMcd = 0.75){ if (is.data.frame(data)) data <- data.matrix(data) if (!is.numeric(data) || !is.matrix(data) || ncol(data) < 2){ stop("Argument \"data\" should be a numeric matrix of at least 2-dimensional data") } if (!is.vector(cardinalities, mode = "numeric") || is.na(min(cardinalities)) || sum(.is.wholenumber(cardinalities)) != length(cardinalities) || min(cardinalities) <= 0 || sum(cardinalities) != nrow(data)){ stop("Argument \"cardinalities\" should be a vector of cardinalities of the classes in \"data\" ") } if (sum(cardinalities < ncol(data) + 1) != 0){ stop("Not in all classes sufficiently enough objetcs") } depth.space <- NULL for (i in 1:length(cardinalities)){ pattern <- data[(1 + sum(cardinalities[0:(i - 1)])):sum(cardinalities[1:i]),] pattern.depths <- depth.Mahalanobis (data, pattern, mah.estimate, mah.parMcd) depth.space <- cbind(depth.space, pattern.depths, deparse.level = 0) } return (depth.space) } ddalpha/R/lda.r0000644000176200001440000000052014550243575013002 0ustar liggesuserslda_train <- function(data){ new.frm <- data.frame(data) z <- lda(formula=as.formula(paste("X", ncol(data), " ~ .", sep="")), data = new.frm, tol = sqrt(.Machine$double.eps))#, prior = rep(1, dimension)/dimension) return (z) } lda_classify <- function(objects, lda){ z <- predict(lda, data.frame(objects))$class return (z) } ddalpha/R/dataf.population2010.r0000644000176200001440000000010414213423775016011 0ustar liggesusersdataf.population2010 <- function() return(getdata("population2010"))ddalpha/R/depth.graph.r0000644000176200001440000000715514213423775014457 0ustar liggesusers################################################################################ # File: depth.graph.r # Created by: Oleksii Pokotylo # First published: 01.10.2014 # Last revised: 01.10.2014 # # Builds the data depth surfaces for 2-dimensional data ################################################################################ depth.graph <- function (data, depth_f = c("halfspace", "Mahalanobis", "projection", "simplicial", "simplicialVolume", "spatial", "zonoid", "none"), apoint = NULL , main = depth_f , xlim = c(min(data[,1]), max(data[,1])), ylim = c(min(data[,2]), max(data[,2])), zlim = c(0,max(z)) , xnum = 250, ynum = 250 , theta=15, phi=60, bold = F, ...){ x1 <- seq(xlim[1], xlim[2], length = xnum) x2 <- seq(ylim[1], ylim[2], length = ynum) x1.step <- (x1[2]-x1[1]) x2.step <- (x2[2]-x2[1]) all.points <- as.matrix(expand.grid(x1, x2)) all.depths <- rep(0, nrow(all.points)) #library(depth) df = depth_f if (!is.function(depth_f)){ depth_f = match.arg (depth_f) df = switch(depth_f, "none" = function(x, X,...) (0), "zonoid" = depth.zonoid, "halfspace" = depth.halfspace, "simplicialVolume" = depth.simplicialVolume, "simplicial" = depth.simplicial, "Mahalanobis" = function(x, X,...) (.Mahalanobis_depth(x, colMeans(X), solve(cov(X)))), "projection" = depth.projection, "spatial" = depth.spatial ) if (depth_f == "none") zlim = c(0,1) } all.depths = df(all.points, data[,1:2], ...) z <- matrix(all.depths, ncol=ynum, nrow=xnum, byrow=FALSE) z.red <- as.integer((data[,1]-x1[1])/x1.step+1) + as.integer((data[,2]-x2[1])/x2.step+1)*(xnum-1) if (bold) z.red <- c(z.red, as.integer((data[,1]-x1[1])/x1.step+2) + as.integer((data[,2]-x2[1])/x2.step+1)*(xnum-1), as.integer((data[,1]-x1[1])/x1.step+1) + as.integer((data[,2]-x2[1])/x2.step+2)*(xnum-1), as.integer((data[,1]-x1[1])/x1.step+0) + as.integer((data[,2]-x2[1])/x2.step+1)*(xnum-1), as.integer((data[,1]-x1[1])/x1.step+1) + as.integer((data[,2]-x2[1])/x2.step+0)*(xnum-1) ) if (!is.null(apoint) && is.numeric(apoint) && length(apoint) == 2){ z.black <- as.integer((apoint[1]-x1[1])/x1.step+1) + as.integer((apoint[2]-x2[1])/x2.step+1)*(xnum-1) if (bold){ z.black <- c(z.black, as.integer((apoint[1]-x1[1])/x1.step+2) + as.integer((apoint[2]-x2[1])/x2.step+1)*(xnum-1), as.integer((apoint[1]-x1[1])/x1.step+1) + as.integer((apoint[2]-x2[1])/x2.step+2)*(xnum-1), as.integer((apoint[1]-x1[1])/x1.step+0) + as.integer((apoint[2]-x2[1])/x2.step+1)*(xnum-1), as.integer((apoint[1]-x1[1])/x1.step+1) + as.integer((apoint[2]-x2[1])/x2.step+0)*(xnum-1) ) } }else{ z.black <- NA } zfacet <- z[-1, -1] + z[-1, -ynum] + z[-xnum, -1] + z[-xnum, -ynum] z.indices.zero <- which(zfacet == 0) cols <- rep("gray", (xnum-1)*(ynum-1)) cols <- replace(cols, z.indices.zero, ifelse (depth_f == "none", NA,"lightblue")) cols <- replace(cols, z.red, "red") cols <- replace(cols, z.black, "black") par(bg = "white") persp(x1, x2, z, xlim=xlim, ylim=ylim, zlim=zlim, r = 10, theta=theta, phi=phi, col=cols, main = main, ltheta=55, shade=0.55, ticktype="detailed", xlab="x", ylab="y", zlab="D(x|X)", border=NA, box=FALSE, ...) } ddalpha/R/depth.zonoid.r0000644000176200001440000000245314213423775014654 0ustar liggesusers################################################################################ # File: depth.zonoid.r # Created by: Pavlo Mozharovskyi # First published: 28.02.2013 # Last revised: 15.05.2013 # # Computation of the zonoid data depth. ################################################################################ depth.zonoid <- function(x, data, seed = 0){ if (seed!=0) set.seed(seed) if (!is.matrix(x) && is.vector(x)){ x <- matrix(x, nrow=1) } if (!(is.matrix(data) && is.numeric(data) || is.data.frame(data) && prod(sapply(data, is.numeric))) || ncol(data) < 2){ stop("Argument \"data\" should be a numeric matrix of at least 2-dimensional data") } if (!is.numeric(x)){ stop("Argument \"x\" should be numeric") } if (ncol(x) != ncol(data)){ stop("Dimensions of the arguments \"x\" and \"data\" should coincide") } if (ncol(data) + 1 > nrow(data)){ #? stop("To few data points") } points <- as.vector(t(data)) objects <- as.vector(t(x)) ds <- .C("ZDepth", as.double(points), as.double(objects), as.integer(nrow(data)), as.integer(nrow(x)), as.integer(ncol(data)), as.integer(seed), depths=double(nrow(x)))$depths return (ds) } ddalpha/R/routines.r0000644000176200001440000000223314213423775014113 0ustar liggesusersis.numeric_data.frame <- function(x){ if (is.data.frame(x) && all(sapply(x,base::is.numeric))) return (T) return (F) } is.numeric <- function(x){ if (base::is.numeric(x)) return (T) if (is.data.frame(x) && all(sapply(x,base::is.numeric))) return (T) return (F) } resetPar <- function() { dev.new() op <- par(no.readonly = TRUE) dev.off() op } is.sorted <- function(x) { return(!is.unsorted(x)) } tryCatchCapture <- function(expr, warn = T, err = T) { val <- NULL myWarnings <- NULL wHandler <- function(w) { myWarnings <<- c(myWarnings, w$message) invokeRestart("muffleWarning") } myError <- NULL eHandler <- function(e) { myError <<- e$message NULL } if(warn && err){ val <- tryCatch(withCallingHandlers(expr, warning = wHandler), error = eHandler) return(list(value = val, warnings = myWarnings, error=myError)) } if(warn){ val <- tryCatch(withCallingHandlers(expr, warning = wHandler)) return(list(value = val, warnings = myWarnings)) } if(err){ val <- tryCatch(expr, error = eHandler) return(list(value = val, error=myError)) } val <- expr return(list(value = val)) } ddalpha/R/depth.halfspace.r0000644000176200001440000001407414213423775015302 0ustar liggesusers################################################################################ # File: depth.halfspace.r # Created by: Pavlo Mozharovskyi # First published: 28.02.2013 # Last revised: 13.11.2015 # # Computation of the Tukey data depth. ################################################################################ .parse_HSD_pars <- function(exact, method){ if(missing(exact) && missing(method)) return(0) if(!missing(exact)){ if(exact == F){ if (missing(method)) return(0) else if (method != 0 && method != "Sunif.1D") stop("Wrong combination of 'exact' and 'method' parameters.") } else{ if (missing(method)) return(1) # default exact else if (!(method %in% 1:3 || method %in% c("recursive","plane","line"))) stop("Wrong combination of 'exact' and 'method' parameters.") } } if (!(method %in% 0:3 || method %in% c("Sunif.1D","recursive","plane","line"))) stop("Wrong parameter 'method'.") if (is.character(method)) method = switch (method, random = 0, recursive = 1, plane = 2, line = 3) return(method) } depth.halfspace <- function(x, data, exact, method, num.directions = 1000, seed = 0){ if (!is.matrix(x) && is.vector(x)){ x <- matrix(x, nrow=1) } if (!(is.matrix(data) && is.numeric(data) || is.data.frame(data) && prod(sapply(data, is.numeric))) || ncol(data) < 2){ stop("Argument \"data\" should be a numeric matrix of at least 2-dimensional data") } if (!is.numeric(x)){ stop("Argument \"x\" should be numeric") } if (ncol(x) != ncol(data)){ stop("Dimensions of the arguments \"x\" and \"data\" should coincide") } if (ncol(data) + 1 > nrow(data)){ #? stop("To few data points") } points <- as.vector(t(data)) objects <- as.vector(t(x)) method = .parse_HSD_pars(exact, method) if (method == 0) if (!is.numeric(num.directions) || is.na(num.directions) || length(num.directions) != 1 || !.is.wholenumber(num.directions) || !(num.directions > 1 && num.directions < 10000000)){ numDirections <- 1000 warning("Argument \"num.directions\" not specified correctly. 1000 is used as a default value") }else{ numDirections <- num.directions } if (method == 0){ c <- as.vector(nrow(data)) k <- numDirections ds <- .C("HDepth", as.double(points), as.double(objects), as.integer(nrow(x)), as.integer(ncol(data)), as.integer(c), as.integer(1), dirs=double(k*ncol(data)), prjs=double(k*nrow(data)), as.integer(k), as.integer(1), # use the same directions and projections as.integer(seed), depths=double(nrow(x)))$depths } else if (method %in% 1:3){ ds <- .C("HDepthEx", as.double(points), as.double(objects), as.integer(nrow(data)), as.integer(nrow(x)), as.integer(ncol(data)), as.integer(method), depths=double(nrow(x)))$depths } else stop("wrong choise of the algorithm, method = ", method) return (ds) } depth.space.halfspace <- function(data, cardinalities, exact, method, num.directions = 1000, seed = 0){ if (seed != 0) set.seed(seed) if (!(is.matrix(data) && is.numeric(data) || is.data.frame(data) && prod(sapply(data, is.numeric))) || ncol(data) < 2){ stop("Argument \"data\" should be a numeric matrix of at least 2-dimensional data") } if (!is.vector(cardinalities, mode = "numeric") || is.na(min(cardinalities)) || sum(.is.wholenumber(cardinalities)) != length(cardinalities) || min(cardinalities) <= 0 || sum(cardinalities) != nrow(data)){ stop("Argument \"cardinalities\" should be a vector of cardinalities of the classes in \"data\" ") } if (sum(cardinalities < ncol(data) + 1) != 0){ stop("Not in all classes sufficiently enough objetcs") } if (!is.numeric(num.directions) || is.na(num.directions) || length(num.directions) != 1 || !.is.wholenumber(num.directions) || !(num.directions > 1 && num.directions < 10000000)){ numDirections <- 1000 warning("Argument \"num.directions\" not specified correctly. 1000 is used as a default value") }else{ numDirections <- num.directions } x <- as.vector(t(data)) c <- as.vector(cardinalities) method = .parse_HSD_pars(exact, method) if (method == 0) if (!is.numeric(num.directions) || is.na(num.directions) || length(num.directions) != 1 || !.is.wholenumber(num.directions) || !(num.directions > 1 && num.directions < 10000000)){ numDirections <- 1000 warning("Argument \"num.directions\" not specified correctly. 1000 is used as a default value") }else{ numDirections <- num.directions } if (method == 0){ k <- numDirections rez <- .C("HDSpace", as.double(x), as.integer(ncol(data)), as.integer(c), as.integer(length(cardinalities)), as.integer(k), as.integer(1), as.integer(seed), dspc=double(nrow(data)*length(cardinalities)), dirs=double(k*ncol(data)), prjs=double(k*nrow(data))) depth.space <- matrix(rez$dspc, nrow=nrow(data), ncol=length(cardinalities), byrow=TRUE) }else if (method %in% 1:3){ ds <- .C("HDepthSpaceEx", as.double(x), as.double(x), as.integer(c), as.integer(length(cardinalities)), as.integer(nrow(data)), as.integer(ncol(data)), as.integer(method), depths=double(nrow(data)*length(cardinalities)))$depths depth.space <- matrix(ds, nrow=nrow(data), ncol=length(cardinalities), byrow=F) } else stop("wrong choise of the algorithm, method = ", method) return (depth.space) } ddalpha/R/depth.contours.r0000644000176200001440000003011714550224255015220 0ustar liggesusers################################################################################ # File: depth.contours.r # Created by: Oleksii Pokotylo # First published: 03.07.2015 # Last revised: 13.11.2015 # # Visualization of the depth contours ################################################################################ gcolors = c("red", "blue", "green", "orange", "violet") depth.contours.ddalpha <- function(ddalpha, main = "", xlab="", ylab = "", drawplot = T, frequency=100, levels = 10, drawsep = T, ...){ if(!inherits(ddalpha, "ddalpha")) stop("Not a 'ddalpha' classifier") if (ddalpha$dimension != 2) { warning ("The contours may be drawn only for 2 dimensional datasets") return(0) } if (ddalpha$needtransform == 1){ data = ddalpha$patterns[[1]]$transformer(ddalpha$patterns[[1]]$points, inv = T) for (i in 1:length(ddalpha$patterns)) data = rbind(data, ddalpha$patterns[[i]]$transformer(ddalpha$patterns[[i]]$points, inv = T)) }else{ data = ddalpha$patterns[[1]]$points for (i in 1:length(ddalpha$patterns)) data = rbind(data, ddalpha$patterns[[i]]$points) } classes = rep(gcolors[1], ddalpha$patterns[[1]]$cardinality) for (i in 1:length(ddalpha$patterns)) classes = c(classes, rep(gcolors[i], ddalpha$patterns[[i]]$cardinality)) margins = c(min(data[,1]), max(data[,1]), min(data[,2]), max(data[,2])); margins = margins + c(-0.1*(margins[2]-margins[1]), 0.1*(margins[2]-margins[1]), -0.1*(margins[4]-margins[3]), 0.1*(margins[4]-margins[3])) C = ncol(data) cr = 0 if (drawplot) plot(data, col = classes, main = main, xlab=xlab, ylab = ylab, ...) if (!is.null(ddalpha$methodDepth)) if (ddalpha$methodDepth == "Mahalanobis" && ddalpha$mahEstimate == "moment"){ # Mahalanobis depth for (i in seq(length(ddalpha$patterns))){ mahalanobisRegions(ddalpha$patterns[[i]]$points, levels, col = gcolors[i]) } } else if (ddalpha$methodDepth == "Mahalanobis" && ddalpha$mahEstimate == "MCD"){ # Mahalanobis depth mit MCD for (i in seq(length(ddalpha$patterns))){ mahalanobisMCDRegions(ddalpha$patterns[[i]]$points, ddalpha$mahParMcd, levels, col = gcolors[i]) } } else # if (ddalpha$methodDepth == "zonoid"){ # if (require(WMTregions)) # for (i in seq(length(ddalpha$patterns))){ # wmtRegions(ddalpha$patterns[[i]]$points, depths = c(1:9/10), trtype = "zonoid", col = gcolors[i]) # } # else{ # contourRegions(ddalpha, margins = margins, depths = c(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1), frequency=frequency) # } # } else # if (ddalpha$methodDepth == "halfspace"){ # library(depth) # for (i in seq(length(ddalpha$patterns))){ # locationRegions(ddalpha$patterns[[i]]$points, depths = c(1:9/10), col = gcolors[i]) # } # } else # no formal depth regions { cr = (contourRegions(ddalpha, margins = margins, depths = levels, frequency=frequency)) } lwd = 2 if(drawsep){ gx <- seq(min(ddalpha$raw[, 1]), max(ddalpha$raw[, 1]), length = frequency) gy <- seq(min(ddalpha$raw[, 2]), max(ddalpha$raw[, 2]), length = frequency) y <- as.matrix(expand.grid(gx, gy)) depthcontours = ddalpha.classify(ddalpha = ddalpha, objects = y) depthcontours = as.numeric(unlist(depthcontours)) contour(gx, gy, matrix(depthcontours, nrow=length(gx), ncol = length(gy)), add = TRUE, levels = unique(depthcontours)+0.5, drawlabels = FALSE, col = "black", lwd = lwd) } invisible(cr) } depth.contours <- function(data, depth, main = "", xlab="", ylab = "", drawplot = T, frequency=100, levels = 10, col = "red", ...){ if(!(is.matrix(data)||is.data.frame(data))) stop("Data is not a matrix or a data frame") if (ncol(data) != 2) { stop("The contours may be drawn only for 2 dimensional datasets") } if (drawplot){ cc = tryCatchCapture( plot(data, col = col, main = main, xlab=xlab, ylab = ylab, ...) , err = F) # catch all warnings about unused params wrns = sort(unique(cc$warnings)) unused = gsub("\"(.+)\".+", "\\1", wrns) if(length(unused)>0) warning("Unused by 'plot' arguments: ", paste(unused, collapse = ', ')) } margins = c(min(data[,1]), max(data[,1]), min(data[,2]), max(data[,2])); margins = margins + c(-0.1*(margins[2]-margins[1]), 0.1*(margins[2]-margins[1]), -0.1*(margins[4]-margins[3]), 0.1*(margins[4]-margins[3])) if (depth == "Mahalanobis"){ # Mahalanobis depth mahalanobisRegions(data, levels, col = col, ...) } else # if (depth == "zonoid"){ # if (require(WMTregions)) # wmtRegions(data, depths = c(1:9/10), trtype = "zonoid", col = col) # else{ # contourRegionsData(data, depth = depth, margins = margins, depths = c(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1), frequency=frequency, col = col, ...) # } # } else # if (depth == "halfspace"){ # library(depth) # locationRegions(data, depths = c(1:9/10), col = col) # } else # no formal depth regions { invisible(contourRegionsData(data, depth = depth, margins = margins, depths = levels, frequency=frequency, col = col, ...)) } invisible(0) } # wmtRegions <- function(x, depths = c(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9), trtype = "zonoid", col = "black"){ # fname <- "Cloud.dat" # #trname <- "TRegion_vertices.dat" # trname <- "tmp_vrtheap.dat" # fdir = getwd() # for (i in 1:length(depths)){ # ffullname = as.character(paste(fdir, "/", fname, sep = "")) # write(trtype, ffullname) # write(depths[i], ffullname, append = TRUE) # write(ncol(x), ffullname, append = TRUE) # write(nrow(x), ffullname, append = TRUE) # write(array(t(x), dim = c(nrow(x), ncol(x))), ffullname, ncolumns = ncol(x), append = TRUE) # WMTR() # cat("Calculated for i = ", i, "\n") # wmtreg <- read.table(as.character(paste(fdir, "/", trname, sep = "")), sep=" ") # unlink(as.character(paste(fdir, "/", trname, sep = ""))) # wmtreg <- as.matrix(wmtreg) # numribs <- nrow(wmtreg)/2 # for (i in 1:numribs){ # lines(rbind(wmtreg[i*2 - 1,], wmtreg[i*2,]), col = col) # } # } # } # # locationRegions <- function(x, depths = NULL, col = "black"){ # numLearn <- nrow(x) # vert = isodepth(x, c(2:(numLearn - 1)), output = T, dpth = as.integer(depths*numLearn/2)) # for (verticles in vert){ # if(is.null(verticles) || nrow(verticles)<1) next # verticles = rbind(verticles, verticles[1,]) # lines(verticles, col = col) # } # } mahalanobisRegions <- function(x, depths = c(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1), col = "black", ...){ if(is.na(depths) || is.null(depths)) depths = 10 if(length(depths) == 1 && depths > 1) depths = seq(0.0001, 1, length.out = depths) # PM (2018-06-22) if (("mah.estimate" %in% names(list(...))) && toupper(list(...)[["mah.estimate"]]) == "MCD"){ if (("mah.parMcd" %in% toupper(names(list(...)))) && (list(...)[["mah.parMcd"]] >= 0.5) && (list(...)[["mah.parMcd"]] <= 1)){ parMcd <- list(...)[["mah.parMcd"]] }else{ parMcd <- 0.75 } est <- covMcd(x, alpha = parMcd) mu <- est$center sigma.inv <- solve(est$cov) }else{ c <- c(0,0) for (i in 1:nrow(x)){ c <- c + x[i,] } mu <- c / nrow(x) sigma.inv <- solve(cov(x)) } for (i in 1:length(depths)){ ellipsem(mu = mu, amat = sigma.inv, c2 = 1/depths[i] - 1, showcentre = F, col = col) } } mahalanobisMCDRegions <- function(x, alpha = 1/2, depths = c(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1), col = "black"){ if(is.na(depths) || is.null(depths)) depths = 10 if(length(depths) == 1 && depths > 1) depths = seq(0.0001, 1, length.out = depths) # library(robustbase) estimate <- covMcd(x, alpha = alpha) mu <- estimate$center sigma.inv <- solve(estimate$cov) for (i in 1:length(depths)){ ellipsem(mu = mu, amat = sigma.inv, c2 = 1/depths[i] - 1, showcentre = F, col = col) } } contourRegions <- function(ddalpha, margins = NULL, depths, frequency=100){ if (is.null(margins)){ if (ddalpha$needtransform == 1) data = rbind(ddalpha$patterns[[1]]$transformer(ddalpha$patterns[[1]]$points, inv = T), ddalpha$patterns[[2]]$transformer(ddalpha$patterns[[2]]$points, inv = T)) else data = rbind(ddalpha$patterns[[1]]$points, ddalpha$patterns[[2]]$points) margins = c(min(data[,1]), max(data[,1]), min(data[,2]), max(data[,2])); margins = margins + c(-0.1*(margins[2]-margins[1]), 0.1*(margins[2]-margins[1]), -0.1*(margins[4]-margins[3]), 0.1*(margins[4]-margins[3])) } gx <- seq(margins[1], margins[2], length=frequency) gy <- seq(margins[3], margins[4], length=frequency) y <- as.matrix(expand.grid(gx, gy)) depthcontours <- .ddalpha.count.depths(ddalpha, y) if(is.na(depths) || is.null(depths)) depths = 10 if(length(depths) == 1 && depths > 1) depths = seq(0, max(depthcontours), length.out = depths) for (i in seq(length(ddalpha$patterns))){ contour(gx, gy, matrix(depthcontours[,i], nrow=length(gx), ncol=length(gy)), add=TRUE, levels=depths*max(depthcontours), drawlabels=FALSE, col = gcolors[i]) } invisible(list(gx = gx, gy = gy, depthcontours = depthcontours)) } contourRegionsData <- function(data, depth, margins = NULL, depths = c(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1), frequency=100, col = "red", ...){ if (is.null(depth) || depth == "none"){ invisible (0);} else{ # df = switch(depth, # "zonoid" = function(x, data, ...) depth.zonoid(x, data) , # "halfspace" = depth.halfspace, # "simplicialVolume" = depth.simplicialVolume, # "simplicial" = depth.simplicial, # "Mahalanobis" = function(x, X) (.Mahalanobis_depth(x, colMeans(X), solve(cov(X)))), # "projection" = depth.projection, # "spatial" = depth.spatial # ) df = function(x, data, ...) ddalpha::depth.(x, data, notion = depth, ...) if (is.null(margins)){ margins = c(min(data[,1]), max(data[,1]), min(data[,2]), max(data[,2])); margins = margins + c(-0.1*(margins[2]-margins[1]), 0.1*(margins[2]-margins[1]), -0.1*(margins[4]-margins[3]), 0.1*(margins[4]-margins[3])) } gx <- seq(margins[1], margins[2], length=frequency) gy <- seq(margins[3], margins[4], length=frequency) y <- as.matrix(expand.grid(gx, gy)) depthcontours <- df(y,data,...) if(is.na(depths) || is.null(depths)) depths = 10 if(length(depths) == 1 && depths > 1) depths = seq(0.0001, max(depthcontours), length.out = depths) contour(gx, gy, matrix(depthcontours, nrow=length(gx), ncol=length(gy)), add=TRUE, levels=depths, drawlabels=FALSE, col = col) invisible(list(gx = gx, gy = gy, depthcontours = depthcontours)) } } ellipsem <- function (mu, amat, c2, npoints = 100, showcentre = T, col, ...){ if (all(dim(amat) == c(2, 2))) { eamat <- eigen(amat) hlen <- sqrt(c2/eamat$val) theta <- angle(eamat$vec[1, 1], eamat$vec[2, 1]) ellipse(hlen[1], hlen[2], theta, mu[1], mu[2], npoints = npoints, col = col, ...) if (showcentre) points(mu[1], mu[2], pch = 3) } invisible() } ellipse <- function (hlaxa = 1, hlaxb = 1, theta = 0, xc = 0, yc = 0, newplot = F, npoints = 100, ...){ a <- seq(0, 2 * pi, length = npoints + 1) x <- hlaxa * cos(a) y <- hlaxb * sin(a) alpha <- angle(x, y) rad <- sqrt(x^2 + y^2) xp <- rad * cos(alpha + theta) + as.double(xc) yp <- rad * sin(alpha + theta) + as.double(yc) if (newplot) plot(xp, yp, type = "l", ...) else lines(xp, yp, ...) invisible() } angle <- function (x, y) { angle2 <- function(xy) { x <- xy[1] y <- xy[2] if (x > 0) { atan(y/x) } else { if (x < 0 & y != 0) { atan(y/x) + sign(y) * pi } else { if (x < 0 & y == 0) { pi } else { if (y != 0) { (sign(y) * pi)/2 } else { NA } } } } } apply(cbind(x, y), 1, angle2) }ddalpha/R/qda.r0000644000176200001440000000045714550243636013016 0ustar liggesusersqda_train <- function(data){ new.frm <- data.frame(data) z <- qda(formula=as.formula(paste("X", ncol(data), " ~ .", sep="")), data = new.frm)#, prior = rep(1, dimension)/dimension) return (z) } qda_classify <- function(objects, qda){ z <- predict(qda, data.frame(objects))$class return (z) } ddalpha/R/depth.r0000644000176200001440000000306614213423775013354 0ustar liggesusers.depth <- function(fname, funcargs, ...){ f <- try(match.fun(fname), silent = T) if (is.function(f)){ args = list(...) fcnArgs <- names(formals(f)) fcnArgs <- unlist(fcnArgs, use.names=FALSE) keep <- intersect(names(args), fcnArgs) unused <- setdiff(names(args), fcnArgs) args <- args[keep] args <- c(args, funcargs) res <- do.call(fname, args=args) if(length(unused)>0) warning("Unused by '", fname, "' arguments: ", paste(unused, collapse = ', ')) #res <- f(x, data, ...) return(res) } else { warning("There is no depth function ", fname) } } depth. <- function(x, data, notion = c("zonoid", "halfspace", "Mahalanobis", "projection", "spatial", "spatialLocal", "simplicial", "simplicialVolume", "ddplot", "potential"), ...){ if(is.null(notion)) stop("Parameter 'notion' must be set") t <- notion try(t <- match.arg(notion), silent = T) fname = paste0("depth.", t) funcargs = list(x = x, data = data) return(.depth(fname, funcargs, ...)) } depth.space. <- function(data, cardinalities, notion = c("zonoid", "halfspace", "Mahalanobis", "projection", "spatial", "spatialLocal", "simplicial", "simplicialVolume", "ddplot", "potential"), ...){ if(is.null(notion)) stop("Parameter 'notion' must be set") t <- notion try(t <- match.arg(notion), silent = T) # try to find a depth fname = paste0("depth.space.", t) funcargs = list(cardinalities = cardinalities, data = data) return(.depth(fname, funcargs, ...)) } # d = depth(data$train, data$train, exact = T) ddalpha/R/depth.space.zonoid.r0000644000176200001440000000425214213423775015745 0ustar liggesusers################################################################################ # File: depth.space.zonoid.r # Created by: Pavlo Mozharovskyi # First published: 28.02.2013 # Last revised: 15.05.2013 # # Computation of the depth space based on the zonoid data depth. ################################################################################ depth.space.zonoid <- function(data, cardinalities, seed = 0){ if (seed!=0) set.seed(seed) if (!(is.matrix(data) && is.numeric(data) || is.data.frame(data) && prod(sapply(data, is.numeric))) || ncol(data) < 2){ stop("Argument \"data\" should be a numeric matrix of at least 2-dimensional data") } if (!is.vector(cardinalities, mode = "numeric") || is.na(min(cardinalities)) || sum(.is.wholenumber(cardinalities)) != length(cardinalities) || min(cardinalities) <= 0 || sum(cardinalities) != nrow(data)){ stop("Argument \"cardinalities\" should be a vector of cardinalities of the classes in \"data\" ") } if (sum(cardinalities < ncol(data) + 1) != 0){ stop("Not in all classes sufficiently enough objetcs") } dim <- ncol(data) depth.space <- NULL for (i in 1:length(cardinalities)){ objects <- as.vector(t(data[(1 + sum(cardinalities[0:(i - 1)])):sum(cardinalities[1:i]),])) pattern.depths <- NULL for (j in 1:length(cardinalities)){ pattern <- as.vector(t(data[(1 + sum(cardinalities[0:(j - 1)])):sum(cardinalities[1:j]),])) ds <- .C("ZDepth", as.double(pattern), as.double(objects), as.integer(cardinalities[j]), as.integer(cardinalities[i]), as.integer(dim), as.integer(seed), depths=double(cardinalities[i]))$depths if (j == i){ ds <- replace(ds, which(ds < 1/cardinalities[j] - sqrt(.Machine$double.eps)), 1/cardinalities[j]) }else{ ds <- replace(ds, which(ds < 1/cardinalities[j] - sqrt(.Machine$double.eps)), 0) } pattern.depths <- cbind(pattern.depths, ds, deparse.level = 0) } depth.space <- rbind(depth.space, pattern.depths, deparse.level = 0) } return (depth.space) } ddalpha/R/ddalpha.test.r0000644000176200001440000000505214213423775014620 0ustar liggesusersddalpha.test <- function(learn, test, ...){ ops <- options(warn = -1) on.exit(options(ops)) if(is.vector(test)) test = t(as.matrix(test)) tryCatch({ time <- system.time( ddalpha <- ddalpha.train(learn, ...) ) C = ddalpha$dimension+1 cc = ddalpha.classify(objects = test[,-C], ddalpha = ddalpha) if (is.numeric(test[,C])){ if(is.factor(cc[[1]]) || is.character(cc[[1]])){ cc <- unlist(lapply(cc, as.character)) cc[cc == "Ignored"] <- NA } equal = (cc == test[,C]) } else { cc <- unlist(lapply(cc, as.numeric)) equal = (cc == as.numeric(test[,C])) } if(!(T %in% equal) && !(F %in% equal)) { return(NA)} error = sum(!equal,na.rm = T)/(sum(!equal,na.rm = T)+sum(equal,na.rm = T)) return(list(error = error, correct = sum(equal,na.rm = T), incorrect = sum(!equal,na.rm = T), total = length(cc)-sum(is.na(equal)), ignored = sum(is.na(equal)), n = length(cc), time = time[1])) } # tryCatch({} , error = function(e) { print ("ERROR T") print (e) }, finally = { }) return (NA) } ddalpha.getErrorRateCV <- function(data, numchunks = 10, ...){ n = nrow(data) numchunks = min(n, numchunks) chunksize = ceiling(n/numchunks) sample = seq(from = 1, by = numchunks, length.out = chunksize) errors = 0 total = 0 times = c() for (i in 1:numchunks){ sample = sample[sample<=n] learn = data[-sample,,drop = F] test = data[sample,,drop = F] el = ddalpha.test(learn, test, ...) if(is.list(el)){ errors = errors + el$incorrect total = total + el$total times = c(times,el$time) } sample = sample+1 } return (list(errors = errors/total, time = mean(times), time_sd = sd(times))) } ddalpha.getErrorRatePart <- function(data, size = 0.3, times = 10, ...){ if (!is.numeric(size) || size <=0 || size >= nrow(data)) stop("Wrong size of excluded sequences") if(size < 1) size = max(1, size*nrow(data)) # at least 1 point size = as.integer(size) indexes = 1:nrow(data) errors = c() total = 0 time = c() for (i in 1:times){ samp = sample(indexes, size) learn = data[-samp,,drop = F] test = data[samp,,drop = F] el = ddalpha.test(learn, test, ...) if(is.list(el)){ errors = c(errors,el$incorrect/el$total) time = c(time,el$time) } } return (list(errors = mean(errors), errors_sd = sd(errors), errors_vec = errors, time = mean(time), time_sd = sd(time))) }ddalpha/R/depth.betaSkeleton.r0000644000176200001440000001413714213423775015774 0ustar liggesusers################################################################################ # File: depth.betaSkeleton.r # Created by: Pavlo Mozharovskyi # First published: 08.03.2018 # Last revised: 08.03.2018 # # Computation of the beta-skeleton depth. ################################################################################ .betaSkeleton_validate <- function(ddalpha, beta = 2, distance = "Lp", Lp.p = 2, mah.estimate = "moment", mah.parMcd = 0.75, ...) { # only validate and stop if anything is wrong if (!is.numeric(beta) || length(beta) > 1 || beta < 1){ stop("Argument \"beta\" should be a real value >= 1") } if (!is.numeric(Lp.p) || length(Lp.p) > 1 || Lp.p < 0){ stop("Argument \"Lp.p\" should be a real value >= 0") } if (toupper(distance) == "MAHALANOBIS"){ if( !(toupper(mah.estimate) %in% c("NONE", "MOMENT", "MCD"))){ stop("Wrong argument \"mah.estimate\", should be one of \"moment\", \"MCD\", \"none\"") } } else if (toupper(distance) != "LP") { stop("Argument \"distance\" should be either \"Lp\" or \"Mahalanobis\"") } return (list(beta = beta, distance = distance, Lp.p = Lp.p, mah.estimate = mah.estimate, mah.parMcd = mah.parMcd)) } .betaSkeleton_learn <- function(ddalpha) { #1. Calculate statistics based on data if (toupper(ddalpha$distance) == "MAHALANOBIS"){ ddalpha$distance.code <- 5L if(toupper(ddalpha$mah.estimate) == "NONE"){ for (i in 1:ddalpha$numPatterns){ ddalpha$patterns[[i]]$sigma <- diag(ddalpha$dimension) } } else { for (i in 1:ddalpha$numPatterns){ if(toupper(ddalpha$mah.estimate) == "MOMENT"){ cov <- cov(as.matrix(ddalpha$patterns[[i]]$points)) } else if(toupper(ddalpha$mah.estimate) == "MCD"){ cov <- covMcd(as.matrix(ddalpha$patterns[[i]]$points), ddalpha$mah.parMcd)$cov } else {stop("Wrong argument \"mah.estimate\", should be one of \"moment\", \"MCD\", \"none\"")} if(sum(is.na(cov)) == 0){ ddalpha$patterns[[i]]$sigma <- solve(cov) } else{ ddalpha$patterns[[i]]$sigma <- diag(ddalpha$dimension) warning("Covariance estimate not found for pattern ", ddalpha$patterns[[i]]$name, ", no affine-invariance-adjustment") } } } }else{ for (i in 1:ddalpha$numPatterns){ ddalpha$patterns[[i]]$sigma <- 0; } if (toupper(ddalpha$distance) == "LP"){ ddalpha$distance.code <- 4L if (ddalpha$Lp.p == 1){ ddalpha$distance.code <- 1L } if (ddalpha$Lp.p == 2){ ddalpha$distance.code <- 2L } if (is.infinite(ddalpha$Lp.p) && ddalpha$Lp.p > 0){ ddalpha$distance.code <- 3L } } else {stop("Argument \"distance\" should be either \"Lp\" or \"Mahalanobis\"")} } #2. Calculate depths for each pattern for (i in 1:ddalpha$numPatterns){ ddalpha$patterns[[i]]$depths = .betaSkeleton_depths(ddalpha, ddalpha$patterns[[i]]$points) } return (ddalpha) } .betaSkeleton_depths <- function(ddalpha, objects){ depths <- NULL for (i in 1:ddalpha$numPatterns){ pattern <- ddalpha$patterns[[i]]$points x <- as.vector(t(pattern)) y <- as.vector(t(objects)) ds <- .C("BetaSkeletonDepth", as.double(x), as.double(y), as.integer(nrow(pattern)), as.integer(nrow(objects)), as.integer(ncol(pattern)), as.double(ddalpha$beta), as.integer(ddalpha$distance.code), as.double(ddalpha$Lp.p), as.double(ddalpha$patterns[[i]]$sigma), depths=double(nrow(objects)))$depths depths <- cbind(depths, ds) } return (depths) } depth.betaSkeleton <- function(x, data, beta = 2, distance = "Lp", Lp.p = 2, mah.estimate = "moment", mah.parMcd = 0.75){ if (!is.matrix(x) && is.vector(x)){ x <- matrix(x, nrow=1) } if (!(is.matrix(data) && is.numeric(data) || is.data.frame(data) && prod(sapply(data, is.numeric))) || ncol(data) < 2){ stop("Argument \"data\" should be a numeric matrix of at least 2-dimensional data") } if (!(is.matrix(x) && is.numeric(x) || is.data.frame(x) && prod(sapply(x, is.numeric))) ){ stop("Argument \"x\" should be numeric") } if (ncol(x) != ncol(data)){ stop("Dimensions of the arguments \"x\" and \"data\" should coincide") } if (nrow(data) < 2){ stop("Too few data points") } if (!is.numeric(beta) || length(beta) > 1 || beta < 1){ stop("Argument \"beta\" should be a real value >= 1") } if (!is.numeric(Lp.p) || length(Lp.p) > 1 || Lp.p < 0){ stop("Argument \"Lp.p\" should be a real value >= 0") } if (toupper(distance) == "MAHALANOBIS"){ distance.code <- 5L if(toupper(mah.estimate) == "NONE"){ sigma = diag(ncol(data)) } else { if(toupper(mah.estimate) == "MOMENT"){ cov <- cov(data) } else if(toupper(mah.estimate) == "MCD"){ cov <- covMcd(data, mah.parMcd)$cov } else {stop("Wrong argument \"mah.estimate\", should be one of \"moment\", \"MCD\", \"none\"")} if(sum(is.na(cov)) == 0){ sigma <- solve(cov) } else{ sigma = diag(ncol(data)) warning("Covariance estimate not found, no affine-invariance-adjustment") } } }else{ sigma = 0; if (toupper(distance) == "LP"){ distance.code <- 4L if (Lp.p == 1){ distance.code <- 1L } if (Lp.p == 2){ distance.code <- 2L } if (is.infinite(Lp.p) && Lp.p > 0){ distance.code <- 3L } } else {stop("Argument \"distance\" should be either \"Lp\" or \"Mahalanobis\"")} } points <- as.vector(t(data)) objects <- as.vector(t(x)) ds <- .C("BetaSkeletonDepth", as.double(points), as.double(objects), as.integer(nrow(data)), as.integer(nrow(x)), as.integer(ncol(data)), as.double(beta), as.integer(distance.code), as.double(Lp.p), as.double(sigma), depths=double(nrow(x)))$depths return (ds) } ddalpha/R/depth.fd.R0000644000176200001440000026211214216410625013674 0ustar liggesusers################ # R call for the F procedures # functional depth computation # Stanislav Nagy # nagy@karlin.mff.cuni.cz # 09/10/2018 # # Stanislav Nagy, Irene Gijbels & Daniel Hlubinka (2017) Depth-Based Recognition of Shape Outlying Functions, Journal of Computational and Graphical Statistics, 26:4, 883-893, DOI: 10.1080/10618600.2017.1336445 # Stanislav Nagy, Frederic Ferraty (2018) Data Depth for Noisy Random Functions. Under review. ################ if(FALSE){ # for roxygenize only unlink("depth.fd",recursive=TRUE) library(roxygen2) library(devtools) package.skeleton("depth.fd",code_files="depth.fd.R") roxygenize("depth.fd") } #' @useDynLib depth.fd #' @export FKS #' @export shape.fd.analysis #' @export shape.fd.outliers #' @export depthf.BD #' @export depthf.ABD #' @export depthf.fd1 #' @export depthf.fd2 #' @export depthf.HR #' @export depthf.hM #' @export depthf.hM2 #' @export depthf.RP1 #' @export depthf.RP2 #' @export derivatives.est #' @export L2metric #' @export Cmetric #' @export depth.sample #' @export infimalRank #' @export dataf2rawfd #' @export rawfd2dataf #' @title Transform a \code{dataf} object to raw functional data #' #' @description #' From a (possibly multivariate) functional data object \code{dataf} constructs an array of the functional values #' evaluated at an equi-distant grid of points. #' #' @author Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} #' @keywords functional #' #' @param dataf Functions to be transformed, represented by a (possibly multivariate) \code{dataf} object of their arguments #' and functional values. \code{m} stands for the number of functions. The grid of observation points for the #' functions in \code{dataf} may not be the same. #' #' @param range The common range of the domain where the fucntions \code{dataf} are observed. #' Vector of length 2 with the left and the right end of the interval. Must contain all arguments given in #' \code{dataf}. If the range is not provided, the smallest interval in which all the arguments from the data functions #' are contained is chosen as the domain. #' #' @param d Grid size to which all the functional data are transformed. All functional observations are #' transformed into vectors of their functional values of length \code{d} #' corresponding to equi-spaced points in the domain given by the interval \code{range}. Functional values in these #' points are reconstructed using linear interpolation, and extrapolation, see Nagy et al. (2016). #' #' @return If the functional data are univariate (scalar-valued), a matrix of size \code{m*d} is given, with each row #' corresponding to one function. If the functional data are \code{k}-variate with k>1, an array of size \code{m*d*k} #' of the functional values is given. #' #' @examples #' ## transform a matrix into a functinal data set and back #' n = 5 #' d = 21 #' X = matrix(rnorm(n*d),ncol=d) #' R = rawfd2dataf(X,range=c(0,1)) #' R2 = dataf2rawfd(R,range=c(0,1),d=d) #' all.equal(X,R2) #' #' ## transform a functional dataset into a raw matrix of functional values #' dataf = dataf.population()$dataf #' dataf2rawfd(dataf,range=c(1950,2015),d=66) #' #' ## transform an array into a multivariate functional data set and back #' k = 3 #' X = array(rnorm(n*d*k),dim=c(n,d,k)) #' R = rawfd2dataf(X,range=c(-1,1)) #' dataf2rawfd(R,range=c(-1,1),d=50) #' #' @seealso \code{\link{rawfd2dataf}} #' @seealso \code{\link{depthf.fd1}} #' @seealso \code{\link{depthf.fd2}} # M = dataf2rawfd(dataf.growth()$dataf) dataf2rawfd = function(dataf, range = NULL, d = 101){ # transform dataf format for functional data to a raw matrix # of functional values evaluated at a grid common to all functions # range: range of the common grid, if not specified the range of all the functions # d: no of discretized points in the grid, equidistant # approximation procedure follows Nagy et al. (2016, JMVA) # Check "dataf" if (!is.list(dataf)) stop("Argument 'dataf' must be a list") if(is.vector(dataf[[1]]$vals)){ mv = FALSE for (df in dataf) if (!(is.list(df) && length(df) == 2 && !is.null(df$args) && !is.null(df$vals) && is.vector(df$args) && is.vector(df$vals) && is.numeric(df$args) && is.numeric(df$vals) && length(df$args) == length(df$vals) && is.sorted(df$args))) stop("Argument 'dataf' must be a list containing lists (functions) of two vectors of equal length, named 'args' and 'vals': arguments sorted in ascending order and corresponding them values respectively") } if(is.matrix(dataf[[1]]$vals)){ mv = TRUE for (df in dataf) if (!(is.list(df) && length(df) == 2 && !is.null(df$args) && !is.null(df$vals) && is.vector(df$args) && is.matrix(df$vals) && is.numeric(df$args) && is.numeric(df$vals) && length(df$args) == nrow(df$vals) && is.sorted(df$args))) stop("Argument 'dataf' must be a list containing lists (functions) of a vector named 'args' and a matrix named 'vals'. The arguments of 'args' must be sorted in ascending order. To each element of 'args' the corresponding row in 'vals' represents the functional values at this point") } # range construction rng = numeric(0) for (df in dataf) rng = range(c(rng,df$args)) # common range of all the data if(!is.null(range)){ if(!(length(range) == 2 && is.numeric(range) && range[1]<=rng[1] && range[2]>=rng[2])) stop("Argument 'range' must be a numeric vector of two components that defines the range of the domain of functional data. All functional data must have 'args' vales inside this domain.") } else range = rng if(!(range[1]=dataf[[i]]$args[ni]] = dataf[[i]]$vals[ni] } } else { k = ncol(dataf[[1]]$vals) X = array(dim=c(n,d,k)) # functional data interpolation / extrapolation for(i in 1:n){ ni = length(dataf[[i]]$args) for(j in 1:k) X[i,,j] = approx(dataf[[i]]$args,dataf[[i]]$vals[,j],t)$y X[i,t<=dataf[[i]]$args[1],] = dataf[[i]]$vals[1,] X[i,t>=dataf[[i]]$args[ni],] = dataf[[i]]$vals[ni,] } } return(X) } #' @title Transform raw functional data to a \code{dataf} object #' #' @description #' Constructs a (possibly multivariate) functional data object given by an array of its functional values #' evaluated at an equi-distant grid of points, and transforms it into a \code{dataf} object more suitable #' for work in the \code{ddalpha} package. #' #' @author Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} #' @keywords functional #' #' @param X Either a matrix of size \code{n*d}, or an array of dimension \code{n*d*k} of functional values. Here \code{n} #' stands for the number of functions, \code{d} is the number of equi-distant points in the domain where the functional #' values are evaluated, and if applicable, \code{k} is the dimensionality of the (vector-valued) functional data. #' #' @param range A vector of size two that represents the endpoints of the common domain of all functions \code{X}. #' #' @return A (possibly multivariate) \code{dataf} object corresponding to the functional data \code{X} evaluated at an #' equi-distant grid of points. #' #' @examples #' ## transform a matrix into a functinal data set #' n = 5 #' d = 21 #' X = matrix(rnorm(n*d),ncol=d) #' rawfd2dataf(X,range=c(0,1)) #' #' ## transform an array into a multivariate functional data set #' k = 3 #' X = array(rnorm(n*d*k),dim=c(n,d,k)) #' rawfd2dataf(X,range=c(-1,1)) #' #' @seealso \code{\link{dataf2rawfd}} #' @seealso \code{\link{depthf.fd1}} #' @seealso \code{\link{depthf.fd2}} rawfd2dataf = function(X, range){ # transform a raw array of functional data values # to a dataf format, where the domain is assumed to be # an equidistant grid in the interval given by range if(is.vector(X)) X = matrix(X,nrow=1) # if X is a single vector, it is considered to be a matrix of one scalar function # Check "rawfd" if (!is.array(X)) stop("Argument 'X' must be an array (multivariate functional data) or a matix (univariate functional data)") mv = !is.matrix(X) # range construction if(!(range[1]0) stop("NA values in the functional args vector are not allowed") # produce the output structure sm.dataf = list() Tout = sort(Tout) for(j in 1:length(dataf)){ T = dataf[[j]]$args X = dataf[[j]]$vals ST = dataf[[j]]$args eps = 10^(-6) Hmin = max(c(ST[1], (1 - ST[length(ST)]), max(ST[-1] - ST[-length(ST)])/2)) + eps Hmax = max(ST[length(ST)]-ST[1],(max(Tout)-min(Tout))) if (Hmin >= Hmax) Hmin = Hmax/10 # in the extreme case when Hmin > Hmax take Hmin very small H = seq(Hmin,Hmax,length=m) # n = length(ST) nR = max(1,floor(n/K)) if(nR==1) K = n TRE = rep(NA,nR*K) XRE = rep(NA,nR*K) TNRE = rep(NA,K*(n-nR)) XNRE = rep(NA,K*(n-nR)) SH = sample(n,n) # random shuffle of the points for CV for(i in 1:K){ S = SH[(i-1)*nR+(1:nR)] TRE[(i-1)*nR+(1:nR)] = T[S] XRE[(i-1)*nR+(1:nR)] = X[S] TNRE[(i-1)*(n-nR)+(1:(n-nR))] = T[-S] XNRE[(i-1)*(n-nR)+(1:(n-nR))] = X[-S] } Res = .Fortran("CVKERNSM", as.double(T), as.double(X), as.double(Tout), as.integer(length(T)), as.integer(length(Tout)), as.double(H), as.integer(length(H)), as.integer(kernI), as.double(TRE), as.double(XRE), as.double(TNRE), as.double(XNRE), as.integer(nR), as.integer(K), as.double(rep(0,length(Tout))) ) Res[Res[[15]]>10^6] = Inf sm.dataf[[j]] = list(args = Tout, vals = Res[[15]]) } return(sm.dataf) } #' @title Fast depth computation for univariate and bivariate random samples #' #' @description #' Faster implementation of the halfspace and the simplicial depth. Computes the depth #' of a whole random sample of a univariate or a bivariate data in one run. #' #' @author Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} #' @keywords depth #' #' @details #' The function returns vectors of sample halfspace and simplicial depth values. #' #' @param A Univariate or bivariate points whose depth is computed, represented by a matrix of #' size \code{m*2}. \code{m} stands for the number of points, \code{d} is 1 for univariate and 2 #' for bivariate data. #' #' @param B Random sample points with respect to which the depth of \code{A} is computed. #' \code{B} is represented by a matrix of size \code{n*2}, where \code{n} is the sample size. #' #' @return Vector of length \code{m} of depth halfspace depth values is returned. #' #' @examples #' n = 100 #' m = 150 #' A = matrix(rnorm(2*n),ncol=2) #' B = matrix(rnorm(2*m),ncol=2) #' depth.sample(A,B) #' system.time(D1<-depth.halfspace(A,B)) #' system.time(D2<-depth.sample(A,B)) #' max(D1-D2$Half) #' #' A = rnorm(100) #' B = rnorm(150) #' depth.sample(A,B) #' # depth.halfspace(matrix(A,ncol=1),matrix(B,ncol=1)) #' #' @seealso \code{\link{depth.halfspace}} #' @seealso \code{\link{depth.simplicial}} depth.sample = function(A,B){ # bivariate halfspace depth # A points whose depth I compute, M*2 matrix # B points wrt whose the depth is computed, N*2 matrix if(is.null(dim(A))){ # for univariate data A1 = as.vector(A) B1 = as.vector(B) m = length(A) n = length(B) FD = .Fortran("dpth1", as.numeric(A1), # A1 as.numeric(B1), # B1 as.integer(m), # m as.integer(n), # n sdep=as.numeric(rep(-1,m)), hdep=as.numeric(rep(-1,m)) ) return(list(Simpl = FD$sdep, Half = FD$hdep)) } else { A1 = as.vector(A[,1]) A2 = as.vector(A[,2]) B1 = as.vector(B[,1]) B2 = as.vector(B[,2]) m = dim(A)[1] n = dim(B)[1] if((dim(B)[2]!=2)|(dim(A)[2]!=2)) stop("Computation for two dimensions only") FD = .Fortran("dpth2", as.numeric(A1), # A1 as.numeric(A2), # A2 as.numeric(B1), # B1 as.numeric(B2), # B2 as.integer(m), # m as.integer(n), # n sdep=as.numeric(rep(-1,m)), hdep=as.numeric(rep(-1,m)) ) return(list(Simpl = FD$sdep, Half = FD$hdep)) } } #' @title Univariate integrated and infimal depth for functional data #' #' @description #' Usual, and order extended integrated and infimal depths for real-valued functional data based on the #' halfspace and simplicial depth. #' #' @author Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} #' @keywords depth functional #' #' @details #' The function returns vectors of sample integrated and infimal depth values. #' #' @param datafA Functions whose depth is computed, represented by a \code{dataf} object of their arguments #' and functional values. \code{m} stands for the number of functions. #' #' @param datafB Random sample functions with respect to which the depth of \code{datafA} is computed. #' \code{datafB} is represented by a \code{dataf} object of their arguments #' and functional values. \code{n} is the sample size. #' The grid of observation points for the #' functions \code{datafA} and \code{datafB} may not be the same. #' #' @param range The common range of the domain where the fucntions \code{datafA} and \code{datafB} are observed. #' Vector of length 2 with the left and the right end of the interval. Must contain all arguments given in #' \code{datafA} and \code{datafB}. #' #' @param d Grid size to which all the functional data are transformed. For depth computation, #' all functional observations are first transformed into vectors of their functional values of length \code{d} #' corresponding to equi-spaced points in the domain given by the interval \code{range}. Functional values in these #' points are reconstructed using linear interpolation, and extrapolation, see Nagy et al. (2016). #' #' @param order The order of the order extended integrated and infimal depths. #' By default, this is set to \code{1}, meaning that the usual univariate depths of #' the functional values are computed. For \code{order=2} or \code{3}, the second #' and the third order extended integrated and infimal depths are computed, #' respectively. #' #' @param approx Number of approximations used in the computation of the order extended depth #' for \code{order} greater than \code{1}. For \code{order=2}, the default #' value is set to \code{0}, meaning that the depth is computed at all possible \code{d^order} #' combinations of the points in the domain. For \code{order=3}, #' the default value is set to \code{101}. When \code{approx} is a positive integer, \code{approx} #' points are randomly sampled in \code{[0,1]^order} and at these points the \code{order}-variate depths of the #' corresponding functional values are computed. #' #' @return Four vectors of length \code{m} of depth values are returned: #' \itemize{ #' \item \code{Simpl_FD} the integrated depth based on the simplicial depth, #' \item \code{Half_FD} the integrated depth based on the halfspace depth, #' \item \code{Simpl_ID} the infimal depth based on the simplicial depth, #' \item \code{Half_ID} the infimal depth based on the halfspace depth. #' } #' In addition, two vectors of length \code{m} of the relative area of smallest depth values is returned: #' \itemize{ #' \item \code{Simpl_IA} the proportions of points at which the depth \code{Simpl_ID} was attained, #' \item \code{Half_IA} the proportions of points at which the depth \code{Half_ID} was attained. #' } #' The values \code{Simpl_IA} and \code{Half_IA} are always in the interval [0,1]. #' They introduce ranking also among functions having the same #' infimal depth value - if two functions have the same infimal depth, the one with larger infimal area #' \code{IA} is said to be less central. #' For \code{order=2} and \code{m=1}, two additional matrices of pointwise depths are also returned: #' \itemize{ #' \item \code{PSD} the matrix of size \code{d*d} containing the computed #' pointwise bivariate simplicial depths used for the computation of \code{Simpl_FD} and \code{Simpl_ID}, #' \item \code{PHD} the matrix of size \code{d*d} containing the computed #' pointwise bivariate halfspace depths used for the computation of \code{Half_FD} and \code{Half_ID}. #' } #' For \code{order=3}, only \code{Half_FD} and \code{Half_ID} are provided. #' #' @references Nagy, S., Gijbels, I. and Hlubinka, D. (2016). #' Weak convergence of discretely observed functional data with applications. #' \emph{Journal of Multivariate Analysis}, \bold{146}, 46--62. #' #' @references Nagy, S., Gijbels, I. and Hlubinka, D. (2017). #' Depth-based recognition of shape outlying functions. #' \emph{Journal of Computational and Graphical Statistics}, \bold{26:4}, 883--893. #' #' @examples #' datafA = dataf.population()$dataf[1:20] #' datafB = dataf.population()$dataf[21:50] #' depthf.fd1(datafA,datafB) #' depthf.fd1(datafA,datafB,order=2) #' depthf.fd1(datafA,datafB,order=3,approx=51) #' #' @seealso \code{\link{depthf.fd2}}, \code{\link{infimalRank}} depthf.fd1 = function(datafA,datafB,range=NULL,d=101,order=1,approx=0){ # univariate integrated depth # A functions whose depth I compute, M*D matrix # B functions wrt whose the depth is computed, N*D matrix # both 1dimensional, n*d, n nr of functions, d dimensionality A = dataf2rawfd(datafA, range = range, d = d) B = dataf2rawfd(datafB, range = range, d = d) if(order==1){ A1 = as.vector(A) B1 = as.vector(B) d = dim(A)[2] m = dim(A)[1] n = dim(B)[1] if(dim(B)[2]!=d) stop("dimension mismatch") FD = .Fortran("funD1", as.numeric(A1), # A as.numeric(B1), # B as.integer(m), # m as.integer(n), # n as.integer(d), # d funsdep=as.numeric(rep(-1,m)), funhdep=as.numeric(rep(-1,m)), fIsdep =as.numeric(rep(-1,m)), fIhdep =as.numeric(rep(-1,m)), IAsdep =as.integer(rep(-1,m)), IAhdep =as.integer(rep(-1,m)) ) return(list( Simpl_FD = FD$funsdep, Half_FD = FD$funhdep, Simpl_ID = FD$fIsdep, Half_ID = FD$fIhdep, Simpl_IA = FD$IAsdep/d, Half_IA = FD$IAhdep/d )) } if(order==2) return(DiffDepth(A,B,approx)) if(order==3) return(DiffDepth3D(A,B,approx)) } #' @title Fast computation of the \eqn{L^2} metric for sets of functional data #' #' @description #' Returns the matrix of \eqn{L^2} distances between two sets of functional data. #' #' @author Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} #' @keywords metric functional #' #' @details #' For two sets of functional data of sizes \code{m} and \code{n} #' represented by matrices of their functional values on the common domain {1,...,d}, #' this function returns the symmetric matrix of size \code{m*n} whose entry in the #' \code{i}-th row and \code{j}-th column is the approximated \eqn{L^2} distance of the #' \code{i}-th function from the first set, and the \code{j}-th function from the second set. #' This function is utilized in the computation of the h-mode depth. #' #' @param A Functions of the first set, represented by a matrix of their functional values of #' size \code{m*d}. \code{m} stands for the number of functions, \code{d} #' is the number of the equi-distant points {1,...,d} in the domain of the data [1,d] at which the functional #' values of the \code{m} functions are evaluated. #' #' @param B Functions of the second set, represented by a matrix of their functional values of #' size \code{n*d}. \code{n} stands for the number of functions, \code{d} #' is the number of the equi-distant points {1,...,d} in the domain of the data [1,d] at which the functional #' values of the \code{n} functions are evaluated. The grid of observation points for the #' functions \code{A} and \code{B} must be the same. #' #' @return A symmetric matrix of the distances of the functions of size \code{m*n}. #' #' @examples #' datapop = dataf2rawfd(dataf.population()$dataf,range=c(1950,2015),d=66) #' A = datapop[1:20,] #' B = datapop[21:50,] #' L2metric(A,B) #' #' @seealso \code{\link{depthf.hM}} #' @seealso \code{\link{dataf2rawfd}} L2metric = function(A,B){ # computes fast approximation of L2 distance between fctions A and B M = .Fortran("metrl2", as.numeric(A), as.numeric(B), as.integer(m<-nrow(A)), as.integer(n<-nrow(B)), as.integer(d<-length(as.numeric(A))/nrow(A)), m = as.numeric(rep(-1,m*n)))$m return(M = matrix(M,nrow=m)) } depthf.M = function(A,B,q=.2){ # h-mode depth for the L2 metric mdist = L2metric(B,B) mdist2 = L2metric(A,B) hq2 = quantile(mdist[mdist>0],probs=q,type=1) # probs=.2 as in Cuevas et al. (2007) return(rowSums(dnorm(mdist2/hq2))) } #' @title Fast computation of the uniform metric for sets of functional data #' #' @description #' Returns the matrix of \eqn{C} (uniform) distances between two sets of functional data. #' #' @author Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} #' @keywords metric functional #' #' @details #' For two sets of functional data of sizes \code{m} and \code{n} #' represented by matrices of their functional values, #' this function returns the symmetric matrix of size \code{m*n} whose entry in the #' \code{i}-th row and \code{j}-th column is the approximated \eqn{C} (uniform) distance of the #' \code{i}-th function from the first set, and the \code{j}-th function from the second set. #' This function is utilized in the computation of the h-mode depth. #' #' @param A Functions of the first set, represented by a matrix of their functional values of #' size \code{m*d}. \code{m} stands for the number of functions, \code{d} #' is the number of the equi-distant points in the domain of the data at which the functional #' values of the \code{m} functions are evaluated. #' #' @param B Functions of the second set, represented by a matrix of their functional values of #' size \code{n*d}. \code{n} stands for the number of functions, \code{d} #' is the number of the equi-distant points in the domain of the data at which the functional #' values of the \code{n} functions are evaluated. The grid of observation points for the #' functions \code{A} and \code{B} must be the same. #' #' @return A symmetric matrix of the distances of the functions of size \code{m*n}. #' #' @examples #' datapop = dataf2rawfd(dataf.population()$dataf,range=c(1950,2015),d=66) #' A = datapop[1:20,] #' B = datapop[21:50,] #' Cmetric(A,B) #' #' @seealso \code{\link{depthf.hM}} #' @seealso \code{\link{dataf2rawfd}} Cmetric = function(A,B){ # computes fast approximation of \eqn{C} distance between fctions A and B M = .Fortran("metrC", as.numeric(A), as.numeric(B), as.integer(m<-nrow(A)), as.integer(n<-nrow(B)), as.integer(d<-length(as.numeric(A))/nrow(A)), m = as.numeric(rep(-1,m*n)))$m return(M = matrix(M,nrow=m)) } depthf.MC = function(A,B,q=.2){ # h-mode depth for the \eqn{C} metric mdist = Cmetric(B,B) mdist2 = Cmetric(A,B) hq2 = quantile(mdist[mdist>0],probs=q,type=1) # probs=.2 as in Cuevas et al. (2007) return(rowSums(dnorm(mdist2/hq2))) } #' @title h-mode depth for functional data #' #' @description #' The h-mode depth of functional real-valued data. #' #' @author Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} #' @keywords depth functional #' #' @details #' The function returns the vectors of the sample h-mode depth values. The kernel #' used in the evaluation is the standard Gaussian kernel, the bandwidth value is chosen #' as a quantile of the non-zero distances between the random sample curves. #' #' @param datafA Functions whose depth is computed, represented by a \code{dataf} object of their arguments #' and functional values. \code{m} stands for the number of functions. #' #' @param datafB Random sample functions with respect to which the depth of \code{datafA} is computed. #' \code{datafB} is represented by a \code{dataf} object of their arguments #' and functional values. \code{n} is the sample size. #' The grid of observation points for the #' functions \code{datafA} and \code{datafB} may not be the same. #' #' @param range The common range of the domain where the fucntions \code{datafA} and \code{datafB} are observed. #' Vector of length 2 with the left and the right end of the interval. Must contain all arguments given in #' \code{datafA} and \code{datafB}. #' #' @param d Grid size to which all the functional data are transformed. For depth computation, #' all functional observations are first transformed into vectors of their functional values of length \code{d} #' corresponding to equi-spaced points in the domain given by the interval \code{range}. Functional values in these #' points are reconstructed using linear interpolation, and extrapolation. #' #' @param norm The norm used for the computation of the depth. Two possible #' choices are implemented: \code{C} for the uniform norm of continuous functions, #' and \code{L2} for the \eqn{L^2} norm of integrable functions. #' #' @param q The quantile used to determine the value of the bandwidth \eqn{h} #' in the computation of the h-mode depth. \eqn{h} is taken as the \code{q}-quantile of #' all non-zero distances between the functions \code{B}. By default, this value is set #' to \code{q=0.2}, in accordance with the choice of Cuevas et al. (2007). #' #' @return A vector of length \code{m} of the h-mode depth values. #' #' @references Cuevas, A., Febrero, M. and Fraiman, R. (2007). #' Robust estimation and classification for functional data via projection-based depth notions. #' \emph{Computational Statistics} \bold{22} (3), 481--496. #' #' @references Nagy, S., Gijbels, I. and Hlubinka, D. (2016). #' Weak convergence of discretely observed functional data with applications. #' \emph{Journal of Multivariate Analysis}, \bold{146}, 46--62. #' #' @examples #' datafA = dataf.population()$dataf[1:20] #' datafB = dataf.population()$dataf[21:50] #' depthf.hM(datafA,datafB) #' depthf.hM(datafA,datafB,norm="L2") depthf.hM = function(datafA,datafB,range=NULL,d=101, norm = c("C","L2"), q=.2){ A = dataf2rawfd(datafA, range = range, d = d) B = dataf2rawfd(datafB, range = range, d = d) norm = match.arg(norm) switch(norm, C = depthf.MC(A,B,q), L2 = depthf.M(A,B,q) ) } AdjBDKernL = function(b,v,J=3){ # v is a matrix m x eval m = dim(v)[1] # sample size eval = length(b) com = combn(m,J) poc = dim(com)[2] s = .Fortran("AdjLP", as.integer(eval), as.integer(J), as.integer(m), as.integer(poc), as.integer(as.vector(com)), as.numeric(b), as.numeric(v), dj = as.numeric(1))$dj return(s) } AdjBDL = function(b,v,J=3,K=1){ eval = length(b) m = dim(v)[1] # sample size sam = sample.int(m,m) # shuffle if (K==0) K=1 # make sure K!=0 nk = m%/%K # subsample size nlast = m %% K+nk # last subsample size Dpom = rep(NA,K) # subsample depth if (K>1){ for (k in 1:(K-1)) if (eval>1) Dpom[k] = AdjBDKernL(b,v[sam[((k-1)*nk+1):(k*nk)],],J) else Dpom[k] = AdjBDKernL(b,t(as.matrix(v[sam[((k-1)*nk+1):(k*nk)],])),J) } {if (nlast>0){ if (eval>1) Dpom[K]= AdjBDKernL(b,v[sam[((K-1)*nk+1):m],],J) else Dpom[K]= AdjBDKernL(b,t(as.matrix(v[sam[((K-1)*nk+1):m],])),J) } else (K=K-1)} return(mean(Dpom[1:K])) } AdjBDsampleL = function(A,B,J=3,K=1){ m = dim(A)[1] hlb = rep(NA,m) for (i in 1:m) hlb[i] = AdjBDL(A[i,],B,J,K) return(hlb) } AdjBDKernC = function(b,v,J=3){ # v ma rozmery m x eval m = dim(v)[1] # sample size eval = length(b) com = combn(m,J) poc = dim(com)[2] s = .Fortran("AdjC", as.integer(eval), as.integer(J), as.integer(m), as.integer(poc), as.integer(as.vector(com)), as.numeric(b), as.numeric(v), dj = as.numeric(1))$dj return(s) } AdjBDC = function(b,v,J=3,K=1){ # v is a matrix m x eval eval = length(b) m = dim(v)[1] # sample size sam = sample.int(m,m) # shuffle if (K==0) K=1 # make sure K!=0 nk = m%/%K # subsample size nlast = m %% K+nk # last subsample size Dpom = rep(NA,K) # subsample depth if (K>1){ for (k in 1:(K-1)) if (eval>1) Dpom[k] = AdjBDKernC(b,v[sam[((k-1)*nk+1):(k*nk)],],J) else Dpom[k] = AdjBDKernC(b,t(as.matrix(v[sam[((k-1)*nk+1):(k*nk)],])),J) } {if (nlast>0){ if (eval>1) Dpom[K]= AdjBDKernC(b,v[sam[((K-1)*nk+1):m],],J) else Dpom[K]= AdjBDKernC(b,t(as.matrix(v[sam[((K-1)*nk+1):m],])),J) } else (K=K-1)} return(mean(Dpom[1:K])) } AdjBDsampleC = function(A,B,J=3,K=1){ m = dim(A)[1] hlb = rep(NA,m) for (i in 1:m) hlb[i] = AdjBDC(A[i,],B,J,K) return(hlb) } #' @title Adjusted band depth for functional data #' #' @description #' The adjusted band depth #' of functional real-valued data based on either the #' \eqn{C} (uniform) norm, or on the \eqn{L^2} norm of functions. #' #' @author Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} #' @keywords depth functional #' #' @details #' The function returns the vector of the sample adjusted band depth values. The kernel #' used in the evaluation is the function \eqn{K(u) = exp(-u)}. #' #' @param datafA Functions whose depth is computed, represented by a \code{dataf} object of their arguments #' and functional values. \code{m} stands for the number of functions. #' #' @param datafB Random sample functions with respect to which the depth of \code{datafA} is computed. #' \code{datafB} is represented by a \code{dataf} object of their arguments #' and functional values. \code{n} is the sample size. #' The grid of observation points for the #' functions \code{datafA} and \code{datafB} may not be the same. #' #' @param range The common range of the domain where the fucntions \code{datafA} and \code{datafB} are observed. #' Vector of length 2 with the left and the right end of the interval. Must contain all arguments given in #' \code{datafA} and \code{datafB}. #' #' @param d Grid size to which all the functional data are transformed. For depth computation, #' all functional observations are first transformed into vectors of their functional values of length \code{d} #' corresponding to equi-spaced points in the domain given by the interval \code{range}. Functional values in these #' points are reconstructed using linear interpolation, and extrapolation, see Nagy et al. (2016). #' #' @param norm The norm used for the computation of the depth. Two possible #' choices are implemented: \code{C} for the uniform norm of continuous functions, #' and \code{L2} for the \eqn{L^2} norm of integrable functions. #' #' @param J The order of the adjusted band depth, that is the maximal number of functions #' taken in a band. Acceptable values are \code{2}, \code{3},... By default this value is set to \code{2}. #' Note that this is NOT the order as #' defined in the order-extended version of adjusted band depths in Nagy et al. (2016), used #' for the detection of shape outlying curves. #' #' @param K Number of sub-samples of the functions from \code{B} taken to speed up the #' computation. By default, sub-sampling is not performed. Values of \code{K} larger than \code{1} #' result in an approximation of the adjusted band depth. #' #' @return A vectors of length \code{m} of the adjusted band depths. #' #' @examples #' datafA = dataf.population()$dataf[1:20] #' datafB = dataf.population()$dataf[21:50] #' depthf.ABD(datafA,datafB) #' depthf.ABD(datafA,datafB,norm="L2") #' #' @seealso \code{\link{depthf.BD}} #' #' @references Gijbels, I., Nagy, S. (2015). #' Consistency of non-integrated depths for functional data. #' \emph{Journal of Multivariate Analysis} \bold{140}, 259--282. #' #' @references Nagy, S., Gijbels, I. and Hlubinka, D. (2016). #' Weak convergence of discretely observed functional data with applications. #' \emph{Journal of Multivariate Analysis}, \bold{146}, 46--62. #' #' @references Nagy, S., Gijbels, I. and Hlubinka, D. (2017). #' Depth-based recognition of shape outlying functions. #' \emph{Journal of Computational and Graphical Statistics}, \bold{26:4}, 883--893. depthf.ABD = function(datafA,datafB,range=NULL,d=101, norm = c("C","L2"), J=2, K=1){ A = dataf2rawfd(datafA, range = range, d = d) B = dataf2rawfd(datafB, range = range, d = d) norm = match.arg(norm) switch(norm, C = AdjBDsampleC(A,B,J,K), L2 = AdjBDsampleL(A,B,J,K) ) } DiffDepth = function(A,B,approx=0){ # A functions whose depth I compute # B functions wrt whose the depth is computed # both 1dimensional, n*d, n nr of functions, d dimensionality # approx is number of approximations to be used, 0 for full computation d = dim(A)[2] m = dim(A)[1] n = dim(B)[1] if(dim(B)[2]!=d) stop("dimension mismatch") Av = as.vector(A) Bv = as.vector(B) if (approx>0){ C = combn(1:d,2) # all couples if (approx>=ncol(C)){ ind.sample = 1:ncol(C) approx = ncol(C) } else ind.sample = sample.int(ncol(C),approx) RN = matrix(C[,ind.sample],nrow=2) # RN = random numbers of size 2*REP from 1:d } else RN = 0 FD = .Fortran("DiffD", as.numeric(Av), # A as.numeric(Bv), # B as.integer(m), # m as.integer(n), # n as.integer(d), # d as.integer(approx), # REP as.integer(RN), # RN funsdep=as.numeric(rep(-1,m)), funhdep=as.numeric(rep(-1,m)), funsdepm=as.numeric(rep(-1,m)), funhdepm=as.numeric(rep(-1,m)), Psdep = as.numeric(rep(-1,d*d)), Phdep = as.numeric(rep(-1,d*d)), IAsdep =as.integer(rep(-1,m)), IAhdep =as.integer(rep(-1,m))) if(approx==0){ S_IA = FD$IAsdep/(d^2) H_IA = FD$IAhdep/(d^2) } else { S_IA = FD$IAsdep/(approx) H_IA = FD$IAhdep/(approx) } if (m>1) return(list( Simpl_FD = FD$funsdep, Half_FD = FD$funhdep, Simpl_ID = FD$funsdepm, Half_ID = FD$funhdepm, Simpl_IA = S_IA, Half_IA = H_IA)) if ((m==1)&(approx==0)){ PSD = matrix(FD$Psdep,ncol=d) PSD = pmax(PSD,0) PSD = PSD + t(PSD) diag(PSD) = NA PHD = matrix(FD$Phdep,ncol=d) PHD = pmax(PHD,0) PHD = PHD + t(PHD) diag(PHD) = NA return(list( Simpl_FD = FD$funsdep, Half_FD = FD$funhdep, Simpl_ID = FD$funsdepm, Half_ID = FD$funhdepm, PSD = PSD, PHD = PHD, Simpl_IA = S_IA, Half_IA = H_IA)) } if ((m==1)&(approx>0)){ PSD = matrix(FD$Psdep,ncol=d) for(i in 1:approx) PSD[RN[2*i-1],RN[2*i]]=PSD[RN[2*i],RN[2*i-1]] # symmetrize PSD[PSD==-1] = NA PHD = matrix(FD$Phdep,ncol=d) for(i in 1:approx) PHD[RN[2*i-1],RN[2*i]]=PHD[RN[2*i],RN[2*i-1]] # symmetrize PHD[PHD==-1] = NA return(list( Simpl_FD = FD$funsdep, Half_FD = FD$funhdep, Simpl_ID = FD$funsdepm, Half_ID = FD$funhdepm, PSD = PSD, PHD = PHD, Simpl_IA = S_IA, Half_IA = H_IA)) } } DiffDepth3D = function(A,B,approx=101){ d = dim(A)[2] m = dim(A)[1] n = dim(B)[1] if(dim(B)[2]!=d) stop("dimension mismatch") if(approx==0) approx=101 DT = matrix(nrow=m,ncol=approx) for(a in 1:approx){ I = sample.int(d,3) DT[,a] = depth.halfspace(A[,I],B[,I],exact=TRUE) } D = apply(DT,1,mean) # integrated depth DI = apply(DT,1,min) # infimal depth IA = apply(DT,1,function(x) sum(x==min(x)))/approx # infimal area return(list(Half_FD=D,Half_ID=DI,Half_IA=IA)) } #' @title Bivariate h-mode depth for functional data based on the \eqn{L^2} metric #' #' @description #' The h-mode depth #' of functional bivariate data (that is, data of the form \eqn{X:[a,b] \to R^2}, #' or \eqn{X:[a,b] \to R} and the derivative of \eqn{X}) based on the #' \eqn{L^2} metric of functions. #' #' @author Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} #' @keywords depth functional derivatives #' #' @details #' The function returns the vectors of sample h-mode depth values. The kernel #' used in the evaluation is the standard Gaussian kernel, the bandwidth value is chosen #' as a quantile of the non-zero distances between the random sample curves. #' #' @param datafA Bivariate functions whose depth is computed, represented by a multivariate \code{dataf} object of #' their arguments (vector), and a matrix with two columns of the corresponding bivariate functional values. #' \code{m} stands for the number of functions. #' #' @param datafB Bivariate random sample functions with respect to which the depth of \code{datafA} is computed. #' \code{datafB} is represented by a multivariate \code{dataf} object of their arguments #' (vector), and a matrix with two columns of the corresponding bivariate functional values. #' \code{n} is the sample size. The grid of observation points for the #' functions \code{datafA} and \code{datafB} may not be the same. #' #' @param range The common range of the domain where the fucntions \code{datafA} and \code{datafB} are observed. #' Vector of length 2 with the left and the right end of the interval. Must contain all arguments given in #' \code{datafA} and \code{datafB}. #' #' @param d Grid size to which all the functional data are transformed. For depth computation, #' all functional observations are first transformed into vectors of their functional values of length \code{d} #' corresponding to equi-spaced points in the domain given by the interval \code{range}. Functional values in these #' points are reconstructed using linear interpolation, and extrapolation. #' #' @param q The quantile used to determine the value of the bandwidth \eqn{h} #' in the computation of the h-mode depth. \eqn{h} is taken as the \code{q}-quantile of #' all non-zero distances between the functions \code{B}. By default, this value is set #' to \code{q=0.2}, in accordance with the choice of Cuevas et al. (2007). #' #' @return Three vectors of length \code{m} of h-mode depth values are returned: #' \itemize{ #' \item \code{hM} the unscaled h-mode depth, #' \item \code{hM_norm} the h-mode depth \code{hM} linearly transformed so that its range is [0,1], #' \item \code{hM_norm2} the h-mode depth \code{FD} linearly transformed by a transformation such that #' the range of the h-mode depth of \code{B} with respect to \code{B} is [0,1]. This depth may give negative values. #' } #' #' @references Cuevas, A., Febrero, M. and Fraiman, R. (2007). #' Robust estimation and classification for functional data via projection-based depth notions. #' \emph{Computational Statistics} \bold{22} (3), 481--496. #' #' @examples #' datafA = dataf.population()$dataf[1:20] #' datafB = dataf.population()$dataf[21:50] #' #' datafA2 = derivatives.est(datafA,deriv=c(0,1)) #' datafB2 = derivatives.est(datafB,deriv=c(0,1)) #' #' depthf.hM2(datafA2,datafB2) #' #' depthf.hM2(datafA2,datafB2)$hM #' # depthf.hM2(cbind(A2[,,1],A2[,,2]),cbind(B2[,,1],B2[,,2]))$hM #' # the two expressions above should give the same result #' #' @seealso \code{\link{depthf.hM}} depthf.hM2 = function(datafA,datafB,range=NULL,d=101,q=.2){ # h-Mode depth Cuevas_etal2007 # A functions whose depth is computed : either M*D matrix (M functions, D points per function), # or M*D*2 array (2 derivative levels), # B functions of random sample : as A # q : quantile, bandwidth value in the resulting kernel estimate # computes the same as depthf.M (with cbind-ed 2 levels if derivatives are involved) # depthf.M(cbind(A[,,1],A[,,2]),cbind(B[,,1],B[,,2])) # depthf.M2(A,B)$FD # depthf.M2(cbind(A[,,1],A[,,2]),cbind(B[,,1],B[,,2]))$FD # all should give the same result A = dataf2rawfd(datafA, range = range, d = d) B = dataf2rawfd(datafB, range = range, d = d) # q=.2 Cuevas et al, 0.15 default v usc.fda M = .Fortran( "funMD", as.numeric(A), as.numeric(B), as.integer(m<-nrow(A)), as.integer(n<-nrow(B)), as.integer(d<-length(as.numeric(A))/nrow(A)), as.numeric(q), md = as.numeric(rep(-1,m)) )$md # because of scaling in depth.mode() in fda.usc M.ori = .Fortran( "funMD", as.numeric(B), as.numeric(B), as.integer(n), as.integer(n), as.integer(d), as.numeric(q), md = as.numeric(rep(-1,n)) )$md Mn = (M-min(M))/(max(M)-min(M)) Mn2 = (M-min(M.ori))/(max(M.ori)-min(M.ori)) return(list(hM = M, hM_norm = Mn, hM_norm2 = Mn2)) } #' @title Univariate random projection depths for functional data #' #' @description #' Random projection depth and random functional depth for functional data. #' #' @author Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} #' @keywords depth functional #' #' @details #' The function returns the vectors of sample random projection, and random functional depth values. #' The random projection depth described in Cuevas et al. (2007) is based on the average univariate depth #' of one-dimensional projections of functional data. The projections are taken randomly as a sample of standard #' normal \code{d}-dimensional random variables, where \code{d} stands for the dimensionality of the discretized #' functional data. #' #' The random functional depth (also called random Tukey depth, or random halfspace depth) is described in #' Cuesta-Albertos and Nieto-Reyes (2008). The functional data are projected into the real line in random #' directions as for the random projection depths. Afterwards, an approximation of the halfspace (Tukey) depth #' based on this limited number of univariate projections is assessed. #' #' @param datafA Functions whose depth is computed, represented by a \code{dataf} object of their arguments #' and functional values. \code{m} stands for the number of functions. #' #' @param datafB Random sample functions with respect to which the depth of \code{datafA} is computed. #' \code{datafB} is represented by a \code{dataf} object of their arguments #' and functional values. \code{n} is the sample size. #' The grid of observation points for the #' functions \code{datafA} and \code{datafB} may not be the same. #' #' @param range The common range of the domain where the fucntions \code{datafA} and \code{datafB} are observed. #' Vector of length 2 with the left and the right end of the interval. Must contain all arguments given in #' \code{datafA} and \code{datafB}. #' #' @param d Grid size to which all the functional data are transformed. For depth computation, #' all functional observations are first transformed into vectors of their functional values of length \code{d} #' corresponding to equi-spaced points in the domain given by the interval \code{range}. Functional values in these #' points are reconstructed using linear interpolation, and extrapolation. #' #' @param nproj Number of projections taken in the computation of the random projection depth. By default taken #' to be \code{51}. #' #' @param nproj2 Number of projections taken in the computation of the random functional depth. By default taken #' to be \code{5}. \code{nproj2} should be much smaller than \code{d}, the dimensionality of the discretized #' functional data. #' #' @return Three vectors of depth values of length \code{m} are returned: #' \itemize{ #' \item \code{Simpl_FD} the random projection depth based on the univariate simplicial depth, #' \item \code{Half_FD} the random projection depth based on the univariate halfspace depth, #' \item \code{RHalf_FD} the random halfspace depth. #' } #' #' @references Cuevas, A., Febrero, M. and Fraiman, R. (2007). #' Robust estimation and classification for functional data via projection-based depth notions, #' \emph{Computational Statistics} \bold{22} (3), 481--496. #' #' @references Cuesta-Albertos, J.A. and Nieto-Reyes, A. (2008). #' The random Tukey depth. #' \emph{Computational Statistics & Data Analysis} \bold{52} (11), 4979--4988. #' #' @examples #' datafA = dataf.population()$dataf[1:20] #' datafB = dataf.population()$dataf[21:50] #' #' depthf.RP1(datafA,datafB) #' #' @seealso \code{\link{depthf.RP2}} depthf.RP1 = function(datafA,datafB,range=NULL,d=101,nproj=50,nproj2=5){ # simple 1D projection depth # nproj nr of projections taken # # SFD : projection \eqn{L^2} -> R -> mean of univariate Simplicial Depth (nproj projections) # HFD : projection \eqn{L^2} -> R -> mean of univariate Halfspace Depth (nproj projections) # RFD : projection \eqn{L^2} -> R -> infimum of univariate Halfspace Depths (nproj2 projections) A = dataf2rawfd(datafA, range = range, d = d) B = dataf2rawfd(datafB, range = range, d = d) A1 = as.vector(A) B1 = as.vector(B) d = dim(A)[2] m = dim(A)[1] n = dim(B)[1] V = rnorm(nproj*d) if(dim(B)[2]!=d) stop("dimension mismatch") FD = .Fortran("funRPD1", as.numeric(A1), # A as.numeric(B1), # B as.integer(m), # m as.integer(n), # n as.integer(d), # d as.integer(nproj), # nproj as.integer(nproj2), # nproj2 as.numeric(V), # projections funsdep=as.numeric(rep(-1,m)), funhdep=as.numeric(rep(-1,m)), funrdep=as.numeric(rep(-1,m))) return(list(Simpl_FD = FD$funsdep, Half_FD = FD$funhdep, RHalf_FD = FD$funrdep)) } #' @title Bivariate integrated and infimal depth for functional data #' #' @description #' Integrated and infimal depths #' of functional bivariate data (that is, data of the form \eqn{X:[a,b] \to R^2}, #' or \eqn{X:[a,b] \to R} and the derivative of \eqn{X}) based on the #' bivariate halfspace and simplicial depths. #' #' @author Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} #' @keywords depth functional derivatives #' #' @details #' The function returns the vectors of sample integrated and infimal depth values. #' #' @param datafA Bivariate functions whose depth is computed, represented by a multivariate \code{dataf} object of #' their arguments (vector), and a matrix with two columns of the corresponding bivariate functional values. #' \code{m} stands for the number of functions. #' #' @param datafB Bivariate random sample functions with respect to which the depth of \code{datafA} is computed. #' \code{datafB} is represented by a multivariate \code{dataf} object of their arguments #' (vector), and a matrix with two columns of the corresponding bivariate functional values. #' \code{n} is the sample size. The grid of observation points for the #' functions \code{datafA} and \code{datafB} may not be the same. #' #' @param range The common range of the domain where the fucntions \code{datafA} and \code{datafB} are observed. #' Vector of length 2 with the left and the right end of the interval. Must contain all arguments given in #' \code{datafA} and \code{datafB}. #' #' @param d Grid size to which all the functional data are transformed. For depth computation, #' all functional observations are first transformed into vectors of their functional values of length \code{d} #' corresponding to equi-spaced points in the domain given by the interval \code{range}. Functional values in these #' points are reconstructed using linear interpolation, and extrapolation. #' #' @return Four vectors of length \code{m} are returned: #' \itemize{ #' \item \code{Simpl_FD} the integrated depth based on the bivariate simplicial depth, #' \item \code{Half_FD} the integrated depth based on the bivariate halfspace depth, #' \item \code{Simpl_ID} the infimal depth based on the bivariate simplicial depth, #' \item \code{Half_ID} the infimal depth based on the bivariate halfspace depth. #' } #' In addition, two vectors of length \code{m} of the relative area of smallest depth values is returned: #' \itemize{ #' \item \code{Simpl_IA} the proportions of points at which the depth \code{Simpl_ID} was attained, #' \item \code{Half_IA} the proportions of points at which the depth \code{Half_ID} was attained. #' } #' The values \code{Simpl_IA} and \code{Half_IA} are always in the interval [0,1]. #' They introduce ranking also among functions having the same #' infimal depth value - if two functions have the same infimal depth, the one with larger infimal area #' \code{IA} is said to be less central. #' #' @references Hlubinka, D., Gijbels, I., Omelka, M. and Nagy, S. (2015). #' Integrated data depth for smooth functions and its application in supervised classification. #' \emph{Computational Statistics}, \bold{30} (4), 1011--1031. #' #' @references Nagy, S., Gijbels, I. and Hlubinka, D. (2017). #' Depth-based recognition of shape outlying functions. #' \emph{Journal of Computational and Graphical Statistics}, \bold{26:4}, 883--893. #' #' @examples #' datafA = dataf.population()$dataf[1:20] #' datafB = dataf.population()$dataf[21:50] #' #' dataf2A = derivatives.est(datafA,deriv=c(0,1)) #' dataf2B = derivatives.est(datafB,deriv=c(0,1)) #' depthf.fd2(dataf2A,dataf2B) #' #' @seealso \code{\link{depthf.fd1}}, \code{\link{infimalRank}} depthf.fd2 = function(datafA,datafB,range=NULL,d=101){ # A functions whose depth I compute # B functions wrt whose the depth is computed # both 2dimensional, n*d*2, n nr of functions, d dimensionality # now provides also infimal depth (inf_D2) A = dataf2rawfd(datafA, range = range, d = d) B = dataf2rawfd(datafB, range = range, d = d) A1 = as.vector(A[,,1]) A2 = as.vector(A[,,2]) B1 = as.vector(B[,,1]) B2 = as.vector(B[,,2]) d = dim(A)[2] m = dim(A)[1] n = dim(B)[1] if(dim(B)[2]!=d) stop("dimension mismatch") FD = .Fortran("funD2", as.numeric(A1), # A1 as.numeric(A2), # A2 as.numeric(B1), # B1 as.numeric(B2), # B2 as.integer(m), # m as.integer(n), # n as.integer(d), # d funsdep=as.numeric(rep(-1,m)), funhdep=as.numeric(rep(-1,m)), fIsdep =as.numeric(rep(-1,m)), fIhdep =as.numeric(rep(-1,m)), IAsdep =as.integer(rep(-1,m)), IAhdep =as.integer(rep(-1,m)) ) return(list( Simpl_FD = FD$funsdep, Half_FD = FD$funhdep, Simpl_ID = FD$fIsdep, Half_ID = FD$fIhdep, Simpl_IA = FD$IAsdep/d, Half_IA = FD$IAhdep/d )) } #' @title Bivariate random projection depths for functional data #' #' @description #' Double random projection depths of functional bivariate data (that is, data of the form \eqn{X:[a,b] \to R^2}, #' or \eqn{X:[a,b] \to R} and the derivative of \eqn{X}). #' #' @author Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} #' @keywords depth functional derivatives #' #' @details #' The function returns the vectors of sample double random projection depth values. #' The double random projection depths are described in Cuevas et al. (2007). They are of two types: RP2 type, and #' RPD type. Both types of depths are based on bivariate projections of the bivariate functional data. #' These projections are taken randomly as a sample of standard #' normal \code{d}-dimensional random variables, where \code{d} stands for the dimensionality of the internally #' represented discretized #' functional data. For RP2 type depths, the average bivariate depth of the projected quantities is assessed. #' For RPD type depths, further univariate projections of these bivariate projected quantities are evaluated, and #' based on these final univariate quantities, the average univariate depth is computed. #' #' @param datafA Bivariate functions whose depth is computed, represented by a multivariate \code{dataf} object of #' their arguments (vector), and a matrix with two columns of the corresponding bivariate functional values. #' \code{m} stands for the number of functions. #' #' @param datafB Bivariate random sample functions with respect to which the depth of \code{datafA} is computed. #' \code{datafB} is represented by a multivariate \code{dataf} object of their arguments #' (vector), and a matrix with two columns of the corresponding bivariate functional values. #' \code{n} is the sample size. The grid of observation points for the #' functions \code{datafA} and \code{datafB} may not be the same. #' #' @param range The common range of the domain where the fucntions \code{datafA} and \code{datafB} are observed. #' Vector of length 2 with the left and the right end of the interval. Must contain all arguments given in #' \code{datafA} and \code{datafB}. #' #' @param d Grid size to which all the functional data are transformed. For depth computation, #' all functional observations are first transformed into vectors of their functional values of length \code{d} #' corresponding to equi-spaced points in the domain given by the interval \code{range}. Functional values in these #' points are reconstructed using linear interpolation, and extrapolation. #' #' @param nproj Number of projections taken in the computation of the double random projection depth. By default taken #' to be \code{51}. #' #' @return Five vectors of length \code{m} are returned: #' \itemize{ #' \item \code{Simpl_FD} the double random projection depth RP2 based on the bivariate simplicial depth, #' \item \code{Half_FD} the double random projection depth RP2 based on the bivariate halfspace depth, #' \item \code{hM_FD} the double random projection depth RP2 based on the bivariate h-mode depth, #' \item \code{Simpl_DD} the double random projection depth RPD based on the univariate simplicial depth, #' \item \code{Half_DD} the random projection depth RPD based on the univariate halfspace depth, #' } #' #' @references Cuevas, A., Febrero, M. and Fraiman, R. (2007). #' Robust estimation and classification for functional data via projection-based depth notions. #' \emph{Computational Statistics} \bold{22} (3), 481--496. #' #' @examples #' datafA = dataf.population()$dataf[1:20] #' datafB = dataf.population()$dataf[21:50] #' #' dataf2A = derivatives.est(datafA,deriv=c(0,1)) #' dataf2B = derivatives.est(datafB,deriv=c(0,1)) #' depthf.RP2(dataf2A,dataf2B) #' #' #' @seealso \code{\link{depthf.RP1}} depthf.RP2 = function(datafA,datafB,range=NULL,d=101,nproj=51){ # double projection depth # nproj nr of projections taken # # SFD : (\eqn{L^2})^2 -> R^2 -> 2D Mean Simplicial Depth # HFD : (\eqn{L^2})^2 -> R^2 -> 2D Mean Halfspace Depth # MFD : (\eqn{L^2})^2 -> R^2 -> 2D Mean h-Mode Depth # SDD : (\eqn{L^2})^2 -> R^2 -> R^1 -> Mean Simplicial Depth # HDD : (\eqn{L^2})^2 -> R^2 -> R^1 -> Mean Halfspace Depth # A = dataf2rawfd(datafA, range = range, d = d) B = dataf2rawfd(datafB, range = range, d = d) q = .2 # quantile for modal depth A1 = as.vector(A[,,1]) A2 = as.vector(A[,,2]) B1 = as.vector(B[,,1]) B2 = as.vector(B[,,2]) d = dim(A)[2] m = dim(A)[1] n = dim(B)[1] V = rnorm(nproj*d+nproj*2) if(dim(B)[2]!=d) stop("dimension mismatch") FD = .Fortran("funRPD2", as.numeric(A1), # A1 as.numeric(A2), # A2 as.numeric(B1), # B1 as.numeric(B2), # B2 as.integer(m), # m as.integer(n), # n as.integer(d), # d as.integer(nproj), # nproj as.numeric(V), # projections as.numeric(q), # q funsdep=as.numeric(rep(-1,m)), funhdep=as.numeric(rep(-1,m)), funmdep=as.numeric(rep(-1,m)), funsddep=as.numeric(rep(-1,m)), funhddep=as.numeric(rep(-1,m))) return(list(Simpl_FD = FD$funsdep, Half_FD = FD$funhdep, hM_FD = FD$funmdep, Simpl_DD = FD$funsddep, Half_DD = FD$funhddep)) } #' @title Half-region depth for functional data #' #' @description #' The half-region depth #' for functional real-valued data. #' #' @author Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} #' @keywords depth functional #' #' @details #' The function returns the vector of the sample half-region depth values. #' #' @param datafA Functions whose depth is computed, represented by a \code{dataf} object of their arguments #' and functional values. \code{m} stands for the number of functions. #' #' @param datafB Random sample functions with respect to which the depth of \code{datafA} is computed. #' \code{datafB} is represented by a \code{dataf} object of their arguments #' and functional values. \code{n} is the sample size. #' The grid of observation points for the #' functions \code{datafA} and \code{datafB} may not be the same. #' #' @param range The common range of the domain where the fucntions \code{datafA} and \code{datafB} are observed. #' Vector of length 2 with the left and the right end of the interval. Must contain all arguments given in #' \code{datafA} and \code{datafB}. #' #' @param d Grid size to which all the functional data are transformed. For depth computation, #' all functional observations are first transformed into vectors of their functional values of length \code{d} #' corresponding to equi-spaced points in the domain given by the interval \code{range}. Functional values in these #' points are reconstructed using linear interpolation, and extrapolation. #' #' @return A vector of length \code{m} of the half-region depth values. #' #' @references Lopez-Pintado, S. and Romo, J. (2011). #' A half-region depth for functional data. #' \emph{Computational Statistics & Data Analysis} \bold{55} (4), 1679--1695. #' #' @examples #' datafA = dataf.population()$dataf[1:20] #' datafB = dataf.population()$dataf[21:50] #' depthf.HR(datafA,datafB) depthf.HR = function(datafA,datafB,range=NULL,d=101){ A = dataf2rawfd(datafA, range = range, d = d) B = dataf2rawfd(datafB, range = range, d = d) d = dim(A)[2] m = dim(A)[1] n = dim(B)[1] if(dim(B)[2]!=d) stop("dimension mismatch") FD = .Fortran("HRD", as.numeric(A), # A as.numeric(B), # B as.integer(m), # m as.integer(n), # n as.integer(d), # d FD=as.numeric(rep(-1,m))) return(FD$FD) } #' @title Band depth for functional data #' #' @description #' The (unadjusted) band depth #' for functional real-valued data of order \code{J=2}. #' #' @author Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} #' @keywords depth functional #' #' @details #' The function returns the vector of the sample (unadjusted) band depth values. #' #' @param datafA Functions whose depth is computed, represented by a \code{dataf} object of their arguments #' and functional values. \code{m} stands for the number of functions. #' #' @param datafB Random sample functions with respect to which the depth of \code{datafA} is computed. #' \code{datafB} is represented by a \code{dataf} object of their arguments #' and functional values. \code{n} is the sample size. #' The grid of observation points for the #' functions \code{datafA} and \code{datafB} may not be the same. #' #' @param range The common range of the domain where the fucntions \code{datafA} and \code{datafB} are observed. #' Vector of length 2 with the left and the right end of the interval. Must contain all arguments given in #' \code{datafA} and \code{datafB}. #' #' @param d Grid size to which all the functional data are transformed. For depth computation, #' all functional observations are first transformed into vectors of their functional values of length \code{d} #' corresponding to equi-spaced points in the domain given by the interval \code{range}. Functional values in these #' points are reconstructed using linear interpolation, and extrapolation. #' #' @return A vector of length \code{m} of the band depth values. #' #' @references Lopez-Pintado, S. and Romo, J. (2009), On the concept of depth for functional data, #' \emph{J. Amer. Statist. Assoc.} \bold{104} (486), 718 - 734. #' #' @examples #' datafA = dataf.population()$dataf[1:20] #' datafB = dataf.population()$dataf[21:50] #' depthf.BD(datafA,datafB) #' #' @seealso \code{\link{depthf.ABD}}, \code{\link{depthf.fd1}} depthf.BD = function(datafA,datafB,range=NULL,d=101){ A = dataf2rawfd(datafA, range = range, d = d) B = dataf2rawfd(datafB, range = range, d = d) d = dim(A)[2] m = dim(A)[1] n = dim(B)[1] if(dim(B)[2]!=d) stop("dimension mismatch") FD = .Fortran("BD", as.numeric(A), # A as.numeric(B), # B as.integer(m), # m as.integer(n), # n as.integer(d), # d FD=as.numeric(rep(-1,m)) ) return(FD$FD) } #' @title Adjusted ranking of functional data based on the infimal depth #' #' @description #' Returns a vector of adjusted depth-based ranks for infimal depth for functional data. #' #' @author Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} #' @keywords rank depth functional #' #' @details #' Infimal depths for functional data tend to give to many functional observations the same #' value of depth. Using this function, the data whose depth is the same is ranked according #' to the infimal area indicator. This indicator is provided in functions \code{depthf.fd1} along #' the value of the infimal depth. #' #' @param ID The vector of infimal depths of the curves of length \code{n}. #' #' @param IA The vector of the infimal areas corresponding to the infimal depths from \code{ID} #' of length \code{n}. #' #' @param ties.method Parameter for breaking ties in infimal area index. By default \code{max}, see #' \code{rank}. #' #' @return A vector of length \code{n}. Low depth values mean high ranks, i.e. potential outlyingess. #' If some of the infimal depths are identical, the ranking of these functions is made according to the #' values of the infimal area. There, higher infimal area index means higher rank, i.e. non-centrality. #' #' @references Nagy, S., Gijbels, I. and Hlubinka, D. (2017). #' Depth-based recognition of shape outlying functions. #' \emph{Journal of Computational and Graphical Statistics}, \bold{26:4}, 883--893. #' #' @examples #' datafA = dataf.population()$dataf[1:20] #' datafB = dataf.population()$dataf[21:50] #' D = depthf.fd1(datafA,datafB) #' infimalRank(D$Half_ID,D$Half_IA) #' #' ID = c(0,1,0,0,0,1,1) #' IA = c(2,3,1,0,2,4,1) #' infimalRank(ID,IA) infimalRank = function(ID,IA,ties.method="max"){ # finds the adjusted rank for appropriate for the infimal depth for functional data # ID is the vector of infimal depths # IA is the vector of the corresponding infimal areas # returns a vector of ranks n = length(ID) if(length(IA)!=n) stop("Lengths of the vectors differ") U = sort(unique(ID),decreasing=TRUE) R = rep(NA,n) cR = 0 # currently assigned rank for(u in U){ Iu = (ID==u) R[Iu] = cR+rank(IA[Iu],ties.method=ties.method) cR = sum(!is.na(R)) } return(R) } #' @title Estimation of the first two derivatives for functional data #' #' @description #' Returns the estimated values of derivatives of functional data. #' #' @author Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} #' @keywords derivatives kernel functional #' #' @details #' If the input \code{dataf} is a functional random sample of size \code{m}, #' the function returns a \code{dataf} object of \code{nd}-dimensional functional data, where #' in the elements of the vector-valued functional data represent the estimated values of the #' derivatives of \code{dataf}. All derivatives are evaluated at an equi-distant grid of \code{d} #' points in the domain given by \code{range}. \code{nd} here stands for \code{1}, \code{2} or \code{3}, #' depending on how many derivatives of \code{dataf} are #' requested to be computed. For the estimation, functions \code{D1ss} and \code{D2ss} from the package #' \code{sfsmisc} are utilized. #' #' @param dataf Functional dataset, represented by a \code{dataf} object of their arguments #' and functional values. \code{m} stands for the number of functions. #' #' @param range The common range of the domain where the fucntions \code{dataf} are observed. #' Vector of length 2 with the left and the right end of the interval. Must contain all arguments given in #' \code{dataf}. #' #' @param d Grid size to which all the functional data are transformed. For computation, #' all functional observations are first transformed into vectors of their functional values of length \code{d} #' corresponding to equi-spaced points in the domain given by the interval \code{range}. Functional values in these #' points are reconstructed using linear interpolation, and extrapolation. #' #' @param spar If provided, this parameter is passed to functions \code{D1ss} and \code{D2ss} from package \code{sfsmisc} #' as the value of the smoothing spline parameter in order to numerically approximate #' the derivatives of \code{dataf}. #' #' @param deriv A vector composed of \code{0}, \code{1}, and \code{2} of the demanded #' functional values / derivatives of the functions in the rows of \code{dataf}. #' \code{0} stands for the functional values, \code{1} for the first derivatives, #' \code{2} for the second derivatives. #' #' @return A multivariate \code{dataf} object of the functional values and / or the derivatives of \code{dataf}. #' The dimensionality of the vector-valued functional data is \code{nd}. The arguments of the data are all equal to #' an equi-distant grid of \code{d} points in the domain given by \code{range}. \code{nd} is the demanded number #' of derivatives at the output, i.e. the length of the vector \code{deriv}. #' #' @seealso \code{\link[sfsmisc]{D1ss}} in package sfsmisc #' @seealso \code{\link[sfsmisc]{D2ss}} in package sfsmisc #' #' @examples #' dataf = dataf.population()$dataf #' derivatives.est(dataf,deriv=c(0,1,2)) derivatives.est = function(dataf,range=NULL,d=101,spar=NULL,deriv=c(0,1)){ X = dataf2rawfd(dataf, range = range, d = d) derd = length(deriv) XK = array(dim=c(dim(X),derd)) # range construction rng = numeric(0) for (df in dataf) rng = range(c(rng,df$args)) # common range of all the data if(!is.null(range)){ if(!(length(range) == 2 && is.numeric(range) && range[1]<=rng[1] && range[2]>=rng[2])) stop("Argument 'range' must be a numeric vector of two components that defines the range of the domain of functional data. All functional data must have 'args' vales inside this domain.") } else range = rng if(!(range[1]1) stop("works only for a single function A (matrix 1*d)") method = match.arg(method) # # diagonal d = ncol(A) HDP = matrix(nrow=nrow(B)+1,ncol=d) SDP = HDP for(i in 1:d){ FL = ecdf(B[,i]) FU = ecdf(-B[,i]) HDP[,i] = pmin(FL(rbind(B,A)[,i]),FU(-rbind(B,A)[,i])) SDP[,i] = FL(rbind(B,A)[,i])*FU(-rbind(B,A)[,i])*nrow(B)^2/choose(nrow(B),2) } if(order==2){ DD = DiffDepth(A,B,approx) if (method=="halfspace") diag(DD$PHD) = HDP[nrow(B)+1,] else diag(DD$PSD) = SDP[nrow(B)+1,] if (plot){ if (method=="halfspace") filled.contour(DD$PHD,main=title,color.palette= function(x)rev(heat.colors(x))) else filled.contour(DD$PSD,main=title,color.palette = function(x)rev(heat.colors(x))) } return(DD) } if(order==1){ nfun = min(nrow(B),nfun) t = seq(0,1,length=ncol(B)) DD = list(Simpl_FD = mean(SDP[nrow(B)+1,]), Half_FD = mean(HDP[nrow(B)+1,]), Simpl_ID = min(SDP[nrow(B)+1,]), Half_ID = min(HDP[nrow(B)+1,]), PHD = HDP[nrow(B)+1,], PSD = SDP[nrow(B)+1,]) if (plot) { if (method=="halfspace"){ plot(rep(t,nrow(B)+1),HDP,type="n",main=title,ylim = c(0,max(HDP)),ann=FALSE) for(i in 1:nfun) lines(t,HDP[i,],lwd=.75,lty=2) lines(t,HDP[nrow(B)+1,],col=2,lwd=3,lty=1) } else { plot(rep(t,nrow(B)+1),SDP,type="n",main=title,ylim = c(0,max(SDP)),ann=FALSE) for(i in 1:nfun) lines(t,SDP[i,],lwd=.75,lty=2) lines(t,SDP[nrow(B)+1,],col=2,lwd=3,lty=1) } } return(DD) } } #' @title Functional depth-based shape outlier detection #' #' @description #' Detects functional outliers of first three orders, based on the order extended integrated depth for functional data. #' #' @author Stanislav Nagy, \email{nagy@karlin.mff.cuni.cz} #' @keywords depth #' @keywords outlier #' @keywords functional #' #' @details #' Using the procedure described in Nagy et al. (2016), the function uses the order extended integrated depths for functions, #' see \code{\link{depthf.fd1}} and \code{\link{shape.fd.analysis}}, to perform informal functional shape outlier detection. #' Outliers of the first order (horizontal shift outliers) are found as the functions with \code{q} \% of smallest (first order) #' integrated depth values. Second and third order outliers (shape outliers) are found using the extension of the boxplot method #' for depths as described in the paper Nagy et al. (2016). #' #' @param dataf Functional dataset, represented by a \code{dataf} object of their arguments #' and functional values. \code{n} stands for the number of functions. #' #' @param range The common range of the domain where the fucntions \code{dataf} are observed. #' Vector of length 2 with the left and the right end of the interval. Must contain all arguments given in #' \code{dataf}. #' #' @param d Grid size to which all the functional data are transformed. For depth computation, #' all functional observations are first transformed into vectors of their functional values of length \code{d} #' corresponding to equi-spaced points in the domain given by the interval \code{range}. Functional values in these #' points are reconstructed using linear interpolation, and extrapolation. #' #' @param q The quantile presenting a threshold for the first order outlier detection. Functions with first order integrated depth #' smaller than the \code{q} quantile of this sample of depths are flagged as potential outliers. If set to \code{NULL}, the #' the outliers are detected from the first order integrated depth after the log-transformation, as for higher order outliers. #' #' @param method The depth that is used in the diagnostic plot. possible values are \code{halfspace} for #' the halfspace depth, or \code{simplicial} for the simplicial depth. #' #' @param approx For the computation of the third order integrated depth, #' the number of approximations used in the computation of the order extended depth. By default #' this is set to \code{100}, meaning that \code{100} #' trivariate points are randomly sampled in unit cube, and at these points the trivariate depths of the #' corresponding functional values. May be set to \code{0} to compute the depth at all possible \code{d^3} #' combinations of the points in the domain. This choice may result in very slow computation, see also \code{\link{depthf.fd1}}. #' #' @param print If the rows of \code{X} are named, \code{print=TRUE} enables a graphical output when the names of the outlying curves #' are displayed. #' #' @param plotpairs If set to \code{TRUE}, the scatter plot of the computed depths for orders \code{1}, \code{2} and \code{3} is #' is displayed. Here, the depths corresponding to the flagged outliers are plotted in colour. #' #' @param max.order Maximal order of shape outlyingness to be computed, can be set to \code{1}, \code{2}, or \code{3}. #' #' @param exclude.out Logical variable; exclude the detected lower order outliers in the flagging process? By default \code{TRUE}. #' #' @param output Output method, can be set to \code{matrix} for a matrix with logical entries (\code{TRUE} for outliers), or \code{list} for #' a list of outliers. #' #' @param identifiers A vector of names for the data observations. Facilitates identification of outlyig functions. #' #' @return A matrix of logical values of size \code{n*4}, where \code{n} is the sample size. In the first three rows indicators of outlyingness #' of the corresponding functions for orders \code{1}, \code{2} and \code{3} are given, in the fourth row the indicator of outlyingness #' with respect to the comparison of the first, and third order depths is given. That is, the fist row corresponds to the first order outliers, #' the second row to the second order outliers, and the last two rows formally to the third order outliers. Please consult Nagy et al. (2016) #' to interpret the notion of shape outlyingness. #' #' @references Nagy, S., Gijbels, I. and Hlubinka, D. (2017). #' Depth-based recognition of shape outlying functions. #' \emph{Journal of Computational and Graphical Statistics}, \bold{26:4}, 883--893. #' #' @examples #' n = 30 #' dataf = dataf.population()$dataf[1:n] #' shape.fd.outliers(dataf,print=TRUE,plotpairs=TRUE, #' identifiers=unlist(dataf.population()$identifier)[1:n]) #' #' @seealso \code{\link{depthf.fd1}}, \code{\link{shape.fd.analysis}} shape.fd.outliers = function(dataf,range=NULL,d=101,q=.05,method=c("halfspace","simplicial"), approx=100,print=FALSE,plotpairs=FALSE,max.order=3, exclude.out = TRUE, output=c("matrix","list"), identifiers = NULL){ X = dataf method = match.arg(method) output = match.arg(output) if(is.null(identifiers) | length(identifiers)!=length(dataf)){ print = FALSE warning("Inconsistent identifiers, print is set to FALSE") } if((max.order>3)|(max.order<1)){ max.order=3 warning("Maximal order set to 3") } if (max.order==3){ if(approx<50){ approx=50 warning("Too small approx value, approximation set to 50") } } n = length(X) # set up the depths D = matrix(nrow=max.order,ncol=n) if(method=="halfspace"){ D[1,] = depthf.fd1(X,X)$Half_FD if(max.order>1) D[2,] = depthf.fd1(X,X,range=range,d=d,order=2)$Half_FD if(max.order>2) D[3,] = depthf.fd1(X,X,range=range,d=d,order=3,approx=approx)$Half_FD } if(method=="simplicial"){ D[1,] = depthf.fd1(X,X)$Simpl_FD if(max.order>1) D[2,] = depthf.fd1(X,X,range=range,d=d,order=2)$Simpl_FD if(max.order>2) D[3,] = depthf.fd1(X,X,range=range,d=d,order=3,approx=approx)$Simpl_FD } D = apply(D,1:2,function(x) max(0,x-1/n)) if(max.order==1) out.rows = 1 if(max.order==2) out.rows = 2 if(max.order==3) out.rows = 4 O = matrix(nrow=out.rows,ncol=ncol(D)) # compute the outliers if (print){ colnames(O) = identifiers print("first order outliers: ") } if(!is.null(q)) O[1,]<-D[1,]B$stats[5,])|(S==Inf)) } if (print) print(which(O[1,])) if(max.order>1) for(i in 1:(max.order-1)){ if (print){ if (i==1) print("second order outliers: ") if (i==2) print("third order outliers: ") } S = -log(D[i+1,]/D[i,]) S[D[i+1,]==0] = Inf B = boxplot(S,plot=FALSE) if(exclude.out) O[i+1,]<-(((S>B$stats[5,])|(S==Inf))&(O[i,]==FALSE)&(O[1,]==FALSE)) if(!exclude.out) O[i+1,]<-((S>B$stats[5,])|(S==Inf)) if (print) print(which(O[i+1,])) } if(max.order==3){ if (print) print("1/3 outliers") S = -log(D[3,]/D[1,]) S[D[3,]==0] = Inf B = boxplot(S,plot=FALSE) if(exclude.out) O[4,]<-(((S>B$stats[5,])|(S==Inf))&(O[3,]==FALSE)&(O[2,]==FALSE)&(O[1,]==FALSE)) if(!exclude.out) O[4,]<-((S>B$stats[5,])|(S==Inf)) if (print) print(which(O[4,])) } if(max.order==1) rownames(O) = "1st" if(max.order==2) rownames(O) = c("1st","2nd") if(max.order==3){ rownames(O) = c("1st","2nd","3rd","1/3rd") if (plotpairs) DpairsPlot(D,O) } if(output=="matrix") return(O) if(output=="list") return(apply(O,1,which)) } DpairsPlot = function(DB2,O,sp.index=NULL){ # plots a 2x2 scatter of all the pairs of order extended integrated depth values # for orders 1, 2, and 3 as presented in the Nagy et al. (2016), Figure 5 cexaxis = 1.3 cexlab = 1.5 n = ncol(O) col = rep("grey",n) colout1 = "olivedrab3" colout2 = "navy" colout3 = "darkorange" colout = c(colout1,colout2,colout3) col[O[1,]] = colout1 col[O[2,]] = colout2 col[O[3,]] = colout3 col[O[4,]] = colout3 pch = rep(16,n) pch[O[1,]] = 1 pch[O[2,]] = 2 pch[O[3,]] = 18 pch[O[4,]] = 18 cx = 1.5 cex = rep(1,n) cex[O[1,]] = cx cex[O[2,]] = cx cex[O[3,]] = cx cex[O[4,]] = cx OI = (colSums(O)>0) # outlier indicator op<-par(cex.axis=cexaxis,cex.lab=cexlab,mfrow = c(2, 2), # 2x2 layout oma = c(3, 3.5, 0.45, 0.45), # two rows of text at the outer left and bottom margin mar = c(1, 1, 0, 0), # space for one row of text at ticks and to separate plots mgp = c(2, 1, 0), # axis label at 2 rows distance, tick labels at 1 row xpd = NA) # allow content to protrude into outer margin (and beyond) plot(c(0,M<-max(DB2)),c(0,max(DB2)),type="n",ann=FALSE,axes=FALSE,frame=TRUE) axis(2) title(ylab=expression(FD[2]),line=2.5) points(DB2[1,],DB2[2,],col=col,pch=pch,cex=cex,lwd=1.35*cex) for(i in 1:n) if(OI[i]) points(DB2[1,i],DB2[2,i],col=col[i],pch=pch[i],cex=cex[i],lwd=1.35*cex[i]) if (!is.null(sp.index)) points(DB2[1,sp.index],DB2[2,sp.index],pch=16,col="orange") segments(0,0,M,M,lty=3,lwd=2) plot(c(0,1),c(0,1),type="n",ann=FALSE,axes=FALSE) legend(0,.7,c("1st order outliers","2nd order outliers","3rd order outliers"),col=colout,pch=c(1,2,18),cex=cx,bty="n") plot(c(0,max(DB2)),c(0,max(DB2)),type="n",ann=FALSE) axis(2) title(ylab=expression(FD[3]^A),line=2.5) axis(1) title(xlab=expression(FD[1]),line=3) points(DB2[1,],DB2[3,],col=col,pch=pch,cex=cex,lwd=1.35*cex) for(i in 1:n) if(OI[i]) points(DB2[1,i],DB2[3,i],col=col[i],pch=pch[i],cex=cex[i],lwd=1.35*cex[i]) if (!is.null(sp.index)) points(DB2[1,sp.index],DB2[3,sp.index],pch=16,col="orange") segments(0,0,M,M,lty=3,lwd=2) plot(c(0,max(DB2)),c(0,max(DB2)),type="n",ann=FALSE,axes=FALSE,frame=TRUE) axis(1) title(xlab=expression(FD[2]),line=3) points(DB2[2,],DB2[3,],col=col,pch=pch,cex=cex,lwd=1.35*cex) for(i in 1:n) if(OI[i]) points(DB2[2,i],DB2[3,i],col=col[i],pch=pch[i],cex=cex[i],lwd=1.35*cex[i]) if (!is.null(sp.index)) points(DB2[2,sp.index],DB2[3,sp.index],pch=16,col="orange") segments(0,0,M,M,lty=3,lwd=2) par(op) }ddalpha/R/dknn.R0000644000176200001440000001026414213423775013140 0ustar liggesusers################################################################################ # File: dknn.r # Created by: Oleksii Pokotylo # First published: # Last revised: # # Contains the realization of the Depth-based KNN classifier of Paindaveine and Van Bever (2015). ################################################################################ dknn.train <- function(data, kMax = -1, depth = "halfspace", seed = 0){ dpth = switch (depth, "halfspace" = 1, "Mahalanobis" = 2, "simplicial" = 3, 0) if(dpth == 0) stop("Wrong depth: ", depth) n = nrow(data) chunkNumber = n #10 dimension = ncol(data)-1 labs <- data[,dimension+1] labels <- integer(length(labs)) uniquelab = unique(labs) cardinalities = unlist(lapply(uniquelab, function(l)sum(labs == l))) uniquelab = uniquelab[order(cardinalities)] cardinalities = cardinalities[order(cardinalities)] for (i in seq_along(uniquelab)){ labels[labs == uniquelab[i]] <- i } if(length(uniquelab)<2) stop("There is only one class") if (!is.numeric(kMax) || is.na(kMax) || length(kMax) != 1 || !.is.wholenumber(kMax) || !(kMax >= 1 && kMax <= (cardinalities[1]+rev(cardinalities)[1]) || kMax == -1)){ warning("In treatment number ", i, ": Argument \"k\" not specified correctly. Defaults are applied") kMax <- - 1 } if(kMax == -1) kMax <- n/2 kMax <- min(kMax, n - 1) kMax <- max(kMax, 2) points <- as.vector(t(data[,1:dimension])) k <- as.integer(.C("DKnnLearnCv", as.double(points), as.integer(labels), as.integer(n), as.integer(dimension), as.integer(kMax), as.integer(dpth), k = integer(1), as.integer(chunkNumber), as.integer(seed))$k) dknn <- list(data = data, n = n, dimension = dimension, labels = labels, uniquelab = uniquelab, methodSeparator = "Dknn", k = k, depth = dpth,#depth, seed = seed) return (dknn) } dknn.classify.trained <- function(objects, dknn){ # Correct input data if(is.data.frame(objects)) objects = as.matrix(objects) if (!is.matrix(objects)){ objects <- matrix(objects, nrow=1) } if(ncol(objects)!=dknn$dimension) stop("Parameter 'objects' has wrong dimension") points <- as.vector(t(dknn$data[,1:dknn$dimension])) obj <- as.vector(t(objects)) output <- .C("DKnnClassify", as.double(obj), as.integer(nrow(objects)), as.double(points), as.integer(dknn$labels), as.integer(dknn$n), as.integer(dknn$dimension), as.integer(dknn$k), as.integer(dknn$depth), as.integer(dknn$seed), output=integer(nrow(objects)))$output results = dknn$uniquelab[output] return (results) } dknn.classify <- function(objects, data, k, depth = "halfspace", seed = 0){ n = nrow(data) dimension = ncol(data)-1 labs <- data[,dimension+1] labels <- integer(length(labs)) uniquelab = unique(labs) cardinalities = unlist(lapply(uniquelab, function(l)sum(labs == l))) uniquelab = uniquelab[order(cardinalities)] cardinalities = cardinalities[order(cardinalities)] for (i in seq_along(uniquelab)){ labels[labs == uniquelab[i]] <- i } if(length(uniquelab)<2) stop("There is only one class") if (!is.numeric(k) || is.na(k) || length(k) != 1 || !.is.wholenumber(k) || k < 1 || k > nrow(data)){ stop("Argument \"k\" not specified correctly.") } dpth = switch (depth, "halfspace" = 1, "Mahalanobis" = 2, "simplicial" = 3, 0) if(dpth == 0) stop("Wrong depth: ", depth) dknn <- list(data = data, n = n, dimension = dimension, labels = labels, uniquelab = uniquelab, methodSeparator = "Dknn", k = k, depth = dpth,#depth, seed = seed) return (dknn.classify.trained(objects, dknn)) }ddalpha/MD50000644000176200001440000002731314550251762012174 0ustar liggesuserseff54113ac3e8b2254875655213a495e *DESCRIPTION 4891cde8cb1c85c9a27b687a66b86353 *NAMESPACE 9ff777225eb7145110005e33af52dbad *R/compclassf.r 2b1dc04c31bdba56a97812aa584fe5ab *R/dataf.geneexp.r 8176cd2ab66c95bd8c707ec8a283833f *R/dataf.growth.r 353f4f040a87428b679507ff1390d4b6 *R/dataf.medflies.r c9bd3312e98a68a0e8e79136f728c5f8 *R/dataf.population.r cbcccec8a110abb83ea38bfb9ed45e21 *R/dataf.population2010.r 90db2775bc79dcc1e22fc059b6234a1a *R/dataf.r 777203e462a5db9e744a39add8050273 *R/dataf.sim.r 4df8a7cdbe593ae6da47da057ef99902 *R/dataf.tecator.r 740fc5cf6a870f3fbbd35b3b667ab03c *R/ddalpha-internal.r e1b5085356ad71b3ca6a28d8cd27868e *R/ddalpha.classify.r 11dc84b075653442b13e42045d3789e3 *R/ddalpha.test.r 01f52b6b63e78f435d01216c91197e5f *R/ddalpha.train.r 2f85ba6d596ad4c59d4fde211e4c205b *R/ddalphaf.r 97326e1414b01d14c87ec31415e1f5c0 *R/ddalphaf.test.r db47b45e2f7b9dd55ff303b1c124de07 *R/depth.L2.r 7eef619fc64c5a9012697f49f21223d4 *R/depth.betaSkeleton.r 04a570c5c15c365b6b596e54daaf7857 *R/depth.contours.r e9a306ac76854fc553ff910aaed79d32 *R/depth.fd.R 245b743b155f4dd6c9c0595e6c8788fb *R/depth.graph.r 3391c896250b042ff2ab6450038e7a3b *R/depth.halfspace.r 7012a313245936e214fc9ad515066c7a *R/depth.potential.r f3fb2d6f9ef2f91c316aed39cb48dd88 *R/depth.projection.r 72df3d5b722591b6829da1bab987e5c0 *R/depth.qhpeeling.r 5b37f8fbe592e58982816d13f6e1934c *R/depth.r 877cd5a7f69d42ba207470ce1984deec *R/depth.simplicial.r 0e6af9e932ced28e739a087f420f2fd3 *R/depth.simplicialVolume.r bda5cd0904be55d5723a2b00efc9b56f *R/depth.space.zonoid.r d2da3ff0ce3a7da6ad40489c88f0fc5f *R/depth.spatial.r e5aee3742fda8beaf4830ca9789bdb19 *R/depth.zonoid.r c921218fc7311714bf4cf72e4da1e282 *R/depthf.r 68f5076ccd94fce2751327b4df586b2c *R/depthf.simplicialBand.R 9657c20fbeee81c5954f72bacb60a08f *R/dknn.R 180f81a6618f1e29ba17be3a4f9194b1 *R/draw.ddplot.r 08a69ee39b8bcc1b48389ce61173b914 *R/getdata.R bd5e12d28bec9f1fcaca69964cd0166c *R/is.in.convex.r 7119e6c4d3817c9ec118da3f07778723 *R/knnaff.r 65d47d32fe5bc74e9850a633b6eb306c *R/lda.r b0e8f4206b8ec10a541030da5826c9b1 *R/mahalanobis.scaling.r 275633cad9af8e6e1751b686b9596b03 *R/plot.functional.r aa190a3f00ce50859d4ab605349e562f *R/qda.r b581addf157ac8a56b19fee8de0dcd42 *R/routines.r 565fa33b05f119a3a3590938e312b038 *R/separator.polynomial.r 420701b3922eaa282b7cd8c26c01b789 *data/baby.txt.gz ccfe61945a3f683276ce92a6e8d4dc47 *data/banknoten.txt.gz 125cc90ae3153b05d315ceda1ea03b44 *data/biomed.txt.gz 5e7adc223dee633a725d3c69d5dab2eb *data/bloodtransfusion.txt.gz b08e025d2e846beabbea7e2db6d3dede *data/breast_cancer_wisconsin.txt.gz 63739c1a8eda9082507fea3ea9c678b9 *data/bupa.txt.gz c184e7e1f86eedc62d070bcc772fc909 *data/chemdiab_1vs2.txt.gz 5a0c6cd6de59e0d819788f47232b054f *data/chemdiab_1vs3.txt.gz 6151869a605ffc659b1ed46015c142a3 *data/chemdiab_2vs3.txt.gz 74fc808c682a4c536157b3365dbd05bc *data/cloud.txt.gz 0188f9341eb0d4654e085163f98144a4 *data/crabB_MvsF.txt.gz 70ec8accf3940470a48ba45b1bd21eb2 *data/crabF_BvsO.txt.gz 517cde82c1591e08f9cfe7d46c482458 *data/crabM_BvsO.txt.gz 1011d03a9b30ef3b303496d930b0792a *data/crabO_MvsF.txt.gz 2f827beb1b109cad8721de6579949c78 *data/crab_BvsO.txt.gz 1680ac8abdd658b0f9bacc89ef14fe82 *data/crab_MvsF.txt.gz 00f13801e618fbe2d9d9374195bd26c6 *data/cricket_CvsP.txt.gz ebb6ba34d97afd984bf0ded9cdb74594 *data/diabetes.txt.gz 63ead66c38660fe9f735b348bbeacf3b *data/ecoli_cpvsim.txt.gz 50a3d7aafa9126d67fd7834034b731c2 *data/ecoli_cpvspp.txt.gz 19e9106212f5a84f63cbf7a6936edaab *data/ecoli_imvspp.txt.gz 7b44ec9a513f704ebc08c7993e4667da *data/gemsen_MvsF.txt.gz 77500917e03b5aaaa962c665f5c37d1f *data/geneexp.rda a37f50b8b2b390ed5fd465644dba906d *data/glass.txt.gz be7c33db1e2e1e1a4fde3eb255391221 *data/groessen_MvsF.txt.gz de1436bf2194b10c8a3b1e85e8d2d3cf *data/growth.rda a44f33c1ecb9dfc67ed579dbb34ac74e *data/haberman.txt.gz bab49611b881a6e18fbee5bd510d4ea3 *data/heart.txt.gz 1b73fda3ae015c840ee55aa3c6a14daa *data/hemophilia.txt.gz 7f2c914ed84792e160552a231f31f477 *data/indian_liver_patient_1vs2.txt.gz f099f50e2f38395ad670af1c60066ad7 *data/indian_liver_patient_FvsM.txt.gz 6dff93a4bad8b490185362d84a09d2a0 *data/iris_setosavsversicolor.txt.gz 8fb455f8fd8dfe7a85e67f5fda6507a5 *data/iris_setosavsvirginica.txt.gz e0e5e7af15b61e2791938e0388d68d71 *data/iris_versicolorvsvirginica.txt.gz 00486abc989444ea94f76ab0adabf66f *data/irish_ed_MvsF.txt.gz 99265bd2ff8eecd81ebed30476175236 *data/kidney.txt.gz c55e6e3a146499d5d54abf269e788309 *data/medflies.rda 15ddfeb5f6233b10ad15e18e2c2a2faa *data/pima.txt.gz d3dcebf7e7a7d978ca7d0971ecfe8ae2 *data/plasma_retinol_MvsF.txt.gz 871beaba62c45defbf4a8000721657f1 *data/population.rda edd4fe14d0c437609ec251d0d4b1c101 *data/population2010.rda 9e2e11df178d8339e9ed917c721e6c1f *data/segmentation.txt.gz bdeb17db9afe85fd9a2fe1a38b1e7469 *data/socmob_IvsNI.txt.gz 6fc9afd1acd58cfc69026e65ebdae342 *data/socmob_WvsB.txt.gz 0901f964192f94c2a5901804228379cc *data/tae.txt.gz ff797af8193615bce99fbc1b338566a5 *data/tecator.rda 2f43e05f8c897e8c4e310002647a69c8 *data/tennis_MvsF.txt.gz 26d1fde06974fc2082c88fb00846b989 *data/tips_DvsN.txt.gz 9cc05f785d004dc0c328841d9e156f98 *data/tips_MvsF.txt.gz 1b3b8dad44d1bb6054d18ae7227175e5 *data/uscrime_SvsN.txt.gz 849868cfd89118c21a8664415c10843e *data/vertebral_column.txt.gz 40b4cf81044f67f59a0b1392394b6912 *data/veteran_lung_cancer.txt.gz 09f6e2e73f011736d3c0eae95522e748 *data/vowel_MvsF.txt.gz f00ffe449bd008d028a2a7f1a3e1b130 *data/wine_1vs2.txt.gz d4e6b368252e7b2c40b8bcbabbc97cd8 *data/wine_1vs3.txt.gz 285c2a26aaff446ba2e3aea50278801f *data/wine_2vs3.txt.gz cf9806486419d9e0a20db83594503fd8 *inst/CITATION 42d1835d515b9c65f2af09c76aa6e4d1 *man/Cmetric.Rd 7e73aaccb60abe3eeb0e15fa2ffc0057 *man/CustomMethods.Rd 8561ac693d92b39e47dff9dd2b748443 *man/FKS.Rd b84647387c619d5bc8e9bc2ebcc2a7c4 *man/L2metric.Rd 65e70bf2774c41d13092e52eb2a9df1f *man/compclassf.classify.Rd 621683d70bee1e892755c7142373c2f4 *man/compclassf.train.Rd 54fa393e2ce3a2e7f26c6d20dd0ffe66 *man/dataf..Rd 0cc336f61954197ed8a8fd8a76513471 *man/dataf.Rd 49d1c63afb2e02747eba188e45816c04 *man/dataf.geneexp.Rd 045325f6a85afd10f7df2203a86817df *man/dataf.growth.Rd 334507933abeddd1f1bcff8a851609f1 *man/dataf.medflies.Rd 62ff8d6ad5783a9ab42ebe4cfea049b5 *man/dataf.population.Rd 97bce2ce4473e8c880ff2ac0d784344f *man/dataf.population2010.Rd a7c10e82119c23796e9bbc4946b624c0 *man/dataf.sim.1.CFF07.Rd 5386cf3ad87e2c8de8de78bb7edf084c *man/dataf.sim.2.CFF07.Rd 8017ad87a4266f47f5b5e5aee500d7c2 *man/dataf.tecator.Rd 10d6ae95af277da67b8c97792a98d284 *man/dataf2rawfd.Rd 90c7ffbc7911f61fa60b7758c5437255 *man/ddalpha-package.Rd f8c7e8e7ed9a15be28f52544ccceb66a *man/ddalpha.classify.Rd 2b1b7cc4433374af973733782c45e225 *man/ddalpha.getErrorRateCV.Rd 5acb9396ca92a50d5fa54ed68895e23f *man/ddalpha.getErrorRatePart.Rd 51f3aed347816ce02b5f23cbf65154a5 *man/ddalpha.test.Rd 6978970385061a4486be632f25ce1561 *man/ddalpha.train.Rd 157627e23e0e1b243e029afdb406f5a3 *man/ddalphaf.classify.Rd d3fd03f7e2c56e943c0c3e9687585cc3 *man/ddalphaf.getErrorRateCV.Rd 5f354ee521ee9fcaaeeadffbdaabc1c9 *man/ddalphaf.getErrorRatePart.Rd c343dbc3bc4d0e4e53d472f554ff3607 *man/ddalphaf.test.Rd 1825c2a8b82bdaabfa4fc5f830c94a0c *man/ddalphaf.train.Rd fc9195a1389dad622a9181ec19fd6ef9 *man/depth..Rd 7299aedd63fede8c236dc6c3c22d955d *man/depth.L2.Rd 1a7f56172ae085fd37ea3eb373701847 *man/depth.Mahalanobis.Rd 6f55fc9153ca12cc39124aadd32a0f1e *man/depth.betaSkeleton.Rd cee54f39836dbaefc0dd4d334dedc736 *man/depth.contours.Rd a79b0f4b9c56571c270b10b449b5a8b6 *man/depth.contours.ddalpha.Rd bab80846e3b9eddbe8a967ee441f8650 *man/depth.graph.Rd 4f360c741c7bd04f879f1abfba6e7511 *man/depth.halfspace.Rd 496500fa8e84bcc1595ec091255a5e1f *man/depth.potential.Rd d5f002dd017d7f4146002565a8441e67 *man/depth.projection.Rd aac0a835faeada004fad5a8a83c9f630 *man/depth.qhpeeling.Rd 15a5e45f702fb98ec552f67f0c534539 *man/depth.sample.Rd 3561779792783a3dcad199eb489ed2e6 *man/depth.simplicial.Rd 5aad30080ebc2c685e22415c2c10a1a2 *man/depth.simplicialVolume.Rd d39271c146a78ba803b12914118624ab *man/depth.space..Rd a0f2261beacbf93b39b9015c1b7c63b3 *man/depth.space.Mahalanobis.Rd ffebe19d9bb8c850d080744eaafc4416 *man/depth.space.halfspace.Rd 4138d41ee15dd15c3d576b2006b5aced *man/depth.space.potential.Rd c0c632e8db5a9ed727e597d15d5fc863 *man/depth.space.projection.Rd db04ab56f27a4c712a6b1e5dd5145d87 *man/depth.space.simplicial.Rd dee96b25a7a21c86526be2ffc865dc06 *man/depth.space.simplicialVolume.Rd 09bbed450983eadeee60dafa4b68f2a2 *man/depth.space.spatial.Rd f8d10359a82f05fb4d5425cbde57a495 *man/depth.space.zonoid.Rd 5f0a3513e4055fb3276649e48bb7f54b *man/depth.spatial.Rd 287fd39bb732af52e46d58751db7d817 *man/depth.zonoid.Rd b09a3ac3066dc1dd95bbad5cdf43fc9d *man/depthf..Rd 782ee0becd9f45141fa9f483989d8367 *man/depthf.ABD.Rd 40e7193b289072e8d00af59778972050 *man/depthf.BD.Rd 4277ef8b8cb11ffea6cd52a8d1ca213a *man/depthf.HR.Rd 2b76e8d46108bf2a531ad9f9300eff80 *man/depthf.RP1.Rd 27759d794c415672d544ba86a964528e *man/depthf.RP2.Rd 4ceb539cf34f6407f14626d2393798f9 *man/depthf.fd1.Rd 4313fd930964ed21edaed8cc128b2f2e *man/depthf.fd2.Rd 8856917bc62ddd5cedefe5d64a30851a *man/depthf.hM.Rd 73a1d7571b25e4ae8e2c7cd84047f4e2 *man/depthf.hM2.Rd 4aceda091dc7994d0fd3171764ef7491 *man/depthf.simplicialBand.Rd 8ad92777e0789c98670811cf687a57f8 *man/derivatives.est.Rd 7ae891638b40364965d25dac46124d33 *man/dknn.classify.Rd 6f093a53f8cd3cb37952e31bf6458290 *man/dknn.classify.trained.Rd b69ee34c6dcccb8b9880220dee2b094c *man/dknn.train.Rd 4e57c52b98cc1d25b6575a900099c88f *man/draw.ddplot.Rd 7c28dd3675fe7b26d8dc36b66a3086dc *man/getdata.Rd bb440f1e5f50c4d6e63cd1a8cc6782c9 *man/infimalRank.Rd 516e1b8668300f022c0105882c052d9d *man/is.in.convex.Rd 338fd013c826f43c5e8cd0925c616515 *man/plot.ddalpha.Rd abbd84a3e47a05b34f645dad854497e6 *man/plot.ddalphaf.Rd c0275711f41a3d505c8388346a7bb8aa *man/plot.functional.Rd 755b95321bb75c55628c29eed665a1ff *man/rawfd2dataf.Rd 553f98996bf9f870922a002da3ea5836 *man/resetPar.Rd 42098d1af6e113678f94f66f73eb879f *man/shape.fd.analysis.Rd cf204055f3e6216c8ef4ee57effbffd3 *man/shape.fd.outliers.Rd 10446d2c21fb0e77c64d393b90b51d97 *src/AlphaProcedure.cpp 5217e4fd435c93e77ff105b5e18c043d *src/AlphaProcedure.h 4bc2241e24f829d976deeccbb3815a32 *src/BandDepth.cpp e1f741f22d959f35646313155140a934 *src/BandDepth.h 6196159119b48ac5b600f87273a5ea7c *src/Common.cpp 63e1a2efc143a927969416b3a82efae9 *src/Common.h dc05054d255fffb592b983e5f4b74411 *src/DKnn.cpp 5b938ab6a1cab8338d8875d046a403df *src/DKnn.h ff3b5b7fad17cde9ba1382c306c7ce60 *src/DataStructures.h 1b70503076f696bed602c6c823a97048 *src/HD.cpp 0e7c7f1fa9a8bf7590b7d1e8d620e5cf *src/HD.h 8b6f3f3a8ca8b70aeeb769e8a40c6c13 *src/Knn.cpp afa23030435065cae5baa28a32a7aef7 *src/Knn.h 47a7128fbcabc6f85f9dcd20664bdc7a *src/LensDepth.cpp 43fa0659f2fd9711663349adcf92c5fd *src/LensDepth.h 310296e055fdfd435c14f5ac4e563843 *src/Mahalanobis.cpp c2c13ea110f5e0597efffae5b4e3587f *src/Mahalanobis.h a82b744914da4fb2b45f429ee999b900 *src/OjaDepth.cpp 905b0d5d98147958ae006f8ef2e3a4d8 *src/OjaDepth.h 51bb35b8d65be263334f9046dcdb14da *src/Polynomial.cpp dd5441ecbb006e3dc9e27285a3c5be5e *src/Polynomial.h de86ded4b6a4f967fec8febf8fad3870 *src/PotentialDepth.cpp bcd7fe3926f3846ec5bf513ae4ff955b *src/PotentialDepth.h e9030ecbdcc007d36ef442445b2322a6 *src/ProjectionDepth.cpp dd72630ebdef6a21d4ecf956867861ef *src/ProjectionDepth.h 68df36c7760089eef6d84ca3c477f283 *src/SimplicialDepth.cpp db12ecbd2b6d9c95dd859c52934e2bf9 *src/SimplicialDepth.h d47f93174110cc45c0525f4154ecec65 *src/TukeyDepth.cpp c7e85da8b8c29692f94e5fe1bae36b7a *src/TukeyDepth.h bc75f84467fefa46f8d813fb920302fd *src/ZonoidDepth.cpp b6b9054c37bab86d07c8baea10f481f5 *src/ZonoidDepth.h 99b1f54b9e63662b9a1fb8fd015cdf84 *src/asa047.cpp 0d15945f463fd3dcc4483620d5f2ab8f *src/asa047.h aa896b8130fc6d0d1e3c8f3b291132e6 *src/ddalpha.cpp 1fc477f40b99304f5cdb8b4da4e62549 *src/depth.fd.f 34a81d4b07e387942a747e00dfcd8567 *src/init.c cfd1dd4fc0ba896d5199e8ff217da727 *src/stdafx.cpp e1e2be14c4e5dd8695d12cc3c59c1265 *src/stdafx.h ddalpha/inst/0000755000176200001440000000000014213423775012634 5ustar liggesusersddalpha/inst/CITATION0000644000176200001440000000152514213423775013774 0ustar liggesusersbibentry(bibtype = "Article", title = "Depth and Depth-Based Classification with {R} Package {ddalpha}", author = c(person(given = "Oleksii", family = "Pokotylo", email = "oleksii.pokotylo@gmail.com"), person(given = "Pavlo", family = "Mozharovskyi", email = "pavlo.mozharovskyi@ensai.fr"), person(given = "Rainer", family = "Dyckerhoff", email = "rainer.dyckerhoff@statistik.uni-koeln.de")), journal = "Journal of Statistical Software", year = "2019", volume = "91", number = "5", pages = "1--46", doi = "10.18637/jss.v091.i05", header = "To cite ddalpha in publications use:" )