From noreply at r-forge.r-project.org Fri Feb 1 05:12:24 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 1 Feb 2013 05:12:24 +0100 (CET) Subject: [Robast-commits] r582 - in branches/robast-0.9/pkg/RobLoxBioC: . R inst inst/scripts man tests/Examples Message-ID: <20130201041224.73D0D184952@r-forge.r-project.org> Author: stamats Date: 2013-02-01 05:12:19 +0100 (Fri, 01 Feb 2013) New Revision: 582 Added: branches/robast-0.9/pkg/RobLoxBioC/R/00pre2160.R branches/robast-0.9/pkg/RobLoxBioC/R/robloxbiocBeadLevelData.R Removed: branches/robast-0.9/pkg/RobLoxBioC/R/robloxbiocBeadLevelList.R branches/robast-0.9/pkg/RobLoxBioC/R/sysdata.rda branches/robast-0.9/pkg/RobLoxBioC/inst/scripts/AffySimStudy.R Modified: branches/robast-0.9/pkg/RobLoxBioC/DESCRIPTION branches/robast-0.9/pkg/RobLoxBioC/R/0AllGeneric.R branches/robast-0.9/pkg/RobLoxBioC/R/AffySimStudyFunction.R branches/robast-0.9/pkg/RobLoxBioC/R/IlluminaSimStudyFunction.R branches/robast-0.9/pkg/RobLoxBioC/R/robloxbiocMatrix.R branches/robast-0.9/pkg/RobLoxBioC/inst/CITATION branches/robast-0.9/pkg/RobLoxBioC/inst/NEWS branches/robast-0.9/pkg/RobLoxBioC/inst/scripts/AffymetrixExample.R branches/robast-0.9/pkg/RobLoxBioC/inst/scripts/IlluminaExample.R branches/robast-0.9/pkg/RobLoxBioC/inst/scripts/IlluminaSimStudy.R branches/robast-0.9/pkg/RobLoxBioC/man/0RobLoxBioC-package.Rd branches/robast-0.9/pkg/RobLoxBioC/man/KolmogorovMinDist.Rd branches/robast-0.9/pkg/RobLoxBioC/man/SimStudies.Rd branches/robast-0.9/pkg/RobLoxBioC/man/robloxbioc.Rd branches/robast-0.9/pkg/RobLoxBioC/tests/Examples/RobLoxBioC-Ex.Rout.save Log: merged trunk into branch, update of Rout.save, had to put some examples in \dontrun to reduce check time Modified: branches/robast-0.9/pkg/RobLoxBioC/DESCRIPTION =================================================================== --- branches/robast-0.9/pkg/RobLoxBioC/DESCRIPTION 2013-01-31 19:09:59 UTC (rev 581) +++ branches/robast-0.9/pkg/RobLoxBioC/DESCRIPTION 2013-02-01 04:12:19 UTC (rev 582) @@ -1,10 +1,10 @@ Package: RobLoxBioC Version: 0.9 -Date: 2010-12-03 -Title: Optimally robust estimation for omics data +Date: 2013-01-31 +Title: Infinitesimally robust estimators for preprocessing omics data Description: Functions for the determination of optimally robust influence curves and estimators for preprocessing omics data, in particular gene expression data. -Depends: R(>= 2.8.1), methods, Biobase, affy, beadarray, distr, RobLox, lattice, RColorBrewer +Depends: R(>= 2.14.0), methods, Biobase, affy, beadarray, distr, RobLox, lattice, RColorBrewer Author: Matthias Kohl Maintainer: Matthias Kohl LazyLoad: yes @@ -14,4 +14,4 @@ Encoding: latin1 LastChangedDate: {$LastChangedDate$} LastChangedRevision: {$LastChangedRevision$} -SVNRevision: 439 +SVNRevision: 511 Copied: branches/robast-0.9/pkg/RobLoxBioC/R/00pre2160.R (from rev 580, pkg/RobLoxBioC/R/00pre2160.R) =================================================================== --- branches/robast-0.9/pkg/RobLoxBioC/R/00pre2160.R (rev 0) +++ branches/robast-0.9/pkg/RobLoxBioC/R/00pre2160.R 2013-02-01 04:12:19 UTC (rev 582) @@ -0,0 +1,43 @@ +## due to a change to .C and .Call in 2.16.0 +.getA1.locsc <- RobLox:::.getA1.locsc +.getA2.locsc <- RobLox:::.getA2.locsc +.geta.locsc <- RobLox:::.geta.locsc +.getb.locsc <- RobLox:::.getb.locsc + +.getlsInterval <- function (r, rlo, rup){ + if (r > 10) { + b <- 1.618128043 + const <- 1.263094656 + A2 <- b^2 * (1 + r^2)/(1 + const) + A1 <- const * A2 + } + else { + A1 <- .getA1.locsc(r) + A2 <- .getA2.locsc(r) + b <- .getb.locsc(r) + } + if (rlo == 0) { + efflo <- (A1 + A2 - b^2 * r^2)/1.5 + } + else { + A1lo <- .getA1.locsc(rlo) + A2lo <- .getA2.locsc(rlo) + efflo <- (A1 + A2 - b^2 * (r^2 - rlo^2))/(A1lo + A2lo) + } + if (rup > 10) { + bup <- 1.618128043 + const.up <- 1.263094656 + A2up <- bup^2 * (1 + rup^2)/(1 + const.up) + A1up <- const.up * A2up + effup <- (A1 + A2 - b^2 * (r^2 - rup^2))/(A1up + A2up) + } + else { + A1up <- .getA1.locsc(rup) + A2up <- .getA2.locsc(rup) + effup <- (A1 + A2 - b^2 * (r^2 - rup^2))/(A1up + A2up) + } + return(effup - efflo) +} + +.onestep.locsc.matrix <- RobLox:::.onestep.locsc.matrix +.kstep.locsc.matrix <- RobLox:::.kstep.locsc.matrix \ No newline at end of file Modified: branches/robast-0.9/pkg/RobLoxBioC/R/0AllGeneric.R =================================================================== --- branches/robast-0.9/pkg/RobLoxBioC/R/0AllGeneric.R 2013-01-31 19:09:59 UTC (rev 581) +++ branches/robast-0.9/pkg/RobLoxBioC/R/0AllGeneric.R 2013-02-01 04:12:19 UTC (rev 582) @@ -1,8 +1,4 @@ ############# preparations ################ -.onLoad <- function(lib, pkg) { - require("methods", character = TRUE, quietly = TRUE) -} - if(!isGeneric("robloxbioc")){ setGeneric("robloxbioc", function(x, ...) standardGeneric("robloxbioc")) Modified: branches/robast-0.9/pkg/RobLoxBioC/R/AffySimStudyFunction.R =================================================================== --- branches/robast-0.9/pkg/RobLoxBioC/R/AffySimStudyFunction.R 2013-01-31 19:09:59 UTC (rev 581) +++ branches/robast-0.9/pkg/RobLoxBioC/R/AffySimStudyFunction.R 2013-02-01 04:12:19 UTC (rev 582) @@ -38,12 +38,13 @@ if(plot2){ - ind <- sample(1:M, min(M, 20)) + ind <- if(M <= 20) 1:M else sample(1:M, 20) if(plot1) dev.new() + M1 <- min(M, 20) print( - stripplot(rep(1:20, each = 20) ~ as.vector(Mre[ind,]), + stripplot(rep(1:M1, each = n) ~ as.vector(Mre[ind,]), ylab = "samples", xlab = "x", pch = 20, - main = "Randomly chosen samples") + main = ifelse(M <= 20, "Samples", "20 randomly chosen samples")) ) } @@ -72,11 +73,10 @@ abline(h = 0) boxplot(Ergebnis2, col = myCol[c(1,2,4)], pch = 20, main = "Scale") abline(h = 1) - op <- par(mar = rep(2, 4), no.readonly = TRUE) + op <- par(mar = rep(2, 4)) plot(c(0,1), c(1, 0), type = "n", axes = FALSE) legend("center", c("ML", "Med/MAD", "biweight", "rmx"), fill = myCol, ncol = 4, cex = 1.5) -# op$cin <- op$cra <- op$csi <- op$cxy <- op$din <- NULL on.exit(par(op)) } Modified: branches/robast-0.9/pkg/RobLoxBioC/R/IlluminaSimStudyFunction.R =================================================================== --- branches/robast-0.9/pkg/RobLoxBioC/R/IlluminaSimStudyFunction.R 2013-01-31 19:09:59 UTC (rev 581) +++ branches/robast-0.9/pkg/RobLoxBioC/R/IlluminaSimStudyFunction.R 2013-02-01 04:12:19 UTC (rev 582) @@ -39,12 +39,13 @@ if(plot2){ - ind <- sample(1:M, min(M, 20)) + ind <- if(M <= 20) 1:M else sample(1:M, 20) if(plot1) dev.new() + M1 <- min(M, 20) print( - stripplot(rep(1:20, each = 20) ~ as.vector(Mre[ind,]), + stripplot(rep(1:M1, each = n) ~ as.vector(Mre[ind,]), ylab = "samples", xlab = "x", pch = 20, - main = "Randomly chosen samples") + main = ifelse(M <= 20, "Samples", "20 randomly chosen samples")) ) } @@ -79,11 +80,11 @@ abline(h = 0) boxplot(Ergebnis2, col = myCol, pch = 20, main = "Scale") abline(h = 1) - op <- par(mar = rep(2, 4), no.readonly = TRUE) + op <- par(mar = rep(2, 4)) plot(c(0,1), c(1, 0), type = "n", axes = FALSE) legend("center", c("ML", "Med/MAD", "Illumina", "rmx"), fill = myCol, ncol = 4, cex = 1.5) -# op$cin <- op$cra <- op$csi <- op$cxy <- op$din <- NULL + op$cin <- op$cra <- op$csi <- op$cxy <- op$din <- NULL on.exit(par(op)) } Copied: branches/robast-0.9/pkg/RobLoxBioC/R/robloxbiocBeadLevelData.R (from rev 580, pkg/RobLoxBioC/R/robloxbiocBeadLevelData.R) =================================================================== --- branches/robast-0.9/pkg/RobLoxBioC/R/robloxbiocBeadLevelData.R (rev 0) +++ branches/robast-0.9/pkg/RobLoxBioC/R/robloxbiocBeadLevelData.R 2013-02-01 04:12:19 UTC (rev 582) @@ -0,0 +1,252 @@ +setMethod("robloxbioc", signature(x = "beadLevelData"), + function(x, channelList = list(greenChannel), probeIDs = NULL, useSampleFac = FALSE, + sampleFac = NULL, weightNames = "wts", removeUnMappedProbes = TRUE, + eps = NULL, eps.lower = 0, eps.upper = 0.05, steps = 3L, fsCor = TRUE, mad0 = 1e-4){ + BLData <- x + arraynms <- sectionNames(BLData) + output <- vector("list", length(channelList)) + if (useSampleFac) { + if (is.null(sampleFac)) { + if (!"SampleGroup" %in% names(BLData at sectionData)) { + cat("Could not determine sample factor from beadLevelData. Summarizing each section separately\n") + sList <- arraynms + sampleFac <- arraynms + newNames <- sList + }else{ + sampleFac <- BLData at sectionData$SampleGroup[, 1] + sList <- unique(sampleFac) + dupList <- which(duplicated(sampleFac)) + if (any(dupList)) { + newNames <- strtrim(arraynms[-dupList], 12) + }else{ + newNames <- strtrim(arraynms, 12) + } + } + }else{ + if (length(sampleFac) != length(arraynms)) { + cat("Length of specified sample factor did not match number of sections\n") + cat("length of sample factor: ", length(sampleFac), sampleFac, "\n") + cat("number of sections: ", length(arraynms), arraynms, "\n") + stop("Aborting summarization\n") + } + else { + sList <- unique(sampleFac) + dupList <- which(duplicated(sampleFac)) + if (any(dupList)) { + newNames <- strtrim(arraynms[-dupList], 12) + }else{ + newNames <- strtrim(arraynms, 12) + } + } + } + } + else { + cat("No sample factor specified. Summarizing each section separately\n") + sList <- arraynms + sampleFac <- arraynms + newNames <- arraynms + } + if (is.null(probeIDs)) { + cat("Finding list of unique probes in beadLevelData\n") + probeIDs <- beadarray:::uniqueProbeList(BLData) + cat(length(probeIDs), " unique probeIDs found\n") + } + if (removeUnMappedProbes) { + annoName <- annotation(BLData) + if (!is.null(annoName)) { + annoLoaded <- require(paste("illumina", annoName, ".db", sep = ""), character.only = TRUE) + if (annoLoaded) { + mapEnv <- as.name(paste("illumina", annoName, "ARRAYADDRESS", sep = "")) + allMapped <- mappedkeys(revmap(eval(mapEnv))) + isMapped <- which(probeIDs %in% allMapped) + cat("Number of unmapped probes removed: ", length(probeIDs) - length(isMapped), "\n") + probeIDs <- probeIDs[isMapped] + } + }else{ + cat("Could not determine annotation for this beadLevelData object.\n") + } + } + cNames <- unlist(lapply(channelList, function(x) x at name)) + if (any(duplicated(cNames))) { + uNames <- unique(cNames) + for (i in 1:length(uNames)) { + sPos <- grep(uNames[i], cNames) + if (length(sPos) > 1) { + for (j in 1:length(sPos)) { + cNames[sPos[j]] <- paste(cNames[sPos[j]], j, sep = ".") + warning("Duplicated channel names were found. Renaming...\n") + } + } + } + } + for (cNum in 1:length(channelList)) { + template <- matrix(nrow = length(probeIDs), ncol = length(sList)) + if (length(channelList) == 1) { + newCols <- newNames + }else{ + newCols <- paste(cNames[cNum], newNames, sep = ":") + } + output[[cNum]][["eMat"]] <- template + colnames(output[[cNum]][["eMat"]]) <- newCols + rownames(output[[cNum]][["eMat"]]) <- probeIDs + output[[cNum]][["varMat"]] <- template + colnames(output[[cNum]][["varMat"]]) <- newCols + rownames(output[[cNum]][["varMat"]]) <- probeIDs + output[[cNum]][["nObs"]] <- template + colnames(output[[cNum]][["nObs"]]) <- newCols + rownames(output[[cNum]][["nObs"]]) <- probeIDs + } + for (s in 1:length(sList)) { + an <- which(sampleFac == sList[s]) + pIDs <- wts <- NULL + values <- vector("list", length(channelList)) + for (i in an) { + tmp <- BLData[[i]] + pidCol <- grep("ProbeID", colnames(tmp)) + retainedBeads <- which(tmp[, pidCol] %in% probeIDs) + tmp <- tmp[retainedBeads, ] + wCol <- grep(weightNames, colnames(tmp)) + pIDs <- c(pIDs, tmp[, pidCol]) + if (length(wCol) == 0){ + wts <- rep(1, length(pIDs)) + }else{ + wts <- c(wts, tmp[, wCol]) + } + for (ch in 1:length(channelList)) { + chName <- channelList[[ch]]@name + transFun <- channelList[[ch]]@transFun[[1]] + cat("Summarizing ", chName, " channel\n") + cat("Processing Array", i, "\n") + newVals <- transFun(BLData, array = i)[retainedBeads] + if (length(newVals) != nrow(tmp)) + stop("Transformation function did not return correct number of values") + values[[ch]] <- c(values[[ch]], newVals) + } + } + for (ch in 1:length(channelList)) { + exprFun <- channelList[[ch]]@exprFun[[1]] #! + varFun <- channelList[[ch]]@varFun[[1]] #! + values2 <- values[[ch]] + naVals <- which(is.na(values2) | is.infinite(values2)) + pIDs2 <- pIDs + wts2 <- wts + if (length(naVals) > 0) { + values2 <- values2[-naVals] + pIDs2 <- pIDs[-naVals] + wts2 <- wts[-naVals] + } + pOrder <- order(pIDs2) + pIDs2 <- pIDs2[pOrder] + values2 <- values2[pOrder] + wts2 <- wts2[pOrder] + if (any(wts2 == 0)) { + values2 <- values2[-which(wts2 == 0)] + pIDs2 <- pIDs2[-which(wts2 == 0)] + wts2 <- wts2[-which(wts2 == 0)] + } + ## spezieller Teil f?r rmx + tmp <- split(wts2 * values2, pIDs2) + pMap <- match(names(tmp), probeIDs) + cat("Using rmx\n") + res.rmx <- rmxBeadSummary(x = tmp, eps = eps, eps.lower = eps.lower, eps.upper= eps.upper, + steps = steps, fsCor = fsCor, mad0 = mad0) + output[[ch]][["eMat"]][pMap, s] <- res.rmx$eMat + output[[ch]][["varMat"]][pMap, s] <- res.rmx$varMat + output[[ch]][["nObs"]][pMap, s] <- res.rmx$nObs + } + } + cat("Making summary object\n") + eMat <- output[[1]][["eMat"]] + varMat <- output[[1]][["varMat"]] + nObs <- output[[1]][["nObs"]] + if (length(output) > 1) { + for (i in 2:length(output)) { + eMat <- cbind(eMat, output[[i]][["eMat"]]) + varMat <- cbind(varMat, output[[i]][["varMat"]]) + nObs <- cbind(nObs, output[[i]][["nObs"]]) + } + } + channelFac <- NULL + for (i in 1:length(channelList)) { + newfac <- cNames[i] + channelFac <- c(channelFac, rep(newfac, length(sList))) + } + BSData <- new("ExpressionSetIllumina") + annoName <- annotation(BLData) + if (!is.null(annoName)) { + annoLoaded <- require(paste("illumina", annoName, ".db", sep = ""), character.only = TRUE) + if (annoLoaded) { + mapEnv <- as.name(paste("illumina", annoName, "ARRAYADDRESS", sep = "")) + IlluminaIDs <- as.character(unlist(AnnotationDbi::mget(as.character(probeIDs), revmap(eval(mapEnv)), ifnotfound = NA))) + rownames(eMat) <- rownames(varMat) <- rownames(nObs) <- as.character(IlluminaIDs) + status <- rep("Unknown", length(probeIDs)) + annoPkg <- paste("illumina", annoName, ".db", sep = "") + annoVers <- packageDescription(annoPkg, field = "Version") + message(paste("Annotating control probes using package ", annoPkg, " Version:", annoVers, "\n", sep = "")) + mapEnv <- as.name(paste("illumina", annoName, "REPORTERGROUPNAME", sep = "")) + t <- try(eval(mapEnv), silent = TRUE) + if (class(t) == "try-error") { + message(paste("Could not find a REPORTERGROUPNAME mapping in annotation package ", annoPkg, + ". Perhaps it needs updating?", sep = "")) + } + else { + status[which(!is.na(IlluminaIDs))] <- unlist(AnnotationDbi::mget(IlluminaIDs[which(!is.na(IlluminaIDs))], + eval(mapEnv), ifnotfound = NA)) + status[which(is.na(status))] <- "regular" + } + featureData(BSData) <- new("AnnotatedDataFrame", data = data.frame(ArrayAddressID = probeIDs, + IlluminaID = IlluminaIDs, Status = status, row.names = IlluminaIDs)) + BSData at annotation <- annoName + } + } + else { + cat("Could not map ArrayAddressIDs: No annotation specified\n") + featureData(BSData) <- new("AnnotatedDataFrame", data = data.frame(ProbeID = probeIDs, + row.names = probeIDs)) + } + assayData(BSData) <- assayDataNew(exprs = eMat, se.exprs = varMat, + nObservations = nObs, storage.mode = "list") + sampInfo <- beadarray:::sampleSheet(BLData) + if (!is.null(sampInfo)) { + expIDs <- paste(sampInfo$Sentrix_ID, sampInfo$Sentrix_Position, sep = "_") + sampInfo <- sampInfo[sapply(newNames, function(x) grep(strtrim(x, 12), expIDs)), ] + p <- new("AnnotatedDataFrame", data.frame(sampInfo, row.names = newNames)) + } + else p <- new("AnnotatedDataFrame", data.frame(sampleID = newNames, SampleFac = unique(sampleFac), + row.names = newNames)) + phenoData(BSData) <- p + qcNames <- names(BLData at sectionData) + qcNames <- setdiff(qcNames, "Targets") + if (length(qcNames) > 0) { + QC <- BLData at sectionData[[qcNames[[1]]]] + if (length(qcNames > 1)) { + for (i in 2:length(qcNames)) { + QC <- cbind(QC, BLData at sectionData[[qcNames[i]]]) + } + } + QC <- new("AnnotatedDataFrame", data.frame(QC, row.names = arraynms)) + BSData at QC <- QC + } + BSData at channelData <- list(channelFac, channelList) + BSData + }) +## computation of bead summaries via robloxbioc for "matrix" +rmxBeadSummary <- function(x, eps, eps.lower, eps.upper, steps, fsCor, mad0){ + nObs <- sapply(x, length) + noBeads <- as.integer(names(table(nObs))) + varMat <- eMat <- numeric(length(nObs)) + for(i in seq(along = noBeads)){ + index <- nObs == noBeads[i] + if(noBeads[i] == 1){ + eMat[index] <- as.vector(unlist(x[index])) + varMat[index] <- mad0 + }else{ + temp <- t(sapply(x[index], rbind)) + rmx <- robloxbioc(temp, eps = eps, eps.lower = eps.lower, eps.upper = eps.upper, + steps = steps, fsCor = fsCor, mad0 = mad0) + eMat[index] <- rmx[,"mean"] + varMat[index] <- rmx[,"sd"] + } + } + list(eMat = eMat, varMat = varMat, nObs = nObs) +} Deleted: branches/robast-0.9/pkg/RobLoxBioC/R/robloxbiocBeadLevelList.R =================================================================== --- branches/robast-0.9/pkg/RobLoxBioC/R/robloxbiocBeadLevelList.R 2013-01-31 19:09:59 UTC (rev 581) +++ branches/robast-0.9/pkg/RobLoxBioC/R/robloxbiocBeadLevelList.R 2013-02-01 04:12:19 UTC (rev 582) @@ -1,196 +0,0 @@ -setMethod("robloxbioc", signature(x = "BeadLevelList"), - function(x, log = TRUE, imagesPerArray = 1, what = "G", probes = NULL, arrays = NULL, - eps = NULL, eps.lower = 0, eps.upper = 0.05, steps = 3L, - fsCor = TRUE, mad0 = 1e-4){ - BLData <- x - arraynms <- arrayNames(BLData) - if(!is.null(arrays) && !is.character(arrays)) arraynms <- arraynms[arrays] - if(is.character(arrays)) arraynms <- which(arraynms %in% arrays) - len <- length(arraynms) - what <- match.arg(what, c("G", "R", "RG", "M", "A", "beta")) - whatelse <- "" - if(what == "RG"){ - if(BLData at arrayInfo$channels == "two"){ - what <- "G" - whatelse <- "R" - }else{ - stop("Need two-channel data to calculate summary R and G values") - } - } - if(imagesPerArray == 1){ - pr <- getArrayData(BLData, what = "ProbeID", array = arraynms[1]) - sel <- pr != 0 - pr <- pr[sel] - finten <- getArrayData(BLData, what = what, log = log, array = arraynms[1])[sel] - nasinf <- !is.finite(finten) | is.na(finten) - finten <- finten[!nasinf] - } - else if(imagesPerArray == 2){ - if(length(arraynms)%%2 != 0) - stop("Need an even number of arrays when 'imagesPerArray=2'") - arrayord <- order(arraynms) - arraynms <- arraynms[arrayord] - tmp <- unlist(strsplit(arraynms, "_")) - chipnums <- tmp[seq(1, length(tmp), by = 3)] - pos <- tmp[seq(2, length(tmp), by = 3)] - stripnum <- as.numeric(tmp[seq(3, length(tmp), by = 3)]) - check <- ((chipnums[seq(1, len, by = 2)] == chipnums[seq(2, len, by = 2)]) - & (pos[seq(1, len, by = 2)] == pos[seq(2, len, by = 2)]) - & (stripnum[seq(1, len, by = 2)] == stripnum[seq(2, len, by = 2)] - 1)) - if (sum(check) != length(check)) - stop("Missing arrays") - sel1 <- getArrayData(BLData, what = "ProbeID", array = arraynms[1]) != 0 - sel2 <- getArrayData(BLData, what = "ProbeID", array = arraynms[2]) != 0 - pr <- append(getArrayData(BLData, what = "ProbeID", array = arraynms[1])[sel1], - getArrayData(BLData, what = "ProbeID", array = arraynms[2])[sel2]) - finten <- append(getArrayData(BLData, what = what, log = log, array = arraynms[1])[sel1], - getArrayData(BLData, what = what, log = log, array = arraynms[2])[sel2]) - nasinf <- !is.finite(finten) | is.na(finten) - finten <- finten[!nasinf] - }else{ - stop("You can only specify 1 or 2 images per array") - } - if(is.null(probes)) probes <- sort(unique(pr)) - probes <- probes[probes > 0 & !is.na(probes)] - noprobes <- length(probes) - pr <- pr[!nasinf] - if (imagesPerArray == 1) { - G <- GBeadStDev <- GNoBeads <- matrix(0, nrow = noprobes, ncol = len) - colnames(G) <- colnames(GBeadStDev) <- colnames(GNoBeads) <- arraynms - if (BLData at arrayInfo$channels == "two" && !is.null(BLData[[arraynms[1]]]$R) && whatelse == "R") - R <- RBeadStDev <- RNoBeads <- G - else R <- NULL - } - else if (imagesPerArray == 2) { - G <- GBeadStDev <- GNoBeads <- matrix(0, nrow = noprobes, ncol = (len/2)) - colnames(G) <- colnames(GBeadStDev) <- colnames(GNoBeads) <- arraynms[seq(1, len, by = 2)] - if (BLData at arrayInfo$channels == "two" && !is.null(BLData[[arraynms[1]]]$R) && whatelse == "R") - R <- RBeadStDev <- RNoBeads <- G - else R <- NULL - } - i <- j <- 1 - while (j <= len) { - probeIDs <- as.integer(pr) - start <- 0 - blah <- rmxBeadSummary(x = finten, probeIDs = probeIDs, probes = probes, - eps = eps, eps.lower = eps.lower, eps.upper = eps.upper, - steps = steps, fsCor = fsCor, mad0 = mad0) - G[, i] <- blah$fore - GBeadStDev[, i] <- blah$sd - GNoBeads[, i] <- blah$noBeads - if (BLData at arrayInfo$channels == "two" && !is.null(BLData[[arraynms[i]]]$R) && whatelse == "R") { - if (imagesPerArray == 1) { - finten <- getArrayData(BLData, what = whatelse, log = log, array = arraynms[i])[sel] - nasinf <- !is.finite(finten) | is.na(finten) - finten <- finten[!nasinf] - } - else if (imagesPerArray == 2) { - finten <- append(getArrayData(BLData, what = whatelse, log = log, array = arraynms[j])[sel1], - getArrayData(BLData, what = whatelse, log = log, array = arraynms[j + 1])[sel2]) - nasinf <- !is.finite(finten) | is.na(finten) - finten <- finten[!nasinf] - } - blah <- rmxBeadSummary(x = finten, probeIDs = probeIDs, probes = probes, - eps = eps, eps.lower = eps.lower, eps.upper = eps.upper, - steps = steps, fsCor = fsCor, mad0 = mad0) - R[, i] <- blah$fore - RBeadStDev[, i] <- blah$sd - RNoBeads[, i] <- blah$noBeads - } - j <- j + imagesPerArray - i <- i + 1 - rm(probeIDs, blah) - gc() - if ((imagesPerArray == 1) && (i <= len)) { - sel <- getArrayData(BLData, what = "ProbeID", array = arraynms[i]) != 0 - pr <- getArrayData(BLData, what = "ProbeID", array = arraynms[i])[sel] - finten <- getArrayData(BLData, what = what, log = log, array = arraynms[i])[sel] - nasinf <- !is.finite(finten) | is.na(finten) - pr <- pr[!nasinf] - finten <- finten[!nasinf] - } - else if ((imagesPerArray == 2) && (j < len)) { - sel1 <- getArrayData(BLData, what = "ProbeID", array = arraynms[j]) != 0 - sel2 <- getArrayData(BLData, what = "ProbeID", array = arraynms[j + 1]) != 0 - pr <- append(getArrayData(BLData, what = "ProbeID", array = arraynms[j])[sel1], - getArrayData(BLData, what = "ProbeID", array = arraynms[j + 1])[sel2]) - finten <- append(getArrayData(BLData, what = what, log = log, array = arraynms[j])[sel1], - getArrayData(BLData, what = what, log = log, array = arraynms[j + 1])[sel2]) - nasinf <- !is.finite(finten) | is.na(finten) - pr <- pr[!nasinf] - finten <- finten[!nasinf] - } - } - GBeadStDev <- GBeadStDev/sqrt(GNoBeads) - if(!is.null(R)) RBeadStDev <- RBeadStDev/sqrt(RNoBeads) - if (whatelse == "R") { - rownames(G) <- rownames(R) <- rownames(GBeadStDev) <- rownames(RBeadStDev) <- rownames(GNoBeads) <- rownames(RNoBeads) <- probes - BSData <- new("NChannelSet", R = R, G = G, GBeadStDev = GBeadStDev, - RBeadStDev = RBeadStDev, GNoBeads = GNoBeads, RNoBeads = RNoBeads) - } - else { - BSData <- new("ExpressionSetIllumina") - assayData(BSData) <- assayDataNew(exprs = G, se.exprs = GBeadStDev, - NoBeads = GNoBeads, storage.mode = "list") - rownames(exprs(BSData)) <- rownames(se.exprs(BSData)) <- rownames(NoBeads(BSData)) <- probes - featureData(BSData) <- new("AnnotatedDataFrame", data = data.frame(ProbeID = probes, row.names = probes)) - } - if (nrow(pData(BLData)) == len) { - if (imagesPerArray == 2) - BSData at phenoData <- new("AnnotatedDataFrame", data = pData(BLData at phenoData)[arrayord, , drop = FALSE][seq(1, len, by = 2), , drop = FALSE]) - else BSData at phenoData <- BLData at phenoData - } - else { - BSData at phenoData <- new("AnnotatedDataFrame", data = data.frame(sampleName = colnames(G))) - } - if (!is.null(pData(BSData)$sampleName)) - sampleNames(BSData) <- pData(BSData)$sampleName - else sampleNames(BSData) <- colnames(G) - if (whatelse == "R") { - varMetadata <- data.frame(labelDescription = colnames(BSData at phenoData@data), channel = "_ALL_") - BSData at phenoData <- new("AnnotatedDataFrame", data = data.frame(BSData at phenoData@data), varMetadata = varMetadata) - } - BSData at annotation <- BLData at annotation - if ("qcScores" %in% names(BLData at arrayInfo)) - t <- try(BSData at BeadLevelQC <- BLData at arrayInfo$qcScores, silent = TRUE) - BSData - }) -## computation of bead summaries via robloxbioc for "matrix" -rmxBeadSummary <- function(x, probeIDs, probes, eps, eps.lower, eps.upper, steps, fsCor, mad0){ - comIDs <- intersect(probeIDs, probes) - x <- x[probeIDs %in% comIDs] - probeIDs <- probeIDs[probeIDs %in% comIDs] - noBeads <- as.vector(table(probeIDs)) - noBeads.uni <- as.integer(names(table(noBeads))) - probes1 <- comIDs - len1 <- length(probes1) - fore1 <- numeric(len1) - SD1 <- numeric(len1) - for(i in seq(along = noBeads.uni)){ - index <- noBeads == noBeads.uni[i] - IDs <- probes1[index] - if(noBeads.uni[i] == 1){ - fore1[index] <- x[probeIDs %in% IDs] - SD1[index] <- mad0 - }else{ - temp <- matrix(x[probeIDs %in% IDs], ncol = noBeads.uni[i], byrow = TRUE) - rmx <- robloxbioc(temp, eps = eps, eps.lower = eps.lower, eps.upper = eps.upper, - steps = steps, fsCor = fsCor, mad0 = mad0) - fore1[index] <- rmx[,"mean"] - SD1[index] <- rmx[,"sd"] - } - } - len <- length(probes) - fore <- numeric(len) - SD <- numeric(len) - noBeads1 <- numeric(len) - nas <- !(probes %in% comIDs) - fore[nas] <- NA - fore[!nas] <- fore1 - SD[nas] <- NA - SD[!nas] <- SD1 - noBeads1[nas] <- 0 - noBeads1[!nas] <- noBeads - - return(list(fore = fore, sd = SD, noBeads = noBeads1)) -} Modified: branches/robast-0.9/pkg/RobLoxBioC/R/robloxbiocMatrix.R =================================================================== --- branches/robast-0.9/pkg/RobLoxBioC/R/robloxbiocMatrix.R 2013-01-31 19:09:59 UTC (rev 581) +++ branches/robast-0.9/pkg/RobLoxBioC/R/robloxbiocMatrix.R 2013-02-01 04:12:19 UTC (rev 582) @@ -7,7 +7,6 @@ fsCor = TRUE, mad0 = 1e-4){ stopifnot(is.numeric(x)) if(ncol(x) <= 2){ - warning("Sample size <= 2! => Median and MAD are used for estimation.") mean <- rowMedians(x, na.rm = TRUE) sd <- rowMedians(abs(x-mean), na.rm = TRUE)/qnorm(0.75) robEst <- cbind(mean, sd) @@ -60,7 +59,7 @@ if(!is.null(eps)){ r <- sqrt(ncol(x))*eps - if(fsCor) r <- .finiteSampleCorrection(r = r, n = ncol(x)) + if(fsCor) r <- finiteSampleCorrection(r = r, n = ncol(x), model = "locsc") if(r > 10){ b <- sd*1.618128043 const <- 1.263094656 @@ -76,7 +75,7 @@ mse <- A1 + A2 } robEst <- .kstep.locsc.matrix(x = x, initial.est = cbind(mean, sd), - A1 = A1, A2 = A2, a = a, b = b, k = steps) + A1 = A1, A2 = A2, a = a, b = b, k = steps)$est colnames(robEst) <- c("mean", "sd") }else{ sqrtn <- sqrt(ncol(x)) @@ -88,7 +87,7 @@ r <- uniroot(.getlsInterval, lower = rlo+1e-8, upper = rup, tol = .Machine$double.eps^0.25, rlo = rlo, rup = rup)$root } - if(fsCor) r <- .finiteSampleCorrection(r = r, n = ncol(x)) + if(fsCor) r <- finiteSampleCorrection(r = r, n = ncol(x), model = "locsc") if(r > 10){ b <- sd*1.618128043 const <- 1.263094656 @@ -115,56 +114,9 @@ } } robEst <- .kstep.locsc.matrix(x = x, initial.est = cbind(mean, sd), - A1 = A1, A2 = A2, a = a, b = b, k = steps) + A1 = A1, A2 = A2, a = a, b = b, k = steps)$est colnames(robEst) <- c("mean", "sd") } return(robEst) }) -############################################################################### -## computation of k-step construction in case x is a matrix -############################################################################### -.onestep.locsc.matrix <- function(x, initial.est, A1, A2, a, b){ - mean <- initial.est[,1] - sd <- initial.est[,2] - u <- A1*(x-mean)/sd^2 - v <- A2*(((x-mean)/sd)^2-1)/sd - a - ind <- b/sqrt(u^2 + v^2) <= 1 - IC1 <- rowMeans(u*(ind*b/sqrt(u^2 + v^2) + !ind), na.rm = TRUE) - IC2 <- rowMeans(v*(ind*b/sqrt(u^2 + v^2) + !ind), na.rm = TRUE) - IC <- cbind(IC1, IC2) - return(initial.est + IC) -} -.kstep.locsc.matrix <- function(x, initial.est, A1, A2, a, b, mean, k){ - est <- .onestep.locsc.matrix(x = x, initial.est = initial.est, A1 = A1, A2 = A2, a = a, b = b) - if(k > 1){ - for(i in 2:k){ - A1 <- est[,2]^2*A1/initial.est[,2]^2 - A2 <- est[,2]^2*A2/initial.est[,2]^2 [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/robast -r 582 From noreply at r-forge.r-project.org Fri Feb 1 08:17:46 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 1 Feb 2013 08:17:46 +0100 (CET) Subject: [Robast-commits] r583 - branches/robast-0.9/pkg/RobExtremes/R Message-ID: <20130201071746.4D5D61842BC@r-forge.r-project.org> Author: ruckdeschel Date: 2013-02-01 08:17:45 +0100 (Fri, 01 Feb 2013) New Revision: 583 Modified: branches/robast-0.9/pkg/RobExtremes/R/QBCC.R branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R branches/robast-0.9/pkg/RobExtremes/R/interpolSn.R branches/robast-0.9/pkg/RobExtremes/R/sysdata.rda Log: RobExtremes: yet another time: the grids are rubbish, as the xi-grid was not sorted Modified: branches/robast-0.9/pkg/RobExtremes/R/QBCC.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/QBCC.R 2013-02-01 04:12:19 UTC (rev 582) +++ branches/robast-0.9/pkg/RobExtremes/R/QBCC.R 2013-02-01 07:17:45 UTC (rev 583) @@ -25,6 +25,7 @@ trafo = NULL, fixed = NULL, na.rm = TRUE, ...){ es.call <- match.call() + force(p1); force(p2) if(length(p1)>1 || any(!is.finite(p1)) || p1<=0 || p1>=1) stop("'p1' has to be in [0,1] and of length 1.") if(length(p2)>1 || any(!is.finite(p2)) || p2<=0 || p2>=1 || abs(p1-p2)< 1e-8) Modified: branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R 2013-02-01 04:12:19 UTC (rev 582) +++ branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R 2013-02-01 07:17:45 UTC (rev 583) @@ -40,6 +40,7 @@ withSmooth = TRUE, withPrint = FALSE, withCall = FALSE){ print(match.call()) call <- match.call() + xiGrid <- unique(sort(xiGrid)) itLM <- 0 getLM <- function(xi){ itLM <<- itLM + 1 @@ -83,6 +84,9 @@ iNA <- apply(LMGrid,1, function(u) any(is.na(u))) LMGrid <- LMGrid[!iNA,,drop=FALSE] xiGrid <- xiGrid[!iNA] + oG <- order(xiGrid) + xiGrid <- xiGrid[oG] + LMGrid <- LMGrid[oG,,drop=FALSE] if(withSmooth) LMGrid2 <- apply(LMGrid,2,function(u) smooth.spline(xiGrid,u)$y) Modified: branches/robast-0.9/pkg/RobExtremes/R/interpolSn.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/interpolSn.R 2013-02-01 04:12:19 UTC (rev 582) +++ branches/robast-0.9/pkg/RobExtremes/R/interpolSn.R 2013-02-01 07:17:45 UTC (rev 583) @@ -61,6 +61,7 @@ upp=1.01, accuracy = 10000, GridFileName="SnGrid.Rdata", withSmooth = TRUE, withPrint = FALSE, withCall = FALSE){ call <- match.call() + xiGrid <- unique(sort(xiGrid)) itSn <- 0 getSn <- function(xi){ itSn <<- itSn + 1 Modified: branches/robast-0.9/pkg/RobExtremes/R/sysdata.rda =================================================================== (Binary files differ) From noreply at r-forge.r-project.org Fri Feb 1 08:20:42 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 1 Feb 2013 08:20:42 +0100 (CET) Subject: [Robast-commits] r584 - in branches/robast-0.9/pkg/ROptEst: R man Message-ID: <20130201072042.ACF7C1813F0@r-forge.r-project.org> Author: ruckdeschel Date: 2013-02-01 08:20:42 +0100 (Fri, 01 Feb 2013) New Revision: 584 Modified: branches/robast-0.9/pkg/ROptEst/R/getStartIC.R branches/robast-0.9/pkg/ROptEst/R/roptest.new.R branches/robast-0.9/pkg/ROptEst/man/getStartIC-methods.Rd Log: two silly errors in roptest.new.R -> threw error when passed on S4-estimators as starting estimators; getStartIC now also dispatches on asCov, trASCov, and asBias risk Modified: branches/robast-0.9/pkg/ROptEst/R/getStartIC.R =================================================================== --- branches/robast-0.9/pkg/ROptEst/R/getStartIC.R 2013-02-01 07:17:45 UTC (rev 583) +++ branches/robast-0.9/pkg/ROptEst/R/getStartIC.R 2013-02-01 07:20:42 UTC (rev 584) @@ -1,7 +1,7 @@ setMethod("getStartIC",signature(model = "ANY", risk = "ANY"), function(model, risk, ...) stop("not yet implemented")) -setMethod("getStartIC",signature(model = "L2ParamFamily", risk = "asRisk"), +setMethod("getStartIC",signature(model = "L2ParamFamily", risk = "asGRisk"), function(model, risk, ..., ..debug=FALSE){ mc <- match.call(expand.dots=FALSE, call = sys.call(sys.parent(1))) dots <- as.list(mc$"...") @@ -19,7 +19,7 @@ }else neighbor <- ContNeighborhood() sm.rmx <- selectMethod("radiusMinimaxIC", signature( - class(model),class(neighbor),class(risk))) + class(model),class(neighbor),class(risk))) dots.rmx <- .fix.in.defaults(dots, sm.rmx) dots.rmx$L2Fam <- NULL dots.rmx$neighbor <- NULL @@ -31,7 +31,8 @@ dots.optic <- .fix.in.defaults(dots, sm.optic) dots.optic$model <- NULL dots.optic$risk <- NULL - if(is.null(eps$e)){ + + if(is.null(eps[["e"]])){ dots.rmx$loRad <- eps$sqn * eps$lower dots.rmx$upRad <- eps$sqn * eps$upper arg.rmx <- c(list(L2Fam = model, neighbor = neighbor, @@ -59,8 +60,36 @@ return(ICstart) }) +setMethod("getStartIC",signature(model = "L2ParamFamily", risk = "asCov"), + function(model, risk, ..., ..debug=FALSE){ + return(optIC(model, risk)) + }) +setMethod("getStartIC",signature(model = "L2ParamFamily", risk = "trAsCov"), + getMethod("getStartIC", signature(model = "L2ParamFamily", risk = "asCov")) + ) +setMethod("getStartIC",signature(model = "L2ParamFamily", risk = "asBias"), + function(model, risk, ..., ..debug=FALSE){ + mc <- match.call(expand.dots=FALSE, call = sys.call(sys.parent(1))) + dots <- as.list(mc$"...") + if("fsCor" %in% names(dots)){ + fsCor <- eval(dots[["fsCor"]]) + dots$fsCor <- NULL + }else fsCor <- 1 + if("eps" %in% names(dots)){ + eps <- dots[["eps"]] + dots$eps <- NULL + }else eps <- NULL + if("neighbor" %in% names(dots)){ + neighbor <- eval(dots[["neighbor"]]) + dots$neighbor <- NULL + }else neighbor <- ContNeighborhood() + infMod <- InfRobModel(center = model, neighbor = neighbor) + return(optIC(infMod, risk)) + }) + + setMethod("getStartIC",signature(model = "L2ScaleShapeUnion", risk = "interpolRisk"), function(model, risk, ...){ @@ -74,11 +103,15 @@ sng <- try(getFromNamespace(.versionSuff(gridn), ns = "RobExtremes"), silent=TRUE) if(!is(sng,"try-error")) nsng <- names(sng) + #print(.versionSuff(gridn)) if(length(nsng)){ if(nam %in% nsng){ interpolfct <- sng[[nam]]$fct #print(xi) #print(beta) + #print(head(sng[[nam]]$grid)) + #print(xi) + #print(beta) .modifyIC <- function(L2Fam, IC){ para <- param(L2Fam) xi0 <- main(para)["shape"]#[scaleshapename(L2Fam)["scale"]] Modified: branches/robast-0.9/pkg/ROptEst/R/roptest.new.R =================================================================== --- branches/robast-0.9/pkg/ROptEst/R/roptest.new.R 2013-02-01 07:17:45 UTC (rev 583) +++ branches/robast-0.9/pkg/ROptEst/R/roptest.new.R 2013-02-01 07:20:42 UTC (rev 584) @@ -83,7 +83,6 @@ nbCtrl <- .fix.in.defaults(nbCtrl, gennbCtrl) startCtrl <- .fix.in.defaults(startCtrl, genstartCtrl) kStepCtrl <- .fix.in.defaults(kStepCtrl, genkStepCtrl) - es.list <- as.list(es.call0[-1]) es.list <- c(es.list,nbCtrl) es.list$nbCtrl <- NULL @@ -148,10 +147,10 @@ }else{ sy.start <- system.time({ sctrl.init <- eval(startCtrl$initial.est) - if(!is.null(startCtrl$initial.est.ArgList)){ + if(is.null(startCtrl$initial.est.ArgList)){ initial.est <- kStepEstimator.start(start = sctrl.init, x = x, nrvalues = nrvalues, na.rm = na.rm, - L2Fam = L2Fam) + L2Fam = L2Fam, startList = NULL) }else{ initial.est <- kStepEstimator.start(start = sctrl.init, x = x, nrvalues = nrvalues, na.rm = na.rm, @@ -172,6 +171,7 @@ if(!is(risk,"interpolRisk")) es.list0$eps <- do.call(.check.eps, args=c(nbCtrl,list("x"=x))) + es.list0$risk <- NULL es.list0$L2Fam <- NULL neighbor <- eval(es.list0$neighbor) Modified: branches/robast-0.9/pkg/ROptEst/man/getStartIC-methods.Rd =================================================================== --- branches/robast-0.9/pkg/ROptEst/man/getStartIC-methods.Rd 2013-02-01 07:17:45 UTC (rev 583) +++ branches/robast-0.9/pkg/ROptEst/man/getStartIC-methods.Rd 2013-02-01 07:20:42 UTC (rev 584) @@ -3,7 +3,10 @@ \alias{getStartIC-methods} \alias{getStartIC} \alias{getStartIC,ANY,ANY-method} -\alias{getStartIC,L2ParamFamily,asRisk-method} +\alias{getStartIC,L2ParamFamily,asGRisk-method} +\alias{getStartIC,L2ParamFamily,asBias-method} +\alias{getStartIC,L2ParamFamily,asCov-method} +\alias{getStartIC,L2ParamFamily,trAsCov-method} \alias{getStartIC,L2ScaleShapeUnion,interpolRisk-method} \title{Methods for Function getStartIC in Package `ROptEst' } From noreply at r-forge.r-project.org Tue Feb 5 19:47:51 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 5 Feb 2013 19:47:51 +0100 (CET) Subject: [Robast-commits] r585 - branches/robast-0.9/pkg/ROptEst/inst/scripts Message-ID: <20130205184751.5F98E18454C@r-forge.r-project.org> Author: ruckdeschel Date: 2013-02-05 19:47:51 +0100 (Tue, 05 Feb 2013) New Revision: 585 Modified: branches/robast-0.9/pkg/ROptEst/inst/scripts/NormalLocationModel.R Log: [ROptEst] minor changes in scripts Modified: branches/robast-0.9/pkg/ROptEst/inst/scripts/NormalLocationModel.R =================================================================== --- branches/robast-0.9/pkg/ROptEst/inst/scripts/NormalLocationModel.R 2013-02-01 07:20:42 UTC (rev 584) +++ branches/robast-0.9/pkg/ROptEst/inst/scripts/NormalLocationModel.R 2013-02-05 18:47:51 UTC (rev 585) @@ -114,14 +114,15 @@ Risks(N0.IC8) plot(N0.IC8) -getReq(asMSE(),neighbor,N0.ICA,N0.IC1,n=1) -getReq(asMSE(),neighbor,N0.ICA,N0.IC1,n=30) -getReq(asL1(),neighbor,N0.ICA,N0.IC1,n=30) -getReq(asL4(),neighbor,N0.ICA,N0.IC1,n=30) -getReq(asMSE(),neighbor,N0.ICA,N0.IC7,n=30) -getReq(asL1(),neighbor,N0.ICA,N0.IC7,n=30) -getReq(asL4(),neighbor,N0.ICA,N0.IC7,n=30) -getReq(asMSE(),neighbor,N0.IC1,N0.IC7,n=30) +neighbor.0 <- ContNeighborhood() +getReq(asMSE(),neighbor.0,N0.ICA,N0.IC1,n=1) +getReq(asMSE(),neighbor.0,N0.ICA,N0.IC1,n=30) +getReq(asL1(),neighbor.0,N0.ICA,N0.IC1,n=30) +getReq(asL4(),neighbor.0,N0.ICA,N0.IC1,n=30) +getReq(asMSE(),neighbor.0,N0.ICA,N0.IC7,n=30) +getReq(asL1(),neighbor.0,N0.ICA,N0.IC7,n=30) +getReq(asL4(),neighbor.0,N0.ICA,N0.IC7,n=30) +getReq(asMSE(),neighbor.0,N0.IC1,N0.IC7,n=30) getMaxIneff(N0.ICA,neighbor=ContNeighborhood()) From noreply at r-forge.r-project.org Thu Feb 7 14:19:22 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 7 Feb 2013 14:19:22 +0100 (CET) Subject: [Robast-commits] r586 - branches/robast-0.9/pkg/RobExtremes/tests/TestSuite Message-ID: <20130207131922.A78FC181128@r-forge.r-project.org> Author: kroisand Date: 2013-02-07 14:19:22 +0100 (Thu, 07 Feb 2013) New Revision: 586 Modified: branches/robast-0.9/pkg/RobExtremes/tests/TestSuite/TestExpectation.R Log: kleine Tippfehler im Test von Erwartungswerten korrigiert Modified: branches/robast-0.9/pkg/RobExtremes/tests/TestSuite/TestExpectation.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/tests/TestSuite/TestExpectation.R 2013-02-05 18:47:51 UTC (rev 585) +++ branches/robast-0.9/pkg/RobExtremes/tests/TestSuite/TestExpectation.R 2013-02-07 13:19:22 UTC (rev 586) @@ -4,110 +4,25 @@ ## ## ########################################## -# .setUp(), .tearDown(): Either one or both functions have to be provided by the test case -#author, take precedence over the dummy definitions provided by the -#RUnit package and are called once for every test case identified. +# .setUp(), .tearDown(): +# Either one or both functions have to be provided by the test case +# author, take precedence over the dummy definitions provided by the +# RUnit package and are called once for every test case identified. - .setUp{ - - - ##expectation of Pareto distributed random variable - expectation.Pareto = function(shape0=1,Min0=1){ +# we construct different objects for testing the expectation operator +.setUp{ + # expectation of Pareto distributed random variable + expectation.Pareto = function(shape0=1,Min0=1){ X = Pareto(shape=shape0,Min=Min0) return(E(X)) - } + } +} - ### zwei Strategien: - ## Ticket Nataliya: - # je ein Test f?r jeden Wert - test.expectationPareto = function(){ - checkEquals(expectation.Pareto(1,1), Inf) - checkEquals(expectation.Pareto(2,1), 0) - } - test.expectationPareto2 = function(){ - checkEquals(expectation.Pareto(2,1), Inf) - } - # ein Test f?r viele Werte - test.expectationPareto = function(){ - a1 <- checkEquals(expectation.Pareto(1,1), Inf) - a2 <- checkEquals(expectation.Pareto(1,1), Inf) - print(c(a1,a2)) - return(all(c(a1,a2))) - } - - -# test.HTMLInfo.Pareto = function(){ -# track <- tracker() -# ## initialize the tracker -# track$init() -# -# ## inspect the function -# resFoo <- inspect(expectation.Pareto(1,1), track = track) -# ## get the tracked function call info for all inspect calls -# resTrack <- track$getTrackInfo() -# } -# -# } - -# .tearDown(){ -# ##create HTML sites in folder ./results for all inspect calls -# printHTML.trackInfo(resTrack,"TestSuite/TestExpectation") -# } - +# test for the expectation of the pareto-distribution +test.expectationPareto1 <- function() { + checkEquals(expectation.Pareto(1, 1), Inf) } -# -# Beispiele -# .setUp() -# { -# test.checkFunctions1 = function(){ -# checkTrue(1 < 2, "check1") ## passes fine -# ## checkTrue(1 > 2, "check2") ## appears as failure in the test protocol -# v <- 1:3 -# w <- 1:3 -# checkEquals(v, w) ## passes fine -# names(v) <- c("A", "B", "C") -# ## checkEquals(v, w) ## fails because v and w have different names -# checkEqualsNumeric(v, w) ## passes fine because names are ignored -# x <- rep(1:12, 2) -# y <- rep(0:1, 12) -# res <- list(a=1:3, b=letters, LM=lm(y ~ x)) -# res2 <- list(a=seq(1,3,by=1), b=letters, LM=lm(y ~ x)) -# checkEquals(res, res2) ## passes fine -# checkIdentical(res, res) -# checkIdentical(res2, res2) -# ## checkIdentical(res, res2) ## fails because element ???a??? differs in type -# } -# } -# .tearDown() -# {} -# -# fun <- function(x) { -# if(x) -# { -# stop("stop conditions signaled") -# } -# return() -# -# } -# -# .setUp() -# { -# test.checkFunctions2 = function(){ -# checkException(fun(TRUE)) ## passes fine -# ## checkException(fun(FALSE)) ## failure, because fun raises no error -# checkException(fun(TRUE), silent=TRUE) -# ## special constants -# ## same behaviour as for underlying base functions -# checkEquals(NA, NA) -# checkEquals(NaN, NaN) -# checkEquals(Inf, Inf) -# checkIdentical(NA, NA) -# checkIdentical(NaN, NaN) -# checkIdentical(-Inf, -Inf) -# ## DEACTIVATED("here one can document on the reason for deactivation") -# } -# } -# -# .tearDown() -# {} \ No newline at end of file +test.expectationPareto2 <- function() { + checkEquals(expectation.Pareto(2, 1), 0) +} From noreply at r-forge.r-project.org Thu Feb 7 17:07:34 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 7 Feb 2013 17:07:34 +0100 (CET) Subject: [Robast-commits] r587 - in branches/robast-0.9/pkg: . RobRDA RobRDA/R RobRDA/man Message-ID: <20130207160735.18A72184780@r-forge.r-project.org> Author: ruckdeschel Date: 2013-02-07 17:07:34 +0100 (Thu, 07 Feb 2013) New Revision: 587 Added: branches/robast-0.9/pkg/RobRDA/ branches/robast-0.9/pkg/RobRDA/DESCRIPTION branches/robast-0.9/pkg/RobRDA/NAMESPACE branches/robast-0.9/pkg/RobRDA/R/ branches/robast-0.9/pkg/RobRDA/R/Comment.R branches/robast-0.9/pkg/RobRDA/R/sysdata.rda branches/robast-0.9/pkg/RobRDA/man/ branches/robast-0.9/pkg/RobRDA/man/0RobRDA-package.Rd Log: new mere sysdata.rda-pkg RobRDA created (for the moment just for testing purposes) Added: branches/robast-0.9/pkg/RobRDA/DESCRIPTION =================================================================== --- branches/robast-0.9/pkg/RobRDA/DESCRIPTION (rev 0) +++ branches/robast-0.9/pkg/RobRDA/DESCRIPTION 2013-02-07 16:07:34 UTC (rev 587) @@ -0,0 +1,17 @@ +Package: RobRDA +Version: 0.9 +Date: 2012-05-17 +Title: sysdata.rda for RobExtremes +Description: sysdata.rda for RobExtremes +Depends: R (>= 2.14.0), methods +Imports: ROptEst (>= 0.9) +Author: Peter Ruckdeschel, Matthias Kohl +Maintainer: Peter Ruckdeschel +LazyData: yes +LazyLoad: yes +ByteCompile: yes +License: LGPL-3 +URL: http://robast.r-forge.r-project.org/ +LastChangedDate: {$LastChangedDate: 2011-09-30 11:10:33 +0200 (Fr, 30 Sep 2011) $} +LastChangedRevision: {$LastChangedRevision: 453 $} +SVNRevision: 439 Added: branches/robast-0.9/pkg/RobRDA/NAMESPACE =================================================================== --- branches/robast-0.9/pkg/RobRDA/NAMESPACE (rev 0) +++ branches/robast-0.9/pkg/RobRDA/NAMESPACE 2013-02-07 16:07:34 UTC (rev 587) @@ -0,0 +1 @@ +import("ROptEst") \ No newline at end of file Added: branches/robast-0.9/pkg/RobRDA/R/Comment.R =================================================================== --- branches/robast-0.9/pkg/RobRDA/R/Comment.R (rev 0) +++ branches/robast-0.9/pkg/RobRDA/R/Comment.R 2013-02-07 16:07:34 UTC (rev 587) @@ -0,0 +1 @@ +### this is a mere sysdata.rda package \ No newline at end of file Added: branches/robast-0.9/pkg/RobRDA/R/sysdata.rda =================================================================== (Binary files differ) Property changes on: branches/robast-0.9/pkg/RobRDA/R/sysdata.rda ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Added: branches/robast-0.9/pkg/RobRDA/man/0RobRDA-package.Rd =================================================================== --- branches/robast-0.9/pkg/RobRDA/man/0RobRDA-package.Rd (rev 0) +++ branches/robast-0.9/pkg/RobRDA/man/0RobRDA-package.Rd 2013-02-07 16:07:34 UTC (rev 587) @@ -0,0 +1,12 @@ +\name{RobRDA-package} +\alias{RobRDA-package} +\alias{RobRDA} +\docType{package} +\title{ +RobRDA a sysdata.rda only package +} +\description{ +This package only contains sysdata.rda; blub. +} +\keyword{package} + From noreply at r-forge.r-project.org Thu Feb 7 20:09:10 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 7 Feb 2013 20:09:10 +0100 (CET) Subject: [Robast-commits] r588 - in pkg/RandVar: . R inst inst/doc man vignettes Message-ID: <20130207190910.7B6FE18074A@r-forge.r-project.org> Author: ruckdeschel Date: 2013-02-07 20:09:10 +0100 (Thu, 07 Feb 2013) New Revision: 588 Added: pkg/RandVar/vignettes/ pkg/RandVar/vignettes/RandVar.Rnw pkg/RandVar/vignettes/RandVariable.eps pkg/RandVar/vignettes/RandVariable.pdf pkg/RandVar/vignettes/svn-multi.sty pkg/RandVar/vignettes/svnkw.sty Removed: pkg/RandVar/chm/ pkg/RandVar/inst/doc/RandVar.Rnw pkg/RandVar/inst/doc/RandVariable.eps pkg/RandVar/inst/doc/RandVariable.pdf pkg/RandVar/inst/doc/svn-multi.sty pkg/RandVar/inst/doc/svnkw.sty Modified: pkg/RandVar/DESCRIPTION pkg/RandVar/R/util.R pkg/RandVar/inst/NEWS pkg/RandVar/man/0RandVar-package.Rd pkg/RandVar/man/EuclRandVariable-class.Rd pkg/RandVar/man/EuclRandVariable.Rd Log: merged RandVar from branches/robast-0.9 back to trunk Modified: pkg/RandVar/DESCRIPTION =================================================================== --- pkg/RandVar/DESCRIPTION 2013-02-07 16:07:34 UTC (rev 587) +++ pkg/RandVar/DESCRIPTION 2013-02-07 19:09:10 UTC (rev 588) @@ -1,16 +1,16 @@ Package: RandVar -Version: 0.8.1 -Date: 2011-09-30 +Version: 0.9 +Date: 2013-01-15 Title: Implementation of random variables Description: Implementation of random variables by means of S4 classes and methods -Depends: R (>= 2.7.0), methods, startupmsg, distr(>= 2.0), distrEx(>= 2.0) +Depends: R (>= 2.12.0), methods, startupmsg, distr(>= 2.0), distrEx(>= 2.0) Author: Matthias Kohl, Peter Ruckdeschel Maintainer: Matthias Kohl +ByteCompile: yes LazyLoad: yes License: LGPL-3 -ByteCompile: yes Encoding: latin1 URL: http://robast.r-forge.r-project.org/ LastChangedDate: {$LastChangedDate$} LastChangedRevision: {$LastChangedRevision$} -SVNRevision: 454 +SVNRevision: 587 Modified: pkg/RandVar/R/util.R =================================================================== --- pkg/RandVar/R/util.R 2013-02-07 16:07:34 UTC (rev 587) +++ pkg/RandVar/R/util.R 2013-02-07 19:09:10 UTC (rev 588) @@ -12,11 +12,15 @@ qd <- q(distr) y <- f(qd(u)) + wmdn <- getdistrOption("warn.makeDNew") + on.exit(distroptions(warn.makeDNew=wmdn)) + distroptions(warn.makeDNew=FALSE) + if(length(unique(c(rl(10000),y)))==10000+length(y)){ DPQnew <- RtoDPQ(r=rl, y=y) return(AbscontDistribution(r = rl, d = DPQnew$d, p = DPQnew$p, q = DPQnew$q, .withArith = TRUE, - .withSim = TRUE)) + .withSim = TRUE, withgaps = FALSE)) }else return(UnivarLebDecDistribution(r = rl, y = y)) Modified: pkg/RandVar/inst/NEWS =================================================================== --- pkg/RandVar/inst/NEWS 2013-02-07 16:07:34 UTC (rev 587) +++ pkg/RandVar/inst/NEWS 2013-02-07 19:09:10 UTC (rev 588) @@ -8,6 +8,12 @@ information) ####################################### +version 0.9 +####################################### ++ introduced folder vignettes + + +####################################### version 0.8 ####################################### Deleted: pkg/RandVar/inst/doc/RandVar.Rnw =================================================================== --- pkg/RandVar/inst/doc/RandVar.Rnw 2013-02-07 16:07:34 UTC (rev 587) +++ pkg/RandVar/inst/doc/RandVar.Rnw 2013-02-07 19:09:10 UTC (rev 588) @@ -1,282 +0,0 @@ -%\VignetteIndexEntry{RandVar} -%\VignetteDepends{distr,distrEx} -%\VignetteKeywords{random variable, S4 classes, S4 methods} -%\VignettePackage{RandVar} -% -\documentclass[11pt]{article} -% -%use svn-multi to fill in revision information -% -\usepackage{svn-multi} -% Version control information: -\svnidlong -{$HeadURL$} -{$LastChangedDate$} -{$LastChangedRevision$} -{$LastChangedBy$} -%\svnid{$Id: example_main.tex 146 2008-12-03 13:29:19Z martin $} -% Don't forget to set the svn property 'svn:keywords' to -% 'HeadURL LastChangedDate LastChangedRevision LastChangedBy' or -% 'Id' or both depending if you use \svnidlong and/or \svnid -% -\newcommand{\svnfooter}{Last Changed Rev: \svnkw{LastChangedRevision}} -\svnRegisterAuthor{ruckdeschel}{Peter Ruckdeschel} -\svnRegisterAuthor{stamats}{Matthias Kohl} -% -\usepackage{geometry}\usepackage{color} -\usepackage{ifpdf} -\definecolor{darkblue}{rgb}{0.0,0.0,0.75} -\usepackage[% -baseurl={http://www.stamats.de},% -pdftitle={RandVar: Implementation of random variables by means of S4 classes and methods},% -pdfauthor={Matthias Kohl},% -pdfsubject={RandVar},% -pdfkeywords={random variable, S4 classes, S4 methods},% -pagebackref,bookmarks,colorlinks,linkcolor=darkblue,citecolor=darkblue,% -pagecolor=darkblue,raiselinks,plainpages,pdftex]{hyperref} -% -\markboth{\sl Packages ``{\tt RandVar}''}{\sl Packages ``{\tt RandVar}''} -% -% ------------------------------------------------------------------------------- -\newcommand{\code}[1]{{\tt #1}} -\newcommand{\pkg}[1]{{\tt "#1"}} -\newcommand{\pkgversion}{{\tt 2.0}} -\newcommand{\pkgExversion}{{\tt 0.6.2}} -% ------------------------------------------------------------------------------- -% -% ------------------------------------------------------------------------------- -\begin{document} -% ------------------------------------------------------------------------------- -\title{RandVar: Implementation of random variables by means - of {\tt S4} classes and methods} -\author{Matthias Kohl\\ -e-Mail: {\tt matthias.kohl at stamats.de}\medskip\\ -\parbox[t]{5cm}{ -\footnotesize\sffamily - Version control information: -\begin{tabbing} -\footnotesize\sffamily - Last changes revision: \= \kill - Head URL: \> \parbox[t]{6cm}{\url{\svnkw{HeadURL}}}\\[1.2ex] - Last changed date: \> \svndate\\ - Last changes revision: \> \svnrev\\ - Version: \> \svnFullRevision*{\svnrev}\\ - Last changed by: \> \svnFullAuthor*{\svnauthor}\\ -\end{tabbing} -} -} -\maketitle -% ------------------------------------------------------------------------------- -\begin{abstract} -% ------------------------------------------------------------------------------- -In this package we implement random variables by means of {\tt S4} classes -and methods. This vignette corresponds to Appendix D.2 in Kohl~(2005)~\cite{MK:05}. -% ------------------------------------------------------------------------------- -\end{abstract} -% ------------------------------------------------------------------------------- -\tableofcontents -% ------------------------------------------------------------------------------- -\clearpage -% ----------------------------------------------------------------------- -\section{{\tt S4} Classes} -% ----------------------------------------------------------------------- -The {\tt S4} class {\tt RandVariable} (cf.\ Figure~\ref{ap.Rpack.RandVar.dia1}) -has the slots {\tt Map}, {\tt Domain} and {\tt Range} where {\tt Map} -contains a list of functions which are measurable maps from {\tt Domain} -to {\tt Range}. The elements contained in the list {\tt Map} must be functions in -one argument named {\tt x}. We do not allow further parameters for these -functions as this would lead to inconsistent objects. Strictly speaking, an object of -class {\tt RandVariable} would represent not only one random variable but a whole -set of random variables depending on these parameters. -% ----------------------------------------------------------------------- -\par -The slots {\tt Domain} and {\tt Range} are filled with an object of -class {\tt OptionalrSpace}; i.e., they contain {\tt NULL} or an object of class -{\tt rSpace} (see package {\tt distr}~\cite{distr}). In case of -{\tt EuclRandVariable} and {\tt RealRandVariable} the slot {\tt Range} is filled -with an object of class {\tt Euclideanspace} and {\tt Reals}, respectively. The -class {\tt EuclRandMatrix} additionally has the slot {\tt Dim} which is a vector -of integers and contains the dimensions of the Euclidean random matrix. -% ----------------------------------------------------------------------- -\par -Using these {\tt S4} classes there are two possibilities to implement a ${\rm R}^k$ -valued random variable. First, we could define a {\tt EuclRandVariable} -whose slot {\tt Map} contains a list with one function which maps to ${\rm R}^k$; -i.e., the slot {\tt Range} is a $k$-dimensional Euclidean space. Second, we could -define a {\tt EuclRandVariable} whose slot {\tt Map} contains a list with $n$ -functions (projections) which map to ${\rm R}^m$ where $k = m*n$. Now, the slot -{\tt Range} is an $m$-dimensional Euclidean space. -Since it is sometimes convenient to regard a ${\rm R}^k$ valued random variable -as measurable map consisting of ${\rm R}^{k_i}$ valued maps where $\sum k_i = k$, -we introduce a further class called {\tt EuclRandVarList}. -With this class we can now define ${\rm R}^k$ valued random variables as a list -of ${\rm R}^{k_i}$ valued random variables with compatible domains. More precisely, -the elements of a {\tt EuclRandVarList} may even have very different ranges -(not necessarily Euclidean spaces) they only need to have compatible -domains which is checked via the generic function {\tt compatibleDomains}. -% ----------------------------------------------------------------------- -\begin{figure}[!ht] -\begin{center} - \ifpdf - \includegraphics[scale=1.0, viewport = 14 15 244 275]{RandVariable.pdf} - \else - \includegraphics[scale=1.0]{RandVariable.eps} - \fi - \caption[Class {\tt RandVariable} and Subclasses]{Class - {\tt RandVariable} and subclasses.} - \label{ap.Rpack.RandVar.dia1} -\end{center} -\end{figure} -% ----------------------------------------------------------------------- -\newpage -\section{Functions and Methods} -% ----------------------------------------------------------------------- -As in case of package {\tt distrEx}~\cite{distr}, we follow the advices of -Section~7.3 of \cite{Cham:98} and \cite{Gent:03}. That is, we introduce -generating functions as well as accessor and replacement functions. A short -description of the implemented generating functions is given in -Table~\ref{ap.Rpack.RandVar.tab.gen}. -% ----------------------------------------------------------------------- -\begin{table}[!ht] -\begin{center} -\begin{tabular}{p{4cm}|p{7.5cm}} - \textbf{Generating Function} & \textbf{Description} \\ \hline\hline - {\tt EuclRandMatrix} & Generates an object of class {\tt EuclRandMatrix}\\ \hline - {\tt EuclRandVariable} & Generates an object of class {\tt EuclRandVariable}\\ \hline - {\tt EuclRandVarList} & Generates an object of class {\tt EuclRandVarList}\\ \hline - {\tt RandVariable} & Generates an object of class {\tt RandVariable}\\ \hline - {\tt RealRandVariable} & Generates an object of class {\tt RealRandVariable} -\end{tabular} -\caption[Generating Functions of Package {\tt RandVar}]{Generating -functions of package {\tt RandVar}.}\label{ap.Rpack.RandVar.tab.gen}% -\end{center} -\end{table} -% ----------------------------------------------------------------------- -\par\noindent -While there are accessor functions for all slots of the newly defined -{\tt S4} classes, replacement functions are only implemented for those -slots a user should modify. -% ----------------------------------------------------------------------- -\par -Our next goal was that one can use these classes of random variables like -ordinary numeric vectors or matrices. Hence, we overloaded the {\tt S4} -group generic functions {\tt Arith} and {\tt Math} as well as matrix -multiplication {\tt \%*\%}. For the matrix multiplication of {\tt EuclRandVarList}s -we additionally introduced the operator {\tt \%m\%}. -Now, if we have random variables {\tt X} and {\tt Y}, a numerical -vector {\tt v} and a numerical matrix {\tt M} (with compatible dimensions) -we can for instance generate -<>= -library(RandVar) -distroptions("withSweave" = TRUE) ## only for use in Sweave - document; set to FALSE else! -(X <- RealRandVariable(Map = list(function(x){x}, function(x){x^2}), Domain = Reals(), Range = Reals())) -Map(X) -evalRandVar(X, 2) -evalRandVar(X, as.matrix(seq(2, 10, 2))) -R1 <- exp(X-1) -Map(R1) -R2 <- exp(X-1:2) -Map(R2) -(Y <- RealRandVariable(Map = list(function(x){sin(x)}, function(x){cos(x)}), Domain = Reals(), Range = Reals())) -Map(Y) -R3 <- X %*% Y -dimension(R3) -#evalRandVar(R3, 2) -2*sin(2) + 2^2*cos(2) -(R4 <- X %*% t(Y)) -dimension(R4) -#evalRandVar(R4, 2) -(M <- matrix(c(2*sin(2), 2^2*sin(2), 2*cos(2), 2^2*cos(2)), ncol = 2)) -(R5 <- M %*% R4) -@ -We also implemented {\tt S4} methods for the generic function {\tt E} of -package {\tt distrEx}~\cite{distr}. That is, given some distribution {\tt D}, -respectively some conditional distribution {\tt CD} and some random variable {\tt X} -we can compute the (conditional) expectation of {\tt X} under {\tt D}, respectively -{\tt CD} simply by -<>= -D <- Norm() -E(object = D, fun = X) -E(D) -var(D) -(CD <- LMCondDistribution(theta = 1)) -E(object = CD, fun = X, cond = 2) -E(Norm(mean = 2)) -E(Norm(mean = 2), fun = function(x){x^2}) -@ -for some given condition {\tt cond}. -% ----------------------------------------------------------------------- -\par -In addition, we define methods for the generic function {\tt show} for the classes -{\tt RandVariable}, {\tt EuclRandMatrix} and {\tt EuclRandVarList}. There are -also methods for the generic functions {\tt dimension} (see package -{\tt distr}~\cite{distr}), {\tt length}, {\tt ncol}, {\tt nrow}, {\tt t} and -{\tt [} (cf.\ package {\tt base}). For more details we refer to the corresponding -help pages. -% ----------------------------------------------------------------------- -\par -Finally, we introduce several new generic functions. A brief description -of these functions is given in Table~\ref{ap.Rpack.RandVar.tab}. -% ----------------------------------------------------------------------- -\begin{table}[!ht] -\begin{center} -\begin{tabular}{p{3.5cm}|p{8cm}} - \textbf{Generic Function} & \textbf{Description} \\ \hline\hline - \texttt{\%m\%} & matrix multiplication for {\tt EuclRandVarList}s \\ \hline - \texttt{compatibleDomains} & test if the domains of two random variables - are compatible \\ \hline - \texttt{evalRandVar} & evaluation of random variables\\ \hline - \texttt{imageDistr} & image distribution of some distribution under some - random variable \\ \hline - \texttt{numberOfMaps} & number of functions contained in the slots {\tt Map} - of the members of a {\tt EuclRandVarList} -\end{tabular} -\caption[New Generic Functions of Package {\tt RandVar}] -{New generic functions of package {\tt RandVar} (without accessor -and replacement functions).}\label{ap.Rpack.RandVar.tab}% -\end{center} -\end{table} -% ----------------------------------------------------------------------- -\par\noindent -For more details about the full functionality of package {\tt RandVar} -we refer to the source code and the corresponding help pages, respectively. -% ----------------------------------------------------------------------- -\section{Odds and Ends} -% ----------------------------------------------------------------------- -The main issue is to reduce the computation time for methods using -objects of class {\tt RandVariable} and its subclasses as these classes -play an important role in the computation of optimally robust -estimators; confer Kohl~(2005)~\cite{MK:05}. -In particular, we are looking for ways to increase the computation speed -of {\tt evalRandVar} and {\tt E}. -%------------------------------------------------------------------------------- -\begin{thebibliography}{8} - -\bibitem{Cham:98} -Chambers J.M. -\newblock {\em {Programming with data. A guide to the S language}\/}. -\newblock {Springer}. -\newblock http://cm.bell-labs.com/stat/Sbook/index.html - -\bibitem{Gent:03} -Gentleman R. -\newblock {\em Object Orientated Programming. Slides of a Short Course held in Auckland\/}. -\newblock http://www.stat.auckland.ac.nz/S-Workshop/Gentleman/Methods.pdf - -\bibitem{MK:05} -Kohl M. -\newblock {\em Numerical Contributions to the Asymptotic Theory of Robustness\/}. -\newblock {Dissertation}, Universit\"at Bayreuth. -\newblock See also http://stamats.de/ThesisMKohl.pdf - -\bibitem{distr} -Ruckdeschel P., Kohl M., Stabla T., and Camphausen F. -\newblock {S4 Classes for Distributions.} -\newblock {\em R-News\/}, {\bf 6}(2): 10--13. -\newblock http://CRAN.R-project.org/doc/Rnews/Rnews\_2006-2.pdf -\newblock See also {http://www.uni-bayreuth.de/departments/math/org/mathe7/RUCKDESCHEL/pubs/distr.pdf} - -\end{thebibliography} -% ------------------------------------------------------------------------------- -\end{document} -% ------------------------------------------------------------------------------- Deleted: pkg/RandVar/inst/doc/RandVariable.eps =================================================================== --- pkg/RandVar/inst/doc/RandVariable.eps 2013-02-07 16:07:34 UTC (rev 587) +++ pkg/RandVar/inst/doc/RandVariable.eps 2013-02-07 19:09:10 UTC (rev 588) @@ -1,352 +0,0 @@ -%!PS-Adobe-3.0 EPSF-3.0 -%%BoundingBox: 14 15 244 275 -%%BeginProcSet: reencode 1.0 0 -/RE -{ findfont begin - currentdict dup length dict begin - {1 index /FID ne {def} {pop pop} ifelse} forall - /FontName exch def dup length 0 ne - { /Encoding Encoding 256 array copy def - 0 exch - { dup type /nametype eq - { Encoding 2 index 2 index put - pop 1 add - } - { exch pop - } ifelse - } forall - } if pop - currentdict dup end end - /FontName get exch definefont pop - } bind def -%%EndProcSet: reencode 1.0 0 -%%BeginProcSet: ellipse 1.0 0 -/ellipsedict 8 dict def -ellipsedict /mtrx matrix put -/ellipse { ellipsedict begin -/endangle exch def -/startangle exch def -/yrad exch def -/xrad exch def -/y exch def -/x exch def -/savematrix mtrx currentmatrix def -x y translate -xrad yrad scale -0 0 1 0 360 arc -savematrix setmatrix end } def -%%EndProcSet: ellipse 1.0 0 -%%EndProlog -%%BeginSetup -/isolatin1encoding -[ 32 /space /exclam /quotedbl /numbersign /dollar /percent /ampersand /quoteright - /parenleft /parenright /asterisk /plus /comma /hyphen /period /slash /zero /one - /two /three /four /five /six /seven /eight /nine /colon /semicolon - /less /equal /greater /question /at /A /B /C /D /E - /F /G /H /I /J /K /L /M /N /O - /P /Q /R /S /T /U /V /W /X /Y - /Z /bracketleft /backslash /bracketright /asciicircum /underscore /quoteleft /a /b /c - /d /e /f /g /h /i /j /k /l /m - /n /o /p /q /r /s /t /u /v /w - /x /y /z /braceleft /bar /braceright /asciitilde /.notdef /.notdef /.notdef - /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef - /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef - /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef - /space /exclamdown /cent /sterling /currency /yen /brokenbar /section /dieresis /copyright - /ordfeminine /guillemotleft /logicalnot /hyphen /registered /macron /degree /plusminus /twosuperior /threesuperior - /acute /mu /paragraph /periodcentered /cedilla /onesuperior /ordmasculine /guillemotright /onequarter /onehalf - /threequarters /questiondown /Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla - /Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex /Idieresis /Eth /Ntilde - /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply /Oslash /Ugrave /Uacute /Ucircumflex - /Udieresis /Yacute /Thorn /germandbls /agrave /aacute /acircumflex /atilde /adieresis /aring - /ae /ccedilla /egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex /idieresis - /eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide /oslash /ugrave - /uacute /ucircumflex /udieresis /yacute /thorn /ydieresis] def -%%EndSetup -1 setlinewidth -isolatin1encoding /_Helvetica /Helvetica RE -/_Helvetica findfont -12 scalefont setfont -0.0 0.0 0.0 setrgbcolor -0 290 translate -1.0 1.0 scale -1.0 1.0 1.0 setrgbcolor -newpath -63 -19 moveto -124 0 rlineto -0 -73 rlineto --124 0 rlineto -closepath -eofill -0.0 0.0 0.0 setrgbcolor -newpath -63 -19 moveto -124 0 rlineto -0 -73 rlineto --124 0 rlineto -closepath -stroke -1.0 1.0 1.0 setrgbcolor -newpath -63 -19 moveto -124 0 rlineto -0 -21 rlineto --124 0 rlineto -closepath -eofill -0.0 0.0 0.0 setrgbcolor -newpath -63 -19 moveto -124 0 rlineto -0 -21 rlineto --124 0 rlineto -closepath -stroke -isolatin1encoding /_Helvetica /Helvetica RE -/_Helvetica findfont -10 scalefont setfont -93 -34 moveto -(RandVariable) show -1.0 1.0 1.0 setrgbcolor -newpath -63 -40 moveto -124 0 rlineto -0 -52 rlineto --124 0 rlineto -closepath -eofill -0.0 0.0 0.0 setrgbcolor -newpath -63 -40 moveto -124 0 rlineto -0 -52 rlineto --124 0 rlineto -closepath -stroke -65 -56 moveto -(Map : list) show -65 -73 moveto -(Domain : OptionalrSpace) show -65 -90 moveto -(Range : OptionalrSpace) show -1.0 1.0 1.0 setrgbcolor -newpath -65 -137 moveto -122 0 rlineto -0 -46 rlineto --122 0 rlineto -closepath -eofill -0.0 0.0 0.0 setrgbcolor -newpath -65 -137 moveto -122 0 rlineto -0 -46 rlineto --122 0 rlineto -closepath -stroke -1.0 1.0 1.0 setrgbcolor -newpath -65 -137 moveto -122 0 rlineto -0 -24 rlineto --122 0 rlineto -closepath -eofill -0.0 0.0 0.0 setrgbcolor -newpath -65 -137 moveto -122 0 rlineto -0 -24 rlineto --122 0 rlineto -closepath -stroke -83 -152 moveto -(EuclRandVariable) show -1.0 1.0 1.0 setrgbcolor -newpath -65 -161 moveto -122 0 rlineto -0 -22 rlineto --122 0 rlineto -closepath -eofill -0.0 0.0 0.0 setrgbcolor -newpath -65 -161 moveto -122 0 rlineto -0 -22 rlineto --122 0 rlineto -closepath -stroke -67 -177 moveto -(Range : EuclideanSpace) show -1.0 1.0 1.0 setrgbcolor -newpath -18 -224 moveto -79 0 rlineto -0 -46 rlineto --79 0 rlineto -closepath -eofill -0.0 0.0 0.0 setrgbcolor -newpath -18 -224 moveto -79 0 rlineto -0 -46 rlineto --79 0 rlineto -closepath -stroke -1.0 1.0 1.0 setrgbcolor -newpath -18 -224 moveto -79 0 rlineto -0 -24 rlineto --79 0 rlineto -closepath -eofill -0.0 0.0 0.0 setrgbcolor -newpath -18 -224 moveto -79 0 rlineto -0 -24 rlineto --79 0 rlineto -closepath -stroke -20 -239 moveto -(EuclRandMatrix) show -1.0 1.0 1.0 setrgbcolor -newpath -18 -248 moveto -79 0 rlineto -0 -22 rlineto --79 0 rlineto -closepath -eofill -0.0 0.0 0.0 setrgbcolor -newpath -18 -248 moveto -79 0 rlineto -0 -22 rlineto --79 0 rlineto -closepath -stroke -20 -264 moveto -(Dim : integer) show -1.0 1.0 1.0 setrgbcolor -newpath -151 -225 moveto -88 0 rlineto -0 -44 rlineto --88 0 rlineto -closepath -eofill -0.0 0.0 0.0 setrgbcolor -newpath -151 -225 moveto -88 0 rlineto -0 -44 rlineto --88 0 rlineto -closepath -stroke -1.0 1.0 1.0 setrgbcolor -newpath -151 -225 moveto -88 0 rlineto -0 -20 rlineto --88 0 rlineto -closepath -eofill -0.0 0.0 0.0 setrgbcolor -newpath -151 -225 moveto -88 0 rlineto -0 -20 rlineto --88 0 rlineto -closepath -stroke -152 -240 moveto -(RealRandVariable) show -1.0 1.0 1.0 setrgbcolor -newpath -151 -245 moveto -88 0 rlineto -0 -25 rlineto --88 0 rlineto -closepath -eofill -0.0 0.0 0.0 setrgbcolor -newpath -151 -245 moveto -88 0 rlineto -0 -25 rlineto --88 0 rlineto -closepath -stroke -1.0 1.0 1.0 setrgbcolor -newpath -152 -246 moveto -64 0 rlineto -0 -14 rlineto --64 0 rlineto -closepath -eofill -0.0 0.0 0.0 setrgbcolor -153 -261 moveto -(Range : Reals) show -newpath -123 -93 moveto -123 -137 lineto -stroke -1.0 1.0 1.0 setrgbcolor -newpath -123 -137 moveto -116 -125 lineto -130 -125 lineto -closepath -eofill -0.0 0.0 0.0 setrgbcolor -newpath -123 -137 moveto -116 -125 lineto -130 -125 lineto -closepath -stroke -newpath -88 -184 moveto -88 -224 lineto -stroke -1.0 1.0 1.0 setrgbcolor -newpath -88 -224 moveto -81 -212 lineto -95 -212 lineto -closepath -eofill -0.0 0.0 0.0 setrgbcolor -newpath -88 -224 moveto -81 -212 lineto -95 -212 lineto -closepath -stroke -newpath -163 -184 moveto -163 -225 lineto -stroke -1.0 1.0 1.0 setrgbcolor -newpath -163 -225 moveto -156 -213 lineto -170 -213 lineto -closepath -eofill -0.0 0.0 0.0 setrgbcolor -newpath -163 -225 moveto -156 -213 lineto -170 -213 lineto -closepath -stroke -showpage -%%Trailer Deleted: pkg/RandVar/inst/doc/RandVariable.pdf =================================================================== (Binary files differ) Deleted: pkg/RandVar/inst/doc/svn-multi.sty =================================================================== --- pkg/RandVar/inst/doc/svn-multi.sty 2013-02-07 16:07:34 UTC (rev 587) +++ pkg/RandVar/inst/doc/svn-multi.sty 2013-02-07 19:09:10 UTC (rev 588) @@ -1,1752 +0,0 @@ -%% -%% This is file `svn-multi.sty', -%% generated with the docstrip utility. -%% -%% The original source files were: -%% -%% svn-multi.dtx (with options: `package') -%% -%% This is a generated file. -%% -%% Copyright (C) 2006-2009 by Martin Scharrer -%% -%% This work may be distributed and/or modified under the -%% conditions of the LaTeX Project Public License, either version 1.3 -%% of this license or (at your option) any later version. -%% The latest version of this license is in -%% http://www.latex-project.org/lppl.txt -%% and version 1.3 or later is part of all distributions of LaTeX -%% version 2005/12/01 or later. -%% -%% This work has the LPPL maintenance status `maintained'. -%% -%% The Current Maintainer of this work is Martin Scharrer. -%% -%% This work consists of the files svn-multi.dtx, svn-multi-pl.dtx, svn-multi.ins -%% and the derived files svn-multi.sty, svnkw.sty and svn-multi.pl. -%% -\makeatletter -\def\svnmulti at version {v2.1} -\def\svnmulti at rev $#1: #2 ${\def\svnmulti at rev{#2}} -\def\svnmulti at date $#1: #2-#3-#4 #5 ${\def\svnmulti at date{#2/#3/#4}} -\svnmulti at rev $Rev: 691 $\relax -\svnmulti at date $Date: 2009-03-27 21:37:56 +0000 (Fri, 27 Mar 2009) $\relax - -\NeedsTeXFormat{LaTeX2e}[1999/12/01] -\ProvidesPackage{svn-multi} - [\svnmulti at date\space\svnmulti at version\space SVN Keywords for multi-file LaTeX documents] - -\RequirePackage{kvoptions} - -\SetupKeyvalOptions{% - family = svn-multi, - prefix = @svnmulti@ -} -\newif\if at svnmulti@anygraphic -\newif\if at svnmulti@autoload -\newif\if at svnmulti@autokw -\newif\if at svnmulti@autokwall - -\DeclareVoidOption{old}{% - \@svnmulti at verbatimtrue - \@svnmulti at groupsfalse - \@svnmulti at externalfalse - \@svnmulti at graphicsfalse - \@svnmulti at pgfimagesfalse - \@svnmulti at autoloadfalse - \@svnmulti at tablefalse - \@svnmulti at filehooksfalse - \@svnmulti at subgroupsfalse -} -\DeclareVoidOption{all}{% - \@svnmulti at verbatimtrue - \@svnmulti at groupstrue - \@svnmulti at externaltrue - \@svnmulti at graphicstrue - \@svnmulti at pgfimagestrue - \@svnmulti at autoloadtrue - \@svnmulti at tabletrue - \@svnmulti at filehookstrue - \@svnmulti at subgroupstrue -} -\DeclareBoolOption[true]{verbatim} -\DeclareBoolOption[false]{groups} -\DeclareBoolOption[false]{external} -\DeclareBoolOption[false]{subgroups} -\DeclareBoolOption[false]{graphics} -\DeclareBoolOption[false]{pgfimages} -\DeclareStringOption{autoload}[true] -\DeclareBoolOption[false]{table} -\DeclareBoolOption[false]{filehooks} -\DeclareStringOption[false]{autokw}[all] - -\ExecuteOptions{old} -\ProcessKeyvalOptions{svn-multi} -\def\svn at depoption#1{% - \csname if at svnmulti@#1\endcsname\else - \message{svn-multi: Required option '#1' enabled.}% - \csname @svnmulti@#1true\endcsname - \fi -} - -\if at svnmulti@groups - \svn at depoption{filehooks} -\fi -\if at svnmulti@external - \svn at depoption{filehooks} -\fi -\if at svnmulti@subgroups - \svn at depoption{groups} - \svn at depoption{filehooks} -\fi -\if at svnmulti@graphics - \svn at depoption{external} - \svn at depoption{autoload} - \svn at depoption{filehooks} -\fi -\if at svnmulti@pgfimages - \svn at depoption{external} - \svn at depoption{autoload} - \svn at depoption{filehooks} -\fi -\if at svnmulti@autoload - \svn at depoption{external} - \svn at depoption{filehooks} -\fi -\if at svnmulti@table - \svn at depoption{groups} - \svn at depoption{filehooks} -\fi -\ifx\@svnmulti at autoload\@undefined -\else -\ifx\@svnmulti at autoload\empty -\else -\def\svn at temp{true} -\ifx\@svnmulti at autoload\svn at temp - \@svnmulti at autoloadtrue - \svn at depoption{external} - \svn at depoption{filehooks} -\else -\def\svn at temp{false} -\ifx\@svnmulti at autoload\svn at temp - \if at svnmulti@autoload - \PackageWarning{svn-multi}{Option 'autoload' disabled.} - \fi - \@svnmulti at autoloadfalse -\else - \PackageError{svn-multi}% - {Invalid value for 'autoload' option: '\@svnmulti at autoload'^^J% - ! Only 'true','false' or empty (='true') are allowed!} -\fi\fi\fi\fi - -\def\svn at temp{true} -\ifx\@svnmulti at autokw\svn at temp - \@svnmulti at autokwtrue - \@svnmulti at autokwalltrue - \svn at depoption{filehooks} -\fi -\def\svn at temp{all} -\ifx\@svnmulti at autokw\svn at temp - \@svnmulti at autokwtrue - \@svnmulti at autokwalltrue - \svn at depoption{filehooks} -\fi -\def\svn at temp{ext} -\ifx\@svnmulti at autokw\svn at temp - \@svnmulti at autokwtrue - \@svnmulti at autokwallfalse -\fi -\def\svn at temp{false} -\ifx\@svnmulti at autokw\svn at temp - \@svnmulti at autokwfalse - \@svnmulti at autokwallfalse -\fi - -\if at svnmulti@graphics - \@svnmulti at anygraphictrue -\fi -\if at svnmulti@pgfimages - \@svnmulti at anygraphictrue -\fi - -\def\svn at ifempty#1{% - \begingroup - \edef\svn at temp{#1}% - \ifx\svn at temp\empty - \endgroup - \expandafter - \@firstoftwo - \else - \endgroup - \expandafter - \@secondoftwo - \fi -} - -\def\svn at ifequal#1#2{% - \begingroup - \edef\svn at stringa{#1}% - \edef\svn at stringb{#2}% - \ifx\svn at stringa\svn at stringb - \endgroup - \expandafter - \@firstoftwo - \else - \endgroup - \expandafter - \@secondoftwo - \fi -} - -\def\svn at ifvalidrev#1{% - \begingroup - \@ifundefined{#1}% - {\def\svn at temp{-1}}% - {\expandafter\edef - \expandafter\svn at temp\expandafter{\csname #1\endcsname}}% - \ifnum\svn at temp>-1\relax - \endgroup - \expandafter - \@firstoftwo - \else - \endgroup - \expandafter - \@secondoftwo - \fi -} - -\def\svn at ifeof#1{% - \ifeof#1% - \expandafter\@firstoftwo - \else - \expandafter\@secondoftwo - \fi -} - -\def\svn at ifonlyone#1{% - \expandafter\expandafter\expandafter - \svn@@ifonlyone\csname @svng@#1 at files\endcsname,\relax -} - -\def\svn@@ifonlyone#1,#2\relax{% - \svn at ifempty{#2} -} - -\def\svn at input#1{% - \begingroup - \let\svn at rg\svn at g - \IfFileExists{#1}{\@@input #1\relax}{}% - \global\let\svn at g\svn at rg - \endgroup -} - -\def\svn at inputsvx#1{% - \svn at pushfilestack - \svn at input{#1.svx}% - \svn at popfilestack -} - -\def\svnrev{-1} \def\@svn at rev{-1} -\def\svndate{} \def\@svn at date{} -\def\svnauthor{} \def\@svn at author{} -\def\svnyear{0000} \def\@svn at year{0000} -\def\svnmonth{00} \def\@svn at month{00} -\def\svnday{00} \def\@svn at day{00} -\def\svnhour{00} \def\@svn at hour{00} -\def\svnminute{00} \def\@svn at minute{00} -\def\svnsecond{00} \def\@svn at second{00} -\def\svntimezonehour{+00} \def\@svn at timezonehour{+00} -\def\svntimezoneminute{00} \def\@svn at timezoneminute{00} -\def\svnmainurl{NOT SET} \def\svnmainfilename{NOT SET} -\def\svnurl{} \def\svnfname{} -\def\svn at temp{} - -\def\svn at pg{} \def\svn at g{} \def\svn at cg{\svn at g} \def\svn at rg{\svn at pg} -\let\@svng@@files\relax - -\def\svn at initfile{% - \gdef\svnfilerev{-1}% - \gdef\svnfiledate{}% - \gdef\svnfileauthor{}% - \gdef\svnfileyear{0000}% - \gdef\svnfilemonth{00}% - \gdef\svnfileday{00}% - \gdef\svnfilehour{00}% - \gdef\svnfileminute{00}% - \gdef\svnfilesecond{00}% - \gdef\svnfiletimezonehour{+00}% - \gdef\svnfiletimezoneminute{00}% - \gdef\svnfileurl{}% - \gdef\svnfilefname{}% - \gdef\svnfiledir{}% -} -\svn at initfile - - -\begingroup -\@makeother\^^L -\if at svnmulti@autokw -\gdef\svne at ff{^^L} -\fi -\endgroup - -\if at svnmulti@autokw -\newread\svne at read - -\newcommand*{\svne at catcodes}{% - \let\do\@makeother - \endlinechar=-1 - \dospecials - \do\- \do\: \do\. \do\^^L -} - -\def\svne at readline#1{% - \ifeof\svne at read - \def#1{}% - \else - \read\svne at read to #1\relax - \fi -} - -\def\svne at gobblerest{% - \ifeof\svne at read - \let\next\relax - \else - \read\svne at read to \svn at temp - \ifx\svn at temp\svne at ff - \let\next\relax - \else - \let\next\svne at gobblerest - \fi - \fi - \next -} - -\def\svne at endread{% - \closein\svne at read -} - -\newcommand*{\svne at parseentriesfile}[1]{% - \begingroup - \let\next\relax - \openin\svne at read=#1format\relax - \ifeof\svne at read\else - \svne at readline\svne at version - \closein\svne at read - \ifnum\svne at version>7\relax - \openin\svne at read=#1entries\relax - \ifeof\svne at read\else - \svne at catcodes - \svne at readline\svne at version - \ifnum\svne at version>7\relax - \def\next{\svne at parsedirentry% - \svne at parseentries} - \else - \closein\svne at read - \fi - \fi - \fi - \fi - \next - \endgroup -} - -\newcommand*{\svne at parsedirentry}{% - \svne at readline\svne at name - \svne at readline\svne at kind - \svn at ifempty{\svne at name}% - {\svn at ifequal{\svne at kind}{dir}% - {% - {\svne at readline\svn at temp}% - \svne at readline\svne at baseurl - \svne at gobblerest - }{}% - }{}% -} - -\begingroup - -\@makeother\- -\@makeother\: -\@makeother\. - -\gdef\svne at scandate#1{% - \expandafter\svne at scandate@#1\relax - 0000-00-00T00:00:00.00000Z\relax\relax -} - -\gdef\svne at scandate@#1-#2-#3T#4:#5:#6.#7\relax#8\relax{% - \gdef\svnfileyear{#1}% - \gdef\svnfilemonth{#2}% - \gdef\svnfileday{#3}% - \gdef\svnfilehour{#4}% - \gdef\svnfileminute{#5}% - \gdef\svnfilesecond{#6}% - \gdef\svnfiletimezonehour{+00}% - \gdef\svnfiletimezoneminute{00}% - \gdef\svnfiledate{#1-#2-#3 #4:#5:#6Z}% - \def\svne at date{#1-#2-#3 #4:#5:#6Z}% -} - -\endgroup - -\newcommand*{\svne at parseentries}{% - \svn at ifeof{\svne at read}% - {}% - {% - \svne at readline\svne at name - \@onelevel at sanitize\svne at name - \svn at ifeof{\svne at read}% - {}% - {% - \svne at readline\svne at kind - \svn at ifequal{\svne at kind}{file}% - {% - \svne at readline\svn at temp - \svne at readline\svn at temp - \svne at readline\svn at temp - \svne at readline\svn at temp - \svne at readline\svn at temp - \svne at readline\svn at temp - \svne at readline\svne at date - \svne at readline\svne at rev - \svne at readline\svne at author - %\@onelevel at sanitize\svne at date - \svne at scandate{\svne at date}% - \edef\svne at url{\svne at baseurl/\svne at name}% - \svne at handleentry - }{}% - \svne at gobblerest - \svne at parseentries - }% - }% -} - [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/robast -r 588 From noreply at r-forge.r-project.org Thu Feb 7 20:44:03 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 7 Feb 2013 20:44:03 +0100 (CET) Subject: [Robast-commits] r589 - in branches/robast-0.9/pkg/ROptEstOld: inst man Message-ID: <20130207194403.E93D518497D@r-forge.r-project.org> Author: ruckdeschel Date: 2013-02-07 20:44:03 +0100 (Thu, 07 Feb 2013) New Revision: 589 Modified: branches/robast-0.9/pkg/ROptEstOld/inst/NEWS branches/robast-0.9/pkg/ROptEstOld/man/Gumbel-class.Rd Log: ROptEstOld: in branch robast-0.9: some minor fiddling (NEWS updated; corrected Rd file) Modified: branches/robast-0.9/pkg/ROptEstOld/inst/NEWS =================================================================== --- branches/robast-0.9/pkg/ROptEstOld/inst/NEWS 2013-02-07 19:09:10 UTC (rev 588) +++ branches/robast-0.9/pkg/ROptEstOld/inst/NEWS 2013-02-07 19:44:03 UTC (rev 589) @@ -8,6 +8,14 @@ information) ####################################### +version 0.9 +####################################### +EVD functionality (including Gumbel distribution) has +moved from distrEx to new pkg RobExtremes; to avoid failure +of ROptEstOld, this functionality has been copied to ROptEstOld +as well. + +####################################### version 0.8 ####################################### Modified: branches/robast-0.9/pkg/ROptEstOld/man/Gumbel-class.Rd =================================================================== --- branches/robast-0.9/pkg/ROptEstOld/man/Gumbel-class.Rd 2013-02-07 19:09:10 UTC (rev 588) +++ branches/robast-0.9/pkg/ROptEstOld/man/Gumbel-class.Rd 2013-02-07 19:44:03 UTC (rev 589) @@ -122,18 +122,10 @@ else the (conditional) expection of \code{fun} is computed. } \item{cond}{ if not missing the conditional expectation given \code{cond} is computed. } - \item{Nsim}{ number of MC simulations used to determine the expectation. } - \item{rel.tol}{relative tolerance for \code{distrExIntegrate}.} \item{low}{lower bound of integration range.} \item{upp}{upper bound of integration range.} - \item{lowerTruncQuantile}{lower quantile for quantile based integration range.} - \item{upperTruncQuantile}{upper quantile for quantile based integration range.} - \item{IQR.fac}{factor for scale based integration range (i.e.; - median of the distribution \eqn{\pm}{+-}\code{IQR.fac}\eqn{\times}{*}IQR).} + \item{x}{ object of class \code{"UnivariateDistribution"}} \item{\dots}{ additional arguments to \code{fun} } - \item{useApply}{ logical: should \code{sapply}, respectively \code{apply} - be used to evaluate \code{fun}. } - \item{withCond}{ logical: is \code{cond} in the argument list of \code{fun}. } } From noreply at r-forge.r-project.org Thu Feb 7 20:45:29 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 7 Feb 2013 20:45:29 +0100 (CET) Subject: [Robast-commits] r590 - in pkg/ROptEstOld: . R inst man Message-ID: <20130207194529.95D6B1847F4@r-forge.r-project.org> Author: ruckdeschel Date: 2013-02-07 20:45:29 +0100 (Thu, 07 Feb 2013) New Revision: 590 Added: pkg/ROptEstOld/R/AllInitialize.R pkg/ROptEstOld/R/Functionals.R pkg/ROptEstOld/R/Gumbel.R pkg/ROptEstOld/R/GumbelLocationFamily.R pkg/ROptEstOld/R/Kurtosis.R pkg/ROptEstOld/R/Skewness.R pkg/ROptEstOld/man/Gumbel-class.Rd pkg/ROptEstOld/man/Gumbel.Rd pkg/ROptEstOld/man/GumbelParameter-class.Rd pkg/ROptEstOld/man/ROptEstOldConstants.Rd Removed: pkg/ROptEstOld/chm/ Modified: pkg/ROptEstOld/DESCRIPTION pkg/ROptEstOld/NAMESPACE pkg/ROptEstOld/R/AllClass.R pkg/ROptEstOld/R/AllGeneric.R pkg/ROptEstOld/R/Expectation.R pkg/ROptEstOld/inst/NEWS pkg/ROptEstOld/man/GumbelLocationFamily.Rd Log: merged ROptEstOld from branch robast-0.9 back to trunk; can now be submitted to avoid failure after reconstruction of pkg distrEx Modified: pkg/ROptEstOld/DESCRIPTION =================================================================== --- pkg/ROptEstOld/DESCRIPTION 2013-02-07 19:44:03 UTC (rev 589) +++ pkg/ROptEstOld/DESCRIPTION 2013-02-07 19:45:29 UTC (rev 590) @@ -1,17 +1,17 @@ Package: ROptEstOld -Version: 0.8.1 -Date: 2011-09-30 +Version: 0.9 +Date: 2010-12-03 Title: Optimally robust estimation - old version Description: Optimally robust estimation using S4 classes and methods. Old version still needed for current versions of ROptRegTS and RobRex. -Depends: R(>= 2.4.0), methods, distr(>= 2.2), distrEx(>= 2.2), RandVar(>= 0.7) +Depends: R(>= 2.4.0), methods, distr(>= 2.4), distrEx(>= 2.4), RandVar(>= 0.8), evd Author: Matthias Kohl Maintainer: Matthias Kohl +LazyLoad: yes ByteCompile: yes -LazyLoad: yes License: LGPL-3 URL: http://robast.r-forge.r-project.org/ Encoding: latin1 LastChangedDate: {$LastChangedDate$} LastChangedRevision: {$LastChangedRevision$} -SVNRevision: 454 +SVNRevision: 588 Modified: pkg/ROptEstOld/NAMESPACE =================================================================== --- pkg/ROptEstOld/NAMESPACE 2013-02-07 19:44:03 UTC (rev 589) +++ pkg/ROptEstOld/NAMESPACE 2013-02-07 19:45:29 UTC (rev 590) @@ -1,3 +1,4 @@ +import("methods") import("distr") import("distrEx") import("RandVar") @@ -134,3 +135,10 @@ "IC", "ContIC", "TotalVarIC") +exportClasses("GumbelParameter", "Gumbel") +exportMethods("initialize", "loc", "loc<-") +exportMethods("scale", "scale<-", "+", "*", + "E", "var", "skewness", "kurtosis") +export("EULERMASCHERONICONSTANT","APERYCONSTANT") +export("Gumbel") +export("loc", "loc<-") \ No newline at end of file Modified: pkg/ROptEstOld/R/AllClass.R =================================================================== --- pkg/ROptEstOld/R/AllClass.R 2013-02-07 19:44:03 UTC (rev 589) +++ pkg/ROptEstOld/R/AllClass.R 2013-02-07 19:45:29 UTC (rev 590) @@ -1,10 +1,57 @@ .onLoad <- function(lib, pkg){ - require("methods", character = TRUE, quietly = TRUE) - require("distr", character = TRUE, quietly = TRUE) - require("distrEx", character = TRUE, quietly = TRUE) - require("RandVar", character = TRUE, quietly = TRUE) } +# parameter of Gumbel distribution +setClass("GumbelParameter", representation(loc = "numeric", + scale = "numeric"), + prototype(name = gettext("parameter of a Gumbel distribution"), + loc = 0, scale = 1), + contains = "Parameter", + validity = function(object){ + if(length(object at scale) != 1) + stop("length of 'scale' is not equal to 1") + if(length(object at loc) != 1) + stop("length of 'loc' is not equal to 1") + if(object at scale <= 0) + stop("'scale' has to be positive") + else return(TRUE) + }) + +# Gumbel distribution +setClass("Gumbel", + prototype = prototype(r = function(n){ rgumbel(n, loc = 0, scale = 1) }, + d = function(x, log){ dgumbel(x, loc = 0, scale = 1, log = FALSE) }, + p = function(q, lower.tail = TRUE, log.p = FALSE){ + p0 <- pgumbel(q, loc = 0, scale = 1, lower.tail = lower.tail) + if(log.p) return(log(p0)) else return(p0) + }, + q = function(p, loc = 0, scale = 1, lower.tail = TRUE, log.p = FALSE){ + ## P.R.: changed to vectorized form + p1 <- if(log.p) exp(p) else p + + in01 <- (p1>1 | p1<0) + i01 <- distr:::.isEqual01(p1) + i0 <- (i01 & p1<1) + i1 <- (i01 & p1>0) + ii01 <- distr:::.isEqual01(p1) | in01 + + p0 <- p + p0[ii01] <- if(log.p) log(0.5) else 0.5 + + q1 <- qgumbel(p0, loc = 0, scale = 1, + lower.tail = lower.tail) + q1[i0] <- if(lower.tail) -Inf else Inf + q1[i1] <- if(!lower.tail) -Inf else Inf + q1[in01] <- NaN + + return(q1) + }, + img = new("Reals"), + param = new("GumbelParameter"), + .logExact = FALSE, + .lowerExact = TRUE), + contains = "AbscontDistribution") + # symmetry of functions setClass("FunctionSymmetry", contains = c("Symmetry", "VIRTUAL")) Modified: pkg/ROptEstOld/R/AllGeneric.R =================================================================== --- pkg/ROptEstOld/R/AllGeneric.R 2013-02-07 19:44:03 UTC (rev 589) +++ pkg/ROptEstOld/R/AllGeneric.R 2013-02-07 19:45:29 UTC (rev 590) @@ -230,3 +230,10 @@ if(!isGeneric("infoPlot")){ setGeneric("infoPlot", function(object) standardGeneric("infoPlot")) } +if(!isGeneric("loc")){ + setGeneric("loc", function(object) standardGeneric("loc")) +} + +if(!isGeneric("loc<-")){ + setGeneric("loc<-", function(object, value) standardGeneric("loc<-")) +} Added: pkg/ROptEstOld/R/AllInitialize.R =================================================================== --- pkg/ROptEstOld/R/AllInitialize.R (rev 0) +++ pkg/ROptEstOld/R/AllInitialize.R 2013-02-07 19:45:29 UTC (rev 590) @@ -0,0 +1,45 @@ +## initialize method +setMethod("initialize", "Gumbel", + function(.Object, loc = 0, scale = 1) { + .Object at img <- Reals() + .Object at param <- new("GumbelParameter", loc = loc, scale = scale, + name = gettext("parameter of a Gumbel distribution")) + .Object at r <- function(n){} + body(.Object at r) <- substitute({ rgumbel(n, loc = loc1, scale = scale1) }, + list(loc1 = loc, scale1 = scale)) + .Object at d <- function(x, log = FALSE){} + body(.Object at d) <- substitute({ dgumbel(x, loc = loc1, scale = scale1, log = log) }, + list(loc1 = loc, scale1 = scale)) + .Object at p <- function(q, lower.tail = TRUE, log.p = FALSE){} + body(.Object at p) <- substitute({p1 <- pgumbel(q, loc = loc1, scale = scale1, lower.tail = lower.tail) + return(if(log.p) log(p1) else p1)}, + list(loc1 = loc, scale1 = scale)) + .Object at q <- function(p, loc = loc1, scale = scale1, lower.tail = TRUE, log.p = FALSE){} + body(.Object at q) <- substitute({ + ## P.R.: changed to vectorized form + p1 <- if(log.p) exp(p) else p + + in01 <- (p1>1 | p1<0) + i01 <- distr:::.isEqual01(p1) + i0 <- (i01 & p1<1) + i1 <- (i01 & p1>0) + ii01 <- distr:::.isEqual01(p1) | in01 + + p0 <- p + p0[ii01] <- if(log.p) log(0.5) else 0.5 + + q1 <- qgumbel(p0, loc = loc1, scale = scale1, + lower.tail = lower.tail) + q1[i0] <- if(lower.tail) -Inf else Inf + q1[i1] <- if(!lower.tail) -Inf else Inf + q1[in01] <- NaN + + return(q1) + }, list(loc1 = loc, scale1 = scale)) + .Object at .withSim <- FALSE + .Object at .withArith <- FALSE + .Object at .logExact <- FALSE + .Object at .lowerExact <- TRUE + .Object + }) + Modified: pkg/ROptEstOld/R/Expectation.R =================================================================== --- pkg/ROptEstOld/R/Expectation.R 2013-02-07 19:44:03 UTC (rev 589) +++ pkg/ROptEstOld/R/Expectation.R 2013-02-07 19:45:29 UTC (rev 590) @@ -22,3 +22,13 @@ return(res) }) +setMethod("E", signature(object = "Gumbel", + fun = "missing", + cond = "missing"), + function(object, low = NULL, upp = NULL, ...){a <- loc(object); b <- scale(object) + if(is.null(low) && is.null(upp)) + return(a- EULERMASCHERONICONSTANT * b) + else + return(E(as(object,"AbscontDistribution"), low=low, upp=upp, ...)) + }) +## http://mathworld.wolfram.com/GumbelDistribution.html Added: pkg/ROptEstOld/R/Functionals.R =================================================================== --- pkg/ROptEstOld/R/Functionals.R (rev 0) +++ pkg/ROptEstOld/R/Functionals.R 2013-02-07 19:45:29 UTC (rev 590) @@ -0,0 +1,15 @@ + +setMethod("var", signature(x = "Gumbel"), + function(x, ...){ + dots <- match.call(call = sys.call(sys.parent(1)), + expand.dots = FALSE)$"..." + fun <- NULL; cond <- NULL; low <- NULL; upp <- NULL + if(hasArg(low)) low <- dots$low + if(hasArg(upp)) upp <- dots$upp + if(hasArg(fun)||hasArg(cond)||!is.null(low)||!is.null(upp)) + return(var(as(x,"AbscontDistribution"),...)) + else{ b <- scale(x) + return(b^2 * pi^2/6) + }}) +## http://mathworld.wolfram.com/GumbelDistribution.html + Added: pkg/ROptEstOld/R/Gumbel.R =================================================================== --- pkg/ROptEstOld/R/Gumbel.R (rev 0) +++ pkg/ROptEstOld/R/Gumbel.R 2013-02-07 19:45:29 UTC (rev 590) @@ -0,0 +1,55 @@ +## access methods +setMethod("loc", "GumbelParameter", function(object) object at loc) +setMethod("scale", "GumbelParameter", + function(x, center = TRUE, scale = TRUE) x at scale) + +## replace Methods +setReplaceMethod("loc", "GumbelParameter", + function(object, value){ object at loc <- value; object }) +setReplaceMethod("scale", "GumbelParameter", + function(object, value){ object at scale <- value; object}) + + +## generating function +Gumbel <- function(loc = 0, scale = 1){ new("Gumbel", loc = loc, scale = scale) } + +## wrapped access methods +setMethod("loc", "Gumbel", function(object) loc(object at param)) +setMethod("scale", "Gumbel", + function(x, center = TRUE, scale = TRUE) scale(x at param)) + +## wrapped replace methods +setMethod("loc<-", "Gumbel", + function(object, value){ + new("Gumbel", loc = value, scale = scale(object)) + }) +setMethod("scale<-", "Gumbel", + function(object, value){ + if(length(value) != 1 || value <= 0) + stop("'value' has to be a single positive number") + new("Gumbel", loc = loc(object), scale = value) + }) + +## extra methods for Gumbel distribution +setMethod("+", c("Gumbel","numeric"), + function(e1, e2){ + if (length(e2)>1) stop("length of operator must be 1") + new("Gumbel", loc = loc(e1) + e2, scale = scale(e1)) + }) + +setMethod("*", c("Gumbel","numeric"), + function(e1, e2){ + if (length(e2)>1) stop("length of operator must be 1") + if (isTRUE(all.equal(e2,0))) + return(new("Dirac", location = 0, .withArith = TRUE)) + new("Gumbel", loc = loc(e1) * e2, scale = scale(e1)*abs(e2)) + }) + +### Euler Mascheroni constant: +EULERMASCHERONICONSTANT <- -digamma(1) ### after http://mathworld.wolfram.com/Euler-MascheroniConstant.html (48) + +### Ap?ry constant +##local helper function: +.fctApery <- function(n) (-1)^n*choose(2*n,n)*n^3 +## +APERYCONSTANT <- -sum(sapply(1:50,.fctApery)^(-1))*5/2 ## after http://mathworld.wolfram.com/AperysConstant.html (8) Added: pkg/ROptEstOld/R/GumbelLocationFamily.R =================================================================== --- pkg/ROptEstOld/R/GumbelLocationFamily.R (rev 0) +++ pkg/ROptEstOld/R/GumbelLocationFamily.R 2013-02-07 19:45:29 UTC (rev 590) @@ -0,0 +1,31 @@ +################################################################## +## Gumbel location family +################################################################## +GumbelLocationFamily <- function(loc = 0, scale = 1, trafo){ + if(missing(trafo)) trafo <- matrix(1, dimnames = list("loc","loc")) + modParam <- function(theta){} + body(modParam) <- substitute({ Gumbel(loc = theta, scale = sd) }, + list(sd = scale)) + res <- L2LocationFamily(loc = loc, + name = "Gumbel location family", + locname = c("loc"="loc"), + centraldistribution = Gumbel(loc = 0, scale = scale), + modParam = modParam, + LogDeriv = function(x) (1 - exp(-x/scale))/scale, + L2derivDistr.0 = (1 - Exp(rate = 1))/scale, + FisherInfo.0 = matrix(1/scale^2, + dimnames = list("loc","loc")), + distrSymm = NoSymmetry(), + L2derivSymm = FunSymmList(NonSymmetric()), + L2derivDistrSymm = DistrSymmList(NoSymmetry()), + trafo = trafo, .returnClsName = "GumbelLocationFamily") + if(!is.function(trafo)) + f.call <- substitute(GumbelLocationFamily(loc = l, scale = s, + trafo = matrix(Tr, dimnames = list("loc","loc"))), + list(l = loc, s = scale, Tr = trafo)) + else + f.call <- substitute(GumbelLocationFamily(loc = l, scale = s, trafo = Tr), + list(l = loc, s = scale, Tr = trafo)) + res at fam.call <- f.call + return(res) +} Added: pkg/ROptEstOld/R/Kurtosis.R =================================================================== --- pkg/ROptEstOld/R/Kurtosis.R (rev 0) +++ pkg/ROptEstOld/R/Kurtosis.R 2013-02-07 19:45:29 UTC (rev 590) @@ -0,0 +1,24 @@ +################################################################################### +#kurtosis --- code due to G. Jay Kerns, gkerns at ysu.edu +################################################################################### + + + +setMethod("kurtosis", signature(x = "Gumbel"), + function(x, ...){ + dots <- match.call(call = sys.call(sys.parent(1)), + expand.dots = FALSE)$"..." + fun <- NULL; cond <- NULL; low <- NULL; upp <- NULL + if(hasArg(low)) low <- dots$low + if(hasArg(upp)) upp <- dots$upp + if(hasArg(fun)||hasArg(cond)||!is.null(low)||!is.null(upp)) + return(kurtosis(as(x,"AbscontDistribution"),...)) + else{ + return(12/5) +# http://mathworld.wolfram.com/GumbelDistribution.html + } +}) + +### source http://en.wikipedia.org/wiki/Generalized_extreme_value_distribution +### http://en.wikipedia.org/wiki/Gumbel_distribution +### http://en.wikipedia.org/wiki/Riemann_zeta_function Added: pkg/ROptEstOld/R/Skewness.R =================================================================== --- pkg/ROptEstOld/R/Skewness.R (rev 0) +++ pkg/ROptEstOld/R/Skewness.R 2013-02-07 19:45:29 UTC (rev 590) @@ -0,0 +1,16 @@ + +setMethod("skewness", signature(x = "Gumbel"), + function(x, ...){ + dots <- match.call(call = sys.call(sys.parent(1)), + expand.dots = FALSE)$"..." + fun <- NULL; cond <- NULL; low <- NULL; upp <- NULL + if(hasArg(low)) low <- dots$low + if(hasArg(upp)) upp <- dots$upp + if(hasArg(fun)||hasArg(cond)||!is.null(low)||!is.null(upp)) + return(skewness(as(x,"AbscontDistribution"),...)) + else{ + return( -12 * sqrt(6) * APERYCONSTANT / pi^3 ) +# http://mathworld.wolfram.com/GumbelDistribution.html + } +}) + Modified: pkg/ROptEstOld/inst/NEWS =================================================================== --- pkg/ROptEstOld/inst/NEWS 2013-02-07 19:44:03 UTC (rev 589) +++ pkg/ROptEstOld/inst/NEWS 2013-02-07 19:45:29 UTC (rev 590) @@ -8,6 +8,14 @@ information) ####################################### +version 0.9 +####################################### +EVD functionality (including Gumbel distribution) has +moved from distrEx to new pkg RobExtremes; to avoid failure +of ROptEstOld, this functionality has been copied to ROptEstOld +as well. + +####################################### version 0.8 ####################################### Added: pkg/ROptEstOld/man/Gumbel-class.Rd =================================================================== --- pkg/ROptEstOld/man/Gumbel-class.Rd (rev 0) +++ pkg/ROptEstOld/man/Gumbel-class.Rd 2013-02-07 19:45:29 UTC (rev 590) @@ -0,0 +1,150 @@ +\name{Gumbel-class} +\docType{class} +\alias{Gumbel-class} +\alias{initialize,Gumbel-method} +\alias{loc,Gumbel-method} +\alias{loc<-,Gumbel-method} +\alias{scale,Gumbel-method} +\alias{scale<-,Gumbel-method} +\alias{+,Gumbel,numeric-method} +\alias{*,Gumbel,numeric-method} +\alias{E} +\alias{E-methods} +\alias{E,Gumbel,missing,missing-method} +\alias{var} +\alias{var-methods} +\alias{var,Gumbel-method} +\alias{skewness} +\alias{skewness-methods} +\alias{skewness,Gumbel-method} +\alias{kurtosis} +\alias{kurtosis-methods} +\alias{kurtosis,Gumbel-method} + +\title{Gumbel distribution} +\description{The Gumbel cumulative distribution function with + location parameter \code{loc} \eqn{= \mu}{= mu} and scale + parameter \code{scale} \eqn{= \sigma}{= sigma} is + \deqn{F(x) = \exp(-\exp[-(x-\mu)/\sigma])}{F(x) = exp(-exp[-(x-mu)/sigma])} + for all real x, where \eqn{\sigma > 0}{sigma > 0}; + c.f. \code{rgumbel}. This distribution is also known as + extreme value distribution of type I; confer Chapter~22 of + Johnson et al. (1995). +} +\section{Objects from the Class}{ + Objects can be created by calls of the form \code{new("Gumbel", loc, scale)}. + More frequently they are created via the generating function + \code{Gumbel}. +} +\section{Slots}{ + \describe{ + \item{\code{img}}{Object of class \code{"Reals"}. } + \item{\code{param}}{Object of class \code{"GumbelParameter"}. } + \item{\code{r}}{\code{rgumbel}} + \item{\code{d}}{\code{dgumbel}} + \item{\code{p}}{\code{pgumbel}} + \item{\code{q}}{\code{qgumbel}} + \item{\code{gaps}}{(numeric) matrix or \code{NULL}} + \item{\code{.withArith}}{logical: used internally to issue warnings as to + interpretation of arithmetics} + \item{\code{.withSim}}{logical: used internally to issue warnings as to + accuracy} + \item{\code{.logExact}}{logical: used internally to flag the case where + there are explicit formulae for the log version of density, cdf, and + quantile function} + \item{\code{.lowerExact}}{logical: used internally to flag the case where + there are explicit formulae for the lower tail version of cdf and quantile + function} + \item{\code{Symmetry}}{object of class \code{"DistributionSymmetry"}; + used internally to avoid unnecessary calculations.} + } +} +\section{Extends}{ +Class \code{"AbscontDistribution"}, directly.\cr +Class \code{"UnivariateDistribution"}, by class \code{"AbscontDistribution"}.\cr +Class \code{"Distribution"}, by class \code{"AbscontDistribution"}. +} +\section{Methods}{ + \describe{ + \item{initialize}{\code{signature(.Object = "Gumbel")}: initialize method. } + + \item{loc}{\code{signature(object = "Gumbel")}: wrapped access method for + slot \code{loc} of slot \code{param}. } + + \item{scale}{\code{signature(x = "Gumbel")}: wrapped access method for + slot \code{scale} of slot \code{param}. } + + \item{loc<-}{\code{signature(object = "Gumbel")}: wrapped replace method for + slot \code{loc} of slot \code{param}. } + + \item{scale<-}{\code{signature(x = "Gumbel")}: wrapped replace method for + slot \code{scale} of slot \code{param}. } + + \item{\code{+}}{\code{signature(e1 = "Gumbel", e2 = "numeric")}: result again of + class \code{"Gumbel"}; exact. } + + \item{\code{*}}{\code{signature(e1 = "Gumbel", e2 = "numeric")}: result again of + class \code{"Gumbel"}; exact. } + + \item{E}{\code{signature(object = "Gumbel", fun = "missing", cond = "missing")}: + exact evaluation of expectation using explicit expressions.} + + \item{var}{\code{signature(x = "Gumbel")}: + exact evaluation of expectation using explicit expressions.} + + \item{skewness}{\code{signature(x = "Gumbel")}: + exact evaluation of expectation using explicit expressions.} + + \item{kurtosis}{\code{signature(x = "Gumbel")}: + exact evaluation of expectation using explicit expressions.} + + \item{median}{\code{signature(x = "Gumbel")}: + exact evaluation of expectation using explicit expressions.} + + \item{IQR}{\code{signature(x = "Gumbel")}: + exact evaluation of expectation using explicit expressions.} + } +} +\usage{ +E(object, fun, cond, ...) +\S4method{E}{Gumbel,missing,missing}(object, low = NULL, upp = NULL, ...) +var(x, ...) +\S4method{var}{Gumbel}(x, ...) +skewness(x, ...) +\S4method{skewness}{Gumbel}(x, ...) +kurtosis(x, ...) +\S4method{kurtosis}{Gumbel}(x, ...) + +} +\arguments{ + \item{object}{ object of class \code{"Distribution"}} + \item{fun}{ if missing the (conditional) expectation is computed + else the (conditional) expection of \code{fun} is computed. } + \item{cond}{ if not missing the conditional expectation + given \code{cond} is computed. } + \item{low}{lower bound of integration range.} + \item{upp}{upper bound of integration range.} + \item{x}{ object of class \code{"UnivariateDistribution"}} + \item{\dots}{ additional arguments to \code{fun} } +} + + +\references{Johnson et al. (1995) \emph{Continuous Univariate Distributions. Vol. 2. 2nd ed.} + New York: Wiley.} +\author{Matthias Kohl \email{Matthias.Kohl at stamats.de}} +\note{This class is based on the code provided by the package \pkg{evd}.} +\seealso{\code{\link[evd:gumbel]{rgumbel}}, \code{\link[distr]{AbscontDistribution-class}}} +\examples{ +(G1 <- new("Gumbel", loc = 1, scale = 2)) +plot(G1) +loc(G1) +scale(G1) +loc(G1) <- -1 +scale(G1) <- 2 +plot(G1) +} +\concept{Gumbel} +\keyword{distribution} +\concept{extreme value distribution} +\concept{absolutely continuous distribution} +\concept{S4 distribution class} Added: pkg/ROptEstOld/man/Gumbel.Rd =================================================================== --- pkg/ROptEstOld/man/Gumbel.Rd (rev 0) +++ pkg/ROptEstOld/man/Gumbel.Rd 2013-02-07 19:45:29 UTC (rev 590) @@ -0,0 +1,43 @@ +\name{Gumbel} +\alias{Gumbel} + +\title{Generating function for Gumbel-class} +\description{ + Generates an object of class \code{"Gumbel"}. +} +\usage{Gumbel(loc = 0, scale = 1)} +\arguments{ + \item{loc}{ real number: location parameter of + the Gumbel distribution. } + \item{scale}{ positive real number: scale parameter + of the Gumbel distribution } +} +%\details{} +\value{Object of class \code{"Gumbel"}} +%\references{} +\author{Matthias Kohl \email{Matthias.Kohl at stamats.de}} +\note{The class \code{"Gumbel"} is based on the code provided + by the package \pkg{evd}.} +\seealso{\code{\link{Gumbel-class}}, \code{\link[evd:gumbel]{rgumbel}}} +\examples{ +(G1 <- Gumbel(loc = 1, scale = 2)) +plot(G1) +loc(G1) +scale(G1) +loc(G1) <- -1 +scale(G1) <- 2 +plot(G1) + +E(Gumbel()) # Euler's constant +E(G1, function(x){x^2}) + +## The function is currently defined as +function(loc = 0, scale = 1){ + new("Gumbel", loc = loc, scale = scale) +} +} +\concept{Gumbel} +\keyword{distribution} +\concept{absolutely continuous distribution} +\concept{Gumbel distribution} +\concept{generating function} Modified: pkg/ROptEstOld/man/GumbelLocationFamily.Rd =================================================================== --- pkg/ROptEstOld/man/GumbelLocationFamily.Rd 2013-02-07 19:44:03 UTC (rev 589) +++ pkg/ROptEstOld/man/GumbelLocationFamily.Rd 2013-02-07 19:45:29 UTC (rev 590) @@ -25,7 +25,7 @@ } \author{Matthias Kohl \email{Matthias.Kohl at stamats.de}} %\note{} -\seealso{\code{\link{L2ParamFamily-class}}, \code{\link[distrEx]{Gumbel-class}}} +\seealso{\code{\link{L2ParamFamily-class}}, \code{\link{Gumbel-class}}} \examples{ distrExOptions("ElowerTruncQuantile" = 1e-15) # problem with # non-finite function value Added: pkg/ROptEstOld/man/GumbelParameter-class.Rd =================================================================== --- pkg/ROptEstOld/man/GumbelParameter-class.Rd (rev 0) +++ pkg/ROptEstOld/man/GumbelParameter-class.Rd 2013-02-07 19:45:29 UTC (rev 590) @@ -0,0 +1,57 @@ +\name{GumbelParameter-class} +\docType{class} +\alias{GumbelParameter-class} +\alias{loc} +\alias{loc,GumbelParameter-method} +\alias{loc<-} +\alias{loc<-,GumbelParameter-method} +\alias{scale,GumbelParameter-method} +\alias{scale<-,GumbelParameter-method} + +\title{Paramter of Gumbel distributions} +\description{The class of the parameter of Gumbel distributions.} +\section{Objects from the Class}{ +Objects can be created by calls of the form \code{new("GumbelParameter", ...)}. +} +\section{Slots}{ + \describe{ + \item{\code{loc}}{ real number: location parameter of + a Gumbel distribution. } + \item{\code{scale}}{ positive real number: scale + parameter of a Gumbel distribution. } + \item{\code{name}}{ default name is + \dQuote{parameter of a Gumbel distribution}. } + } +} +\section{Extends}{ +Class \code{"Parameter"}, directly.\cr +Class \code{"OptionalParameter"}, by class \code{"Parameter"}. +} +\section{Methods}{ + \describe{ + \item{loc}{\code{signature(object = "GumbelParameter")}: access method for + slot \code{loc}. } + \item{scale}{\code{signature(x = "GumbelParameter")}: access method for + slot \code{scale}. } + \item{loc<-}{\code{signature(object = "GumbelParameter")}: replace method for + slot \code{loc}. } + \item{scale<-}{\code{signature(x = "GumbelParameter")}: replace method for + slot \code{scale}. } + } +} +%\references{} +\author{Matthias Kohl \email{Matthias.Kohl at stamats.de}} +%\note{} +\seealso{\code{\link{Gumbel-class}}, \code{\link[distr]{Parameter-class}}} +\examples{ +new("GumbelParameter") +} +\concept{Gumbel distribution} +\keyword{distribution} +\concept{parameter} +\concept{S4 parameter class} +\keyword{models} +\concept{generating function} +\concept{scale} +\concept{location} +\concept{location scale model} Added: pkg/ROptEstOld/man/ROptEstOldConstants.Rd =================================================================== --- pkg/ROptEstOld/man/ROptEstOldConstants.Rd (rev 0) +++ pkg/ROptEstOld/man/ROptEstOldConstants.Rd 2013-02-07 19:45:29 UTC (rev 590) @@ -0,0 +1,34 @@ +\name{ROptEstOldConstants} +\alias{EULERMASCHERONICONSTANT} +\alias{APERYCONSTANT} +\encoding{latin1} +\title{Built-in Constants in package ROptEstOld} +\description{ + Constants built into \pkg{ROptEstOld}. +} +\usage{ +EULERMASCHERONICONSTANT +APERYCONSTANT +} +\details{ + \pkg{ROptEstOld} has a small number of built-in constants. + + The following constants are available: + \itemize{ + \item \code{EULERMASCHERONICONSTANT}: the Euler Mascheroni constant + \deqn{\gamma=-\Gamma'(1)}{gamma=-digamma(1)} + given in \url{http://mathworld.wolfram.com/Euler-MascheroniConstant.html} (48); + \item \code{APERYCONSTANT}: the \enc{Ap?ry}{Apery} constant + \deqn{\zeta(3)= \frac{5}{2} (\sum_{k\ge 1}\frac{(-1)^{k-1}}{k^3 {2k\choose k}})}{ + zeta(3) = 5/2 sum_{k>=0} (-1)^(k-1)/(k^3 * choose(2k,k))} + as given in \url{http://mathworld.wolfram.com/AperysConstant.html}, equation (8); + } + + These are implemented as variables in the \pkg{ROptEstOld} name space taking + appropriate values. +} +\examples{ +EULERMASCHERONICONSTANT +APERYCONSTANT +} +\keyword{sysdata} From noreply at r-forge.r-project.org Fri Feb 8 10:01:32 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 8 Feb 2013 10:01:32 +0100 (CET) Subject: [Robast-commits] r591 - branches/robast-0.9/pkg/RandVar/tests/Examples Message-ID: <20130208090133.0587F184241@r-forge.r-project.org> Author: stamats Date: 2013-02-08 10:01:32 +0100 (Fri, 08 Feb 2013) New Revision: 591 Modified: branches/robast-0.9/pkg/RandVar/tests/Examples/RandVar-Ex.Rout.save Log: update of Rout.save - no errors or warnings Modified: branches/robast-0.9/pkg/RandVar/tests/Examples/RandVar-Ex.Rout.save =================================================================== --- branches/robast-0.9/pkg/RandVar/tests/Examples/RandVar-Ex.Rout.save 2013-02-07 19:45:29 UTC (rev 590) +++ branches/robast-0.9/pkg/RandVar/tests/Examples/RandVar-Ex.Rout.save 2013-02-08 09:01:32 UTC (rev 591) @@ -1,5 +1,5 @@ -R Under development (unstable) (2013-01-09 r61595) -- "Unsuffered Consequences" +R Under development (unstable) (2013-02-06 r61845) -- "Unsuffered Consequences" Copyright (C) 2013 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: x86_64-unknown-linux-gnu (64-bit) @@ -123,10 +123,10 @@ :RandVar> vignette("RandVar"). > -> assign(".oldSearch", search(), pos = 'CheckExEnv') -> assign(".ExTimings", "RandVar-Ex.timings", pos = 'CheckExEnv') -> cat("name\tuser\tsystem\telapsed\n", file=get(".ExTimings", pos = 'CheckExEnv')) -> assign(".format_ptime", +> base::assign(".oldSearch", base::search(), pos = 'CheckExEnv') +> base::assign(".ExTimings", "RandVar-Ex.timings", pos = 'CheckExEnv') +> base::cat("name\tuser\tsystem\telapsed\n", file=base::get(".ExTimings", pos = 'CheckExEnv')) +> base::assign(".format_ptime", + function(x) { + if(!is.na(x[4L])) x[1L] <- x[1L] + x[4L] + if(!is.na(x[5L])) x[2L] <- x[2L] + x[5L] @@ -140,7 +140,7 @@ > > flush(stderr()); flush(stdout()) > -> assign(".ptime", proc.time(), pos = "CheckExEnv") +> base::assign(".ptime", proc.time(), pos = "CheckExEnv") > ### Name: RandVar-package > ### Title: Implementation of random variables > ### Aliases: RandVar-package RandVar @@ -154,15 +154,15 @@ > > > -> assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -> cat("0RandVar-package", get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") +> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") +> base::cat("0RandVar-package", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") > cleanEx() > nameEx("EuclRandMatrix-class") > ### * EuclRandMatrix-class > > flush(stderr()); flush(stdout()) > -> assign(".ptime", proc.time(), pos = "CheckExEnv") +> base::assign(".ptime", proc.time(), pos = "CheckExEnv") > ### Name: EuclRandMatrix-class > ### Title: Euclidean random matrix > ### Aliases: EuclRandMatrix-class @@ -229,7 +229,7 @@ } t(f(x)) } - + > > R2 <- EuclRandMatrix(Map = L2, ncol = 2, Domain = Reals(), dimension = 1) @@ -258,7 +258,7 @@ } gamma(f1(x)) } - + [[2]] function (x) @@ -269,7 +269,7 @@ } gamma(f1(x)) } - + [[3]] function (x) @@ -280,7 +280,7 @@ } gamma(f1(x)) } - + [[4]] function (x) @@ -291,7 +291,7 @@ } gamma(f1(x)) } - + > > ## "Arith" group @@ -305,7 +305,7 @@ } 2/f2(x) } - + [[2]] function (x) @@ -316,7 +316,7 @@ } 2/f2(x) } - + [[3]] function (x) @@ -327,7 +327,7 @@ } 2/f2(x) } - + [[4]] function (x) @@ -338,7 +338,7 @@ } 2/f2(x) } - + [[5]] function (x) @@ -349,7 +349,7 @@ } 2/f2(x) } - + [[6]] function (x) @@ -360,7 +360,7 @@ } 2/f2(x) } - + > Map(R2 * R2) [[1]] @@ -376,7 +376,7 @@ } f1(x) * f2(x) } - + [[2]] function (x) @@ -391,7 +391,7 @@ } f1(x) * f2(x) } - + [[3]] function (x) @@ -406,7 +406,7 @@ } f1(x) * f2(x) } - + [[4]] function (x) @@ -421,21 +421,21 @@ } f1(x) * f2(x) } - + > > > > -> assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -> cat("EuclRandMatrix-class", get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") +> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") +> base::cat("EuclRandMatrix-class", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") > cleanEx() > nameEx("EuclRandMatrix") > ### * EuclRandMatrix > > flush(stderr()); flush(stdout()) > -> assign(".ptime", proc.time(), pos = "CheckExEnv") +> base::assign(".ptime", proc.time(), pos = "CheckExEnv") > ### Name: EuclRandMatrix > ### Title: Generating function for EuclRandMatrix-class > ### Aliases: EuclRandMatrix @@ -476,7 +476,7 @@ } t(f(x)) } - + > > R2 <- EuclRandMatrix(Map = L2, ncol = 2, Domain = Reals(), dimension = 1) @@ -503,7 +503,7 @@ } gamma(f1(x)) } - + [[2]] function (x) @@ -514,7 +514,7 @@ } gamma(f1(x)) } - + [[3]] function (x) @@ -525,7 +525,7 @@ } gamma(f1(x)) } - + [[4]] function (x) @@ -536,7 +536,7 @@ } gamma(f1(x)) } - + > > ## "Arith" group @@ -550,7 +550,7 @@ } 2/f2(x) } - + [[2]] function (x) @@ -561,7 +561,7 @@ } 2/f2(x) } - + [[3]] function (x) @@ -572,7 +572,7 @@ } 2/f2(x) } - + [[4]] function (x) @@ -583,7 +583,7 @@ } 2/f2(x) } - + [[5]] function (x) @@ -594,7 +594,7 @@ } 2/f2(x) } - + [[6]] function (x) @@ -605,7 +605,7 @@ } 2/f2(x) } - + > Map(R2 * R2) [[1]] @@ -621,7 +621,7 @@ } f1(x) * f2(x) } - + [[2]] function (x) @@ -636,7 +636,7 @@ } f1(x) * f2(x) } - + [[3]] function (x) @@ -651,7 +651,7 @@ } f1(x) * f2(x) } - + [[4]] function (x) @@ -666,7 +666,7 @@ } f1(x) * f2(x) } - + > > @@ -705,15 +705,15 @@ > > > -> assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -> cat("EuclRandMatrix", get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") +> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") +> base::cat("EuclRandMatrix", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") > cleanEx() > nameEx("EuclRandVarList-class") > ### * EuclRandVarList-class > > flush(stderr()); flush(stdout()) > -> assign(".ptime", proc.time(), pos = "CheckExEnv") +> base::assign(".ptime", proc.time(), pos = "CheckExEnv") > ### Name: EuclRandVarList-class > ### Title: List of Euclidean random variables > ### Aliases: EuclRandVarList-class numberOfMaps @@ -788,7 +788,7 @@ } exp(f1(x)) } - + [[2]] function (x) @@ -799,7 +799,7 @@ } exp(f1(x)) } - + [[3]] function (x) @@ -810,7 +810,7 @@ } exp(f1(x)) } - + [[4]] function (x) @@ -821,7 +821,7 @@ } exp(f1(x)) } - + > > ## "Arith" group @@ -835,7 +835,7 @@ } 1 + f2(x) } - + [[2]] function (x) @@ -846,7 +846,7 @@ } 1 + f2(x) } - + [[3]] function (x) @@ -857,7 +857,7 @@ } 1 + f2(x) } - + [[4]] function (x) @@ -868,7 +868,7 @@ } 1 + f2(x) } - + > Map((RL1 * 2)[[2]]) [[1]] @@ -880,7 +880,7 @@ } f1(x) * 2 } - + [[2]] function (x) @@ -891,7 +891,7 @@ } f1(x) * 2 } - + [[3]] function (x) @@ -902,7 +902,7 @@ } f1(x) * 2 } - + [[4]] function (x) @@ -913,7 +913,7 @@ } f1(x) * 2 } - + [[5]] function (x) @@ -924,7 +924,7 @@ } f1(x) * 2 } - + [[6]] function (x) @@ -935,7 +935,7 @@ } f1(x) * 2 } - + > Map((RL1 / RL1)[[3]]) [[1]] @@ -951,7 +951,7 @@ } f1(x)/f2(x) } - + [[2]] function (x) @@ -966,7 +966,7 @@ } f1(x)/f2(x) } - + [[3]] function (x) @@ -981,7 +981,7 @@ } f1(x)/f2(x) } - + [[4]] function (x) @@ -996,21 +996,21 @@ } f1(x)/f2(x) } - + > > > > -> assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -> cat("EuclRandVarList-class", get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") +> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") +> base::cat("EuclRandVarList-class", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") > cleanEx() > nameEx("EuclRandVarList") > ### * EuclRandVarList > > flush(stderr()); flush(stdout()) > -> assign(".ptime", proc.time(), pos = "CheckExEnv") +> base::assign(".ptime", proc.time(), pos = "CheckExEnv") > ### Name: EuclRandVarList > ### Title: Generating function for EuclRandVarList-class > ### Aliases: EuclRandVarList @@ -1066,7 +1066,7 @@ } exp(f1(x)) } - + [[2]] function (x) @@ -1077,7 +1077,7 @@ } exp(f1(x)) } - + [[3]] function (x) @@ -1088,7 +1088,7 @@ } exp(f1(x)) } - + [[4]] function (x) @@ -1099,7 +1099,7 @@ } exp(f1(x)) } - + > > ## "Arith" group @@ -1113,7 +1113,7 @@ } 1 + f2(x) } - + [[2]] function (x) @@ -1124,7 +1124,7 @@ } 1 + f2(x) } - + [[3]] function (x) @@ -1135,7 +1135,7 @@ } 1 + f2(x) } - + [[4]] function (x) @@ -1146,7 +1146,7 @@ } 1 + f2(x) } - + > Map((RL1 * 2)[[2]]) [[1]] @@ -1158,7 +1158,7 @@ } f1(x) * 2 } - + [[2]] function (x) @@ -1169,7 +1169,7 @@ } f1(x) * 2 } - + [[3]] function (x) @@ -1180,7 +1180,7 @@ } f1(x) * 2 } - + [[4]] function (x) @@ -1191,7 +1191,7 @@ } f1(x) * 2 } - + [[5]] function (x) @@ -1202,7 +1202,7 @@ } f1(x) * 2 } - + [[6]] function (x) @@ -1213,7 +1213,7 @@ } f1(x) * 2 } - + > Map((RL1 / RL1)[[3]]) [[1]] @@ -1229,7 +1229,7 @@ } f1(x)/f2(x) } - + [[2]] function (x) @@ -1244,7 +1244,7 @@ } f1(x)/f2(x) } - + [[3]] function (x) @@ -1259,7 +1259,7 @@ } f1(x)/f2(x) } - + [[4]] function (x) @@ -1274,7 +1274,7 @@ } f1(x)/f2(x) } - + > > ## The function is currently defined as @@ -1289,15 +1289,15 @@ > > > -> assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -> cat("EuclRandVarList", get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") +> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") +> base::cat("EuclRandVarList", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") > cleanEx() > nameEx("EuclRandVariable-class") > ### * EuclRandVariable-class > > flush(stderr()); flush(stdout()) > -> assign(".ptime", proc.time(), pos = "CheckExEnv") +> base::assign(".ptime", proc.time(), pos = "CheckExEnv") > ### Name: EuclRandVariable-class > ### Title: Euclidean random variable > ### Aliases: EuclRandVariable-class @@ -1479,7 +1479,7 @@ } log(f1(x)) } - + [[2]] function (x) @@ -1494,7 +1494,7 @@ } log(f1(x)) } - + [[3]] function (x) @@ -1509,7 +1509,7 @@ } log(f1(x)) } - + [[4]] function (x) @@ -1524,7 +1524,7 @@ } log(f1(x)) } - + > > # "Arith" group generic @@ -1538,7 +1538,7 @@ } 3 + f2(x) } - + [[2]] function (x) @@ -1549,7 +1549,7 @@ } 3 + f2(x) } - + [[3]] function (x) @@ -1560,7 +1560,7 @@ } 3 + f2(x) } - + [[4]] function (x) @@ -1571,7 +1571,7 @@ } 3 + f2(x) } - + > Map(c(1,3,5) * R1) Warning in c(1, 3, 5) * R1 : @@ -1585,7 +1585,7 @@ } 1 * f2(x) } - + [[2]] function (x) @@ -1596,7 +1596,7 @@ } 3 * f2(x) } - + [[3]] function (x) @@ -1607,7 +1607,7 @@ } 5 * f2(x) } - + [[4]] function (x) @@ -1618,7 +1618,7 @@ } 1 * f2(x) } - + > try(1:5 * R1) # error Error in 1:5 * R1 : @@ -1633,7 +1633,7 @@ } 1:2 * f2(x) } - + [[2]] function (x) @@ -1644,7 +1644,7 @@ } 1:2 * f2(x) } - + [[3]] function (x) @@ -1655,7 +1655,7 @@ } 1:2 * f2(x) } - + [[4]] function (x) @@ -1666,7 +1666,7 @@ } 1:2 * f2(x) } - + > Map(R2 - 5) [[1]] @@ -1678,7 +1678,7 @@ } f1(x) - c(5, 5) } - + [[2]] function (x) @@ -1689,7 +1689,7 @@ } f1(x) - c(5, 5) } - + [[3]] function (x) @@ -1700,7 +1700,7 @@ } f1(x) - c(5, 5) } - + [[4]] function (x) @@ -1711,7 +1711,7 @@ } f1(x) - c(5, 5) } - + > Map(R1 ^ R1) [[1]] @@ -1727,7 +1727,7 @@ } f1(x)^f2(x) } - + [[2]] function (x) @@ -1742,7 +1742,7 @@ } f1(x)^f2(x) } - + [[3]] function (x) @@ -1757,7 +1757,7 @@ } f1(x)^f2(x) } - + [[4]] function (x) @@ -1772,22 +1772,22 @@ } f1(x)^f2(x) } - + > > > > > -> assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -> cat("EuclRandVariable-class", get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") +> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") +> base::cat("EuclRandVariable-class", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") > cleanEx() > nameEx("EuclRandVariable") > ### * EuclRandVariable > > flush(stderr()); flush(stdout()) > -> assign(".ptime", proc.time(), pos = "CheckExEnv") +> base::assign(".ptime", proc.time(), pos = "CheckExEnv") > ### Name: EuclRandVariable > ### Title: Generating function for EuclRandVariable-class > ### Aliases: EuclRandVariable @@ -1936,7 +1936,7 @@ } log(f1(x)) } - + [[2]] function (x) @@ -1951,7 +1951,7 @@ } log(f1(x)) } - + [[3]] function (x) @@ -1966,7 +1966,7 @@ } log(f1(x)) } - + [[4]] function (x) @@ -1981,7 +1981,7 @@ } log(f1(x)) } - + > > # "Arith" group generic @@ -1995,7 +1995,7 @@ } 3 + f2(x) } - + [[2]] function (x) @@ -2006,7 +2006,7 @@ } 3 + f2(x) } - + [[3]] function (x) @@ -2017,7 +2017,7 @@ } 3 + f2(x) } - + [[4]] function (x) @@ -2028,7 +2028,7 @@ } 3 + f2(x) } - + > Map(c(1,3,5) * R1) Warning in c(1, 3, 5) * R1 : @@ -2042,7 +2042,7 @@ } 1 * f2(x) } - + [[2]] function (x) @@ -2053,7 +2053,7 @@ } 3 * f2(x) } - + [[3]] function (x) @@ -2064,7 +2064,7 @@ } 5 * f2(x) } - + [[4]] function (x) @@ -2075,7 +2075,7 @@ } 1 * f2(x) } - + > try(1:5 * R1) # error Error in 1:5 * R1 : @@ -2090,7 +2090,7 @@ } 1:2 * f2(x) } - + [[2]] function (x) @@ -2101,7 +2101,7 @@ } 1:2 * f2(x) } - + [[3]] function (x) @@ -2112,7 +2112,7 @@ } 1:2 * f2(x) } - + [[4]] function (x) @@ -2123,7 +2123,7 @@ } 1:2 * f2(x) } - + > Map(R2 - 5) [[1]] @@ -2135,7 +2135,7 @@ } f1(x) - c(5, 5) } - + [[2]] function (x) @@ -2146,7 +2146,7 @@ } f1(x) - c(5, 5) } - + [[3]] function (x) @@ -2157,7 +2157,7 @@ } f1(x) - c(5, 5) } - + [[4]] function (x) @@ -2168,7 +2168,7 @@ } f1(x) - c(5, 5) } - + > Map(R1 ^ R1) [[1]] @@ -2184,7 +2184,7 @@ } f1(x)^f2(x) } - + [[2]] function (x) @@ -2199,7 +2199,7 @@ } f1(x)^f2(x) } - + [[3]] function (x) @@ -2214,7 +2214,7 @@ } f1(x)^f2(x) } - + [[4]] function (x) @@ -2229,7 +2229,7 @@ } f1(x)^f2(x) } - + > > @@ -2256,15 +2256,15 @@ > > > -> assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -> cat("EuclRandVariable", get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") +> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") +> base::cat("EuclRandVariable", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") > cleanEx() > nameEx("RandVariable-class") > ### * RandVariable-class > > flush(stderr()); flush(stdout()) > -> assign(".ptime", proc.time(), pos = "CheckExEnv") +> base::assign(".ptime", proc.time(), pos = "CheckExEnv") > ### Name: RandVariable-class > ### Title: Random variable > ### Aliases: RandVariable-class Map Domain Range compatibleDomains @@ -2288,7 +2288,7 @@ function (x) { } - + > Domain(R1) @@ -2336,15 +2336,15 @@ > > > -> assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -> cat("RandVariable-class", get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") +> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") +> base::cat("RandVariable-class", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") > cleanEx() > nameEx("RandVariable") > ### * RandVariable > > flush(stderr()); flush(stdout()) > -> assign(".ptime", proc.time(), pos = "CheckExEnv") +> base::assign(".ptime", proc.time(), pos = "CheckExEnv") > ### Name: RandVariable > ### Title: Generating function for RandVariable-class > ### Aliases: RandVariable @@ -2362,7 +2362,7 @@ function (x) { } - + > Domain(R1) NULL @@ -2419,15 +2419,15 @@ > > > -> assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -> cat("RandVariable", get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") +> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") +> base::cat("RandVariable", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") > cleanEx() > nameEx("RealRandVariable-class") > ### * RealRandVariable-class > > flush(stderr()); flush(stdout()) > -> assign(".ptime", proc.time(), pos = "CheckExEnv") +> base::assign(".ptime", proc.time(), pos = "CheckExEnv") > ### Name: RealRandVariable-class > ### Title: Real random variable > ### Aliases: RealRandVariable-class Range<-,RealRandVariable-method @@ -2444,15 +2444,15 @@ > > > -> assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -> cat("RealRandVariable-class", get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") +> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") +> base::cat("RealRandVariable-class", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") > cleanEx() > nameEx("RealRandVariable") > ### * RealRandVariable > > flush(stderr()); flush(stdout()) > -> assign(".ptime", proc.time(), pos = "CheckExEnv") +> base::assign(".ptime", proc.time(), pos = "CheckExEnv") > ### Name: RealRandVariable > ### Title: Generating function for RealRandVariable-class > ### Aliases: RealRandVariable @@ -2490,12 +2490,12 @@ > > > -> assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") -> cat("RealRandVariable", get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") +> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv") +> base::cat("RealRandVariable", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t") > ### *