circular/0000755000176200001440000000000014475703172012070 5ustar liggesuserscircular/NAMESPACE0000644000176200001440000002013714475660077013320 0ustar liggesusersuseDynLib(circular) #Import directive importFrom("graphics", "axis", "text", "lines.default", "text.default", "par", "plot.default", "points.default", "hist.default", "arrows", "layout", "image", "mtext", "plot", "frame", "title", "abline", "lines", "polygon", "axTicks", "points", "segments") importFrom("stats", "density", "quantile", "median", "weights", "runif", "weighted.mean", "pnorm", "dnorm", "qnorm", "rnorm", "pf", "qf", "pchisq", "qchisq", "integrate", "median.default", "uniroot", "lm.wfit", "lm", "optim", "optimize", "rcauchy", "kruskal.test", "approxfun", "na.omit", "complete.cases", "is.empty.model", "model.response", "model.matrix", "model.weights", "model.offset", "model.extract", "model.frame", "formula", "hclust", "reorder", "as.dendrogram", "order.dendrogram", "coef", "naprint", "printCoefmat", "setNames", "symnum", "rexp", "pt", "residuals", ".getXlevels", "as.formula", "naresid", "knots") importFrom("utils", "packageDescription", "data") importFrom("boot", "boot") importFrom("mvtnorm", "rmvnorm", "dmvnorm") importFrom("grDevices", "hsv", "dev.flush", "dev.hold", "xy.coords") #Export directive # functions export( # file A1.R A1, # file A1FirstDerivative.R A1FirstDerivative, # file A1SecondDerivative.R A1SecondDerivative, # file A1inv.R A1inv, # file I.0.R I.0, # file I.1.R I.1, # file I.p.R I.p, # file angular.deviation.R angular.deviation, # file angular.variance.R angular.variance, # file aov.circular.R aov.circular, # file arrows.circular.R arrows.circular, # file as.circular.R as.circular, # file as.data.frame.circular.R as.data.frame.circular, # asytriangular.R dasytriangular, # file axialvonmises.R daxialvonmises, # file bw.circular.R bw.cv.mse.circular, bw.cv.ml.circular, bw.nrd.circular, # file cardioid.R rcardioid, dcardioid, # file change.point.R change.point, # file circular.R circular, conversion.circular, circularp, "circularp<-", is.circular, # file circular.colors.R circular.colors, # file coord2rad.R coord2rad, # file cor.circular.R cor.circular, # file curve.circular.R curve.circular, plot.function.circular, # file deg.R deg, # file dist.circular.R dist.circular, # file equal.kappa.test.R equal.kappa.test, ## # file family.circular.R vonMises, # file heatmap.circular.R heatmap.circular, # file kuiper.test.R kuiper.test, # file lm.circular.R lm.circular, # file lsfit.circle.R lsfit.circle, ## # file make.circular.link.R ## make.circular.link, # file meandeviation.R meandeviation, # file minuspipluspi.R minusPiPlusPi, # file mle.vonmises.R mle.vonmises, # file mle.vonmises.bootstrap.ci.R mle.vonmises.bootstrap.ci, # file mle.wrappedcauchy.R mle.wrappedcauchy, # file mle.wrappednormal.R mle.wrappednormal, # file intersect.modal.region.R intersect.modal.region, intersect.modal.region.default, intersect.modal.region.circular, # file modal.region.R modal.region, modal.region.default, modal.region.circular, # file plot.edf.R plot.edf, lines.edf, # file pp.plot.R pp.plot, # file pp.unif.plot.R pp.unif.plot, # file projectednormal.R rpnorm, dpnorm, # file quantile.circular.R quantile.circular, # file rad.R rad, # file rao.spacing.test.R rao.spacing.test, # file rao.test.R rao.test, # file rayleigh.test.R rayleigh.test, # file rho.circular.R rho.circular, # file rose.diag.R rose.diag, # file rstable.R rstable, # file triangular.R rtriangular, dtriangular, # file ticks.circular.R ticks.circular, # file trigonometric.moment.R trigonometric.moment, # file totalvariation.R totalvariation.circular, # file uniform.R rcircularuniform, dcircularuniform, # file vonmises.R rvonmises, dvonmises, pvonmises, qvonmises, rmixedvonmises, dmixedvonmises, pmixedvonmises, # file watson.test.R watson.test, # file watson.two.test.R watson.two.test, # file windrose.R windrose, # file wrappedcauchy.R rwrappedcauchy, dwrappedcauchy, # file wrappednormal.R rwrappednormal, dwrappednormal, pwrappednormal, qwrappednormal, # file wrappedstable.R rwrappedstable ) ## unexported functions #export( ## file lm.circular.cc.R # lm.circular.cc, ## file lm.circular.cl.R # lm.circular.cl #) # methods export( # file circular.R c.circular, # file density.circular.R density.circular, # file mean.circular.R mean.circular, # file weighted.mean.circular.R weighted.mean.circular, # file median.circular.R median.circular, # file medianHL.circular.R medianHL.circular, # file axis.circular.R axis.circular, # file lines.circular.R lines.circular, # file plot.circular.R plot.circular, circle.control, # file points.circular.R points.circular, # file plot.lsfit.circle.R plot.lsfit.circle, # file range.circular.R range.circular, # file unique.circular.R unique.circular, # fiel sd.circular.R sd, sd.default, sd.data.frame, sd.circular, # file var.circular.R var, var.default, var.data.frame, var.circular, # file carthwrite.R dcarthwrite, # file genvonmises.R dgenvonmises, # file jonespewsey.R djonespewsey, # file katojones.R dkatojones, rkatojones, # file watson.williams.test.R watson.williams.test, watson.williams.test.default, watson.williams.test.list, watson.williams.test.formula, # file watson.wheeler.test.R watson.wheeler.test, watson.wheeler.test.default, watson.wheeler.test.list, watson.wheeler.test.formula, # file wallraff.test.R wallraff.test, wallraff.test.default, wallraff.test.list, wallraff.test.formula ) ## unexported methods #export( ## file aov.circular.R # print.aov.circular, ## file circular.R # print.circular, ## file equal.kappa.test.R # print.equal.kappa.test, ## file kuiper.test.R # print.kuiper.test, ## file lm.circular.cl.R # print.lm.circular.cl, ## file lsfit.circle.R # print.lsfit.circle, ## file mle.vonmises.R # print.mle.vonmises, ## file mle.vonmises.bootstrap.ci.R # print.mle.vonmises.bootstrap.ci, ## file mle.wrappedcauchy.R # print.mle.wrappedcauchy, ## file mle.wrappednormal.R # print.mle.wrappednormal, ## file rao.spacing.test.R # print.rao.spacing.test, ## file rao.test.R # print.rao.test, ## file rayleigh.test.R # print.rayleigh.test, ## file summary.circular.R # summary.circular, ## file watson.test.R # print.watson.test, ## file watson.two.test.R # print.watson.two.test #) #S3methods directive #[ S3method("[", circular) #axis #S3method(axis, circular) #c S3method(c, circular) #density S3method(density, circular) #lines S3method(lines, circular) S3method(lines, density.circular) S3method(lines, modal.region.circular) #mean S3method(mean, circular) #weighted mean S3method(weighted.mean, circular) #median S3method(median, circular) #print S3method(print, aov.circular) S3method(print, circular) S3method(print, density.circular) S3method(print, equal.kappa.test) S3method(print, kuiper.test) S3method(print, lm.circular.cl) S3method(print, lsfit.circle) S3method(print, mle.vonmises) S3method(print, mle.vonmises.bootstrap.ci) S3method(print, mle.wrappedcauchy) S3method(print, mle.wrappednormal) S3method(print, rao.spacing.test) S3method(print, rao.test) S3method(print, rayleigh.test) S3method(print, watson.test) S3method(print, watson.two.test) #plot S3method(plot, density.circular) S3method(plot, circular) S3method(plot, lsfit.circle) S3method(plot, modal.region.circular) S3method(plot, totalvariation.circular) #points S3method(points, circular) #quantile S3method(quantile, circular) #range S3method(range, circular) S3method(sd, default) #S3method(sd, matrix) S3method(sd, data.frame) S3method(sd, circular) #summary S3method(summary, circular) #unique S3method(unique, circular) #var S3method(var, default) #S3method(var, matrix) S3method(var, data.frame) S3method(var, circular) # tests S3method(watson.williams.test, default) S3method(watson.williams.test, list) S3method(watson.williams.test, formula) S3method(watson.wheeler.test, default) S3method(watson.wheeler.test, list) S3method(watson.wheeler.test, formula) S3method(wallraff.test, default) S3method(wallraff.test, list) S3method(wallraff.test, formula) S3method(modal.region, default) S3method(modal.region, circular) S3method(intersect.modal.region, default) S3method(intersect.modal.region, circular) S3method(as.data.frame, circular) S3method(plot, edf) S3method(lines, edf) S3method(plot, function.circular) circular/README0000644000176200001440000000065614470153537012756 0ustar liggesusers Version 0.4-7 2023/08/19 This is the circular package build over the R port of the CircStats package by Ulric Lund from "Topics in circular Statistics" (2001) S. Rao Jammalamadaka and A. SenGupta, World Scientific. See inst/NEWS for a partial list of changes. Claudio Agostinelli Ulric Lund Maintainer: Eduardo García-Portugués circular/data/0000755000176200001440000000000013124712013012761 5ustar liggesuserscircular/data/fisherB18.rda0000644000176200001440000000041213124712013015201 0ustar liggesusers r0b```b`f@& `d`aҜiEN ` |@,PRa4.Х 3+LP(]rBA}Pҡ 0q L uX twl i`5J@0s`tT{&B `ּb CPԒD(=N`xA@.[tsafRKҊ ZVcircular/data/fisherB11.rda0000644000176200001440000000020213124712013015167 0ustar liggesusers r0b```b`f@& `d`aҜiEN@1@F+@i-(mҮ  J'%@d>!;:@LJC`Nmcircular/data/fisherB9c.rda0000644000176200001440000000052113124712013015265 0ustar liggesusersJ0϶m!x'/^.^Ed"bh$=)Q$c I/}I(r1  Lan"3"89J¡-wГǞg{x ~~?nfNv"]խSp'~nͪfhCG&ɠ[y|{V*'Tf/6)iI(̵gblK(g G3\!IVy÷W\Knsخ lJFx));|ZRn^ )WآgJ{~%{^VXKCZ9A circular/data/fisherB10c.rda0000644000176200001440000000063113124712013015337 0ustar liggesusersSJ@^ HEdU<k $73ݙ]Oo׮j~Z :எ]}>V(+)nYt#xuѠʁTO SxYH2t{Sq&ɥ=e/hBF(circular/data/fisherB3c.rda0000644000176200001440000000060113124712013015256 0ustar liggesusers}N10!q ]`DQ$FRٙYGQ|GpkL95RIگ9'MN)B 5圕KӐS Yu>;k2K& j{Ôuud'O32I67kB?$/&q~]]_BB5EoR:ݽ.r>>r>r|2zK`G,q.c^ #Mq[_[а0}ˤ3Ə<Ѫ.hs60SﻑNB |̽Хڴ=ry4v_GzOH4T@]?pX'Oiȫcircular/data/rao.table.rda0000644000176200001440000000135613124712013015325 0ustar liggesusers]MHUAǯ>#|dh^)HVpi"xIP=xAu2 %@@@[dxB}`H7eJh\=?{g?93{utB/V1YT^^WOfK]ѵsm\t*̉ѥTMD!ڣUͽ"u3!>nψ2s3"~2㣮LU"}0n.x$H@;9"ߚOQr?ż&h@Q}Ž@M!9+jB/c>+W~U;-r,pOS2xЕ=TԬpa^K\3/x )axyr.W!OC>v 򵷡N{ `#e"9uF t7ץ60B9IW?G}ɣpYriϛ73N`|Fȿ~k"jyI¶/tOi= pC< ^O37D|^B@Gk!7oQ7Y=> oQQ *>!֘~3bztbu*;c l3IJvIn eCMYjkK\7*ѐ~ub(M M,UN,47oܩg_9wJCA/ξԕu+p(kO;Bz+goZX tI_o ?=I .koC]"nh[2,bcrd=ۍ?7EKcircular/data/pigeons.rda0000644000176200001440000000064013124712013015115 0ustar liggesusers͔J@gJU@DDIV *nۤzy <>%f'ytgvvwj*df0 eaGnZMDtqX7^2ya.^ q%+, KTo-:Twe7zP}"J` zv \C(b.{`CM±sUP>=KZ' j.~*fa-t4 }c|QҖN+h+`8 ǵ=1;BtV?Aہ}_>ygŝQu O?';v;a`˰c{aPe:،RmkPR鳁[LPb74no~΄ a ="QKTlnYs}6]q#G>1-4p4B3^kF?93p5@%7Ch9 /\ G='og[d>^>&fTmW25ܾ@+8'q.!j{M?]TaUeYڹ?>eƹyӋd.;T+_xn circular/data/fisherB7.rda0000644000176200001440000000037213124712013015124 0ustar liggesusers r0b```b`f@& `d`aiEN@68,`"3]tTy€&]_"N:J/Uǡ˂j.L.vfL'&X@7-UPa`ԅ=`?#@4_{N:TGtIB'CiPt(?JgBb9hL,J.I,*U< @vnb^zNj1({JjzQ*0wzj~zQbAFf2Kbq&H iFC\t%԰&'g5/1n̴ʂTҼ̒b($5 '&ɖRVZcs$dLI, *Xe&ccXϡTϖz_NHr"r=2*:\.n/I\\g{yL8xdJ!=Q JmYCSC}G;e#K2_5AH;.1$ڸLfy$\m :F$F9D џQ_b_.qnDЇ*lf~kOQ66t6>gOd}7tM之DE~I0O(z+#}cj ुs  [.PDDt//rywߥV "-!wke(*6RSpq"0k|}J3ڋEwːKa]4C9󍆌RV|^…6 /QrbT9 d!%*lu Tzx#|_64e+!}W!qAΩDﳊ Bڻ5fv,`0=gC3Hx? SOp 8"0ѫ75B0hG.U#R0sRS/@(φ'C^Vtc >3A¬a&9JA 0*d͵3>^x_T'㒪@Wʄp#$ %k]Ciw*ڽ9z%-|QR,?&Jij6[R9l1/Px7~c:Vh)\ 7aH|Xģbov/]kMWH$l1?Ƞ<&v *-.k RP˦x xvsjCC&ȸ#($5^d YNv4[>@U#V?O]#Azcaj-4<ͮ#Cnj7/H: E}k ]ߩ`X6'k~l^)0HO*1<ET=-Z&O@ZHa!iYmH2{g&yrEӡл6d(+}zHt괙CױHJv&@N^Dx7~*?^CO#x  =}H5OӼKf^du|C҈`-` ,ryk|+ SF MXJ-m8+0/ ;& F~q0Ҝw+*`(sm|CBy `Œ#ߞѝֺ{H=EdЩ04ycJi!,4o՟ !-=\^+y.6Yz¬K%\x_n-Z5c5So4gaF lM.1G#c3HԲEB@r||9'"m>x@7fT=^؃qv>CyP.l>WqW( $0FCP Cr'H,dzeC}v>`<{^bŦKƷKS_|c1Hƣ5>6F}gg$BZ@,Wa)L$l{%Ks'XplvP$ *xx,!HԲ#}gw cm"{监WQ|&e[oڨĝu~KVȴ(`k UVgJ1\_@Iv :}X)dv( C72"Ğ䜤i%{ƃ40h|P 2ETD9{"S@ ;+!';Aڎ< bb.9 ,>CqW]c!vgDBKePE_< !~U Y*WݘH;-w ƎM݃^rCI(a7$F9!o! o%=tIVԌ)|o|W!Od*VFe!(([gZU* circular/data/fisherB2.rda0000644000176200001440000000055213124712013015117 0ustar liggesusers]ANPG`, .0WM\ TP*-Dz6ã(_y/iM;M.&ak^wmIC6o{'t;"ZjeeQ1x)y/=ބbV]+XNC|>q՝=^n}~_Cub}˿?4_}%>-=2til<#>|YUgT7){mޯgv~ԗSpz=r{=ۣc;?)ioiewB_7g<i{sțsXTU[%ʈ_circular/data/fisherB8c.rda0000644000176200001440000000041113124712013015262 0ustar liggesusers r0b```b`f@& `d`aҜiEN |@&t]DљIg:tbi44Jg̢ҜĢ` ̢b4TtaĂdt)L(2T+59'?9͕yp`TeC9%9%0IҜ|"($7 90;`` Ԣd~m߲circular/data/fisherB1.rda0000644000176200001440000000115413124712013015115 0ustar liggesusersm=nPnHpExYBXAK.\#BED@Hto7̛7z[4­Lwn޾yb;?>VtHwgڈD^^tx>OmsLͽKTyϷ}Jxo}v/-gʫ|-U|y9~{W#;?y{dP|oxzc'MO<C{M}׉SV|'Dr<[k>x)OG)?~Gq_]\ԯXqoJ§S\ԝ_zakKrTJ^&y;kbPc!\~Beni_/?B] |؏ab;.|֯}U!gΘS$Ko1Wڇ Lyd&|Wُs?:o'circular/data/fisherB13.rda0000644000176200001440000000305213124712013015177 0ustar liggesusers}YKFe^r&{yvYp'J&"xAGx Wvy(oWUzzu/y|._P:llއF[_Wc6&16^y97ccu+MT,4?~zN`Odž~8]?Ϳ \=\?po?9}-pic;;|>J< z+x0n(8=7v<^?Qxf\⇞Z=2y{{<n<]߯׆8:4'쁞Σ5}=uyEϯQxEo (Fk9Hu;+ ϱv7U/Ip0IinywO/m^t8#IVIPZp߂(}d>y,-Qٿ,v'*}m$/w:u8Ue $_=oW7UOMO[ߛ ?8~%Y$l*v(=Jߔ%nmU?.}g:?㾉Ȕl[l7ֳvf_iWfkqLNX]6pl=zg{^`5g]ޖ<ٛ vl\o;>䯱έWnC [6ix#<؎ r?؇{ڋTޒƇO( b|x@~}btm\_Ծ/~q ~_I!Gɻ$ryRG{^rPWI Xg⺉"w~ԏR~P?'G/Y??/uxe%_ւs]Ǵ(ۗOSҾyKs#9Ou9Ÿ7Y>qy;>UW>}^9)e nY_c;nF٨|+?$͗S{w7Y(TaW/Q\vy$Iy7p~c;?,KWwwg?̞=>ߵO^'7?ʠcircular/data/fisherB12.rda0000644000176200001440000000015513124712013015177 0ustar liggesusers r0b```b`f@& `d`aҜiENF@;:0CT:B')@]xBgBYPs@)s(circular/data/fisherB4.rda0000644000176200001440000000032013124712013015112 0ustar liggesusers] @gAsKKqğ>circular/data/fisherB6c.rda0000644000176200001440000000100613124712013015261 0ustar liggesusersTn0e,u ЭCn] 4%C6<)ZMIIO' ~?!kQ )]3LuRtxwNwx1c=c={Ny*ɡ7Y{Vn dU@*g@/ x,/`kԭ`PGߡ/Ex?/0_ (aTGun}߆EiBq1my](i;rYA!p=-Eוr[VK9秋/:1B5bpպPܵKga ⎜y`]ح)TG 4*A)EΗkI>v-&VoG(~{^ZIb~ e{ēQCݰ9y>c0]s.|lN_¼}.zȋ>R5s+L٬-uE)岰k%D6s2j'-knWF|Z:Yեp&.-Ckph^Y)]BUY'BFcircular/data/fisherB13c.rda0000644000176200001440000000357313124712013015352 0ustar liggesusersMnVYu,=@qүFWH"K$/ڕ=#:#IkF5Pm.dΛ73o87l|%OYUٖvynO?Z0m`|!(z/i`ѺK>rEG屃RzW VޏbzN?^/<2z3]~uq _S?*/'hqX} 8&ޯWv* %WC~g)97?dZV⓾ߵLzz/nį'iVOaw:A:vλrXWyQNxTĵÏSoFbrԽ61)`'z2!_?)Oyw^Gf6ΰyQu1FsSໂ FĤJ$4 @"I0 '8kk9([x\=¤C/zʀgfNד>|mmq$'ykAvlQWZY=?^A~JV^1V;KnGWGt;Սz^Eӆ^6)ZYL$oR"ԧ񐮂>T89\'&ε[.=c_?)zB^|ĭ'oGk~/ t/1}a(TYꈾ|S}~#(<]{>{fco&߾>pm{{6Ϸw_8cPZ]ֿUT/ 3Wg*}(z_yVj{ϏX[;K ^ȱJTKEx+(:=\AP_&Μ\Fuw^{k<9~ڽ'vZOB_a]{DӛmνOom?\+gާZ':[z${tn.z3qnЏ&/zXG/~gy0ށɓ79ss~aF߱MZ .vNu"dؾvRU֭Ctu o3}+`<=M/=}1 tػvˀr_3q g_.=?]1;Br.;u[Rw^^?v g11+/v/w_70)y' 37H#?,Pmcircular/data/fisherB2c.rda0000644000176200001440000000077513124712013015271 0ustar liggesusers]TN@B ]fQ!Tue jI#ƓRbGc{l>OC)>>oF"5Z>DM,[\_m:m%Du X J1/Q?H Cxo=+u1x\ m.ʹ[~GJ@WþsY_OK7B?侎wȽ'|Sܼu`11r%Н<(15};'B=]D{K̻|ws~۝gpu8<_`_p>؁{ ~Ϡosgɭgy6yWA?9!QQD̬YnQl4`eP>uZ dw::=JPqc(_hizP|*9$NҁPZ_J[ M%p2B'4սPFChxcT D9!PoSFK y@8q@YSK FHl1@&P}circular/data/fisherB5.rda0000644000176200001440000000031113124712013015113 0ustar liggesusers]K@vA V&Q") 1 [.((bb0{#e D,WOo^JKU[).=H+X6mbCǡ#q } gJ}I\47ŝqo}G;">H"_QWSK_/ljcircular/data/fisherB20c.rda0000644000176200001440000000065413124712013015345 0ustar liggesuserseSMK@6iEГ͋"4Ԋ"*T%Ym0MfUƼ)f]H޾ɛnֻu"*㚻cnJR`.L{R567|"gWIάe坏rlπ^z9鎊k1~>[^[]^y+/OP?o2#> 佒nҎ4t륽ϕNsmT(WĢ?Pjy Y0CLkDBj? Qi/R~Z%Z0G"eN`a_)k~= x { *pذ Ou>y,,x@9x;猩hYE '{TΧ;eM{.t?wʤPn^IQcircular/data/fisherB9.rda0000644000176200001440000000051113124712013015121 0ustar liggesusers?K1g{A vpҡtq ]HPmNOjҏO"|9~G\ 5j@}6k԰'EWVQd>Lj:u`o4wxNͩɄu~*clLWݸAX_wsͅ&i=͍tW)k˼fjNOݽO$CppǁBpp 6!~raLrܨlY.3d#a~m4^vǸ6jGļb{-_VA circular/data/fisherB1c.rda0000644000176200001440000000142113124712013015255 0ustar liggesusers]Vn@iH+@J&)ycKPЭe G$ ؐ#(|D>Mlk PsF̌\ߙ81~vrn!JboR!b;ۯE过}o?s/Yuq,p>%4 by{S/CCx0Uuq=xs2g>#ccN3ȱxaa\ ҍJO_u1'p8 /m.8>76_OO{\5Fsfo" l :FW`hr>PmLf,3S,QIb(J4x circular/data/fisherB18c.rda0000644000176200001440000000062413124712013015351 0ustar liggesuserseSJ@&il ؋xҋUAPhA{Җ, N>W} x$BnwhHݙM~үB bZmʥeWX,21'.!fu$Ī#bɲAcx~Ը.xX| ov ؟ʮԧ\P YEi8Y. ؈a+BS<5Bk^qWCw 8%اv R?B=.HPE\O{>MpO8#l>L=W뉾csk"{sV&?Sl g!~"o|g=ȟ?){Y3A)? pJeه&ZXn !vZ=circular/data/swallows.rda0000644000176200001440000000070513124712013015326 0ustar liggesusers=KQ쬮~(D6 *ؙ Q[;JF vb``Z>3wFpss܏s=fS3)g411CDk%eN(b6ĬG`;[{WֺeճS\ǎb~5YيU[/TsvyuaҰM =#P &c>6(̓c i{dYc^ `υqBs蜎X>ט?&ߙ.5?0l$oI>?΀ɒ_K0~ 5ppu ~"\߯ڮxfUvNs-Y/ꝼ,WK*<ιUq|uJ b ry7쭧g3 +circular/data/fisherB4c.rda0000644000176200001440000000054313124712013015264 0ustar liggesuserse=N04 mP%6&`g@(MT#p8G•1{89a⑺u==4[QL Uzȯ ?z)!CCud0#> )%fNAz1,s33`LHVT[FΟa ]PrȳP|* oS65;;l4](ǜۂ2h*1U6 l\ƙm{Ҏ2ST,㹻&ial=*{ip)'fhcircular/man/0000755000176200001440000000000014470153537012642 5ustar liggesuserscircular/man/jonespewsey.Rd0000644000176200001440000000275514470146310015504 0ustar liggesusers\name{JonesPewsey} \alias{djonespewsey} \alias{jonespewsey} \title{Jones and Pewsey Density Function} \description{ Density for the Jones and Pewsey circular distribution. } \usage{djonespewsey(x, mu, kappa, psi)} \arguments{ \item{x}{a vector. The object is coerced to class \code{\link{circular}}.} \item{mu}{direction parameter of the distribution. The object is coerced to class \code{\link{circular}}.} \item{kappa}{non-negative concentration parameter of the distribution.} \item{psi}{real shape parameter.} } \details{The JonesPewsey distribution has density \deqn{ f(x)=\frac{(\cosh(\kappa\psi) + \sinh(\kappa\psi)\cos(x-\mu))^{1/\psi}} {2\pi P_{1/\psi}(\cosh(\kappa\psi))}, }{% f(x)=[(\cosh(\kappa\psi) + \sinh(\kappa\psi)\cos(x-\mu))^{1/\psi}] / [2\pi P_{1/\psi}(\cosh(\kappa\psi))], } for \eqn{0 \le x < 2\pi}{0 <= x < 2 \pi}, where \eqn{P_{1/\psi}(\cdot)}{P_{1/\psi}(.)} is the associated Legendre function of the first kind, degree \eqn{1/\psi} and order 0. } \value{The density} \references{Jones , M.C. and Pewsey, A. (2005). A family of symmetric distributions on the circle. J. Am. Statist. Assoc. 100, 1422-1428} \author{Federico Rotolo} \examples{ ff <- function(x) djonespewsey(x, mu=circular(4), kappa=1.8, psi=-.6) curve.circular(ff, join=TRUE, xlim=c(-1, 1), ylim=c(-1.2, 1.2), main="Density of a JonesPewsey Distribution", xlab=expression(paste(mu,"=1.3",pi,", ",kappa,"=1.8, ",psi,"=-0.6")) ) } \keyword{distribution} \keyword{circle} \keyword{circular} circular/man/modal.region.Rd0000644000176200001440000000544612236424524015513 0ustar liggesusers\name{modal.region} \alias{modal.region} \alias{modal.region.default} \alias{modal.region.circular} \title{ Modal regions } \description{ Evaluate the modal regions for a data set. Only the version for circular data is implemented. } \usage{ modal.region(x, ...) \method{modal.region}{default}(x, ...) \method{modal.region}{circular}(x, z=NULL, q=0.95, bw, adjust = 1, type = c("K", "L"), kernel = c("vonmises", "wrappednormal"), na.rm = FALSE, step=0.01, eps.lower=10^(-4), eps.upper=10^(-4), ...) } \arguments{ \item{x}{numeric or an object of class \code{\link{circular}}.} \item{z}{numeric or object of class \code{\link{circular}}. The grid were the kernel density estimate will be evaluated. If \code{NULL} equally spaced points in the interval [0,2*pi) with step \code{step}.} \item{q}{numeric in the interval [0,1]. The quantile of the modal region.} \item{bw}{the smoothing bandwidth to be used. When the \code{kernel} is \code{vonmises} the bandwidth is equal to the concentration parameter.} \item{adjust}{the bandwidth used is actually \code{adjust*bw}. This makes it easy to specify values like ``half the default bandwidth''.} \item{type}{Not Yet Used.} \item{kernel}{a character string giving the smoothing kernel to be used. This must be one of \code{"vonmises"} or \code{"wrappednormal"}, that are kernels of \code{type} \code{"K"}.} \item{na.rm}{logical; if \code{TRUE}, missing values are removed from \code{x}. If \code{FALSE} any missing values cause an error.} \item{step}{numeric. Used in the construction of the regular grid \code{z}.} \item{eps.lower,eps.upper}{the cut point in the density is searched in the interval [min(density)*(1+eps.lower),max(density)*(1-eps.upper)].} \item{\dots}{further arguments passed to the next methods.} } \details{ Only the version for circular data is actually implemented. } \value{ A list of class \code{modal.region.circular} with the following elements \item{zeros}{extremes of modal regions, possible as a matrix} \item{areas}{a list with two components: \code{tot} with the total (area under the density) probability, which should approximately equal to \code{q} and \code{areas} with the probability of each modal region.} \item{density}{the object from function \code{density.circular}.} \item{q}{the modal region order as in input.} \item{level}{the cut point at the density scale.} } \references{ L.G.R. Oliveira-Santos, C.A. Zucco and C. Agostinelli (2013) Using conditional circular kernel density functions to test hypotheses on animal circadian activity. Animal Behaviour, 85(1) 269-280. } \author{ Claudio Agostinelli } \seealso{ \code{\link{totalvariation.circular}} } \examples{ x <- rvonmises(100, circular(pi), 10) res <- modal.region(x, bw=50) plot(res) } \keyword{univariate} circular/man/rao.test.Rd0000644000176200001440000000323011312211557014653 0ustar liggesusers\name{rao.test} \title{Rao's Tests for Homogeneity} \alias{rao.test} \alias{print.rao.test} \description{ Performs Rao's test for homogeneity on k populations of angular data. } \usage{ rao.test(\dots, alpha=0) \method{print}{rao.test}(x, digits = 4, \dots) } \arguments{ \item{\dots}{a sequence of \code{\link{circular}} for the \code{rao.test} and further arguments passed to or from other methods for the \code{print.rao.test} function.} \item{alpha}{numeric value specifying the significance level of the test. Default is 0, in which case p-values for the test statistic is printed.} \item{x}{an object from the \code{rao.test}.} \item{digits}{integer indicating the precision to be used.} } \value{ A list with the statistic and p.value for the mean and the dispersion and the value of alpha. } \note{ The test is performed, and the results are written to the screen. Test results are given for both the test of equality of polar vectors, and of dispersions. If alpha is specified, the test statistic is printed, along with the level critical value. If alpha is not specified, a p-value for the test is printed. } \details{ Critical values and p-values are determined according to the chi-squared approximation of the test statistic. } \author{Claudio Agostinelli and Ulric Lund} \references{ Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Section 7.6.1, World Scientific Press, Singapore. Rao, J.S. (1967). Large sample tests for the homogeneity of angular data, Sankhya, Ser, B., 28. } \examples{ x <- rvonmises(100, circular(0), kappa=10) y <- rvonmises(100, circular(0), kappa=10) rao.test(x, y) } \keyword{htest} circular/man/rad.Rd0000644000176200001440000000102711312211557013664 0ustar liggesusers\name{rad} \title{Radians} \alias{rad} \description{ Converts degrees to radians. } \usage{ rad(x) } \arguments{ \item{x}{vector or matrix of degree measurements.} } \value{ Returns a vector or matrix of radian measurements corresponding to the data in degrees. } \details{This function is available for compatibility with the CircStats package, please use \code{\link{conversion.circular}}.} \author{Claudio Agostinelli and Ulric Lund} \seealso{ \code{\link{conversion.circular}} and \code{\link{deg}} } \keyword{math} circular/man/fisherB9.Rd0000644000176200001440000000145011312211557014571 0ustar liggesusers\name{fisherB9} \alias{fisherB9} \alias{fisherB9direction} \alias{fisherB9frequency} \alias{fisherB9c} \title{B.9 Dance directions of bees} \usage{ data(fisherB9) data(fisherB9c) } \description{ Dance directions of 279 honey bees viewing a zenith patch of artificially polarised light. } \format{ \code{fisherB9} a vector of 279 observations (in degrees). \code{fisherB9c} contains the same observations in a circular objects. } \source{ Adapted by Prof. N.I. Fisher from R. Wehner & S. Strasser (1985) The POL area of the honey bee's eye: behavioural evidence. Physiol. Entomol. 10, 337-49. Pag. 346. } \seealso{ N.I. Fisher (1993) Statistical analysis of circular data. Cambridge University Press. Pag. 244. } \examples{ data(fisherB9c) plot(fisherB9c, stack=TRUE, shrink=1.5) } \keyword{datasets} circular/man/watson.two.test.Rd0000644000176200001440000000371414470146310016226 0ustar liggesusers\name{watson.two.test} \title{Watson's Two-Sample Test of Homogeneity} \alias{watson.two.test} \alias{print.watson.two.test} \description{ Performs Watson's test for homogeneity on two samples of circular data. } \usage{ watson.two.test(x, y, alpha=0) \method{print}{watson.two.test}(x, digits=4, \dots) } \arguments{ \item{x}{a vector. The object is coerced to class \code{\link{circular}}.} \item{y}{a vector. The object is coerced to class \code{\link{circular}}.} \item{alpha}{significance level of the test. Valid levels are 0.001, 0.01, 0.05, 0.1. This argument may be omitted, in which case, a range for the p-value will be returned.} \item{digits}{integer indicating the precision to be used.} \item{\dots}{further arguments passed to or from other methods.} } \value{ a list with statistic, alpha and the number of observations of the first and second sample. } \details{ Watson's two-sample test of homogeneity is performed, and the results are printed. If alpha is specified and non-zero, the test statistic is printed along with the critical value and decision. If alpha is omitted, the test statistic is printed and a range for the p-value of the test is given. Critical values for the test statistic are obtained using the asymptotic distribution of the test statistic. It is recommended to use the obtained critical values and ranges for p-values only for combined sample sizes in excess of 17. Tables are available for smaller sample sizes and can be found in Mardia (1972) for instance. } \author{Claudio Agostinelli and Ulric Lund} \references{ Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Section 7.5, World Scientific Press, Singapore. } \examples{ # Perform a two-sample test of homogeneity on two # simulated data sets. data1 <- rvonmises(n=20, mu=circular(0), kappa=3) data2 <- rvonmises(n=20, mu=circular(pi), kappa=2) watson.two.test(data1, data2, alpha=0.05) watson.two.test(data1, data2) } \keyword{htest} circular/man/A1FirstDerivative.Rd0000644000176200001440000000155012021347555016421 0ustar liggesusers\name{A1FirstDerivative} \title{First derivative of the Ratio of First and Zeroth Order Bessel Functions.} \alias{A1FirstDerivative} \description{Evaluates the first derivative of the Ratio of First and Zeroth Order Bessel Functions} \usage{ A1FirstDerivative(kappa) } \arguments{ \item{kappa}{non-negative numeric value at which to evaluate the first derivative of A1 function.} } \value{ The value of the first derivative of A1 function in the point \code{kappa}. } \details{ The formula (3.48) of Fisher (1993), pag. 52 is implemented. The function uses \code{\link{A1}} and \code{\link{besselI}}. } \author{Claudio Agostinelli and Alessandro Gagliardi.} \references{ N.I. Fisher (1993) Statistical Analysis of Circular Data, Cambridge University Press. } \seealso{ \code{\link{A1}}, \code{\link{besselI}}, \code{\link{A1inv}}. } \keyword{math} circular/man/mle.vonmises.Rd0000644000176200001440000000526411611000110015523 0ustar liggesusers\name{mle.vonmises} \title{von Mises Maximum Likelihood Estimates} \alias{mle.vonmises} \alias{print.mle.vonmises} \description{ Computes the maximum likelihood estimates for the parameters of a von Mises distribution: the mean direction and the concentration parameter. } \usage{ mle.vonmises(x, mu=NULL, kappa=NULL, bias=FALSE, control.circular=list()) \method{print}{mle.vonmises}(x, digits = max(3, getOption("digits") - 3), \dots) } \arguments{ \item{x}{a vector. The object is coerced to class \code{\link{circular}}.} \item{mu}{if \code{NULL} the maximum likelihood estimate of the mean direction is calculated. If provided it is coerced to a class \code{circular}.} \item{kappa}{if \code{NULL} the maximum likelihood estimate of the concentration parameter is calculated.} \item{bias}{logical, if \code{TRUE}, the estimate for kappa is computed with a bias corrected method. Default is \code{FALSE}, i.e. no bias correction.} \item{control.circular}{the attribute of the resulting objects (\code{mu})} \item{digits}{integer indicating the precision to be used.} \item{\dots}{further arguments passed to or from other methods.} } \value{ Returns a list with the following components: \item{call}{the \code{\link[base]{match.call}} result.} \item{mu}{the estimate of the mean direction or the value supplied as an object of class \code{circular}.} \item{kappa}{the estimate of the concentration parameter or the value supplied} \item{se.mu}{the standard error for the estimate of the mean direction (0 if the value is supplied) in the same units of \code{mu}.} \item{se.kappa}{the standard error for the estimate of the concentration parameter (0 if the value is supplied).} \item{est.mu}{TRUE if the estimator is reported.} \item{est.kappa}{TRUE if the estimator is reported.} } \details{ Best and Fisher (1981) show that the MLE of kappa is seriously biased when both sample size and mean resultant length are small. They suggest a bias-corrected estimate for kappa when n < 16. } \author{Claudio Agostinelli and Ulric Lund} \references{ Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Section 4.2.1, World Scientific Press, Singapore. Best, D. and Fisher N. (1981). The bias of the maximum likelihood estimators of the von Mises-Fisher concentration parameters. Communications in Statistics - Simulation and Computation, B10(5), 493-502. } \seealso{ \code{\link{mean.circular}} and \code{\link{mle.vonmises.bootstrap.ci}} } \examples{ x <- rvonmises(n=50, mu=circular(0), kappa=5) mle.vonmises(x) # estimation of mu and kappa mle.vonmises(x, mu=circular(0)) # estimation of kappa only } \keyword{htest} circular/man/change.point.Rd0000644000176200001440000000311311312211557015471 0ustar liggesusers\name{change.point} \title{Change Point Test} \alias{change.point} \description{ Tests for a change in mean direction, concentration, or both, given a set of directional data points. } \usage{ change.point(x) } \arguments{ \item{x}{a vector. The object is coerced to class \code{\link{circular}}.} } \value{ Returns a list with variables n, rho, rmax, k.r, rave, tmax, k.t, and tave. The first of these is the sample size, followed by the overall mean resultant length. Both of these are needed to enter any of the tables or nomograms (see under Details). The other values represent the change point test statistics. While rmax and rave test for a change in mean direction (with unknown concentration), tmax and tave are useful in the context of testing more generally, for a change in mean direction and/or concentration. k.r and k.t are the observation numbers for which rmax and tmax attain their maximum value and indicate the observation at which the change is most likely to have occurred, when the tables or nomograms indicate significance. } \details{ In either context, the user can choose which statistic (max or ave) to use, and then consult the appropriate table provided in the book referenced below. The critical values for these 4 statistics are to be found in Table 11.3 (or Figure 11.3) for rmax, Table 11.4 (or Figure 11.4) for rave, Figure 11.5 for tmax and Figure 11.6 for tave. } \author{Claudio Agostinelli and Ulric Lund} \seealso{ Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Chapter 11, World Scientific Press, Singapore. } \keyword{htest} circular/man/lines.density.circular.Rd0000644000176200001440000000465114470146310017521 0ustar liggesusers\name{lines.density.circular} \alias{lines.density.circular} \title{Add a Plot for Kernel Density Estimation for Circular Data} \description{ The \code{lines} add a plot for \code{density.circular} objects. } \usage{ \method{lines}{density.circular}(x, type = "l", zero.line = TRUE, points.plot = FALSE, points.col = 1, points.pch = 1, points.cex = 1, plot.type = c("circle", "line"), bins = NULL, offset=1, shrink = 1, tcl = 0.025, sep = 0.025, join = TRUE, nosort = FALSE, plot.info = NULL, zero = NULL, rotation = NULL, ...) } \arguments{ \item{x}{an object of class \code{\link{density.circular}}.} \item{type}{plotting parameter with useful default.} \item{zero.line}{logical; if \code{TRUE}, add a base line at \eqn{y = 0}. Used when \code{plot.type} is \code{"line"}.} \item{points.plot}{logical; if \code{TRUE} original data are added to the plot.} \item{points.col, points.pch, points.cex}{parameters used to draw the points.} \item{plot.type}{type of the plot.} \item{bins}{number of ticks to plot. } \item{offset}{the radius of the circle} \item{shrink}{parameter that controls the size of the plotted function. Default is 1.} \item{tcl}{length of the ticks.} \item{sep}{constant used to specify the distance between stacked points. Default is 0.025; smaller values will create smaller spaces.} \item{join}{logical: should the first and the last point joined.} \item{nosort}{logical: should the data sort before plotting. Defaults is to sort.} \item{plot.info}{an object from \code{\link{plot.circular}} that contains information on the \code{zero}, the \code{rotation} and \code{next.points}.} \item{zero}{the zero of the plot. Ignored if \code{plot.info} is provided.} \item{rotation}{the rotation of the plot. Ignored if \code{plot.info} is provided.} \item{\dots}{further parameters passed to \code{\link{lines.default}}.} } \value{ A list with information on the plot: zero, rotation and next.points and, if available, the coordinates x and y. } \author{Claudio Agostinelli} \seealso{\code{\link{density.circular}} and \code{\link{plot.density.circular}} } \examples{ set.seed(1234) x <- rvonmises(n=100, mu=circular(pi), kappa=2) y <- rvonmises(n=100, mu=circular(pi/2), kappa=2) resx <- density(x, bw=25) res <- plot(resx, points.plot=TRUE, xlim=c(-1.5,1), ylim=c(-1.1, 1.5)) resy <- density(y, bw=25) lines(resy, points.plot=TRUE, col=2, points.col=2, plot.info=res) } \keyword{dplot} circular/man/I.p.Rd0000644000176200001440000000072111611533556013554 0ustar liggesusers\name{I.p} \title{P-th Order Bessel Function of the First Kind} \alias{I.p} \description{ An alias of \code{besselI(x, nu=p)}. } \usage{ I.p(p, x) } \arguments{ \item{p}{positive integer order of the Bessel function.} \item{x}{non-negative numerical value at which to evaluate the Bessel function.} } \value{ Returns the p-th order Bessel function of the first kind, evaluated at a specified real number. } \seealso{ \code{\link{besselI}}. } \keyword{math} circular/man/fisherB20.Rd0000644000176200001440000000203714470146310014646 0ustar liggesusers\name{fisherB20} \alias{fisherB20} \alias{fisherB20c} \title{B.20 Movements of blue periwinkles.} \usage{ data(fisherB20) data(fisherB20c) } \description{ Distances 'x' and directions 'theta' by small blue periwinkles, Nodilittorina unifasciata, after they had been transplanted downshore from the height at which they normally live. } \format{ \code{fisherB20} is a \code{\link{data.frame}} of integer value. \code{fisherB20c} is a \code{\link{data.frame}} that contains the same observations, but in the first column, the data is a \code{\link{circular}} object. } \source{ N.I. Fisher (1993) pag. 252-253. Data kindly supplied by Dr A. Underwood and Ms G. Chapman. } \references{ N.I. Fisher (1993) Statistical analysis of circular data. Cambridge University Press. } \examples{ data(fisherB20) data(fisherB20c) par(mfcol=c(1,3)) plot(fisherB20c$theta, xlab=expression(theta)) boxplot(fisherB20c$x, xlab="x") plot(c(fisherB20$x, fisherB20$x), c(fisherB20$theta, fisherB20$theta+360), xlab="x", ylab=expression(theta)) } \keyword{datasets} circular/man/rao.table.Rd0000644000176200001440000000037611312211557014773 0ustar liggesusers\name{rao.table} \title{Table for Rao's Spacing Test of Uniformity} \alias{rao.table} \description{Table for Rao's spacing test of uniformity} \usage{data(rao.table)} \author{Ulric Lund} \seealso{ \code{\link{rao.spacing.test}} } \keyword{datasets} circular/man/mle.wrappednormal.Rd0000644000176200001440000000520713115244727016561 0ustar liggesusers\name{mle.wrappednormal} \title{Wrapped Normal Maximum Likelihood Estimates} \alias{mle.wrappednormal} \alias{print.mle.wrappednormal} \description{ Computes the maximum likelihood estimates for the parameters of a Wrapped Normal distribution: mean and concentration parameter. } \usage{ mle.wrappednormal(x, mu = NULL, rho = NULL, sd = NULL, K = NULL, tol = 1e-05, min.sd = 1e-3, min.k = 10, max.iter = 100, verbose = FALSE, control.circular=list()) \method{print}{mle.wrappednormal}(x, digits = max(3, getOption("digits") - 3), \dots) } \arguments{ \item{x}{a vector. The object is coerced to class \code{\link{circular}}.} \item{mu}{if \code{NULL} the maximum likelihood estimate of the mean direction is calculated, otherwise the value is coerced to an object of class \code{circular}.} \item{rho}{if \code{NULL} the maximum likelihood estimate of the concentration parameter is calculated.} \item{sd}{standard deviation of the (unwrapped) normal. Used as an alternative parametrization.} \item{K}{number of terms to be used in approximating the density.} \item{tol}{precision of the estimation.} \item{min.sd}{minimum value should be reached by the search procedure for the standard deviation parameter.} \item{min.k}{minimum number of terms used in approximating the density.} \item{max.iter}{maximum number of iterations.} \item{verbose}{logical, if \code{TRUE} information on the convergence process are printed.} \item{control.circular}{the attribute of the resulting objects (\code{mu})} \item{digits}{integer indicating the precision to be used.} \item{\dots}{further arguments passed to or from other methods.} } \value{ Returns a list with the following components: \item{call}{the \code{\link[base]{match.call}} result.} \item{mu}{the estimate of the mean direction or the value supplied as an object of class \code{circular}.} \item{rho}{the estimate of the concentration parameter or the value supplied} \item{sd}{the estimate of the standard deviation or the value supplied.} \item{est.mu}{TRUE if the estimator is reported.} \item{est.rho}{TRUE if the estimator is reported.} \item{convergence}{TRUE if the convergence is achieved.} } \author{Claudio Agostinelli with a bug fix by Ana Nodehi} \references{ Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Section 4.2.1, World Scientific Press, Singapore. } \seealso{ \code{\link{mean.circular}} } \examples{ x <- rwrappednormal(n=50, mu=circular(0), rho=0.5) mle.wrappednormal(x) # estimation of mu and rho (and sd) mle.wrappednormal(x, mu=circular(0)) # estimation of rho (and sd) only } \keyword{htest} circular/man/fisherB1.Rd0000644000176200001440000000157011312211557014564 0ustar liggesusers\name{fisherB1} \alias{fisherB1} \alias{fisherB1c} \title{B.1 Arrival times at an intensive care unit} \usage{ data(fisherB1) data(fisherB1c) } \description{ Arrival time on a 24-hour clock of 254 patients at an intensive care unit, over a period of about 12 months. } \format{ \code{fisherB1} is a vector of 254 observations (in the format hours.minutes). \code{fisherB1c} contains the same observations in a circular objects (minutes are expressed as decimals). } \source{ Cox, D.R. and Lewis, P.A.W. (1966) The Statistical Analysis of Series of Events. London : Methuen & CO. Ltd. pp. 254-255} \seealso{ N.I. Fisher (1993) Statistical analysis of circular data. Cambridge University Press. Pag. 239. } \examples{ data(fisherB1c) par(mfcol=c(1,2)) plot(fisherB1c, main="Clock 24", shrink=1.5) plot(fisherB1c, template="clock12", main="Clock 12", shrink=1.5) } \keyword{datasets} circular/man/katojones.Rd0000644000176200001440000000470011522276176015127 0ustar liggesusers\name{KatoJones} \alias{rkatojones} \alias{dkatojones} \title{Kato and Jones Density Function} \description{Density and random generation for the Kato and Jones distribution.} \usage{ rkatojones(n, mu, nu, r, kappa, control.circular=list()) dkatojones(x, mu, nu, r, kappa) } \arguments{ \item{x}{the angular value the density must be computed in.} \item{n}{number of observations.} \item{mu}{the Mobius 'mu' parameter. The object is coerced to class \code{\link{circular}}.} \item{nu}{the Mobius 'nu' parameter. The object is coerced to class \code{\link{circular}}.} \item{r}{the Mobius 'r' parameter. It must be in [0,1).} \item{kappa}{the positive vonMises parameter.} \item{control.circular}{the attribute of the resulting object.} } \details{The Kato and Jones distribution has density \deqn{ f(x)= \frac{1-r^2}{2\pi\mathcal I_0(\kappa)} \exp\left[ \frac{\kappa\{ \xi\cos(x-\eta)-2r\cos\nu \}} {1+r^2-2r\cos(x -\gamma)} \right]\\ \phantom{\exp[]} \times \frac1{1+r^2-2r\cos(x -\gamma)}, }{% f(x)= [1-r^2]/[{2\pi\mathcal I_0(\kappa)}{1+r^2-2r\cos(x -\gamma)}] exp[{\kappa\{ \xi\cos(x-\eta)-2r\cos\nu \}} / {1+r^2-2r\cos(x -\gamma)}], } for \eqn{0 \le x < 2\pi}{0 <= x < 2 \pi}, where \eqn{\gamma=\mu+\nu}, \eqn{\xi=\{r^4+2r^2\cos(2\nu)+1\}^{1/2}}{\xi={r^4+2r^2 cos(2\nu)+1}^{1/2}} and \eqn{\eta=\mu+\arg[ r^2\{\cos(2\nu)+i\sin(2\nu)\}+1 ]}{\eta=\mu+arg[ r^2{cos(2\nu)+i sin(2\nu)}+1 ]}. Original code for random generation is by Kato, S. and Jones, M.C. and can be found at the address http://pubs.amstat.org/doi/suppl/10.1198/jasa.2009.tm08313/suppl_file/t08-313code.txt. } \value{The density. \code{dkatojones} gives the density and \code{rkatojones} generates random deviates. } \references{Kato , S. and Jones, M.C. (2010). A family of distributions on the circle with links to, and applications arising from, Mobius transformation. J. Am. Statist. Assoc. 105, 249-262.} \author{Federico Rotolo} \examples{ data1 <- rkatojones(n=100, mu=circular(0), nu=circular(pi/4), r=.2, kappa=1) plot(data1) data1 <- rkatojones(n=100, mu=circular(pi/3), nu=circular(pi), r=.7, kappa=2.3) plot(data1) ff <- function(x) dkatojones(x, mu=circular(pi/3), nu=circular(pi), r=.7, kappa=2.3) curve.circular(ff, join=TRUE, xlim=c(-1, 1), ylim=c(-1.2, 1.2), main="Density of a KatoJones Distribution", xlab=expression(paste(mu,"=",pi,"/3, ",nu,"=",pi,", r=0.7, ",kappa,"=2.3")) ) } \keyword{distribution} \keyword{circle} \keyword{circular} circular/man/variance.Rd0000644000176200001440000000313614470146310014713 0ustar liggesusers\name{var} \title{Variance} \alias{var} \alias{var.default} \alias{var.data.frame} \description{ The \code{var} function from the \pkg{stats} is replace by a new \code{method} in order to report the variance of circular data appropriately. \code{var.default} is an alias of the original function \code{var} see \code{\link[stats]{cor}}. The behavior would be the same for objects which are not from \code{\link{class}} \code{\link{data.frame}} and \code{\link{circular}} (in the last case the variance is define as one minus the mean resultant length divided by the sample size of data, see \code{\link{var.circular}} for more details). The method for \code{data.frame} will apply the \code{var} function to each columns. } \usage{ var(x, \dots) \method{var}{default}(x, y = NULL, na.rm = FALSE, use, \dots) \method{var}{data.frame}(x, \dots) } \arguments{ \item{x}{a numeric vector, matrix or data frame.} \item{y}{\code{NULL} (default) or a vector, matrix or data frame with compatible dimensions to \code{x}. The default is equivalent to \code{y = x} (but more efficient).} \item{na.rm}{logical. Should missing values be removed?} \item{use}{an optional character string giving a method for computing covariances in the presence of missing values. This must be (an abbreviation of) one of the strings \code{"all.obs"}, \code{"complete.obs"} or \code{"pairwise.complete.obs"}.} \item{\dots}{further arguments passed to or from other methods.} } \seealso{ \code{\link[stats]{cor}}, \code{\link{var.circular}}, \code{\link{rho.circular}} and \code{\link{summary.circular}}. } \keyword{univar} circular/man/fisherB8.Rd0000644000176200001440000000145614470146310014600 0ustar liggesusers\name{fisherB8} \alias{fisherB8} \alias{fisherB8c} \title{B.8 Orientations of pebbles} \usage{ data(fisherB8) data(fisherB8c) } \description{ Horizontal axes of 100 outwash pebbles fromo a late Wisconsin outwash terrace along Fox river, near Cary, Illinois } \format{ \code{fisherB8} a vector of 100 observations (in degrees). \code{fisherB8c} contains the same observations in a circular objects. } \source{ Mardia, K.V. (1972) Statistics of Directional Data. London: Academic Press. Table 1.6 adapted from Krumbein W.C. (1939) Preferred orientations of pebbles in sedimentary deposits. J. Geol. 47, 673-706. } \seealso{ N.I. Fisher (1993) Statistical analysis of circular data. Cambridge University Press. Pag. 243. } \examples{ data(fisherB8c) plot(fisherB8c, stack=TRUE, shrink=1.5) } \keyword{datasets} circular/man/plot.density.circular.Rd0000644000176200001440000001030614470146310017357 0ustar liggesusers\name{plot.density.circular} \alias{plot.density.circular} \title{Plot Method for Kernel Density Estimation for Circular Data} \description{ The \code{plot} method for \code{density.circular} objects. } \usage{ \method{plot}{density.circular}(x, main=NULL, sub=NULL, xlab=NULL, ylab="Density circular", type="l", zero.line=TRUE, points.plot=FALSE, points.col=1, points.pch=1, points.cex=1, plot.type=c("circle", "line"), axes=TRUE, ticks=FALSE, bins=NULL, offset=1, shrink=1, tcl=0.025, tcl.text = 0.125, sep=0.025, tol=0.04, digits=2, cex=1, uin=NULL, xlim=NULL, ylim=NULL, join=FALSE, nosort=FALSE, units=NULL, template=NULL, zero=NULL, rotation=NULL, control.circle=circle.control(), ...) } \arguments{ \item{x}{an object of class \code{\link{density.circular}}.} \item{main, sub, xlab, ylab, type}{plotting parameters with useful defaults.} \item{zero.line}{logical; if \code{TRUE}, add a base line at \eqn{y = 0}. Used when \code{plot.type} is \code{"line"}.} \item{points.plot}{logical; if \code{TRUE} original data are added to the plot.} \item{points.col, points.pch, points.cex}{parameters used to draw the points.} \item{plot.type}{type of the plot: "line": linear plot, "circle": circular plot.} \item{axes}{logical; if \code{TRUE} axis are drawn.} \item{ticks}{logical; if \code{TRUE} ticks are drawn.} \item{bins}{number of ticks to plot. } \item{offset}{the radius of the circle} \item{shrink}{parameter that controls the size of the plotted function. Default is 1.} \item{tcl}{length of the ticks.} \item{tcl.text}{The position of the axis labels.} \item{sep}{constant used to specify the distance between stacked points. Default is 0.025; smaller values will create smaller spaces.} \item{tol}{proportion of white space at the margins of plot} \item{digits}{number of digits used to print axis values.} \item{cex}{point character size. See help on \code{\link{par}}.} \item{uin}{desired values for the units per inch parameter. If of length 1, the desired units per inch on the x axis.} \item{xlim, ylim}{the ranges to be encompassed by the x and y axes. Useful for centering the plot.} \item{join}{logical: should the first and the last point joined.} \item{nosort}{logical: should the data sort before plotting. Defaults is to sort.} \item{units}{units measure used in the plot. If \code{NULL} the value is taken from the attribute of object 'x' from the argument 'x', i.e. \code{x$x}.} \item{template}{template used in the plot. If \code{NULL} the value is taken from the attribute of object 'x' from the argument 'x', i.e. \code{x$x}.} \item{zero}{position of the zero used in the plot. If \code{NULL} the value is taken from the attribute of object 'x' from the argument 'x', i.e. \code{x$x}.} \item{rotation}{rotation used in the plot. If \code{NULL} the value is taken from the attribute of object 'x' from the argument 'x', i.e. \code{x$x}.} \item{control.circle}{parameters passed to \code{\link{plot.default}} in order to draw the circle. The function \code{\link{circle.control}} is used to set the parameters.} \item{\dots}{further parameters passed to \code{\link{plot.default}}.} } \value{ A list with information on the plot: zero, rotation and next.points. } \author{Claudio Agostinelli} \seealso{\code{\link{density.circular}}, \code{\link{lines.density.circular}}, \code{\link{plot.circular}}, \code{\link{lines.circular}} and \code{\link{curve.circular}}.} \examples{ set.seed(1234) x <- rvonmises(n=100, mu=circular(pi), kappa=2) res25x <- density(x, bw=25) plot(res25x, points.plot=TRUE, xlim=c(-1.5,1)) res50x <- density(x, bw=25, adjust=2) lines(res50x, col=2) resp25x <- plot(res25x, points.plot=TRUE, xlim=c(-1, 1.3), ylim=c(-1.5,1.2), template="geographics", main="Plotting density estimate for two data set") y <- rvonmises(n=100, mu=circular(pi/2), kappa=2, control.circular=list(template="geographics")) res25y <- density(y, bw=25) lines(res25y, points.plot=TRUE, plot.info=resp25x, col=2, points.col=2) plot(res25x, plot.type="line", points.plot=TRUE, xlim=c(-1, 1.3), ylim=c(-1.5,1.2), template="geographics", main="Plotting density estimate for two data set") lines(res25y, plot.type="line", points.plot=TRUE, col=2, points.col=2) } \keyword{dplot} circular/man/lines.circular.Rd0000644000176200001440000000253012017361277016043 0ustar liggesusers\name{lines.circular} \alias{lines.circular} \title{Add Connected Line Segments to a Circular Plot} \description{ A method taking coordinates in a polar system and joining the corresponding points with line segments. } \usage{ \method{lines}{circular}(x, y, join = FALSE, nosort = FALSE, offset=1, shrink=1, plot.info = NULL, zero = NULL, rotation = NULL, modulo = NULL, \dots) } \arguments{ \item{x}{a vector of class \code{circular}.} \item{y}{a vector with the same length as 'x'.} \item{join}{logical: if \code{TRUE} the first and the last values are joined by a line.} \item{nosort}{logical: if \code{TRUE} the data are not sorted before join them.} \item{offset}{the radius of the circle} \item{shrink}{parameter that controls the size of the plotted function. Default is 1.} \item{plot.info}{an object from another circular graphic function.} \item{zero}{the zero of the axis.} \item{rotation}{the rotation of the axis.} \item{modulo}{the modulo applied to 'x' before sorting.} \item{\dots}{graphical parameters passed to \code{\link{lines.default}}.} } \value{ A list with information on the plot: zero, rotation and next.points. } \author{Claudio Agostinelli} \seealso{\code{\link{plot.circular}}} \examples{ x <- rvonmises(20, circular(0), 10) y <- runif(20, 0.5, 1) plot(x, shrink=2) lines(x, y) } \keyword{hplot} circular/man/rayleigh.test.Rd0000644000176200001440000000312311312211557015677 0ustar liggesusers\name{rayleigh.test} \title{Rayleigh Test of Uniformity} \alias{rayleigh.test} \alias{print.rayleigh.test} \description{ Performs a Rayleigh test of uniformity, assessing the significance of the mean resultant length. The alternative hypothesis is a unimodal distribution with unknown mean direction and unknown mean resultant length if \code{mu} is \code{NULL} otherwise the alternative hypothesis is a unimodal distribution with a specified mean direction and unknown mean resultant length. } \usage{ rayleigh.test(x, mu = NULL) \method{print}{rayleigh.test}(x, digits=4, \dots) } \arguments{ \item{x}{a vector. The object is coerced to class \code{\link{circular}}.} \item{mu}{Specified mean direction in alternative hypothesis as a \code{circular} object.} \item{digits}{integer indicating the precision to be used.} \item{\dots}{further arguments passed to or from other methods.} } \value{ Returns a list with three components: the mean resultant length, \code{statistic}, the p-value of the test statistic, \code{p.value} and the value of the alternative mean direction \code{mu}. } \author{Claudio Agostinelli and Ulric Lund} \references{ Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Sections 3.3.2 and 3.4.1, World Scientific Press, Singapore. } \seealso{ \code{\link{range.circular}}, \code{\link{kuiper.test}}, \code{\link{rao.spacing.test}} and \code{\link{watson.test}} } \examples{ x <- rvonmises(n=25, mu=circular(pi), kappa=2) # General alternative rayleigh.test(x) # Specified alternative rayleigh.test(x, mu=circular(0)) } \keyword{htest} circular/man/fisherB10.Rd0000644000176200001440000000170111312211557014640 0ustar liggesusers\name{fisherB10} \alias{fisherB10} \alias{fisherB10c} \title{B.10 Directions of desert ants} \usage{ data(fisherB10) data(fisherB10c) } \description{ Directions of 11 long-legged desert ants (Cataglyphis fortis) after one eye on each ant was 'trained' to learn the ant's home direction, then covered and the other eye uncovered. } \format{ \code{fisherB10} is a list (in degrees). \code{fisherB10c} contains the same observations in a circular objects. } \source{ Personal communication of Prof. Dr. R. Wehner to Prof. N.I. Fisher, experiment described in R. Wehner and M. Muller (1985) Does interocular transfer occur in visual navigation by ants? Nature, 315, 228-9. } \seealso{ N.I. Fisher (1993) Statistical analysis of circular data. Cambridge University Press. Pag. 244-245. } \examples{ data(fisherB10c) res <- plot(fisherB10c$set1) points(fisherB10c$set2, col=2, plot.info=res) points(fisherB10c$set3, col=3, plot.info=res) } \keyword{datasets} circular/man/standarddeviation.Rd0000644000176200001440000000231514470146310016624 0ustar liggesusers\name{sd} \title{Standard Deviation} \alias{sd} \alias{sd.default} \alias{sd.data.frame} \description{ The \code{sd} function from the \pkg{base} is replace by a new \code{method} in order to report the standard deviation of circular data appropriately. \code{sd.default} is an alias of the original function \code{sd} see \code{\link[stats]{sd}}. The behavior would be the same for objects which are not from \code{\link{class}} \code{\link{data.frame}} and \code{\link{circular}} (in the last case the standard deviation is define as in Mardia (1972) \deqn{\sqrt{-2\ln r}}{sqrt(-2 * ln(r))} where \code{r} is the mean resultant length of the data, see \code{\link{sd.circular}} for more details). The method for \code{data.frame} will apply the \code{sd} function to each columns. } \usage{ sd(x, \dots) \method{sd}{default}(x, na.rm = FALSE, \dots) \method{sd}{data.frame}(x, \dots) } \arguments{ \item{x}{a numeric vector, matrix or data frame.} \item{na.rm}{logical. Should missing values be removed?} \item{\dots}{further arguments passed to or from other methods.} } \seealso{ \code{\link[stats]{sd}}, \code{\link{sd.circular}}, \code{\link{var.circular}} and \code{\link{summary.circular}}. } \keyword{univar} circular/man/var.circular.Rd0000644000176200001440000000226611564453721015531 0ustar liggesusers\name{var.circular} \title{A measure of variance for Circular Data} \alias{var.circular} \description{ Returns one minus the mean resultant length divided by the sample size of a vector of circular data. } \usage{ \method{var}{circular}(x, na.rm = FALSE, \dots) } \arguments{ \item{x}{a vector. The object is coerced to class \code{\link{circular}}.} \item{na.rm}{logical, indicating if \code{\link{NA}}'s should be omitted.} \item{\dots}{further arguments passed to or from other methods.} } \value{ Returns one minus the mean resultant length divided by the sample size of data. } \author{Claudio Agostinelli and Ulric Lund} \references{ Mardia, K.V. (1972) Statistics of Directional Data. Academic Press, London. Fisher, N.I. (1993) Statistical analysis of circular data. Cambridge University Press. Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Section 1.3, World Scientific Press, Singapore. } \seealso{ \code{\link{sd.circular}}, \code{\link{angular.variance}}, \code{\link{mean.circular}}, \code{\link{rho.circular}} and \code{\link{summary.circular}}. } \examples{ x <- rvonmises(n=100, mu=circular(0), kappa=1) var(x) } \keyword{univar} circular/man/rstable.Rd0000644000176200001440000000545114470146310014561 0ustar liggesusers\name{rstable} \title{Random Generation from the Stable Family of Distributions} \alias{rstable} \description{ Returns random deviates from the stable family of probability distributions. } \usage{ rstable(n, scale = 1, index = stop("no index arg"), skewness = 0) } \arguments{ \item{n}{sample size.} \item{index}{number from the interval (0, 2]. An index of 2 corresponds to the normal, 1 to the Cauchy. Smaller values mean longer tails.} \item{skewness}{number giving the modified skewness (see Chambers et al., 1976). Negative values correspond to skewness to the left (the median is smaller than the mean, if it exists), and positive values correspond to skewness to the right (the median is larger than the mean). The absolute value of skewness should not exceed 1.} \item{scale}{the scale of the distribution.} } \value{ random sample from the specified stable distribution. } \details{ This function return random variates from the Levy skew stable distribution with \code{index}=\eqn{\alpha}{alpha}, \code{scale}=\eqn{c}{c} and \code{skewness}=\eqn{\beta}{beta}. The \code{skewness} parameter must lie in the range [-1,1] while the \code{index} parameter must lie in the range (0,2]. The Levy skew stable probability distribution is defined by a Fourier transform, \deqn{ p(x) = {1 \over 2 \pi} \int_{-\infty}^{+\infty} dt \exp(-it x - |c t|^\alpha (1-i \beta sign(t) \tan(\pi\alpha/2))) } When \eqn{\alpha = 1}{alpha = 1} the term \eqn{\tan(\pi \alpha/2)}{tan(pi alpha/2)} is replaced by \eqn{-(2/\pi)\log|t|}{-(2/pi) log|t|}. For \eqn{\alpha = 2}{alpha = 2} the distribution reduces to a Gaussian distribution with \eqn{\sigma = \sqrt{2} scale}{sigma = sqrt(2) scale} and the skewness parameter has no effect. For \eqn{\alpha < 1}{alpha < 1} the tails of the distribution become extremely wide. The symmetric distribution corresponds to \eqn{\beta = 0}{beta = 0}. The Levy alpha-stable distributions have the property that if \eqn{N}{N} alpha-stable variates are drawn from the distribution \eqn{p(c, \alpha, \beta)}{p(c, alpha, beta)} then the sum \eqn{Y = X_1 + X_2 + \dots + X_N}{Y = X_1 + X_2 + ... + X_N} will also be distributed as an alpha-stable variate, \eqn{p(N^{1/\alpha} c, \alpha, \beta)}{p(N^{1/alpha} c, alpha, beta)}. There is no explicit solution for the form of \eqn{p(x)}{p(x)} and there are no density, probability or quantile functions supplied for this distribution. } \author{Claudio Agostinelli} \references{ Chambers, J. M., Mallows, C. L. and Stuck, B. W. (1976). A Method for Simulating Stable Random Variables. Journal of the American Statistical Association 71, 340-344. Logaeve, M. (1977). Probability Theory I. (fourth edition) Springer-Verlag, New York. } \seealso{ \link{rnorm}, \link{rcauchy}. } \examples{ hist(rstable(200, 1.5, .5)) #fairly long tails, skewed right } \keyword{distribution} circular/man/heatmap.circular.Rd0000644000176200001440000001571411312211557016350 0ustar liggesusers\name{heatmap.circular} \alias{heatmap.circular} \title{ Draw a Heat Map for circular data } \description{ A heat map is a false color image (basically \code{\link{image}(t(x))}) with a dendrogram added to the left side and to the top. Typically, reordering of the rows and columns according to some set of values (row or column means) within the restrictions imposed by the dendrogram is carried out. See also \code{\link[stats]{heatmap}}. } \usage{ heatmap.circular(x, Rowv = NULL, Colv = if (symm) "Rowv" else NULL, distfun = dist.circular, hclustfun = hclust, reorderfun = function(d, w) reorder(d, w), add.expr, symm = FALSE, revC = identical(Colv, "Rowv"), na.rm = TRUE, margins = c(5, 5), lwid = c(1, 4), lhei = c(1, 4), ColSideColors, RowSideColors, NAColors = "black", cexRow = 0.2 + 1/log10(nr), cexCol = 0.2 + 1/log10(nc), labRow = NULL, labCol = NULL, main = NULL, xlab = NULL, ylab = NULL, keep.dendro = FALSE, annotate.expr, annotate = rep(NA, 4), verbose = getOption("verbose"), ...) } \arguments{ \item{x}{numeric matrix of class \code{\link{circular}} of the values to be plotted.} \item{Rowv}{determines if and how the \emph{row} dendrogram should be computed and reordered. Either a \code{\link{dendrogram}} or a vector of values used to reorder the row dendrogram or \code{\link{NA}} to suppress any row dendrogram (and reordering) or by default, \code{\link{NULL}}, see \sQuote{Details} below.} \item{Colv}{determines if and how the \emph{column} dendrogram should be reordered. Has the same options as the \code{Rowv} argument above and \emph{additionally} when \code{x} is a square matrix, \code{Colv = "Rowv"} means that columns should be treated identically to the rows (and so if there is to be no row dendrogram there will not be a column one either).} \item{distfun}{function used to compute the distance (dissimilarity) between both rows and columns. Defaults to \code{\link{dist.circular}}.} \item{hclustfun}{function used to compute the hierarchical clustering when \code{Rowv} or \code{Colv} are not dendrograms. Defaults to \code{\link{hclust}}. Should take as argument a result of \code{distfun} and return an object to which \code{\link{as.dendrogram}} can be applied.} \item{reorderfun}{function(d,w) of dendrogram and weights for reordering the row and column dendrograms. The default uses \code{\link{reorder.dendrogram}}.} \item{add.expr}{expression that will be evaluated after the call to \code{image}. Can be used to add components to the plot.} \item{symm}{logical indicating if \code{x} should be treated \bold{symm}etrically; can only be true when \code{x} is a square matrix.} \item{revC}{logical indicating if the column order should be \code{\link{rev}}ersed for plotting, such that e.g., for the symmetric case, the symmetry axis is as usual.} \item{na.rm}{logical indicating whether \code{NA}'s should be removed.} \item{margins}{numeric vector of length 2 containing the margins (see \code{\link{par}(mar= *)}) for column and row names, respectively.} \item{lwid}{a vector of values for the widths of columns on the device. Relative widths are specified with numeric values. Absolute widths (in centimetres) are specified with the \code{\link{lcm}()} function (see \code{\link{layout}}).} \item{lhei}{a vector of values for the heights of rows on the device. Relative and absolute heights can be specified, see \code{lwid} above.} \item{ColSideColors}{(optional) character vector of length \code{ncol(x)} containing the color names for a horizontal side bar that may be used to annotate the columns of \code{x}.} \item{RowSideColors}{(optional) character vector of length \code{nrow(x)} containing the color names for a vertical side bar that may be used to annotate the rows of \code{x}.} \item{NAColors}{ the color used to plot missing values. } \item{cexRow, cexCol}{positive numbers, used as \code{cex.axis} in for the row or column axis labeling. The defaults currently only use number of rows or columns, respectively.} \item{labRow, labCol}{character vectors with row and column labels to use; these default to \code{rownames(x)} or \code{colnames(x)}, respectively.} \item{main, xlab, ylab}{main, x- and y-axis titles; defaults to none.} \item{keep.dendro}{logical indicating if the dendrogram(s) should be kept as part of the result (when \code{Rowv} and/or \code{Colv} are not NA).} \item{annotate}{annotation in the four external side of the figure. A positive value in a position means you want annotate something in that position (1=bottom, 2=left, 3=top, 4=right). For instance, \code{annotate=c(0.1, NA, NA, 1, 1)} means you want to annotate one thing on the bottom with dimension \code{0.1} and two things on right each with dimension \code{1}.} \item{annotate.expr}{must be a list of expressions with the same length as \code{annotate}. For instance for \code{annotate=c(0.1, NA, NA, 1, 1)} you must have something as \code{annotate.expr=list(expr1, NA, NA, expr2, expr2)} where \code{expr1} etc. must be a valid \code{R} expression able to produce a plot.} \item{verbose}{logical indicating if information should be printed.} \item{\dots}{additional arguments passed on to \code{\link{image}}, e.g., \code{col} specifying the colors.}} \details{ If either \code{Rowv} or \code{Colv} are dendrograms they are honored (and not reordered). Otherwise, dendrograms are computed as \code{dd <- as.dendrogram(hclustfun(distfun(X)))} where \code{X} is either \code{x} or \code{t(x)}. If either is a vector (of \sQuote{weights}) then the appropriate dendrogram is reordered according to the supplied values subject to the constraints imposed by the dendrogram, by \code{\link{reorder}(dd, Rowv)}, in the row case. If either is missing, as by default, then the ordering of the corresponding dendrogram is by the mean direction value of the rows/columns, i.e., in the case of rows, \code{Rowv <- rowMeans(x, na.rm=na.rm)}. If either is \code{\link{NULL}}, \emph{no reordering} will be done for the corresponding side. Unless \code{Rowv = NA} (or \code{Colw = NA}), the original rows and columns are reordered \emph{in any case} to match the dendrogram, e.g., the rows by \code{\link{order.dendrogram}(Rowv)} where \code{Rowv} is the (possibly \code{\link{reorder}()}ed) row dendrogram. \code{heatmap()} uses \code{\link{layout}} and draws the \code{\link{image}} in the lower right corner of a 2x2 layout. Consequentially, it can \bold{not} be used in a multi column/row layout, i.e., when \code{\link{par}(mfrow= *)} or \code{(mfcol= *)} has been called. } \value{ \code{\link{par}(mfrow= *)} or \code{(mfcol= *)} has been called. } \author{ Claudio Agostinelli using the code from \code{\link[stats]{heatmap}}. } \seealso{\code{\link{dist.circular}}, \code{\link{heatmap}}, \code{\link{image}}, \code{\link{hclust}}} %\examples{ % %} \keyword{hplot} circular/man/triangular.Rd0000644000176200001440000000203311312211557015264 0ustar liggesusers\name{triangular} \title{Triangular Density Function} \alias{dtriangular} \alias{rtriangular} \description{ Density and random generation for the Triangular circular distribution. } \usage{ dtriangular(x, rho) rtriangular(n, rho, control.circular=list()) } \arguments{ \item{x}{a vector. The object is coerced to class \code{\link{circular}}.} \item{n}{number of observations.} \item{rho}{concentration parameter of the distribution. rho must be between 0 and \eqn{4/pi^2}.} \item{control.circular}{the attribute of the resulting object.} } \value{ \code{dtriangular} gives the density and \code{rtriangular} generates random deviates. } \author{Claudio Agostinelli and Ulric Lund} \references{ Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Section 2.2.3, World Scientific Press, Singapore. } \examples{ data1 <- rtriangular(100, 0.3, control.circular=list(units="degrees")) plot(data1) ff <- function(x) dtriangular(x, rho=0.3) curve.circular(ff, shrink=1.2, join=TRUE) } \keyword{distribution} circular/man/summary.circular.Rd0000644000176200001440000000270112236420131016412 0ustar liggesusers\name{summary.circular} \title{Circular Summary Statistics} \alias{summary.circular} \description{ Computes circular summary statistics including the sample size, mean direction and mean resultant length and quartiles. } \usage{ \method{summary}{circular}(object, digits = max(3, getOption("digits") - 3), ...) } \arguments{ \item{object}{an object of class \code{\link{circular}}.} \item{digits}{digits to be used in printing.} \item{...}{parameters passed to \code{\link{summary.matrix}} if needed.} } \value{ Returns a vector with the sample size, the sample mean direction and the sample mean resultant length. } \details{ Each observation is treated as a unit vector or a point on the unit circle. The resultant vector of the observations is found, and the direction of the resultant vector is returned as well as its length divided by the sample size. } \author{Claudio Agostinelli, David Andel and Alessandro Gagliardi} \references{ Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Section 1.3, World Scientific Press, Singapore. } \seealso{ \code{\link{mean.circular}}, \code{\link{median.circular}}, \code{\link{quantile.circular}}, \code{\link{var.circular}}, \code{\link{mle.vonmises}}, \code{\link{rho.circular}}. } \examples{ # Compute summary statistics of a random sample of observations. data <- circular(runif(50, 0, pi)) summary(data) summary(data.frame(data, runif(50, 0, pi))) } \keyword{univar} circular/man/watson.williams.test.Rd0000644000176200001440000000605211574567602017251 0ustar liggesusers\name{watson.williams.test} \title{Watson-Williams Test of Homogeneity of Means} \alias{watson.williams.test} \alias{watson.williams.test.default} \alias{watson.williams.test.list} \alias{watson.williams.test.formula} \description{ Performs the Watson-Williams test for homogeneity of means between several samples of circular data. } \usage{ watson.williams.test(x, ...) \method{watson.williams.test}{default}(x, group, ...) \method{watson.williams.test}{list}(x, ...) \method{watson.williams.test}{formula}(formula, data, ...) } \arguments{ \item{x}{a vector of angles (coerced to class \code{\link{circular}}) or a list of such angles.} \item{group}{a vector or factor object giving the group for the corresponding elements of \code{x}. Ignored if \code{x} is a list} \item{formula}{a formula of the form \code{lhs ~ rhs} where \code{lhs} is a vector of angles and \code{rhs} a vector or factor giving the corresponding groups.} \item{data}{an optional data.frame containing the variables in the formula \code{\link{formula}}.} \item{\dots}{further arguments passed to or from other methods.} } \value{ A list with class \code{"htest"} containing the following components: \item{statistic}{the F statistic of the test.} \item{parameter}{the degrees of freedom for the F statistic.} \item{p.value}{the p-value for the test.} \item{estimate}{a vector of the means of each group.} \item{method}{a character string containing the name of the test.} \item{data.name}{a character string giving the name(s) of the data.} } \details{ The Watson-Williams test for the homogeneity of means between two or more groups is performed and the results are printed. The null hypothesis is that means are equal across groups. The assumptions are that: (1) the samples are drawn from populations with a von Mises distribution; (2) the parameter of concentration has the same value in all populations; (3) this parameter is sufficiently large (i.e. > 1). Assumptions 2 and 3 are checked and a warning is issued if they are not met. In the default method, \code{x} is a vector of angles and \code{group} must be a vector or factor object of the same length as \code{x} giving the group for the corresponding elements of \code{x}. If \code{x} is a list, its elements are taken as the samples to be compared. In the \code{\link{formula}} method, the angles and grouping elements are identified as the left and right hand side of the formula respectively. All angles should be of class \code{\link{circular}} and will be coerced as such if they are not. } \author{Jean-Olivier Irisson} \references{ Batschelet, E (1981). Circular Statistics in Biology. chap. 6.2, p. 99 Mardia, KV and Jupp, PE (2000). Directional statistics. p. 135 } \examples{ # Ant orientation from Duelli and Wehner (1973) # Example used in Batschelet (1981) data <- list( exp = circular(rep(c(-20, -10, 0), c(1,7,2)), units="degrees", template="geographics"), control = circular(rep(c(-10, 0, 10, 20), c(3,3,3,1)), units="degrees", template="geographics") ) watson.williams.test(data) } \keyword{htest} circular/man/as.data.frame.circular.Rd0000644000176200001440000000126412017361117017331 0ustar liggesusers\name{as.data.frame.circular} \title{as.data.frame.circular} \alias{as.data.frame.circular} \description{ This function is a method of \code{\link{as.data.frame}} for a circular object. } \usage{ \method{as.data.frame}{circular}(x, row.names = NULL, optional = FALSE, ...) } \arguments{ \item{x}{object of class \code{\link{circular}}.} \item{row.names}{\code{NULL} or a character vector giving the row names for the data frame. Missing values are not allowed.} \item{optional}{logical; if \code{TRUE} setting row names is optional.} \item{\dots}{additional arguments to be passed to or from methods.} } \author{Claudio Agostinelli} \keyword{classes} \keyword{methods} circular/man/uniform.Rd0000644000176200001440000000201511312211557014573 0ustar liggesusers\name{Circular Uniform} \title{Circular Uniform Density Function} \alias{dcircularuniform} \alias{rcircularuniform} \description{ Density and random generation for the Circular Uniform distribution on the whole circle. } \usage{ dcircularuniform(x) rcircularuniform(n, control.circular=list()) } \arguments{ \item{x}{a vector. The object is not coerced to class \code{\link{circular}}.} \item{n}{number of observations.} \item{control.circular}{the attribute of the resulting object.} } \value{ \code{dcircularuniform} gives the density and \code{rcircularuniform} generates random deviates. } \author{Claudio Agostinelli} \references{ Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Section 2.2.1, World Scientific Press, Singapore. } \examples{ data1 <- rcircularuniform(100, control.circular=list(units="degrees")) plot(data1) curve.circular(dcircularuniform, join=TRUE, xlim=c(-1.2, 1.2), ylim=c(-1.2, 1.2), main="Density of a Circular Uniform Distribution") } \keyword{distribution} circular/man/wind.Rd0000644000176200001440000000173511424622214014065 0ustar liggesusers\name{wind} \alias{wind} \docType{data} \title{ Col De La Roa wind direction } \description{ In a place named "Col de la Roa" in the Italian Alps there is a meteorological station that records via data-logger several parameters. Measures are made every 15 minutes, in this dataset we report the wind direction recorded every day from January 29, 2001 to March 31, 2001 from 3.00am to 4.00am included. Which means 5 observations every day for a total of 310 measures. } \usage{data(wind)} \format{ This data frame contains one variables (wind direction) in radians. } \source{ http://www.tesaf.unipd.it/SanVito/dati.htm } \references{ C. Agostinelli (2007) Robust estimation for circular data, Computational Statistics and Data Analysis, 51(12), 5867-5875, doi = doi:10.1016/j.csda.2006.11.002 } \examples{ data(wind) wind <- circular(wind, template='geographics') par(mfcol=c(1,2)) plot(wind) plot(density(wind, bw=40), main='') } \keyword{datasets} circular/man/aov.circular.Rd0000644000176200001440000000762714470146310015524 0ustar liggesusers\name{aov.circular} \alias{aov.circular} \alias{print.aov.circular} \title{Analysis of Variance for circular data} \description{ One Critrion Analysis of Variance for circular data } \usage{ aov.circular(x, group, kappa = NULL, method = c("F.test", "LRT"), F.mod = TRUE, control.circular=list()) \method{print}{aov.circular}(x, digits = max(3, getOption("digits") - 3), ...) } \arguments{ \item{x}{a vector of class \code{circular}.} \item{group}{a vector identifying the groups or samples.} \item{kappa}{the common value of the concentration parameter. Used when \code{method} is \code{"LRT"}. If left unspecified (by default) the maximum likelihood estimate of kappa is computed and used in the test statistic.} \item{method}{the test statistic to use; either a high-concentration F-test or a likelihood ratio test.} \item{F.mod}{logical; if \code{TRUE}, the AOV F-statistic is modified by a factor of 1+3/8k to improve its approximate F distribution. Default is \code{TRUE}.} \item{control.circular}{the coordinate system used in the output for the objects \code{mu} and \code{mu.all}. See \code{\link{circular}} for details.} \item{digits}{the number of digits to be printed.} \item{\dots}{additional arguments.} } \value{ An object of class \code{aov.circular} with the following components: \item{mu}{mean direction for each sample with class \code{circular}.} \item{mu.all}{mean direction of all samples combined with class \code{circular}.} \item{kappa}{concentration parameter for each sample.} \item{kappa.all}{concentration parameter for all samples combined.} \item{rho}{mean resultant length for each sample.} \item{rho.all}{mean resultant length for all samples combined.} \item{method}{the test statistic used.} \item{df}{degrees of freedom.} \item{statistic}{the value of the test statistic.} \item{p.value}{the p.value of the test statistic.} \item{call}{the \code{\link[base]{match.call}} result.} If the \code{method} is \code{"F.test"} then the object contains also: \item{SSE}{Sum of squares used in F-test.} \item{MSE}{Mean squares used in F-test.} } \details{ The samples are assumed to have been drawn from von Mises populations with equal concentration parameter, kappa. The null hypothesis being tested is that all populations also have the same mean direction. If \code{method} is \code{"F.test"} a high concentration F-test makes use of a decomposition of total sample variation into between groups and within groups variation, analogous to the one-way classification analysis of variance for linear data. Stephens (1972) presented an improved modification to the F-test derived from this decomposition. This is implemented when \code{F.mod} is \code{TRUE}. A likelihood ratio test is performed when \code{method} is \code{"LRT"}. This function uses the test statistic presented by Cordeiro, Paula, and Botter (1994) which has an approximate chi-squared distribution. If the common concentration parameter is known, it can be specified and used in the computation of the test statistic. Otherwise, the maximum likelihood estimate of the common concentration parameter is used. } \references{ Cordeiro, G., Paula, G. and Botter, D. (1994). Improved likelihood ratio tests for dispersion models. International Statistical Review, 62, 257-274. Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Section 5.3, World Scientific Press, Singapore. Mardia, K. and Jupp, P. (1999). Directional Statistics, Section 7.4, John Wiley and Sons, England. Stephens, M. (1972). Multi-sample tests for the von Mises distribution. Technical Report 190, Department of Statistics, Stanford University. } \author{Claudio Agostinelli and Ulric Lund} \examples{ x <- c(rvonmises(50, circular(0), 1), rvonmises(100, circular(pi/3), 10)) group <- c(rep(0, 50), rep(1, 100)) aov.circular(x, group) aov.circular(x, group, method="LRT") } \keyword{models} circular/man/A1SecondDerivative.Rd0000644000176200001440000000170712021347555016551 0ustar liggesusers\name{A1SecondDerivative} \title{Second derivative of the Ratio of First and Zeroth Order Bessel Functions.} \alias{A1SecondDerivative} \description{Evaluates the second derivative of the second derivative of the Ratio of First and Zeroth Order Bessel Functions.} \usage{ A1SecondDerivative(kappa) } \arguments{ \item{kappa}{non-negative numeric value at which to evaluate the second derivative of A1 function.} } \value{ The value of the second derivative of A1 function in the point \code{kappa}. } \details{ Formula (3.49) of Fisher (1993), pag. 52 is implemented. The function uses \code{\link{A1}}, \code{\link{A1FirstDerivative}} and \code{\link{besselI}}. } \author{Claudio Agostinelli and Alessandro Gagliardi.} \references{ N.I. Fisher (1993) Statistical Analysis of Circular Data, Cambridge University Press. } \seealso{ \code{\link{A1}}, \code{\link{A1FirstDerivative}}, \code{\link{besselI}}, \code{\link{A1inv}}. } \keyword{math} circular/man/plot.circular.Rd0000644000176200001440000001043714470146310015706 0ustar liggesusers\name{plot.circular} \title{Circular Data Plot} \alias{plot.circular} \description{ Creates a plot of circular data points on the current graphics device. Data points are either plotted as points on the unit circle, or the range of the circle is divided into a specified number of bins, and points are stacked in the bins corresponding to the number of observations in each bin. } \usage{ \method{plot}{circular}(x, pch = 16, cex = 1, stack = FALSE, axes = TRUE, start.sep=0, sep = 0.025, shrink = 1, bins = NULL, ticks = FALSE, tcl = 0.025, tcl.text = 0.125, col = NULL, tol = 0.04, uin = NULL, xlim = c(-1, 1), ylim = c(-1, 1), digits = 2, units = NULL, template = NULL, zero = NULL, rotation = NULL, main = NULL, sub=NULL, xlab = "", ylab = "", control.circle=circle.control(), ...) } \arguments{ \item{x}{a vector, matrix or data.frame. The object is coerced to class \code{\link{circular}}.} \item{pch}{point character to use. See help on \code{\link{par}}.} \item{cex}{point character size. See help on \code{\link{par}}.} \item{stack}{logical; if \code{TRUE}, points are stacked on the perimeter of the circle. Otherwise, all points are plotted on the perimeter of the circle. Default is \code{FALSE}.} \item{axes}{logical; if \code{TRUE} axes are plotted according to properties of \code{x}.} \item{start.sep}{constant used to specify the distance between the center of the point and the axis.} \item{sep}{constant used to specify the distance between stacked points, if \code{stack==TRUE} or in the case of more than one dataset. Default is 0.025; smaller values will create smaller spaces.} \item{shrink}{parameter that controls the size of the plotted circle. Default is 1. Larger values shrink the circle, while smaller values enlarge the circle.} \item{bins}{if \code{stack==TRUE}, bins is the number of arcs to partition the circle with.} \item{ticks}{logical; if \code{TRUE} ticks are plotted according to the value of \code{bins}.} \item{tcl}{length of the ticks.} \item{tcl.text}{The position of the axis labels.} \item{col}{color of the points. The values are recycled if needed.} \item{tol}{proportion of white space at the margins of plot.} \item{uin}{desired values for the units per inch parameter. If of length 1, the desired units per inch on the x axis.} \item{xlim, ylim}{the ranges to be encompassed by the x and y axes. Useful for centering the plot.} \item{digits}{number of digits used to print axis values.} \item{main, sub, xlab, ylab}{title, subtitle, x label and y label of the plot.} \item{units}{the units used in the plot.} \item{template}{the template used in the plot.} \item{zero}{the zero used in the plot.} \item{rotation}{the rotation used in the plot.} \item{control.circle}{parameters passed to \code{\link{plot.default}} in order to draw the circle. The function \code{\link{circle.control}} is used to set the parameters.} \item{\dots}{further parameters passed to \code{\link{points.default}}.} } \details{ When there are many closely distributed observations, stacking is recommended. When stacking the points, if there are many points in a particular bin, it may be necessary to shrink the plot of the circle so that all points fit. This is controlled with the parameter \code{shrink}. Generally the parameter \code{sep} does not need adjustment, however, when shrinking the plot, or for a very large number of observations, it may be helpful. Since version 0.3-9 the intervals are on the form [a,b). } \note{some codes from \code{\link{eqscplot}} in MASS is used.} \author{Claudio Agostinelli and Ulric Lund} \seealso{ \code{\link{axis.circular}}, \code{\link{ticks.circular}}, \code{\link{points.circular}}, \code{\link{lines.circular}}, \code{\link{rose.diag}}, \code{\link{windrose}} and \code{\link{curve.circular}}. } \value{ A list with information on the plot: zero, rotation and next.points. } \examples{ # Generate 100 observations from a von Mises distribution. # with mean direction 0 and concentration 3. data.vm <- rvonmises(n=100, mu=circular(0), kappa=3) # Plot data set. All points do not fit on plot. plot(data.vm, stack=TRUE, bins=150) # Shrink the plot so that all points fit. plot(data.vm, stack=TRUE, bins=150, shrink=1.5) # Recentering the figure in a different place plot(data.vm, stack=TRUE, bins=150, xlim=c(-1,1.2), ylim=c(-1,0)) } \keyword{hplot} circular/man/fisherB6.Rd0000644000176200001440000000146211312211557014571 0ustar liggesusers\name{fisherB6} \alias{fisherB6} \alias{fisherB6c} \title{B.6 Cross-bed azimuths of palaeocurrents} \usage{ data(fisherB6) data(fisherB6c) } \description{ Set of cross-bed azimuths of palaeocurrents measured in the Belford Anticline (New South Wales). } \format{ \code{fisherB6} is a list (in degrees). \code{fisherB6c} contains the same observations in a circular objects. } \source{ Fisher, N.I. & Powell C. McA. (1989) Statistical analysis of two-dimensional palaeocurrent data: Methods and examples. Aust. J. Earth Sci. 36, 91-107. } \seealso{ N.I. Fisher (1993) Statistical analysis of circular data. Cambridge University Press. Pag. 242. } \examples{ data(fisherB6c) res <- plot(fisherB6c$set1) points(fisherB6c$set2, col=2, plot.info=res) points(fisherB6c$set3, col=3, plot.info=res) } \keyword{datasets} circular/man/range.circular.Rd0000644000176200001440000000317412023611721016017 0ustar liggesusers\name{range.circular} \title{Circular Range} \alias{range.circular} \description{ Computes the circular range of a data set and performs a test of uniformity if specified. } \usage{ \method{range}{circular}(x, test=FALSE, na.rm = FALSE, finite = FALSE, control.circular=list(), ...) } \arguments{ \item{x}{a vector. The object is coerced to class \code{\link{circular}}.} \item{test}{logical flag: if TRUE then the test of uniformity is performed; otherwise the test is not performed. Default is FALSE.} \item{na.rm}{logical, indicating if \code{\link{NA}}'s should be omitted.} \item{finite}{logical, indicating if all non-finite elements should be omitted.} \item{control.circular}{the attribute of the resulting object.} \item{\ldots}{further parameter passed from/to the method.} } \value{ Returns the circular range as a \code{circular} object. If the significance test is requested the p-value of the test is returned as p.value. } \details{ The circular range is the shortest arc on the circle containing the entire set of data. The p-value is computed using the exact distribution of the circular range under the hypothesis of uniformity, details can be found in Mardia and Jupp (1999) pag. 107. } \author{Claudio Agostinelli and Ulric Lund} \references{ K.V. Mardia and P.E. Jupp (1999) Directional Statistics, Wiley. } \seealso{ \code{\link{kuiper.test}}, \code{\link{rao.spacing.test}}, \code{\link{rayleigh.test}} and \code{\link{watson.test}}. } \examples{ data <- rvonmises(n=50, mu=circular(0), kappa=2) range(data, test=TRUE) data <- circular(runif(50, 0, 2*pi)) range(data, test=TRUE) } \keyword{univar} \keyword{htest} circular/man/curve.circular.Rd0000644000176200001440000000532312017361717016057 0ustar liggesusers\name{curve.circular} \alias{curve.circular} \alias{plot.function.circular} \title{Draw Function Plots in a Circle} \description{ Draws a curve corresponding to the given function or expression (in \code{x}) over the interval \code{[from,to]} in a circle. Mainly used to plot circular density functions. } \usage{ \method{curve}{circular}(expr, from=NULL, to=NULL, n=101, add=FALSE, cex=1, axes=TRUE, ticks=FALSE, shrink=1, tcl=0.025, tcl.text=0.125, tol=0.04, uin=NULL, xlim=c(-1, 1), ylim=c(-1, 1), digits=2, modulo=c("2pi", "asis", "pi"), main=NULL, sub=NULL, xlab="", ylab="", control.circle=circle.control(), \dots) \method{plot}{function.circular}(x, from=0, to=2*pi, \dots) } \arguments{ \item{expr}{an expression written as a function of \code{x}, or alternatively the name of a function which will be plotted.} \item{x}{a \sQuote{vectorizing} numeric \R function.} \item{from,to}{the range over which the function will be plotted.} \item{n}{integer; the number of x values at which to evaluate.} \item{add}{logical; if \code{TRUE} add to already existing plot.} \item{axes}{logical: if \code{TRUE} axis are added to the plot.} \item{ticks}{logical: if \code{TRUE} tick - marks are added to the plot.} \item{shrink}{parameter that controls the size of the plotted circle. Default is 1. Larger values shrink the circle, while smaller values enlarge the circle.} \item{tcl}{length of the ticks.} \item{tcl.text}{The position of the axis labels.} \item{tol}{proportion of white space at the margins of plot.} \item{uin}{desired values for the units per inch parameter. If of length 1, the desired units per inch on the x axis.} \item{xlim, ylim}{the ranges to be encompassed by the x and y axes. Useful for centering the plot.} \item{digits}{number of digits used to print axis values.} \item{modulo}{the modulo used to process the data.} \item{main, sub, xlab, ylab, cex}{graphical parameters.} \item{control.circle}{parameters passed to \code{\link{plot.default}} in order to draw the circle. The function \code{\link{circle.control}} is used to set the parameters.} \item{\dots}{parameters, passed to \code{\link{lines.circular}}.} } \details{ For now, curve circular draws functions defined in radians, counterclockwise coordinate and zero at 0. } \value{ A list with information on the plot: zero, rotation and next.points. } \seealso{ \code{\link{lines.circular}} and \code{\link{circle.control}} } \author{Claudio Agostinelli} \examples{ ff <- function(x) sqrt(x)/20 curve.circular(ff) curve.circular(ff, to=6*pi, join=FALSE, nosort=TRUE, n=1001, modulo="asis", shrink=1.2) plot.function.circular(function(x) dvonmises(x, circular(0), 10), xlim=c(-1, 2.2)) } \keyword{hplot} circular/man/plot.edf.Rd0000644000176200001440000000402113124753205014632 0ustar liggesusers\name{plot.edf} \title{Plot Circular Empirical Distribution Function} \alias{plot.edf} \alias{lines.edf} \description{ Plots the empirical distribution function of a circular data set. } \usage{ \method{plot}{edf}(x, type = "s", xlim = c(0, 2 * pi), ylim = c(0, 1), \dots) \method{lines}{edf}(x, type = "s", \dots) } \arguments{ \item{x}{vector of circular data measured.} \item{type, xlim, ylim}{plotting parameters with useful defaults. \code{xlim} is in radians.} \item{\dots}{optional graphical parameters. See help section on \code{\link{par}}.} } \note{ Creates a plot or adds a plot (\code{lines.edf}) of the empirical distribution function of the circular data vector. } \details{ The vector of data is taken modulo 2*pi, and then the linear ranks are used to generate an empirical distribution function. } \author{Claudio Agostinelli and Ulric Lund} \seealso{ \code{\link{plot.ecdf}}, \code{\link{curve.circular}} and \code{\link{par}}. } \examples{ # Compare the edf's of two simulated sets of data. data1 <- rvonmises(n=10, mu=circular(0), kappa=3) data2 <- rvonmises(n=10, mu=circular(0), kappa=1) plot.edf(data1, xlab="Data", ylab="EDF", main="Plots of Two EDF's") lines.edf(data2, lty=2, col=2) #You can use standard ecdf and plot.ecdf functions ff <- function(x, data) { x <- x%%(2*pi) data <- data%%(2*pi) temp <- ecdf(data) temp(x) } plot(function(x) ff(x, data=data1), from=0, to=2*pi-3*.Machine$double.eps) #Or curve.circular plot.function.circular(function(x) ff(x, data=data1), from=0, to=(2*pi-3*.Machine$double.eps), join=FALSE, nosort=TRUE, xlim=c(-2,2), ylim=c(-2,2), modulo="asis", main="Empirical Distribution Function", n=2001, tcl.text=0.25) res <- plot.function.circular(function(x) ff(x, data=data2), from=0, to=(2*pi-3*.Machine$double.eps), join=FALSE, nosort=TRUE, modulo="asis", add=TRUE, col=2, n=2001) res1 <- points(data1, plot.info=res) points(data2, plot.info=res1, col=2, sep=0.05) legend(-1.9, 1.9, legend=c("data1", "data2"), col=c(1,2), lty=c(1,1)) } \keyword{hplot} circular/man/pp.plot.Rd0000644000176200001440000000304411312211557014513 0ustar liggesusers\name{pp.plot} \title{von Mises Probability-Probability Plot} \alias{pp.plot} \description{ Plots the empirical distribution of a data set against the best fitting von Mises distribution function. } \usage{ pp.plot(x, ref.line = TRUE, tol=1e-20, xlab = "von Mises Distribution", ylab = "Empirical Distribution", control.circular = list(), ...) } \arguments{ \item{x}{a vector. The object is coerced to class \code{\link{circular}}.} \item{ref.line}{logical, if TRUE a 45 degree reference line is added to the plot. Default is TRUE.} \item{tol}{parameter passed to \code{\link{pvonmises}}.} \item{xlab, ylab}{labels of the axis.} \item{control.circular}{the attribute of the resulting object.} \item{...}{parameters passed to the \code{\link{plot.default}} function.} } \value{ a list with the estimated mean and concentration parameter for a von Mises distribution. } \details{ The maximum likelihood estimates of the parameters of the von Mises distribution are computed from the given data set. The empirical distribution function is plotted against a von Mises distribution function with parameters given by the MLEs computed. } \author{Claudio Agostinelli and Ulric Lund} \references{ Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Section 10.2, World Scientific Press, Singapore. } \seealso{ \code{\link{mle.vonmises}} } \examples{ x <- rvonmises(n=25, mu=circular(0), kappa=3) pp.plot(x) x <- c(rvonmises(n=20, mu=circular(0), kappa=7), rvonmises(n=20, mu=circular(pi), kappa=7)) pp.plot(x) } \keyword{hplot} circular/man/conversion.circular.Rd0000644000176200001440000000351414470146310017113 0ustar liggesusers\name{conversion.circular} \alias{conversion.circular} \title{Unit of Measure Conversion for Circular Data and other conversions} \description{ Conversion for Circular Data from one coordinate/units system to another one. For back compatibility, without arguments the function converts data from degrees to radians. } \usage{ conversion.circular(x, units = c("radians", "degrees", "hours"), type = NULL, template = NULL, modulo = NULL, zero = NULL, rotation = NULL) } \arguments{ \item{x}{an object of class \code{\link{circular}}.} \item{units}{unit of the transformed data.} \item{type}{type of the transformed data. If \code{NULL} no action is performed.} \item{template}{template of the transformed data. If \code{NULL} no action is performed.} \item{modulo}{modulo of the transformed data. If \code{NULL} no action is performed.} \item{zero}{zero of the transformed data. If \code{NULL} no action is performed.} \item{rotation}{rotation of the transformed data. If \code{NULL} no action is performed.} } \value{ an object of class \code{\link{circular}} with the specified unit of measure, modulo, zero and rotation. } \author{Claudio Agostinelli} \seealso{ \code{\link{deg}} and \code{\link{rad}}. If you want to set the properties of an object instead to transform it, you can use \code{\link{circular}} or \code{\link{circularp<-}}. } \examples{ x <- rvonmises(n=10, mu=circular(0), kappa=9, control.circular=list(units="degrees")) par(mfcol=c(2, 2)) plot(x) y <- conversion.circular(x) # only the unit is changed (to radians) and ####### the data converted. plot(y) z <- conversion.circular(x, units="degrees", zero=pi) # only the zero is changed and ####### the data converted. plot(z) w <- conversion.circular(x, zero=pi, rotation="clock") # zero and rotation is ####### changed and the data converted. plot(w) } \keyword{misc} circular/man/wrappednormal.Rd0000644000176200001440000000573311430772026016005 0ustar liggesusers\name{wrappedNormal} \title{Wrapped Normal Density Function} \alias{dwrappednormal} \alias{rwrappednormal} \alias{pwrappednormal} \alias{qwrappednormal} \description{ Density, and random generation for the wrapped normal circular distribution. } \usage{ rwrappednormal(n, mu = circular(0), rho = NULL, sd = 1, control.circular = list()) dwrappednormal(x, mu = circular(0), rho = NULL, sd = 1, K = NULL, min.k = 10) pwrappednormal(q, mu = circular(0), rho = NULL, sd = 1, from = NULL, K = NULL, min.k = 10, \dots) qwrappednormal(p, mu = circular(0), rho = NULL, sd = 1, from = NULL, K = NULL, min.k = 10, tol = .Machine$double.eps^(0.6), control.circular = list(), \dots) } \arguments{ \item{x, q}{vector of quantiles. The object is coerced to class \code{\link{circular}}.} \item{p}{vector of probabilities.} \item{n}{number of observations.} \item{mu}{mean direction of the distribution as a \code{circular} object.} \item{rho}{concentration parameter of the distribution. \code{rho} must be in the interval from 0 to 1.} \item{sd}{standard deviation of the (unwrapped) normal distribution.} \item{from}{if \code{NULL} is set to \eqn{mu-pi}. This is the value from which the pwrappednormal and qwrappednormal are evaluated. It should be a \code{circular} object.} \item{K}{number of terms to be used in approximating the density.} \item{min.k}{minimum number of terms used in approximating the density.} \item{tol}{passed to \code{\link{uniroot}}.} \item{control.circular}{the attribute of the resulting object.} \item{\dots}{parameters passed to \code{\link{integrate}}.} } \value{ \code{dwrappednormal} gives the density and \code{rwrappednormal} generates random deviates, \code{pwrappednormal} gives the distribution function, and \code{qwrappednormal} provides quantiles. } \author{Claudio Agostinelli and Ulric Lund} \references{ Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Section 2.2.7, World Scientific Press, Singapore. } \examples{ data1 <- rwrappednormal(100, mu=circular(0), rho=0.7, control.circular=list(units="degrees")) plot(data1) ff <- function(x) dwrappednormal(x, mu=circular(pi), rho=0.7) curve.circular(ff, join=TRUE, xlim=c(-1.5, 1), main="Density of a Wrapped Normal Distribution \n mu=pi, rho=0.7") ff <- function(x) pwrappednormal(x, mu=circular(pi), rho=0.7) curve.circular(ff, join=FALSE, xlim=c(-2, 2), ylim=c(-2, 2), to=(2*pi-3*.Machine$double.eps), modulo="asis", nosort=TRUE, main="Probability of a Wrapped Normal Distribution \n mu=pi, rho=0.7, from=0") ff <- function(x) pwrappednormal(x, mu=circular(pi), rho=0.7, from=circular(pi)) curve.circular(ff, join=FALSE, xlim=c(-2, 2), ylim=c(-2, 2), from=-pi, to=(pi-3*.Machine$double.eps), modulo="asis", nosort=TRUE, main="Probability of a Wrapped Normal Distribution \n mu=pi, rho=0.7, from=pi") plot(qwrappednormal, from=0, to=1) plot(function(x) qwrappednormal(p=x, mu=circular(pi)), from=0, to=1) } \keyword{distribution} circular/man/mle.wrappedcauchy.Rd0000644000176200001440000000363611611000126016527 0ustar liggesusers\name{mle.wrappedcauchy} \title{Wrapped Cauchy Maximum Likelihood Estimates} \alias{mle.wrappedcauchy} \alias{print.mle.wrappedcauchy} \description{ Computes the maximum likelihood estimates for the parameters of a Wrapped Cauchy distribution: mean and concentration parameter. } \usage{ mle.wrappedcauchy(x, mu = NULL, rho = NULL, tol = 1e-15, max.iter = 100, control.circular = list()) \method{print}{mle.wrappedcauchy}(x, digits = max(3, getOption("digits") - 3), \dots) } \arguments{ \item{x}{a vector. The object is coerced to class \code{\link{circular}}.} \item{mu}{if \code{NULL} the maximum likelihood estimate of the mean direction is calculated otherwise it is coerced to an object of class \code{circular}.} \item{rho}{if \code{NULL} the maximum likelihood estimate of the concentration parameter is calculated.} \item{tol}{precision of the estimation.} \item{max.iter}{maximum number of iterations.} \item{control.circular}{the attribute of the resulting objects (\code{mu})} \item{digits}{integer indicating the precision to be used.} \item{\dots}{further arguments passed to or from other methods.} } \value{ Returns a list with the following components: \item{call}{the \code{\link[base]{match.call}} result.} \item{mu}{the estimate of the mean direction or the value supplied as an object of class \code{circular}.} \item{rho}{the estimate of the concentration parameter or the value supplied} \item{convergence}{TRUE if convergence is achieved.} } \author{Claudio Agostinelli and Ulric Lund} \references{ Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Section 4.2.1, World Scientific Press, Singapore. } \seealso{ \code{\link{mean.circular}} } \examples{ x <- rwrappedcauchy(n=50, mu=circular(0), rho=0.5) mle.wrappedcauchy(x) # estimation of mu and rho mle.wrappedcauchy(x, mu=circular(0)) # estimation of rho only } \keyword{htest} circular/man/fisherB5.Rd0000644000176200001440000000154611312211557014573 0ustar liggesusers\name{fisherB5} \alias{fisherB5} \alias{fisherB5c} \title{B.5 Measurements of long-axis orientation of 164 feldspar laths in basalt} \usage{ data(fisherB5) data(fisherB5c) } \description{ Measurements of long-axis orientation of 164 feldspar laths in basalt } \format{ \code{fisherB5} is a vector of 164 observations (in degrees). \code{fisherB5c} contains the same observations in a circular objects. } \source{ Smith, N.M. (1988) Reconstruction of the Tertiary drainage systems of the Inverell region. Unpublished B.Sc. (Hons.) thesis, Department of Geography, University of Sydney, Australia. This dataset (set 24-6-5co.prn) was kindly supplied by Ms Nicola Smith to Prof. N.I. Fisher. } \seealso{ N.I. Fisher (1993) Statistical analysis of circular data. Cambridge University Press. Pag. 242. } \examples{ data(fisherB5c) plot(fisherB5c) } \keyword{datasets} circular/man/swallows.Rd0000644000176200001440000000236011402364021014765 0ustar liggesusers\name{swallows} \alias{swallows} \docType{data} \title{ Orientation of juvenile barn swallows } \description{ The _swallows_ dataset has 114 rows and 2 columns. The observations are the headings of juvenile barn swallows (_Hirundo rustica_) tested in orientation cages (Emlen funnels) during autumn migration under simulated overcast conditions. } \usage{data(swallows)} \format{ A data frame with 114 observations on the following 2 variables. \describe{ \item{\code{treatment}}{a factor with levels \code{control} (control group: local magnetic field) and \code{shifted} (shifted magnetic field, magnetic North = geographical West)} \item{\code{heading}}{a numeric vector: modal heading of each bird} } } \source{ Giunchi, D., and Baldaccini N. E. (2004) Orientation of juvenile barn swallows (Hirundo rustica) tested in Emlen funnels during autumn migration. Behav. Ecol. Sociobiol. (56):124-131. } \examples{ data(swallows) swallows <- split(swallows$heading, swallows$treatment) swallows <- lapply(swallows, function(x) circular(x, units='degrees', template='geographics')) plot(swallows[[1]]) points(swallows[[2]], col=2) legend('topright', legend=c('control', 'shifted'), pch=c(19,19), col=c(1,2)) } \keyword{datasets} circular/man/A1.Rd0000644000176200001440000000122711611533450013362 0ustar liggesusers\name{A1} \title{Ratio of First and Zeroth Order Bessel Functions} \alias{A1} \description{Evaluates the first and zeroth order Bessel functions of the first kind at a specified non-negative real number, and returns the ratio.} \usage{ A1(kappa) } \arguments{ \item{kappa}{non-negative numeric value at which to evaluate the Bessel functions.} } \value{ If I1(kappa) is the first order Bessel function and I0(kappa) is the zeroth order Bessel function, then A1(kappa) returns I1(kappa)/I0(kappa). } \details{ The function uses \code{\link{besselI}}. } \author{Claudio Agostinelli} \seealso{ \code{\link{besselI}}, \code{\link{A1inv}}. } \keyword{math} circular/man/fisherB12.Rd0000644000176200001440000000141411402433006014636 0ustar liggesusers\name{fisherB12} \alias{fisherB12} \alias{fisherB12c} \title{B.12: Vanishing directions of homing pigeons} \usage{ data(fisherB12) data(fisherB12c) } \description{ Vanishing directions of 15 homing pigeons, released just over 16 kilometres Northwest of their loft. } \format{ \code{fisherB12} a vector of 15 observations (in degrees). \code{fisherB12c} contains the same observations in a circular objects.} \source{ Schmidt-Koenig (1963) On the role of the loft, the distance and site of release in pigeon homing (the "cross-loft experiment"). Biol. Bull. (125)154-164. } \references{ N.I. Fisher (1993) Statistical analysis of circular data. Cambridge University Press. Pag. 245. } \examples{ data(fisherB12c) plot(fisherB12c, stack=TRUE, shrink=1.5) } \keyword{datasets} circular/man/wallraff.test.Rd0000644000176200001440000001153211547527475015717 0ustar liggesusers\name{wallraff.test} \title{Wallraff Test of Angular Distances} \alias{wallraff.test} \alias{wallraff.test.default} \alias{wallraff.test.list} \alias{wallraff.test.formula} \description{ Performs the Wallraff test of angular distances or angular dispersion around the mean. } \usage{ wallraff.test(x, ...) \method{wallraff.test}{default}(x, group, ref=NULL, ...) \method{wallraff.test}{list}(x, ref=NULL, ...) \method{wallraff.test}{formula}(formula, data, ref=NULL, ...) } \arguments{ \item{x}{a vector of angles (coerced to class \code{\link{circular}}) or a list of such angles. When \code{x} is a list, its elements are taken as the samples to be compared.} \item{group}{a vector or factor object giving the group for the corresponding elements of \code{x}. Ignored if \code{x} is a list} \item{formula}{a formula of the form \code{lhs ~ rhs} where \code{lhs} is a vector of angles and \code{rhs} a vector or factor giving the corresponding groups.} \item{data}{an optional data.frame containing the variables in the formula \code{\link{formula}}.} \item{ref}{a vector of angles used as reference to compute the angular distances from, in each group. It should contain as many elements as there are groups, \emph{in the same order}. If \code{x} is a list, the order is the order of the elements of the list. In the default or formula interfaces, if the grouping vector is a factor, the order is the order of its levels; if the grouping vector is not a factor, it is coerced as such but with levels in the order of their appearance in the original vector. In this case a warning is issued to make sure the order of \code{ref} is correct. If \code{ref} has less elements than the number of groups (typically one: a common reference for all groups), it is recycled to match the number of groups. If \code{ref} is \code{NULL} (the default), the mean angle of each group will be used as reference. In this situation, the Wallraff test becomes a comparison of angular dispersion around the mean.} \item{\dots}{further arguments passed to or from other methods.} } \details{ The Wallraff test of angular distances between two or more groups is performed and the results are printed. The null hypothesis is that distances are equal across groups. The test proceeds by computing the angular distances from a reference angle, in each group. The angular distance between two angles is the circular range and is computed with \code{\link{range.circular}}. Then the distances are compared with a usual rank sum test (Kruskal-Wallis, \code{\link{kruskal.test}}). When there are only two groups, the Wilcoxon-Mann-Whitney test could be used but \code{\link{wilcox.test}} without continuity correction for the p-value is equivalent to \code{\link{kruskal.test}} so only \code{\link{kruskal.test}} is used here. The Wallraff test is most frequently used to compare angular dispersion around the mean, between samples. In this case, the reference angle is the mean angle of each sample. This is the default here, when no reference angles are provided. All angles should be of class \code{\link{circular}} and will be coerced as such with the default parameters if they are not. An exception are the reference angles in \code{ref}. For ease of use, those can be only numeric and are then considered to be in the same angular reference as \code{x}. } \value{ A list with class \code{"htest"} containing the following components: \item{statistic}{the chi-squared statistic from \code{\link{kruskal.test}}.} \item{parameter}{the degrees of freedom for the chi-squared statistic.} \item{p.value}{the p-value for the test.} \item{method}{a character string containing the name of the test.} \item{data.name}{a character string giving the name(s) of the data.} } \author{Jean-Olivier Irisson} \references{ Batschelet, E (1981). Circular Statistics in Biology. chap. 6.10, p. 124 Zar, J H (2010). Biostatistical analysis. sec. 27.7-8, p. 643 } \seealso{ \code{\link{kruskal.test}} for the Kruskal-Wallis rank sum test used on the angular distances. \code{\link{wilcox.test}} for the two samples alternative to the Kruskal-Wallis test. } \examples{ # Homing of pigeons # Example used in Batschelet (1981) data <- list( control = circular(c(70, 80, 80, 85, 85, 90, 95, 95), units="degrees", template="geographics"), experimental = circular(c(5, 5, 15, 55, 55, 65, 105, 120, 340), units="degrees", template="geographics") ) # compare the angular dispersion between the two groups wallraff.test(data) # compare the homing performance # home azimuth is 40 degrees for both groups wallraff.test(data, ref = circular(c(40, 40), units="degrees", template="geographics") ) # we could have more simply used wallraff.test(data, ref=40) # because ref is automatically repeated and considered # in the same circular reference as the data } \keyword{htest} circular/man/mixedvonmises.Rd0000644000176200001440000000337614470146310016023 0ustar liggesusers\name{mixedvonmises} \title{Mixture of von Mises Distributions} \alias{dmixedvonmises} \alias{rmixedvonmises} \alias{pmixedvonmises} \description{ Density and random generation for the mixed von Mises circular distribution. } \usage{ dmixedvonmises(x, mu1, mu2, kappa1, kappa2, prop) rmixedvonmises(n, mu1, mu2, kappa1, kappa2, prop, control.circular = list()) pmixedvonmises(q, mu1, mu2, kappa1, kappa2, prop, from=NULL, tol = 1e-020) } \arguments{ \item{x, q}{a vector. The object is coerced to class \code{\link{circular}}.} \item{n}{number of observations.} \item{mu1}{mean direction of one of the two von Mises distributions as a \code{circular} object.} \item{mu2}{mean direction of the other von Mises distribution as a \code{circular} object.} \item{kappa1}{concentration parameter of one of the two von Mises distributions.} \item{kappa2}{concentration parameter of the other von Mises distribution.} \item{prop}{mixing proportion.} \item{from}{if \code{NULL} is set equal to \eqn{0} (Notice the difference from the corresponding vonmises distribution). This is the value from which the pmixedvonmises is evaluated. It should be a \code{circular} object.} \item{tol}{the precision in evaluating the distribution function or the quantile.} \item{control.circular}{the attribute of the resulting object.} } \value{ \code{dmixedvonmises} gives the density, \code{pmixedvonmises} gives the distribution function and \code{rmixedvonmises} generates random deviates. } \author{Claudio Agostinelli and Ulric Lund} \seealso{ \code{\link{dvonmises}} \code{\link{pvonmises}} and \code{\link{rvonmises}} } \examples{ x <- rmixedvonmises(n=100, mu1=circular(0), mu2=circular(pi), kappa1=15, kappa2=15, prop=0.5) plot(x) } \keyword{distribution} circular/man/cardioid.Rd0000644000176200001440000000240211312211557014672 0ustar liggesusers\name{Cardioid} \title{Cardioid Density Function} \alias{dcardioid} \alias{rcardioid} \description{ Density and random generation for the Cardioid circular distribution. } \usage{ dcardioid(x, mu = circular(0), rho = 0) rcardioid(n, mu = circular(0), rho = 0, control.circular=list()) } \arguments{ \item{x}{a vector. The object is coerced to class \code{\link{circular}}.} \item{n}{number of observations.} \item{mu}{mean direction of the distribution. The object is coerced to class \code{\link{circular}}.} \item{rho}{concentration parameter of the distribution. Absolute value of \code{rho} must be less than 0.5.} \item{control.circular}{the coordinate system used in the output of \code{rcardioid}. See \code{\link{circular}} for details.} } \value{ \code{dcardioid} gives the density and \code{rcardioid} generates random deviates. } \author{Claudio Agostinelli and Ulric Lund} \references{ Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Section 2.2.2, World Scientific Press, Singapore. } \examples{ set.seed(1234) resrad <- rcardioid(n=10) set.seed(1234) resdeg <- rcardioid(n=10, control.circular=list(units="radians", zero=pi)) max(abs(resrad - conversion.circular(resdeg, zero=0))) } \keyword{distribution} circular/man/trigonometric.moment.Rd0000644000176200001440000000250111312211557017277 0ustar liggesusers\name{trigonometric.moment} \title{Trigonometric Moments} \alias{trigonometric.moment} \description{ Computes the specified order trigonometric moment for a set of directional data points. } \usage{ trigonometric.moment(x, p = 1, center = FALSE, control.circular = list()) } \arguments{ \item{x}{a vector of class \code{circular}.} \item{p}{order of trigonometric moment to be computed. Default is for a first order trigonometric moment.} \item{center}{logical, whether to compute centered moments or not. Default is to compute an uncentered moment.} \item{control.circular}{the attribute of the resulting object \code{mu}.} } \value{ Returns a list with variables mu, rho, cos, sin, p, n, call, respectively the pth trigonometric moment's direction, resultant length, real and imaginary components, the order, the number of observations and the call. } \author{Claudio Agostinelli and Ulric Lund} \references{ Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Section 1.3, World Scientific Press, Singapore. } \seealso{ \code{\link{var.circular}}, \code{\link{mean.circular}}, \code{\link{summary.circular}}, \code{\link{mle.vonmises}} and \code{\link{rho.circular}} } \examples{ x <- rvonmises(100, circular(0), 5) trigonometric.moment(x, control.circular=list(units="degrees")) } \keyword{math} circular/man/rwrappedstable.Rd0000644000176200001440000000252311312211557016137 0ustar liggesusers\name{rwrappedstable} \title{Random Generation from the Wrapped Stable Distribution} \alias{rwrappedstable} \description{ Generates pseudo-random numbers from a wrapped stable distribution. } \usage{ rwrappedstable(n, scale=1, index, skewness, control.circular=list()) } \arguments{ \item{n}{number of random numbers to generate.} \item{scale}{the scale of the distribution.} \item{index}{number from the interval (0, 2]. An index of 2 corresponds to the normal, 1 to the Cauchy. Smaller values mean longer tails.} \item{skewness}{number giving the modified skewness. Negative values correspond to skewness to the left (the median is smaller than the mean, if it exists), and positive values correspond to skewness to the right (the median is larger than the mean). The absolute value of skewness should not exceed 1.} \item{control.circular}{the attribute of the resulting object.} } \value{ Returns a vector of n independent random numbers generated from a wrapped stable distribution. } \details{ n random numbers are generated from a stable distribution with with parameters index, skewness and scale. The function returns these values modulo 2*pi. } \author{Claudio Agostinelli} \references{ Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Section 2.2.8, World Scientific Press, Singapore. } \keyword{distribution} circular/man/axialvonmises.Rd0000644000176200001440000000151211312211557015777 0ustar liggesusers\name{axialvonMises} \title{Axial von Mises Density Function} \alias{daxialvonmises} \description{ Density for the axial von Mises circular distribution. } \usage{ daxialvonmises(x, mu, kappa, l = 2) } \arguments{ \item{x}{a vector. The object is coerced to class \code{\link{circular}}.} \item{mu}{mean direction of the distribution. The object is coerced to class \code{\link{circular}}} \item{kappa}{non-negative numeric value for the concentration parameter of the distribution.} \item{l}{a positive number. \code{l=2} provide the axial distribution in the range [0, pi].} } \value{ \code{daxialvonmises} gives the density. } \author{Claudio Agostinelli} \references{ Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Section 2.2.4, World Scientific Press, Singapore. } \keyword{distribution} circular/man/fisherB4.Rd0000644000176200001440000000132111312211557014561 0ustar liggesusers\name{fisherB4} \alias{fisherB4} \alias{fisherB4c} \title{B.4 Directional preferences of starhead topminnows} \usage{ data(fisherB4) data(fisherB4c) } \description{ Sun compass orientations of 50 starhead topminnows, measured under heavily overcast conditions. } \format{ \code{fisherB4} is a vector of 50 observations (in degrees). \code{fisherB4c} contains the same observations in a circular objects. } \source{ Goodyear (1970) Terrestrial and aquatic orientation in the Starhead Topminnow, Fundulus notti. Science 168, 603-5. Figure 1D. } \seealso{ N.I. Fisher (1993) Statistical analysis of circular data. Cambridge University Press. Pag. 241. } \examples{ data(fisherB3c) plot(fisherB3c) } \keyword{datasets} circular/man/watson.wheeler.test.Rd0000644000176200001440000000563112236441240017046 0ustar liggesusers\name{watson.wheeler.test} \title{Watson-Williams Test of Homogeneity of Means} \alias{watson.wheeler.test} \alias{watson.wheeler.test.default} \alias{watson.wheeler.test.list} \alias{watson.wheeler.test.formula} \description{ Performs the Watson-Wheeler test for homogeneity on two or more samples of circular data. } \usage{ watson.wheeler.test(x, ...) \method{watson.wheeler.test}{default}(x, group, ...) \method{watson.wheeler.test}{list}(x, ...) \method{watson.wheeler.test}{formula}(formula, data, ...) } \arguments{ \item{x}{a vector of angles (coerced to class \code{\link{circular}}) or a list of such angles.} \item{group}{a vector or factor object giving the groups for the corresponding elements of \code{x}. Ignored if \code{x} is a list} \item{formula}{a formula of the form \code{lhs ~ rhs} where \code{lhs} is a vector of angles and \code{rhs} a vector or factor giving the corresponding groups.} \item{data}{an optional data.frame containing the variables in the formula \code{\link{formula}}.} \item{\dots}{further arguments passed to or from other methods.} } \value{ A list with class \code{"htest"} containing the following components: \item{statistic}{W, the statistic of the test, which is approximately distributed as a chi-squared.} \item{parameter}{the degrees of freedom for the chi-squared approximation of the statistic.} \item{p.value}{the p-value for the test.} \item{method}{a character string containing the name of the test.} \item{data.name}{a character string giving the name(s) of the data.} } \details{ The Watson-Wheeler (or Mardia-Watson-Wheeler, or uniform score) test is a non-parametric test to compare two or several samples. The difference between the samples can be in either the mean or the variance. The \emph{p}-value is estimated by assuming that the test statistic follows a chi-squared distribution. For this approximation to be valid, all groups must have at least 10 elements. In the default method, \code{x} is a vector of angles and \code{group} must be a vector or factor object of the same length as \code{x} giving the group for the corresponding elements of \code{x}. If \code{x} is a list, its elements are taken as the samples to be compared. In the \code{\link{formula}} method, the angles and grouping elements are identified as the left and right hand side of the formula respectively. All angles should be of class \code{\link{circular}} and will be coerced as such if they are not. } \author{Jean-Olivier Irisson} \references{ Batschelet, E (1981). Circular Statistics in Biology. chap 6.3, p. 104 Zar, J H (1999). Biostatistical analysis. section 27.5, p. 640 } \examples{ # Example used in Zar (1999) x1 <- circular(c(35, 45, 50, 55, 60, 70, 85, 95, 105, 120), units="degrees", template="geographics") x2 <- circular(c(75, 80, 90, 100, 110, 130, 135, 140, 150, 160, 165), units="degrees", template="geographics") watson.wheeler.test(list(x1,x2)) } \keyword{htest} circular/man/vonmises.Rd0000644000176200001440000000507114470146310014766 0ustar liggesusers\name{vonMises} \title{von Mises Density Function} \alias{vonMises} \alias{dvonmises} \alias{rvonmises} \alias{pvonmises} \alias{qvonmises} \description{ Density, distribution function, random generation and quantiles for the von Mises circular distribution. } \usage{ rvonmises(n, mu, kappa, control.circular=list()) dvonmises(x, mu, kappa, log) pvonmises(q, mu, kappa, from=NULL, tol = 1e-020) qvonmises(p, mu = circular(0), kappa=NULL, from=NULL, tol = .Machine$double.eps^(0.6), control.circular = list(), \dots) } \arguments{ \item{x, q, p}{a vector. The \code{x} and \code{q} objects are coerced to class \code{\link{circular}}.} \item{n}{number of observations.} \item{mu}{mean direction of the distribution. The object is coerced to class \code{\link{circular}}.} \item{kappa}{non-negative numeric value for the concentration parameter of the distribution.} \item{log}{logical; if TRUE, probabilities p are given as log(p).} \item{from}{if \code{NULL} is set to \eqn{mu-pi}. This is the value from which the pvonmises and qvonmises are evaluated. It should be a \code{circular} object.} \item{tol}{the precision in evaluating the distribution function or the quantile.} \item{control.circular}{the attribute of the resulting object.} \item{\dots}{parameters passed to \code{\link{integrate}}.} } \value{ \code{dvonmises} gives the density, \code{pvonmises} gives the distribution function, \code{rvonmises} generates random deviates and \code{qvonmises} provides quantiles. Since version 0.3-5 the random deviates are generated using a C code. } \author{Claudio Agostinelli, Ulric Lund and Harry Southworth} \references{ Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Section 2.2.4, World Scientific Press, Singapore. } \examples{ data1 <- rvonmises(100, circular(0), 10, control.circular=list(units="degrees")) plot(data1) ff <- function(x) dvonmises(x, mu=circular(pi), kappa=10) curve.circular(ff, join=TRUE, xlim=c(-2.3, 1), main="Density of a VonMises Distribution \n mu=pi, kappa=10") ff <- function(x) pvonmises(x, mu=circular(pi), kappa=10) curve.circular(ff, join=FALSE, xlim=c(-2, 2), ylim=c(-2, 1), to=(2*pi-3*.Machine$double.eps), modulo="asis", nosort=TRUE, main="Probability of a VonMises Distribution \n mu=pi, kappa=10") plot(function(x) qvonmises(x, mu=circular(0), kappa=5), from=0, to=1) ##curve do not work! plot(function(x) qvonmises(x, mu=circular(pi), kappa=5), from=0, to=1) plot(function(x) qvonmises(x, mu=circular(pi), kappa=5, from=circular(pi/2)), from=0, to=1) } \keyword{distribution} circular/man/angular.deviation.Rd0000644000176200001440000000223714470146310016536 0ustar liggesusers\name{angular.deviation} \title{A measure of deviation for Circular Data} \alias{angular.deviation} \description{ Returns the square root of twice one minus the mean resultant length divided by the sample size of a vector of circular data. } \usage{ angular.deviation(x, na.rm = FALSE) } \arguments{ \item{x}{a vector. The object is coerced to class \code{\link{circular}}.} \item{na.rm}{logical, indicating if \code{\link{NA}}'s should be omitted.} } \value{ Returns the square root of twice one minus the mean resultant length divided by the sample size. } \author{Claudio Agostinelli} \references{ Batschelet, E. (1981) Circular Statistics in Biology. Academic Press, London. Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Section 1.3, World Scientific Press, Singapore. Zar, J.H. (2010) Biostatistical Analysis. Fifth edition. Pearson Educational International.} \seealso{ \code{\link{sd.circular}}, \code{\link{angular.variance}}, \code{\link{mean.circular}}, \code{\link{rho.circular}} and \code{\link{summary.circular}}. } \examples{ x <- rvonmises(n=100, mu=circular(0), kappa=1) angular.deviation(x) } \keyword{univar} circular/man/unique.circular.Rd0000644000176200001440000000137211312211557016232 0ustar liggesusers\name{unique.circular} \alias{unique.circular} \title{Extract Unique Elements from a circular vector} \description{ \code{unique.circular} returns a circular vector but with duplicate elements removed. } \usage{ \method{unique}{circular}(x, \dots) } \arguments{ \item{x}{a vector or a data frame or an array or \code{NULL}.} \item{\dots}{parameters passed to \code{\link{unique.default}}} } \details{ This is a method for \code{circular} object. See the documentation of \code{\link{unique}}. } \value{ An object of the same type of \code{x}, but if an element is equal to one with a smaller index, it is removed. } \seealso{ \code{\link{unique}} } \examples{ x <- rvonmises(10, circular(0), 10) unique(x) } \keyword{manip} \keyword{logic} circular/man/mean.circular.Rd0000644000176200001440000000300311312211557015635 0ustar liggesusers\name{mean.circular} \title{Mean Direction} \alias{mean.circular} \description{ Returns the mean direction of a vector of circular data. } \usage{ \method{mean}{circular}(x, na.rm=FALSE, control.circular=list(), \dots) } \arguments{ \item{x}{a vector. The object is coerced to class \code{\link{circular}}.} \item{na.rm}{logical, indicating if \code{\link{NA}}'s should be omitted.} \item{control.circular}{the attribute of the resulting object.} \item{\dots}{further arguments passed to or from other methods.} } \value{ Returns the mean direction of the data as an object of class \code{circular} with the attribute given by \code{control.circular} or from \code{x} if missed in \code{control.circular}. } \details{ Each observation is treated as a unit vector, or point on the unit circle. The resultant vector of the observations is found, and the direction of the resultant vector is returned. An \code{\link{NA}} is returned if the resultant length (see \code{\link{rho.circular}}) is less than \code{\link{.Machine}} } \author{Claudio Agostinelli and Ulric Lund} \references{ Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Section 1.3, World Scientific Press, Singapore. } \seealso{ \code{\link{var.circular}}, \code{\link{summary.circular}}, \code{\link{mle.vonmises}}, \code{\link{rho.circular}} and \code{\link{.Machine}}. } \examples{ # Compute the mean direction of a random sample of observations. x <- circular(runif(50, circular(0), pi)) mean(x) } \keyword{univar} circular/man/pigeons.Rd0000644000176200001440000000212511424622052014562 0ustar liggesusers\name{pigeons} \docType{data} \alias{pigeons} \title{Initial orientation of displaced homing pigeons} \description{This data set has 108 rows and 2 columns. The observations are the vanishing bearings of homing pigeons displaced and released at two unfamiliar locations. The data are pooled with respect to the home direction (home direction set in 360 grades). } \usage{data(pigeons)} \format{This data frame contains the following columns: \describe{ \item{\code{treatment}}{, a factor with levels: \emph{c}, control pigeon (unmanipulated); \emph{v1}, pigeons subjected to bilateral section of the ophthalmic branch of the trigeminal nerve; \emph{on}, pigeons subjected to bilateral section of the olfactory nerve} \item{\code{bearing}}{, vanishing bearing of each bird in degrees} } } \references{ Gagliardo A., Ioale' P., Savini M., and Wild M. (2008). Navigational abilities of homing pigeons deprived of olfactory or trigeminally mediated magnetic information when young. \emph{J. Exp. Biol.}, \bold{211}:2046--2051. } \keyword{datasets} circular/man/medianHL.circular.Rd0000644000176200001440000000601414475660623016422 0ustar liggesusers\name{medianHL.circular} \alias{medianHL.circular} \alias{medianHL} \alias{medianHL.default} \title{ Median using Hodges-Lehmann estimate. } \description{ Sample median for a vector of data using Hodges-Lehmann estimate and Sample median direction measure for a vector of circular data using Hodges-Lehmann estimate. } \usage{ medianHL(x, na.rm=FALSE, ...) \method{medianHL}{default}(x, na.rm=FALSE, method=c("HL1","HL2","HL3"), prop=NULL,...) \method{medianHL}{circular}(x, na.rm=FALSE, method=c("HL1","HL2","HL3"), prop=NULL,...) } \arguments{ \item{x}{a vector. For the function \code{medianHL.circular} the object is coerced to class \code{\link{circular}}.} \item{na.rm}{logical, indicating if \code{\link{NA}}'s should be omitted.} \item{method}{The method used to calculate the median, see details below.} \item{prop}{The proportion of pairs that are sampled. If \code{NULL} all combinations are used. It must be a number in the interval (0,1) or \code{NULL}.} \item{...}{further arguments passed to the next method.} } \details{ The algorithm is as follows: The algorithm will create pairs of elements of the vector \code{x}. It will calculate the circular mean on those pairs. It will calculate the circular median on these averages. The type of pairs considered are controlled by \code{method}: if \code{method} is "HL1" are considered unordered pairs without replications and repetition in the number of \code{(n*(n-1))/2} pairs; if \code{method} is "HL2" are considered unordered pairs without replications in the number of \code{(n*(n+1))/2} pairs; if \code{method} is "HL3" all pairs are considered in the number of \code{n^2}. If \code{prop} is not \code{NULL}, the algorithm will consider a subsample following the rules specified by \code{method}, however, the number of pairs considered is prop * (number of pairs defined by \code{method}). For more details see Bennett Sango Otieno, 'An Alternative Estimate of Preferred Direction for Circular Data', Virginia Tech (2002) pag. 27-28 and 46-47. } \value{ For \code{medianHL.circular} the median is returned as an object of class \code{circular} with the attribute given by those of \code{x}. An attributes \code{medians} reports all the averages which are minimizer of the circular median function. } \references{ Bennett Sango Otieno, An Alternative Estimate of Preferred Direction for Circular Data, Virginia Tech (July 2002). Bennett Sango Otieno and Christine M. Anderson-Cook,Measures of preferred direction for environmental and ecological circular data, Springer (June 2004). } \author{ Claudio Agostinelli and Alessandro Gagliardi. } \seealso{ \code{\link{mean.circular}}, \code{\link{median.circular}}. } \examples{ # Compute the median direction of a random sample of observations. x <- circular(runif(50, circular(0), pi)) # Calculate the three medians for each method without \code{prop} argument. medianHL.circular(x,method="HL1") medianHL.circular(x,method="HL2") medianHL.circular(x,method="HL3") } \keyword{univar} circular/man/coope.Rd0000644000176200001440000000062011312211557014221 0ustar liggesusers\name{Coope} \alias{x.coope} \alias{y.coope} \title{Coope dataset } \usage{ data(coope) } \description{ A dataset taken from the paper of Coope (1993). } \format{ \code{x.coope} and \code{y.coope} are vectors of length 8. } \source{ Coope, I. (1993). Circle fitting by linear and non-linear least squares. Journal of Optimization Theory and Applications, 76, 381-388. } \keyword{datasets} circular/man/median.circular.Rd0000644000176200001440000000313513124163634016165 0ustar liggesusers\name{median.circular} \alias{median.circular} \title{ Median Direction } \description{ Sample median direction for a vector of circular data } \usage{ \method{median}{circular}(x, na.rm = FALSE, ...) } \arguments{ \item{x}{a vector. The object is coerced to class \code{\link{circular}}. } \item{na.rm}{logical, indicating if \code{\link{NA}}'s should be omitted. } \item{\dots}{NotYetUsed.} } \details{ The Definition in equations 2.32 & 2.33 from N.I. Fisher's 'Statistical Analysis of Circular Data', Cambridge Univ. Press 1993. is implemented. Since version 0.4-4, the algorithm (not the definition) for the calculation of the median is changed. For a measure of spread associated to the circular median use function \code{\link{meandeviation}}. } \value{ A scalar with the circular median value. The median is returned as an object of class \code{circular}. } \references{ N.I. Fisher (1993) Statistical Analysis of Circular Data, Cambridge University Press. R.Y. Liu and K. Singh (1992) Ordering Directional Data: Concepts of Data Depth on Circles and Spheres, The Annals of Statistics, vol. 20, n. 3, 1468-1484. } \author{ Claudio Agostinelli and Alessandro Gagliardi } \seealso{ \code{\link{meandeviation}}, \code{\link{mean.circular}}, \code{\link{var.circular}}, \code{\link{summary.circular}}, \code{\link{rho.circular}} and \code{\link{medianHL.circular}}. } \examples{ # Compute the median direction of a random sample of observations. x <- circular(runif(50, circular(0), pi)) median(x) #only the median is returned meandeviation(x) #mean deviation is reported } \keyword{univar} circular/man/carthwrite.Rd0000644000176200001440000000210111522276001015262 0ustar liggesusers\name{Carthwrite} \alias{dcarthwrite} \title{Carthwrite's Power-of-Cosine Density Function} \description{Density for the Carthwrite's power-of-cosine distribution.} \usage{dcarthwrite(x, mu, psi)} \arguments{ \item{x}{a vector. The \code{x} and \code{q} objects are coerced to class \code{\link{circular}}.} \item{mu}{the location angular parameter. The object is coerced to class \code{\link{circular}}.} \item{psi}{the positive shape parameter.} } \details{The Carthwrite's power-of-cosine distribution has density \deqn{ f(x)=\frac{2^{(1/\psi)-1} \Gamma^2((1/\psi)+1) (1+\cos(x-\mu))^{1/\psi}} {\pi\Gamma((2/\psi)+1)}, }{% f(x)=[2^{(1/\psi)-1} \Gamma^2((1/\psi)+1) (1+\cos(x-\mu))^{1/\psi}] / [\pi \Gamma((2/\psi)+1)], } for \eqn{0 \le x < 2\pi}{0 <= x < 2\pi}. } \value{The density} \references{Carthwrite, D.E. (1963). The use of directional spectra in studying the output of a wave recorder on a moving ship. Ocean Wave Spectra , 203-218.} \author{Federico Rotolo} \keyword{distribution} \keyword{circle} \keyword{circular} \keyword{Carthwrite} \keyword{cosine} circular/man/ncfrog.Rd0000644000176200001440000000201211312211557014367 0ustar liggesusers\name{ncfrog} \alias{ncfrog} \alias{ncfrog.rad} \title{Northern Cricket Frog} \usage{ data(ncfrog) } \description{ In an experiment due to Ferguson et al. (1967) a number of northern cricket frogs (Acris crepitans) were collected from the mud flats of an abandoned stream meandering near Indianola, Mississippi, and taken to a test pen lying to the north west of the collection point. After 30 hours of enclosure within a dark environmental chamber, 14 of them were released and the directions taken by these frogs recorded. 0 degrees means North. } \format{ \code{ncfrog} is a vector of 14 observations (in degrees). \code{ncfrog.rad} contains the same observations in radians (pi/180). } \source{ Collett, D. (1980) Outliers in Circular Data \emph{Applied Statistics} \bold{29}, 1, 50--57. } \seealso{ Ferguson, D.E, Landreth, H.F. and McKeown, J.P. (1967) Sun compass orientation of the northern cricket frog, \emph{Acris crepitans}. \emph{Anim. Behav.}, \bold{14}, 45--53. } %\examples{} \keyword{datasets} circular/man/density.circular.Rd0000644000176200001440000000754314470146310016413 0ustar liggesusers\name{density.circular} \alias{density.circular} \alias{print.density.circular} \title{Kernel Density Estimation for Circular Data} \description{ The function \code{density.circular} computes kernel density estimates with the given kernel and bandwidth for circular data. } \usage{ \method{density}{circular}(x, z=NULL, bw, adjust = 1, type = c("K", "L"), kernel = c("vonmises", "wrappednormal"), na.rm = FALSE, from = circular(0), to = circular(2 * pi), n = 512, K = NULL, min.k=10, control.circular=list(), \dots) \method{print}{density.circular}(x, digits = NULL, \dots) } \arguments{ \item{x}{the data from which the estimate is to be computed. The object is coerced to class \code{circular}.} \item{z}{the points where the density is estimated. If \code{NULL} equally spaced points are used according to the parameters \code{from}, \code{to} and \code{n}.} \item{bw}{the smoothing bandwidth to be used. When the \code{kernel} is \code{vonmises} the bandwidth is equal to the concentration parameter.} \item{adjust}{the bandwidth used is actually \code{adjust*bw}. This makes it easy to specify values like ``half the default bandwidth''.} \item{type}{Not Yet Used.} \item{kernel}{a character string giving the smoothing kernel to be used. This must be one of \code{"vonmises"} or \code{"wrappednormal"}, that are kernels of \code{type} \code{"K"}.} \item{na.rm}{logical; if \code{TRUE}, missing values are removed from \code{x}. If \code{FALSE} any missing values cause an error.} \item{from, to}{the left and right-most points of the grid at which the density is to be estimated. The objects are coerced to class \code{circular}.} \item{n}{the number of equally spaced points at which the density is to be estimated.} \item{K}{number of terms to be used in approximating the density.} \item{min.k}{minimum number of terms used in approximating the density.} \item{control.circular}{the attribute of the resulting objects (\code{x} component).} \item{digits}{integer indicating the precision to be used.} \item{\dots}{further arguments passed to or from other methods.} } \value{ an object with class \code{"density.circular"} whose underlying structure is a list containing the following components. \item{data}{original dataset.} \item{x}{the \code{n} coordinates of the points where the density is estimated. It is a circular objects with coordinate system setting using \code{control.circular}.} \item{y}{the estimated density values.} \item{bw}{the bandwidth used.} \item{N}{the sample size after elimination of missing values.} \item{call}{the call which produced the result.} \item{data.name}{the deparsed name of the \code{x} argument.} \item{has.na}{logical, for compatibility (always FALSE).} } \references{ Z.D. Bai and C.R. Rao and L.C. Zhao (1988). Kernel Estimators of Density Function of Directional Data, Journal of Multivariate Analysis, 27, 24-39. J. Klemel\"a (2000). Estimation of densities and derivatives of densities with directional data, Journal of Multivariate Analysis, 73, 18-40. V.R. Prayag and A.P. Gore (1990). Density Estimation for Randomly Distributed Circular Objects, Metrika, 1990, 37, 63-69. P. Hall and G.S. Watson and J. Cabrera (1987). Kernel Density Estimation with Spherical Data, Biometrika, 74, 4, 751--762. } \author{Claudio Agostinelli} \seealso{\code{\link{plot.density.circular}} and \code{\link{lines.density.circular}}} \examples{ x <- rvonmises(n=100, mu=circular(pi), kappa=2) res25 <- density(x, bw=25, control.circular=list(units="degrees")) circularp(res25$x) plot(res25, points.plot=TRUE, xlim=c(-1.6,1)) res50 <- density(x, bw=25, adjust=2) lines(res50, col=2) lines(res50, col=3, shrink=0.9) #shrink the plot wrt the function :-) lines(res50, col=4, offset=0.5) #draw it with a reference circle of 0.5 } \keyword{distribution} \keyword{smooth} circular/man/circular.colors.Rd0000644000176200001440000000126311312211557016224 0ustar liggesusers\name{circular.colors} \alias{circular.colors} \title{ Color Palettes for Circular } \description{ Create a vector of \code{n} contiguous colors. } \usage{ circular.colors(n, m = 0, M = 2 * pi, offset = 0, ...) } \arguments{ \item{n}{the number of colors (>= 1) to be in the palette.} \item{m}{the smallest angle in radians.} \item{M}{the largest angle in radians.} \item{offset}{the zero in radians.} \item{\dots}{further arguments passed to the function \code{\link{hsv}}.} } \value{ a vector of length \code{n}. } \author{ Claudio Agostinelli } \seealso{ \code{\link{hsv}}, \code{\link{colors}} } \examples{ circular.colors(n=10, m=0, M=2*pi) } \keyword{color} circular/man/meandeviation.Rd0000644000176200001440000000232612017360630015744 0ustar liggesusers\name{meandeviation} \title{A measure of deviation for Circular Data} \alias{meandeviation} \description{ Returns a measure of spread associated with the circular median of a vector of circular data. } \usage{ meandeviation(x, na.rm = FALSE) } \arguments{ \item{x}{a vector. The object is coerced to class \code{\link{circular}}.} \item{na.rm}{logical, indicating if \code{\link{NA}}'s should be omitted.} } \details{ See equation (2.33) at pag. 36 in Fisher (1993) for its definition. In the case the circular median is not defined, that is, every angle is a median axis, the mean deviation is not reported and set to \code{NA}. } \value{ Returns a measure of spread associated with the circular median of a vector of circular data. } \author{Claudio Agostinelli and Alessandro Gagliardi} \references{ N.I. Fisher (1993) Statistical Analysis of Circular Data, Cambridge University Press. } \seealso{ \code{\link{median.circular}}, \code{\link{sd.circular}}, \code{\link{angular.variance}}, \code{\link{angular.deviation}}, \code{\link{mean.circular}}, \code{\link{rho.circular}} and \code{\link{summary.circular}}. } \examples{ x <- rvonmises(n=100, mu=circular(0), kappa=1) meandeviation(x) } \keyword{univar} circular/man/sd.circular.Rd0000644000176200001440000000357111601102417015330 0ustar liggesusers\name{sd.circular} \title{Circular Standard Deviation} \alias{sd.circular} \description{ Returns the circular standard deviation of a vector of circular data which is defined as the square root of minus 2 times the log of the mean resultant length divided by the number of observations. } \usage{ \method{sd}{circular}(x, na.rm = FALSE, \dots) } \arguments{ \item{x}{a vector. The object is coerced to class \code{\link{circular}}.} \item{na.rm}{logical, indicating if \code{\link{NA}}'s should be omitted.} %%% \item{control.circular}{the attributes of the resulting object.} \item{\dots}{further arguments passed to or from other methods.} } \details{ Computes the circular standard deviation as defined by Mardia (1972) \deqn{\sqrt{-2\ln r}}{sqrt(-2 * ln(r))} where \code{r} is the mean resultant length of the data. } \value{ Returns the circular standard deviation. %%%%% of the data as an object of class \code{\link{circular}} with the attributes given by \code{control.circular} or taken from \code{x} if missing in \code{control.circular}. } \author{Claudio Agostinelli and Jean-Olivier Irisson} \references{ Mardia, K.V. (1972) Statistics of Directional Data. Academic Press, London, sec. 26.5, p. 617 Fisher, N.I. (1993) Statistical analysis of circular data. Cambridge University Press. Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Section 1.3, World Scientific Press, Singapore. Zar, J H (2010). Biostatistical analysis. Prentice Hall. sec. 26.5, p. 617 } \seealso{ \code{\link{var.circular}}, \code{\link{angular.deviation}}, \code{\link{mean.circular}}, \code{\link{rho.circular}} and \code{\link{summary.circular}}. } \examples{ # Compute the circular standard deviation of a random # sample of observations from a von Mises distribution x <- rvonmises(n=100, mu=circular(0, units="degrees"), kappa=10) sd(x) } \keyword{univar} circular/man/windrose.Rd0000644000176200001440000001324711611000165014750 0ustar liggesusers\name{windrose} \alias{windrose} \title{Windrose Generator} \description{This function creates a windrose used to visualize the direction and magnitude of wind. The pedals of a windrose indicate the proportion of time wind comes from a given direction. Bands on the windrose indicate the proportions of winds of each magnitude.} \usage{windrose(x, y=NULL, breaks=NULL, bins=12, increment = 10, main='Wind Rose', cir.ind = 0.05, fill.col=NULL, plot.mids=TRUE, mids.size=1.2, osize=0.1, axes=TRUE, ticks=TRUE, tcl=0.025, tcl.text=-0.15, cex=1, digits=2, units=NULL, template=NULL, zero=NULL, rotation=NULL, num.ticks=12, xlim=c(-1.2, 1.2), ylim=c(-1.2, 1.2), uin, tol=0.04, right=FALSE, shrink=NULL, label.freq=FALSE, calm=c("0", "NA"), ...) } \arguments{ \item{x}{a vector contains direction or a two columns data frame, where the first component is the direction and the second the magnitude. The vector or the first column in the case of data frame is coerced to class \code{\link{circular}}.} \item{y}{a vector contains magnitude. If 'y' is not NULL and 'x' is a dataframe, only the first column of 'x' is used for direction.} \item{breaks}{the extremes of the pedals. The biggest value (in 2*pi) is recycled for building the first pedal. The vector is coerced to class \code{\link{circular}} but only the units is used.} \item{bins}{Number of pedals. Ignored if 'breaks' is not NULL.} \item{increment}{Grouping size of magnitude. These are the bins of the magnitudes displayed on each pedal.} \item{main}{Title for plot.} \item{cir.ind}{Percent intervals expressed on each circle if the pedals are equally spaced, otherwise values of density} \item{fill.col}{colors used to fill the pedals for each magnitude. The colors are recycled if necessary. The default is to use 'blue' and 'red'.} \item{plot.mids}{plot lines at the midpoints of the pedals.} \item{mids.size}{length of the lines for midpoints.} \item{osize}{radius of the circle draws at the center of the plot.} \item{axes}{if TRUE axes are added to the plot. The function \code{\link{axis.circular}} is used.} \item{ticks}{if TRUE ticks are added to the plot. The function \code{\link{ticks.circular}} is used.} \item{tcl}{length of the ticks.} \item{tcl.text}{The position of the axis labels.} \item{cex}{point character size. See help on \code{\link{par}}.} \item{digits}{number of digits used to print axis values and other numbers.} \item{units}{the units used in the plot.} \item{template}{the template used in the plot.} \item{zero}{the zero used in the plot.} \item{rotation}{the rotation used in the plot.} \item{num.ticks}{number of tick marks draw.} \item{tol}{proportion of white space at the margins of plot} \item{uin}{desired values for the units per inch parameter. If of length 1, the desired units per inch on the x axis.} \item{xlim, ylim}{the ranges to be encompassed by the x and y axes. Useful for centering the plot.} \item{right}{logical; if TRUE, the pedals are right-closed (left open) intervals.} \item{shrink}{maximum length of the pedals, it can be used to plot several graphics with the same scale.} \item{label.freq}{logical; if TRUE, the relative frequencies are used in the magnitude instead of intensities, when the breaks are equally spaced.} \item{calm}{"0" or "NA", see details below.} \item{\dots}{further parameters ignored for now.} } \details{Following the convention of the National Weather Service, winds with a direction of 0 are considered calm, while winds with a direction of 360 degrees (2*pi radians) are assumed to be from the north. Calm winds are excluded from the wind rose creation. We allow, in direction, to use \code{NA} to indicate calm wind (argument \code{calm}). This wind rose preserve areas of pedals, that is counts are proportional to the area of the pedals rather than to the length of the pedals. This is also for the slides created for the magnitudes. } \value{ \item{x}{directions} \item{y}{magnitudes} \item{table}{Matrix output of the counts of wind direction and magnitude. Columns are in the same units as the data, according to step size, and rows are based on the increment size.} \item{number.obs}{Total number of observations.} \item{number.calm}{The number of calm observations omitted from the wind rose plot.} \item{breaks}{extremes of the pedals.} \item{mids}{midpoints of pedals.} \item{call}{the \code{\link[base]{match.call}} result.} } \note{some codes from \code{\link{eqscplot}} in 'MASS' is used.} \author{Matt Pocernich , ported in the package 'circular' by Claudio Agostinelli} \examples{ # Random distribution of direction and magnitude in degrees dir <- circular(runif(100, 0, 360), units="degrees") mag <- rgamma(100, 15) sample <- data.frame(dir=dir, mag=mag) par(mfrow=c(2,2)) res <- windrose(sample) ## we join two pedals and keep the same shrink (scale of the plot) breaks <-circular(seq(0, 2 * pi, by = pi/6)) breaks <- breaks[-2] windrose(sample, breaks=breaks, main="The same but with two pedals joined", shrink=res$shrink) ## change the rotation sample <- data.frame(dir=circular(dir, units="degrees", rotation="clock"), mag=mag) windrose(sample, breaks=breaks, main="Change the rotation", shrink=res$shrink) ## use geographics template sample <- data.frame(dir=circular(dir, units="degrees", template="geographics"), mag=mag) windrose(sample, breaks=breaks, main="Use the template 'geographics'", shrink=res$shrink) ## do the same plot but in radians dir <- conversion.circular(dir) windrose(x=dir, y=mag, xlim=c(-1.3, 1.3)) ## magnify some part of the plot windrose(x=dir, y=mag, xlim=c(0, 1.3)) } \keyword{hplot} circular/man/bw.circular.Rd0000644000176200001440000002006614470146310015337 0ustar liggesusers% File created by Eduardo Garcia-Portugues % Modified by Claudio Agostinelli (2011/06/24) % Modified by Claudio Agostinelli (2011/07/27) \name{bandwidth} \alias{bw.cv.mse.circular} \alias{bw.cv.ml.circular} \alias{bw.nrd.circular} \concept{bandwidth} \concept{Circular Bandwidth} \title{Bandwidth Selectors for Kernel Density Estimation for Circular Data} \description{ Bandwidth selectors for circular kernels in \code{\link{density.circular}}. } \usage{ bw.cv.mse.circular(x, lower=NULL, upper=NULL, tol = 1e-4, kernel = c("vonmises", "wrappednormal"), K = NULL, min.k = 10) bw.cv.ml.circular(x, lower=NULL, upper=NULL, tol = 1e-4, kernel = c("vonmises", "wrappednormal"), K = NULL, min.k = 10) bw.nrd.circular(x, lower=NULL, upper=NULL, kappa.est=c("ML","trigmoments"), kappa.bias=FALSE, P=3) } \arguments{ \item{x}{the data from which the bandwidth is to be computed. The object is coerced to class \code{circular}.} \item{lower, upper}{range over which to minimize for cross validatory bandwidths. The default is almost always satisfactory, although it is recommended experiment a little with different ranges. A warning message indicates if the resulting bandwidth is too near to the endpoints of the interval search.} \item{tol}{for cross validatory bandwidths, the convergence tolerance for \code{\link{optimize}}.} \item{kernel}{a character string giving the smoothing kernel to be used. This must be one of \code{"vonmises"} or \code{"wrappednormal"}.} \item{K}{number of terms to be used in approximating the wrappednormal density. See \code{\link{dwrappednormal}}.} \item{min.k}{minimum number of terms used in approximating the wrappednormal density. See \code{\link{dwrappednormal}}.} \item{kappa.est}{a numerical value or one available method.} \item{kappa.bias}{logical. If \code{TRUE}, when \code{kappa.est=="ML"} a bias correction in the estimation of kappa is applied.} \item{P}{integer, the maximum order of the sample trigonometric moments used in the estimation of \code{kappa} when \code{kappa.est=="trigmoments"}, see Details.} } \details{ \code{bw.cv.mse.circular} and \code{bw.cv.ml.circular} implement cross validatory bandwidths minimizing squared--error loss and Kullback--Leibler loss, respectively. This is done by minimizing the second and third equations in section 5 of Hall, Watson and Cabrera (1987). Kullback--Leibler loss is equivalent to maximize the cross validation log--likelihood with respect to the bandwidth parameter. \code{bw.nrd.circular} implements a rule-of-thumb for choosing the bandwidth of a von Mises kernel density estimator with underlying population von Mises. It was proposed by Taylor (2008, equation (7)) and is the circular analogue of the usual rule of thumb used for the normal distribution. The only remarkable difference between them is that Taylor's bandwidth supposes a von Mises population for the derivation of AMISE, while normal rule of thumb only introduces distribution assumption to compute the density curvature. Estimation of the spread is done by maximum likelihood. The "trigmoments" method for the estimation of \code{kappa} is implemented as follows. Let \eqn{\mu_p} be the p-th sample trigonometric moment. Let \eqn{k_p} be the estimates of \code{kappa} using the p-th sample trigonometric moment, as solution (using \code{uniroot} function) of the equation \eqn{A_p(k) = \frac{1}{n} \sum_{i=1}^n \cos(p x_i - \mu_p)}. We let \code{kappa} equal to \eqn{max(k_1, k_2, \cdots, k_P)}, see Taylor (2008) for further details. Note that circular bandwidth has a different scale from linear bandwidth (see Hall, Watson and Cabrera (1987)). The behaviour of the circular bandwidth is the \emph{inverse} of the linear: large values overestimate the density, whereas small values underestimate. } \section{Warning}{ Plug-in bandwidth selector \code{bw.nrd.circular} assumes that the underlying population is von Mises. If this is not true, it might lead to serious misestimations of the circular bandwidth. Example 2 below shows how this behaviour can appear with multimodality populations. In those cases, the use of \code{kappa.est="trigmoments"} could be of help. } \value{ A bandwidth on a scale suitable for the \code{bw} argument of \code{density.circular}. } \references{ P. Hall and G.S. Watson and J. Cabrera (1987). Kernel Density Estimation with Spherical Data, Biometrika, 74, 4, 751--762. C.C Taylor (2008). Automatic bandwidth selection for circular density estimation. Computational Statistics and Data Analysis, 52, 7, 3493--3500. } \author{Claudio Agostinelli and Eduardo Garcia--Portugues} \seealso{\code{\link{density.circular}}} \examples{ set.seed(12345) ## Example 1: von Mises ## theta1 <- rvonmises(n=150,mu=circular(pi),kappa=2) bw.nrd1 <- bw.nrd.circular(theta1) bw.cv.mse1 <- bw.cv.mse.circular(theta1) bw.cv.ml1 <- bw.cv.ml.circular(theta1) ## Linear plot plot(function(x) dvonmises(circular(x), mu=circular(pi), kappa=2), type="l", lwd=2, col=1, main="von Mises", xlab=expression(theta), ylab="Density", from=0, to=2*pi) plot(approxfun(density.circular(x=theta1, bw=bw.nrd1)), col=2, from=0, to=2*pi, add=TRUE) plot(approxfun(density.circular(x=theta1, bw=bw.cv.mse1)), col=3, from=0, to=2*pi, add=TRUE) plot(approxfun(density.circular(x=theta1, bw=bw.cv.ml1)), col=4, from=0, to=2*pi, add=TRUE) legend("topright", legend=c("True", "Taylor", "LSCV", "MLCV"), col=1:4, lwd=2) rug(theta1) ## Circular plot dvonmises1 <- function(x) dvonmises(circular(x), mu=circular(pi), kappa=2) curve.circular(dvonmises1, lwd=2, col=1, main="von Mises", xlim=c(-1.5, 1.5), ylim=c(-1.5,1.5)) lines(density.circular(x=theta1, bw=bw.nrd1), col=2) lines(density.circular(x=theta1, bw=bw.cv.mse1), col=3) lines(density.circular(x=theta1, bw=bw.cv.ml1), col=4) legend("topright", legend=c("True", "Taylor", "LSCV", "MLCV"), col=1:4, lwd=2) points(theta1) ## Example 2: mixture of von Mises ## theta2 <- rmixedvonmises(n=150, mu1=circular(pi/2), mu2=circular(3*pi/2), kappa1=5, kappa2=5,p=0.5) bw.nrd2 <- bw.nrd.circular(theta2) bw.cv.mse2 <- bw.cv.mse.circular(theta2) bw.cv.ml2 <- bw.cv.ml.circular(theta2) ## Linear plot plot(function(x) dmixedvonmises(circular(x), mu1=circular(pi/2), mu2=circular(3*pi/2), kappa1=5, kappa2=5, p=0.5), type="l", lwd=2, col=1, main="mixture of von Mises", xlab=expression(theta), ylab="Density", from=0, to=2*pi) lines(density.circular(x=theta2, bw=bw.nrd2), plot.type='line', col=2) lines(density.circular(x=theta2, bw=bw.cv.mse2), plot.type='line', col=3) lines(density.circular(x=theta2, bw=bw.cv.ml2), plot.type='line', col=4) rug(theta2) legend("topright", legend=c("True", "Taylor", "LSCV", "MLCV"), col=1:4, lwd=2) ## Circular plot dmixedvonmises1 <- function(x) dmixedvonmises(circular(x), mu1=circular(pi/2), mu2=circular(3*pi/2), kappa1=5, kappa2=5, p=0.5) curve.circular(dmixedvonmises1, join=TRUE, xlim=c(-1.5, 1.5), ylim=c(-1.5, 1.5), lwd=2, col=1, main="mixture of von Mises") lines(density.circular(x=theta2, bw=bw.nrd2), col=2) lines(density.circular(x=theta2, bw=bw.cv.mse2), col=3) lines(density.circular(x=theta2, bw=bw.cv.ml2), col=4) points(theta2) legend("topright", legend=c("True", "Taylor", "LSCV", "MLCV"), col=1:4, lwd=2) ## Example 3: mixture of von Mises and Wrapped Cauchy ## rmixture <- function(n){ x <- circular(sapply(runif(n), function(u) ifelse(u>0.5, rvonmises(n=1, mu=circular(pi),kappa=10), rwrappedcauchy(n=1,mu=circular(pi/2),rho=0.75)))) return(x) } theta3 <- rmixture(n=150) bw.nrd3 <- bw.nrd.circular(theta3) bw.cv.mse3 <- bw.cv.mse.circular(theta3, lower=0.1, upper=100) bw.cv.ml3 <- bw.cv.ml.circular(theta3, lower=0.1, upper=100) dmixture <- function(x) (dvonmises(x, mu=circular(pi), kappa=10)+dwrappedcauchy(x, mu=circular(pi/2), rho=0.75))/2 curve.circular(dmixture, join=TRUE, xlim=c(-1.5, 1.5), ylim=c(-1.5, 1.5), lwd=2, col=1, main="mixture of von Mises and Wrapped Normal") lines(density.circular(x=theta3, bw=bw.nrd3), col=2) lines(density.circular(x=theta3, bw=bw.cv.mse3), col=3) lines(density.circular(x=theta3, bw=bw.cv.ml3), col=4) legend("topright", legend=c("True", "Taylor", "LSCV", "MLCV"), col=1:4, lwd=2) points(theta3) } \keyword{distribution} \keyword{smooth} circular/man/lsfit.circle.Rd0000644000176200001440000000654711611000067015505 0ustar liggesusers\name{lsfit.circle} \alias{lsfit.circle} \alias{print.lsfit.circle} \title{Fit a 2D circle to an (x,y) dataset} \description{ Fit a 2D circle to an (x,y) dataset using LS. } \usage{ lsfit.circle(x, y, init = NULL, units = c("radians", "degrees"), template = c("none", "geographics"), modulo = c("asis", "2pi", "pi"), zero = 0, rotation = c("counter", "clock"), ...) \method{print}{lsfit.circle}(x, digits = max(3, getOption("digits") - 3), ...) } \arguments{ \item{x}{either a matrix with two columns or a vector.} \item{y}{if \code{x} is a vector then \code{y} must be a vector with the same length.} \item{init}{initial values of the parameters. A vector of length 3 with the following components: radius of the circle, x-coordinate of the center, y-coordinate of the center. If \code{NULL} the vector is set to \code{c(max(c(abs(x-mean(x)), abs(y-mean(y)))), mean(x), mean(y)}.} \item{units}{the \code{units} used in defining the angles between observations and the center of the circle. See \code{\link{circular}}.} \item{template}{the \code{template} used in defining the angles between observations and the center of the circle. See \code{\link{circular}}.} \item{modulo}{the \code{modulo} used in defining the angles between observations and the center of the circle. See \code{\link{circular}}.} \item{zero}{the \code{zero} used in defining the angles between observations and the center of the circle. See \code{\link{circular}}.} \item{rotation}{the \code{rotation} used in defining the angles between observations and the center of the circle. See \code{\link{circular}}.} \item{\dots}{further parameters passed to the \code{optim} function.} \item{digits}{the number of digits to be printed.} } \details{ \code{lsfit.circle} uses the \code{optim} function to minimize the sum of the squared residuals between the observations and the optimally fitting circle. } \value{ An object of class \code{lsfit.circle}. \item{coefficients}{a vector of length 3 with the estimated radius and coordinate of the center of the fitted circle.} \item{x}{the x-coordinate.} \item{y}{the y-coordinate.} \item{x.centered}{the x-coordinate re-centered at the center of the circle.} \item{y.centered}{the y-coordinate re-centered at the center of the circle.} \item{angles}{angles of the observations with respect to the center coordinate of class \code{circular}.} \item{radius}{the distance between the observations and the center coordinate} \item{convergence}{value from the function optim.} \item{optim}{the output from the function optim.} \item{call}{the \code{\link[base]{match.call}} result.} } \references{ Coope, I. (1993). Circle fitting by linear and non-linear least squares. Journal of Optimization Theory and Applications, 76, 381-388. } \author{Claudio Agostinelli and Ulric Lund} \examples{ data(coope) res <- lsfit.circle(x=x.coope, y=y.coope) res plot(res) par(mfcol=c(1,2)) plot(res$angles) hist(res$radius) plot(circular(0), type="n", xlim=c(-5.2, 5.2), ylim=c(-5.2, 5.2), xlab="The Radius of the circle \n is measured from the base line of the axes.") lines(x=res$angles, y=res$radius, join=TRUE, type="b") ff <- function(x) sqrt((res$coefficients[1]*cos(x))^2+(res$coefficients[1]*sin(x))^2) curve.circular(ff, add=TRUE, join=TRUE, nosort=FALSE, col=2) windrose(x=res$angles, y=res$radius) } \keyword{models} circular/man/pp.unif.plot.Rd0000644000176200001440000000216713124453061015461 0ustar liggesusers\name{pp.unif.plot} \title{Uniform Circular Probability-Probability Plot} \alias{pp.unif.plot} \description{ Plots the empirical distribution of a data set against a uniform circular distribution function. } \usage{ pp.unif.plot(x, ref.line = TRUE, frac = NULL, xlab = "Uniform Distribution", ylab = "Empirical Distribution", col = NULL, col.inf = NULL, col.sup = NULL, ...) } \arguments{ \item{x}{a vector. The object is coerced to class \code{\link{circular}}.} \item{ref.line}{logical, if TRUE a 45 degree reference line is added to the plot. Default is TRUE.} \item{frac}{a number in the [0,1] interval or \code{NULL}.} \item{xlab, ylab}{labels of the axis.} \item{col}{color of the points.} \item{col.inf, col.sup}{color of the \code{frac}tion of the points replicated in the left bottom and right upper corner of the plot.} \item{...}{parameters passed to the \code{\link{plot.default}} function.} } \author{Claudio Agostinelli} \seealso{ \code{\link{pp.plot} for the von Mises distribution.} } \examples{ x <- rvonmises(n=25, mu=circular(0), kappa=3) pp.unif.plot(x) pp.unif.plot(x, frac=0.2) } \keyword{hplot} circular/man/points.circular.Rd0000644000176200001440000000550614470146310016245 0ustar liggesusers\name{points.circular} \title{Add Points to a Circular Plot} \alias{points.circular} \description{ Add points to a plot of circular data points on the current graphics device. } \usage{ \method{points}{circular}(x, pch = 16, cex = 1, stack = FALSE, start.sep=0, sep = 0.025, shrink = 1, bins = NULL, col = NULL, next.points = NULL, plot.info = NULL, zero = NULL, rotation = NULL, ...) } \arguments{ \item{x}{a vector, matrix or data.frame. The object is coerced to class \code{\link{circular}}.} \item{pch}{point character to use. See help on \code{\link{par}}.} \item{cex}{point character size. See help on par.} \item{stack}{logical: if \code{TRUE}, points are stacked on the perimeter of the circle. Otherwise, all points are plotted on the perimeter of the circle. Default is \code{FALSE}.} \item{start.sep}{constant used to specify the distance between the center of the point and the axis.} \item{sep}{constant used to specify the distance between stacked points, if \code{stack==TRUE} or in the case of more than one dataset. Default is 0.025; smaller values will create smaller spaces.} \item{shrink}{parameter that controls the size of the plotted circle. Default is 1. Larger values shrink the circle, while smaller values enlarge the circle.} \item{bins}{if \code{stack==TRUE}, bins is the number of arcs to partition the circle with.} \item{col}{color of the points. The values are recycled if needed.} \item{next.points}{if \code{stack=FALSE}, the distance from the circle the next dataset is plotted. Ignored if \code{plot.info} is provided.} \item{plot.info}{an object from \code{\link{plot.circular}} that contains information on the \code{zero}, the \code{rotation} and \code{next.points}.} \item{zero}{the zero of the plot. Ignored if \code{plot.info} is provided.} \item{rotation}{the rotation of the plot. Ignored if \code{plot.info} is provided.} \item{...}{further parameters passed to \code{\link{points.default}}.} } \details{ When there are many closely distributed observations, stacking is recommended. When stacking the points, if there are many points in a particular bin, it may be necessary to shrink the plot of the circle so that all points fit. This is controlled with the parameter \code{shrink}. Generally the parameter \code{sep} does not need adjustment, however, when shrinking the plot, or for a very large number of observations, it may be helpful. Since version 0.3-9 the intervals are on the form [a,b). } \author{Claudio Agostinelli} \value{ A list with information on the plot: zero, rotation and next.points. } \seealso{ \code{\link{plot.circular}} and \code{\link{lines.circular}}. } \examples{ data.1 <- rvonmises(n=100, mu=circular(0), kappa=3) data.2 <- rvonmises(n=100, mu=circular(pi/3), kappa=3) res <- plot(data.1, stack=FALSE, col=1) points(data.2, plot.info=res, col=2) } \keyword{hplot} circular/man/fisherB7.Rd0000644000176200001440000000141314470146310014570 0ustar liggesusers\name{fisherB7} \alias{fisherB7} \alias{fisherB7c} \title{B.7 Movements of ants} \usage{ data(fisherB7) data(fisherB7c) } \description{ Directions chosen by 100 ants in response to an evenly illuminated black targets placed as shown. } \format{ \code{fisherB7} a vector of 100 observations (in degrees). \code{fisherB7c} contains the same observations in a circular objects. } \source{ Randomly selected values from Jander, R. (1957) Die optische Richtangsorientierung der roten Waldameise (Formica rufa. L.) Z. vergl. Physiologie 40, 162-238. Figure 18A. } \seealso{ N.I. Fisher (1993) Statistical analysis of circular data. Cambridge University Press. Pag. 243. } \examples{ data(fisherB7c) plot(fisherB7c, zero=pi/2, rotation='clock', stack=TRUE) } \keyword{datasets} circular/man/equal.kappa.test.Rd0000644000176200001440000000473111611000020016262 0ustar liggesusers\name{equal.kappa.test} \alias{equal.kappa.test} \alias{print.equal.kappa.test} \title{Equal Kappa Test} \description{ This function tests for the homogeneity of concentration parameters for multiple samples of directional data. } \usage{ equal.kappa.test(x, group) \method{print}{equal.kappa.test}(x, digits = max(3, getOption("digits") - 3), ...) } \arguments{ \item{x}{a vector of class \code{circular}.} \item{group}{a vector identifying the groups or samples.} \item{digits}{the number of digits to be printed.} \item{\dots}{additional arguments.} } \value{ An object of class \code{equal.kappa.test} with the following components: \item{kappa}{concentration parameter for each sample.} \item{kappa.all}{concentration parameter of all samples combined.} \item{rho}{mean resultant length for each sample.} \item{rho.all}{mean resultant length of all samples combined.} \item{df}{degrees of freedom for chi-squared distribution.} \item{statistic}{the value of the chi-squared test statistic.} \item{p.value}{the p.value of the test statistic.} \item{call}{the \code{\link[base]{match.call}} result.} } \details{ The samples are assumed to have been drawn from von Mises populations. The null hypothesis tested is that all populations sampled have the same concentration parameter, kappa. When the pooled data has high concentration, sample mean resultant length above 0.70, Bartlett's test is used. For less concentrated pooled data, variance-stabilizing transformations are used to improve normal approximations needed to arrive at an approximate chi-squared test statistic (see references below). For pooled sample mean resultant length below 0.45, it is possible that individually a sample may in fact have quite a large sample mean resultant length. In this case, it is possible that the variance-stabilizing transformation involving the inverse sine function is passed a value outside of -1,1. If this occurs, the function will automatically use Bartlett's test and issue a warning to that effect. } \references{ Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Section 5.3, World Scientific Press, Singapore. Mardia, K. and Jupp, P. (1999). Directional Statistics, Section 7.4, John Wiley and Sons, England. } \author{Claudio Agostinelli and Ulric Lund} \examples{ x <- c(rvonmises(50, circular(0), 1), rvonmises(100, circular(pi/3), 10)) group <- c(rep(0, 50), rep(1, 100)) equal.kappa.test(x, group) } \keyword{htest} circular/man/axis.circular.Rd0000644000176200001440000000511214470146310015666 0ustar liggesusers\name{axis.circular} \title{Add Axis to a Circular Plot} \alias{axis.circular} \description{ Add axis to a plot of circular data points on the current graphics device. } \usage{ axis.circular(at=NULL, labels=NULL, units = NULL, template=NULL, modulo=NULL, zero=NULL, rotation=NULL, tick=TRUE, lty, lwd, cex, col, font, tcl=0.025, tcl.text=0.125, digits=2) } \arguments{ \item{at}{the points at which tick-marks are to be drawn. If \code{NULL} the tick-marks are placed to 0, pi/2, pi and 3pi/2 radians.} \item{labels}{a vector of character strings to be placed at the tickpoints. If \code{NULL} the labels are chosen according to \code{units} and \code{template} arguments.} \item{units}{either \code{radians} or \code{degrees}. If \code{NULL} the value is taken from the attributes of the object \code{at}.} \item{template}{either \code{none} or \code{geographics}. If \code{NULL} the value is taken from the attributes of the object \code{at}.} \item{modulo}{either \code{asis} or \code{2pi} or \code{pi}. If \code{NULL} the value is taken from the attributes of the object \code{at}.} \item{zero}{the zero of the plot (in radians, counterclockwise). If \code{NULL} the value is taken from the attributes of the object \code{at}.} \item{rotation}{the rotation of the plot. If \code{NULL} the value is taken from the attributes of the object \code{at}.} \item{tick}{logical: if \code{TRUE} ticks are plotted at tick-marks.} \item{lty, lwd}{line type, width for the tick marks. If missing means to use `par("lty")' and `par("lwd")'.} \item{cex}{a numerical value giving the amount by which plotting text and symbols should be scaled relative to the default.} \item{col}{color for the the tick marks. If missing means to use `par("col.axis")'. } \item{font}{font for text. If missing means to use `par("font.axis")'.} \item{tcl}{The length of tick marks.} \item{tcl.text}{The position of the axis labels.} \item{digits}{number of digits used to print axis values.} } \author{Claudio Agostinelli} \seealso{ \code{\link{plot.circular}} and \code{\link{ticks.circular}}. } \examples{ data.vm <- rvonmises(n=100, mu=circular(0), kappa=3) plot(data.vm, axes=FALSE, ticks=FALSE) axis.circular(at=circular(seq(0, 11/6*pi, pi/6)), labels=c("0", expression(frac(pi,6)), expression(paste(frac(1,3), pi)), expression(frac(pi,2)), expression(paste(frac(2,3), pi)), expression(paste(frac(5,6), pi)), expression(pi), expression(paste(frac(7,6), pi)), expression(paste(frac(4,3), pi)), expression(paste(frac(3,2), pi)), expression(paste(frac(5,3), pi)), expression(paste(frac(11,6), pi)))) } \keyword{hplot} circular/man/cor.circular.Rd0000644000176200001440000000322611312211557015507 0ustar liggesusers\name{cor.circular} \title{Correlation Coefficient for Angular Variables} \alias{cor.circular} \description{ Computes a circular version of the Pearson's product moment correlation, and performs a significance test if requested. } \usage{ cor.circular(x, y=NULL, test=FALSE) } \arguments{ \item{x}{vector or matrix of circular data.} \item{y}{vector or matrix of circular data.} \item{test}{if \code{test == TRUE}, then a significance test for the correlation coefficient is computed.} } \value{ Returns a vector or a matrix of a circular version of the Pearson's product moment correlation, if \code{test == TRUE} then a list is reported with statistic and p.value, the test statistic and p-value respectively, for testing significance of the correlation coefficient. } \details{ The correlation coefficient is computed like Pearson's product moment correlation for two linear variables X and Y. In the computational formula, however, (xi - xbar) and (yi - ybar) are replaced by sin(xi - xbar) and sin(yi - ybar), where xbar and ybar in the second two expressions are the mean directions of the samples. } \author{Claudio Agostinelli and Ulric Lund} \references{ Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Section 8.2, World Scientific Press, Singapore. Jammalamadaka, S. and Sarma, Y. (1988). A correlation coefficient for angular variables. Statistical Theory and Data Analysis 2. North Holland: New York. } \examples{ # Generate two circular data sets, and compute their correlation. x <- rvonmises(n=50, mu=circular(0), kappa=3) y <- x + rvonmises(n=50, mu=circular(pi), kappa=10) cor.circular(x, y, test=TRUE) } \keyword{univar} circular/man/weighted.mean.circular.Rd0000644000176200001440000000350012524350144017440 0ustar liggesusers\name{weighted.mean.circular} \title{Weighted Mean Direction} \alias{weighted.mean.circular} \description{ Returns the weighetd mean direction of a vector of circular data. } \usage{ \method{weighted.mean}{circular}(x, w, na.rm=FALSE, control.circular=list(), \dots) } \arguments{ \item{x}{a vector. The object is coerced to class \code{\link{circular}}.} \item{w}{a numerical vector of weights the same length as \code{x} giving the weights to use for elements of \code{x}.} \item{na.rm}{logical, indicating if \code{\link{NA}}'s should be omitted.} \item{control.circular}{the attribute of the resulting object.} \item{\dots}{further arguments passed to or from other methods.} } \value{ Returns the weighted mean direction of the data as an object of class \code{circular} with the attribute given by \code{control.circular} or from \code{x} if missed in \code{control.circular}. } \details{ Each observation is treated as a unit vector, or point on the unit circle. The resultant vector of the observations is found, and the direction of the resultant vector is returned. An \code{\link{NA}} is returned if the weighted resultant length is less than \code{\link{.Machine}}. If \code{w} is missing then all elements of \code{x} are given the same weight, otherwise the weights coerced to numeric by \code{as.numeric} and normalized to sum to one. Missing values in \code{w} are not handled specially and so give a missing value as the result. However, zero weights are handled specially and the corresponding \code{x} values are omitted from the computation. } \author{Claudio Agostinelli} \seealso{ \code{\link{mean.circular}} } \examples{ # Compute the weighted mean direction of a random sample of observations. x <- circular(runif(50, circular(0), pi)) w <- runif(50, 0, 1) weighted.mean(x, w) } \keyword{univar} circular/man/fisherB3.Rd0000644000176200001440000000125014470146310014563 0ustar liggesusers\name{fisherB3} \alias{fisherB3} \alias{fisherB3c} \title{B.3 Movements of turtles} \usage{ data(fisherB3) data(fisherB3c) } \description{ Measurements of the directions taken by 76 turtles after treatment. } \format{ \code{fisherB3} is a vector of 76 observations (in degrees). \code{fisherB3c} contains the same observations in a circular objects. } \source{ Stephens, M.A. (1969) Techniques for directional data. Technical Report #150, Department of Statistics, Stanford University, Stanford, CA. } \seealso{ N.I. Fisher (1993) Statistical analysis of circular data. Cambridge University Press. Pag. 241. } \examples{ data(fisherB3c) plot(fisherB3c) } \keyword{datasets} circular/man/kuiper.test.Rd0000644000176200001440000000400511312211557015372 0ustar liggesusers\name{kuiper.test} \title{Kuiper's Test} \alias{kuiper.test} \alias{print.kuiper.test} \description{ Performs Kuiper's one-sample test of uniformity on the circle. } \usage{ kuiper.test(x, alpha=0) \method{print}{kuiper.test}(x, digits = 4, \dots) } \arguments{ \item{x}{a vector. The object is coerced to class \code{\link{circular}}.} \item{alpha}{significance level of the test. Possible levels are 0.15, 0.1, 0.05, 0.025, 0.01. Alpha may be omitted or set to zero, in which case a range for the p-value of the test will be printed.} \item{digits}{integer indicating the precision to be used.} \item{\dots}{further arguments passed to or from other methods.} } \value{ A list with the statistic and alpha value. } \note{ Kuiper's one-sample test of uniformity is performed, and the results are printed to the screen. If alpha is specified and non-zero, the test statistic is printed along with the critical value and decision. If alpha is omitted, the test statistic is printed and a range for the p-value of the test is given. } \details{ Kuiper's test statistic is a rotation-invariant Kolmogorov-type test statistic. The critical values of a modified Kuiper's test statistic are used according to the tabulation given in Stephens (1970). } \author{Claudio Agostinelli and Ulric Lund} \references{ Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Section 7.2, World Scientific Press, Singapore. Stephens, M. (1970). Use of the Kolmogorov-Smirnov, Cramer-von Mises and related statistics without extensive tables. Journal of the Royal Statistical Society, B32, 115-122. } \seealso{ \code{\link{range.circular}}, \code{\link{rao.spacing.test}}, \code{\link{rayleigh.test}} and \code{\link{watson.test}} } \examples{ # Generate data from the uniform distribution on the circle. data <- circular(runif(100, 0, 2*pi)) kuiper.test(data) # Generate data from the von Mises distribution. data <- rvonmises(n=100, mu=circular(0), kappa=3) kuiper.test(data, alpha=0.01) } \keyword{htest} circular/man/fisherB11.Rd0000644000176200001440000000156511312211557014651 0ustar liggesusers\name{fisherB11} \alias{fisherB11} \alias{fisherB11c} \title{B.11 Movements of sea stars} \usage{ data(fisherB11) data(fisherB11c) } \description{ Resultant directions of 22 sea stars 11 days after being displaced from their natural habitat. } \format{ \code{fisherB11} a vector of 22 observations (in degrees). \code{fisherB11c} contains the same observations in a circular objects. } \source{ G.J.G. Upton and B. Fingleton (1989) Spatial Data Analysis by Example. Volume 2. Categorical and Directional Data. New York: John Wiley as adapted from B. Pabst and H. Vicentini (1978) Dislocation experiments in the migrating seastar. Astropecten jonstoni. Marine Biology 48, 271-8. } \seealso{ N.I. Fisher (1993) Statistical analysis of circular data. Cambridge University Press. Pag. 245. } \examples{ data(fisherB11c) plot(fisherB11c, stack=TRUE, shrink=1.5) } \keyword{datasets} circular/man/asytriangular.Rd0000644000176200001440000000125211611526153016006 0ustar liggesusers\name{asytriangular} \title{Asymmetric Triangular Density Function} \alias{dasytriangular} \description{ Density the Asymmetric Triangular circular distribution. } \usage{ dasytriangular(x, rho) } \arguments{ \item{x}{a vector. The object is coerced to class \code{\link{circular}}.} \item{rho}{concentration parameter of the distribution. rho must be between 0 and \eqn{1/pi}.} } \value{ \code{dasytriangular} gives the density. } \author{Claudio Agostinelli} \references{ Mardia (1972) Statistics for Directional Data, Wiley. Pag. 52 } \examples{ ff <- function(x) dasytriangular(x, rho=0.3) curve.circular(ff, shrink=1.2, join=TRUE) } \keyword{distribution} circular/man/genvonmises.Rd0000644000176200001440000000324211522276133015460 0ustar liggesusers\name{GenVonMises} \alias{dgenvonmises} \alias{genvonmises} \title{Generalized Von Mises Density Function} \description{ Density for the Generalized von Mises circular distribution. } \usage{dgenvonmises(x, mu1, mu2, kappa1, kappa2)} \arguments{ \item{x}{a vector. The object is coerced to class \code{\link{circular}}.} \item{mu1}{principal direction of the distribution. The object is coerced to class \code{\link{circular}}.} \item{mu2}{secondary direction parameter. The object is coerced to class \code{\link{circular}}.} \item{kappa1}{non-negative numeric parameter of the distribution.} \item{kappa2}{non-negative numeric parameter of the distribution.} } \details{The Generalized von Mises distribution has density \deqn{ f(x)=\frac1{2\pi G_0(\delta,\kappa_1,\kappa_2)} \exp\{\kappa_1 \cos(x-\mu_1) + \kappa_2 \cos2(x-\mu_2)\}, }{% f(x)=exp[\kappa_1 \cos(x-\mu_1) + \kappa_2 \cos{2(x-\mu_2) }] / [2 \pi G_0(\delta,\kappa_1,\kappa_2)], } for \eqn{0 \le x < 2\pi}{0 <= x < 2 \pi}, where \eqn{\delta=(\mu_1-\mu_2)} and \eqn{G_0} is the normalizing constant. } \value{The density} \references{Gatto , R. & Jammalamadaka , S.R. (2007). The generalized von Mises distribution. Statistical Methodology 4, 341-353.} \author{Federico Rotolo} \examples{ ff <- function(x) dgenvonmises(x, mu1=circular(5*pi/4), mu2=circular(pi/4), kappa1=.3, kappa2=1) curve.circular(ff, join=TRUE, xlim=c(-1, 1), ylim=c(-1.2, 1.2), main="Density of a Generalized von Mises Distribution", xlab=expression(paste(mu,"1=5/4",pi,", ",mu2,"=",pi/4,", ",kappa,"1=0.3, ",kappa,"2=1")) ) } \keyword{distribution} \keyword{circle} \keyword{circular} \keyword{vonMises} circular/man/watson.test.Rd0000644000176200001440000000473514470146310015422 0ustar liggesusers\name{watson.test} \title{Watson's Test } \alias{watson.test} \alias{print.watson.test} \description{ Performs a Watson's goodness of fit test for the von Mises or circular uniform distribution. } \usage{ watson.test(x, alpha=0, dist=c("uniform", "vonmises")) \method{print}{watson.test}(x, digits = 4, \dots) } \arguments{ \item{x}{a vector. The object is coerced to class \code{\link{circular}}.} \item{alpha}{significance level of the test. Valid levels are 0.01, 0.05, 0.1. This argument may be omitted, in which case, a range for the p-value will be returned.} \item{dist}{distribution to test for. The default is the uniform distribution. To test for the von Mises distribution, set \code{dist} to "vonmises".} \item{digits}{integer indicating the precision to be used.} \item{\dots}{further arguments passed to or from other methods.} } \value{ a list with the statistic, alpha, the number of observations, the distribution and 'row' which is used by \code{print.watson.test} to evaluate the p-value. } \details{If \code{dist} = "uniform", Watson's one-sample test for the circular uniform distribution is performed, and the results are printed. If alpha is specified and non-zero, the test statistic is printed along with the critical value and decision. If alpha is omitted, the test statistic is printed and a range for the p-value of the test is given. If \code{dist} = "vonmises", estimates of the population parameters are used to evaluate the von Mises distribution function at all data points, thereby arriving at a sample of approximately uniformly distributed data, if the original observations have a von Mises distribution. The one-sample Watson test is then applied to the transformed data as above. } \author{Claudio Agostinelli and Ulric Lund} \references{ Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Section 7.2, World Scientific Press, Singapore. Stephens, M. (1970). Use of the Kolmogorov-Smirnov, Cramer-von Mises and related statistics without extensive tables. Journal of the Royal Statistical Society, B32, 115-122. } \seealso{ \code{\link{range.circular}}, \code{\link{kuiper.test}}, \code{\link{rao.spacing.test}} and \code{\link{rayleigh.test}} } \examples{ # Generate data from the uniform distribution on the circle. x <- circular(runif(100, 0, 2*pi)) watson.test(x) # Generate data from a von Mises distribution. x <- rvonmises(n=50, mu=circular(0), kappa=4) watson.test(x, alpha=0.05, dist="vonmises") } \keyword{htest} circular/man/intersect.modal.region.Rd0000644000176200001440000000547313124713734017513 0ustar liggesusers\name{intersect.modal.region} \alias{intersect.modal.region} \alias{intersect.modal.region.default} \alias{intersect.modal.region.circular} \title{ Intersection between model region and a given interval. } \description{ Find an estimates of the probability of the intersection between a modal region and a given interval. } \usage{ intersect.modal.region(x, ...) \method{intersect.modal.region}{default}(x, ...) \method{intersect.modal.region}{circular}(x, breaks, z = NULL, q = 0.95, bw, adjust = 1, type = c("K", "L"), kernel = c("vonmises", "wrappednormal"), na.rm = FALSE, step = 0.01, eps.lower = 10^(-4), eps.upper = 10^(-4), ...) } \arguments{ \item{x}{numeric or an object of class \code{\link{circular}}.} \item{breaks}{a matrix with two columns. Each row specifies a sub-interval.} \item{z}{numeric or object of class \code{\link{circular}}. The grid were the kernel density estimate will be evaluated. If \code{NULL} equally spaced points in the interval [0,2*pi) with step \code{step}.} \item{q}{numeric in the interval [0,1]. The quantile of the modal region.} \item{bw}{the smoothing bandwidth to be used. When the \code{kernel} is \code{vonmises} the bandwidth is equal to the concentration parameter.} \item{adjust}{the bandwidth used is actually \code{adjust*bw}. This makes it easy to specify values like ``half the default bandwidth''.} \item{type}{Not Yet Used.} \item{kernel}{a character string giving the smoothing kernel to be used. This must be one of \code{"vonmises"} or \code{"wrappednormal"}, that are kernels of \code{type} \code{"K"}.} \item{na.rm}{logical; if \code{TRUE}, missing values are removed from \code{x}. If \code{FALSE} any missing values cause an error.} \item{step}{numeric. Used in the construction of the regular grid \code{z}.} \item{eps.lower,eps.upper}{the cut point in the density is searched in the interval [min(density)*(1+eps.lower),max(density)*(1-eps.upper)].} \item{\dots}{further arguments passed to the next methods.} } \details{ Only the version for circular data is actually implemented. } \value{ For the circular method a list with the following three components \item{tot}{the total area.} \item{areas}{information for each subinterval.} \item{breaks}{the extremes of each subinterval.} } \author{ Claudio Agostinelli } \seealso{ \code{\link{modal.region}} } \examples{ x <- rvonmises(100, circular(pi), 10) res <- intersect.modal.region(x, breaks=circular(matrix(c(pi,pi+pi/12, pi-pi/12, pi), ncol=2, byrow=TRUE)), bw=50) res$tot x <- rvonmises(100, circular(0), 10) res <- intersect.modal.region(x, breaks=circular(matrix(c(pi,pi+pi/12), ncol=2)), bw=50) res$tot res <- intersect.modal.region(x, breaks=circular(matrix(c(pi/12, 2*pi-pi/12), ncol=2, byrow=TRUE)), bw=50) res$tot } circular/man/mle.vonmises.bootstrap.ci.Rd0000644000176200001440000000435414470146310020153 0ustar liggesusers\name{mle.vonmises.bootstrap.ci} \title{Bootstrap Confidence Intervals} \alias{mle.vonmises.bootstrap.ci} \alias{print.mle.vonmises.bootstrap.ci} \description{ Generates simple bootstrap confidence intervals for the parameters of a von Mises distribution: the mean direction mu, and the concentration parameter kappa. } \usage{ mle.vonmises.bootstrap.ci(x, mu = NULL, bias = FALSE, alpha = 0.05, reps = 1000, control.circular = list()) \method{print}{mle.vonmises.bootstrap.ci}(x, \dots) } \arguments{ \item{x}{vector of angular measurements as a \code{circular} object.} \item{mu}{If \code{NULL} the value is estimated. This value is used in the bootstrap replications for \code{kappa}.} \item{bias}{logical, if \code{TRUE}, the replication estimates for kappa are computed with a bias corrected method. See \code{\link{mle.vonmises}}. Default is \code{FALSE}, i.e. no bias correction.} \item{alpha}{parameter determining level of confidence intervals. 1-alpha confidence intervals for \code{mu} and \code{kappa} are computed. By default, 95\% confidence intervals are generated.} \item{reps}{number of resampled data sets to use. Default is 1000.} \item{control.circular}{the attribute of the resulting objects (\code{mu}, \code{mu.ci}).} \item{\dots}{arguments passed to \code{\link{print.default}}.} } \value{ A list is returned with the following components: \item{mu.ci}{limits of the confidence interval for mu as a \code{circular} object.} \item{kappa.ci}{limits of the confidence interval for kappa.} \item{mu}{estimate of mu as a \code{circular} object.} \item{kappa}{estimate of kappa.} } \details{ Percentile confidence intervals are computed by resampling from the original data set \code{reps} times. For each resampled data set, the MLE's of mu and kappa are computed. The bootstrap confidence intervals are the alpha/2 and 1-alpha/2 percentiles of the \code{reps} MLE's computed for each resampled data set. } \author{Claudio Agostinelli and Ulric Lund} \seealso{ \code{\link{mle.vonmises}} } \examples{ x <- rvonmises(n=25, mu=circular(0), kappa=3) x.bs <- mle.vonmises.bootstrap.ci(x, alpha=.10) par(mfcol=c(1,2)) rose.diag(x.bs$mu, bins=30, main=expression(mu)) hist(x.bs$kappa, main=expression(kappa)) } \keyword{htest} circular/man/circular.Rd0000644000176200001440000000522314470146310014726 0ustar liggesusers\name{circular} \alias{circular} \alias{as.circular} \alias{is.circular} \alias{print.circular} \title{Create Objects of class circular for Circular data.} \description{ The function \code{circular} is used to create circular objects. \code{as.circular} and \code{is.circular} coerce an object to a circular and test whether an object is a circular data. } \usage{ circular(x, type = c("angles", "directions"), units = c("radians", "degrees", "hours"), template = c("none", "geographics", "clock12", "clock24"), modulo = c("asis", "2pi", "pi"), zero = 0, rotation = c("counter", "clock"), names) \method{as}{circular}(x, control.circular=list(), ...) \method{is}{circular}(x) \method{print}{circular}(x, info=TRUE, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{a vector or a matrix. If a data.frame is supply then it is coerced to a matrix.} \item{type}{the type of measures (Not Used Yet).} \item{units}{units of the measures.} \item{template}{how the data should be plotted. This set \code{modulo}, \code{zero} and \code{rotation} to some suitable values. For instance for 'geographics': zero=pi/2 and rotation='clock'. It is also used to set default labels on the plots.} \item{modulo}{if we need to reduce the measures to modulo.} \item{zero}{the zero of the axes (in radians, counter).} \item{rotation}{the orientation of the axes.} \item{names}{names of the data.} \item{info}{if \code{TRUE} information on the properties of the data are printed.} \item{control.circular}{the attribute (coordinate system) used to coerced the resulting objects. See \code{\link{circular}}.} \item{...}{For \code{as.circular} an alternative way of setting the coordinate system of the resulting objects. Passed parameters to \code{print.default} for \code{print.circular}.} } \value{ an object of class \code{\link{circular}}. Since version 0.3-5 the previous class of the object is retain. } \author{Claudio Agostinelli} \seealso{ \code{\link{conversion.circular}} } \examples{ x <- circular(c(pi, pi/3, pi/4)) print(x) is.circular(x) x <- circular(runif(10, -pi/2, pi/2), template="geographics") plot(x) class(x) x <- circular(data.frame(runif(10, -pi/2, pi/2))) plot(x) class(x) cbind(x, x) # the matrix, cbind, rbind functions unclass and lost attributes! ########Use it with care. x <- c(pi/12,2*pi+pi/12)%%(2*pi) # unique may not work as desidered due to machine precision print(x) x <- unique(x) print(x) x[1]==x[2] all.equal(x[1], x[2]) x <- as.circular(pi, control.circular=list(units="radians", zero=pi)) y <- conversion.circular(circular(pi), zero=pi) res <- plot(x) points(y, col=2, plot.info=res) } \keyword{misc} circular/man/circle.control.Rd0000644000176200001440000000436011312211557016041 0ustar liggesusers\name{circle.control} \alias{circle.control} \title{Auxiliary for Controlling Circular Plots} \description{ Auxiliary function as user interface for circular plots. Typically only used when calling plot.circular. } \usage{ circle.control(n = 1000, type = "l", col = 1, bg = par("bg"), pch = 1, cex = 1, lty = 1, lwd = 1) } \arguments{ \item{n}{number of points used to interpolate the circle} \item{type}{1-character string giving the type of plot desired. The following values are possible, for details, see \code{\link{plot}}: "p" for points, "l" for lines, "o" for overplotted points and lines, "b", "c" for (empty if "c") points joined by lines, "s" and "S" for stair steps and "h" for histogram-like vertical lines. Finally, "n" does not produce any points or lines.} \item{col}{The color used.} \item{bg}{The color to be used for the background of the device region. } \item{pch}{Either an integer specifying a symbol or a single character to be used as the default in plotting points. See \code{\link{points}} for possible values and their interpretation. Note that only integers and single-character strings can be set as a graphics parameter (and not \code{NA} nor \code{NULL}).} \item{cex}{A numerical value giving the amount by which plotting text and symbols should be magnified relative to the default.} \item{lty}{The line type. Line types can either be specified as an integer (0=blank, 1=solid (default), 2=dashed, 3=dotted, 4=dotdash, 5=longdash, 6=twodash) or as one of the character strings "blank", "solid", "dashed", "dotted", "dotdash", "longdash", or "twodash", where "blank" uses 'invisible lines' (i.e., does not draw them). Alternatively, a string of up to 8 characters (from c(1:9, "A":"F")) may be given, giving the length of line segments which are alternatively drawn and skipped. See section 'Line Type Specification'. } \item{lwd}{The line width, a positive number, defaulting to 1. The interpretation is device-specific, and some devices do not implement line widths less than one. (See the help on the device for details of the interpretation.) } } \author{Claudio Agostinelli} \seealso{\code{\link{plot.circular}}} \examples{ plot(rvonmises(10, circular(0), 1), control.circle=circle.control(col=2, lty=2)) } \keyword{hplot} circular/man/rao.spacing.test.Rd0000644000176200001440000000411011312211557016274 0ustar liggesusers\name{rao.spacing.test} \title{Rao's Spacing Test of Uniformity} \alias{rao.spacing.test} \alias{print.rao.spacing.test} \description{ Performs Rao's spacing test of uniformity. } \usage{ rao.spacing.test(x, alpha=0) \method{print}{rao.spacing.test}(x, digits = 4, \dots) } \arguments{ \item{x}{a vector. The object is coerced to class \code{\link{circular}}.} \item{alpha}{numeric value specifying the significance level of the test. The default value is 0, in which case, a range for the p-value will be returned. Valid significance levels are 0.10, 0.05, 0.01 and 0.001.} \item{digits}{integer indicating the precision to be used.} \item{\dots}{further arguments passed to or from other methods.} } \value{ a list with the statistic, alpha and the number of observations. } \details{ If alpha is specified, critical values are determined (using the \code{print} function) from a table of simulated critical points (see reference below); in this case the \code{print} function return a further value \code{accepted} which is \code{TRUE} if the null hypothesis is accepted and \code{FALSE} otherwise. If alpha is not specified, a range for the p-value is determined using the table of simulated critical points in the \code{print} function but not reported. } \author{Claudio Agostinelli and Ulric Lund} \references{ Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Section 7.4, World Scientific Press, Singapore. Rao, J.S. (1976). Some tests based on arc-lengths for the circle. Sankhya, The Indian Journal of Statistics, Serial B(4), 38, 329-338. Russell, G.S. and Levitin, D.J. (1995). An expanded table of probability values for Rao's Spacing Test. Communications in Statistics - Simulation and Computation, 24, 4, 879-888. } \seealso{ \code{\link{range.circular}}, \code{\link{kuiper.test}}, \code{\link{rayleigh.test}} and \code{\link{watson.test}} } \examples{ x <- circular(runif(200, 0, 2*pi)) rao.spacing.test(x) res <- print(rao.spacing.test(x, alpha=0.1)) res$accepted x <- rvonmises(100, circular(0), 20) rao.spacing.test(x) } \keyword{htest} circular/man/ticks.circular.Rd0000644000176200001440000000144111312211557016036 0ustar liggesusers\name{ticks.circular} \alias{ticks.circular} \title{Draw Tick-Marks in a Circular Plot} \description{ Draw tick-marks in a circular plot. } \usage{ ticks.circular(x, template = c("none", "geographics"), zero = NULL, rotation = NULL, tcl = 0.025, col = NULL, \dots) } \arguments{ \item{x}{the points at which tick-marks are to be drawn.} \item{template}{either \code{none} or \code{geographics}.} \item{zero}{the zero of the plot (in radians).} \item{rotation}{the rotation of the plot.} \item{col}{color for the tick marks. If \code{NULL}, function uses `par("col.axis")'. } \item{tcl}{The length of tick marks.} \item{\dots}{parameters passed to \code{line.default}.} } \author{Claudio Agostinelli} \seealso{ \code{\link{plot.circular}} and \code{\link{axis.circular}}. } \keyword{hplot} circular/man/rose.diag.Rd0000644000176200001440000001255214470153537015011 0ustar liggesusers\name{rose.diag} \title{Rose Diagram} \alias{rose.diag} \description{ Creates a rose diagram of a circular data set on the current graphics device.} \usage{rose.diag(x, pch = 16, cex = 1, axes = TRUE, shrink = 1, bins = NULL, upper = TRUE, ticks = TRUE, tcl = 0.025, tcl.text = 0.125, radii.scale = c("sqrt", "linear"), border=NULL, col=NULL, tol = 0.04, uin = NULL, xlim = c(-1, 1), ylim = c(-1, 1), prop = 1, digits = 2, plot.info = NULL, units = NULL, template = NULL, zero = NULL, rotation = NULL, main = NULL, sub = NULL, xlab = "", ylab = "", add = FALSE, control.circle = circle.control(), ...) } \arguments{ \item{x}{a vector, matrix or data.frame. The object is coerced to class \code{\link{circular}}.} \item{pch}{point character to use. See help on \code{\link{par}}.} \item{cex}{point character size. See help on \code{\link{par}}.} \item{axes}{logical: if \code{TRUE} axes are plotted according to properties of \code{x}.} \item{shrink}{parameter that controls the size of the plotted circle. Default is 1. Larger values shrink the circle, while smaller values enlarge the circle.} \item{bins}{number of arcs to partition the circle with.} \item{upper}{therose diagram cells are "upper"-closed intervals.} \item{ticks}{logical: if \code{TRUE} ticks are plotted according to the value of \code{bins}.} \item{tcl}{length of the ticks.} \item{tcl.text}{the position of the axis labels.} \item{radii.scale}{make possible to choose sector radius form: square-root of relative frequency (\code{sqrt}, default) or conventional linear scale (\code{linear}).} \item{border}{the color to draw the border. The default, \code{NULL}, means to use \code{par("fg")}. Use \code{border = NA} to omit borders.} \item{col}{the color for filling the rose diagram. The default, \code{NULL}, is to leave rose diagram unfilled. color of the points. The values are recycled if needed.} \item{tol}{proportion of white space at the margins of plot.} \item{uin}{desired values for the units per inch parameter. If of length 1, the desired units per inch on the x axis.} \item{xlim, ylim}{the ranges to be encompassed by the x and y axes. Useful for centering the plot.} \item{prop}{numerical constant determining the radii of the sectors. By default, prop = 1.} \item{digits}{number of digits used to print axis values.} \item{plot.info}{an object from \code{\link{plot.circular}} that contains information on the \code{zero}, the \code{rotation} and \code{next.points}.} \item{units}{the \code{units} used in the plot. If \code{NULL} the \code{units} of the first component of 'x' is used.} \item{template}{the template of the plot. Ignored if \code{plot.info} is provided.} \item{zero}{the zero of the plot. Ignored if \code{plot.info} or \code{template} are provided.} \item{rotation}{the rotation of the plot. Ignored if \code{plot.info} or \code{template} are provided.} \item{main, sub, xlab, ylab}{title, subtitle, x label and y label of the plot.} \item{add}{add the rose diag to an existing plot.} \item{control.circle}{parameters passed to \code{\link{plot.default}} in order to draw the circle. The function \code{\link{circle.control}} is used to set the parameters.} \item{...}{further parameters passed to \code{\link{polygon}}.} } \value{ a list with information on the plot: zero, rotation and next.points. } \note{some codes from \code{\link{eqscplot}} in MASS is used. Since version 0.4-1 the meaning of the \code{col} parameter is changed.} \details{ The circumference of the circle is split into groups, the number of groups specified by bins. For each group, a sector is drawn. The radii of the sectors are by default equal to the square root of the relative frequencies of observations in each group. This ensures that the area of the sector is proportional to the group frequency. The length of the radii can be controlled by varying the parameter prop. Since version 0.3-9 the intervals are on the form [a,b). } \author{Claudio Agostinelli, Ulric Lund and Hiroyoshi Arai} \seealso{ \code{\link{plot.circular}} } \examples{ # Generate uniform data and create several rose diagrams. # Some optional parameters may be needed to optimize plots. x <- circular(runif(50, 0, 2*pi)) rose.diag(x, bins = 18, main = 'Uniform Data') points(x) # Generate von Mises data and create several rose diagrams. x <- rvonmises(n=50, mu=circular(0), kappa=5, control.circular=list(zero=pi/4)) y <- rose.diag(x, bins=18) # Points fall out of bounds. points(x, plot.info=y, stack=TRUE) y <- rose.diag(x, bins=18, prop=1.5, shrink=1.5) # Adjust optional parameters to fit ######## all points on plot. points(x, plot.info=y, stack=TRUE) # Add the rose diag to a plot plot(x) rose.diag(x, bins=12, add=TRUE, col=2) # Examples on using radii.scale and prop with a dummy dataset where # highest proportion is 50\% in bin 2 x <- c(2, 2, 2, 2, 5, 5, 10, 20) circ.x <- circular::circular(x, units = "hours", template = "clock24") old_par <- par(mfrow = c(2, 2)) rose.diag(circ.x, bins=24, main="radii.scale=linear, prop=1", radii.scale="linear", prop=1) rose.diag(circ.x, bins=24, main = "radii.scale=linear, prop=2", radii.scale="linear", prop=2) rose.diag(circ.x, bins=24, main = "radii.scale=sqrt, prop=1", radii.scale="sqrt", prop=1) rose.diag(circ.x, bins=24, main = "radii.scale=sqrt, prop=sqrt(2)", radii.scale="sqrt", prop=sqrt(2)) par(old_par) } \keyword{hplot} circular/man/projectednormal.Rd0000644000176200001440000000405213124713765016322 0ustar liggesusers\name{projected bivariate normal on the circle} \alias{dpnorm} \alias{rpnorm} \title{ Projected bivariate normal on the circle } \description{ The projected normal distribution provides a flexible distribution for circular data, e.g., asymmetry and possible bimodality. } \usage{ dpnorm(x, mu, sigma, log = FALSE) rpnorm(n, mu, sigma, control.circular=list()) } \arguments{ \item{x}{a vector. The \code{x} and \code{q} objects are coerced to class \code{\link{circular}}. } \item{n}{number of observations.} \item{mu}{the mean vector of the bivariate normal.} \item{sigma}{the 2x2 variance and covariance matrix of the bivariate normal.} \item{log}{logical. If \code{TRUE} the log of the density is reported.} \item{control.circular}{the attribute of the resulting object.} } \value{\code{dpnorm} gives the density, \code{rpnorm} generates random deviates.} \references{ S.R. Jammalamadaka and A. SenGupta (2001). Topics in Circular Statistics, Section 2.2.4, World Scientific Press, Singapore. K.V. Mardia (1972). Statistics of Directional Data. Academic Press. London and New York. F. Wang and A.E. Gelfand (2013). Directional data analysis under the general projected normal distribution. Stat Methodol. 10(1):113-127. doi:10.1016/j.stamet.2012.07.005. } \author{ Claudio Agostinelli } \examples{ data1 <- rpnorm(100, mu=c(0,0), sigma=diag(2), control.circular=list(units="degrees")) # Uniform on the circle plot(data1) ff <- function(x) dpnorm(x, mu=c(0,0), sigma=diag(2)) # Uniform on the circle curve.circular(ff, join=TRUE, main="Density of a Projected Normal Distribution \n mu=(0,0), sigma=diag(2)") ff <- function(x) dpnorm(x, mu=c(1,1), sigma=diag(2)) # Unimodal curve.circular(ff, join=TRUE, xlim=c(-1, 2.3), main="Density of a Projected Normal Distribution \n mu=(1,1), sigma=diag(2)") sigma <- matrix(c(1,0.9,0.9,1), nrow=2) ff <- function(x) dpnorm(x, mu=c(0.5,0.5), sigma=sigma) # Bimodal curve.circular(ff, join=TRUE, xlim=c(-1, 2.3), main="Density of a Projected Normal Distribution \n mu=(0.5,0.5), rho=0.9") } \keyword{distribution} circular/man/circularp.Rd0000644000176200001440000000217011312211557015102 0ustar liggesusers\name{circularp} \alias{circularp} \alias{circularp<-} \title{Attributes for a Circular Object} \description{ `circularp' returns the `circularp' attribute (or `NULL'). `circularp<-' sets the `circularp' attribute. } \usage{ circularp(x) circularp(x) <- value } \arguments{ \item{x}{a vector or a matrix of circular data.} \item{value}{a vector of length 6 or a list with six components: type, units, template, modulo, zero and rotation.} } \details{ The \code{circularp} attribute is a list of six elements: type, units, template, modulo, zero and rotation; see \code{\link{circular}} for their meaning. Assignments are checked for consistency. Assigning \code{NULL} removes the \code{circularp} attribute and any \code{"circular"} class of \code{x}. } \author{Claudio Agostinelli} \seealso{\code{\link{circular}}} \examples{ x <- pi circularp(x) # now NULL circularp(x) <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") circularp(x) x class(x) <- "circular" # now we set also the class so that print.circular is used x } \keyword{misc } circular/man/fisherB18.Rd0000644000176200001440000000200514470146310014650 0ustar liggesusers\name{fisherB18} \alias{fisherB18} \alias{fisherB18c} \title{B.18 Wind direction and ozone concentration.} \usage{ data(fisherB18) data(fisherB18c) } \description{ 19 measurements of wind direction 'theta' and ozone level 'x' taken at 6.00am at four-day intervals between April 18th and June 29th, 1975 at a weather station in Milwaukee. } \format{ \code{fisherB18} is a \code{\link{data.frame}} of integer value. \code{fisherB18c} is a \code{\link{data.frame}} that contains the same observations, but in the first column, the data is a \code{\link{circular}} object. } \source{ N.I. Fisher (1993) pag. 251. Johnson & Wehrly (1977, Table 1). } \references{ N.I. Fisher (1993) Statistical analysis of circular data. Cambridge University Press. } \examples{ data(fisherB18) data(fisherB18c) par(mfcol=c(1,3)) plot(fisherB18c$theta, xlab=expression(theta)) boxplot(fisherB18c$x, xlab="x") plot(c(fisherB18$x, fisherB18$x), c(fisherB18$theta, fisherB18$theta+360), xlab="x", ylab=expression(theta)) } \keyword{datasets} circular/man/coord2rad.Rd0000644000176200001440000000140511424556067015011 0ustar liggesusers\name{coord2rad} \alias{coord2rad} \title{ Angles between a vector and the x-axis } \description{ From coordinates of the end point of a vector in 2 dimensions to the angle between this vector and the x-axis } \usage{ coord2rad(x, y = NULL, control.circular = list()) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{a \code{matrix} or a \code{data.frame} with two columns if y is \code{NULL} otherwise a vector.} \item{y}{a vector.} \item{control.circular}{the attribute of the resulting object.} } \value{ an object of class \code{\link{circular}} } \author{ Claudio Agostinelli and Frederick T. Wehrle } \seealso{ \code{\link{circular}} } \examples{ set.seed(1234) x <- cbind(rnorm(20), rnorm(20)) y <- coord2rad(x) } circular/man/fisherB2.Rd0000644000176200001440000000154611312211557014570 0ustar liggesusers\name{fisherB2} \alias{fisherB2} \alias{fisherB2c} \title{B.2 Measurements of long-axis orientation of 133 feldspar laths in basalt} \usage{ data(fisherB2) data(fisherB2c) } \description{ Measurements of long-axis orientation of 133 feldspar laths in basalt } \format{ \code{fisherB2} is a vector of 133 observations (in degrees). \code{fisherB2c} contains the same observations in a circular objects. } \source{ Smith, N.M. (1988) Reconstruction of the Tertiary drainage systems of the Inverell region. Unpublished B.Sc. (Hons.) thesis, Department of Geography, University of Sydney, Australia. This dataset (set 28-6-1co.prn) was kindly supplied by Ms Nicola Smith to Prof. N.I. Fisher. } \seealso{ N.I. Fisher (1993) Statistical analysis of circular data. Cambridge University Press. Pag. 240. } \examples{ data(fisherB2c) plot(fisherB2c) } \keyword{datasets} circular/man/dist.circular.Rd0000644000176200001440000000675711314430277015707 0ustar liggesusers\name{dist.circular} \alias{dist.circular} \concept{dissimilarity} \title{Distance Matrix Computation for Circular Data} \description{ This function computes and returns the distance matrix computed by using the specified distance measure to compute the distances between the rows of a data matrix containing circular data. } \usage{ dist.circular(x, method = "correlation", diag = FALSE, upper = FALSE) } \arguments{ \item{x}{a numeric matrix of class \code{\link{circular}}.} \item{method}{the distance measure to be used. This must be one of \code{"correlation"}, \code{"angularseparation"}, \code{"chord"}, \code{"geodesic"}. Any unambiguous substring can be given.} \item{diag}{logical value indicating whether the diagonal of the distance matrix should be printed by \code{print.dist}.} \item{upper}{logical value indicating whether the upper triangle of the distance matrix should be printed by \code{print.dist}.} } \details{ Available distance measures are (written for two vectors \eqn{x} and \eqn{y}): \describe{ \item{\code{correlation}:}{\eqn{\sqrt{1 - \rho}}{sqrt(1-rho)} where \eqn{\rho}{rho} is the Circular Correlation coefficient defined as \deqn{\frac{\sum_{i=1}^n \sin(x_i - \mu_x) \sin(y_i - \mu_y)}{\sqrt{\sum_{i=1}^n \sin^2(x_i - \mu_x) \sum_{i=1}^n \sin^2(y_i - \mu_y)}}}{sum(sin(x - mux)*sin(y - muy))/(sum(sin(x - mux)^2)*sum(sin(y - muy)^2))^(1/2)} and \eqn{\mu_x}{mux}, \eqn{\mu_y}{muy} are the mean direction of the two vectors} \item{\code{angularseparation}:}{\eqn{\sum_{i=1}^n 1 - cos(x_i - y_i)}{sum(1 - cos(x - y))}} \item{\code{chord}:}{\eqn{\sum_{i=1}^n \sqrt{2 (1 - \cos(x_i - y_i))}}{sum(sqrt(2 (1 - cos(x - y))))}} \item{\code{geodesic}:}{\eqn{\sum_{i=1}^n \pi - |\pi - |x_i - y_i||}{sum(pi - abs(pi - abs(x - y)))} where the abs(x - y) is expressed with an angle in [-pi,pi]} } Missing values are allowed, and are excluded from all computations involving the rows within which they occur. Further, when \code{Inf} values are involved, all pairs of values are excluded when their contribution to the distance gave \code{NaN} or \code{NA}. \cr If some columns are excluded in calculating the sum is scaled up proportionally to the number of columns used. If all pairs are excluded when calculating a particular distance, the value is \code{NA}. } \value{ \code{dist.circular} returns an object of class \code{"dist"}. The lower triangle of the distance matrix stored by columns in a vector, say \code{do}. If \code{n} is the number of observations, i.e., \code{n <- attr(do, "Size")}, then for \eqn{i < j <= n}, the dissimilarity between (row) i and j is \code{do[n*(i-1) - i*(i-1)/2 + j-i]}. The length of the vector is \eqn{n*(n-1)/2}, i.e., of order \eqn{n^2}. The object has the following attributes (besides \code{"class"} equal to \code{"dist"}): \item{Size}{integer, the number of observations in the dataset.} \item{Labels}{optionally, contains the labels, if any, of the observations of the dataset.} \item{Diag, Upper}{logicals corresponding to the arguments \code{diag} and \code{upper} above, specifying how the object should be printed.} \item{call}{optionally, the \code{\link{call}} used to create the object.} \item{method}{optionally, the distance method used; resulting from \code{\link{dist.circular}()}, the (\code{\link{match.arg}()}ed) \code{method} argument.} } %\references{ %} \seealso{ \code{\link[stats]{dist}} } %\examples{ % %} \keyword{multivariate} \keyword{cluster} circular/man/fisherB13.Rd0000644000176200001440000000167111402433466014656 0ustar liggesusers\name{fisherB13} \alias{fisherB13} \alias{fisherB13c} \title{B.13: Orientations of termite mounds} \usage{ data(fisherB13) data(fisherB13c) } \description{ Orientations of termite mounds of Amitermes laurensis at 14 sites in Cape York Penisula, North Queensland. } \format{ \code{fisherB13} a list of 14 datasets (axes in degrees) at several locations. \code{fisherB13c} contains the same observations in a circular objects.} \details{ Set 1: n=100, Latitude -15'43'', Longitude 144'42'' Set 2: n=50, Latitude -15'32'', Longitude 144'17'' } \source{ A.V. Spain, T. Okello-Oloya and R.D. John (1983) Orientation of the termitaria of two species of Amitermes (Isoptera:Termitinae) from Northern Queensland. Aust. J. Zoo. (31):167-177. } \references{ N.I. Fisher (1993) Statistical analysis of circular data. Cambridge University Press. Pag. 246. } \examples{ data(fisherB13c) plot(fisherB13c$set1, stack=TRUE, shrink=1.5) } \keyword{datasets} circular/man/arrows.circular.Rd0000644000176200001440000000315314470146310016242 0ustar liggesusers\name{arrows.circular} \alias{arrows.circular} \title{Add Arrows to a Circular Plot} \description{ Draw arrows in a circular plot. } \usage{ arrows.circular(x, y = NULL, x0 = 0, y0 = 0, na.rm = FALSE, shrink = 1, plot.info = NULL, zero = NULL, rotation = NULL, ...) } \arguments{ \item{x}{a vector. The object is coerced to class \code{\link{circular}}.} \item{y}{a vector with the same length as \code{x}.} \item{x0}{a vector of origins (x axis).} \item{y0}{a vector of origins (y axis).} \item{na.rm}{logical, indicating if \code{\link{NA}}'s should be omitted.} \item{shrink}{parameter that controls the size of the plotted circle. Default is 1. Larger values shrink the circle, while smaller values enlarge the circle.} \item{plot.info}{an object from \code{\link{plot.circular}} that contains information on the \code{zero}, the \code{rotation} and \code{next.points}.} \item{zero}{the zero used in the plot. Ignored if \code{plot.info} is provided.} \item{rotation}{the rotation used in the plot. Ignored if \code{plot.info} is provided.} \item{\dots}{further parameters passed to \code{\link{arrows}}.} } \author{Claudio Agostinelli} \note{The function call \code{\link{arrows}} and it is not a method of \code{\link{arrows}}.} \seealso{\code{\link{arrows}}} \examples{ plot(rvonmises(10, circular(0), kappa=1)) arrows.circular(rvonmises(10, circular(0), kappa=1)) arrows.circular(rvonmises(10, circular(0), kappa=1), y=runif(10), col=2) arrows.circular(rvonmises(10, circular(0), kappa=1), y=runif(10), x0=runif(10, -1, 1), y0=runif(10, -1, 1), col=3) } \keyword{aplot} \keyword{hplot} circular/man/deg.Rd0000644000176200001440000000103111312211557013650 0ustar liggesusers\name{deg} \title{Degrees} \alias{deg} \description{ Converts radians to degrees. } \usage{ deg(x) } \arguments{ \item{x}{vector or matrix of radian measurements.} } \value{ Returns a vector or matrix of degree measurements corresponding to the data in radians. } \details{This function is available for compatibility with the CircStats package; please use \code{\link{conversion.circular}}.} \author{Claudio Agostinelli and Ulric Lund} \seealso{ \code{\link{conversion.circular}} and \code{\link{rad}} } \keyword{math} circular/man/I.1.Rd0000644000176200001440000000063011611533546013453 0ustar liggesusers\name{I.1} \title{First Order Bessel Function of the First Kind} \alias{I.1} \description{ An alias of \code{besselI(x, nu=1)}. } \usage{ I.1(x) } \arguments{ \item{x}{non-negative numerical value at which to evaluate the Bessel function.} } \value{ Returns the first order Bessel function of the first kind, evaluated at a specified real number. } \seealso{ \code{\link{besselI}}. } \keyword{math} circular/man/circular-package.Rd0000644000176200001440000000534514211403732016321 0ustar liggesusers\name{Circular} \alias{Circular} \alias{circular-package} \title{Package `circular': summary information} \description{ The package `circular' provides functions for the statistical analysis and graphics representation of circular data (observations which are angles). It originally started as a porting from S-plus to R of functions developed for the book: Circular Statistics, from "Topics in circular Statistics" (2001) S. Rao Jammalamadaka and A. SenGupta, World Scientific. Now, it has an S3 implementation and several new functions and datasets. } \section{Version}{ The version level of the package is given by the command \code{packageDescription("circular")}. The most recent version of the package can be obtained from the R-Forge repository at \url{https://r-forge.r-project.org/projects/circular/} } \section{Author}{ Claudio Agostinelli, Department of Mathematics University of Trento, Italy (\url{http://datascience.maths.unitn.it/~claudio/}) Ulric Lund, Department of Statistics, California Polytechnic State University, San Luis Obispo, California, USA (\url{https://statistics.calpoly.edu/ulric-lund}) } \section{Licence}{ This package and its documentation are usable under the terms of the "GNU General Public License", a copy of which is distributed with the package. While the software is freely usable, it would be appreciated if a reference is inserted in publications or other work which makes use of it; for this purpose, see the command \code{citation("circular")}. } \section{Acknowledgements}{ The package has evolved through several versions, developed over some years. Many thanks to all that points out bugs, provide suggestions and comments. The functions \code{median} and \code{medianHS} are developed together with Alessandro Gagliardi \url{mailto:alessandro.gagliardi@unipd.it} The functions \code{watson.wiliams.test} and \code{wallraff.test} are developed by Jean-Olivier Irisson (\url{https://www.obs-vlfr.fr/~irisson/}) The functions \code{dcarthwrite}, \code{dgenvonmises}, \code{(d,r)katojones}, \code{djonespewsey} are developed by Federico Rotolo The function \code{rose.diag} has contribution by Hiroyoshi Arai (\url{mailto:h_arai@aoni.waseda.jp}) The function \code{windrose} is developed by Matthew Pocernich Dataset \code{swallows} is kindly provided by Dimitri Giunchi \url{http://unimap.unipi.it/cercapersone/dettaglio.php?ri=2504&template=dettaglio.tpl} The function \code{bw.circular} is developed together with Eduardo Garcia Portugues \url{https://egarpor.github.io/} If I miss to report your contribution please let me know by email at \url{mailto:claudio.agostinelli@unitn.it} } \keyword{circle} \keyword{circular} \keyword{distribution} \keyword{univariate} \keyword{hplot} \keyword{htest} circular/man/totalvariation.circular.Rd0000644000176200001440000000620314470146310017764 0ustar liggesusers\name{totalvariation.circular} \alias{totalvariation.circular} \title{ Conditional total variation distance between two circular samples. } \description{ The total variation distance between two circular samples is evaluated conditional on a circular modal region. } \usage{ totalvariation.circular(x, y, z = NULL, q = 0.95, bw, adjust = 1, type = c("K", "L"), kernel = c("vonmises", "wrappednormal"), na.rm = FALSE, step = 0.001, eps.lower = 10^(-4), eps.upper = 10^(-4), ...) } \arguments{ \item{x}{numeric or an object of class \code{\link{circular}}.} \item{y}{numeric or an object of class \code{\link{circular}}.} \item{z}{numeric or object of class \code{\link{circular}}. The grid were the kernel density estimate will be evaluated. If \code{NULL} equally spaced points in the interval [0,2*pi) with step \code{step}.} \item{q}{numeric in the interval [0,1]. The quantile of the modal region.} \item{bw}{the smoothing bandwidth to be used. When the \code{kernel} is \code{vonmises} the bandwidth is equal to the concentration parameter.} \item{adjust}{the bandwidth used is actually \code{adjust*bw}. This makes it easy to specify values like ``half the default bandwidth''.} \item{type}{Not Yet Used.} \item{kernel}{a character string giving the smoothing kernel to be used. This must be one of \code{"vonmises"} or \code{"wrappednormal"}, that are kernels of \code{type} \code{"K"}.} \item{na.rm}{logical; if \code{TRUE}, missing values are removed from \code{x}. If \code{FALSE} any missing values cause an error.} \item{step}{numeric. Used in the construction of the regular grid \code{z}.} \item{eps.lower,eps.upper}{the cut point in the density is searched in the interval [min(density)*(1+eps.lower),max(density)*(1-eps.upper)].} \item{\dots}{further arguments passed to the \code{modal.region.circular} function. Not used at present.} } \value{ A list of class \code{totalvariation.circular} with the following components \item{tv}{the (conditional) total variation.} \item{ovl}{the (conditional) overlapping coefficient.} \item{q}{the order of the modal regions.} \item{bw}{the bandwidth value as in input.} \item{modal.x}{an object of class \code{\link{modal.region.circular}} for the \code{x} data set.} \item{modal.y}{an object of class \code{\link{modal.region.circular}} for the \code{y} data set.} \item{density.x}{an object of class \code{\link{density.circular}} for the \code{x} data set.} \item{density.y}{an object of class \code{\link{density.circular}} for the \code{y} data set.} \item{density}{a function which report the positive part of the difference between the estimated density of the two data sets.} } \references{ L.G.R. Oliveira-Santos, C.A. Zucco and C. Agostinelli (2013) Using conditional circular kernel density functions to test hypotheses on animal circadian activity. Animal Behaviour, 85(1) 269-280. } \author{ Claudio Agostinelli } \seealso{ \code{\link{modal.region.circular}} } \examples{ x <- rvonmises(100, circular(pi), 10) y <- rvonmises(100, circular(pi+pi/8), 10) res <- totalvariation.circular(x,y,bw=50) plot(res) } \keyword{univariate} circular/man/Extract.circular.Rd0000644000176200001440000000103111312211557016326 0ustar liggesusers\name{[.circular} \title{Extract or Replace Parts of a Circular Object} \alias{[.circular} \description{ Operators act on vectors and matrices to extract or replace subsets, methods for Circular Data. } \usage{ \method{[}{circular}(x, i, \dots) } \arguments{ \item{x}{object from which to extract elements.} \item{i, \dots}{elements to extract or replace.} } \author{Claudio Agostinelli} \examples{ x <- circular(matrix(rwrappednormal(n=100, mu=circular(0)), nrow=5)) dim(x) x[1,] x[,1] x[,1, drop=FALSE] } \keyword{array} circular/man/rho.circular.Rd0000644000176200001440000000214411312211557015512 0ustar liggesusers\name{rho.circular} \title{Mean Resultant Length} \alias{rho.circular} \description{ Returns the mean resultant length of a vector of circular data. } \usage{ rho.circular(x, na.rm = FALSE) } \arguments{ \item{x}{a vector. The object is coerced to class \code{\link{circular}}.} \item{na.rm}{logical, indicating if \code{\link{NA}}'s should be omitted.} } \value{ Returns the mean resultant length of data. } \details{ Each observation is treated as a unit vector, or point on the unit circle. The resultant vector of the observations is found, and the length of the resultant vector divided by the sample size is returned. } \author{Claudio Agostinelli and Ulric Lund} \references{ Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Section 1.3, World Scientific Press, Singapore. } \seealso{ \code{\link{mean.circular}}, \code{\link{var.circular}}, \code{\link{summary.circular}} and \code{\link{mle.vonmises}}. } \examples{ # Compute the mean resultant length of a random sample of observations. data <- circular(runif(100, 0, 2*pi)) rho.circular(data) } \keyword{univar} circular/man/turtles.Rd0000644000176200001440000000200611402365171014620 0ustar liggesusers\name{turtles} \alias{turtles} \docType{data} \title{ Arrival directions of displaced sea turtles} \description{ The _turtles_ dataset has 10 rows and 2 columns. The observations are the directions from which 10 green sea turtles approached their nesting island (Ascension Island, South Atlantic Ocean) after having been displaced to open-sea sites. } \usage{data(turtles)} \format{ A data frame with 10 observations on the following 2 variables. \describe{ \item{\code{id}}{a numeric vector: the turtle ID} \item{\code{arrival}}{a numeric vector: the direction of arrival to Ascension Island} } } \source{ Luschi, P., Akesson, S., Broderick, A. C., Glen, F., Godley, B. J., Papi F., and Hays, G. C. (2001) Testing the navigational abilities of ocean migrants: displacement experiments on green sea turtles (_Chelonia mydas_). Behav. Ecol. Sociobiol. (50):528-534. } \examples{ data(turtles) turtles[,2] <- circular(turtles[,2], units='degrees', template='geographics') plot(turtles[,2]) } \keyword{datasets} circular/man/plot.lsfit.circle.Rd0000644000176200001440000000226011312211557016454 0ustar liggesusers\name{plot.lsfit.circle} \alias{plot.lsfit.circle} \title{Plot method for lsfit.circle function} \description{ This is a plot method for objects of class \code{lsfit.circle}. } \usage{ \method{plot}{lsfit.circle}(x, add = FALSE, main = NULL, xlim = NULL, ylim = NULL, xlab = NULL, ylab = NULL, uin, tol = 0.04, plus.cex = 1, ...) } \arguments{ \item{x}{an object of class \code{lsfit.circle}.} \item{add}{logical: if \code{TRUE} the plot is superimposed on the active device.} \item{main}{a main title for the plot.} \item{xlim}{the x limits (min,max) of the plot.} \item{ylim}{the y limits of the plot.} \item{xlab}{a label for the x axis.} \item{ylab}{a label for the x axis.} \item{uin}{desired values for the units per inch parameter. If of length 1, the desired units per inch on the x axis.} \item{tol}{proportion of white space at the margins of plot.} \item{plus.cex}{dimension of the cross in the center of the circle.} \item{\dots}{further arguments passed to the next method.} } \author{Claudio Agostinelli and Ulric Lund} \seealso{\code{\link{lsfit.circle}}} \examples{ data(coope) res <- lsfit.circle(x=x.coope, y=y.coope) plot(res) } \keyword{hplot} circular/man/minusPiPlusPi.Rd0000644000176200001440000000076712236421404015711 0ustar liggesusers\name{minusPiPlusPi} \alias{minusPiPlusPi} \title{ return angles in the [-pi,pi] interval. } \description{ return angles in the (-pi,pi] interval. } \usage{ minusPiPlusPi(x) } \arguments{ \item{x}{an object of class \code{\link{circular}}.} } \value{ a \code{\link{circular}} object with values in the interval (-pi,pi]. } \author{ Claudio Agostinelli and Alessandro Gagliardi } \examples{ x <- circular(c(0, 90, 180, 270), units="degrees") minusPiPlusPi(x) } \keyword{univariate} circular/man/angular.variance.Rd0000644000176200001440000000216714470146310016346 0ustar liggesusers\name{angular.variance} \title{A measure of variance for Circular Data} \alias{angular.variance} \description{ Returns twice one minus the mean resultant length divided by the sample size of a vector of circular data. } \usage{ angular.variance(x, na.rm = FALSE) } \arguments{ \item{x}{a vector. The object is coerced to class \code{\link{circular}}.} \item{na.rm}{logical, indicating if \code{\link{NA}}'s should be omitted.} } \value{ Returns twice one minus the mean resultant length divided by the sample size. } \author{Claudio Agostinelli} \references{ Batschelet, E. (1981) Circular Statistics in Biology. Academic Press, London. Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Section 1.3, World Scientific Press, Singapore. Zar, J.H. (2010) Biostatistical Analysis. Fifth edition. Pearson Educational International. } \seealso{ \code{\link{var.circular}}, \code{\link{angular.deviation}}, \code{\link{mean.circular}}, \code{\link{rho.circular}} and \code{\link{summary.circular}}. } \examples{ x <- rvonmises(n=100, mu=circular(0), kappa=1) angular.variance(x) } \keyword{univar} circular/man/c.circular.Rd0000644000176200001440000000154312017361504015147 0ustar liggesusers\name{c.circular} \alias{c.circular} \title{A method for circular object, which combines its arguments} \description{ A method for circular object, which combines its arguments } \usage{ \method{c}{circular}(..., recursive = FALSE) } \arguments{ \item{\dots}{vectors, the first of which of class \code{circular}.} \item{recursive}{logical. If 'recursive=TRUE', the function recursively descends through lists combining all their elements into a vector. } } \author{Claudio Agostinelli} \seealso{\code{\link{c}} } \examples{ x <- rvonmises(10, circular(0), 10) y <- rvonmises(10, circular(0), 10, control.circular=list(units="degrees")) z <- runif(10, 0, 20) # here you do not use circular properties, #####but you mean it is measured in degrees c(x, y, z) # While y is converted in radians, z is treated as it was! } \keyword{manip} circular/man/A1inv.Rd0000644000176200001440000000272011611533463014102 0ustar liggesusers\name{A1inv} \title{Inverse of A1} \alias{A1inv} \description{ Inverse function of the ratio of the first and zeroth order Bessel functions of the first kind. This function is used to compute the maximum likelihood estimate of the concentration parameter of a von Mises distribution. } \usage{ A1inv(x) } \arguments{ \item{x}{numeric value in the interval between 0 and 1.} } \value{ Returns the value k, such that A1inv(x) = k, i.e. A1(k) = x. } \details{ A1inv(0) = 0 and A1inv(1) = Inf. This function is useful in estimating the concentration parameter of data from a von Mises distribution. Our function use the results in Best and Fisher (1981). Tables use tabulated values by Gumbel, Greenwood and Durand (1953). } \author{Claudio Agostinelli} \references{ BEST, D.J. and FISHER, N.I. 1981. The bias of the maximum likelihood estimators for the von Mises-Fisher concentration parameters. Communications in Statistics, 10, 493-502. GUMBEL, E.J., GREENWOOD, J.A. AND DURAND, D. 1953. The circular normal distribution: theory and tables. J. Amer. Statis. Assoc., 48, 131-152. } \seealso{ \code{\link{mle.vonmises}}, \code{\link{A1}}, \code{\link{besselI}}. } \examples{ #Generate data from a von Mises distribution data <- rvonmises(n=50, mu=circular(pi), kappa=4) #Estimate the concentration parameter s <- sum(sin(data)) c <- sum(cos(data)) mean.dir <- atan2(s, c) kappa <- A1inv(mean(cos(data - mean.dir))) } \keyword{math} circular/man/I.0.Rd0000644000176200001440000000062711611533534013455 0ustar liggesusers\name{I.0} \title{Zeroth Order Bessel Function of the First Kind} \alias{I.0} \description{ An alias of \code{besselI(x, nu=0)}. } \usage{ I.0(x) } \arguments{ \item{x}{non-negative numerical value at which to evaluate the Bessel function.} } \value{ Returns the zeroth order Bessel function of the first kind evaluated at a specified real number. } \seealso{ \code{\link{besselI}}. } \keyword{math} circular/man/wrappedcauchy.Rd0000644000176200001440000000250711312211557015761 0ustar liggesusers\name{wrappedCauchy} \title{Wrapped Cauchy Density Function} \alias{dwrappedcauchy} \alias{rwrappedcauchy} \description{ Density, and random generation for the wrapped Cauchy circular distribution. } \usage{ dwrappedcauchy(x, mu = circular(0), rho = exp(-1)) rwrappedcauchy(n, mu = circular(0), rho = exp(-1), control.circular=list()) } \arguments{ \item{x}{a vector. The object is coerced to class \code{\link{circular}}.} \item{n}{number of observations.} \item{mu}{mean direction of the distribution as a \code{circular} object.} \item{rho}{concentration parameter of the distribution. \code{rho} must be in the interval from 0 to 1.} \item{control.circular}{the attribute of the resulting object.} } \value{ \code{dwrappedcauchy} gives the density and \code{rwrappedcauchy} generates random deviates. } \author{Claudio Agostinelli and Ulric Lund} \references{ Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Section 2.2.7, World Scientific Press, Singapore. } \examples{ data1 <- rwrappedcauchy(100, mu=circular(0), rho=0.7, control.circular=list(units="degrees")) plot(data1) ff <- function(x) dwrappedcauchy(x, mu=circular(pi), rho=0.7) curve.circular(ff, join=TRUE, xlim=c(-2, 1), main="Density of a Wrapped Cauchy Distribution \n mu=pi, rho=0.7") } \keyword{distribution} circular/man/quantile.circular.Rd0000644000176200001440000000360314470146310016547 0ustar liggesusers\name{quantile.circular} \title{Sample Circular Quantiles} \alias{quantile.circular} \description{ The function \code{quantile.circular} produces sample circular quantiles corresponding to the given probabilities for a circular data set. } \usage{ \method{quantile}{circular}(x, probs = seq(0, 1, 0.25), na.rm=FALSE, names = TRUE, type = 7, ...) } \arguments{ \item{x}{numeric circular vector whose sample quantiles are wanted. \code{\link{NA}} and \code{NaN} values are not allowed in numeric vectors unless \code{na.rm} is \code{TRUE}.} \item{probs}{numeric vector of probabilities with values in \eqn{[0,1]}. (Values up to \samp{2e-14} outside that range are accepted and moved to the nearby endpoint.)} \item{na.rm}{logical; if true, any \code{\link{NA}} and \code{NaN}'s are removed from \code{x} before the quantiles are computed.} \item{names}{logical; if true, the result has a \code{\link{names}} attribute. Set to \code{FALSE} for speedup with many \code{probs}.} \item{type}{an integer between 1 and 9 selecting one of the nine quantile algorithms detailed below to be used.} \item{...}{further arguments passed to or from other methods. Like \code{quantile} and so on.} } \details{ A vector of length \code{length(probs)} is returned; if \code{names = TRUE}, it has a \code{\link{names}} attribute. \code{\link{NA}} and \code{\link{NaN}} values in \code{probs} are propagated to the result. The algorithm will proceed how described below: 1) Linearize the circular observations. 2) Calculate the linear median like type establish. 3) The value it will transformed in circular. } \section{Types}{ See description on documentation of \code{quantile}. } \author{ Claudio Agostinelli and Alessandro Gagliardi. } \examples{ x <- rvonmises(1001, mu=circular(pi), kappa=5) quantile.circular(x) # Extremes & Quartiles by default } \keyword{univar} circular/man/lm.circular.Rd0000644000176200001440000001704514470153537015353 0ustar liggesusers\name{lm.circular} \title{Circular-Circular and Circular-Linear Regression} \alias{lm.circular} \alias{lm.circular.cc} \alias{lm.circular.cl} \alias{print.lm.circular.cl} \description{ Fits a regression model for a circular dependent and circular independent variable or for a circular dependent and linear independent variables. } \usage{ lm.circular(..., type=c("c-c", "c-l")) lm.circular.cc(y, x, order = 1, level = 0.05, control.circular = list()) lm.circular.cl(y, x, init = NULL, verbose = FALSE, tol = 1e-10, control.circular = list()) \method{print}{lm.circular.cl}(x, digits = max(3, getOption("digits") - 3), signif.stars= getOption("show.signif.stars"), ...) } \arguments{ \item{\dots}{arguments passed to \code{lm.circular.cc} or to \code{lm.circular.cl} depending on the value of \code{type}.} \item{type}{if \code{type=="c-c"} then \code{lm.circular.cc} is called otherwise \code{lm.circular.cl} is called.} \item{y}{vector of data for the dependent circular variable.} \item{x}{vector of data for the independent circular variable if \code{type="c-c"} or \code{lm.circular.cc} is used otherwise a matrix or a vector containing the independent linear variables.} \item{order}{order of trigonometric polynomial to be fit. Order must be an integer value. By default, order=1. Used if \code{type="c-c"}.} \item{level}{level of the test for the significance of higher order trigonometric terms. Used if \code{type="c-c"}.} \item{control.circular}{the attribute of the resulting objects (\code{fitted}, \code{residuals} components in the case of \code{type=="c-c"} and \code{mu} and \code{se.mu}) otherwise.} \item{init}{a vector with initial values of length equal to the columns of \code{x}.} \item{verbose}{logical: if \code{TRUE} messages are printed while the function is running.} \item{tol}{the absolute accuracy to be used to achieve convergence of the algorithm.} \item{digits}{the number of digits to be printed.} \item{signif.stars}{logical; if \code{TRUE}, P-values are additionally encoded visually as ``significance stars'' in order to help scanning of long coefficient tables. It defaults to the \code{show.signif.stars} slot of \code{\link{options}}.} } \value{ If \code{type=="c-c"} or \code{lm.circular.cc} is called directly an object of class \code{lm.circular.cc} is returned with the following components: \item{call}{the \code{\link[base]{match.call}} result.} \item{rho}{square root of the average of the squares of the estimated conditional concentration parameters of y given x.} \item{fitted}{fitted values of the model of class \code{circular}.} \item{data}{matrix whose columns correspond to x and y.} \item{residuals}{circular residuals of the model of class \code{circular}.} \item{coefficients}{matrix whose entries are the estimated coefficients of the model. The first column corresponds to the coefficients of the model predicting the cosine of y, while the second column contains the estimates for the model predicting the sine of y. The rows of the matrix correspond to the coefficients according to increasing trigonometric order.} \item{p.values}{p-values testing whether the (order + 1) trigonometric terms are significantly different from zero.} \item{A.k}{is mean of the cosines of the circular residuals.} \item{kappa}{assuming the circular residuals come from a von Mises distribution, kappa is the MLE of the concentration parameter.} If \code{type=="c-l"} or \code{lm.circular.cl} is called directly an object of class \code{lm.circular.cc} is returned with the following components: \item{call}{the \code{\link[base]{match.call}} result.} \item{x}{the independent variables.} \item{y}{the dependent variable.} \item{mu}{the circular mean of the dependent variable of class \code{circular}.} \item{se.mu}{an estimated standard error of the circular mean with the same units of measure used for \code{mu}.} \item{kappa}{the concentration parameter for the dependent variable.} \item{se.kappa}{an estimated standard error of the concentration parameter.} \item{coefficients}{the estimated coefficients.} \item{cov.coef}{covariance matrix of the estimated coefficients.} \item{se.coef}{standard errors of the estimated coefficients.} \item{log.lik}{log-likelihood.} \item{t.values}{values of the t statistics for the coefficients.} \item{p.values}{p-values of the t statistics. Approximated values using Normal distribution.} } \details{ If \code{type=="c-c"} or \code{lm.circular.cc} is called directly a trigonometric polynomial of x is fit against the cosine and sine of y. The order of trigonometric polynomial is specified by order. Fitted values of y are obtained by taking the inverse tangent of the predicted values of sin(y) divided by the predicted values of cos(y). Details of the regression model can be found in Sarma and Jammalamadaka (1993). If \code{type=="c-l"} or \code{lm.circular.cl} is called directly, this function implements the homoscedastic version of the maximum likelihood regression model proposed by Fisher and Lee (1992). The model assumes that a circular response variable theta has a von Mises distribution with concentration parameter kappa, and mean direction related to a vector of linear predictor variables according to the relationship: mu + 2*atan(beta'*x), where mu and beta are unknown parameters, beta being a vector of regression coefficients. The function uses Green's (1984) iteratively reweighted least squares algorithm to perform the maximum likelihood estimation of kappa, mu, and beta. Standard errors of the estimates of kappa, mu, and beta are estimated via large-sample asymptotic variances using the information matrix. An estimated circular standard error of the estimate of mu is then obtained according to Fisher and Lewis (1983, Example 1). } \author{Claudio Agostinelli and Ulric Lund} \references{ Fisher, N. and Lee, A. (1992). Regression models for an angular response. Biometrics, 48, 665-677. Fisher, N. and Lewis, T. (1983). Estimating the common mean direction of several circular or spherical distributions with different dispersions. Biometrika, 70, 333-341. Green, P. (1984). Iteratively reweighted least squares for maximum likelihood estimation, and some robust and resistant alternatives. Journal of the Royal Statistical Society, B, 46, 149-192. Jammalamadaka, S. Rao and SenGupta, A. (2001). Topics in Circular Statistics, Section 8.3, World Scientific Press, Singapore. Sarma, Y. and Jammalamadaka, S. (1993). Circular Regression. Statistical Science and Data Analysis, 109-128. Proceeding of the Thrid Pacific Area Statistical Conference. VSP: Utrecht, Netherlands. } \examples{ # Generate a data set of dependent circular variables. x <- circular(runif(50, 0, 2*pi)) y <- atan2(0.15*cos(x) + 0.25*sin(x), 0.35*sin(x)) + rvonmises(n=50, mu=circular(0), kappa=5) # Fit a circular-circular regression model. circ.lm <- lm.circular(y, x, order=1) # Obtain a crude plot of the data and fitted regression line. plot.default(x, y) circ.lm$fitted[circ.lm$fitted>pi] <- circ.lm$fitted[circ.lm$fitted>pi] - 2*pi points.default(x[order(x)], circ.lm$fitted[order(x)], type='l') # Fit a circular-linear regression model and show predictions. set.seed(1234) x <- cbind(rnorm(10), rep(1, 10)) x <- cbind(rnorm(10), rep(1,10)) y <- circular(2*atan(c(x\%*\%c(5,1))))+rvonmises(10, mu=circular(0), kappa=100) lm.circular(y=y, x=x, init=c(5,1), type='c-l', verbose=TRUE) plot(y) lmC <- lm.circular(y=y, x=x, init=c(5,1), type='c-l', verbose=TRUE) p <- circular(lmC$mu+2*atan(x\%*\%lmC$coefficients)) points(p, col=2, pch= "+") } \keyword{models} \keyword{regression} circular/DESCRIPTION0000644000176200001440000000171114475703172013576 0ustar liggesusersTitle: Circular Statistics LazyLoad: yes LazyData: yes Package: circular Version: 0.5-0 Author: Ulric Lund [aut], Claudio Agostinelli [aut], Hiroyoshi Arai [ctb], Alessando Gagliardi [ctb], Eduardo García-Portugués [ctb, cre], Dimitri Giunchi [ctb], Jean-Olivier Irisson [ctb], Matthew Pocernich [ctb], Federico Rotolo [ctb] Maintainer: Eduardo García-Portugués Date: 2023-09-05 Depends: R (>= 3.0.0), stats Imports: boot, mvtnorm Description: Circular Statistics, from "Topics in circular Statistics" (2001) S. Rao Jammalamadaka and A. SenGupta, World Scientific. License: GPL-2 NeedsCompilation: yes Encoding: UTF-8 Packaged: 2023-09-05 18:36:24 UTC; Eduardo Repository: CRAN Date/Publication: 2023-09-05 19:50:18 UTC circular/tests/0000755000176200001440000000000013124712013013212 5ustar liggesuserscircular/tests/test-walraff.test.R0000644000176200001440000000153212236521622016722 0ustar liggesusers# Test data from: # Batschelet, E (1981). Circular Statistics in Biology. # Examples 6.10.1 and 6.10.2, p 126 # suppressMessages(library("circular")) # ?wallraff.test angles <- circular(c(70, 80, 80, 85, 85, 90, 95, 95, 5, 5, 15, 55, 55, 65, 105, 120, 340), units="degrees", template="geographics") group <- factor(c(rep("control", 8), rep("experimental", 9))) homeDir <- 40 # expect: # W = 2 (in wilcox.test) and p < 0.01 for the dispersion test # W = 26 (in wilcox.test) and p > 0.05 for the homing test xn <- angles wallraff.test(xn, group) wallraff.test(xn, group, ref=homeDir) wallraff.test(xn, as.factor(group), ref=homeDir) xl <- split(xn, group) wallraff.test(xl, ref=homeDir) wallraff.test(xl) xl <- split(xn, group) names(xl) <- NULL wallraff.test(xl) xd <- data.frame(group=group, angles=angles) wallraff.test(angles ~ group, xd) circular/tests/test-watson.williams.test.R0000644000176200001440000000234612236522124020435 0ustar liggesusers# Test data from: # Circular statistics in biology, Batschelet, E (1981) # §6.2, p99 # suppressMessages(library("circular")) # ?watson.williams.test angles <- circular( c(rep(c(-20, -10, 0), c(1,7,2)), rep(c(-10, 0, 10, 20), c(3,3,3,1))), units="degrees", template="geographics") group <- factor(rep(c("exp", "control"), each=10)) # expect this: # F = 8.7329, df1 = 1, df2 = 18, p-value = 0.003108 # mean of control mean of exp # 1.988969 -9.000615 # Test interfaces xn <- angles watson.williams.test(xn, group) xl <- split(xn, group) watson.williams.test(xl) xl <- split(xn, group) names(xl) <- NULL watson.williams.test(xl) xd <- data.frame(group=group, angles=angles) watson.williams.test(angles ~ group, xd) # Test the influence of ordering the groups id <- c(9, 8, 7, 4, 6, 5, 12, 18, 10, 17, 1, 19, 3, 20, 2, 16, 15, 14, 13, 11) angles <- angles[id] group <- group[id] xn <- angles watson.williams.test(xn, group) xl <- split(xn, group) watson.williams.test(xl) xd <- data.frame(group=group, angles=angles) watson.williams.test(angles ~ group, xd) # Test NAs angles[length(angles)+1] <- NA levels(group) <- c("exp", "control", "bar") group[length(group)+1] <- "bar" xn <- angles watson.williams.test(xn, group) circular/tests/test-median.R0000644000176200001440000000052212022330020015534 0ustar liggesuserssuppressMessages(library("circular")) # ?median.circular med <- median.circular(circular(c(0, pi/2, pi, 3/2*pi))) ## expect: ## median is equal to NA stopifnot( is.na(med) ) ## expect: ## all the points are minimizers of the function stopifnot( all.equal(attr(med, "medians"), c(0, pi/2, pi, 3/2*pi), tol = 2e-7) ) circular/tests/test-watson.williams.test.Rout.save0000644000176200001440000001103413124453535022122 0ustar liggesusers R version 3.4.0 (2017-04-21) -- "You Stupid Darkness" Copyright (C) 2017 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > # Test data from: > # Circular statistics in biology, Batschelet, E (1981) > # §6.2, p99 > # > > suppressMessages(library("circular")) > # ?watson.williams.test > > angles <- circular( c(rep(c(-20, -10, 0), c(1,7,2)), rep(c(-10, 0, 10, 20), c(3,3,3,1))), units="degrees", template="geographics") > group <- factor(rep(c("exp", "control"), each=10)) > > # expect this: > # F = 8.7329, df1 = 1, df2 = 18, p-value = 0.003108 > # mean of control mean of exp > # 1.988969 -9.000615 > > # Test interfaces > xn <- angles > watson.williams.test(xn, group) Watson-Williams test for homogeneity of means data: xn by group F = 8.7329, df1 = 1, df2 = 18, p-value = 0.008472 sample estimates: Circular Data: Type = angles Units = degrees Template = geographics Modulo = asis Zero = 1.570796 Rotation = clock mean of control mean of exp 1.988969 -9.000615 > > xl <- split(xn, group) > watson.williams.test(xl) Watson-Williams test for homogeneity of means data: control and exp F = 8.7329, df1 = 1, df2 = 18, p-value = 0.008472 sample estimates: Circular Data: Type = angles Units = degrees Template = geographics Modulo = asis Zero = 1.570796 Rotation = clock mean of control mean of exp 1.988969 -9.000615 > > xl <- split(xn, group) > names(xl) <- NULL > watson.williams.test(xl) Watson-Williams test for homogeneity of means data: 1 and 2 F = 8.7329, df1 = 1, df2 = 18, p-value = 0.008472 sample estimates: Circular Data: Type = angles Units = degrees Template = geographics Modulo = asis Zero = 1.570796 Rotation = clock mean of 1 mean of 2 1.988969 -9.000615 > > xd <- data.frame(group=group, angles=angles) > watson.williams.test(angles ~ group, xd) Watson-Williams test for homogeneity of means data: angles by group F = 8.7329, df1 = 1, df2 = 18, p-value = 0.008472 sample estimates: Circular Data: Type = angles Units = degrees Template = geographics Modulo = asis Zero = 1.570796 Rotation = clock mean of control mean of exp 1.988969 -9.000615 > > # Test the influence of ordering the groups > id <- c(9, 8, 7, 4, 6, 5, 12, 18, 10, 17, 1, 19, 3, 20, 2, 16, 15, 14, 13, 11) > angles <- angles[id] > group <- group[id] > > xn <- angles > watson.williams.test(xn, group) Watson-Williams test for homogeneity of means data: xn by group F = 8.7329, df1 = 1, df2 = 18, p-value = 0.008472 sample estimates: Circular Data: Type = angles Units = degrees Template = geographics Modulo = asis Zero = 1.570796 Rotation = clock mean of control mean of exp 1.988969 -9.000615 > xl <- split(xn, group) > watson.williams.test(xl) Watson-Williams test for homogeneity of means data: control and exp F = 8.7329, df1 = 1, df2 = 18, p-value = 0.008472 sample estimates: Circular Data: Type = angles Units = degrees Template = geographics Modulo = asis Zero = 1.570796 Rotation = clock mean of control mean of exp 1.988969 -9.000615 > xd <- data.frame(group=group, angles=angles) > watson.williams.test(angles ~ group, xd) Watson-Williams test for homogeneity of means data: angles by group F = 8.7329, df1 = 1, df2 = 18, p-value = 0.008472 sample estimates: Circular Data: Type = angles Units = degrees Template = geographics Modulo = asis Zero = 1.570796 Rotation = clock mean of control mean of exp 1.988969 -9.000615 > > # Test NAs > angles[length(angles)+1] <- NA > levels(group) <- c("exp", "control", "bar") > group[length(group)+1] <- "bar" > xn <- angles > watson.williams.test(xn, group) Watson-Williams test for homogeneity of means data: xn by group F = 8.7329, df1 = 1, df2 = 18, p-value = 0.008472 sample estimates: Circular Data: Type = angles Units = degrees Template = geographics Modulo = asis Zero = 1.570796 Rotation = clock mean of exp mean of control 1.988969 -9.000615 > circular/tests/test-walraff.test.Rout.save0000644000176200001440000000500413124453637020414 0ustar liggesusers R version 3.4.0 (2017-04-21) -- "You Stupid Darkness" Copyright (C) 2017 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > # Test data from: > # Batschelet, E (1981). Circular Statistics in Biology. > # Examples 6.10.1 and 6.10.2, p 126 > # > > suppressMessages(library("circular")) > # ?wallraff.test > > angles <- circular(c(70, 80, 80, 85, 85, 90, 95, 95, 5, 5, 15, 55, 55, 65, 105, 120, 340), units="degrees", template="geographics") > group <- factor(c(rep("control", 8), rep("experimental", 9))) > > homeDir <- 40 > > # expect: > # W = 2 (in wilcox.test) and p < 0.01 for the dispersion test > # W = 26 (in wilcox.test) and p > 0.05 for the homing test > > xn <- angles > wallraff.test(xn, group) Wallraff rank sum test of angular distance data: xn by group Kruskal-Wallis chi-squared = 10.77, df = 1, p-value = 0.001032 > > wallraff.test(xn, group, ref=homeDir) Wallraff rank sum test of angular distance data: xn by group Kruskal-Wallis chi-squared = 0.93278, df = 1, p-value = 0.3341 > wallraff.test(xn, as.factor(group), ref=homeDir) Wallraff rank sum test of angular distance data: xn by as.factor(group) Kruskal-Wallis chi-squared = 0.93278, df = 1, p-value = 0.3341 > > > xl <- split(xn, group) > wallraff.test(xl, ref=homeDir) Wallraff rank sum test of angular distance data: control and experimental Kruskal-Wallis chi-squared = 0.93278, df = 1, p-value = 0.3341 > wallraff.test(xl) Wallraff rank sum test of angular distance data: control and experimental Kruskal-Wallis chi-squared = 10.77, df = 1, p-value = 0.001032 > > xl <- split(xn, group) > names(xl) <- NULL > wallraff.test(xl) Wallraff rank sum test of angular distance data: 1 and 2 Kruskal-Wallis chi-squared = 10.77, df = 1, p-value = 0.001032 > > xd <- data.frame(group=group, angles=angles) > wallraff.test(angles ~ group, xd) Wallraff rank sum test of angular distance data: angles by group Kruskal-Wallis chi-squared = 10.77, df = 1, p-value = 0.001032 > circular/src/0000755000176200001440000000000014475672450012663 5ustar liggesuserscircular/src/medianHL.circular.c0000644000176200001440000000527113124754230016303 0ustar liggesusers /**************************************************************** * * * AUTHORS : CLAUDIO AGOSTINELLI and ALESSANDRO GAGLIARDI * * AIM : COMPUTE THE MEDIAN CIRCULAR * * DATA : 12 NOVEMBER 2012. * * * *****************************************************************/ #include #include #include #include #include #include "medianHL.circular.h" #include "mean.circular.h" #include "median.circular.h" void MedianHLCircularRad(double *x,double *y,int *n,int *whichMethod,double *result) { int nTotal; int cond; switch(*whichMethod) { //HL2 case 0: nTotal = *n *((*n+1))/2; cond = 1; break; //HL1 case 1: nTotal = *n *((*n-1))/2; cond = 1; break; //HL3 case 2: nTotal = *n * (*n); cond = 0; break; default: nTotal = 1; cond = 0; break; } int i,j; int k=0; double tempV[2]; double meanOfPair[nTotal]; int sizeTempv = 2; int condI = (cond)?(*n - (*whichMethod)):(*n); int initJ; for (i=0;i1) { int size=2; int allIndex[(*n)]; double meanOfPair[nTotal]; double dataRnd[2]; int i,k=0; for(i=0;i #include void rvm(double *x, int *n, double *mu, double *kappa) { /* Harry Southworth, January 2005. GENERATE RANDOM NUMBERS FROM A vonMises DISTRIBUTION. FOLLOWING THE ALGORITHM ON PAGE 43 OF MARDIA AND JUPP, DUE TO BEST AND FISHER. NOTE TAKEN OF ULRIC LUND'S IMPLEMENTATION IN S. THE ALGORITHM IS A REJECTION ALGORITHM AND RUNS SLOWLY IN S. Ported the C to R by Claudio Agostinelli, August 2006. */ int i; double U1, U2, U3; double a, b, r, z, f, c; GetRNGstate(); /* SET a, b AND r */ a = 1 + sqrt(1+4* *kappa * *kappa); b = (a - sqrt(2*a))/(2* *kappa); r = (1 + b*b)/(2*b); i = 0; do{ /* GENERATE U(0,1) RANDOM NUMBERS WITH THE R ROUTINE */ U1 = unif_rand(); z = cos(M_PI * U1); f = (1. + r * z)/(r + z); c = *kappa * (r - f); U2 = unif_rand(); if(c * (2 - c) - U2 > 0) { U3 = unif_rand(); if (U3 > 0.50) x[i] = acos(f) + *mu; else x[i] = -acos(f) + *mu; i++; } else { if(log(c/U2) + 1 - c >= 0.) { U3 = unif_rand(); if (U3 > 0.50) x[i] = acos(f) + *mu; else x[i] = -acos(f) + *mu; i++; } } } while(i < *n); PutRNGstate(); } circular/src/distance.h0000644000176200001440000000040413124754230014607 0ustar liggesusersdouble R_angularseparation(double*, int, int, int, int); double R_chord(double*, int, int, int, int); double R_geodesic(double*, int, int, int, int); double R_correlation(double*, int, int, int, int); void R_distance(double*, int*, int*, double*, int*, int*); circular/src/init.c0000644000176200001440000000231013124754230013751 0ustar liggesusers#include "mean.circular.h" #include "median.circular.h" #include "medianHL.circular.h" #include "weighted.mean.circular.h" #include "minuspipluspi.h" #include "rvonmises.h" #include "distance.h" #include "dwrappednormal.h" #include "mle.wrappednormal.h" #include #include #include #define C_DEF(name, n) {#name, (DL_FUNC) &name, n} static const R_CMethodDef CEntries[] = { C_DEF(MeanCircularRad, 3), C_DEF(MedianCircularRad, 5), C_DEF(MedianHLCircularRad, 5), C_DEF(MedianHLCircularPropRad, 5), C_DEF(sampleReplace, 4), C_DEF(sampleNoReplace, 5), C_DEF(MinusPiPlusPiRad, 2), C_DEF(WeightedMeanCircularRad, 4), C_DEF(rvm, 4), C_DEF(R_angularseparation, 5), C_DEF(R_chord, 5), C_DEF(R_geodesic, 5), C_DEF(R_correlation, 5), C_DEF(R_distance, 6), {NULL, NULL, 0} }; static const R_FortranMethodDef FortEntries[] = { {"dwrpnorm", (DL_FUNC) &F77_NAME(dwrpnorm), 7}, {"mlewrpno", (DL_FUNC) &F77_NAME(mlewrpno), 10}, {NULL, NULL, 0} }; void attribute_visible R_init_circular(DllInfo *dll) { R_registerRoutines(dll, CEntries, NULL, FortEntries, NULL); R_useDynamicSymbols(dll, FALSE); } circular/src/mean.circular.h0000644000176200001440000000057713124754230015553 0ustar liggesusers /****************************************************************** * * * AUTHORS : CLAUDIO AGOSTINELLI and ALESSANDRO GAGLIARDI * * AIM : Header of mean.circular.c * * DATA : 18 OCTOBER 2012. * * * *******************************************************************/ void MeanCircularRad(double*,int*,double*); circular/src/distance.c0000644000176200001440000001157714470146310014616 0ustar liggesusers/* * Version 0.1 2009/10/13 * * R : A Computer Language for Statistical Data Analysis * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka * Copyright (C) 1998, 2001 Robert Gentleman, Ross Ihaka and the * R Development Core Team * Copyright (C) 2002, 2004 The R Foundation * Copyright (C) 2009 Claudio Agostinelli * * This code is build over the same code in distance.c file in the package stats * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, a copy is available at * http://www.r-project.org/Licenses/ */ #ifdef HAVE_CONFIG_H # include #endif /* do this first to get the right options for math.h */ #include #include #include #include #include #include "distance.h" #ifdef ENABLE_NLS #include #define _(String) dgettext ("stats", String) #else #define _(String) (String) #endif #define both_FINITE(a,b) (R_FINITE(a) && R_FINITE(b)) #ifdef R_160_and_older #define both_non_NA both_FINITE #else #define both_non_NA(a,b) (!ISNAN(a) && !ISNAN(b)) #endif double R_angularseparation(double *x, int nr, int nc, int i1, int i2) { double dev, dist; int count, j; count= 0; dist = 0.0; for(j = 0 ; j < nc ; j++) { if(both_non_NA(x[i1], x[i2])) { dev = 1.0 - cos(x[i1] - x[i2]); if(!ISNAN(dev)) { dist += dev; count++; } } i1 += nr; i2 += nr; } if(count == 0) return NA_REAL; // if(count != nc) dist /= ((double)count/nc); return (double) dist/count; } double R_chord(double *x, int nr, int nc, int i1, int i2) { double dev, dist; int count, j; count= 0; dist = 0.0; for(j = 0 ; j < nc ; j++) { if(both_non_NA(x[i1], x[i2])) { dev = sqrt(2.0*(1.0 - cos(x[i1] - x[i2]))); if(!ISNAN(dev)) { dist += dev; count++; } } i1 += nr; i2 += nr; } if(count == 0) return NA_REAL; // if(count != nc) dist /= ((double)count/nc); return dist/count; } double R_geodesic(double *x, int nr, int nc, int i1, int i2) { double dev, dist, dif; int count, j; count= 0; dist = 0.0; for(j = 0 ; j < nc ; j++) { if(both_non_NA(x[i1], x[i2])) { dif = fabs(fmod((x[i1]-x[i2]+2.0*M_PI), (2.0*M_PI))); if (dif > M_PI) { dif = 2.0*M_PI - dif; } dev = M_PI - fabs(M_PI - dif); if(!ISNAN(dev)) { dist += dev; count++; } } i1 += nr; i2 += nr; } if(count == 0) return NA_REAL; // if(count != nc) dist /= ((double)count/nc); return (double) dist/count; } double R_correlation(double *x, int nr, int nc, int i1, int i2) { double sin1, sin2, cos1, cos2, mu1, mu2, num, den, den1, den2; int count, j, i1t, i2t; count= 0; //dist = 0.0; sin1 = 0.0; sin2 = 0.0; cos1 = 0.0; cos2 = 0.0; num = 0.0; den = 0.0; den1 = 0.0; den2 = 0.0; i1t = i1; i2t = i2; for(j = 0 ; j < nc ; j++) { if(both_non_NA(x[i1t], x[i2t])) { sin1 += sin(x[i1t]); cos1 += cos(x[i1t]); sin2 += sin(x[i2t]); cos2 += cos(x[i2t]); count++; } i1t += nr; i2t += nr; } if(count == 0) return NA_REAL; mu1 = atan2(sin1,cos1); mu2 = atan2(sin2,cos2); i1t = i1; i2t = i2; for(j = 0 ; j < nc ; j++) { if(both_non_NA(x[i1t], x[i2t])) { num += sin(x[i1t] - mu1) * sin(x[i2t] - mu2); den1 += R_pow(sin(x[i1t] - mu1), 2.0); den2 += R_pow(sin(x[i2t] - mu2), 2.0); count++; } i1t += nr; i2t += nr; } den = sqrt(den1*den2); if(count == 0) return NA_REAL; // if(count != nc) dist /= ((double)count/nc); return (double) sqrt(1.0 - num/den); } enum { CORRELATION=1, ANGULARSEPARATION, CHORD, GEODESIC }; /* == 1,2,..., defined by order in the R function dist */ void R_distance(double *x, int *nr, int *nc, double *d, int *diag, int *method) { int dc, i, j, ij; double (*distfun)(double*, int, int, int, int) = NULL; switch(*method) { case CORRELATION: distfun = R_correlation; break; case ANGULARSEPARATION: distfun = R_angularseparation; break; case CHORD: distfun = R_chord; break; case GEODESIC: distfun = R_geodesic; break; default: error(_("distance(): invalid distance")); } dc = (*diag) ? 0 : 1; /* diag=1: we do the diagonal */ ij = 0; for(j = 0 ; j <= *nr ; j++) for(i = j+dc ; i < *nr ; i++) d[ij++] = distfun(x, *nr, *nc, i, j); } circular/src/weighted.mean.circular.h0000644000176200001440000000044213124754230017341 0ustar liggesusers/****************************************************************** * AUTHORS CLAUDIO AGOSTINELLI * AIM : Header of WeightedMeanCircular.c * DATA : 12 May 2015 *******************************************************************/ void WeightedMeanCircularRad(double*,double*,int*,double*); circular/src/median.circular.c0000644000176200001440000000302514230004221016035 0ustar liggesusers /**************************************************************** * * * AUTHORS : CLAUDIO AGOSTINELLI and ALESSANDRO GAGLIARDI * * AIM : COMPUTE THE MEDIAN CIRCULAR * * DATA : 10 NOVEMBER 2012. * * * *****************************************************************/ #include #include #include #include #include "mean.circular.h" #include "median.circular.h" /* * This function compute the circular median and return, the median value and all candidate observations for median values * To use this function witohut all candidate observations for median values, write as follow : * * int a = 0; * double tmp[(*n)]; * MedianCircularRad(x,n,result,tmp,&a); */ void MedianCircularRad(double *x,int *n,double *result,double *medians,int *lMedians) { double valueOfDev; int i,k=0; double minimum = PI; for(i=0;i<(*n);i++) { valueOfDev = dev(x,x[i],n); if((valueOfDev - minimum)/(*n) < -DBL_EPSILON) { minimum = valueOfDev; medians[0] = x[i]; k=1; } else if(fabs(valueOfDev-minimum) <= pow(10,-8)) { medians[k++] = x[i]; } } MeanCircularRad(medians,&k,result); *lMedians = k; } double dev(double *theta,double xv,int *n) { double values=0; int j; for(j=0;j<(*n);j++) { values += fabs(PI-fabs(theta[j]-xv)); } values = values / (*n); values = PI - values; return(values); } circular/src/dwrappednormal.h0000644000176200001440000000023513124754230016036 0ustar liggesusers#include void F77_NAME(dwrpnorm)(double *dtheta, double *dmu, double *dsd, int *nsize, int *nmu, int *ik, double *dd); circular/src/median.circular.h0000644000176200001440000000104413124754230016056 0ustar liggesusers /**************************************************************** * * * AUTHORS : CLAUDIO AGOSTINELLI and ALESSANDRO GAGLIARDI * * AIM : Header of median.circular.c * * DATA : 10 NOVEMBER 2012. * * * *****************************************************************/ void MedianCircularRad(double*,int*,double*,double *,int *); double dev(double *,double,int *); circular/src/weighted.mean.circular.c0000644000176200001440000000125014230004270017321 0ustar liggesusers/****************************************************************** * AUTHORS CLAUDIO AGOSTINELLI * AIM : Compute Weighted Circular Mean * DATA : 12 May 2015 *******************************************************************/ #include #include "weighted.mean.circular.h" void WeightedMeanCircularRad(double *x, double *w, int *n, double *result) { double sinr = 0.0; double cosr = 0.0; double sumw = 0.0; double circmean = NA_REAL; int i; for (i=0;i<(*n);i++) { sinr += sin(x[i])*w[i]; cosr += cos(x[i])*w[i]; sumw += w[i]; } if (sqrt(pow(sinr,2) + pow(cosr,2))/sumw > DBL_EPSILON) circmean = atan2(sinr, cosr); *result = circmean; } circular/src/mean.circular.c0000644000176200001440000000131714470146310015536 0ustar liggesusers /****************************************************************** * * * AUTHORS : CLAUDIO AGOSTINELLI and ALESSANDRO GAGLIARDI * * AIM : COMPUTE THE MEAN CIRCULAR * * DATA : 18 OCTOBER 2012. * * * *******************************************************************/ #include #include "mean.circular.h" void MeanCircularRad(double *x,int *n,double *result) { double sinr = 0.0; double cosr = 0.0; double circmean = NA_REAL; int i; for(i=0;i<(*n);i++) { sinr += sin(x[i]); cosr += cos(x[i]); } if (sqrt(pow(sinr,2) + pow(cosr,2))/(*n) > DBL_EPSILON) { circmean = atan2(sinr, cosr); } *result = circmean; } circular/src/medianHL.circular.h0000644000176200001440000000135613124754230016310 0ustar liggesusers /**************************************************************** * * * AUTHORS : CLAUDIO AGOSTINELLI and ALESSANDRO GAGLIARDI * * AIM : Header of medianHL.circular.c * * DATA : 10 NOVEMBER 2012. * * * *****************************************************************/ void MedianHLCircularRad(double *,double*,int*,int*,double*); void MedianHLCircularPropRad(double *,int *,int *,double *,double *); /*Taken from /src/main/random.c and readapted.*/ void sampleNoReplace(double *,int,double *,int,int *); void sampleReplace(double *,int,double *,int); circular/src/mle.wrappednormal.f0000644000176200001440000000712513124754230016451 0ustar liggesusers SUBROUTINE mlewrpno(DTHETA, DMU, DSD, NSIZE, IK, IM, IR, & dw, dwk, dwm) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C functions for mlewrpno C C Author: Claudio Agostinelli C Dipartimento di Statistica C Universita' di Venezia C 30125 VENEZIA C ITALIA C C E-mail: claudio@unive.it C C March, 04, 2003 C C Version: 0.1 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C Copyright (C) 2003 Claudio Agostinelli C C This program is free software; you can redistribute it and/or modify C it under the terms of the GNU General Public License as published by C the Free Software Foundation; either version 2 of the License, or C (at your option) any later version. C C This program is distributed in the hope that it will be useful, C but WITHOUT ANY WARRANTY; without even the implied warranty of C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the C GNU General Public License for more details. C C You should have received a copy of the GNU General Public License C along with this program; if not, write to the Free Software C Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C PARAMETER: C NAME: I/O: TYPE: DIMENSIONS: DESCRIPTIONS: C DTHETA input D NSIZE vector of the data C DMU input D 1 mean C DSD input D 1 sd C NSIZE input I 1 length of the data C IK input I 1 number of index to sum C IM input I 1 if 1 you are estimating the mean C IR input I 1 if 1 you are estimating the sd C dw output D NSIZE C dwk output D NSIZE C dwm output D NSIZE C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC implicit double precision(a-h,o-z) implicit integer (n,i,j) parameter(dzero=0.0d00) parameter(ddue=2.0d00) parameter(dpi=3.141592654d00) dimension dtheta(nsize), dw(nsize), dwk(nsize), dwm(nsize) do 10 i=1, nsize dw(i) = dzero dwk(i) = dzero dwm(i) = dzero 10 continue do 20 i=1, nsize dw(i) = dexp(-((dtheta(i) - dmu)**ddue)/(ddue * dsd**ddue)) dwm(i) = (dtheta(i) - dmu)**ddue * & dexp(-((dtheta(i) - dmu)**ddue)/(ddue * dsd**ddue)) do 30 j=1,ik dw(i) = dw(i) & + dexp(-((dtheta(i) - dmu + ddue*dpi*j)**ddue) & /(ddue * dsd**ddue)) & + dexp(-((dtheta(i) - dmu - ddue*dpi*j)**ddue) & /(ddue * dsd**ddue)) if (im.eq.1) then dwk(i) = dwk(i) & + j*dexp(-((dtheta(i) - dmu + ddue*dpi*j)**ddue) & /(ddue * dsd**ddue)) & - j*dexp(-((dtheta(i) - dmu - ddue*dpi*j)**ddue) & /(ddue * dsd**ddue)) endif if (ir.eq.1) then dwm(i) = dwm(i) & + (dtheta(i) - dmu + ddue*j*dpi)**ddue & * dexp(-((dtheta(i) - dmu + ddue*dpi*j)**ddue) & /(ddue * dsd**ddue)) & + (dtheta(i) - dmu - ddue*j*dpi)**ddue & * dexp(-((dtheta(i) - dmu - ddue*dpi*j)**ddue) & /(ddue * dsd**ddue)) endif 30 continue 20 continue return end circular/src/minuspipluspi.c0000644000176200001440000000134313124754230015734 0ustar liggesusers/**************************************************************** * * * AUTHORS : CLAUDIO AGOSTINELLI and ALESSANDRO GAGLIARDI * * AIM : MinusPiPlusPiRad from internal function * * in circular package * * DATA : 02 NOVEMBER 2012. * * * *****************************************************************/ #include #include #include "minuspipluspi.h" void MinusPiPlusPiRad(double *x,int *n) { int i; for (i=0;i<(*n);i++) { x[i] = (x[i] < -PI)?(x[i] + (2 * PI)):(x[i]); x[i] = (x[i] > PI)?(x[i] - (2 * PI)):(x[i]); } } circular/src/rvonmises.h0000644000176200001440000000005313124754230015042 0ustar liggesusersvoid rvm(double*, int*, double*, double*); circular/src/dwrappednormal.f0000644000176200001440000000521413124754230016036 0ustar liggesusers SUBROUTINE dwrpnorm(DTHETA, DMU, DSD, NSIZE, NMU, IK, dd) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C functions for dwrpnorm C C Author: Claudio Agostinelli C Dipartimento di Statistica C Universita' di Venezia C 30125 VENEZIA C ITALIA C C E-mail: claudio@unive.it C C March, 17, 2003 C C Version: 0.1-1 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C Copyright (C) 2003 Claudio Agostinelli C C This program is free software; you can redistribute it and/or modify C it under the terms of the GNU General Public License as published by C the Free Software Foundation; either version 2 of the License, or C (at your option) any later version. C C This program is distributed in the hope that it will be useful, C but WITHOUT ANY WARRANTY; without even the implied warranty of C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the C GNU General Public License for more details. C C You should have received a copy of the GNU General Public License C along with this program; if not, write to the Free Software C Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C PARAMETER: C NAME: I/O: TYPE: DIMENSIONS: DESCRIPTIONS: C DTHETA input D NSIZE vector of the data C DMU input D 1 mean C DSD input D 1 sd C NSIZE input I 1 length of the data C NMU inout I 1 length of mu C IK input I 1 number of index to sum C dd output D NSIZE C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC implicit double precision(a-h,o-z) implicit integer (n,i,j) parameter(dzero=0.0d00) parameter(ddue=2.0d00) parameter(dpi=3.141592654d00) dimension dtheta(nsize), dmu(nmu), dd(nmu, nsize) do 10 i=1, nsize do 20 j=1, nmu dd(j, i) = dzero 20 continue 10 continue do 30 i=1, nsize do 40 j=1, nmu dd(j,i) = dexp(-((dtheta(i) - dmu(j))**ddue)/(ddue * dsd**ddue)) do 50 k=1,ik dd(j,i) = dd(j,i) & + dexp(-((dtheta(i) - dmu(j) + ddue*dpi*k)**ddue) & /(ddue * dsd**ddue)) & + dexp(-((dtheta(i) - dmu(j) - ddue*dpi*k)**ddue) & /(ddue * dsd**ddue)) 50 continue 40 continue 30 continue return end circular/src/mle.wrappednormal.h0000644000176200001440000000032713124754230016450 0ustar liggesusers#include void F77_NAME(mlewrpno)(double *dtheta, double *dmu, double *dsd, int *nsize, int *ik, int *im, int *ir, double *dw, double *dwk, double *dwm); circular/COPYING0000644000176200001440000004316411312211636013115 0ustar liggesusers GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 59 Temple Place - Suite 330 Boston, MA 02111-1307, USA. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19yy name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. circular/R/0000755000176200001440000000000014470153537012270 5ustar liggesuserscircular/R/family.circular.R0000644000176200001440000000401712243102436015465 0ustar liggesusers############################################################# # # vonMises # Author: Claudio Agostinelli and Alessandro Gagliardi # E-mail: claudio@unive.it # Date: November, 07, 2013 # Version: 0.1 # # Copyright (C) 2013 Claudio Agostinelli and Alessandro Gagliardi # ############################################################# vonMises <- function (link = "tan") { linktemp <- substitute(link) if (!is.character(linktemp)) linktemp <- deparse(linktemp) okLinks <- c("tan", "log", "probit", "identity") if (linktemp %in% okLinks) stats <- make.circular.link(linktemp) else if (is.character(link)) { stats <- make.circular.link(link) linktemp <- link } else { ## what else shall we allow? At least objects of class link-glm. if (inherits(link, "link-glm")) { stats <- link if (!is.null(stats$name)) linktemp <- stats$name } else { stop(gettextf('link "%s" not available for gaussian family; available links are %s', linktemp, paste(sQuote(okLinks), collapse =", ")), domain = NA) } } structure(list(family = "vonMises", link = linktemp, linkfun = stats$linkfun, linkinv = stats$linkinv, variance = function(mu) rep.int(1, length(mu)), dev.resids = function(y, mu, mulinear, kappa, wt) { if (kappa < 100000) llik <- 2*sum(wt)*(log(2*pi)+log(besselI(kappa,nu=0,expon.scaled=TRUE))+kappa) - 2*sum(wt * kappa * cos(y-mu-mulinear)) else llik <- ifelse((y-mu-mulinear)==0, -sqrt(.Machine$double.xmax), sqrt(.Machine$double.xmax)) return(llik) }, aic = function(dev,rank){ dev + 2*rank }, mu.eta = stats$mu.eta, #initialize = expression({ # n <- rep.int(1, nobs) # if(is.null(etastart) && is.null(start) && # is.null(mustart) && (family$link == "log" && any(y <= 0))) # stop("cannot find valid starting values: please specify some") # mustart <- y - circular:::MeanCircularRad(y)}), validmu = function(mu) TRUE, valideta = stats$valideta ), class = "family") } circular/R/watson.two.test.R0000644000176200001440000001024011312211537015474 0ustar liggesusers ############################################################# # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################# ############################################################# # # # watson.two.test function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: December, 16, 2009 # # Version: 0.3-2 # # # # Copyright (C) 2009 Claudio Agostinelli # # # ############################################################# watson.two.test <- function(x, y, alpha=0) { # Handling missing values x <- na.omit(x) if (length(x)==0) { warning("'x': No observations (at least after removing missing values)") return(NULL) } y <- na.omit(y) if (length(y)==0) { warning("'y': No observations (at least after removing missing values)") return(NULL) } x <- conversion.circular(x, units="radians", zero=0, rotation="counter", modulo="2pi") attr(x, "circularp") <- attr(x, "class") <- NULL y <- conversion.circular(y, units="radians", zero=0, rotation="counter", modulo="2pi") attr(y, "circularp") <- attr(y, "class") <- NULL result <- WatsonTwoTestRad(x, y) result$call <- match.call() result$alpha <- alpha class(result) <- "watson.two.test" return(result) } WatsonTwoTestRad <- function(x, y) { n1 <- length(x) n2 <- length(y) n <- n1 + n2 x <- cbind(sort(x %% (2 * pi)), rep(1, n1)) y <- cbind(sort(y %% (2 * pi)), rep(2, n2)) xx <- rbind(x, y) rank <- order(xx[, 1]) xx <- cbind(xx[rank, ], 1:n) a <- 1:n b <- 1:n for (i in 1:n) { a[i] <- sum(xx[1:i, 2] == 1) b[i] <- sum(xx[1:i, 2] == 2) } d <- b/n2 - a/n1 dbar <- mean.default(d) u2 <- (n1 * n2)/n^2 * sum((d - dbar)^2) result <- list(statistic=u2, nx=n1, ny=n2) return(result) } ############################################################# # # # print.watson.two.test function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: November, 19, 2003 # # Version: 0.1-1 # # # # Copyright (C) 2003 Claudio Agostinelli # # # ############################################################# print.watson.two.test <- function(x, digits=4, ...) { u2 <- x$statistic n1 <- x$nx n2 <- x$ny alpha <- x$alpha n <- n1 + n2 cat("\n Watson's Two-Sample Test of Homogeneity \n\n") if (n < 18) warning("Total Sample Size < 18: Consult tabulated critical values \n\n") crits <- c(99, 0.385, 0.268, 0.187, 0.152) cat("Test Statistic:", round(u2, digits=digits), "\n") if (alpha == 0) { if (u2 > 0.385) cat("P-value < 0.001", "\n", "\n") else if (u2 > 0.268) cat("0.001 < P-value < 0.01", "\n", "\n") else if (u2 > 0.187) cat("0.01 < P-value < 0.05", "\n", "\n") else if (u2 > 0.152) cat("0.05 < P-value < 0.10", "\n", "\n") else cat("P-value > 0.10", "\n", "\n") } else { index <- (1:5)[alpha == c(0, 0.001, 0.01, 0.05, 0.1)] Critical <- crits[index] if (u2 > Critical) Reject <- "Reject Null Hypothesis" else Reject <- "Do Not Reject Null Hypothesis" cat("Level", alpha, "Critical Value:", round(Critical, digits=digits), "\n") cat(Reject, "\n\n") } invisible(x) } circular/R/mle.wrappednormal.R0000644000176200001440000001301013115244370016024 0ustar liggesusers############################################################# # # # mle.wrappednormal function # # Author: Claudio Agostinelli # # Email: claudio.agostinelli@unitn.it # # Date: 05 June 2017 # # Copyright (C) 2017 Claudio Agostinelli # # # # Version 0.3 # ############################################################# mle.wrappednormal <- function(x, mu=NULL, rho=NULL, sd=NULL, K=NULL, tol=1e-5, min.sd=1e-3, min.k=10, max.iter=100, verbose=FALSE, control.circular=list()) { # Handling missing values x <- na.omit(x) if (length(x)==0) { warning("No observations (at least after removing missing values)") return(NULL) } if (is.circular(x)) { datacircularp <- circularp(x) } else if (is.circular(mu)) { datacircularp <- circularp(mu) } else { datacircularp <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") } dc <- control.circular if (is.null(dc$type)) dc$type <- datacircularp$type if (is.null(dc$units)) dc$units <- datacircularp$units if (is.null(dc$template)) dc$template <- datacircularp$template if (is.null(dc$modulo)) dc$modulo <- datacircularp$modulo if (is.null(dc$zero)) dc$zero <- datacircularp$zero if (is.null(dc$rotation)) dc$rotation <- datacircularp$rotation x <- conversion.circular(x, units="radians", zero=0, rotation="counter", modulo="2pi") attr(x, "class") <- attr(x, "circularp") <- NULL if (!is.null(mu)) { mu <- conversion.circular(mu, units="radians", zero=0, rotation="counter", modulo="2pi") attr(mu, "class") <- attr(mu, "circularp") <- NULL } res <- MlewrappednormalRad(x, mu, rho, sd, min.sd, K, min.k, tol, max.iter, verbose) mu <- conversion.circular(circular(res[1]), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) result <- list() result$call <- match.call() result$mu <- mu result$rho <- res[2] result$sd <- res[3] result$est.mu <- res[4] result$est.rho <- res[5] result$convergence <- TRUE if (res[6] > max.iter) { result$convergence <- FALSE } class(result) <- "mle.wrappednormal" return(result) } MlewrappednormalRad <- function(x, mu=NULL, rho=NULL, sd=NULL, min.sd, K=NULL, min.k=10, tol, max.iter, verbose) { n <- length(x) sinr <- sum(sin(x)) cosr <- sum(cos(x)) est.mu <- FALSE if (is.null(mu)) { mu <- atan2(sinr, cosr) est.mu <- TRUE } est.rho <- FALSE if (is.null(sd)) { if (is.null(rho)) { sd <- sqrt(-2*log(sqrt(sinr^2 + cosr^2)/n)) if (is.na(sd) || sd < min.sd) sd <- min.sd est.rho <- TRUE } else { sd <- sqrt(-2*log(rho)) } } xdiff <- 1+tol iter <- 0 if (is.null(K)) { range <- max(mu, x) - min(mu, x) K <- (range+6*sd)%/%(2*pi)+1 K <- max(min.k, K) } while (xdiff > tol & iter <= max.iter) { iter <- iter + 1 mu.old <- mu sd.old <- sd z <- .Fortran("mlewrpno", as.double(x), as.double(mu), as.double(sd), as.integer(n), as.integer(K), as.integer(est.mu), as.integer(est.rho), w=double(n), wk=double(n), wm=double(n), PACKAGE="circular" ) w <- z$w wk <- z$wk wm <- z$wm if (est.mu) { mu <- sum(x)/n if (any(wk!=0)) { mu <- mu + 2*pi*sum(wk[wk!=0]/w[wk!=0])/n } } if (est.rho) { if (any(wm!=0)) { sd <- sqrt(sum(wm[wm!=0]/w[wm!=0])/n) } else { sd <- min.sd } } if (verbose) { cat("mu: ", mu, "\n") cat("rho: ", exp(-sd^2/2), "\n") cat("sd: ", sd, "\n") } xdiff <- max(abs(mu - mu.old), abs(sd - sd.old)) } rho <- exp(-sd^2/2) result <- c(mu, rho, sd, est.mu, est.rho, iter) return(result) } ############################################################# # # # print.mle.wrappednormal function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: November, 19, 2003 # # Version: 0.1-2 # # # # Copyright (C) 2003 Claudio Agostinelli # # # ############################################################# print.mle.wrappednormal <- function(x, digits = max(3, getOption("digits") - 3), ...) { cat("\nCall:\n",deparse(x$call),"\n\n",sep="") cat("mu: ") cat(format(x$mu, digits=digits), "\n") cat("\n") cat("rho: ") cat(format(x$rho, digits=digits), "\n") cat("\n") cat("sd: ") cat(format(x$sd, digits=digits), "\n") cat("\n") if (!x$est.mu) cat("mu is known\n") if (!x$est.rho) { cat("rho and sd are known\n") } if (!x$convergence) cat("\nThe convergence is not achieved after the prescribed number of iterations \n") invisible(x) } circular/R/regularize.values.R0000644000176200001440000000117013124714415016052 0ustar liggesusersregularize.values <- function (x, y, ties) { x <- xy.coords(x, y, setLab = FALSE) y <- x$y x <- x$x if (any(na <- is.na(x) | is.na(y))) { ok <- !na x <- x[ok] y <- y[ok] } nx <- length(x) if (!identical(ties, "ordered")) { o <- order(x) x <- x[o] y <- y[o] if (length(ux <- unique(x)) < nx) { if (missing(ties)) warning("collapsing to unique 'x' values") y <- as.vector(tapply(y, match(x, x), ties)) x <- ux stopifnot(length(y) == length(x)) } } list(x = x, y = y) } circular/R/var.circular.R0000644000176200001440000000324411601100766014776 0ustar liggesusers var <- function(x, ...) UseMethod("var") var.default <- function(x, y = NULL, na.rm = FALSE, use, ...) stats::var(x=x, y=y, na.rm=na.rm, use=use) #var.matrix <- function(x, ...) { # apply(x, 2, var, ...) #} var.data.frame <- function(x, ...) { sapply(x, var, ...) } ############################################################# # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################# ############################################################# # # # var.circular function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: June, 24, 2011 # # Copyright (C) 2011 Claudio Agostinelli # # # # Version 0.5 # ############################################################# var.circular <- function (x, na.rm=FALSE, ...) { if (is.matrix(x)) { apply(x, 2, var.circular, na.rm=na.rm) } else { if (na.rm) x <- x[!is.na(x)] x <- conversion.circular(x, units="radians", zero=0, rotation="counter") attr(x, "class") <- attr(x, "circularp") <- NULL VarCircularRad(x=x) } } VarCircularRad <- function(x) { rbar <- RhoCircularRad(x) circvar <- 1-rbar return(circvar) } circular/R/uniform.R0000644000176200001440000000417012236416074014070 0ustar liggesusers############################################################# # # # rcircularuniform function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: November, 06, 2013 # # Copyright (C) 2013 Claudio Agostinelli # # # # Version 0.1-1 # ############################################################# rcircularuniform <- function(n, control.circular=list()) { datacircularp <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") dc <- control.circular if (is.null(dc$type)) dc$type <- datacircularp$type if (is.null(dc$units)) dc$units <- datacircularp$units if (is.null(dc$template)) dc$template <- datacircularp$template if (is.null(dc$modulo)) dc$modulo <- datacircularp$modulo if (is.null(dc$zero)) dc$zero <- datacircularp$zero if (is.null(dc$rotation)) dc$rotation <- datacircularp$rotation un <- RuniformRad(n) un <- conversion.circular(circular(un), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) return(un) } RuniformRad <- function(n) { un <- stats::runif(n=n, min=0, max=2*pi) return(un) } ############################################################# # # # dcircularuniform function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: March, 31, 2009 # # Copyright (C) 2009 Claudio Agostinelli # # # # Version 0.1 # ############################################################# dcircularuniform <- function (x) { x <- rep(1/(2*pi), length(x)) return(x) } circular/R/range.circular.R0000644000176200001440000000562711560724105015314 0ustar liggesusers############################################################# # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################# ############################################################# # # # range.circular function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: May, 06, 2011 # # Copyright (C) 2011 Claudio Agostinelli # # # # Version 0.5 # ############################################################# range.circular <- function(x, test = FALSE, na.rm=FALSE, finite=FALSE, control.circular=list(), ...) { if (finite) x <- x[is.finite(x)] if (na.rm) x <- x[!is.na(x)] else { if (any(is.na(x))) { x <- circular(NA) return(x) } } if (is.circular(x)) { datacircularp <- circularp(x) } else { datacircularp <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") } dc <- control.circular if (is.null(dc$type)) dc$type <- datacircularp$type if (is.null(dc$units)) dc$units <- datacircularp$units if (is.null(dc$template)) dc$template <- datacircularp$template if (is.null(dc$modulo)) dc$modulo <- datacircularp$modulo if (is.null(dc$zero)) dc$zero <- datacircularp$zero if (is.null(dc$rotation)) dc$rotation <- datacircularp$rotation x <- conversion.circular(x, units="radians", zero=0, rotation="counter", modulo="2pi") attr(x, "class") <- attr(x, "circularp") <- NULL result <- RangeCircularRad(x, test) if (test) { result$range <- conversion.circular(x=circular(result$range, template=dc$template, rotation='counter'), units=dc$units, type=dc$type, modulo="asis", zero=NULL) } else { result <- conversion.circular(x=circular(result, template=dc$template, rotation='counter'), units=dc$units, type=dc$type, modulo="asis", zero=NULL) } return(result) } RangeCircularRad <- function(x, test=TRUE) { x <- sort(x %% (2*pi)) n <- length(x) spacings <- c(diff(x), x[1] - x[n] + 2*pi) range <- 2*pi - max(spacings) if (test == TRUE) { stop <- floor(1/(1 - range/(2*pi))) index <- c(1:stop) sequence <- ((-1)^(index - 1)) * exp(lgamma(n + 1) - lgamma(index + 1) - lgamma(n - index + 1)) * (1 - index * (1 - range/(2 * pi)))^(n - 1) p.value <- sum(sequence) result <- list(range=range, p.value=p.value) } else { result <- range } return(result) } circular/R/pp.unif.plot.R0000644000176200001440000000416513124431056014743 0ustar liggesusers############################################################# # # # pp.unif.plot function # # Author: Claudio Agostinelli # # Email: claudio.agostinelli@unitn.it # # Date: December, 09, 2016 # # Copyright (C) 2016 Claudio Agostinelli # # # # Version 0.1 # ############################################################# pp.unif.plot <- function(x, ref.line = TRUE, frac=NULL, xlab = "Uniform Distribution", ylab = "Empirical Distribution", col=NULL, col.inf=NULL, col.sup=NULL, ...) { # Handling missing values x <- na.omit(x) if (length(x)==0) { warning("No observations (at least after removing missing values)") return(NULL) } x <- conversion.circular(x, units="radians", zero=0, rotation="counter", modulo="2pi") attr(x, "class") <- attr(x, "circularp") <- NULL y <- sort(x %% (2 * pi))/(2*pi) n <- length(y) z <- (1:n)/(n + 1) if (is.null(col)) col <- rep(1, n) else col <- rep(col, length.out=n) if (!is.null(frac)) { if (!is.numeric(frac) || (frac < 0 | frac > 1)) { stop("'frac' must be in the interval [0,1]") } f <- round(frac*n) if (f) { zm <- -1 + ((n-f+1):n)/(n+1) zp <- 1 + (1:f)/(n+1) ym <- -1+y[(n-f+1):n] yp <- 1+y[1:f] y <- c(ym,y,yp) z <- c(zm,z,zp) if (is.null(col.inf)) col.inf <- rep(2, f) else col.inf <- rep(col.inf, length.out=f) if (is.null(col.sup)) col.sup <- rep(2, f) else col.sup <- rep(col.sup, length.out=f) col <- c(col.inf, col, col.sup) } } plot.default(z, y, xlab=xlab, ylab=ylab, col=col, ...) if (ref.line) { abline(0, 1) if (!is.null(frac)) { abline(h=c(0,1), lty=3) abline(v=c(0,1), lty=3) } } } circular/R/angular.variance.R0000644000176200001440000000205211601101067015612 0ustar liggesusers############################################################# # # # angular.variance function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: June, 24, 2011 # # Copyright (C) 2011 Claudio Agostinelli # # # # Version 0.2 # ############################################################# angular.variance <- function (x, na.rm=FALSE) { if (is.matrix(x)) { apply(x, 2, angular.variance, na.rm=na.rm) } else { if (na.rm) x <- x[!is.na(x)] x <- conversion.circular(x, units="radians", zero=0, rotation="counter") attr(x, "class") <- attr(x, "circularp") <- NULL AngularVarianceRad(x=x) } } AngularVarianceRad <- function(x) { rbar <- RhoCircularRad(x) circvar <- 2*(1-rbar) return(circvar) } circular/R/meandeviation.R0000644000176200001440000000220412017357431015226 0ustar liggesusers############################################################# # # # meandeviation function # # Author: Claudio Agostinelli and Alessandro Gagliardi # # Email: claudio@unive.it # # Date: August, 29, 2012 # # Copyright (C) 2012 Claudio Agostinelli # # # # Version 0.1 # ############################################################# meandeviation <- function (x, na.rm=FALSE) { if (is.matrix(x)) { apply(x, 2, meandeviation, na.rm=na.rm) } else { if (na.rm) x <- x[!is.na(x)] x <- conversion.circular(x, units="radians", zero=0, rotation="counter") attr(x, "class") <- attr(x, "circularp") <- NULL MeanDeviationRad(x=x) } } MeanDeviationRad <- function(x) { circmedian <- MedianCircularRad(x) ## circmedian <- attr(circmedian, 'medians')[1] meandev <- pi - mean(abs(pi-abs(MinusPiPlusPiRad(x-circmedian)))) return(meandev) } circular/R/mean.circular.R0000644000176200001440000000475312524351543015142 0ustar liggesusers ############################################################# # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################# ############################################################# # # # mean.circular function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: May, 12, 2015 # # Version: 0.5-1 # # # # Copyright (C) 2015 Claudio Agostinelli # # # ############################################################# mean.circular <- function(x, na.rm=FALSE, control.circular=list(), ...) { if (na.rm) x <- x[!is.na(x)] if (length(x)==0) { warning("No observations (at least after removing missing values)") return(circular(NA)) } if (is.circular(x)) { datacircularp <- circularp(x) } else { datacircularp <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") } dc <- control.circular if (is.null(dc$type)) dc$type <- datacircularp$type if (is.null(dc$units)) dc$units <- datacircularp$units if (is.null(dc$template)) dc$template <- datacircularp$template if (is.null(dc$modulo)) dc$modulo <- datacircularp$modulo if (is.null(dc$zero)) dc$zero <- datacircularp$zero if (is.null(dc$rotation)) dc$rotation <- datacircularp$rotation x <- conversion.circular(x, units="radians") attr(x, "class") <- attr(x, "circularp") <- NULL circmean <- MeanCircularRad(x) circmean <- conversion.circular(circular(circmean, template=datacircularp$template, zero=datacircularp$zero, rotation=datacircularp$rotation), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) return(circmean) } MeanCircularRad <- function(x) { if (any(is.na(x))) { circmean <- NA } else { circmean <- .C("MeanCircularRad",x=as.double(x),n=as.integer(length(x)),result=as.double(0),PACKAGE="circular")$result } return(circmean) } circular/R/angular.deviation.R0000644000176200001440000000206411601101027016003 0ustar liggesusers############################################################# # # # angular.deviation function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: June, 24, 2011 # # Copyright (C) 2011 Claudio Agostinelli # # # # Version 0.3 # ############################################################# angular.deviation <- function (x, na.rm=FALSE) { if (is.matrix(x)) { apply(x, 2, angular.deviation, na.rm=na.rm) } else { if (na.rm) x <- x[!is.na(x)] x <- conversion.circular(x, units="radians", zero=0, rotation="counter") attr(x, "class") <- attr(x, "circularp") <- NULL AngularDeviationRad(x=x) } } AngularDeviationRad <- function(x) { rbar <- RhoCircularRad(x) circvar <- sqrt(2*(1-rbar)) return(circvar) } circular/R/I.0.R0000644000176200001440000000010511312211537012720 0ustar liggesusers I.0 <- function(x) { besselI(x=x, nu=0, expon.scaled = FALSE) } circular/R/asytriangular.R0000644000176200001440000000175511611525730015300 0ustar liggesusers############################################################# # # # dasytriangular function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: July, 20, 2011 # # Copyright (C) 2011 Claudio Agostinelli # # # # Version 0.1 # ############################################################# #Mardia pag. 52 dasytriangular <- function(x, rho) { if (rho < 0 | rho > 1/pi) stop("'rho' must be between 0 and 1/pi") x <- conversion.circular(x, units="radians", zero=0, rotation="counter") attr(x, "class") <- attr(x, "circularp") <- NULL DasytriangularRad(x, rho) } DasytriangularRad <- function(x, rho) { d <- (1 + rho * (x - pi))/(2 * pi) return(d) } circular/R/A1inv.R0000644000176200001440000000125411312211537013356 0ustar liggesusers############################################################### # # # R port: Claudio Agostinelli # # # # Date: January, 14, 2003 # # Version: 0.1-1 # # # ############################################################### A1inv <- function(x) { ifelse (0 <= x & x < 0.53, 2 * x + x^3 + (5 * x^5)/6, ifelse (x < 0.85, -0.4 + 1.39 * x + 0.43/(1 - x), 1/(x^3 - 4 * x^2 + 3 * x))) } circular/R/zzz.R0000644000176200001440000000030613124452775013250 0ustar liggesusers## .First.lib <- function(lib, pkg) { ## library.dynam("circular", pkg, lib) ## } .onLoad <- function(libname, pkgname) { data("rao.table", package=pkgname, envir=parent.env(environment())) } circular/R/mle.wrappedcauchy.R0000644000176200001440000001443311312211537016016 0ustar liggesusers ############################################################# # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################# ############################################################# # # # mle.wrappedcauchy function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: August, 10, 2006 # # Copyright (C) 2006 Claudio Agostinelli # # # # Version 0.2-2 # ############################################################# mle.wrappedcauchy <- function(x, mu=NULL, rho=NULL, tol = 1e-015, max.iter = 100, control.circular=list()) { if (tol <= 0) stop("'tol' must be positive") # Handling missing values x <- na.omit(x) if (length(x)==0) { warning("No observations (at least after removing missing values)") return(NULL) } if (is.circular(x)) { datacircularp <- circularp(x) } else if (is.circular(mu)) { datacircularp <- circularp(mu) } else { datacircularp <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") } dc <- control.circular if (is.null(dc$type)) dc$type <- datacircularp$type if (is.null(dc$units)) dc$units <- datacircularp$units if (is.null(dc$template)) dc$template <- datacircularp$template if (is.null(dc$modulo)) dc$modulo <- datacircularp$modulo if (is.null(dc$zero)) dc$zero <- datacircularp$zero if (is.null(dc$rotation)) dc$rotation <- datacircularp$rotation x <- conversion.circular(x, units="radians", zero=0, rotation="counter", modulo="2pi") attr(x, "class") <- attr(x, "circularp") <- NULL if (!is.null(mu)) { mu <- conversion.circular(mu, units="radians", zero=0, rotation="counter", modulo="2pi") attr(mu, "class") <- attr(mu, "circularp") <- NULL } res <- MlewrappedcauchyRad(x, mu, rho, tol, max.iter) mu <- conversion.circular(circular(res[1]), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) result <- list() result$call <- match.call() result$mu <- mu result$rho <- res[2] result$est.mu <- res[3] result$est.rho <- res[4] result$convergence <- TRUE if (!is.na(res[5]) && res[5] > max.iter) { result$convergence <- FALSE } class(result) <- "mle.wrappedcauchy" return(result) } MlewrappedcauchyRad <- function(x, mu, rho, tol, max.iter) { n <- length(x) est.mu <- FALSE if (is.null(mu)) { mu <- MeanCircularRad(x) est.mu <- TRUE } est.rho <- FALSE if (is.null(rho)) { rho <- RhoCircularRad(x) est.rho <- TRUE } if (rho < 0 | rho > 1) stop("'rho' must be between 0 and 1") if (est.mu) { if (est.rho) { mu1.old <- (2 * rho * cos(mu))/(1 + rho^2) mu2.old <- (2 * rho * sin(mu))/(1 + rho^2) w.old <- 1/(1 - mu1.old * cos(x) - mu2.old * sin(x)) flag <- TRUE iter <- 0 while (flag & iter <= max.iter) { iter <- iter + 1 mu1.new <- sum(w.old * cos(x))/sum(w.old) mu2.new <- sum(w.old * sin(x))/sum(w.old) diff1 <- abs(mu1.new - mu1.old) diff2 <- abs(mu2.new - mu2.old) if ((diff1 < tol) && (diff2 < tol)) flag <- FALSE else { mu1.old <- mu1.new mu2.old <- mu2.new w.old <- 1/(1 - mu1.old * cos(x) - mu2.old * sin(x)) } } mu.const <- sqrt(mu1.new^2 + mu2.new^2) mu <- atan2(mu2.new, mu1.new) %% (2 * pi) rho <- (1 - sqrt(1 - mu.const^2))/mu.const } else { score <- function(x, data, rho) { sum(sin(data-x)/(1+rho^2-2*rho*cos(data-x))) } res <- uniroot(f=score, lower=mu-pi/2, upper=mu+pi/2, data=x, rho=rho, tol=tol) mu <- res$root iter <- NA } } else { if (est.rho) { wt <- function(x, mu, rho) { ((1-rho^2)*(1+rho^2-2*rho*cos(x-mu)))^(-1) } diff <- 1+tol iter <- 0 rho.old <- rho while (diff >= tol & iter <= max.iter) { iter <- iter + 1 w <- wt(x, mu, rho) sumw <- sum(w) sumwcos <- w%*%cos(x-mu) rho <- (sumw - sqrt(sumw^2 - sumwcos^2))/sumwcos diff <- abs(rho - rho.old) ##### cat("iter: ", iter, " rho: ", rho, "\n") rho.old <- rho } } } result <- c(mu, rho, est.mu, est.rho, iter) return(result) } ############################################################# # # # print.mle.wrappednormal function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: May, 22, 2006 # # Version: 0.2 # # # # Copyright (C) 2006 Claudio Agostinelli # # # ############################################################# print.mle.wrappedcauchy <- function(x, digits = max(3, getOption("digits") - 3), ...) { cat("\nCall:\n",deparse(x$call),"\n\n",sep="") cat("mu: ") cat(format(x$mu, digits=digits), "\n") cat("\n") cat("rho: ") cat(format(x$rho, digits=digits), "\n") cat("\n") if (!x$est.mu) cat("mu is known\n") if (!x$est.rho) cat("rho is known\n") if (!x$convergence) cat("\n The convergence is not achieved after the prescribed number of iterations \n") invisible(x) } circular/R/rstable.R0000644000176200001440000001037413124162654014047 0ustar liggesusers############################################################### # rstable function # # Date: January, 22, 2002 # # Version: 0.1 # # # ############################################################### # # # This R code is based on C functions gsl_ran_levy and # # gsl_ran_levy_skew from GNU Scientifi Library # # copyrighted under GNU general license by # # James Theiler, Brian Gough and Keith Briggs. # # # ############################################################### # Here the original comments in the code: # # The stable Levy probability distributions have the form # # p(x) dx = (1/(2 pi)) \int dt exp(- it x - |c t|^alpha) # # with 0 < alpha <= 2. # # For alpha = 1, we get the Cauchy distribution # For alpha = 2, we get the Gaussian distribution with sigma = sqrt(2) c. # # Fromn Chapter 5 of Bratley, Fox and Schrage "A Guide to # Simulation". The original reference given there is, # # J.M. Chambers, C.L. Mallows and B. W. Stuck. "A method for # simulating stable random variates". Journal of the American # Statistical Association, JASA 71 340-344 (1976). # # The following routine for the skew-symmetric case was provided by # Keith Briggs. # # The stable Levy probability distributions have the form # # 2*pi* p(x) dx # # = \int dt exp(mu*i*t-|sigma*t|^alpha*(1-i*beta*sign(t)*tan(pi*alpha/2))) for alpha!=1 # = \int dt exp(mu*i*t-|sigma*t|^alpha*(1+i*beta*sign(t)*2/pi*log(|t|))) for alpha==1 # # with 00. # # For beta=0, sigma=c, mu=0, we get gsl_ran_levy above. # # For alpha = 1, beta=0, we get the Lorentz distribution # For alpha = 2, beta=0, we get the Gaussian distribution # # See A. Weron and R. Weron: Computer simulation of Levy alpha-stable # variables and processes, preprint Technical University of Wroclaw. # http://www.im.pwr.wroc.pl/~hugo/Publications.html # ############################################################################### rstable <- function(n, scale = 1, index = stop("no index arg"), skewness = 0) { ## alpha <- index ## beta <- skewness if (index > 2 | index <= 0) stop("rstable is not define for index outside the interval 0 < index <= 2\n") if (skewness > 1 | skewness < -1) {stop("rstable is not define for skewness outside the interval -1 <= skewness <= 1\n")} if (skewness==0) { ## cauchy case if (index == 1) { return(scale*rcauchy(n, location = 0, scale = 1)) } ## gaussian case if (index == 2) { return(rnorm(n, mean = 0, sd = sqrt(2)*scale)) } ## general case rngstab <- vector(length=0) for (i in 1:n) { u <- 0 while (u == 0 | u == 1) { u <- pi * (runif(1, min=0, max=1) - 0.5) } v <- 0 while (v == 0) { v <- rexp(1,rate=1) } t <- sin (index * u) / (cos (u)^(1 / index)) s <- (cos ((1 - index) * u) / v)^((1 - index) / index) rngstab <- c(rngstab, t*s) } return (scale * rngstab); } else { rngstab <- vector(length=0) for (i in 1:n) { u <- 0 while (u == 0 | u == 1) { u <- pi * (runif(1, min=0, max=1) - 0.5) } v <- 0 while (v == 0) { v <- rexp(1,rate=1) } if (index == 1) { X <- (((pi/2) + skewness * u) * tan (u) - skewness * log ((pi/2) * v * cos (u) / ((pi/2) + skewness * u))) / (pi/2) rngstab <- c(rngstab, (scale * (X + skewness * log (scale) / (pi/2)))) } else { t <- skewness * tan ((pi/2) * index) B <- atan(t) / index S <- (1 + t * t)^(1/(2 * index)) X <- S * sin (index * (u + B)) / (cos (u)^(1 / index)) * (cos (u - index * (u + B)) / v)^((1 - index) / index) rngstab <- c(rngstab, (scale * X)) } } return(rngstab) } } circular/R/windrose.R0000644000176200001440000002437711553766131014261 0ustar liggesusers ############################################################# # # # Original code: Matt Pocernich # # E-mail: pocernic@rap.ucar.edu # # *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=* # # ** Copyright UCAR (c) 1992 - 2004 # # ** University Corporation for Atmospheric Research(UCAR) # # ** National Center for Atmospheric Research(NCAR) # # ** Research Applications Program(RAP) # # ** P.O.Box 3000, Boulder, Colorado, 80307-3000, USA # # ** 2004/28/6 11:31:8 # # *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=* # ############################################################# ############################################################# # # # windrose function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: April, 21, 2011 # # Version: 0.5 # # # # Copyright (C) 2011 Claudio Agostinelli # # # ############################################################# windrose <- function(x, y=NULL, breaks=NULL, bins=12, increment = 10, main='Wind Rose', cir.ind = 0.05, fill.col=NULL, plot.mids=TRUE, mids.size=1.2, osize=0.1, axes=TRUE, ticks=TRUE, tcl=0.025, tcl.text=-0.15, cex=1, digits=2, units=NULL, template=NULL, zero=NULL, rotation=NULL, num.ticks=12, xlim=c(-1.2, 1.2), ylim=c(-1.2, 1.2), uin=NULL, tol=0.04, right=FALSE, shrink=NULL, label.freq=FALSE, calm=c("0", "NA"), ...) { calm <- match.arg(calm) ###### internal function used to plot circles circles<- function(rad, sector=c(0, 2*pi), lty=2, col="white", border=NA, fill = FALSE) { ## draws circle, radius in units of plot ## internal function for windrose values <- seq(sector[1], sector[2], by=(sector[2]-sector[1])/360) x <- rad*cos(values) y <- rad*sin(values) if (fill) { polygon(x, y, xpd=FALSE, lty=lty, col=col, border=border) } lines(x, y, col = 1, lty = lty) } #### if (!is.null(cir.ind) && (cir.ind > 1 | cir.ind <= 0)) { cir.ind <- 0.05 warning("'cir.ind' must be in (0, 1]") } if (any(is.null(y))) { if (is.data.frame(x) && NCOL(x)==2) { y <- x[,2] x <- x[,1] } else { stop("'y' can not be 'NULL' if 'x' is not a dataframe with 2 columns (direction and magnitude) ") } } else { y <- as.vector(y) if (length(y)!=length(x)) stop("'x' and 'y' must have the same length") if (is.data.frame(x)) { if (NCOL(x) > 1) x <- x[,1] } } ### rm calms ### #### count calms #### following NWS protocol, when dir == 0 weather calm, we allows also to set cam==NA no <- length(x) if (calm=="NA") { calmcalm <- sum(is.na(x)) notcalm <- !is.na(x) } else { calmcalm <- sum(x == calm) notcalm <- x!=calm } x <- x[notcalm] y <- y[notcalm] # Handling missing values in any case ok <- complete.cases(x, y) x <- x[ok] y <- y[ok] if (length(y)==0) { warning("No observations (at least after removing missing values and calm winds)") return(NULL) } result <- list() result$x <- x result$y <- y xcircularp <- attr(as.circular(x), "circularp") type <- xcircularp$type modulo <- xcircularp$modulo if (is.null(units)) units <- xcircularp$units if (is.null(template)) template <- xcircularp$template if (template=="geographics" | template=="clock24") { zero <- pi/2 rotation <- "clock" } else if (template=="clock12") { zero <- pi/2 rotation <- "clock" } else { if (is.null(zero)) zero <- xcircularp$zero if (is.null(rotation)) rotation <- xcircularp$rotation } op <- par(mar = c(1,1,2,1)) mai <- par("mai") on.exit(par(op)) midx <- 0.5 * (xlim[2] + xlim[1]) xlim <- midx + (1 + tol) * 0.5 * c(-1, 1) * (xlim[2] - xlim[1]) midy <- 0.5 * (ylim[2] + ylim[1]) ylim <- midy + (1 + tol) * 0.5 * c(-1, 1) * (ylim[2] - ylim[1]) oldpin <- par("pin") - c(mai[2]+mai[4], mai[1]+mai[3]) xuin <- oxuin <- oldpin[1]/diff(xlim) yuin <- oyuin <- oldpin[2]/diff(ylim) if (is.null(uin)) { if (yuin > xuin) xuin <- yuin else yuin <- xuin } else { if (length(uin) == 1) uin <- uin * c(1, 1) if (any(c(xuin, yuin) < uin)) stop("uin is too large to fit plot in") xuin <- uin[1]; yuin <- uin[2] } xlim <- midx + oxuin/xuin * c(-1, 1) * diff(xlim) * 0.5 ylim <- midy + oyuin/yuin * c(-1, 1) * diff(ylim) * 0.5 if (any(is.null(breaks))) { step <- 2*pi/bins breaks <- circular(seq(0, 2*pi, by=step), units="radians") } else { breaks <- as.circular(breaks) } breaks <- conversion.circular(breaks, units="radians", zero=0, rotation="counter", modulo="2pi") attr(breaks, "class") <- attr(breaks, "circularp") <- NULL if (template=="clock12") { ### added for clock12 breaks <- 2*breaks breaks <- breaks%%(2*pi) } breaks <- sort(unique(breaks)) if (breaks[1]!=0) { breaks <- c(breaks[length(breaks)]-2*pi, breaks) } else { breaks <- c(breaks, 2*pi) } bins <- length(breaks)-1 step <- diff(breaks) # the step for the breaks which include zero degrees is the first one x <- conversion.circular(x, units="radians", zero=0, rotation="counter", modulo="2pi") attr(x, "class") <- attr(x, "circularp") <- NULL if (template=="clock12") { ### added for clock12 x <- 2*x x <- x%%(2*pi) } x[x >= breaks[bins+1]] <- x[x >= breaks[bins+1]]-2*pi ### x[(x+step/2)%%(2*pi)==0] <- 2*pi # Values like 359 go to Sector 0 plot(c(-1.2,1.2), c(-1.2,1.2), xlab='', ylab='', main=main, xaxt='n', yaxt='n', pch=' ', xlim=xlim, ylim=ylim) counts <- hist.default(x, breaks=breaks ,plot=FALSE, right=right)$counts #use hist for mids <- breaks[1:bins]+step/2 # midpoints if (plot.mids) { for (i in 1:bins) { lines(c(0, mids.size*cos(mids[i])), c(0, mids.size*sin(mids[i])), lty=2) } } ####### lines maxlength.orig <- sqrt(max(counts/step)/length(x)+osize^2) if (is.null(shrink)) { maxlength <- shrink <- maxlength.orig } else { maxlength <- shrink } J <- ceiling(max(y, na.rm = TRUE)/increment) ## should deal with NA elsewhere if (any(is.null(fill.col))) { if (J%%2 == 0) { fill.col <- c("blue", "red") } else { fill.col <- c("red", "blue") } } fill.col <- rep(fill.col, length.out=bins) OUT <- matrix(NA, nrow = J, ncol = bins) OUT[J,] <- counts for(j in J:1){ data1<- x[y <= j*increment] OUT[j,] <- counts <- hist.default(data1, breaks=breaks, plot=FALSE, right=right)$counts #use hist for for (i in 1:bins) { w1 <- breaks[i] ## in radians, the locations of the upper and lower lines w2 <- breaks[i+1] if (counts[i]) { rad <- sqrt(counts[i]/(step[i]*length(x)) + osize^2)/maxlength } else { rad <- 0 } xx <- rad*c(0,cos(w1),cos(w2),0) ## increase length by percent equal to bin with yy <- rad*c(0,sin(w1),sin(w2),0) polygon(xx, yy, xpd=FALSE, col = fill.col[j], border=NA) lines(xx[1:2], yy[1:2]) lines(xx[3:4], yy[3:4]) circles(rad=rad, sector=c(w1, w2), fill=TRUE, lty=1, col=fill.col[j], border=NA) } ## close for i } ## close J loop m <- dim(OUT)[1] new <- OUT if (m > 1) { for (i in 2:m) { new[i,]<- OUT[i,] - OUT[i-1,] } } ## circles if (!is.null(cir.ind)) { equalstep <- max(abs(diff(step))) <= 10*.Machine$double.eps max.plt <- maxlength.orig^2 - osize^2 if (equalstep & label.freq) max.plt <- max.plt*step[1] cir.ind <- min(cir.ind, max.plt) max.plt <- floor(max.plt/cir.ind)*cir.ind ## sets max plotted area max.plt <- seq(cir.ind, max.plt, by = cir.ind) if (equalstep & label.freq) { rad <- sqrt(max.plt/step[1]+osize^2)/maxlength } else { rad <- sqrt(max.plt+osize^2)/maxlength } if (equalstep & label.freq) { text(0, rad, paste(round(max.plt * 100, digits=digits), "%", sep = ""), cex = 0.9*cex, pos = 3, font = 3, offset=0.2) } else { text(0, rad, paste(round(max.plt, digits=digits), sep = ""), cex = 0.9*cex, pos = 3, font = 3, offset=0.2) } for (i in 1:length(rad)) { circles(rad[i]) } # close circle } else { circles(1) } circles(osize, fill = TRUE) if (axes) { axis.circular(at=NULL, labels=NULL, units=units, template=template, modulo="2pi", zero=zero, rotation=rotation, tick=ticks, cex=cex, tcl=tcl, tcl.text=tcl.text, digits=digits) } if (axes==FALSE & ticks) { at <- (0:num.ticks)/num.ticks*2*pi if (rotation=="clock") at <- -at at <- at + zero ticks.circular(circular(x=at, type="angles", units="radians", modulo="asis", zero=zero, rotation=rotation), tcl=tcl) } OUT <- round(new/sum(OUT[m,]),3) colnamesout <- rep("", bins) breaks <- conversion.circular(circular(breaks), units=units) mids <- conversion.circular(circular(mids), units=units) for (i in 1:bins) { if (right) { colnamesout[i] <- paste("(", round(breaks[i], digits=digits), ", ", round(breaks[i+1], digits=digits), "]", sep="") } else { colnamesout[i] <- paste("[", round(breaks[i], digits=digits), ", ", round(breaks[i+1], digits=digits), ")", sep="") } } colnames(OUT) <- colnamesout rownames(OUT) <- paste( "(", 0:(J-1)*increment, ",", 1:J * increment, "]", sep = "") result$table <- OUT result$number.obs <- no result$number.calm <- calmcalm result$breaks <- breaks result$mids <- mids result$shrink <- shrink result$call <- match.call() invisible(result) } circular/R/equal.kappa.test.R0000644000176200001440000001016612236523363015573 0ustar liggesusers ############################################################# # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################# ############################################################# # # # equal.kappa.test function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: November, 06, 2013 # # Version: 0.4 # # # # Copyright (C) 2013 Claudio Agostinelli # # # ############################################################# equal.kappa.test <- function(x, group) { # Handling missing values ok <- complete.cases(x, group) x <- x[ok] group <- group[ok, drop = TRUE] if (length(x)==0 | length(table(group)) < 2) { warning("No observations or no groups (at least after removing missing values)") return(NULL) } x <- conversion.circular(x, units="radians", zero=0, rotation="counter", modulo="2pi") attr(x, "class") <- attr(x, "circularp") <- NULL result <- EqualKappaTestRad(x, group) result$call <- match.call() class(result) <- "equal.kappa.test" return(result) } EqualKappaTestRad <- function(x, group) { x <- x%%(2*pi) ns <- tapply(x, group, FUN=length) r.bars <- tapply(x, group, FUN=RhoCircularRad) rs <- r.bars*ns kappas <- tapply(x, group, FUN=function(x) MlevonmisesRad(x)[4]) grps <- length(r.bars) n <- length(group) r.bar.all <- RhoCircularRad(x) kappa.all <- MlevonmisesRad(x)[4] warn1 <- 0 if (r.bar.all < 0.45){ g1 <- function(x){asin(sqrt(3/8)*x)} ws <- 4*(ns-4)/3 g1s <- g1(2*r.bars) U <- sum(ws*g1s^2) - sum(ws*g1s)^2/sum(ws) if (any(is.na(g1s))) { warn1 <- 1 warning("An argument outside of [-1,1] was passed to asin function in calculation of approximate chi-squared test statistic. Bartlett's test of homogeneity was used instead of the approximation using asin.") } } if (r.bar.all >= 0.45 & r.bar.all <= 0.70){ g2 <- function(x){ c1 <- 1.089 c2 <- 0.258 asinh((x-c1)/c2) } ws <- (ns-3)/0.798 g2s <- g2(r.bars) U <- sum(ws*g2s^2) - sum(ws*g2s)^2/sum(ws) } if (r.bar.all > 0.70 | warn1==1){ vs <- ns-1 v <- n-grps d <- 1/(3*(grps-1))*(sum(1/vs)-1/v) U <- 1/(1+d)*(v*log((n-sum(rs))/v) - sum(vs*log((ns-rs)/vs))) } p.value <- 1-pchisq(U, grps-1) result <- list(kappa=kappas, kappa.all=kappa.all, rho=r.bars, rho.all=r.bar.all, df=grps-1, statistic=U, p.value=p.value) return(result) } ############################################################# # # # print.equal.kappa.test functio # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: April, 13, 2005 # # Version: 0.1-1 # # # # Copyright (C) 2005 Claudio Agostinelli # # # ############################################################# print.equal.kappa.test <- function(x, digits = max(3, getOption("digits") - 3), ...) { cat("\nCall:\n",deparse(x$call),"\n\n",sep="") cat("\n", "Test for Homogeneity of Concentration Parameters", "\n \n") cat(" df: ", format(x$df, digits=digits), "\n ChiSq: ", format(x$statistic, digits=digits), "\n p.value:", format(x$p.value, digits=digits), "\n \n") invisible(x) } circular/R/plot.lsfit.circle.R0000644000176200001440000000514611312211537015742 0ustar liggesusers ############################################################# # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################# ############################################################# # # # plot.lsfit.circle function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: December, 15, 2004 # # Version: 0.1 # # # # Copyright (C) 2004 Claudio Agostinelli # # # ############################################################# plot.lsfit.circle <- function(x, add=FALSE, main=NULL, xlim=NULL, ylim=NULL, xlab=NULL, ylab=NULL, uin, tol=0.04, plus.cex=1, ...){ xx <- x x <- xx$x y <- xx$y r <- xx$coefficients[1] a <- xx$coefficients[2] b <- xx$coefficients[3] if (is.null(xlim)) { xlim <- range(c(a+r*cos(seq(0., 2. * pi, length = 1000.)), x)) } if (is.null(ylim)) { ylim <- range(c(b+r*sin(seq(0., 2. * pi, length = 1000.)), y)) } if (is.null(xlab)) xlab <- "X" if (is.null(ylab)) ylab <- "Y" if (is.null(main)) main <- "Least Square Circle Fit" midx <- 0.5 * (xlim[2] + xlim[1]) xlim <- midx + (1 + tol) * 0.5 * c(-1, 1) * (xlim[2] - xlim[1]) midy <- 0.5 * (ylim[2] + ylim[1]) ylim <- midy + (1 + tol) * 0.5 * c(-1, 1) * (ylim[2] - ylim[1]) oldpin <- par("pin") xuin <- oxuin <- oldpin[1]/diff(xlim) yuin <- oyuin <- oldpin[2]/diff(ylim) if (missing(uin)) { if (yuin > xuin) xuin <- yuin else yuin <- xuin } else { if (length(uin) == 1) uin <- uin * c(1, 1) if (any(c(xuin, yuin) < uin)) stop("uin is too large to fit plot in") xuin <- uin[1]; yuin <- uin[2] } xlim <- midx + oxuin/xuin * c(-1, 1) * diff(xlim) * 0.5 ylim <- midy + oyuin/yuin * c(-1, 1) * diff(ylim) * 0.5 if (!add) { plot.default(0, 0, main=main, type="n", xlab=xlab, ylab=ylab, xlim=xlim, ylim=ylim, ...) } lines.default(a+ r*cos(seq(0., 2. * pi, length = 1000.)), b+r*sin(seq(0., 2. * pi, length = 1000.)), ...) points.default(x, y, ...) text.default(a, b, "+", cex=plus.cex) invisible(xx) } circular/R/modal.region.R0000644000176200001440000002134312206626673014775 0ustar liggesusersmodal.region <- function(x, ...) UseMethod("modal.region") modal.region.default <- function(x, ...) .NotYetImplemented() ############################################################# # # modal.region.circular # GNU General Public Licence 2.0 # Author: Claudio Agostinelli # E-mail: claudio@unive.it # Date: July, 21, 2011 # Version: 0.6 # # Copyright (C) 2011 Claudio Agostinelli # ############################################################# modal.region.circular <- function(x, z=NULL, q=0.95, bw, adjust = 1, type = c("K", "L"), kernel = c("vonmises", "wrappednormal"), na.rm = FALSE, step=0.01, eps.lower=10^(-4), eps.upper=10^(-4), ...) { if (is.null(z)) z <- circular(seq(0,2*pi+step,step)) if (is.circular(x)) xcp <- circularp(x) else xcp <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") x <- conversion.circular(x, units="radians", zero=0, rotation="counter", modulo="2pi") z <- conversion.circular(z, units="radians", zero=0, rotation="counter", modulo="asis") object <- density.circular(x=x, z=z, bw=bw, adjust=adjust, type=type, kernel=kernel, na.rm=na.rm) if (q > 1 | q < 0) stop("'q' must be between 0 and 1") pos.max <- which.max(object$y) pos.min <- which.min(object$y) if (q==0 & length(pos.max)==1) { zeros <- matrix(c(object$x[pos.max], object$x[pos.max]), nrow=1) areas <- list(tot=0, areas=0) l <- object$y[pos.max] } else if (q==1 & length(pos.min)==1) { zeros <- matrix(c(0, object$x[pos.min], object$x[pos.min], 2*pi), nrow=2, byrow=TRUE) areas <- list(tot=1, areas=1) l <- object$y[pos.min] } else { internal <- function(x) { area(allcrosses(l=x, object=object, grid=z), object)$tot - q } l <- uniroot(internal, lower=min(object$y)*(1+eps.lower), upper=max(object$y)*(1-eps.upper))$root zeros <- allcrosses(l=l, object=object, grid=z) areas <- area(zeros, object) } result <- list() xunits <- circularp(x)$units result$zeros <- conversion.circular(circular(zeros), xcp$units, xcp$type, xcp$template, 'asis', xcp$zero, xcp$rotation) result$areas <- areas object$x <- conversion.circular(object$x, xcp$units, xcp$type, xcp$template, 'asis', xcp$zero, xcp$rotation) result$density <- object result$q <- q result$level <- l class(result) <- 'modal.region.circular' return(result) } ############################################################# # # plot.modal.region.circular # GNU General Public Licence 2.0 # Author: Claudio Agostinelli # E-mail: claudio@unive.it # Date: July, 5, 2011 # Version: 0.5-1 # # Copyright (C) 2011 Claudio Agostinelli # ############################################################# plot.modal.region.circular <- function(x, plot.type=c('line', 'circle'), xlab=NULL, ylab=NULL, xlim=NULL, ylim=NULL, main=NULL, polygon.control=list(), ...) { polygon.control.default <- list(density = NULL, angle = 45, border = NULL, col = NA, lty = par("lty"), fillOddEven = FALSE) npc <- names(polygon.control) npcd <- names(polygon.control.default) polygon.control <- c(polygon.control, polygon.control.default[setdiff(npcd, npc)]) plot.type <- match.arg(plot.type) if (is.null(xlab)) xlab <- paste('bw=', round(x$density$bw,3), sep='') if (is.null(ylab)) ylab <- 'Kernel Density Estimates' if (is.null(main)) main <- 'Areas under the curve' plot(x$density, plot.type=plot.type, xlab=xlab, ylab=ylab, main=main, xlim=xlim, ylim=ylim, ...) if (plot.type=='line') { abline(h=x$level, lty=2) abline(v=c(x$zeros), lty=2) for (i in 1:nrow(x$zeros)) { zero1 <- x$zeros[i,1] zero2 <- x$zeros[i,2] inside <- x$density$x >= zero1 & x$density$x <= zero2 polygon(x=c(zero2, zero1, x$density$x[inside], zero2), y=c(0,0,x$density$y[inside], 0), density = polygon.control$density, angle = polygon.control$angle, border = polygon.control$border, col = polygon.control$col, lty = polygon.control$lty, fillOddEven = polygon.control$fillOddEven) } } else { warning('Not Yet Implemented for plot.type=circle') } } ############################################################# # # lines.modal.region.circular # GNU General Public Licence 2.0 # Author: Claudio Agostinelli # E-mail: claudio@unive.it # Date: July, 5, 2011 # Version: 0.5-1 # # Copyright (C) 2011 Claudio Agostinelli # ############################################################# lines.modal.region.circular <- function(x, plot.type=c('line', 'circle'), polygon.control=list(), ...) { polygon.control.default <- list(density = NULL, angle = 45, border = NULL, col = NA, lty = par("lty"), fillOddEven = FALSE) npc <- names(polygon.control) npcd <- names(polygon.control.default) polygon.control <- c(polygon.control, polygon.control.default[setdiff(npcd, npc)]) plot.type <- match.arg(plot.type) lines(x$density, plot.type=plot.type, ...) if (plot.type=='line') { abline(h=x$level, lty=2) abline(v=c(x$zeros), lty=2) for (i in 1:nrow(x$zeros)) { zero1 <- x$zeros[i,1] zero2 <- x$zeros[i,2] inside <- x$density$x >= zero1 & x$density$x <= zero2 polygon(x=c(zero2, zero1, x$density$x[inside], zero2), y=c(0,0,x$density$y[inside], 0), density = polygon.control$density, angle = polygon.control$angle, border = polygon.control$border, col = polygon.control$col, lty = polygon.control$lty, fillOddEven = polygon.control$fillOddEven) } } else { warning('Not Yet Implemented for plot.type=circle') } } ############################################################# # # Internal functions for modal.region.circular # GNU General Public Licence 2.0 # Author: Claudio Agostinelli # E-mail: claudio@unive.it # Date: July, 5, 2011 # Version: 0.5-1 # # Copyright (C) 2011 Claudio Agostinelli # ############################################################# ### product of subsequent observations (like function diff.default) prodseq <- function (x, lag = 1L, differences = 1L, ...) { ismat <- is.matrix(x) xlen <- if (ismat) dim(x)[1L] else length(x) if (length(lag) > 1L || length(differences) > 1L || lag < 1L || differences < 1L) stop("'lag' and 'differences' must be integers >= 1") if (lag * differences >= xlen) return(x[0]) r <- unclass(x) i1 <- -seq_len(lag) if (ismat) for (i in seq_len(differences)) r <- r[i1, , drop = FALSE] * r[-nrow(r):-(nrow(r) - lag + 1L), , drop = FALSE] else for (i in seq_len(differences)) r <- r[i1] * r[-length(r):-(length(r) - lag + 1L)] class(r) <- oldClass(x) return(r) } ### Search for all crosses allcrosses <- function(l, object, grid=seq(0,2*pi+0.01,0.01), tol=.Machine$double.eps^0.25, ...) { den <- approxfun(x=object$x, y=object$y) int <- function(x, l) { den(x) - l } x <- object$x y <- int(x=grid, l=l) sy <- sign(y) psy <- prodseq(sy) pos <- which(psy==-1) if (length(pos)) { intervals <- matrix(c(grid[pos], grid[pos+1]), ncol=2, byrow=FALSE) sy <- matrix(c(sy[pos], sy[pos+1]), ncol=2, byrow=FALSE) zeros <- rep(NA, nrow(intervals)) for (i in 1:nrow(intervals)) { zeros[i] <- cross(l=l, object=object, lower=intervals[i,1], upper=intervals[i,2], tol=tol, ...) } if (length(zeros)%%2) { if (isTRUE(all.equal(zeros[1L]%%(2*pi), zeros[length(zeros)]%%(2*pi), tol=tol^0.9, scale=1))) zeros <- zeros[-length(zeros)] } if (!length(zeros)%%2) { tsy <- apply(sy,2,prodseq) if (all(tsy==-1)) { if (sy[1,1]==1) { zeros <- c(0, zeros, 2*pi) } zeros <- matrix(zeros, ncol=2, byrow=TRUE) } else { warning('Probably one zeros is missed, the zeros found are not in order') } } else { warning('The number of zeros is odd. At least one zero is missed') } } else { zeros <- NA } return(zeros) } ## Search the precise position of one cross cross <- function(l, object, lower, upper, ...) { #l: level #object: an object from density.circular with results in radians den <- approxfun(x=object$x, y=object$y) int <- function(x, l) { den(x) - l } zero <- uniroot(int, l=l, lower=lower, upper=upper, ...)$root return(zero) } ## Calculate areas under several disjoint intervals area <- function(x, object, ...) { #x: is a matrix with two columns #object: an object from density.circular #...: values passed to integrate function den <- approxfun(x=c(object$x-2*pi,object$x,object$x+2*pi), y=rep(object$y, 3)) int <- function(x) integrate(f=den, lower=x[1], upper=x[2], ...)$value areas <- apply(x, 1, int) tot <- sum(areas) result <- list(tot=tot, areas=areas) return(result) } circular/R/lm.circular.R0000644000176200001440000000154111312211537014612 0ustar liggesusers ############################################################# # # # lm.circular function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: April, 27, 2005 # # Version: 0.2 # # # # Copyright (C) 2005 Claudio Agostinelli # # # ############################################################# lm.circular <- function(..., type=c("c-c", "c-l")) { type <- match.arg(type) if (type=="c-c") { lm.circular.cc(...) } else { lm.circular.cl(...) } } circular/R/points.circular.R0000644000176200001440000000747412371161713015537 0ustar liggesusers############################################################# # # # points.circular function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: August, 08, 2014 # # Version: 0.4 # # # # Copyright (C) 2014 Claudio Agostinelli # # # ############################################################# points.circular <- function(x, pch = 16, cex = 1, stack = FALSE, start.sep=0, sep = 0.025, shrink=1, bins=NULL, col=NULL, next.points=NULL, plot.info=NULL, zero=NULL, rotation=NULL, ...) { if (is.matrix(x) | is.data.frame(x)) { nseries <- ncol(x) } else { nseries <- 1 } xx <- as.data.frame(x) xcircularp <- attr(as.circular(xx[,1]), "circularp") type <- xcircularp$type modulo <- xcircularp$modulo if (is.null(plot.info)) { if (is.null(zero)) zero <- xcircularp$zero if (is.null(rotation)) rotation <- xcircularp$rotation if (is.null(next.points)) next.points <- 0 } else { zero <- plot.info$zero rotation <- plot.info$rotation if (is.null(next.points)) next.points <- plot.info$next.points } if (is.null(bins)) { bins <- NROW(x) } else { bins <- round(bins) if (bins<=0) stop("bins must be non negative") } if (is.null(col)) { col <- seq(nseries) } else { if (length(col)!=nseries) { col <- rep(col, nseries)[1:nseries] } } pch <- rep(pch, nseries, length.out=nseries) for (iseries in 1:nseries) { x <- xx[,iseries] x <- na.omit(x) n <- length(x) if (n) { x <- conversion.circular(x, units="radians") attr(x, "circularp") <- attr(x, "class") <- NULL if (rotation=="clock") x <- -x x <- x+zero x <- x%%(2*pi) PointsCircularRad(x, bins, stack, col, pch, iseries, nseries, start.sep, sep, next.points, shrink, cex, ...) } } return(invisible(list(zero=zero, rotation=rotation, next.points=next.points+nseries*sep))) } PointsCircularRad <- function(x, bins, stack, col, pch, iseries, nseries, start.sep, sep, next.points, shrink, cex, ...) { #### x musts be in modulo 2pi if (!stack) { z <- cos(x) y <- sin(x) r <- 1+((iseries-1)*sep+next.points+start.sep)*shrink points.default(z*r, y*r, cex=cex, pch=pch[iseries], col = col[iseries], ...) } else { x[x >= 2*pi] <- 2*pi-4*.Machine$double.eps arc <- (2 * pi)/bins pos.bins <- ((1:nseries)-1/2)*arc/nseries-arc/2 # bins.count <- c(1:bins) # for (i in 1:bins) { # bins.count[i] <- sum(x < i * arc & x >= (i - 1) * arc) # } breaks <- seq(0,2*pi,length.out=(bins+1)) bins.count <- hist.default(x, breaks=breaks, plot=FALSE, right=TRUE)$counts ###### TO BE USED IN THE FUTURE .C("bincount", x, as.integer(length(x)), seq(0,2*pi,length.out=bins), as.integer(bins+1), counts = integer(bins), right = as.logical(TRUE), include = as.logical(FALSE), naok = FALSE, NAOK = FALSE, DUP = FALSE, PACKAGE = "base")$counts mids <- seq(arc/2, 2 * pi - pi/bins, length = bins) + pos.bins[iseries] index <- cex*sep for (i in 1:bins) { if (bins.count[i] != 0) { for (j in 0:(bins.count[i] - 1)) { r <- 1 + start.sep + j * index z <- r * cos(mids[i]) y <- r * sin(mids[i]) points.default(z, y, cex=cex, pch=pch[iseries], col=col[iseries], ...) } } } } } circular/R/Ralpha.R0000644000176200001440000001024611312211537013610 0ustar liggesusersRalpha <- function(x, n, alpha) { #x is the C part of the observed R (resultant length) if (n==1) stop('We are not able to provide sensible results for n=1') I2n <- function(x, n, lower=NULL, upper=NULL) { if (is.null(lower)) lower <- 0 if (is.null(upper)) { if (n < 1500) upper <- 100+10000/n else upper <- 50+10000/n } #x is R here while in the next x is the variable of integration temp <- function(x, n, lower, upper) { f1 <- integrate(function(x, R, n) besselJ(x, 0)^n*besselJ(R*x, 0)*x, lower=lower, upper=upper-2*0.99*log(n), R=x, n=n, subdivisions=4000, stop.on.error=FALSE)$value f2 <- integrate(function(x, R, n) besselJ(x, 0)^n*besselJ(R*x, 0)*x, lower=lower, upper=upper-0.99*log(n), R=x, n=n, subdivisions=4000, stop.on.error=FALSE)$value f3 <- integrate(function(x, R, n) besselJ(x, 0)^n*besselJ(R*x, 0)*x, lower=lower, upper=upper, R=x, n=n, subdivisions=4000, stop.on.error=FALSE)$value f4 <- integrate(function(x, R, n) besselJ(x, 0)^n*besselJ(R*x, 0)*x, lower=lower, upper=upper+0.99*log(n), R=x, n=n, subdivisions=4000, stop.on.error=FALSE)$value f5 <- integrate(function(x, R, n) besselJ(x, 0)^n*besselJ(R*x, 0)*x, lower=lower, upper=upper+2*0.99*log(n), R=x, n=n, subdivisions=4000, stop.on.error=FALSE)$value median(c(f1,f2,f3,f4,f5)) } sapply(X=x, FUN=temp, n=n, lower=lower, upper=upper) } I3n <- function(x, n, lower=NULL, upper=NULL) { if (is.null(lower)) lower <- 0 if (is.null(upper)) { #### upper <- approx(x=c(4, 5, 10, 13, 15, 20, 28, 50, 60, 75, 100, 250, 500, 1000, 2000, 5000), y=c(6000, 2000, 1250, 1000, 700, 600, 500, 400, 350, 300, 250, 200, 150, 90, 70, 50), xout=n, method='constant', yleft=6000, yright=40, rule=2, f=1)$y #### lma <- lm(I(y[-(1:2)]~I(1/x[-(1:2)])) #### upper <- 114.3+10856.2/n if (n < 1500) upper <- 100+10000/n else upper <- 50+10000/n } #x is the C part here while in the next x is the variable of integration temp <- function(x, n, lower, upper) { f1 <- integrate(function(x, C, n) besselJ(x, 0)^n*cos(C*x), lower=lower, upper=upper-2*0.99*log(n+1), C=x, n=n, subdivisions=4000, stop.on.error=FALSE)$value f2 <- integrate(function(x, C, n) besselJ(x, 0)^n*cos(C*x), lower=lower, upper=upper-0.99*log(n+1), C=x, n=n, subdivisions=4000, stop.on.error=FALSE)$value f3 <- integrate(function(x, C, n) besselJ(x, 0)^n*cos(C*x), lower=lower, upper=upper, C=x, n=n, subdivisions=4000, stop.on.error=FALSE)$value f4 <- integrate(function(x, C, n) besselJ(x, 0)^n*cos(C*x), lower=lower, upper=upper+0.99*log(n+1), C=x, n=n, subdivisions=4000, stop.on.error=FALSE)$value f5 <- integrate(function(x, C, n) besselJ(x, 0)^n*cos(C*x), lower=lower, upper=upper+2*0.99*log(n+1), C=x, n=n, subdivisions=4000, stop.on.error=FALSE)$value median(c(f1,f2,f3,f4,f5)) } sapply(X=x, temp, n=n, lower=lower, upper=upper) } lhs <- function(x, C, n) { #left hand side of the equation #x is the R0 while in the next x is the variable of integration temp <- function(x, C, n) integrate(function(x, C, n) x/sqrt(x^2-C^2)*I2n(x, n), lower=x, upper=n, C=C, n=n, subdivisions=4000, stop.on.error=FALSE)$value sapply(X=x, FUN=temp, C=C, n=n) } equat <- function(x, C, n, alphaI3n) { #equation lhs(x=x, C=C, n=n) - alphaI3n } temp <- function(x, n, alpha) { alphaI3n <- alpha*I3n(x=x, n=n) uniroot(equat, lower=x, upper=n, C=x, n=n, alphaI3n=alphaI3n)$root } sapply(X=x, FUN=temp, n=n, alpha=alpha) } Ralphaapprox <- function(x, n, alpha) { if (n<3) stop('We are not able to provide sensible results for n<3') temp <- function(x, n, alpha) { if (n >=15 & x > 0 & x < n/3) { y <- sqrt(x^2+qchisq(alpha, df=1, lower.tail=FALSE)*0.5*n) #3.2 } else if (x > n/2 & x < 3*n/4) { ff <- qf(alpha, df1=2, df2=2*n-2, lower.tail=FALSE) y <- (ff*n+(n-1)*x)/(n+ff-1) #3.3 } else if (x > 5/6*n) { ff <- qf(alpha, df1=1, df2=n-1, lower.tail=FALSE) y <- (ff*n+(n-1)*x)/(n+ff-1) #3.4 } else { y <- NA } return(y) } sapply(X=x, FUN=temp, n=n, alpha=alpha) } circular/R/wallraff.test.R0000644000176200001440000001022212236524042015153 0ustar liggesusers# # Wallraff procedure for comparing angular distances # # Allows to compare the deviation from an angle of interest # between several data sets. If the angle of interest is # the mean direction, then it becomes a comparison of # angular dispersion around the mean. # # In essence, it is a rank-based test (Wilcoxon-Mann-Withney # or Kruskall-Wallis) on the angular distances from the angle # of interest. # # (c) Copyright 2011 Jean-Olivier Irisson # GNU General Public License v3 # #------------------------------------------------------------ # added drop=TRUE 20131106 Claudio # Generic function wallraff.test <- function(x, ...) { UseMethod("wallraff.test", x) } # Default method, for an angle vector and a grouping vector wallraff.test.default <- function(x, group, ref=NULL, ...) { # get data name data.name <- paste(deparse(substitute(x)), "by", deparse(substitute(group))) # check arguments ok <- complete.cases(x, group) x <- x[ok] group <- group[ok,drop=TRUE] if (length(x)==0 | length(table(group)) < 2) { stop("No observations or no groups (at least after removing missing values)") } # make sure group is a factor # if not, force it to keep the order in the original vector if (!is.factor(group)) { group <- factor(group, levels=unique(group)) if (!is.null(ref)) { warning("\"group\" was converted into a factor.\n The levels were kept in the order of the original vector:\n ", paste(levels(group), collapse=", "), "\n Please make sure the elements of \"ref\" match this order") } } # convert data to the radians/trigonometric case if (is.circular(x)) { dc <- circularp(x) x <- conversion.circular(x, units="radians", zero=0, rotation="counter", modulo="2pi") attr(x, "class") <- attr(x, "circularp") <- NULL } else { dc <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") } if (is.null(ref)) { # if no reference angle is provided, use the mean angle xL <- split(x, group) ref <- sapply(xL, MeanCircularRad) } else { # when a reference angle is provided, if it is not of class circular, cast it as circular assuming that it is in the same reference as the original data if (!is.circular(ref)) { ref <- circular(ref, type=dc$type, units=dc$units, template=dc$template, modulo=dc$modulo, zero=dc$zero, rotation=dc$rotation) } # now that ref necessarily circular, convert it to the radians/trigonometric case ref <- conversion.circular(ref, units="radians", zero=0, rotation="counter", modulo="2pi") attr(ref, "class") <- attr(ref, "circularp") <- NULL } # compute concentration parameters and check assumptions result <- WallraffTestRad(x, group, ref) result$data.name <- data.name return(result) } # Method for a list wallraff.test.list <- function(x, ref=NULL, ...) { # fecth or fill list names k <- length(x) if (is.null(names(x))) { names(x) <- 1:k } # get data name data.name <- paste(names(x), collapse=" and ") # convert into x and group ns <- lapply(x, length) group <- rep(names(x), times=ns) group <- factor(group, levels=unique(group)) x <- do.call("c", x) # NB: unlist() removes the circular attributes here # call default method result <- wallraff.test.default(x, group, ref) result$data.name <- data.name return(result) } # Method for a formula wallraff.test.formula <- function(formula, data, ref=NULL, ...) { # convert into x and group d <- model.frame(as.formula(formula), data) # get data name data.name <- paste(names(d), collapse=" by ") # call default method result <- wallraff.test.default(d[,1], d[,2], ref) result$data.name <- data.name return(result) } # Computation in the usual trigonometric space WallraffTestRad <- function(x, group, ref) { # consolidate data if (length(ref) < nlevels(group)) { ref = rep(ref, nlevels(group)) } d <- matrix(c(x, ref=ref[as.numeric(group)]), ncol=2) # compute angular distances = ranges dists <- apply(d, 1, function(X) RangeCircularRad(X[1:2], test=FALSE) ) result <- kruskal.test(dists, group) # NB: kruskal.test with 2 groups is equivalent to wilcox.test with exact=FALSE and correct=FALSE result$method <- "Wallraff rank sum test of angular distance" return(result) } circular/R/mle.cardioid.R0000644000176200001440000000624111312211537014733 0ustar liggesusers############################################################# # # # mle.cardioid function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: December, 6, 2005 # # Copyright (C) 2005 Claudio Agostinelli # # # # Version 0.1-2 # ############################################################# mle.cardioid <- function(x, mu, rho=0, max.iter=100, tol=1e-3) { # Handling missing values x <- na.omit(x) if (length(x)==0) { warning("No observations (at least after removing missing values)") return(NULL) } if (rho==0) { mu <- NA convergence <- FALSE } else { x <- as.circular(x) xcircularp <- circularp(x) units <- xcircularp$units x <- conversion.circular(x, units="radians") n <- length(x) sinr <- sum(sin(x)) cosr <- sum(cos(x)) if (missing(mu)) mu <- atan2(sinr, cosr) diff <- tol + 1 i <- 0 while (diff>tol & i <= max.iter) { i <- i + 1 mu.old <- mu temp <- 1+2*rho*cos(x-mu) mu <- atan2(sum(sin(x)/temp),sum(cos(x)/temp)) cat("i ", i, "\n") cat("mu ", mu, "\n") cat("temp ", cos(x-mu)[1], "\n") diff <- abs(mu-mu.old) } convergence <- TRUE if (i > max.iter) convergence <- FALSE if (units=="degrees") { mu <- mu/pi*180 } } attr(mu, "circularp") <- xcircularp attr(mu, "class") <- "circular" result <- list() result$call <- match.call() result$mu <- mu result$convergence <- convergence class(result) <- "mle.cardioid" return(result) } ############################################################# # # # print.mle.cardioid function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: April, 29, 2003 # # Version: 0.1 # # # # Copyright (C) 2003 Claudio Agostinelli # # # ############################################################# print.mle.cardioid <- function(x, digits = max(3, getOption("digits") - 3), ...) { cat("\nCall:\n",deparse(x$call),"\n\n",sep="") cat("mu: \n") print(x$mu, digits=digits) cat("\n") if (!x$convergence) cat("Maximum number of iteration is reached \n") invisible(x) } ver <- function(x, mu, rho) { prod(dcardioid(x, mu, rho)) } score <- function(x, mu, rho) { temp <- 1+2*rho*cos(x-mu) cos(mu)*sum(sin(x)/temp)-sin(mu)*sum(cos(x)/temp) } #grid <- seq(0, 2*pi, 0.1) #res <- res.s <- vector(length=0) #for(i in 1:length(grid)) { # res <- c(res, ver(x, grid[i], rho)) # res.s <- c(res.s, score(x, grid[i], rho)) #} circular/R/wrappednormal.R0000644000176200001440000002154111430767673015276 0ustar liggesusers############################################################# # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################# ############################################################# # # # rwrappednormal function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: August, 10, 2006 # # Copyright (C) 2006 Claudio Agostinelli # # # # Version 0.3-3 # ############################################################# rwrappednormal <- function(n, mu=circular(0), rho=NULL, sd=1, control.circular=list()) { if (is.circular(mu)) { datacircularp <- circularp(mu) } else { datacircularp <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") } dc <- control.circular if (is.null(dc$type)) dc$type <- datacircularp$type if (is.null(dc$units)) dc$units <- datacircularp$units if (is.null(dc$template)) dc$template <- datacircularp$template if (is.null(dc$modulo)) dc$modulo <- datacircularp$modulo if (is.null(dc$zero)) dc$zero <- datacircularp$zero if (is.null(dc$rotation)) dc$rotation <- datacircularp$rotation mu <- conversion.circular(mu, units="radians", zero=0, rotation="counter") attr(mu, "class") <- attr(mu, "circularp") <- NULL if (is.null(rho)) rho <- exp(-sd^2/2) if (rho < 0 | rho > 1) stop("rho must be between 0 and 1") result <- RwrappednormalRad(n, mu, rho) result <- conversion.circular(circular(result), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) return(result) } RwrappednormalRad <- function(n, mu, rho) { if (rho == 0) result <- runif(n, 0, 2*pi) else if (rho == 1) result <- rep(mu, n) else { sd <- sqrt(-2 * log(rho)) result <- rnorm(n, mu, sd) %% (2*pi) } return(result) } ############################################################# # # # dwrappednormal function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: May, 31, 2006 # # Copyright (C) 2006 Claudio Agostinelli # # # # Version 0.3-1 # ############################################################# dwrappednormal <- function(x, mu=circular(0), rho=NULL, sd=1, K=NULL, min.k=10) { x <- conversion.circular(x, units="radians", zero=0, rotation="counter") mu <- conversion.circular(mu, units="radians", zero=0, rotation="counter") attr(x, "class") <- attr(x, "circularp") <- NULL attr(mu, "class") <- attr(mu, "circularp") <- NULL if (is.null(rho)) rho <- exp(-sd^2/2) if (rho < 0 | rho > 1) stop("rho must be between 0 and 1") if (length(mu)!=1) stop("is implemented only for scalar 'mean'") result <- DwrappednormalRad(x, mu, rho, K, min.k) return(result) } DwrappednormalRad <- function(x, mu, rho, K, min.k=10) { var <- -2 * log(rho) sd <- sqrt(var) if (is.null(K)) { range <- abs(mu-x) K <- (range+6*sqrt(var))%/%(2*pi)+1 K <- max(min.k, K) } n <- length(x) z <- .Fortran("dwrpnorm", as.double(x), as.double(mu), as.double(sd), as.integer(n), as.integer(length(mu)), as.integer(K), d=mat.or.vec(length(mu), n), PACKAGE="circular" ) d <- t(z$d/sqrt(var * 2 * pi)) if (ncol(d)==1) d <- c(d) return(d) } ############################################################# # # # pwrappednormal function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: May, 31, 2006 # # Copyright (C) 2006 Claudio Agostinelli # # # # Version 0.2-1 # ############################################################# pwrappednormal <- function(q, mu=circular(0), rho=NULL, sd=1, from=NULL, K=NULL, min.k=10, ...) { q <- conversion.circular(q, units="radians", zero=0, rotation="counter", modulo="2pi") mu <- conversion.circular(mu, units="radians", zero=0, rotation="counter", modulo="2pi") if (is.null(from)) { from <- mu - pi } else { from <- conversion.circular(from, units="radians", zero=0, rotation="counter", modulo="2pi") } attr(q, "class") <- attr(q, "circularp") <- NULL attr(mu, "class") <- attr(mu, "circularp") <- NULL attr(from, "class") <- attr(from, "circularp") <- NULL n <- length(q) if (length(mu) != 1) stop("is implemented only for scalar 'mean'") mu <- (mu-from)%%(2*pi) q <- (q-from)%%(2*pi) if (is.null(rho)) { rho <- exp(-sd^2/2) } if (rho < 0 | rho > 1) stop("rho must be between 0 and 1") intDwrappednormalRad <- function(q) { if (is.na(q)) { return(NA) } else { return(integrate(DwrappednormalRad, mu=mu, rho=rho, K=K, min.k=min.k, lower=0, upper=q, ...)$value) } } value <- sapply(X=q, FUN=intDwrappednormalRad) return(value) } ############################################################# # # # qwrappednormal function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: August, 12, 2010 # # Copyright (C) 2010 Claudio Agostinelli # # # # Version 0.3-1 # ############################################################# qwrappednormal <- function(p, mu=circular(0), rho=NULL, sd=1, from=NULL, K=NULL, min.k=10, tol=.Machine$double.eps^(0.6), control.circular=list(), ...) { epsilon <- 10 * .Machine$double.eps if (any(p>1) | any(p<0)) stop("p must be in [0,1]") if (is.circular(mu)) { datacircularp <- circularp(mu) } else { datacircularp <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") } dc <- control.circular if (is.null(dc$type)) dc$type <- datacircularp$type if (is.null(dc$units)) dc$units <- datacircularp$units if (is.null(dc$template)) dc$template <- datacircularp$template if (is.null(dc$modulo)) dc$modulo <- datacircularp$modulo if (is.null(dc$zero)) dc$zero <- datacircularp$zero if (is.null(dc$rotation)) dc$rotation <- datacircularp$rotation mu <- conversion.circular(mu, units="radians", zero=0, rotation="counter", modulo="2pi") if (is.null(from)) { from <- mu - pi } else { from <- conversion.circular(from, units="radians", zero=0, rotation="counter", modulo="2pi") } attr(mu, "class") <- attr(mu, "circularp") <- NULL attr(from, "class") <- attr(from, "circularp") <- NULL n <- length(p) if (length(mu) != 1) stop("is implemented only for scalar 'mean'") mu <- (mu-from)%%(2*pi) if (is.null(rho)) rho <- exp(-sd^2/2) if (rho < 0 | rho > 1) stop("rho must be between 0 and 1") zeroPwrappednormalRad <- function(x, p, mu, rho, K, min.k) { if (is.na(x)) { y <- NA } else { y <- integrate(DwrappednormalRad, mu=mu, rho=rho, K=K, min.k=min.k, lower=0, upper=x)$value - p } return(y) } value <- rep(NA, length(p)) sem <- options()$show.error.messages options(show.error.messages=FALSE) for (i in 1:length(p)) { res <- try(uniroot(zeroPwrappednormalRad, p=p[i], mu=mu, rho=rho, K=K, min.k=min.k, lower=0, upper=2*pi-epsilon, tol=tol)) if (is.list(res)) { value[i] <- res$root } else if (p[i] < 10*epsilon) { value[i] <- 0 } else if (p[i] > 1-10*epsilon) { value[i] <- 2*pi-epsilon } } options(show.error.messages=sem) value <- value + from value <- conversion.circular(circular(value), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) return(value) } circular/R/trigonometric.polynomials.R0000644000176200001440000000415112072527000017630 0ustar liggesusers##################################################################### # # # trigonometric.polynomials function # # Author: Claudio Agostinelli and Alessandro Gagliardi # # Email: claudio@unive.it # # Date: January, 04, 2013 # # Copyright (C) 2013 Claudio Agostinelli and Alessandro Gagliardi # # # # Version 0.1 # ##################################################################### trigonometric.polynomials <- function(x, p = 1, center = FALSE) { p <- as.vector(p) x <- conversion.circular(x, units="radians", zero=0, rotation="counter") attr(x, "class") <- attr(x, "circularp") <- NULL x <- as.matrix(x) if (is.null(colnames(x))) colnam <- paste('x', 1L:NCOL(x), sep='') else colnam <- colnames(x) # if (is.null(colnames(x))) { # if (NCOL(x)==1) # colnames(x) <- deparse(substitute(x)) # else # colnames(x) <- paste(deparse(substitute(x)), 1L:NCOL(x), sep='') # } result <- matrix(NA, nrow=NROW(x), ncol=0) for (i in 1L:NCOL(x)) { for (j in 1L:length(p)) { res <- TrigonometricPolynomialsRad(x[,i], p[j], center) colnames(res) <- c(paste('cos(', ifelse(p[j]==1,'',round(p[j],3)), colnam[i], ifelse(center,'-mean',''), ')', sep=''), paste('sin(', ifelse(p[j]==1,'',round(p[j],3)), colnam[i], ifelse(center,'-mean',''), ')', sep='')) result <- cbind(result, res) } } return(result) } TP <- function(x, p = 1, center = FALSE) { tp <- trigonometric.polynomials(x = x, p = p, center = center) class(tp) <- unique(c("AsIs", oldClass(tp))) return(tp) } TrigonometricPolynomialsRad <- function(x, p, center) { center <- as.numeric(center) sinr <- sum(sin(x)) cosr <- sum(cos(x)) circmean <- atan2(sinr, cosr) sin.p <- sin(p * (x - circmean * center)) cos.p <- cos(p * (x - circmean * center)) result <- cbind(cos.p, sin.p) return(result) } circular/R/A1.R0000644000176200001440000000122011312211537012632 0ustar liggesusers############################################################### # # # R port: Claudio Agostinelli # # # # Date: January, 14, 2003 # # Version: 0.1-6 # # # ############################################################### A1 <- function(kappa) { result <- besselI(kappa, nu=1, expon.scaled = TRUE)/besselI(kappa, nu=0, expon.scaled = TRUE) return(result) } circular/R/rao.spacing.test.R0000644000176200001440000001141311312211537015560 0ustar liggesusers ############################################################# # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################# ############################################################# # # # rao.spacing.test function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: May, 31, 2006 # # Version: 0.3-1 # # # # Copyright (C) 2006 Claudio Agostinelli # # # ############################################################# rao.spacing.test <- function(x, alpha = 0) { # Handling missing values x <- na.omit(x) if ((n <- length(x))==0) { warning("No observations (at least after removing missing values)") return(NULL) } if (!any(c(0, 0.01, 0.025, 0.05, 0.1, 0.15)==alpha)) stop("'alpha' must be one of the following values: 0, 0.01, 0.025, 0.05, 0.1, 0.15") x <- conversion.circular(x, units="degrees", zero=0, rotation="counter", modulo="2pi") attr(x, "circularp") <- attr(x, "class") <- NULL statistic <- RaoSpacingTestDeg(x) result <- list() result$call <- match.call() result$statistic <- statistic result$alpha <- alpha result$n <- n class(result) <- "rao.spacing.test" return(result) } RaoSpacingTestDeg <- function(x) { x <- sort(x %% 360) n <- length(x) if (n < 4) { warning("Sample size too small") U <- NA } else { spacings <- c(diff(x), x[1] - x[n] + 360) U <- 1/2 * sum(abs(spacings - 360/n)) } return(U) } ############################################################# # # # print.rao.spacing.test function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: August, 15, 2007 # # Version: 0.2-2 # # # # Copyright (C) 2007 Claudio Agostinelli # # # ############################################################# print.rao.spacing.test <- function(x, digits=4, ...) { U <- x$statistic alpha <- x$alpha n <- x$n data(rao.table, package='circular', envir=sys.frame(which=sys.nframe())) if (n <= 30) table.row <- n - 3 else if (n <= 32) table.row <- 27 else if (n <= 37) table.row <- 28 else if (n <= 42) table.row <- 29 else if (n <= 47) table.row <- 30 else if (n <= 62) table.row <- 31 else if (n <= 87) table.row <- 32 else if (n <= 125) table.row <- 33 else if (n <= 175) table.row <- 34 else if (n <= 250) table.row <- 35 else if (n <= 350) table.row <- 36 else if (n <= 450) table.row <- 37 else if (n <= 550) table.row <- 38 else if (n <= 650) table.row <- 39 else if (n <= 750) table.row <- 40 else if (n <= 850) table.row <- 41 else if (n <= 950) table.row <- 42 else table.row <- 43 cat("\n") cat(" Rao's Spacing Test of Uniformity", "\n", "\n") cat("Test Statistic =", round(U, digits=digits), "\n") if (alpha == 0) { if (U > rao.table[table.row, 1]) cat("P-value < 0.001", "\n", "\n") else if (U > rao.table[table.row, 2]) cat("0.001 < P-value < 0.01", "\n", "\n") else if (U > rao.table[table.row, 3]) cat("0.01 < P-value < 0.05", "\n", "\n") else if (U > rao.table[table.row, 4]) cat("0.05 < P-value < 0.10", "\n", "\n") else cat("P-value > 0.10", "\n", "\n") x$accepted <- NA } else { table.col <- (1:4)[alpha == c(0.001, 0.01, 0.05, 0.1)] critical <- rao.table[table.row, table.col] cat("Level", alpha, "critical value =", critical, "\n") if (U > critical) { cat("Reject null hypothesis of uniformity \n\n") x$accepted <- FALSE } else { cat("Do not reject null hypothesis of uniformity \n\n") x$accepted <- TRUE } } invisible(x) } circular/R/jonespewsey.R0000644000176200001440000000323611460610426014761 0ustar liggesusers############################################################# # # # djonespewsey function # # Author: Federico Rotolo # # Email: federico.rotolo@stat.unipd.it # # Date: October, 05, 2010 # # Copyright (C) 2010 Federico Rotolo # # # # Version # ############################################################# djonespewsey <- function(x, mu=NULL, kappa=NULL, psi=NULL){ if (is.null(mu) || length(mu)!=1) stop("the mean direction parameter 'mu' is mandatory and it must have length 1") if (is.null(kappa) || length(kappa)!=1) stop("the concentration parameter 'kappa' is mandatory and it must have length 1") if (is.null(psi) || length(psi)!=1) stop("the parameter 'psi' is mandatory and it must have length 1") if(kappa<0){stop("kappa must be non negative")} x <- conversion.circular(x, units="radians", zero=0, rotation="counter") mu <- conversion.circular(mu, units="radians", zero=0, rotation="counter") mu <- as.vector(mu) kappa <- as.vector(kappa) psi <- as.vector(psi) attr(x, "class") <- attr(x, "circularp") <- NULL attr(mu, "class") <- attr(mu, "circularp") <- NULL DjonespewseyRad(x, mu, kappa, psi) } DjonespewseyRad <- function(x, mu, kappa, psi){ ker<- function(x){ (cosh(kappa*psi)+sinh(kappa*psi)*cos(x-mu))^(1/psi) / (2*pi*cosh(kappa*psi))} ncost<-integrate(ker,0,2*pi)$value dens<-ker(x)/ncost return(dens) } circular/R/cor.circular.R0000644000176200001440000001034111312211537014763 0ustar liggesusers ############################################################### # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################### ############################################################### # # # R port: Claudio Agostinelli # # # # Date: May, 26, 2006 # # Version: 0.3-1 # # # ############################################################### cor.circular <- function(x, y=NULL, test = FALSE) { if (!is.null(y) & NROW(x)!=NROW(y)) stop("x and y must have the same number of observations") if (is.null(y) & NCOL(x)<2) stop("supply both x and y or a matrix-like x") ncx <- NCOL(x) ncy <- NCOL(y) # Handling missing values if (is.null(y)) { ok <- complete.cases(x) x <- x[ok,] } else { ok <- complete.cases(x, y) if (ncx==1) { x <- x[ok] } else { x <- x[ok,] } if (ncy==1) { y <- y[ok] } else { y <- y[ok,] } } n <- NROW(x) if (n==0) { warning("No observations (at least after removing missing values)") return(NULL) } x <- conversion.circular(x, units="radians", zero=0, rotation="counter", modulo="2pi") attr(x, "class") <- attr(x, "circularp") <- NULL if (!is.null(y)) { y <- conversion.circular(y, units="radians", zero=0, rotation="counter", modulo="2pi") attr(y, "class") <- attr(y, "circularp") <- NULL } if (is.null(y)) { result <- matrix(1, ncol=ncx, nrow=ncx) if (test) { test.stat <- matrix(0, ncol=ncx, nrow=ncx) p.value <- matrix(0, ncol=ncx, nrow=ncx) } for (i in 1:ncx) { for (j in i:ncx) { res <- CorCircularRad(x=x[,i], y=x[,j], test=test) result[i,j] <- result[j,i] <- res[1] if (test) { if (i==j) { test.stat[i,i] <- NA p.value[i,i] <- NA } else { test.stat[i,j] <- test.stat[j,i] <- res[2] p.value[i,j] <- p.value[j,i] <- res[3] } } } } } else { attributes(x) <- c(attributes(x), list(dim=c(n, ncx))) attributes(y) <- c(attributes(y), list(dim=c(n, ncy))) result <- matrix(1, ncol=ncy, nrow=ncx) if (test) { test.stat <- matrix(0, ncol=ncy, nrow=ncx) p.value <- matrix(0, ncol=ncy, nrow=ncx) } for (i in 1:ncx) { for (j in 1:ncy) { res <- CorCircularRad(x=x[,i], y=y[,j], test=test) result[i,j] <- res[1] if (test) { test.stat[i,j] <- res[2] p.value[i,j] <- res[3] } } } } if (ncx==1 | (!is.null(y) & ncy==1)) { result <- c(result) if (test) { test.stat <- c(test.stat) p.value <- c(p.value) } } if (test) { result <- list(cor=result, statistic=test.stat, p.value=p.value) } return(result) } CorCircularRad <- function(x, y, test=FALSE) { n <- length(x) x.bar <- MeanCircularRad(x) y.bar <- MeanCircularRad(y) num <- sum(sin(x - x.bar) * sin(y - y.bar)) den <- sqrt(sum(sin(x - x.bar)^2) * sum(sin(y - y.bar)^2)) result <- num/den if (test) { l20 <- mean.default(sin(x - x.bar)^2) l02 <- mean.default(sin(y - y.bar)^2) l22 <- mean.default((sin(x - x.bar)^2) * (sin(y - y.bar)^2)) test.stat <- sqrt((n * l20 * l02)/l22) * result p.value <- 2 * (1 - pnorm(abs(test.stat))) result <- c(result, test.stat, p.value) } return(result) } circular/R/as.data.frame.circular.R0000644000176200001440000000425111312211537016607 0ustar liggesusers############################################################# # # # as.data.frame.circular function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: September, 22, 2003 # # Version: 0.1-2 # # # # Copyright (C) 2003 Claudio Agostinelli # # # ############################################################# as.data.frame.circular <- function(x, row.names=NULL, optional=FALSE, ...) { if (is.matrix(x)) { if (!is.null(xcircularp <- circularp(x))) { typep <- xcircularp$type unitsp <- xcircularp$units templatep <- xcircularp$template modulop <- xcircularp$modulo zerop <- xcircularp$zero rotationp <- xcircularp$rotation } else { typep <- "angles" unitsp <- "radians" templatep <- "none" modulop <- "asis" zerop <- 0 rotationp <- "counter" } d <- dim(x) nrows <- d[1]; ir <- seq(length = nrows) ncols <- d[2]; ic <- seq(length = ncols) dn <- dimnames(x) row.names <- dn[[1]] collabs <- dn[[2]] if (any(empty <- nchar(collabs)==0)) collabs[empty] <- paste("Circular", ic, sep = "")[empty] value <- vector("list", ncols) for(i in ic) value[[i]] <- as.circular(x[,i], type=typep, units=unitsp, modulo=modulop, zero=zerop, rotation=rotationp) if (length(row.names) != nrows) row.names <- if(optional) character(nrows) else as.character(ir) if (length(collabs) == ncols) names(value) <- collabs else if(!optional) names(value) <- paste("Circular", ic, sep="") attr(value, "row.names") <- row.names class(value) <- "data.frame" return(value) } else return(as.data.frame.vector(x, row.names, optional)) } circular/R/lines.circular.R0000644000176200001440000000463411354047172015332 0ustar liggesusers############################################################# # # # lines.circular function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: March, 29, 2010 # # Version: 0.2-1 # # # # Copyright (C) 2010 Claudio Agostinelli # # # ############################################################# lines.circular <- function(x, y, join=FALSE, nosort=FALSE, offset=1, shrink=1, plot.info=NULL, zero=NULL, rotation=NULL, modulo=NULL, ...) { xcircularp <- attr(as.circular(x), "circularp") # type <- xcircularp$type if (is.null(modulo)) modulo <- xcircularp$modulo if (is.null(plot.info)) { if (is.null(zero)) zero <- xcircularp$zero if (is.null(rotation)) rotation <- xcircularp$rotation next.points <- 0 } else { zero <- plot.info$zero rotation <- plot.info$rotation next.points <- plot.info$next.points } # Handling missing values ok <- complete.cases(x, y) x <- x[ok] y <- y[ok] if (length(x)) { x <- conversion.circular(x, units="radians", modulo=modulo) attr(x, "circularp") <- attr(x, "class") <- NULL attr(y, "circularp") <- attr(y, "class") <- NULL if (rotation=="clock") x <- -x x <- x+zero ### x <- x%%(2*pi) ll <- LinesCircularRad(x, y, join, nosort, offset, shrink, ...) } return(invisible(list(x=ll$x, y=ll$y, zero=zero, rotation=rotation, next.points=next.points))) } LinesCircularRad <- function(x, y, join=FALSE, nosort=FALSE, offset=1, shrink=1, ...) { n <- length(x) if (!nosort) { xorder <- order(x) x <- x[xorder] y <- y[xorder] spacings <- c(diff(x), x[1] - x[n] + 2*pi) pos <- which.max(spacings)[1] if (pos==n) xorder <- 1:n else xorder <- c((pos+1):n, 1:pos) } else { xorder <- 1:n } z <- (y/shrink+offset)*cos(x) w <- (y/shrink+offset)*sin(x) z <- z[xorder] w <- w[xorder] if (join) { z <- c(z, z[1]) w <- c(w, w[1]) } lines.default(x=z, y=w, ...) invisible(list(x=z, y=w)) } circular/R/subset.circular.R0000644000176200001440000000246311312211537015513 0ustar liggesusers ############################################################# # # # subset.circular function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: March, 7, 2003 # # Version: 0.1 # # # # Copyright (C) 2003 Claudio Agostinelli # # # ############################################################# ### do not work fine yet subset.circular <- function(x, subset, select, ...) { xcircularp <- attr(x, "circularp") x <- unclass(x) ismatrix <- is.matrix(x) x <- as.data.frame(x) if(missing(subset)) r <- TRUE else { e <- substitute(subset) r <- eval(e, x, parent.frame()) r <- r & !is.na(r) } if(missing(select)) vars <- TRUE else { nl <- as.list(1:ncol(x)) names(nl) <- names(x) vars <- eval(substitute(select),nl, parent.frame()) } x <- x[r,vars,drop=FALSE] if (ismatrix) x <- as.matrix(x) attr(x, "circularp") <- xcircularp attr(x, "class") <- "circular" return(x) } circular/R/summary.circular.R0000644000176200001440000000330512234225021015674 0ustar liggesusers ############################################################### # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################### ############################################################# # # # summary.circular # # Authors: Claudio Agostinelli, David Andel, # # Alessandro Gagliardi # # Email: claudio@unive.it, andel@ifi.unizh.ch # # Date: February, 3, 2013 # # Copyright (C) 2003 Claudio Agostinelli, David Andel # # Copyright (C) 2013 Claudio Agostinelli # # # # Version 0.4 # ############################################################# summary.circular <- function(object, digits = max(3, getOption("digits") - 3), ...) { if (is.matrix(object)) { return(summary.matrix(object, ...)) } if (is.data.frame(object)) { return(summary.data.frame(object, ...)) } else { nas <- is.na(object) object <- object[!nas] n <- length(object) qq <- minusPiPlusPi(quantile.circular(object)) qq <- signif(c(n, qq[1L:3L], mean.circular(object), qq[4L:5L], rho.circular(object)), digits) names(qq) <- c("n", "Min.", "1st Qu.", "Median", "Mean", "3rd Qu.", "Max.", "Rho") if(any(nas)) c(qq, "NA's" = sum(nas)) else qq } } circular/R/wrappedstable.R0000644000176200001440000000167311312211537015242 0ustar liggesusers############################################################# # # # rwrappedstable function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: August, 15, 2007 # # Copyright (C) 2007 Claudio Agostinelli # # # # Version 0.2-3 # ############################################################# rwrappedstable <- function(n, scale=1, index, skewness, control.circular=list()) { dc <- control.circular result <- rstable(n=n, scale=scale, index=index, skewness=skewness) %% (2 * pi) result <- conversion.circular(circular(result), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) return(result) } circular/R/plot.edf.R0000644000176200001440000000500713124753140014117 0ustar liggesusers ############################################################# # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################# ############################################################# # # # plot.edf function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: May, 27, 2006 # # Version: 0.2-1 # # # # Copyright (C) 2006 Claudio Agostinelli # # # ############################################################# plot.edf <- function(x, type = "s", xlim = c(0, 2 * pi), ylim = c(0, 1), ...) { # Handling missing values x <- na.omit(x) if (length(x)==0) { warning("No observations (at least after removing missing values)") return(NULL) } x <- conversion.circular(x, units="radians", modulo="2pi") attr(x, "circularp") <- attr(x, "class") <- NULL # x <- x %% (2 * pi) x <- sort(x) n <- length(x) plot.default(c(0, x, 2 * pi), c(0, seq(1:n)/n, 1), type=type, xlim=xlim, ylim=ylim, ...) } ############################################################# # # # lines.edf function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: May, 27, 2006 # # Version: 0.1-2 # # # # Copyright (C) 2006 Claudio Agostinelli # # # ############################################################# lines.edf <- function(x, type = "s", ...) { x <- conversion.circular(x, units="radians", modulo="2pi") attr(x, "circularp") <- attr(x, "class") <- NULL # x <- x %% (2 * pi) x <- sort(x) n <- length(x) lines.default(c(0, x, 2 * pi), c(0, seq(1:n)/n, 1), type=type, ...) } circular/R/wrappedcauchy.R0000644000176200001440000000664111312211537015244 0ustar liggesusers ############################################################# # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################# ############################################################# # # # rwrappedcauchy function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: August, 10, 2006 # # Copyright (C) 2006 Claudio Agostinelli # # # # Version 0.2-3 # ############################################################# rwrappedcauchy <- function(n, mu = circular(0), rho = exp(-1), control.circular=list()) { if (is.circular(mu)) { datacircularp <- circularp(mu) } else { datacircularp <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") } dc <- control.circular if (is.null(dc$type)) dc$type <- datacircularp$type if (is.null(dc$units)) dc$units <- datacircularp$units if (is.null(dc$template)) dc$template <- datacircularp$template if (is.null(dc$modulo)) dc$modulo <- datacircularp$modulo if (is.null(dc$zero)) dc$zero <- datacircularp$zero if (is.null(dc$rotation)) dc$rotation <- datacircularp$rotation mu <- conversion.circular(mu, units="radians", zero=0, rotation="counter") attr(mu, "class") <- attr(mu, "circularp") <- NULL result <- RwrappedcauchyRad(n, mu, rho) result <- conversion.circular(circular(result), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) return(result) } RwrappedcauchyRad <- function(n, mu, rho) { if (rho == 0) result <- runif(n, 0, 2 * pi) else if (rho == 1) result <- rep(mu, n) else { scale <- - log(rho) result <- rcauchy(n, mu, scale) %% (2 * pi) } return(result) } ############################################################# # # # dwrappedcauchy function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: May, 22, 2006 # # Copyright (C) 2006 Claudio Agostinelli # # # # Version 0.2 # ############################################################# dwrappedcauchy <- function(x, mu=circular(0), rho=exp(-1)) { if (rho < 0 | rho > 1) stop("rho must be between 0 and 1") x <- conversion.circular(x, units="radians", zero=0, rotation="counter") mu <- conversion.circular(mu, units="radians", zero=0, rotation="counter") attr(x, "class") <- attr(x, "circularp") <- NULL attr(mu, "class") <- attr(mu, "circularp") <- NULL DwrappedcauchyRad(x, mu, rho) } DwrappedcauchyRad <- function(x, mu, rho) { d <- (1 - rho^2)/((2 * pi) * (1 + rho^2 - 2 * rho * cos(x - mu))) return(d) } circular/R/unique.circular.R0000644000176200001440000000021111312211537015501 0ustar liggesusersunique.circular <- function (x, ...) { z <- unique.default(x, ...) circularp(z) <- circularp(x) class(z) <- class(x) return(z) } circular/R/coord2rad.R0000644000176200001440000000206511402427365014270 0ustar liggesuserscoord2rad <- function(x, y=NULL, control.circular=list()) { if (NCOL(x)==2) { x <- atan2(x[,2],x[,1]) } else if (!is.null(y)) { x <- as.vector(x) y <- as.vector(y) if (length(x)!=length(y)) stop('x and y must have the same length') x <- atan2(y,x) } else { stop('if y is NULL then x must be a matrix or a dataframe with 2 columns otherwise x and y must be vectors') } datacircularp <- list(type="angles", units="radians", template="none", modulo="2pi", zero=0, rotation="counter") dc <- control.circular if (is.null(dc$type)) dc$type <- datacircularp$type if (is.null(dc$units)) dc$units <- datacircularp$units if (is.null(dc$template)) dc$template <- datacircularp$template if (is.null(dc$modulo)) dc$modulo <- datacircularp$modulo if (is.null(dc$zero)) dc$zero <- datacircularp$zero if (is.null(dc$rotation)) dc$rotation <- datacircularp$rotation x <- conversion.circular(circular(x), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) return(x) } circular/R/deg.R0000644000176200001440000000165311312211537013142 0ustar liggesusers ############################################################### # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################### ############################################################### # # # R port: Claudio Agostinelli # # # # Date: January, 14, 2003 # # Version: 0.1-6 # # # ############################################################### deg <- function(x) { (x * 180)/pi } circular/R/lsfit.circle.R0000644000176200001440000001224611312211537014764 0ustar liggesusers ############################################################# # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################# ############################################################# # # # lsfit.circle function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: May, 27, 2006 # # Version: 0.3 # # # # Copyright (C) 2006 Claudio Agostinelli # # # ############################################################# lsfit.circle <- function(x, y=NULL, init=NULL, units=c("radians", "degrees"), template=c("none", "geographics"), modulo=c("asis", "2pi", "pi"), zero=0, rotation=c("counter", "clock"), ...) { type <- "angles" units <- match.arg(units) template <- match.arg(template) modulo <- match.arg(modulo) rotation <- match.arg(rotation) if (is.null(y)) { if (NCOL(x)==2) { y <- x[,2] x <- x[,1] } else { stop("Must be either 'x' a matrix with two columns or 'x' and 'y' a vector") } } x <- as.vector(x) y <- as.vector(y) if (length(x)!=length(y)) { stop("'x' and 'y' must have the same length") } # Handling missing values ok <- complete.cases(x, y) x <- x[ok] y <- y[ok] if (length(y)==0) { warning("No observations (at least after removing missing values)") return(NULL) } result <- LsfitCircleRad(x, y, init, ...) result$angles <- conversion.circular(circular(result$angles), units, type, template, modulo, zero, rotation) result$call <- match.call() class(result) <- "lsfit.circle" return(result) } LsfitCircleRad <- function(x, y, init, ...) { if (is.null(init)) { x.mean <- mean.default(x) y.mean <- mean.default(y) est.r <- max(c(abs(x-x.mean), abs(y-y.mean))) init <- c(est.r, x.mean, y.mean) } obj.fun <- function(p, x, y){ sum((p[1]-sqrt((x-p[2])^2 + (y-p[3])^2))^2) } grad.fun <- function(p, x, y){ n <- length(x); r <- p[1]; a <- p[2]; b <- p[3] common <- sqrt((x-a)^2 + (y-b)^2) g.e1 <- 2*n*r - 2 * sum(common) g.e2 <- 2*n*a - 2*sum(x) + 2 * r * sum((x-a)/common) g.e3 <- 2*n*b - 2*sum(y) + 2 * r * sum((y-b)/common) # NO HESSIAN is used by optim # h.e11 <- 2*n # h.e21 <- 2*sum((x-a)/common) # h.e22 <- 2*n - 2*r*sum((y-b)^2/common^3) # h.e31 <- 2*sum((y-b)/common) # h.e32 <- 2*r*sum((x-a)*(y-b)/common^3) # h.e33 <- 2*n - 2*r*sum((x-a)^2/common^3) # pppp <- list(gradient=c(g.e1, g.e2, g.e3), hessian=c(h.e11, h.e21, h.e22, h.e31, h.e32, h.e33)) return(c(g.e1, g.e2, g.e3)) } # nlminb(start = init, obj = obj.fun, gradient = grad.fun, hessian=TRUE, x = x, y = y, ...) res <- optim(par=init, fn=obj.fun, gr=grad.fun, hessian=TRUE, x = x, y = y, method ="BFGS", ...) result <- list() result$coefficients <- res$par names(result$coefficients) <- c("r", "a", "b") result$x <- x result$y <- y result$x.centered <- x - res$par[2] result$y.centered <- y - res$par[3] result$angles <- atan2(y=result$y.centered, x=result$x.centered) result$radius <- sqrt(result$x.centered^2+result$y.centered^2) result$convergence <- res$convergence result$optim <- res return(result) } ############################################################# # # # print.lsfit.circle function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: April, 27, 2005 # # Version: 0.1-1 # # # # Copyright (C) 2005 Claudio Agostinelli # # # ############################################################# print.lsfit.circle <- function(x, digits = max(3, getOption("digits") - 3), ...) { cat("\nCall:\n",deparse(x$call),"\n\n",sep="") coef <- matrix(x$coefficients, nrow=1) dimnames(coef) <- list(" Coeff: ", c("r", "a", "b")) print.default(format(coef, digits=digits), print.gap = 2, quote = FALSE) cat("\n Summary in Rectangular Coordinates \n") print(summary(data.frame(x=x$x, y=x$y))) cat("\n Summary in Polar Coordinates of Recentered Observations \n") print(summary(data.frame(angles=x$angles, radius=x$radius))) if (x$convergence) { cat("Warnings: convergence problems in 'optim': ", x$convergence, "\n\n") } invisible(x) } circular/R/medianHL.circular.R0000644000176200001440000000461614475657010015706 0ustar liggesusers############################################################# # # median.circular function # Author: Claudio Agostinelli and Alessandro Gagliardi # E-mail: claudio@unive.it # Date: May, 12, 2015 # Version: 0.4-1 # # Copyright (C) 2015 Claudio Agostinelli and Alessandro Gagliardi # ############################################################# medianHL.circular <- function(x, na.rm=FALSE, method=c("HL1","HL2","HL3"), prop=NULL,...) { method <- match.arg(method) if (!is.null(prop)) if (prop <= 0 | prop >=1) stop("'prop' is outside (0,1)") if (na.rm) x <- x[!is.na(x)] if (length(x)==0) { warning("No observations (at least after removing missing values)") return(circular(NA)) } if (is.circular(x)) { dc <- circularp(x) } else { dc <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") } x <- conversion.circular(x, units="radians", zero=0, rotation="counter") attr(x, "class") <- attr(x, "circularp") <- NULL circmedian <- MedianHLCircularRad(x, method, prop) circmedian <- conversion.circular(circular(drop(circmedian)), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) attr(circmedian, "medians") <- conversion.circular(circular(drop(MinusPiPlusPiRad(attr(circmedian, "medians")))), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) attr(attr(circmedian, "medians"), "class") <- attr(attr(circmedian, "medians"), "circularp") <- NULL return(circmedian) } MedianHLCircularRad <- function(x, method, prop) { x <- x%%(2*pi) x <- MinusPiPlusPiRad(x) n <- length(x) mediancirc <- NA methods <- c("HL2","HL1","HL3") if (is.null(prop)) { mediancirc <- .C("MedianHLCircularRad",x=as.double(x),y=as.double(x),n=as.integer(n),whichMethod=as.integer(which(methods==method) - 1),result=as.double(0))$result } else { mediancirc <- .C("MedianHLCircularPropRad",x=as.double(x),n=as.integer(n),whichMethod=as.integer(which(methods==method) - 1),prop=as.double(prop),result=as.double(0))$result } return(mediancirc) } circular/R/rad.R0000644000176200001440000000165311312211537013151 0ustar liggesusers ############################################################### # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################### ############################################################### # # # R port: Claudio Agostinelli # # # # Date: January, 14, 2003 # # Version: 0.1-6 # # # ############################################################### rad <- function(x) { (x * pi)/180 } circular/R/minuspipluspi.R0000644000176200001440000000336212244631265015334 0ustar liggesusers############################################################# # # MinusPiPlusPiRad function # Author: Claudio Agostinelli # E-mail: claudio@unive.it # Date: November, 25, 2013 # Version: 0.2 # # Copyright (C) 2013 Claudio Agostinelli # ############################################################# minusPiPlusPi <- function(x) { if (is.circular(x)) { datacircularp <- circularp(x) } else { datacircularp <- list(type = "angles", units = "radians", template = "none", modulo = "asis", zero = 0, rotation = "counter") } dc <- list() if (is.null(dc$type)) dc$type <- datacircularp$type if (is.null(dc$units)) dc$units <- datacircularp$units if (is.null(dc$template)) dc$template <- datacircularp$template if (is.null(dc$modulo)) dc$modulo <- datacircularp$modulo if (is.null(dc$zero)) dc$zero <- datacircularp$zero if (is.null(dc$rotation)) dc$rotation <- datacircularp$rotation x <- conversion.circular(x, units = "radians", zero = 0, rotation = "counter", modulo = "2pi") attr(x, "class") <- attr(x, "circularp") <- NULL x[!is.na(x)] <- MinusPiPlusPiRad(x[!is.na(x)]) x <- conversion.circular(circular(x), dc$units, dc$type, dc$template, "asis", dc$zero, dc$rotation) return(x) } MinusPiPlusPiRad <- function(x) { x <- .C("MinusPiPlusPiRad",x=as.double(x),n=as.integer(length(x)))$x return(x) } circular/R/carthwrite.R0000644000176200001440000000267611460610426014571 0ustar liggesusers############################################################# # # # dcarthwrite function # # Author: Federico Rotolo # # Email: federico.rotolo@stat.unipd.it # # Date: October, 05, 2010 # # Copyright (C) 2010 Federico Rotolo # # # # Version # ############################################################# dcarthwrite <- function (x, mu=NULL, psi=NULL) { if (is.null(mu) || length(mu)!=1) stop("the mean direction parameter 'mu' is mandatory and it must have length 1") if (is.null(psi) || length(psi)!=1) stop("the parameter 'psi' is mandatory and it must have length 1") if(psi<0) stop("the parameter 'psi' must be non negative") x <- conversion.circular(x, units="radians", zero=0, rotation="counter") mu <- conversion.circular(mu, units="radians", zero=0, rotation="counter") mu <- as.vector(mu) psi <- as.vector(psi) attr(x, "class") <- attr(x, "circularp") <- NULL attr(mu, "class") <- attr(mu, "circularp") <- NULL DcarthwrightRad(x, mu, psi) } DcarthwrightRad <- function(x, mu, psi) { cpc<-2^(1/psi-1) * (gamma(1+1/psi))^2 * (1+cos(x-mu))^(1/psi) cpc<-cpc/(pi*gamma(1+2/psi)) return(cpc) } circular/R/watson.test.R0000644000176200001440000001436312705217737014715 0ustar liggesusers ############################################################# # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################# ############################################################# # # # watson.test function # # Author: Claudio Agostinelli # # E-mail: claudio.agostinelli@unive.it # # Date: April, 18, 2016 # # Version: 0.3-2 # # # # Copyright (C) 2016 Claudio Agostinelli # # # ############################################################# watson.test <- function(x, alpha = 0, dist = c("uniform", "vonmises")) { # Handling missing values x <- na.omit(x) if (length(x)==0) { warning("No observations (at least after removing missing values)") return(NULL) } dist <- match.arg(dist) x <- conversion.circular(x, units="radians", zero=0, rotation="counter", modulo="2pi") attr(x, "circularp") <- attr(x, "class") <- NULL if (!any(c(0, 0.01, 0.025, 0.05, 0.1)==alpha)) stop("'alpha' must be one of the following values: 0, 0.01, 0.025, 0.05, 0.10") result <- WatsonTestRad(x, dist) result$call <- match.call() result$n <- length(x) result$alpha <- alpha result$dist <- dist class(result) <-"watson.test" return(result) } WatsonTestRad <- function(x, dist) { n <- length(x) if (dist == "uniform") { u <- sort(x)/(2 * pi) u.bar <- mean.default(u) i <- 1:n sum.terms <- (u - u.bar - (2 * i - 1)/(2 * n) + 0.5)^2 u2 <- sum(sum.terms) + 1/(12 * n) u2 <- (u2 - 0.1/n + 0.1/(n^2)) * (1 + 0.8/n) result <- list(statistic=u2, row=NA) } else { res <- MlevonmisesRad(x, bias=FALSE) mu.hat <- res[1] kappa.hat <- res[4] x <- (x - mu.hat) %% (2 * pi) x <- matrix(x, ncol = 1) z <- apply(x, 1, PvonmisesRad, mu=0, kappa=kappa.hat, tol=1e-020) z <- sort(z) z.bar <- mean.default(z) i <- 1:n sum.terms <- (z - (2 * i - 1)/(2 * n))^2 Value <- sum(sum.terms) - n * (z.bar - 0.5)^2 + 1/(12 * n) if (kappa.hat < 0.25) row <- 1 else if (kappa.hat < 0.75) row <- 2 else if (kappa.hat < 1.25) row <- 3 else if (kappa.hat < 1.75) row <- 4 else if (kappa.hat < 3) row <- 5 else if (kappa.hat < 5) row <- 6 else row <- 7 result <- list(statistic=Value, row=row) } return(result) } ############################################################# # # # print.watson.test function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: November, 19, 2003 # # Version: 0.1-1 # # # # Copyright (C) 2003 Claudio Agostinelli # # # ############################################################# print.watson.test <- function(x, digits=4, ...) { dist <- x$dist n <- x$n alpha <- x$alpha if (dist == "uniform") { u2 <- x$statistic cat("\n", " Watson's Test for Circular Uniformity", "\n", "\n") crits <- c(99, 0.267, 0.221, 0.187, 0.152) if (n < 8) { warning("Total Sample Size < 8: Results may not be valid", "\n", "\n") } cat("Test Statistic:", round(u2, digits=digits), "\n") if (alpha == 0) { if (u2 > 0.267) cat("P-value < 0.01", "\n", "\n") else if (u2 > 0.221) cat("0.01 < P-value < 0.025", "\n", "\n") else if (u2 > 0.187) cat("0.025 < P-value < 0.05", "\n", "\n") else if (u2 > 0.152) cat("0.05 < P-value < 0.10", "\n", "\n") else cat("P-value > 0.10", "\n", "\n") } else { index <- (1:5)[alpha == c(0, 0.01, 0.025, 0.05, 0.1)] Critical <- crits[index] if (u2 > Critical) Reject <- "Reject Null Hypothesis" else Reject <- "Do Not Reject Null Hypothesis" cat("Level", alpha, "Critical Value:", round(Critical, digits=digits), "\n") cat(Reject, "\n\n") } } else if (dist=="vonmises") { Value <- x$statistic row <- x$row cat("\n", " Watson's Test for the von Mises Distribution \n\n") u2.crits <- cbind(c(0, 0.5, 1, 1.5, 2, 4, 100), c(0.052, 0.056, 0.066, 0.077, 0.084, 0.093, 0.096), c(0.061, 0.066, 0.079, 0.092, 0.101, 0.113, 0.117), c(0.081, 0.09, 0.11, 0.128, 0.142, 0.158, 0.164)) if (alpha != 0) { if (alpha == 0.1) col <- 2 else if (alpha == 0.05) col <- 3 else if (alpha == 0.01) col <- 4 Critical <- u2.crits[row, col] if (Value > Critical) Reject <- "Reject Null Hypothesis" else Reject <- "Do Not Reject Null Hypothesis" cat("Test Statistic:", round(Value, digits=digits), "\n") cat("Level", alpha, "Critical Value:", round(Critical, digits=digits), "\n") cat(Reject, "\n\n") } else { cat("Test Statistic:", round(Value, digits=digits), "\n") if (Value < u2.crits[row, 2]) cat("P-value > 0.10", "\n", "\n") else if ((Value >= u2.crits[row, 2]) && (Value < u2.crits[row, 3])) cat("0.05 < P-value < 0.10", "\n", "\n") else if ((Value >= u2.crits[row, 3]) && (Value < u2.crits[row, 4])) cat("0.01 < P-value < 0.05", "\n", "\n") else cat("P-value < 0.01", "\n", "\n") } } invisible(x) } circular/R/triangular.R0000644000176200001440000000601711312211537014552 0ustar liggesusers ############################################################# # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################# ############################################################# # # # rtriangular function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: May, 29, 2006 # # Copyright (C) 2006 Claudio Agostinelli # # # # Version 0.2-2 # ############################################################# rtriangular <- function(n, rho, control.circular=list()) { dc <- control.circular theta <- RtriangularRad(n, rho) theta <- conversion.circular(circular(theta), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) return(theta) } RtriangularRad <- function(n, rho) { if (rho < 0 | rho > 4/pi^2) stop("'rho' must be between 0 and 4/pi^2") u <- matrix(c(runif(n)), ncol = 1) get.theta <- function(u, rho) { if (u < 0.5) { a <- pi * rho b <- - (4 + pi^2 * rho) c <- 8 * pi * u theta1 <- ( - b + sqrt(b^2 - 4 * a * c))/(2 * a) theta2 <- ( - b - sqrt(b^2 - 4 * a * c))/(2 * a) min(theta1, theta2) } else { a <- pi * rho b <- 4 - 3 * pi^2 * rho c <- (2 * pi^3 * rho) - (8 * pi * u) theta1 <- ( - b + sqrt(b^2 - 4 * a * c))/(2 * a) theta2 <- ( - b - sqrt(b^2 - 4 * a * c))/(2 * a) max(theta1, theta2) } } theta <- apply(u, 1, get.theta, rho) theta[theta > pi] <- theta[theta > pi] - 2 * pi return(theta) } ############################################################# # # # dtriangular function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: May, 24, 2006 # # Copyright (C) 2006 Claudio Agostinelli # # # # Version 0.2 # ############################################################# dtriangular <- function(x, rho) { if (rho < 0 | rho > 4/pi^2) stop("'rho' must be between 0 and 4/pi^2") x <- conversion.circular(x, units="radians", zero=0, rotation="counter") attr(x, "class") <- attr(x, "circularp") <- NULL DtriangularRad(x, rho) } DtriangularRad <- function(x, rho) { d <- (4 - pi^2 * rho + 2 * pi * rho * abs(pi - x))/(8 * pi) return(d) } circular/R/lm.circular.cc.R0000644000176200001440000001076011312211537015201 0ustar liggesusers ############################################################# # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################# ############################################################# # # # lm.circular.cc function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: August, 10, 2006 # # Version: 0.2-3 # # # # Copyright (C) 2006 Claudio Agostinelli # # # ############################################################# lm.circular.cc <- function(y, x, order = 1, level = 0.05, control.circular=list()) { # Handling missing values ok <- complete.cases(x, y) x <- x[ok] y <- y[ok] if (length(x)==0) { warning("No observations (at least after removing missing values)") return(NULL) } if (is.circular(y)) { datacircularp <- circularp(y) } else if (is.circular(x)) { datacircularp <- circularp(x) } else { datacircularp <- list(type="angles", units="radians", template="none", modulo="2pi", zero=0, rotation="counter") } dc <- control.circular if (is.null(dc$type)) dc$type <- datacircularp$type if (is.null(dc$units)) dc$units <- datacircularp$units if (is.null(dc$template)) dc$template <- datacircularp$template if (is.null(dc$modulo)) dc$modulo <- datacircularp$modulo if (is.null(dc$zero)) dc$zero <- datacircularp$zero if (is.null(dc$rotation)) dc$rotation <- datacircularp$rotation x <- conversion.circular(x, units="radians", zero=0, rotation="counter", modulo="2pi") attr(x, "circularp") <- attr(x, "class") <- NULL y <- conversion.circular(y, units="radians", zero=0, rotation="counter", modulo="2pi") attr(y, "circularp") <- attr(y, "class") <- NULL circ.lm <- LmCircularccRad(y, x, order) circ.lm$call <- match.call() circ.lm$fitted <- conversion.circular(circular(circ.lm$fitted), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) circ.lm$residuals <- conversion.circular(circular(circ.lm$residuals), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) if (circ.lm$p.values[1] > level & circ.lm$p.values[2] > level) circ.lm$message <- paste("Higher order terms are not significant at the ", level, " level", sep = "") else circ.lm$message <- paste("Higher order terms are significant at the ", level, " level", sep = "") class(circ.lm) <- "lm.circular.cc" return(circ.lm) } LmCircularccRad <- function(y, x, order) { n <- length(x) cy <- cos(y) sy <- sin(y) order.matrix <- t(matrix(rep(c(1:order), n), ncol = n)) cos.x <- cos(x * order.matrix) sin.x <- sin(x * order.matrix) cos.lm <- lm(cy ~ cos.x + sin.x) sin.lm <- lm(sy ~ cos.x + sin.x) cos.fit <- cos.lm$fitted sin.fit <- sin.lm$fitted g1.sq <- t(cos.fit) %*% cos.fit g2.sq <- t(sin.fit) %*% sin.fit rho <- sqrt((g1.sq + g2.sq)/n) y.fitted <- atan2(sin.fit, cos.fit) Y1 <- cy Y2 <- sy ones <- matrix(1, n, 1) X <- cbind(ones, cos.x, sin.x) W <- cbind(cos((order + 1) * x), sin((order + 1) * x)) M <- X %*% solve(t(X) %*% X) %*% t(X) I <- diag(n) H <- t(W) %*% (I - M) %*% W N <- W %*% solve(H) %*% t(W) cc <- n - (2 * order + 1) N1 <- t(Y1) %*% (I - M) %*% N %*% (I - M) %*% Y1 D1 <- t(Y1) %*% (I - M) %*% Y1 T1 <- cc * (N1/D1) N2 <- t(Y2) %*% (I - M) %*% N %*% (I - M) %*% Y2 D2 <- t(Y2) %*% (I - M) %*% Y2 T2 <- cc * (N2/D2) p1 <- 1 - pchisq(T1, 2) p2 <- 1 - pchisq(T2, 2) pvalues <- cbind(p1, p2) circ.lm <- list() circ.lm$rho <- rho circ.lm$fitted <- y.fitted %% (2 * pi) circ.lm$x <- cbind(x, y) circ.lm$residuals <- (y - y.fitted) %% (2 * pi) circ.lm$coefficients <- cbind(cos.lm$coefficients, sin.lm$coefficients) circ.lm$p.values <- pvalues circ.lm$A.k <- mean(cos(circ.lm$residuals)) circ.lm$kappa <- A1inv(circ.lm$A.k) return(circ.lm) } circular/R/weighted.mean.circular.R0000644000176200001440000000425612524351467016744 0ustar liggesusers############################################################# # weighted.mean.circular function # Author: Claudio Agostinelli # E-mail: claudio@unive.it # Date: May, 12, 2015 # Version: 0.1 # Copyright (C) 2015 Claudio Agostinelli ############################################################# weighted.mean.circular <- function(x, w, na.rm=FALSE, control.circular=list(), ...) { if (missing(w)) mean.circular(x=x, na.rm=na.rm, control.circular=control.circular, ...) if (any(is.na(w))) { warning("Missing values are not allowed in the weights vector") return(circular(NA)) } if (length(w) != length(x)) stop("'x' and 'w' must have the same length") w <- as.double(w) if (na.rm) { nax <- !is.na(x) x <- x[nax] w <- w[nax] } neq0 <- w !=0 x <- x[neq0] w <- w[neq0] if (length(x)==0) { warning("No observations (at least after removing missing values)") return(circular(NA)) } if (is.circular(x)) { datacircularp <- circularp(x) } else { datacircularp <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") } dc <- control.circular if (is.null(dc$type)) dc$type <- datacircularp$type if (is.null(dc$units)) dc$units <- datacircularp$units if (is.null(dc$template)) dc$template <- datacircularp$template if (is.null(dc$modulo)) dc$modulo <- datacircularp$modulo if (is.null(dc$zero)) dc$zero <- datacircularp$zero if (is.null(dc$rotation)) dc$rotation <- datacircularp$rotation x <- conversion.circular(x, units="radians") attr(x, "class") <- attr(x, "circularp") <- NULL circmean <- WeightedMeanCircularRad(x, w) circmean <- conversion.circular(circular(circmean, template=datacircularp$template, zero=datacircularp$zero, rotation=datacircularp$rotation), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) return(circmean) } WeightedMeanCircularRad <- function(x, w) { if (any(is.na(x))) { circmean <- NA } else { circmean <- .C("WeightedMeanCircularRad", x=as.double(x), w=as.double(w), n=as.integer(length(x)), result=as.double(0), PACKAGE="circular")$result } return(circmean) } circular/R/rao.test.R0000644000176200001440000001315111312211537014136 0ustar liggesusers ############################################################# # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################# ############################################################# # # # rao.test function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: May, 31, 2006 # # Version: 0.3-1 # # # # Copyright (C) 2006 Claudio Agostinelli # # # ############################################################# rao.test <- function(..., alpha = 0) { y <- list(...) x <- list() for (i in 1:length(y)) { if (is.data.frame(y[[i]])) { x <- c(x, as.list(y[[i]])) } else if (is.matrix(y[[i]])) { for (j in 1:ncol(y[[i]])) { x <- c(x, list(y[[i]][,j])) } } else if (is.list(y[[i]])) { x <- c(x, y[[i]]) } else { x <- c(x, list(y[[i]])) } } if (length(x)<2) stop("There must be at least two samples") for (i in 1:length(x)) { x[[i]] <- conversion.circular(x[[i]], units="radians", zero=0, rotation="counter", modulo="2pi") attr(x[[i]], "circularp") <- attr(x[[i]], "class") <- NULL } if (!any(c(0, 0.01, 0.025, 0.05, 0.1, 0.15)==alpha)) stop("'alpha' must be one of the following values: 0, 0.01, 0.025, 0.05, 0.1, 0.15") # Handling missing values x <- lapply(x, na.omit) result <- RaoTestRad(x) result$call <- match.call() result$alpha <- alpha class(result) <- "rao.test" return(result) } RaoTestRad <- function(x) { n <- unlist(lapply(x, length)) k <- length(x) c.data <- lapply(x, cos) s.data <- lapply(x, sin) x <- unlist(lapply(c.data, mean.default)) y <- unlist(lapply(s.data, mean.default)) s.co <- unlist(lapply(c.data, var.default)) s.ss <- unlist(lapply(s.data, var.default)) s.cs <- c(1:k) for(i in 1:k) { s.cs[i] <- var.default(c.data[[i]], s.data[[i]]) } s.polar <- 1/n * (s.ss/x^2 + (y^2 * s.co)/x^4 - (2 * y * s.cs)/x^3) tan <- y/x H.polar <- sum(tan^2/s.polar) - (sum(tan/s.polar))^2/sum(1/s.polar) U <- x^2 + y^2 s.disp <- 4/n * (x^2 * s.co + y^2 * s.ss + 2 * x * y * s.cs) H.disp <- sum(U^2/s.disp) - (sum(U/s.disp))^2/sum(1/s.disp) result <- list() result$statistic <- c(H.polar, H.disp) result$df <- k-1 result$p.value <- c((1 - pchisq(H.polar, k - 1)), (1 - pchisq(H.disp, k - 1))) return(result) } ############################################################# # # # print.rao.test function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: November, 19, 2003 # # Version: 0.1-1 # # # # Copyright (C) 2003 Claudio Agostinelli # # # ############################################################# print.rao.test <- function(x, digits=4, ...) { statistic <- x$statistic p.value <- x$p.value alpha <- x$alpha df <- x$df cat("\n") cat("Rao's Tests for Homogeneity", "\n") if(alpha == 0) { cat("\n") cat(" Test for Equality of Polar Vectors:", "\n", "\n") cat("Test Statistic =", round(statistic[1], digits=digits), "\n") cat("Degrees of Freedom =", df, "\n") cat("P-value of test =", round(p.value[1], digits=digits), "\n", "\n") cat(" Test for Equality of Dispersions:", "\n", "\n") cat("Test Statistic =", round(statistic[2], digits=digits), "\n") cat("Degrees of Freedom =", df, "\n") cat("P-value of test =", round(p.value[2], digits=digits), "\n", "\n") } else { cat("\n") cat(" Test for Equality of Polar Vectors:", "\n", "\n") cat("Test Statistic =", round(statistic[1], digits=digits), "\n") cat("Degrees of Freedom =", df, "\n") cat("Level", alpha, "critical value =", round(qchisq(1 - alpha, df), digits=digits), "\n") if (statistic[1] > qchisq(1 - alpha, df)) { cat("Reject null hypothesis of equal polar vectors", "\n", "\n") } else { cat("Do not reject null hypothesis of equal polar vectors", "\n", "\n") } cat(" Test for Equality of Dispersions:", "\n", "\n") cat("Test Statistic =", round(statistic[2], digits=digits), "\n") cat("Degrees of Freedom =", df, "\n") cat("Level", alpha, "critical value =", round(qchisq(1 - alpha, df), digits=digits), "\n") if (statistic[2] > qchisq(1 - alpha, df)) { cat("Reject null hypothesis of equal dispersions", "\n", "\n") } else { cat("Do not reject null hypothesis of equal dispersions", "\n", "\n") } } invisible(x) } circular/R/onAttach.R0000644000176200001440000000064214470153537014156 0ustar liggesusers.onAttach <- function(library, pkg) { # Rv <- R.Version() # if(Rv$major < 2 |(Rv$major == 2 && Rv$minor < 2.0)) # stop("This package requires R 2.2.0 or later") if(interactive()) { meta <- packageDescription("circular") # packageStartupMessage( # "Package 'circular', ", meta$Version, " (", meta$Date, "). ", # "Type 'help(Circular)' for summary information.") } invisible() } circular/R/rayleigh.test.R0000644000176200001440000000731112130464225015165 0ustar liggesusers ############################################################# # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################# ############################################################# # # # rayleigh.test function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: June, 04, 2006 # # Version: 0.3 # # # # Copyright (C) 2006 Claudio Agostinelli # # # ############################################################# rayleigh.test <- function(x, mu=NULL) { # Handling missing values x <- na.omit(x) if (length(x)==0) { warning("No observations (at least after removing missing values)") return(NULL) } x <- conversion.circular(x, units="radians", zero=0, rotation="counter", modulo="2pi") attr(x, "circularp") <- attr(x, "class") <- NULL if (!is.null(mu)) { mu <- conversion.circular(mu, units="radians", zero=0, rotation="counter", modulo="2pi") attr(mu, "circularp") <- attr(mu, "class") <- NULL } result <- RayleighTestRad(x, mu) result$call <- match.call() class(result) <- "rayleigh.test" return(result) } RayleighTestRad <- function(x, mu=NULL) { n <- length(x) if (is.null(mu)) { ss <- sum(sin(x)) cc <- sum(cos(x)) rbar <- (sqrt(ss^2 + cc^2))/n z <- (n * rbar^2) p.value <- exp( - z) if (n < 50) temp <- 1 + (2 * z - z^2)/(4 * n) - (24 * z - 132 * z^2 + 76 * z^3 - 9 * z^4)/(288 * n^2) else temp <- 1 p.value <- min(max(p.value * temp,0),1) result <- list(statistic = rbar, p.value = p.value, mu=NA) } else { r0.bar <- (sum(cos(x - mu)))/n z0 <- sqrt(2 * n) * r0.bar pz <- pnorm(z0) fz <- dnorm(z0) p.value <- 1 - pz + fz * ((3 * z0 - z0^3)/(16 * n) + (15 * z0 + 305 * z0^3 - 125 * z0^5 + 9 * z0^7)/(4608 * n^2)) p.value <- min(max(p.value,0),1) result <- list(statistic = r0.bar, p.value = p.value, mu=mu) } return(result) } ############################################################# # # # print.rayleigh.test function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: November, 19, 2003 # # Version: 0.1-1 # # # # Copyright (C) 2003 Claudio Agostinelli # # # ############################################################# print.rayleigh.test <- function(x, digits=4, ...) { rbar <- x$statistic p.value <- x$p.value mu <- x$mu cat("\n", " Rayleigh Test of Uniformity \n") if (is.na(mu)) { cat(" General Unimodal Alternative \n\n") } else { cat(" Alternative with Specified Mean Direction: ", mu, "\n\n") } cat("Test Statistic: ", round(rbar, digits=digits), "\n") cat("P-value: ", round(p.value, digits=digits), "\n\n") invisible(x) } circular/R/circular.R0000644000176200001440000003155411553765107014230 0ustar liggesusers############################################################# # # # circular function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: October, 19, 2009 # # Version: 0.8 # # # # Copyright (C) 2009 Claudio Agostinelli # # # ############################################################# circular <- function(x, type=c("angles", "directions"), units=c("radians", "degrees", "hours"), template=c("none", "geographics", "clock12", "clock24"), modulo=c("asis", "2pi", "pi"), zero=0, rotation=c("counter", "clock"), names=NULL) { type <- match.arg(type) units <- match.arg(units) template <- match.arg(template) modulo <- match.arg(modulo) rotation <- match.arg(rotation) if (template=="geographics") { zero <- pi/2 rotation <- "clock" } else if (template=="clock24") { zero <- pi/2 rotation <- "clock" } else if (template=="clock12") { zero <- pi/2 rotation <- "clock" } if (is.data.frame(x)) x <- as.matrix(x) cl <- class(x) if (is.matrix(x)) { nseries <- ncol(x) if (is.null(names)) { if (is.null(colnames(x))) colnames <- paste("Circular", seq(nseries), sep="") } else colnames(x) <- names } else { nseries <- 1 } if (modulo!="asis") { if (modulo=="2pi") { ang <- 2 } else { ang <- 1 } if (units=="radians") { x <- x %% (ang*pi) } else if (units=="degrees") { x <- x %% (ang*180) } else { x <- x %% (ang*12) ## hours } } attr(x, "circularp") <- list(type=type, units=units, template=template, modulo=modulo, zero=zero, rotation=rotation) #-- order is fixed if (!inherits(x, "circular")) class(x) <- c("circular", cl) return(x) } ############################################################# # # # c.circular function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: March, 30, 2011 # # Version: 0.2 # # # # Copyright (C) 2011 Claudio Agostinelli # # # ############################################################# c.circular <- function (..., recursive = FALSE) { x <- list(...) value <- attr(x[[1]], "circularp") n <- length(x) if (n>1) { for (i in 2:length(x)) { x[[i]] <- conversion.circular(x[[i]], type=value$type, units=value$units, template=value$template, modulo=value$modulo, zero=value$zero, rotation=value$rotation) } } x <- structure(c(unlist(lapply(x, unclass))), class = c("circular", "numeric")) attr(x, "circularp") <- value return(x) } ############################################################# # # # conversion.circular function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: December, 16, 2009 # # Version: 0.3-1 # # # # Copyright (C) 2009 Claudio Agostinelli # # # ############################################################# conversion.circular <- function(x, units=c("radians", "degrees", "hours"), type=NULL, template=NULL, modulo=NULL, zero=NULL, rotation=NULL) { units <- match.arg(units) if (!is.null(type) && type!="angles" && type!="directions") stop("'type' must be 'angles' or 'directions' or NULL") if (!is.null(template) && template!="none" && template!="geographics" && template!="clock24" && template!="clock12") stop("'template' must be 'none' or 'geographics' or 'clock24' or 'clock12' or NULL") if (!is.null(modulo) && modulo!="asis" && modulo!="2pi" && modulo!="pi") stop("'modulo' must be 'asis' or 'pi' or '2pi' or NULL") if (!is.null(zero) && !is.numeric(zero)) stop("'zero' must be numeric or NULL") if (!is.null(rotation) && rotation!="clock" && rotation!="counter") stop("'rotation' must be 'clock' or 'counter' or NULL") x <- as.circular(x) value <- attr(x, "circularp") typep <- value$type unitsp <- value$units rotationp <- value$rotation zerop <- value$zero if (!is.null(template)) { if (template=="geographics") { zero <- pi/2 rotation <- "clock" } else if (template=="clock24") { zero <- pi/2 rotation <- "clock" } else if (template=="clock12") { zero <- pi/2 rotation <- "clock" } value$template <- template } if (!is.null(type) && type=="directions" && typep!=type) { x <- 2*x value$type <- type } if (!is.null(units)) { if (unitsp=="degrees" & units=="radians") { x <- x/180*pi } else if (unitsp=="radians" & units=="degrees") { x <- x/pi*180 } else if (unitsp=="degrees" & units=="hours") { x <- x/180*12 } else if (unitsp=="radians" & units=="hours") { x <- x/pi*12 } else if (unitsp=="hours" & units=="degrees") { x <- x/12*180 } else if (unitsp=="hours" & units=="radians") { x <- x/12*pi } value$units <- units } if (!is.null(zero) && zerop!=zero) { if (units=="degrees") { zerod <- zero*180/pi zeropd <- zerop*180/pi } else if (units=="hours") { zerod <- zero*12/pi zeropd <- zerop*12/pi } else { zerod <- zero zeropd <- zerop } if (rotationp=="counter") { x <- x + zeropd - zerod } else { x <- x - zeropd + zerod } value$zero <- zero } if (!is.null(rotation) && rotationp!=rotation) { x <- -x value$rotation <- rotation } if (!is.null(modulo) && modulo!="asis") { if (modulo=="2pi") { ang <- 2 } else { ang <- 1 } if (units=="radians") { x <- x %% (ang*pi) } else if (units=="degrees") { x <- x %% (ang*180) } else { x <- x %% (ang*12) ## time } } if (!is.null(modulo)) value$modulo <- modulo if (!is.null(zero) && zero%%(2*pi)!=pi/2) value$template <- "none" if (!is.null(rotation) && rotation=="counter") value$template <- "none" circularp(x) <- value return(x) } ############################################################# # # # circularp function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: March, 7, 2003 # # Version: 0.1 # # # # Copyright (C) 2003 Claudio Agostinelli # # # ############################################################# circularp <- function(x) attr(x, "circularp") ############################################################# # # # circularp<- function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: October, 19, 2009 # # Version: 0.3 # # # # Copyright (C) 2009 Claudio Agostinelli # # # ############################################################# "circularp<-" <- function(x, value) { cl <- class(x) if (length(value)!=6) stop("value must have six elements") if (is.list(value)) { type <- value$type units <- value$units template <- value$template modulo <- value$modulo zero <- value$zero rotation <- value$rotation } else { type <- value[1] units <- value[2] template <- value[3] modulo <- value[4] zero <- as.numeric(value[5]) rotation <- value[6] value <- list(type=type, units=units, template=template, modulo=modulo, zero=zero, rotation=rotation) } if (type!="angles" & type!="directions") stop("type (value[1]) must be 'angles', 'directions'") if (units!="radians" & units!="degrees" & units!="hours") stop("units (value[2]) must be 'radians' or 'degrees' or 'hours'") if (template!="none" & template!="geographics" & template!="clock24" & template!="clock12") stop("template (value[3]) must be 'none' or 'geographics' or 'clock24' or 'clock12'") if (modulo!="asis" & modulo!="2pi" & modulo!="pi") stop("modulo (value[4]) must be 'asis' or 'pi' or '2pi'") if (!is.numeric(zero)) stop("zero (value[5]) must be numeric") if (rotation!="clock" & rotation!="counter") stop("rotation (value[6]) must be 'clock' or 'counter'") attr(x, "circularp") <- value if (inherits(x, "circular") && is.null(value)) class(x) <- if (!identical(cl, "circular")) cl["circular" != cl] return(x) } ############################################################# # # # is.circular function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: March, 7, 2003 # # Version: 0.1 # # # # Copyright (C) 2003 Claudio Agostinelli # # # ############################################################# is.circular <- function (x) inherits(x, "circular") ############################################################# # # # [.circular function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: March, 7, 2003 # # Version: 0.1 # # # # Copyright (C) 2003 Claudio Agostinelli # # # ############################################################# "[.circular" <- function(x, i, ...) { y <- NextMethod("[", ...) class(y) <- class(x) attr(y, "circularp") <- attr(x, "circularp") return(y) } ############################################################# # # # print.circular function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: June, 21, 2003 # # Version: 0.2 # # # # Copyright (C) 2003 Claudio Agostinelli # # # ############################################################# print.circular <- function(x, info=TRUE, ...) { x.orig <- x x <- as.circular(x) if (info) { xcircularp <- attr(x, "circularp") type <- xcircularp$type units <- xcircularp$units template <- xcircularp$template modulo <- xcircularp$modulo zero <- xcircularp$zero rotation <- xcircularp$rotation cat("Circular Data: \nType =", type, "\nUnits =", units, "\nTemplate =", template, "\nModulo =", modulo, "\nZero =", zero, "\nRotation =", rotation, "\n") } attr(x, "class") <- attr(x, "circularp") <- attr(x, "na.action") <- NULL NextMethod("print", x, quote = FALSE, right = TRUE, ...) invisible(x.orig) } circular/R/trigonometric.moment.R0000644000176200001440000000530211312211537016561 0ustar liggesusers ############################################################# # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################# ############################################################# # # # trigonometric.moment function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: August, 10, 2006 # # Copyright (C) 2006 Claudio Agostinelli # # # # Version 0.3-3 # ############################################################# trigonometric.moment <- function(x, p = 1, center = FALSE, control.circular=list()) { x <- unlist(x) if (is.circular(x)) { datacircularp <- circularp(x) } else { datacircularp <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") } dc <- control.circular if (is.null(dc$type)) dc$type <- datacircularp$type if (is.null(dc$units)) dc$units <- datacircularp$units if (is.null(dc$template)) dc$template <- datacircularp$template if (is.null(dc$modulo)) dc$modulo <- datacircularp$modulo if (is.null(dc$zero)) dc$zero <- datacircularp$zero if (is.null(dc$rotation)) dc$rotation <- datacircularp$rotation # Handling missing values x <- na.omit(x) if ((n <- length(x))==0) { warning("No observations (at least after removing missing values)") return(NULL) } x <- conversion.circular(x, units="radians", zero=0, rotation="counter") attr(x, "class") <- attr(x, "circularp") <- NULL res <- TrigonometricMomentRad(x, p, center) mu.p <- conversion.circular(circular(res[1]), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) result <- list(mu=mu.p, rho=res[2], cos=res[3], sin=res[4], p=res[5], n=res[6], call=match.call()) return(result) } TrigonometricMomentRad <- function(x, p, center) { center <- as.numeric(center) n <- length(x) sinr <- sum(sin(x)) cosr <- sum(cos(x)) circmean <- atan2(sinr, cosr) sin.p <- sum(sin(p * (x - circmean * center)))/n cos.p <- sum(cos(p * (x - circmean * center)))/n mu.p <- atan2(sin.p, cos.p) rho.p <- sqrt(sin.p^2 + cos.p^2) result <- c(mu.p, rho.p, cos.p, sin.p, p, n) return(result) } circular/R/A1FirstDerivative.R0000644000176200001440000000016212065027012015670 0ustar liggesusersA1FirstDerivative <- function(kappa) { result <- 1-(A1(kappa=kappa)/kappa)-A1(kappa=kappa)^2 return(result) } circular/R/cardioid.R0000644000176200001440000000675311312211537014167 0ustar liggesusers ############################################################# # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################# ############################################################# # # # rcardioid function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: August, 10, 2006 # # Copyright (C) 2006 Claudio Agostinelli # # # # Version 0.2-3 # ############################################################# rcardioid <- function(n, mu=circular(0), rho=0, control.circular=list()) { if (is.circular(mu)) { datacircularp <- circularp(mu) } else { datacircularp <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") } dc <- control.circular if (is.null(dc$type)) dc$type <- datacircularp$type if (is.null(dc$units)) dc$units <- datacircularp$units if (is.null(dc$template)) dc$template <- datacircularp$template if (is.null(dc$modulo)) dc$modulo <- datacircularp$modulo if (is.null(dc$zero)) dc$zero <- datacircularp$zero if (is.null(dc$rotation)) dc$rotation <- datacircularp$rotation mu <- conversion.circular(mu, units="radians", zero=0, rotation="counter") attr(mu, "class") <- attr(mu, "circularp") <- NULL res <- RcardioidRad(n, mu, rho) res <- conversion.circular(circular(res), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) return(res) } RcardioidRad <- function(n, mu, rho) { if (rho < -0.5 | rho > 0.5) stop("rho must be between -0.5 and 0.5") i <- 1 result <- rep(0, n) while (i <= n) { x <- runif(1, 0, 2 * pi) y <- runif(1, 0, (1 + 2 * rho)/(2 * pi)) f <- (1 + 2 * rho * cos(x - mu))/(2 * pi) if (y <= f) { result[i] <- x i <- i + 1 } } return(result) } ############################################################# # # # dcardioid function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: May, 31, 2006 # # Copyright (C) 2006 Claudio Agostinelli # # # # Version 0.3-1 # ############################################################# dcardioid <- function(x, mu=circular(0), rho=0) { x <- conversion.circular(x, units="radians", zero=0, rotation="counter") mu <- conversion.circular(mu, units="radians", zero=0, rotation="counter") attr(x, "class") <- attr(x, "circularp") <- NULL attr(mu, "class") <- attr(mu, "circularp") <- NULL DcardioidRad(x, mu, rho) } DcardioidRad <- function(x, mu=0, rho=0) { if (rho < -0.5 | rho > 0.5) stop("rho must be between -0.5 and 0.5") d <- (1 + 2 * rho * cos(x - mu))/(2 * pi) return(d) } circular/R/median.circular.R0000644000176200001440000000773113124163330015446 0ustar liggesusers### This is necessary since stats::median do not have ... argument ### Work around suggested by Kurt but does not work. ###median <- function(x, na.rm, ...) UseMethod("median") ###median.default <- function(x, na.rm, ...) stats::median.default(x, na.rm) ############################################################# # # median.circular function # Author: Claudio Agostinelli and Alessandro Gagliardi # E-mail: claudio.agostinelli@unitn.it # Date: June, 26, 2017 # Version: 0.5 # # Copyright (C) 2015-2017 Claudio Agostinelli and Alessandro Gagliardi # ############################################################# median.circular <- function(x, na.rm=FALSE, ...) { if (na.rm) x <- x[!is.na(x)] if (length(x)==0) { warning("No observations (at least after removing missing values)") return(circular(NA)) } if (is.circular(x)) { dc <- circularp(x) } else { dc <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") } x <- conversion.circular(x, units="radians") attr(x, "class") <- attr(x, "circularp") <- NULL circmedian <- MedianCircularRad(x) circmedian <- conversion.circular(circular(drop(circmedian), template=dc$template, zero=dc$zero, rotation=dc$rotation), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) attr(circmedian, "medians") <- conversion.circular(circular(drop(attr(circmedian, "medians")), template=dc$template, zero=dc$zero, rotation=dc$rotation), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) attr(attr(circmedian, "medians"), "class") <- attr(attr(circmedian, "medians"), "circularp") <- NULL return(circmedian) } MedianCircularRad <- function(x) { n <- length(x) res <- .C("MedianCircularRad",x=as.double(x),n=as.integer(n),result=as.double(0),medians=double(length(x)),lMedians=as.integer(n)) median <- res$result attr(median, "medians") <- unique(res$medians[1:res$lMedians]) return(median) } medianCircular <- function(x, na.rm=FALSE, type="Fisher", deviation=FALSE, control.circular=list(), ...) { .Deprecated(new="median.circular") ## For now only the definition in ## equations 2.32 & 2.33 ## from N.I. Fisher's 'Statistical Analysis of Circular Data', ## Cambridge Univ. Press 1993. ## is implemented type <- match.arg(type) if (na.rm) x <- x[!is.na(x)] if (length(x)==0) { warning("No observations (at least after removing missing values)") return(NULL) } if (is.circular(x)) { datacircularp <- circularp(x) } else { datacircularp <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") } dc <- control.circular if (is.null(dc$type)) dc$type <- datacircularp$type if (is.null(dc$units)) dc$units <- datacircularp$units if (is.null(dc$template)) dc$template <- datacircularp$template if (is.null(dc$modulo)) dc$modulo <- datacircularp$modulo if (is.null(dc$zero)) dc$zero <- datacircularp$zero if (is.null(dc$rotation)) dc$rotation <- datacircularp$rotation x <- conversion.circular(x, units="radians") attr(x, "class") <- attr(x, "circularp") <- NULL circmedian <- list() if (type=="Fisher") circmedian$median <- MedianCircularRad(x) else stop("Others 'type' not yet implemented") circmedian$median <- conversion.circular(circular(circmedian$median, template=datacircularp$template, zero=datacircularp$zero, rotation=datacircularp$rotation), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) if (deviation) { circmedian$deviation <- MeanDeviationRad(x) return(circmedian) } else return(circmedian$median) } circular/R/intersect.modal.region.R0000644000176200001440000000737112633073053016771 0ustar liggesusersintersect.modal.region <- function(x, ...) UseMethod("intersect.modal.region") intersect.modal.region.default <- function(x, ...) .NotYetImplemented() ############################################################# # # intersect.modal.region.circular # GNU General Public Licence 2.0 # Author: Claudio Agostinelli # E-mail: claudio.agostinelli@unitn.it # Date: November, 09, 2015 # Version: 0.1 # # Copyright (C) 2015 Claudio Agostinelli # ############################################################# intersect.modal.region.circular <- function(x, breaks, z=NULL, q=0.95, bw, adjust = 1, type = c("K", "L"), kernel = c("vonmises", "wrappednormal"), na.rm = FALSE, step=0.01, eps.lower=10^(-4), eps.upper=10^(-4), ...) { breaks <- conversion.circular(breaks, units="radians", zero=0, rotation="counter", modulo="asis") class(breaks) <- class(breaks)[class(breaks)!="circular"] attr(breaks, "circularp") <- NULL nrb <- nrow(breaks) mr <- modal.region.circular(x=x, z=z, q=q, bw=bw, adjust=adjust, type=type, kernel=kernel, na.rm=na.rm, step=step, eps.lower=eps.lower, eps.upper=eps.upper, ...) zeros <- mr$zeros nrz <- nrow(zeros) newbreaks <- areas <- list() tot <- 0 for (i in 1:nrb) { newbreaks[[i]] <- matrix(0, nrow=0, ncol=2) for (j in 1:nrz) { temp <- circular(IntersectIntervalRad(x=zeros[j,], y=breaks[i,])) newbreaks[[i]] <- rbind(newbreaks[[i]], temp) } if (nrow(newbreaks[[i]]) > 0) { areas[[i]] <- areas.region.circular(x=x, breaks=newbreaks[[i]], z=z, bw=bw, adjust=adjust, type=type, kernel=kernel, na.rm=na.rm, step=step, ...) tot <- tot + areas[[i]]$tot } else areas[[i]] <- NA } result <- list(tot=tot, areas=areas, breaks=newbreaks) return(result) } IntersectIntervalRad <- function(x, y) { x <- x%%(2*pi) y <- y%%(2*pi) if (x[1] <= x[2]) { if (y[1] <= y[2]) { if (x[2] < y[1] | y[2] < x[1]) res <- matrix(0, nrow=0, ncol=2) else res <- c(max(x[1], y[1]), min(x[2],y[2])) } else { res <- matrix(0, nrow=0, ncol=2) if (x[1] <= y[2]) { res <- rbind(res, c(x[1], min(y[2],x[2]))) } if (x[2] >= y[1]) { res <- rbind(res, c(max(x[1],y[1]), x[2])) } } } else { if (y[1] <= y[2]) { res <- matrix(0, nrow=0, ncol=2) if (y[1] <= x[2]) { res <- rbind(res, c(y[1], min(x[2],y[2]))) } if (y[2] >= x[1]) { res <- rbind(res, c(max(y[1],x[1]), y[2])) } } else { res <- rbind(c(0, min(x[2],y[2])),c(max(x[1],y[1]),2*pi)) if (y[2] >= x[1]) res <- rbind(res, c(x[1],y[2])) if (y[1] <= x[2]) res <- rbind(res, c(y[1],x[2])) } } return(res) } if (FALSE) { library(gtools) z <- pi/c(8,6,4,3) z <- permutations(n=4, r=4, v=z) for (i in 1:nrow(z)) { print(z[i,]) print(IntersectIntervalRad(x=c(z[i,1],z[i,2]), y=c(z[i,3],z[i,4]))) } } if (FALSE) { x <- rvonmises(100, circular(pi), 10) res <- intersect.modal.region(x, breaks=circular(matrix(c(pi,pi+pi/12), ncol=2)), bw=50) res$tot res <- intersect.modal.region(x, breaks=circular(matrix(c(pi,pi+pi/12, pi-pi/12, pi), ncol=2, byrow=TRUE)), bw=50) res$tot x <- rvonmises(100, circular(0), 10) res <- intersect.modal.region(x, breaks=circular(matrix(c(pi,pi+pi/12), ncol=2)), bw=50) res$tot res <- intersect.modal.region(x, breaks=circular(matrix(c(pi/12, 2*pi-pi/12), ncol=2, byrow=TRUE)), bw=50) res$tot res <- intersect.modal.region(x, breaks=circular(matrix(c(2*pi-pi/12, pi/12), ncol=2, byrow=TRUE)), bw=50) res$tot res <- intersect.modal.region(x, breaks=circular(matrix(c(2*pi-pi/12,2*pi), ncol=2, byrow=TRUE)), bw=50) res$tot res <- intersect.modal.region(x, breaks=circular(matrix(c(0,pi/12), ncol=2, byrow=TRUE)), bw=50) res$tot } circular/R/areas.circular.R0000644000176200001440000000700712620121202015270 0ustar liggesusers############################################################# # # areas.region.circular # GNU General Public Licence 2.0 # Author: Claudio Agostinelli # E-mail: claudio@unive.it # Date: August, 26, 2013 # Version: 0.1 # # Copyright (C) 2013 Claudio Agostinelli # ############################################################# areas.region.circular <- function(x, breaks=NULL, z=NULL, bw, adjust = 1, type = c("K", "L"), kernel = c("vonmises", "wrappednormal"), na.rm = FALSE, step=0.01, ...) { if (is.null(z)) z <- circular(seq(-step,2*pi+step,step)) if (is.null(breaks)) breaks <- circular(seq(0, 2*pi+pi/4, pi/4)) if (is.circular(x)) xcp <- circularp(x) else xcp <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") x <- conversion.circular(x, units="radians", zero=0, rotation="counter", modulo="2pi") z <- conversion.circular(z, units="radians", zero=0, rotation="counter", modulo="asis") if (is.vector(breaks)) modulobreaks <- "2pi" else modulobreaks <- "asis" breaks <- conversion.circular(breaks, units="radians", zero=0, rotation="counter", modulo=modulobreaks) class(breaks) <- class(breaks)[class(breaks)!="circular"] attr(breaks, "circularp") <- NULL if (is.vector(breaks)) { breaks <- sort(unique(breaks)) breaks <- cbind(breaks, c(breaks[-1], breaks[1]+2*pi)) } extend <- range(breaks) extend <- c(floor(extend[1]/(2*pi)), ceiling(extend[2]/(2*pi))) object <- density.circular(x=x, z=z, bw=bw, adjust=adjust, type=type, kernel=kernel, na.rm=na.rm) areas <- area2(breaks, object, extend=extend) result <- list() xunits <- circularp(x)$units result$breaks <- conversion.circular(circular(breaks), xcp$units, xcp$type, xcp$template, 'asis', xcp$zero, xcp$rotation) result$tot <- areas$tot result$areas <- areas$areas object$x <- conversion.circular(object$x, xcp$units, xcp$type, xcp$template, 'asis', xcp$zero, xcp$rotation) result$density <- object class(result) <- 'areas.region.circular' return(result) } ## Calculate areas under several disjoint intervals area2 <- function(x, object, extend, ...) { #x: is a matrix with two columns #object: an object from density.circular #...: values passed to integrate function extend <- seq(extend[1], extend[2],1) ### extend <- extend[extend!=0] den <- approxfun(x=as.vector(outer(object$x,extend*2*pi,FUN="+")), y=rep(object$y, length(extend))) int <- function(x) integrate(f=den, lower=x[1], upper=x[2], ...)$value areas <- apply(x, 1, int) tot <- sum(areas) result <- list(tot=tot, areas=areas) return(result) } if (FALSE) { #### EXAMPLES set.seed(1234) x <- c(rvonmises(100, circular(0), 8, control.circular=list(units="hours")), rvonmises(100, circular(pi), 8, control.circular=list(units="hours"))) plot(x, template="clock24") res1 <- areas.region.circular(x, breaks=circular(c(5,8,17,19,21), units="hours"), bw=10) ## a partition of the circle res2 <- areas.region.circular(x, breaks=circular(matrix(c(7,18), nrow=1), units="hours"), bw=10) ## a single interval res3 <- areas.region.circular(x, breaks=circular(matrix(c(7,18,19,6+24), ncol=2), units="hours"), bw=10) ## a two or more intervals res4 <- areas.region.circular(x, breaks=circular(matrix(c(6,6+3*24), ncol=2), units="hours"), bw=10) ## over more than one clock res5 <- areas.region.circular(x, breaks=circular(matrix(c(6,6+3*24), ncol=2), units="hours"), bw=10, step=0.0001) ## increase precision as in modal.region.circular } circular/R/rose.diag.R0000644000176200001440000001310214470144776014270 0ustar liggesusers ############################################################# # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################# ############################################################# # # # rose.diag function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: March, 15, 2011 # # Copyright (C) 2011 Claudio Agostinelli # # # # Version 0.2-3 # # # # Modified by Hiroyoshi Arai # # Date: October, 19, 2010 # # Added arguments # # upper: if TRUE, upper-closed (lower-open) intervals. # # radii.scale: "sqrt"(default) or "linear" # # border: the color to draw the border. # # Revised argument # # col: the color to filling the sector. # # # ############################################################# rose.diag <- function(x, pch = 16, cex=1, axes = TRUE, shrink = 1, bins=NULL, upper=TRUE, ticks = TRUE, tcl=0.025, tcl.text=0.125, radii.scale = c("sqrt", "linear"), border=NULL, col=NULL, tol = 0.04, uin=NULL, xlim=c(-1, 1), ylim=c(-1, 1), prop = 1, digits=2, plot.info=NULL, units=NULL, template=NULL, zero=NULL, rotation=NULL, main=NULL, sub=NULL, xlab="", ylab="", add=FALSE, control.circle = circle.control(), ...) { radii.scale <- match.arg(radii.scale) if (is.matrix(x) | is.data.frame(x)) { nseries <- ncol(x) } else { nseries <- 1 } xx <- as.data.frame(x) xcircularp <- attr(as.circular(xx[,1]), "circularp") # type <- xcircularp$type modulo <- xcircularp$modulo if (is.null(units)) units <- xcircularp$units if (is.null(plot.info)) { if (is.null(template)) template <- xcircularp$template if (template=="geographics" | template=="clock24") { zero <- pi/2 rotation <- "clock" } else if (template=="clock12") { zero <- pi/2 rotation <- "clock" modulo <- "pi" } else { if (is.null(zero)) zero <- xcircularp$zero if (is.null(rotation)) rotation <- xcircularp$rotation } next.points <- 0 } else { zero <- plot.info$zero rotation <- plot.info$rotation next.points <- plot.info$next.points } if (!add) { CirclePlotRad(xlim=xlim, ylim=ylim, uin=uin, shrink=shrink, tol=tol, main=main, sub=sub, xlab=xlab, ylab=ylab, control.circle=control.circle) } if (is.null(bins)) { bins <- NROW(x) } else { bins <- round(bins) if (bins<=0) stop("bins must be non negative") } if (is.null(border)) { border <- seq(nseries) } else { if (length(border)!=nseries) { border <- rep(border, nseries)[1:nseries] } } pch <- rep(pch, nseries, length.out=nseries) if (axes) { axis.circular(units=units, template=template, zero=zero, rotation=rotation, digits=digits, cex=cex, tcl=tcl, tcl.text=tcl.text) } if (!is.logical(ticks)) stop("ticks must be logical") if (ticks) { at <- circular((0:bins)/bins*2*pi, zero=zero, rotation=rotation) ticks.circular(at, tcl=tcl) } for (iseries in 1:nseries) { x <- xx[,iseries] x <- na.omit(x) n <- length(x) if (n) { x <- conversion.circular(x, units="radians", modulo=modulo) attr(x, "circularp") <- attr(x, "class") <- NULL # x <- x+zero if (template=="clock12") x <- 2*x x <- x%%(2*pi) RosediagRad(x, zero=zero, rotation, bins, upper, radii.scale, prop, border[iseries], col, ...) } } return(invisible(list(zero=zero, rotation=rotation, next.points=0))) } RosediagRad <- function(x, zero, rotation, bins, upper, radii.scale, prop, border, col, ...) { #### x musts be in modulo 2pi n <- length(x) freq <- rep(0, bins) arc <- (2 * pi)/bins if (!is.logical(upper)) stop("upper must be logical") if (upper == TRUE) x[x == 0] <- 2*pi x[x >= 2*pi] <- 2*pi-4*.Machine$double.eps # for (i in 1:bins) { # freq[i] <- sum(x < i * arc & x >= (i - 1) * arc) # } breaks <- seq(0,2*pi,length.out=(bins+1)) freq <- hist.default(x, breaks=breaks, plot=FALSE, right=upper)$counts rel.freq <- freq/n if (rotation == "clock") rel.freq <- rev(rel.freq) if (radii.scale == "sqrt") { radius <- sqrt(rel.freq)*prop } else { radius <- rel.freq*prop } sector <- seq(0, 2 * pi - (2 * pi)/bins, length = bins) mids <- seq(arc/2, 2 * pi - pi/bins, length = bins) for (i in 1:bins) { if (rel.freq[i] != 0) { xx <- c(0, radius[i]*cos(seq(sector[i], sector[i]+(2*pi)/bins, length=1000/bins)+zero), 0) yy <- c(0, radius[i]*sin(seq(sector[i], sector[i]+(2*pi)/bins, length=1000/bins)+zero), 0) polygon(xx, yy, border=border, col=col, ...) } } } circular/R/aov.circular.R0000644000176200001440000001322611312211537014772 0ustar liggesusers ############################################################# # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################# ############################################################# # # # aov.circular function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: August, 10, 2006 # # Version: 0.2-1 # # # # Copyright (C) 2006 Claudio Agostinelli # # # ############################################################# aov.circular <- function(x, group, kappa=NULL, method=c("F.test", "LRT"), F.mod=TRUE, control.circular=list()) { method <- match.arg(method) # Handling missing values ok <- complete.cases(x, group) x <- x[ok] group <- group[ok] if (length(x)==0 | length(table(group)) < 2) { warning("No observations or no groups (at least after removing missing values)") return(NULL) } if (is.circular(x)) { datacircularp <- circularp(x) } else { datacircularp <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") } dc <- control.circular if (is.null(dc$type)) dc$type <- datacircularp$type if (is.null(dc$units)) dc$units <- datacircularp$units if (is.null(dc$template)) dc$template <- datacircularp$template if (is.null(dc$modulo)) dc$modulo <- datacircularp$modulo if (is.null(dc$zero)) dc$zero <- datacircularp$zero if (is.null(dc$rotation)) dc$rotation <- datacircularp$rotation x <- conversion.circular(x, units="radians", zero=0, rotation="counter", modulo="2pi") attr(x, "class") <- attr(x, "circularp") <- NULL result <- AovCircularRad(x, group, kappa=NULL, method, F.mod) result$mu <- conversion.circular(circular(result$mu), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) result$mu.all <- conversion.circular(circular(result$mu.all), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) result$call <- match.call() class(result) <- "aov.circular" return(result) } AovCircularRad <- function(x, group, kappa=NULL, method, F.mod) { ### x must be in radians, modulo 2pi ns <- tapply(x, group, FUN=length) resultant <- tapply(x, group, FUN=function(x) RhoCircularRad(x)*length(x)) mean.dirs <- tapply(x, group, FUN=MeanCircularRad) kappas <- tapply(x, group, FUN=function(x) MlevonmisesRad(x)[4]) grps <- length(resultant) n <- length(group) res.all <- RhoCircularRad(x)*n mean.dir.all <- MeanCircularRad(x) kappa.all <- MlevonmisesRad(x)[4] if (method=="F.test"){ if (!is.null(kappa)) warning("Specified value of kappas is not used in the F-test") sum.res <- sum(resultant) df <- c(grps-1, n-grps, n-1) SS <- c(sum.res - res.all, n-sum.res, n-res.all) MS <- SS/df if (F.mod==TRUE) { stat <- (1+3/(8*kappa.all))*MS[1]/MS[2] } else { stat <- MS[1]/MS[2] } p.value <- 1-pf(stat, grps-1,n-grps) } else { SS <- NA MS <- NA if (is.null(kappa)) kappa <- kappa.all stat1 <- 1-1/(4*kappa)*A1(kappa)*(sum(1/ns)-1/n) stat2 <- 2*kappa*sum(resultant*(1-cos(mean.dirs-mean.dir.all))) stat <- stat1*stat2 df <- grps-1 p.value <- 1-pchisq(stat, df) } result <- list() result$mu <- mean.dirs result$mu.all <- mean.dir.all result$kappa <- kappas result$kappa.all <- kappa.all result$rho <- resultant result$rho.all <- res.all result$method <- method result$df <- df result$SS <- SS result$MS <- MS result$statistic <- stat result$p.value <- p.value return(result) } ############################################################# # # # print.aov.circular function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: April, 30, 2005 # # Version: 0.2-1 # # # # Copyright (C) 2005 Claudio Agostinelli # # # ############################################################# print.aov.circular <- function(x, digits = max(3, getOption("digits") - 3), ...) { cat("\nCall:\n",deparse(x$call),"\n\n",sep="") if (x$method=="F.test") { result.matrix <- cbind(x$df, x$SS, x$MS, c(x$statistic,NA,NA), c(x$p.value,NA,NA)) dimnames(result.matrix) <- list(c("Between","Within","Total"),c("df", "SS", "MS", "F", "p")) cat("\n", "Circular Analysis of Variance: High Concentration F-Test", "\n", "\n") print(result.matrix, digits=digits) cat("\n \n") } else { cat("\n", "Circular Analysis of Variance: Likelihood Ratio Test", "\n", "\n") cat(" df: ", format(x$df, digits=digits), "\n ChiSq: ", format(x$statistic, digits=digits), "\n p.value:", format(x$p.value, digits=digits), "\n \n") } invisible(x) } circular/R/vonmises.R0000644000176200001440000004523012236416131014250 0ustar liggesusers############################################################# # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################# ############################################################# # # # rvonmises function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: November, 06, 2013 # # Copyright (C) 2013 Claudio Agostinelli # # # # Version 0.2-6 # ############################################################# rvonmises <- function(n, mu, kappa, control.circular=list()) { if (missing(mu) || length(mu)!=1) stop("the mean direction parameter 'mu' is mandatory and it must have length 1") if (missing(kappa) || length(kappa)!=1) stop("the concentration parameter 'kappa' is mandatory and it must have length 1") if (is.circular(mu)) { datacircularp <- circularp(mu) } else { datacircularp <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") } dc <- control.circular if (is.null(dc$type)) dc$type <- datacircularp$type if (is.null(dc$units)) dc$units <- datacircularp$units if (is.null(dc$template)) dc$template <- datacircularp$template if (is.null(dc$modulo)) dc$modulo <- datacircularp$modulo if (is.null(dc$zero)) dc$zero <- datacircularp$zero if (is.null(dc$rotation)) dc$rotation <- datacircularp$rotation mu <- conversion.circular(mu, units="radians", zero=0, rotation="counter") mu <- as.vector(mu) kappa <- as.vector(kappa) if (kappa < 0) stop("the concentration parameter 'kappa' must be non negative") attr(mu, "class") <- attr(mu, "circularp") <- NULL vm <- RvonmisesRad(n, mu, kappa) vm <- conversion.circular(circular(vm), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) return(vm) } #RvonmisesRad <- function(n, mu, kappa) { # vm <- 1:n # a <- 1 + (1 + 4 * (kappa^2))^0.5 # b <- (a - (2 * a)^0.5)/(2 * kappa) # r <- (1 + b^2)/(2 * b) # obs <- 1 # while (obs <= n) { # U1 <- runif(1, 0, 1) # z <- cos(pi * U1) # f <- (1 + r * z)/(r + z) # c <- kappa * (r - f) # U2 <- runif(1, 0, 1) # if (c * (2 - c) - U2 > 0) { # U3 <- runif(1, 0, 1) # vm[obs] <- sign(U3 - 0.5) * acos(f) + mu # vm[obs] <- vm[obs] %% (2 * pi) # obs <- obs + 1 # } else { # if (log(c/U2) + 1 - c >= 0) { # U3 <- runif(1, 0, 1) # vm[obs] <- sign(U3 - 0.5) * acos(f) + mu # vm[obs] <- vm[obs] %% (2 * pi) # obs <- obs + 1 # } # } # } # return(vm) #} RvonmisesRad <- function(n, mu, kappa) { x <- vector(length = n) if (kappa) { vm <- .C("rvm", as.double(x), as.integer(n), as.double(mu), as.double(kappa), PACKAGE="circular")[[1]] %% (2 * pi) } else { vm <- stats::runif(n=n, min=0, max=2*pi) } return(vm) } ############################################################# # # # dvonmises function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: February, 07, 2013 # # Copyright (C) 2013 Claudio Agostinelli # # # # Version 0.3 # ############################################################# dvonmises <- function (x, mu, kappa, log=FALSE) { if (missing(mu) || length(mu)!=1) stop("the mean direction parameter 'mu' is mandatory and it must have length 1") if (missing(kappa) || length(kappa)!=1) stop("the concentration parameter 'kappa' is mandatory and it must have length 1") if (!is.logical(log)) stop("'log' must be logical") x <- conversion.circular(x, units="radians", zero=0, rotation="counter") mu <- conversion.circular(mu, units="radians", zero=0, rotation="counter") mu <- as.vector(mu) kappa <- as.vector(kappa) if (kappa < 0) stop("the concentration parameter 'kappa' must be non negative") attr(x, "class") <- attr(x, "circularp") <- NULL attr(mu, "class") <- attr(mu, "circularp") <- NULL DvonmisesRad(x, mu, kappa, log) } DvonmisesRad <- function(x, mu, kappa, log=FALSE) { if (log) { if (kappa == 0) vm <- log(rep(1/(2*pi), length(x))) else if (kappa < 100000) vm <- -(log(2*pi)+log(besselI(kappa, nu = 0, expon.scaled=TRUE)) + kappa) + kappa*(cos(x - mu)) else vm <- ifelse(((x-mu)%%(2*pi))==0, Inf, -Inf) } else { if (kappa == 0) vm <- rep(1/(2*pi), length(x)) else if (kappa < 100000) vm <- 1/(2 * pi * besselI(x = kappa, nu = 0, expon.scaled = TRUE)) * (exp(cos(x - mu) -1))^kappa else vm <- ifelse(((x-mu)%%(2*pi))==0, Inf, 0) } return(vm) } ############################################################# # # # pvonmises function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: August, 12, 2010 # # Copyright (C) 2010 Claudio Agostinelli # # # # Version 0.4 # ############################################################# pvonmises <- function(q, mu, kappa, from=NULL, tol = 1e-020) { if (missing(mu) || length(mu)!=1) stop("the mean direction parameter 'mu' is mandatory and it must have length 1") if (missing(kappa) || length(kappa)!=1) stop("the concentration parameter 'kappa' is mandatory and it must have length 1") q <- conversion.circular(q, units="radians", zero=0, rotation="counter") mu <- conversion.circular(mu, units="radians", zero=0, rotation="counter") mu <- as.vector(mu) kappa <- as.vector(kappa) if (kappa < 0) stop("the concentration parameter 'kappa' must be non negative") if (is.null(from)) { from <- mu - pi } else { from <- conversion.circular(from, units="radians", zero=0, rotation="counter", modulo="2pi") } attr(q, "class") <- attr(q, "circularp") <- NULL attr(mu, "class") <- attr(mu, "circularp") <- NULL attr(from, "class") <- attr(from, "circularp") <- NULL mu <- (mu-from)%%(2*pi) q <- (q-from)%%(2*pi) PvonmisesRad(q, mu, kappa, tol) } PvonmisesRad <- function(q, mu, kappa, tol) { q <- q %% (2 * pi) n <- length(q) mu <- mu %% (2 * pi) pvm.mu0 <- function(q, kappa, tol) { flag <- TRUE p <- 1 sum <- 0 while (flag) { term <- (besselI(x=kappa, nu=p, expon.scaled = FALSE) * sin(p * q))/p sum <- sum + term p <- p + 1 if (abs(term) < tol) flag <- FALSE } return(q/(2 * pi) + sum/(pi * besselI(x=kappa, nu=0, expon.scaled = FALSE))) } result <- rep(NA, n) if (mu == 0) { for (i in 1:n) { result[i] <- pvm.mu0(q[i], kappa, tol) } } else { for (i in 1:n) { if (q[i] <= mu) { upper <- (q[i] - mu) %% (2 * pi) if (upper == 0) upper <- 2 * pi lower <- ( - mu) %% (2 * pi) result[i] <- pvm.mu0(upper, kappa, tol) - pvm.mu0(lower, kappa, tol) } else { upper <- q[i] - mu lower <- mu %% (2 * pi) result[i] <- pvm.mu0(upper, kappa, tol) + pvm.mu0(lower, kappa, tol) } } } return(result) } ############################################################# # # # qvonmises function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: August, 12, 2010 # # Copyright (C) 2010 Claudio Agostinelli # # # # Version 0.2 # ############################################################# qvonmises <- function(p, mu=circular(0), kappa=NULL, from=NULL, tol = .Machine$double.eps^(0.6), control.circular=list(), ...) { epsilon <- 10 * .Machine$double.eps if (any(p>1) | any(p<0)) stop("p must be in [0,1]") if (is.circular(mu)) { datacircularp <- circularp(mu) } else { datacircularp <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") } dc <- control.circular if (is.null(dc$type)) dc$type <- datacircularp$type if (is.null(dc$units)) dc$units <- datacircularp$units if (is.null(dc$template)) dc$template <- datacircularp$template if (is.null(dc$modulo)) dc$modulo <- datacircularp$modulo if (is.null(dc$zero)) dc$zero <- datacircularp$zero if (is.null(dc$rotation)) dc$rotation <- datacircularp$rotation mu <- conversion.circular(mu, units="radians", zero=0, rotation="counter", modulo="2pi") if (is.null(from)) { from <- mu - pi } else { from <- conversion.circular(from, units="radians", zero=0, rotation="counter", modulo="2pi") } attr(mu, "class") <- attr(mu, "circularp") <- NULL attr(from, "class") <- attr(from, "circularp") <- NULL n <- length(p) if (length(mu) != 1) stop("is implemented only for scalar 'mean'") mu <- (mu-from)%%(2*pi) if (is.null(kappa)) stop("kappa must be provided") zeroPvonmisesRad <- function(x, p, mu, kappa) { if (is.na(x)) { y <- NA } else { y <- integrate(DvonmisesRad, mu=mu, kappa=kappa, lower=0, upper=x)$value - p } return(y) } value <- rep(NA, length(p)) sem <- options()$show.error.messages options(show.error.messages=FALSE) for (i in 1:length(p)) { res <- try(uniroot(zeroPvonmisesRad, p=p[i], mu=mu, kappa=kappa, lower=0, upper=2*pi-epsilon, tol=tol)) if (is.list(res)) { value[i] <- res$root } else if (p[i] < 10*epsilon) { value[i] <- 0 } else if (p[i] > 1-10*epsilon) { value[i] <- 2*pi-epsilon } } options(show.error.messages=sem) value <- value + from value <- conversion.circular(circular(value), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) return(value) } ############################################################# # # # dmixedvonmises function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: July, 18, 2011 # # Copyright (C) 2011 Claudio Agostinelli # # # # Version 0.9-2 # ############################################################# dmixedvonmises <- function(x, mu1, mu2, kappa1, kappa2, prop) { if (missing(mu1) || length(mu1)!=1) stop("the mean direction parameter 'mu1' is mandatory and it must have length 1") if (missing(kappa1) || length(kappa1)!=1) stop("the concentration parameter 'kappa1' is mandatory and it must have length 1") if (missing(mu2) || length(mu2)!=1) stop("the mean direction parameter 'mu2' is mandatory and it must have length 1") if (missing(kappa2) || length(kappa2)!=1) stop("the concentration parameter 'kappa2' is mandatory and it must have length 1") if (missing(prop) || length(prop)!=1 || prop > 1 || prop < 0) stop("the proportion parameter 'prop' is mandatory and it must have a value between 0 and 1") x <- conversion.circular(x, units="radians", zero=0, rotation="counter") mu1 <- conversion.circular(mu1, units="radians", zero=0, rotation="counter") mu2 <- conversion.circular(mu2, units="radians", zero=0, rotation="counter") mu1 <- as.vector(mu1) kappa1 <- as.vector(kappa1) mu2 <- as.vector(mu2) kappa2 <- as.vector(kappa2) if (kappa1 < 0) stop("the concentration parameter 'kappa1' must be non negative") if (kappa2 < 0) stop("the concentration parameter 'kappa2' must be non negative") attr(x, "class") <- attr(x, "circularp") <- NULL attr(mu1, "class") <- attr(mu1, "circularp") <- NULL attr(mu2, "class") <- attr(mu2, "circularp") <- NULL DmixedvonmisesRad(x, mu1, mu2, kappa1, kappa2, prop) } DmixedvonmisesRad <- function(x, mu1, mu2, kappa1, kappa2, prop) { vm <- prop/(2 * pi * besselI(x=kappa1, nu=0, expon.scaled = TRUE)) * (exp(cos(x - mu1) - 1))^kappa1 + (1 - prop)/(2 * pi * besselI(x=kappa2, nu=0, expon.scaled = TRUE)) * (exp(cos(x - mu2) - 1))^kappa2 return(vm) } ############################################################# # # # rmixedvonmises function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: July, 18, 2011 # # Copyright (C) 2011 Claudio Agostinelli # # # # Version 0.2-6 # ############################################################# rmixedvonmises <- function(n, mu1, mu2, kappa1, kappa2, prop, control.circular=list()) { if (missing(mu1) || length(mu1)!=1) stop("the mean direction parameter 'mu1' is mandatory and it must have length 1") if (missing(kappa1) || length(kappa1)!=1) stop("the concentration parameter 'kappa1' is mandatory and it must have length 1") if (missing(mu2) || length(mu2)!=1) stop("the mean direction parameter 'mu2' is mandatory and it must have length 1") if (missing(kappa2) || length(kappa2)!=1) stop("the concentration parameter 'kappa2' is mandatory and it must have length 1") if (missing(prop) || length(prop)!=1 || prop > 1 || prop < 0) stop("the proportion parameter 'prop' is mandatory and it must have a value between 0 and 1") if (is.circular(mu1)) { datacircularp <- circularp(mu1) } else if (is.circular(mu2)) { datacircularp <- circularp(mu2) } else { datacircularp <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") } dc <- control.circular if (is.null(dc$type)) dc$type <- datacircularp$type if (is.null(dc$units)) dc$units <- datacircularp$units if (is.null(dc$template)) dc$template <- datacircularp$template if (is.null(dc$modulo)) dc$modulo <- datacircularp$modulo if (is.null(dc$zero)) dc$zero <- datacircularp$zero if (is.null(dc$rotation)) dc$rotation <- datacircularp$rotation mu1 <- conversion.circular(mu1, units="radians", zero=0, rotation="counter") mu2 <- conversion.circular(mu2, units="radians", zero=0, rotation="counter") mu1 <- as.vector(mu1) kappa1 <- as.vector(kappa1) mu2 <- as.vector(mu2) kappa2 <- as.vector(kappa2) if (kappa1 < 0) stop("the concentration parameter 'kappa1' must be non negative") if (kappa2 < 0) stop("the concentration parameter 'kappa2' must be non negative") attr(mu1, "class") <- attr(mu1, "circularp") <- NULL attr(mu2, "class") <- attr(mu2, "circularp") <- NULL vm <- RmixedvonmisesRad(n, mu1, mu2, kappa1, kappa2, prop) vm <- conversion.circular(circular(vm), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) return(vm) } RmixedvonmisesRad <- function(n, mu1, mu2, kappa1, kappa2, prop) { result <- rep(NA, n) test <- runif(n) n1 <- sum(test < prop) n2 <- n - n1 res1 <- RvonmisesRad(n1, mu1, kappa1) res2 <- RvonmisesRad(n2, mu2, kappa2) result[test < prop] <- res1 result[test >= prop] <- res2 return(result) } ############################################################# # # # pmixedvonmises function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: July, 18, 2011 # # Copyright (C) 2011 Claudio Agostinelli # # # # Version 0.1 # ############################################################# pmixedvonmises <- function(q, mu1, mu2, kappa1, kappa2, prop, from=NULL, tol = 1e-020) { if (missing(mu1) || length(mu1)!=1) stop("the mean direction parameter 'mu1' is mandatory and it must have length 1") if (missing(kappa1) || length(kappa1)!=1) stop("the concentration parameter 'kappa1' is mandatory and it must have length 1") if (missing(mu2) || length(mu2)!=1) stop("the mean direction parameter 'mu2' is mandatory and it must have length 1") if (missing(kappa2) || length(kappa2)!=1) stop("the concentration parameter 'kappa2' is mandatory and it must have length 1") if (missing(prop) || length(prop)!=1 || prop > 1 || prop < 0) stop("the proportion parameter 'prop' is mandatory and it must have a value between 0 and 1") q <- conversion.circular(q, units="radians", zero=0, rotation="counter") mu1 <- conversion.circular(mu1, units="radians", zero=0, rotation="counter") mu2 <- conversion.circular(mu2, units="radians", zero=0, rotation="counter") mu1 <- as.vector(mu1) kappa1 <- as.vector(kappa1) mu2 <- as.vector(mu2) kappa2 <- as.vector(kappa2) if (kappa1 < 0) stop("the concentration parameter 'kappa1' must be non negative") if (kappa2 < 0) stop("the concentration parameter 'kappa2' must be non negative") attr(q, "class") <- attr(q, "circularp") <- NULL attr(mu1, "class") <- attr(mu1, "circularp") <- NULL attr(mu2, "class") <- attr(mu2, "circularp") <- NULL if (is.null(from)) { from <- 0 } else { from <- conversion.circular(from, units="radians", zero=0, rotation="counter", modulo="2pi") } mu1 <- (mu1-from)%%(2*pi) mu2 <- (mu2-from)%%(2*pi) q <- (q-from)%%(2*pi) p <- prop*PvonmisesRad(q, mu1, kappa1, tol)+(1-prop)*PvonmisesRad(q, mu2, kappa2, tol) return(p) } circular/R/Calpha.R0000644000176200001440000001117411312211537013572 0ustar liggesusersCalpha <- function(x, n, alpha) { #x is the observed R (resultant length) if (n==1) stop('We are not able to provide sensible results for n=1') I2n <- function(x, n, lower=NULL, upper=NULL) { if (is.null(lower)) lower <- 0 if (is.null(upper)) { if (n < 1500) upper <- 100+10000/n else upper <- 50+10000/n } #x is R here while in the next x is the variable of integration temp <- function(x, n, lower, upper) { f1 <- integrate(function(x, R, n) besselJ(x, 0)^n*besselJ(R*x, 0)*x, lower=lower, upper=upper-2*0.99*log(n), R=x, n=n, subdivisions=4000, stop.on.error=FALSE)$value f2 <- integrate(function(x, R, n) besselJ(x, 0)^n*besselJ(R*x, 0)*x, lower=lower, upper=upper-0.99*log(n), R=x, n=n, subdivisions=4000, stop.on.error=FALSE)$value f3 <- integrate(function(x, R, n) besselJ(x, 0)^n*besselJ(R*x, 0)*x, lower=lower, upper=upper, R=x, n=n, subdivisions=4000, stop.on.error=FALSE)$value f4 <- integrate(function(x, R, n) besselJ(x, 0)^n*besselJ(R*x, 0)*x, lower=lower, upper=upper+0.99*log(n), R=x, n=n, subdivisions=4000, stop.on.error=FALSE)$value f5 <- integrate(function(x, R, n) besselJ(x, 0)^n*besselJ(R*x, 0)*x, lower=lower, upper=upper+2*0.99*log(n), R=x, n=n, subdivisions=4000, stop.on.error=FALSE)$value median(c(f1,f2,f3,f4,f5)) } sapply(X=x, FUN=temp, n=n, lower=lower, upper=upper) } I3n <- function(x, n, lower=NULL, upper=NULL) { if (is.null(lower)) lower <- 0 if (is.null(upper)) { #### upper <- approx(x=c(4, 5, 10, 13, 15, 20, 28, 50, 60, 75, 100, 250, 500, 1000, 2000, 5000), y=c(6000, 2000, 1250, 1000, 700, 600, 500, 400, 350, 300, 250, 200, 150, 90, 70, 50), xout=n, method='constant', yleft=6000, yright=40, rule=2, f=1)$y #### lma <- lm(I(y[-(1:2)]~I(1/x[-(1:2)])) #### upper <- 114.3+10856.2/n if (n < 1500) upper <- 100+10000/n else upper <- 50+10000/n } #x is the C part here while in the next x is the variable of integration temp <- function(x, n, lower, upper) { f1 <- integrate(function(x, C, n) besselJ(x, 0)^n*cos(C*x), lower=lower, upper=upper-2*0.99*log(n+1), C=x, n=n, subdivisions=4000, stop.on.error=FALSE)$value f2 <- integrate(function(x, C, n) besselJ(x, 0)^n*cos(C*x), lower=lower, upper=upper-0.99*log(n+1), C=x, n=n, subdivisions=4000, stop.on.error=FALSE)$value f3 <- integrate(function(x, C, n) besselJ(x, 0)^n*cos(C*x), lower=lower, upper=upper, C=x, n=n, subdivisions=4000, stop.on.error=FALSE)$value f4 <- integrate(function(x, C, n) besselJ(x, 0)^n*cos(C*x), lower=lower, upper=upper+0.99*log(n+1), C=x, n=n, subdivisions=4000, stop.on.error=FALSE)$value f5 <- integrate(function(x, C, n) besselJ(x, 0)^n*cos(C*x), lower=lower, upper=upper+2*0.99*log(n+1), C=x, n=n, subdivisions=4000, stop.on.error=FALSE)$value median(c(f1,f2,f3,f4,f5)) } sapply(X=x, temp, n=n, lower=lower, upper=upper) } lhs <- function(x, R, n) { #x is the Calpha temp <- function(x, R, n) { integrate(function(x, C, n) x/sqrt(x^2-C^2)*I2n(x, n), lower=R, upper=n, C=x, n=n, subdivisions=4000, stop.on.error=FALSE)$value } sapply(X=x, FUN=temp, R=R, n=n) } equat <- function(x, R, n, alpha) { lhs(x=x, R=R, n=n) - alpha*I3n(x=x, n=n) } temp <- function(x, n, alpha) { uniroot(equat, lower=0, upper=x, R=x, n=n, alpha=alpha)$root } sapply(X=x, FUN=temp, n=n, alpha=alpha) } delta <- function(x, n=50, alpha=0.05) { temp <- function(x, n, alpha) acos(Calpha(x*n, n, alpha)/(x*n)) sapply(x, temp, n=n, alpha=alpha) } Calphaapprox <- function(x, n, alpha) { if (n<3) stop('We are not able to provide sensible results for n<3') temp <- function(x, n, alpha) { if (n >=15 & x > 0 & x < n/3) { y <- sqrt(x^2-qchisq(alpha, df=1, lower.tail=FALSE)*0.5*n) #3.2 } else if (x > n/2 & x < 3*n/4) { ff <- qf(alpha, df1=2, df2=2*n-2, lower.tail=FALSE) y <- x - ff*(n-x)/(n-1) #3.3 } else if (x > 5/6*n) { ff <- qf(alpha, df1=1, df2=n-1, lower.tail=FALSE) y <- x - ff*(n-x)/(n-1) #3.4 } else { y <- NA } return(y) } sapply(X=x, FUN=temp, n=n, alpha=alpha) } deltaapprox <- function(x, n=50, alpha=0.05) { temp <- function(x, n, alpha) acos(Calphaapprox(x*n, n, alpha)/(x*n)) sapply(x, temp, n=n, alpha=alpha) } # plot(delta, from=0.2, to=0.6, xlim=c(0,1), ylim=c(0, 90)) #abline(h=seq(0,90,10), lty=2) #abline(v=seq(0,1,0.1), lty=2) #sequat <- function(x) sapply(X=x, FUN=equat, R=50*0.6, n=50, alpha=0.05) #temp <- function(x, C, n) x/sqrt(x^2-C^2)*I2n(x, n) #plot(function(x) temp, C=1, n=50, from=0, to=50) circular/R/A1SecondDerivative.R0000644000176200001440000000023612065027044016023 0ustar liggesusersA1SecondDerivative <- function(kappa) { result <- A1(kappa=kappa)/kappa^2 - A1FirstDerivative(kappa=kappa)*(2*A1(kappa=kappa)+(1/kappa)) return(result) } circular/R/lm.circular.cl.R0000644000176200001440000001413011312211537015205 0ustar liggesusers ############################################################# # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################# ############################################################# # # # lm.circular.cl function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: July, 25, 2006 # # Version: 0.2-2 # # # # Copyright (C) 2006 Claudio Agostinelli # # # ############################################################# lm.circular.cl <- function(y, x, init=NULL, verbose=FALSE, tol=1e-10, control.circular=list()) { # Handling missing values ok <- complete.cases(x, y) if (NCOL(x)==1) { x <- x[ok] } else { x <- x[ok,] } y <- y[ok] if ((n <- length(y))==0) { warning("No observations (at least after removing missing values)") return(NULL) } if (is.null(init)) stop("'init' is missing with no default") if (is.vector(x)) x <- cbind(x) if (NCOL(x)!=length(init)) stop("'init' must have the same number of elements as the columns of 'x'") if (is.circular(y)) { datacircularp <- circularp(y) } else { datacircularp <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") } dc <- control.circular if (is.null(dc$type)) dc$type <- datacircularp$type if (is.null(dc$units)) dc$units <- datacircularp$units if (is.null(dc$template)) dc$template <- datacircularp$template if (is.null(dc$modulo)) dc$modulo <- datacircularp$modulo if (is.null(dc$zero)) dc$zero <- datacircularp$zero if (is.null(dc$rotation)) dc$rotation <- datacircularp$rotation y <- conversion.circular(y, units="radians", zero=0, rotation="counter", modulo="2pi") attr(y, "circularp") <- attr(y, "class") <- NULL result <- LmCircularclRad(y, x, init, verbose, tol) result$mu <- conversion.circular(circular(result$mu), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) if (dc$units=="degrees") result$se.mu <- result$se.mu*180/pi result$call <- match.call() class(result) <- "lm.circular.cl" return(result) } LmCircularclRad <- function(y, x, init, verbose, tol) { n <- length(y) y <- y%%(2*pi) betaPrev <- init S <- sum(sin(y-2*atan(x%*%betaPrev)))/n C <- sum(cos(y-2*atan(x%*%betaPrev)))/n R <- sqrt(S^2 + C^2) mu <- atan2(S,C) k <- A1inv(R) diff <- tol+1 iter <- 0 while (diff > tol){ iter <- iter + 1 u <- k*sin(y - mu - 2*atan(x%*%betaPrev)) A <- diag(k*A1(k), nrow=n) g.p <- diag(apply(x, 1, function(row, betaPrev) 2/(1+(t(betaPrev)%*%row)^2), betaPrev=betaPrev), nrow=n) D <- g.p%*%x betaNew <- lm(t(D)%*%(u+A%*%D%*%betaPrev) ~ t(D)%*%A%*%D - 1)$coefficients diff <- max(abs(betaNew - betaPrev)) betaPrev <- betaNew S <- sum(sin(y-2*atan(x%*%betaPrev)))/n C <- sum(cos(y-2*atan(x%*%betaPrev)))/n R <- sqrt(S^2 + C^2) mu <- atan2(S,C) k <- A1inv(R) if (verbose){ log.lik <- -n*log(besselI(x = k, nu = 0, expon.scaled = FALSE)) + k*sum(cos(y-mu-2*atan(x%*%betaNew))) cat("Iteration ", iter, ": Log-Likelihood = ", log.lik, "\n") } } log.lik <- -n*log(besselI(x = k, nu = 0, expon.scaled = FALSE)) + k*sum(cos(y-mu-2*atan(x%*%betaNew))) cov.beta <- solve(t(D)%*%A%*%D) se.beta <- sqrt(diag(cov.beta)) se.kappa <- sqrt(1/(n*(1-A1(k)^2-A1(k)/k))) se.mu <- 1/sqrt((n-ncol(x))*k*A1(k)) t.values <- abs(betaNew/se.beta) p.values <- 1-pnorm(t.values) betaNew <- as.vector(betaNew) result <- list() result$x <- x result$y <- y result$mu <- mu result$se.mu <- se.mu result$kappa <- k result$se.kappa <- se.kappa result$coefficients <- betaNew result$cov.coef <- cov.beta result$se.coef <- se.beta result$log.lik <- log.lik result$t.values <- t.values result$p.values <- p.values return(result) } ############################################################# # # # print.lm.circular.cl function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: April, 27, 2005 # # Version: 0.2 # # # # Copyright (C) 2005 Claudio Agostinelli # # # ############################################################# print.lm.circular.cl <- function(x, digits = max(3, getOption("digits") - 3), signif.stars= getOption("show.signif.stars"), ...) { cat("\nCall:\n",deparse(x$call),"\n\n",sep="") result.matrix <- cbind(x$coefficients, x$se.coef, x$t.values, x$p.values) dimnames(result.matrix) <- list(names(x$x),c("Estimate", "Std. Error", "t value", "Pr(>|t|)")) cat("\n Circular-Linear Regression \n") cat("\n Coefficients:\n") printCoefmat(result.matrix, digits=digits, signif.stars=signif.stars, ...) cat("\n") cat(" Log-Likelihood: ", format(x$log.lik, digits=digits), "\n") cat("\n Summary: (mu in radians)\n") cat(" mu: ", format(x$mu, digits=digits), "(", format(x$se.mu, digits=digits), ") kappa: ", format(x$kappa, digits=digits), "(", format(x$se.kappa, digits=digits), ")\n") cat("p-values are approximated using normal distribution\n\n") invisible(x) } circular/R/make.circular.link.R0000644000176200001440000000362012234225021016050 0ustar liggesusers##################################################################### # # # make.circular.link function # # Author: Claudio Agostinelli and Alessandro Gagliardi # # Email: claudio@unive.it # # Date: April, 08, 2013 # # Copyright (C) 2013 Claudio Agostinelli and Alessandro Gagliardi # # # # Version 0.1-2 # ##################################################################### make.circular.link <- function (link) { switch(link, tan = { linkfun <- function(mu) tan(mu/2) linkinv <- function(eta) 2*atan(eta) mu.eta <- function(eta) 2/(eta^2 + 1) valideta <- function(eta) TRUE }, log = { linkfun <- function(mu) log(mu) linkinv <- function(eta) exp(eta) mu.eta <- function(eta) exp(eta) valideta <- function(eta) TRUE }, probit = { ## see Mardia and Jupp (2000) pag. 258 linkfun <- function(mu) qnorm(mu/(2*pi) + 0.5) linkinv <- function(eta) { thresh <- -qnorm(.Machine$double.eps) eta <- pmin(pmax(eta, -thresh), thresh) 2*pi*(pnorm(eta) - 0.5) } mu.eta <- function(eta) 2*pi*pmax(dnorm(eta), .Machine$double.eps) valideta <- function(eta) TRUE }, identity = { linkfun <- function(mu) mu linkinv <- function(eta) eta mu.eta <- function(eta) rep(1, length(eta)) valideta <- function(eta) TRUE }, ## else : stop(gettextf("%s link not recognised", sQuote(link)), domain = NA) )# end switch(.) structure(list(linkfun = linkfun, linkinv = linkinv, mu.eta = mu.eta, valideta = valideta, name = link), class="link-cm") } circular/R/pp.plot.R0000644000176200001440000000502411312211537013773 0ustar liggesusers ############################################################# # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################# ############################################################# # # # pp.plot function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: August, 10, 2006 # # Copyright (C) 2006 Claudio Agostinelli # # # # Version 0.2-1 # ############################################################# pp.plot <- function(x, ref.line = TRUE, tol=1e-20, xlab = "von Mises Distribution", ylab = "Empirical Distribution", control.circular=list(), ...) { # Handling missing values x <- na.omit(x) if (length(x)==0) { warning("No observations (at least after removing missing values)") return(NULL) } if (is.circular(x)) { datacircularp <- circularp(x) } else { datacircularp <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") } dc <- control.circular if (is.null(dc$type)) dc$type <- datacircularp$type if (is.null(dc$units)) dc$units <- datacircularp$units if (is.null(dc$template)) dc$template <- datacircularp$template if (is.null(dc$modulo)) dc$modulo <- datacircularp$modulo if (is.null(dc$zero)) dc$zero <- datacircularp$zero if (is.null(dc$rotation)) dc$rotation <- datacircularp$rotation x <- conversion.circular(x, units="radians", zero=0, rotation="counter", modulo="2pi") attr(x, "class") <- attr(x, "circularp") <- NULL res <- MlevonmisesRad(x) mu <- res[1] kappa <- res[4] n <- length(x) # x <- sort(x %% (2 * pi)) x <- sort(x) z <- (1:n)/(n + 1) y <- PvonmisesRad(q=x, mu=mu, kappa=kappa, tol=tol) plot.default(z, y, xlab=xlab, ylab=ylab, ...) if (ref.line) abline(0, 1) mu <- conversion.circular(circular(res[1]), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) invisible(list(mu=mu, kappa=kappa)) } circular/R/kuiper.test.R0000644000176200001440000000716311312211537014662 0ustar liggesusers ############################################################# # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################# ############################################################# # # # kuiper.test function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: May, 27, 2006 # # Version: 0.3 # # # # Copyright (C) 2006 Claudio Agostinelli # # # ############################################################# kuiper.test <- function(x, alpha=0) { # Handling missing values x <- na.omit(x) if (length(x)==0) { warning("No observations (at least after removing missing values)") return(NULL) } x <- conversion.circular(x, units="radians", zero=0, rotation="counter", modulo="2pi") attr(x, "circularp") <- attr(x, "class") <- NULL result <- list() result$call <- match.call() result$statistic <- KuiperTestRad(x, alpha) result$alpha <- alpha class(result) <- "kuiper.test" return(result) } KuiperTestRad <- function(x, alpha) { if (!any(c(0, 0.01, 0.025, 0.05, 0.1, 0.15)==alpha)) stop("'alpha' must be one of the following values: 0, 0.01, 0.025, 0.05, 0.1, 0.15") x <- sort(x %% (2 * pi))/(2 * pi) n <- length(x) i <- 1:n D.P <- max(i/n - x) D.M <- max(x - (i - 1)/n) V <- (D.P + D.M) * (sqrt(n) + 0.155 + 0.24/sqrt(n)) return(V) } ############################################################# # # # print.kuiper.test function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: November, 19, 2003 # # Version: 0.1-1 # # # # Copyright (C) 2003 Claudio Agostinelli # # # ############################################################# print.kuiper.test <- function(x, digits=4, ...) { V <- x$statistic alpha <- x$alpha kuiper.crits <- cbind(c(0.15, 0.1, 0.05, 0.025, 0.01), c(1.537, 1.62, 1.747, 1.862, 2.001)) cat("\n", " Kuiper's Test of Uniformity", "\n", "\n") cat("Test Statistic: ", round(V, digits=digits), "\n") if (alpha == 0) { if (V < 1.537) cat("P-value > 0.15", "\n", "\n") else if (V < 1.62) cat("0.10 < P-value < 0.15", "\n", "\n") else if (V < 1.747) cat("0.05 < P-value < 0.10", "\n", "\n") else if (V < 1.862) cat("0.025 < P-value < 0.05", "\n", "\n") else if (V < 2.001) cat("0.01 < P-value < 0.025", "\n", "\n") else cat("P-value < 0.01", "\n", "\n") } else { Critical <- kuiper.crits[(1:5)[alpha == c(kuiper.crits[, 1])],2] cat("Level", alpha, "Critical Value:", round(Critical, 4), "\n") if (V > Critical) cat("Reject Null Hypothesis", "\n", "\n") else cat("Do Not Reject Null Hypothesis", "\n", "\n") } invisible(x) } circular/R/heatmap.circular.R0000644000176200001440000001575412640040536015640 0ustar liggesusers############################################################# # # # heatmap.circular function # # Author: Claudio Agostinelli # # E-mail: claudio.agostinelli@unitn.it # # Date: December, 27, 2015 # # Version: 0.8 # # # # Copyright (C) 2015 Claudio Agostinelli # # # ############################################################# ## This is a modified version of the heatmap function in package stats. ## The original heatmap function is made by Andy Liaw; modified RG, MM : ############################################################# heatmap.circular <- function (x, Rowv=NULL, Colv=if(symm)"Rowv" else NULL, distfun = dist.circular, hclustfun = hclust, reorderfun = function(d,w) reorder(d,w), add.expr, symm = FALSE, revC = identical(Colv, "Rowv"), na.rm=TRUE, margins = c(5, 5), lwid=c(1,4), lhei=c(1,4), ColSideColors, RowSideColors, NAColors="black", cexRow = 0.2 + 1/log10(nr), cexCol = 0.2 + 1/log10(nc), labRow = NULL, labCol = NULL, main = NULL, xlab = NULL, ylab = NULL, keep.dendro = FALSE, annotate.expr, annotate=rep(NA, 4), verbose = getOption("verbose"), ...) { if(length(di <- dim(x)) != 2 || !is.numeric(x)) stop("'x' must be a numeric matrix") nr <- di[1] nc <- di[2] if(nr <= 1 || nc <= 1) stop("'x' must have at least 2 rows and 2 columns") if(!is.numeric(margins) || length(margins) != 2) stop("'margins' must be a numeric vector of length 2") doRdend <- !identical(Rowv,NA) doCdend <- !identical(Colv,NA) ## by default order by row/col means if(is.null(Rowv)) Rowv <- rowMeans(x, na.rm = na.rm) if(is.null(Colv)) Colv <- colMeans(x, na.rm = na.rm) ## get the dendrograms and reordering indices if(doRdend) { if(inherits(Rowv, "dendrogram")) ddr <- Rowv else { hcr <- hclustfun(distfun(x)) ddr <- as.dendrogram(hcr) if(!is.logical(Rowv) || Rowv) ddr <- reorderfun(ddr, Rowv) } if(nr != length(rowInd <- order.dendrogram(ddr))) stop("row dendrogram ordering gave index of wrong length") } else rowInd <- 1L:nr if(doCdend) { if(inherits(Colv, "dendrogram")) ddc <- Colv else if(identical(Colv, "Rowv")) { if(nr != nc) stop('Colv = "Rowv" but nrow(x) != ncol(x)') ddc <- ddr } else { hcc <- hclustfun(distfun(if(symm)x else t(x))) ddc <- as.dendrogram(hcc) if(!is.logical(Colv) || Colv) ddc <- reorderfun(ddc, Colv) } if(nc != length(colInd <- order.dendrogram(ddc))) stop("column dendrogram ordering gave index of wrong length") } else colInd <- 1L:nc ## reorder x x <- x[rowInd, colInd] labRow <- if(is.null(labRow)) if(is.null(rownames(x))) (1L:nr)[rowInd] else rownames(x) else labRow[rowInd] labCol <- if(is.null(labCol)) if(is.null(colnames(x))) (1L:nc)[colInd] else colnames(x) else labCol[colInd] ## Calculate the plot layout lmat <- rbind(c(NA, 3), 2:1) lwid <- c(if(doRdend) lwid[1] else 0.05, lwid[2]) lhei <- c((if(doCdend) lhei[1] else 0.05) + if(!is.null(main)) 0.2 else 0, lhei[2]) if(!missing(ColSideColors)) { ## add middle row to layout if(!is.character(ColSideColors) || length(ColSideColors) != nc) stop("'ColSideColors' must be a character vector of length ncol(x)") lmat <- rbind(lmat[1,]+1, c(NA,1), lmat[2,]+1) lhei <- c(lhei[1], 0.2, lhei[2]) } if(!missing(RowSideColors)) { ## add middle column to layout if(!is.character(RowSideColors) || length(RowSideColors) != nr) stop("'RowSideColors' must be a character vector of length nrow(x)") lmat <- cbind(lmat[,1]+1, c(rep(NA, nrow(lmat)-1), 1), lmat[,2]+1) lwid <- c(lwid[1], 0.2, lwid[2]) } # Annotate setup if (!is.na(annotate[1])) { lmat <- rbind(lmat, c(rep(NA, ncol(lmat)-1), max(lmat, na.rm=TRUE)+1)) lhei <- c(lhei, annotate[1]) } if (!is.na(annotate[3])) { lmat <- rbind(c(rep(NA, ncol(lmat)-1), max(lmat, na.rm=TRUE)+1), lmat) lhei <- c(annotate[3], lhei) } if (!is.na(annotate[2])) { lmat <- cbind(c(rep(NA, nrow(lmat)-1-!is.na(annotate[1])), max(lmat, na.rm=TRUE)+1, rep(NA, !is.na(annotate[1]))), lmat) lwid <- c(annotate[2], lwid) } for (i in 4:length(annotate)) { if (!is.na(annotate[i])) { lmat <- cbind(lmat, c(rep(NA, nrow(lmat)-1-!is.na(annotate[1])), max(lmat, na.rm=TRUE)+1, rep(NA, !is.na(annotate[1])))) lwid <- c(lwid, annotate[i]) } } lmat[is.na(lmat)] <- 0 if(verbose) { cat("layout: widths = ", lwid, ", heights = ", lhei,"; lmat=\n") print(lmat) } ## Graphics `output' ----------------------- op <- par(no.readonly = TRUE) on.exit(par(op)) layout(lmat, widths = lwid, heights = lhei, respect = TRUE) ## draw the side bars if(!missing(RowSideColors)) { par(mar = c(margins[1],0, 0,0.5)) image(rbind(1L:nr), col = RowSideColors[rowInd], axes = FALSE) } if(!missing(ColSideColors)) { par(mar = c(0.5,0, 0,margins[2])) image(cbind(1L:nc), col = ColSideColors[colInd], axes = FALSE) } ## draw the main carpet par(mar = c(margins[1], 0, 0, margins[2])) if(!symm) x <- t(x) if(revC) { # x columns reversed iy <- nr:1 ddr <- rev(ddr) x <- x[,iy] } else iy <- 1L:nr image(1L:nc, 1L:nr, x, xlim = 0.5+ c(0, nc), ylim = 0.5+ c(0, nr), axes = FALSE, xlab = "", ylab = "", zlim=c(0,2*pi), ...) xna <- is.na(x) mode(xna) <- "numeric" xna[xna==0] <- NA image(1L:nc, 1L:nr, xna, col=NAColors, add=TRUE) axis(1, 1L:nc, labels= labCol, las= 2, line= -0.5, tick= 0, cex.axis= cexCol) if(!is.null(xlab)) mtext(xlab, side = 1, line = margins[1] - 1.25) axis(4, iy, labels= labRow, las= 2, line= -0.5, tick= 0, cex.axis= cexRow) if(!is.null(ylab)) mtext(ylab, side = 4, line = margins[2] - 1.25) if (!missing(add.expr)) eval.parent(substitute(add.expr)) ## the two dendrograms : par(mar = c(margins[1], 0, 0, 0)) if(doRdend) plot(ddr, horiz = TRUE, axes = FALSE, yaxs = "i", leaflab = "none") else frame() par(mar = c(0, 0, if(!is.null(main)) 1 else 0, margins[2])) if(doCdend) plot(ddc, axes = FALSE, xaxs = "i", leaflab = "none") else if(!is.null(main)) frame() ## title if(!is.null(main)) title(main, cex.main = 1.5*op[["cex.main"]]) par(mar = c(0, 0, 0, margins[2])) if (!is.na(annotate[1])) eval(annotate.expr[[1]]) if (!is.na(annotate[3])) eval(annotate.expr[[3]]) par(mar = c(margins[1], 0, 0, 0)) if (!is.na(annotate[2])) eval(annotate.expr[[2]]) for (i in 4:length(annotate)) { if (!is.na(annotate[i])) eval(annotate.expr[[i]]) } invisible(list(rowInd = rowInd, colInd = colInd, Rowv = if(keep.dendro && doRdend) ddr, Colv = if(keep.dendro && doCdend) ddc )) } circular/R/katojones.R0000644000176200001440000001224012017360366014402 0ustar liggesusers############################################################# # # # rkatojones function # # Author: Federico Rotolo, # # original code from Kato, S. and Jones, M.C. # # Email: federico.rotolo@stat.unipd.it # # Date: October, 23, 2010 # # Copyright (C) 2010 Federico Rotolo # # # # Version # ############################################################# rkatojones <- function(n, mu=NULL, nu=NULL, r=NULL, kappa=NULL, control.circular=list()) { if (is.null(mu) || length(mu)!=1) stop("the mean direction parameter 'mu' is mandatory and it must have length 1") if (is.null(nu) || length(nu)!=1) stop("the parameter 'nu' is mandatory and it must have length 1") if (is.null(r) || length(r)!=1) stop("the parameter 'r' is mandatory and it must have length 1") if (is.null(kappa) || length(kappa)!=1) stop("the parameter 'kappa' is mandatory and it must have length 1") if((r<0)||(r>=1)){stop("'r' must be in [0,1)")} if(kappa<0){stop("'kappa' must be not negative")} if (is.circular(mu)) { datacircularp <- circularp(mu) } else { datacircularp <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") } dc <- control.circular if (is.null(dc$type)) dc$type <- datacircularp$type if (is.null(dc$units)) dc$units <- datacircularp$units if (is.null(dc$template)) dc$template <- datacircularp$template if (is.null(dc$modulo)) dc$modulo <- datacircularp$modulo if (is.null(dc$zero)) dc$zero <- datacircularp$zero if (is.null(dc$rotation)) dc$rotation <- datacircularp$rotation mu <- conversion.circular(mu, units="radians", zero=0, rotation="counter") mu <- as.vector(mu) nu <- conversion.circular(nu, units="radians", zero=0, rotation="counter") nu <- as.vector(nu) r <- as.vector(r) kappa <- as.vector(kappa) attr(mu, "class") <- attr(mu, "circularp") <- NULL attr(nu, "class") <- attr(nu, "circularp") <- NULL vm <- rkatojonesRad(n, mu, nu, r, kappa) vm <- conversion.circular(circular(vm), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) return(vm) } rkatojonesRad <- function(n, mu, nu, r, kappa) { x <- vector(length = n) if (kappa) { t <- NULL j <- 1 a <- 1 + sqrt(1 + 4 * kappa^2) b <- (a - sqrt(2 * a)) / (2 * kappa) zeta <- (1 + b^2) / (2 * b) while (j <= n) { u <- runif(2) z <- cos(pi * u[1]) f <- (zeta * z + 1) / (zeta + z) con <- kappa * (zeta - f) if ((con * (2 - con) - u[2] > 0) || (log(con / u[2]) + 1 - con >= 0)) { u3 <- runif(1) t[j] <- sign(u3 - 0.5) * acos(f) j <- j+1 } } } else { t <- runif(n, min = -pi, max = pi) } vm <- mu + nu + 2 * atan((1-r) / (1+r) * tan((t-nu) / 2)) vm <- Arg(exp((1i) * vm)) return(vm) } ############################################################# # # # dkatojones function # # Author: Federico Rotolo # # Email: federico.rotolo@stat.unipd.it # # Date: October, 05, 2010 # # Copyright (C) 2010 Federico Rotolo # # # # Version # ############################################################# dkatojones <-function(x, mu=NULL, nu=NULL, r=NULL, kappa=NULL){ if (is.null(mu) || length(mu)!=1) stop("the mean direction parameter 'mu' is mandatory and it must have length 1") if (is.null(nu) || length(nu)!=1) stop("the parameter 'nu' is mandatory and it must have length 1") if (is.null(r) || length(r)!=1) stop("the parameter 'r' is mandatory and it must have length 1") if (is.null(kappa) || length(kappa)!=1) stop("the parameter 'kappa' is mandatory and it must have length 1") if((r<0)||(r>=1)){stop("'r' must be in [0,1)")} if(kappa<0){stop("'kappa' must be not negative")} x <- conversion.circular(x, units="radians", zero=0, rotation="counter") mu <- conversion.circular(mu, units="radians", zero=0, rotation="counter") nu <- conversion.circular(nu, units="radians", zero=0, rotation="counter") mu <- as.vector(mu) nu <- as.vector(nu) kappa <- as.vector(kappa) r <- as.vector(r) attr(x, "class") <- attr(x, "circularp") <- NULL attr(mu, "class") <- attr(mu, "circularp") <- NULL attr(nu, "class") <- attr(nu, "circularp") <- NULL DkatojonesRad(x, mu, nu, r, kappa) } DkatojonesRad <-function(x, mu, nu, r, kappa){ gamma<-mu+nu den <- 2*pi*besselI(kappa,0) * (1+r^2-2*r*cos(x-gamma)) xi<-(r^4+2*r^2*cos(2*nu)+1)^.5 eta<-mu+Arg(r^2*cos(2*nu)+r^2*sin(2*nu)*1i+1) num<-(1-r^2)*exp((kappa*(xi*cos(x-eta)-2*r*cos(nu)))/(1+r^2-2*r*cos(x-gamma))) return(num/den) } circular/R/totalvariation.R0000644000176200001440000001156012025550376015452 0ustar liggesusers############################################################# # # totalvariation.circular # GNU General Public Licence 2.0 # Author: Claudio Agostinelli # E-mail: claudio@unive.it # Date: September, 17, 2012 # Version: 0.6 # # Copyright (C) 2012 Claudio Agostinelli # ############################################################# totalvariation.circular <- function(x, y, z=NULL, q=0.95, bw, adjust = 1, type = c("K", "L"), kernel = c("vonmises", "wrappednormal"), na.rm = FALSE, step=0.001, eps.lower=10^(-4), eps.upper=10^(-4), ...) { if (is.null(z)) z <- circular(seq(0,2*pi+step,step)) x <- conversion.circular(x, units="radians", zero=0, rotation="counter", modulo="2pi") y <- conversion.circular(y, units="radians", zero=0, rotation="counter", modulo="2pi") z <- conversion.circular(z, units="radians", zero=0, rotation="counter", modulo="asis") modalx <- modal.region.circular(x=x, z=z, q=q, bw=bw, adjust=adjust, type=type, kernel=kernel, na.rm=na.rm, step=step, eps.lower=eps.lower, eps.upper=eps.upper, ...) modaly <- modal.region.circular(x=y, z=z, q=q, bw=bw, adjust=adjust, type=type, kernel=kernel, na.rm=na.rm, step=step, eps.lower=eps.lower, eps.upper=eps.upper, ...) zerosx <- modalx$zeros areasx <- modalx$areas$tot zerosy <- modaly$zeros nx <- nrow(zerosx) ny <- nrow(zerosy) areasy <- modaly$areas$tot denx <- modalx$density deny <- modaly$density denx <- denx$y/areasx deny <- deny$y/areasy denx[z < zerosx[1,1]] <- 0 if (nx > 1) { for (i in 1:(nx-1)) { denx[z > zerosx[i,2] & z < zerosx[i+1,1]] <- 0 } } denx[z > zerosx[nx, 2]] <- 0 deny[z < zerosy[1,1]] <- 0 if (ny > 1) { for (i in 1:(ny-1)) { deny[z > zerosy[i,2] & z < zerosy[i+1,1]] <- 0 } } deny[z > zerosy[ny, 2]] <- 0 den <- ifelse(denx > deny, denx-deny, 0) denmax <- approxfun(x=z, y=den) tv <- 0 ## byhand <- 0 for (i in 1:nx) { ## byhand <- byhand + step*sum(den[z >= zerosx[i,1] & z <= zerosx[i,2]]) tv <- tv + integrate(denmax, lower=zerosx[i,1]+step, upper=zerosx[i,2]-step)$value } result <- list() result$tv <- tv result$ovl <- 1 - tv ## result$byhand <- byhand result$q <- q result$bw <- bw result$modal.x <- modalx result$modal.y <- modaly result$density.x <- approxfun(x=z, y=denx) result$density.y <- approxfun(x=z, y=deny) result$density <- denmax class(result) <- 'totalvariation.circular' return(result) } plot.totalvariation.circular <- function(x, tv=TRUE, ovl=TRUE, units=c('radians', 'degrees', 'hours'), xlab=NULL, ylab=NULL, main=NULL, from=0, to=2*pi, add=FALSE, n=1000, polygon.control.tv=list(), polygon.control.ovl=list(), xlty=1, ylty=1, xcol=1, ycol=1, xlwd=1, ylwd=1, axes=TRUE, ...) { units <- match.arg(units) if (is.null(xlab)) xlab <- paste('bw=', round(x$bw, 3), sep='') if (is.null(ylab)) ylab <- 'Kernel density estimates' if (is.null(main)) main <- 'Common area under the curves' polygon.control.default <- list(density = NULL, angle = 45, border = NA, col = NA, lty = par("lty"), fillOddEven = FALSE) npc.tv <- names(polygon.control.tv) npc.ovl <- names(polygon.control.ovl) npcd <- names(polygon.control.default) polygon.control.tv <- c(polygon.control.tv, polygon.control.default[setdiff(npcd, npc.tv)]) polygon.control.ovl <- c(polygon.control.ovl, polygon.control.default[setdiff(npcd, npc.ovl)]) if (add==TRUE) plot(x$density.x, from=from, to=to, add=TRUE, n=n, xlab=xlab, ylab=ylab, main=main, lty=xlty, col=xcol, lwd=xlwd, ...) else { plot(x$density.x, from=from, to=to, add=FALSE, axes=FALSE, n=n, xlab=xlab, ylab=ylab, main=main, lty=xlty, col=xcol, lwd=xlwd, ...) if (axes) { axis(2) if (units=='degrees') { labels <- c(0, 45, 90, 135, 180, 225, 270, 315, 360) at <- labels*pi/180 } else if (units=='hours') { labels <- c(0, 3, 6, 9, 12, 15, 18, 21, 24) at <- labels*pi/12 } else { labels <- NULL at <- axTicks(1) } axis(1, at=at, labels=labels) } } plot(x$density.y, from=from, to=to, add=TRUE, n=n, lty=ylty, col=ycol, lwd=ylwd, ...) z <- seq(from, to, length.out=n) denmin <- pmin(x$density.x(z), x$density.y(z)) denmax <- pmax(x$density.x(z), x$density.y(z)) if (tv) polygon(x=c(from, z, to, rev(z), from), y=c(0, denmin, 0, rev(denmax), 0), density = polygon.control.tv$density, angle = polygon.control.tv$angle, border = polygon.control.tv$border, col = polygon.control.tv$col, lty = polygon.control.tv$lty, fillOddEven = polygon.control.tv$fillOddEven) if (ovl) polygon(x=c(from, z, to, from), y=c(0,denmin, 0, 0), density = polygon.control.ovl$density, angle = polygon.control.ovl$angle, border = polygon.control.ovl$border, col = polygon.control.ovl$col, lty = polygon.control.ovl$lty, fillOddEven = polygon.control.ovl$fillOddEven) abline(v=c(x$modal.x$zeros), lty=2) abline(v=c(x$modal.y$zeros), lty=2) invisible(x) } circular/R/axialvonmises.R0000644000176200001440000000226211312211537015262 0ustar liggesusers ############################################################# # # # daxialvonmises function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: May, 24, 2006 # # Copyright (C) 2006 Claudio Agostinelli # # # # Version 0.2 # ############################################################# daxialvonmises <- function (x, mu, kappa, l=2) { if (l<=0) stop("'l' must be non negative") x <- conversion.circular(x, units="radians", zero=0, rotation="counter") mu <- conversion.circular(mu, units="radians", zero=0, rotation="counter") attr(x, "class") <- attr(x, "circularp") <- NULL attr(mu, "class") <- attr(mu, "circularp") <- NULL DaxialvonmisesRad(x, mu, kappa, l) } DaxialvonmisesRad <- function(x, mu, kappa, l=2) { d <- l/(2 * pi * besselI(x = kappa, nu = 0, expon.scaled = TRUE)) * (exp(cos(l*(x - mu))-1))^kappa return(d) } circular/R/stephens.test.R0000644000176200001440000000046011312211537015205 0ustar liggesusersStephensTestRad <- function(x, mu=0, alpha) { n <- length(x) Muobs <- MeanCircularRad(x) Robs <- RhoCircularRad(x)*n Cobs <- Robs*cos(Muobs-mu) Rcrit <- Ralpha(x=Cobs, n=n, alpha=alpha) test <- TRUE if (Robs > Rcrit) test <- FALSE result <- c(test, Robs, Cobs, Rcrit) return(result) } circular/R/plot.circular.R0000644000176200001440000001166012371161660015172 0ustar liggesusers############################################################# # # # plot.circular function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: August, 08, 2014 # # Version: 0.7 # # # # Copyright (C) 2014 Claudio Agostinelli # # # ############################################################# plot.circular <- function(x, pch=16, cex=1, stack=FALSE, axes=TRUE, start.sep=0, sep=0.025, shrink=1, bins=NULL, ticks=FALSE, tcl=0.025, tcl.text=0.125, col=NULL, tol=0.04, uin=NULL, xlim=c(-1, 1), ylim=c(-1, 1), digits=2, units=NULL, template=NULL, zero=NULL, rotation=NULL, main=NULL, sub=NULL, xlab="", ylab="", control.circle=circle.control(), ...) { if (is.matrix(x) | is.data.frame(x)) { nseries <- ncol(x) } else { nseries <- 1 } xx <- as.data.frame(x) xcircularp <- attr(as.circular(xx[,1]), "circularp") type <- xcircularp$type modulo <- xcircularp$modulo if (is.null(units)) units <- xcircularp$units if (is.null(template)) template <- xcircularp$template if (template=="geographics" | template=="clock24") { zero <- pi/2 rotation <- "clock" } else if (template=="clock12") { zero <- pi/2 rotation <- "clock" } else { if (is.null(zero)) zero <- xcircularp$zero if (is.null(rotation)) rotation <- xcircularp$rotation } CirclePlotRad(xlim=xlim, ylim=ylim, uin=uin, shrink=shrink, tol=tol, main=main, sub=sub, xlab=xlab, ylab=ylab, control.circle=control.circle) if (is.null(bins)) { bins <- NROW(x) } else { bins <- round(bins) if (bins<=0) stop("bins must be non negative") } if (is.null(col)) { col <- seq(nseries) } else { if (length(col)!=nseries) { col <- rep(col, nseries)[1:nseries] } } pch <- rep(pch, nseries, length.out=nseries) if (!is.logical(ticks)) stop("ticks must be logical") if (axes) { axis.circular(at=NULL, labels=NULL, units=units, template=template, modulo="2pi", zero=zero, rotation=rotation, tick=ticks, cex=cex, tcl=tcl, tcl.text=tcl.text, digits=digits) } if (axes==FALSE & ticks) { at <- circular((0:bins)/bins*2*pi, zero=zero, rotation=rotation) ticks.circular(at, tcl=tcl) } for (iseries in 1:nseries) { x <- xx[,iseries] x <- na.omit(x) n <- length(x) if (n) { x <- conversion.circular(x, units="radians", modulo="2pi") attr(x, "circularp") <- attr(x, "class") <- NULL if (rotation=="clock") x <- -x if (template=="clock12") x <- 2*x x <- x+zero x <- x%%(2*pi) PointsCircularRad(x, bins, stack, col, pch, iseries, nseries, start.sep, sep, 0, shrink, cex, ...) } } return(invisible(list(zero=zero, rotation=rotation, next.points=nseries*sep))) } CirclePlotRad <- function(xlim=c(-1,1), ylim=c(-1,1), uin=NULL, shrink=1, tol=0.04, main=NULL, sub=NULL, xlab=NULL, ylab=NULL, control.circle=circle.control()) { xlim <- shrink * xlim ylim <- shrink * ylim midx <- 0.5 * (xlim[2] + xlim[1]) xlim <- midx + (1 + tol) * 0.5 * c(-1, 1) * (xlim[2] - xlim[1]) midy <- 0.5 * (ylim[2] + ylim[1]) ylim <- midy + (1 + tol) * 0.5 * c(-1, 1) * (ylim[2] - ylim[1]) oldpin <- par("pin") xuin <- oxuin <- oldpin[1]/diff(xlim) yuin <- oyuin <- oldpin[2]/diff(ylim) if (is.null(uin)) { if (yuin > xuin) yuin <- xuin else xuin <- yuin } else { if (length(uin) == 1) uin <- uin * c(1, 1) if (any(c(xuin, yuin) < uin)) stop("uin is too large to fit plot in") xuin <- uin[1]; yuin <- uin[2] } xlim <- midx + oxuin/xuin * c(-1, 1) * diff(xlim) * 0.5 ylim <- midy + oyuin/yuin * c(-1, 1) * diff(ylim) * 0.5 n <- control.circle$n x <- cos(seq(0, 2 * pi, length = n)) y <- sin(seq(0, 2 * pi, length = n)) axes <- FALSE log <- "" xaxs <- "i" yaxs <- "i" ann <- par("ann") frame.plot <- axes panel.first <- NULL panel.last <- NULL asp <- NA plot.default(x=x, y=y, type=control.circle$type, xlim=xlim, ylim=ylim, log="", main=main, sub=sub, xlab=xlab, ylab=ylab, ann=ann, axes=axes, frame.plot=frame.plot, panel.first=panel.first, panel.last=panel.last, asp=asp, col=control.circle$col, bg=control.circle$bg, pch=control.circle$pch, cex=control.circle$cex, lty=control.circle$lty, lwd=control.circle$lwd) } circle.control <- function(n=1000, type='l', col=1, bg=par('bg'), pch=1, cex=1, lty=1, lwd=1) { x <- list(n=n, type=type, col=col, bg=bg, pch=pch, cex=cex, lty=lty, lwd=lwd) return(x) } circular/R/I.p.R0000644000176200001440000000011011312211537013014 0ustar liggesusers I.p <- function(p, x) { besselI(x=x, nu=p, expon.scaled = FALSE) } circular/R/change.point.R0000644000176200001440000000443511312211537014761 0ustar liggesusers ############################################################# # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################# ############################################################# # # # change.point function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: May, 26, 2006 # # Copyright (C) 2006 Claudio Agostinelli # # # # Version 0.2 # ############################################################# change.point <- function(x) { x <- conversion.circular(x, units="radians", zero=0, rotation="counter", modulo="2pi") attr(x, "class") <- attr(x, "circularp") <- NULL ChangePointRad(x) } ChangePointRad <- function(x) { phi <- function(x) { arg <- A1inv(x) if (besselI(x=arg, nu=0, expon.scaled = FALSE) != Inf) result <- x * A1inv(x) - log(besselI(x=arg, nu=0, expon.scaled = FALSE)) else result <- x * A1inv(x) - (arg + log(1/sqrt(2 * pi * arg) * (1 + 1/(8 * arg) + 9/(128 * arg^2) + 225/(1024 * arg^3)))) return(result) } n <- length(x) rho <- RhoCircularRad(x) R1 <- 1:n R2 <- 1:n V <- 1:n for (k in 1:(n - 1)) { R1[k] <- RhoCircularRad(x[1:k]) * k R2[k] <- RhoCircularRad(x[(k + 1):n]) * (n - k) if (k >= 2 & k <= (n - 2)) { V[k] <- k/n * phi(R1[k]/k) + (n - k)/n * phi(R2[k]/(n - k)) } } R1[n] <- rho * n R2[n] <- 0 R.diff <- R1 + R2 - rho * n rmax <- max(R.diff) rave <- mean(R.diff) k.r <- (1:n)[R.diff == max(R.diff)] V <- V[2:(n - 2)] if (n > 3) { tmax <- max(V) tave <- mean(V) k.t <- (1:(n - 3))[V == max(V)] + 1 } else stop("Sample size must be at least 4") return(list(n=n, rho=rho, rmax=rmax, k.r=k.r, rave=rave, tmax=tmax, k.t=k.t, tave=tave)) } circular/R/curve.circular.R0000644000176200001440000000566511312211537015341 0ustar liggesusers############################################################# # # # curve.circular function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: April, 02, 2009 # # Version: 0.2 # # # # Copyright (C) 2009 Claudio Agostinelli # # # ############################################################# # For now the function can use only this coordinate system: units="radians", zero=0, rotation="counter" curve.circular <- function(expr, from=NULL, to=NULL, n=101, add=FALSE, cex=1, axes=TRUE, ticks=FALSE, shrink=1, tcl=0.025, tcl.text=0.125, tol=0.04, uin=NULL, xlim=c(-1, 1), ylim=c(-1, 1), digits=2, modulo=c("2pi", "asis", "pi"), main=NULL, sub=NULL, xlab="", ylab="", control.circle=circle.control(), ...) { modulo <- match.arg(modulo) sexpr <- substitute(expr) if (is.name(sexpr)) { fcall <- paste(sexpr, "(x)") expr <- parse(text=fcall) } else { if(!(is.call(sexpr) && match("x", all.vars(sexpr), nomatch=0))) stop("'expr' must be a function or an expression containing 'x'") expr <- sexpr } if (is.null(from)) from <- 0 if (is.null(to)) to <- 2*pi-3*.Machine$double.eps x <- circular(seq(from, to, length=n), modulo=modulo) y <- eval(expr, envir=list(x = x), enclos=parent.frame()) attr(y, "circularp") <- attr(y, "class") <- NULL if (!add) { CirclePlotRad(xlim=xlim, ylim=ylim, uin=uin, shrink=shrink, tol=tol, main=main, sub=sub, xlab=xlab, ylab=ylab, control.circle=control.circle) if (axes) { axis.circular(units="radians", template="none", zero=0, rotation="counter", digits=digits, cex=cex, tcl=tcl, tcl.text=tcl.text) } if (ticks) { at <- circular(seq(0, 2*pi, length.out=(ticks+1)), zero=0, rotation="counter") ticks.circular(at, tcl=tcl) } } lines.circular(x, y, ...) } ############################################################# # # # plot.function.circular function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: May, 31, 2006 # # Version: 0.1 # # # # Copyright (C) 2006 Claudio Agostinelli # # # ############################################################# plot.function.circular <- function(x, from = 0, to = 2*pi, ...) { curve.circular(x, from, to, ...) } circular/R/sd.circular.R0000644000176200001440000000502212017352115014607 0ustar liggesusers sd <- function(x, ...) UseMethod("sd") sd.default <- function(x, na.rm = FALSE, ...) stats::sd(x=x, na.rm=na.rm) sd.data.frame <- function(x, ...) { sapply(x, sd, ...) } ############################################################## # # # sd.circular function # # Author: Claudio Agostinelli and Jean-Olivier Irisson # # Email: claudio@unive.it # # Date: June, 24, 2011 # # Copyright (C) 2011 Claudio Agostinelli # # # # As defined in # # Mardia, KV. Statistics of directional data. 1972 # # Formula actually taken from # # Zar, JH. Biostatistical analysis. 2010, 26.5, p 617 # # # # Version 0.3 # ############################################################## sd.circular <- function (x, na.rm=FALSE, ...) { if (is.matrix(x)) { # NB: matrices cannot be handled by a method because a matrix of circular data would have "circular" as its first class apply(x, 2, sd.circular, na.rm=na.rm) } else { # Remove missing values if (na.rm) { x <- x[!is.na(x)] } # Checks if (length(x) == 0) { warning("No observations (at least after removing missing values)") return(NA) } # Possibly set and then get the circular attributes of the input data if (!is.circular(x)) { x <- circular(x) } datacircularp <- circularp(x) # Compute the standard deviation x <- conversion.circular(x, units="radians", zero=0, rotation="counter") attr(x, "class") <- attr(x, "circularp") <- NULL s <- SdCircularRad(x=x) # Determine circular attributes of interest for the result, # based on the attributes of the data and on control.circular ## dc <- control.circular ## if (is.null(dc$type)) ## dc$type <- datacircularp$type ## if (is.null(dc$units)) ## dc$units <- datacircularp$units ## # Convert the standard deviation into the appropriate circular class ## s <- conversion.circular(circular(s), units=dc$units, type=dc$type, template="none", modulo="2pi", zero=0, rotation="counter") return(s) } } SdCircularRad <- function(x) { rbar <- RhoCircularRad(x) circsd <- sqrt(-2*log(rbar)) return(circsd) } circular/R/axis.circular.R0000644000176200001440000001152214475660255015170 0ustar liggesusers############################################################# # # # axis.circular function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: October, 04, 2012 # # Version: 0.7 # # # # Copyright (C) 2012 Claudio Agostinelli # # and Alessandro Gagliardi # # # ############################################################# axis.circular <- function(at=NULL, labels=NULL, units = NULL, template=NULL, modulo=NULL, zero=NULL, rotation=NULL, tick=TRUE, lty, lwd, cex, col, font, tcl=0.025, tcl.text=0.125, digits=2) { if (missing(cex)) cex <- par("cex.axis") if (missing(col)) col <- par("col.axis") if (missing(font)) font <- par("font.axis") if (missing(lty)) lty <- par("lty") if (missing(lwd)) lwd <- par("lwd") if (is.null(at)) { if (is.null(template) | template=="none" | template=="geographics") { at <- circular(c(0, pi/2, pi, 3/2*pi),rotation=rotation,zero=zero) } else if (template=="clock24") { at <- circular(seq(0, 23), units="hours",rotation=rotation,zero=zero) units <- "hours" } else if (template=="clock12") { at <- circular(seq(0, 11), units="hours",rotation=rotation,zero=zero) units <- "hours" } } at <- na.omit(at) atcircularp <- attr(as.circular(at), "circularp") type <- atcircularp$type if (is.null(modulo)) modulo <- atcircularp$modulo if (is.null(units)) units <- atcircularp$units if (is.null(template)) template <- atcircularp$template if (template=="geographics" | template=="clock24") { zero <- pi/2 rotation <- "clock" } else if (template=="clock12") { zero <- pi/2 rotation <- "clock" } else { if (is.null(zero)) zero <- atcircularp$zero if (is.null(rotation)) rotation <- atcircularp$rotation } atasis <- at attr(atasis, "circularp") <- attr(atasis, "class") <- NULL attext <- atasis/pi if (modulo=="2pi") { if (units=="radians") { atasis <- atasis%%(2*pi) } else if (units=="degrees") { atasis <- atasis%%(360) } else if (units=="hours") { atasis <- atasis%%(24) } attext <- attext%%2 } else if (modulo=="pi") { if (units=="radians") { atasis <- atasis%%pi } else if (units=="degrees") { atasis <- atasis%%180 } else if (units=="hours") { atasis <- atasis%%12 } attext <- attext%%1 } attext <- round(attext, digits=digits) if (template=="clock12") at <- 2*at at <- conversion.circular(at, units="radians", modulo="2pi", zero=0, rotation="counter") attr(at, "circularp") <- attr(at, "class") <- NULL ## if (rotation=="clock") ## at <- -at ## at <- at+zero if (is.null(labels)) { if (length(atasis)==4 && all(atasis==c(0, pi/2, pi, 3/2*pi))) { if (template=="geographics") { labels <- c("N", "E", "S", "W") } else { if (units=="radians") { labels <- c("0", expression(frac(pi,2)), expression(pi), expression(frac(3*pi,2))) } else if (units=="degrees") { labels <- c("0", "90", "180", "270") } } } else if (length(atasis)==12 && all(atasis==0:11) && template=="clock12") { labels <- c("0/12", "1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11") } else if (length(atasis)==24 && all(atasis==0:23) && template=="clock24") { labels <- c("0/24", "1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23") } else if (units=="radians") { labels <- as.character(round(atasis, digits=digits)) } else if (units=="degrees") { labels <- as.character(round(atasis, digits=digits)) } else if (units=="hours") { labels <- as.character(round(atasis, digits=digits)) } } if (!is.null(labels) && length(at)!=length(labels)) stop("'at' and 'labels' must have the same length") AxisCircularRad(at, units, labels, attext, tick, tcl, tcl.text, cex, col, lty, lwd) } AxisCircularRad <- function(at, units, labels, attext, tick, tcl, tcl.text, cex, col, lty, lwd) { #### at must be in radians, counter, zero=0 r <- 1+tcl*c(-1/2,1/2) r.l <- 1-tcl.text z <- cos(at) y <- sin(at) for (i in 1:length(at)) { if (tick) { lines.default(z[i]*r, y[i]*r, col=col, lty=lty, lwd=lwd) } if (is.null(labels)) { labeltext <- substitute(at*pi, list(at=attext[i])) } else { labeltext <- labels[i] } text.default(z[i]*r.l, y[i]*r.l, labeltext, cex=cex, col=col) } text(0, 0, "+", cex=1) } circular/R/medianaxis.circular.R0000644000176200001440000000377412017360533016342 0ustar liggesusersmedianaxis <- function(x, na.rm, ...) UseMethod("medianaxis") medianaxis.default <- function(x, na.rm, ...) .NotYetImplemented() ############################################################# # # medianaxis.circular function # Author: Claudio Agostinelli and Alessandro Gagliardi # E-mail: claudio@unive.it # Date: August, 3, 2011 # Version: 0.1 # # Copyright (C) 2012 Claudio Agostinelli and Alessandro Gagliardi # ############################################################# medianaxis.circular <- function(x, na.rm=FALSE, ...) { if (na.rm) x <- x[!is.na(x)] if (length(x)==0) { warning("No observations (at least after removing missing values)") return(NULL) } if (is.circular(x)) { dc <- circularp(x) } else { dc <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") } x <- conversion.circular(x, units="radians", zero=0, rotation="counter") attr(x, "class") <- attr(x, "circularp") <- NULL circmedianaxis <- MedianAxisCircularRad(x) circmedianaxis <- conversion.circular(circular(circmedianaxis$medianaxis), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) return(circmedianaxis) } MedianAxisCircularRad <- function(x) { n <- length(x) y <- c(x, x+pi) y <- sort(y %% (2*pi)) if (odd <- as.logical(n%%2)) { ## odd number of observations ismedianaxis <- rep(FALSE, n) for (i in 1:length(x)) { z <- MinusPiPlusPiRad((x-x[i])%%(2*pi)) pos <- sum(z > 0 & z != pi) neg <- sum(z < 0 & z !=-pi) zero <- sum(z==0) atpi <- sum(z==pi | z==-pi) ### ismedianaxis[i] <- pos == (neg) } } else { ## even number of observations eps <- min(diff(y), y[1]+(2*pi-y[2*n]))/4 } } circular/R/projectednormal.R0000644000176200001440000000712314211356542015600 0ustar liggesusers############################################################# # # # rpnorm function # # Author: Claudio Agostinelli # # Email: claudio.agostinelli@unitn.it # # Date: March, 07, 2022 # # Copyright (C) 2022 Claudio Agostinelli # # # # Version 0.1-1 # ############################################################# rpnorm <- function(n, mu, sigma, control.circular=list()) { if (missing(mu) || length(mu)!=2) stop("the mean direction parameter 'mu' is mandatory and it must have length 1") if (missing(sigma) || !all(dim(sigma)==c(2,2))) stop("the variance matrix parameter 'Sigma' is mandatory and it must be a matrix of dimension 2 by 2") datacircularp <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") dc <- control.circular if (is.null(dc$type)) dc$type <- datacircularp$type if (is.null(dc$units)) dc$units <- datacircularp$units if (is.null(dc$template)) dc$template <- datacircularp$template if (is.null(dc$modulo)) dc$modulo <- datacircularp$modulo if (is.null(dc$zero)) dc$zero <- datacircularp$zero if (is.null(dc$rotation)) dc$rotation <- datacircularp$rotation mu <- as.vector(mu) pn <- RpnormRad(n, mu, sigma) pn <- conversion.circular(circular(pn), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) return(pn) } RpnormRad <- function(n, mu, sigma) { x <- rmvnorm(n=n, mean=mu, sigma=sigma) x <- apply(x, 1, function(z) z/sqrt(z[1]^2+z[2]^2)) theta <- apply(x, 2, function(z) atan2(z[2],z[1])) theta <- theta%%(2*pi) return(theta) } ############################################################# # # # dpnorm function # # Author: Claudio Agostinelli # # Email: claudio.agostinelli@unitn.it # # Date: March, 07, 2022 # # Copyright (C) 2022 Claudio Agostinelli # # # # Version 0.1-1 # ############################################################# dpnorm <- function (x, mu, sigma, log=FALSE) { if (missing(mu) || length(mu)!=2) stop("the mean direction parameter 'mu' is mandatory and it must have length 2") if (missing(sigma) || !all(dim(sigma)==c(2,2))) stop("the variance matrix parameter 'sigma' is mandatory and it must be a matrix of dimension 2 by 2") if (!is.logical(log)) stop("'log' must be logical") x <- conversion.circular(x, units="radians", zero=0, rotation="counter") mu <- as.vector(mu) attr(x, "class") <- attr(x, "circularp") <- NULL DpnormRad(x, mu, sigma, log) } DpnormRad <- function(x, mu, sigma, log=FALSE) { ### Wang and Gelfand (2013) Statistical Methodology sigma1 <- sqrt(sigma[1,1]) sigma2 <- sqrt(sigma[2,2]) rho <- sigma[1,2]/(sigma1*sigma2) a <- 1/(sigma1*sigma2*sqrt(1-rho^2)) C <- a^2*(sigma2^2*cos(x)^2-rho*sigma1*sigma2*sin(2*x)+sigma1^2*sin(x)^2) D <- a^2*(mu[1]*sigma2*(sigma2*cos(x)-rho*sigma1*sin(x))+mu[2]*sigma1*(sigma1*sin(x)-rho*sigma2*cos(x)))/sqrt(C) den <- dmvnorm(mu, c(0,0), sigma)/C+a*D*pnorm(D)*dnorm(a*(mu[1]*sin(x)-mu[2]*cos(x))/sqrt(C))/C if (log) { den <- log(den) } return(den) } circular/R/density.circular.R0000644000176200001440000003327612371162151015676 0ustar liggesusers############################################################# # # # density.circular function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # date: February, 14, 2013 # # Copyright (C) 2013 Claudio Agostinelli # # # # Version 0.3-1 # # # ############################################################# density.circular <- function(x, z=NULL, bw, adjust = 1, type = c("K", "L"), kernel= c("vonmises", "wrappednormal"), na.rm = FALSE, from=circular(0), to=circular(2*pi), n=512, K=NULL, min.k=10, control.circular=list(), ...) { name <- deparse(substitute(x)) data <- x if (!is.numeric(from)) stop("argument 'from' must be numeric") if (!is.numeric(to)) stop("argument 'to' must be numeric") if (!is.finite(from)) stop("non-finite `from'") if (!is.finite(to)) stop("non-finite `to'") if (!is.numeric(n)) stop("argument 'n' must be numeric") n <- round(n) if (n <=0) stop("argument 'n' must be integer and positive") if (!is.numeric(x)) stop("argument 'x' must be numeric") if (!is.null(z) && is.circular(z)) { datacircularp <- circularp(z) } else if (is.circular(x)) datacircularp <- circularp(x) else { datacircularp <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") } dc <- control.circular if (is.null(dc$type)) dc$type <- datacircularp$type if (is.null(dc$units)) dc$units <- datacircularp$units if (is.null(dc$template)) dc$template <- datacircularp$template if (is.null(dc$modulo)) dc$modulo <- datacircularp$modulo if (is.null(dc$zero)) dc$zero <- datacircularp$zero if (is.null(dc$rotation)) dc$rotation <- datacircularp$rotation if (dc$modulo=="pi") stop("The function does not work yet for modulo='pi'") x <- conversion.circular(x, units="radians", zero=0, rotation="counter") attr(x, "class") <- attr(x, "circularp") <- NULL from <- conversion.circular(from, units="radians", zero=0, rotation="counter") attr(from, "class") <- attr(from, "circularp") <- NULL to <- conversion.circular(to, units="radians", zero=0, rotation="counter") attr(to, "class") <- attr(to, "circularp") <- NULL kernel <- match.arg(kernel) x <- as.vector(x) x.na <- is.na(x) if (any(x.na)) { if (na.rm) x <- x[!x.na] else stop("x contains missing values") } x.finite <- is.finite(x) if (any(!x.finite)) { x <- x[x.finite] } nx <- length(x) if (is.null(z)) { z <- circular(seq(from=from, to=to, length=n)) } else { if (!is.numeric(z)) stop("argument 'z' must be numeric") namez <- deparse(substitute(z)) z.na <- is.na(z) if (any(z.na)) { if (na.rm) { z <- z[!z.na] } else { stop("z contains missing values") } } z.finite <- is.finite(z) if (any(!z.finite)) { z <- z[z.finite] } } zz <- conversion.circular(z, dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) z <- conversion.circular(z, units="radians", zero=0, rotation="counter") attr(z, "class") <- attr(z, "circularp") <- NULL z <- as.vector(z) bw <- adjust * bw if (!is.numeric(bw)) stop("argument 'bw' and 'adjust' must be numeric") if (!is.finite(bw)) stop("non-finite `bw'") if (bw <= 0) stop("`bw' is not positive.") y <- DensityCircularRad(x=x, z=z, bw=bw, kernel=kernel, K=K, min.k=min.k) structure(list(data = data, x = zz, y = y, bw = bw, n = nx, kernel=kernel, call = match.call(), data.name=name, has.na = FALSE), class = "density.circular") } DensityCircularRad <- function(x, z, bw, kernel, K=NULL, min.k=10) { nx <- length(x) if (kernel=="vonmises") { y <- sapply(z, DvonmisesRad, mu=x, kappa=bw, log=FALSE) } else if (kernel=="wrappednormal") { rho <- exp(-bw^2/2) y <- sapply(z, DwrappednormalRad, mu=x, rho=rho, K=K, min.k=min.k) } else { stop("other kernels not implemented yet") } y <- apply(y, 2, sum)/nx return(y) } ############################################################# # # # plot.density.circular function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: July, 22, 2011 # # Copyright (C) 2011 Claudio Agostinelli # # # # Version 0.5-12 # # # ############################################################# plot.density.circular <- function(x, main = NULL, sub=NULL, xlab = NULL, ylab ="Density circular", type = "l", zero.line = TRUE, points.plot=FALSE, points.col=1, points.pch=1, points.cex=1, plot.type = c("circle", "line"), axes=TRUE, ticks=FALSE, bins=NULL, offset=1, shrink=1, tcl=0.025, tcl.text=0.125, sep=0.025, tol = 0.04, digits=2, cex=1, uin=NULL, xlim=NULL, ylim=NULL, join=FALSE, nosort=FALSE, units=NULL, template=NULL, zero=NULL, rotation=NULL, control.circle=circle.control(), ...) { xcircularp <- attr(x$x, "circularp") if (is.null(xcircularp)) stop("the component 'x' of the object must be of class circular") ## type <- xcircularp$type modulo <- xcircularp$modulo if (is.null(units)) units <- xcircularp$units if (is.null(template)) template <- xcircularp$template if (template=="geographics" | template=="clock24") { zero <- pi/2 rotation <- "clock" } else if (template=="clock12") { zero <- pi/2 rotation <- "clock" modulo <- "pi" } else { if (is.null(zero)) zero <- xcircularp$zero if (is.null(rotation)) rotation <- xcircularp$rotation } next.points <- 0 if (template=="clock12") { x$x <- 2*x$x x$data <- 2*x$data } x$x <- conversion.circular(x$x, units="radians", modulo="2pi") x$data <- conversion.circular(x$data, units="radians", modulo="2pi") attr(x$x, "class") <- attr(x$x, "circularp") <- NULL attr(x$data, "class") <- attr(x$data, "circularp") <- NULL plot.type <- match.arg(plot.type) if (is.null(xlab)) xlab <- paste("N =", x$n, " Bandwidth =", formatC(x$bw), " Unit =", units) if (is.null(main)) main <- deparse(x$call) #### as scatter plot if (plot.type == "line") { if (units=='degrees') { x$x <- x$x/pi*180 x$data <- x$data/pi*180 } if (units=='hours') { x$x <- x$x/pi*12 x$data <- x$data/pi*12 } if (is.null(xlim)) xlim <- range(c(x$x, x$data)) if (is.null(ylim)) { ylim <- range(x$y) if (points.plot) ylim[1] <- ylim[1]-0.04*points.cex } xorder <- order(x$x) x$x <- x$x[xorder] x$y <- x$y[xorder] plot.default(x, type = type, xlim=xlim, ylim=ylim, main=main, xlab=xlab, ylab=ylab, axes=axes, ...) if (zero.line) abline(h = 0, lwd = 0.2, col = "gray") if (points.plot) points(x$data, rep(ylim[1]+0.02*points.cex, length(x$data)), col=points.col, pch=points.pch, cex=points.cex) return(NULL) } else { #### as circular plot if (is.null(xlim)) xlim <- c(-1, 1) if (is.null(ylim)) ylim <- c(-1, 1) if (is.null(bins)) { bins <- NROW(x) } else { bins <- round(bins) if (bins<=0) stop("'bins' must be non negative") } CirclePlotRad(xlim=xlim, ylim=ylim, uin=uin, shrink=shrink, tol=tol, main=main, sub=sub, xlab=xlab, ylab=ylab, control.circle=control.circle) if (!is.logical(ticks)) stop("ticks must be logical") if (axes) { axis.circular(at=NULL, labels=NULL, units=units, template=template, modulo=modulo, zero=zero, rotation=rotation, tick=ticks, cex=cex, tcl=tcl, tcl.text=tcl.text, digits=digits) } if (axes==FALSE & ticks) { at <- circular((0:bins)/bins*2*pi, zero=zero, rotation=rotation) ticks.circular(at, tcl=tcl) } if (rotation=="clock") x$x <- -x$x x$x <- x$x+zero x$x <- x$x%%(2*pi) ll <- LinesCircularRad(x=x$x, y=x$y, join=join, nosort=nosort, offset=offset, shrink=shrink, ...) if (points.plot) { next.points <- sep if (rotation=="clock") x$data <- -x$data x$data <- x$data+zero x$data <- x$data%%(2*pi) PointsCircularRad(x$data, bins, FALSE, points.col, points.pch, 1, 1, 0, sep, next.points, shrink, points.cex) } return(invisible(list(x=ll$x, y=ll$y, zero=zero, rotation=rotation, next.points=next.points))) } } ############################################################# # # # lines.density.circular function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: July, 5, 2011 # # Copyright (C) 2010 Claudio Agostinelli # # # # Version 0.5-1 # # # ############################################################# lines.density.circular <- function(x, type = "l", zero.line = TRUE, points.plot=FALSE, points.col=1, points.pch=1, points.cex=1, plot.type = c("circle", "line"), bins=NULL, offset=1, shrink=1, tcl=0.025, sep=0.025, join=TRUE, nosort=FALSE, plot.info=NULL, zero=NULL, rotation=NULL, ...) { xcircularp <- attr(x$x, "circularp") if (is.null(xcircularp)) stop("the component 'x' of the object must be of class circular") ## type <- xcircularp$type modulo <- xcircularp$modulo units <- xcircularp$units template <- xcircularp$template if (is.null(plot.info)) { if (is.null(zero)) { if (template=="geographics" | template=="clock24" | template=="clock12") zero <- pi/2 else zero <- xcircularp$zero } if (is.null(rotation)) { if (template=="geographics" | template=="clock24" | template=="clock12") rotation <- "clock" else rotation <- xcircularp$rotation } next.points <- 0 } else { zero <- plot.info$zero rotation <- plot.info$rotation next.points <- plot.info$next.points } if (template=="clock12") { x$x <- 2*x$x x$data <- 2*x$data } x$x <- conversion.circular(x$x, units="radians") x$data <- conversion.circular(x$data, units="radians") attr(x$x, "circularp") <- attr(x$x, "class") <- NULL attr(x$data, "circularp") <- attr(x$data, "class") <- NULL ll <- list() plot.type <- match.arg(plot.type) if (is.null(bins)) { bins <- NROW(x) } else { bins <- round(bins) if (bins<=0) stop("bins must be non negative") } if (plot.type == "line") { if (units=='degrees') { x$x <- x$x/pi*180 x$data <- x$data/pi*180 } if (units=='hours') { x$x <- x$x/pi*12 x$data <- x$data/pi*12 } xorder <- order(x$x) x$x <- x$x[xorder] x$y <- x$y[xorder] lines.default(x, type = type, ...) if (zero.line) abline(h = 0, lwd = 0.2, col = "gray") if (points.plot) points.default(x$data, rep(min(x$y)-0.02*points.cex, length(x$data)), col=points.col, pch=points.pch) } else { if (rotation=="clock") x$x <- -x$x x$x <- x$x+zero x$x <- x$x%%(2*pi) ll <- LinesCircularRad(x=x$x, y=x$y, join=join, nosort=nosort, offset=offset, shrink=shrink, ...) if (points.plot) { if (rotation=="clock") x$data <- -x$data x$data <- x$data+zero x$data <- x$data%%(2*pi) next.points <- next.points+sep PointsCircularRad(x$data, bins, FALSE, points.col, points.pch, 1, 1, 0, sep, next.points, shrink, points.cex) } } return(invisible(list(x=ll$x, y=ll$y, zero=zero, rotation=rotation, next.points=next.points))) } ############################################################# # # # print.density.circular function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: July, 23, 2003 # # Copyright (C) 2003 Claudio Agostinelli # # # # Version 0.1 # # # ############################################################# print.density.circular <- function(x, digits=NULL, ...) { cat("\nCall:\n\t",deparse(x$call), "\n\nData: ",x$data.name," (",x$n," obs.);", "\tBandwidth 'bw' = ",formatC(x$bw,digits=digits), "\n\n",sep="") print(summary(as.data.frame(x[c("x","y")])), digits=digits, ...) invisible(x) } circular/R/mle.vonmises.R0000644000176200001440000001163511312211537015023 0ustar liggesusers ############################################################# # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################# ############################################################# # # # mle.vonmises function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: August, 10, 2006 # # Copyright (C) 2006 Claudio Agostinelli # # # # Version 0.3-2 # ############################################################# mle.vonmises <- function(x, mu=NULL, kappa=NULL, bias=FALSE, control.circular=list()) { # Handling missing values x <- na.omit(x) if (length(x)==0) { warning("No observations (at least after removing missing values)") return(NULL) } if (is.circular(x)) { datacircularp <- circularp(x) } else if (is.circular(mu)) { datacircularp <- circularp(mu) } else { datacircularp <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") } dc <- control.circular if (is.null(dc$type)) dc$type <- datacircularp$type if (is.null(dc$units)) dc$units <- datacircularp$units if (is.null(dc$template)) dc$template <- datacircularp$template if (is.null(dc$modulo)) dc$modulo <- datacircularp$modulo if (is.null(dc$zero)) dc$zero <- datacircularp$zero if (is.null(dc$rotation)) dc$rotation <- datacircularp$rotation x <- conversion.circular(x, units="radians", zero=0, rotation="counter", modulo="2pi") attr(x, "class") <- attr(x, "circularp") <- NULL if (!is.null(mu)) { mu <- conversion.circular(mu, units="radians", zero=0, rotation="counter", modulo="2pi") attr(mu, "class") <- attr(mu, "circularp") <- NULL } res <- MlevonmisesRad(x, mu, kappa, bias) mu <- conversion.circular(circular(res[1]), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) if (dc$units=="degrees") res[2] <- res[2]*180/pi result <- list() result$call <- match.call() result$mu <- mu result$kappa <- res[4] result$se.mu <- res[2] result$se.kappa <- res[5] result$est.mu <- res[3] result$est.kappa <- res[6] result$bias <- bias class(result) <- "mle.vonmises" return(result) } MlevonmisesRad <- function(x, mu=NULL, kappa=NULL, bias=FALSE) { n <- length(x) sinr <- sum(sin(x)) cosr <- sum(cos(x)) est.mu <- FALSE if (is.null(mu)) { mu <- atan2(sinr, cosr) est.mu <- TRUE } est.kappa <- FALSE if (is.null(kappa)) { V <- mean.default(cos(x - mu)) if (V > 0) { kappa <- A1inv(V) } else { kappa <- 0 } if (bias == TRUE) { if (kappa < 2) { kappa <- max(kappa - 2 * (n * kappa)^-1, 0) } else { kappa <- ((n - 1)^3 * kappa)/(n^3 + n) } } est.kappa <- TRUE } A1temp <- A1(kappa) se.mu <- se.kappa <- 0 if (est.mu) se.mu <- sqrt(1/(n*kappa*A1temp)) if (est.kappa) se.kappa <- sqrt(1/(n*(1-A1temp/kappa-A1temp^2))) result <- c(mu, se.mu, est.mu, kappa, se.kappa, est.kappa) return(result) } ############################################################# # # # print.mle.vonmises function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: May, 22, 2006 # # Version: 0.2 # # # # Copyright (C) 2006 Claudio Agostinelli # # # ############################################################# print.mle.vonmises <- function(x, digits = max(3, getOption("digits") - 3), ...) { cat("\nCall:\n",deparse(x$call),"\n\n",sep="") cat("mu: ") cat(format(x$mu, digits=digits), " (", format(x$se.mu, digits=digits), ")\n") cat("\n") cat("kappa: ") cat(format(x$kappa, digits=digits), " (", format(x$se.kappa, digits=digits), ")\n") cat("\n") if (!x$est.mu) cat("mu is known\n") if (!x$est.kappa) cat("kappa is known\n") if (x$bias) cat("Bias correction (Best and Fisher, 1981) applied to kappa\n") invisible(x) } circular/R/circular.colors.R0000644000176200001440000000155611312211537015511 0ustar liggesusers############################################################# # # circular.colors function # Author: Claudio Agostinelli # E-mail: claudio@unive.it # Date: October, 7, 2007 # Version: 0.7 # # Copyright (C) 2007 Claudio Agostinelli # ############################################################# circular.colors <- function(n, m=0, M=2*pi, offset=0, ...) { hh <- seq(from=(m-offset)%%(2*pi), to=if((M-offset)==2*pi) (M-offset) else (M-offset)%%(2*pi), length.out=n)/(M-m) hsv(h=hh, ...) } circular/R/mle.vonmises.bootstrap.ci.R0000644000176200001440000001244012236415561017435 0ustar liggesusers ############################################################# # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################# ############################################################# # # # mle.vonmises.bootstrap.ci function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: November, 06, 2013 # # Copyright (C) 2013 Claudio Agostinelli # # # # Version 0.3-3 # ############################################################# mle.vonmises.bootstrap.ci <- function(x, mu=NULL, bias = FALSE, alpha = 0.05, reps = 1000, control.circular=list()) { # Handling missing values x <- na.omit(x) if (length(x)==0) { warning("No observations (at least after removing missing values)") return(NULL) } if (is.circular(x)) { datacircularp <- circularp(x) } else if (is.circular(mu)) { datacircularp <- circularp(mu) } else { datacircularp <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") } dc <- control.circular if (is.null(dc$type)) dc$type <- datacircularp$type if (is.null(dc$units)) dc$units <- datacircularp$units if (is.null(dc$template)) dc$template <- datacircularp$template if (is.null(dc$modulo)) dc$modulo <- datacircularp$modulo if (is.null(dc$zero)) dc$zero <- datacircularp$zero if (is.null(dc$rotation)) dc$rotation <- datacircularp$rotation x <- conversion.circular(x, units="radians", zero=0, rotation="counter", modulo="2pi") attr(x, "class") <- attr(x, "circularp") <- NULL if (is.null(mu)) { sinr <- sum(sin(x)) cosr <- sum(cos(x)) mu <- atan2(sinr, cosr) } else { mu <- conversion.circular(mu, units="radians", zero=0, rotation="counter", modulo="2pi") attr(mu, "class") <- attr(mu, "circularp") <- NULL } result <- MleVonmisesBootstrapCiRad(x, mu, bias, alpha, reps) result$mu <- conversion.circular(circular(result$mu), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) result$mu.ci <- conversion.circular(circular(result$mu.ci), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) result$call <- match.call() result$alpha <- alpha class(result) <- "mle.vonmises.bootstrap.ci" return(result) } MleVonmisesBootstrapCiRad <- function(x, mu, bias, alpha, reps) { mean.bs <- boot(data = x, statistic = MleVonmisesMuRad, R = reps, stype="i") mean.reps <- mean.bs$t mean.reps <- sort(mean.reps %% (2 * pi)) spacings <- c(diff(mean.reps), mean.reps[1] - mean.reps[reps] + 2 * pi) max.spacing <- (1:reps)[spacings == max(spacings)] off.set <- 2 * pi - mean.reps[max.spacing + 1] if (max.spacing != reps) mean.reps2 <- mean.reps + off.set else mean.reps2 <- mean.reps mean.reps2 <- sort(mean.reps2 %% (2 * pi)) mean.ci <- quantile(mean.reps2, c(alpha/2, 1 - alpha/2)) if (max.spacing != reps) mean.ci <- mean.ci - off.set kappa.bs <- boot(data = x, statistic = MleVonmisesKappaRad, R = reps, stype="i", mu=mu, bias = bias) kappa.reps <- kappa.bs$t kappa.ci <- quantile(kappa.reps, c(alpha/2, 1 - alpha/2)) result <- list() result$mu.ci <- mean.ci result$mu <- c(mean.reps) result$kappa.ci <- kappa.ci result$kappa <- c(kappa.reps) return(result) } MleVonmisesMuRad <- function(x, i) { sinr <- sum(sin(x[i])) cosr <- sum(cos(x[i])) mu <- atan2(sinr, cosr) return(mu) } MleVonmisesKappaRad <- function(x, i, mu, bias) { n <- length(x[i]) V <- mean(cos(x[i] - mu)) if (V > 0) { kappa <- A1inv(V) } else { kappa <- 0 } if (bias == TRUE) { if (kappa < 2) { kappa <- max(kappa - 2 * (n * kappa)^-1, 0) } else { kappa <- ((n - 1)^3 * kappa)/(n^3 + n) } } return(kappa) } ############################################################# # # # print.mle.vonmises.bootstrap.ci function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: September, 17, 2003 # # Copyright (C) 2003 Claudio Agostinelli # # # # Version 0.1 # ############################################################# print.mle.vonmises.bootstrap.ci <- function(x, ...) { cat("Bootstrap Confidence Intervals for Mean Direction and Concentration", "\n") cat("Confidence Level: ", round(100 * (1 - x$alpha),2), "%", "\n") cat("Mean Direction: ", "Low =", round(x$mu.ci[1], 2), " High =", round(x$mu.ci[2], 2), "\n") cat("Concentration Parameter: ", "Low =", round(x$kappa.ci[1], 2), " High =", round(x$kappa.ci[2], 2), "\n") } circular/R/rose.diag.oldstyle.R0000644000176200001440000001145711430776324016132 0ustar liggesusers#####This code is not used anymore. It is here for historical reason. Please use #####the code in the file rose.diag.R ############################################################# # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################# ############################################################# # # # rose.diag function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: October, 18, 2009 # # Copyright (C) 2009 Claudio Agostinelli # # # # Version 0.2-2 # # # ############################################################# rose.diag.oldstyle <- function(x, pch = 16, cex=1, axes = TRUE, shrink = 1, bins=NULL, ticks = TRUE, tcl=0.025, tcl.text=0.125, col=NULL, tol = 0.04, uin=NULL, xlim=c(-1, 1), ylim=c(-1, 1), prop = 1, digits=2, plot.info=NULL, units=NULL, template=NULL, zero=NULL, rotation=NULL, main="", xlab="", ylab="", add=FALSE, ...) { if (is.matrix(x) | is.data.frame(x)) { nseries <- ncol(x) } else { nseries <- 1 } xx <- as.data.frame(x) xcircularp <- attr(as.circular(xx[,1]), "circularp") # type <- xcircularp$type modulo <- xcircularp$modulo if (is.null(units)) units <- xcircularp$units if (is.null(plot.info)) { if (is.null(template)) template <- xcircularp$template if (template=="geographics" | template=="clock24") { zero <- pi/2 rotation <- "clock" } else if (template=="clock12") { zero <- pi/2 rotation <- "clock" modulo <- "pi" } else { if (is.null(zero)) zero <- xcircularp$zero if (is.null(rotation)) rotation <- xcircularp$rotation } next.points <- 0 } else { zero <- plot.info$zero rotation <- plot.info$rotation next.points <- plot.info$next.points } if (!add) { CirclePlotRad(xlim, ylim, uin, shrink, tol, 1000, main=main, xlab=xlab, ylab=ylab) } if (is.null(bins)) { bins <- NROW(x) } else { bins <- round(bins) if (bins<=0) stop("bins must be non negative") } if (is.null(col)) { col <- seq(nseries) } else { if (length(col)!=nseries) { col <- rep(col, nseries)[1:nseries] } } pch <- rep(pch, nseries, length.out=nseries) if (axes) { axis.circular(units=units, template=template, zero=zero, rotation=rotation, digits=digits, cex=cex, tcl=tcl, tcl.text=tcl.text) } if (!is.logical(ticks)) stop("ticks must be logical") if (ticks) { at <- circular((0:bins)/bins*2*pi, zero=zero, rotation=rotation) ticks.circular(at, tcl=tcl) } for (iseries in 1:nseries) { x <- xx[,iseries] x <- na.omit(x) n <- length(x) if (n) { x <- conversion.circular(x, units="radians", modulo=modulo) attr(x, "circularp") <- attr(x, "class") <- NULL if (rotation=="clock") x <- -x x <- x+zero if (template=="clock12") x <- 2*x x <- x%%(2*pi) RosediagOSRad(x, bins, prop, col[iseries], ...) } } return(invisible(list(zero=zero, rotation=rotation, next.points=0))) } RosediagOSRad <- function(x, bins, prop, col, ...) { #### x musts be in modulo 2pi n <- length(x) freq <- rep(0, bins) arc <- (2 * pi)/bins x[x >= 2*pi] <- 2*pi-4*.Machine$double.eps # for (i in 1:bins) { # freq[i] <- sum(x < i * arc & x >= (i - 1) * arc) # } breaks <- seq(0,2*pi,length.out=(bins+1)) freq <- hist.default(x, breaks=breaks, plot=FALSE, right=TRUE)$counts rel.freq <- freq/n radius <- sqrt(rel.freq) * prop sector <- seq(0, 2 * pi - (2 * pi)/bins, length = bins) mids <- seq(arc/2, 2 * pi - pi/bins, length = bins) for (i in 1:bins) { if (rel.freq[i] != 0) { lines.default(c(0, radius[i] * cos(sector[i])), c(0, radius[i] * sin(sector[i])), col=col, ...) lines.default(c(0, radius[i] * cos(sector[i] + (2 * pi)/bins)), c(0, radius[i] * sin(sector[i] + (2 * pi)/bins)), col=col, ...) lines.default(c(radius[i] * cos(sector[i]), radius[i] * cos(sector[i] + (2 * pi)/bins)), c(radius[i] * sin(sector[i]), radius[i] * sin(sector[i] + (2 * pi)/bins)), col=col, ...) } } } circular/R/arrows.circular.R0000644000176200001440000000353011431453066015526 0ustar liggesusers############################################################# # # # arrows.circular function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: August, 14, 2010 # # Version: 0.3 # # # # Copyright (C) 2010 Claudio Agostinelli # # # ############################################################# # patche suggests by Peter Cowan (pdc) # [#193] fix for plotting many arrows with one call to arrows.circular() arrows.circular <- function(x, y=NULL, x0=0, y0=0, na.rm=FALSE, shrink=1, plot.info=NULL, zero=NULL, rotation=NULL, ...) { if (na.rm) x <- x[!is.na(x)] if (length(x)==0) { warning("No observations (at least after removing missing values)") return(NULL) } xcircularp <- attr(as.circular(x), "circularp") if (is.null(plot.info)) { if (is.null(zero)) zero <- xcircularp$zero if (is.null(rotation)) rotation <- xcircularp$rotation } else { zero <- plot.info$zero rotation <- plot.info$rotation } x <- conversion.circular(x, units="radians") attr(x, "class") <- attr(x, "circularp") <- NULL if (rotation=="clock") x <- -x x <- x+zero x <- x%%(2*pi) x <- as.vector(x) if (is.null(y)) y <- rep(1, length(x)) y <- as.vector(y) if (length(y)!=length(x)) stop("'y' must have the same length of 'x'") y <- y*shrink if (length(x0)!=length(x)) x0 <- rep(x0, length(x)) if (length(y0)!=length(x)) y0 <- rep(y0, length(x)) x1 <- x0 + y*cos(x) y1 <- y0 + y*sin(x) arrows(x0, y0, x1, y1, ...) } circular/R/watson.wheeler.test.R0000644000176200001440000000726213124162710016331 0ustar liggesusers# # Watson-Wheeler test for homogeneity # # Allows to compare the distribution of angles in two or more samples. # # Based on # Circular statistics in biology, Batschelet, E (1981) # 6.3, p. 104 # Biostatistical analysis, Zar, J H (1999) # 27.5, p. 640 # # (c) Copyright 2010-211 Jean-Olivier Irisson # GNU General Public License, v.3 # #------------------------------------------------------------ # Generic function watson.wheeler.test <- function(x, ...) { UseMethod("watson.wheeler.test", x) } # Default method, for an angle vector and a grouping vector watson.wheeler.test.default <- function(x, group, ...) { # get data name data.name <- paste(deparse(substitute(x)), "by", deparse(substitute(group))) # check arguments ok <- complete.cases(x, group) x <- x[ok] group <- group[ok] if (length(x)==0 | length(table(group)) < 2) { stop("No observations or no groups (at least after removing missing values)") } # remove circular attributes, if any if (is.circular(x)) { attr(x, "class") <- attr(x, "circularp") <- NULL } # NB: Since we will only work on ranks the units have no influence as long as they are consistent across groups. We do not need to store the angles attributes # check for ties nbTies <- sum(duplicated(x)) if (nbTies > 0) { mess = ifelse(nbTies == 1, "There is 1 tie", paste("There are", nbTies, "ties")) warning(mess, " in the data.\n Ties will be broken appart randomly and may influence the result.\n Re-run the test several times to check the influence of ties.") } # check sample size per group ns <- as.numeric(table(group)) if (!all(ns >= 10)) { warning("Some groups have less than 10 elements : ", paste(ns[ns < 10], collapse=", "),".\n The Chi-squared approximation of the p-value is incorrect.") } result <- WatsonWheelerTestRad(x, group) result$data.name <- data.name return(result) } # Method for a list watson.wheeler.test.list <- function(x, ...) { # fecth or fill list names k <- length(x) if (is.null(names(x))) { names(x) <- 1:k } # get data name data.name <- paste(names(x), collapse=" and ") # convert into x and group ns <- lapply(x, length) group <- rep(names(x), times=ns) x <- do.call("c", x) # NB: unlist() removes the circular attributes here # call default method result <- watson.wheeler.test.default(x, group) result$data.name <- data.name return(result) } # Method for a formula watson.wheeler.test.formula <- function(formula, data, ...) { # convert into x and group d <- model.frame(as.formula(formula), data) # get data name data.name <- paste(names(d), collapse=" by ") # call default method result <- watson.wheeler.test.default(d[,1], d[,2]) result$data.name <- data.name return(result) } # Computation in the usual trigonometric space WatsonWheelerTestRad <- function(x, group) { # number of groups group <- as.factor(group) k <- nlevels(group) # total sample size n <- length(x) # sample size per group ns <- as.numeric(table(group)) # ranks r <- rank(x, ties.method="random") # circular rank (or uniform score) cr <- r * 2*pi / n # compute C <- tapply(cos(cr), group, sum) S <- tapply(sin(cr), group, sum) if (k == 2) { W <- 2 * (n-1) * (C[1]^2 + S[1]^2) / prod(ns) names(W) <- NULL df <- 2 } else { W <- 2 * sum( (C^2 + S^2) / ns) df <- 2*(k-1) } p.value <- pchisq(W, df=df, lower.tail=FALSE) # return result result <- list( method = "Watson-Wheeler test for homogeneity of angles", parameter = c(df=df), statistic = c(W=W), p.value = p.value ) class(result) <- "htest" return(result) } # Test data (from Zar) # x1 <- c(35, 45, 50, 55, 60, 70, 85, 95, 105, 120) # x2 <- c(75, 80, 90, 100, 110, 130, 135, 140, 150, 160, 165) # # watson.wheeler.test(list(x1,x2)) circular/R/medianHL.default.R0000644000176200001440000000252514475657026015532 0ustar liggesusersmedianHL <- function(x, na.rm=FALSE, ...) UseMethod("medianHL") medianHL.default <- function(x, na.rm=FALSE, method=c("HL1","HL2","HL3"), prop=NULL,...) { method <- match.arg(method) if (!is.null(prop)) if (prop <= 0 | prop >=1) stop("'prop' is outside (0,1)") if (na.rm) x <- x[!is.na(x)] if ((n <- length(x))==0) { warning("No observations (at least after removing missing values)") return(NULL) } if (method=="HL2") { nt <- n*(n+1)/2 nm <- n } else if (method=="HL1") { nt <- n*(n-1)/2 nm <- n-1 } else { nt <- n^2 nm <- n im <- 1 } if (is.null(prop)) { meanpairs <- rep(0,nt) ni <- 0 for (i in 1:nm) { if (method=="HL1") im <- i+1 else if (method=="HL2") im <- i for (j in im:n) { ni <- ni + 1 meanpairs[ni] <- (x[i]+x[j])/2 } } } else { np <- round(nt*prop) indici <- sample(x=nt, size=np, replace=FALSE) if (np < 1) np <- 1 meanpairs <- rep(0,np) ni <- 0 npi <- 0 for (i in 1:nm) { if (method=="HL1") im <- i+1 else if (method=="HL2") im <- i for (j in im:n) { ni <- ni + 1 if (any(indici==ni)) { npi <- npi + 1 meanpairs[npi] <- (x[i]+x[j])/2 } } } } median.default(meanpairs) } circular/R/quantile.circular.R0000644000176200001440000000411114211353212016016 0ustar liggesusers############################################################# # # # quantile.circular function # # Author: Claudio Agostinelli and Alessandro Gagliardi # # Email: claudio.agostinelli@unitn.it # # Date: March, 07, 2022 # # Copyright (C) 2013-2022 Claudio Agostinelli # # # # Version 0.2-2 # ############################################################# quantile.circular <- function(x, probs = seq(0, 1, 0.25), na.rm=FALSE, names = TRUE, type = 7, ...) { if (na.rm) x <- x[!is.na(x)] if (length(x)==0) { warning("No observations (at least after removing missing values)") return(NULL) } if(any(probs < 0 | probs > 1)) { warning("'probs' outside [0,1] were removed") probs <- probs[probs >=0 & probs <=1] } if (length(probs)==0) { return(NULL) } if (is.circular(x)) { dc <- circularp(x) } else { dc <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") } x <- conversion.circular(x, units="radians", zero=0, rotation="counter") attr(x, "class") <- attr(x, "circularp") <- NULL circquantile <- QuantileCircularRad(x=x, probs=probs, names=names, type=type, ...) circquantile <- conversion.circular(circular(drop(circquantile)), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation) return(circquantile) } ## quantile.default becomes quantile ## 20130826 QuantileCircularRad <- function(x, probs = seq(0, 1, 0.25), names = TRUE, type = 7, ...) { circularmedian <- MedianCircularRad(x) if(is.na(circularmedian)) return(rep(NA,length(probs))) attr(circularmedian, "medians") <- NULL tx <- (x-circularmedian)%%(2*pi) tx <- MinusPiPlusPiRad(tx) circularQuantile <- quantile(x=tx, probs=probs, names=names, type=type, ...) return((circularQuantile + circularmedian)%%(2*pi)) } circular/R/as.circular.R0000644000176200001440000000644411312211537014614 0ustar liggesusers############################################################# # # # as.circular function # # Author: Claudio Agostinelli # # Email: claudio@unive.it # # Date: May, 31, 2006 # # Copyright (C) 2006 Claudio Agostinelli # # # # Version 0.2-1 # ############################################################# as.circular <- function (x, control.circular=list(), ...) { if (is.circular(x)) return(x) else if (!is.null(xcircularp <- circularp(x))) circular(x, type=xcircularp$type, units=xcircularp$units, template=xcircularp$template, modulo=xcircularp$modulo, zero=xcircularp$zero, rotation=xcircularp$rotation) else { warntype <- warnunits <- warntemplate <- warnrotation <- warnmodulo <- warnzero <- "" printwarn <- FALSE dotc <- list(..., expand=TRUE) dc <- control.circular if (is.null(dc$type)) { if (!is.null(dotc$type)) dc$type <- dotc$type else { dc$type <- "angles" warntype <- " type: 'angles'\n" printwarn <- TRUE } } if (is.null(dc$units)) { if (!is.null(dotc$units)) dc$units <- dotc$units else { dc$units <- "radians" warnunits <- " units: 'radians'\n" printwarn <- TRUE } } if (is.null(dc$template)) { if (!is.null(dotc$template)) dc$template <- dotc$template else { dc$template <- "none" warntemplate <- " template: 'none'\n" printwarn <- TRUE } } if (is.null(dc$modulo)) { if (!is.null(dotc$modulo)) dc$modulo <- dotc$modulo else { dc$modulo <- "asis" warnmodulo <- " modulo: 'asis'\n" printwarn <- TRUE } } if (is.null(dc$zero)) { if (!is.null(dotc$zero)) dc$zero <- dotc$zero else { dc$zero <- 0 warnzero <- " zero: 0\n" printwarn <- TRUE } } if (is.null(dc$rotation)) { if (!is.null(dotc$rotation)) dc$rotation <- dotc$rotation else { dc$rotation <- "counter" warnrotation <- " rotation: 'counter'\n" printwarn <- TRUE } } if (printwarn) { warn <- paste("an object is coerced to the class 'circular' using default value for the following components:\n", warntype, warnunits, warntemplate, warnmodulo, warnzero, warnrotation, sep="") warning(warn, sys.call(-1)) } circular(x, type=dc$type, units=dc$units, template=dc$template, modulo=dc$modulo, zero=dc$zero, rotation=dc$rotation) } } circular/R/watson.williams.test.R0000644000176200001440000001141713124162733016521 0ustar liggesusers# # Watson-Williams test for homogeneity of means # # Allows to compare mean angles in two or more samples. # Equivalent, for angles, of an ANOVA/Kruskal-Wallis test. # # Based on # Circular statistics in biology, Batschelet, E (1981) # 6.2, p. 99 # Biostatistical analysis, Zar, J H (1999) # 27.4, p. 634 # Directional statistics, Mardia, K.V. and Jupp, P.E. (2000) # p. 135 # # (c) Copyright 2010-2011 Jean-Olivier Irisson # GNU General Public License, v.3 # #------------------------------------------------------------ # added drop=TRUE 20131106 Claudio # Generic function watson.williams.test <- function(x, ...) { UseMethod("watson.williams.test", x) } # Default method, for an angle vector and a grouping vector watson.williams.test.default <- function(x, group, ...) { # get data name data.name <- paste(deparse(substitute(x)), "by", deparse(substitute(group))) # check arguments ok <- complete.cases(x, group) x <- x[ok] group <- group[ok,drop=TRUE] if (length(x)==0 | length(table(group)) < 2) { stop("No observations or no groups (at least after removing missing values)") } # convert everything to the radians/trigonometric case if (is.circular(x)) { dc <- circularp(x) x <- conversion.circular(x, units="radians", zero=0, rotation="counter", modulo="2pi") attr(x, "class") <- attr(x, "circularp") <- NULL } else { dc <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter") } # compute concentration parameters and check assumptions kt <- EqualKappaTestRad(x, group) # equality of concentration parameters if (kt$p.value < 0.05) { warning("Concentration parameters (", paste(format(kt$kappa, digits=3), collapse=", ") ,") not equal between groups. The test might not be applicable") } # sufficiently large concentration # Batschelet provides kappa.all > 2 (or equivalently rho.all > 0.75) in the two sample case (but no indication in the multisample one) # Mardia & Jupp cite Stephens 1972 to justify that kappa.all >= 1 (or equivalently rho.all >= 0.45) in the multisample case # Zar's adds conditions on minimum sample size to use the smaller thresholds of the concentration parameter -- but there is no discussion of how things change when the sample size smaller but the concentration larger) : # N / 2 >= 25 in the two sample case # N / k >= 6 in the multisample case # determine whether we are doing a two or multisample test if (length(table(group)) == 2) { kappa.thresh <- 2 } else { kappa.thresh <- 1 } if ( kt$kappa.all < kappa.thresh ) { warning("Global concentration parameter: ", format(kt$kappa.all, digits=3)," < ", kappa.thresh, ". The test is probably not applicable") } # TODO : also check that distributions conform to Von Mises? result <- WatsonWilliamsTestRad(x, group, kt) result$data.name <- data.name # convert means back in their original units result$estimate <- conversion.circular(circular(result$estimate), units=dc$units, type=dc$type, template=dc$template, modulo=dc$modulo, zero=dc$zero, dc$rotation) return(result) } # Method for a list watson.williams.test.list <- function(x, ...) { # fecth or fill list names k <- length(x) if (is.null(names(x))) { names(x) <- 1:k } # get data name data.name <- paste(names(x), collapse=" and ") # convert into x and group ns <- lapply(x, length) group <- rep(names(x), times=ns) x <- do.call("c", x) # NB: unlist() removes the circular attributes here # call default method result <- watson.williams.test.default(x, group) result$data.name <- data.name return(result) } # Method for a formula watson.williams.test.formula <- function(formula, data, ...) { # convert into x and group d <- model.frame(as.formula(formula), data) # get data name data.name <- paste(names(d), collapse=" by ") # call default method result <- watson.williams.test.default(d[,1], d[,2]) result$data.name <- data.name return(result) } # Computation in the usual trigonometric space WatsonWilliamsTestRad <- function(x, group, kt) { # number of groups group <- as.factor(group) k <- nlevels(group) # total sample size n <- length(x) # sample size per group ns <- as.numeric(table(group)) # correction factor g <- 1 + 3 / (8 * kt$kappa.all) # sum of resultant vectors lengths sRi <- sum(kt$rho * ns) # total resultant vector length R <- kt$rho.all * n statistic <- g * ((n - k) * (sRi - R)) / ((k - 1) * (n - sRi)) p.value <- pf(statistic, k-1, n-k, lower.tail=FALSE) # compute estimates of means means <- tapply(x, group, MeanCircularRad) names(means) <- paste("mean of", names(means)) # return result result <- list( method = "Watson-Williams test for homogeneity of means", parameter = c(df1=k-1, df2=n-k), statistic = c(F=statistic), p.value = p.value, estimate = means ) class(result) <- "htest" return(result) } circular/R/rho.circular.R0000644000176200001440000000273611312211537015001 0ustar liggesusers ############################################################### # # # Original Splus: Ulric Lund # # E-mail: ulund@calpoly.edu # # # ############################################################### ############################################################# # # # rho.circular function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: May, 26, 2006 # # Version: 0.3-1 # # # # Copyright (C) 2006 Claudio Agostinelli # # # ############################################################# rho.circular <- function(x, na.rm=FALSE) { if (na.rm) x <- x[!is.na(x)] if (any(is.na(x))) { warning("No observations (at least after removing missing values)") return(NA) } x <- conversion.circular(x, units="radians") RhoCircularRad(x) } RhoCircularRad <- function(x) { n <- length(x) sinr <- sum(sin(x)) cosr <- sum(cos(x)) result <- sqrt(sinr^2 + cosr^2)/n return(result) } circular/R/dist.circular.R0000644000176200001440000000335213124150011015137 0ustar liggesusers############################################################# # # # dist.circular function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: October, 12, 2009 # # Version: 0.1-2 # # # # Copyright (C) 2007 Claudio Agostinelli # # # ############################################################# dist.circular <- function (x, method = "correlation", diag = FALSE, upper = FALSE) { x <- conversion.circular(x, units="radians", zero=0, rotation="counter", modulo="2pi") attr(x, "class") <- attr(x, "circularp") <- NULL if (!is.na(pmatch(method, "correlation"))) method <- "correlation" METHODS <- c("correlation", "angularseparation", "chord", "geodesic") method <- pmatch(method, METHODS) if (is.na(method)) stop("invalid distance method") if (method == -1) stop("ambiguous distance method") N <- nrow(x <- as.matrix(x)) d <- .C("R_distance", x = as.double(x), nr = N, nc = ncol(x), d = double(N * (N - 1)/2), diag = as.integer(FALSE), method = as.integer(method), NAOK = TRUE, PACKAGE = "circular")$d attr(d, "Size") <- N attr(d, "Labels") <- dimnames(x)[[1]] attr(d, "Diag") <- diag attr(d, "Upper") <- upper attr(d, "method") <- METHODS[method] # if (method == 6) # attr(d, "p") <- p attr(d, "call") <- match.call() class(d) <- "dist" return(d) } circular/R/genvonmises.R0000644000176200001440000000374111460610426014744 0ustar liggesusers############################################################# # # # dgenvonmises function # # Author: Federico Rotolo # # Email: federico.rotolo@stat.unipd.it # # Date: October, 05, 2010 # # Copyright (C) 2010 Federico Rotolo # # # # Version # ############################################################# dgenvonmises <- function (x, mu1=NULL, mu2=NULL, kappa1=NULL, kappa2=NULL) { if (is.null(mu1) || length(mu1)!=1 || is.null(mu2) || length(mu2)!=1) stop("the mean direction parameters 'mu1' and 'mu2' are mandatory and it must have length 1") if (is.null(kappa1) || length(kappa1)!=1 || is.null(kappa2) || length(kappa2)!=1) stop("the concentration direction parameters 'kappa1' and 'kappa2' are mandatory and it must have length 1") if((kappa1<0)||(kappa2<0)){stop("'kappa1' and 'kappa2' must be non negative")} if((mu2%/%pi)%%2!=0){stop("'mu2' must be upper - tol) warning("minimum occurred at one end of the range") return(bw) } ############################################################# # # bw.cv.ml.circular function # Author: Claudio Agostinelli and Eduardo Garcia Portugues # Email: claudio@unive.it # date: June, 23, 2011 # Copyright (C) 2011 Claudio Agostinelli and Eduardo Garcia Portugues # # Version 0.2 # ############################################################# ### Cross validation by ML ### bw.cv.ml.circular <- function(x, lower=NULL, upper=NULL, tol = 1e-4, kernel = c("vonmises", "wrappednormal"), K = NULL, min.k = 10) { kernel <- match.arg(kernel) if (is.null(upper)) upper = 50 if (is.null(lower)) lower = 0.1 if ((n <- length(x)) < 2L) stop("need at least 2 data points") x <- conversion.circular(x, units="radians", zero=0, rotation="counter", modulo="2pi") attr(x, "class") <- attr(x, "circularp") <- NULL if (!is.numeric(x)) stop("invalid 'x'") ml.internal <- function(bw, data) { ##bw: bw ##data: x ss <- sapply(1:length(data), function(i) log(DensityCircularRad(x=data[-i], z=data[i], bw=bw, kernel=kernel, K=K, min.k=min.k))) result <- sum(ss)/length(data) return(result) } bw <- optimize(function(bw) ml.internal(bw, x), lower=lower, upper=upper, tol=tol, maximum = TRUE)$maximum if (bw < lower + tol | bw > upper - tol) warning("minimum occurred at one end of the range") return(bw) } ############################################################# # # bw.nrd.circular function # Author: Claudio Agostinelli and Eduardo Garcia Portugues # Email: claudio@unive.it # date: July, 22, 2011 # Copyright (C) 2011 Claudio Agostinelli and Eduardo Garcia Portugues # # Version 0.3 # ############################################################# ###References: Taylor (2008) CSDA formula (7) bw.nrd.circular <- function(x, lower=NULL, upper=NULL, kappa.est=c("ML","trigmoments"), kappa.bias=FALSE, P=3) { if (is.null(upper)) upper = 50 if (is.null(lower)) lower = 0.01 if ((n <- length(x)) < 2L) stop("need at least 2 data points") x <- conversion.circular(x, units="radians", zero=0, rotation="counter", modulo="2pi") attr(x, "class") <- attr(x, "circularp") <- NULL if (!is.numeric(x)) stop("invalid 'x'") if (is.numeric(kappa.est)) { if (length(kappa.est) != 1) stop("if 'kappa.est' is numeric, its length must be one") kappa <- kappa.est } else { kappa.est <- match.arg(kappa.est) if(kappa.est=="ML"){ kappa <- MlevonmisesRad(x, mu=NULL, kappa=NULL, bias=kappa.bias)[4] } else if(kappa.est=="trigmoments"){ kappa <- rep(NA, P) for (p in 1:P) { mup <- TrigonometricMomentRad(x, p, center=FALSE)[1] const <- mean(cos(p*x-mup)) Apzero <- function(x) besselI(x, nu=p, expon.scaled = FALSE)/besselI(x, nu=0, expon.scaled = FALSE) - const kappa[p] <- uniroot(f=Apzero, lower=lower, upper=upper)$root } kappa <- max(kappa) } else { .NotYetImplemented() } } bw <- (3*n*kappa^2*besselI(x=2*kappa, nu=2, expon.scaled = FALSE)*(4*sqrt(pi)*besselI(x=kappa, nu=0, expon.scaled = FALSE)^2)^(-1))^(2/5) return(bw) } circular/R/ticks.circular.R0000644000176200001440000000310411312211537015314 0ustar liggesusers############################################################# # # # ticks.circular function # # Author: Claudio Agostinelli # # E-mail: claudio@unive.it # # Date: November, 13, 2008 # # Version: 0.4-1 # # # # Copyright (C) 2008 Claudio Agostinelli # # # ############################################################# ticks.circular <- function(x, template=c("none", "geographics"), zero=NULL, rotation=NULL, tcl=0.025, col=NULL, ...) { template <- match.arg(template) if (is.null(col)) col <- par("col") xcircularp <- attr(as.circular(x), "circularp") type <- xcircularp$type if (type=='directions') x <- 2*x if (template=="geographics") { zero <- pi/2 rotation <- "clock" } else { if (is.null(zero)) zero <- xcircularp$zero if (is.null(rotation)) rotation <- xcircularp$rotation } x <- conversion.circular(x, units="radians") attr(x, "circularp") <- attr(x, "class") <- NULL if (rotation=="clock") x <- -x x <- x+zero x <- x%%(2*pi) TicksCircularRad(x, tcl, col, ...) } TicksCircularRad <- function(x, tcl, col, ...) { r <- 1+tcl*c(-1/2,1/2) z <- cos(x) y <- sin(x) for (i in 1:length(x)) { lines.default(z[i]*r, y[i]*r, col=col, ...) } } circular/R/I.1.R0000644000176200001440000000010511312211537012721 0ustar liggesusers I.1 <- function(x) { besselI(x=x, nu=1, expon.scaled = FALSE) } circular/MD50000644000176200001440000003542314475703172012407 0ustar liggesusers0db8fb4a8a9148f3e8029eee41b77939 *COPYING 46932cf99856e5427fd5dc857b8e7e7a *DESCRIPTION 3f533d73d1a227bc64e2853295601148 *NAMESPACE cca22485e725dc1681e0f01723e1fd59 *R/A1.R d642acad73d30fd023af1e7cb5f53777 *R/A1FirstDerivative.R 87d8618f16f78bbbb817ef4ef06fc1e8 *R/A1SecondDerivative.R 6aeba0012aa9cd54ead5b47ac04519f0 *R/A1inv.R 2d3435dae5e15483fc34f176a93b6015 *R/Calpha.R a247de28bcf3782f1b0163de71ddfd82 *R/I.0.R e58d116b031e78d6d874b0f5d32955af *R/I.1.R 2c95e24e260226d8ab6abdf793101f9e *R/I.p.R 8532d15c15eed6b2bf6f7376240fb07d *R/Ralpha.R a94a59bc9dfc82985768ebfd54b20435 *R/angular.deviation.R 712503972c34999e132d2ca148a92923 *R/angular.variance.R 298d977eee84ff789d43555b59b2f202 *R/aov.circular.R 3e2281e3867f57e1c6365b3253c15557 *R/areas.circular.R 1c5b744f6a62ff05b031fbc09b1c9649 *R/arrows.circular.R dd4344db14a225130ec1dba98b64961d *R/as.circular.R 0e0fa1a397d107b959d398d992e4b78f *R/as.data.frame.circular.R 3a9f9c87b5990fc72c5e46492837b421 *R/asytriangular.R af0ede56a865552be4849a94000d6d32 *R/axialvonmises.R c4ea2fab3242862b7d192bbf7b0d296d *R/axis.circular.R efc3ab1f3ccfb2125dc80bc383dfb8cd *R/bw.circular.R b349fc64bf7cedd02c99574c56b9f231 *R/cardioid.R 91df456953db048e805d615b05617880 *R/carthwrite.R aea39f4da980433a120ba43c2a207380 *R/change.point.R 72b28abb97ee62515e08c3352fb16843 *R/circular.R af2e8ac2580491e73d2af7ec092bee90 *R/circular.colors.R bf5d515b810c29d3ddac889099c4b8d3 *R/coord2rad.R ad0fbba1da2a32ac57c3bb8c9cbf685b *R/cor.circular.R 5a4feef5246a51e1cd8d4bf205eb4893 *R/curve.circular.R 371abe61128cc543a276d99a5be61424 *R/deg.R 2e4d9fb4d01342c9b928f7effd856bc0 *R/density.circular.R fdecf21aa0a03722ce72d50527b12670 *R/dist.circular.R ab7806b2ca1811193269f284f800e020 *R/equal.kappa.test.R 1ce10eda1942a443a02a0154838fd9a8 *R/family.circular.R d6f8aba958676c6440105c5585506ddd *R/genvonmises.R 2a2622c3a7f745ab44db1d62d3afe701 *R/heatmap.circular.R c42802137ad971f064a5ac08123afe83 *R/intersect.modal.region.R f7a87f4af5e1532786a671a828e62aca *R/jonespewsey.R 59cc2f150368912396b8bf5b1b8e3db6 *R/katojones.R d8cec02eefd55100df65804eda6be1db *R/kuiper.test.R 03a133277f238ffeaac2141b04b11e2a *R/lines.circular.R 26788062985b7cebd1277bdac9277b93 *R/lm.circular.R 9fc6c2cc2e0d3495e48da45018f7a70a *R/lm.circular.cc.R f80bb42969db4bf796925a91e368e106 *R/lm.circular.cl.R 6f90ad8fb682de4e0239696742076dd7 *R/lsfit.circle.R def2a476a0ffcf7d355ccd5d5e91f832 *R/make.circular.link.R 9b1e7e9fa6e49fceb9095130ee1db9ad *R/mean.circular.R cb7f0142ef44b1d0c08862731cd79697 *R/meandeviation.R d386de06171c2024dae5bf544941dbd8 *R/median.circular.R 865fe6f6fca8fa6fb2a9304e925e8bb3 *R/medianHL.circular.R 3cff3b44acf4d97156ea9b49653b0a91 *R/medianHL.default.R efa635a33462eff146538d3b979ab061 *R/medianaxis.circular.R a31fd3d9330f9a41effec4860b8405ec *R/minuspipluspi.R 11bff10955d136642e9503bb9130508e *R/mle.cardioid.R f5e6608c52e58aecdfcd7ad0ee353b32 *R/mle.vonmises.R 431f69436889acd679ad5b8a77ac22b3 *R/mle.vonmises.bootstrap.ci.R 411669bb0cf696bad51a0aa4f7cb1b31 *R/mle.wrappedcauchy.R 0b2552574c4ed4b61ac8fbd71cc981b8 *R/mle.wrappednormal.R f62fea5c5c724363af3a052936cd60e2 *R/modal.region.R 6cd2d61d470ade9bae415e578d4f3d7e *R/onAttach.R 3e7bff7976ef6353a88b4a7a29857a43 *R/plot.circular.R 1bc80292861692ec2c25f1126cd04450 *R/plot.edf.R 018120a462b974e755e07b4175f359d2 *R/plot.lsfit.circle.R e6f9e316fd7a89837e105e4d489289ef *R/points.circular.R 4e1f7cd0c52b3d45a127d4448f813e12 *R/pp.plot.R ec0ab4792ac1957935e3a77941d56d96 *R/pp.unif.plot.R d4c8fbf06aa04d3ad0f84b91cc9d7bb7 *R/projectednormal.R bc07445cbd641908b1e276f94fd9681c *R/quantile.circular.R c5a4cce9acd342b7c3020e30f89c367f *R/rad.R 7ff0bbfbc470b5986f45bc706a3cad76 *R/range.circular.R 9a7493eddd347de13967c0d97e891a03 *R/rao.spacing.test.R 7b5b8568f7d4ed6dc021bbe1c5b590f3 *R/rao.test.R 070207f2e201442345877db872c30d89 *R/rayleigh.test.R 4b52f43bb17258f089544ac059bddf87 *R/regularize.values.R e9cd19ae5e7126733456921a39ed031c *R/rho.circular.R a70548a8765e48f52eb55c2108f544bf *R/rose.diag.R f1d717ad39efc74a927334acd5d78f21 *R/rose.diag.oldstyle.R 0caee6071fe056086a69ff5907d1e0d8 *R/rstable.R 39c54929d64786b12f11ea991417fcce *R/sd.circular.R 2da79582564b3a83057e74a41b7ef8e5 *R/stephens.test.R b4f0a920b3e7b55b6a73100a26a44bf6 *R/subset.circular.R c770fe3c11bfddb71f1628de1f690090 *R/summary.circular.R 9fec5199199dc57e037f52af1d415925 *R/ticks.circular.R b56e44baa21c70fe95abe0dffae6af15 *R/totalvariation.R 9bcf9dfd52022a90a73bb0083149fbd7 *R/triangular.R 0f9c4623c0126aa26b0851e9599548e3 *R/trigonometric.moment.R 47992623b7561a6b84bfe932de2202d7 *R/trigonometric.polynomials.R 37b07e3ed0253efec85a01501a9b1c6d *R/uniform.R 29ebd1a4580b3a341091e73f83e8585a *R/unique.circular.R 0616bf037db6135ae8f097a834388094 *R/var.circular.R 546f9bcaca56e4e705321e6f9feb6c6e *R/vonmises.R 5cddbe3f602757f86860eedff0a59938 *R/wallraff.test.R 851bc8a6e6a0ce0da4a8053dc9809d98 *R/watson.test.R 0a2da463f73974ddf990a13e62cfc6b4 *R/watson.two.test.R e108f80ae786664dfdd79f5d268935a6 *R/watson.wheeler.test.R 1109c40530bbfa44486c49c6ced9589c *R/watson.williams.test.R f16a51a94c0945c799c4b8f9a588912d *R/weighted.mean.circular.R bb8dd100d4df06f8e928932bb49326fc *R/windrose.R ed6687ebea7f14a3d6b2d26ce111d404 *R/wrappedcauchy.R c7325939ad1becf1bffda1cb769ba061 *R/wrappednormal.R 965baf8e9fc2169ca460ea6328d85297 *R/wrappedstable.R 907fbf4d65ee3b0b9801d9f565c19b83 *R/zzz.R 7b1bc2dfc7a924c62d368a550ba95919 *README 198c8d07013f2425941ba0917473ecd6 *data/coope.rda 865bde81d23bce4eb4c218f0dbe15b86 *data/fisherB1.rda ba481790f28a43fc37b04bf84600b002 *data/fisherB10.rda 319134ac8125cf11feb18fb49767b6fd *data/fisherB10c.rda 3134d7ff2e8b9edb346e289a3e6d0431 *data/fisherB11.rda 0f3fefd5c7918909b096af70346361e1 *data/fisherB11c.rda 9bd5e36d3a57e214d9f542518c68c3f0 *data/fisherB12.rda 6aaeb6f594bcde71c3b1c66b902a48dd *data/fisherB12c.rda ce8eeb1dbfe133aabf72a03b3324cc0b *data/fisherB13.rda d6d1860f838135c9e359ef1eeeb3f887 *data/fisherB13c.rda c51b61cceee0c96da0c9644fd82238d0 *data/fisherB18.rda 881559b3e3c5e02dbe75448908ee797a *data/fisherB18c.rda d64b1ece5d571e850db2aebd776edab0 *data/fisherB1c.rda 8625f4af72bf93535f2a131a0dfa10fb *data/fisherB2.rda 4929572bae10c69a2c822aeba1307e46 *data/fisherB20.rda 697b56a6854226b9a492ab2f84881868 *data/fisherB20c.rda 1544e6fd41269a9791466959512a192f *data/fisherB2c.rda e52821cbbc078e8ffe73857a5e4be572 *data/fisherB3.rda 4b22fcd77be6beb33a15e2ba8def1596 *data/fisherB3c.rda d5c3d6a5127bd9d2d0b0a2cf492e2df8 *data/fisherB4.rda 5fcb2e3df40f225d0ed62f821b022006 *data/fisherB4c.rda df6cb1724466a71dd44a2912793842ec *data/fisherB5.rda 95789f86160f1d2c2b3bbfd54889d980 *data/fisherB5c.rda 7f2b179e92b2ca88a581767190d706f6 *data/fisherB6.rda 6f3e7d5abb22b6bbccb7904778534790 *data/fisherB6c.rda 547901012182a2283984bf68eb019ea1 *data/fisherB7.rda 218b460a114870bed593831b4f3c806e *data/fisherB7c.rda 0291ec82f3ccb3eca14852c45666c4f3 *data/fisherB8.rda 00006e6d900b2e61e02ee26f6a888d24 *data/fisherB8c.rda c48e33cca73bea18844bf72d1b9af66b *data/fisherB9.rda a78fffc5ba2baaf0f4898301cabeb885 *data/fisherB9c.rda 797c45a8eae7671de636e61e9f6e6dd5 *data/ncfrog.rda 1e9b0cca7a589049d92585dff65d371a *data/pigeons.rda f0a42569153bdd948c03a06b71e5a1b1 *data/rao.table.rda c9b82ed81ebbae3ba963074e68de4e8b *data/swallows.rda bd47e4db763984f426323ae2b837994c *data/turtles.rda 0b459167afcad0c183d820a93b085e71 *data/wind.rda d2dd290fba7bf3b92502da054c060289 *inst/CITATION 08ee0db1331c304a3def2f9baa28aec8 *inst/COPYRIGHTS 79513bbb401143cd9437458bf234e297 *inst/NEWS c42c62f7601b5fed9fb658ce1ee1104c *man/A1.Rd 5d600404e6ef69c891b62310a134a3b3 *man/A1FirstDerivative.Rd 7d2317bea3e39eb5818204843016d4da *man/A1SecondDerivative.Rd 364420c53708acbf76e1a88f3c72943a *man/A1inv.Rd a3c0f5e6e32781a6036bb6ea925bc568 *man/Extract.circular.Rd a7d06566555eceb0df8538ee37f83a8b *man/I.0.Rd aefe14a478d4cd85bc385283ee5db857 *man/I.1.Rd f090a7b30ddbbe79899378bf3f6c4fa2 *man/I.p.Rd 4c7b229ded4b3a847ad002f0d22f0f17 *man/angular.deviation.Rd d5562e59619ac1a2f8a4d46ea16093b8 *man/angular.variance.Rd d97a0bc7a6b8b42b269439731caf4c7f *man/aov.circular.Rd 5f54aaf845bdc6b191c6c6ea2453fbcd *man/arrows.circular.Rd 4abf18e7b84483c3a3aea11b9e850449 *man/as.data.frame.circular.Rd 79b0eace486807d2457327734f0a7310 *man/asytriangular.Rd 707ff54a3fc93fbf021f40efdbb79869 *man/axialvonmises.Rd fff84d9d43fef243b5dabafcdedc935d *man/axis.circular.Rd 67443958640ffe709f0f666cceee3053 *man/bw.circular.Rd 9f0033a855bef6a5661352971577bf5c *man/c.circular.Rd 1c068a8debc26a0b37a2da4b065c0b63 *man/cardioid.Rd b81dbedbb3f95b908adb653f2db37eaa *man/carthwrite.Rd 2915255744b743794f90f62f58904842 *man/change.point.Rd 287871f7877d54a9f1a4bc16ffd52c2d *man/circle.control.Rd d742fe3fa8d9c5b5595cdfffb7114fbc *man/circular-package.Rd b8c65f36870b5420d63d31cefdee030b *man/circular.Rd 37b958f4ea06b997dfb6c71142b2cdb3 *man/circular.colors.Rd 4009077a917bf4b4f968a705bb8e3444 *man/circularp.Rd 42c554bbf41bcadf7b22c884a62f2717 *man/conversion.circular.Rd d437898bc4c7e36e102b5ec6aeef5e43 *man/coope.Rd d46bddfb85e0052692327437859a83cd *man/coord2rad.Rd e187d057de6e04ac702e7ccbf780f0f1 *man/cor.circular.Rd ce4a05f4feffb696ed12dc63233f3fd7 *man/curve.circular.Rd aee4c6f919553b17b99fab11f0845128 *man/deg.Rd f2a609ddc9fc449361e6af3d3ce851c0 *man/density.circular.Rd ea20da7f4eda1e62b0604ce2c7964f0d *man/dist.circular.Rd 25f3f6ab9ca6f631e3e128c805c36feb *man/equal.kappa.test.Rd 65ef1455d9b6636451c428409fb72471 *man/fisherB1.Rd 8e989fdcc6b1a4a66697a93b0221f300 *man/fisherB10.Rd a4ffa38fa400d39682a8be15f0961c8e *man/fisherB11.Rd a9dbc6f364d29ce23767a48fddeb691c *man/fisherB12.Rd 3e288cf40381500a4f72b65ce074ba59 *man/fisherB13.Rd edd1eae0787f7a73d25ebb574f3bbaa1 *man/fisherB18.Rd 06230b0f50314cf0e6a202f8feae5611 *man/fisherB2.Rd abaca1442f048272c7df3368798c9691 *man/fisherB20.Rd 10ceea21aba014dfbe9473840812c94c *man/fisherB3.Rd 39d3989f7e671f049fe2e4eb50988d9e *man/fisherB4.Rd 9e6b09781c46118a694ba3dd020579f7 *man/fisherB5.Rd c8465fd198302cf81c3a98c1feb06bef *man/fisherB6.Rd cb72458f801d1542267729c4046f16c2 *man/fisherB7.Rd 77848c787133e96848c37c20bd9b8296 *man/fisherB8.Rd f3cb56ec04856bf0e57516ca34e1d07f *man/fisherB9.Rd 5597c9fe83f05365de11da21bd420889 *man/genvonmises.Rd fb5b399be02ef4ca6c727e9e7735914f *man/heatmap.circular.Rd b3fed2a0aa37f168134ba15c6e7dd534 *man/intersect.modal.region.Rd 8d2001f44c08d469597b85173d6825e8 *man/jonespewsey.Rd 108a0589bae8da46e42a945dc365e96f *man/katojones.Rd 1115fa6487a231034451bb0ddbc8af7b *man/kuiper.test.Rd d190a33c56dd12b73c1e05d8a748052f *man/lines.circular.Rd d1d6b82eb0f3935ed735c3dc91268901 *man/lines.density.circular.Rd 1f92896fdd6416eae26d2d08421445c3 *man/lm.circular.Rd 8f872bdca221efc6d700816a7da3fd25 *man/lsfit.circle.Rd 27d847385f61622278175217e3700bb9 *man/mean.circular.Rd 91325d6e85ac9c9efe99f3dc82e69663 *man/meandeviation.Rd 8ad79083ca6ef8592f7b35b1833e6511 *man/median.circular.Rd e44d80d2253214638f6c65dfaaa12dfd *man/medianHL.circular.Rd bb48454a57f904e41b2e389760bb6bf1 *man/minusPiPlusPi.Rd 38e55097fbf41b85e226d4bae2a4fed8 *man/mixedvonmises.Rd d4a6afee943c43899c6487c0b542df12 *man/mle.vonmises.Rd 8358bdde09eefc6e2d21780c503d1815 *man/mle.vonmises.bootstrap.ci.Rd 8700c746334463d48828834c0589e7ae *man/mle.wrappedcauchy.Rd 66c630e9281462862c166a3a84a0cba5 *man/mle.wrappednormal.Rd ae950fb081a4002320c0ee3eb85e4a70 *man/modal.region.Rd 891f4e45fef6dd2b54a40604b2c848c1 *man/ncfrog.Rd ac0851168bf2e76008f9ff83953ed558 *man/pigeons.Rd 74fdb8863293547e70011fe06bbbfbb9 *man/plot.circular.Rd 544a54ee8e8fdd4596cf1ea7c0324c3f *man/plot.density.circular.Rd b46553d316a413fb34e83e7df251f610 *man/plot.edf.Rd 1eb85bfc187dfad48330c919333612c8 *man/plot.lsfit.circle.Rd 02ed7922c02a744998b712f810830f46 *man/points.circular.Rd f297882900b38d4426e531344f8a75b4 *man/pp.plot.Rd 1c03d45f1d5651bfa65a9d002b289028 *man/pp.unif.plot.Rd 2e07db2400470a98feb3b6a3daeb1426 *man/projectednormal.Rd 530d054ec981d1a7c425dfd87dfc9ecf *man/quantile.circular.Rd b758f4e24662ee0e255dde92c3da4c1a *man/rad.Rd 14d1054753c9dab74e7f6b934de4cc82 *man/range.circular.Rd ef104113efae32a4505d2f4a690f2975 *man/rao.spacing.test.Rd 2d5c9b5b7f105102e63c972190e1f1ea *man/rao.table.Rd c1093d7ae40f08671e78c9e885180ed6 *man/rao.test.Rd d1154ff1c4963b355d3381e1ada57c29 *man/rayleigh.test.Rd 3fb0a67b26668cce809f19dfad03127d *man/rho.circular.Rd ffad7036a2294f3f9a3dd37c0e95692e *man/rose.diag.Rd 0e5e87f83fcf523f643a5c0c2a64b633 *man/rstable.Rd c95734bb89e2cf00a56a2f7b427fdc3b *man/rwrappedstable.Rd 80906a98e6536724de3cfafc54a98d2f *man/sd.circular.Rd 70b3d85e4e3eb69b541d637b45053551 *man/standarddeviation.Rd ca80d2131adbb5ef09efd3b69c5c8dfa *man/summary.circular.Rd f7c7f21b8d0827b894bf8d43c7dc745f *man/swallows.Rd ea3000810b00846f99b47c3b3447188f *man/ticks.circular.Rd 4e5a8f90af020ae0a751849eacdd087e *man/totalvariation.circular.Rd a99cf971c6ef93995caabe4f8b1590ff *man/triangular.Rd 3ec45c32fcd507fb866e83417f1a2ec7 *man/trigonometric.moment.Rd 5e1b955ae21926a80b5fe52866ba4c20 *man/turtles.Rd 40e6ae0a61c7bef5c9f3b6d4dfa81573 *man/uniform.Rd 83d33f3dd7d9084e9dd18aa222356e69 *man/unique.circular.Rd 0813ee9ae6d8a7ba0ae62dabe4dc980d *man/var.circular.Rd 4e5cdb6f04859dea4be5794f7ef2cf99 *man/variance.Rd f733fd88c162c7cf6491e1de4ca61065 *man/vonmises.Rd c0d78adf2220be4c9754802b43f10f28 *man/wallraff.test.Rd bcb75130f166329902e5937a3d6daf21 *man/watson.test.Rd 45fc402bb9cb5a1799876bf5aa92860e *man/watson.two.test.Rd f077d1596cf993840fbed04bbc5da1af *man/watson.wheeler.test.Rd 92f4448521b5e817d2f2ca298efe5251 *man/watson.williams.test.Rd 5abdc3ac2287bb49bbad6f0931bf7557 *man/weighted.mean.circular.Rd 95efc724fcf93917c50d961ad30eae25 *man/wind.Rd c4378684d293b1a5bd52988f2b984768 *man/windrose.Rd c222993763d5bf2658d673eb049dba69 *man/wrappedcauchy.Rd 6108037a2da36e5a7e8e6daf649c19d5 *man/wrappednormal.Rd d54e1fc9cb2b17baf7d1e51ddc2e590b *src/distance.c c6e0a746fc817ce2852659b326d41eb0 *src/distance.h 6f4e96826745f34842f8ef6f8dbd504b *src/dwrappednormal.f d24375b035ddc3f136a71f16e5c5f8bb *src/dwrappednormal.h 94323f47b9d46611d240fc160c5b6afb *src/init.c 1dcb58c68937336d22ec034306136df7 *src/mean.circular.c 836d94c628d2c0b664cbcdad81a80571 *src/mean.circular.h cf57648f59185612560440f808888f43 *src/median.circular.c 3e1a6400a16b04bb3f53cbbec9dae466 *src/median.circular.h a19f516602d29d4534197fc6170c7cc1 *src/medianHL.circular.c ef3057d063263aefb1bb6ce14e1cceb7 *src/medianHL.circular.h 43ac92ef871dcac69afb0bd44a694853 *src/minuspipluspi.c 229d5520b685ad7ceb949c7cd307b550 *src/minuspipluspi.h e25024492be7d8bac2c7a7cc37650cda *src/mle.wrappednormal.f 56f758e4f332166765182796c8706eb0 *src/mle.wrappednormal.h 8164418337e95a437b28b6afbd57e407 *src/rvonmises.c 5cf41b5c5c71638e39e1c10782a0b56f *src/rvonmises.h 70cec631a756b6422ad86165096dce3e *src/weighted.mean.circular.c 5d795c5df6f7485b2796b28bc557cb5e *src/weighted.mean.circular.h 59e73bd7b067823d1f3f7e21a9cf2017 *tests/test-median.R 4b228b0e90d4677613770414ccd40f54 *tests/test-walraff.test.R 4c24881ef288dee3e669e87b07d21d74 *tests/test-walraff.test.Rout.save 59a016bf92d1e631fa322e340456fb31 *tests/test-watson.williams.test.R 4d50eb9592f4175f16048be5a7e72328 *tests/test-watson.williams.test.Rout.save circular/inst/0000755000176200001440000000000014470153537013044 5ustar liggesuserscircular/inst/COPYRIGHTS0000644000176200001440000000234112236440210014443 0ustar liggesusersCOPYRIGHT circular: Circular Statistics Copyright (C) 2013 Claudio Agostinelli, Ulric Lund This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; version 2 of the License or any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. CREDITS Some of the functions are originally written for S by Ulric Lund . rstable function is based on C functions gsl_ran_levy and gsl_ran_levy_skew from GNU Scientifi Library copyrighted under GNU general license by James Theiler, Brian Gough and Keith Briggs. The function summary.circular is written with David Andel The function windrose was originally written by Matt Pocernich circular/inst/CITATION0000644000176200001440000000156414470153537014207 0ustar liggesuserscitHeader("To cite the 'circular' package in publications use:") if(!exists("meta") || is.null(meta)) meta <- packageDescription("circular") bibentry(bibtype = "manual", title = paste("{R} package \\texttt{circular}: Circular Statistics", " (version ", meta$Version, ")", sep=""), author = c(person(given = "Claudio", family = "Agostinelli"), person(given = "Ulric", family = "Lund")), year = substr(meta$Date, 1, 4), url = "https://CRAN.R-project.org/package=circular", textVersion = paste("Agostinelli, C. and Lund, U. (", substr(meta$Date, 1, 4), "). ", "R package 'circular': Circular Statistics", " (version ", meta$Version, "). ", "URL https://CRAN.R-project.org/package=circular", sep="") ) circular/inst/NEWS0000644000176200001440000001537314475672303013556 0ustar liggesusersLibrary circular ================= Version 0.5 Added an example to RosediagRad (thanks to Hugo Flávio). Added an example to lm.circular (thanks to Dirk Walther). Drop personList() and citEntry(). axis.circular() is no longer an S3 method, just a standalone function. Version 0.4-95 Maintainer change to avoid archiving. Fixed documentation typos. Version 0.4-91 Fixed a bug in heatmap.circular Version 0.4-8 2014/08/08 minusPiPlusPi now accepts missing values Added the start.sep argument to plot.circular and points.circular. Also the internal function PointsCircularRad has changed the API. Version 0.4-6 2013/10/30 Added function dasytriangular for the density of asymmetric triangular distribution as described in Mardia (1972) In this version two functions are available for evaluating the median (medianCircular which allows for the dispersion parameter and median.circular with only the median reported), however medianCircular is deprecated and it will be removed in the next releases. Added mean.circular.c to calculate the circular mean in C language. New algorithm for circular median. The implementation is in C language. Added function for Hodges Lehmann estimate of the median for circular and non circular data. Several bugs fixed. Version 0.4-3 2011/07/18 Fixed a bug in c.circular function. New functions: watson.williams.test, wallraff.test. Add a summary introduction to the package. Add citation information. Fixed the behaviour of axis.circular for template 'clock12' and 'clock24'. Fixed windrose and plot.density.circular for template 'clock12' and 'clock24'. Function range.circular use lgamma(x) instead of log(gamma(x)). Fixed a bug in density.circular. Now the arguments K and min.k are passed to the internal function. Added functions bw.cv.mse.circular and bw.cv.ml.circular for bandwidth selection using crossvalidation and mse or ml. Added functions sd.default, sd.data.frame, sd.circular (with sd method), angular.variance and angular.deviation. Added pmixedvonmises function. Now *mixedvonmises functions use argument prop instead of p. Added function quantile.circular Version 0.4-2 2011/03/15 Fixed a bug in rose.diag function. Now the rose.diag function has two new parameters: sub and control.circle Version 0.4-1 2011/02/02 New functions: dgenvonmises, Density for the Generalized von Mises circular distribution. djonespewsey, Density for the Jones and Pewsey circular distribution. dkatojones, Density for the Kato and Jones distribution dcarthwrite, Density for the Carthwrite's power-of-cosine distribution Fixed a bug in density.circular rose.diag function has new parameters and better control of the colors. Now it use polygon instead of lines.default and it draws edges of sectors as arcs. Fixed bug on qvonmises and its documentation Fixed bug on qwrappednormal Fixed bug on arrows.circular Now range.circular do not retain the rotation attributes. Always return a counter rotation angle. Version 0.4, 2010/08/01 Refixed range.circular Version 0.3-9, 2010/07/31 Fixed bug #729 on watson.two.test function. Fixed bug #69 small bug in rose.diag of R package "circular", 0.3-8 and the same problem in the points.circular and plot.circular Fixed bug #104 bug in rvonmises, 0.3-8. Now, when kappa is zero, random deviates are generated according to the Circular Uniform Distribution Use patches #193 to fix for plotting many arrows with one call to arrows.circular() Add the argument control.circle to pass parameters to the internal function that draws the circle in plot.circular, curve.circular, plot.circular.function, plot.density.circular. A function, circle.control, is introduced to set those parameters. This is used instead of the proposed patches #194 The CirclePlotRad() function can accept "..." but it isn't currently passed. Add the argument sub, and change the default of main to NULL in the above functions. Internal functions PointsCircularRad and RosediagRad use the hist function to construct intervals in stack=TRUE. Add units "hours" for data expressed in hours (minutes and seconds must be expressed in decimals). Add template "clock12" and "clock24" to plot data which are time. Add dist.circular function. Add heatmap.circular function. Add medianCircular function. Add offset argument to the lines.circular, lines.density.circular, plot.density.circular functions. Add shrink argument to the lines.circular function. Function lines.circular return x and y in the invisible object. Fixed the name of the help page for the circular function. Version 0.3-8, 2007/08/15 Now unique.circular calls unique.default instead of the internal function. print.rao.spacing.test loads locally the dataset rao.table Version 0.3-7, 2007/08/13 Fix a problem in the api of unique.circular function, fix the documentation of summary.circular and [.circular. Version 0.3-6, 2006/08/28 Changed long declaration into int in circular/src/rvonmises.c file Version 0.3-5, 2006/08/10 Rewrite most of the functions. Add functions c.circular, unique.circular, curve.circular, plot.function.circular, lines.circular. Add arguments to conversion.circular and change its behavior. Add pwrappednormal, qwrappednormal (experimental versions). Add new features to r,d,p,q functions (now mu must be specifies using a circular object) Almost all the functions use control.circular argument in order to specify the attribute of the resulting object. The rvonmises function uses a C code from Harry Southworth. Version 0.3-4, 2006/02/13 Add an argument to windrose, rewrite small part of it. Fix typos in kuiper.test.Rd, extract.Rd and lm.circular.Rd. Now, var.default definition in var.circular.R point to stats::var and not to base::var Version 0.3-3, 2005/12/06 Add NAMESPACE file. Functions now use atan2 instead of atan when two arguments. summary.circular is fixed. Version 0.3-2, 2005/05/05 Remove direct call to x11() in man pages. Version 0.3-1, 2005/05/05 Remove the alias density and density.default and the corresponding documentation. Fix a problem in the documentation of lsfit.circle. Change MSE and SSE to MS and SS in aov.circular Version 0.3, 2005/04/27 All the functions handle NA values. Most of them by removing NA (without ask). When more than one variable is needed only complete cases are considered. Added functions: aov.circular, equal.kappa.test, lsfit.circle Modified the function lm.circular so that now circular-circular and circular-linear regression are available Version 0.2, 2004/12/25 Added function windrose Version 0.1, 2004/05/24 Released the version Version 0.1, 2003/12/23 Pre-released version of the circular package Fixed a consistency for range.circular function Version 0.1, 2003/12/03 Pre-released version of the circular package build on the R port of CircStats. Claudio Agostinelli Department of Statistics University Ca' Foscari of Venice Italy http://www.dst.unive.it/~claudio