r2d2/0000755000176200001440000000000014236715742011036 5ustar liggesusersr2d2/NAMESPACE0000644000176200001440000000065214236554267012263 0ustar liggesusersimportFrom(graphics, polygon) importFrom(grDevices, contourLines) importFrom(KernSmooth, dpik, bkde2D) importFrom(MASS, bandwidth.nrd, kde2d) importFrom(sp, over, Polygon, Polygons, SpatialPoints, SpatialPolygons) export(conf2d, conf2d.default, conf2d.formula, conf2d_int, freq2d, freq2d.default, freq2d.formula) S3method(conf2d, default) S3method(conf2d, formula) S3method(freq2d, default) S3method(freq2d, formula) r2d2/data/0000755000176200001440000000000014236560225011741 5ustar liggesusersr2d2/data/Ushape.rda0000644000176200001440000001524014236560225013660 0ustar liggesusers]+e;҅d23Lٿ4A қ4i""]"rA]D@. ]\"Ho?kݻ:g$3lVB[-4k֬g;y?N~5׬yg-8>{va]/-6kb)w3Zȏ)?j/.Zz>{{.3}\gŋҥ> {Lú^~!Œn)?⸭Wj^ly? S|PO\/;'o4K6u:蹯jF'i}ebֱ3Gs_b7_MN:g>rx용o)K&`0=Vnu'?|1:7+>}uϓLC+h"j7xLgw~o|OeuQiؠ+3nmjft= M jF/7ftϮL2M=/SDfg=jFO̼6keF}_g_N>HQ$?>o0#XgyM's̖^ohHߣc8ycyy\ЌٱX_-@?7}:f}jD +~O~9qM(=ovigGy8vo7{c+m6oKL=)1'ۍ)ul{dK{ۯww|v7%3d⚱/o1quM_e8͞mޜsڤ(n[ p%;ÉM5t}*'gWO=_gB##]]?5ɏ&ۤO1B¹t=r=a;q&J{cKI{g=oL_d[^5i Wܤ ߙ㝢k- n͘w+SH8Z_Dz OJo㒫Jk%Mw-k4fU2Wc,a(u^<6i28Dzoֹ Oew7G?z|U-RJ>Q/(/KTj Ĺ>\BGi;J,c¯yݿ뜕m7+S/sαrީ3Ք^xKwɳeCsQ?\)|UBa*gFvX[,sM'_ه:KP=ظ"8 3Gd:ѷf37c~mqciO G>/STZ =MvovnT37$y<˷ xs aѤlޡ:ǫ/>Zv9[?FO wEn-ȵO~!8NONv59Oz_ M{^?3MkT8A O|Wo-kc>ߪ֏mG+ w׻ۨsܠNh/kH_m\<ԁ7:ypx-⸷=L<цmx_~I>Px/^.~3W?0ݑ6voMw:έee&q$Wֹ{k:CkŇS:}Ҏ%P_hs6q}Ms$];@?::,g[z}`m¿HR#?>%fOBG}H gG抏 B)!xJ55<*|Y >p5C/åT ~$wU|l"{D)U#W*._Gԝ{["&"_DB;m3:\٧]%#/g(^SG~1O]*wQh]7.&ʎ pO'&E𾸬 ))/$ޫf N'ooE7]S#H~4򏸡J{f3^OoÙnbGQh)yD}\M7:O1}T_{xG%FnۏK.K9O9ޘ{'ѷ%s.y4]Wy2NϘC$ W9?dӷ^IW}㊻tysڪ#ɵg)}_C+<"݊Ó/9q!IWKU?4r>g鳂 s~ʼ##Rk>UlF(V^H*}G~Ϣo6sႺ1>)<*{y]y(\}t;Ⱥ±lcN!Rx\weG1_!𳑝s-~<~h6o"(%̕w9F[ x舸9}}>DOPOçm 9FxU/ϮRZ#z~p,^̘;C' ;_~>U_|=Ȗ>Wͨ;Gwߕ\;Ɏ1F+ϚyfQ:YL‡H'tbSr|7Zh?W.+3ʋ~ѿ)G^ SoW%}O-%~MSЗ,s:> dNdĜ8ys886 >ԝB<[̳݇ls0Sr˻w7]d4 9Hi(oY+R9 ϣca3WqL S,K2UlS[IjӗIm=WOO){U uM-%{)">}M1slLwׄ}d/uuq¼,o>Bdqx&#ٺnCÏ;C *LD:bs &?RvRgvosl~_>{yCXާ>Sg~૕3:[b߇c|>|˞;~곗YNe"?`k@n*{[GCs-[tdI@|o 3>[o  C>Gҟ0 \&J>6 w7*x@x>rU><1Xs1S_]{g@F^~h1w%\1_0]2G]/=xVtusU 铅WCzoؿ>GN$|1gww?Nz =m%WryZ^Hyj!|l1l1Q ~Aq}]a>=MHyxTN>szE=dku|؟{vݦnhr{,||~E8dRxՠ?۠N7M#YjOvλ{[?4w݇Z6]u9vsJ~S:Dv~{^ G$oVQaoJO|g`}(fkd'='].쒗jo>]{L̙]o|em@%[~OepʾOY?wm <ɇ݃o/eyMezçzqΞ!<%p/{vO~?C0,c=ʞ_:j)}K\e$A]gE:)z߷{%]vo۔"{bKe<%]-RV2uG0E'3U2.~ZW| 7*Q?W}=XpBTTyU*` /psSY?SQoW% ^[c Fok*e\j W幡*vr~#}8Oxnfq>Ǿ^<ÃCٽt= Wi=8mEAM~e~W/^o<>ke[a]^z}=sb8W_F?r2d2/data/saithe.rda0000644000176200001440000001635114236560225013714 0ustar liggesusers]\Uօ$Cgp9Hp0   k}]gp zUu'@Կd-HW}Ϩ6yzzz Rhga=sq3g]== ? xR1S5|A3g56o RwqGRuIk\iܕsKvo6)=fBZnzQöM׏`~_)'Hh^-qcO}7'ߊSR óI[%űy3mE?M+.ݲdaw_v]IFB ϲ_(ϳHKАޏߺd$1>a/$eo9a$떔d|zƒ|EK:njկɬ]p֗׾?lVs5$?͖@ .QstѤ夵Ql+Iu$&%^1"œ߽߿׻sJ!Ƶ%D\/zLIy59Bp׫{}nkYN^5xYcjOɾp S>;\]R2s7 ozi[)N(OqۼM`%]Vg?r^nu$2;M}?4^l;֑`7;燻7}Tv{OY=s8-xcJozHW6 Y =]p,ޑKYX;(5g';K~;/ 8u'hXH`cN}fYs--6!$u&:7[ZjF$C=׭;R3}߷vΒGsI+{Н2Ѽ8I|Du'+_~|s߼1Jy{ߏ.RSwalc)춏kVSIҳ_񘹿_ɛtߊ_%"eC\f^ӫR,on) >܄I :~ju@HˆBRLO̺$RpXU*A6b R]Z[ &CY3\۽kN^2>6dl?R'y}ȋsJ:ߺsibbv5JXo'6i%b/ !g<Iff{$ /g_6W_CTT~k)!C{ # ۣi. иq:QF-6%ޓܾBZeQһ-HV"iXͤ}&b /,P;O{/J{|]<&yiLrK̺ p2Y2Fknҍ bM [$%J XPBs=/ke4?aϕlά^O$X&G*&!Nm^h͹W@:դNo%X$RZxX\Tlɨ7sX58G|p(3aėg2`oD'}*Hd`.|^]&'.s +/Eՙ C>o NX|)-#1qޞn7LߚOBe2H)vv{瓂?5>lr$Kx y]wijk$N<%]<J[Ɨ׺(:k,-9tהOόs(,pq[%ergǔHmܖwK |i[:t+aO#f?^Xr.}pvT5GL\BijoxI]I$s+%yM$9<[n@y'^ 4Rܳ>Ddީﺆ.Km+UII-QBN5TW@D4nep_򾏺*2/^W'׼~"YxM4ዊ 517ك?~\ !VBpؿk0`Rw{[W\WAe[?dzęd83(N̨ϗs챯(I%|쳚*/}t=3%6e}S$k u`oWpL? p}.ǡ\/ xS*5{&?~[ {?K G\: p$nGï +O -0Ka`n+Ч_b RjzgNgǥ> ,ռ1wޕ <1<*'?KS;[|:7erS;**ԕr9CN:z'HN*?H ۧƝ79|+OfFҚ,`E)7>8c%7p 4xCݗկHg-a|]C=ܹ>2-v6h{*` })Q' pۇq3Ϳ$Kmݯk }RP]?WJ]96?)) oH{5f+%ܔ^/1Y3Rvz}Rv-_;n9g+szC6]?kjf$9C~wʞ]$58z wUK>6Us狺W?K?W]?,ϡ2}Mt)mzm))xq.~҂ u-LoX&fUǽ*mSv~YRl4\WyUJe.%o=%Gǔo]HD) [(D'Ľʓd_Kxa:ӏQ2+?XԵ| ݦg`Թ<3n~[ZKkn7P\>a on0۴7ݺGm[ Utd:y?& U2K$2a)q[zaͯlJL^&].T SN%,Rq9qק9)RmhHa<:8H ÙQ[[1>Dboқ5$7@rp£NEcF=.*-K ϩ__&-ᩆ=$ >G!9z2np_:\S-<-%:CW@*~Ͷ8UεRGIQ_JA8GJ$BŶ -Kz?VH5 K)SӖ}k`dʤWtukEn]_2BI_@,R4YjqƇ9ycX_bz~<}^Ԭs|vP/UtFHޖ<(~q8J^PVw=x)k%4{4K%`gx04sRӆ=/\(/9#tD5RXZ5dC'6\l %k*Guok)]R#F+9:ڲ2gJ6-0҆/j[t Eİc 3 u~m_vxM9BJα _-0]wы1|62kmx"1l&ʬc$mtIï) !1|11qG*#{M6YVV">:?~Qח*Oh]cSc=w7lާ:wmt;)U6X xM u\_S:r0o x?}^ >ƣ4C;PoM'贔,9RK]rY}-]#s?u~zXuel'f 6R˪~0rYNq}܃4Z.gv;畔~v  <>uNmyx2Т_X|q,aPϰ!1}b#|:o>KI/ S, n M7I˶7OTh7&/>) š߯}J~]}j1D|_s' 7GC T޷!#̥Ѣ-.6 u~qAM9vCx֢9|nK? BlW't·}M3gFjY8[Z'}rg#tifcf[|u[_y,aoLSӧpqW)]Nmk>sA&mNM"{1&̖q!i#c~y.<5Go!k%T/s/q+3_z}>'};XCIB+K^x4xCq=j U8׀GЦ1h?ؖYLr|El)W~RS:@^߱ 5vC._vZNV?A":\bĹ |>wE|e%`MI_3>f"4/cg;>^ʗvuCNl i־:JZoDwu`= 3[}ԧ+GRZ?>w/u6ҋ1=gmO)147Xg.yԷ_K98}ׂzkF]B]jKynj<-]ݹ }om:8N(9y?"/vM8}kOj"c>SV/}Qcᖕz4O[/:.ӹ{ݩXU'Eԃ=+#>5rii\⥁w4ᙎGX"(2-z~@:$O߽Mg4tu_V|Lm_Zߪ.Y _@tO5ӝ >mpOpZ^8mEiC&qqڠND΃ó#~k9V\ľ4e1C9 -ⶉ/@gw玉^xTg˹Qu.3w5-:K}/}OA q C/@oOZ}&sc coi2gѴ4meilKZĵzB5tmH!3)ȈsMvdheI?*OGu9U<郧~7yM~9oz3_дzH &} '%[tyʖűҿk109Рn OQo{eUMB7/T}XFcyWqoNz>g)}dIoӢnd]c#{VZɛUeiY]/?'gn3#\snX*F_t[#V܍CE?2oɗ&x 9xvyR)OgP"-<6?H%ay,>~/w-)$ũ̆q79 '}sw7ӗL8h\0|3 a.8o{~xh:]ˡѢOQ"GGs>.|DGQSʆ[mpcx Έiۂs:KKD3 ~Ʃ~ 9'Cο_j>5yRW2ֺ^r?O> 9&u32} iKs1 =Wq#o,R<~Ѣ2{>w.}sHMn> 1}_|$~s.:NGNSbR}&ܤDBqsrM[uB_Sw|+ ԗ1;<9'7rmKo79τ9j?p-#T>U7g"f&D6Ly}5q f/=tW9_ \!"V}>/9}4\~?*й"~dy_s|g)U_O-[~.7}>w_7)1 4#GŊ:?U-c%z6a>Y}=jJf_U<U}}>Y{IȜӱ^5M}6<_<yXL"q7C'=ai >n9t'㐝O}Ig߼{#{^Z9ϑcOQ֟_2XS?r2d2/man/0000755000176200001440000000000014236473046011607 5ustar liggesusersr2d2/man/conf2d.Rd0000644000176200001440000001120314236473046013246 0ustar liggesusers\name{conf2d} \alias{conf2d} \alias{conf2d.default} \alias{conf2d.formula} \alias{conf2d_int} \title{Bivariate (Two-Dimensional) Confidence Region} \description{ Calculate an empirical confidence region for two variables, and optionally overlay the smooth polygon on a scatterplot. } \usage{ conf2d(x, \dots) \method{conf2d}{formula}(formula, data, subset, \dots) \method{conf2d}{default}(x, y, level=0.95, n=200, method="wand", shape=1, smooth=50, plot=TRUE, add=FALSE, xlab=NULL, ylab=NULL, col.points="gray", col="black", lwd=2, \dots) conf2d_int(x, y, surf, level, n) # internal function } \arguments{ \item{x}{a vector of x values, or a data frame whose first two columns contain the x and y values.} \item{y}{a vector of y values.} \item{formula}{a \code{\link{formula}}, such as \code{y~x}.} \item{data}{a \code{data.frame}, \code{matrix}, or \code{list} from which the variables in \code{formula} should be taken.} \item{subset}{an optional vector specifying a subset of observations to be used.} \item{level}{the proportion of points that should be inside the region.} \item{n}{the number of regions to evaluate, before choosing the region that matches \code{level} best.} \item{method}{kernel smoothing function to use: \code{"wand"} or \code{"mass"}.} \item{shape}{a bandwidth scaling factor, affecting the polygon shape.} \item{smooth}{the number of bins (scalar or vector of length 2), affecting the polygon smoothness.} \item{plot}{whether to plot a scatterplot and overlay the region as a polygon.} \item{add}{whether to add a polygon to an existing plot.} \item{xlab}{a label for the x axis.} \item{ylab}{a label for the y axis.} \item{col.points}{color of points.} \item{col}{color of polygon.} \item{lwd}{line width of polygon.} \item{\dots}{further arguments passed to \code{plot} and \code{polygon}.} \item{surf}{a list whose first three elements are x coordinates, y coordinates, and a surface matrix.} } \details{ This function constructs a large number (\code{n}) of smooth polygons, and then chooses the polygon that comes closest to containing a given proportion (\code{level}) of the total points. The default \code{method="wand"} calls the \code{\link[KernSmooth]{bkde2D}} kernel smoother from the \pkg{KernSmooth} package, while \code{method="mass"} calls \code{\link[MASS]{kde2d}} from the \pkg{MASS} package. The \code{conf2d} function calls \code{bkde2D} or \code{kde2d} to compute a smooth surface from \code{x} and {y}. If users already have a smoothed surface to work from, the internal \code{conf2d_int} can be used directly to find the empirical confidence region that matches \code{level} best. } \value{ List containing five elements: \item{x}{x coordinates defining the region.} \item{y}{y coordinates defining the region.} \item{inside}{logical vector indicating which of the original data coordinates are inside the region.} \item{area}{area inside the region.} \item{prop}{actual proportion of points inside the region.} } \note{ The \code{area} of a bivariate region is analogous to the range of a univariate interval. This allows a quantitative comparison of different confidence regions. Ellipses are a more restrictive approach to calculate an empirical bivariate confidence region. Smooth polygons make fewer assumptions about how x and y covary. The \code{conf2d} and \code{freq2d} functions are closely related. The advantage of \code{conf2d} is that it returns a region as a smooth polygon. The advantage of \code{freq2d} is that it returns a set that is guaranteed to contain the correct proportion of points, even for spatially complex datasets. } \author{ Arni Magnusson and Julian Burgos, based on an earlier function by Gregory R. Warnes. } \seealso{ \code{\link{quantile}} is the corresponding univariate equivalent. The \pkg{distfree.cr} package uses a different smoothing algorithm to calculate bivariate empirical confidence regions. \code{\link[gplots]{ci2d}} in the \pkg{gplots} package is a predecessor of \code{conf2d}. \code{\link{freq2d}} calculates a discrete frequency distribution for two continuous variables. \code{\link{r2d2-package}} gives an overview of the package. } \examples{ conf2d(Ushape)$prop conf2d(saithe, pch=16, cex=1.2, col.points=rgb(0,0,0,0.1), lwd=3) # First surface, then region plot(saithe, col="gray") surf <- MASS::kde2d(saithe$Bio, saithe$HR, h=0.25, n=100) region <- conf2d_int(saithe$Bio, saithe$HR, surf, level=0.95, n=200) polygon(region, lwd=2) } % Graphics \keyword{dplot} % Statistics \keyword{distribution} \keyword{multivariate} \keyword{smooth} r2d2/man/r2d2-package.Rd0000644000176200001440000000251114236547177014246 0ustar liggesusers\name{r2d2-package} \alias{r2d2-package} \alias{r2d2} \docType{package} \title{ Bivariate (Two-Dimensional) Confidence Region and Frequency Distribution } \description{ This package provides generic functions to analyze the distribution of two continuous variables. } \details{ \emph{Bivariate calculations:} \tabular{ll}{ \code{\link{conf2d}} \tab empirical confidence region, a smooth polygon\cr \code{\link{freq2d}} \tab frequency distribution, a table } \emph{Examples:} \tabular{ll}{ \code{\link{saithe}} \tab MCMC results in two columns\cr \code{\link{Ushape}} \tab U-shaped cloud in two columns } } \author{ Arni Magnusson and Julian Burgos, based on earlier functions by Gregory R. Warnes. } \references{ Bivand, R. S., Pebesma, E., and Gomez-Rubio, V. (2013). \emph{Applied Spatial Data Analysis with R}. Second edition. New York: Springer. Venables, W. N. and Ripley, B. D. (2002). \emph{Modern Applied Statistics with S}. Fourth edition. New York: Springer. Wand, M. P. and Jones, M. C. (1995). \emph{Kernel Smoothing}. London: Chapman and Hall. } \seealso{ Combines existing tools from the \pkg{KernSmooth}, \pkg{MASS}, and \pkg{sp} packages. } % Graphics \keyword{dplot} % Basics \keyword{manip} % Statistics \keyword{distribution} \keyword{multivariate} \keyword{smooth} r2d2/man/saithe.Rd0000644000176200001440000000201614236550102013337 0ustar liggesusers\name{saithe} \alias{saithe} \docType{data} \title{MCMC Results from Saithe Assessment} \description{ Markov chain Monte Carlo results from the analysis of the saithe (\emph{Pollachius virens}) fishery in Icelandic waters. } \usage{saithe} \format{ Data frame containing 1000 rows and 2 columns: \tabular{ll}{ \code{Bio}\tab population biomass in 2013, relative to the expected long-term biomass under optimal harvest rate.\cr \code{HR}\tab harvest rate in 2013, relative to the optimal harvest rate. } } \references{ Magnusson, A. (2013). Icelandic saithe. In: \emph{Report of the North Western Working Group (NWWG)}. ICES CM 2013/ACOM:07, pp. 231--252. \doi{10.17895/ices.pub.5284}. Magnusson, A., Punt, A. E., and Hilborn, R. (2013). Measuring uncertainty in fisheries stock assessment: the delta method, bootstrap, and MCMC. \emph{Fish and Fisheries} \bold{14}, 325--342. \doi{10.1111/j.1467-2979.2012.00473.x}. } \examples{ conf2d(saithe, level=0.9) freq2d(saithe) } \keyword{datasets} r2d2/man/Ushape.Rd0000644000176200001440000000060114236473046013320 0ustar liggesusers\name{Ushape} \alias{Ushape} \docType{data} \title{U-Shaped Cloud} \description{ Bivariate scatter shaped like an open circle, for testing spatial algorithms. } \usage{Ushape} \format{ Matrix containing 1000 rows and 2 columns: \tabular{ll}{ \code{x}\tab x coordinates.\cr \code{y}\tab y coordinates. } } \examples{ freq2d(Ushape) conf2d(Ushape) } \keyword{datasets} r2d2/man/freq2d.Rd0000644000176200001440000000555114236473046013267 0ustar liggesusers\name{freq2d} \alias{freq2d} \alias{freq2d.default} \alias{freq2d.formula} \title{Bivariate (Two-Dimensional) Frequency Distribution} \description{ Calculate a frequency distribution for two continuous variables. } \usage{ freq2d(x, \dots) \method{freq2d}{formula}(formula, data, subset, \dots) \method{freq2d}{default}(x, y, n=20, pad=0, layout=1, print=TRUE, dnn=NULL, \dots) } \arguments{ \item{x}{a vector of x values, or a data frame whose first two columns contain the x and y values.} \item{y}{a vector of y values.} \item{formula}{a \code{\link{formula}}, such as \code{y~x}.} \item{data}{a \code{data.frame}, \code{matrix}, or \code{list} from which the variables in \code{formula} should be taken.} \item{subset}{an optional vector specifying a subset of observations to be used.} \item{n}{the desired number of bins for the output, a scalar or a vector of length 2.} \item{pad}{number of rows and columns to add to each margin, containing only zeros.} \item{layout}{one of three layouts for the output: \code{1}, \code{2}, or \code{3}.} \item{print}{whether to display the resulting matrix on the screen using dots for zeros.} \item{dnn}{the names to be given to the dimensions in the result.} \item{\dots}{named arguments to be passed to the default method.} } \details{ The exact number of bins is determined by the \code{\link{pretty}} function, based on the value of \code{n}. Padding the margins with zeros can be helpful for subsequent analysis, such as smoothing. The \code{print} logical flag only has an effect when \code{layout=1}. } \value{ The \code{layout} argument specifies one of the following formats for the binned frequency output: \enumerate{ \item{\code{matrix} that is easy to read, aligned like a scatterplot.} \item{\code{list} with three elements (x, y, matrix) that can be passed to various plotting functions.} \item{\code{data.frame} with three columns (x, y, frequency) that can be analyzed further.} } } \author{Arni Magnusson.} \seealso{ \code{\link{cut}}, \code{\link{table}}, and \code{\link{print.table}} are the basic underlying functions. \code{\link[gplots]{hist2d}} in the \pkg{gplots} package is a related function with graphical capabilities. \code{\link{conf2d}} calculates a bivariate empirical confidence region, a smooth polygon. \code{\link{r2d2-package}} gives an overview of the package. } \examples{ freq2d(Ushape) freq2d(quakes$long, quakes$lat, dnn="") freq2d(lat~long, quakes, n=c(10,20), pad=1) # Supress display freq2d(saithe) range(freq2d(saithe, print=FALSE)) # Layout, plot freq2d(saithe, layout=2) freq2d(saithe, layout=3) contour(freq2d(saithe, layout=2)) lattice::contourplot(Freq~Bio+HR, freq2d(saithe,layout=3)) } % Graphics \keyword{dplot} % Basics \keyword{manip} % Statistics \keyword{distribution} \keyword{multivariate} r2d2/DESCRIPTION0000644000176200001440000000155514236715742012552 0ustar liggesusersPackage: r2d2 Version: 1.0.1 Date: 2022-05-11 Title: Bivariate (Two-Dimensional) Confidence Region and Frequency Distribution Authors@R: c(person("Arni", "Magnusson", role=c("aut","cre"), email="thisisarni@gmail.com"), person("Julian", "Burgos", role="aut"), person(c("Gregory","R."), "Warnes", role="ctb")) Imports: graphics, grDevices, KernSmooth, MASS, sp Suggests: lattice LazyData: yes Description: Generic functions to analyze the distribution of two continuous variables: 'conf2d' to calculate a smooth empirical confidence region, and 'freq2d' to calculate a frequency distribution. License: GPL-3 NeedsCompilation: no Packaged: 2022-05-10 22:00:53 UTC; arnim Author: Arni Magnusson [aut, cre], Julian Burgos [aut], Gregory R. Warnes [ctb] Maintainer: Arni Magnusson Repository: CRAN Date/Publication: 2022-05-11 11:20:02 UTC r2d2/build/0000755000176200001440000000000014236560225012127 5ustar liggesusersr2d2/build/partial.rdb0000644000176200001440000000007314236560225014254 0ustar liggesusersb```b`a 0X84k^bnj1!d7r2d2/R/0000755000176200001440000000000014236473046011235 5ustar liggesusersr2d2/R/conf2d.R0000644000176200001440000000624214236551016012531 0ustar liggesusersconf2d <- function(x, ...) { UseMethod("conf2d") } conf2d.formula <- function(formula, data, subset, ...) { m <- match.call(expand.dots=FALSE) if(is.matrix(eval(m$data,parent.frame()))) m$data <- as.data.frame(data) m$... <- NULL m[[1L]] <- as.name("model.frame") mf <- eval(m, parent.frame()) conf2d.default(mf[2:1], ...) } conf2d.default <- function(x, y, level=0.95, n=200, method="wand", shape=1, smooth=50, plot=TRUE, add=FALSE, xlab=NULL, ylab=NULL, col.points="gray", col="black", lwd=2, ...) { method <- match.arg(tolower(method), c("wand","mass")) ## 1 Extract data if(is.matrix(x)) x <- as.data.frame(x) if(is.list(x)) # data.frame or list { xlab <- if(is.null(xlab)) names(x)[1] else xlab ylab <- if(is.null(ylab)) names(x)[2] else ylab y <- x[[2]] x <- x[[1]] } ## 2 Plot xy scatter if(plot && !add) { if(is.null(xlab)) xlab <- deparse(substitute(x)) if(is.null(ylab)) ylab <- deparse(substitute(y)) plot(x, y, xlab=xlab, ylab=ylab, lwd=1, col=col.points, ...) } ## 3 Compute surface matrix smooth <- rep(smooth, length.out=2) if(method == "wand") { bandwidth <- c(dpik(x), dpik(y)) surf <- bkde2D(cbind(x,y), bandwidth=1.3*bandwidth*shape, gridsize=c(smooth,smooth)) } else # mass { bandwidth <- c(bandwidth.nrd(x), bandwidth.nrd(y)) lx <- range(x) + c(-0.05,0.05)*diff(range(x)) ly <- range(y) + c(-0.05,0.05)*diff(range(y)) surf <- kde2d(x, y, h=bandwidth*shape, n=5*smooth/shape, lims=c(lx,ly)) } ## 4 Find best region output <- conf2d_int(x, y, surf, level, n) if(abs(level-output$prop) > 0.01) warning("appropriate region not found (desired level=", level, ", but actual prop=", round(output$prop,3), ")") ## 5 Overlay polygon if(plot || add) { polygon(output, lwd=lwd, border=col, col=NA, ...) invisible(output) } else { output } } conf2d_int <- function(x, y, surf, level, n) { ## 1 Slice surface into candidate regions (as contour lines) cl <- contourLines(surf[[1]], surf[[2]], surf[[3]], nlevels=n) ## 2 Find best region by counting the points inside pts <- SpatialPoints(cbind(x,y)) spols <- list() # spatial polygons representing candidate regions pin <- numeric(length(cl)) # number of points inside each region for(i in seq_len(length(cl))) { spol <- tryCatch(Polygon(cbind(cl[[i]]$x,cl[[i]]$y)), error=function(...) NA) spol <- tryCatch(Polygons(list(spol),ID=" "), error=function(...) NA) spol <- tryCatch(SpatialPolygons(list(spol)), error=function(...) NA) pin[i] <- tryCatch(sum(!is.na(over(pts,spol))), error=function(...) 0) spols[[i]] <- spol } pin <- pin / length(x) best <- which.min(abs(pin-level)) ## 3 Extract statistics best.spol <- spols[[best]]@polygons[[1]]@Polygons[[1]] xcoords <- best.spol@coords[,1] ycoords <- best.spol@coords[,2] inside <- !is.na(over(pts,spols[[best]])) area <- best.spol@area prop <- pin[best] output <- list(x=xcoords, y=ycoords, inside=inside, area=area, prop=prop) output } r2d2/R/freq2d.R0000644000176200001440000000500214236551242012533 0ustar liggesusersfreq2d <- function(x, ...) { UseMethod("freq2d") } freq2d.formula <- function(formula, data, subset, ...) { m <- match.call(expand.dots=FALSE) if(is.matrix(eval(m$data,parent.frame()))) m$data <- as.data.frame(data) m$... <- NULL m[[1L]] <- as.name("model.frame") mf <- eval(m, parent.frame()) freq2d.default(mf[2:1], ...) } freq2d.default <- function(x, y, n=20, pad=0, layout=1, print=TRUE, dnn=NULL, ...) { method <- match.arg(as.character(layout), c("1","2","3")) dnn <- if(!is.null(dnn)) rep(dnn,length.out=2) else NULL xname <- dnn[1] yname <- dnn[2] ## 1 Extract data if(is.matrix(x)) x <- as.data.frame(x) if(is.list(x)) # data.frame or list { xname <- if(is.null(xname)) names(x)[1] else xname yname <- if(is.null(yname)) names(x)[2] else yname y <- x[[2]] x <- x[[1]] } ## 2 Create grid n <- rep(n, length.out=2) xmid <- pretty(x, n=n[1]) xstep <- diff(xmid)[1] xgrid <- c(xmid-0.5*xstep, max(xmid)+0.5*xstep) ymid <- pretty(y, n=n[2]) ystep <- diff(ymid)[1] ygrid <- c(ymid-0.5*ystep, max(ymid)+0.5*ystep) ## 3 Map data on grid xfac <- cut(x, xgrid, include.lowest=TRUE, labels=format(xmid)) if(is.null(xname)) xname <- deparse(substitute(x)) yfac <- cut(y, ygrid, include.lowest=TRUE, labels=format(ymid)) if(is.null(yname)) yname <- deparse(substitute(y)) z <- table(xfac, yfac, dnn=c(xname,yname)) ## 4 Remove existing edges with only zeros z <- z[cumsum(rowSums(z))>0, cumsum(colSums(z))>0] z <- z[rev(cumsum(rev(rowSums(z))))>0, rev(cumsum(rev(colSums(z))))>0] ## 5 Add edges with only zeros for(i in seq_len(pad)) { tmp <- cbind(0, rbind(0, z, 0), 0) rownames(tmp)[c(1,nrow(tmp))] <- as.numeric(rownames(z)[c(1,nrow(z))]) + c(-xstep,xstep) colnames(tmp)[c(1,ncol(tmp))] <- as.numeric(colnames(z)[c(1,ncol(z))]) + c(-xstep,xstep) names(dimnames(tmp)) <- names(dimnames(z)) z <- tmp } ## 5 Prepare output xnum <- as.numeric(rownames(z)) ynum <- as.numeric(colnames(z)) if(layout == 1) { output <- t(z)[ncol(z):1,] if(print) { print.table(output, zero.print=".") invisible(output) } else { output } } else if(layout == 2) { output <- list(x=xnum, y=ynum, z=z) output } else # layout 3 { output <- data.frame(x=rep(xnum,length(ynum)), y=rep(ynum,each=length(xnum)), z=c(z)) names(output) <- make.names(c(xname,yname,"Freq"), unique=TRUE) output } } r2d2/NEWS.md0000644000176200001440000000015214236551603012124 0ustar liggesusers# r2d2 1.0.1 (2022-05-11) * Added doi to references. --- # r2d2 1.0.0 (2014-03-31) * Initial release. r2d2/MD50000644000176200001440000000115414236715742011347 0ustar liggesusers8c47b57e6531c08d7c35b09e48c9a66a *DESCRIPTION 07a68f40f5947698c4975b897ec4725d *NAMESPACE 8d9d17fbdedac5812c582f3e4878ac72 *NEWS.md 56caac2c82f335fb09254dd92cef24ef *R/conf2d.R 4ca84e820699e8fed347a99d47212d49 *R/freq2d.R 1961639f6f4f7f9efffa91b624b3d060 *build/partial.rdb eee1a444a9710752003c90989fffa7b4 *data/Ushape.rda 41e3a5c18bfe7a894084af7021bea814 *data/saithe.rda 87d865b3b578ce618c48d4bd690ed4cb *man/Ushape.Rd 12a277321ff96d7fb4ff30751462545e *man/conf2d.Rd 841739748ac1d92dc2b0a3473a7ef953 *man/freq2d.Rd 1564ff58c9dadc2fd774bb37a53c63b2 *man/r2d2-package.Rd 82d93ec067ca8f1be0e02f6489f722fd *man/saithe.Rd