[Rflptools-commits] r7 - in pkg/RFLPtools: . R inst/doc man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Jan 27 18:47:12 CET 2011
Author: stamats
Date: 2011-01-27 18:47:12 +0100 (Thu, 27 Jan 2011)
New Revision: 7
Added:
pkg/RFLPtools/R/linCombDist.R
pkg/RFLPtools/man/linCombDist.Rd
Modified:
pkg/RFLPtools/DESCRIPTION
pkg/RFLPtools/NAMESPACE
pkg/RFLPtools/NEWS
pkg/RFLPtools/R/RFLPdist.R
pkg/RFLPtools/R/RFLPdist2.R
pkg/RFLPtools/R/RFLPdist2ref.R
pkg/RFLPtools/R/RFLPplot.R
pkg/RFLPtools/R/diffDist.R
pkg/RFLPtools/inst/doc/RFLPtools.pdf
Log:
corrected some minor bugs, added function linCombDist
Modified: pkg/RFLPtools/DESCRIPTION
===================================================================
--- pkg/RFLPtools/DESCRIPTION 2010-07-20 07:15:04 UTC (rev 6)
+++ pkg/RFLPtools/DESCRIPTION 2011-01-27 17:47:12 UTC (rev 7)
@@ -1,8 +1,8 @@
Package: RFLPtools
Type: Package
Title: Tools to analyse RFLP data
-Version: 1.3
-Date: 2010-07-20
+Version: 1.4
+Date: 2011-01-26
Author: Fabienne Flessa, Alexandra Kehl, Matthias Kohl
Maintainer: Matthias Kohl <Matthias.Kohl at stamats.de>
Description: RFLPtools provides functions to analyse DNA fragment samples
Modified: pkg/RFLPtools/NAMESPACE
===================================================================
--- pkg/RFLPtools/NAMESPACE 2010-07-20 07:15:04 UTC (rev 6)
+++ pkg/RFLPtools/NAMESPACE 2011-01-27 17:47:12 UTC (rev 7)
@@ -1,5 +1,6 @@
export(read.rflp,
diffDist,
+ linCombDist,
RFLPqc,
RFLPdist,
RFLPdist2,
Modified: pkg/RFLPtools/NEWS
===================================================================
--- pkg/RFLPtools/NEWS 2010-07-20 07:15:04 UTC (rev 6)
+++ pkg/RFLPtools/NEWS 2011-01-27 17:47:12 UTC (rev 7)
@@ -3,19 +3,17 @@
###############################################################################
###########################################################
-## Version 1.0
+## Version 1.4
###########################################################
-- start of implementation, first version on CRAN
-
+- correction of some minor bugs
+- added function linCombDist to compute a linear combination of distances
+
###########################################################
-## Version 1.1
+## Version 1.3
###########################################################
-- added NEWS file
-- some examples simplyfied to reduce check-time
-- added warnings for BLAST datasets for the case that there are subject.ids
- which do not occur as query.ids
-- extended vignette and package Rd-file by RFLPplot and RFLPrefplot examples
-
+- added function diffDist for distance matrix computation based on
+ successive differences
+
###########################################################
## Version 1.2
###########################################################
@@ -26,7 +24,15 @@
MKmisc version 0.8
###########################################################
-## Version 1.3
+## Version 1.1
###########################################################
-- added function diffDist for distance matrix computation based on
- successive differences
\ No newline at end of file
+- added NEWS file
+- some examples simplyfied to reduce check-time
+- added warnings for BLAST datasets for the case that there are subject.ids
+ which do not occur as query.ids
+- extended vignette and package Rd-file by RFLPplot and RFLPrefplot examples
+
+###########################################################
+## Version 1.0
+###########################################################
+- start of implementation, first version on CRAN
Modified: pkg/RFLPtools/R/RFLPdist.R
===================================================================
--- pkg/RFLPtools/R/RFLPdist.R 2010-07-20 07:15:04 UTC (rev 6)
+++ pkg/RFLPtools/R/RFLPdist.R 2011-01-27 17:47:12 UTC (rev 7)
@@ -6,7 +6,8 @@
## distfun: function to compute distance (cf. ?dist)
RFLPdist <- function(x, distfun = dist, nrBands){
stopifnot(is.data.frame(x))
- stopifnot(is.function(dist))
+ stopifnot(is.function(distfun))
+
x1 <- split(x, x$Sample)
nrbands <- sort(unique(sapply(x1, nrow)))
x1.bands <- sapply(x1, nrow)
Modified: pkg/RFLPtools/R/RFLPdist2.R
===================================================================
--- pkg/RFLPtools/R/RFLPdist2.R 2010-07-20 07:15:04 UTC (rev 6)
+++ pkg/RFLPtools/R/RFLPdist2.R 2011-01-27 17:47:12 UTC (rev 7)
@@ -16,6 +16,8 @@
## compares samples with number of bands in: nrBands, nrBands + 1, ..., nrBands + nrMissing
RFLPdist2 <- function(x, distfun = dist, nrBands, nrMissing, diag = FALSE, upper = FALSE){
stopifnot(is.data.frame(x))
+ stopifnot(is.function(distfun))
+
x1 <- split(x, x$Sample)
nrbands <- sort(unique(sapply(x1, nrow)))
x1.bands <- sapply(x1, nrow)
@@ -31,7 +33,7 @@
d <- matrix(NA, nrow = N, ncol = N)
dfun <- function(x, y){
m <- sum(!is.na(x))
- min(as.matrix(dist(rbind(x[1:m], t(combn(y, m)))))[-1,1])
+ min(as.matrix(distfun(rbind(x[1:m], t(combn(y, m)))))[-1,1])
}
for(i in 1:N){
for(j in 1:i){
Modified: pkg/RFLPtools/R/RFLPdist2ref.R
===================================================================
--- pkg/RFLPtools/R/RFLPdist2ref.R 2010-07-20 07:15:04 UTC (rev 6)
+++ pkg/RFLPtools/R/RFLPdist2ref.R 2011-01-27 17:47:12 UTC (rev 7)
@@ -8,7 +8,7 @@
RFLPdist2ref <- function(x, ref, distfun = dist, nrBands){
stopifnot(is.data.frame(x))
stopifnot(is.data.frame(ref))
- stopifnot(is.function(dist))
+ stopifnot(is.function(distfun))
if(missing(nrBands))
stop("Number of Bands 'nrBands' is missing.")
Modified: pkg/RFLPtools/R/RFLPplot.R
===================================================================
--- pkg/RFLPtools/R/RFLPplot.R 2010-07-20 07:15:04 UTC (rev 6)
+++ pkg/RFLPtools/R/RFLPplot.R 2011-01-27 17:47:12 UTC (rev 7)
@@ -9,7 +9,8 @@
mar.bottom = 5, cex.axis = 0.5,
colBands){
stopifnot(is.data.frame(x))
- stopifnot(is.function(dist))
+ stopifnot(is.function(distfun))
+
if(missing(nrBands))
stop("Number of Bands 'nrBands' is missing.")
Modified: pkg/RFLPtools/R/diffDist.R
===================================================================
--- pkg/RFLPtools/R/diffDist.R 2010-07-20 07:15:04 UTC (rev 6)
+++ pkg/RFLPtools/R/diffDist.R 2011-01-27 17:47:12 UTC (rev 7)
@@ -1,4 +1,6 @@
diffDist <- function(x, method = "euclidean", diag = FALSE, upper = FALSE, p = 2){
- x.diff <- t(diff(t(x)))
- dist(x.diff, method = method, diag = diag, upper = upper, p = p)
+ x.diff <- t(diff(t(as.matrix(x))))
+ res <- dist(x.diff, method = method, diag = diag, upper = upper, p = p)
+ attr(res, "call") <- match.call()
+ res
}
Added: pkg/RFLPtools/R/linCombDist.R
===================================================================
--- pkg/RFLPtools/R/linCombDist.R (rev 0)
+++ pkg/RFLPtools/R/linCombDist.R 2011-01-27 17:47:12 UTC (rev 7)
@@ -0,0 +1,14 @@
+linCombDist <- function(x, distfun1, w1, distfun2, w2, diag = FALSE, upper = FALSE){
+ stopifnot(is.function(distfun1))
+ stopifnot(is.function(distfun2))
+
+ res <- w1*distfun1(x) + w2*distfun2(x)
+ attributes(res) <- NULL
+ attr(res, "Size") <- nrow(as.matrix(x))
+ attr(res, "Labels") <- dimnames(x)[[1L]]
+ attr(res, "Diag") <- diag
+ attr(res, "Upper") <- upper
+ attr(res, "call") <- match.call()
+ class(res) <- "dist"
+ res
+}
Modified: pkg/RFLPtools/inst/doc/RFLPtools.pdf
===================================================================
(Binary files differ)
Added: pkg/RFLPtools/man/linCombDist.Rd
===================================================================
--- pkg/RFLPtools/man/linCombDist.Rd (rev 0)
+++ pkg/RFLPtools/man/linCombDist.Rd 2011-01-27 17:47:12 UTC (rev 7)
@@ -0,0 +1,54 @@
+\name{linCombDist}
+\alias{linCombDist}
+\title{ Linear Combination of Distances }
+\description{
+ This function computes linear combinations of distances.
+}
+\usage{
+linCombDist(x, distfun1, w1, distfun2, w2, diag = FALSE, upper = FALSE)
+}
+\arguments{
+ \item{x}{object which is passed to \code{distfun1} and \code{distfun2}.}
+ \item{distfun1}{function used to compute an object of class \code{"dist"}.}
+ \item{w1}{weight for result of \code{distfun1}.}
+ \item{distfun2}{function used to compute an object of class \code{"dist"}.}
+ \item{w2}{weight for result of \code{distfun2}.}
+ \item{diag}{ see \code{\link[stats]{dist}} }
+ \item{upper}{ see \code{\link[stats]{dist}} }
+}
+\details{
+ This function computes and returns the distance matrix computed by
+ a linear combination of two distance matrices.
+}
+\value{
+ \code{linCombDist} returns an object of class \code{"dist"}; cf. \code{\link[stats]{dist}}.
+}
+%\references{}
+\author{ Matthias Kohl \email{Matthias.Kohl at stamats.de}}
+%\note{}
+\examples{
+## assume a shift in the measured bands
+M <- rbind(c(550, 500, 300, 250), c(510, 460, 260, 210),
+ c(700, 650, 450, 400), c(550, 490, 310, 250))
+dist(M)
+diffDist(M)
+
+## convex combination of dist and diffDist
+linCombDist(M, distfun1 = dist, w1 = 0.5, distfun2 = diffDist, w2 = 0.5)
+
+## linear combination
+linCombDist(M, distfun1 = dist, w1 = 2, distfun2 = diffDist, w2 = 5)
+
+## maximum distance
+linCombDist(M, distfun1 = function(x) dist(x, method = "maximum"), w1 = 0.5,
+ distfun2 = function(x) diffDist(x, method = "maximum"), w2 = 0.5)
+
+data(RFLPdata)
+distfun <- function(x) linCombDist(x, distfun1 = dist, w1 = 0.1, distfun2 = diffDist, w2 = 0.9)
+par(mfrow = c(2, 2))
+plot(hclust(RFLPdist(RFLPdata, nrBands = 3, distfun = distfun)), cex = 0.7, cex.lab = 0.7)
+RFLPplot(RFLPdata, nrBands = 3, distfun = distfun, mar.bottom = 6, cex.axis = 0.8)
+plot(hclust(RFLPdist(RFLPdata, nrBands = 3)), cex = 0.7, cex.lab = 0.7)
+RFLPplot(RFLPdata, nrBands = 3, mar.bottom = 6, cex.axis = 0.8)
+}
+\keyword{multivariate}
More information about the Rflptools-commits
mailing list