biwt/0000755000176000001440000000000012043442453011250 5ustar ripleyusersbiwt/NAMESPACE0000644000176000001440000000030712043442453012467 0ustar ripleyusers# Default NAMESPACE created by R # Remove the previous line if you edit this file # Export all names exportPattern(".") # Import all packages listed as Imports or Depends import( rrcov, MASS ) biwt/man/0000755000176000001440000000000011236116273012024 5ustar ripleyusersbiwt/man/biwt.est.Rd0000744000176000001440000000625211245047000014047 0ustar ripleyusers\name{biwt.est} \alias{biwt.est} %- Also NEED an '\alias' for EACH other topic documented here. \title{A function to compute Tukey's biweight mean vector and covariance matrix} \description{ Compute a multivariate location and scale estimate based on Tukey's biweight weight function. } \usage{ biwt.est(x, r=.2, med.init=covMcd(x)) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ a \eqn{2 x n} matrix or data frame (\eqn{n} is the number of measurements)} \item{r}{ breakdown (\eqn{k/n} where \eqn{k} is the largest number of measurements that can be replaced with arbitrarily large values while keeping the estimates bounded). Default is r=.2. } \item{med.init}{ a (robust) initial estimate of the center and shape of the data. The format is a list with components center and cov (as in the output of covMcd from the rrcov library). Default is the minimum covariance determinant (MCD) on the data. } } \details{ A robust measure of center and shape is computed using Tukey's biweight M-estimator. The biweight estimates are essentially weighted means and covariances where the weights are calculated based on the distance of each measurement to the data center with respect to the shape of the data. The estimates should be computed pair-by-pair because the weights should depend only on the pairwise relationship at hand and not the relationship between all the observations globally. } \value{ A list with components: \item{biwt.mu}{the final estimate of center} \item{biwt.sig}{the final estimate of shape} } \references{ Hardin, J., Mitani, A., Hicks, L., VanKoten, B.; \bold{A Robust Measure of Correlation Between Two Genes on a Microarray}, \emph{BMC Bioinformatics}, \bold{8}:220; 2007. } \author{Jo Hardin \email{jo.hardin@pomona.edu} } \seealso{ \code{\link{biwt.cor}}} \note{ If there is too much missing data or if the initialization is not accurate, the function will compute the MCD for a given pair of observations before computing the biweight correlation (regardless of the initial settings given in the call to the function). } \examples{ samp.data <- t(mvrnorm(30,mu=c(0,0),Sigma=matrix(c(1,.75,.75,1),ncol=2))) samp.bw <- biwt.est(samp.data) samp.bw samp.bw.var1 <- samp.bw$biwt.sig[1,1] samp.bw.var2 <- samp.bw$biwt.sig[2,2] samp.bw.cov <- samp.bw$biwt.sig[1,2] samp.bw.cor <- samp.bw.cov / sqrt(samp.bw.var1 * samp.bw.var2) samp.bw.cor # or: samp.bw.cor <- samp.bw$biwt.sig[1,2] / sqrt(samp.bw$biwt.sig[1,1]*samp.bw$biwt.sig[2,2]) samp.bw.cor ############## # to speed up the calculations, use the median/mad for the initialization: ############## samp.init <- list() samp.init$cov <- diag(apply(samp.data,1,mad,na.rm=TRUE)) samp.init$center <- apply(samp.data,1,median,na.rm=TRUE) samp.init samp.bw <- biwt.est(samp.data,med.init = samp.init) samp.bw.cor <- samp.bw$biwt.sig[1,2] / sqrt(samp.bw$biwt.sig[1,1]*samp.bw$biwt.sig[2,2]) samp.bw.cor } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{robust} \keyword{multivariate} \keyword{cluster} %\keyword{biweight} %\keyword{correlation} %\keyword{Tukey} biwt/man/biwt-package.Rd0000744000176000001440000000512711245040076014654 0ustar ripleyusers\name{biwt-package} \Rdversion{1.1} \alias{biwt-package} \alias{biwt} \docType{package} \title{ A package to compute the biweight mean vector and covariance & correlation matrices} \description{ Compute multivariate location, scale, and correlation estimates based on Tukey's biweight weight function. } \details{ \tabular{ll}{ Package: \tab biwt\cr Type: \tab Package\cr Version: \tab 1.0\cr Date: \tab 2009-07-20\cr License: \tab GPL-2\cr LazyLoad: \tab yes\cr } The two basic functions (1) calculate multivariate estimates of location and shape based on Tukey's biweight, and (2) compute correlations based on the biweight. The correlation functions also have options to output the data as a correlation matrix or a distance matrix (typically one minus the correlation or one minus the absoulte correlation). Once the output is in a distance matrix, it can easily be converted (as.dist() ) to an object of the class "dist" which stores the lower triangle of the correlation matrix in a vector. Many clustering algorithms take as input objects of the class "dist". } \author{ Jo Hardin \email{jo.hardin@pomona.edu} Maintainer: Jo Hardin \email{jo.hardin@pomona.edu} } \references{ Hardin, J., Mitani, A., Hicks, L., VanKoten, B.; \bold{A Robust Measure of Correlation Between Two Genes on a Microarray}, \emph{BMC Bioinformatics}, \bold{8}:220; 2007. } \keyword{robust} \keyword{multivariate} \keyword{cluster} %\keyword{biweight} %\keyword{correlation} %\keyword{Tukey} \seealso{ \code{\link{biwt.est}}, \code{\link{biwt.cor}} } \examples{ ### To calculate the multivariate location vector and scale matrix: samp.data <- t(mvrnorm(30,mu=c(0,0),Sigma=matrix(c(1,.75,.75,1),ncol=2))) samp.bw <- biwt.est(samp.data) samp.bw samp.bw.var1 <- samp.bw$biwt.sig[1,1] samp.bw.var2 <- samp.bw$biwt.sig[2,2] samp.bw.cov <- samp.bw$biwt.sig[1,2] samp.bw.cor <- samp.bw$biwt.sig[1,2] / sqrt(samp.bw$biwt.sig[1,1]*samp.bw$biwt.sig[2,2]) samp.bw.cor ### To calculate the correlation(s): samp.data <- t(mvrnorm(30,mu=c(0,0,0), Sigma=matrix(c(1,.75,-.75,.75,1,-.75,-.75,-.75,1),ncol=3))) # To compute the 3 pairwise correlations from the sample data: samp.bw.cor <- biwt.cor(samp.data, output="vector") samp.bw.cor # To compute the 3 pairwise correlations in matrix form: samp.bw.cor.mat <- biwt.cor(samp.data) samp.bw.cor.mat # To compute the 3 pairwise distances in matrix form: samp.bw.dist.mat <- biwt.cor(samp.data, output="distance") samp.bw.dist.mat # To convert the distances into an object of class `dist' as.dist(samp.bw.dist.mat) } biwt/man/biwtInternalFunctions.Rd0000744000176000001440000000656011241043450016646 0ustar ripleyusers\name{biwtInternalFunctions} \alias{biwtInternalFunctions} \alias{chi.int2.p} \alias{chi.int2} \alias{chi.int.p} \alias{chi.int} \alias{erho.bw.p} \alias{erho.bw} \alias{ksolve} \alias{psibw} \alias{rejpt.bw} \alias{rhobw} \alias{vbw} \alias{wtbw} \alias{vect2diss} %- Also NEED an '\alias' for EACH other topic documented here. \title{Functions used internally for the biwt package } \description{ Tukey's biweight gives robust estimates of a p-dimensional mean vector and covariance matrix. These functions are used internally within the biweight estimation function. } \usage{ chi.int2.p(p, a, c1) chi.int2(p,a,c1) chi.int.p(p,a,c1) chi.int(p,a,c1) erho.bw.p(p,c1) erho.bw(p,c1) ksolve(d,p,c1,b0) psibw(x,c1) rhobw(x,c1) vbw(x,c1) wtbw(x,c1) rejpt.bw(p,r) vect2diss(v) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{p}{ the dimension of the data (should be two if computing correlations. Unlike Pearson correlation, pairwise correlations will not be the same if computed on the entire data set as compared to one pair at a time.) } \item{a}{ degrees of freedom for the chi square distribution} \item{c1}{ cutoff value at which the biweight function gives zero weight to any data point} \item{d}{ vector of distances from each data point to mean vector} \item{b0}{ expected value of the \eqn{\rho} function for the biweight estimator (under normality)} \item{x}{ value at which the biweight (\eqn{\rho, \psi, v, w}) should be evaluated} \item{r}{breakdown (\eqn{k/n} where \eqn{k} is the largest number of observations that can be replaced with arbitrarily large values while keeping the estimates bounded)} \item{v}{a vector (presumably from \code{biwt.cor}) consisting of the lower triangle of a symmetric dissimilarity or similarity matrix} } \details{ These functions are used internally for the \code{\link{biwt.est}} and \code{\link{biwt.cor}} functions in the \code{\link{biwt}} package. } \value{ The following functions evaluate partial integrals of the \eqn{\chi^2} distribution: \code{chi.int}, \code{chi.in2}, \code{chi.int.p}, \code{chi.int2.p}. The following functions evaluate the biweight functions: \code{psibw}, \code{rhobw}, \code{wbw}, \code{vbw}. The following functions caluclate the expected value of the \eqn{\rho} function under the assumption of normally distribued data: \code{erho.bw}, \code{erho.bw.p}. The function \code{ksolve} keeps the estimates from imploding by setting the mean value of \eqn{\rho} equal to its expected value under normality. The function \code{rejpt.bw} gives the asymptotic rejection point. The function \code{vect2diss} converts a vector consisting of a lower triangle of a matrix into a symmetric dissimilarity or similarity matrix. The function is similar to \code{dissmatrix} in the \code{hopach} package, except that \code{vect2diss} fills in the lower triangle first while \code{dissmatrix} fills in the upper triangle first. } \references{ Hardin, J., Mitani, A., Hicks, L., VanKoten, B.; \bold{A Robust Measure of Correlation Between Two Genes on a Microarray}, \emph{BMC Bioinformatics}, \bold{8}:220; 2007. } \author{Jo Hardin \email{jo.hardin@pomona.edu}} \seealso{ \code{\link{biwt.est}} , \code{\link{biwt.cor}}} \examples{ ## These are not user level functions ## See examples for biwt.est or biwt.cor ## ?biwt.est ## ?biwt.cor } biwt/man/biwtCorrelation.Rd0000744000176000001440000001210511245047003015454 0ustar ripleyusers\name{biwtCorrelation} \alias{biwtCorrelation} %\alias{biwt.cor.vect} \alias{biwt.cor} %\alias{biwt.dist} %- Also NEED an '\alias' for EACH other topic documented here. \title{A function to compute a weighted correlation based on Tukey's biweight} \description{ The following function compute a multivariate location and scale estimate based on Tukey's biweight weight function. } \usage{ biwt.cor(x, r=.2, output="matrix", median=TRUE, full.init=TRUE, absval=TRUE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ a \eqn{g x n} matrix or data frame (\eqn{g} is the number of observations (genes), \eqn{n} is the number of measurements)} \item{r}{ breakdown (\eqn{k/n} where \eqn{k} is the largest number of measurements that can be replaced with arbitrarily large values while keeping the estimates bounded). Default is r=.2. } \item{output}{ a character string specifying the output format. Options are "matrix" (default), "vector", or "distance". See value below} \item{median}{ a logical command to determine whether the initialization is done using the coordinate-wise median and MAD^2 (TRUE, default) or using the minimum covariance determinant (MCD) (FALSE). Using the MCD is substantially slower. The MAD is the median of the absolute deviations from the median. See the R help file on \code{mad}.} \item{full.init}{ a logical command to determine whether the initialization is done for each pair separately (FALSE) or only one time at the beginning using a random sample from the data matrix (TRUE, default). Initializing for each pair separately is substantially slower.} \item{absval}{ a logical command to determine whether the distance should be measured as 1 minus the absolute value of the correlation (TRUE, default) or simply 1 minus the correlation (FALSE)} } \details{ Using \code{\link{biwt.est}} to estimate the robust covariance matrix, a robust measure of correlation is computed using Tukey's biweight M-estimator. The biweight correlation is essentially a weighted correlation where the weights are calculated based on the distance of each measurement to the data center with respect to the shape of the data. The correlations are computed pair-by-pair because the weights should depend only on the pairwise relationship at hand and not the relationship between all the observations globally. The biwt functions simply compute many pairwise correlations and create distance matrices for use in other algorithms (e.g., clustering). In order for the biweight estimates to converge, a reasonable initialization must be given. Typically, using TRUE for the median and full.init arguments will provide acceptable initializations. With particularly irregular data, the MCD should be used to give the initial estimate of center and shape. With data sets in which the observations are orders of magnitudes different, full.init=FALSE should be specified. } \value{ Specifying "matrix" for the ouput argument returns a matrix of the biweight correlations. Specifying "vector" for the ouput argument returns a vector consisting of the lower triangle of the correlation matrix stored by columns in a vector, say \eqn{bwcor}. If \eqn{g} is the number of observations and \eqn{bwcor} is the correlation vector, then for \eqn{i < j <= g}, the biweight correlation between (rows) \eqn{i} and \eqn{j} is \eqn{bwcor[(j-1)*(j-2)/2 + i]}. The length of the vector is \eqn{g*(g-1)/2}, i.e., of order \eqn{g^2}. Specifying "distance" for the ouput argument returns a matrix of the biweight distances (default is 1 minus absolute value of the biweight correlation). } \references{ Hardin, J., Mitani, A., Hicks, L., VanKoten, B.; \bold{A Robust Measure of Correlation Between Two Genes on a Microarray}, \emph{BMC Bioinformatics}, \bold{8}:220; 2007. } \author{Jo Hardin \email{jo.hardin@pomona.edu} } \note{ If there is too much missing data or if the initialization is not accurate, the function will compute the MCD for a given pair of observations before computing the biweight correlation (regardless of the initial settings given in the call to the function). The "vector" output option is given so that correlations can be stored as vectors which are less computationally intensive than matrices. } \seealso{\code{\link{biwt.est}} } \examples{ samp.data <-t(mvrnorm(30,mu=c(0,0,0), Sigma=matrix(c(1,.75,-.75,.75,1,-.75,-.75,-.75,1),ncol=3))) # To compute the 3 pairwise correlations from the sample data: samp.bw.cor <- biwt.cor(samp.data, output="vector") samp.bw.cor # To compute the 3 pairwise correlations in matrix form: samp.bw.cor.mat <- biwt.cor(samp.data) samp.bw.cor.mat # To compute the 3 pairwise distances in matrix form: samp.bw.dist.mat <- biwt.cor(samp.data, output="distance") samp.bw.dist.mat # To convert the distances into an object of class `dist' as.dist(samp.bw.dist.mat) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{robust} \keyword{multivariate} \keyword{cluster} %\keyword{biweight} %\keyword{correlation} %\keyword{Tukey} biwt/DESCRIPTION0000744000176000001440000000102012043501737012751 0ustar ripleyusersPackage: biwt Type: Package Title: Functions to compute the biweight mean vector and covariance & correlation matrices Version: 1.0 Date: 2009-08-11 Author: Jo Hardin Maintainer: Jo Hardin Depends: R (>= 2.1.0), rrcov, MASS Description: Compute multivariate location, scale, and correlation estimates based on Tukey's biweight M-estimator. License: GPL-2 LazyLoad: yes Packaged: 2012-10-29 08:58:19 UTC; ripley Repository: CRAN Date/Publication: 2012-10-29 08:58:19 biwt/MD50000644000176000001440000000175512043501737011571 0ustar ripleyusersc504d36498387f8aac0c4e49c1113820 *DESCRIPTION a8df90d860c831f443ba15f1b215d219 *NAMESPACE 04a97fb08577303ee104ada132647c08 *R/biwt.cor.R ccdde3af8238e9953b452795c07ebb1e *R/biwt.est.R d2dd231b32cfba158c9373ada375c713 *R/chi.int.R cd8cf7639e731a3328235030fe9872b7 *R/chi.int.p.R cfcf377896183cc1703ff77b51f067a1 *R/chi.int2.R ccac047752a95ca743def77e0c1494f3 *R/chi.int2.p.R 7d66402afe5c98945d9e0adf8d03ce91 *R/erho.bw.R 8e1e3f76a8bc38a1896aadf2a8657906 *R/erho.bw.p.R d23abc9c24f2683139aa3a47d5ca36b9 *R/ksolve.R c00eda3e89ac091976501184cc058e34 *R/psibw.R 18c42e25909b2e4bda67c1f891bfe93c *R/rejpt.bw.R 0405ad84b102c13a4c443f7f4eab0679 *R/rhobw.R bb04c5c77978ab16f9f3001a1014fac7 *R/vbw.R 5faa8afed3aeb88f688bac504798e9b9 *R/vect2diss.r 7b3b7142d7d0474adb76945cba6e7e75 *R/wtbw.R cd6d055d84b393cfba079f042c5705f8 *man/biwt-package.Rd 021d6c5388d355f90b770343e8f8100b *man/biwt.est.Rd b1743645d1a48c1ed93913ffa6b4c67b *man/biwtCorrelation.Rd bef90c18eb03c5378a97a00b4db8353f *man/biwtInternalFunctions.Rd biwt/R/0000755000176000001440000000000011245021660011445 5ustar ripleyusersbiwt/R/biwt.cor.R0000744000176000001440000000424011245023577013331 0ustar ripleyusers`biwt.cor` <- function(x,r=.2,output="matrix",median=TRUE,full.init=TRUE,absval=TRUE){ if (full.init==TRUE){ rand.samp <-x[sample(1:nrow(x),2),] if (median != TRUE) { med.init <- covMcd(t(rand.samp)) } else { med.init <- list() med.init$cov <- diag(1, 2) * (apply(rand.samp, 1, mad, na.rm = TRUE))^2 med.init$center <- c(1, 1) * apply(rand.samp, 1, median, na.rm = TRUE) } } corr <- c() g <- dim(x)[1] if(output=="matrix"){ for(i in 1:g){ j <- 1 while(j < i){ if (full.init !=TRUE){ if (median!=TRUE) {med.init<-covMcd(cbind(x[i,],x[j,]))} else {med.init<-list() med.init$cov <- diag(1,2)*(apply(cbind(x[i,],x[j,]),2,mad,na.rm=TRUE))^2 med.init$center <- apply(cbind(x[i,],x[j,]),2,median,na.rm=TRUE)} } biwt <- biwt.est(rbind(x[i,],x[j,]),r,med.init) corr <- c(corr,biwt$biwt.sig[1,2]/sqrt(biwt$biwt.sig[1,1]*biwt$biwt.sig[2,2])) j<-j+1 } } corr.mat <- vect2diss(corr) diag(corr.mat) <- 1 return(corr.mat)} if(output=="distance"){ for(i in 1:g){ j <- 1 while(j < i){ if (full.init !=TRUE){ if (median!=TRUE) {med.init<-covMcd(cbind(x[i,],x[j,]))} else {med.init<-list() med.init$cov <- diag(1,2)*(apply(cbind(x[i,],x[j,]),2,mad,na.rm=TRUE))^2 med.init$center <- apply(cbind(x[i,],x[j,]),2,median,na.rm=TRUE)} } biwt <- biwt.est(rbind(x[i,],x[j,]),r,med.init) corr <- c(corr,biwt$biwt.sig[1,2]/sqrt(biwt$biwt.sig[1,1]*biwt$biwt.sig[2,2])) j<-j+1 } } if(absval==TRUE){dist.mat <- vect2diss(1 - abs(corr))} else {dist.mat <- vect2diss(1 - corr)} diag(dist.mat) <- 0 return(dist.mat)} if(output=="vector"){ for(i in 1:g){ j <- 1 while(j < i){ if (full.init !=TRUE){ if (median!=TRUE) {med.init<-covMcd(cbind(x[i,],x[j,]))} else {med.init<-list() med.init$cov <- diag(1,2)*(apply(cbind(x[i,],x[j,]),2,mad,na.rm=TRUE))^2 med.init$center <- apply(cbind(x[i,],x[j,]),2,median,na.rm=TRUE)} } biwt <- biwt.est(rbind(x[i,],x[j,]),r,med.init) corr <- c(corr,biwt$biwt.sig[1,2]/sqrt(biwt$biwt.sig[1,1]*biwt$biwt.sig[2,2])) j<-j+1 } } return(corr)} } biwt/R/rhobw.R0000744000176000001440000000017211231140327012707 0ustar ripleyusersrhobw <- function(x,c1){ ivec <- (abs(x)>c1) return((c1^2/6)*ivec +(1-ivec)*(x^2/2-x^4/(2*c1^2)+x^6/(6*c1^4)))} biwt/R/rejpt.bw.R0000744000176000001440000000065211231140327013324 0ustar ripleyusersrejpt.bw <- function(p,r){ # gives c1 = ARP c1 <- 2*p iter <- 1 crit <- 100 eps <- 1e-5 while ((crit > eps)&(iter<100)){ c1.old <- c1 fc <- erho.bw(p,c1) - c1^2*r/6 fcp <- erho.bw.p(p,c1) - c1*r/3 c1 <- c1 - fc/fcp if (c1 < 0) c1 <- c1.old/2 crit <- abs(fc) iter <- iter+1 } return(c(c1,pchisq(c1^2,p),log10(1-pchisq(c1^2,p))))} biwt/R/erho.bw.p.R0000744000176000001440000000034511231140327013372 0ustar ripleyuserserho.bw.p <- function(p,c1) return(chi.int.p(p,2,c1)/2-chi.int.p(p,4,c1)/(2*c1^2)+ 2*chi.int(p,4,c1)/(2*c1^3)+chi.int.p(p,6,c1)/(6*c1^4)- 4*chi.int(p,6,c1)/(6*c1^5)+c1^2*chi.int2.p(p,0,c1)/6 +2*c1*chi.int2(p,0,c1)/6) biwt/R/chi.int.p.R0000744000176000001440000000015411231140327013360 0ustar ripleyuserschi.int.p <- function(p,a,c1) return( exp(lgamma((p+a)/2)-lgamma(p/2))*2^{a/2}*dchisq(c1^2,p+a)*2*c1 ) biwt/R/vbw.R0000744000176000001440000000006011231140327012360 0ustar ripleyusersvbw <- function(x,c1) return(psibw(x,c1)*x) biwt/R/wtbw.R0000744000176000001440000000013311231140327012546 0ustar ripleyuserswtbw <- function(x,c1){ ivec <- (abs(x)>c1) return((1-ivec)*(1-(x/c1)^2)^2)} biwt/R/chi.int2.R0000744000176000001440000000015211231140327013202 0ustar ripleyuserschi.int2 <- function(p,a,c1) return( exp(lgamma((p+a)/2)-lgamma(p/2))*2^{a/2}*(1-pchisq(c1^2,p+a)) ) biwt/R/biwt.est.R0000744000176000001440000000172611242605023013334 0ustar ripleyusers`biwt.est` <- function(x,r=.2,med.init=covMcd(x)){ p<-2 n <- dim(x)[2] c1<-rejpt.bw(p=2,r)[1] b0<-erho.bw(p=2,c1)[1] x<-t(x) d <- sqrt(mahalanobis(x,med.init$center,med.init$cov)) k <- ksolve(d,p,c1,b0) if(is.na(k)) { med.init <- covMcd(x) d <- sqrt(mahalanobis(x,med.init$center,med.init$cov)) k <- ksolve(d,p,c1,b0)} # MCD is a more robust estimate of the center/shape # than the median which is sometimes used eps <- 1e-5 crit <- 100 iter <- 1 while (crit > eps & iter < 100) { d <- d/k biwt.mu <- apply(wtbw(d,c1)*x,2,sum,na.rm=TRUE) / sum (wtbw(d,c1),na.rm=TRUE) cent <- array(dim=c(n,p,p)) for (i in 1:n){ cent[i,,] <- (x[i,] - biwt.mu)%*%t(x[i,]-biwt.mu)} biwt.sig <- apply(cent*wtbw(d,c1),c(2,3),sum,na.rm=TRUE)/ sum(vbw(d,c1),na.rm=TRUE) d2 <- sqrt(mahalanobis(x,biwt.mu,biwt.sig)) k <- ksolve(d2,p,c1,b0) crit <- max(abs(d-(d2/k)),na.rm=TRUE) d <- d2 iter <- iter+1} return(list(biwt.mu=biwt.mu,biwt.sig=biwt.sig))} biwt/R/psibw.R0000744000176000001440000000013411231140327012710 0ustar ripleyuserspsibw <- function(x,c1){ ivec <- (abs(x)>c1) return((1-ivec)*(x*(1-(x/c1)^2)^2))} biwt/R/ksolve.R0000744000176000001440000000070511236636676013121 0ustar ripleyusersksolve <- function(d,p,c1,b0){ k <- 1 iter <- 1 crit <- 100 eps <- 1e-10 while ((crit > eps)&(iter<100)){ k.old <- k fk <- mean(rhobw(d/k,c1),na.rm=TRUE)-b0 fkp <- -mean(psibw(d/k,c1)*d/k^2,na.rm=TRUE) if (fkp==0) {k<-NA return(k) stop("no values close enough")} k <- k - fk/fkp if (k < 0) k <- k.old/2 crit <- abs(k-k.old) iter <- iter+1 } return(k) } biwt/R/chi.int.R0000744000176000001440000000014511231140327013122 0ustar ripleyuserschi.int <- function(p,a,c1) return( exp(lgamma((p+a)/2)-lgamma(p/2))*2^{a/2}*pchisq(c1^2,p+a) ) biwt/R/chi.int2.p.R0000744000176000001440000000015611231140327013444 0ustar ripleyuserschi.int2.p <- function(p,a,c1) return( -exp(lgamma((p+a)/2)-lgamma(p/2))*2^{a/2}*dchisq(c1^2,p+a)*2*c1 ) biwt/R/erho.bw.R0000744000176000001440000000023611231140327013133 0ustar ripleyuserserho.bw <- function(p,c1) # gives b0 = E(rho) return(chi.int(p,2,c1)/2-chi.int(p,4,c1)/(2*c1^2)+ chi.int(p,6,c1)/(6*c1^4)+c1^2*chi.int2(p,0,c1)/6) biwt/R/vect2diss.r0000744000176000001440000000101111241043173013527 0ustar ripleyusersvect2diss <- function (v) # This function is very similar to # dissmatrix in the hopach package # except that it fills in by the lower # triangle of the matrix instead of the # upper triangle { if (!is.vector(v)) stop("arg to dissmatrix() must be a vector") p <- (1 + sqrt(1 + 8 * length(v)))/2 M <- matrix(0, nrow = p, ncol = p) count <- 1 for (i in 1:(p - 1)) { M[(i+1), 1:i] <- v[count:(count + i - 1)] count <- count + i } return(M + t(M)) }