R.utils/0000755000176200001440000000000014526006222011611 5ustar liggesusersR.utils/NAMESPACE0000644000176200001440000003302314372747611013046 0ustar liggesusers# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # IMPORTS # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - importFrom("R.methodsS3", "setMethodS3") importFrom("R.oo", "setConstructorS3") importFrom("R.oo", "extend") importFrom("R.oo", "throw") ## Importing Class:es importFrom("R.oo", "Object") importFrom("R.oo", "Package") ## Importing generics importFrom("R.oo", "attachLocally") importFrom("R.oo", "check") importFrom("R.oo", "compile") importFrom("R.oo", "equals") importFrom("R.oo", "getEnvironment") importFrom("R.oo", "getMessage") importFrom("R.oo", "isVisible") ## Importing functions importFrom("R.oo", "charToInt") importFrom("R.oo", "clone") importFrom("R.oo", "detach") ## Multi-sources: R.oo, base importFrom("R.oo", "Exception") importFrom("R.oo", "getFields") importFrom("R.oo", "intToChar") importFrom("R.oo", "save") ## Multi-sources: R.oo, base importFrom("R.oo", "startupMessage") importFrom("R.oo", "trim") ## More functions importFrom("graphics", "lines") importFrom("graphics", "mtext") importFrom("graphics", "par") importFrom("graphics", "plot") importFrom("graphics", "strwidth") importFrom("graphics", "strheight") importFrom("grDevices", "dev.off") importFrom("grDevices", "jpeg") importFrom("grDevices", "png") importFrom("methods", "as") importFrom("methods", "show") importFrom("stats", "update") importFrom("stats", "na.omit") ## importFrom("tools", "compactPDF") ## importFrom("tools", "file_ext") ## importFrom("tools", "Rd2txt") ## importFrom("tools", "Rd2HTML") ## importFrom("tools", "Rd2latex") importFrom("utils", "available.packages") importFrom("utils", "capture.output") importFrom("utils", "compareVersion") importFrom("utils", "contrib.url") importFrom("utils", "download.file") importFrom("utils", "file_test") importFrom("utils", "flush.console") importFrom("utils", "head") importFrom("utils", "help") importFrom("utils", "install.packages") importFrom("utils", "object.size") importFrom("utils", "packageDescription") importFrom("utils", "packageVersion") importFrom("utils", "read.table") importFrom("utils", "str") importFrom("utils", "type.convert") importFrom("utils", "URLdecode") importFrom("utils", "write.table") # Manual fixes importFrom("R.oo", "load") ## Multi-sources: R.oo, base # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # EXPORTS # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Export all public methods, that is, those without a preceeding dot # in their names. exportPattern("^[^\\.]") # .Last.lib needs to be exported in order to be used. export(.Last.lib) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # DECLARE # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # From 006.fixVarArgs.R S3method("isOpen", "default") S3method("parse", "default") S3method("cat", "default") S3method("getOption", "default") # From Verbose.R S3method("warnings", "default") # Arguments S3method("getCharacter", "Arguments") S3method("getCharacters", "Arguments") S3method("getDirectory", "Arguments") S3method("getDouble", "Arguments") S3method("getDoubles", "Arguments") S3method("getEnvironment", "Arguments") S3method("getFilename", "Arguments") S3method("getIndex", "Arguments") S3method("getIndices", "Arguments") S3method("getInstanceOf", "Arguments") S3method("getInteger", "Arguments") S3method("getIntegers", "Arguments") S3method("getLogical", "Arguments") S3method("getLogicals", "Arguments") S3method("getNumeric", "Arguments") S3method("getNumerics", "Arguments") S3method("getReadablePath", "Arguments") S3method("getReadablePathname", "Arguments") S3method("getReadablePathnames", "Arguments") S3method("getRegularExpression", "Arguments") S3method("getVector", "Arguments") S3method("getVerbose", "Arguments") S3method("getWritablePath", "Arguments") S3method("getWritablePathname", "Arguments") # array S3method("extract", "array") S3method("unwrap", "array") S3method("wrap", "array") # Assert S3method("check", "Assert") S3method("inheritsFrom", "Assert") S3method("isMatrix", "Assert") S3method("isScalar", "Assert") S3method("isVector", "Assert") # binmode S3method("format", "binmode") S3method("as.character", "binmode") # CapturedEvaluation S3method("print", "CapturedEvaluation") # character S3method("downloadFile", "character") S3method("isOpen", "character") S3method("toAsciiRegExprPattern", "character") S3method("toFileListTree", "character") # CmdArgsFunction S3method("print", "CmdArgsFunction") # connection S3method("isEof", "connection") # data.frame S3method("attachLocally", "data.frame") S3method("unwrap", "data.frame") S3method("wrap", "data.frame") S3method("writeDataFrame", "data.frame") # default S3method("addFinalizerToLast", "default") S3method("bunzip2", "default") S3method("bzip2", "default") S3method("callHooks", "default") S3method("capitalize", "default") S3method("cat", "default") S3method("colClasses", "default") S3method("copyDirectory", "default") S3method("copyFile", "default") S3method("compressFile", "default") S3method("compressPDF", "default") S3method("countLines", "default") S3method("createFileAtomically", "default") S3method("createLink", "default") S3method("createWindowsShortcut", "default") S3method("dataFrame", "default") S3method("decapitalize", "default") S3method("decompressFile", "default") S3method("detachPackage", "default") S3method("dimNA<-", "default") S3method("displayCode", "default") S3method("doCall", "default") S3method("extract", "default") S3method("fileAccess", "default") S3method("filePath", "default") S3method("finalizeSession", "default") S3method("findFiles", "default") S3method("findSourceTraceback", "default") S3method("gcat", "default") S3method("getAbsolutePath", "default") S3method("getOption", "default") S3method("getParent", "default") S3method("getRelativePath", "default") S3method("gstring", "default") S3method("gunzip", "default") S3method("gzip", "default") S3method("hasUrlProtocol", "default") S3method("hpaste", "default") S3method("insert", "default") S3method("installPackages", "default") S3method("isAbsolutePath", "default") S3method("isBzipped", "default") S3method("isCompressedFile", "default") S3method("isDirectory", "default") S3method("isFile", "default") S3method("isGzipped", "default") S3method("isOpen", "default") S3method("isPackageInstalled", "default") S3method("isPackageLoaded", "default") S3method("isUrl", "default") ## S3method("xz", "default") ## S3method("unxz", "default") ## S3method("isXzipped", "default") S3method("isZero", "default") S3method("lastModified", "default") S3method("listDirectory", "default") S3method("loadObject", "default") S3method("loadToEnv", "default") S3method("mkdirs", "default") S3method("moveInSearchPath", "default") S3method("onGarbageCollect", "default") S3method("onSessionExit", "default") S3method("parse", "default") S3method("patchCode", "default") S3method("popBackupFile", "default") S3method("popTemporaryFile", "default") S3method("printf", "default") S3method("pushBackupFile", "default") S3method("pushTemporaryFile", "default") S3method("readBinFragments", "default") S3method("readRdHelp", "default") S3method("readTable", "default") S3method("readTableIndex", "default") S3method("readWindowsShellLink", "default") S3method("readWindowsShortcut", "default") S3method("reassignInPackage", "default") S3method("removeDirectory", "default") S3method("renameFile", "default") S3method("resample", "default") S3method("saveObject", "default") S3method("seqToHumanReadable", "default") S3method("seqToIntervals", "default") S3method("setOption", "default") S3method("sourceDirectory", "default") S3method("sourceTo", "default") S3method("splitByPattern", "default") S3method("stext", "default") S3method("subplots", "default") S3method("systemR", "default") S3method("timestamp", "default") S3method("toCamelCase", "default") S3method("touchFile", "default") S3method("toUrl", "default") S3method("unwrap", "default") S3method("use", "default") S3method("writeBinFragments", "default") # density S3method("draw", "density") S3method("swapXY", "density") # environment S3method("attachLocally", "environment") # FileListTree S3method("cat", "FileListTree") S3method("pasteTree", "FileListTree") # FileProgressBar S3method("cleanup", "FileProgressBar") S3method("update", "FileProgressBar") # function S3method("callHooks", "function") # GenericSummary S3method("[", "GenericSummary") S3method("c", "GenericSummary") S3method("print", "GenericSummary") # GString S3method("as.character", "GString") S3method("evaluate", "GString") S3method("gcat", "GString") S3method("getBuiltinDate", "GString") S3method("getBuiltinDatetime", "GString") S3method("getBuiltinHostname", "GString") S3method("getBuiltinOs", "GString") S3method("getBuiltinPid", "GString") S3method("getBuiltinRhome", "GString") S3method("getBuiltinRversion", "GString") S3method("getBuiltinTime", "GString") S3method("getBuiltinUsername", "GString") S3method("getRaw", "GString") S3method("getVariableValue", "GString") S3method("gstring", "GString") S3method("parse", "GString") S3method("print", "GString") # Java S3method("asByte", "Java") S3method("asInt", "Java") S3method("asLong", "Java") S3method("asShort", "Java") S3method("readByte", "Java") S3method("readInt", "Java") S3method("readShort", "Java") S3method("readUTF", "Java") S3method("writeByte", "Java") S3method("writeInt", "Java") S3method("writeShort", "Java") S3method("writeUTF", "Java") # list S3method("attachLocally", "list") S3method("callHooks", "list") # logical S3method("whichVector", "logical") # matrix S3method("extract", "matrix") S3method("intervalsToSeq", "matrix") S3method("unwrap", "matrix") S3method("whichVector", "matrix") S3method("wrap", "matrix") # MultiVerbose S3method("as.list", "MultiVerbose") S3method("writeRaw", "MultiVerbose") # NullVerbose S3method("cat", "NullVerbose") S3method("enter", "NullVerbose") S3method("evaluate", "NullVerbose") S3method("exit", "NullVerbose") S3method("header", "NullVerbose") S3method("isOn", "NullVerbose") S3method("isVisible", "NullVerbose") S3method("newline", "NullVerbose") S3method("print", "NullVerbose") S3method("printf", "NullVerbose") S3method("ruler", "NullVerbose") S3method("str", "NullVerbose") S3method("summary", "NullVerbose") S3method("writeRaw", "NullVerbose") # numeric S3method("hsize", "numeric") S3method("hsize", "object_size") S3method("inAnyInterval", "numeric") S3method("mapToIntervals", "numeric") S3method("mergeIntervals", "numeric") # Options S3method("as.character", "Options") S3method("as.list", "Options") S3method("equals", "Options") S3method("getLeaves", "Options") S3method("getOption", "Options") S3method("hasOption", "Options") S3method("names", "Options") S3method("nbrOfOptions", "Options") S3method("setOption", "Options") S3method("str", "Options") # ProgressBar S3method("as.character", "ProgressBar") S3method("getBarString", "ProgressBar") S3method("increase", "ProgressBar") S3method("isDone", "ProgressBar") S3method("reset", "ProgressBar") S3method("setMaxValue", "ProgressBar") S3method("setProgress", "ProgressBar") S3method("setStepLength", "ProgressBar") S3method("setTicks", "ProgressBar") S3method("setValue", "ProgressBar") S3method("update", "ProgressBar") # Settings S3method("findSettings", "Settings") S3method("getLoadedPathname", "Settings") S3method("isModified", "Settings") S3method("loadAnywhere", "Settings") S3method("promptAndSave", "Settings") S3method("saveAnywhere", "Settings") # SmartComments S3method("compile", "SmartComments") S3method("convertComment", "SmartComments") S3method("parse", "SmartComments") S3method("reset", "SmartComments") S3method("validate", "SmartComments") # System S3method("currentTimeMillis", "System") S3method("findGhostscript", "System") S3method("findGraphicsDevice", "System") S3method("getHostname", "System") S3method("getMappedDrivesOnWindows", "System") S3method("getUsername", "System") S3method("mapDriveOnWindows", "System") S3method("openBrowser", "System") S3method("parseDebian", "System") S3method("unmapDriveOnWindows", "System") # TextStatusBar S3method("flush", "TextStatusBar") S3method("getLabel", "TextStatusBar") S3method("newline", "TextStatusBar") S3method("popMessage", "TextStatusBar") S3method("setLabel", "TextStatusBar") S3method("setLabels", "TextStatusBar") S3method("update", "TextStatusBar") S3method("updateLabels", "TextStatusBar") # TimeoutException S3method("getMessage", "TimeoutException") # VComments S3method("convertComment", "VComments") S3method("reset", "VComments") S3method("validate", "VComments") # Verbose S3method("as.character", "Verbose") S3method("as.double", "Verbose") S3method("as.logical", "Verbose") S3method("capture", "Verbose") S3method("cat", "Verbose") S3method("enter", "Verbose") S3method("enterf", "Verbose") S3method("equals", "Verbose") S3method("evaluate", "Verbose") S3method("exit", "Verbose") S3method("getThreshold", "Verbose") S3method("getTimestampFormat", "Verbose") S3method("header", "Verbose") S3method("isOn", "Verbose") S3method("isVisible", "Verbose") S3method("less", "Verbose") S3method("more", "Verbose") S3method("newline", "Verbose") S3method("off", "Verbose") S3method("on", "Verbose") S3method("popState", "Verbose") S3method("print", "Verbose") S3method("printf", "Verbose") S3method("pushState", "Verbose") S3method("ruler", "Verbose") S3method("setDefaultLevel", "Verbose") S3method("setThreshold", "Verbose") S3method("setTimestampFormat", "Verbose") S3method("str", "Verbose") S3method("summary", "Verbose") S3method("timestamp", "Verbose") S3method("timestampOff", "Verbose") S3method("timestampOn", "Verbose") S3method("printWarnings", "Verbose") S3method("warnings", "Verbose") S3method("writeRaw", "Verbose") R.utils/man/0000755000176200001440000000000014525572637012405 5ustar liggesusersR.utils/man/file.info2.Rd0000644000176200001440000000221514525573057014624 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Sys.readlink2.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{file.info2} \alias{file.info2} \title{Extract File Information (acknowledging symbolic file links also on Windows)} \description{ Extract File Information (acknowledging symbolic file links also on Windows). } \usage{ file.info2(...) } \arguments{ \item{...}{A \code{\link[base]{character}} \code{\link[base]{vector}}s containing file paths. Tilde expansion is done: see \code{\link[base]{path.expand}}().} } \value{ A \code{\link[base]{data.frame}}. See \code{\link[base]{file.info}}() for details. } \seealso{ Internally, \code{\link[base]{file.info}}() is used, which does not respect symbolic links on Windows. Instead, on Windows, \code{\link{Sys.readlink2}}() is used for such link to identify the target file and retrieve the file information on that instead. } \author{Henrik Bengtsson} \keyword{file} \keyword{IO} \keyword{internal} R.utils/man/hasOption.Options.Rd0000644000176200001440000000206614525573056016272 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Options.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{hasOption.Options} \alias{hasOption.Options} \alias{Options.hasOption} \alias{hasOption,Options-method} \title{Checks if an option exists} \description{ Checks if an option exists. } \usage{ \method{hasOption}{Options}(this, pathname, ...) } \arguments{ \item{pathname}{A single or a \code{\link[base]{vector}} of \code{\link[base]{character}} strings specifying the paths to the options to be queried.} \item{...}{Not used.} } \value{Returns a \code{\link[base]{logical}} (\code{\link[base]{vector}}).} \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:getOption.Options]{*getOption}()}. \code{\link[R.utils:setOption.Options]{*setOption}()}. For more information see \code{\link{Options}}. } \keyword{internal} \keyword{methods} \keyword{programming} R.utils/man/update.TextStatusBar.Rd0000644000176200001440000000143114525573057016726 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % TextStatusBar.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{update.TextStatusBar} \alias{update.TextStatusBar} \alias{TextStatusBar.update} \alias{update,TextStatusBar-method} \title{Updates the status bar (visually)} \description{ Updates the status bar (visually). } \usage{ \method{update}{TextStatusBar}(object, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns nothing. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{TextStatusBar}}. } \keyword{internal} \keyword{methods} \keyword{programming} R.utils/man/isScalar.Assert.Rd0000644000176200001440000000174314525573055015675 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Assert.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Assert$isScalar} \alias{Assert$isScalar} \alias{isScalar.Assert} \alias{Assert.isScalar} \alias{isScalar,Assert-method} \title{Static method asserting that an object is a single value} \description{ Static method asserting that an object is a single value. } \usage{ ## Static method (use this): ## Assert$isScalar(x, ...) ## Don't use the below: \method{isScalar}{Assert}(static, x, ...) } \arguments{ \item{x}{Object to be checked.} \item{...}{Not used.} } \value{ Returns (invisibly) \code{\link[base:logical]{TRUE}}, or throws an exception. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Assert}}. } \keyword{internal} \keyword{methods} R.utils/man/isVisible.NullVerbose.Rd0000644000176200001440000000156314525573056017065 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % NullVerbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{isVisible.NullVerbose} \alias{isVisible.NullVerbose} \alias{NullVerbose.isVisible} \alias{isVisible,NullVerbose-method} \title{Checks if a certain verbose level will be shown or not} \description{ Checks if a certain verbose level will be shown or not. } \usage{ \method{isVisible}{NullVerbose}(this, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns always \code{\link[base:logical]{FALSE}}. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{NullVerbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} R.utils/man/findSettings.Settings.Rd0000644000176200001440000000252314525573056017132 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Settings.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Settings$findSettings} \alias{Settings$findSettings} \alias{findSettings.Settings} \alias{Settings.findSettings} \alias{findSettings,Settings-method} \title{Searches for the settings file in one or several directories} \description{ Searches for the settings file in one or several directories. } \usage{ ## Static method (use this): ## Settings$findSettings(basename, paths=c(".", "~"), ...) ## Don't use the below: \method{findSettings}{Settings}(static, basename, paths=c(".", "~"), ...) } \arguments{ \item{basename}{A \code{\link[base]{character}} string of the basename of the settings file.} \item{paths}{A \code{\link[base]{vector}} of \code{\link[base]{character}} string specifying the directories to be searched.} \item{...}{Not used.} } \value{ Returns the absolute pathname (\code{\link[base]{character}} string) of the first settings file found, otherwise \code{\link[base]{NULL}}. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Settings}}. } \keyword{internal} \keyword{methods} \keyword{programming} R.utils/man/callHooks.Rd0000644000176200001440000000450014525573060014601 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % callHooks.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{callHooks} \alias{callHooks.default} \alias{callHooks} \title{Call hook functions by hook name} \description{ Call hook functions by hook name. } \usage{ \method{callHooks}{default}(hookName, ..., removeCalledHooks=FALSE) } \arguments{ \item{hookName}{A \code{\link[base]{character}} string of the hook name.} \item{...}{Argument passed to each hook function.} \item{removeCalledHooks}{If \code{\link[base:logical]{TRUE}}, called hook functions are removed, otherwise not.} } \value{ Returns (invisibly) whatever \code{\link{callHooks.list}}() returns. } \examples{ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Example 1 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # First, clean up if called more than once setHook("myFunction.onEnter", NULL, action="replace") setHook("myFunction.onExit", NULL, action="replace") runConference <- function(...) { callHooks("myFunction.onEnter") cat("Speaker A: Hello there...\n") callHooks("myFunction.onExit") } setHook("myFunction.onEnter", function(...) { cat("Chair: Welcome to our conference.\n") }) setHook("myFunction.onEnter", function(...) { cat("Chair: Please welcome Speaker A!\n") }) setHook("myFunction.onExit", function(...) { cat("Chair: Please thanks Speaker A!\n") }) runConference() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Example 2 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - setHook("randomNumber", NULL, action="replace") setHook("randomNumber", rnorm) # By function setHook("randomNumber", "rexp") # By name setHook("randomNumber", "runiff") # Non-existing name setHook("randomNumber", .GlobalEnv) # Not a function res <- callHooks("randomNumber", n=1) str(res) cat("Number of hooks: ", length(res), "\n") isErroneous <- unlist(lapply(res, FUN=function(x) !is.null(x$exception))) cat("Erroneous hooks: ", sum(isErroneous), "\n") } \author{Henrik Bengtsson} \seealso{ Internally, after retrieving hook functions, \code{\link{callHooks.list}}() is called. } \keyword{programming} R.utils/man/writeUTF.Java.Rd0000644000176200001440000000203714525573055015262 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Java.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Java$writeUTF} \alias{Java$writeUTF} \alias{writeUTF.Java} \alias{Java.writeUTF} \alias{writeUTF,Java-method} \title{Writes a string to a connection in Java format (UTF-8)} \description{ Writes a string to a connection in Java format (UTF-8) so it will be readable by Java. At the beginning of each UTF-8 sequence there is a short integer telling how many bytes (characters?) follows. } \usage{ ## Static method (use this): ## Java$writeUTF(con, str, ...) ## Don't use the below: \method{writeUTF}{Java}(static, con, str, ...) } \arguments{ \item{con}{Binary connection to be written to.} \item{str}{String to be written.} } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Java}}. } \keyword{internal} \keyword{methods} R.utils/man/isZero.Rd0000644000176200001440000000433214525573061014141 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % isZero.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{isZero} \alias{isZero.default} \alias{isZero} \title{Checks if a value is (close to) zero or not} \usage{ \method{isZero}{default}(x, neps=1, eps=.Machine$double.eps, ...) } \description{ Checks if a value (or a vector of values) is (close to) zero or not where "close" means if the absolute value is less than \code{neps*eps}. \emph{Note that \code{x == 0} will not work in all cases.} By default \code{eps} is the smallest possible floating point value that can be represented by the running machine, i.e. \code{.Machine$double.eps} and \code{neps} is one. By changing \code{neps} it is easy to adjust how close to zero "close" means without having to know the machine precision (or remembering how to get it). } \arguments{ \item{x}{A \code{\link[base]{vector}} of values.} \item{eps}{The smallest possible floating point.} \item{neps}{A scale factor of \code{eps} specifying how close to zero "close" means. If \code{eps} is the smallest value such that \code{1 + eps != 1}, i.e. \code{.Machine$double.eps}, \code{neps} must be greater or equal to one.} \item{...}{Not used.} } \value{Returns a \code{\link[base]{logical}} \code{\link[base]{vector}} indicating if the elements are zero or not.} \author{Henrik Bengtsson} \seealso{ \code{\link[base]{all.equal}}(). \code{\link[base]{Comparison}}. \code{\link[base:zMachine]{.Machine}}. } \examples{ x <- 0 print(x == 0) # TRUE print(isZero(x)) # TRUE x <- 1 print(x == 0) # FALSE print(isZero(x)) # FALSE x <- .Machine$double.eps print(x == 0) # FALSE print(isZero(x)) # FALSE x <- 0.9*.Machine$double.eps print(x == 0) # FALSE print(isZero(x)) # TRUE # From help(Comparisions) x1 <- 0.5 - 0.3 x2 <- 0.3 - 0.1 print(x1 - x2) print(x1 == x2) # FALSE on most machines print(identical(all.equal(x1, x2), TRUE)) # TRUE everywhere print(isZero(x1-x2)) # TRUE everywhere } \keyword{logic} R.utils/man/readShort.Java.Rd0000644000176200001440000000222314525573055015501 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Java.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Java$readShort} \alias{Java$readShort} \alias{readShort.Java} \alias{Java.readShort} \alias{readShort,Java-method} \title{Reads a Java formatted short (16 bits) from a connection} \description{ Reads one or several Java formatted short's (16 bits) from a connection. All data types in Java are signed, i.e. a byte can hold a value in the range [-32768,32767]. } \usage{ ## Static method (use this): ## Java$readShort(con, n=1, ...) ## Don't use the below: \method{readShort}{Java}(static, con, n=1, ...) } \arguments{ \item{con}{Binary connection to be read from.} \item{n}{Number of short's to be read.} \item{...}{Not used.} } \value{ Returns an \code{\link[base]{integer}} \code{\link[base]{vector}}. } \author{Henrik Bengtsson} \seealso{ \code{\link[base]{readBin}}(). For more information see \code{\link{Java}}. } \keyword{internal} \keyword{methods} R.utils/man/printWarnings.Verbose.Rd0000644000176200001440000000235414525573060017140 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{printWarnings.Verbose} \alias{printWarnings.Verbose} \alias{Verbose.printWarnings} \alias{printWarnings,Verbose-method} \title{Outputs any warnings recorded} \description{ Outputs any warnings recorded. The output is indented according to \code{\link[R.utils:enter.Verbose]{*enter}()}/\code{\link[R.utils:exit.Verbose]{*exit}()} calls. } \usage{ \method{printWarnings}{Verbose}(this, title="Warnings detected:", ..., level=this$defaultLevel) } \arguments{ \item{title}{A \code{\link[base]{character}} string to be outputted before the warnings, if they exists.} \item{...}{Arguments passed to \code{\link[R.utils:cat.Verbose]{*cat}()}.} \item{level}{A \code{\link[base]{numeric}} value to be compared to the threshold.} } \value{ Returns nothing. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Verbose}}. } \alias{printWarnings} \alias{warnings.Verbose} \keyword{internal} \keyword{methods} \keyword{programming} R.utils/man/setValue.ProgressBar.Rd0000644000176200001440000000202614525573056016710 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % ProgressBar.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{setValue.ProgressBar} \alias{setValue.ProgressBar} \alias{ProgressBar.setValue} \alias{setValue,ProgressBar-method} \title{Sets current value} \description{ Sets current value. Note that this method does \emph{not} update the bar visually. } \usage{ \method{setValue}{ProgressBar}(this, value, ...) } \arguments{ \item{value}{A \code{\link[base]{numeric}} in [0,maxValue].} \item{...}{Not used.} } \value{ Returns old value. } \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:setProgress.ProgressBar]{*setProgress}()}. \code{\link[R.utils:increase.ProgressBar]{*increase}()}. \code{\link[R.utils:reset.ProgressBar]{*reset}()}. For more information see \code{\link{ProgressBar}}. } \keyword{internal} \keyword{methods} R.utils/man/getLogicals.Arguments.Rd0000644000176200001440000000270114525573054017067 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Arguments.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Arguments$getLogicals} \alias{Arguments$getLogicals} \alias{getLogicals.Arguments} \alias{Arguments.getLogicals} \alias{getLogicals,Arguments-method} \alias{Arguments.getLogical} \alias{getLogical.Arguments} \alias{getLogical,Arguments-method} \title{Coerces to a logical vector and validates} \description{ Coerces to a logical vector and validates. } \usage{ ## Static method (use this): ## Arguments$getLogicals(x, ..., disallow=c("NA", "NaN"), coerce=FALSE, .name=NULL) ## Don't use the below: \method{getLogicals}{Arguments}(static, x, ..., disallow=c("NA", "NaN"), coerce=FALSE, .name=NULL) } \arguments{ \item{x}{A \code{\link[base]{vector}}.} \item{disallow}{A \code{\link[base]{character}} \code{\link[base]{vector}} specifying disallowed value sets after coercing, i.e. \code{"NA"}.} \item{...}{Arguments passed to @method "getVector".} \item{.name}{A \code{\link[base]{character}} string for name used in error messages.} } \value{ Returns a \code{\link[base]{numeric}} \code{\link[base]{vector}}. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Arguments}}. } \keyword{internal} \keyword{methods} \keyword{IO} R.utils/man/cmdArgs.Rd0000644000176200001440000000510114525573060014240 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % cmdArgs.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{cmdArgs} \alias{cmdArgs} \alias{cmdArg} \title{Simple access to parsed command-line arguments} \description{ Simple access to parsed command-line arguments. } \usage{ cmdArgs(args=NULL, names=NULL, unique=TRUE, ..., .args=NULL) cmdArg(...) } \arguments{ \item{args}{A named \code{\link[base]{list}} of arguments.} \item{names}{A \code{\link[base]{character}} \code{\link[base]{vector}} specifying the arguments to be returned. If \code{\link[base]{NULL}}, all arguments are returned.} \item{unique}{If \code{\link[base:logical]{TRUE}}, only unique arguments are returned.} \item{...}{ For \code{cmdArgs()}, additional arguments passed to \code{\link{commandArgs}}(), e.g. \code{defaults} and \code{always}. For \code{cmdArg()}, named arguments \code{name} and \code{default}, where \code{name} must be a \code{\link[base]{character}} string and \code{default} is an optional default value (if not given, it's \code{\link[base]{NULL}}). Alternatively, \code{name} and \code{default} can be given as a named argument (e.g. \code{n=42}).} \item{.args}{(advanced/internal) A named \code{\link[base]{list}} of parsed command-line arguments.} } \value{ \code{cmdArgs()} returns a named \code{\link[base]{list}} with command-line arguments. \code{cmdArg()} return the value of the requested command-line argument. } \section{Coercing to non-character data types}{ The value of each command-line argument is returned as a \code{\link[base]{character}} string, unless an argument share name with ditto in the (optional) arguments \code{always} and \code{default} in case the retrieved value is coerced to that of the latter. Finally, remaining character string command-line arguments are coerced to \code{\link[base]{numeric}}s (via \code{\link[base]{as.numeric}}()), if possible, that is unless the coerced value becomes \code{\link[base]{NA}}. } \author{Henrik Bengtsson} \examples{ args <- cmdArgs() cat("User command-line arguments used when invoking R:\n") str(args) # Retrieve command line argument 'n', e.g. '-n 13' or '--n=13' n <- cmdArg("n", 42L) printf("Argument n=\%d\n", n) # Short version doing the same n <- cmdArg(n=42L) printf("Argument n=\%d\n", n) } \seealso{ Internally, \code{\link{commandArgs}}() is used. } \keyword{programming} R.utils/man/Sys.readlink2.Rd0000644000176200001440000000213414525573057015321 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Sys.readlink2.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Sys.readlink2} \alias{Sys.readlink2} \title{Read File Symbolic Links (also on Windows)} \description{ Read File Symbolic Links (also on Windows) and returns the target of each link. This implementation is fully compatible with the \code{\link[base]{Sys.readlink}}() implementation in the \pkg{base} package. } \usage{ Sys.readlink2(paths, what=c("asis", "corrected")) } \arguments{ \item{paths}{A \code{\link[base]{character}} \code{\link[base]{vector}} of file paths. Tilde expansion is done: see \code{\link[base]{path.expand}}().} \item{what}{A \code{\link[base]{character}} string specifying what to return.} } \value{ A \code{\link[base]{character}} \code{\link[base]{vector}} of the the same length as \code{paths}. } \author{Henrik Bengtsson} \keyword{file} \keyword{IO} \keyword{internal} R.utils/man/getLoadedPathname.Settings.Rd0000644000176200001440000000172114525573056020036 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Settings.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{getLoadedPathname.Settings} \alias{getLoadedPathname.Settings} \alias{Settings.getLoadedPathname} \alias{getLoadedPathname,Settings-method} \title{Gets the pathname of the settings file loaded} \description{ Gets the pathname of the settings file loaded. } \usage{ \method{getLoadedPathname}{Settings}(this, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns the absolute pathname (\code{\link[base]{character}} string) of the settings file loaded. If no file was read, \code{\link[base]{NULL}} is returned. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Settings}}. } \keyword{internal} \keyword{methods} \keyword{programming} R.utils/man/eget.Rd0000644000176200001440000000500714525573060013611 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % eget.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{eget} \alias{eget} \alias{ecget} \title{Gets a variable by name} \description{ Gets a variable by name. If non-existing, the default value is returned. } \usage{ eget(..., coerce=TRUE, envir=parent.frame(), inherits=FALSE, mode="default", cmdArg=FALSE) } \arguments{ \item{...}{Named arguments \code{name} and \code{default}, where \code{name} must be a \code{\link[base]{character}} string and \code{default} is an optional default value (if not given, it's \code{\link[base]{NULL}}). Alternatively, \code{name} and \code{default} can be given as a named argument (e.g. \code{n=42}).} \item{coerce}{If \code{\link[base:logical]{TRUE}}, the returned value is coerced to the class of the default value (unless \code{\link[base]{NULL}}) using \code{\link[methods]{as}}.} \item{envir}{A \code{\link[base]{environment}} or a named \code{\link[base]{list}} where to look for the variable. Only if \code{envir} is an \code{\link[base]{environment}}.} \item{inherits}{A \code{\link[base]{logical}} specifying whether the enclosing frames of the environment should be searched or not.} \item{mode}{A \code{\link[base]{character}} string specifying the mode of the object to retrieve. Only if \code{envir} is an \code{\link[base]{environment}}.} \item{cmdArg}{If \code{\link[base:logical]{TRUE}}, the corresponding command-line argument is used as the default value.} } \value{ Returns an object. } \details{ \code{ecget(...)} is short for \code{eget(..., cmdArg=TRUE)}. } \examples{ # Get variable 'a' if it exists, otherwise return the default value. value <- eget("a", default=42L) print(value) # 42L # Short version doing the same value <- eget(a=42L) print(value) # 42L # Same, but look for the variable in 'envir' (here a list) value <- eget("a", default=42L, envir=list(a=1)) print(value) # 1L # Get variable 'n', which defaults to command-line argument # 'n' ('-n' or '--n'), which in turn defaults to 42L. value <- eget(n=cmdArg(n=42L)) print(value) # Equivalently. value <- ecget(n=42L) print(value) } \author{Henrik Bengtsson} \seealso{ To retrieve command-line arguments, see \code{\link[R.utils]{cmdArg}}. See also \code{\link[base]{mget}}(). } \keyword{file} \keyword{IO} \keyword{internal} R.utils/man/SmartComments.Rd0000644000176200001440000000437314525573057015474 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % SmartComments.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{SmartComments} \docType{class} \alias{SmartComments} \title{Abstract class SmartComments} \description{ Package: R.utils \cr \bold{Class SmartComments}\cr \code{\link[R.oo]{Object}}\cr \code{~~|}\cr \code{~~+--}\emph{\code{SmartComments}}\cr \bold{Directly known subclasses:}\cr \link[R.utils]{LComments}, \link[R.utils]{VComments}\cr public abstract static class \bold{SmartComments}\cr extends \link[R.oo]{Object}\cr Abstract class SmartComments. } \usage{ SmartComments(letter=NA, ...) } \arguments{ \item{letter}{A single \code{\link[base]{character}}.} \item{...}{Not used.} } \section{Fields and Methods}{ \bold{Methods:}\cr \tabular{rll}{ \tab \code{compile} \tab -\cr \tab \code{convertComment} \tab -\cr \tab \code{parse} \tab -\cr \tab \code{reset} \tab -\cr \tab \code{validate} \tab -\cr } \bold{Methods inherited from Object}:\cr $, $<-, [[, [[<-, as.character, attach, attachLocally, clearCache, clearLookupCache, clone, detach, equals, extend, finalize, getEnvironment, getFieldModifier, getFieldModifiers, getFields, getInstantiationTime, getStaticInstance, hasField, hashCode, ll, load, names, objectSize, print, save } \details{ A "smart" source-code comment is an \R comment, which start with a '#', but is followed by a single letter, then a single symbol and a second '#' and then an option character string, and there must not be any code before the comment on the same line. In summary, a smart comment line has format: \code{## }. Example code with two smart comments (VComments): \preformatted{ x <- 2 #V1# threshold=-1 #Vc# A v-comment log message cat("Hello world") } which after compilation becomes \preformatted{ x <- 2 verbose <- Verbose(threshold=-1) if (verbose) { cat(verbose, "A v-comment log message"); } cat("Hello world") } } \author{Henrik Bengtsson} \seealso{ \code{\link{VComments}}. } \keyword{classes} \keyword{programming} \keyword{IO} R.utils/man/Arguments.Rd0000644000176200001440000000376414525573054014645 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Arguments.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Arguments} \docType{class} \alias{Arguments} \title{Static class to validate and process arguments} \description{ Package: R.utils \cr \bold{Class Arguments}\cr \code{\link[R.oo]{Object}}\cr \code{~~|}\cr \code{~~+--}\code{Arguments}\cr \bold{Directly known subclasses:}\cr \cr public static class \bold{Arguments}\cr extends \link[R.oo]{Object}\cr } \section{Fields and Methods}{ \bold{Methods:}\cr \tabular{rll}{ \tab \code{getCharacter} \tab -\cr \tab \code{getCharacters} \tab -\cr \tab \code{getDirectory} \tab -\cr \tab \code{getDouble} \tab -\cr \tab \code{getDoubles} \tab -\cr \tab \code{getEnvironment} \tab -\cr \tab \code{getFilename} \tab -\cr \tab \code{getIndex} \tab -\cr \tab \code{getIndices} \tab -\cr \tab \code{getInstanceOf} \tab -\cr \tab \code{getInteger} \tab -\cr \tab \code{getIntegers} \tab -\cr \tab \code{getLogical} \tab -\cr \tab \code{getLogicals} \tab -\cr \tab \code{getNumeric} \tab -\cr \tab \code{getNumerics} \tab -\cr \tab \code{getReadablePath} \tab -\cr \tab \code{getReadablePathname} \tab -\cr \tab \code{getReadablePathnames} \tab -\cr \tab \code{getRegularExpression} \tab -\cr \tab \code{getVector} \tab -\cr \tab \code{getVerbose} \tab -\cr \tab \code{getWritablePath} \tab -\cr \tab \code{getWritablePathname} \tab -\cr } \bold{Methods inherited from Object}:\cr $, $<-, [[, [[<-, as.character, attach, attachLocally, clearCache, clearLookupCache, clone, detach, equals, extend, finalize, getEnvironment, getFieldModifier, getFieldModifiers, getFields, getInstantiationTime, getStaticInstance, hasField, hashCode, ll, load, names, objectSize, print, save } \author{Henrik Bengtsson} \keyword{classes} \keyword{programming} R.utils/man/on.Verbose.Rd0000644000176200001440000000147514525573060014712 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{on.Verbose} \alias{on.Verbose} \alias{Verbose.on} \alias{on,Verbose-method} \title{Turn on the output} \description{ Turn on the output. } \usage{ \method{on}{Verbose}(this, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns (invisibly) \code{\link[base:logical]{TRUE}}. } \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:off.Verbose]{*off}()} and \code{\link[R.utils:isOn.Verbose]{*isOn}()}. For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} R.utils/man/popMessage.TextStatusBar.Rd0000644000176200001440000000172614525573057017556 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % TextStatusBar.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{popMessage.TextStatusBar} \alias{popMessage.TextStatusBar} \alias{TextStatusBar.popMessage} \alias{popMessage,TextStatusBar-method} \title{Adds a message above the status bar} \description{ Adds a message above the status bar by scrolling up previous messages popped. } \usage{ \method{popMessage}{TextStatusBar}(this, ..., collapse="", sep="") } \arguments{ \item{...}{Arguments passed to \code{\link[base]{cat}}().} \item{collapse, sep}{Default values to \code{\link[base]{cat}}().} } \value{ Returns nothing. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{TextStatusBar}}. } \keyword{internal} \keyword{methods} \keyword{programming} R.utils/man/popTemporaryFile.Rd0000644000176200001440000000345114525573061016170 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % popTemporaryFile.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{popTemporaryFile} \alias{popTemporaryFile.default} \alias{popTemporaryFile} \title{Drops a temporary suffix from the temporary pathname} \usage{ \method{popTemporaryFile}{default}(filename, path=NULL, suffix=".tmp", isFile=TRUE, ..., verbose=FALSE) } \description{ Drops a temporary suffix from the temporary pathname and, by default, renames an existing temporary file accordingly. } \arguments{ \item{filename}{The filename of the temporary file.} \item{path}{The path of the temporary file.} \item{suffix}{The suffix of the temporary filename to be dropped.} \item{isFile}{If \code{\link[base:logical]{TRUE}}, the temporary file must exist and will be renamed. If \code{\link[base:logical]{FALSE}}, it is only the pathname string that will be modified. For details, see below.} \item{...}{Not used.} \item{verbose}{A \code{\link[base]{logical}} or \code{\link{Verbose}}.} } \value{ Returns the pathname with the temporary suffix dropped. } \details{ If \code{isFile} is \code{\link[base:logical]{FALSE}}, the pathname where the suffix of the temporary pathname has been dropped is returned. If \code{isFile} is \code{\link[base:logical]{TRUE}}, the temporary file is renamed. Then, if the temporary file does not exists or it was not successfully renamed, an exception is thrown. } \author{Henrik Bengtsson} \seealso{ See \code{\link{pushTemporaryFile}}() for more details and an example. } \keyword{utilities} \keyword{programming} \keyword{IO} R.utils/man/installPackages.Rd0000644000176200001440000000335714525573061016001 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % installPackages.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{installPackages} \alias{installPackages.default} \alias{installPackages} \title{Install R packages by name or URL} \description{ Install R packages by name or URL. } \usage{ \method{installPackages}{default}(pkgs, types="auto", repos=getOption("repos"), ..., destPath=".", cleanup=TRUE) } \arguments{ \item{pkgs}{A \code{\link[base]{character}} \code{\link[base]{vector}} specifying the names and/or the URLs of the R packages to be installed.} \item{types}{A \code{\link[base]{character}} \code{\link[base]{vector}} of corresponding package types.} \item{repos}{A \code{\link[base]{character}} \code{\link[base]{vector}} of package repository URLs.} \item{...}{Additional arguments passed to \code{\link[utils]{install.packages}}.} \item{destPath}{Path where any downloaded files are saved.} \item{cleanup}{If \code{\link[base:logical]{TRUE}}, downloaded and successfully installed package files are removed, otherwise not.} } \value{ Returns nothing. } \section{Limitations}{ This method cannot install any packages that are already in use. Certain packages are always in use when calling this method, e.g. \pkg{R.methodsS3}, \pkg{R.oo}, and \pkg{R.utils}. } \examples{\dontrun{ installPackages("R.rsp") installPackages("https://cran.r-project.org/src/contrib/Archive/R.rsp/R.rsp_0.8.2.tar.gz") installPackages("https://cran.r-project.org/bin/windows/contrib/4.0/R.rsp_0.44.0.zip") }} \author{Henrik Bengtsson} \keyword{file} R.utils/man/isPackageLoaded.Rd0000644000176200001440000000214214525573061015663 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % isPackageLoaded.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{isPackageLoaded} \alias{isPackageLoaded.default} \alias{isPackageLoaded} \title{Checks if a package is loaded or not} \description{ Checks if a package is loaded or not. Note that, contrary to \code{\link[base:library]{require}()}, this function does not load the package if not loaded. } \usage{ \method{isPackageLoaded}{default}(package, version=NULL, ...) } \arguments{ \item{package}{The name of the package.} \item{version}{A \code{\link[base]{character}} string specifying the version to test for. If \code{\link[base]{NULL}}, any version is tested for.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{logical}}. } \author{Henrik Bengtsson} \seealso{ To check if a package is installed or not, see \code{\link{isPackageInstalled}}(). } \keyword{utilities} \keyword{package} R.utils/man/getOption.Options.Rd0000644000176200001440000000307514525573056016277 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Options.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{getOption.Options} \alias{getOption.Options} \alias{Options.getOption} \alias{getOption,Options-method} \title{Gets an option} \description{ Gets an option in the options tree structure or return a default value. } \usage{ \method{getOption}{Options}(this, pathname=NULL, defaultValue=NULL, ...) } \arguments{ \item{pathname}{A single or a \code{\link[base]{vector}} of \code{\link[base]{character}} strings specifying the paths to the options to be queried. By default the complete options structure is returned.} \item{defaultValue}{The default value to be returned, if option is missing. If multiple options are queried at the same times, multiple default values may be specified as a \code{\link[base]{vector}} or a \code{\link[base]{list}}.} \item{...}{Not used.} } \value{If a single option is queried, a single value is returned. If a \code{\link[base]{vector}} of options are queried, a \code{\link[base]{list}} of values are returned. For non-existing options, the default value is returned.} \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:hasOption.Options]{*hasOption}()}. \code{\link[R.utils:setOption.Options]{*setOption}()}. For more information see \code{\link{Options}}. } \keyword{internal} \keyword{methods} \keyword{programming} R.utils/man/less.Verbose.Rd0000644000176200001440000000163414525573060015241 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{less.Verbose} \alias{less.Verbose} \alias{Verbose.less} \alias{less,Verbose-method} \title{Creates a cloned instance with a higher threshold} \description{ Creates a cloned instance with a higher threshold. } \usage{ \method{less}{Verbose}(this, dThreshold=1, ...) } \arguments{ \item{dThreshold}{The amount the threshold should be raised.} \item{...}{Not used.} } \value{ Returns a cloned \code{\link{Verbose}} object. } \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:more.Verbose]{*more}()} For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} R.utils/man/newline.TextStatusBar.Rd0000644000176200001440000000137214525573057017111 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % TextStatusBar.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{newline.TextStatusBar} \alias{newline.TextStatusBar} \alias{TextStatusBar.newline} \alias{newline,TextStatusBar-method} \title{Writes a newline} \description{ Writes a newline. } \usage{ \method{newline}{TextStatusBar}(this, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns nothing. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{TextStatusBar}}. } \keyword{internal} \keyword{methods} \keyword{programming} R.utils/man/R.utils-package.Rd0000644000176200001440000001023114525573054015614 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % 999.package.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{R.utils-package} \alias{R.utils-package} \alias{R.utils} \docType{package} \title{Package R.utils} \description{ Utility functions useful when programming and developing R packages. \emph{Warning}: The Application Programming Interface (API) of the classes and methods in this package may change. Classes and methods are considered either to be stable, or to be in beta or alpha (pre-beta) stage. See list below for details. The main reason for publishing this package on CRAN although it lacks a stable API, is that its methods and classes are used internally by other packages on CRAN that the author has published. For package history, see \code{showHistory(R.utils)}. } \section{Requirements}{ This package requires the \pkg{R.oo} package [1]. } \section{Installation and updates}{ To install this package do:\cr \code{install.packages("R.utils")} } \section{To get started}{ \describe{ \item{\link{Arguments}}{[alpha] Methods for common argument processing.} \item{\link{Assert}}{[alpha] Methods for assertion of values and states.} \item{\link{GString}}{[alpha] A character string class with methods for simple substitution.} \item{\link{Java}}{[beta] Reads and writes Java streams.} \item{\link{Options}}{[alpha] Tree-structured options queried in a file-system like manner.} \item{\link{Settings}}{[alpha] An Options class for reading and writing package settings.} \item{\link{ProgressBar}}{[beta] Text-based progress bar.} \item{\link{FileProgressBar}}{[beta] A ProgressBar that reports progress as file size.} \item{\link{System}}{[alpha] Methods for access to system.} \item{\link{Verbose}}{[alpha] A class for verbose and log output. Utilized by the VComments and LComments classes.} \item{\link{SmartComments}, \link{VComments}, \link{LComments}}{[alpha] Methods for preprocessing source code comments of certain formats into R code.} } In addition to the above, there is a large set of function for file handling such as support for reading/following Windows Shortcut links, but also other standalone utility functions. See package index for a list of these. These should also be considered to be in alpha or beta stage. } \section{How to cite this package}{ Whenever using this package, please cite [1] as \preformatted{ Bengtsson, H. The R.oo package - Object-Oriented Programming with References Using Standard R Code, Proceedings of the 3rd International Workshop on Distributed Statistical Computing (DSC 2003), ISSN 1609-395X, Hornik, K.; Leisch, F. & Zeileis, A. (ed.), 2003 } } \section{Wishlist}{ Here is a list of features that would be useful, but which I have too little time to add myself. Contributions are appreciated. \itemize{ \item Write a TclTkProgressBar class. \item Improve/stabilize the GString class. \item Mature the SmartComments classes. Also add AComments and PComments for assertion and progress/status comments. } If you consider implement some of the above, make sure it is not already implemented by downloading the latest "devel" version! } \author{Henrik Bengtsson} \section{License}{ The releases of this package is licensed under LGPL version 2.1 or newer. The development code of the packages is under a private licence (where applicable) and patches sent to the author fall under the latter license, but will be, if incorporated, released under the "release" license above. } \section{References}{ [1] H. Bengtsson, \emph{The R.oo package - Object-Oriented Programming with References Using Standard R Code}, In Kurt Hornik, Friedrich Leisch and Achim Zeileis, editors, Proceedings of the 3rd International Workshop on Distributed Statistical Computing (DSC 2003), March 20-22, Vienna, Austria. \url{https://www.r-project.org/conferences/DSC-2003/Proceedings/} \cr } \keyword{package} R.utils/man/pushState.Verbose.Rd0000644000176200001440000000235114525573060016250 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{pushState.Verbose} \alias{pushState.Verbose} \alias{Verbose.pushState} \alias{pushState,Verbose-method} \alias{Verbose.popState} \alias{popState.Verbose} \alias{popState,Verbose-method} \title{Pushes the current indentation state of the Verbose object} \description{ Pushes the current indentation state of the Verbose object, which is controlled by \code{\link[R.utils:enter.Verbose]{*enter}()} and \code{\link[R.utils:exit.Verbose]{*exit}()}. By pushing the state when entering a function and using \code{\link[base]{on.exit}}() to pop the state, the correct state will set regardless of if the functions returned naturally or via an error. } \usage{ \method{pushState}{Verbose}(this, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns (invisibly) \code{\link[base:logical]{TRUE}}. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} R.utils/man/dataFrame.Rd0000644000176200001440000000224314525573060014550 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % dataFrame.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{dataFrame} \alias{dataFrame.default} \alias{dataFrame} \title{Allocates a data frame with given column classes} \usage{ \method{dataFrame}{default}(colClasses, nrow=1, ...) } \description{ Allocates a data frame with given column classes. } \arguments{ \item{colClasses}{A \code{\link[base]{character}} \code{\link[base]{vector}} of column classes, cf. \code{\link[utils]{read.table}}.} \item{nrow}{An \code{\link[base]{integer}} specifying the number of rows of the allocated data frame.} \item{...}{Not used.} } \value{ Returns an NxK \code{\link[base]{data.frame}} where N equals \code{nrow} and K equals \code{length(colClasses)}. } \examples{ df <- dataFrame(colClasses=c(a="integer", b="double"), nrow=10) df[,1] <- sample(1:nrow(df)) df[,2] <- rnorm(nrow(df)) print(df) } \seealso{ \code{\link[base]{data.frame}}. } \keyword{manip} \keyword{utilities} R.utils/man/withRepos.Rd0000644000176200001440000000375114525573061014656 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % withRepos.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{withRepos} \alias{withRepos} \title{Evaluate an R expression with repositories set temporarily} \description{ Evaluate an R expression with repositories set temporarily. } \usage{ withRepos(expr, repos="[[mainstream]]", ..., substitute=TRUE, envir=parent.frame()) } \arguments{ \item{expr}{The R expression to be evaluated.} \item{repos}{A \code{\link[base]{character}} \code{\link[base]{vector}} of repositories to use.} \item{...}{Additional arguments passed to \code{\link{useRepos}}().} \item{substitute}{If \code{\link[base:logical]{TRUE}}, argument \code{expr} is \code{\link[base]{substitute}()}:ed, otherwise not.} \item{envir}{The \code{\link[base]{environment}} in which the expression should be evaluated.} } \value{ Returns the results of the expression evaluated. } \author{Henrik Bengtsson} \examples{\dontrun{ # Install from BioC related repositories only withRepos(install.packages("edgeR"), repos="[[BioC]]") # Install from CRAN or BioC related repositories only withRepos(install.packages("edgeR"), repos=c("CRAN", "[[BioC]]")) # Install from mainstream repositories only (same as previous) withRepos(install.packages("edgeR"), repos="[[mainstream]]") # Install from R-Forge and mainstream repositories only withRepos(install.packages("R.utils"), repos="[[R-Forge]]") # Update only CRAN packages withRepos(update.packages(ask=FALSE), repos="[[CRAN]]") # Update only Bioconductor packages withRepos(update.packages(ask=FALSE), repos="[[BioC]]") }} \seealso{ Internally, \code{\link[base]{eval}}() is used to evaluate the expression. See also \code{\link[base]{options}}() and \code{\link[utils]{install.packages}}. } \keyword{IO} \keyword{programming} R.utils/man/capture.Verbose.Rd0000644000176200001440000000170614525573060015736 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{capture.Verbose} \alias{capture.Verbose} \alias{Verbose.capture} \alias{capture,Verbose-method} \title{Captures output of a function} \description{ Captures output of a function. Evaluates its arguments with the output being verbosed. } \usage{ \method{capture}{Verbose}(this, ..., level=this$defaultLevel) } \arguments{ \item{...}{Arguments to be captured.} \item{level}{A \code{\link[base]{numeric}} value to be compared to the threshold.} } \value{ Returns a \code{\link[base]{vector}} of \code{\link[base]{character}} string. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} R.utils/man/setMaxValue.ProgressBar.Rd0000644000176200001440000000143314525573056017357 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % ProgressBar.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{setMaxValue.ProgressBar} \alias{setMaxValue.ProgressBar} \alias{ProgressBar.setMaxValue} \alias{setMaxValue,ProgressBar-method} \title{Sets maximum value} \description{ Sets maximum value. } \usage{ \method{setMaxValue}{ProgressBar}(this, maxValue, ...) } \arguments{ \item{maxValue}{New maximum value.} \item{...}{Not used.} } \value{ Returns nothing. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{ProgressBar}}. } \keyword{internal} \keyword{methods} R.utils/man/getBuiltinRversion.GString.Rd0000644000176200001440000000164614525573055020110 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % GString-class.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{GString$getBuiltinRversion} \alias{GString$getBuiltinRversion} \alias{getBuiltinRversion.GString} \alias{GString.getBuiltinRversion} \alias{getBuiltinRversion,GString-method} \title{Gets the current R version} \description{ Gets the current R version. } \usage{ ## Static method (use this): ## GString$getBuiltinRversion(...) ## Don't use the below: \method{getBuiltinRversion}{GString}(static, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}} string. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{GString}}. } \keyword{internal} \keyword{methods} R.utils/man/isAbsolutePath.Rd0000644000176200001440000000152714525573061015620 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % isAbsolutePath.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{isAbsolutePath} \alias{isAbsolutePath.default} \alias{isAbsolutePath} \title{Checks if this pathname is absolute} \description{ Checks if this pathname is absolute. } \usage{ \method{isAbsolutePath}{default}(pathname, ...) } \arguments{ \item{pathname}{A \code{\link[base]{character}} string of the pathname to be checked.} \item{...}{Not used.} } \value{ Returns a \code{\link[base:logical]{TRUE}} if the pathname is absolute, otherwise \code{\link[base:logical]{FALSE}}. } \author{Henrik Bengtsson} \keyword{IO} \keyword{programming} R.utils/man/parse.SmartComments.Rd0000644000176200001440000000240614525573057016600 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % SmartComments.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{parse.SmartComments} \alias{parse.SmartComments} \alias{SmartComments.parse} \alias{parse,SmartComments-method} \title{Parses one single smart comment} \description{ Parses one single smart comment. } \usage{ \method{parse}{SmartComments}(this, lines, currLine, ..., letter=this$letter, pattern=NULL) } \arguments{ \item{lines}{A \code{\link[base]{character}} \code{\link[base]{vector}} of lines of code containing smart comments (only).} \item{currLine}{The line number on which to smart smart comment begins.} \item{...}{Not used.} \item{letter}{The letter of the smart comment. Available to avoid lookup at every line.} \item{pattern}{The pattern of the smart comment.} } \value{ Returns a \code{\link[base]{list}} structure. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{SmartComments}}. } \keyword{internal} \keyword{methods} \keyword{programming} R.utils/man/isEof.connection.Rd0000644000176200001440000000214214525573061016066 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % isEof.connection.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{isEof.connection} \alias{isEof.connection} \title{Checks if the current file position for a connection is at the 'End of File'} \description{ Checks if the current file position for a connection is at the 'End of File'. } \usage{ \method{isEof}{connection}(con, ...) } \arguments{ \item{con}{A \code{\link[base:connections]{connection}}.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{logical}}. } \details{ Internally \code{\link[base]{seek}}() is used, which according to to the \R help is discouraged on Windows. However, after many years of large-scale testing on various Windows versions and file systems we have yet to experience issues with using \code{seek()} on Windows. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{connection}}. } \keyword{methods} R.utils/man/sourceTo.Rd0000644000176200001440000001074214525573061014473 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % sourceTo.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{sourceTo} \alias{sourceTo.default} \alias{sourceTo} \title{Parses and evaluates code from a file or a connection} \usage{ \method{sourceTo}{default}(file, path=NULL, chdir=FALSE, ..., local=TRUE, envir=parent.frame(), modifiedOnly=FALSE) } \description{ Parses and evaluates code from a file or a connection. This has the same effect as if \code{source(..., local=TRUE)} would have been called from within the given environment. This is useful when setting up a new local working environment. } \arguments{ \item{file}{A \code{\link[base:connections]{connection}} or a \code{\link[base]{character}} string giving the pathname of the file or URL to read from.} \item{path}{An optional \code{\link[base]{character}} string giving the path to the file. Ignored if \code{file} is a connection.} \item{chdir}{If \code{\link[base:logical]{TRUE}} and \code{file} is a pathname, the \R working directory is temporarily changed to the directory containing \code{file} for evaluating.} \item{...}{Arguments to \code{\link[base]{source}}(). If argument \code{file} is not explicitly given, the first argument is assumed to be the \code{file} argument. This argument is converted into a string by \code{as.character()}. } \item{local}{If \code{\link[base:logical]{FALSE}}, evaluation is done in the global environment, otherwise in the calling environment.} \item{envir}{An \code{\link[base]{environment}} in which \code{\link[base]{source}}() should be called. If \code{\link[base]{NULL}}, the global environment is used.} \item{modifiedOnly}{If \code{\link[base:logical]{TRUE}}, the file is sourced only if modified since the last time it was sourced, otherwise regardless.} } \value{ Return the result of \code{\link[base]{source}}(). } \section{Hooks}{ This methods recognizes the hook \code{sourceTo/onPreprocess}, which is called after the lines in file has been read, but before they have been parsed by the \R parser, cf. \code{\link[base]{parse}}(). An \code{onPreprocess} hook function should take a \code{\link[base]{character}} \code{\link[base]{vector}} of code lines and return a \code{\link[base]{character}} \code{\link[base]{vector}} of code lines. This can for instance be used to pre-process R source code with special directives such as \code{\link{VComments}}. Note that only one hook function can be used for this function, otherwise an error is generated. } \examples{ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Example 1 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - cat("=== Example 1 ================================================\n") foo <- function(file, ...) { cat("Local objects before calling sourceTo():\n") print(ls()) res <- sourceTo(file, ...) cat("Local objects after calling sourceTo():\n") print(ls()) } cat("Global objects before calling foo():\n") lsBefore <- NA lsBefore <- ls() foo(file=textConnection(c('a <- 1', 'b <- 2'))) cat("Global objects after calling foo():\n") stopifnot(length(setdiff(ls(), lsBefore)) == 0) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Example 2 - with VComments preprocessor # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - cat("=== Example 2 ================================================\n") preprocessor <- function(lines, ...) { cat("-----------------------------------------\n") cat("Source code before preprocessing:\n") displayCode(code=lines, pager="console") cat("-----------------------------------------\n") cat("Source code after preprocessing:\n") lines <- VComments$compile(lines) displayCode(code=lines, pager="console") cat("-----------------------------------------\n") lines } oldHooks <- getHook("sourceTo/onPreprocess") setHook("sourceTo/onPreprocess", preprocessor, action="replace") code <- c( 'x <- 2', '#V1# threshold=-1', '#Vc# A v-comment log message', 'print("Hello world")' ) fh <- textConnection(code) sourceTo(fh) setHook("sourceTo/onPreprocess", oldHooks, action="replace") } \author{Henrik Bengtsson} \seealso{ \code{\link{sourceDirectory}}(). \code{\link[base]{sys.source}}() and \code{\link[base]{source}}(). } \keyword{programming} \keyword{IO} R.utils/man/readRdHelp.Rd0000644000176200001440000000207214525573061014677 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % readRdHelp.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{readRdHelp} \alias{readRdHelp.default} \alias{readRdHelp} \title{Reads one or more Rd help files in a certain format} \description{ Reads one or more Rd help files in a certain format. } \usage{ \method{readRdHelp}{default}(..., format=c("text", "html", "latex", "rd"), drop=TRUE) } \arguments{ \item{...}{Arguments passed to \code{\link[utils]{help}}.} \item{format}{A \code{\link[base]{character}} string specifying the return type.} \item{drop}{If \code{\link[base:logical]{FALSE}} or more than one help entry is found, the result is returned as a \code{\link[base]{list}}.} } \value{ Returns a \code{\link[base]{list}} of \code{\link[base]{character}} strings or a single \code{\link[base]{character}} string. } \author{Henrik Bengtsson} \keyword{programming} R.utils/man/as.list.Options.Rd0000644000176200001440000000143514525573056015702 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Options.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{as.list.Options} \alias{as.list.Options} \alias{Options.as.list} \alias{as.list,Options-method} \title{Gets a list representation of the options} \description{ Gets a list representation of the options. } \usage{ \method{as.list}{Options}(x, ...) } \arguments{ \item{...}{Not used.} } \value{Returns a tree \code{\link[base]{list}} structure.} \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Options}}. } \keyword{internal} \keyword{methods} \keyword{programming} R.utils/man/getBuiltinHostname.GString.Rd0000644000176200001440000000170414525573055020052 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % GString-class.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{GString$getBuiltinHostname} \alias{GString$getBuiltinHostname} \alias{getBuiltinHostname.GString} \alias{GString.getBuiltinHostname} \alias{getBuiltinHostname,GString-method} \title{Gets the hostname of the system running R} \description{ Gets the hostname of the system running R. } \usage{ ## Static method (use this): ## GString$getBuiltinHostname(...) ## Don't use the below: \method{getBuiltinHostname}{GString}(static, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}} string. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{GString}}. } \keyword{internal} \keyword{methods} R.utils/man/asInt.Java.Rd0000644000176200001440000000163614525573055014633 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Java.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Java$asInt} \alias{Java$asInt} \alias{asInt.Java} \alias{Java.asInt} \alias{asInt,Java-method} \title{Converts an numeric to a Java integer} \description{ Converts an numeric to a Java integer. } \usage{ ## Static method (use this): ## Java$asInt(x, ...) ## Don't use the below: \method{asInt}{Java}(static, x, ...) } \arguments{ \item{x}{A \code{\link[base]{numeric}} \code{\link[base]{vector}}.} \item{...}{Not used.} } \value{ Returns an \code{\link[base]{integer}} \code{\link[base]{vector}}. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Java}}. } \keyword{internal} \keyword{methods} R.utils/man/popBackupFile.Rd0000644000176200001440000000330114525573061015405 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % popBackupFile.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{popBackupFile} \alias{popBackupFile.default} \alias{popBackupFile} \title{Drops a backup suffix from the backup pathname} \usage{ \method{popBackupFile}{default}(filename, path=NULL, suffix=".bak", isFile=TRUE, onMissing=c("ignore", "error"), drop=TRUE, ..., verbose=FALSE) } \description{ Drops a backup suffix from the backup pathname and, by default, restores an existing backup file accordingly by renaming it. } \arguments{ \item{filename}{The filename of the backup file.} \item{path}{The path of the file.} \item{suffix}{The suffix of the filename to be dropped.} \item{isFile}{If \code{\link[base:logical]{TRUE}}, the backup file must exist and will be renamed. If \code{\link[base:logical]{FALSE}}, it is only the pathname string that will be modified. For details, see below.} \item{onMissing}{A \code{\link[base]{character}} string specifying what to do if the backup file does not exist.} \item{drop}{If \code{\link[base:logical]{TRUE}}, the backup file will be dropped in case the original file already exists or was successfully restored.} \item{...}{Not used.} \item{verbose}{A \code{\link[base]{logical}} or \code{\link{Verbose}}.} } \value{ Returns the pathname with the backup suffix dropped. } \author{Henrik Bengtsson} \seealso{ See \code{\link{pushBackupFile}}() for more details and an example. } \keyword{utilities} \keyword{programming} \keyword{IO} R.utils/man/validate.VComments.Rd0000644000176200001440000000165614525573057016404 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % VComments.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{validate.VComments} \alias{validate.VComments} \alias{VComments.validate} \alias{validate,VComments-method} \title{Validates the compiled lines} \description{ Validates the compiled lines } \usage{ \method{validate}{VComments}(this, lines, ...) } \arguments{ \item{lines}{A \code{\link[base]{character}} \code{\link[base]{vector}} of lines of code to validated.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}} \code{\link[base]{vector}}. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{VComments}}. } \keyword{internal} \keyword{methods} \keyword{programming} R.utils/man/asShort.Java.Rd0000644000176200001440000000164614525573055015201 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Java.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Java$asShort} \alias{Java$asShort} \alias{asShort.Java} \alias{Java.asShort} \alias{asShort,Java-method} \title{Converts a numeric to a Java short} \description{ Converts a numeric to a Java short. } \usage{ ## Static method (use this): ## Java$asShort(x, ...) ## Don't use the below: \method{asShort}{Java}(static, x, ...) } \arguments{ \item{x}{A \code{\link[base]{numeric}} \code{\link[base]{vector}}.} \item{...}{Not used.} } \value{ Returns an \code{\link[base]{integer}} \code{\link[base]{vector}}. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Java}}. } \keyword{internal} \keyword{methods} R.utils/man/downloadFile.character.Rd0000644000176200001440000000465314525573060017235 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % downloadFile.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{downloadFile.character} \alias{downloadFile.character} \alias{downloadFile} \title{Downloads a file} \description{ Downloads a file. } \usage{ \method{downloadFile}{character}(url, filename=basename(url), path=NULL, skip=TRUE, overwrite=!skip, ..., username=NULL, password=NULL, binary=TRUE, dropEmpty=TRUE, verbose=FALSE) } \arguments{ \item{url}{A \code{\link[base]{character}} string specifying the URL to be downloaded.} \item{filename, path}{(optional) \code{\link[base]{character}} strings specifying the local filename and the path of the downloaded file.} \item{skip}{If \code{\link[base:logical]{TRUE}}, an already downloaded file is skipped.} \item{overwrite}{If \code{\link[base:logical]{TRUE}}, an already downloaded file is overwritten, otherwise an error is thrown.} \item{...}{Additional arguments passed to \code{\link[utils]{download.file}}.} \item{username, password}{\code{\link[base]{character}} strings specifying the username and password for authenticated downloads. The alternative is to specify these via the URL.} \item{binary}{If \code{\link[base:logical]{TRUE}}, the file is downloaded exactly "as is", that is, byte by byte (recommended).} \item{dropEmpty}{If \code{\link[base:logical]{TRUE}} and the downloaded file is empty, the file is ignored and \code{\link[base]{NULL}} is returned.} \item{verbose}{A \code{\link[base]{logical}}, \code{\link[base]{integer}}, or a \code{\link{Verbose}} object.} } \value{ Returns the local pathname to the downloaded filename, or \code{\link[base]{NULL}} if no file was downloaded. } \details{ Currently arguments \code{username} and \code{password} are only used for downloads via URL protocol 'https'. The 'https' protocol requires that either of 'curl' or 'wget' are available on the system. } \examples{\dontrun{ pathname <- downloadFile("https://www.r-project.org/index.html", path="www.r-project.org/") print(pathname) }} \author{Henrik Bengtsson} \seealso{ Internally \code{\link[utils]{download.file}} is used. That function may generate an empty file if the URL is not available. } \keyword{methods} \keyword{programming} \keyword{file} R.utils/man/evaluate.GString.Rd0000644000176200001440000000167614525573055016063 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % GString-class.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{evaluate.GString} \alias{evaluate.GString} \alias{GString.evaluate} \alias{evaluate,GString-method} \title{Parses and evaluates a GString} \description{ Parses and evaluates a GString. } \usage{ \method{evaluate}{GString}(object, envir=parent.frame(), ...) } \arguments{ \item{envir}{The \code{\link[base]{environment}} in which the \code{\link{GString}} is evaluated.} \item{...}{Additional arguments passed to \code{\link[R.utils:parse.GString]{*parse}()}.} } \value{ Returns a \code{\link[base]{character}} string. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{GString}}. } \keyword{internal} \keyword{methods} R.utils/man/doCall.Rd0000644000176200001440000000346214525573060014066 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % doCall.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{doCall} \alias{doCall.default} \alias{doCall} \title{Executes a function call with option to ignore unused arguments} \description{ Executes a function call with option to ignore unused arguments. } \usage{ \method{doCall}{default}(.fcn, ..., args=NULL, alwaysArgs=NULL, .functions=list(.fcn), .ignoreUnusedArgs=TRUE, envir=parent.frame()) } \arguments{ \item{.fcn}{A \code{\link[base]{function}} or a \code{\link[base]{character}} string specifying the name of a \code{\link[base]{function}} to be called.} \item{...}{Named arguments to be passed to the function.} \item{args}{A \code{\link[base]{list}} of additional named arguments that will be appended to the above arguments.} \item{alwaysArgs}{A \code{\link[base]{list}} of additional named arguments that will be appended to the above arguments and that will \emph{never} be ignore.} \item{.functions}{A \code{\link[base]{list}} of \code{\link[base]{function}}:s or names of functions. This can be used to control which arguments are passed.} \item{.ignoreUnusedArgs}{If \code{\link[base:logical]{TRUE}}, arguments that are not accepted by the function, will not be passed to it. Otherwise, all arguments are passed.} \item{envir}{An \code{\link[base]{environment}} in which to evaluate the call.} } \examples{ doCall("plot", x=1:10, y=sin(1:10), col="red", dummyArg=54, alwaysArgs=list(xlab="x", ylab="y"), .functions=c("plot", "plot.xy")) } \seealso{ \code{\link[base]{do.call}}(). } \author{Henrik Bengtsson} \keyword{programming} R.utils/man/getThreshold.Verbose.Rd0000644000176200001440000000163214525573060016725 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{getThreshold.Verbose} \alias{getThreshold.Verbose} \alias{Verbose.getThreshold} \alias{getThreshold,Verbose-method} \title{Gets current verbose threshold} \description{ Gets current verbose threshold. } \usage{ \method{getThreshold}{Verbose}(this, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns a \code{\link[base]{numeric}} value. } \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:setThreshold.Verbose]{*setThreshold}()} and \code{\link[R.utils:isVisible.Verbose]{*isVisible}()}. For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} R.utils/man/filePath.Rd0000644000176200001440000001022314525573060014415 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % filePath.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{filePath} \alias{filePath.default} \alias{filePath} \title{Construct the path to a file from components and expands Windows Shortcuts along the pathname from root to leaf} \usage{ \method{filePath}{default}(..., fsep=.Platform$file.sep, removeUps=TRUE, expandLinks=c("none", "any", "local", "relative", "network"), unmap=FALSE, mustExist=FALSE, verbose=FALSE) } \description{ Construct the path to a file from components and expands Windows Shortcuts along the pathname from root to leaf. This function is backward compatible with \code{\link[base]{file.path}}() when argument \code{removeUps=FALSE} and \code{expandLinks="none"}, except that a (character) \code{\link[base]{NA}} is return if any argument is NA. This function exists on all platforms, not only Windows systems. } \arguments{ \item{...}{Arguments to be pasted together to a file path and then be parsed from the root to the leaf where Windows shortcut files are recognized and expanded according to argument \code{which} in each step.} \item{fsep}{the path separator to use.} \item{removeUps}{If \code{\link[base:logical]{TRUE}}, relative paths, for instance "foo/bar/../" are shortened into "foo/", but also "./" are removed from the final pathname, if possible.} \item{expandLinks}{A \code{\link[base]{character}} string. If \code{"none"}, Windows Shortcut files are ignored. If \code{"local"}, the absolute target on the local file system is used. If \code{"relative"}, the relative target is used. If \code{"network"}, the network target is used. If \code{"any"}, first the local, then the relative and finally the network target is searched for.} \item{unmap}{If \code{\link[base:logical]{TRUE}}, paths on mapped Windows drives are "followed" and translated to their corresponding "true" paths.} \item{mustExist}{If \code{\link[base:logical]{TRUE}} and if the target does not exist, the original pathname, that is, argument \code{pathname} is returned. In all other cases the target is returned.} \item{verbose}{If \code{\link[base:logical]{TRUE}}, extra information is written while reading.} } \value{ Returns a \code{\link[base]{character}} string. } \details{ If \code{expandLinks != "none"}, each component, call it \emph{parent}, in the absolute path is processed from the left to the right as follows: 1. If a "real" directory of name \emph{parent} exists, it is followed. 2. Otherwise, if Microsoft Windows Shortcut file with name \emph{parent.lnk} exists, it is read. If its local target exists, that is followed, otherwise its network target is followed. 3. If no valid existing directory was found in (1) or (2), the expanded this far followed by the rest of the pathname is returned quietly. 4. If all of the absolute path was expanded successfully the expanded absolute path is returned. } \section{On speed}{ Internal \code{file.exists()} is call while expanding the pathname. This is used to check if there exists a Windows shortcut file named 'foo.lnk' in 'path/foo/bar'. If it does, 'foo.lnk' has to be followed, and in other cases 'foo' is ordinary directory. The \code{file.exists()} is unfortunately a bit slow, which is why this function appears slow if called many times. } \examples{ # Default print(file.path("foo", "bar", "..", "name")) # "foo/bar/../name" # Shorten pathname, if possible print(filePath("foo", "bar", "..", "name")) # "foo/name" print(filePath("foo/bar/../name")) # "foo/name" # Recognize Windows Shortcut files along the path, cf. Unix soft links filename <- system.file("data-ex/HISTORY.LNK", package="R.utils") print(filename) filename <- filePath(filename, expandLinks="relative") print(filename) } \author{Henrik Bengtsson} \seealso{ \code{\link{readWindowsShellLink}}(). \code{\link{readWindowsShortcut}}(). \code{\link[base]{file.path}}(). } \keyword{IO} R.utils/man/MultiVerbose.Rd0000644000176200001440000000614014525573056015311 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % MultiVerbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{MultiVerbose} \docType{class} \alias{MultiVerbose} \title{A Verbose class ignoring everything} \description{ Package: R.utils \cr \bold{Class MultiVerbose}\cr \code{\link[R.oo]{Object}}\cr \code{~~|}\cr \code{~~+--}\code{\link[R.utils]{Verbose}}\cr \code{~~~~~~~|}\cr \code{~~~~~~~+--}\code{MultiVerbose}\cr \bold{Directly known subclasses:}\cr \cr public static class \bold{MultiVerbose}\cr extends \link[R.utils]{Verbose}\cr A Verbose class ignoring everything. \emph{This is a trial class}. } \usage{ MultiVerbose(verboseList=NULL, ...) } \arguments{ \item{verboseList}{A \code{\link[base]{list}} of \code{\link{Verbose}} objects.} \item{...}{Ignored.} } \section{Fields and Methods}{ \bold{Methods:}\cr \tabular{rll}{ \tab \code{as.list} \tab -\cr \tab \code{writeRaw} \tab -\cr } \bold{Methods inherited from Verbose}:\cr as.character, as.double, as.logical, capture, cat, enter, enterf, equals, evaluate, exit, getThreshold, getTimestampFormat, header, isOn, isVisible, less, more, newline, off, on, popState, print, printWarnings, printf, pushState, ruler, setDefaultLevel, setThreshold, setTimestampFormat, str, summary, timestamp, timestampOff, timestampOn, writeRaw \bold{Methods inherited from Object}:\cr $, $<-, [[, [[<-, as.character, attach, attachLocally, clearCache, clearLookupCache, clone, detach, equals, extend, finalize, getEnvironment, getFieldModifier, getFieldModifiers, getFields, getInstantiationTime, getStaticInstance, hasField, hashCode, ll, load, names, objectSize, print, save } \examples{ # Output to both standard output and to log file stdoutLog <- Verbose(threshold=-1) fileLog <- Verbose(file.path(tempdir(), "foo.log"), threshold=-1) verbose <- MultiVerbose(list(stdoutLog, fileLog), threshold=-1) header(verbose, "A verbose writer example", padding=0) enter(verbose, "Analysis A") for (kk in 1:10) { printf(verbose, "step \%d\n", kk) if (kk == 2) { cat(verbose, "Turning ON automatic timestamps") timestampOn(verbose) } else if (kk == 4) { timestampOff(verbose) cat(verbose, "Turned OFF automatic timestamps") cat(verbose, "Turning OFF verbose messages for steps ", kk, "-6") off(verbose) } else if (kk == 6) { on(verbose) cat(verbose, "Turned ON verbose messages just before step ", kk+1) } if (kk \%in\% c(5,8)) { enter(verbose, "Sub analysis ", kk) for (jj in c("i", "ii", "iii")) { cat(verbose, "part ", jj) } exit(verbose) } } cat(verbose, "All steps completed!") exit(verbose) ruler(verbose) cat(verbose, "Demo of some other methods:") str(verbose, c(a=1, b=2, c=3)) print(verbose, c(a=1, b=2, c=3)) summary(verbose, c(a=1, b=2, c=3)) evaluate(verbose, rnorm, n=3, mean=2, sd=3) ruler(verbose) newline(verbose) } \author{Henrik Bengtsson} \keyword{classes} \keyword{programming} \keyword{IO} \keyword{internal} R.utils/man/withOptions.Rd0000644000176200001440000000351614525573061015220 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % withOptions.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{withOptions} \alias{withOptions} \title{Evaluate an R expression with options set temporarily} \description{ Evaluate an R expression with options set temporarily. } \usage{ withOptions(expr, ..., args=list(), substitute=TRUE, envir=parent.frame()) } \arguments{ \item{expr}{The R expression to be evaluated.} \item{...}{Named options to be used.} \item{args}{(optional) Additional named options specified as a named \code{\link[base]{list}}.} \item{substitute}{If \code{\link[base:logical]{TRUE}}, argument \code{expr} is \code{\link[base]{substitute}()}:ed, otherwise not.} \item{envir}{The \code{\link[base]{environment}} in which the expression should be evaluated.} } \value{ Returns the results of the expression evaluated. } \details{ Upon exit (also on errors), this function will reset \emph{all} options to the state of options available upon entry. This means any options \emph{modified} but also those \emph{added} when evaluating \code{expr} will also be undone upon exit. } \author{Henrik Bengtsson} \examples{ print(pi) # Same, i.e. using default withOptions({ print(pi) }) # Printing with two digits withOptions({ print(pi) }, digits=2) # Printing with two digits then with three more withOptions({ print(pi) withOptions({ print(pi) }, digits=getOption("digits")+3) }, digits=2) # Still printing with the default print(pi) } \seealso{ Internally, \code{\link[base]{eval}}() is used to evaluate the expression. and \code{\link[base]{options}}() to set options. } \keyword{IO} \keyword{programming} R.utils/man/setThreshold.Verbose.Rd0000644000176200001440000000176114525573060016744 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{setThreshold.Verbose} \alias{setThreshold.Verbose} \alias{Verbose.setThreshold} \alias{setThreshold,Verbose-method} \title{Sets verbose threshold} \description{ Sets verbose threshold. Output requests below this threshold will be ignored. } \usage{ \method{setThreshold}{Verbose}(this, threshold, ...) } \arguments{ \item{threshold}{A \code{\link[base]{numeric}} threshold.} \item{...}{Not used.} } \value{ Returns old threshold. } \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:getThreshold.Verbose]{*getThreshold}()} and \code{\link[R.utils:isVisible.Verbose]{*isVisible}()}. For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} R.utils/man/gcDLLs.Rd0000644000176200001440000000353014525573060013774 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % gcDLLs.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{gcDLLs} \alias{gcDLLs} \alias{strayDLLs} \title{Identifies and removes DLLs of packages already unloaded} \description{ Identifies and removes DLLs of packages already unloaded. When packages are unloaded, they are ideally also unloading any DLLs (also known as a dynamic shared object or library) they have loaded. Unfortunately, not all package do this resulting in "stray" DLLs still being loaded and occupying \R's limited registry. These functions identifies and removes such DLLs. } \usage{ gcDLLs(gc=TRUE, quiet=TRUE) } \arguments{ \item{gc}{If \code{\link[base:logical]{TRUE}}, if there are stray DLLs, then the garbage collector is run before unloading those DLLs. This is done in order to trigger any finalizers, of which some may need those DLLs, to be called.} \item{quiet}{If \code{\link[base:logical]{FALSE}}, a message is outputted for every stray DLL that is unloaded.} } \value{ Returns (invisibly) the set of stray DLLs identified. } \details{ If a library fails to unload, an informative warning is generated. } \section{How to unload DLLs in package (for package developers)}{ To unload a package DLL whenever the package in unloaded, add the following to your package: \preformatted{ .onUnload <- function(libpath) { ## (1) Force finalizers to be called before removing the DLL ## in case some of them need the DLL. gc() ## (2) Unload the DLL for this package library.dynam.unload(.packageName, libpath) } } } \author{Henrik Bengtsson} \seealso{ \code{\link[base]{getLoadedDLLs}}(). } R.utils/man/equals.Verbose.Rd0000644000176200001440000000157014525573060015564 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{equals.Verbose} \alias{equals.Verbose} \alias{Verbose.equals} \alias{equals,Verbose-method} \title{Checks if this object is equal to another} \description{ Checks if this object is equal to another. } \usage{ \method{equals}{Verbose}(this, other, ...) } \arguments{ \item{other}{Another Object.} \item{...}{Not used.} } \value{Returns \code{\link[base:logical]{TRUE}} if they are equal, otherwise \code{\link[base:logical]{FALSE}}.} \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} R.utils/man/getParent.Rd0000644000176200001440000000223214525573060014613 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % getParent.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{getParent} \alias{getParent.default} \alias{getParent} \title{Gets the string of the parent specified by this pathname} \description{ Gets the string of the parent specified by this pathname. This is basically, by default the string before the last path separator of the absolute pathname. } \usage{ \method{getParent}{default}(pathname, depth=1L, fsep=.Platform$file.sep, ...) } \arguments{ \item{pathname}{A \code{\link[base]{character}} string of the pathname to be checked.} \item{depth}{An \code{\link[base]{integer}} specifying how many generations up the path should go.} \item{fsep}{A \code{\link[base]{character}} string of the file separator.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}} string if the parent exists, otherwise \code{\link[base]{NULL}}. } \author{Henrik Bengtsson} \keyword{IO} \keyword{programming} R.utils/man/convertComment.SmartComments.Rd0000644000176200001440000000161514525573057020472 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % SmartComments.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{convertComment.SmartComments} \alias{convertComment.SmartComments} \alias{SmartComments.convertComment} \alias{convertComment,SmartComments-method} \title{Converts a single smart comment to R code} \description{ Converts a single smart comment to R code. } \usage{ \method{convertComment}{SmartComments}(...) } \arguments{ \item{...}{Not used.} } \value{ Should return single \code{\link[base]{character}} of valid \R code. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{SmartComments}}. } \keyword{internal} \keyword{methods} \keyword{programming} R.utils/man/print.GString.Rd0000644000176200001440000000145514525573055015404 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % GString-class.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{print.GString} \alias{print.GString} \alias{GString.print} \alias{print,GString-method} \title{Prints the processed GString} \description{ Prints the processed GString. } \usage{ \method{print}{GString}(x, ...) } \arguments{ \item{...}{Arguments passed to \code{\link[base]{print}}().} } \value{ Returns (invisibly) the process GString \code{\link[base]{character}} string. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{GString}}. } \keyword{internal} \keyword{methods} R.utils/man/000.Last.lib.Rd0000644000176200001440000000143314525573061014633 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % zzz.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{.Last.lib} \alias{.Last.lib} \alias{.Last.lib} \title{Undo changed done by this package when detached} \usage{ .Last.lib(libpath) } \description{ Undo changed done by this package when detached. Reverts \code{.Last()} to the function that existed before this package was attached. } \arguments{ \item{libpath}{a character string giving the complete path to the package.} } \value{ Returns nothing. } \author{Henrik Bengtsson} \keyword{utilities} \keyword{programming} \keyword{internal} R.utils/man/listDirectory.Rd0000644000176200001440000000356714525573061015537 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % listDirectory.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{listDirectory} \alias{listDirectory.default} \alias{listDirectory} \title{Gets the file names in the directory} \description{ Gets the file names in the directory. Contrary to \code{list.files()}, this method guarantees to work recursively. Moreover, when subdirectories are processed recursively, directory names are also returned. } \usage{ \method{listDirectory}{default}(path=".", pattern=NULL, recursive=FALSE, allNames=FALSE, fullNames=FALSE, ...) } \arguments{ \item{path}{A path to be listed.} \item{pattern}{A \code{\link[base]{character}} string of the filename pattern passed. See \code{\link[base]{list.files}}() for more details.} \item{recursive}{If \code{\link[base:logical]{TRUE}}, subdirectories are recursively processed, and not if \code{\link[base:logical]{FALSE}}. Alternatively, the maximum recursive depth can be specified as a non-negative \code{\link[base]{numeric}}, where \code{\link[base:logical]{FALSE}} corresponds to \code{0L} depth and \code{\link[base:logical]{TRUE}} corresponds \code{+Inf} depth.} \item{allNames}{If \code{\link[base:logical]{TRUE}}, also files starting with a period are returned.} \item{fullNames}{If \code{\link[base:logical]{TRUE}}, the full path names are returned.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{vector}} of file names. } \section{Recursive searching}{ Recursive searching of directory structure is done breath-first in a lexicographic order. } \author{Henrik Bengtsson} \seealso{ Internally \code{\link[base]{list.files}}() is used. } \keyword{IO} \keyword{programming} R.utils/man/moveInSearchPath.Rd0000644000176200001440000000305514525573061016067 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % moveInSearchPath.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{moveInSearchPath} \alias{moveInSearchPath.default} \alias{moveInSearchPath} \title{Moves a environment in the search path to another position} \description{ Moves a environment in the search path to another position. } \usage{ \method{moveInSearchPath}{default}(from, to, where=c("before", "after"), ...) } \arguments{ \item{from}{An \code{\link[base]{integer}} specifying the position of the environment to be moved, or a \code{\link[base]{character}} specifying the name of the environment to be moved.} \item{to}{The destination position like the \code{from} argument.} \item{where}{A \code{\link[base]{character}} string specify where in relation to the destination position the environment should be moved.} \item{...}{Not used.} } \value{ Returns (invisibly) the name of the environment moved, if it was moved, otherwise \code{\link[base]{NULL}}. } \details{ It is not possible to move the first environment in the search path, i.e. the so called global environment. } \examples{ # Make package 'utils' come behind 'datasets' in the search path moveInSearchPath("package:utils", "package:datasets", where="after") } \author{Henrik Bengtsson} \seealso{ \code{\link[base]{search}}(). } \keyword{programming} \keyword{internal} R.utils/man/asByte.Java.Rd0000644000176200001440000000163514525573055015003 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Java.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Java$asByte} \alias{Java$asByte} \alias{asByte.Java} \alias{Java.asByte} \alias{asByte,Java-method} \title{Converts a numeric to a Java byte} \description{ Converts a numeric to a Java byte. } \usage{ ## Static method (use this): ## Java$asByte(x, ...) ## Don't use the below: \method{asByte}{Java}(static, x, ...) } \arguments{ \item{x}{A \code{\link[base]{numeric}} \code{\link[base]{vector}}.} \item{...}{Not used.} } \value{ Returns an \code{\link[base]{integer}} \code{\link[base]{vector}}. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Java}}. } \keyword{internal} \keyword{methods} R.utils/man/compressPDF.Rd0000644000176200001440000000311614525573060015051 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % compressPDF.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{compressPDF} \alias{compressPDF.default} \alias{compressPDF} \title{Compresses a PDF (into a new PDF)} \description{ Compresses a PDF (into a new PDF). } \usage{ \method{compressPDF}{default}(filename, path=NULL, outFilename=basename(pathname), outPath="compressedPDFs", skip=FALSE, overwrite=FALSE, compression="gs(ebook)+qpdf", ...) } \arguments{ \item{filename, path}{The filename and (optional) path of the PDF to be compressed.} \item{outFilename, outPath}{The generated PDF.} \item{skip}{If \code{\link[base:logical]{TRUE}} and an existing output file, then it is returned.} \item{overwrite}{If \code{\link[base:logical]{FALSE}}, an error is thrown if the output file already exists, otherwise not.} \item{compression}{A \code{\link[base]{character}} \code{\link[base]{vector}} of compression methods to apply. This overrides any low-level arguments passed via \code{...} that \code{\link[tools]{compactPDF}}.} \item{...}{Additional arguments passed to \code{\link[tools]{compactPDF}}, e.g. \code{gs_quality}.} } \value{ Returns the pathname of the generated PDF. } \examples{\dontrun{ pathnameZ <- compressPDF("report.pdf") }} \author{Henrik Bengtsson} \seealso{ Internally \code{\link[tools]{compactPDF}} is utilized. } \keyword{file} \keyword{IO} R.utils/man/splitByPattern.Rd0000644000176200001440000000257114525573061015655 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % splitByPattern.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{splitByPattern} \alias{splitByPattern.default} \alias{splitByPattern} \title{Splits a single character string by pattern} \description{ Splits a single character string by pattern. The main difference compared to \code{\link[base]{strsplit}}() is that this method also returns the part of the string that matched the pattern. Also, it only takes a single character string. } \usage{ \method{splitByPattern}{default}(str, pattern, ...) } \arguments{ \item{str}{A single \code{\link[base]{character}} string to be split.} \item{pattern}{A regular expression \code{\link[base]{character}} string.} \item{...}{Not used.} } \value{ Returns a named \code{\link[base]{character}} \code{\link[base]{vector}} with names equal to \code{"TRUE"} if element is a pattern part and \code{"FALSE"} otherwise. } \examples{ rspCode <- "Hello <\%=\"world\"\%>" rspParts <- splitByPattern(rspCode, pattern="<\%.*\%>") cat(rspCode, "\n") print(rspParts) } \author{Henrik Bengtsson} \seealso{ Compare to \code{\link[base]{strsplit}}(). } \keyword{programming} R.utils/man/loadObject.Rd0000644000176200001440000000265314525573061014740 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % loadObject.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{loadObject} \alias{loadObject.default} \alias{loadObject} \title{Method to load object from a file or a connection} \description{ Method to load object from a file or a connection, which previously have been saved using \code{\link{saveObject}}(). } \usage{ \method{loadObject}{default}(file, path=NULL, format=c("auto", "xdr", "rds"), ...) } \arguments{ \item{file}{A filename or \code{\link[base:connections]{connection}} to read the object from.} \item{path}{The path where the file exists.} \item{format}{File format.} \item{...}{Not used.} } \value{ Returns the saved object. } \details{ The main difference from this method and \code{\link[base]{load}}() in the \pkg{base} package, is that this one returns the object read rather than storing it in the global environment by its default name. This makes it possible to load objects back using any variable name. } \author{Henrik Bengtsson} \seealso{ \code{\link{saveObject}}() to save an object to file. Internally \code{\link[base]{load}}() is used. See also \code{\link{loadToEnv}}(). See also \code{\link[base]{saveRDS}}(). } \keyword{programming} \keyword{IO} R.utils/man/wrap.array.Rd0000644000176200001440000001030614525573061014752 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % wrap.array.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{wrap.array} \alias{wrap.array} \alias{wrap.matrix} \alias{wrap.data.frame} \title{Reshape an array or a matrix by permuting and/or joining dimensions} \description{ Reshape an array or a matrix by permuting and/or joining dimensions. A useful application of this is to reshape a multidimensional \code{\link[base]{array}} to a \code{\link[base]{matrix}}, which then can be saved to file using for instance \code{write.table()}. } \usage{ \method{wrap}{array}(x, map=list(NA), sep=".", ...) } \arguments{ \item{x}{An \code{\link[base]{array}} or a \code{\link[base]{matrix}}.} \item{map}{A \code{\link[base]{list}} of length equal to the number of dimensions in the reshaped array. Each element should be an \code{\link[base]{integer}} \code{\link[base]{vector}}s specifying the dimensions to be joined in corresponding new dimension. One element may equal \code{\link[base]{NA}} to indicate that that dimension should be a join of all non-specified (remaining) dimensions. Default is to wrap everything into a \code{\link[base]{vector}}. } \item{sep}{A \code{\link[base]{character}} pasting joined dimension names.} \item{...}{Not used.} } \value{ Returns an \code{\link[base]{array}} of \code{length(map)} dimensions, where the first dimension is of size \code{prod(map[[1]])}, the second \code{prod(map[[2]])}, and so on. } \details{ If the indices in \code{unlist(map)} is in a non-increasing order, \link[base:aperm]{aperm()} will be called, which requires reshuffling of array elements in memory. In all other cases, the reshaping of the array does not require this, but only fast modifications of attributes \code{dim} and \code{dimnames}. } \examples{ # Create a 3x2x3 array dim <- c(3,2,3) ndim <- length(dim) dimnames <- list() for (kk in 1:ndim) dimnames[[kk]] <- sprintf("\%s\%d", letters[kk], 1:dim[kk]) x <- 1:prod(dim) x <- array(x, dim=dim, dimnames=dimnames) cat("Array 'x':\n") print(x) cat("\nReshape 'x' to its identity:\n") y <- wrap(x, map=list(1, 2, 3)) print(y) # Assert correctness of reshaping stopifnot(identical(y, x)) cat("\nReshape 'x' by swapping dimensions 2 and 3, i.e. aperm(x, perm=c(1,3,2)):\n") y <- wrap(x, map=list(1, 3, 2)) print(y) # Assert correctness of reshaping stopifnot(identical(y, aperm(x, perm=c(1,3,2)))) cat("\nWrap 'x' to a matrix 'y' by keeping dimension 1 and joining the others:\n") y <- wrap(x, map=list(1, NA)) print(y) # Assert correctness of reshaping for (aa in dimnames(x)[[1]]) { for (bb in dimnames(x)[[2]]) { for (cc in dimnames(x)[[3]]) { tt <- paste(bb, cc, sep=".") stopifnot(identical(y[aa,tt], x[aa,bb,cc])) } } } cat("\nUnwrap matrix 'y' back to array 'x':\n") z <- unwrap(y) print(z) stopifnot(identical(z,x)) cat("\nWrap a matrix 'y' to a vector and back again:\n") x <- matrix(1:8, nrow=2, dimnames=list(letters[1:2], 1:4)) y <- wrap(x) z <- unwrap(y) print(z) stopifnot(identical(z,x)) cat("\nWrap and unwrap a randomly sized and shaped array 'x2':\n") maxdim <- 5 dim <- sample(1:maxdim, size=sample(2:maxdim, size=1)) ndim <- length(dim) dimnames <- list() for (kk in 1:ndim) dimnames[[kk]] <- sprintf("\%s\%d", letters[kk], 1:dim[kk]) x2 <- 1:prod(dim) x2 <- array(x, dim=dim, dimnames=dimnames) cat("\nArray 'x2':\n") print(x) # Number of dimensions of wrapped array ndim2 <- sample(1:(ndim-1), size=1) # Create a random map for joining dimensions splits <- NULL if (ndim > 2) splits <- sort(sample(2:(ndim-1), size=ndim2-1)) splits <- c(0, splits, ndim) map <- list() for (kk in 1:ndim2) map[[kk]] <- (splits[kk]+1):splits[kk+1] cat("\nRandom 'map':\n") print(map) cat("\nArray 'y2':\n") y2 <- wrap(x2, map=map) print(y2) cat("\nArray 'x2':\n") z2 <- unwrap(y2) print(z2) stopifnot(identical(z2,x2)) } \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:unwrap.array]{*unwrap}()}. See \link[base:aperm]{aperm()}. } \keyword{methods} \keyword{programming} R.utils/man/isModified.Settings.Rd0000644000176200001440000000175414525573056016552 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Settings.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{isModified.Settings} \alias{isModified.Settings} \alias{Settings.isModified} \alias{isModified,Settings-method} \title{Checks if settings has been modified compared to whats on file} \description{ Checks if settings has been modified compared to whats on file. } \usage{ \method{isModified}{Settings}(this, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns \code{\link[base:logical]{TRUE}} if settings have been modified since lasted loaded, or if they never have been loaded. Otherwise \code{\link[base:logical]{FALSE}} is returned. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Settings}}. } \keyword{internal} \keyword{methods} \keyword{programming} R.utils/man/onSessionExit.Rd0000644000176200001440000000313314525573061015476 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % onSessionExit.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{onSessionExit} \alias{onSessionExit.default} \alias{onSessionExit} \title{Registers a function to be called when the R session finishes} \description{ Registers a function to be called when the R session finishes. } \usage{ \method{onSessionExit}{default}(fcn, action=c("prepend", "append", "replace"), ...) } \arguments{ \item{fcn}{A \code{\link[base]{function}} to be called without argument.} \item{action}{A \code{\link[base]{character}} string specifying how the hook function is added to list of hooks.} \item{...}{Not used.} } \value{ Returns (invisibly) the hooks successfully called. } \details{ Functions registered this way are called when \code{\link{finalizeSession}}() is called. Moreover, when this package is loaded, the \code{.Last()} function is modified such that \code{finalizeSession()} is called. However, note that \code{.Last()} is \emph{not} guaranteed to be called when the \R session finished. For instance, the user may quit \R by calling \code{quit(callLast=FALSE)}. Moreover, when \R is run in batch mode, \code{.Last()} is never called. } \author{Henrik Bengtsson} \examples{\dontrun{ onSessionExit(function(...) { message("Bye bye world!") }) quit() }} \seealso{ \code{\link{.Last}()}. \code{\link{finalizeSession}}(). } \keyword{programming} R.utils/man/use.Rd0000644000176200001440000000531714525573061013466 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % use.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{use} \alias{use.default} \alias{use} \title{Attaches or loads packages} \description{ Attaches or loads packages. If a package is not installed, it (and its dependencies) will be installed from one of the (known) repositories. } \usage{ \method{use}{default}(pkg="R.utils", version=NULL, how=c("attach", "load"), quietly=TRUE, warn.conflicts=!quietly, install=getOption("R.utils.use.install", Sys.getenv("R_R_UTILS_USE_INSTALL", "TRUE")), repos=getOption("use/repos", c("[[current]]", "[[mainstream]]")), ..., verbose=FALSE) } \arguments{ \item{pkg}{A \code{\link[base]{character}} \code{\link[base]{vector}} specifying the package(s) to be used.} \item{version}{(optional) Version constraint(s) on requested package(s).} \item{how}{A \code{\link[base]{character}} string specifying whether the package should be attached or loaded.} \item{quietly}{If \code{\link[base:logical]{TRUE}}, minimal or no messages are reported.} \item{warn.conflicts}{If \code{\link[base:logical]{TRUE}}, warnings on namespace conflicts are reported, otherwise not.} \item{install}{If \code{\link[base:logical]{TRUE}} and the package is not installed or an too old version is installed, then tries to install a newer version, otherwise not.} \item{repos}{(optional) A \code{\link[base]{character}} \code{\link[base]{vector}} specifying from which repositories to install the package from, iff a requested package is not already installed.} \item{...}{Additional \emph{named} arguments passed to \code{\link[base]{require}}() or \code{\link[base]{requireNamespace}}().} \item{verbose}{If \code{\link[base:logical]{TRUE}}, verbose output is generated (regardless of \code{quietly}).} } \value{ Returns a \code{\link[base]{vector}} of \code{\link[base]{package_version}}() for each package attached/loaded. If one of the requested packages/package versions is not available and could not be installed, an error is thrown. } \seealso{ \code{\link[base]{library}}() and "base::install.packages". To modify the set of known repositories, set option \code{repos} (see \code{\link[base]{options}}()), which can also be done via \code{\link[utils]{setRepositories}}. } \examples{\dontrun{ use("digest") use("digest (>= 0.6.3)") use("digest (>= 0.6.3)", repos=c("CRAN", "R-Forge")) use("(CRAN|R-Forge)::digest (>= 0.6.3)") use("BioCsoft::ShortRead") use("digest, R.rsp (>= 0.9.17)") }} \keyword{programming} \keyword{utilities} \keyword{internal} R.utils/man/getCharacters.Arguments.Rd0000644000176200001440000000413714525573054017416 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Arguments.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Arguments$getCharacters} \alias{Arguments$getCharacters} \alias{getCharacters.Arguments} \alias{Arguments.getCharacters} \alias{getCharacters,Arguments-method} \alias{Arguments.getCharacter} \alias{getCharacter.Arguments} \alias{getCharacter,Arguments-method} \title{Coerces to a character vector and validates} \description{ Coerces to a character vector and validates. } \usage{ ## Static method (use this): ## Arguments$getCharacters(s, length=NULL, trim=FALSE, nchar=NULL, useNames=TRUE, ## asGString=getOption("Arguments$getCharacters/args/asGString", TRUE), .name=NULL, ## ...) ## Don't use the below: \method{getCharacters}{Arguments}(static, s, length=NULL, trim=FALSE, nchar=NULL, useNames=TRUE, asGString=getOption("Arguments$getCharacters/args/asGString", TRUE), .name=NULL, ...) } \arguments{ \item{s}{A \code{\link[base]{vector}}.} \item{nchar}{A \code{\link[base]{numeric}} \code{\link[base]{vector}} of length one or two. If one, the maximum number of characters ("length") in \code{s}. If two, the minimum and maximum length of \code{s}.} \item{useNames}{If \code{\link[base:logical]{TRUE}}, the 'names' attribute is preserved, otherwise it is dropped.} \item{asGString}{If \code{\link[base:logical]{TRUE}}, each string is treated as a \code{\link{GString}}.} \item{.name}{A \code{\link[base]{character}} string for name used in error messages.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}} \code{\link[base]{vector}}, if it is valid. Otherwise an exception is thrown. } \section{Missing values}{ If \code{s} contains missing values, and \code{nchar} is not \code{\link[base]{NULL}}, then an exception is thrown. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Arguments}}. } \keyword{internal} \keyword{methods} \keyword{IO} R.utils/man/as.character.Verbose.Rd0000644000176200001440000000150714525573060016630 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{as.character.Verbose} \alias{as.character.Verbose} \alias{Verbose.as.character} \alias{as.character,Verbose-method} \title{Returns a character string version of this object} \description{ Returns a character string version of this object. } \usage{ \method{as.character}{Verbose}(x, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}} string. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} R.utils/man/withCapture.Rd0000644000176200001440000000535614525573061015174 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % withCapture.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{withCapture} \alias{withCapture} \alias{evalCapture} \title{Evaluates an expression and captures the code and/or the output} \description{ Evaluates an expression and captures the code and/or the output. } \usage{ withCapture(expr, replace=getOption("withCapture/substitute", ".x."), code=TRUE, output=code, ..., max.deparse.length=getOption("max.deparse.length", 10000), trim=TRUE, newline=getOption("withCapture/newline", TRUE), collapse="\n", envir=parent.frame()) } \arguments{ \item{expr}{The R expression to be evaluated.} \item{replace}{An optional named \code{\link[base]{list}} used for substituting symbols with other strings.} \item{code}{If \code{\link[base:logical]{TRUE}}, the deparsed code of the expression is echoed.} \item{output}{If \code{\link[base:logical]{TRUE}}, the output of each evaluated subexpression is echoed.} \item{...}{Additional arguments passed to \code{\link[R.utils]{sourceTo}} which in turn passes arguments to \code{\link[base]{source}}().} \item{max.deparse.length}{A positive \code{\link[base]{integer}} specifying the maximum length of a deparsed expression, before truncating it.} \item{trim}{If \code{\link[base:logical]{TRUE}}, the captured rows are trimmed.} \item{newline}{If \code{\link[base:logical]{TRUE}} and \code{collapse} is non-\code{\link[base]{NULL}}, a newline is appended at the end.} \item{collapse}{A \code{\link[base]{character}} string used for collapsing the captured rows. If \code{\link[base]{NULL}}, the rows are not collapsed.} \item{envir}{The \code{\link[base]{environment}} in which the expression is evaluated.} } \value{ Returns a \code{\link[base]{character}} string class 'CapturedEvaluation'. } \examples{ print(withCapture({ n <- 3 n for (kk in 1:3) { printf("Iteration #\%d\n", kk) } print(Sys.time()) type <- "horse" type })) ## > n <- 3 ## > n ## [1] 3 ## > for (kk in 1:3) { ## + printf("Iteration #\%d\n", kk) ## + } ## Iteration #1 ## Iteration #2 ## Iteration #3 ## > print(Sys.time()) ## [1] "2011-11-06 11:06:32 PST" ## > type <- "horse" ## > type ## [1] "horse" # Automatic "variable" substitute # (disable with relabel=NULL) a <- 2 b <- "Hello world!" print(withCapture({ x <- .a. s <- .b. x s })) ## > x <- 2 ## > s <- "Hello world!" ## > x ## [1] 2 ## > s ## [1] "Hello world!" } \author{Henrik Bengtsson} \seealso{ Internally, \code{\link[base]{eval}}() is used to evaluate the expression. } \keyword{utilities} R.utils/man/getDoubles.Arguments.Rd0000644000176200001440000000226014525573054016727 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Arguments.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Arguments$getDoubles} \alias{Arguments$getDoubles} \alias{getDoubles.Arguments} \alias{Arguments.getDoubles} \alias{getDoubles,Arguments-method} \alias{Arguments.getDouble} \alias{getDouble.Arguments} \alias{getDouble,Arguments-method} \title{Coerces to a double vector and validates} \description{ Coerces to a double vector and validates. } \usage{ ## Static method (use this): ## Arguments$getDoubles(..., disallow=c("NA", "NaN")) ## Don't use the below: \method{getDoubles}{Arguments}(static, ..., disallow=c("NA", "NaN")) } \arguments{ \item{...}{Arguments passed to @method "getNumeric".} \item{disallow}{Disallowed values. See @method "getNumerics" for details.} } \value{ Returns a \code{\link[base]{double}} \code{\link[base]{vector}}. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Arguments}}. } \keyword{internal} \keyword{methods} \keyword{IO} R.utils/man/readInt.Java.Rd0000644000176200001440000000240714525573055015140 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Java.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Java$readInt} \alias{Java$readInt} \alias{readInt.Java} \alias{Java.readInt} \alias{readInt,Java-method} \title{Reads a Java formatted int (32 bits) from a connection} \description{ Reads one or several Java formatted int's (32 bits) from a connection. All data types in Java are signed, i.e. a byte can hold a value in the range [-2147483648,2147483647]. } \usage{ ## Static method (use this): ## Java$readInt(con, n=1, ...) ## Don't use the below: \method{readInt}{Java}(static, con, n=1, ...) } \arguments{ \item{con}{Binary connection to be read from.} \item{n}{Number of int's to be read.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{vector}} of \code{\link[base]{double}}s. Note that R \code{\link[base]{integer}}s gives NA is as.integer(-2147483648), which is the smallest Java int available. } \author{Henrik Bengtsson} \seealso{ \code{\link[base]{readBin}}(). For more information see \code{\link{Java}}. } \keyword{internal} \keyword{methods} R.utils/man/writeShort.Java.Rd0000644000176200001440000000222414525573055015721 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Java.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Java$writeShort} \alias{Java$writeShort} \alias{writeShort.Java} \alias{Java.writeShort} \alias{writeShort,Java-method} \title{Writes a short (16 bits) to a connection in Java format} \description{ Writes one or several short's (16 bits) to a connection in Java format so they will be readable by Java. All data types in Java are signed, i.e. a byte can hold a value in the range [-32768,32767]. Trying to write a value outside this range will automatically be truncated without a warning. } \usage{ ## Static method (use this): ## Java$writeShort(con, s, ...) ## Don't use the below: \method{writeShort}{Java}(static, con, s, ...) } \arguments{ \item{con}{Binary connection to be written to.} \item{s}{Vector of shorts to be written.} } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Java}}. } \keyword{internal} \keyword{methods} R.utils/man/as.logical.Verbose.Rd0000644000176200001440000000162114525573060016303 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{as.logical.Verbose} \alias{as.logical.Verbose} \alias{Verbose.as.logical} \alias{as.logical,Verbose-method} \title{Gets a logical value of this object} \description{ Gets a logical value of this object. Returns \code{isVisible(this, level=this$defaultLevel)}. } \usage{ \method{as.logical}{Verbose}(x, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns a \code{\link[base]{logical}} value. } \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:isVisible.Verbose]{*isVisible}()}. For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} R.utils/man/getMessage.TimeoutException.Rd0000644000176200001440000000157714525573057020273 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % TimeoutException.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{getMessage.TimeoutException} \alias{getMessage.TimeoutException} \alias{TimeoutException.getMessage} \alias{getMessage,TimeoutException-method} \title{Gets the message of the exception} \description{ Gets the message of the exception. } \usage{ \method{getMessage}{TimeoutException}(this, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}} string. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{TimeoutException}}. } \keyword{programming} \keyword{methods} \keyword{error} \keyword{internal} \keyword{methods} R.utils/man/writeBinFragments.Rd0000644000176200001440000000265514525573061016326 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % writeBinFragments.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{writeBinFragments} \alias{writeBinFragments.default} \alias{writeBinFragments} \title{Writes binary data to disjoint sections of a connection or a file} \usage{ \method{writeBinFragments}{default}(con, object, idxs, size=NA, ...) } \description{ Writes binary data to disjoint sections of a connection or a file. } \arguments{ \item{con}{A \code{\link[base:connections]{connection}} or the pathname of an existing file.} \item{object}{A \code{\link[base]{vector}} of objects to be written.} \item{idxs}{A \code{\link[base]{vector}} of (non-duplicated) indices or a Nx2 \code{\link[base]{matrix}} of N from-to index intervals specifying the elements to be read. Positions are always relative to the start of the file/connection.} \item{size}{The size of the data type to be read. If \code{\link[base]{NA}}, the natural size of the data type is used.} \item{...}{Additional arguments passed to \code{\link[base:readBin]{writeBin}()}.} } \value{ Returns nothing. } \examples{\dontrun{# See example(readBinFragments.connection)}} \author{Henrik Bengtsson} \seealso{ \code{\link{readBinFragments}}(). } \keyword{IO} R.utils/man/Assert.Rd0000644000176200001440000000242714525573055014135 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Assert.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Assert} \docType{class} \alias{Assert} \title{The Assert class} \description{ Package: R.utils \cr \bold{Class Assert}\cr \code{\link[R.oo]{Object}}\cr \code{~~|}\cr \code{~~+--}\code{Assert}\cr \bold{Directly known subclasses:}\cr \cr public static class \bold{Assert}\cr extends \link[R.oo]{Object}\cr } \usage{ Assert(...) } \arguments{ \item{...}{Not used.} } \section{Fields and Methods}{ \bold{Methods:}\cr \tabular{rll}{ \tab \code{check} \tab -\cr \tab \code{inheritsFrom} \tab -\cr \tab \code{isMatrix} \tab -\cr \tab \code{isScalar} \tab -\cr \tab \code{isVector} \tab -\cr } \bold{Methods inherited from Object}:\cr $, $<-, [[, [[<-, as.character, attach, attachLocally, clearCache, clearLookupCache, clone, detach, equals, extend, finalize, getEnvironment, getFieldModifier, getFieldModifiers, getFields, getInstantiationTime, getStaticInstance, hasField, hashCode, ll, load, names, objectSize, print, save } \author{Henrik Bengtsson} \keyword{classes} R.utils/man/getBuiltinDate.GString.Rd0000644000176200001440000000175314525573055017155 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % GString-class.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{GString$getBuiltinDate} \alias{GString$getBuiltinDate} \alias{getBuiltinDate.GString} \alias{GString.getBuiltinDate} \alias{getBuiltinDate,GString-method} \title{Gets the current date} \description{ Gets the current date. } \usage{ ## Static method (use this): ## GString$getBuiltinDate(format="\%Y-\%m-\%d", ...) ## Don't use the below: \method{getBuiltinDate}{GString}(static, format="\%Y-\%m-\%d", ...) } \arguments{ \item{format}{A \code{\link[base]{character}} format string.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}} string. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{GString}}. } \keyword{internal} \keyword{methods} R.utils/man/header.Verbose.Rd0000644000176200001440000000247614525573060015530 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{header.Verbose} \alias{header.Verbose} \alias{Verbose.header} \alias{header,Verbose-method} \title{Writes a header} \description{ Writes a header surrounded by a frame. The output is indented according to \code{\link[R.utils:enter.Verbose]{*enter}()}/\code{\link[R.utils:exit.Verbose]{*exit}()} calls. } \usage{ \method{header}{Verbose}(this, ..., char="-", padding=0, prefix=paste(char, paste(rep(" ", max(padding, 1)), collapse = ""), sep = ""), level=this$defaultLevel) } \arguments{ \item{...}{The title.} \item{char}{The \code{\link[base]{character}} string to make up the frame.} \item{padding}{The number of rows and character to pad the title above, below, and to the left.} \item{prefix}{The prefix of all padded lines and the title line.} \item{level}{A \code{\link[base]{numeric}} value to be compared to the threshold.} } \value{ Returns nothing. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} R.utils/man/pushBackupFile.Rd0000644000176200001440000000550714525573061015600 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % pushBackupFile.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{pushBackupFile} \alias{pushBackupFile.default} \alias{pushBackupFile} \title{Appends a backup suffix to the pathname} \usage{ \method{pushBackupFile}{default}(filename, path=NULL, suffix=".bak", isFile=TRUE, onMissing=c("ignore", "error"), copy=FALSE, overwrite=TRUE, ..., verbose=FALSE) } \description{ Appends a backup suffix to the pathname and, optionally, renames an existing file accordingly. In combination with \code{\link{popBackupFile}}(), this method is useful for creating a backup of a file and restoring it. } \arguments{ \item{filename}{The filename of the file to backup.} \item{path}{The path of the file.} \item{suffix}{The suffix to be appended.} \item{isFile}{If \code{\link[base:logical]{TRUE}}, the file must exist and will be renamed on the file system. If \code{\link[base:logical]{FALSE}}, it is only the pathname string that will be modified. For details, see below.} \item{onMissing}{A \code{\link[base]{character}} string specifying what to do if the file does not exist.} \item{copy}{If \code{\link[base:logical]{TRUE}}, an existing original file remains after creating the backup copy, otherwise it is dropped.} \item{overwrite}{If \code{\link[base:logical]{TRUE}}, any existing backup files are overwritten, otherwise an exception is thrown.} \item{...}{Not used.} \item{verbose}{A \code{\link[base]{logical}} or \code{\link{Verbose}}.} } \value{ Returns the pathname with the suffix appended. } \examples{ # Create a file pathname <- file.path(tempdir(), "foobar.txt") cat(file=pathname, "File v1\n") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # (a) Backup and restore a file # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Turn it into a backup file pathnameB <- pushBackupFile(pathname, verbose=TRUE) print(pathnameB) # Restore main file from backup pathnameR <- popBackupFile(pathnameB, verbose=TRUE) print(pathnameR) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # (b) Backup, create a new file and frop backup file # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Turn it into a backup file pathnameB <- pushBackupFile(pathname, verbose=TRUE) print(pathnameB) # Create a new file cat(file=pathname, "File v2\n") # Drop backup because a new main file was successfully created pathnameR <- popBackupFile(pathnameB, verbose=TRUE) print(pathnameR) } \author{Henrik Bengtsson} \seealso{ \code{\link{popBackupFile}}(). } \keyword{utilities} \keyword{programming} \keyword{IO} R.utils/man/setTimestampFormat.Verbose.Rd0000644000176200001440000000234214525573060020120 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{setTimestampFormat.Verbose} \alias{setTimestampFormat.Verbose} \alias{Verbose.setTimestampFormat} \alias{setTimestampFormat,Verbose-method} \title{Sets the default timestamp format} \description{ Sets the default timestamp format. } \usage{ \method{setTimestampFormat}{Verbose}(this, format="\%Y\%m\%d \%H:\%M:\%S|", ...) } \arguments{ \item{format}{If a \code{\link[base]{function}}, this function is called (without arguments) whenever a timestamp is generated. If a \code{\link[base]{character}} string, it used as the format string in \code{format(Sys.date(), fmt)}.} \item{...}{Not used.} } \value{ Returns (invisibly) the old timestamp format. } \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:getTimestampFormat.Verbose]{*getTimestampFormat}()}. \code{\link[R.utils:timestampOn.Verbose]{*timestampOn}()}. For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} R.utils/man/unwrap.array.Rd0000644000176200001440000000412314525573061015315 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % unwrap.array.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{unwrap.array} \alias{unwrap.array} \alias{unwrap.matrix} \alias{unwrap.data.frame} \alias{unwrap.default} \title{Unwrap an array, matrix or a vector to an array of more dimensions} \description{ Unwrap an array, matrix or a vector to an array of more dimensions. This is done by splitting up each dimension into several dimension based on the names of that dimension. } \usage{ \method{unwrap}{array}(x, split=rep("[.]", length(dim(x))), drop=FALSE, ...) } \arguments{ \item{x}{An \code{\link[base]{array}} or a \code{\link[base]{matrix}}.} \item{split}{A \code{\link[base]{list}} or a \code{\link[base]{character}} \code{\link[base]{vector}}. If a \code{\link[base]{list}}, it should contain \code{\link[base]{function}}s that takes a \code{\link[base]{character}} \code{\link[base]{vector}} as the first argument and optional \code{...} arguments. Each function should split the \code{\link[base]{vector}} into a \code{\link[base]{list}} of same length and where all elements contains the same number of parts. If a \code{\link[base]{character}} \code{\link[base]{vector}}, each element \code{split[i]} is replaced by a \code{\link[base]{function}} call \code{function(names, ...) strsplit(names, split=split[i])}. } \item{drop}{If \code{\link[base:logical]{TRUE}}, dimensions of of length one are dropped, otherwise not.} \item{...}{Arguments passed to the \code{split} \code{\link[base]{function}}s.} } \value{ Returns an \code{\link[base]{array}}. } \details{ Although not tested thoroughly, \code{unwrap()} should be the inverse of \code{wrap()} such that \code{identical(unwrap(wrap(x)), x)} holds. } \examples{\dontrun{See ?wrap.array for an example}} \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:wrap.array]{*wrap}()}. } \keyword{methods} \keyword{programming} R.utils/man/copyFile.Rd0000644000176200001440000000602614525573060014441 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % copyFile.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{copyFile} \alias{copyFile.default} \alias{copyFile} \title{Copies a file atomically} \description{ Copies a file atomically, by first copying to a temporary file and then renaming that file. } \usage{ \method{copyFile}{default}(srcPathname, destPathname, skip=FALSE, overwrite=FALSE, ..., validate=TRUE, verbose=FALSE) } \arguments{ \item{srcPathname}{The source file to be copied.} \item{destPathname}{The destination file to be created. If an \emph{existing directory}, then the destination file becomes \code{file.path(destPathname, basename(srcPathname))}.} \item{skip, overwrite}{If a destination file does not exist, these arguments have no effect. If such a file exists and \code{skip} is \code{\link[base:logical]{TRUE}}, then no copying is attempted and \code{\link[base:logical]{FALSE}} is returned (indicating that no copying was made). If such a file exists, both \code{skip} and \code{overwrite} are \code{\link[base:logical]{FALSE}} then an exception is thrown. If a destination file exists, \code{skip} is \code{\link[base:logical]{FALSE}} and \code{overwrite} is \code{\link[base:logical]{TRUE}}, then it is overwritten and \code{\link[base:logical]{TRUE}} is returned. If the copying/overwriting failed, for instance due to non sufficient file permissions, an informative exception is thrown.} \item{...}{Additional \emph{named} arguments passed to \code{\link[base]{file.copy}}(). Non-named or unknown arguments are ignored.} \item{validate}{If \code{\link[base:logical]{TRUE}}, validation of the copied file is applied, otherwise not.} \item{verbose}{See \code{\link[R.utils]{Verbose}}.} } \value{ Returns a \code{\link[base]{logical}} indicating whether a successful file copy was completed or not, or equivalently. In other words, \code{\link[base:logical]{TRUE}} is returned if the file was successfully copied, and \code{\link[base:logical]{FALSE}} if not. If an error occurs, an informative exception is thrown. If the error occurs while renaming the temporary file to the final name, the temporary file will remain in the destination directory. } \details{ If the source file does not exists (or is not a file), then an informative exception is thrown. If the source and destination pathnames are the same, it is not safe to copy (which can lead to either corrupt or lost files) and an informative exception is thrown. If (and only if) the file is successfully copied and argument \code{validate} is \code{\link[base:logical]{TRUE}}, then this method also asserts that the file size of the destination matches that of the source, otherwise an informative exception is thrown. } \author{Henrik Bengtsson} \seealso{ \code{\link[base:files]{file.copy}()}. } \keyword{internal} R.utils/man/toCamelCase.Rd0000644000176200001440000000356514525573061015055 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % toCamelCase.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{toCamelCase} \alias{toCamelCase.default} \alias{toCamelCase} \title{Converts a string of words into a merged camel-cased word} \description{ Converts a string of words into a merged camel-cased word, e.g. "a single espresso" is converted to "aSingleEspresso". } \usage{ \method{toCamelCase}{default}(s, capitalize=FALSE, preserveSameCase=FALSE, split="[ \t]+", ...) } \arguments{ \item{s}{A \code{\link[base]{character}} \code{\link[base]{vector}}.} \item{capitalize}{If \code{\link[base:logical]{TRUE}}, the first letter will be in upper case, otherwise it will be in lower case.} \item{preserveSameCase}{If \code{\link[base:logical]{TRUE}}, words that are in all upper case will remain as all same case words, e.g. acronyms.} \item{split}{A pattern used to identify words. See \code{\link[base]{strsplit}}() for more details.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}} \code{\link[base]{vector}}. } \examples{ s <- "hello world" print(toCamelCase(s)) # helloWorld print(toCamelCase(s, capitalize=TRUE)) # HelloWorld stopifnot(toCamelCase(s) == toCamelCase(toCamelCase(s))) s <- "GEO Accession" print(toCamelCase(s)) # gEOAccession print(toCamelCase(s, preserveSameCase=TRUE)) # geoAccession print(toCamelCase(s, capitalize=TRUE)) # GEOAccession print(toCamelCase(s, capitalize=TRUE, preserveSameCase=TRUE)) # GEOAccession stopifnot(toCamelCase(s) == toCamelCase(toCamelCase(s))) } \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils]{capitalize}}. \code{\link[base]{chartr}}(). } \keyword{programming} \keyword{IO} \keyword{internal} R.utils/man/findGhostscript.System.Rd0000644000176200001440000000375414525573057017337 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % System.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{System$findGhostscript} \alias{System$findGhostscript} \alias{findGhostscript.System} \alias{System.findGhostscript} \alias{findGhostscript,System-method} \title{Searches for a Ghostview executable on the current system} \description{ Searches for a Ghostview executable on the current system. } \usage{ ## Static method (use this): ## System$findGhostscript(updateRGSCMD=TRUE, firstOnly=TRUE, force=FALSE, ...) ## Don't use the below: \method{findGhostscript}{System}(static, updateRGSCMD=TRUE, firstOnly=TRUE, force=FALSE, ...) } \arguments{ \item{updateRGSCMD}{If \code{\link[base:logical]{TRUE}} and Ghostscript is found, then the system environment variable \code{\link[base]{R_GSCMD}} is set to the (first) path found.} \item{firstOnly}{If \code{\link[base:logical]{TRUE}}, only the first executable is returned.} \item{force}{If \code{\link[base:logical]{TRUE}}, existing \code{\link[base]{R_GSCMD}} is ignored, otherwise not.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}} \code{\link[base]{vector}} of full and normalized pathnames where Ghostscript executables are found. } \examples{\dontrun{ print(System$findGhostscript()) }} \author{Henrik Bengtsson} \references{ [1] \emph{How to use Ghostscript}, Ghostscript, 2022 \url{https://ghostscript.com/docs/9.55.0/Use.htm}\cr [2] \emph{Environment variable}, Wikipedia, 2013. \url{https://en.wikipedia.org/wiki/Environment_variable}\cr [3] \emph{Environment.SpecialFolder Enumeration}, Microsoft, 2013. \url{https://docs.microsoft.com/en-us/dotnet/api/system.environment.specialfolder}\cr } \seealso{ For more information see \code{\link{System}}. } \keyword{internal} \keyword{methods} R.utils/man/compressFile.Rd0000644000176200001440000001035714525573060015324 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % compressFile.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{compressFile} \alias{compressFile.default} \alias{compressFile} \alias{decompressFile} \alias{decompressFile.default} \alias{isCompressedFile} \alias{isCompressedFile.default} \alias{bzip2} \alias{bzip2.default} \alias{bunzip2} \alias{bunzip2.default} \alias{isBzipped} \alias{isBzipped.default} \alias{gzip} \alias{gzip.default} \alias{gunzip} \alias{gunzip.default} \alias{isGzipped} \alias{isGzipped.default} %% \alias{xz} %% \alias{xz.default} %% \alias{unxz} %% \alias{unxz.default} %% \alias{isXzipped} %% \alias{isXzipped.default} \title{Compressing and decompressing files} \usage{ \method{compressFile}{default}(filename, destname=sprintf("\%s.\%s", filename, ext), ext, FUN, temporary=FALSE, skip=FALSE, overwrite=FALSE, remove=TRUE, BFR.SIZE=1e+07, ...) \method{decompressFile}{default}(filename, destname=gsub(sprintf("[.]\%s$", ext), "", filename, ignore.case = TRUE), ext, FUN, temporary=FALSE, skip=FALSE, overwrite=FALSE, remove=TRUE, BFR.SIZE=1e+07, ...) \method{isCompressedFile}{default}(filename, method=c("extension", "content"), ext, fileClass, ...) \method{bzip2}{default}(filename, ..., ext="bz2", FUN=bzfile) \method{bunzip2}{default}(filename, ..., ext="bz2", FUN=bzfile) \method{gzip}{default}(filename, ..., ext="gz", FUN=gzfile) \method{gunzip}{default}(filename, ..., ext="gz", FUN=gzfile) } \description{ Compressing and decompressing files such as gzip:ed and bzip2:ed files. \emph{ NOTE: The default (\code{remove=TRUE}) behavior is that the input file is removed after that the output file is fully created and closed. } } \arguments{ \item{filename}{Pathname of input file.} \item{destname}{Pathname of output file.} \item{temporary}{If \code{\link[base:logical]{TRUE}}, the output file is created in a temporary directory.} \item{skip}{If \code{\link[base:logical]{TRUE}} and the output file already exists, the output file is returned as is.} \item{overwrite}{If \code{\link[base:logical]{TRUE}} and the output file already exists, the file is silently overwritten, otherwise an exception is thrown (unless \code{skip} is \code{\link[base:logical]{TRUE}}).} \item{remove}{If \code{\link[base:logical]{TRUE}}, the input file is removed afterward, otherwise not.} \item{BFR.SIZE}{The number of bytes read in each chunk.} \item{...}{Passed to the underlying function or alternatively not used.} \item{method}{A \code{\link[base]{character}} string specifying how to infer whether a file is compressed or not.} \item{ext, fileClass, FUN}{(internal) Filename extension, file class, and a connection \code{\link[base]{function}} used to read from/write to file.} } \value{ Returns the pathname of the output file. The number of bytes processed is returned as an attribute. \code{isCompressedFile()}, \code{isGzipped()} and \code{isBzipped()} return a \code{\link[base]{logical}}. Note that with \code{method = "extension"} (default), only the filename extension is used to infer whether the file is compressed or not. Specifically, it does not matter whether the file actually exists or not. } \details{ Internally \code{bzfile()} and \code{gzfile()} (see \code{\link[base]{connections}}) are used to read (write) files. If the process is interrupted before completed, the partially written output file is automatically removed. } \examples{ ## bzip2 cat(file="foo.txt", "Hello world!") print(isBzipped("foo.txt")) print(isBzipped("foo.txt.bz2")) bzip2("foo.txt") print(file.info("foo.txt.bz2")) print(isBzipped("foo.txt")) print(isBzipped("foo.txt.bz2")) bunzip2("foo.txt.bz2") print(file.info("foo.txt")) ## gzip cat(file="foo.txt", "Hello world!") print(isGzipped("foo.txt")) print(isGzipped("foo.txt.gz")) gzip("foo.txt") print(file.info("foo.txt.gz")) print(isGzipped("foo.txt")) print(isGzipped("foo.txt.gz")) gunzip("foo.txt.gz") print(file.info("foo.txt")) ## Cleanup file.remove("foo.txt") } \author{Henrik Bengtsson} \keyword{file} \keyword{programming} R.utils/man/FileProgressBar.Rd0000644000176200001440000000435714525573055015731 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % FileProgressBar.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{FileProgressBar} \docType{class} \alias{FileProgressBar} \title{A progress bar that sets the size of a file accordingly} \description{ Package: R.utils \cr \bold{Class FileProgressBar}\cr \code{\link[R.oo]{Object}}\cr \code{~~|}\cr \code{~~+--}\code{\link[R.utils]{ProgressBar}}\cr \code{~~~~~~~|}\cr \code{~~~~~~~+--}\code{FileProgressBar}\cr \bold{Directly known subclasses:}\cr \cr public static class \bold{FileProgressBar}\cr extends \link[R.utils]{ProgressBar}\cr } \usage{ FileProgressBar(pathname=NULL, ...) } \arguments{ \item{pathname}{The pathname of the output file.} \item{...}{Other arguments accepted by the \code{\link{ProgressBar}} constructor.} } \section{Fields and Methods}{ \bold{Methods:}\cr \tabular{rll}{ \tab \code{cleanup} \tab -\cr \tab \code{update} \tab -\cr } \bold{Methods inherited from ProgressBar}:\cr as.character, getBarString, increase, isDone, reset, setMaxValue, setProgress, setStepLength, setTicks, setValue, update \bold{Methods inherited from Object}:\cr $, $<-, [[, [[<-, as.character, attach, attachLocally, clearCache, clearLookupCache, clone, detach, equals, extend, finalize, getEnvironment, getFieldModifier, getFieldModifiers, getFields, getInstantiationTime, getStaticInstance, hasField, hashCode, ll, load, names, objectSize, print, save } \details{ A progress bar that sets the size of a file accordingly. This class useful to check the progress of a batch job by just querying the size of a file, for instance, via ftp. } \examples{ \dontrun{ # Creates a progress bar (of length 100) that displays it self as a file. pb <- FileProgressBar(file.path(tempdir(), "progress.simulation"), max = 10L) reset(pb) while (!isDone(pb)) { x <- rnorm(3e4) increase(pb) # Emulate a slow process if (interactive()) Sys.sleep(0.1) cat(sprintf("File size: \%d bytes\n", file.info(pb$pathname)$size)) Sys.sleep(0.01) } } } \author{Henrik Bengtsson} \keyword{classes} R.utils/man/VComments.Rd0000644000176200001440000000712114525573057014605 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % VComments.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{VComments} \docType{class} \alias{VComments} \title{The VComments class} \description{ Package: R.utils \cr \bold{Class VComments}\cr \code{\link[R.oo]{Object}}\cr \code{~~|}\cr \code{~~+--}\code{\link[R.utils]{SmartComments}}\cr \code{~~~~~~~|}\cr \code{~~~~~~~+--}\code{VComments}\cr \bold{Directly known subclasses:}\cr \link[R.utils]{LComments}\cr public static class \bold{VComments}\cr extends \emph{\link[R.utils]{SmartComments}}\cr The VComments class. } \usage{ VComments(letter="V", verboseName="verbose", ...) } \arguments{ \item{letter}{The smart letter.} \item{verboseName}{The name of the verbose object.} \item{...}{Not used.} } \section{Fields and Methods}{ \bold{Methods:}\cr \tabular{rll}{ \tab \code{convertComment} \tab -\cr \tab \code{reset} \tab -\cr \tab \code{validate} \tab -\cr } \bold{Methods inherited from SmartComments}:\cr compile, convertComment, parse, reset, validate \bold{Methods inherited from Object}:\cr $, $<-, [[, [[<-, as.character, attach, attachLocally, clearCache, clearLookupCache, clone, detach, equals, extend, finalize, getEnvironment, getFieldModifier, getFieldModifiers, getFields, getInstantiationTime, getStaticInstance, hasField, hashCode, ll, load, names, objectSize, print, save } \details{ The 'v' in VComments stands for 'verbose', because of its relationship to the \code{\link{Verbose}} class. Here is a list of VComments and the \R code that replaces each of them by the compiler: \bold{Constructors}\cr \describe{ \item{#V0#}{[] - NullVerbose()} \item{#V1#}{[] - Verbose()} } \bold{Controls}\cr \describe{ \item{#V=#}{[] - Sets the name of the object. Default is 'verbose'.} \item{#V^#}{ - setThreshold(, )} \item{#V?#}{ - if (isVisible()) \{ \}} \item{#V@#}{ - setDefaultLevel(, )} \item{#Vm#}{ - (, )} } \bold{Enters and exits}\cr \describe{ \item{#V+#}{[] - enter(, )} \item{#V-#}{[] - exit(, )} \item{#V!#}{[] - pushState()\cr on.exit(popState())\cr If , enter(, )} } \bold{Simple output}\cr \describe{ \item{#Vn#}{ - newline()} \item{#Vr#}{ - ruler()} \item{#Vt#}{ - timestamp()} \item{#Vw#}{[] - warnings(<verbose>, <title>)} } \bold{Output messages}\cr \describe{ \item{#Vc#}{[<message>] - cat(<verbose>, <message>)} \item{#Ve#}{<expression> - eval(<verbose>, <expression>)} \item{#Vh#}{<message> - header(<verbose>, <message>)} \item{#Vp#}{<object> - print(<verbose>, <object>)} \item{#Vs#}{<object> - summary(<verbose>, <object>)} \item{#Vz#}{<object> - str(<verbose>, <object>)} } } \examples{ filename <- system.file("data-ex/exampleVComments.R", package="R.utils") lines <- readLines(filename) cat("Code before preprocessing:\n") displayCode(code=lines, pager="console") lines <- VComments$compile(lines) cat("Code after preprocessing:\n") displayCode(code=lines, pager="console") } \author{Henrik Bengtsson} \keyword{classes} \keyword{programming} \keyword{IO} �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/isSingle.Rd�����������������������������������������������������������������������������0000644�0001762�0000144�00000001551�14525573061�014443� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % isSingle.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{isSingle} \alias{isSingle} \alias{singles} \title{Identifies all entries that exists exactly once} \description{ Identifies all entries that exists exactly once. } \usage{ isSingle(x, ...) singles(x, ...) } \arguments{ \item{x}{A \code{\link[base]{vector}} of length K.} \item{...}{Additional arguments passed to \code{\link{isReplicated}}().} } \value{ A \code{\link[base]{logical}} \code{\link[base]{vector}} of length K, indicating whether the value is unique or not. } \author{Henrik Bengtsson} \seealso{ Internally \code{\link{isReplicated}}() is used. } �������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/getTimestampFormat.Verbose.Rd�����������������������������������������������������������0000644�0001762�0000144�00000001762�14525573060�020111� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{getTimestampFormat.Verbose} \alias{getTimestampFormat.Verbose} \alias{Verbose.getTimestampFormat} \alias{getTimestampFormat,Verbose-method} \title{Gets the default timestamp format} \description{ Gets the default timestamp format. } \usage{ \method{getTimestampFormat}{Verbose}(this, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}} string or a \code{\link[base]{function}}. } \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:setTimestampFormat.Verbose]{*setTimestampFormat}()}. \code{\link[R.utils:timestampOn.Verbose]{*timestampOn}()}. For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} ��������������R.utils/man/getIntegers.Arguments.Rd����������������������������������������������������������������0000644�0001762�0000144�00000002275�14525573054�017120� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Arguments.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Arguments$getIntegers} \alias{Arguments$getIntegers} \alias{getIntegers.Arguments} \alias{Arguments.getIntegers} \alias{getIntegers,Arguments-method} \alias{Arguments.getInteger} \alias{getInteger.Arguments} \alias{getInteger,Arguments-method} \title{Coerces to a integer vector and validates} \description{ Coerces to a integer vector and validates. } \usage{ ## Static method (use this): ## Arguments$getIntegers(..., disallow=c("NA", "NaN")) ## Don't use the below: \method{getIntegers}{Arguments}(static, ..., disallow=c("NA", "NaN")) } \arguments{ \item{...}{Arguments passed to @method "getNumeric".} \item{disallow}{Disallowed values. See @method "getNumerics" for details.} } \value{ Returns a \code{\link[base]{integer}} \code{\link[base]{vector}}. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Arguments}}. } \keyword{internal} \keyword{methods} \keyword{IO} �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/getReadablePathname.Arguments.Rd��������������������������������������������������������0000644�0001762�0000144�00000004505�14525573054�020513� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Arguments.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Arguments$getReadablePathname} \alias{Arguments$getReadablePathname} \alias{getReadablePathname.Arguments} \alias{Arguments.getReadablePathname} \alias{getReadablePathname,Arguments-method} \title{Gets a readable pathname} \description{ Gets a readable pathname. } \usage{ ## Static method (use this): ## Arguments$getReadablePathname(file=NULL, path=NULL, mustExist=TRUE, absolute=FALSE, ## adjust=c("none", "url"), ...) ## Don't use the below: \method{getReadablePathname}{Arguments}(static, file=NULL, path=NULL, mustExist=TRUE, absolute=FALSE, adjust=c("none", "url"), ...) } \arguments{ \item{file}{A \code{\link[base]{character}} string specifying the file.} \item{path}{A \code{\link[base]{character}} string specifying the path.} \item{mustExist}{If \code{\link[base:logical]{TRUE}}, the pathname must exists and be readable, otherwise an exception is thrown. If \code{\link[base:logical]{FALSE}}, no such test is performed.} \item{absolute}{If \code{\link[base:logical]{TRUE}}, the absolute pathname is returned.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}} string of the absolute pathname of the file. } \section{Missing values}{ If \code{file} or \code{path} is \code{\link[base]{NA}} and \code{mustExist} is \code{\link[base:logical]{FALSE}}, then (character) \code{\link[base]{NA}} is returned, otherwise an exception is thrown. } \section{Windows}{ If a too long pathname is detected on Windows, an informative warning is given. The maximum number of symbols in a Windows pathname is 256, including file separators '/' or '\', but excluding the drive letter, and initial file separator (e.g. 'C:/'), and the string terminator ('\\0'), cf. 'MSDN - Naming a File or Directory', Microsoft. In R, the limit is one symbol less, i.e. 255. } \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:getWritablePathname.Arguments]{*getWritablePathname}()} \code{\link[R.utils]{filePath}}. For more information see \code{\link{Arguments}}. } \keyword{internal} \keyword{methods} \keyword{IO} �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/writeRaw.MultiVerbose.Rd����������������������������������������������������������������0000644�0001762�0000144�00000001656�14525573056�017123� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % MultiVerbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{writeRaw.MultiVerbose} \alias{writeRaw.MultiVerbose} \alias{MultiVerbose.writeRaw} \alias{writeRaw,MultiVerbose-method} \title{Writes to each of the Verbose objects} \description{ Writes to each of the Verbose objects. } \usage{ \method{writeRaw}{MultiVerbose}(this, ...) } \arguments{ \item{...}{Additional objects to be passed to \code{writeRaw()} for each \code{\link{Verbose}} object.} } \value{ Returns (invisibly) \code{\link[base:logical]{TRUE}}. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{MultiVerbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} ����������������������������������������������������������������������������������R.utils/man/setOption.Rd����������������������������������������������������������������������������0000644�0001762�0000144�00000001527�14525573061�014655� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % setOption.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{setOption} \alias{setOption.default} \alias{setOption} \title{Sets a option in R} \description{ Sets a option in R by specifying its name as a \code{\link[base]{character}} string. } \usage{ \method{setOption}{default}(x, value, ...) } \arguments{ \item{x}{The name of the option to be set.} \item{value}{The new value of the option.} \item{...}{Not used.} } \value{ Returns (invisibly) the previous value of the option. } \author{Henrik Bengtsson} \seealso{ See \code{\link[base]{getOption}}() and "base::options". } \keyword{programming} �������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/withLocale.Rd���������������������������������������������������������������������������0000644�0001762�0000144�00000003275�14525573061�014766� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % withLocale.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{withLocale} \alias{withLocale} \title{Evaluate an R expression with locale set temporarily} \description{ Evaluate an R expression with locale set temporarily. } \usage{ withLocale(expr, category, locale, ..., substitute=TRUE, envir=parent.frame()) } \arguments{ \item{expr}{The R expression to be evaluated.} \item{category}{A \code{\link[base]{character}} string specifying the category to use.} \item{locale}{\code{\link[base]{character}} \code{\link[base]{vector}} specifying the locale to used. The first successfully set one will be used.} \item{...}{Not used.} \item{substitute}{If \code{\link[base:logical]{TRUE}}, argument \code{expr} is \code{\link[base]{substitute}()}:ed, otherwise not.} \item{envir}{The \code{\link[base]{environment}} in which the expression should be evaluated.} } \value{ Returns the results of the expression evaluated. } \author{Henrik Bengtsson} \examples{ # Vector cat("Original vector:\n") x <- c(letters[1:8], LETTERS[1:8]) print(x) cat("Sorting with 'C' locale:\n") y1 <- withLocale(sort(x), "LC_COLLATE", "C") print(y1) cat("Sorting with an 'English' locale:\n") y2 <- withLocale(sort(x), "LC_COLLATE", c("en_US", "en_US.UTF8", "English_United States.1252")) print(y2) } \seealso{ Internally, \code{\link[base]{eval}}() is used to evaluate the expression. and \code{\link[base]{Sys.setlocale}}() to set locale. } \keyword{IO} \keyword{programming} �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/getFilename.Arguments.Rd����������������������������������������������������������������0000644�0001762�0000144�00000004204�14525573054�017052� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Arguments.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Arguments$getFilename} \alias{Arguments$getFilename} \alias{getFilename.Arguments} \alias{Arguments.getFilename} \alias{getFilename,Arguments-method} \title{Gets and validates a filename} \description{ Gets and validates a filename. } \usage{ ## Static method (use this): ## Arguments$getFilename(filename, nchar=c(1, 128), class=c("safe"), .name=NULL, ## .type="filename", ...) ## Don't use the below: \method{getFilename}{Arguments}(static, filename, nchar=c(1, 128), class=c("safe"), .name=NULL, .type="filename", ...) } \arguments{ \item{filename}{A \code{\link[base]{character}} string.} \item{nchar}{An \code{\link[base]{integer}} \code{\link[base]{vector}} of length two specifying the range of valid filename lengths.} \item{class}{A \code{\link[base]{character}} string specifying the class of valid filenames.} \item{.name}{The name of the argument validated.} \item{.type}{Not used.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}} string if filename is valid, otherwise an exception is thrown. } \section{Missing values}{ If \code{filename} is a missing value, then an exception is thrown. } \details{ When argument \code{class="safe"}, the following 86 ASCII characters are allowed in filenames: \preformatted{ #$%&'()+,-.0123456789;= (24 including initial space) @ABCDEFGHIJKLMNOPQRSTUVWXYZ[]^_ (31) `abcdefghijklmnopqrstuvwxyz{|}~ (31) } This class of filenames has been extensively tested on for cross-platform support on Microsoft Windows, macOS, and various Unix flavors. } \references{ [1] Microsoft, \emph{Naming Files, Paths, and Namespaces}, 2018. \url{https://learn.microsoft.com/en-us/windows/win32/fileio/naming-a-file}. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Arguments}}. } \keyword{internal} \keyword{methods} ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/reset.VComments.Rd����������������������������������������������������������������������0000644�0001762�0000144�00000001372�14525573057�015730� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % VComments.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{reset.VComments} \alias{reset.VComments} \alias{VComments.reset} \alias{reset,VComments-method} \title{Resets a VComments compiler} \description{ Resets a VComments compiler. } \usage{ \method{reset}{VComments}(this, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns nothing. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{VComments}}. } \keyword{internal} \keyword{methods} \keyword{programming} ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/insert.Rd�������������������������������������������������������������������������������0000644�0001762�0000144�00000005211�14525573060�014166� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % insert.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{insert} \alias{insert.default} \alias{insert} \title{Insert values to a vector at certain positions} \description{ Insert values to a vector at certain positions. } \usage{ \method{insert}{default}(x, ats, values=NA, useNames=TRUE, ...) } \arguments{ \item{x}{The \code{\link[base]{vector}} of data values.} \item{ats}{The indices of \code{x} where the values should be inserted.} \item{values}{A \code{\link[base]{list}} or a \code{\link[base]{vector}} of the values to be inserted. Should be of same length as \code{ats}, unless if a single value when it is automatically extended without a warning.} \item{useNames}{If \code{\link[base:logical]{FALSE}}, the names attribute is dropped/ignored, otherwise not. Only applied if argument \code{x} is named.} \item{...}{Not used.} } \examples{ # Insert NAs (default) between all values y <- c(a=1, b=2, c=3) print(y) x <- insert(y, ats=2:length(y)) Ex <- c(y[1], NA_real_, y[2], NA_real_, y[3]) print(x) stopifnot(identical(x,Ex)) # Insert at first position y <- c(a=1, b=2, c=3) print(y) x <- insert(y, ats=1, values=rep(NA_real_,2)) Ex <- c(NA_real_,NA_real_,y) print(x) stopifnot(identical(x,Ex)) x <- insert(y, ats=1, values=rep(NA_real_,2), useNames=FALSE) print(x) # Insert at last position (names of 'values' are ignored # because input vector has no names) x <- insert(1:3, ats=4, values=c(d=2, e=1)) Ex <- c(1:3,2,1) print(x) stopifnot(identical(x,Ex)) # Insert in the middle of a vector x <- insert(c(1,3,2,1), ats=2, values=2) print(x) stopifnot(identical(as.double(x),as.double(Ex))) # Insert multiple vectors at multiple indices at once x0 <- c(1:4, 8:11, 13:15) x <- insert(x0, ats=c(5,9), values=list(5:7,12)) print(x) Ex <- 1:max(x) stopifnot(identical(as.double(x),as.double(Ex))) x <- insert(x0, ats=c(5,9,12), values=list(5:7,12,16:18)) print(x) Ex <- 1:max(x) stopifnot(identical(as.double(x),as.double(Ex))) # Insert missing indices Ex <- 1:20 missing <- setdiff(Ex, x0) x <- x0 for (m in missing) x <- insert(x, ats=m, values=m) print(x) stopifnot(identical(as.double(x),as.double(Ex))) } \seealso{ \code{\link[base]{append}}() takes argument \code{after} (a scalar). For example, \code{append(x, y, after=after) == insert(x, values=y, ats=after+1)}. Contrary to \code{append()}, \code{insert()} accepts a vector of insert indices. } \author{Henrik Bengtsson} \keyword{manip} ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/equals.Options.Rd�����������������������������������������������������������������������0000644�0001762�0000144�00000001636�14525573056�015622� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Options.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{equals.Options} \alias{equals.Options} \alias{Options.equals} \alias{equals,Options-method} \title{Checks if this object is equal to another Options object} \description{ Checks if this object is equal to another Options object. } \usage{ \method{equals}{Options}(this, other, ...) } \arguments{ \item{other}{Another Options object.} \item{...}{Not used.} } \value{Returns \code{\link[base:logical]{TRUE}} if they are equal, otherwise \code{\link[base:logical]{FALSE}}.} \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Options}}. } \keyword{internal} \keyword{methods} \keyword{programming} ��������������������������������������������������������������������������������������������������R.utils/man/pushTemporaryFile.Rd��������������������������������������������������������������������0000644�0001762�0000144�00000005765�14525573061�016363� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % pushTemporaryFile.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{pushTemporaryFile} \alias{pushTemporaryFile.default} \alias{pushTemporaryFile} \title{Appends a temporary suffix to the pathname} \usage{ \method{pushTemporaryFile}{default}(filename, path=NULL, suffix=".tmp", isFile=FALSE, ..., verbose=FALSE) } \description{ Appends a temporary suffix to the pathname and, optionally, renames an existing file accordingly. In combination with \code{\link{popTemporaryFile}}(), this method is useful for creating a file/writing data to file \emph{atomically}, by first writing to a temporary file which is the renamed. If for some reason the generation of the file was interrupted, for instance by a user interrupt or a power failure, then it is only the temporary file that is incomplete. } \arguments{ \item{filename}{The filename of the file.} \item{path}{The path of the file.} \item{suffix}{The suffix to be appended.} \item{isFile}{If \code{\link[base:logical]{TRUE}}, the file must exist and will be renamed on the file system. If \code{\link[base:logical]{FALSE}}, it is only the pathname string that will be modified. For details, see below.} \item{...}{Not used.} \item{verbose}{A \code{\link[base]{logical}} or \code{\link{Verbose}}.} } \value{ Returns the pathname with the suffix appended. } \details{ If \code{isFile} is \code{\link[base:logical]{FALSE}}, the pathname where the suffix of the temporary pathname has been added is returned. If \code{isFile} is \code{\link[base:logical]{TRUE}}, the file is also renamed. Then, if the file does not exists or it was not successfully renamed, an exception is thrown. } \examples{ createAtomically <- function(pathname, ...) { cat("Pathname: ", pathname, "\n", sep=""); # Generate a file atomically, i.e. the file will either be # complete or not created at all. If interrupted while # writing, only a temporary file will exist/remain. pathnameT <- pushTemporaryFile(pathname); cat("Temporary pathname: ", pathnameT, "\n", sep=""); cat(file=pathnameT, "This file was created atomically:\n"); for (kk in 1:10) { cat(file=pathnameT, kk, "\n", append=TRUE); # Emulate a slow process if (interactive()) Sys.sleep(0.1) } cat(file=pathnameT, "END OF FILE\n", append=TRUE); # Rename the temporary file pathname <- popTemporaryFile(pathnameT); pathname; } # createAtomically() pathname <- tempfile(); tryCatch({ # Try to interrupt the process while writing... pathname <- createAtomically(pathname); }, interrupt=function(intr) { str(intr); }) # ...and this will throw an exception bfr <- readLines(pathname); cat(bfr, sep="\n"); } \author{Henrik Bengtsson} \seealso{ \code{\link{popTemporaryFile}}(). } \keyword{utilities} \keyword{programming} \keyword{IO} �����������R.utils/man/Options.Rd������������������������������������������������������������������������������0000644�0001762�0000144�00000006170�14525573056�014327� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Options.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Options} \docType{class} \alias{Options} \title{The Options class} \usage{ Options(options=list(), ...) } \arguments{ \item{options}{A tree \code{\link[base]{list}} structure of options.} \item{...}{Not used.} } \description{ Package: R.utils \cr \bold{Class Options}\cr \code{\link[R.oo]{Object}}\cr \code{~~|}\cr \code{~~+--}\code{Options}\cr \bold{Directly known subclasses:}\cr \link[R.utils]{Settings}\cr public static class \bold{Options}\cr extends \link[R.oo]{Object}\cr A class to set and get either options stored in a \code{\link[base]{list}} tree structure. Each option has a pathname. The format of a pathname is similar to a (Unix) filesystem pathname, e.g. "graphics/cex". See examples for more details. } \section{Fields and Methods}{ \bold{Methods:}\cr \tabular{rll}{ \tab \code{as.character} \tab -\cr \tab \code{as.list} \tab -\cr \tab \code{equals} \tab -\cr \tab \code{getLeaves} \tab -\cr \tab \code{getOption} \tab -\cr \tab \code{hasOption} \tab -\cr \tab \code{names} \tab -\cr \tab \code{nbrOfOptions} \tab -\cr \tab \code{setOption} \tab -\cr \tab \code{str} \tab -\cr } \bold{Methods inherited from Object}:\cr $, $<-, [[, [[<-, as.character, attach, attachLocally, clearCache, clearLookupCache, clone, detach, equals, extend, finalize, getEnvironment, getFieldModifier, getFieldModifiers, getFields, getInstantiationTime, getStaticInstance, hasField, hashCode, ll, load, names, objectSize, print, save } \value{ The constructor returns an Options object. } \details{ Note, this class and its methods do \emph{not} operate on the global options structure defined in \R (\link{options}). } \examples{ local <- Options() # Query a missing option cex <- getOption(local, "graphics/cex") cat("graphics/cex =", cex, "\n") # Returns NULL # Query a missing option with default value cex <- getOption(local, "graphics/cex", defaultValue=1) cat("graphics/cex =", cex, "\n") # Returns NULL # Set option and get previous value oldCex <- setOption(local, "graphics/cex", 2) cat("previous graphics/cex =", oldCex, "\n") # Returns NULL # Set option again and get previous value oldCex <- setOption(local, "graphics/cex", 3) cat("previous graphics/cex =", oldCex, "\n") # Returns 2 # Query a missing option with default value, which is ignored cex <- getOption(local, "graphics/cex", defaultValue=1) cat("graphics/cex =", cex, "\n") # Returns 3 # Query multiple options with multiple default values multi <- getOption(local, c("graphics/cex", "graphics/pch"), c(1,2)) print(multi) # Check existance of multiple options has <- hasOption(local, c("graphics/cex", "graphics/pch")) print(has) # Get a subtree of options graphics <- getOption(local, "graphics") print(graphics) # Get the complete tree of options all <- getOption(local) print(all) } \author{Henrik Bengtsson} \keyword{classes} \keyword{programming} ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/useRepos.Rd�����������������������������������������������������������������������������0000644�0001762�0000144�00000002723�14525573061�014475� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % useRepos.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{useRepos} \alias{useRepos} \alias{parseRepos} \title{Sets package repositories} \description{ Sets package repositories. } \usage{ useRepos(repos=NULL, where=c("before", "after", "replace"), unique=TRUE, fallback=TRUE, ...) } \arguments{ \item{repos}{A \code{\link[base]{character}} \code{\link[base]{vector}} of repositories to use. If \code{\link[base]{NULL}}, nothing is replaced.} \item{where}{A \code{\link[base]{character}} string specifying how to add them to the current set of repositories.} \item{unique}{If \code{\link[base:logical]{TRUE}}, only unique repositories are set.} \item{fallback}{If \code{\link[base:logical]{TRUE}}, any remaining non-specified repository value of format '\code{...}@' (e.g. '@CRAN@') than could not be recovered by other means, will be assigned to a pre-defined known value, if possible. If so, then an informative warning is given.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{list}} with element 'repos' reflecting \code{options("repos")} as the options where prior to calling this function. } \author{Henrik Bengtsson} \seealso{ \code{\link{withRepos}}(). } \keyword{IO} \keyword{programming} ���������������������������������������������R.utils/man/getLeaves.Options.Rd��������������������������������������������������������������������0000644�0001762�0000144�00000001454�14525573056�016245� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Options.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{getLeaves.Options} \alias{getLeaves.Options} \alias{Options.getLeaves} \alias{getLeaves,Options-method} \title{Gets all (non-list) options in a flat list} \description{ Gets all (non-list) options in a flat list. } \usage{ \method{getLeaves}{Options}(this, ...) } \arguments{ \item{...}{Not used.} } \value{Returns a flat \code{\link[base]{list}} structure.} \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Options}}. } \keyword{internal} \keyword{methods} \keyword{programming} ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/off.Verbose.Rd��������������������������������������������������������������������������0000644�0001762�0000144�00000001503�14525573060�015040� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{off.Verbose} \alias{off.Verbose} \alias{Verbose.off} \alias{off,Verbose-method} \title{Turn off the output} \description{ Turn off the output. } \usage{ \method{off}{Verbose}(this, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns (invisibly) \code{\link[base:logical]{FALSE}}. } \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:on.Verbose]{*on}()} and \code{\link[R.utils:isOn.Verbose]{*isOn}()}. For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/isMatrix.Assert.Rd����������������������������������������������������������������������0000644�0001762�0000144�00000002272�14525573055�015732� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Assert.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Assert$isMatrix} \alias{Assert$isMatrix} \alias{isMatrix.Assert} \alias{Assert.isMatrix} \alias{isMatrix,Assert-method} \title{Static method asserting that an object is a matrix} \description{ Static method asserting that an object is a matrix. } \usage{ ## Static method (use this): ## Assert$isMatrix(x, nrow=NULL, ncol=NULL, ...) ## Don't use the below: \method{isMatrix}{Assert}(static, x, nrow=NULL, ncol=NULL, ...) } \arguments{ \item{x}{Object to be checked.} \item{nrow}{Required number of rows. If \code{\link[base]{NULL}}, this is not checked.} \item{ncol}{Required number of columns. If \code{\link[base]{NULL}}, this is not checked.} \item{...}{Not used.} } \value{ Returns (invisibly) \code{\link[base:logical]{TRUE}}, or throws an exception. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Assert}}. } \keyword{internal} \keyword{methods} ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/fileAccess.Rd���������������������������������������������������������������������������0000644�0001762�0000144�00000007037�14525573060�014733� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % fileAccess.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{fileAccess} \alias{fileAccess.default} \alias{fileAccess} \title{Checks the permission of a file or a directory} \description{ Checks the permission of a file or a directory. } \usage{ \method{fileAccess}{default}(pathname, mode=0, safe=TRUE, ...) } \arguments{ \item{pathname}{A \code{\link[base]{character}} string of the file or the directory to be checked.} \item{mode}{An \code{\link[base]{integer}} (0,1,2,4), cf. \code{\link[base]{file.access}}().} \item{safe}{If \code{\link[base:logical]{TRUE}}, the permissions are tested more carefully, otherwise \code{\link[base]{file.access}}() is used.} \item{...}{Not used.} } \value{ Returns an \code{\link[base]{integer}}; 0 if the permission exists, -1 if not. } \details{ In \R there is \code{\link[base]{file.access}}() for checking whether the permission of a file. Unfortunately, that function cannot be 100\% trusted depending on platform used and file system queried, cf. [1]. } \section{Symbolic links}{ This function follows symbolic links (also on Windows) and returns a value based on the link target (rather than the link itself). } \examples{ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Current directory # - - - - - - - - - - - - - - - - - - - - - - - - - - - - path <- "." # Test for existence print(fileAccess(path, mode=0)) # Test for execute permission print(fileAccess(path, mode=1)) # Test for write permission print(fileAccess(path, mode=2)) # Test for read permission print(fileAccess(path, mode=4)) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - # A temporary file # - - - - - - - - - - - - - - - - - - - - - - - - - - - - pathname <- tempfile() cat(file=pathname, "Hello world!") # Test for existence print(fileAccess(pathname, mode=0)) # Test for execute permission print(fileAccess(pathname, mode=1)) # Test for write permission print(fileAccess(pathname, mode=2)) # Test for read permission print(fileAccess(pathname, mode=4)) file.remove(pathname) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - # The 'base' package directory # - - - - - - - - - - - - - - - - - - - - - - - - - - - - path <- system.file(package="base") # Test for existence print(fileAccess(path, mode=0)) # Test for execute permission print(fileAccess(path, mode=1)) # Test for write permission print(fileAccess(path, mode=2)) # Test for read permission print(fileAccess(path, mode=4)) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - # The 'base' package DESCRIPTION file # - - - - - - - - - - - - - - - - - - - - - - - - - - - - pathname <- system.file("DESCRIPTION", package="base") # Test for existence print(fileAccess(pathname, mode=0)) # Test for execute permission print(fileAccess(pathname, mode=1)) # Test for write permission print(fileAccess(pathname, mode=2)) # Test for read permission print(fileAccess(pathname, mode=4)) } \seealso{ \code{\link[base]{file.access}}() } \references{ [1] R-devel thread \emph{file.access() on network (mounted) drive on Windows Vista?} on Nov 26, 2008. \url{https://stat.ethz.ch/pipermail/r-devel/2008-December/051461.html}\cr [2] Filesystem permissions, Wikipedia, 2010. \url{https://en.wikipedia.org/wiki/Filesystem_permissions}\cr } \author{Henrik Bengtsson} \keyword{IO} \keyword{programming} �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/exit.Verbose.Rd�������������������������������������������������������������������������0000644�0001762�0000144�00000002713�14525573060�015243� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{exit.Verbose} \alias{exit.Verbose} \alias{Verbose.exit} \alias{exit,Verbose-method} \title{Writes a message and unindents the following output} \description{ Writes a message and unindents the following output. The output is indented according to \code{\link[R.utils:enter.Verbose]{*enter}()}/\code{\link[R.utils:exit.Verbose]{*exit}()} calls. } \usage{ \method{exit}{Verbose}(this, ..., indent=-this$indentStep, sep="", suffix="...done", level=NULL) } \arguments{ \item{...}{Objects to be passed to \code{\link[R.utils:cat.Verbose]{*cat}()}. If not specified the message used in the corresponding \code{\link[R.utils:enter.Verbose]{*enter}()} call is used.} \item{indent}{The number of characters to be removed from the indentation.} \item{sep}{The default separator \code{\link[base]{character}} string.} \item{suffix}{A \code{\link[base]{character}} string to be appended to the end of the message.} \item{level}{A \code{\link[base]{numeric}} value to be compared to the threshold.} } \value{ Returns nothing. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} �����������������������������������������������������R.utils/man/setOption.Options.Rd��������������������������������������������������������������������0000644�0001762�0000144�00000002264�14525573056�016312� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Options.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{setOption.Options} \alias{setOption.Options} \alias{Options.setOption} \alias{setOption,Options-method} \title{Sets an option} \description{ Sets an option in the options tree structure. } \usage{ \method{setOption}{Options}(this, pathname, value, overwrite=TRUE, ...) } \arguments{ \item{pathname}{A single \code{\link[base]{character}} string specifying the path to the option.} \item{value}{The value to be assigned to the option.} \item{overwrite}{If \code{\link[base:logical]{TRUE}}, already existing options are overwritten, otherwise not.} \item{...}{Not used.} } \value{Returns (invisibly) the old option value.} \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:hasOption.Options]{*hasOption}()}. \code{\link[R.utils:setOption.Options]{*setOption}()}. For more information see \code{\link{Options}}. } \keyword{internal} \keyword{methods} \keyword{programming} ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/as.character.GString.Rd�����������������������������������������������������������������0000644�0001762�0000144�00000001457�14525573055�016610� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % GString-class.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{as.character.GString} \alias{as.character.GString} \alias{GString.as.character} \alias{as.character,GString-method} \title{Gets the processed character string} \description{ Gets the processed character string. } \usage{ \method{as.character}{GString}(x, envir=parent.frame(), ...) } \arguments{ \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}} string. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{GString}}. } \keyword{internal} \keyword{methods} �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/writeDataFrame.data.frame.Rd������������������������������������������������������������0000644�0001762�0000144�00000004205�14525573061�017565� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % writeDataFrame.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{writeDataFrame.data.frame} \alias{writeDataFrame.data.frame} \alias{writeDataFrame} \title{Writes a data.frame to tabular text file} \usage{ \method{writeDataFrame}{data.frame}(data, file, path=NULL, sep="\t", quote=FALSE, row.names=FALSE, col.names=!append, ..., header=list(), createdBy=NULL, createdOn=format(Sys.time(), format = "\%Y-\%m-\%d \%H:\%M:\%S \%Z"), nbrOfRows=nrow(data), headerPrefix="# ", headerSep=": ", append=FALSE, overwrite=FALSE) } \description{ Writes a data.frame to tabular text file with an optional header. } \arguments{ \item{data}{A \code{\link[base]{data.frame}}.} \item{file}{A \code{\link[base:connections]{connection}} or a filename to write to.} \item{path}{The directory where the file will be written.} \item{sep, quote, row.names, col.names, ...}{Additional arguments passed to \code{\link[utils]{write.table}}.} \item{header}{An optional named \code{\link[base]{list}} of header rows to be written at the beginning of the file. If \code{\link[base]{NULL}}, no header will be written.} \item{createdBy, createdOn, nbrOfRows}{If non-\code{\link[base]{NULL}}, common header rows to be added to the header.} \item{headerPrefix}{A \code{\link[base]{character}} string specifying the prefix of each header row.} \item{headerSep}{A \code{\link[base]{character}} string specifying the character separating the header name and header values.} \item{append}{If \code{\link[base:logical]{TRUE}}, the output is appended to an existing file.} \item{overwrite}{If \code{\link[base:logical]{TRUE}}, an existing file is overwritten.} } \value{ Returns (invisibly) the pathname to the file written (or the \code{\link[base:connections]{connection}} written to). } \author{Henrik Bengtsson} \seealso{ \code{\link[utils]{write.table}}. \code{\link{readTable}}(). } \keyword{methods} \keyword{IO} �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/convertComment.VComments.Rd�������������������������������������������������������������0000644�0001762�0000144�00000002077�14525573057�017614� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % VComments.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{convertComment.VComments} \alias{convertComment.VComments} \alias{VComments.convertComment} \alias{convertComment,VComments-method} \title{Converts a verbose comment to R code} \description{ Converts a verbose comment to R code. } \usage{ \method{convertComment}{VComments}(this, vcomment, .currLine=NA, .line=NA, ...) } \arguments{ \item{vcomment}{A vcomment \code{\link[base]{list}} structure.} \item{.currLine, .line}{A line number and the line currently processed. Used for error message and warnings.} \item{...}{Not used.} } \value{ Returns one \code{\link[base]{character}} string of \R code. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{VComments}}. } \keyword{internal} \keyword{methods} \keyword{programming} �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/printf.Rd�������������������������������������������������������������������������������0000644�0001762�0000144�00000002613�14525573061�014170� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % printf.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{printf} \alias{printf.default} \alias{printf} \title{C-style formatted output} \description{ C-style formatted output. } \usage{ \method{printf}{default}(fmt, ..., sep="", file="") } \arguments{ \item{fmt}{A \code{\link[base]{character}} vector of format strings. See same argument for \code{\link[base]{sprintf}}().} \item{...}{Additional arguments \code{\link[base]{sprintf}}().} \item{sep}{A \code{\link[base]{character}} \code{\link[base]{vector}} of strings to append after each element.} \item{file}{A \code{\link[base:connections]{connection}}, or a \code{\link[base]{character}} of a file to print to. See same argument for \code{\link[base]{cat}}().} } \value{ Returns nothing. } \examples{ cat("Hello world\n") printf("Hello world\n") x <- 1.23 cat(sprintf("x=\%.2f\n", x)) printf("x=\%.2f\n", x) y <- 4.56 cat(sprintf(c("x=\%.2f\n", "y=\%.2f\n"), c(x,y)), sep="") printf(c("x=\%.2f\n", "y=\%.2f\n"), c(x,y)) } \author{Henrik Bengtsson} \seealso{ For C-style formatting of \code{\link[base]{character}} strings, see \code{\link[base]{sprintf}}(). } \keyword{utilities} ���������������������������������������������������������������������������������������������������������������������R.utils/man/getVector.Arguments.Rd������������������������������������������������������������������0000644�0001762�0000144�00000002553�14525573054�016601� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Arguments.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Arguments$getVector} \alias{Arguments$getVector} \alias{getVector.Arguments} \alias{Arguments.getVector} \alias{getVector,Arguments-method} \title{Validates a vector} \description{ Validates a vector by checking its length (number of elements). } \usage{ ## Static method (use this): ## Arguments$getVector(x, length=NULL, .name=NULL, ...) ## Don't use the below: \method{getVector}{Arguments}(static, x, length=NULL, .name=NULL, ...) } \arguments{ \item{x}{A single \code{\link[base]{vector}}.} \item{length}{A \code{\link[base]{numeric}} \code{\link[base]{vector}} of length two or more. If two, it is the minimum and maximum length of \code{x}. Otherwise, it is the set of possible lengths of \code{x}.} \item{.name}{A \code{\link[base]{character}} string for name used in error messages.} \item{...}{Not used.} } \value{ Returns the same \code{\link[base]{vector}}, if it is valid. Otherwise an exception is thrown. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Arguments}}. } \keyword{internal} \keyword{methods} \keyword{IO} �����������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/mout.Rd���������������������������������������������������������������������������������0000644�0001762�0000144�00000003103�14525573061�013645� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % mout.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{mout} \alias{mout} \alias{mprint} \alias{mshow} \alias{mcat} \alias{mstr} \alias{mprintf} \alias{cmsg} \alias{cout} \alias{cprint} \alias{cshow} \alias{ccat} \alias{cstr} \alias{cprintf} \title{Miscellaneous functions for outputting via message()} \description{ Miscellaneous functions for outputting via message(). These "m*" methods work analogously to their corresponding "*" methods \code{\link[base]{print}}(), \code{\link[base]{cat}}(), \code{\link[methods]{show}}, \code{\link[utils]{str}}, and \code{\link{printf}}() but uses \code{\link[base]{message}}() to output the content, which in turn outputs to standard error. The \code{mout()} method can be used for all other output methods, e.g. \code{mout(write(x, file=stdout()))}. } \usage{ mout(..., appendLF=FALSE) } \arguments{ \item{...}{Arguments passed to the underlying output method.} \item{appendLF}{A \code{\link[base]{logical}} specifying whether to append a newline at the end or not.} } \value{ Returns what the \code{\link[base]{message}}() returns. } \examples{ print(letters[1:8]) mprint(letters[1:8]) cat(c(letters[1:8], "\n")) mcat(c(letters[1:8], "\n")) str(letters[1:8]) mstr(letters[1:8]) printf("x=\%d\n", 1:3) mprintf("x=\%d\n", 1:3) } \author{Henrik Bengtsson} \keyword{utilities} �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/parseDebian.System.Rd�������������������������������������������������������������������0000644�0001762�0000144�00000003213�14525573057�016370� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % System.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{System$parseDebian} \alias{System$parseDebian} \alias{parseDebian.System} \alias{System.parseDebian} \alias{parseDebian,System-method} \title{Parses a string, file or connection for Debian formatted parameters} \usage{ ## Static method (use this): ## System$parseDebian(text=NULL, file=NULL, keys=NULL, ...) ## Don't use the below: \method{parseDebian}{System}(this, text=NULL, file=NULL, keys=NULL, ...) } \arguments{ \item{text}{The text to be parsed. Default value is \code{\link[base]{NULL}}.} \item{file}{Name file, a \code{File} object or connection to be parsed. Default value is \code{\link[base]{NULL}}.} \item{keys}{The keys (names of the parameters) to be retrieved. If \code{\link[base]{NULL}} all fields are returned. Default value is \code{\link[base]{NULL}}.} Either, \code{text} or \code{file} must be given. } \description{ Parses a text, file or a connection for Debian formatted parameters. A file in Debian format contains rows with parameters of the form \code{KEY=VALUE}. It is allowed to have duplicated keys. } \value{ Returns a named \code{\link[base]{list}} of parameter values. } \examples{ file <- file.path(Package("R.utils")$path, "DESCRIPTION") l <- System$parseDebian(file=file) print(l) } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{System}}. } \keyword{internal} \keyword{methods} �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/findFiles.Rd����������������������������������������������������������������������������0000644�0001762�0000144�00000004176�14525573060�014576� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % findFiles.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{findFiles} \alias{findFiles.default} \alias{findFiles} \title{Finds one or several files in multiple directories} \description{ Finds one or several files in multiple directories. } \usage{ \method{findFiles}{default}(pattern=NULL, paths=NULL, recursive=FALSE, firstOnly=TRUE, allFiles=TRUE, ...) } \arguments{ \item{pattern}{A regular expression file name pattern to match.} \item{paths}{A \code{\link[base]{character}} \code{\link[base]{vector}} of paths to be searched.} \item{recursive}{If \code{\link[base:logical]{TRUE}}, subdirectories are recursively processed, and not if \code{\link[base:logical]{FALSE}}. Alternatively, the maximum recursive depth can be specified as a non-negative \code{\link[base]{numeric}}, where \code{\link[base:logical]{FALSE}} corresponds to \code{0L} depth and \code{\link[base:logical]{TRUE}} corresponds \code{+Inf} depth.} \item{firstOnly}{If \code{\link[base:logical]{TRUE}}, the method returns as soon as a matching file is found, otherwise not.} \item{allFiles}{If \code{\link[base:logical]{FALSE}}, files and directories starting with a period will be skipped, otherwise not.} \item{...}{Arguments passed to \code{\link[base]{list.files}}().} } \value{ Returns a \code{\link[base]{vector}} of the full pathnames of the files found. } \section{Search path}{ The \code{paths} argument may also contain paths specified as semi-colon (\code{";"}) separated paths, e.g. \code{"/usr/;usr/bin/;.;"}. } \section{Recursive searching}{ Recursive searching of directory structure is done breath-first in a lexicographic order. } \section{Windows Shortcut links}{ Windows Shortcut links (*.lnk) are recognized and can be used to imitate links to directories elsewhere. For more details, see \code{\link{filePath}}(). } \author{Henrik Bengtsson} \keyword{file} \keyword{IO} \keyword{internal} ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/as.list.MultiVerbose.Rd�����������������������������������������������������������������0000644�0001762�0000144�00000001470�14525573056�016666� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % MultiVerbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{as.list.MultiVerbose} \alias{as.list.MultiVerbose} \alias{MultiVerbose.as.list} \alias{as.list,MultiVerbose-method} \title{Gets a list of Verbose objects} \description{ Gets a list of Verbose objects. } \usage{ \method{as.list}{MultiVerbose}(x, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns a \code{\link[base]{list}} of \code{\link{Verbose}} objects. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{MultiVerbose}}. } \keyword{internal} \keyword{methods} ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/seqToHumanReadable.Rd�������������������������������������������������������������������0000644�0001762�0000144�00000002706�14525573061�016375� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % seqToHumanReadable.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{seqToHumanReadable} \alias{seqToHumanReadable.default} \alias{seqToHumanReadable} \title{Gets a short human readable string representation of an vector of indices} \description{ Gets a short human readable string representation of an vector of indices. } \usage{ \method{seqToHumanReadable}{default}(idx, tau=2L, delimiter="-", collapse=", ", ...) } \arguments{ \item{idx}{A \code{\link[base]{vector}} of \code{\link[base]{integer}} indices.} \item{tau}{A non-negative \code{\link[base]{integer}} specifying the minimum span of of a contiguous sequences for it to be collapsed to \code{<from>-<to>}.} \item{delimiter}{A \code{\link[base]{character}} string delimiter.} \item{collapse}{A \code{\link[base]{character}} string used to collapse subsequences.} \item{...}{Not used.} } \author{Henrik Bengtsson} \examples{ print(seqToHumanReadable(1:2)) # "1, 2" print(seqToHumanReadable(1:2, tau=1)) # "1-2" print(seqToHumanReadable(1:10)) # "1-10" print(seqToHumanReadable(c(1:10, 15:18, 20))) # "1-10, 15-18, 20" } \seealso{ Internally, \code{\link{seqToIntervals}}() is used. } \keyword{attribute} ����������������������������������������������������������R.utils/man/readTableIndex.Rd�����������������������������������������������������������������������0000644�0001762�0000144�00000003010�14525573061�015531� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % readTableIndex.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{readTableIndex} \alias{readTableIndex.default} \alias{readTableIndex} \title{Reads a single column from file in table format} \usage{ \method{readTableIndex}{default}(..., indexColumn=1, colClass="character", verbose=FALSE) } \description{ Reads a single column from file in table format, which can then be used as a index-to-row (look-up) map for fast access to a subset of rows using \code{\link{readTable}}(). } \arguments{ \item{indexColumn}{An single \code{\link[base]{integer}} of the index column.} \item{colClass}{A single \code{\link[base]{character}} specifying the class of the index column.} \item{...}{Arguments passed to \code{\link{readTable}}() used internally.} \item{verbose}{A \code{\link[base]{logical}} or a \code{\link{Verbose}} object.} } \value{ Returns a \code{\link[base]{vector}}. } \examples{\dontrun{ # File containing data table to be access many times filename <- "somefile.txt" # Create a look-up index index <- readTableIndex(filename) # Keys of interest keys <- c("foo", "bar", "wah") # Read only those keys and do it fast df <- readTable(filename, rows=match(keys, index)) }} \author{Henrik Bengtsson} \seealso{ \code{\link{readTable}}(). } \keyword{IO} ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/isPackageInstalled.Rd�������������������������������������������������������������������0000644�0001762�0000144�00000001565�14525573061�016422� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % isPackageInstalled.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{isPackageInstalled} \alias{isPackageInstalled.default} \alias{isPackageInstalled} \title{Checks if a package is installed or not} \description{ Checks if a package is installed or not. } \usage{ \method{isPackageInstalled}{default}(package, ...) } \arguments{ \item{package}{A \code{\link[base]{character}} \code{\link[base]{vector}} of package names.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{logical}} \code{\link[base]{vector}}. } \author{Henrik Bengtsson} \seealso{ \code{\link{isPackageLoaded}}(). } \keyword{utilities} \keyword{package} �������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/hpaste.Rd�������������������������������������������������������������������������������0000644�0001762�0000144�00000007424�14525573060�014156� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % hpaste.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{hpaste} \alias{hpaste.default} \alias{hpaste} \title{Concatenating vectors into human-readable strings} \description{ Concatenating vectors into human-readable strings such as "1, 2, 3, ..., 10". } \usage{ \method{hpaste}{default}(..., sep="", collapse=", ", lastCollapse=NULL, maxHead=if (missing(lastCollapse)) 3 else Inf, maxTail=if (is.finite(maxHead)) 1 else Inf, abbreviate="...", empty=character(0L)) } \arguments{ \item{...}{Arguments to be pasted.} \item{sep}{A \code{\link[base]{character}} string used to concatenate the arguments in \code{...}, if more than one.} \item{collapse, lastCollapse}{The \code{\link[base]{character}} strings to collapse the elements together, where \code{lastCollapse} is specifying the collapse string used between the last two elements. If \code{lastCollapse} is \code{\link[base]{NULL}} (default), it is corresponds to using the default collapse.} \item{maxHead, maxTail, abbreviate}{Non-negative \code{\link[base]{integer}}s (also \code{\link[base:is.finite]{Inf}}) specifying the maximum number of elements of the beginning and then end of the vector to be outputted. If \code{n = length(x)} is greater than \code{maxHead+maxTail+1}, then \code{x} is truncated to consist of \code{x[1:maxHead]}, \code{abbreviate}, and \code{x[(n-maxTail+1):n]}.} \item{empty}{A \code{\link[base]{character}} string, or \code{character(0)} (default), to be returned in case the result is of length zero.} } \value{ Returns a \code{\link[base]{character}} string. } \details{ \code{hpaste(..., sep=" ", maxHead=Inf)} corresponds to \code{paste(..., sep=" ", collapse=", ")}. } \author{Henrik Bengtsson} \examples{ # Some vectors x <- 1:6 y <- 10:1 z <- LETTERS[x] # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Abbreviation of output vector # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - printf("x = \%s.\n", hpaste(x)) ## x = 1, 2, 3, ..., 6. printf("x = \%s.\n", hpaste(x, maxHead=2)) ## x = 1, 2, ..., 6. printf("x = \%s.\n", hpaste(x, maxHead=3)) # Default ## x = 1, 2, 3, ..., 6. # It will never output 1, 2, 3, 4, ..., 6 printf("x = \%s.\n", hpaste(x, maxHead=4)) ## x = 1, 2, 3, 4, 5, 6. # Showing the tail printf("x = \%s.\n", hpaste(x, maxHead=1, maxTail=2)) ## x = 1, ..., 5, 6. # Turning off abbreviation printf("y = \%s.\n", hpaste(y, maxHead=Inf)) ## y = 10, 9, 8, 7, 6, 5, 4, 3, 2, 1 ## ...or simply printf("y = \%s.\n", paste(y, collapse=", ")) ## y = 10, 9, 8, 7, 6, 5, 4, 3, 2, 1 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Adding a special separator before the last element # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Change last separator printf("x = \%s.\n", hpaste(x, lastCollapse=", and ")) ## x = 1, 2, 3, 4, 5, and 6. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Backward compatibility with paste() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - s1 <- hpaste(x, maxHead=Inf) s2 <- paste(x, collapse=", ") printf("s = \%s.\n", s1); stopifnot(identical(s1, s2)) s1 <- hpaste('<', x, '>', maxHead=Inf) s2 <- paste('<', x, '>', sep="", collapse=", ") printf("s = \%s.\n", s1); stopifnot(identical(s1, s2)) s1 <- hpaste(x, y, z, sep="/", maxHead=Inf) s2 <- paste(x, y, z, sep="/", collapse=", ") printf("s = \%s.\n", s1); stopifnot(identical(s1, s2)) s1 <- hpaste(x, collapse=NULL, maxHead=Inf) s2 <- paste(x, collapse=NULL) stopifnot(identical(s1, s2)) } \seealso{ Internally \code{\link[base]{paste}}() is used. } \keyword{programming} ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/withSeed.Rd�����������������������������������������������������������������������������0000644�0001762�0000144�00000003226�14525573061�014443� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % withSeed.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{withSeed} \alias{withSeed} \title{Evaluate an R expression with a temporarily set random set} \description{ Evaluate an R expression with a temporarily set random set. } \usage{ withSeed(expr, seed, ..., substitute=TRUE, envir=parent.frame()) } \arguments{ \item{expr}{The R expression to be evaluated.} \item{seed, ...}{Arguments passed to \code{\link[base]{set.seed}}().} \item{substitute}{If \code{\link[base:logical]{TRUE}}, argument \code{expr} is \code{\link[base]{substitute}()}:ed, otherwise not.} \item{envir}{The \code{\link[base]{environment}} in which the expression should be evaluated.} } \value{ Returns the results of the expression evaluated. } \details{ Upon exit (also on errors), this function will restore \code{\link[base]{.Random.seed}} in the global environment to the value it had upon entry. If it did not exist, it will be removed. } \author{Henrik Bengtsson} \examples{ # Generate a random number y0 <- runif(1) print(y0) # Generate a random number using the same seed over and over yp <- NULL for (ii in 1:10) { y <- withSeed({ runif(1) }, seed=0x42) print(y) # Assert identical if (!is.null(yp)) stopifnot(identical(y, yp)) yp <- y } # Generate a random number y <- runif(1) print(y) } \seealso{ Internally, \code{\link[base]{set.seed}}() is used to set the random seed. } \keyword{IO} \keyword{programming} ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/getHostname.System.Rd�������������������������������������������������������������������0000644�0001762�0000144�00000002143�14525573057�016432� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % System.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{System$getHostname} \alias{System$getHostname} \alias{getHostname.System} \alias{System.getHostname} \alias{getHostname,System-method} \title{Retrieves the computer name of the current host} \description{ Retrieves the computer name of the current host. } \usage{ ## Static method (use this): ## System$getHostname(...) ## Don't use the below: \method{getHostname}{System}(static, ...) } \value{ Returns a \code{\link[base]{character}} string. } \details{ First, this function checks the system environment variables \code{HOST}, \code{HOSTNAME}, and \code{COMPUTERNAME}. Second, it checks \code{Sys.info()["nodename"]} for host name details. Finally, it tries to query the system command \code{uname -n}. } \seealso{ \code{\link[R.utils:getUsername.System]{*getUsername}()}. } \keyword{internal} \keyword{methods} �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/getUsername.System.Rd�������������������������������������������������������������������0000644�0001762�0000144�00000002072�14525573057�016434� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % System.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{System$getUsername} \alias{System$getUsername} \alias{getUsername.System} \alias{System.getUsername} \alias{getUsername,System-method} \title{Retrieves the name of the user running R} \description{ Retrieves the name of the user running R. } \usage{ ## Static method (use this): ## System$getUsername(...) ## Don't use the below: \method{getUsername}{System}(static, ...) } \value{ Returns a \code{\link[base]{character}} string. } \details{ First, this function checks the system environment variables \code{USER}, and \code{USERNAME}. Second, it checks \code{Sys.info()["user"]} for user name details. Finally, it tries to query the system command \code{whoami}. } \seealso{ \code{\link[R.utils:getHostname.System]{*getHostname}()}. } \keyword{internal} \keyword{methods} ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/getReadablePathnames.Arguments.Rd�������������������������������������������������������0000644�0001762�0000144�00000002643�14525573054�020677� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Arguments.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Arguments$getReadablePathnames} \alias{Arguments$getReadablePathnames} \alias{getReadablePathnames.Arguments} \alias{Arguments.getReadablePathnames} \alias{getReadablePathnames,Arguments-method} \title{Gets a readable pathname} \description{ Gets a readable pathname. } \usage{ ## Static method (use this): ## Arguments$getReadablePathnames(files=NULL, paths=NULL, ...) ## Don't use the below: \method{getReadablePathnames}{Arguments}(static, files=NULL, paths=NULL, ...) } \arguments{ \item{files}{A \code{\link[base]{character}} \code{\link[base]{vector}} of filenames.} \item{paths}{A \code{\link[base]{character}} \code{\link[base]{vector}} of paths.} \item{...}{Arguments passed to \code{\link[R.utils:getReadablePathname.Arguments]{*getReadablePathname}()}.} } \value{ Returns a \code{\link[base]{character}} \code{\link[base]{vector}} of the pathnames for the files. } \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:getReadablePathname.Arguments]{*getReadablePathname}()} \code{\link[R.utils]{filePath}}. For more information see \code{\link{Arguments}}. } \keyword{internal} \keyword{methods} \keyword{IO} ���������������������������������������������������������������������������������������������R.utils/man/intToBin.Rd�����������������������������������������������������������������������������0000644�0001762�0000144�00000003035�14525573061�014413� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % intToHex.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{intToBin} \alias{intToBin} \alias{intToOct} \alias{intToHex} \title{Converts an integer to a binary/octal/hexadecimal number} \description{ Converts an integer to a binary/octal/hexadecimal number. } \usage{ intToBin(x) intToOct(x) intToHex(x) } \arguments{ \item{x}{A \code{\link[base]{numeric}} vector of integers to be converted.} } \value{ Returns a \code{\link[base]{character}} string of length \code{length(x)}. For coercions out of range, \code{NA_character_} is returned for such elements. } \details{ For \code{length(x)} > 1, the number of characters in each of returned elements is the same and driven by the \code{x} element that requires the highest number of character - all other elements are padded with zeros (or ones for negative values). This is why we for instance get \code{intToHex(15) == "f"} but \code{intToHex(15:16) == c("0f", "10")}. The supported range for \code{intToHex()}, \code{intToOct()}, and \code{intToBin()} is that of \R integers, i.e. \code{[-.Machine$integer.max, +.Machine$integer.max]} where. \code{.Machine$integer.max} is \eqn{2^31-1}. This limitation is there such that negative values can be converted too. } \author{Henrik Bengtsson} \keyword{manip} \keyword{character} \keyword{programming} ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/toUrl.Rd��������������������������������������������������������������������������������0000644�0001762�0000144�00000001670�14525573061�013775� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % toUrl.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{toUrl} \alias{toUrl.default} \alias{toUrl} \title{Converts a pathname into a URL} \description{ Converts a pathname into a URL starting with \code{file://}. } \usage{ \method{toUrl}{default}(pathname, safe=TRUE, ...) } \arguments{ \item{pathname}{A \code{\link[base]{character}} \code{\link[base]{vector}} of pathnames to be made into URLs.} \item{safe}{If \code{\link[base:logical]{TRUE}}, certain "unsafe" characters are escaped.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}} \code{\link[base]{vector}}. } \author{Henrik Bengtsson} \seealso{ \code{\link[utils]{URLencode}}. } \keyword{IO} \keyword{programming} ������������������������������������������������������������������������R.utils/man/timestamp.Verbose.Rd��������������������������������������������������������������������0000644�0001762�0000144�00000001643�14525573060�016276� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{timestamp.Verbose} \alias{timestamp.Verbose} \alias{Verbose.timestamp} \alias{timestamp,Verbose-method} \title{Writes a timestamp} \description{ Writes a timestamp with default format [2005-06-23 21:20:03]. } \usage{ \method{timestamp}{Verbose}(this, format=getTimestampFormat(this), ...) } \arguments{ \item{format}{A \code{\link[base]{function}} or a \code{\link[base]{character}} specifying the format of the timestamp.} \item{...}{Not used.} } \value{ Returns nothing. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} ���������������������������������������������������������������������������������������������R.utils/man/env.Rd����������������������������������������������������������������������������������0000644�0001762�0000144�00000002770�14525573060�013461� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % env.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{env} \alias{env} \title{Creates a new environment, evaluates an expression therein, and returns the environment} \description{ Creates a new environment, evaluates an expression therein, and returns the environment. } \usage{ env(..., hash=FALSE, parent=parent.frame(), size=29L) } \arguments{ \item{...}{Arguments passed to \code{\link[base]{evalq}}(), particularly a \code{\link[base]{expression}} to be evaluated inside the newly created \code{\link[base]{environment}}.} \item{hash, parent, size}{Arguments passed to \code{\link[base]{new.env}}().} } \value{ Returns an \code{\link[base]{environment}}. } \examples{ x <- list(); x$case1 <- env({ # Cut'n'pasted from elsewhere a <- 1; b <- 2; }); x$case2 <- env({ # Cut'n'pasted from elsewhere foo <- function(x) x^2; a <- foo(2); b <- 1; rm(foo); # Not needed anymore }); # Turn into a list of lists x <- lapply(x, FUN=as.list); str(x); } \author{Henrik Bengtsson} \seealso{ Internally \code{\link[base]{new.env}}() and \code{\link[base]{evalq}}() are used. } \references{ [1] R-devel thread 'Create an environment and assign objects to it in one go?' on March 9-10, 2011.\cr } \keyword{device} \keyword{utilities} ��������R.utils/man/readWindowsShortcut.Rd������������������������������������������������������������������0000644�0001762�0000144�00000004771�14525573061�016717� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % readWindowsShortcut.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{readWindowsShortcut} \alias{readWindowsShortcut.default} \alias{readWindowsShortcut} \title{Reads a Microsoft Windows Shortcut (.lnk file)} \usage{ \method{readWindowsShortcut}{default}(con, verbose=FALSE, ...) } \description{ Reads a Microsoft Windows Shortcut (.lnk file). } \arguments{ \item{con}{A \code{\link[base:connections]{connection}} or a \code{\link[base]{character}} string (filename).} \item{verbose}{If \code{\link[base:logical]{TRUE}}, extra information is written while reading.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{list}} structure. } \examples{ pathname <- system.file("data-ex/HISTORY.LNK", package="R.utils") lnk <- readWindowsShortcut(pathname) # Print all information print(lnk) # Get the relative path to the target file history <- file.path(dirname(pathname), lnk$relativePath) # Alternatively, everything in one call history <- filePath(pathname, expandLinks="relative") } \details{ The MIME type for a Windows Shortcut file is \code{application/x-ms-shortcut}. } \author{Henrik Bengtsson} \seealso{ \code{\link{createWindowsShortcut}}() and \code{\link{filePath}()} } \references{ [1] Wotsit's Format, \url{http://www.wotsit.org/}, 2005.\cr [2] Hager J, \emph{The Windows Shortcut File Format} (as reverse-engineered by), version 1.0.\cr [3] Microsoft Developer Network, \emph{IShellLink Interface}, 2018. \url{https://learn.microsoft.com/en-us/windows/win32/api/shobjidl_core/nn-shobjidl_core-ishelllinka} \cr [4] Andrews D, \emph{Parsing Windows Shortcuts (lnk) files in java}, comp.lang.java.help, Aug 1999. \url{https://groups.google.com/d/topic/comp.lang.java.help/ouFHsH1UgKI} \cr [5] Multiple authors, \emph{Windows shell links} (in Tcl), Tcler's Wiki, April 2008. \url{https://wiki.tcl-lang.org/1844} \cr [6] Daniel S. Bensen, \emph{Shortcut File Format (.lnk)}, Stdlib.com, April 24, 2009. \cr \url{https://web.archive.org/web/20110817051855/http://www.stdlib.com/art6-Shortcut-File-Format-lnk.html} (was http://www.stdlib.com/art6-Shortcut-File-Format-lnk.html)\cr [7] [MS-SHLLINK]: Shell Link (.LNK) Binary File Format, Microsoft Inc., September 25, 2009. \cr } \keyword{file} \keyword{IO} �������R.utils/man/update.FileProgressBar.Rd���������������������������������������������������������������0000644�0001762�0000144�00000001645�14525573055�017207� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % FileProgressBar.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{update.FileProgressBar} \alias{update.FileProgressBar} \alias{FileProgressBar.update} \alias{update,FileProgressBar-method} \title{Updates file progress bar} \usage{ \method{update}{FileProgressBar}(object, visual=TRUE, ...) } \description{ Updates file progress bar. } \arguments{ \item{visual}{If \code{\link[base:logical]{TRUE}}, the file is resized according to the value of the progress bar, otherwise not.} \item{...}{Not used.} } \value{ Returns nothing. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{FileProgressBar}}. } \keyword{internal} \keyword{methods} �������������������������������������������������������������������������������������������R.utils/man/updateLabels.TextStatusBar.Rd�����������������������������������������������������������0000644�0001762�0000144�00000001676�14525573057�020064� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % TextStatusBar.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{updateLabels.TextStatusBar} \alias{updateLabels.TextStatusBar} \alias{TextStatusBar.updateLabels} \alias{updateLabels,TextStatusBar-method} \title{Sets the new values of given labels and updates the status bar} \description{ Sets the new values of given labels and updates the status bar. } \usage{ \method{updateLabels}{TextStatusBar}(this, ...) } \arguments{ \item{...}{A set of named arguments.} } \value{ Returns nothing. } \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:setLabels.TextStatusBar]{*setLabels}()}. For more information see \code{\link{TextStatusBar}}. } \keyword{internal} \keyword{methods} \keyword{programming} ������������������������������������������������������������������R.utils/man/printf.Verbose.Rd�����������������������������������������������������������������������0000644�0001762�0000144�00000002373�14525573060�015576� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{printf.Verbose} \alias{printf.Verbose} \alias{Verbose.printf} \alias{printf,Verbose-method} \title{Formats and prints object if above threshold} \description{ Formats and prints object if above threshold. The output is indented according to \code{\link[R.utils:enter.Verbose]{*enter}()}/\code{\link[R.utils:exit.Verbose]{*exit}()} calls. } \usage{ \method{printf}{Verbose}(this, fmtstr, ..., level=this$defaultLevel, timestamp=this$.timestamp) } \arguments{ \item{...}{Objects to be passed to \code{\link[base]{sprintf}}().} \item{fmtstr}{A \code{\link[base]{character}} string specify the printf format string.} \item{level}{A \code{\link[base]{numeric}} value to be compared to the threshold.} \item{timestamp}{A \code{\link[base]{logical}} indicating if output should start with a timestamp, or not.} } \value{ Returns nothing. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/isDirectory.Rd��������������������������������������������������������������������������0000644�0001762�0000144�00000002274�14525573061�015171� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % isDirectory.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{isDirectory} \alias{isDirectory.default} \alias{isDirectory} \title{Checks if the file specification is a directory} \description{ Checks if the file specification is a directory. } \usage{ \method{isDirectory}{default}(pathname, ...) } \arguments{ \item{pathname}{A \code{\link[base]{character}} string of the pathname to be checked.} \item{...}{Not used.} } \value{ Returns \code{\link[base:logical]{TRUE}} if the file specification is a directory, otherwise \code{\link[base:logical]{FALSE}} is returned. } \section{Symbolic links}{ This function follows symbolic links (also on Windows) and returns a value based on the link target (rather than the link itself). } \author{Henrik Bengtsson} \seealso{ To check if it is a file see \code{\link{isFile}}(). Internally \code{\link[base]{file.info}}() is used. See also \code{\link[utils]{file_test}}. } \keyword{IO} \keyword{programming} ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/reset.SmartComments.Rd������������������������������������������������������������������0000644�0001762�0000144�00000001436�14525573057�016612� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % SmartComments.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{reset.SmartComments} \alias{reset.SmartComments} \alias{SmartComments.reset} \alias{reset,SmartComments-method} \title{Resets a SmartComments compiler} \description{ Resets a SmartComments compiler. } \usage{ \method{reset}{SmartComments}(this, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns nothing. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{SmartComments}}. } \keyword{internal} \keyword{methods} \keyword{programming} ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/reassignInPackage.Rd��������������������������������������������������������������������0000644�0001762�0000144�00000002223�14525573061�016241� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % reassignInPackage.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{reassignInPackage} \alias{reassignInPackage.default} \alias{reassignInPackage} \title{Re-assigns a new value to an existing object in a loaded package} \description{ Re-assigns a new value to an existing object in a loaded package. } \usage{ \method{reassignInPackage}{default}(name, pkgName, value, keepOld=TRUE, ...) } \arguments{ \item{name}{The name of the object to be replaced."} \item{pkgName}{The name of the package where the object lives."} \item{value}{The new value to be assigned.} \item{keepOld}{If \code{\link[base:logical]{TRUE}}, the old value is kept as attribute \code{oldValue} in the new object.} \item{...}{Not used.} } \value{ Returns (invisibly) the new object. } \author{Henrik Bengtsson} \seealso{ See \code{assignInNamespace()} in \code{\link[utils]{getFromNamespace}}. } \keyword{internal} �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/detachPackage.Rd������������������������������������������������������������������������0000644�0001762�0000144�00000001616�14525573060�015373� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % detachPackage.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{detachPackage} \alias{detachPackage.default} \alias{detachPackage} \title{Detaches packages by name} \description{ Detaches packages by name, if loaded. } \usage{ \method{detachPackage}{default}(pkgname, ...) } \arguments{ \item{pkgname}{A \code{\link[base]{character}} \code{\link[base]{vector}} of package names to be detached.} \item{...}{Not used.} } \value{ Returns (invisibly) a named \code{\link[base]{logical}} \code{\link[base]{vector}} indicating whether each package was detached or not. } \author{Henrik Bengtsson} \seealso{ \code{\link[base]{detach}}(). } \keyword{programming} ������������������������������������������������������������������������������������������������������������������R.utils/man/mergeIntervals.numeric.Rd���������������������������������������������������������������0000644�0001762�0000144�00000003601�14525573061�017314� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % mergeIntervals.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{mergeIntervals.numeric} \alias{mergeIntervals.numeric} \title{Merges intervals} \usage{ \method{mergeIntervals}{numeric}(intervals, ...) } \description{ Merges intervals by returning an index \code{\link[base]{vector}} specifying the (first) interval that each value maps to, if any. } \arguments{ \item{intervals}{The N intervals to be merged. If an Nx2 \code{\link[base]{numeric}} \code{\link[base]{matrix}}, the first column should be the lower bounds and the second column the upper bounds of each interval. If a \code{\link[base]{numeric}} \code{\link[base]{vector}} of length 2N, each consecutive pair should be the lower and upper bounds of an interval. } \item{...}{Not used.} } \value{ Returns a \code{\link[base]{matrix}} (or a \code{\link[base]{vector}}) of M intervals, where M <= N. The intervals are ordered by their lower bounds. The @mode of the returned intervals is the same as the mode of the input intervals. } \details{ The upper and lower bounds are considered to be inclusive, that is, all intervals are interpreted to be of form [a,b]. There is currently no way to specify intervals with open bounds, e.g. (a,b]. Furthermore, the bounds are currently treated as real values. For instance, merging [0,1] and [2,3] will return the same intervals. Note, if integer intervals were treated specially, we would merge these intervals to integer interval [0,3] == \{0,1,2,3\}. } \author{Henrik Bengtsson} \seealso{ \code{\link{inAnyInterval}}(). \code{\link[base]{match}}(). } \keyword{methods} \keyword{utilities} \keyword{programming} �������������������������������������������������������������������������������������������������������������������������������R.utils/man/parse.GString.Rd������������������������������������������������������������������������0000644�0001762�0000144�00000001323�14525573055�015354� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % GString-class.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{parse.GString} \alias{parse.GString} \alias{GString.parse} \alias{parse,GString-method} \title{Parses a GString} \description{ Parses a GString. } \usage{ \method{parse}{GString}(object, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns a \code{\link[base]{list}} structure. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{GString}}. } \keyword{internal} \keyword{methods} �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/isVisible.Verbose.Rd��������������������������������������������������������������������0000644�0001762�0000144�00000002253�14525573060�016222� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{isVisible.Verbose} \alias{isVisible.Verbose} \alias{Verbose.isVisible} \alias{isVisible,Verbose-method} \title{Checks if a certain verbose level will be shown or not} \description{ Checks if a certain verbose level will be shown or not. } \usage{ \method{isVisible}{Verbose}(this, level=this$defaultLevel, ...) } \arguments{ \item{level}{A \code{\link[base]{numeric}} value to be compared to the threshold.} \item{...}{Not used.} } \value{ Returns \code{\link[base:logical]{TRUE}}, if given level is greater than (not equal to) the current threshold, otherwise \code{\link[base:logical]{FALSE}} is returned. } \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:getThreshold.Verbose]{*getThreshold}()} and \code{\link[R.utils:setThreshold.Verbose]{*setThreshold}()}. For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/TextStatusBar.Rd������������������������������������������������������������������������0000644�0001762�0000144�00000007613�14525573057�015455� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % TextStatusBar.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{TextStatusBar} \docType{class} \alias{TextStatusBar} \title{A status bar at the R prompt that can be updated} \description{ Package: R.utils \cr \bold{Class TextStatusBar}\cr \code{\link[R.oo]{Object}}\cr \code{~~|}\cr \code{~~+--}\code{TextStatusBar}\cr \bold{Directly known subclasses:}\cr \cr public static class \bold{TextStatusBar}\cr extends \link[R.oo]{Object}\cr A status bar at the R prompt that can be updated. } \usage{ TextStatusBar(fmt=paste("\%-", getOption("width") - 1, "s", sep = ""), ...) } \arguments{ \item{fmt}{A \code{\link[base]{character}} format string to be used by \code{\link[base]{sprintf}}(). Default is a left-aligned string of full width.} \item{...}{Named arguments to be passed to \code{\link[base]{sprintf}}() together with the format string.} } \section{Fields and Methods}{ \bold{Methods:}\cr \tabular{rll}{ \tab \code{flush} \tab -\cr \tab \code{getLabel} \tab -\cr \tab \code{newline} \tab -\cr \tab \code{popMessage} \tab -\cr \tab \code{setLabel} \tab -\cr \tab \code{setLabels} \tab -\cr \tab \code{update} \tab -\cr \tab \code{updateLabels} \tab -\cr } \bold{Methods inherited from Object}:\cr $, $<-, [[, [[<-, as.character, attach, attachLocally, clearCache, clearLookupCache, clone, detach, equals, extend, finalize, getEnvironment, getFieldModifier, getFieldModifiers, getFields, getInstantiationTime, getStaticInstance, hasField, hashCode, ll, load, names, objectSize, print, save } \details{ A label with name \code{hfill} can be used for automatic horizontal filling. It must be \code{\link[base]{numeric}} and be immediate before a string label such that a \code{hfill} label and the following string label together specifies an sprintf format such as \code{"\%*-s"}. The value of \code{hfill} will be set such that the resulting status bar has width equal to \code{getOption("width")-1} (the reason for the -1 is to prevent the text status bar from writing into the next line). If more than one \code{hfill} label is used their widths will be uniformly distributed. Left over spaces will be distributed between \code{hfill} labels with initial values of one. } \examples{ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Read all HTML files in the base package # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - path <- system.file(package="base") files <- list.files(path, recursive=TRUE, full.names=TRUE) files <- files[sapply(files, FUN=isFile)] nfiles <- length(files) cat(sprintf("Reading \%d files in \%s:\n", nfiles, path)) # Create a status bar with four labels sb <- TextStatusBar("File: \%-*s [\%3.0f\%\% \%7.0f bytes \%-8s]", hfill=1, file="", progress=0, nbytes=0L, time="") nbytes <- 0L for (kk in seq_len(nfiles)) { file <- files[kk] # Update the status bar if (sb) { setLabel(sb, "progress", 100*kk/nfiles) if (kk \%\% 10 == 1 || kk == nfiles) setLabel(sb, "file", substr(basename(file), 1, 44)) size <- file.info(file)$size # popMessage() calls update() too popMessage(sb, sprintf("Processing \%s (\%.2fkB)", basename(file), size/1024)) flush(sb) } # Read the file bfr <- readBin(file, what="raw", n=size) nbytes <- nbytes + size # Emulate a slow process if (interactive()) Sys.sleep(rexp(1, rate=60)) # Update the status bar if (sb) { setLabel(sb, "nbytes", nbytes) setLabel(sb, "time", format(Sys.time(), "\%H:\%M:\%S")) update(sb) } } setLabel(sb, "file", "<done>") update(sb) cat("\n") } \author{Henrik Bengtsson} \keyword{classes} \keyword{programming} \keyword{IO} ���������������������������������������������������������������������������������������������������������������������R.utils/man/check.Assert.Rd�������������������������������������������������������������������������0000644�0001762�0000144�00000002323�14525573055�015204� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Assert.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Assert$check} \alias{Assert$check} \alias{check.Assert} \alias{Assert.check} \alias{check,Assert-method} \title{Static method asserting that a generic condition is true} \description{ Static method asserting that a generic condition is true. } \usage{ ## Static method (use this): ## Assert$check(condition, message=NULL, ...) ## Don't use the below: \method{check}{Assert}(static, condition, message=NULL, ...) } \arguments{ \item{condition}{A condition that should return \code{\link[base:logical]{TRUE}} if ok, or something else if not.} \item{message}{The error message to be reported on failure. If \code{\link[base]{NULL}}, a message is automatically created.} \item{...}{Not used.} } \value{ Returns (invisibly) \code{\link[base:logical]{TRUE}}, or throws an exception. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Assert}}. } \keyword{internal} \keyword{methods} �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/hsize.Rd��������������������������������������������������������������������������������0000644�0001762�0000144�00000002736�14525573060�014015� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % hsize.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{hsize} \alias{hsize} \alias{hsize.numeric} \alias{hsize.object_size} \title{Convert byte sizes into human-readable byte sizes} \description{ Convert byte sizes into human-readable byte sizes. } \usage{ \method{hsize}{numeric}(sizes, digits=1L, units="auto", standard=getOption("hsize.standard", "IEC"), bytes=getOption("hsize.bytes", "B"), ...) \method{hsize}{object_size}(sizes, ...) } \arguments{ \item{sizes}{A \code{\link[base]{numeric}} \code{\link[base]{vector}} of sizes.} \item{digits}{Number of digits to be presented in the give unit.} \item{units}{A \code{\link[base]{character}} string specifying type of units to use.} \item{bytes}{The string used for units of bytes without a prefix. Applied only if \code{units="auto"}.} \item{...}{Not used.} } \value{ A \code{\link[base]{character}} \code{\link[base]{vector}}. } \examples{ sizes <- c(1000^(0:8), 1024^(0:8)) df <- data.frame(size=sizes) df$SI <- hsize(sizes, standard="SI") df$TB <- hsize(sizes, units="TB") df$IEC <- hsize(sizes, standard="IEC") df$TiB <- hsize(sizes, units="TiB") print(df) } \author{Henrik Bengtsson} \seealso{ \code{\link[utils]{object.size}}. } \keyword{programming} \keyword{internal} ����������������������������������R.utils/man/subplots.Rd�����������������������������������������������������������������������������0000644�0001762�0000144�00000004056�14525573061�014544� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % subplots.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{subplots} \alias{subplots.default} \alias{subplots} \title{Creates a grid of subplots} \description{ Creates a grid of subplots in the current figure. If arguments \code{nrow} and \code{ncol} are given a \code{nrow}-by-\code{ncol} grid of subplots are created. If only argument \code{n} is given then a r-by-s grid is created where |r-s| <= 1, i.e. a square or almost a square of subplots is created. If \code{n} and \code{nrow} is given then a grid with \code{nrow} rows and at least \code{n} subplots are created. Similar if \code{n} and \code{ncol} is given. The argument \code{byrow} specifies if the order of the subplots should be rowwise (\code{byrow=TRUE}) or columnwise. } \usage{ \method{subplots}{default}(n=1, nrow=NULL, ncol=NULL, byrow=TRUE, ...) } \arguments{ \item{n}{If given, the minimum number of subplots.} \item{nrow}{If given, the number of rows the grid of subplots should contain.} \item{ncol}{If given, the number of columns the grid of subplots should contain.} \item{byrow}{If \code{\link[base:logical]{TRUE}}, the panels are ordered row by row in the grid, otherwise column by column.} \item{...}{Not used.} } \value{Returns the \code{\link[base]{matrix}} containing the order of plots.} \author{Henrik Bengtsson} \examples{ subplots(nrow=2, ncol=3) # 2-by-3 grid of subplots subplots(n=6, nrow=2) # 2-by-3 grid of subplots subplots(n=5, ncol=2) # 3-by-2 grid of subplots subplots(1) # (Reset) to a 1-by-1 grid of subplots subplots(2) # 1-by-2 grid of subplots subplots(3) # 2-by-2 grid of subplots l <- subplots(8) # 3-by-3 grid of subplots layout.show(length(l)) } \seealso{ \code{\link[graphics]{layout}} and \code{layout.show}(). } ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/systemR.Rd������������������������������������������������������������������������������0000644�0001762�0000144�00000003152�14525573061�014333� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % systemR.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{systemR} \alias{systemR.default} \alias{systemR} \alias{systemR} \title{Launches another R process from within R} \usage{ \method{systemR}{default}(command="", ..., Rcommand="R", verbose=FALSE) } \description{ Launches another R process from within R via \code{\link[base]{system}}() by automatically locating the R executable, cf [1]. } \arguments{ \item{command}{A \code{\link[base]{character}} string be appended to the \code{\link[base]{system}}() call. If a \code{\link[base]{vector}}, then the strings are concatenated separated with a space.} \item{...}{Additional arguments passed to \code{\link[base]{system}}().} \item{Rcommand}{A \code{\link[base]{character}} string specifying the basename of the R executable.} \item{verbose}{A \code{\link[base]{logical}} or a \code{\link{Verbose}} object.} } \value{ Returns what \code{\link[base]{system}}() returns. } \examples{ res <- systemR(paste("--slave -e", shQuote("cat(runif(1))")), intern=TRUE) cat("A random number: ", res, "\n", sep="") } \author{Henrik Bengtsson} \references{ [1] R-devel thread 'Best way to locate R executable from within R?', May 22, 2012. } \seealso{ The R executable is located using \code{\link[base]{R.home}}(), which is then launched using \code{\link[base]{system}}(). } \keyword{programming} \keyword{IO} ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/writeRaw.Verbose.Rd���������������������������������������������������������������������0000644�0001762�0000144�00000002045�14525573060�016074� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{writeRaw.Verbose} \alias{writeRaw.Verbose} \alias{Verbose.writeRaw} \alias{writeRaw,Verbose-method} \title{Writes objects if above threshold} \description{ Writes objects if above threshold. This method is used by all other methods of this class for output. } \usage{ \method{writeRaw}{Verbose}(this, ..., sep="", level=this$defaultLevel) } \arguments{ \item{...}{Objects to be passed to \code{\link[base]{paste}}().} \item{sep}{The default separator \code{\link[base]{character}} string.} \item{level}{A \code{\link[base]{numeric}} value to be compared to the threshold.} } \value{ Returns nothing. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/gcat.Rd���������������������������������������������������������������������������������0000644�0001762�0000144�00000002351�14525573060�013602� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % gcat.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{gcat} \alias{gcat.default} \alias{gcat} \alias{gcat.GString} \title{Parses, evaluates and outputs a GString} \description{ Parses, evaluates and outputs a GString. } \usage{ \method{gcat}{default}(..., file="", append=FALSE, envir=parent.frame()) } \arguments{ \item{...}{\code{\link[base]{character}} strings passed to \code{\link{gstring}}().} \item{file}{A \code{\link[base:connections]{connection}}, or a pathname where to direct the output. If \code{""}, the output is sent to the standard output.} \item{append}{Only applied if \code{file} specifies a pathname If \code{\link[base:logical]{TRUE}}, then the output is appended to the file, otherwise the files content is overwritten.} \item{envir}{The \code{\link[base]{environment}} in which the \code{\link{GString}} is evaluated.} } \value{ Returns (invisibly) a \code{\link[base]{character}} string. } \author{Henrik Bengtsson} \seealso{ \code{\link{gstring}}(). } ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/increase.ProgressBar.Rd�����������������������������������������������������������������0000644�0001762�0000144�00000001621�14525573056�016711� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % ProgressBar.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{increase.ProgressBar} \alias{increase.ProgressBar} \alias{ProgressBar.increase} \alias{increase,ProgressBar-method} \title{Increases (steps) progress bar} \description{ Increases (steps) progress bar. } \usage{ \method{increase}{ProgressBar}(this, stepLength=this$stepLength, visual=TRUE, ...) } \arguments{ \item{stepLength}{Positive or negative step length.} \item{...}{Not used.} } \value{ Returns new value. } \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:setValue.ProgressBar]{*setValue}()}. For more information see \code{\link{ProgressBar}}. } \keyword{internal} \keyword{methods} ���������������������������������������������������������������������������������������������������������������R.utils/man/nullfile.Rd�����������������������������������������������������������������������������0000644�0001762�0000144�00000002055�14525573061�014500� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % nullfile.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{nullfile} \alias{nullfile} \alias{nullcon} \title{Gets the pathname or a connection to the NULL device on the current platform} \description{ Gets the pathname or a connection to the NULL device on the current platform. } \usage{ nullfile() nullcon() } \value{ \code{nullfile()} returns a \code{\link[base]{character}} string, which is \code{"/dev/null"} except on Windows where it is \code{"nul:"}. \code{nullcon()} returns a \emph{newly opened} (binary) \code{\link[base:connections]{connection}} to the NULL device - make sure to close it when no longer needed. } \seealso{ In R (>= 3.6.0), there exists \code{base::nullfile()}, which is identical to \code{R.utils::nullfile()}. } \author{Henrik Bengtsson} \keyword{programming} \keyword{file} �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/isDone.ProgressBar.Rd�������������������������������������������������������������������0000644�0001762�0000144�00000001463�14525573056�016345� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % ProgressBar.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{isDone.ProgressBar} \alias{isDone.ProgressBar} \alias{ProgressBar.isDone} \alias{isDone,ProgressBar-method} \title{Checks if progress bar is completed} \description{ Checks if progress bar is completed. } \usage{ \method{isDone}{ProgressBar}(this, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns \code{\link[base:logical]{TRUE}} or \code{\link[base:logical]{FALSE}}. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{ProgressBar}}. } \keyword{internal} \keyword{methods} �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/isOpen.character.Rd���������������������������������������������������������������������0000644�0001762�0000144�00000002601�14525573061�016053� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % isOpen.character.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{isOpen.character} \alias{isOpen.character} \title{Checks if there is an open connection to a file} \usage{ \method{isOpen}{character}(pathname, rw=c("read", "write"), ...) } \description{ Checks if there is an open connection to a file. } \arguments{ \item{pathname}{An \code{\link[base]{character}} \code{\link[base]{vector}}.} \item{rw}{A \code{\link[base]{character}} \code{\link[base]{vector}}. If \code{"read"}, a file is considered to be open if there exist an open connection that can read from that file. If \code{"write"}, a file is considered to be open if there exist an open connection that can write to that file. Both these values may be specified. } \item{...}{Not used.} } \value{ Returns a \code{\link[base]{logical}} \code{\link[base]{vector}} indicating for each file whether there exists an open file \code{\link[base:connections]{connection}} or not. } \author{Henrik Bengtsson} \seealso{ See \code{isOpen()} in \code{\link[base]{connections}}. \code{\link[base]{showConnections}}(). } \keyword{methods} \keyword{IO} \keyword{utilities} �������������������������������������������������������������������������������������������������������������������������������R.utils/man/update.ProgressBar.Rd�������������������������������������������������������������������0000644�0001762�0000144�00000001507�14525573056�016405� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % ProgressBar.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{update.ProgressBar} \alias{update.ProgressBar} \alias{ProgressBar.update} \alias{update,ProgressBar-method} \title{Updates progress bar} \description{ Updates progress bar. } \usage{ \method{update}{ProgressBar}(object, visual=TRUE, ...) } \arguments{ \item{visual}{If \code{\link[base:logical]{TRUE}}, the progress bar is redrawn, otherwise not.} \item{...}{Not used.} } \value{ Returns nothing. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{ProgressBar}}. } \keyword{internal} \keyword{methods} �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/tmpfile.Rd������������������������������������������������������������������������������0000644�0001762�0000144�00000001717�14525573061�014332� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % tmpfile.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{tmpfile} \alias{tmpfile} \title{Creates a temporary file with content} \description{ Creates a temporary file with content that will auto delete as soon as there is no longer any references to it. } \usage{ tmpfile(content=NULL, ...) } \arguments{ \item{content}{A \code{\link[base]{character}} string to be written to the file.} \item{...}{Optional arguments passed to \code{\link[base]{tempfile}}().} } \value{ The absolute pathname to the temporary file. } \examples{ md5 <- tools::md5sum(tmpfile("Hello world!")) print(md5) } \author{Henrik Bengtsson} \seealso{ \code{\link[base]{tempfile}}(). } \keyword{programming} \keyword{file} \keyword{internal} �������������������������������������������������R.utils/man/promptAndSave.Settings.Rd���������������������������������������������������������������0000644�0001762�0000144�00000003061�14525573056�017252� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Settings.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{promptAndSave.Settings} \alias{promptAndSave.Settings} \alias{Settings.promptAndSave} \alias{promptAndSave,Settings-method} \title{Prompt user to save modified settings} \description{ Prompt user to save modified settings. } \usage{ \method{promptAndSave}{Settings}(this, saveOption="saveSettings", settingsName=NULL, ...) } \arguments{ \item{saveOption}{A \code{\link[base]{character}} string of the option used to set if user is prompted or not.} \item{...}{Arguments passed to \code{\link{saveAnywhere}}().} } \value{ Returns \code{\link[base:logical]{TRUE}} if settings were successfully written to file, otherwise \code{\link[base:logical]{FALSE}} is returned. An exception may also be thrown. } \details{ If settings has been modified since loaded, the user is by default prompted to save the settings (if \R runs interactively). To save or not save without asking or when \R runs non-interactively, set option \code{"saveSettings"} to "yes" or "no", respectively. For prompting the user, use "prompt". } \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:isModified.Settings]{*isModified}()}. \code{\link[base]{interactive}}(). For more information see \code{\link{Settings}}. } \keyword{internal} \keyword{methods} \keyword{programming} �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/mapToIntervals.numeric.Rd���������������������������������������������������������������0000644�0001762�0000144�00000003333�14525573061�017277� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % mapToIntervals.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{mapToIntervals.numeric} \alias{mapToIntervals.numeric} \title{Maps values to intervals} \usage{ \method{mapToIntervals}{numeric}(x, intervals, includeLower=TRUE, includeUpper=TRUE, ...) } \description{ Maps values to intervals by returning an index \code{\link[base]{vector}} specifying the (first) interval that each value maps to, if any. } \arguments{ \item{x}{A \code{\link[base]{numeric}} \code{\link[base]{vector}} of K values to be matched.} \item{intervals}{The N intervals to be matched against. If an Nx2 \code{\link[base]{numeric}} \code{\link[base]{matrix}}, the first column should be the lower bounds and the second column the upper bounds of each interval. If a \code{\link[base]{numeric}} \code{\link[base]{vector}} of length 2N, each consecutive pair should be the lower and upper bounds of an interval. } \item{includeLower, includeUpper}{If \code{\link[base:logical]{TRUE}}, the lower (upper) bound of \emph{each} interval is included in the test, otherwise not.} \item{...}{Not used.} } \value{ Returns an \code{\link[base]{integer}} \code{\link[base]{vector}} of length K. Values that do not map to any interval have return value \code{\link[base]{NA}}. } \author{Henrik Bengtsson} \seealso{ \code{\link{inAnyInterval}}(). \code{\link[base]{match}}(). \code{\link[base]{findInterval}}(). \code{\link[base]{cut}}(). } \keyword{methods} \keyword{utilities} \keyword{programming} �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/format.binmode.Rd�����������������������������������������������������������������������0000644�0001762�0000144�00000001625�14525573061�015574� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % intToHex.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{format.binmode} \alias{format.binmode} \alias{as.character.binmode} \title{Converts a binary/octal/hexadecimal number into a string} \description{ Converts a binary/octal/hexadecimal number into a string. } \usage{ \method{format}{binmode}(x, ...) } \arguments{ \item{x}{Object to be converted.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}}. } \author{Henrik Bengtsson} \seealso{ \code{format.octmode()}, cf. \code{\link[base]{octmode}}. \code{\link{intToBin}}() (incl. \code{intToOct()} and \code{intToHex()}). } \keyword{manip} \keyword{character} \keyword{programming} �����������������������������������������������������������������������������������������������������������R.utils/man/evaluate.Verbose.Rd���������������������������������������������������������������������0000644�0001762�0000144�00000002052�14525573060�016074� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{evaluate.Verbose} \alias{evaluate.Verbose} \alias{Verbose.evaluate} \alias{evaluate,Verbose-method} \title{Evaluates a function and prints its results if above threshold} \description{ Evaluates a function and prints its results if above threshold. The output is \emph{not} indented. } \usage{ \method{evaluate}{Verbose}(this, fun, ..., level=this$defaultLevel) } \arguments{ \item{fun}{A \code{\link[base]{function}} to be evaluated (only if above threshold).} \item{...}{Additional arguments passed to the function.} \item{level}{A \code{\link[base]{numeric}} value to be compared to the threshold.} } \value{ Returns nothing. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/compile.SmartComments.Rd����������������������������������������������������������������0000644�0001762�0000144�00000003020�14525573057�017107� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % SmartComments.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{compile.SmartComments} \alias{compile.SmartComments} \alias{SmartComments.compile} \alias{compile,SmartComments-method} \title{Preprocess a vector of code lines} \description{ Preprocess a vector of code lines. } \usage{ \method{compile}{SmartComments}(this, lines, trim=TRUE, excludeComments=FALSE, ...) } \arguments{ \item{lines}{A \code{\link[base]{character}} \code{\link[base]{vector}} of lines of code to be preprocessed.} \item{trim}{If \code{\link[base:logical]{TRUE}}, trailing whitespace characters are removed from every line of code, and contiguous empty lines are replaced with a single empty line.} \item{excludeComments}{If \code{\link[base:logical]{TRUE}}, comments in the input lines, that is, also smart comments, are excluded.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}} \code{\link[base]{vector}}. } \details{ When called, the compiler is reset. Just before trimming is done, the validate() method is called. In the current class, this does nothing, but can be overridden in subclasses. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{SmartComments}}. } \keyword{internal} \keyword{methods} \keyword{programming} ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/writeByte.Java.Rd�����������������������������������������������������������������������0000644�0001762�0000144�00000002311�14525573055�015522� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Java.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Java$writeByte} \alias{Java$writeByte} \alias{writeByte.Java} \alias{Java.writeByte} \alias{writeByte,Java-method} \title{Writes a byte (8 bits) to a connection in Java format} \description{ Writes one or several byte's (8 bits) to a connection in Java format so they will be readable by Java. All data types in Java are signed, i.e. a byte can hold a value in the range [-128,127]. Trying to write a value outside this range will automatically be truncated without a warning. } \usage{ ## Static method (use this): ## Java$writeByte(con, b, ...) ## Don't use the below: \method{writeByte}{Java}(static, con, b, ...) } \arguments{ \item{con}{Binary connection to be written to.} \item{b}{Vector of bytes to be written.} } \details{ This method is included for consistency reasons only. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Java}}. } \keyword{internal} \keyword{methods} �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/stext.Rd��������������������������������������������������������������������������������0000644�0001762�0000144�00000003165�14525573061�014040� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % stext.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{stext} \alias{stext.default} \alias{stext} \title{Writes text in the margin along the sides of a plot} \description{ Writes text in the margin along the sides of a plot. } \usage{ \method{stext}{default}(text, side=1, line=0, pos=0.5, margin=c(0.2, 0.2), charDim=c(strwidth("M", cex = cex), strheight("M", cex = cex)), cex=par("cex"), ...) } \arguments{ \item{text}{The text to be written. See \code{\link[graphics]{mtext}} for details.} \item{side}{An \code{\link[base]{integer}} specifying which side to write the text on. See \code{\link[graphics]{mtext}} for details.} \item{line}{A \code{\link[base]{numeric}} specifying on which line to write on.} \item{pos}{A \code{\link[base]{numeric}}, often in [0,1], specifying the position of the text relative to the left and right edges.} \item{margin}{A \code{\link[base]{numeric}} \code{\link[base]{vector}} length two specifying the text margin.} \item{charDim}{A \code{\link[base]{numeric}} \code{\link[base]{vector}} length two specifying the size of a typical symbol.} \item{cex}{A \code{\link[base]{numeric}} specifying the character expansion factor.} \item{...}{Additional arguments passed to \code{\link[graphics]{mtext}}.} } \value{ Returns what \code{\link[graphics]{mtext}} returns. } \author{Henrik Bengtsson} \seealso{ Internally \code{\link[graphics]{mtext}} is used. } �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/createLink.Rd���������������������������������������������������������������������������0000644�0001762�0000144�00000005222�14525573060�014745� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % createLink.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{createLink} \alias{createLink.default} \alias{createLink} \title{Creates a link to a file or a directory} \usage{ \method{createLink}{default}(link=".", target, skip=!overwrite, overwrite=FALSE, methods=getOption("createLink/args/methods", c("unix-symlink", "windows-ntfs-symlink", "windows-shortcut")), ...) } \description{ Creates a link to a file or a directory. This method tries to create a link to a file/directory on the file system, e.g. a symbolic link and Windows Shortcut links. It depends on operating and file system (and argument settings), which type of link is finally created, but all this is hidden internally so that links can be created the same way regardless of system. } \arguments{ \item{link}{The path or pathname of the link to be created. If \code{"."} (or \code{\link[base]{NULL}}), it is inferred from the \code{target} argument, if possible.} \item{target}{The target file or directory to which the shortcut should point to.} \item{skip}{If \code{\link[base:logical]{TRUE}} and a file with the same name as argument \code{link} already exists, then the nothing is done.} \item{overwrite}{If \code{\link[base:logical]{TRUE}}, an existing link file is overwritten, otherwise not.} \item{methods}{A \code{\link[base]{character}} \code{\link[base]{vector}} specifying what methods (and in what order) should be tried for creating links.} \item{...}{Not used.} } \value{ Returns (invisibly) the path or pathname to the link. If no link was created, \code{\link[base]{NULL}} is returned. } \section{Required privileges on Windows}{ In order for \code{method="unix-symlink"} (utilizing \code{\link[base:files]{file.symlink}()}), \code{method="windows-ntfs-symlink"} (utilizing executable \code{mklink}), and/or \code{method="windows-shortcut"} (utilizing \code{\link{createWindowsShortcut}}()) to succeed on Windows, the client/R session must run with sufficient privileges (it has been reported that Administrative rights are necessary). } \author{Henrik Bengtsson} \seealso{ \code{\link{createWindowsShortcut}}() and \code{\link[base:files]{file.symlink}()} } \references{ Ben Garrett, \emph{Windows File Junctions, Symbolic Links and Hard Links}, September 2009 [\url{https://devtidbits.com/2009/09/07/windows-file-junctions-symbolic-links-and-hard-links/}]\cr } \keyword{file} \keyword{IO} ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/mkdirs.Rd�������������������������������������������������������������������������������0000644�0001762�0000144�00000004057�14525573061�014163� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % mkdirs.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{mkdirs} \alias{mkdirs.default} \alias{mkdirs} \title{Creates a directory including any necessary but nonexistent parent directories} \description{ Creates a directory including any necessary but nonexistent parent directories. } \usage{ \method{mkdirs}{default}(pathname, mustWork=FALSE, maxTries=5L, ...) } \arguments{ \item{pathname}{A \code{\link[base]{character}} string of the pathname to be checked.} \item{mustWork}{If \code{\link[base:logical]{TRUE}} and the directory does not already exists or is failed to be created, an error is thrown, otherwise not.} \item{maxTries}{A positive \code{\link[base]{integer}} specifying how many times the method should try to create a missing directory before giving up.} \item{...}{Not used.} } \value{ Returns \code{\link[base:logical]{TRUE}} if the directory was successfully created, otherwise \code{\link[base:logical]{FALSE}}. Note that if the directory already exists, \code{\link[base:logical]{FALSE}} is returned. } \section{Slow file systems}{ On very rare occasions, we have observed on a large shared file system that if one tests for the existence of a directory immediately after creating it with \code{\link[base]{dir.create}}(), it may appear not to be created. We believe this is due to the fact that there is a short delay between creating a directory and that information being fully propagated on the file system. To minimize the risk for such false assertions on "slow" file systems, this method tries to create a missing directory multiple times (argument \code{maxTries}) (while waiting a short period of time between each round) before giving up. } \author{Henrik Bengtsson} \seealso{ Internally \code{\link[base:files]{dir.create}}() is used. } \keyword{IO} \keyword{programming} ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/createFileAtomically.Rd�����������������������������������������������������������������0000644�0001762�0000144�00000007715�14525573060�016757� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % createFileAtomically.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{createFileAtomically} \alias{createFileAtomically.default} \alias{createFileAtomically} \title{Creates a file atomically} \usage{ \method{createFileAtomically}{default}(filename, path=NULL, FUN, ..., skip=FALSE, overwrite=FALSE, backup=TRUE, verbose=FALSE) } \description{ Creates a file atomically by first creating and writing to a temporary file which is then renamed. } \arguments{ \item{filename}{The filename of the file to create.} \item{path}{The path to the file.} \item{FUN}{A \code{\link[base]{function}} that creates and writes to the pathname that is passed as the first argument. This pathname is guaranteed to be a non-existing temporary pathname.} \item{...}{Additional arguments passed to \code{\link{pushTemporaryFile}}() and \code{\link{popTemporaryFile}}().} \item{skip}{If \code{\link[base:logical]{TRUE}} and a file with the same pathname already exists, nothing is done/written.} \item{overwrite}{If \code{\link[base:logical]{TRUE}} and a file with the same pathname already exists, the existing file is overwritten. This is also done atomically such that if the new file was not successfully created, the already original file is restored. If restoration also failed, the original file remains as the pathname with suffix \code{".bak"} appended.} \item{backup}{If \code{\link[base:logical]{TRUE}} and a file with the same pathname already exists, then it is backed up while creating the new file. If the new file was not successfully created, the original file is restored from the backup copy.} \item{verbose}{A \code{\link[base]{logical}} or \code{\link{Verbose}}.} } \value{ Returns (invisibly) the pathname. } \examples{ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Create a file atomically # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - n <- 10 pathname <- createFileAtomically("foobar.txt", path=tempdir(), FUN=function(pathname) { cat(file=pathname, "This file was created atomically.\n") cat(file=pathname, "Timestamp: ", as.character(Sys.time()), "\n", sep="") for (kk in 1:n) { cat(file=pathname, kk, "\n", append=TRUE) # Emulate a slow process if (interactive()) Sys.sleep(0.1) } cat(file=pathname, "END OF FILE\n", append=TRUE) }, overwrite=TRUE) bfr <- readLines(pathname) cat(bfr, sep="\n") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Overwrite the file atomically (emulate write failure) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - tryCatch({ pathname <- createFileAtomically("foobar.txt", path=tempdir(), FUN=function(pathname) { cat(file=pathname, "Trying to create a new file.\n") cat(file=pathname, "Writing a bit, but then an error...\n", append=TRUE) # Emulate write error stop("An error occured while writing to the new file.") cat(file=pathname, "END OF FILE\n", append=TRUE) }, overwrite=TRUE) }, error = function(ex) { print(ex$message) }) # The original file was never overwritten bfr2 <- readLines(pathname) cat(bfr2, sep="\n") stopifnot(identical(bfr2, bfr)) # The partially temporary file remains pathnameT <- sprintf("\%s.tmp", pathname) stopifnot(isFile(pathnameT)) bfr3 <- readLines(pathnameT) cat(bfr3, sep="\n") file.remove(pathnameT) file.remove(pathname) } \author{Henrik Bengtsson} \seealso{ Internally, \code{\link{pushTemporaryFile}}() and \code{\link{popTemporaryFile}}() are used for working toward a temporary file, and \code{\link{pushBackupFile}}() and \code{\link{popBackupFile}}() are used for backing up and restoring already existing file. } \keyword{utilities} \keyword{programming} \keyword{IO} ���������������������������������������������������R.utils/man/copyDirectory.Rd������������������������������������������������������������������������0000644�0001762�0000144�00000002452�14525573060�015525� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % copyDirectory.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{copyDirectory} \alias{copyDirectory.default} \alias{copyDirectory} \title{Copies a directory} \description{ Copies a directory. } \usage{ \method{copyDirectory}{default}(from, to=".", ..., private=TRUE, recursive=TRUE) } \arguments{ \item{from}{The pathname of the source directory to be copied.} \item{to}{The pathname of the destination directory.} \item{...}{Additional arguments passed to \code{\link[base:files]{file.copy}}(), e.g. \code{overwrite}.} \item{private}{If \code{\link[base:logical]{TRUE}}, files (and directories) starting with a period is also copied, otherwise not.} \item{recursive}{If \code{\link[base:logical]{TRUE}}, subdirectories are copied too, otherwise not.} } \value{ Returns (invisibly) a \code{\link[base]{character}} \code{\link[base]{vector}} of pathnames copied. } \details{ Note that this method does \emph{not} use \code{\link{copyFile}}() to copy the files, but \code{\link[base]{file.copy}}(). } \author{Henrik Bengtsson} \keyword{file} ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/readUTF.Java.Rd�������������������������������������������������������������������������0000644�0001762�0000144�00000002750�14525573055�015045� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Java.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Java$readUTF} \alias{Java$readUTF} \alias{readUTF.Java} \alias{Java.readUTF} \alias{readUTF,Java-method} \title{Reads a Java (UTF-8) formatted string from a connection} \description{ Reads a Java (UTF-8) formatted string from a connection. } \usage{ ## Static method (use this): ## Java$readUTF(con, as.character=TRUE, ...) ## Don't use the below: \method{readUTF}{Java}(static, con, as.character=TRUE, ...) } \arguments{ \item{con}{Binary connection to be read from.} \item{as.character}{If \code{\link[base:logical]{TRUE}}, the read string converted, i.e. translated, into an \R character string before returned, otherwise an integer vector representation of the Unicode string is returned.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}} string or an \code{\link[base]{integer}} \code{\link[base]{vector}}. } \details{ Currently only 8-bit UTF-8 byte sequences are supported, i.e. plain ASCII sequences, i.e. characters that take up more than one byte are read \emph{incorrectly} without any warnings. } \author{Henrik Bengtsson} \seealso{ \code{\link[base]{readBin}}(). For more information see \code{\link{Java}}. } \keyword{internal} \keyword{methods} ������������������������R.utils/man/findSourceTraceback.Rd������������������������������������������������������������������0000644�0001762�0000144�00000004276�14525573060�016575� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % findSourceTraceback.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{findSourceTraceback} \alias{findSourceTraceback.default} \alias{findSourceTraceback} \title{Finds all 'srcfile' objects generated by source() in all call frames} \usage{ \method{findSourceTraceback}{default}(...) } \description{ Finds all 'srcfile' objects generated by source() in all call frames. This makes it possible to find out which files are currently scripted by \code{\link[base]{source}}(). } \arguments{ \item{...}{Not used.} } \value{ Returns a named list of \code{\link[base]{srcfile}}() objects and/or \code{\link[base]{character}} strings. The names of the list entries corresponds to the 'filename' value of each corresponding 'srcfile' object. The returned list is empty if \code{\link[base]{source}}() was not called. } \examples{ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Create two R script files where one source():s the other # and both lists the traceback of filenames source():d. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - path <- tempdir() pathnameA <- Arguments$getWritablePathname("foo.R", path=path) pathnameB <- Arguments$getWritablePathname("bar.R", path=path) code <- 'cat("BEGIN foo.R\n")' code <- c(code, 'print(findSourceTraceback());') code <- c(code, sprintf('source("\%s");', pathnameB)) code <- c(code, 'cat("END foo.R\n")') code <- paste(code, collapse="\n") cat(file=pathnameA, code) code <- 'cat("BEGIN bar.R\n")' code <- c(code, 'x <- findSourceTraceback();') code <- c(code, 'print(x);') code <- c(code, 'cat("END bar.R\n")') code <- paste(code, collapse="\n") cat(file=pathnameB, code) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Source the first file # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - source(pathnameA, echo=TRUE) } \author{Henrik Bengtsson} \seealso{ See also \code{\link[utils]{sourceutils}}. } \keyword{IO} \keyword{programming} ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/withTimeout.Rd��������������������������������������������������������������������������0000644�0001762�0000144�00000015076�14525573061�015217� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % withTimeout.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{withTimeout} \alias{withTimeout} \title{Evaluate an R expression and interrupts it if it takes too long} \description{ Evaluate an R expression and interrupts it if it takes too long. } \usage{ withTimeout(expr, substitute=TRUE, envir=parent.frame(), timeout, cpu=timeout, elapsed=timeout, onTimeout=c("error", "warning", "silent"), ...) } \arguments{ \item{expr}{The R expression to be evaluated.} \item{substitute}{If \code{\link[base:logical]{TRUE}}, argument \code{expr} is \code{\link[base]{substitute}()}:ed, otherwise not.} \item{envir}{The \code{\link[base]{environment}} in which the expression should be evaluated.} \item{timeout, cpu, elapsed}{A \code{\link[base]{numeric}} specifying the maximum number of seconds the expression is allowed to run before being interrupted by the timeout. The \code{cpu} and \code{elapsed} arguments can be used to specify whether time should be measured in CPU time or in wall time.} \item{onTimeout}{A \code{\link[base]{character}} specifying what action to take if a timeout event occurs.} \item{...}{Not used.} } \value{ Returns the results of the expression evaluated. If timed out, \code{\link[base]{NULL}} is returned if \code{onTimeout} was \code{"warning"} or \code{"silent"}. If \code{"error"} a \code{\link{TimeoutException}} is thrown. } \details{ This method utilizes \code{\link[base]{setTimeLimit}}() by first setting the timeout limits, then evaluating the expression that may or may not timeout. The method is guaranteed to reset the timeout limits to be infinitely long upon exiting, regardless whether it returns normally or preemptively due to a timeout or an error. } \section{Known limitation: Not everything can be timed out}{ In order to understand when this function works and when it does not, it is useful to know that it utilizes R's built-in time-out mechanism, which sets the limits on what is possible and not. From \code{\link[base]{setTimeLimit}}(), we learn that: \emph{"Time limits are checked whenever a user interrupt could occur. This will happen frequently in R code and during Sys.sleep(*), but only at points in compiled C and Fortran code identified by the code author."} More precisely, if a function is implemented in native code (e.g. C) and the developer of that function does not check for user interrupts, then you cannot interrupt that function neither via a user interrupt (e.g. Ctrl-C) \emph{nor via the built-in time out mechanism}. To change this, you need to contact the developer of that piece of code and ask them to check for R user interrupts in their native code. Furthermore, it is not possible to interrupt/break out of a "readline" prompt (e.g. \code{\link[base]{readline}}() and \code{\link[base]{readLines}}()) using timeouts; the timeout exception will not be thrown until after the user completes the prompt (i.e. after pressing ENTER). System calls via \code{\link[base]{system}}() and \code{system2()} cannot be timed out via the above mechanisms. However, in \R (>= 3.5.0) these functions have argument \code{timeout} providing their own independent timeout mechanism. Other examples of calls that do \emph{not} support timeout are "atomic" calls that may take very long such as large object allocation and \code{rnorm(n)} where \code{n} is very large. (*) Note that on Unix and macOS, \code{Sys.sleep(time)} will signal a timeout error only \emph{after} \code{time} seconds passed, regardless of \code{timeout} limit (< \code{time}). } \section{Known limitation: May fail when temporarily switching language}{ \code{withTimeout()} does \emph{not} handle the case when the expression evaluated \emph{temporarily} switches the language used by R, e.g. assume we run in a non-French locale and call: \preformatted{ withTimeout({ olang <- Sys.getenv("LANGUAGE") on.exit(Sys.setenv(LANGUAGE=olang)) Sys.setenv(LANGUAGE="fr") repeat Sys.sleep(0.1) }, timeout = 1.0, onTimeout = "warning") } In this case, the error message produced by \code{\link[base]{setTimeLimit}}() is in French, i.e. `la limite de temps est atteinte`. However, when \code{withTimeout()} inspects this message, it can \emph{not} know that French was used, and will therefore not check against the French template message for timeout errors. Because of this, \code{withTimeout()} fails to detect the timeout error (and therefore also deescalate it to a warning in this example). \emph{Comment}: This appears to only fail on MS Windows and macOS, whereas on Linux, \code{withTimeout()} appears to work, but it is unknown why there is a difference between operating systems in this case. } \author{Henrik Bengtsson} \examples{ # - - - - - - - - - - - - - - - - - - - - - - - - - # Function that takes "a long" time to run # - - - - - - - - - - - - - - - - - - - - - - - - - foo <- function() { print("Tic") for (kk in 1:100) { print(kk) Sys.sleep(0.1) } print("Tac") } # - - - - - - - - - - - - - - - - - - - - - - - - - # Evaluate code, if it takes too long, generate # a timeout by throwing a TimeoutException. # - - - - - - - - - - - - - - - - - - - - - - - - - res <- NULL tryCatch({ res <- withTimeout({ foo() }, timeout = 0.75) }, TimeoutException = function(ex) { message("Timeout. Skipping.") }) # - - - - - - - - - - - - - - - - - - - - - - - - - # Evaluate code, if it takes too long, generate # a timeout returning NULL and generate a warning. # - - - - - - - - - - - - - - - - - - - - - - - - - res <- withTimeout({ foo() }, timeout = 0.75, onTimeout = "warning") # The same using an expression object expr <- quote(foo()) res <- withTimeout(expr, substitute = FALSE, timeout = 0.75, onTimeout = "warning") # - - - - - - - - - - - - - - - - - - - - - - - - - # Evaluate code, if it takes too long, generate # a timeout, and return silently NULL. # - - - - - - - - - - - - - - - - - - - - - - - - - res <- withTimeout({ foo() }, timeout = 0.75, onTimeout = "silent") } \seealso{ Internally, \code{\link[base]{eval}}() is used to evaluate the expression and \code{\link[base]{setTimeLimit}}() is used to control for timeout events. } \references{ [1] R help thread 'Time out for a R Function' on 2010-12-07. \url{https://stat.ethz.ch/pipermail/r-help/2010-December/262316.html} \cr } \keyword{IO} \keyword{programming} ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/as.character.ProgressBar.Rd�������������������������������������������������������������0000644�0001762�0000144�00000001503�14525573056�017455� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % ProgressBar.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{as.character.ProgressBar} \alias{as.character.ProgressBar} \alias{ProgressBar.as.character} \alias{as.character,ProgressBar-method} \title{Gets a string description of the progress bar} \description{ Gets a string description of the progress bar. } \usage{ \method{as.character}{ProgressBar}(x, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}} string. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{ProgressBar}}. } \keyword{internal} \keyword{methods} ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/readBinFragments.Rd���������������������������������������������������������������������0000644�0001762�0000144�00000012201�14525573061�016073� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % readBinFragments.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{readBinFragments} \alias{readBinFragments.default} \alias{readBinFragments} \title{Reads binary data from disjoint sections of a connection or a file} \usage{ \method{readBinFragments}{default}(con, what, idxs=1, origin=c("current", "start"), size=NA, ..., verbose=FALSE) } \description{ Reads binary data from disjoint sections of a connection or a file. } \arguments{ \item{con}{A \code{\link[base:connections]{connection}} or the pathname of an existing file.} \item{what}{A \code{\link[base]{character}} string or an object specifying the the data type (\code{\link[base]{mode}}()) to be read.} \item{idxs}{A \code{\link[base]{vector}} of (non-duplicated) indices or a Nx2 \code{\link[base]{matrix}} of N from-to index intervals specifying the elements to be read. Positions are either relative to the start or the current location of the file/connection as given by argument \code{origin}.} \item{origin}{A \code{\link[base]{character}} string specify whether the indices in argument \code{idxs} are relative to the \code{"start"} or the \code{"current"} position of the file/connection.} \item{size}{The size of the data type to be read. If \code{\link[base]{NA}}, the natural size of the data type is used.} \item{...}{Additional arguments passed to \code{\link[base]{readBin}}().} \item{verbose}{A \code{\link[base]{logical}} or a \code{\link{Verbose}} object.} } \value{ Returns a \code{\link[base]{vector}} of the requested \code{\link[base]{mode}}(). } \examples{ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Create a data file # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - data <- 1:255 size <- 2 pathname <- tempfile("exampleReadBinFragments") writeBin(con=pathname, data, size=size) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Read and write using index vectors # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - cat("Read file...\n") # Read every 16:th byte in the file idxs <- seq(from=1, to=255, by=16) x <- readBinFragments(pathname, what="integer", size=size, signed=FALSE, idxs=idxs) stopifnot(identical(x, data[idxs])) print(x) # Read every 16:th byte in a connection starting with the 6th. idxs <- idxs + 5L x <- readBinFragments(pathname, what="integer", size=size, signed=FALSE, idxs=idxs) stopifnot(identical(x, data[idxs])) print(x) cat("Read file...done\n") cat("Write file...\n") # Update every 16:th byte in the file idxs <- seq(from=1, to=255, by=16) x0 <- data[idxs] writeBinFragments(pathname, idxs=idxs, rev(x0), size=size) x <- readBinFragments(pathname, what="integer", size=size, signed=FALSE, idxs=idxs) print(x) stopifnot(identical(rev(x0), x)) # Update every 16:th byte in the file idxs <- seq(from=1, to=255, by=16) writeBinFragments(pathname, idxs=idxs, rev(x), size=size) x <- readBinFragments(pathname, what="integer", size=size, signed=FALSE, idxs=idxs) print(x) stopifnot(identical(x0, x)) # Assert everything is as expected # Read the complete file x <- readBin(pathname, what="integer", size=size, signed=FALSE, n=length(data)) stopifnot(identical(x, data)) cat("Write file...done\n") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Ditto but via a connection # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - cat("Read connection...\n") # Read every 16:th byte in a connection con <- file(pathname, open="rb") idxs <- seq(from=1, to=255, by=16) x <- readBinFragments(con, what="integer", size=size, signed=FALSE, idxs=idxs) stopifnot(identical(x, data[idxs])) print(x) # Read every 16:th byte in a connection starting with the 6th. idxs <- idxs + 5L x <- readBinFragments(con, what="integer", size=size, signed=FALSE, idxs=idxs, origin="start") stopifnot(identical(x, data[idxs])) print(x) close(con) cat("Read connection...done\n") # Update every 16:th byte in a connection cat("Write connection...\n") con <- file(pathname, open="r+b") idxs <- seq(from=1, to=255, by=16) x0 <- data[idxs] writeBinFragments(pathname, idxs=idxs, rev(x0), size=size) x <- readBinFragments(pathname, what="integer", size=size, signed=FALSE, idxs=idxs) print(x) stopifnot(identical(rev(x0), x)) # Update every 16:th byte in the file idxs <- seq(from=1, to=255, by=16) writeBinFragments(pathname, idxs=idxs, rev(x), size=size) x <- readBinFragments(pathname, what="integer", size=size, signed=FALSE, idxs=idxs, origin="start") print(x) stopifnot(identical(x0, x)) close(con) # Assert everything is as expected # Read the complete file x <- readBin(pathname, what="integer", size=size, signed=FALSE, n=length(data)) stopifnot(identical(x, data)) cat("Write connection...done\n") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Clean up # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - file.remove(pathname) } \author{Henrik Bengtsson} \seealso{ \code{\link{writeBinFragments}}(). } \keyword{IO} �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/asLong.Java.Rd��������������������������������������������������������������������������0000644�0001762�0000144�00000001635�14525573055�014777� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Java.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Java$asLong} \alias{Java$asLong} \alias{asLong.Java} \alias{Java.asLong} \alias{asLong,Java-method} \title{Converts a numeric to a Java long} \description{ Converts a numeric to a Java long. } \usage{ ## Static method (use this): ## Java$asLong(x, ...) ## Don't use the below: \method{asLong}{Java}(static, x, ...) } \arguments{ \item{x}{A \code{\link[base]{numeric}} \code{\link[base]{vector}}.} \item{...}{Not used.} } \value{ Returns an \code{\link[base]{integer}} \code{\link[base]{vector}}. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Java}}. } \keyword{internal} \keyword{methods} ���������������������������������������������������������������������������������������������������R.utils/man/isFile.Rd�������������������������������������������������������������������������������0000644�0001762�0000144�00000002236�14525573061�014102� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % isFile.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{isFile} \alias{isFile.default} \alias{isFile} \title{Checks if the file specification is a file} \description{ Checks if the file specification is a file. } \usage{ \method{isFile}{default}(pathname, ...) } \arguments{ \item{pathname}{A \code{\link[base]{character}} string of the pathname to be checked.} \item{...}{Not used.} } \value{ Returns \code{\link[base:logical]{TRUE}} if the file specification is a file, otherwise \code{\link[base:logical]{FALSE}} is returned. } \section{Symbolic links}{ This function follows symbolic links (also on Windows) and returns a value based on the link target (rather than the link itself). } \author{Henrik Bengtsson} \seealso{ To check if it is a directory see \code{\link{isDirectory}}(). Internally \code{\link[base]{file.info}}() is used. See also \code{\link[utils]{file_test}}. } \keyword{IO} \keyword{programming} ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/isVector.Assert.Rd����������������������������������������������������������������������0000644�0001762�0000144�00000002105�14525573055�015723� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Assert.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Assert$isVector} \alias{Assert$isVector} \alias{isVector.Assert} \alias{Assert.isVector} \alias{isVector,Assert-method} \title{Static method asserting that an object is a vector} \description{ Static method asserting that an object is a vector. } \usage{ ## Static method (use this): ## Assert$isVector(x, length=NULL, ...) ## Don't use the below: \method{isVector}{Assert}(static, x, length=NULL, ...) } \arguments{ \item{x}{Object to be checked.} \item{length}{Required length. If \code{\link[base]{NULL}}, this is not checked.} \item{...}{Not used.} } \value{ Returns (invisibly) \code{\link[base:logical]{TRUE}}, or throws an exception. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Assert}}. } \keyword{internal} \keyword{methods} �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/writeRaw.NullVerbose.Rd�����������������������������������������������������������������0000644�0001762�0000144�00000003412�14525573056�016733� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % NullVerbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{writeRaw.NullVerbose} \alias{writeRaw.NullVerbose} \alias{NullVerbose.writeRaw} \alias{writeRaw,NullVerbose-method} \alias{NullVerbose.cat} \alias{cat.NullVerbose} \alias{cat,NullVerbose-method} \alias{NullVerbose.printf} \alias{printf.NullVerbose} \alias{printf,NullVerbose-method} \alias{NullVerbose.enter} \alias{enter.NullVerbose} \alias{enter,NullVerbose-method} \alias{NullVerbose.exit} \alias{exit.NullVerbose} \alias{exit,NullVerbose-method} \alias{NullVerbose.print} \alias{print.NullVerbose} \alias{print,NullVerbose-method} \alias{NullVerbose.str} \alias{str.NullVerbose} \alias{str,NullVerbose-method} \alias{NullVerbose.summary} \alias{summary.NullVerbose} \alias{summary,NullVerbose-method} \alias{NullVerbose.evaluate} \alias{evaluate.NullVerbose} \alias{evaluate,NullVerbose-method} \alias{NullVerbose.newline} \alias{newline.NullVerbose} \alias{newline,NullVerbose-method} \alias{NullVerbose.ruler} \alias{ruler.NullVerbose} \alias{ruler,NullVerbose-method} \alias{NullVerbose.header} \alias{header.NullVerbose} \alias{header,NullVerbose-method} \title{All output methods} \description{ All output methods of this class ignores their input arguments and outputs nothing. } \usage{ \method{writeRaw}{NullVerbose}(...) } \arguments{ \item{...}{Ignored.} } \value{ Returns nothing. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{NullVerbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/readWindowsShellLink.Rd�����������������������������������������������������������������0000644�0001762�0000144�00000003351�14525573061�016762� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % readWindowsShellLink.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{readWindowsShellLink} \alias{readWindowsShellLink.default} \alias{readWindowsShellLink} \title{Reads a Microsoft Windows Shortcut (.lnk file)} \usage{ \method{readWindowsShellLink}{default}(con, clean=TRUE, verbose=FALSE, ...) } \description{ Reads a Microsoft Windows Shortcut (.lnk file). } \arguments{ \item{con}{A \code{\link[base:connections]{connection}} or a \code{\link[base]{character}} string (filename).} \item{clean}{If \code{\link[base:logical]{TRUE}}, low-level file specific fields are dropped, e.g. offsets on file locations.} \item{verbose}{If \code{\link[base:logical]{TRUE}}, extra information is written while reading.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{list}} structure. } \examples{ pathname <- system.file("data-ex/HISTORY.LNK", package="R.utils") lnk <- readWindowsShellLink(pathname) str(lnk) str(lnk$pathname) lnk0 <- readWindowsShortcut(pathname) str(lnk0$pathname) } \details{ This function is implemented based on the official file format specification [1]. It is intended to replace \code{\link{readWindowsShortcut}}(), which was written based on reverse engineering (before [1] was made available). } \author{Henrik Bengtsson} \seealso{ \code{\link{readWindowsShortcut}}() \code{\link{filePath}} } \references{ [1] [MS-SHLLINK]: Shell Link (.LNK) Binary File Format, Microsoft Inc., September 25, 2009. \cr } \keyword{file} \keyword{IO} \keyword{internal} ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/egsub.Rd��������������������������������������������������������������������������������0000644�0001762�0000144�00000004571�14525573060�013777� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % egsub.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{egsub} \alias{egsub} \title{Global substitute of expression using regular expressions} \description{ Global substitute of expression using regular expressions. } \usage{ egsub(pattern, replacement, x, ..., value=TRUE, envir=parent.frame(), inherits=TRUE) } \arguments{ \item{pattern}{A \code{\link[base]{character}} string with the regular expression to be matched, cf. \code{\link[base]{gsub}}().} \item{replacement}{A \code{\link[base]{character}} string of the replacement to use when there is a match, cf. \code{\link[base]{gsub}}().} \item{x}{The \code{\link[base]{expression}} or a \code{\link[base]{function}} to be modified.} \item{...}{Additional arguments passed to \code{\link[base]{gsub}}()} \item{value}{If \code{\link[base:logical]{TRUE}}, the value of the replacement itself is used to look up a variable with that name and then using that variables value as the replacement. Otherwise the replacement value is used.} \item{envir, inherits}{An \code{\link[base]{environment}} from where to find the variable and whether the search should also include enclosing frames, cf. \code{\link[base]{get}}(). Only use if \code{value} is \code{\link[base:logical]{TRUE}}.} } \value{ Returns an \code{\link[base]{expression}}. } \examples{ # Original expression expr <- substitute({ res <- foo.bar.yaa(2) print(res) R.utils::use("R.oo") x <- .b. }) # Some predefined objects foo.bar.yaa <- function(x) str(x) a <- 2 b <- a # Substitute with variable name expr2 <- egsub("^[.]([a-zA-Z0-9_.]+)[.]$", "\\\\1", expr, value=FALSE) print(expr2) ## { ## res <- foo.bar.yaa(2) ## print(res) ## R.utils::use("R.oo") ## x <- b ## } # Substitute with variable value expr3 <- egsub("^[.]([a-zA-Z0-9_.]+)[.]$", "\\\\1", expr, value=TRUE) print(expr3) ## { ## res <- foo.bar.yaa(2) ## print(res) ## R.utils::use("R.oo") ## x <- 2 ## } # Substitute the body of a function warnifnot <- egsub("stop", "warning", stopifnot, value=FALSE) print(warnifnot) warnifnot(pi == 3.14) } \author{Henrik Bengtsson} \keyword{utilities} \keyword{programming} ���������������������������������������������������������������������������������������������������������������������������������������R.utils/man/cleanup.FileProgressBar.Rd��������������������������������������������������������������0000644�0001762�0000144�00000001717�14525573055�017354� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % FileProgressBar.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{cleanup.FileProgressBar} \alias{cleanup.FileProgressBar} \alias{FileProgressBar.cleanup} \alias{cleanup,FileProgressBar-method} \title{Removes the progress file for a file progress bar} \usage{ \method{cleanup}{FileProgressBar}(object, ...) } \description{ Removes the progress file for a file progress bar. } \arguments{ \item{...}{Not used.} } \value{ Returns (invisibly) \code{\link[base:logical]{TRUE}}, if there is no progress file afterwards. Otherwise, \code{\link[base:logical]{FALSE}} is returned. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{FileProgressBar}}. } \keyword{internal} \keyword{methods} �������������������������������������������������R.utils/man/getBuiltinRhome.GString.Rd��������������������������������������������������������������0000644�0001762�0000144�00000001641�14525573055�017346� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % GString-class.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{GString$getBuiltinRhome} \alias{GString$getBuiltinRhome} \alias{getBuiltinRhome.GString} \alias{GString.getBuiltinRhome} \alias{getBuiltinRhome,GString-method} \title{Gets the path where R is installed} \description{ Gets the path where R is installed. } \usage{ ## Static method (use this): ## GString$getBuiltinRhome(...) ## Don't use the below: \method{getBuiltinRhome}{GString}(static, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}} string. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{GString}}. } \keyword{internal} \keyword{methods} �����������������������������������������������������������������������������������������������R.utils/man/isOn.NullVerbose.Rd���������������������������������������������������������������������0000644�0001762�0000144�00000001422�14525573056�016036� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % NullVerbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{isOn.NullVerbose} \alias{isOn.NullVerbose} \alias{NullVerbose.isOn} \alias{isOn,NullVerbose-method} \title{Checks if the output is on} \description{ Checks if the output is on. } \usage{ \method{isOn}{NullVerbose}(this, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns always \code{\link[base:logical]{FALSE}}. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{NullVerbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/getRegularExpression.Arguments.Rd�������������������������������������������������������0000644�0001762�0000144�00000002334�14525573054�021015� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Arguments.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Arguments$getRegularExpression} \alias{Arguments$getRegularExpression} \alias{getRegularExpression.Arguments} \alias{Arguments.getRegularExpression} \alias{getRegularExpression,Arguments-method} \title{Gets a valid regular expression pattern} \description{ Gets a valid regular expression pattern. } \usage{ ## Static method (use this): ## Arguments$getRegularExpression(pattern=NULL, ..., .name=NULL) ## Don't use the below: \method{getRegularExpression}{Arguments}(static, pattern=NULL, ..., .name=NULL) } \arguments{ \item{pattern}{A \code{\link[base]{character}} string to be validated.} \item{.name}{A \code{\link[base]{character}} string for name used in error messages.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}} string. } \author{Henrik Bengtsson} \seealso{ \code{\link[base]{grep}}(). For more information see \code{\link{Arguments}}. } \keyword{internal} \keyword{methods} \keyword{IO} ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/more.Verbose.Rd�������������������������������������������������������������������������0000644�0001762�0000144�00000001633�14525573060�015234� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{more.Verbose} \alias{more.Verbose} \alias{Verbose.more} \alias{more,Verbose-method} \title{Creates a cloned instance with a lower threshold} \description{ Creates a cloned instance with a lower threshold. } \usage{ \method{more}{Verbose}(this, dThreshold=1, ...) } \arguments{ \item{dThreshold}{The amount the threshold should be lowered.} \item{...}{Not used.} } \value{ Returns a cloned \code{\link{Verbose}} object. } \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:less.Verbose]{*less}()} For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} �����������������������������������������������������������������������������������������������������R.utils/man/as.double.Verbose.Rd��������������������������������������������������������������������0000644�0001762�0000144�00000001753�14525573060�016151� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{as.double.Verbose} \alias{as.double.Verbose} \alias{Verbose.as.double} \alias{as.double,Verbose-method} \title{Gets a numeric value of this object} \description{ Gets a numeric value of this object. Returns what \code{\link[R.utils:getThreshold.Verbose]{*getThreshold}()} returns. } \usage{ \method{as.double}{Verbose}(x, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns a \code{\link[base]{numeric}} value. } \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:getThreshold.Verbose]{*getThreshold}()} and \code{\link[R.utils:getThreshold.Verbose]{*getThreshold}()}. For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} ���������������������R.utils/man/timestampOn.Verbose.Rd������������������������������������������������������������������0000644�0001762�0000144�00000002026�14525573060�016567� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{timestampOn.Verbose} \alias{timestampOn.Verbose} \alias{Verbose.timestampOn} \alias{timestampOn,Verbose-method} \alias{Verbose.timestampOff} \alias{timestampOff.Verbose} \alias{timestampOff,Verbose-method} \title{Turns automatic timestamping on and off} \description{ Turns automatic timestamping on and off. } \usage{ \method{timestampOn}{Verbose}(this, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns (invisibly) the old timestamp status. } \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:setTimestampFormat.Verbose]{*setTimestampFormat}()}. \code{\link[R.utils:timestampOn.Verbose]{*timestampOn}()}. For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/getRaw.GString.Rd�����������������������������������������������������������������������0000644�0001762�0000144�00000001460�14525573055�015475� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % GString-class.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{getRaw.GString} \alias{getRaw.GString} \alias{GString.getRaw} \alias{getRaw,GString-method} \title{Gets the unprocessed GString} \description{ Gets the unprocessed GString. } \usage{ \method{getRaw}{GString}(object, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}} string. } \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:as.character.GString]{*as.character}()} For more information see \code{\link{GString}}. } \keyword{internal} \keyword{methods} ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/ProgressBar.Rd��������������������������������������������������������������������������0000644�0001762�0000144�00000004525�14525573056�015127� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % ProgressBar.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{ProgressBar} \docType{class} \alias{ProgressBar} \title{Provides text based counting progress bar} \description{ Package: R.utils \cr \bold{Class ProgressBar}\cr \code{\link[R.oo]{Object}}\cr \code{~~|}\cr \code{~~+--}\code{ProgressBar}\cr \bold{Directly known subclasses:}\cr \link[R.utils]{FileProgressBar}\cr public static class \bold{ProgressBar}\cr extends \link[R.oo]{Object}\cr } \usage{ ProgressBar(max=100, ticks=10, stepLength=1, newlineWhenDone=TRUE) } \arguments{ \item{max}{The maximum number of steps.} \item{ticks}{Put visual "ticks" every \code{ticks} step.} \item{stepLength}{The default length for each increase.} \item{newlineWhenDone}{If \code{\link[base:logical]{TRUE}}, a newline is outputted when bar is updated, when done, otherwise not.} } \section{Fields and Methods}{ \bold{Methods:}\cr \tabular{rll}{ \tab \code{as.character} \tab -\cr \tab \code{getBarString} \tab -\cr \tab \code{increase} \tab -\cr \tab \code{isDone} \tab -\cr \tab \code{reset} \tab -\cr \tab \code{setMaxValue} \tab -\cr \tab \code{setProgress} \tab -\cr \tab \code{setStepLength} \tab -\cr \tab \code{setTicks} \tab -\cr \tab \code{setValue} \tab -\cr \tab \code{update} \tab -\cr } \bold{Methods inherited from Object}:\cr $, $<-, [[, [[<-, as.character, attach, attachLocally, clearCache, clearLookupCache, clone, detach, equals, extend, finalize, getEnvironment, getFieldModifier, getFieldModifiers, getFields, getInstantiationTime, getStaticInstance, hasField, hashCode, ll, load, names, objectSize, print, save } \examples{ # A progress bar with default step length one. pb <- ProgressBar(max=42) reset(pb) while (!isDone(pb)) { x <- rnorm(3e4) increase(pb) # Emulate a slow process if (interactive()) Sys.sleep(0.02) } cat("\n") # A "faster" progress bar with default step length 1.4. pb <- ProgressBar(max=42, stepLength=1.4) reset(pb) while (!isDone(pb)) { x <- rnorm(3e4) increase(pb) # Emulate a slow process if (interactive()) Sys.sleep(0.02) } cat("\n") } \author{Henrik Bengtsson} \keyword{classes} ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/System.Rd�������������������������������������������������������������������������������0000644�0001762�0000144�00000003075�14525573057�014162� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % System.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{System} \docType{class} \alias{System} \title{Static class to query information about the system} \description{ Package: R.utils \cr \bold{Class System}\cr \code{\link[R.oo]{Object}}\cr \code{~~|}\cr \code{~~+--}\code{System}\cr \bold{Directly known subclasses:}\cr \cr public static class \bold{System}\cr extends \link[R.oo]{Object}\cr The System class contains several useful class fields and methods. It cannot be instantiated. } \section{Fields and Methods}{ \bold{Methods:}\cr \tabular{rll}{ \tab \code{currentTimeMillis} \tab -\cr \tab \code{findGhostscript} \tab -\cr \tab \code{findGraphicsDevice} \tab -\cr \tab \code{getHostname} \tab -\cr \tab \code{getMappedDrivesOnWindows} \tab -\cr \tab \code{getUsername} \tab -\cr \tab \code{mapDriveOnWindows} \tab -\cr \tab \code{openBrowser} \tab -\cr \tab \code{parseDebian} \tab -\cr \tab \code{unmapDriveOnWindows} \tab -\cr } \bold{Methods inherited from Object}:\cr $, $<-, [[, [[<-, as.character, attach, attachLocally, clearCache, clearLookupCache, clone, detach, equals, extend, finalize, getEnvironment, getFieldModifier, getFieldModifiers, getFields, getInstantiationTime, getStaticInstance, hasField, hashCode, ll, load, names, objectSize, print, save } \author{Henrik Bengtsson} \keyword{classes} �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/lastModified.Rd�������������������������������������������������������������������������0000644�0001762�0000144�00000002221�14525573061�015265� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % lastModified.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{lastModified} \alias{lastModified.default} \alias{lastModified} \title{Gets the time when the file was last modified} \description{ Gets the time when the file was last modified. The time is returned as a \code{POSIXct} object. } \usage{ \method{lastModified}{default}(pathname, ...) } \arguments{ \item{pathname}{A \code{\link[base]{character}} string of the pathname to be checked.} \item{...}{Not used.} } \value{ Returns \code{POSIXct} object specifying when the file was last modified. If the file does not exist or it is a directory, \code{0} is returned. } \section{Symbolic links}{ This function follows symbolic links (also on Windows) and returns a value based on the link target (rather than the link itself). } \author{Henrik Bengtsson} \seealso{ Internally \code{\link[base]{file.info}}() is used. } \keyword{IO} \keyword{programming} �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/draw.density.Rd�������������������������������������������������������������������������0000644�0001762�0000144�00000002766�14525573060�015311� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % density.EXTS.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{draw.density} \alias{draw.density} \title{Draws a density curve} \description{ Draws a density curve along one of the sides of the current plotting region. } \usage{ \method{draw}{density}(object, side=1, height=0.2, offset=0, scale=c("absolute", "relative"), xtrim=NULL, xpd=TRUE, ...) } \arguments{ \item{side}{An \code{\link[base]{integer}} specifying which side to draw along. See \code{\link[graphics]{mtext}} for details.} \item{height}{A \code{\link[base]{numeric}} scalar specifying the "height" of the curve, where height means the maximum height of the density. that is, how much the zero-density position should be shifted.} \item{scale}{A \code{\link[base]{character}} specifying the scale of the curve, which can be either absolute or relative.} \item{xpd}{If \code{\link[base:logical]{TRUE}}, the curve is not clipped, cf. \code{\link[graphics]{par}}.} \item{...}{Not used.} } \value{ Returns the drawn 'density' object (with the 'x' and 'y' coordinates as plotted). } \author{Henrik Bengtsson} \seealso{ See \code{\link[stats]{density}} for estimating densities. Internally \code{\link[R.utils:swapXY.density]{*swapXY}()} may be used. } \keyword{methods} \keyword{internal} ����������R.utils/man/getRelativePath.Rd����������������������������������������������������������������������0000644�0001762�0000144�00000004305�14525573060�015755� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % getRelativePath.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{getRelativePath} \alias{getRelativePath.default} \alias{getRelativePath} \title{Gets the relative pathname relative to a directory} \usage{ \method{getRelativePath}{default}(pathname, relativeTo=getwd(), caseSensitive=NULL, ...) } \description{ Gets the relative pathname relative to a directory. } \arguments{ \item{pathname}{A \code{\link[base]{character}} string of the pathname to be converted into an relative pathname.} \item{relativeTo}{A \code{\link[base]{character}} string of the reference pathname.} \item{caseSensitive}{If \code{\link[base:logical]{TRUE}}, the comparison is case sensitive, otherwise not. If \code{\link[base]{NULL}}, it is decided from the relative path.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}} string of the relative pathname. } \section{Non-case sensitive comparison}{ If \code{caseSensitive == NULL}, the relative path is used to decide if the comparison should be done in a case-sensitive mode or not. The current check is if it is a Windows path or not, that is, if the relative path starts with a device letter, then the comparison is non-case sensitive. } \details{ In case the two paths are on different file systems, for instance, C:/foo/bar/ and D:/foo/, the method returns \code{pathname} as is. } \examples{ getRelativePath("foo", "foo") # "." getRelativePath("foo/bar", "foo") # "bar" getRelativePath("foo/bar", "foo/bar/yah") # ".." getRelativePath("foo/bar/cool", "foo/bar/yah/sub/") # "../../cool" getRelativePath("/tmp/bar/", "/bar/foo/") # "../../tmp/bar" # Windows getRelativePath("C:/foo/bar/", "C:/bar/") # "../foo/bar" getRelativePath("C:/foo/bar/", "D:/bar/") # "C:/foo/bar" } \author{Henrik Bengtsson} \seealso{ \code{\link{getAbsolutePath}}(). \code{\link{isAbsolutePath}}(). } \keyword{IO} \keyword{programming} ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/getBuiltinPid.GString.Rd����������������������������������������������������������������0000644�0001762�0000144�00000001637�14525573055�017015� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % GString-class.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{GString$getBuiltinPid} \alias{GString$getBuiltinPid} \alias{getBuiltinPid.GString} \alias{GString.getBuiltinPid} \alias{getBuiltinPid,GString-method} \title{Gets the process id of the current R session} \description{ Gets the process id of the current R session. } \usage{ ## Static method (use this): ## GString$getBuiltinPid(...) ## Don't use the below: \method{getBuiltinPid}{GString}(static, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns an \code{\link[base]{integer}}. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{GString}}. } \keyword{internal} \keyword{methods} �������������������������������������������������������������������������������������������������R.utils/man/onGarbageCollect.Rd���������������������������������������������������������������������0000644�0001762�0000144�00000002201�14525573061�016052� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % onGarbageCollect.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{onGarbageCollect} \alias{onGarbageCollect.default} \alias{onGarbageCollect} \title{Registers a function to be called when the R garbage collector is (detected to be) running} \description{ Registers a function to be called when the R garbage collector is (detected to be) running. } \usage{ \method{onGarbageCollect}{default}(fcn, action=c("prepend", "append", "replace"), ...) } \arguments{ \item{fcn}{A \code{\link[base]{function}} to be called without argument.} \item{action}{A \code{\link[base]{character}} string specifying how the hook function is added to list of hooks.} \item{...}{Not used.} } \value{ Returns (invisibly) the hooks successfully called. } \author{Henrik Bengtsson} \examples{\dontrun{ onGarbageCollect(function(...) { message("The R garbage collector is running!") }) }} \keyword{programming} �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/getEnvironment.Arguments.Rd�������������������������������������������������������������0000644�0001762�0000144�00000002341�14525573054�017636� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Arguments.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Arguments$getEnvironment} \alias{Arguments$getEnvironment} \alias{getEnvironment.Arguments} \alias{Arguments.getEnvironment} \alias{getEnvironment,Arguments-method} \title{Gets an existing environment} \description{ Gets an existing environment. } \usage{ ## Static method (use this): ## Arguments$getEnvironment(envir=NULL, .name=NULL, ...) ## Don't use the below: \method{getEnvironment}{Arguments}(static, envir=NULL, .name=NULL, ...) } \arguments{ \item{envir}{An \code{\link[base]{environment}}, the name of a loaded package, or \code{\link[base]{NULL}}. If \code{\link[base]{NULL}}, the global environment is returned.} \item{.name}{A \code{\link[base]{character}} string for name used in error messages.} \item{...}{Not used.} } \value{ Returns an \code{\link[base]{environment}}. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Arguments}}. } \keyword{internal} \keyword{methods} \keyword{IO} �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/extract.array.Rd������������������������������������������������������������������������0000644�0001762�0000144�00000005223�14525573060�015454� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % extract.array.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{extract.array} \alias{extract.array} \alias{extract.matrix} \alias{extract.default} \title{Extract a subset of an array, matrix or a vector with unknown dimensions} \description{ Extract a subset of an array, matrix or a vector with unknown dimensions. This method is useful when you do not know the number of dimensions of the object your wish to extract values from, cf. example. } \usage{ \method{extract}{array}(x, ..., indices=list(...), dims=names(indices), drop=FALSE) } \arguments{ \item{x}{An \code{\link[base]{array}} or a \code{\link[base]{matrix}}.} \item{...}{These arguments are by default put into the \code{indices} \code{\link[base]{list}}.} \item{indices}{A \code{\link[base]{list}} of index \code{\link[base]{vector}}s to be extracted.} \item{dims}{An \code{\link[base]{vector}} of dimensions - one per element in \code{indices} - which will be coerced to \code{\link[base]{integer}}s. If \code{\link[base]{NULL}}, it will default to \code{seq_along(indices)}.} \item{drop}{If \code{\link[base:logical]{TRUE}}, dimensions of length one are dropped, otherwise not.} } \value{ Returns an \code{\link[base]{array}}. } \examples{ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Example using an array with a random number of dimensions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - maxdim <- 4 dim <- sample(3:maxdim, size=sample(2:maxdim, size=1), replace=TRUE) ndim <- length(dim) dimnames <- list() for (kk in 1:ndim) dimnames[[kk]] <- sprintf("\%s\%d", letters[kk], 1:dim[kk]) x <- 1:prod(dim) x <- array(x, dim=dim, dimnames=dimnames) cat("\nArray 'x':\n") print(x) cat("\nExtract 'x[2:3,...]':\n") print(extract(x, "1"=2:3)) cat("\nExtract 'x[3,2:3,...]':\n") print(extract(x, "1"=3,"2"=2:3)) cat("\nExtract 'x[...,2:3]':\n") print(extract(x, indices=2:3, dims=length(dim(x)))) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Assertions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - y <- array(1:24, dim=c(2,3,4)) yA <- y[,,2:3] yB <- extract(y, indices=list(2:3), dims=length(dim(y))) stopifnot(identical(yB, yA)) yA <- y[,2:3,2] yB <- extract(y, indices=list(2:3,2), dims=c(2,3), drop=TRUE) stopifnot(identical(yB, yA)) } \author{Henrik Bengtsson} \seealso{ \code{\link[base]{slice.index}}() } \keyword{methods} \keyword{programming} �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/setLabels.TextStatusBar.Rd��������������������������������������������������������������0000644�0001762�0000144�00000001664�14525573057�017372� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % TextStatusBar.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{setLabels.TextStatusBar} \alias{setLabels.TextStatusBar} \alias{TextStatusBar.setLabels} \alias{setLabels,TextStatusBar-method} \title{Sets new values of given labels} \description{ Sets new values of given labels. } \usage{ \method{setLabels}{TextStatusBar}(this, ...) } \arguments{ \item{...}{A set of named arguments.} } \value{ Returns nothing. } \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:setLabel.TextStatusBar]{*setLabel}()}. \code{\link[R.utils:updateLabels.TextStatusBar]{*updateLabels}()}. For more information see \code{\link{TextStatusBar}}. } \keyword{internal} \keyword{methods} \keyword{programming} ����������������������������������������������������������������������������R.utils/man/getInstanceOf.Arguments.Rd��������������������������������������������������������������0000644�0001762�0000144�00000003107�14525573054�017364� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Arguments.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Arguments$getInstanceOf} \alias{Arguments$getInstanceOf} \alias{getInstanceOf.Arguments} \alias{Arguments.getInstanceOf} \alias{getInstanceOf,Arguments-method} \title{Gets an instance of the object that is of a particular class} \description{ Gets an instance of the object that is of a particular class. } \usage{ ## Static method (use this): ## Arguments$getInstanceOf(object, class, coerce=FALSE, ..., .name=NULL) ## Don't use the below: \method{getInstanceOf}{Arguments}(static, object, class, coerce=FALSE, ..., .name=NULL) } \arguments{ \item{object}{The object that should be returned as an instance of class \code{class}.} \item{class}{A \code{\link[base]{character}} string specifying the name of the class that the returned object should inherit from.} \item{coerce}{If \code{\link[base:logical]{TRUE}} and the object is not of the wanted class, then method will be coerced to that class, if possible. Otherwise, an error is thrown.} \item{...}{Not used.} \item{.name}{A \code{\link[base]{character}} string for name used in error messages.} } \value{ Returns an object inheriting from class \code{class}. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Arguments}}. } \keyword{internal} \keyword{methods} \keyword{programming} ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/getLabel.TextStatusBar.Rd���������������������������������������������������������������0000644�0001762�0000144�00000002003�14525573057�017157� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % TextStatusBar.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{getLabel.TextStatusBar} \alias{getLabel.TextStatusBar} \alias{TextStatusBar.getLabel} \alias{getLabel,TextStatusBar-method} \title{Gets the current value of a label} \description{ Gets the current value of a label address either by its index or its names. } \usage{ \method{getLabel}{TextStatusBar}(this, label, ...) } \arguments{ \item{label}{The index or the name of the label.} \item{...}{Not used.} } \value{ Returns the value. } \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:setLabel.TextStatusBar]{*setLabel}()} and \code{\link[R.utils:setLabels.TextStatusBar]{*setLabels}()}. For more information see \code{\link{TextStatusBar}}. } \keyword{internal} \keyword{methods} \keyword{programming} �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/getWritablePathname.Arguments.Rd��������������������������������������������������������0000644�0001762�0000144�00000004462�14525573054�020567� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Arguments.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Arguments$getWritablePathname} \alias{Arguments$getWritablePathname} \alias{getWritablePathname.Arguments} \alias{Arguments.getWritablePathname} \alias{getWritablePathname,Arguments-method} \title{Gets a writable pathname} \description{ Gets a writable pathname. } \usage{ ## Static method (use this): ## Arguments$getWritablePathname(..., mustExist=FALSE, mustNotExist=FALSE, mkdirs=TRUE, ## maxTries=5L) ## Don't use the below: \method{getWritablePathname}{Arguments}(static, ..., mustExist=FALSE, mustNotExist=FALSE, mkdirs=TRUE, maxTries=5L) } \arguments{ \item{...}{Arguments passed to \code{\link[R.utils:getReadablePathname.Arguments]{*getReadablePathname}()}.} \item{mustExist}{If \code{\link[base:logical]{TRUE}} and the pathname does not exists, an Exception is thrown, otherwise not.} \item{mustNotExist}{If the file exists, and \code{mustNotExist} is \code{\link[base:logical]{TRUE}}, an Exception is thrown. If the file exists, and \code{mustNotExist} is \code{\link[base:logical]{FALSE}}, or the file does not exists, the pathname is accepted.} \item{mkdirs}{If \code{\link[base:logical]{TRUE}}, \code{mustNotExist} is \code{\link[base:logical]{FALSE}}, and the path to the file does not exist, it is (recursively) created.} \item{maxTries}{A positive \code{\link[base]{integer}} specifying how many times the method should try to create a missing directory before giving up. For more details, see \code{\link[R.utils]{mkdirs}}.} } \value{ Returns a \code{\link[base]{character}} string of the pathname of the file. If the argument was invalid an \code{\link[R.oo]{Exception}} is thrown. } \section{Missing values}{ If any argument in \code{...} is \code{\link[base]{NA}}, an exception is thrown. } \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:getReadablePathname.Arguments]{*getReadablePathname}()}. \code{\link[R.utils]{filePath}}. \code{\link[R.utils]{mkdirs}}. For more information see \code{\link{Arguments}}. } \keyword{internal} \keyword{methods} \keyword{IO} ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/setStepLength.ProgressBar.Rd������������������������������������������������������������0000644�0001762�0000144�00000001502�14525573056�017707� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % ProgressBar.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{setStepLength.ProgressBar} \alias{setStepLength.ProgressBar} \alias{ProgressBar.setStepLength} \alias{setStepLength,ProgressBar-method} \title{Sets default step length} \description{ Sets default step length. } \usage{ \method{setStepLength}{ProgressBar}(this, stepLength, ...) } \arguments{ \item{stepLength}{New default step length.} \item{...}{Not used.} } \value{ Returns on step length. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{ProgressBar}}. } \keyword{internal} \keyword{methods} ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/countLines.Rd���������������������������������������������������������������������������0000644�0001762�0000144�00000002456�14525573060�015015� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % countLines.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{countLines} \alias{countLines.default} \alias{countLines} \title{Counts the number of lines in a text file} \description{ Counts the number of lines in a text file by counting the number of occurrences of platform-independent newlines (CR, LF, and CR+LF [1]), including a last line with neither. An empty file has zero lines. } \usage{ \method{countLines}{default}(file, chunkSize=5e+07, ...) } \arguments{ \item{file}{A \code{\link[base:connections]{connection}} or a pathname.} \item{chunkSize}{The number of bytes read in each chunk.} \item{...}{Not used.} } \value{ Returns an non-negative \code{\link[base]{integer}}. } \details{ Both compressed and non-compressed files are supported. } \author{Henrik Bengtsson} \examples{ pathname <- system.file("NEWS.md", package="R.utils"); n <- countLines(pathname); n2 <- length(readLines(pathname)); stopifnot(n == n2); } \references{ [1] Page \emph{Newline}, Wikipedia, July 2008. \url{https://en.wikipedia.org/wiki/Newline} } \keyword{programming} ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/Java.Rd���������������������������������������������������������������������������������0000644�0001762�0000144�00000006605�14525573055�013557� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Java.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Java} \docType{class} \alias{Java} \title{Static class for Java related methods} \description{ Package: R.utils \cr \bold{Class Java}\cr \code{\link[R.oo]{Object}}\cr \code{~~|}\cr \code{~~+--}\code{Java}\cr \bold{Directly known subclasses:}\cr \cr public static class \bold{Java}\cr extends \link[R.oo]{Object}\cr Static class that provides methods for reading and writing Java data types. Currently the following data types are supported: byte, short and int. R character strings can be written as UTF-8 formatted strings, which can be read by Java. Currently on Java String's that contain ASCII characters can be imported into \R. The reason for this is that other characters are translated into non-eight bits data, e.g. 16- and 24-bits, which the readChar() method currently does not support.\cr Furthermore, the Java class defines some static constants describing the minimum and maximum value of some of the common Java data types: \code{BYTE.MIN}, \code{BYTE.MAX} \code{SHORT.MIN}, \code{SHORT.MAX} \code{INT.MIN}, \code{INT.MAX} \code{LONG.MIN}, and \code{LONG.MAX}. } \usage{ Java() } \section{Fields and Methods}{ \bold{Methods:}\cr \tabular{rll}{ \tab \code{asByte} \tab -\cr \tab \code{asInt} \tab -\cr \tab \code{asLong} \tab -\cr \tab \code{asShort} \tab -\cr \tab \code{readByte} \tab -\cr \tab \code{readInt} \tab -\cr \tab \code{readShort} \tab -\cr \tab \code{readUTF} \tab -\cr \tab \code{writeByte} \tab -\cr \tab \code{writeInt} \tab -\cr \tab \code{writeShort} \tab -\cr \tab \code{writeUTF} \tab -\cr } \bold{Methods inherited from Object}:\cr $, $<-, [[, [[<-, as.character, attach, attachLocally, clearCache, clearLookupCache, clone, detach, equals, extend, finalize, getEnvironment, getFieldModifier, getFieldModifiers, getFields, getInstantiationTime, getStaticInstance, hasField, hashCode, ll, load, names, objectSize, print, save } \examples{ pathname <- tempfile() # Open the temporary file for writing out <- file(pathname, open="wb") b <- -128:127 Java$writeByte(out, b) s <- -32768:32767 Java$writeShort(out, s) i <- c(-2147483648, -2147483647, -1, 0, +1, 2147483646, 2147483647); Java$writeInt(out, i) str <- c("This R string was written (using the UTF-8 format) using", "the static methods of the Java class in the R.io package.") str <- paste(str, collapse="\n") Java$writeUTF(out, str) close(out) # Open the temporary file for reading inn <- file(pathname, open="rb") bfr <- Java$readByte(inn, n=length(b)) cat("Read ", length(bfr), " bytes.\n", sep="") if (!identical(bfr, b)) throw("Failed to read the same data that was written.") bfr <- Java$readShort(inn, n=length(s)) cat("Read ", length(bfr), " shorts.\n", sep="") if (!identical(bfr, s)) throw("Failed to read the same data that was written.") bfr <- Java$readInt(inn, n=length(i)) cat("Read ", length(bfr), " ints.\n", sep="") if (!identical(bfr, i)) throw("Failed to read the same data that was written.") bfr <- Java$readUTF(inn) cat("Read ", nchar(bfr), " UTF characters:\n", "'", bfr, "'\n", sep="") close(inn) file.remove(pathname) } \author{Henrik Bengtsson} \keyword{classes} ���������������������������������������������������������������������������������������������������������������������������R.utils/man/readTable.Rd����������������������������������������������������������������������������0000644�0001762�0000144�00000010563�14525573061�014554� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % readTable.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{readTable} \alias{readTable.default} \alias{readTable} \title{Reads a file in table format} \usage{ \method{readTable}{default}(file, colClasses=NULL, isPatterns=FALSE, defColClass=NA, header=FALSE, skip=0, nrows=-1, rows=NULL, col.names=NULL, check.names=FALSE, path=NULL, ..., stripQuotes=TRUE, method=c("readLines", "intervals"), verbose=FALSE) } \description{ Reads a file in table format and creates a data frame from it, with cases corresponding to lines and variables to fields in the file. \emph{WARNING: This method is very much in an alpha stage. Expect it to change.} This method is an extension to the default \code{\link[utils]{read.table}} function in \R. It is possible to specify a column name to column class map such that the column classes are automatically assigned from the column header in the file. In addition, it is possible to read any subset of rows. The method is optimized such that only columns and rows that are of interest are parsed and read into \R's memory. This minimizes memory usage at the same time as it speeds up the reading. } \arguments{ \item{file}{A \code{\link[base:connections]{connection}} or a filename. If a filename, the path specified by \code{path} is added to the front of the filename. Unopened files are opened and closed at the end.} \item{colClasses}{Either a named or an unnamed \code{\link[base]{character}} \code{\link[base]{vector}}. If unnamed, it specified the column classes just as used by \code{\link[utils]{read.table}}. If it is a named vector, \code{names(colClasses)} are used to match the column names read (this requires that \code{header=TRUE}) and the column classes are set to the corresponding values. } \item{isPatterns}{If \code{\link[base:logical]{TRUE}}, the matching of \code{names(colClasses)} to the read column names is done by regular expressions matching.} \item{defColClass}{If the column class map specified by a named \code{colClasses} argument does not match some of the read column names, the column class is by default set to this class. The default is to read the columns in an "as is" way.} \item{header}{If \code{\link[base:logical]{TRUE}}, column names are read from the file.} \item{skip}{The number of lines (commented or non-commented) to skip before trying to read the header or alternatively the data table.} \item{nrows}{The number of rows to read of the data table. Ignored if \code{rows} is specified.} \item{rows}{An row index \code{\link[base]{vector}} specifying which rows of the table to read, e.g. row one is the row following the header. Non-existing rows are ignored. Note that rows are returned in the same order they are requested and duplicated rows are also returned.} \item{col.names}{Same as in \code{read.table()}.} \item{check.names}{Same as in \code{read.table()}, but default value is \code{\link[base:logical]{FALSE}} here.} \item{path}{If \code{file} is a filename, this path is added to it, otherwise ignored.} \item{...}{Arguments passed to \code{\link[utils]{read.table}} used internally.} \item{stripQuotes}{If \code{\link[base:logical]{TRUE}}, quotes are stripped from values before being parse. This argument is only effective when \code{method=="readLines"}. } \item{method}{If \code{"readLines"}, \code{(readLines())} is used internally to first only read rows of interest, which is then passed to \code{read.table()}. If \code{"intervals"}, contiguous intervals are first identified in the rows of interest. These intervals are the read one by one using \code{read.table()}. The latter methods is faster and especially more memory efficient if the intervals are not too many, where as the former is preferred if many "scattered" rows are to be read.} \item{verbose}{A \code{\link[base]{logical}} or a \code{\link{Verbose}} object.} } \value{ Returns a \code{\link[base]{data.frame}}. } \author{Henrik Bengtsson} \seealso{ \code{\link{readTableIndex}}(). \code{\link[utils]{read.table}}. \code{\link{colClasses}}(). } \keyword{IO} ���������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/as.character.Options.Rd�����������������������������������������������������������������0000644�0001762�0000144�00000001507�14525573056�016663� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Options.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{as.character.Options} \alias{as.character.Options} \alias{Options.as.character} \alias{as.character,Options-method} \title{Returns a character string version of this object} \description{ Returns a character string version of this object. } \usage{ \method{as.character}{Options}(x, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}} string. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Options}}. } \keyword{internal} \keyword{methods} \keyword{programming} �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/str.Verbose.Rd��������������������������������������������������������������������������0000644�0001762�0000144�00000001700�14525573060�015075� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{str.Verbose} \alias{str.Verbose} \alias{Verbose.str} \alias{str,Verbose-method} \title{Prints the structure of an object if above threshold} \description{ Prints the structure of an object if above threshold. The output is \emph{not} indented. } \usage{ \method{str}{Verbose}(object, ..., level=this$defaultLevel) } \arguments{ \item{...}{Objects to be passed to \code{\link[utils]{str}}.} \item{level}{A \code{\link[base]{numeric}} value to be compared to the threshold.} } \value{ Returns nothing. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} ����������������������������������������������������������������R.utils/man/hasUrlProtocol.Rd�����������������������������������������������������������������������0000644�0001762�0000144�00000001473�14525573060�015650� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % hasUrlProtocol.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{hasUrlProtocol} \alias{hasUrlProtocol.default} \alias{hasUrlProtocol} \title{Checks if one or several pathnames has a URL protocol} \description{ Checks if one or several pathnames has a URL protocol. } \usage{ \method{hasUrlProtocol}{default}(pathname, ...) } \arguments{ \item{pathname}{A \code{\link[base]{character}} \code{\link[base]{vector}}.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{logical}} \code{\link[base]{vector}}. } \author{Henrik Bengtsson} \keyword{IO} \keyword{programming} �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/getNumerics.Arguments.Rd����������������������������������������������������������������0000644�0001762�0000144�00000003271�14525573054�017122� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Arguments.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Arguments$getNumerics} \alias{Arguments$getNumerics} \alias{getNumerics.Arguments} \alias{Arguments.getNumerics} \alias{getNumerics,Arguments-method} \alias{Arguments.getNumeric} \alias{getNumeric.Arguments} \alias{getNumeric,Arguments-method} \title{Coerces to a numeric vector and validates} \description{ Coerces to a numeric vector and validates. } \usage{ ## Static method (use this): ## Arguments$getNumerics(x, range=NULL, asMode=NULL, disallow=NULL, ..., .name=NULL) ## Don't use the below: \method{getNumerics}{Arguments}(static, x, range=NULL, asMode=NULL, disallow=NULL, ..., .name=NULL) } \arguments{ \item{x}{A \code{\link[base]{vector}}.} \item{range}{Two \code{\link[base]{numeric}}s for the allowed ranged. If \code{\link[base]{NULL}}, range is not checked.} \item{asMode}{A \code{\link[base]{character}} specifying the mode to coerce to.} \item{disallow}{A \code{\link[base]{character}} \code{\link[base]{vector}} specifying disallowed value sets, i.e. \code{"NA"}, \code{"NaN"}, and/or \code{"Inf"}.} \item{...}{Arguments passed to @method "getVector".} \item{.name}{A \code{\link[base]{character}} string for name used in error messages.} } \value{ Returns a \code{\link[base]{numeric}} \code{\link[base]{vector}}. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Arguments}}. } \keyword{internal} \keyword{methods} \keyword{IO} ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/sourceDirectory.Rd����������������������������������������������������������������������0000644�0001762�0000144�00000003742�14525573061�016057� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % sourceDirectory.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{sourceDirectory} \alias{sourceDirectory.default} \alias{sourceDirectory} \title{Sources files recursively to either local or global environment} \description{ Sources files recursively to either local or global environment. } \usage{ \method{sourceDirectory}{default}(path, pattern=".*[.](r|R|s|S|q)([.](lnk|LNK))*$", recursive=TRUE, envir=parent.frame(), onError=c("error", "warning", "skip"), modifiedOnly=TRUE, ..., verbose=FALSE) } \arguments{ \item{path}{A path to a directory to be sourced.} \item{pattern}{A regular expression file name pattern to identify source code files.} \item{recursive}{If \code{\link[base:logical]{TRUE}}, subdirectories are recursively sourced first, otherwise not.} \item{envir}{An \code{\link[base]{environment}} in which the code should be evaluated.} \item{onError}{If an error occurs, the error may stop the job, give a warning, or silently be skipped.} \item{modifiedOnly}{If \code{\link[base:logical]{TRUE}}, only files that are modified since the last time they were sourced are sourced, otherwise regardless.} \item{...}{Additional arguments passed to \code{\link{sourceTo}}().} \item{verbose}{A \code{\link[base]{logical}} or a \code{\link{Verbose}} object.} } \value{ Returns a \code{\link[base]{vector}} of the full pathnames of the files sourced. } \section{Details}{ Subdirectories and files in each (sub-)directory are sourced in lexicographic order. } \section{Hooks}{ This method does not provide hooks, but the internally used \code{\link{sourceTo}}() does. } \seealso{ \code{\link{sourceTo}}() and compare to \code{\link[base]{source}}(). } \author{Henrik Bengtsson} \keyword{IO} \keyword{programming} ������������������������������R.utils/man/renameFile.Rd���������������������������������������������������������������������������0000644�0001762�0000144�00000002635�14525573061�014741� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % renameFile.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{renameFile} \alias{renameFile.default} \alias{renameFile} \title{Renames a file (or a directory) atomically/safely} \description{ Renames a file (or a directory) atomically/safely, by also asserting that it was successfully renamed without side effects. If failing to rename and overwrite an existing file, the original file is kept. } \usage{ \method{renameFile}{default}(pathname, newPathname, overwrite=FALSE, ..., verbose=FALSE) } \arguments{ \item{pathname}{The pathname of the file to be renamed.} \item{newPathname}{The new pathname. If an \emph{existing directory} and the source is a file, then the destination becomes \code{file.path(newPathname, basename(pathname))}.} \item{overwrite}{If \code{\link[base:logical]{TRUE}} and there exists a file with new pathname, then it is overwritten.} \item{...}{Not used.} \item{verbose}{See \code{\link[R.utils]{Verbose}}.} } \value{ Returns \code{\link[base:logical]{TRUE}} if the file was successfully renamed. If it failed, an exception is thrown. } \author{Henrik Bengtsson} \seealso{ \code{\link[base:files]{file.rename}()}. } \keyword{internal} ���������������������������������������������������������������������������������������������������R.utils/man/cmdArgsCall.Rd��������������������������������������������������������������������������0000644�0001762�0000144�00000002264�14525573060�015043� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % cmdArgs.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{cmdArgsCall} \alias{cmdArgsCall} \title{Calls an R function passing command-line arguments} \description{ Calls an R function passing command-line arguments. } \usage{ cmdArgsCall(..., args=cmdArgs(unique = FALSE), .ignoreUnusedArgs=FALSE, envir=parent.frame()) } \arguments{ \item{...}{Arguments passed to \code{\link{doCall}}(), including the function to be called.} \item{args}{A \code{\link[base]{list}} of arguments to be passed to the function being called.} \item{.ignoreUnusedArgs}{Passed to \code{\link{doCall}}().} \item{envir}{An \code{\link[base]{environment}} in which to evaluate the call.} } \value{ Returns whatever the called function returns. } \author{Henrik Bengtsson} \examples{\dontrun{ Rscript -e R.utils::cmdArgsCall(rnorm) n=4 }} \seealso{ Internally, \code{\link{cmdArgs}}() and \code{\link{doCall}}() is used. } \keyword{programming} \keyword{internal} ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/reset.ProgressBar.Rd��������������������������������������������������������������������0000644�0001762�0000144�00000001654�14525573056�016250� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % ProgressBar.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{reset.ProgressBar} \alias{reset.ProgressBar} \alias{ProgressBar.reset} \alias{reset,ProgressBar-method} \title{Reset progress bar} \description{ Reset progress bar by setting the value to zero and updating the display. } \usage{ \method{reset}{ProgressBar}(this, visual=TRUE, ...) } \arguments{ \item{visual}{If \code{\link[base:logical]{TRUE}}, the progress bar is redraw, otherwise not.} \item{...}{Not used.} } \value{ Returns nothing. } \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:setValue.ProgressBar]{*setValue}()}. For more information see \code{\link{ProgressBar}}. } \keyword{internal} \keyword{methods} ������������������������������������������������������������������������������������R.utils/man/commandArgs.Rd��������������������������������������������������������������������������0000644�0001762�0000144�00000016224�14525573060�015123� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % commandArgs.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{commandArgs} \alias{commandArgs} \title{Extract command-line arguments} \usage{ commandArgs(trailingOnly=FALSE, asValues=FALSE, defaults=NULL, always=NULL, adhoc=FALSE, unique=FALSE, excludeReserved=FALSE, excludeEnvVars=FALSE, os=NULL, .args=NULL, ...) } \description{ Provides access to a copy of the command-line arguments supplied when this \R session was invoked. This function is backward compatible with \code{\link[base]{commandArgs}}() of the \pkg{base} package, but adds more features. } \arguments{ \item{trailingOnly}{If \code{\link[base:logical]{TRUE}}, only arguments after \code{--args} are returned.} \item{asValues}{If \code{\link[base:logical]{TRUE}}, a named \code{\link[base]{list}} is returned, where command line arguments of type \code{--foo} will be returned as \code{\link[base:logical]{TRUE}} with name \code{foo}, and arguments of type \code{-foo=value} will be returned as \code{\link[base]{character}} string \code{value} with name \code{foo}. In addition, if \code{-foo value} is given, this is interpreted as \code{-foo=value}, as long as \code{value} does not start with a double dash (\code{--}).} \item{defaults}{A \code{\link[base]{character}} \code{\link[base]{vector}} or a named \code{\link[base]{list}} of default arguments. Any command-line or fixed arguments will override default arguments with the same name.} \item{always}{A \code{\link[base]{character}} \code{\link[base]{vector}} or a named \code{\link[base]{list}} of fixed arguments. These will override default and command-line arguments with the same name.} \item{adhoc}{(ignored if \code{asValues=FALSE}) If \code{\link[base:logical]{TRUE}}, then additional coercion of \code{\link[base]{character}} command-line arguments to more specific data types is performed, iff possible.} \item{unique}{If \code{\link[base:logical]{TRUE}}, the returned set of arguments contains only unique arguments such that no two arguments have the same name. If duplicates exists, it is only the last one that is kept.} \item{excludeReserved}{If \code{\link[base:logical]{TRUE}}, arguments reserved by \R are excluded, otherwise not. Which the reserved arguments are depends on operating system. For details, see Appendix B on "Invoking R" in \emph{An Introduction to R}.} \item{excludeEnvVars}{If \code{\link[base:logical]{TRUE}}, arguments that assigns environment variable are excluded, otherwise not. As described in \code{R --help}, these are arguments of format <key>=<value>.} \item{os}{A \code{\link[base]{vector}} of \code{\link[base]{character}} strings specifying which set of reserved arguments to be used. Possible values are \code{"unix"}, \code{"mac"}, \code{"windows"}, \code{"ANY"} or \code{"current"}. If \code{"current"}, the current platform is used. If \code{"ANY"} or \code{\link[base]{NULL}}, all three OSs are assumed for total cross-platform compatibility.} \item{args}{A named \code{\link[base]{list}} of arguments.} \item{.args}{A \code{\link[base]{character}} \code{\link[base]{vector}} of command-line arguments.} \item{...}{Passed to \code{\link[base]{commandArgs}}() of the \pkg{base} package.} } \value{ If \code{asValue} is \code{\link[base:logical]{FALSE}}, a \code{\link[base]{character}} \code{\link[base]{vector}} is returned, which contains the name of the executable and the non-parsed user-supplied arguments. If \code{asValue} is \code{\link[base:logical]{TRUE}}, a named \code{\link[base]{list}} containing is returned, which contains the the executable and the parsed user-supplied arguments. The first returned element is the name of the executable by which \R was invoked. As far as I am aware, the exact form of this element is platform dependent. It may be the fully qualified name, or simply the last component (or basename) of the application. The returned attribute \code{isReserved} is a \code{\link[base]{logical}} \code{\link[base]{vector}} specifying if the corresponding command-line argument is a reserved \R argument or not. } \section{Backward compatibility}{ This function should be fully backward compatible with the same function in the \pkg{base} package, except when littler is used (see below). } \section{Compatibility with littler}{ The littler package provides the \code{r} binary, which parses user command-line options and assigns them to character vector \code{argv} in the global environment. The \code{commandArgs()} of this package recognizes \code{argv} arguments as well. } \section{Coercing to non-character data types}{ When \code{asValues} is \code{\link[base:logical]{TRUE}}, the command-line arguments are returned as a named \code{\link[base]{list}}. By default, the values of these arguments are \code{\link[base]{character}} strings. However, any command-line argument that share name with one of the 'always' or 'default' arguments, then its value is coerced to the corresponding data type (via \code{\link[methods]{as}}). This provides a mechanism for specifying data types other than \code{\link[base]{character}} strings. Furthermore, when \code{asValues} and \code{adhoc} are \code{\link[base:logical]{TRUE}}, any remaining character string command-line arguments are coerced to more specific data types (via \code{\link[utils]{type.convert}}), if possible. } \author{Henrik Bengtsson} \examples{ ###################################################################### # Non-parsed command-line arguments ###################################################################### # Display how this instance of R was invoked. cmd <- paste(commandArgs(), collapse=" ") cat("How R was invoked:\n"); cat(cmd, "\n") # Get all arguments args <- commandArgs() print(args) # Get only "private" arguments and not the name of the R executable. args <- commandArgs(excludeReserved=TRUE)[-1] print(args) # Assert backward compatibility args0 <- base::commandArgs() args <- commandArgs() stopifnot(all.equal(args, args0, check.attributes=FALSE)) ###################################################################### # Parsed command-line arguments ###################################################################### # Get all arguments as a named list, e.g. if R is started as: # # R DATAPATH=../data --args --root="do da" --foo bar --details --a=2 # # then 'args' below will equal # # list(R=NA, DATAPATH="../data" args=TRUE, root="do da", # foo="bar", details=TRUE, a="2") args <- commandArgs(asValues=TRUE) str(args) # Turn arguments into R variables args <- commandArgs(asValues=TRUE, excludeReserved=TRUE)[-1] keys <- attachLocally(args) cat("Command-line arguments attached to global environment:\n"); print(keys); str(mget(keys, envir=globalenv())) } \seealso{ For a more user friendly solution, see \code{\link{cmdArgs}}(). Internally \code{\link[base]{commandArgs}}() is used. } \keyword{programming} \keyword{internal} ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/inAnyInterval.numeric.Rd����������������������������������������������������������������0000644�0001762�0000144�00000001575�14525573060�017117� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % inAnyInterval.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{inAnyInterval.numeric} \alias{inAnyInterval.numeric} \title{Checks if a set of values are inside one or more intervals} \usage{ \method{inAnyInterval}{numeric}(...) } \description{ Checks if a set of values are inside one or more intervals. } \arguments{ \item{...}{Arguments passed to \code{\link[R.utils:mapToIntervals.numeric]{*mapToIntervals}()}.} } \value{ Returns a \code{\link[base]{logical}} \code{\link[base]{vector}}. } \author{Henrik Bengtsson} \seealso{ \code{\link{mapToIntervals}}(). } \keyword{methods} \keyword{utilities} \keyword{programming} �����������������������������������������������������������������������������������������������������������������������������������R.utils/man/saveAnywhere.Settings.Rd����������������������������������������������������������������0000644�0001762�0000144�00000003022�14525573056�017125� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Settings.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{saveAnywhere.Settings} \alias{saveAnywhere.Settings} \alias{Settings.saveAnywhere} \alias{saveAnywhere,Settings-method} \title{Saves settings to file} \description{ Saves settings to file. If the settings was read from file, they are by default written back to the same file. If this was not the case, it defaults to the settings file in the home directory of the current user. } \usage{ \method{saveAnywhere}{Settings}(this, file=NULL, path="~", ...) } \arguments{ \item{file}{A \code{\link[base]{character}} string or a \code{\link[base:connections]{connection}} where to write too. If \code{\link[base]{NULL}}, the file from which the settings were read is used. If this was not the case, argument \code{path} is used.} \item{path}{The default path, if no settings files are specified. This defaults to the current user's home directory.} \item{...}{Arguments passed to \code{\link[R.oo:save.Object]{save}()} in superclass Object.} } \value{ Returns (invisibly) the pathname to the save settings file. } \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:loadAnywhere.Settings]{*loadAnywhere}()}. For more information see \code{\link{Settings}}. } \keyword{internal} \keyword{methods} \keyword{programming} ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/nbrOfOptions.Options.Rd�����������������������������������������������������������������0000644�0001762�0000144�00000001430�14525573056�016742� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Options.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{nbrOfOptions.Options} \alias{nbrOfOptions.Options} \alias{Options.nbrOfOptions} \alias{nbrOfOptions,Options-method} \title{Gets the number of options set} \description{ Gets the number of options set. } \usage{ \method{nbrOfOptions}{Options}(this, ...) } \arguments{ \item{...}{Not used.} } \value{Returns an \code{\link[base]{integer}}.} \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Options}}. } \keyword{internal} \keyword{methods} \keyword{programming} ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/setTicks.ProgressBar.Rd�����������������������������������������������������������������0000644�0001762�0000144�00000001520�14525573056�016707� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % ProgressBar.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{setTicks.ProgressBar} \alias{setTicks.ProgressBar} \alias{ProgressBar.setTicks} \alias{setTicks,ProgressBar-method} \title{Sets values for which ticks should be visible} \description{ Sets values for which ticks should be visible. } \usage{ \method{setTicks}{ProgressBar}(this, ticks=10, ...) } \arguments{ \item{ticks}{Tick positions (values).} \item{...}{Not used.} } \value{ Returns old tick positions. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{ProgressBar}}. } \keyword{internal} \keyword{methods} ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/getIndices.Arguments.Rd�����������������������������������������������������������������0000644�0001762�0000144�00000002744�14525573054�016717� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Arguments.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Arguments$getIndices} \alias{Arguments$getIndices} \alias{getIndices.Arguments} \alias{Arguments.getIndices} \alias{getIndices,Arguments-method} \alias{Arguments.getIndex} \alias{getIndex.Arguments} \alias{getIndex,Arguments-method} \title{Coerces to a integer vector and validates} \description{ Coerces to a integer vector and validates. } \usage{ ## Static method (use this): ## Arguments$getIndices(x, ..., max=Inf, range=c(1 * (max > 0L), max), .name=NULL) ## Don't use the below: \method{getIndices}{Arguments}(static, x, ..., max=Inf, range=c(1 * (max > 0L), max), .name=NULL) } \arguments{ \item{x}{A single \code{\link[base]{vector}}. If \code{\link[base]{logical}}, \code{\link[base]{which}}() is used.} \item{...}{Arguments passed to @method "getIntegers".} \item{range}{Allowed range. See @method "getNumerics" for details.} \item{max}{The maximum of the default range.} \item{.name}{A \code{\link[base]{character}} string for name used in error messages.} } \value{ Returns an \code{\link[base]{integer}} \code{\link[base]{vector}}. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Arguments}}. } \keyword{internal} \keyword{methods} \keyword{IO} ����������������������������R.utils/man/queryRCmdCheck.Rd�����������������������������������������������������������������������0000644�0001762�0000144�00000002565�14525573061�015545� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % queryRCmdCheck.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{queryRCmdCheck} \alias{queryRCmdCheck} \title{Gets the on R CMD check if the current R session was launched by it} \description{ Gets the on R CMD check if the current R session was launched by it. } \usage{ queryRCmdCheck(...) } \arguments{ \item{...}{Not used.} } \value{ Returns \code{\link[base]{character}} string \code{"checkingTests"} if 'R CMD check' runs one one of the package tests, and \code{"checkingExamples"} if it runs one of the package examples. If the current R session was not launched by 'R CMD check', then \code{"notRunning"} is returned. } \section{Limitations}{ This function only works if the working directory has not been changed. } \examples{ status <- queryRCmdCheck() if (status != "notRunning") { cat("The current R session was launched by R CMD check. Status: ", status, "\n") } else { cat("The current R session was not launched by R CMD check.\n") } # Display how R was launched print(base::commandArgs()) # Display loaded packages etc. print(search()) # Display current working directory print(getwd()) } \author{Henrik Bengtsson} �������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/names.Options.Rd������������������������������������������������������������������������0000644�0001762�0000144�00000001475�14525573056�015434� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Options.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{names.Options} \alias{names.Options} \alias{Options.names} \alias{names,Options-method} \title{Gets the full pathname of all (non-list) options} \description{ Gets the full pathname of all (non-list) options. } \usage{ \method{names}{Options}(x, ...) } \arguments{ \item{...}{Not used.} } \value{Returns a \code{\link[base]{vector}} of \code{\link[base]{character}} strings.} \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Options}}. } \keyword{internal} \keyword{methods} \keyword{programming} ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/currentTimeMillis.System.Rd�������������������������������������������������������������0000644�0001762�0000144�00000001671�14525573057�017634� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % System.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{System$currentTimeMillis} \alias{System$currentTimeMillis} \alias{currentTimeMillis.System} \alias{System.currentTimeMillis} \alias{currentTimeMillis,System-method} \title{Get the current time in milliseconds} \usage{ ## Static method (use this): ## System$currentTimeMillis(...) ## Don't use the below: \method{currentTimeMillis}{System}(this, ...) } \description{ Get the current time in milliseconds. } \value{ Returns an \code{\link[base]{integer}}. } \author{Henrik Bengtsson} \seealso{ \code{\link[base]{Sys.time}}(). \code{\link[base]{proc.time}}(). For more information see \code{\link{System}}. } \keyword{internal} \keyword{methods} �����������������������������������������������������������������������R.utils/man/displayCode.Rd��������������������������������������������������������������������������0000644�0001762�0000144�00000004445�14525573060�015132� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % displayCode.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{displayCode} \alias{displayCode.default} \alias{displayCode} \title{Displays the contents of a text file with line numbers and more} \description{ Displays the contents of a text file with line numbers and more. } \usage{ \method{displayCode}{default}(con=NULL, code=NULL, numerate=TRUE, lines=-1, wrap=79, highlight=NULL, pager=getOption("pager"), ...) } \arguments{ \item{con}{A \code{\link[base:connections]{connection}} or a \code{\link[base]{character}} string filename. If \code{code} is specified, this argument is ignored.} \item{code}{A \code{\link[base]{character}} \code{\link[base]{vector}} of code lines to be displayed.} \item{numerate}{If \code{\link[base:logical]{TRUE}}, line are numbers, otherwise not.} \item{lines}{If a single \code{\link[base]{numeric}}, the maximum number of lines to show. If -1, all lines are shown. If a \code{\link[base]{vector}} of \code{\link[base]{numeric}}, the lines numbers to display.} \item{wrap}{The (output) column \code{\link[base]{numeric}} where to wrap lines.} \item{highlight}{A \code{\link[base]{vector}} of line number to be highlighted.} \item{pager}{If \code{"none"}, code is not displayed in a pager, but only returned. For other options, see \code{\link[base]{file.show}}().} \item{...}{Additional arguments passed to \code{\link[base]{file.show}}(), which is used to display the formatted code.} } \value{ Returns (invisibly) the formatted code as a \code{\link[base]{character}} string. } \examples{ file <- system.file("DESCRIPTION", package="R.utils") cat("Displaying: ", file, ":\n", sep="") displayCode(file) file <- system.file("NEWS.md", package="R.utils") cat("Displaying: ", file, ":\n", sep="") displayCode(file, numerate=FALSE, lines=100:110, wrap=65) file <- system.file("NEWS.md", package="R.utils") cat("Displaying: ", file, ":\n", sep="") displayCode(file, lines=100:110, wrap=65, highlight=c(101,104:108)) } \author{Henrik Bengtsson} \seealso{ \code{\link[base]{file.show}}(). } \keyword{file} \keyword{IO} ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/removeDirectory.Rd����������������������������������������������������������������������0000644�0001762�0000144�00000003112�14525573061�016043� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % removeDirectory.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{removeDirectory} \alias{removeDirectory.default} \alias{removeDirectory} \title{Removes a directory} \description{ Removes a directory, and if requested, also its contents. } \usage{ \method{removeDirectory}{default}(path, recursive=FALSE, mustExist=TRUE, ...) } \arguments{ \item{path}{A \code{\link[base]{character}} string specifying the directory to be removed.} \item{recursive}{If \code{\link[base:logical]{TRUE}}, subdirectories and files are also removed. If \code{\link[base:logical]{FALSE}}, and directory is non-empty, an exception is thrown.} \item{mustExist}{If \code{\link[base:logical]{TRUE}}, and the directory does not exist, an exception is thrown.} \item{...}{Not used.} } \value{ Returns (invisibly) \code{\link[base:logical]{TRUE}}, the directory was successfully removed, otherwise \code{\link[base:logical]{FALSE}}, unless an exception is thrown. } \section{Symbolic links}{ This function can also be used to remove symbolic links to directories without removing the target. Note that neither \code{\link[base]{file.remove}}() nor \code{\link[base]{unlink}}() is capable of remove symbolic \emph{directory} links on Windows. } \author{Henrik Bengtsson} \seealso{ Internally \code{\link[base]{unlink}}() is used. } \keyword{IO} \keyword{programming} ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/getBuiltinUsername.GString.Rd�����������������������������������������������������������0000644�0001762�0000144�00000001700�14525573055�020047� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % GString-class.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{GString$getBuiltinUsername} \alias{GString$getBuiltinUsername} \alias{getBuiltinUsername.GString} \alias{GString.getBuiltinUsername} \alias{getBuiltinUsername,GString-method} \title{Gets the username of the user running R} \description{ Gets the username of the user running R. } \usage{ ## Static method (use this): ## GString$getBuiltinUsername(...) ## Don't use the below: \method{getBuiltinUsername}{GString}(static, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}} string. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{GString}}. } \keyword{internal} \keyword{methods} ����������������������������������������������������������������R.utils/man/gstring.Rd������������������������������������������������������������������������������0000644�0001762�0000144�00000002076�14525573060�014345� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % gstring.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{gstring} \alias{gstring.default} \alias{gstring} \alias{gstring.GString} \title{Parses and evaluates a GString into a regular string} \description{ Parses and evaluates a GString into a regular string. } \usage{ \method{gstring}{default}(..., file=NULL, path=NULL, envir=parent.frame()) } \arguments{ \item{...}{\code{\link[base]{character}} strings.} \item{file, path}{Alternatively, a file, a URL or a \code{\link[base:connections]{connection}} from with the strings are read. If a file, the \code{path} is prepended to the file, iff given.} \item{envir}{The \code{\link[base]{environment}} in which the \code{\link{GString}} is evaluated.} } \value{ Returns a \code{\link[base]{character}} string. } \author{Henrik Bengtsson} \seealso{ \code{\link{gcat}}(). } ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/summary.Verbose.Rd����������������������������������������������������������������������0000644�0001762�0000144�00000001727�14525573060�015773� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{summary.Verbose} \alias{summary.Verbose} \alias{Verbose.summary} \alias{summary,Verbose-method} \title{Generates a summary of an object if above threshold} \description{ Generates a summary of an object if above threshold. The output is \emph{not} indented. } \usage{ \method{summary}{Verbose}(object, ..., level=this$defaultLevel) } \arguments{ \item{...}{Objects to be passed to \code{\link[base]{summary}}().} \item{level}{A \code{\link[base]{numeric}} value to be compared to the threshold.} } \value{ Returns nothing. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} �����������������������������������������R.utils/man/NullVerbose.Rd��������������������������������������������������������������������������0000644�0001762�0000144�00000004366�14525573056�015141� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % NullVerbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{NullVerbose} \docType{class} \alias{NullVerbose} \title{A Verbose class ignoring everything} \description{ Package: R.utils \cr \bold{Class NullVerbose}\cr \code{\link[R.oo]{Object}}\cr \code{~~|}\cr \code{~~+--}\code{\link[R.utils]{Verbose}}\cr \code{~~~~~~~|}\cr \code{~~~~~~~+--}\code{NullVerbose}\cr \bold{Directly known subclasses:}\cr \cr public static class \bold{NullVerbose}\cr extends \link[R.utils]{Verbose}\cr A Verbose class ignoring everything. } \usage{ NullVerbose(...) } \arguments{ \item{...}{Ignored.} } \section{Fields and Methods}{ \bold{Methods:}\cr \tabular{rll}{ \tab \code{cat} \tab -\cr \tab \code{enter} \tab -\cr \tab \code{evaluate} \tab -\cr \tab \code{exit} \tab -\cr \tab \code{header} \tab -\cr \tab \code{isOn} \tab -\cr \tab \code{isVisible} \tab -\cr \tab \code{newline} \tab -\cr \tab \code{print} \tab -\cr \tab \code{printf} \tab -\cr \tab \code{ruler} \tab -\cr \tab \code{str} \tab -\cr \tab \code{summary} \tab -\cr \tab \code{writeRaw} \tab -\cr } \bold{Methods inherited from Verbose}:\cr as.character, as.double, as.logical, capture, cat, enter, enterf, equals, evaluate, exit, getThreshold, getTimestampFormat, header, isOn, isVisible, less, more, newline, off, on, popState, print, printWarnings, printf, pushState, ruler, setDefaultLevel, setThreshold, setTimestampFormat, str, summary, timestamp, timestampOff, timestampOn, writeRaw \bold{Methods inherited from Object}:\cr $, $<-, [[, [[<-, as.character, attach, attachLocally, clearCache, clearLookupCache, clone, detach, equals, extend, finalize, getEnvironment, getFieldModifier, getFieldModifiers, getFields, getInstantiationTime, getStaticInstance, hasField, hashCode, ll, load, names, objectSize, print, save } \examples{ verbose <- Verbose() cat(verbose, "A verbose messages") verbose <- NullVerbose() cat(verbose, "A verbose messages") # Ignored } \author{Henrik Bengtsson} \keyword{classes} \keyword{programming} \keyword{IO} ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/mpager.Rd�������������������������������������������������������������������������������0000644�0001762�0000144�00000002154�14525573061�014141� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % mpager.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{mpager} \alias{mpager} \title{A \"pager\" function that outputs to standard error} \description{ A \"pager\" function that outputs to standard error and is compatible with \code{\link[base]{file.show}}(). } \usage{ mpager(files, header=NULL, title="R Information", delete.file=FALSE) } \arguments{ \item{files}{A \code{\link[base]{character}} \code{\link[base]{vector}} of K pathnames.} \item{header}{A \code{\link[base]{character}} \code{\link[base]{vector}} of K headers.} \item{title}{A \code{\link[base]{character}} string.} \item{delete.file}{If \code{\link[base:logical]{TRUE}}, the files are deleted after displayed, otherwise not.} } \value{ Returns nothing. } \author{Henrik Bengtsson} \seealso{ \code{\link[base]{file.show}}() and argument \code{pager}. } \keyword{programming} \keyword{IO} \keyword{file} ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/print.Verbose.Rd������������������������������������������������������������������������0000644�0001762�0000144�00000001642�14525573060�015426� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{print.Verbose} \alias{print.Verbose} \alias{Verbose.print} \alias{print,Verbose-method} \title{Prints objects if above threshold} \description{ Prints objects if above threshold. The output is \emph{not} indented. } \usage{ \method{print}{Verbose}(x, ..., level=this$defaultLevel) } \arguments{ \item{...}{Objects to be passed to \code{\link[base]{print}}().} \item{level}{A \code{\link[base]{numeric}} value to be compared to the threshold.} } \value{ Returns nothing. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} ����������������������������������������������������������������������������������������������R.utils/man/LComments.Rd����������������������������������������������������������������������������0000644�0001762�0000144�00000003372�14525573056�014576� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % LComments.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{LComments} \docType{class} \alias{LComments} \title{The LComments class} \description{ Package: R.utils \cr \bold{Class LComments}\cr \code{\link[R.oo]{Object}}\cr \code{~~|}\cr \code{~~+--}\code{\link[R.utils]{SmartComments}}\cr \code{~~~~~~~|}\cr \code{~~~~~~~+--}\code{\link[R.utils]{VComments}}\cr \code{~~~~~~~~~~~~|}\cr \code{~~~~~~~~~~~~+--}\code{LComments}\cr \bold{Directly known subclasses:}\cr \cr public static class \bold{LComments}\cr extends \link[R.utils]{VComments}\cr The LComments class. This class, is almost identical to the super class, except that the constructor has different defaults. } \usage{ LComments(letter="L", verboseName="log", ...) } \arguments{ \item{letter}{The smart letter.} \item{verboseName}{The name of the verbose object.} \item{...}{Not used.} } \section{Fields and Methods}{ \bold{Methods:}\cr \emph{No methods defined}. \bold{Methods inherited from VComments}:\cr convertComment, reset, validate \bold{Methods inherited from SmartComments}:\cr compile, convertComment, parse, reset, validate \bold{Methods inherited from Object}:\cr $, $<-, [[, [[<-, as.character, attach, attachLocally, clearCache, clearLookupCache, clone, detach, equals, extend, finalize, getEnvironment, getFieldModifier, getFieldModifiers, getFields, getInstantiationTime, getStaticInstance, hasField, hashCode, ll, load, names, objectSize, print, save } \author{Henrik Bengtsson} \keyword{classes} \keyword{programming} \keyword{IO} ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/cat.Verbose.Rd��������������������������������������������������������������������������0000644�0001762�0000144�00000002705�14525573060�015042� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{cat.Verbose} \alias{cat.Verbose} \alias{Verbose.cat} \alias{cat,Verbose-method} \title{Concatenates and prints objects if above threshold} \description{ Concatenates and prints objects if above threshold. The output is indented according to \code{\link[R.utils:enter.Verbose]{*enter}()}/\code{\link[R.utils:exit.Verbose]{*exit}()} calls. } \usage{ \method{cat}{Verbose}(this, ..., sep="", newline=TRUE, level=this$defaultLevel, timestamp=this$.timestamp) } \arguments{ \item{...}{Objects to be passed to \code{\link[base]{cat}}().} \item{sep}{The default separator \code{\link[base]{character}} string.} \item{newline}{If \code{\link[base:logical]{TRUE}}, a newline is added at the end, otherwise not.} \item{level}{A \code{\link[base]{numeric}} value to be compared to the threshold.} \item{timestamp}{A \code{\link[base]{logical}} indicating if output should start with a timestamp, or not.} } \value{ Returns nothing. } \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:timestampOn.Verbose]{*timestampOn}()} and \code{timestampOff}(). For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} �����������������������������������������������������������R.utils/man/swapXY.density.Rd�����������������������������������������������������������������������0000644�0001762�0000144�00000001630�14525573060�015574� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % density.EXTS.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{swapXY.density} \alias{swapXY.density} \title{Swaps x and y coordinates of a density object} \description{ Swaps x and y coordinates of a density object returned by \code{\link[stats]{density}}. } \usage{ \method{swapXY}{density}(object, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns a 'density' object of the same class with elements 'x' and 'y' swapped. } \author{Henrik Bengtsson} \seealso{ See \code{\link[stats]{density}} for estimating densities. See \code{\link[R.utils:draw.density]{*draw}()} for plotting a density along one of the sides. } \keyword{methods} \keyword{internal} ��������������������������������������������������������������������������������������������������������R.utils/man/withSink.Rd�����������������������������������������������������������������������������0000644�0001762�0000144�00000004104�14525573061�014463� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % withSink.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{withSink} \alias{withSink} \title{Evaluate an R expression while temporarily diverting output} \description{ Evaluate an R expression while temporarily diverting output. } \usage{ withSink(expr, file, append=FALSE, type=c("output", "message"), substitute=TRUE, envir=parent.frame()) } \arguments{ \item{expr}{The R expression to be evaluated.} \item{file}{A writable \code{\link[base:connections]{connection}} or a \code{\link[base]{character}} string naming the file to write to.} \item{append}{If \code{\link[base:logical]{TRUE}}, the diverted output is appended to the file, otherwise not.} \item{type}{A \code{\link[base]{character}} string specifying whether to divert output sent to the standard output or the standard error. See \code{\link[base]{sink}}() for details.} \item{substitute}{If \code{\link[base:logical]{TRUE}}, argument \code{expr} is \code{\link[base]{substitute}()}:ed, otherwise not.} \item{envir}{The \code{\link[base]{environment}} in which the expression should be evaluated.} } \value{ Returns the results of the expression evaluated. } \details{ Upon exit (also on errors), this function will close the requested "sink". If additional sinks (of any type) where also opened during the evaluation, those will also be closed with a warning. } \author{Henrik Bengtsson} \examples{ # Divert standard output pathname <- tempfile(fileext=".output.txt") res <- withSink(file=pathname, { print(letters) }) mcat(readLines(pathname), sep="\n") # Divert standard error/messages pathname <- tempfile(fileext=".message.txt") res <- withSink(file=pathname, type="message", { mprint(LETTERS) }) mcat(readLines(pathname), sep="\n") } \seealso{ Internally, \code{\link[base]{sink}}() is used to divert any output. } \keyword{IO} \keyword{programming} ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/flush.TextStatusBar.Rd������������������������������������������������������������������0000644�0001762�0000144�00000001675�14525573057�016577� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % TextStatusBar.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{flush.TextStatusBar} \alias{flush.TextStatusBar} \alias{TextStatusBar.flush} \alias{flush,TextStatusBar-method} \title{Flushes the output} \description{ Flushes the output. } \usage{ \method{flush}{TextStatusBar}(con, ...) } \arguments{ \item{...}{Arguments passed to \code{\link[base]{cat}}().} } \value{ Returns nothing. } \details{ All this methods does is to call \code{\link[utils]{flush.console}}, which flushes the output to the console. } \author{Henrik Bengtsson} \seealso{ \code{\link[utils]{flush.console}}. For more information see \code{\link{TextStatusBar}}. } \keyword{internal} \keyword{methods} \keyword{programming} �������������������������������������������������������������������R.utils/man/finalizeSession.Rd����������������������������������������������������������������������0000644�0001762�0000144�00000001656�14525573060�016040� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % finalizeSession.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{finalizeSession} \alias{finalizeSession.default} \alias{finalizeSession} \title{Function to call for finalizing the R session} \description{ Function to call for finalizing the R session. When called, all registered "onSessionExit" hooks (functions) are called. To define such hooks, use the \code{\link{onSessionExit}}() function. This method should not be used by the user. } \usage{ \method{finalizeSession}{default}(...) } \arguments{ \item{...}{Not used.} } \value{ Returns (invisibly) the hooks successfully called. } \author{Henrik Bengtsson} \seealso{ \code{\link{onSessionExit}}(). } \keyword{programming} ����������������������������������������������������������������������������������R.utils/man/intervalsToSeq.matrix.Rd����������������������������������������������������������������0000644�0001762�0000144�00000002013�14525573061�017146� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % intervalsToSeq.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{intervalsToSeq.matrix} \alias{intervalsToSeq.matrix} \title{Generates a vector of indices from a matrix of intervals} \description{ Generates a vector of indices from a matrix of intervals. } \usage{ \method{intervalsToSeq}{matrix}(fromTo, sort=FALSE, unique=FALSE, ...) } \arguments{ \item{fromTo}{An Nx2 \code{\link[base]{integer}} \code{\link[base]{matrix}}.} \item{sort}{If \code{\link[base:logical]{TRUE}}, the returned indices are ordered.} \item{unique}{If \code{\link[base:logical]{TRUE}}, the returned indices are unique.} \item{...}{Not used.} } \author{Henrik Bengtsson} \examples{\dontrun{See example(seqToIntervals)}} \seealso{ \code{\link{seqToIntervals}}(). } \keyword{methods} \keyword{attribute} ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/saveObject.Rd���������������������������������������������������������������������������0000644�0001762�0000144�00000003245�14525573061�014755� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % saveObject.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{saveObject} \alias{saveObject.default} \alias{saveObject} \title{Saves an object to a file or a connection} \description{ Saves an object to a file or a connection. } \usage{ \method{saveObject}{default}(object, file=NULL, path=NULL, format=c("auto", "xdr", "rds"), compress=TRUE, ..., safe=TRUE) } \arguments{ \item{object}{The object to be saved.} \item{file}{A filename or \code{\link[base:connections]{connection}} where the object should be saved. If \code{\link[base]{NULL}}, the filename will be the hash code of the object plus ".xdr".} \item{path}{Optional path, if \code{file} is a filename.} \item{format}{File format.} \item{compress}{If \code{\link[base:logical]{TRUE}}, the file is compressed to, otherwise not.} \item{...}{Other arguments accepted by \code{save()} in the base package.} \item{safe}{If \code{\link[base:logical]{TRUE}} and \code{file} is a file, then, in order to lower the risk for incomplete files, the object is first written to a temporary file, which is then renamed to the final name.} } \value{ Returns (invisibly) the pathname or the \code{\link[base:connections]{connection}}. } \author{Henrik Bengtsson} \seealso{ \code{\link{loadObject}}() to load an object from file. \code{\link[digest]{digest}} for how hash codes are calculated from an object. See also \code{\link[base]{saveRDS}}(). } \keyword{programming} \keyword{IO} �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/getBuiltinDatetime.GString.Rd�����������������������������������������������������������0000644�0001762�0000144�00000002007�14525573055�020025� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % GString-class.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{GString$getBuiltinDatetime} \alias{GString$getBuiltinDatetime} \alias{getBuiltinDatetime.GString} \alias{GString.getBuiltinDatetime} \alias{getBuiltinDatetime,GString-method} \title{Gets the current date and time} \description{ Gets the current date and time. } \usage{ ## Static method (use this): ## GString$getBuiltinDatetime(format=NULL, ...) ## Don't use the below: \method{getBuiltinDatetime}{GString}(static, format=NULL, ...) } \arguments{ \item{format}{A \code{\link[base]{character}} format string.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}} string. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{GString}}. } \keyword{internal} \keyword{methods} �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/readByte.Java.Rd������������������������������������������������������������������������0000644�0001762�0000144�00000002310�14525573055�015302� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Java.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Java$readByte} \alias{Java$readByte} \alias{readByte.Java} \alias{Java.readByte} \alias{readByte,Java-method} \title{Reads a Java formatted byte (8 bits) from a connection} \description{ Reads one or several Java formatted byte's (8 bits) from a connection. All data types in Java are signed, i.e. a byte can hold a value in the range [-128,127]. } \usage{ ## Static method (use this): ## Java$readByte(con, n=1, ...) ## Don't use the below: \method{readByte}{Java}(static, con, n=1, ...) } \arguments{ \item{con}{Binary connection to be read from.} \item{n}{Number of byte's to be read.} \item{...}{Not used.} } \value{ Returns an \code{\link[base]{integer}} \code{\link[base]{vector}}. } \details{ This method is included for consistency reasons only. } \author{Henrik Bengtsson} \seealso{ \code{\link[base]{readBin}}(). For more information see \code{\link{Java}}. } \keyword{internal} \keyword{methods} ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/GString-class.Rd������������������������������������������������������������������������0000644�0001762�0000144�00000013143�14525573055�015351� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % GString-class.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{GString} \docType{class} \alias{GString} \title{Character string with advanced substitutions} \description{ Package: R.utils \cr \bold{Class GString}\cr \code{character}\cr \code{~~|}\cr \code{~~+--}\code{GString}\cr \bold{Directly known subclasses:}\cr \cr public static class \bold{GString}\cr extends character\cr } \usage{ GString(..., sep="") } \arguments{ \item{...}{one or more objects, to be coerced to \code{\link[base]{character}} vectors.} \item{sep}{A \code{\link[base]{character}} string to separate the terms.} } \section{Fields and Methods}{ \bold{Methods:}\cr \tabular{rll}{ \tab \code{as.character} \tab -\cr \tab \code{evaluate} \tab -\cr \tab \code{gcat} \tab -\cr \tab \code{getBuiltinDate} \tab -\cr \tab \code{getBuiltinDatetime} \tab -\cr \tab \code{getBuiltinHostname} \tab -\cr \tab \code{getBuiltinOs} \tab -\cr \tab \code{getBuiltinPid} \tab -\cr \tab \code{getBuiltinRhome} \tab -\cr \tab \code{getBuiltinRversion} \tab -\cr \tab \code{getBuiltinTime} \tab -\cr \tab \code{getBuiltinUsername} \tab -\cr \tab \code{getRaw} \tab -\cr \tab \code{getVariableValue} \tab -\cr \tab \code{gstring} \tab -\cr \tab \code{parse} \tab -\cr \tab \code{print} \tab -\cr } \bold{Methods inherited from character}:\cr Ops,nonStructure,vector-method, Ops,structure,vector-method, Ops,vector,nonStructure-method, Ops,vector,structure-method, all.equal, as.Date, as.POSIXlt, as.data.frame, as.raster, coerce,ANY,character-method, coerce,character,SuperClassMethod-method, coerce,character,signature-method, coerce<-,ObjectsWithPackage,character-method, coerce<-,signature,character-method, downloadFile, formula, getDLLRegisteredRoutines, glyphJust, isOpen, makeRaw, sha1, toAsciiRegExprPattern, toFileListTree, toLatex, uses } \examples{ # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # First example # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - who <- "world" # Compare this... cat(as.character(GString("Hello ${who}\n"))) # ...to this. cat(GString("Hello ${who}\n")) # Escaping cat(as.character(GString("Hello \\\\${who}\n"))) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Looping over vectors # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x <- 1:5 y <- c("hello", "world") cat(as.character(GString("(x,y)=(${x},${y})")), sep=", ") cat("\n") cat(as.character(GString("(x,y)=(${x},$[capitalize]{y})")), sep=", ") cat("\n") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Predefined ("builtin") variables # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - cat(as.character(GString("Hello ${username} on host ${hostname} running ", "R v${rversion} in process #${pid} on ${os}. R is installed in ${rhome}."))) # Other built-in variables/functions... cat(as.character(GString("Current date: ${date}\n"))) cat(as.character(GString("Current date: $[format='\%d/\%m/\%y']{date}\n"))) cat(as.character(GString("Current time: ${time}\n"))) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Evaluating inline R code # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - cat(as.character(GString("Simple calculation: 1+1=${`1+1`}\n"))) cat(as.character(GString("Alternative current date: ${`date()`}\n"))) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Function values # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Call function rnorm with arguments n=1, i.e. rnorm(n=1) cat(as.character(GString("Random normal number: $[n=1]{rnorm}\n"))) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Global search-replace feature # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Replace all '-' with '.' cat(as.character(GString("Current date: ${date/-/.}\n"))) # Another example cat(as.character(GString("Escaped string: 12*12=${`12*12`/1/}\n"))) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Defining new "builtin" function values # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Define your own builtin variables (functions) setMethodS3("getBuiltinAletter", "GString", function(object, ...) { base::letters[runif(1, min=1, max=length(base::letters))] }) cat(as.character(GString("A letter: ${aletter}\n"))) cat(as.character(GString("Another letter: ${aletter}\n"))) # Another example setMethodS3("getBuiltinGstring", "GString", function(object, ...) { # Return another GString. GString("${date} ${time}") }) cat(as.character(GString("Advanced example: ${gstring}\n"))) # Advanced example setMethodS3("getBuiltinRunif", "GString", function(object, n=1, min=0, max=1, ...) { formatC(runif(n=n, min=min, max=max), ...) }) cat(as.character(GString("A random number: ${runif}\n"))) n <- 5 cat(as.character(GString("${n} random numbers: "))) cat(as.character(GString("$[n=n, format='f']{runif}"))) cat("\n") # Advanced options. # Options are parsed as if they are elements in a list, e.g. # list(n=runif(n=1,min=1,max=5), format='f') cat(as.character(GString("$Random number of numbers: "))) cat(as.character(GString("$[n=runif(n=1,min=1,max=5), format='f']{runif}"))) cat("\n") } \author{Henrik Bengtsson} \seealso{ For convenience, see functions \code{\link{gstring}}() and \code{\link{gcat}}(). } \keyword{classes} �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/colClasses.Rd���������������������������������������������������������������������������0000644�0001762�0000144�00000004127�14525573060�014762� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % colClasses.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{colClasses} \alias{colClasses.default} \alias{colClasses} \title{Creates a vector of column classes used for tabular reading} \description{ Creates a vector of column classes used for tabular reading based on a compact format string. } \usage{ \method{colClasses}{default}(fmt, ...) } \arguments{ \item{fmt}{A \code{\link[base]{character}} string specifying the column-class format. This string is first translated by \code{\link[base]{sprintf}}().} \item{...}{Optional arguments for the \code{\link[base]{sprintf}}() translation.} } \value{ Returns a \code{\link[base]{vector}} of \code{\link[base]{character}} strings. } \author{Henrik Bengtsson} \examples{ # All predefined types print(colClasses("-?cdfilnrzDP")) ## [1] "NULL" "NA" "character" "double" ## [5] "factor" "integer" "logical" "numeric" ## [9] "raw" "complex" "Date" "POSIXct" # A string in column 1, integers in column 4 and 5, rest skipped print(colClasses("c--ii----")) ## [1] "character" "NULL" "NULL" "integer" ## [5] "integer" "NULL" "NULL" "NULL" ## [9] "NULL" # Repeats and custom column classes c1 <- colClasses("3c{MyClass}3{foo}") print(c1) ## [1] "character" "character" "character" "MyClass" ## [5] "foo" "foo" "foo" # Passing repeats and class names using sprintf() syntax c2 <- colClasses("\%dc{\%s}\%d{foo}", 3, "MyClass", 3) stopifnot(identical(c1, c2)) # Repeats of a vector of column classes c3 <- colClasses("3{MyClass,c}") print(c3) ## [1] "MyClass" "character" "MyClass" "character" ## [4] "MyClass" "character" # Large number repeats c4 <- colClasses("321{MyClass,c,i,d}") c5 <- rep(c("MyClass", "character", "integer", "double"), times=321) stopifnot(identical(c4, c5)) } \seealso{ \code{\link[utils]{read.table}}. } \keyword{programming} �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/resample.Rd�����������������������������������������������������������������������������0000644�0001762�0000144�00000002414�14525573061�014475� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % resample.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{resample} \alias{resample.default} \alias{resample} \title{Sample values from a set of elements} \description{ Sample values from a set of elements. Contrary to \code{\link[base]{sample}}(), this function also works as expected when there is only one element in the set to be sampled, cf. [1]. This function originates from the example code of \code{\link[base]{sample}}() as of R v2.12.0. } \usage{ \method{resample}{default}(x, ...) } \arguments{ \item{x}{A \code{\link[base]{vector}} of any length and data type.} \item{...}{Additional arguments passed to \code{\link[base]{sample.int}}().} } \value{ Returns a sampled \code{\link[base]{vector}} of the same data types as argument \code{x}. } \author{Henrik Bengtsson} \seealso{ Internally \code{\link[base]{sample.int}}() is used. } \references{ [1] Henrik Bengtsson, \emph{Using sample() to sample one value from a single value?}, R-devel mailing list, 2010-11-03.\cr } \keyword{IO} \keyword{programming} ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/getAbsolutePath.Rd����������������������������������������������������������������������0000644�0001762�0000144�00000002516�14525573060�015762� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % getAbsolutePath.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{getAbsolutePath} \alias{getAbsolutePath.default} \alias{getAbsolutePath} \title{Gets the absolute pathname string} \usage{ \method{getAbsolutePath}{default}(pathname, workDirectory=getwd(), expandTilde=FALSE, ...) } \description{ Gets the absolute pathname string. } \arguments{ \item{pathname}{A \code{\link[base]{character}} string of the pathname to be converted into an absolute pathname.} \item{workDirectory}{A \code{\link[base]{character}} string of the current working directory.} \item{expandTilde}{If \code{\link[base:logical]{TRUE}}, tilde (\code{~}) is expanded to the corresponding directory, otherwise not.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}} string of the absolute pathname. } \details{ This method will replace replicated slashes ('/') with a single one, except for the double forward slashes prefixing a Microsoft Windows UNC (Universal Naming Convention) pathname. } \author{Henrik Bengtsson} \seealso{ \code{\link{isAbsolutePath}}(). } \keyword{IO} \keyword{programming} ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/openBrowser.System.Rd�������������������������������������������������������������������0000644�0001762�0000144�00000004726�14525573057�016472� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % System.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{System$openBrowser} \alias{System$openBrowser} \alias{openBrowser.System} \alias{System.openBrowser} \alias{openBrowser,System-method} \title{Opens an HTML document using the OS default HTML browser} \usage{ ## Static method (use this): ## System$openBrowser(query, ...) ## Don't use the below: \method{openBrowser}{System}(this, query, ...) } \arguments{ \item{query}{The path to document to be opened by the browser.} } \description{ Opens an HTML document using the OS default HTML browser. Note that this call is dependent on the operating system (currently only Windows and Unix are supported). The document given by \code{query} can either be a local file or a web page. If the \code{query} was given as non-url string, i.e. as a standard file pathname, the method will automatically check if the file exists and conform the query to a correct url starting with \code{file:}. The used url will be returned as a string. Any suggestion how implement this on Apple system are welcome! } \value{ Returns the url of the \code{query}. } \details{ It is hard to create a good cross-platform \code{openBrowser()} method, but here is one try. In the following text \code{<browser>} is the value returned by \code{getOption("browser")} and \code{<url>} is the URL conformed query, which starts with either \code{file:} or \code{http:}. On a \emph{Windows} system, if \code{<browser>} is not \code{\link[base]{NULL}}, first \code{shell.exec(<browser> <url>)} is tried. If this fails, then \code{shell.exec(<url>)} is tried. Using this latter approach will \emph{not} guarantee that an HTML browser will open the url, e.g. depending on the Windows file associations, a \code{*.txt} file might be opened by NotePad. However, it will most likely open something. If \code{<browser>} contains spaces, make sure it is quoted. On \emph{Unix} systems, \code{system()} will be used to call: \code{ <browser> -remote "openURL(<url>)" 2> /dev/null || <browser> <url> &} } \examples{\dontrun{ System$openBrowser("https://www.r-project.org/") }} \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{System}}. } \keyword{internal} \keyword{methods} ������������������������������������������R.utils/man/touchFile.Rd����������������������������������������������������������������������������0000644�0001762�0000144�00000003424�14525573061�014611� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % touchFile.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{touchFile} \alias{touchFile.default} \alias{touchFile} \title{Updates the timestamp of a file} \description{ Updates the timestamp of a file. Currently, it is only possible to change the timestamp specifying when the file was last modified, and time can only be set to the current time. } \usage{ \method{touchFile}{default}(pathname, ...) } \arguments{ \item{pathname}{A \code{\link[base]{character}} \code{\link[base]{vector}} specifying files to be updated.} \item{...}{Not used.} } \value{ Returns (invisibly) a \code{\link[base]{vector}} of the old timestamps. } \examples{ # 1. Create a file pathname <- tempfile() cat(file=pathname, "Hello world!") md5a <- digest::digest(pathname, file=TRUE) # 2. Current time stamp ta <- file.info(pathname)$mtime print(ta) # 3. Update time stamp Sys.sleep(1.2) touchFile(pathname) tb <- file.info(pathname)$mtime print(tb) # 4. Verify that the timestamp got updated stopifnot(tb > ta) # 5. Verify that the contents did not change md5b <- digest::digest(pathname, file=TRUE) stopifnot(identical(md5a, md5b)) } \author{Henrik Bengtsson} \seealso{ Internally, \code{\link[base]{Sys.setFileTime}}() (iff available) and \code{\link[base]{file.info}}() are utilized. } \references{ [1] R-devel mailing list thread \emph{Unix-like touch to update modification timestamp of file?}, started on 2008-02-26. \url{https://stat.ethz.ch/pipermail/r-devel/2008-February/048542.html}\cr } \keyword{programming} \keyword{IO} \keyword{file} ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/findGraphicsDevice.System.Rd������������������������������������������������������������0000644�0001762�0000144�00000005364�14525573057�017705� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % System.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{System$findGraphicsDevice} \alias{System$findGraphicsDevice} \alias{findGraphicsDevice.System} \alias{System.findGraphicsDevice} \alias{findGraphicsDevice,System-method} \title{Searches for a working PNG device} \description{ Searches for a working PNG device. On Unix, the png device requires that X11 is available, which it is not when running batch scripts or running \R remotely. In such cases, an alternative is to use the \code{bitmap()} device, which generates an EPS file and the uses Ghostscript to transform it to a PNG file. Moreover, if identical looking bitmap and vector graphics (EPS) files are wanted for the same figures, in practice, \code{bitmap()} has to be used. By default, this method tests a list of potential graphical devices and returns the first that successfully creates an image file. By default, it tries to create a PNG image file via the built-in \code{png()} device. } \usage{ ## Static method (use this): ## System$findGraphicsDevice(devices=list(png), maxCount=100, sleepInterval=0.1, ## findGhostscript=TRUE, ...) ## Don't use the below: \method{findGraphicsDevice}{System}(static, devices=list(png), maxCount=100, sleepInterval=0.1, findGhostscript=TRUE, ...) } \arguments{ \item{devices}{A \code{\link[base]{list}} of graphics device driver \code{\link[base]{function}}s to be tested.} \item{maxCount}{The maximum number of subsequent tests for the the existences of \code{bitmap()} generated image files.} \item{sleepInterval}{The time in seconds between above subsequent tests.} \item{findGhostscript}{If \code{\link[base:logical]{TRUE}}, Ghostscript, which is needed by the \code{bitmap()} device, is searched for on the current system. If found, its location is recorded.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{function}} that generates images, or \code{\link[base]{NULL}}. } \author{Henrik Bengtsson} \examples{ fcn <- System$findGraphicsDevice() if (identical(fcn, png)) { cat("PNG device found: png()") } else if (identical(fcn, bitmap)) { cat("PNG device found: bitmap()") } else { cat("PNG device not found.") } } \seealso{ For supported graphical devices, see \code{\link{capabilities}}(). \code{\link[grDevices]{png}}, \code{bitmap()} and \code{\link[grDevices]{dev2bitmap}}. \code{\link[R.utils:findGhostscript.System]{*findGhostscript}()}. For more information see \code{\link{System}}. } \keyword{internal} \keyword{methods} \keyword{device} ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/tempvar.Rd������������������������������������������������������������������������������0000644�0001762�0000144�00000003341�14525573061�014343� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % tempvar.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{tempvar} \alias{tempvar} \title{Gets a unique non-existing temporary variable name} \description{ Gets a unique non-existing temporary variable name, and optionally assigns it an initial value. } \usage{ tempvar(prefix="var", value, envir=parent.frame(), inherits=FALSE) } \arguments{ \item{prefix}{A \code{\link[base]{character}} string specifying the prefix of the temporary variable name.} \item{value}{(optional) If given, a variable with the temporary name is assigned this value. Only works if \code{envir} is an environment.} \item{envir}{An \code{\link[base]{environment}}, a named \code{\link[base]{list}}, or a named \code{\link[base]{data.frame}}, whose elements the temporary variable should not clash with.} \item{inherits}{A \code{\link[base]{logical}} specifying whether the enclosing frames of the environment should be searched or not.} } \value{ Returns a \code{\link[base]{character}} string. } \examples{ # Get a temporary variable name <- tempvar() print(name) # Get and assign a temporary variable name <- tempvar(value=base::letters) print(name) str(get(name)) # Get a temporary variable with custom prefix name <- tempvar(prefix=".hidden") print(name) # Get a temporary variable for a data.frame name <- tempvar(envir = datasets::mtcars) print(name) } \author{Henrik Bengtsson} \seealso{ \code{\link[base]{tempfile}}() and \code{\link[base]{assign}}(). } \keyword{programming} \keyword{internal} �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/setLabel.TextStatusBar.Rd���������������������������������������������������������������0000644�0001762�0000144�00000002034�14525573057�017177� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % TextStatusBar.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{setLabel.TextStatusBar} \alias{setLabel.TextStatusBar} \alias{TextStatusBar.setLabel} \alias{setLabel,TextStatusBar-method} \title{Sets the value of a label} \description{ Sets the value of a label address either by its index or its names. } \usage{ \method{setLabel}{TextStatusBar}(this, label, value, ...) } \arguments{ \item{label}{The index or the name of the label.} \item{value}{The value of the label.} \item{...}{Not used.} } \value{ Returns nothing. } \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:setLabels.TextStatusBar]{*setLabels}()} \code{\link[R.utils:getLabel.TextStatusBar]{*getLabel}()} For more information see \code{\link{TextStatusBar}}. } \keyword{internal} \keyword{methods} \keyword{programming} ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/newline.Verbose.Rd����������������������������������������������������������������������0000644�0001762�0000144�00000001623�14525573060�015732� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{newline.Verbose} \alias{newline.Verbose} \alias{Verbose.newline} \alias{newline,Verbose-method} \title{Writes one or several empty lines} \description{ Writes one or several empty lines. } \usage{ \method{newline}{Verbose}(this, n=1, ..., level=this$defaultLevel) } \arguments{ \item{n}{The number of empty lines to write.} \item{...}{Not used.} \item{level}{A \code{\link[base]{numeric}} value to be compared to the threshold.} } \value{ Returns nothing. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} �������������������������������������������������������������������������������������������������������������R.utils/man/getBuiltinTime.GString.Rd���������������������������������������������������������������0000644�0001762�0000144�00000001753�14525573055�017176� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % GString-class.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{GString$getBuiltinTime} \alias{GString$getBuiltinTime} \alias{getBuiltinTime.GString} \alias{GString.getBuiltinTime} \alias{getBuiltinTime,GString-method} \title{Gets the current time} \description{ Gets the current time. } \usage{ ## Static method (use this): ## GString$getBuiltinTime(format="\%H:\%M:\%S", ...) ## Don't use the below: \method{getBuiltinTime}{GString}(static, format="\%H:\%M:\%S", ...) } \arguments{ \item{format}{A \code{\link[base]{character}} format string.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}} string. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{GString}}. } \keyword{internal} \keyword{methods} ���������������������R.utils/man/getVariableValue.GString.Rd�������������������������������������������������������������0000644�0001762�0000144�00000003233�14525573055�017466� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % GString-class.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{GString$getVariableValue} \alias{GString$getVariableValue} \alias{getVariableValue.GString} \alias{GString.getVariableValue} \alias{getVariableValue,GString-method} \title{Gets a variable value given a name and attributes} \description{ Gets a variable value given a name and attributes. } \usage{ ## Static method (use this): ## GString$getVariableValue(name, attributes="", where=c("builtin", "envir", ## "parent", "Sys.getenv", "getOption"), envir=parent.frame(), inherits=TRUE, ## missingValue=NA, ...) ## Don't use the below: \method{getVariableValue}{GString}(static, name, attributes="", where=c("builtin", "envir", "parent", "Sys.getenv", "getOption"), envir=parent.frame(), inherits=TRUE, missingValue=NA, ...) } \arguments{ \item{name}{The name of the variable or function to be queried.} \item{attributes}{A \code{\link[base]{character}} string of the attributes.} \item{where}{A \code{\link[base]{character}} \code{\link[base]{vector}} of where to search for the variable or function.} \item{envir}{An \code{\link[base]{environment}}.} \item{inherits}{A \code{\link[base]{logical}}.} \item{missingValue}{The value returned if not found.} \item{...}{Not used.} } \value{ Returns a (\code{\link[base]{vector}} of) objects. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{GString}}. } \keyword{internal} \keyword{methods} ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/loadAnywhere.Settings.Rd����������������������������������������������������������������0000644�0001762�0000144�00000003101�14525573056�017104� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Settings.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{loadAnywhere.Settings} \alias{loadAnywhere.Settings} \alias{Settings.loadAnywhere} \alias{loadAnywhere,Settings-method} \title{Loads settings from file} \description{ Loads settings from file. If the settings was read from file, they are by default written back to the same file. If this was not the case, it defaults to the settings file in the home directory of the current user. } \usage{ \method{loadAnywhere}{Settings}(static, file=NULL, ..., verbose=FALSE) } \arguments{ \item{file}{A \code{\link[base]{character}} string or a \code{\link[base:connections]{connection}} from which settings should be read. If \code{\link[base]{NULL}}, the settings file is searched for by \code{\link[R.utils:findSettings.Settings]{*findSettings}()}.} \item{...}{Arguments passed to \code{\link[R.utils:findSettings.Settings]{*findSettings}()}.} \item{verbose}{If \code{\link[base:logical]{TRUE}}, verbose information is written while reading, otherwise not.} } \value{Returns a \link{Settings} object if file was successfully read, otherwise \code{\link[base]{NULL}}.} \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:saveAnywhere.Settings]{*saveAnywhere}()}. For more information see \code{\link{Settings}}. } \keyword{internal} \keyword{methods} \keyword{programming} ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/captureOutput.Rd������������������������������������������������������������������������0000644�0001762�0000144�00000005325�14525573060�015554� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % captureOutput.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{captureOutput} \alias{captureOutput} \title{Evaluate an R expression and captures the output} \description{ Evaluate an R expression and captures the output. } \usage{ captureOutput(expr, file=NULL, append=FALSE, collapse=NULL, envir=parent.frame()) } \arguments{ \item{expr}{The R expression to be evaluated.} \item{file}{A file name or a \code{\link[base:connections]{connection}} to where the output is directed. Alternatively, if \code{\link[base]{NULL}} the output is captured to and returned as a \code{\link[base]{character}} \code{\link[base]{vector}}.} \item{append}{If \code{\link[base:logical]{TRUE}}, the output is appended to the file or the (unopened) connection, otherwise it overwrites.} \item{collapse}{A \code{\link[base]{character}} string used for collapsing the captured rows. If \code{\link[base]{NULL}}, the rows are not collapsed.} \item{envir}{The \code{\link[base]{environment}} in which the expression is evaluated.} } \value{ Returns captured output as a \code{\link[base]{character}} \code{\link[base]{vector}}. } \details{ This method imitates \code{\link[utils]{capture.output}} with the major difference that it captures strings via a \code{\link[base]{raw}} connection rather than via internal strings. The latter becomes exponentially slow for large outputs [1,2]. } \examples{ # captureOutput() is much faster than capture.output() # for large outputs when capturing to a string. for (n in c(10e3, 20e3, 30e3, 40e3)) { printf("n=\%d\n", n) x <- rnorm(n) t0 <- system.time({ bfr0 <- capture.output(print(x)) }) print(t0) t1 <- system.time({ bfr <- captureOutput(print(x)) }) print(t1) print(t1/t0) bfr2n <- captureOutput(print(x), collapse="\n") bfr2r <- captureOutput(print(x), collapse="\r") stopifnot(identical(bfr, bfr0)) } # for (n ...) } \author{Henrik Bengtsson} \seealso{ Internally, \code{\link[base]{eval}}() is used to evaluate the expression. and \code{\link[utils]{capture.output}} to capture the output. } \references{ [1] R-devel thread 'capture.output(): Using a rawConnection() [linear] instead of textConnection() [exponential]?', 2014-02-04. \url{https://stat.ethz.ch/pipermail/r-devel/2014-February/068349.html} [2] JottR blog post 'PERFORMANCE: captureOutput() is much faster than capture.output()', 2015-05-26. \url{https://www.jottr.org/2014/05/26/captureoutput/} } \keyword{IO} \keyword{programming} �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/setDefaultLevel.Verbose.Rd��������������������������������������������������������������0000644�0001762�0000144�00000001551�14525573060�017361� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{setDefaultLevel.Verbose} \alias{setDefaultLevel.Verbose} \alias{Verbose.setDefaultLevel} \alias{setDefaultLevel,Verbose-method} \title{Sets the current default verbose level} \description{ Sets the current default verbose level. } \usage{ \method{setDefaultLevel}{Verbose}(this, level, ...) } \arguments{ \item{level}{A \code{\link[base]{numeric}} value.} \item{...}{Not used.} } \value{ Returns old default level. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} �������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/isUrl.Rd��������������������������������������������������������������������������������0000644�0001762�0000144�00000001510�14525573061�013757� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % isUrl.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{isUrl} \alias{isUrl.default} \alias{isUrl} \title{Checks if one or several pathnames is URLs} \description{ Checks if one or several pathnames is URLs. } \usage{ \method{isUrl}{default}(pathname, ...) } \arguments{ \item{pathname}{A \code{\link[base]{character}} \code{\link[base]{vector}}.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{logical}} \code{\link[base]{vector}} of either \code{\link[base:logical]{TRUE}} or \code{\link[base:logical]{FALSE}}. } \author{Henrik Bengtsson} \keyword{IO} \keyword{programming} ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/isReplicated.Rd�������������������������������������������������������������������������0000644�0001762�0000144�00000004751�14525573061�015303� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % isReplicated.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{isReplicated} \alias{isReplicated} \alias{replicates} \title{Identifies all entries with replicated values} \description{ Identifies all entries with replicated values, that is, with values that exist more than once. } \usage{ isReplicated(x, ...) replicates(x, ...) } \arguments{ \item{x}{A \code{\link[base]{vector}} of length K.} \item{...}{Additional arguments passed to \code{\link[base]{duplicated}}().} } \value{ A \code{\link[base]{logical}} \code{\link[base]{vector}} of length K, where \code{\link[base:logical]{TRUE}} indicates that the value exists elsewhere, otherwise not. } \details{ Let \code{reps <- isReplicated(x)}. Then it always holds that: \itemize{ \item \code{reps == rev(isReplicated(rev(x)))} \item \code{reps == duplicated(x) | duplicated(x, fromLast=TRUE)} \item \code{reps == !is.element(x, setdiff(x, unique(x[duplicated(x)])))} } } \examples{ x <- c(1,1,2,3,4,2,1) x <- base::letters[x] print(x) # Identify entries with replicated values reps <- isReplicated(x) print(x[reps]) stopifnot(x[reps] == replicates(x)) # Identify entries with unique values print(x[!reps]) stopifnot(x[!reps] == singles(x)) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validation # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x <- c(1,1,2,3,4,2,1) x <- base::letters[x] reps <- isReplicated(x) stopifnot(all(table(x[reps]) > 1)) stopifnot(all(table(x[!reps]) == 1)) stopifnot(all(reps == rev(isReplicated(rev(x))))) stopifnot(all(reps == duplicated(x) | duplicated(x, fromLast=TRUE))) stopifnot(all(reps == !is.element(x, setdiff(x, unique(x[duplicated(x)]))))) stopifnot(all(sort(c(singles(x), replicates(x))) == sort(x))) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Benchmarking singles() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - set.seed(0xBEEF) n <- 1e6 x <- sample(1:(n/2), size=n, replace=TRUE) t <- system.time({ s <- isSingle(x) }) print(sum(s)) t0 <- system.time({ s0 <- !(x \%in\% x[duplicated(x)]); }) print(t/t0) stopifnot(all(s == s0)) } \author{Henrik Bengtsson} \seealso{ Internally \code{\link[base]{duplicated}}() is used. See also \code{\link{isSingle}}(). } �����������������������R.utils/man/seqToIntervals.Rd�����������������������������������������������������������������������0000644�0001762�0000144�00000002226�14525573061�015651� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % seqToIntervals.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{seqToIntervals} \alias{seqToIntervals.default} \alias{seqToIntervals} \title{Gets all contiguous intervals of a vector of indices} \description{ Gets all contiguous intervals of a vector of indices. } \usage{ \method{seqToIntervals}{default}(idx, ...) } \arguments{ \item{idx}{A \code{\link[base]{vector}} of N \code{\link[base]{integer}} indices.} \item{...}{Not used.} } \value{ An Nx2 \code{\link[base]{integer}} \code{\link[base]{matrix}}. } \author{Henrik Bengtsson} \examples{ x <- 1:10 y <- seqToIntervals(x) print(y) # [1 10] x <- c(1:10, 15:18, 20) y <- seqToIntervals(x) print(y) # [1 10; 15 18; 20 20] z <- intervalsToSeq(y) print(z) stopifnot(all.equal(x,z)) } \seealso{ \code{\link[R.utils:intervalsToSeq.matrix]{*intervalsToSeq}()}. To identify sequences of \emph{equal} values, see \code{\link[base]{rle}}(). } \keyword{attribute} ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/TimeoutException.Rd���������������������������������������������������������������������0000644�0001762�0000144�00000004705�14525573057�016204� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % TimeoutException.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{TimeoutException} \docType{class} \alias{TimeoutException} \title{TimeoutException represents timeout errors} \description{ Package: R.utils \cr \bold{Class TimeoutException}\cr \code{\link[R.oo]{Object}}\cr \code{~~|}\cr \code{~~+--}\code{try-error}\cr \code{~~~~~~~|}\cr \code{~~~~~~~+--}\code{condition}\cr \code{~~~~~~~~~~~~|}\cr \code{~~~~~~~~~~~~+--}\code{error}\cr \code{~~~~~~~~~~~~~~~~~|}\cr \code{~~~~~~~~~~~~~~~~~+--}\code{simpleError}\cr \code{~~~~~~~~~~~~~~~~~~~~~~|}\cr \code{~~~~~~~~~~~~~~~~~~~~~~+--}\code{\link[R.oo]{Exception}}\cr \code{~~~~~~~~~~~~~~~~~~~~~~~~~~~|}\cr \code{~~~~~~~~~~~~~~~~~~~~~~~~~~~+--}\code{TimeoutException}\cr \bold{Directly known subclasses:}\cr \cr public static class \bold{TimeoutException}\cr extends \link[R.oo]{Exception}\cr TimeoutException represents timeout errors occurring when a set of R expressions executed did not finish in time. } \usage{ TimeoutException(..., cpu=NA, elapsed=NA) } \arguments{ \item{...}{Any arguments accepted by \code{\link{Exception}}}. \item{cpu, elapsed}{The maximum time the R expressions were allowed to be running before the timeout occurred as measured in CPU time and (physically) elapsed time.} } \section{Fields and Methods}{ \bold{Methods:}\cr \tabular{rll}{ \tab \code{getMessage} \tab -\cr } \bold{Methods inherited from Exception}:\cr as.character, getCall, getCalls, getLastException, getMessage, getStackTrace, getWhen, print, printStackTrace, throw \bold{Methods inherited from error}:\cr as.character, throw \bold{Methods inherited from condition}:\cr abort, as.character, conditionCall, conditionMessage, print \bold{Methods inherited from Object}:\cr $, $<-, [[, [[<-, as.character, attach, attachLocally, clearCache, clearLookupCache, clone, detach, equals, extend, finalize, getEnvironment, getFieldModifier, getFieldModifiers, getFields, getInstantiationTime, getStaticInstance, hasField, hashCode, ll, load, names, objectSize, print, save } \author{Henrik Bengtsson} \seealso{ For detailed information about exceptions see \code{\link{Exception}}. } \keyword{programming} \keyword{methods} \keyword{error} \keyword{classes} �����������������������������������������������������������R.utils/man/getBuiltinOs.GString.Rd�����������������������������������������������������������������0000644�0001762�0000144�00000001650�14525573055�016655� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % GString-class.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{GString$getBuiltinOs} \alias{GString$getBuiltinOs} \alias{getBuiltinOs.GString} \alias{GString.getBuiltinOs} \alias{getBuiltinOs,GString-method} \title{Gets the operating system of the running machine} \description{ Gets the operating system of the running machine. } \usage{ ## Static method (use this): ## GString$getBuiltinOs(...) ## Don't use the below: \method{getBuiltinOs}{GString}(static, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}} string. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{GString}}. } \keyword{internal} \keyword{methods} ����������������������������������������������������������������������������������������R.utils/man/addFinalizerToLast.Rd�������������������������������������������������������������������0000644�0001762�0000144�00000002216�14525573060�016407� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % addFinalizerToLast.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{addFinalizerToLast} \alias{addFinalizerToLast.default} \alias{addFinalizerToLast} \title{Modifies .Last() to call 'finalizeSession()} \description{ Modifies .Last() to call 'finalizeSession() \emph{before} calling the default \code{.Last()} function. Note that \code{.Last()} is \emph{not} guaranteed to be called when the \R session finished. For instance, the user may quit \R by calling \code{quit(runLast=FALSE)} or run R in batch mode. Note that this function is called when the R.utils package is loaded. } \usage{ \method{addFinalizerToLast}{default}(...) } \arguments{ \item{...}{Not used.} } \value{ Returns (invisibly) \code{\link[base:logical]{TRUE}} if \code{.Last()} was modified, otherwise \code{\link[base:logical]{FALSE}}. } \author{Henrik Bengtsson} \seealso{ \code{\link{onSessionExit}}(). } \keyword{programming} ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/dimNALT_-.Rd����������������������������������������������������������������������������0000644�0001762�0000144�00000002610�14525573060�014326� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % dimNA.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{dimNA< -} \alias{dimNA< -.default} \alias{dimNA< -} \alias{dimNA<-} \alias{dimNA<-.default} \title{Sets the dimension of an object with the option to infer one dimension automatically} \description{ Sets the dimension of an object with the option to infer one dimension automatically. If one of the elements in the dimension \code{\link[base]{vector}} is \code{\link[base]{NA}}, then its value is inferred from the length of the object and the other elements in the dimension vector. If the inferred dimension is not an \code{\link[base]{integer}}, an error is thrown. } \usage{ \method{dimNA}{default}(x) <- value } \arguments{ \item{x}{An R object.} \item{value}{\code{\link[base]{NULL}} of a positive \code{\link[base]{numeric}} \code{\link[base]{vector}} with one optional \code{\link[base]{NA}}.} } \value{ Returns (invisibly) what \code{dim<-()} returns (see \code{\link[base]{dim}}() for more details). } \examples{ x <- 1:12 dimNA(x) <- c(2,NA,3) stopifnot(dim(x) == as.integer(c(2,2,3))) } \author{Henrik Bengtsson} \seealso{ \code{\link[base]{dim}}(). } \keyword{file} \keyword{IO} ������������������������������������������������������������������������������������������������������������������������R.utils/man/patchCode.Rd����������������������������������������������������������������������������0000644�0001762�0000144�00000005674�14525573061�014572� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % patchCode.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{patchCode} \alias{patchCode.default} \alias{patchCode} \title{Patches installed and loaded packages and more} \usage{ \method{patchCode}{default}(paths=NULL, recursive=TRUE, suppressWarnings=TRUE, knownExtensions=c("R", "r", "S", "s"), verbose=FALSE, ...) } \description{ Patches installed and loaded packages and more. } \arguments{ \item{paths}{The path to the directory (and subdirectories) which contains source code that will patch loaded packages. If \code{\link[base]{NULL}}, the patch path is given by the option \code{R_PATCHES}, If the latter is not set, the system environment with the same name is used. If neither is given, then \code{~/R-patches/} is used.} \item{recursive}{If \code{\link[base:logical]{TRUE}}, source code in subdirectories will also get loaded. } \item{suppressWarnings}{If \code{\link[base:logical]{TRUE}}, \code{\link[base]{warning}}s will be suppressed, otherwise not.} \item{knownExtensions}{A \code{\link[base]{character}} \code{\link[base]{vector}} of filename extensions used to identify source code files. All other files are ignored.} \item{verbose}{If \code{\link[base:logical]{TRUE}}, extra information is printed while patching, otherwise not.} \item{...}{Not used.} } \value{ Returns (invisibly) the number of files sourced. } \details{ The method will look for source code files (recursively or not) that match known filename extensions. Each found source code file is then \code{\link[base]{source}}()d. If the search is recursive, subdirectories are entered if and only if either (1) the name of the subdirectory is the same as a \emph{loaded} (and installed) package, or (2) if there is no installed package with that name. The latter allows common code to be organized in directories although it is still not assigned to packages. Each of the directories given by argument \code{paths} will be processed one by one. This makes it possible to have more than one file tree containing patches. To set an options, see \code{\link[base]{options}}(). To set a system environment, see \code{\link[base]{Sys.setenv}}(). The character \code{;} is interpreted as a separator. Due to incompatibility with Windows pathnames, \code{:} is \emph{not} a valid separator. } \examples{\dontrun{ # Patch all source code files in the current directory patchCode(".") # Patch all source code files in R_PATCHES options("R_PATCHES"="~/R-patches/") # alternatively, Sys.setenv("R_PATCHES"="~/R-patches/") patchCode() }} \author{Henrik Bengtsson} \seealso{ \code{\link[base]{source}}(). \code{\link[base]{library}}(). } \keyword{utilities} \keyword{programming} ��������������������������������������������������������������������R.utils/man/shell.exec2.Rd��������������������������������������������������������������������������0000644�0001762�0000144�00000003670�14525573061�015006� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % shell.exec2.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{shell.exec2} \alias{shell.exec2} \title{Open a file or URL using Windows File Associations} \usage{ shell.exec2(file) } \description{ Open a file or URL using Windows File Associations using \code{shell.exec()} but makes some tweaks to filenames to make them more likely to be opened properly. \emph{This function is only applicable on Windows systems.} } \arguments{ \item{file}{A \code{\link[base]{character}} string specifying a file or an URL.} } \value{ Returns nothing. } \details{ Before passing a \emph{file} on the file system to \code{shell.exec()}, this function: (i) unmaps any mapped drive letters used in the pathname (e.g. 'X:/foo.bar.html' to 'C:/Users/Joe/bar.html'), (ii) and replaces any forward slashed with backward ones (e.g. 'C:/Users/Joe/bar.html' to 'C:\\Users\\Joe\\bar.html'). URLs are passed as is to \code{shell.exec()}. The reason for (i) is that some web browsers (e.g. Google Chrome) will not open files on mapped drives. The reason for (ii) is that if forward slashes are used, then \code{shell.exec()} will give an error that the file was not found (at least with the default Windows shell). } \section{Setting on startup}{ The intended usage of this function is to set it as the default browser for \code{\link[utils]{browseURL}}. Just add the following to your \code{\link{.Rprofile}} file: \preformatted{ if (.Platform$OS.type == "windows") options(browser=function(...) R.utils::shell.exec2(...)) } This will only load (not attach) the \pkg{R.utils} package when the browser function is actual used. } \author{Henrik Bengtsson} \keyword{file} \keyword{IO} ������������������������������������������������������������������������R.utils/man/Settings.Rd�����������������������������������������������������������������������������0000644�0001762�0000144�00000010164�14525573056�014472� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Settings.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Settings} \docType{class} \alias{Settings} \title{Class for applicational settings} \description{ Package: R.utils \cr \bold{Class Settings}\cr \code{\link[R.oo]{Object}}\cr \code{~~|}\cr \code{~~+--}\code{\link[R.utils]{Options}}\cr \code{~~~~~~~|}\cr \code{~~~~~~~+--}\code{Settings}\cr \bold{Directly known subclasses:}\cr \cr public static class \bold{Settings}\cr extends \link[R.utils]{Options}\cr Class for applicational settings. } \usage{ Settings(basename=NULL, ...) } \arguments{ \item{basename}{A \code{\link[base]{character}} string of the basename of the settings file.} \item{...}{Arguments passed to constructor of superclass \link{Options}.} } \section{Fields and Methods}{ \bold{Methods:}\cr \tabular{rll}{ \tab \code{findSettings} \tab -\cr \tab \code{getLoadedPathname} \tab -\cr \tab \code{isModified} \tab -\cr \tab \code{loadAnywhere} \tab -\cr \tab \code{promptAndSave} \tab -\cr \tab \code{saveAnywhere} \tab -\cr } \bold{Methods inherited from Options}:\cr as.character, as.list, equals, getLeaves, getOption, hasOption, names, nbrOfOptions, setOption, str \bold{Methods inherited from Object}:\cr $, $<-, [[, [[<-, as.character, attach, attachLocally, clearCache, clearLookupCache, clone, detach, equals, extend, finalize, getEnvironment, getFieldModifier, getFieldModifiers, getFields, getInstantiationTime, getStaticInstance, hasField, hashCode, ll, load, names, objectSize, print, save } \section{Load settings with package and save on exit}{ Here is a generic \code{.First.lib()} function for loading settings with package. It also (almost) assures that the package is detached when R finishes. See \code{\link{onSessionExit}}() why it is not guaranteed! The almost generic \code{.Last.lib()} function, which will prompt user to save settings, is called when a package is detached. It is custom to put these functions in a file named \code{zzz.R}. \bold{.First.lib():} \preformatted{ .First.lib <- function(libname, pkgname) { # Write a welcome message when package is loaded pkg <- Package(pkgname) assign(pkgname, pkg, pos=getPosition(pkg)) # Read settings file ".<pkgname>Settings" and store it in package # variable '<pkgname>Settings'. varname <- paste(pkgname, "Settings") basename <- paste(".", varname, sep="") settings <- Settings$loadAnywhere(basename, verbose=TRUE) if (is.null(settings)) settings <- Settings(basename) assign(varname, settings, pos=getPosition(pkg)) # Detach package when R finishes, which will save package settings too. onSessionExit(function(...) detachPackage(pkgname)) packageStartupMessage(getName(pkg), " v", getVersion(pkg), " (", getDate(pkg), ") successfully loaded. See ?", pkgname, " for help.\n", sep="") } # .First.lib() } \bold{.Last.lib():} \preformatted{ .Last.lib <- function(libpath) { pkgname <- "<package name>" # Prompt and save package settings when package is detached. varname <- paste(pkgname, "Settings", sep="") if (exists(varname)) { settings <- get(varname) if (inherits(settings, "Settings")) promptAndSave(settings) } } # .Last.lib() } } \examples{ # Load settings from file, or create default settings basename <- "some.settings" settings <- Settings$loadAnywhere(basename) if (is.null(settings)) settings <- Settings(basename) # Set default options, if missing. setOption(settings, "graphics/verbose", TRUE, overwrite=FALSE) setOption(settings, "io/verbose", Verbose(threshold=-1), overwrite=FALSE) # Save and reload settings path <- tempdir() saveAnywhere(settings, path=path) settings2 <- Settings$loadAnywhere(basename, paths=path) # Clean up file.remove(getLoadedPathname(settings2)) # Assert correctness stopifnot(equals(settings, settings2)) } \author{Henrik Bengtsson} \keyword{classes} \keyword{programming} \keyword{IO} ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/ruler.Verbose.Rd������������������������������������������������������������������������0000644�0001762�0000144�00000002057�14525573060�015424� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{ruler.Verbose} \alias{ruler.Verbose} \alias{Verbose.ruler} \alias{ruler,Verbose-method} \title{Writes a ruler} \description{ Writes a ruler. } \usage{ \method{ruler}{Verbose}(this, char="-", toColumn=this$rightMargin, length=toColumn - this$indentPos, level=this$defaultLevel, ...) } \arguments{ \item{char}{A \code{\link[base]{character}} string to make up the ruler.} \item{toColumn}{The column number where the ruler should finish.} \item{length}{The length of the ruler.} \item{...}{Not used.} \item{level}{A \code{\link[base]{numeric}} value to be compared to the threshold.} } \value{ Returns nothing. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/Non-documented_objects.Rd���������������������������������������������������������������0000644�0001762�0000144�00000011177�14525573054�017265� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % 999.NonDocumentedObjects.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Non-documented objects} \alias{Non-documented objects} \title{Non-documented objects} % The Arguments class \alias{getCharacter} \alias{getCharacters} \alias{getDirectory} \alias{getDouble} \alias{getDoubles} \alias{getIndex} \alias{getIndices} \alias{getInteger} \alias{getIntegers} \alias{getLogical} \alias{getLogicals} \alias{getNumeric} \alias{getNumerics} \alias{getVector} \alias{getVerbose} \alias{getFilename} \alias{getReadablePathname} \alias{getReadablePathnames} \alias{getWritablePathname} \alias{getReadablePath} \alias{getRegularExpression} \alias{getWritablePath} % Devel methods \alias{getInstanceOf} \alias{getDirectory.Arguments} \alias{getReadablePath.Arguments} \alias{getWritablePath.Arguments} % The Assert class \alias{isMatrix} \alias{isScalar} \alias{isVector} % The CmdArgsFunction class \alias{CmdArgsFunction} \alias{print.CmdArgsFunction} % The connection class \alias{isEof} % The GenericSummary class \alias{GenericSummary} \alias{[.GenericSummary} \alias{c.GenericSummary} \alias{print.GenericSummary} % The GString class \alias{getBuiltinDate} \alias{getBuiltinDatetime} \alias{getBuiltinHostname} \alias{getBuiltinOs} \alias{getBuiltinPid} \alias{getBuiltinRhome} \alias{getBuiltinRversion} \alias{getBuiltinTime} \alias{getBuiltinUsername} \alias{getRaw} \alias{getVariableValue} \alias{parse} \alias{parse.default} % The Java class \alias{asByte} \alias{asInt} \alias{asLong} \alias{asShort} \alias{readByte} \alias{readInt} \alias{readShort} \alias{readUTF} \alias{writeByte} \alias{writeInt} \alias{writeShort} \alias{writeUTF} % The Options class \alias{hasOption} \alias{getOption} \alias{getOption.default} \alias{getLeaves} \alias{nbrOfOptions} % The ProgressBar and FileProgressBar classes \alias{cleanup} \alias{getBarString} \alias{increase} \alias{isDone} \alias{reset} \alias{setMaxValue} \alias{setProgress} \alias{setStepLength} \alias{setTicks} \alias{setValue} % The Settings class \alias{findSettings} \alias{getLoadedPathname} \alias{isModified} \alias{loadAnywhere} \alias{saveAnywhere} \alias{promptAndSave} % The System class \alias{currentTimeMillis} \alias{findGhostscript} \alias{findGraphicsDevice} \alias{getHostname} \alias{getUsername} \alias{openBrowser} \alias{parseDebian} \alias{getMappedDrivesOnWindows} \alias{getMappedDrivesOnWindows.System} \alias{mapDriveOnWindows} \alias{mapDriveOnWindows.System} \alias{unmapDriveOnWindows} \alias{unmapDriveOnWindows.System} % The System class \alias{getLabel} \alias{setLabel} % The TextStatusBar class \alias{popMessage} \alias{setLabels} \alias{updateLabels} % The Verbose class \alias{capture} \alias{cat} \alias{cat.default} \alias{evaluate} \alias{enter} \alias{enterf} \alias{exit} \alias{popState} \alias{pushState} \alias{getThreshold} \alias{getVariable} \alias{header} \alias{isOn} \alias{isVisible} \alias{less} \alias{more} \alias{newline} \alias{on} \alias{off} \alias{ruler} \alias{setDefaultLevel} \alias{setThreshold} \alias{warnings} \alias{warnings.default} \alias{writeRaw} \alias{timestamp} \alias{getTimestampFormat} \alias{setTimestampFormat} \alias{timestamp.default} \alias{timestampOff} \alias{timestampOn} % The SmartComments class \alias{convertComment} \alias{reset} \alias{validate} % The VComments class % <none> % Intervals \alias{inAnyInterval} \alias{mapToIntervals} \alias{mergeIntervals} \alias{intervalsToSeq} % Misc. \alias{extract} \alias{isOpen} \alias{isOpen.default} \alias{remove.default} \alias{unwrap} \alias{verbose} \alias{withoutGString} \alias{wrap} \alias{whichVector} \alias{draw} \alias{swapXY} % Private \alias{toFileListTree} \alias{toFileListTree.character} \alias{pasteTree} \alias{pasteTree.FileListTree} \alias{cat.FileListTree} \alias{toAsciiRegExprPattern} \alias{toAsciiRegExprPattern.character} \alias{getCommonPrefix} \alias{mergeByCommonTails} \alias{splitByCommonTails} \alias{print.CapturedEvaluation} \description{ This page contains aliases for all "non-documented" objects that \code{R CMD check} detects in this package. Almost all of them are \emph{generic} functions that have specific document for the corresponding method coupled to a specific class. Other functions are re-defined by \code{setMethodS3()} to \emph{default} methods. Neither of these two classes are non-documented in reality. The rest are deprecated methods. } \author{Henrik Bengtsson} \keyword{documentation} \keyword{internal} �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/getBarString.ProgressBar.Rd�������������������������������������������������������������0000644�0001762�0000144�00000001504�14525573056�017513� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % ProgressBar.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{getBarString.ProgressBar} \alias{getBarString.ProgressBar} \alias{ProgressBar.getBarString} \alias{getBarString,ProgressBar-method} \title{Gets the progress bar string to be displayed} \description{ Gets the progress bar string to be displayed. } \usage{ \method{getBarString}{ProgressBar}(this, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}} string. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{ProgressBar}}. } \keyword{internal} \keyword{methods} ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/Verbose.Rd������������������������������������������������������������������������������0000644�0001762�0000144�00000016554�14525573060�014303� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Verbose} \docType{class} \alias{Verbose} \title{Class to writing verbose messages to a connection or file} \description{ Package: R.utils \cr \bold{Class Verbose}\cr \code{\link[R.oo]{Object}}\cr \code{~~|}\cr \code{~~+--}\code{Verbose}\cr \bold{Directly known subclasses:}\cr \link[R.utils]{MultiVerbose}, \link[R.utils]{NullVerbose}\cr public static class \bold{Verbose}\cr extends \link[R.oo]{Object}\cr Class to writing verbose messages to a connection or file. } \usage{ Verbose(con=stderr(), on=TRUE, threshold=0, asGString=TRUE, timestamp=FALSE, removeFile=TRUE, core=TRUE, ...) } \arguments{ \item{con}{A \code{\link[base:connections]{connection}} or a \code{\link[base]{character}} string filename.} \item{on}{A \code{\link[base]{logical}} indicating if the writer is on or off.} \item{threshold}{A \code{\link[base]{numeric}} threshold that the \code{level} argument of any write method has to be equal to or larger than in order to the message being written. Thus, the lower the threshold is the more and more details will be outputted.} \item{timestamp}{If \code{\link[base:logical]{TRUE}}, each output is preceded with a timestamp.} \item{removeFile}{If \code{\link[base:logical]{TRUE}} and \code{con} is a filename, the file is first deleted, if it exists.} \item{asGString}{If \code{\link[base:logical]{TRUE}}, all messages are interpreted as \code{\link{GString}} before being output, otherwise not.} \item{core}{Internal use only.} \item{...}{Not used.} } \section{Fields and Methods}{ \bold{Methods:}\cr \tabular{rll}{ \tab \code{as.character} \tab -\cr \tab \code{as.double} \tab -\cr \tab \code{as.logical} \tab -\cr \tab \code{capture} \tab -\cr \tab \code{cat} \tab -\cr \tab \code{enter} \tab -\cr \tab \code{enterf} \tab -\cr \tab \code{equals} \tab -\cr \tab \code{evaluate} \tab -\cr \tab \code{exit} \tab -\cr \tab \code{getThreshold} \tab -\cr \tab \code{getTimestampFormat} \tab -\cr \tab \code{header} \tab -\cr \tab \code{isOn} \tab -\cr \tab \code{isVisible} \tab -\cr \tab \code{less} \tab -\cr \tab \code{more} \tab -\cr \tab \code{newline} \tab -\cr \tab \code{off} \tab -\cr \tab \code{on} \tab -\cr \tab \code{popState} \tab -\cr \tab \code{print} \tab -\cr \tab \code{printWarnings} \tab -\cr \tab \code{printf} \tab -\cr \tab \code{pushState} \tab -\cr \tab \code{ruler} \tab -\cr \tab \code{setDefaultLevel} \tab -\cr \tab \code{setThreshold} \tab -\cr \tab \code{setTimestampFormat} \tab -\cr \tab \code{str} \tab -\cr \tab \code{summary} \tab -\cr \tab \code{timestamp} \tab -\cr \tab \code{timestampOff} \tab -\cr \tab \code{timestampOn} \tab -\cr \tab \code{writeRaw} \tab -\cr } \bold{Methods inherited from Object}:\cr $, $<-, [[, [[<-, as.character, attach, attachLocally, clearCache, clearLookupCache, clone, detach, equals, extend, finalize, getEnvironment, getFieldModifier, getFieldModifiers, getFields, getInstantiationTime, getStaticInstance, hasField, hashCode, ll, load, names, objectSize, print, save } \section{Output levels}{ As a guideline, use the following levels when outputting verbose/debug message using the Verbose class. For a message to be shown, the output level must be greater than (not equal to) current threshold. Thus, the lower the threshold is set, the more messages will be seen. \describe{ \item{<= -100}{Only for debug messages, i.e. messages containing all necessary information for debugging purposes and to find bugs in the code. Normally these messages are so detailed so they will be a pain for the regular user, but very useful for bug reporting and bug tracking by the developer.} \item{-99 -- -11}{Detailed verbose messages. These will typically be useful for the user to understand what is going on and do some simple debugging fixing problems typically due to themselves and not due to bugs in the code.} \item{-10 -- -1}{Verbose messages. For example, these will typically report the name of the file to be read, the current step in a sequence of analysis steps and so on. These message are not very useful for debugging.} \item{0}{Default level in all output methods and default threshold. Thus, by default, messages at level 0 are not shown.} \item{>= +1}{Message that are always outputted (if threshold is kept at 0). We recommend not to output message at this level, because methods should be quiet by default (at the default threshold 0).} } } \section{A compatibility trick and a speed-up trick}{ If you want to include calls to Verbose in a package of yours in order to debug code, but not use it otherwise, you might not want to load R.utils all the time, but only for debugging. To achieve this, the value of a reference variable to a Verbose class is always set to \code{\link[base:logical]{TRUE}}, cf. typically an Object reference has value \code{\link[base]{NA}}. This makes it possible to use the reference variable as a first test before calling Verbose methods. Example: \preformatted{ foo <- function(..., verbose=FALSE) { # enter() will never be called if verbose==FALSE, thus no error. verbose && enter(verbose, "Loading") } } Thus, R.utils is not required for \code{foo()}, but for \code{foo(verbose==Verbose(level=-1))} it is. Moreover, if using the \code{\link{NullVerbose}} class for ignoring all verbose messages, the above trick will indeed speed up the code, because the value of a NullVerbose reference variable is always \code{\link[base:logical]{FALSE}}. } \section{Extending the Verbose class}{ If extending this class, make sure to output messages via \code{\link[R.utils:writeRaw.Verbose]{*writeRaw}()} or one of the other output methods (which in turn all call the former). This guarantees that \code{\link[R.utils:writeRaw.Verbose]{*writeRaw}()} has full control of the output, e.g. this makes it possible to split output to standard output and to file. } \examples{ verbose <- Verbose(threshold=-1) header(verbose, "A verbose writer example", padding=0) enter(verbose, "Analysis A") for (kk in 1:10) { printf(verbose, "step \%d\n", kk) if (kk == 2) { cat(verbose, "Turning ON automatic timestamps") timestampOn(verbose) } else if (kk == 4) { timestampOff(verbose) cat(verbose, "Turned OFF automatic timestamps") cat(verbose, "Turning OFF verbose messages for steps ", kk, "-6") off(verbose) } else if (kk == 6) { on(verbose) cat(verbose, "Turned ON verbose messages just before step ", kk+1) } if (kk \%in\% c(5,8)) { enterf(verbose, "Sub analysis #\%d", kk) for (jj in c("i", "ii", "iii")) { cat(verbose, "part ", jj) } exit(verbose) } } cat(verbose, "All steps completed!") exit(verbose) ruler(verbose) cat(verbose, "Demo of some other methods:") str(verbose, c(a=1, b=2, c=3)) print(verbose, c(a=1, b=2, c=3)) summary(verbose, c(a=1, b=2, c=3)) evaluate(verbose, rnorm, n=3, mean=2, sd=3) ruler(verbose) newline(verbose) } \author{Henrik Bengtsson} \seealso{ \code{\link{NullVerbose}}. } \keyword{classes} \keyword{programming} \keyword{IO} ����������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/isOn.Verbose.Rd�������������������������������������������������������������������������0000644�0001762�0000144�00000001604�14525573060�015200� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{isOn.Verbose} \alias{isOn.Verbose} \alias{Verbose.isOn} \alias{isOn,Verbose-method} \title{Checks if the output is on} \description{ Checks if the output is on. } \usage{ \method{isOn}{Verbose}(this, ...) } \arguments{ \item{...}{Not used.} } \value{ Returns \code{\link[base:logical]{TRUE}} if output is on, otherwise \code{\link[base:logical]{FALSE}}. } \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:on.Verbose]{*on}()} and \code{\link[R.utils:off.Verbose]{*off}()}. For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} ����������������������������������������������������������������������������������������������������������������������������R.utils/man/inheritsFrom.Assert.Rd������������������������������������������������������������������0000644�0001762�0000144�00000002157�14525573055�016605� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Assert.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Assert$inheritsFrom} \alias{Assert$inheritsFrom} \alias{inheritsFrom.Assert} \alias{Assert.inheritsFrom} \alias{inheritsFrom,Assert-method} \alias{inheritsFrom} \title{Static method asserting that an object inherits from of a certain class} \description{ Static method asserting that an object inherits from of a certain class. } \usage{ ## Static method (use this): ## Assert$inheritsFrom(object, class, ...) ## Don't use the below: \method{inheritsFrom}{Assert}(static, object, class, ...) } \arguments{ \item{object}{Object to be checked.} \item{class}{Name of class.} \item{...}{Not used.} } \value{ Returns (invisibly) \code{\link[base:logical]{TRUE}}, or throws an exception. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Assert}}. } \keyword{internal} \keyword{methods} �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/writeInt.Java.Rd������������������������������������������������������������������������0000644�0001762�0000144�00000002226�14525573055�015356� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Java.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Java$writeInt} \alias{Java$writeInt} \alias{writeInt.Java} \alias{Java.writeInt} \alias{writeInt,Java-method} \title{Writes a integer (32 bits) to a connection in Java format} \description{ Writes one or several integer's (32 bits) to a connection in Java format so they will be readable by Java. All data types in Java are signed, i.e. a byte can hold a value in the range [-2147483648,2147483647]. Trying to write a value outside this range will automatically be truncated without a warning. } \usage{ ## Static method (use this): ## Java$writeInt(con, i, ...) ## Don't use the below: \method{writeInt}{Java}(static, con, i, ...) } \arguments{ \item{con}{Binary connection to be written to.} \item{i}{Vector of integers to be written.} } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Java}}. } \keyword{internal} \keyword{methods} ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/capitalize.Rd���������������������������������������������������������������������������0000644�0001762�0000144�00000003223�14525573060�015010� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % capitalize.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{capitalize} \alias{capitalize.default} \alias{capitalize} \alias{decapitalize} \alias{decapitalize.default} \title{Capitalizes/decapitalizes each character string in a vector} \description{ Capitalizes/decapitalized (making the first letter upper/lower case) of each character string in a vector. } \usage{ \method{capitalize}{default}(str, ...) \method{decapitalize}{default}(str, ...) } \arguments{ \item{str}{A \code{\link[base]{vector}} of \code{\link[base]{character}} strings to be capitalized.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{vector}} of \code{\link[base]{character}} strings of the same length as the input vector. } \author{Henrik Bengtsson} \examples{ words <- strsplit("Hello wOrld", " ")[[1]] cat(paste(toupper(words), collapse=" "), "\n") # "HELLO WORLD" cat(paste(tolower(words), collapse=" "), "\n") # "hello world" cat(paste(capitalize(words), collapse=" "), "\n") # "Hello WOrld" cat(paste(decapitalize(words), collapse=" "), "\n") # "hello wOrld" # Sanity checks stopifnot(paste(toupper(words), collapse=" ") == "HELLO WORLD") stopifnot(paste(tolower(words), collapse=" ") == "hello world") stopifnot(paste(capitalize(words), collapse=" ") == "Hello WOrld") stopifnot(paste(decapitalize(words), collapse=" ") == "hello wOrld") } \seealso{ \code{\link[R.utils]{toCamelCase}}. } \keyword{programming} �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/loadToEnv.Rd����������������������������������������������������������������������������0000644�0001762�0000144�00000001757�14525573061�014571� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % loadToEnv.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{loadToEnv} \alias{loadToEnv.default} \alias{loadToEnv} \title{Method to load objects to a new environment} \description{ Method to load objects to a new environment for objects previously stored by \code{\link[base]{save}}(). } \usage{ \method{loadToEnv}{default}(file, ..., envir=new.env()) } \arguments{ \item{...}{Arguments passed to \code{\link[base]{load}}().} \item{envir}{The \code{\link[base]{environment}} to load the objects to.} } \value{ Returns \code{\link[base]{environment}} \code{envir} containing all loaded objects. } \author{Henrik Bengtsson} \seealso{ Internally \code{\link[base]{load}}() is used. See also \code{\link{loadObject}}(). } \keyword{IO} \keyword{internal} �����������������R.utils/man/callHooks.function.Rd�������������������������������������������������������������������0000644�0001762�0000144�00000002226�14525573060�016430� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % callHooks.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{callHooks.function} \alias{callHooks.function} \alias{callHooks.list} \title{Call hook functions} \description{ Call hook functions. } \usage{ \method{callHooks}{function}(hooks, ...) } \arguments{ \item{hooks}{A \code{\link[base]{function}} or a \code{\link[base]{list}} of hook \code{\link[base]{function}}s or names of such.} \item{...}{Argument passed to each hook function.} } \value{ Returns (invisibly) a \code{\link[base]{list}} that is named with hook names, if possible. Each element in the list is in turn a \code{\link[base]{list}} with three element: \code{fcn} is the hook function called, \code{result} is its return value, and \code{exception} is the exception caught or \code{\link[base]{NULL}}. } \author{Henrik Bengtsson} \seealso{ See \code{\link{callHooks}}() to call hook function by name. } \keyword{methods} \keyword{programming} ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/attachLocally.list.Rd�������������������������������������������������������������������0000644�0001762�0000144�00000004057�14525573060�016427� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % attachLocally.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{attachLocally.list} \alias{attachLocally.list} \alias{attachLocally.data.frame} \alias{attachLocally.environment} \alias{attachLocally} \title{Assigns an objects elements locally} \usage{ \method{attachLocally}{list}(object, fields=NULL, excludeFields=NULL, overwrite=TRUE, envir=parent.frame(), ...) } \description{ Assigns an objects elements locally. } \arguments{ \item{object}{An object with named elements such as an \code{\link[base]{environment}}, a \code{\link[base]{list}}, or a \code{\link[base]{data.frame}}.} \item{fields}{A \code{\link[base]{character}} \code{\link[base]{vector}} specifying elements to be copied. If \code{\link[base]{NULL}}, all elements are considered.} \item{excludeFields}{A \code{\link[base]{character}} \code{\link[base]{vector}} specifying elements not to be copied. This has higher priority than \code{fields}.} \item{overwrite}{If \code{\link[base:logical]{FALSE}}, fields that already exists will not be copied.} \item{envir}{The \code{\link[base]{environment}} where elements are copied to.} \item{...}{Not used.} } \value{ Returns (invisibly) a \code{\link[base]{character}} \code{\link[base]{vector}} of the fields copied. } \examples{ foo <- function(object) { cat("Local objects in foo():\n") print(ls()) attachLocally(object) cat("\nLocal objects in foo():\n") print(ls()) for (name in ls()) { cat("\nObject '", name, "':\n", sep="") print(get(name, inherits=FALSE)) } } a <- "A string" l <- list(a=1:10, msg="Hello world", df=data.frame(a=NA, b=2)) foo(l) print(a) } \author{Henrik Bengtsson} \seealso{ \code{\link[R.oo:attachLocally.Object]{attachLocally}()} of class Object. \code{\link[base]{attach}}(). } \keyword{methods} \keyword{utilities} \keyword{programming} ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/validate.SmartComments.Rd���������������������������������������������������������������0000644�0001762�0000144�00000001712�14525573057�017256� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % SmartComments.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{validate.SmartComments} \alias{validate.SmartComments} \alias{SmartComments.validate} \alias{validate,SmartComments-method} \title{Validates the compiled lines} \description{ Validates the compiled lines } \usage{ \method{validate}{SmartComments}(this, lines, ...) } \arguments{ \item{lines}{A \code{\link[base]{character}} \code{\link[base]{vector}} of lines of code to validated.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{character}} \code{\link[base]{vector}}. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{SmartComments}}. } \keyword{internal} \keyword{methods} \keyword{programming} ������������������������������������������������������R.utils/man/getVerbose.Arguments.Rd�����������������������������������������������������������������0000644�0001762�0000144�00000003521�14525573054�016740� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Arguments.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Arguments$getVerbose} \alias{Arguments$getVerbose} \alias{getVerbose.Arguments} \alias{Arguments.getVerbose} \alias{getVerbose,Arguments-method} \title{Coerces to Verbose object} \description{ Coerces to Verbose object. } \usage{ ## Static method (use this): ## Arguments$getVerbose(verbose, defaultThreshold=-1, useNullVerbose=TRUE, ..., ## .name=NULL) ## Don't use the below: \method{getVerbose}{Arguments}(static, verbose, defaultThreshold=-1, useNullVerbose=TRUE, ..., .name=NULL) } \arguments{ \item{verbose}{A single object. If a \code{\link{Verbose}}, it is immediately returned. If a \code{\link[base]{numeric}} value, it is used as the threshold. Otherwise the object is coerced to a \code{\link[base]{logical}} value and if \code{\link[base:logical]{TRUE}}, the threshold is \code{defaultThreshold}.} \item{defaultThreshold}{A \code{\link[base]{numeric}} value for the default threshold, if \code{verbose} was interpreted as a \code{\link[base]{logical}} value.} \item{useNullVerbose}{If \code{verbose} can be interpreted as \code{\link[base:logical]{FALSE}}, return a \code{\link{NullVerbose}} object if \code{\link[base:logical]{TRUE}}.} \item{...}{Passed to the constructor of \code{\link{Verbose}}.} \item{.name}{A \code{\link[base]{character}} string for name used in error messages.} } \value{ Returns a \code{\link{Verbose}} (or a \code{\link{NullVerbose}}) object. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Arguments}}. } \keyword{internal} \keyword{methods} \keyword{IO} �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/str.Options.Rd��������������������������������������������������������������������������0000644�0001762�0000144�00000001553�14525573056�015136� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Options.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{str.Options} \alias{str.Options} \alias{Options.str} \alias{str,Options-method} \title{Prints the structure of the options} \description{ Prints the structure of the options. } \usage{ \method{str}{Options}(object, header=paste(class(this)[1], ":\n", sep = ""), ...) } \arguments{ \item{header}{A \code{\link[base]{character}} string header to be printed at the top.} \item{...}{Not used.} } \value{ Returns nothing. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Options}}. } \keyword{internal} \keyword{methods} \keyword{programming} �����������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/setProgress.ProgressBar.Rd��������������������������������������������������������������0000644�0001762�0000144�00000002160�14525573056�017437� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % ProgressBar.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{setProgress.ProgressBar} \alias{setProgress.ProgressBar} \alias{ProgressBar.setProgress} \alias{setProgress,ProgressBar-method} \title{Sets current progress} \description{ Sets current progress. } \usage{ \method{setProgress}{ProgressBar}(this, progress, visual=TRUE, ...) } \arguments{ \item{progress}{A \code{\link[base]{double}} in [0,1] specifying the relative progress.} \item{visual}{If \code{\link[base:logical]{TRUE}}, the progress bar is redraw, otherwise not.} \item{...}{Not used.} } \value{ Returns old value. } \author{Henrik Bengtsson} \seealso{ \code{\link[R.utils:setValue.ProgressBar]{*setValue}()}. \code{\link[R.utils:increase.ProgressBar]{*increase}()}. \code{\link[R.utils:reset.ProgressBar]{*reset}()}. For more information see \code{\link{ProgressBar}}. } \keyword{internal} \keyword{methods} ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/createWindowsShortcut.Rd����������������������������������������������������������������0000644�0001762�0000144�00000005260�14525573060�017240� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % createWindowsShortcut.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{createWindowsShortcut} \alias{createWindowsShortcut.default} \alias{createWindowsShortcut} \title{Creates a Microsoft Windows Shortcut (.lnk file)} \usage{ \method{createWindowsShortcut}{default}(pathname, target, overwrite=FALSE, mustWork=FALSE, ...) } \description{ Creates a Microsoft Windows Shortcut (.lnk file). } \arguments{ \item{pathname}{The pathname (with file extension *.lnk) of the link file to be created.} \item{target}{The target file or directory to which the shortcut should point to.} \item{overwrite}{If \code{\link[base:logical]{TRUE}}, an existing link file is overwritten, otherwise not.} \item{mustWork}{If \code{\link[base:logical]{TRUE}}, an error is produced if the Windows Shortcut link is not created, otherwise not.} \item{...}{Not used.} } \value{ Returns (invisibly) the pathname. } \section{Required privileges on Windows}{ In order for this method, which utilizes Windows Script Host a VBScript, to succeed on Windows, the client/R session must run with sufficient privileges (it has been reported that Administrative rights are necessary). } \examples{ # Create Windows Shortcut links to a directory and a file targets <- list( system.file(package="R.utils"), system.file("DESCRIPTION", package="R.utils") ) for (kk in seq_along(targets)) { cat("Link #", kk, "\n", sep="") target <- targets[[kk]] cat("Target: ", target, "\n", sep="") # Name of *.lnk file pathname <- sprintf("\%s.LNK", tempfile()) tryCatch({ # Will only work on Windows systems with support for VB scripting createWindowsShortcut(pathname, target=target) }, error = function(ex) { print(ex) }) # Was it created? if (isFile(pathname)) { cat("Created link file: ", pathname, "\n", sep="") # Validate that it points to the correct target dest <- filePath(pathname, expandLinks="any") cat("Available target: ", dest, "\n", sep="") res <- all.equal(tolower(dest), tolower(target)) if (!isTRUE(res)) { msg <- sprintf("Link target does not match expected target: \%s != \%s", dest, target) cat(msg, "\n") warning(msg) } # Cleanup file.remove(pathname) } } } \author{Henrik Bengtsson} \seealso{ \code{\link{readWindowsShortcut}}() } \references{ [1] Create a windows shortcut (.LNK file), SS64.com, \url{https://ss64.com/nt/shortcut.html} \cr } \keyword{file} \keyword{IO} ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/whichVector.logical.Rd������������������������������������������������������������������0000644�0001762�0000144�00000006505�14525573061�016570� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % whichVector.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{whichVector.logical} \alias{whichVector.logical} \alias{whichVector.matrix} \title{Identifies TRUE elements in a logical vector} \description{ Identifies TRUE elements in a logical vector. \emph{NOTE: \code{\link[base]{which}}() should be used instead of this method} unless you are running R (< 2.11.0), for which this method is faster than \code{\link[base]{which}}() for \code{\link[base]{logical}} \code{\link[base]{vector}}s, especially when there are no missing values. } \usage{ \method{whichVector}{logical}(x, na.rm=TRUE, use.names=TRUE, ...) } \arguments{ \item{x}{A \code{\link[base]{logical}} \code{\link[base]{vector}} of length N.} \item{na.rm}{If \code{\link[base:logical]{TRUE}}, missing values are treated as \code{\link[base:logical]{FALSE}}, otherwise they are returned as \code{\link[base]{NA}}.} \item{use.names}{If \code{\link[base:logical]{TRUE}}, the names attribute is preserved, otherwise it is not return.} \item{...}{Not used.} } \value{ Returns an \code{\link[base]{integer}} \code{\link[base]{vector}} of length less or equal to N. } \section{Benchmarking}{ In R v2.11.0 \code{\link[base]{which}}() was made approx. 10 times faster via a native implementation. Because of this, this method is of little use and approximately 3 times slower. However, for earlier version of R, this method is still significantly faster. For example, simple comparison on R v2.7.1 on Windows XP, show that this implementation can be more than twice as fast as \code{\link[base]{which}}(), especially when there are no missing value (and \code{na.rm=FALSE}) is used. } \examples{\dontrun{ # - - - - - - - - - - - - - - - - - - - - - - - - - - # Simulate two large named logical vectors, # one with missing values one without # - - - - - - - - - - - - - - - - - - - - - - - - - - N <- 1e6 # Vector #1 x <- sample(c(TRUE, FALSE), size=N, replace=TRUE) names(x) <- seq_along(x) # Vector #2 y <- x y[sample(N, size=0.1*N)] <- NA # - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate consistency # - - - - - - - - - - - - - - - - - - - - - - - - - - stopifnot(identical(which(x), whichVector(x))) stopifnot(identical(which(y), whichVector(y))) # - - - - - - - - - - - - - - - - - - - - - - - - - - # Benchmarking # - - - - - - - - - - - - - - - - - - - - - - - - - - # Number of iterations K <- 5 t1 <- 0 for (kk in 1:K) { t1 <- t1 + system.time({ idxs1 <- which(x) }) } t2 <- 0 for (kk in 1:K) { t2 <- t2 + system.time({ idxs2 <- whichVector(x, na.rm=FALSE) }) } cat(sprintf("whichVector(x, na.rm=FALSE)/which(x): \%.2f\n", (t2/t1)[3])) stopifnot(identical(idxs1, idxs2)) t1 <- 0 for (kk in 1:K) { t1 <- t1 + system.time({ idxs1 <- which(y) }) } t2 <- 0 for (kk in 1:K) { t2 <- t2 + system.time({ idxs2 <- whichVector(y) }) } cat(sprintf("whichVector(y)/which(y): \%.2f\n", (t2/t1)[3])) stopifnot(identical(idxs1, idxs2)) }} \author{Henrik Bengtsson} \seealso{ \code{\link[base]{which}}() } \keyword{methods} \keyword{programming} \keyword{internal} �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/man/enter.Verbose.Rd������������������������������������������������������������������������0000644�0001762�0000144�00000003302�14525573060�015402� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % Verbose.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{enter.Verbose} \alias{enter.Verbose} \alias{Verbose.enter} \alias{enter,Verbose-method} \alias{Verbose.enterf} \alias{enterf.Verbose} \alias{enterf,Verbose-method} \title{Writes a message and indents the following output} \description{ Writes a message and indents the following output. The output is indented according to \code{\link[R.utils:enter.Verbose]{*enter}()}/\code{\link[R.utils:exit.Verbose]{*exit}()} calls. } \usage{ \method{enter}{Verbose}(this, ..., indent=this$indentStep, sep="", suffix="...", level=this$defaultLevel) \method{enterf}{Verbose}(this, fmtstr, ..., indent=this$indentStep, sep="", suffix="...", level=this$defaultLevel) } \arguments{ \item{fmtstr}{An \code{\link[base]{sprintf}}() format string, which together with \code{...} constructs the message.} \item{...}{Objects to be passed to \code{\link[R.utils:cat.Verbose]{*cat}()} (or \code{\link[base]{sprintf}}()).} \item{indent}{The number of characters to add to the indentation.} \item{sep}{The default separator \code{\link[base]{character}} string.} \item{suffix}{A \code{\link[base]{character}} string to be appended to the end of the message.} \item{level}{A \code{\link[base]{numeric}} value to be compared to the threshold.} } \value{ Returns nothing. } \author{Henrik Bengtsson} \seealso{ For more information see \code{\link{Verbose}}. } \keyword{internal} \keyword{methods} \keyword{programming} ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/DESCRIPTION���������������������������������������������������������������������������������0000644�0001762�0000144�00000001464�14526006222�013324� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Package: R.utils Version: 2.12.3 Depends: R (>= 2.14.0), R.oo Imports: methods, utils, tools, R.methodsS3 Suggests: datasets, digest (>= 0.6.10) Title: Various Programming Utilities Authors@R: c(person("Henrik", "Bengtsson", role=c("aut", "cre", "cph"), email = "henrikb@braju.com")) Author: Henrik Bengtsson [aut, cre, cph] Maintainer: Henrik Bengtsson <henrikb@braju.com> Description: Utility functions useful when programming and developing R packages. License: LGPL (>= 2.1) LazyLoad: TRUE URL: https://henrikbengtsson.github.io/R.utils/, https://github.com/HenrikBengtsson/R.utils BugReports: https://github.com/HenrikBengtsson/R.utils/issues NeedsCompilation: no Packaged: 2023-11-17 05:13:25 UTC; henrik Repository: CRAN Date/Publication: 2023-11-18 01:00:02 UTC ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/��������������������������������������������������������������������������������������0000755�0001762�0000144�00000000000�14525546077�012773� 5����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/pushTemporaryFile.R�������������������������������������������������������������������0000644�0001762�0000144�00000002005�14372747611�016572� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") createAtomically <- function(pathname, ...) { cat("Pathname: ", pathname, "\n", sep="") # Generate a file atomically, i.e. the file will either be # complete or not created at all. If interrupted while # writing, only a temporary file will exist/remain. pathnameT <- pushTemporaryFile(pathname, verbose=TRUE) cat("Temporary pathname: ", pathnameT, "\n", sep="") cat(file=pathnameT, "This file was created atomically:\n") for (kk in 1:10) { cat(file=pathnameT, kk, "\n", append=TRUE) # Emulate a slow process if (interactive()) Sys.sleep(0.1) } cat(file=pathnameT, "END OF FILE\n", append=TRUE) # Rename the temporary file pathname <- popTemporaryFile(pathnameT, verbose=TRUE) pathname } # createAtomically() pathname <- tempfile() tryCatch({ # Try to interrupt the process while writing... pathname <- createAtomically(pathname) }, interrupt=function(intr) { str(intr) }) # ...and this will throw an exception bfr <- readLines(pathname) cat(bfr, sep="\n") ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/withTimeout.R�������������������������������������������������������������������������0000644�0001762�0000144�00000012273�14372747611�015442� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") oopts <- options(warn=1) # - - - - - - - - - - - - - - - - - - - - - - - - - # Function that takes "a long" time to run # - - - - - - - - - - - - - - - - - - - - - - - - - foo <- function() { print("Tic") for (kk in 1:20) { print(kk) Sys.sleep(0.1) } print("Tac") 42L } fib <- function(n) { if (n == 0 | n == 1) return(n) return (fib(n - 1) + fib(n - 2)) } # - - - - - - - - - - - - - - - - - - - - - - - - - # Evaluate code, if it takes too long, generate # a TimeoutException error. # - - - - - - - - - - - - - - - - - - - - - - - - - message("withTimeout() with error") res <- tryCatch({ res <- withTimeout({ foo() }, timeout=1.08) }, TimeoutException=function(ex) { cat("Timeout (", ex$message, "). Skipping.\n", sep="") TRUE }) stopifnot(isTRUE(res)) # - - - - - - - - - - - - - - - - - - - - - - - - - # Evaluate code, if it takes too much CPU time, # generate a TimeoutException error. # - - - - - - - - - - - - - - - - - - - - - - - - - message("withTimeout() with error") res <- tryCatch({ res <- withTimeout({ fib(30) }, cpu=0.1, elapsed=Inf) }, TimeoutException=function(ex) { cat("Timeout (", ex$message, "). Skipping.\n", sep="") TRUE }) stopifnot(isTRUE(res)) # - - - - - - - - - - - - - - - - - - - - - - - - - # Evaluate code, if it takes too long, generate # a timeout warning. # - - - - - - - - - - - - - - - - - - - - - - - - - message("withTimeout() with warning") res <- withTimeout({ foo() }, timeout=1.08, onTimeout="warning") stopifnot(is.null(res)) res <- tryCatch({ res <- withTimeout({ foo() }, timeout=1.08, onTimeout="warning") }, warning=function(ex) { cat("Timeout warning (", ex$message, "). Skipping.\n", sep="") TRUE }) stopifnot(isTRUE(res)) # - - - - - - - - - - - - - - - - - - - - - - - - - # Evaluate code, if it takes too much CPU time, # generate a timeout warning. # - - - - - - - - - - - - - - - - - - - - - - - - - message("withTimeout() with warning") res <- withTimeout({ fib(30) }, cpu=0.1, elapsed=Inf, onTimeout="warning") stopifnot(is.null(res)) res <- tryCatch({ res <- withTimeout({ fib(30) }, cpu=0.1, elapsed=Inf, onTimeout="warning") }, warning=function(ex) { cat("Timeout warning (", ex$message, "). Skipping.\n", sep="") TRUE }) stopifnot(isTRUE(res)) # - - - - - - - - - - - - - - - - - - - - - - - - - # Evaluate code, if it takes too long, generate # a timeout, and return silently NULL. # - - - - - - - - - - - - - - - - - - - - - - - - - message("withTimeout() with silent") res <- withTimeout({ foo() }, timeout=1.08, onTimeout="silent") stopifnot(is.null(res)) # - - - - - - - - - - - - - - - - - - - - - - - - - # Evaluate code, that does not timeout, then # evaluate code that takes long, but should not # timeout. # - - - - - - - - - - - - - - - - - - - - - - - - - message("withTimeout() without timeout") res <- withTimeout({ cat("Hello world!\n") TRUE }, timeout=1.08) stopifnot(isTRUE(res)) # - - - - - - - - - - - - - - - - - - - - - - - - - # Evaluate code, that does not timeout, but # throws an error. # - - - - - - - - - - - - - - - - - - - - - - - - - message("withTimeout() without timeout, but with error") res <- tryCatch({ res <- withTimeout({ stop("boom") }, timeout=1.08, onTimeout="warning") }, error=function(ex) { cat("Another error occured: ", ex$message, "\n", sep="") TRUE }) stopifnot(isTRUE(res)) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Evalute expression # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - message("withTimeout() without timeout") expr <- quote({ cat("Hello world!\n"); TRUE }) res <- withTimeout(expr, substitute = FALSE, timeout=1.08) stopifnot(isTRUE(res)) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Visibility # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - message("withTimeout() - visibility") res <- withVisible({ withTimeout({ 1 }, timeout=1) }) str(res) stopifnot(all.equal(res$value, 1)) stopifnot(res$visible) x <- 0 res <- withVisible({ withTimeout({ x <- 1 }, timeout=1) }) str(res) stopifnot(all.equal(res$value, 1)) stopifnot(!res$visible) stopifnot(all.equal(x, 1)) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Non-English settings # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - message("withTimeout() - other languages") local({ olang <- Sys.getenv("LANGUAGE") on.exit(Sys.setenv(LANGUAGE=olang)) Sys.setenv(LANGUAGE="fr") res <- tryCatch({ res <- withTimeout({ foo() }, timeout=1.08, onTimeout="warning") }, warning=function(ex) { cat("Timeout warning (", ex$message, "). Skipping.\n", sep="") TRUE }) stopifnot(isTRUE(res)) }) message("withTimeout() - switching language inside function (doesn't work)") res <- tryCatch({ res <- withTimeout({ olang <- Sys.getenv("LANGUAGE") on.exit(Sys.setenv(LANGUAGE=olang)) Sys.setenv(LANGUAGE="fr") foo() }, timeout=1.08, onTimeout="warning") }, warning=function(ex) { cat("Timeout warning (", ex$message, "). Skipping.\n", sep="") TRUE }, error=function(ex) { warning("withTimeout() fails to detect timeouts when the language is temporarily switched") FALSE }) print(res) # Undo options(oopts) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/symlinks,dirs.R�����������������������������������������������������������������������0000644�0001762�0000144�00000004746�14372747611�015735� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") verbose <- Arguments$getVerbose(TRUE, timestamp=TRUE) # Run only tests if this platform/client supports symbolic file links canSymlink <- tryCatch({ res <- file.symlink(".", "test-symlink-dir") if (isDirectory("test-symlink-dir")) removeDirectory("test-symlink-dir") res }, error = function(ex) FALSE) # Test only if symlinks are supported if (canSymlink) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Local functions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - fileAccessT <- function(pathname, modes=c(exist=0, exec=1, write=2, read=4)) { sapply(modes, FUN=function(mode) fileAccess(pathname, mode=mode)) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # DIRECTORIES # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - verbose && enter(verbose, "Symbolic links to directories") # Create a target path <- file.path(tempdir(), "foo") mkdirs(path) stopifnot(isDirectory(path)) # Create a symbolic link pathL <- "link-to-tempdir" file.symlink(path, pathL) stopifnot(isDirectory(pathL)) # File information (directly and via link) fi <- file.info(path) fiL <- file.info2(pathL) stopifnot(all.equal(fiL, fi, check.attributes=FALSE)) # Add a file (via link) pathnameL <- file.path(pathL, "target2.txt") cat("Hello", file=pathnameL) # Assert that it exists (via direct pathname) pathname <- file.path(path, "target2.txt") stopifnot(isFile(pathname)) # Remove file (via direct pathname) file.remove(pathname) stopifnot(!isFile(pathname)) stopifnot(!isFile(pathnameL)) verbose && enter(verbose, "Renaming") pathL2 <- sprintf("%s-new", pathL) renameFile(pathL, pathL2) stopifnot(isDirectory(pathL2)) renameFile(pathL2, pathL) stopifnot(isDirectory(pathL)) verbose && exit(verbose) # File access verbose && enter(verbose, "Testing file permissions & access information") fa <- fileAccessT(path) faL <- fileAccessT(pathL) stopifnot(identical(faL, fa)) # Disable write permission on target Sys.chmod(path, mode="0077") fa <- fileAccessT(path) faL <- fileAccessT(pathL) stopifnot(identical(faL, fa)) # Reset Sys.chmod(path, mode="0777") verbose && exit(verbose) # Removing & cleanup verbose && enter(verbose, "Cleanup") # (Neither file.remove() nor unlink() can remove symbolic directory links) removeDirectory(pathL) stopifnot(!isDirectory(pathL)) stopifnot(isDirectory(path)) removeDirectory(path) stopifnot(!isDirectory(path)) verbose && exit(verbose) verbose && exit(verbose) } # if (canSymlink) ��������������������������R.utils/tests/Arguments-FILES.R���������������������������������������������������������������������0000644�0001762�0000144�00000001167�14372747611�015725� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # getReadablePathname() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - paths <- c(".", getwd(), R.home(), system.file(package="R.utils")) for (path in paths) { for (mustExist in c(FALSE, TRUE)) { path2 <- Arguments$getReadablePath(path, mustExist=mustExist) str(list(path=path, path2=path2)) } } # Missing values pathname <- Arguments$getReadablePathname(NA_character_, mustExist=FALSE) stopifnot(is.na(pathname)) path <- Arguments$getReadablePath(NA_character_, mustExist=FALSE) stopifnot(is.na(path)) ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/FileProgressBar.R���������������������������������������������������������������������0000644�0001762�0000144�00000000437�14372747611�016150� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # Creates a progress bar (of length 100) that displays it self as a file. pb <- FileProgressBar(file.path(tempdir(), "progress.simulation")) reset(pb) while (!isDone(pb)) { x <- rnorm(3e4) increase(pb) # Emulate a slow process Sys.sleep(0.001) } cleanup(pb) ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/use.R���������������������������������������������������������������������������������0000644�0001762�0000144�00000001230�14372747611�013703� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # Use with one package use("tools", how="load") # Use with one package use("tools") # Use with multiple packages use(c("tools", "graphics")) use("tools, graphics") use(c("tools, graphics", "grDevices")) # Use with version constraint use("tools", version="(>= 2.5.0)") use("tools (>= 2.5.0)") # Use with multiple packages and version constraints use(c("tools", "graphics"), version=c("(>= 2.5.0)", "(>= 2.5.0)")) use("tools, graphics", version="(>= 2.5.0), (>= 2.5.0)") use("tools (>= 2.5.0), graphics (>= 2.5.0)") # Exception should be visible tryCatch({ use("NonExistingPackage", install=FALSE) }, error = function(ex) { print(ex) }) ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/systemR.R�����������������������������������������������������������������������������0000644�0001762�0000144�00000000312�14372747611�014555� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") message("*** systemR() ...") res <- systemR('--slave -e "cat(runif(1))"', intern=TRUE, verbose=TRUE) cat("A random number: ", res, "\n", sep="") message("*** systemR() ... DONE") ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/toCamelCase.R�������������������������������������������������������������������������0000644�0001762�0000144�00000003164�14372747611�015277� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") strings <- list( "", "hello world" = c("helloWorld", "HelloWorld", "helloWorld", "HelloWorld"), "tcn start" = c("tcnStart", "TcnStart", "tcnStart", "TcnStart"), "GEO Accession" = c("gEOAccession", "GEOAccession", "geoAccession", "GEOAccession") ) for (s in names(strings)) { printf("Original: %s\n", sQuote(s)) y <- toCamelCase(s) printf("Camel case: %s\n", sQuote(y)) stopifnot(y == strings[[s]][1L]) y <- toCamelCase(s, capitalize=TRUE) printf("Capitalized camel case: %s\n", sQuote(y)) stopifnot(y == strings[[s]][2L]) y <- toCamelCase(s, preserveSameCase=TRUE) printf("Capitalized camel case without same case preserved: %s\n", sQuote(y)) stopifnot(y == strings[[s]][3L]) y <- toCamelCase(s, capitalize=TRUE, preserveSameCase=TRUE) printf("Capitalized camel case with same case preserved: %s\n", sQuote(y)) stopifnot(y == strings[[s]][4L]) cat("\n") } # Vectorized s <- names(strings) y <- toCamelCase(s) stopifnot(length(y) == length(s)) y0 <- sapply(strings, FUN=function(s) s[1L]) stopifnot(all(y == y0)) # Empty vector y <- toCamelCase(character(0L)) stopifnot(length(y) == 0L) y <- toCamelCase(NULL) stopifnot(length(y) == 0L) # Missing values for (preserveSameCase in c(FALSE, TRUE)) { y <- toCamelCase(NA_character_, preserveSameCase=preserveSameCase) stopifnot(is.na(y)) y <- toCamelCase(c(NA_character_, NA_character_), preserveSameCase=preserveSameCase) stopifnot(all(is.na(y))) y <- toCamelCase(c(NA_character_, "hello world", NA_character_), preserveSameCase=preserveSameCase) stopifnot(identical(y, c(NA_character_, "helloWorld", NA_character_))) } ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/isPackageLoaded.R���������������������������������������������������������������������0000644�0001762�0000144�00000000270�14372747611�016112� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") for (pkg in c("R.utils", "tools", "MASS", "unknown")) { mprintf("isPackageLoaded('%s'): %s\n", pkg, isPackageLoaded(pkg)) } isPackageLoaded("R.utils", "1.2.0") ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/doCall.R������������������������������������������������������������������������������0000644�0001762�0000144�00000001145�14372747611�014312� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") message("*** doCall() ...\n") value <- doCall(seq_len, length.out=5L, .ignoreUnusedArgs=FALSE) print(value) value <- doCall("seq_len", args=list(length.out=5L), .ignoreUnusedArgs=FALSE) print(value) value <- doCall("seq_len", args=list(length.out=5L), .functions=list("seq_len"), .ignoreUnusedArgs=FALSE) print(value) ## Exception handling res <- try(doCall(2L), silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(doCall("seq_len", args=list(length.out=5L), .functions=list("<unknown>")), silent=TRUE) stopifnot(inherits(res, "try-error")) message("*** doCall() ... DONE\n") ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/parseRepos.R��������������������������������������������������������������������������0000644�0001762�0000144�00000002575�14372747611�015247� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") message("CRAN:") str(as.list(parseRepos("CRAN"))) message("braju.com:") str(as.list(parseRepos("braju.com"))) message("CRAN + braju.com:") str(as.list(parseRepos(c("CRAN", "braju.com")))) message("braju.com + CRAN:") str(as.list(parseRepos(c("braju.com", "CRAN")))) message("All CRAN related repositories:") str(as.list(parseRepos("[[CRAN]]"))) message("All BioC related repositories:") str(as.list(parseRepos("[[BioC]]"))) message("braju.com + all CRAN related repositories:") str(as.list(parseRepos(c("braju.com", "[[CRAN]]")))) message("All CRAN related repositories + braju.com:") str(as.list(parseRepos(c("[[CRAN]]", "braju.com")))) message("All CRAN related + BioC related repositories:") str(as.list(parseRepos(c("[[CRAN]]", "[[BioC]]")))) message("All BioC related + CRAN related repositories:") str(as.list(parseRepos(c("[[BioC]]", "[[CRAN]]")))) message("Mainstream (CRAN and BioC related) repositories (only):") str(as.list(parseRepos("[[mainstream]]"))) message("An explicit repository URL:") str(as.list(parseRepos("http://r-forge.r-project.org"))) message("An explicit repository URL + mainstream:") str(as.list(parseRepos(c("http://r-forge.r-project.org", "[[mainstream]]")))) message("Repositories according to option 'repos':") str(as.list(parseRepos("[[current]]"))) message("All repositories known to this system:") str(as.list(parseRepos("[[all]]"))) �����������������������������������������������������������������������������������������������������������������������������������R.utils/tests/gcDLLs.R������������������������������������������������������������������������������0000644�0001762�0000144�00000000311�14372747611�014216� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") message("*** getDLLs() ...") dlls <- strayDLLs() print(dlls) dlls <- gcDLLs(quiet = TRUE) print(dlls) dlls <- gcDLLs(quiet = FALSE) print(dlls) message("*** getDLLs() ... DONE")�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/attachLocally.R�����������������������������������������������������������������������0000644�0001762�0000144�00000001531�14372747611�015677� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # A named list x <- list(a=1, b=base::letters) keys <- attachLocally(x) stopifnot(identical(keys, names(x))) for (key in keys) stopifnot(identical(get(key), x[[key]])) # A list with "empty" names x <- list(a=1, b=base::letters, "noname", "another one") keys <- attachLocally(x) stopifnot(identical(keys, setdiff(names(x), ""))) for (key in keys) stopifnot(identical(get(key), x[[key]])) # An environment x <- list(a=1, b=base::letters) env <- list2env(x) stopifnot(identical(ls(envir=env), names(x))) keys <- attachLocally(env) stopifnot(identical(keys, ls(envir=env))) for (key in keys) stopifnot(identical(get(key), env[[key]])) # A data.frame df <- data.frame(a=1, b=base::letters, stringsAsFactors=FALSE) keys <- attachLocally(df) stopifnot(identical(keys, names(df))) for (key in keys) stopifnot(identical(get(key), df[[key]])) �����������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/isReplicated.R������������������������������������������������������������������������0000644�0001762�0000144�00000002305�14372747611�015523� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") x <- c(1,1,2,3,4,2,1) x <- base::letters[x] print(x) # Identify entries with replicated values reps <- isReplicated(x) print(x[reps]) stopifnot(x[reps] == replicates(x)) # Identify entries with unique values print(x[!reps]) stopifnot(x[!reps] == singles(x)) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validation # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x <- c(1,1,2,3,4,2,1) x <- base::letters[x] reps <- isReplicated(x) stopifnot(all(table(x[reps]) > 1)) stopifnot(all(table(x[!reps]) == 1)) stopifnot(all(reps == rev(isReplicated(rev(x))))) stopifnot(all(reps == duplicated(x) | duplicated(x, fromLast=TRUE))) stopifnot(all(reps == !is.element(x, setdiff(x, unique(x[duplicated(x)]))))) stopifnot(all(sort(c(singles(x), replicates(x))) == sort(x))) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Benchmarking singles() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - set.seed(0xBEEF) n <- 1e6 x <- sample(1:(n/2), size=n, replace=TRUE) t <- system.time({ s <- isSingle(x) }) print(sum(s)) t0 <- system.time({ s0 <- !(x %in% x[duplicated(x)]) }) print(t/t0) stopifnot(all(s == s0)) ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/queryRCmdCheck.R����������������������������������������������������������������������0000644�0001762�0000144�00000000665�14372747611�015773� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ # Get the 'R CMD check' status, if any status <- R.utils::queryRCmdCheck() print(status) if (status != "notRunning") { cat("The current R session was launched by R CMD check. Status:", status, "\n") } else { cat("The current R session was not launched by R CMD check.\n") } # Display how R was launched print(base::commandArgs()) # Display loaded packages etc. print(search()) # Display current working directory print(getwd()) ���������������������������������������������������������������������������R.utils/tests/cout.R��������������������������������������������������������������������������������0000644�0001762�0000144�00000002536�14372747611�014073� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") show <- methods::show # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # General tests # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x <- letters[1:8] x2 <- c(x[-1], "\n") x3 <- x2[-1] y <- as.list(x[1:3]) cat("mprint():\n") print(x) cprint(x) print(y) cprint(y) cat("mcat():\n") cat(x, "\n") ccat(x, "\n") cat(x2) ccat(x2) cat(x3, sep=",") ccat(x3, sep=",") cat(x3, sep="\n") ccat(x3, sep="\n") cat("mstr():\n") str(x) cstr(x) str(y) cstr(y) cat("mshow():\n") show(x) cshow(x) show(y) cshow(y) cat("mprintf():\n") printf("x=%d\n", 1:3) cprintf("x=%d\n", 1:3) cat("mout():\n") writeLines(x) cout(writeLines(x)) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Tests related to closure # - - - - - - - - - - - -- - - - - - - - - - - - - - - - - - cfoo <- function(a=1) { cprintf("a=%s\n", a) } cbar <- function(...) { cfoo(...) } a <- 2 cfoo(a) cfoo(3) cbar(a) cbar(3) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Assert that "console" messages cannot be captured/sunk # via neither stdout nor stderr # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - res <- captureOutput({ ccat("Hello") }) str(res) stopifnot(length(res) == 0L) withSink({ ccat("Hello") }, file="foo.txt", type="message") res <- readLines("foo.txt") str(res) stopifnot(length(res) == 0L) ������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/mpager.R������������������������������������������������������������������������������0000644�0001762�0000144�00000000223�14372747611�014363� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") file <- tempfile() cat("Hello world!\n", file=file) mpager(file, header=file, title="Example for mpager()", delete.file=TRUE) �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/extract.array.R�����������������������������������������������������������������������0000644�0001762�0000144�00000002600�14372747611�015700� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Example using an array with a random number of dimensions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - maxdim <- 4 dim <- sample(3:maxdim, size=sample(2:maxdim, size=1), replace=TRUE) ndim <- length(dim) dimnames <- list() for (kk in 1:ndim) dimnames[[kk]] <- sprintf("%s%d", letters[kk], 1:dim[kk]) x <- 1:prod(dim) x <- array(x, dim=dim, dimnames=dimnames) cat("\nArray 'x':\n") print(x) cat("\nExtract 'x[2:3,...]':\n") print(extract(x, "1"=2:3)) cat("\nExtract 'x[3,2:3,...]':\n") print(extract(x, "1"=3,"2"=2:3)) cat("\nExtract 'x[...,2:3]':\n") print(extract(x, indices=2:3, dims=length(dim(x)))) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Assertions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - y <- array(1:24, dim=c(2,3,4)) yA <- y[,,2:3] yB <- extract(y, indices=list(2:3), dims=length(dim(y))) stopifnot(identical(yB, yA)) yA <- y[,2:3,2] yB <- extract(y, indices=list(2:3,2), dims=c(2,3), drop=TRUE) stopifnot(identical(yB, yA)) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Matrix # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - y <- matrix(1:24, nrow=6, ncol=4) yA <- y[,2:3] yB <- extract(y, indices=list(2:3), dims=length(dim(y))) stopifnot(identical(yB, yA)) ��������������������������������������������������������������������������������������������������������������������������������R.utils/tests/cmdArgs.R�����������������������������������������������������������������������������0000644�0001762�0000144�00000002424�14372747611�014475� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") ###################################################################### # Parsed command-line arguments ###################################################################### # Call: exprA <- "str(R.utils::cmdArgs(defaults=list(n=2L,a=2)))" exprB <- "str(R.utils::cmdArgs(defaults=list(n=3L,a=3)))" argsC <- c("Rscript", "-e", exprA, "--args", "-e", exprB, "-n", "1") print(argsC) # Truth: args0 <- list(e=exprB, n=1) args <- cmdArgs(.args=argsC) str(args) stopifnot(all.equal(args, args0)) # Truth: args0 <- list(x=3.14, e=exprB, n=1L) args <- cmdArgs(defaults=list(n=0L, x=3.14), .args=argsC) str(args) stopifnot(all.equal(args, args0)) # Truth: args0 <- list(K=50) args <- cmdArgs(args=args0, .args=argsC) str(args) stopifnot(all.equal(args, args0)) args <- cmdArgs(args=list()) str(args) args <- cmdArgs(args="*") str(args) args <- cmdArgs(args=list("*", "*")) str(args) args <- cmdArgs(args=list("*", a=3L, "*")) str(args) args <- cmdArgs(args=args0, names="K") str(args) stopifnot(all.equal(args, args0["K"])) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Call function via command-line arguments ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - value <- cmdArgsCall("seq_len", args=list(length.out=5)) print(value) ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/insert.R������������������������������������������������������������������������������0000644�0001762�0000144�00000003446�14372747611�014426� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # Insert NAs (default) between all values y <- c(a=1, b=2, c=3) print(y) x <- insert(y, ats=2:length(y)) Ex <- c(y[1], NA_real_, y[2], NA_real_, y[3]) print(x) stopifnot(identical(x,Ex)) # Insert at first position y <- c(a=1, b=2, c=3) print(y) x <- insert(y, ats=1, values=rep(NA_real_, 2)) Ex <- c(NA_real_,NA_real_,y) print(x) stopifnot(identical(x,Ex)) x <- insert(y, ats=1, values=rep(NA_real_,2), useNames=FALSE) print(x) # Insert at last position (names of 'values' are ignored # because input vector has no names) x <- insert(1:3, ats=4, values=c(d=2, e=1)) Ex <- c(1:3,2,1) print(x) stopifnot(identical(x,Ex)) # Insert in the middle of a vector x <- insert(c(1,3,2,1), ats=2, values=2) print(x) stopifnot(identical(as.double(x),as.double(Ex))) # Insert multiple vectors at multiple indices at once x0 <- c(1:4, 8:11, 13:15) x <- insert(x0, ats=c(5,9), values=list(5:7,12)) print(x) Ex <- 1:max(x) stopifnot(identical(as.double(x),as.double(Ex))) x <- insert(x0, ats=c(5,9,12), values=list(5:7,12,16:18)) print(x) Ex <- 1:max(x) stopifnot(identical(as.double(x),as.double(Ex))) # Insert with duplicated locations (which requires grouping) x <- letters[1:6] ats <- c(1L, 1L, 4L) values <- LETTERS[1:3] y0 <- c("A", "B", "a", "b", "c", "C", "d", "e", "f") y <- insert(x, ats = ats, values = values) print(y) stopifnot(identical(y, y0)) ats <- c(1L, 4L) values <- list(LETTERS[1:2], LETTERS[3]) y <- insert(x, ats = ats, values = values) print(y) stopifnot(identical(y, y0)) # Insert missing indices Ex <- 1:20 missing <- setdiff(Ex, x0) x <- x0 for (m in missing) x <- insert(x, ats=m, values=m) print(x) stopifnot(identical(as.double(x),as.double(Ex))) ## Exception handling x <- 1:10 res <- try(y <- insert(x, ats=1:2, values=1:3), silent=TRUE) stopifnot(inherits(res, "try-error")) ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/withOptions.R�������������������������������������������������������������������������0000644�0001762�0000144�00000002611�14372747611�015442� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") oopts <- options() digits <- getOption("digits") print(pi) # Same, i.e. using default withOptions({ print(pi) stopifnot(getOption("digits") == digits) }) # Printing with two digits withOptions({ print(pi) stopifnot(getOption("digits") == 2) }, digits=2) # Printing with two digits then with three more withOptions({ print(pi) withOptions({ print(pi) stopifnot(getOption("digits") == 5) }, digits=getOption("digits")+3) stopifnot(getOption("digits")+3 == 5) }, digits=2) # Still printing with the default print(pi) stopifnot(getOption("digits") == digits) # Reset also options set inside call options(dummy=NULL) withOptions({ print(pi) options(digits=1L) print(pi) stopifnot(getOption("digits") == 1L) options(dummy="Hello") print(getOption("dummy")) }) stopifnot(is.null(getOption("dummy"))) # Any modified or added option is undone stopifnot(all.equal(options(), oopts)) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Visibility # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - digits <- getOption("digits")+1L res <- withVisible({ withOptions({ 1 }, digits=digits) }) str(res) stopifnot(all.equal(res$value, 1)) stopifnot(res$visible) x <- 0 res <- withVisible({ withOptions({ x <- 1 }, digits=digits) }) str(res) stopifnot(all.equal(res$value, 1)) stopifnot(!res$visible) stopifnot(all.equal(x, 1)) �����������������������������������������������������������������������������������������������������������������������R.utils/tests/displayCode.R�������������������������������������������������������������������������0000644�0001762�0000144�00000002001�14372747611�015344� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") opager <- options(pager=mpager) file <- system.file("DESCRIPTION", package="R.utils") cat("Displaying: ", file, ":\n", sep="") displayCode(file) file <- system.file("NEWS.md", package="R.utils") cat("Displaying: ", file, ":\n", sep="") displayCode(file, numerate=FALSE, lines=100:110, wrap=65) file <- system.file("NEWS.md", package="R.utils") cat("Displaying: ", file, ":\n", sep="") displayCode(file, lines=100:110, wrap=65, highlight=c(101,104:108)) con <- file(file) displayCode(con, lines=1:10) displayCode(file, lines=1:10, pager=mpager) displayCode(file, lines=1:10, pager="mpager") ## Exception handling res <- try(displayCode(file, lines=-10:110), silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(displayCode(file, wrap=integer(0)), silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(displayCode(file, wrap=55:66), silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(displayCode(2L), silent=TRUE) stopifnot(inherits(res, "try-error")) options(opager) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/touchFile.R���������������������������������������������������������������������������0000644�0001762�0000144�00000001661�14372747611�015041� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # Create files pathnames <- sapply(1:3, FUN=function(x) { pathname <- tempfile() cat(file=pathname, "Hello world!") pathname }) # Record checksums md5a <- sapply(pathnames, FUN=digest::digest, file=TRUE) # Record current time stamps ta <- file.info(pathnames)$mtime print(ta) # Wait a bit... Sys.sleep(1.2) # Touch zero files stopifnot(is.null(touchFile(NULL))) stopifnot(is.null(touchFile(character(0L)))) # Touch multiple files ta0 <- touchFile(pathnames) tb <- file.info(pathnames)$mtime print(tb) # Verify return value stopifnot(identical(ta0, ta)) # Verify that the timestamps got updated stopifnot(tb > ta) # Touch a single file ta0 <- touchFile(pathnames[2L]) tb <- file.info(pathnames[2L])$mtime print(tb) # Verify that the timestamps got updated stopifnot(tb > ta[2L]) # Verify that the content did not change md5b <- sapply(pathnames, FUN=digest::digest, file=TRUE) stopifnot(identical(md5a, md5b)) �������������������������������������������������������������������������������R.utils/tests/gcat.R��������������������������������������������������������������������������������0000644�0001762�0000144�00000001036�14372747611�014031� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������message("*** Testing gcat()...") library("R.utils") gcat("Hello world!\n") a <- 1 gcat("a=${a}\n") gcat(GString("a=${a}\n")) message("*** Testing gcat()...DONE") message("*** Testing gstring()...") a <- 2 s <- gstring("a=${a}\n") print(s) cat("a=${a}\n", file="foo.txt") s <- gstring(file="foo.txt") print(s) file.remove("foo.txt") pathT <- tempdir() pathname <- file.path(pathT, "foo.txt") cat("a=${a}\n", file=pathname) s <- gstring(file="foo.txt", path=pathT) print(s) file.remove(pathname) message("*** Testing gcat()...DONE") ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/filePath.R����������������������������������������������������������������������������0000644�0001762�0000144�00000001676�14372747611�014661� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") assertEqual <- function(a, b) { a <- gsub("\\", "/", a, fixed=TRUE) b <- gsub("\\", "/", b, fixed=TRUE) if (a != b) { throw("The two paths/pathnames differ: ", sQuote(a), " != ", sQuote(b)) } } # assertEqual() path <- file.path("foo", "bar", "..", "name") assertEqual(path, "foo/bar/../name") path <- filePath("foo", "bar", "..", "name") assertEqual(path, "foo/name") path <- filePath("foo/bar/../name") assertEqual(path, "foo/name") path <- filePath(".") assertEqual(path, ".") path <- filePath("..") assertEqual(path, "..") path <- filePath("../..") assertEqual(path, "../..") path <- filePath("./.") assertEqual(path, ".") path <- filePath(".", ".") assertEqual(path, ".") path <- filePath(".", "..") assertEqual(path, "..") path <- filePath("C:/foo/..") assertEqual(path, "C:/") path <- filePath("/tmp/../../..") assertEqual(path, "/../..") path <- filePath("C:/../../..") assertEqual(path, "C:/../../..") ������������������������������������������������������������������R.utils/tests/hpaste.R������������������������������������������������������������������������������0000644�0001762�0000144�00000004146�14372747611�014404� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # Some vectors x <- 1:6 y <- 10:1 z <- LETTERS[x] # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Abbreviation of output vector # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - printf("x = %s.\n", hpaste(x)) ## x = 1, 2, 3, ..., 6. printf("x = %s.\n", hpaste(x, maxHead=2)) ## x = 1, 2, ..., 6. printf("x = %s.\n", hpaste(x, maxHead=3)) # Default ## x = 1, 2, 3, ..., 6. # It will never output 1, 2, 3, 4, ..., 6 printf("x = %s.\n", hpaste(x, maxHead=4)) ## x = 1, 2, 3, 4, 5 and 6. # Showing the tail printf("x = %s.\n", hpaste(x, maxHead=1, maxTail=2)) ## x = 1, ..., 5, 6. # Turning off abbreviation printf("y = %s.\n", hpaste(y, maxHead=Inf)) ## y = 10, 9, 8, 7, 6, 5, 4, 3, 2, 1 ## ...or simply printf("y = %s.\n", paste(y, collapse=", ")) ## y = 10, 9, 8, 7, 6, 5, 4, 3, 2, 1 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Adding a special separator before the last element # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Change last separator printf("x = %s.\n", hpaste(x, lastCollapse=" and ")) ## x = 1, 2, 3, 4, 5 and 6. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Empty input # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - s <- hpaste(integer(0)) stopifnot(identical(s, character(0L))) s <- hpaste(integer(0), empty = "") stopifnot(identical(s, "")) s <- hpaste(integer(0), empty = NA_character_) stopifnot(identical(s, NA_character_)) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Backward compatibility with paste() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - s1 <- hpaste(x, maxHead=Inf) s2 <- paste(x, collapse=", ") printf("s = %s.\n", s1) stopifnot(identical(s1, s2)) s1 <- hpaste('<', x, '>', maxHead=Inf) s2 <- paste('<', x, '>', sep="", collapse=", ") printf("s = %s.\n", s1) stopifnot(identical(s1, s2)) s1 <- hpaste(x, y, z, sep="/", maxHead=Inf) s2 <- paste(x, y, z, sep="/", collapse=", ") printf("s = %s.\n", s1) stopifnot(identical(s1, s2)) s1 <- hpaste(x, collapse=NULL, maxHead=Inf) s2 <- paste(x, collapse=NULL) stopifnot(identical(s1, s2)) ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/createFileAtomically.R����������������������������������������������������������������0000644�0001762�0000144�00000003241�14372747611�017175� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Create a file atomically # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - n <- 10 createFileAtomically("foobar.txt", FUN=function(pathname) { cat(file=pathname, "This file was created atomically.\n") cat(file=pathname, "Timestamp: ", as.character(Sys.time()), "\n", sep="") for (kk in 1:n) { cat(file=pathname, kk, "\n", append=TRUE) # Emulate a slow process if (interactive()) Sys.sleep(0.1) } cat(file=pathname, "END OF FILE\n", append=TRUE) }, overwrite=TRUE) # Skip, if already exists createFileAtomically("foobar.txt", FUN=function(pathname) { cat("This will not be called\n") }, skip=TRUE, verbose=TRUE) bfr <- readLines("foobar.txt") cat(bfr, sep="\n") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Overwrite the file atomically (emulate write failure) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - tryCatch({ createFileAtomically("foobar.txt", FUN=function(pathname) { cat(file=pathname, "Trying to create a new file.\n") cat(file=pathname, "Writing a bit, but then an error...\n", append=TRUE) # Emulate write error stop("An error occured while writing to the new file.") cat(file=pathname, "END OF FILE\n", append=TRUE) }, overwrite=TRUE) }, error = function(ex) { print(ex$message) }) # The original file was never overwritten bfr2 <- readLines("foobar.txt") cat(bfr2, sep="\n") stopifnot(identical(bfr2, bfr)) # The partially temporary file remains stopifnot(isFile("foobar.txt.tmp")) bfr3 <- readLines("foobar.txt.tmp") cat(bfr3, sep="\n") file.remove("foobar.txt.tmp") file.remove("foobar.txt") ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/captureOutput.R�����������������������������������������������������������������������0000644�0001762�0000144�00000001672�14372747611�016005� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") message("*** captureOutput() == capture.output()") for (n in c(0, 1, 10, 100, 1000)) { printf("n=%d\n", n) x <- rnorm(n) str(x) bfr0 <- capture.output(print(x)) bfr <- captureOutput(print(x)) stopifnot(nchar(bfr) == nchar(bfr0)) stopifnot(identical(bfr, bfr0)) } # for (n ...) message("*** captureOutput(..., collapse=ch)") x <- c("abc", "123", "def\n456") for (ch in list(NULL, "\n", "\r", "\n\r", "\r\n", ";\n", "")) { bfr0 <- paste(capture.output(cat(x)), collapse=ch) bfr <- captureOutput(cat(x), collapse=ch) str(list(bfr0=bfr0, bfr=bfr)) stopifnot(identical(bfr0, bfr)) } message("*** captureOutput(..., file='foo.txt')") x <- c("abc", "123", "def\n456") capture.output(cat(x), file="foo1.txt") captureOutput(cat(x), file="foo2.txt") bfr1 <- readLines("foo1.txt", warn=FALSE) bfr2 <- readLines("foo2.txt", warn=FALSE) stopifnot(all.equal(bfr2, bfr1)) file.remove("foo1.txt") file.remove("foo2.txt") ����������������������������������������������������������������������R.utils/tests/tmpfile.R�����������������������������������������������������������������������������0000644�0001762�0000144�00000001170�14372747611�014552� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Assert that auto delete works ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Temporary files before tfiles <- dir(path=tempdir(), full.names=TRUE) ## Create temporary file on the fly without any references to it bfr <- readLines(tmpfile("Hello world!\n")) print(bfr) ## Find new temporary file tfile <- setdiff(dir(path=tempdir(), full.names=TRUE), tfiles) print(tfile) stopifnot(file.exists(tfile)) ## The on-the-fly temporary file is removed ## whenever the garbage collector runs gc() stopifnot(!file.exists(tfile)) ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/seqToHumanReadable.R������������������������������������������������������������������0000644�0001762�0000144�00000001574�14372747611�016626� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") ## Empty s <- seqToHumanReadable(integer(0L)) print(s) stopifnot(s == "") ## Single s <- seqToHumanReadable(0L) print(s) stopifnot(s == "0") ## Duplicates s <- seqToHumanReadable(c(1:2, 1:2)) print(s) stopifnot(s == "1, 2") ## Two s <- seqToHumanReadable(1:2) print(s) stopifnot(s == "1, 2") ## Two s <- seqToHumanReadable(c(1, 3)) print(s) stopifnot(s == "1, 3") ## A few subsets x <- c(1:3, 5:8, 15, 21:20, 25:26) s <- seqToHumanReadable(x) print(s) stopifnot(s == "1-3, 5-8, 15, 20, 21, 25, 26") ## Other delimiters s <- seqToHumanReadable(x, delimiter=":", collapse="; ") print(s) stopifnot(s == "1:3; 5:8; 15; 20; 21; 25; 26") ## Display 1:2 as 1-2 s <- seqToHumanReadable(x, tau=1L) print(s) stopifnot(s == "1-3, 5-8, 15, 20-21, 25-26") ## Display 1:3 as 1, 2, 3 s <- seqToHumanReadable(x, tau=3L) print(s) stopifnot(s == "1, 2, 3, 5-8, 15, 20, 21, 25, 26") ������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/Verbose.R�����������������������������������������������������������������������������0000644�0001762�0000144�00000003063�14372747611�014522� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") verbose <- Verbose(threshold=-1) print(verbose) header(verbose, "A verbose writer example", padding=0) enter(verbose, "Analysis A") for (kk in 1:10) { printf(verbose, "step %d\n", kk) if (kk == 2) { cat(verbose, "Turning ON automatic timestamps") timestampOn(verbose) } else if (kk == 4) { timestampOff(verbose) cat(verbose, "Turned OFF automatic timestamps") cat(verbose, "Turning OFF verbose messages for steps ", kk, "-6") off(verbose) } else if (kk == 6) { on(verbose) cat(verbose, "Turned ON verbose messages just before step ", kk+1) } if (kk %in% c(5,8)) { enterf(verbose, "Sub analysis #%d", kk) for (jj in c("i", "ii", "iii")) { cat(verbose, "part ", jj) } exit(verbose) } } cat(verbose, "All steps completed!") exit(verbose) ruler(verbose) cat(verbose, "Demo of some other methods:") str(verbose, c(a=1, b=2, c=3)) print(verbose, c(a=1, b=2, c=3)) summary(verbose, c(a=1, b=2, c=3)) evaluate(verbose, rnorm, n=3, mean=2, sd=3) ruler(verbose) newline(verbose) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Odds and ends # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - print(equals(verbose, verbose)) print(equals(verbose, NA)) setThreshold(verbose, -4) print(verbose) setDefaultLevel(verbose, -1) print(verbose) print(as.logical(verbose)) print(as.double(verbose)) print(less(verbose)) print(more(verbose)) timestamp(verbose) setTimestampFormat(verbose) print(getTimestampFormat(verbose)) warning("Hello world!") warnings(verbose) print(timestamp()) �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/colClasses.R��������������������������������������������������������������������������0000644�0001762�0000144�00000002106�14372747611�015205� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # All predefined types print(colClasses("-?cdfilnrzDP")) ## [1] "NULL" "NA" "character" "double" ## [5] "factor" "integer" "logical" "numeric" ## [9] "raw" "complex" "Date" "POSIXct" # A string in column 1, integers in column 4 and 5, rest skipped print(colClasses("c--ii----")) ## [1] "character" "NULL" "NULL" "integer" ## [5] "integer" "NULL" "NULL" "NULL" ## [9] "NULL" # Repeats and custom column classes c1 <- colClasses("3c{MyClass}3{foo}") print(c1) ## [1] "character" "character" "character" "MyClass" ## [5] "foo" "foo" "foo" # Passing repeats and class names using sprintf() syntax c2 <- colClasses("%dc{%s}%d{foo}", 3, "MyClass", 3) stopifnot(identical(c1, c2)) # Repeats of a vector of column classes c3 <- colClasses("3{MyClass,c}") print(c3) ## [1] "MyClass" "character" "MyClass" "character" ## [4] "MyClass" "character" # Large number repeats c4 <- colClasses("321{MyClass,c,i,d}") c5 <- rep(c("MyClass", "character", "integer", "double"), times=321) stopifnot(identical(c4, c5)) ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/splitByPattern.R����������������������������������������������������������������������0000644�0001762�0000144�00000000235�14372747611�016077� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") rspCode <- "<body>Hello <%=\"world\"%></body>" rspParts <- splitByPattern(rspCode, pattern="<%.*%>") cat(rspCode, "\n") print(rspParts) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/dataFrame.R���������������������������������������������������������������������������0000644�0001762�0000144�00000000225�14372747611�014776� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") df <- dataFrame(colClasses=c(a="integer", b="double"), nrow=10) df[,1] <- sample(1:nrow(df)) df[,2] <- rnorm(nrow(df)) print(df) ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/loadObject.R��������������������������������������������������������������������������0000644�0001762�0000144�00000001351�14372747611�015161� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") x <- 1:10 str(x) file <- tempfile(fileext="") file1 <- saveObject(x, file=file) print(file1) x1 <- loadObject(file1) str(x1) stopifnot(all.equal(x1, x)) file.remove(file1) file2 <- saveObject(x, file=sprintf("%s.xdr", file)) print(file2) x2 <- loadObject(file2) str(x2) stopifnot(all.equal(x2, x)) file.remove(file2) file3 <- saveObject(x, file=sprintf("%s.rds", file)) print(file3) x3 <- loadObject(file3, format="rds") str(x3) stopifnot(all.equal(x3, x)) file.remove(file3) file4 <- saveObject(x, file=sprintf("%s.Rbin", file)) print(file4) x4 <- loadObject(file4) str(x4) stopifnot(all.equal(x4, x)) file.remove(file4) if (isPackageInstalled("digest")) { file <- saveObject(x) print(file) file.remove(file) } ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/seqToIntervals.R����������������������������������������������������������������������0000644�0001762�0000144�00000001060�14372747611�016073� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") x <- 1:10 y <- seqToIntervals(x) print(y) # [1 10] x <- c(1:10, 15:18, 20) y <- seqToIntervals(x) print(y) # [1 10; 15 18; 20 20] z <- intervalsToSeq(y) print(z) stopifnot(all.equal(x,z)) y <- matrix(c(5,11, 1,10), ncol=2L, byrow=TRUE) z <- intervalsToSeq(y, unique=FALSE) print(z) z <- intervalsToSeq(y, unique=TRUE) print(z) z <- intervalsToSeq(y, sort=TRUE) print(z) z <- intervalsToSeq(y, unique=TRUE, sort=TRUE) print(z) ## Corner cases x <- integer(0) y <- seqToIntervals(x) print(y) str(y) stopifnot(all.equal(dim(y), c(0,2))) ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/symlinks,files.R����������������������������������������������������������������������0000644�0001762�0000144�00000010330�14372747611�016060� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") verbose <- Arguments$getVerbose(TRUE, timestamp=TRUE) # Run only tests if this platform/client supports symbolic file links canSymlink <- tryCatch({ res <- file.symlink(".", "test-symlink-dir") if (isDirectory("test-symlink-dir")) removeDirectory("test-symlink-dir") res }, error = function(ex) FALSE) # Test only if symlinks are supported if (canSymlink) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Local functions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - fileAccessT <- function(pathname, modes=c(exist=0, exec=1, write=2, read=4)) { sapply(modes, FUN=function(mode) fileAccess(pathname, mode=mode)) } filename <- "foo.txt" paths <- list(".", tempdir()) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # FILES # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - for (path in paths) { verbose && enter(verbose, "Symbolic links to files") verbose && cat(verbose, "Path: ", path) pathnameS <- pathname <- file.path(path, filename) # WORKAROUND: On Windows, file.symlink() does not translate forward # slashes for you! Fixed (PR#15631) in r64711 2014-01-09. if (.Platform$OS.type == "windows") { pathnameS <- gsub("/", "\\", pathname, fixed=TRUE) } # Create a target file cat("Hello", file=pathname) # Create a symbolic link pathnameL <- file.path(path, sprintf("link-to-%s", filename)) file.symlink(pathnameS, pathnameL) stopifnot(isFile(pathnameL)) stopifnot(identical(lastModified(pathnameL), lastModified(pathname))) # Get target pathname pathnameT <- Sys.readlink2(pathnameL) # Should be equal stopifnot(getAbsolutePath(pathnameT) == getAbsolutePath(pathname)) # Read contents (directly and via link) bfr <- readChar(pathname, n=1e6) bfrL <- readChar(pathnameL, n=1e6) # Should be identical content stopifnot(identical(bfrL, bfr)) # Append content (via link) cat(" world!", file=pathnameL, append=TRUE) # Read contents (directly and via link) bfr <- readChar(pathname, n=1e6) printf("Target content: '%s'\n", bfr) bfrL <- readChar(pathnameL, n=1e6) printf("Link content : '%s'\n", bfrL) # Should be identical content stopifnot(identical(bfrL, bfr)) # Retrieve file information (directly and via link) fi <- file.info(pathname) printf("*** file.info('%s'):\n", pathname) print(fi) fiL <- file.info2(pathnameL) printf("*** file.info2('%s'):\n", pathnameL) print(fiL) # Should be equal file information except the filenames stopifnot(all.equal(fiL, fi, check.attributes=FALSE)) stopifnot(identical(lastModified(pathnameL), lastModified(pathname))) # Note that file.info() does not follow links on Windows if (.Platform$OS.type == "windows") { fiLx <- file.info(pathnameL) printf("*** file.info('%s'):\n", pathnameL) print(fiLx) res <- all.equal(fiLx, fi, check.attributes=FALSE) } # Renaming verbose && enter(verbose, "Renaming file link") pathnameL2 <- sprintf("%s-new", pathnameL) renameFile(pathnameL, pathnameL2) stopifnot(isFile(pathnameL2)) stopifnot(!isFile(pathnameL)) renameFile(pathnameL2, pathnameL) stopifnot(isFile(pathnameL)) stopifnot(!isFile(pathnameL2)) verbose && exit(verbose) # File access verbose && enter(verbose, "Testing file permissions & access information") fa <- fileAccessT(pathname) faL <- fileAccessT(pathnameL) stopifnot(identical(faL, fa)) # Disable write permission on target Sys.chmod(pathname, mode="0077") fa <- fileAccessT(pathname) faL <- fileAccessT(pathnameL) stopifnot(identical(faL, fa)) # Reset Sys.chmod(pathname, mode="0777") verbose && exit(verbose) # Removing & cleanup verbose && enter(verbose, "Cleanup") verbose && enter(verbose, "Removing file link") verbose && cat(verbose, "Link: ", pathnameL) verbose && cat(verbose, "Target: ", pathname) file.remove(pathnameL) # unlink() cannot remove symbolic links stopifnot(!file.exists(pathnameL)) stopifnot(isFile(pathname)) verbose && exit(verbose) verbose && enter(verbose, "Removing target") file.remove(pathname) stopifnot(!file.exists(pathname)) verbose && exit(verbose) verbose && exit(verbose) verbose && exit(verbose) } # for (path in ...) } # if (canSymlink) ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/ProgressBar.R�������������������������������������������������������������������������0000644�0001762�0000144�00000001150�14372747611�015341� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # A progress bar with default step length one. pb <- ProgressBar(max=42) reset(pb) while (!isDone(pb)) { x <- rnorm(3e4) increase(pb) # Emulate a slow process if (interactive()) Sys.sleep(0.02) } cat("\n") # A "faster" progress bar with default step length 1.4. pb <- ProgressBar(max=42, stepLength=1.4) reset(pb) while (!isDone(pb)) { x <- rnorm(3e4) increase(pb) # Emulate a slow process if (interactive()) Sys.sleep(0.02) } cat("\n") ## Odds and ends print(pb) print(setStepLength(pb, 1L)) print(setMaxValue(pb, 100L)) print(setProgress(pb, 0.3)) print(setTicks(pb, 10L)) ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/capitalize.R��������������������������������������������������������������������������0000644�0001762�0000144�00000002022�14372747611�015234� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") words <- strsplit("Hello wOrld", " ")[[1]] cat(paste(toupper(words), collapse=" "), "\n") # "HELLO WORLD" cat(paste(tolower(words), collapse=" "), "\n") # "hello world" cat(paste(capitalize(words), collapse=" "), "\n") # "Hello WOrld" cat(paste(decapitalize(words), collapse=" "), "\n") # "hello wOrld" # Sanity checks stopifnot(paste(toupper(words), collapse=" ") == "HELLO WORLD") stopifnot(paste(tolower(words), collapse=" ") == "hello world") stopifnot(paste(capitalize(words), collapse=" ") == "Hello WOrld") stopifnot(paste(decapitalize(words), collapse=" ") == "hello wOrld") # Empty character vector s <- character(0L) stopifnot(identical(capitalize(s), s)) stopifnot(identical(decapitalize(s), s)) # Empty string s <- "" stopifnot(identical(capitalize(s), s)) stopifnot(identical(decapitalize(s), s)) s <- NA_character_ stopifnot(identical(capitalize(s), s)) stopifnot(identical(decapitalize(s), s)) s <- c(NA_character_, "Hello wOrld") y <- capitalize(s) print(y) y <- decapitalize(s) print(y) ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/resample.R����������������������������������������������������������������������������0000644�0001762�0000144�00000000235�14372747611�014723� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") x <- 1:5 y <- resample(x) print(y) stopifnot(length(y) == length(x)) x <- 5 y <- resample(x) print(y) stopifnot(length(y) == length(x)) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/dimNA.R�������������������������������������������������������������������������������0000644�0001762�0000144�00000000417�14372747611�014105� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") x <- 1:12 dimNA(x) <- c(2,NA_real_,3) stopifnot(dim(x) == as.integer(c(2,2,3))) dimNA(x) <- NULL stopifnot(is.null(dim(x))) ## Exception handling x <- 1:12 res <- try(dimNA(x) <- c(4,NA_real_,4), silent=TRUE) stopifnot(inherits(res, "try-error")) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/whichVector.R�������������������������������������������������������������������������0000644�0001762�0000144�00000001043�14372747611�015376� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # - - - - - - - - - - - - - - - - - - - - - - - - - - # Simulate two large named logical vectors, # one with missing values one without # - - - - - - - - - - - - - - - - - - - - - - - - - - N <- 1e5 # Vector #1 x <- sample(c(TRUE, FALSE), size=N, replace=TRUE) names(x) <- seq_along(x) # Vector #2 y <- x y[sample(N, size=0.1*N)] <- NA # Validate consistency stopifnot(identical(which(x), whichVector(x))) stopifnot(identical(which(y), whichVector(y))) # A matrix x <- t(x) stopifnot(identical(which(x), whichVector(x))) ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/GString.R�����������������������������������������������������������������������������0000644�0001762�0000144�00000007100�14372747611�014466� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # First example # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - who <- "world" # Compare this... cat(as.character(GString("Hello ${who}\n"))) # ...to this. cat(GString("Hello ${who}\n")) # Escaping cat(as.character(GString("Hello \\\\${who}\n"))) # Printing print(GString("Hello ${who}\n")) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Looping over vectors # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x <- 1:5 y <- c("hello", "world") cat(as.character(GString("(x,y)=(${x},${y})")), sep=", ") cat("\n") cat(as.character(GString("(x,y)=(${x},$[capitalize]{y})")), sep=", ") cat("\n") cat(as.character(GString("(x,y)=(${x},$[toupper]{y})")), sep=", ") cat("\n") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Predefined ("builtin") variables # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - cat(as.character(GString("Hello ${username} on host ${hostname} running ", "R v${rversion} in process #${pid} on ${os}. R is installed in ${rhome}."))) # Other built-in variables/functions... cat(as.character(GString("Current date: ${date}\n"))) cat(as.character(GString("Current date: $[format='%d/%m/%y']{date}\n"))) cat(as.character(GString("Current time: ${time}\n"))) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Evaluating inline R code # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - cat(as.character(GString("Simple calculation: 1+1=${`1+1`}\n"))) cat(as.character(GString("Alternative current date: ${`date()`}\n"))) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Function values # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Call function rnorm with arguments n=1, i.e. rnorm(n=1) cat(as.character(GString("Random normal number: $[n=1]{rnorm}\n"))) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Global search-replace feature # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Replace all '-' with '.' cat(as.character(GString("Current date: ${date/-/.}\n"))) # Another example cat(as.character(GString("Escaped string: 12*12=${`12*12`/1/}\n"))) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Defining new "builtin" function values # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Define your own builtin variables (functions) setMethodS3("getBuiltinAletter", "GString", function(object, ...) { base::letters[runif(1, min=1, max=length(base::letters))] }) cat(as.character(GString("A letter: ${aletter}\n"))) cat(as.character(GString("Another letter: ${aletter}\n"))) # Another example setMethodS3("getBuiltinGstring", "GString", function(object, ...) { # Return another GString. GString("${date} ${time}") }) if (FALSE) { cat(as.character(GString("Advanced example: ${gstring}\n"))) # Advanced example setMethodS3("getBuiltinRunif", "GString", function(object, n=1, min=0, max=1, ...) { formatC(runif(n=n, min=min, max=max), ...) }) cat(as.character(GString("A random number: ${runif}\n"))) n <- 5 cat(as.character(GString("${n} random numbers: "))) cat(as.character(GString("$[n=n, format='f']{runif}"))) cat("\n") # Advanced options. # Options are parsed as if they are elements in a list, e.g. # list(n=runif(n=1,min=1,max=5), format='f') cat(as.character(GString("$Random number of numbers: "))) cat(as.character(GString("$[n=runif(n=1,min=1,max=5), format='f']{runif}"))) cat("\n") } # if (FALSE) ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/compressFile.R������������������������������������������������������������������������0000644�0001762�0000144�00000002765�14372747611�015560� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - # bzip2 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - cat(file="foo.txt", "Hello world!") print(isBzipped("foo.txt")) print(isBzipped("foo.txt.bz2")) bzip2("foo.txt") print(file.info("foo.txt.bz2")) print(isBzipped("foo.txt")) print(isBzipped("foo.txt.bz2")) bunzip2("foo.txt.bz2") print(file.info("foo.txt")) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - # gzip # - - - - - - - - - - - - - - - - - - - - - - - - - - - - cat(file="foo.txt", "Hello world!") print(isGzipped("foo.txt")) print(isGzipped("foo.txt.gz")) gzip("foo.txt") print(file.info("foo.txt.gz")) print(isGzipped("foo.txt")) print(isGzipped("foo.txt.gz")) gunzip("foo.txt.gz") print(file.info("foo.txt")) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Skipping and overwriting # - - - - - - - - - - - - - - - - - - - - - - - - - - - - cat(file="foo.txt", "Hello world!") gzip("foo.txt", remove=FALSE) res <- try(gzip("foo.txt", remove=FALSE, skip=FALSE), silent=TRUE) stopifnot(inherits(res, "try-error")) gzip("foo.txt", remove=FALSE, overwrite=TRUE) gzip("foo.txt", remove=FALSE, skip=TRUE) res <- try(gzip("foo.txt", remove=FALSE, skip=FALSE), silent=TRUE) stopifnot(inherits(res, "try-error")) gunzip("foo.txt.gz", remove=FALSE, overwrite=TRUE) res <- try(gunzip("foo.txt.gz", remove=FALSE, skip=FALSE), silent=TRUE) stopifnot(inherits(res, "try-error")) gunzip("foo.txt.gz", overwrite=TRUE) ## Cleanup file.remove("foo.txt") �����������R.utils/tests/withSink.R����������������������������������������������������������������������������0000644�0001762�0000144�00000003361�14372747611�014716� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") mfile <- function(file, ...) { mprintf("\n%s:\n", file) mcat("-------------------------------------------------\n") mcat(readLines(pathname), sep="\n") mcat("-------------------------------------------------\n") } # mfile() # Display warnings as they occur oopts <- options(warn=1L) cons0 <- showConnections() # Divert standard output pathname <- tempfile(fileext=".output.txt") mprint(pathname) res <- withSink(file=pathname, { print(letters) NULL }) mfile(pathname) mprint(warnings()) # Divert standard error/messages pathname <- tempfile(fileext=".message.txt") mprint(pathname) res <- withSink(file=pathname, type="message", { mprint(letters) NULL }) mfile(pathname) mprint(warnings()) # Divert standard output (and make sure to close any other sinks opened) pathname <- tempfile(fileext=".output2.txt") mprint(pathname) res <- withSink(file=pathname, { print(letters) pathnameT <- tempfile(fileext=".output3.txt") sink(pathnameT, type="output") print(LETTERS) mstr(1:10) }, append=TRUE) mfile(pathname) mprint(warnings()) # Assert that all connections opened were closed cons1 <- showConnections() mprint(cons0) mprint(cons1) stopifnot(all.equal(cons1, cons0)) # Reset how warnings are displayed options(oopts) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Visibility # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - pathname <- tempfile(fileext=".output.txt") res <- withVisible({ withSink({ print(1); 1 }, file=pathname) }) str(res) stopifnot(all.equal(res$value, 1)) stopifnot(res$visible) x <- 0 res <- withVisible({ withSink({ print(1); x <- 1 }, file=pathname) }) str(res) stopifnot(all.equal(res$value, 1)) stopifnot(!res$visible) stopifnot(all.equal(x, 1)) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/MultiVerbose.R������������������������������������������������������������������������0000644�0001762�0000144�00000002263�14372747611�015536� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # Output to both standard output and to log file stdoutLog <- Verbose(threshold=-1) fileLog <- Verbose("foo.log", threshold=-1) verbose <- MultiVerbose(list(stdoutLog, fileLog), threshold=-1) header(verbose, "A verbose writer example", padding=0) enter(verbose, "Analysis A") for (kk in 1:10) { printf(verbose, "step %d\n", kk) if (kk == 2) { cat(verbose, "Turning ON automatic timestamps") timestampOn(verbose) } else if (kk == 4) { timestampOff(verbose) cat(verbose, "Turned OFF automatic timestamps") cat(verbose, "Turning OFF verbose messages for steps ", kk, "-6") off(verbose) } else if (kk == 6) { on(verbose) cat(verbose, "Turned ON verbose messages just before step ", kk+1) } if (kk %in% c(5,8)) { enter(verbose, "Sub analysis ", kk) for (jj in c("i", "ii", "iii")) { cat(verbose, "part ", jj) } exit(verbose) } } cat(verbose, "All steps completed!") exit(verbose) ruler(verbose) cat(verbose, "Demo of some other methods:") str(verbose, c(a=1, b=2, c=3)) print(verbose, c(a=1, b=2, c=3)) summary(verbose, c(a=1, b=2, c=3)) evaluate(verbose, rnorm, n=3, mean=2, sd=3) ruler(verbose) newline(verbose) ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/Java.R��������������������������������������������������������������������������������0000644�0001762�0000144�00000003632�14372747611�014000� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") pathname <- tempfile() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Writing # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Open the temporary file for writing out <- file(pathname, open="wb") b <- -128:127 Java$writeByte(out, b) s <- -32768:32767 Java$writeShort(out, s) i <- c(-2147483648, -2147483647, -1, 0, +1, 2147483646, 2147483647) Java$writeInt(out, i) str <- c("This R string was written (using the UTF-8 format) using", "the static methods of the Java class in the R.utils package.") str <- paste(str, collapse="\n") Java$writeUTF(out, str) close(out) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Reading # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - for (as.character in c(TRUE, FALSE)) { # Open the temporary file for reading inn <- file(pathname, open="rb") bfr <- Java$readByte(inn, n=length(b)) cat("Read ", length(bfr), " bytes.\n", sep="") if (!identical(bfr, b)) throw("Failed to read the same data that was written.") bfr <- Java$readShort(inn, n=length(s)) cat("Read ", length(bfr), " shorts.\n", sep="") if (!identical(bfr, s)) throw("Failed to read the same data that was written.") bfr <- Java$readInt(inn, n=length(i)) cat("Read ", length(bfr), " ints.\n", sep="") if (!identical(bfr, i)) throw("Failed to read the same data that was written.") bfr <- Java$readUTF(inn, as.character=TRUE) if (is.character(bfr)) { cat("Read ", nchar(bfr), " UTF characters:\n", "'", bfr, "'\n", sep="") } else { cat("Read ", length(bfr), " UTF character bytes:\n", "'", hpaste(bfr), "'\n", sep="") } # Trying to read more when there isn't anything else available bfr <- Java$readUTF(inn, as.character=FALSE) cat("Read ", length(bfr), " UTF character bytes:\n", "'", hpaste(bfr), "'\n", sep="") close(inn) } # for (as.character ...) file.remove(pathname) ������������������������������������������������������������������������������������������������������R.utils/tests/mkdirs.R������������������������������������������������������������������������������0000644�0001762�0000144�00000004201�14372747611�014401� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") message("*** mkdirs() ...") message("*** mkdirs(..., recursive=TRUE) ...") pathT <- tempdir() mprint(pathT) stopifnot(isDirectory(pathT)) path <- file.path(pathT, "foo", "bar") mprint(path) mkdirs(path) stopifnot(isDirectory(path)) paths <- c(dirname(path), path) stopifnot(all(isDirectory(paths))) path <- dirname(path) removeDirectory(path, recursive=TRUE) stopifnot(!isDirectory(path)) message("*** mkdirs(..., recursive=TRUE) ... DONE") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # EXCEPTIONS # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - message("*** mkdirs(..., mustWork=TRUE) ...") path <- file.path(pathT, "foo") res <- mkdirs(path) stopifnot(isDirectory(path)) ## Create file with same name pathname <- file.path(path, "bar") cat("Hello", file=pathname) stopifnot(isFile(pathname)) res <- mkdirs(pathname) stopifnot(isFile(pathname), !isDirectory(pathname)) res <- try(mkdirs(pathname, mustWork=TRUE), silent=TRUE) cat(res) stopifnot(inherits(res, "try-error")) stopifnot(isFile(pathname), !isDirectory(pathname)) ## Parent is a file, not a directory path2 <- file.path(path, "bar", "yaa") res <- try(mkdirs(path2, mustWork=TRUE), silent=TRUE) cat(res) stopifnot(inherits(res, "try-error")) stopifnot(!isDirectory(path2)) removeDirectory(path, recursive=TRUE) stopifnot(!isDirectory(path)) message("*** mkdirs(..., mustWork=TRUE) ... DONE") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # SPECIAL: # Windows has a undocumented "feature" that for some set # ups on some machines (not all) it will for instance # silently drop a trailing period and create the directory # without it, e.g. 'G.S.' becomes 'G.S', cf.help("dir.create"). # See also https://bugs.r-project.org/bugzilla3/show_bug.cgi?id=15996 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - message("*** mkdirs('G.S.') ...") path <- file.path(pathT, "G.S.") mprint(path) mkdirs(path) tryCatch({ stopifnot(isDirectory(path)) removeDirectory(path) }, error = function(ex) { mprint(ex) }) message("*** mkdirs('G.S.') ... DONE") message("*** mkdirs() ... DONE") �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/getOption.R���������������������������������������������������������������������������0000644�0001762�0000144�00000001013�14372747611�015056� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������digits0 <- digits <- base::getOption("digits") print(digits) digits <- getOption("digits") print(digits) stopifnot(identical(digits, digits0)) digits <- R.utils::getOption("digits") print(digits) stopifnot(identical(digits, digits0)) library("R.utils") digits <- base::getOption("digits") print(digits) stopifnot(identical(digits, digits0)) digits <- getOption("digits") print(digits) stopifnot(identical(digits, digits0)) digits <- R.utils::getOption("digits") print(digits) stopifnot(identical(digits, digits0)) ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/getParent.R���������������������������������������������������������������������������0000644�0001762�0000144�00000000211�14372747611�015036� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") path <- "C:/Users/JohnDoe/" parent0 <- dirname(path) parent <- getParent(path) stopifnot(identical(parent, parent0)) ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/Options.R�����������������������������������������������������������������������������0000644�0001762�0000144�00000002352�14372747611�014550� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") local <- Options() print(local) str(local) print(names(local)) print(nbrOfOptions(local)) print(getLeaves(local)) # Query a missing option cex <- getOption(local, "graphics/cex") cat("graphics/cex =", cex, "\n") # Returns NULL # Query a missing option with default value cex <- getOption(local, "graphics/cex", defaultValue=1) cat("graphics/cex =", cex, "\n") # Returns NULL # Set option and get previous value oldCex <- setOption(local, "graphics/cex", 2) cat("previous graphics/cex =", oldCex, "\n") # Returns NULL # Set option again and get previous value oldCex <- setOption(local, "graphics/cex", 3) cat("previous graphics/cex =", oldCex, "\n") # Returns 2 # Query a missing option with default value, which is ignored cex <- getOption(local, "graphics/cex", defaultValue=1) cat("graphics/cex =", cex, "\n") # Returns 3 # Query multiple options with multiple default values multi <- getOption(local, c("graphics/cex", "graphics/pch"), c(1,2)) print(multi) # Check existance of multiple options has <- hasOption(local, c("graphics/cex", "graphics/pch")) print(has) # Get a subtree of options graphics <- getOption(local, "graphics") print(graphics) # Get the complete tree of options all <- getOption(local) print(all) ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/egsub.R�������������������������������������������������������������������������������0000644�0001762�0000144�00000001731�14372747611�014222� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # A symbol # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x <- 1L y <- 2L symb <- as.symbol("x") print(symb) expr <- egsub("x", "y", symb, value=FALSE) print(expr) expr2 <- egsub("x", "y", symb, value=TRUE) print(expr2) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Missing expression # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - expr <- expression(x[,1]) print(expr) expr2 <- egsub("foo", "bar", expr) print(expr2) stopifnot(identical(expr2, expr)) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # NULLs in expression # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # An expression containing a function definition for a # function without arguments. expr <- substitute(y <- function() 0) print(expr) # Don't replace anything expr2 <- egsub("x", "x", expr) print(expr2) stopifnot(identical(expr2, expr)) ���������������������������������������R.utils/tests/withCapture.R�������������������������������������������������������������������������0000644�0001762�0000144�00000005734�14372747611�015423� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") oopts <- options(prompt = "> ") print(withCapture({ n <- 3 n for (kk in 1:3) { printf("Iteration #%d\n", kk) } print(Sys.time()) type <- "horse" type })) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Assert correct capture of code and output # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - bfr <- withCapture({ x <- 1 x }, newline=TRUE) print(bfr) stopifnot(bfr == "> x <- 1\n> x\n[1] 1\n") bfr <- withCapture({ x <- 1 x }, code=TRUE, output=FALSE, newline=TRUE) print(bfr) stopifnot(bfr == "> x <- 1\n> x\n") bfr <- withCapture({ x <- 1 x }, code=FALSE, output=TRUE, newline=TRUE) print(bfr) stopifnot(bfr == "[1] 1\n") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Fixed substitutions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - bfr <- withCapture({ x <- a }, replace=list(a="abc")) print(bfr) stopifnot(bfr == '> x <- "abc"\n') res <- tryCatch({ withCapture({ x <- a }, substitute=list(a="abc")) }, error = identity) stopifnot(inherits(res, "error")) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # With automatic variable substitute # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - a <- 2 bfr <- withCapture({ x <- .a. x }, newline=TRUE) print(bfr) stopifnot(bfr == "> x <- 2\n> x\n[1] 2\n") # Make sure not to substitute parts of variable names # or expressions foo.bar.yaa <- function(x) x a <- 2 b.c <- 3 bfr <- withCapture({ res <- foo.bar.yaa(3.14) R.utils::use("R.utils") x <- .a. y <- .b.c. }) print(bfr) ## ODD: Different results when sourcing and R CMD check:ing ## this test script. /HB 2014-08-12 ## stopifnot(bfr ==""> res <- foo.bar.yaa(3.14)\n> R.utils::use(\"R.utils\")\n> x <- 2\n> y <- 3\n") # Make sure '...' is not substituted bfr <- withCapture({ benchmark <- function(fcn, n, len=100L, ...) { x <- lineBuffer(n, len=len, ...) foo(...) system.time({ fcn(cat(x)) }, gcFirst=TRUE)[[3]] } # benchmark() }) print(bfr) ## ODD: Different results when sourcing and R CMD check:ing ## this test script. /HB 2014-08-12 ## stopifnot(bfr == "> benchmark <- function(fcn, n, len = 100L, ...) {\n+ x <- lineBuffer(n, len = len, ...)\n+ foo(...)\n+ system.time({\n+ fcn(cat(x))\n+ }, gcFirst = TRUE)[[3]]\n+ }\n") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # BUG TEST: if-else statements # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - bfr <- withCapture(if (TRUE) 1 else 2) print(bfr) stopifnot(bfr == "> if (TRUE) 1 else 2\n[1] 1\n") bfr <- withCapture({if (TRUE) 1 else 2 }) print(bfr) ## ODD: Different results when sourcing and R CMD check:ing ## this test script. /HB 2014-08-12 ## stopifnot(bfr == "> if (TRUE) \n+ 1 else 2\n[1] 1\n") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Empty # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - bfr <- withCapture({}) print(bfr) stopifnot(length(bfr) == 0L) options(oopts) ������������������������������������R.utils/tests/nullfile.R����������������������������������������������������������������������������0000644�0001762�0000144�00000000045�14372747611�014724� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") print(nullfile()) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/loadToEnv.R���������������������������������������������������������������������������0000644�0001762�0000144�00000000220�14372747611�015000� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") file <- tempfile() x <- 1:10 save(x, file=file) env <- loadToEnv(file) print(env) print(ls(envir=env)) file.remove(file) ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/wrap.array.R��������������������������������������������������������������������������0000644�0001762�0000144�00000006372�14372747611�015211� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # A matrix # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - cat("\nWrap a matrix 'y' to a vector and back again:\n") x <- matrix(1:8, nrow=2, dimnames=list(letters[1:2], 1:4)) y <- wrap(x) z <- unwrap(y) print(z) stopifnot(identical(z,x)) # Drop dimensions, iff applicable z <- unwrap(y, drop=TRUE) print(z) # Argument 'split' can also be a list of functions split <- list(function(names, ...) strsplit(names, split="[.]", ...)) z2 <- unwrap(y, split=split) print(z2) stopifnot(identical(z2, z)) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # A matrix and a data frame # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x3 <- matrix(1:27, nrow=3L, ncol=9L) rownames(x3) <- LETTERS[1:3] colnames(x3) <- letters[1:9] x3b <- as.data.frame(x3, stringsAsFactors=FALSE) y3 <- wrap(x3) print(y3) y3b <- wrap(x3b) print(y3b) stopifnot(identical(y3b,y3)) z3 <- unwrap(y3) stopifnot(identical(z3,x3)) y3b <- as.data.frame(y3, stringsAsFactors=FALSE) z3b <- unwrap(y3b) stopifnot(identical(z3b,x3)) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # A 3x2x3 array # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - dim <- c(3,2,3) ndim <- length(dim) dimnames <- list() for (kk in 1:ndim) dimnames[[kk]] <- sprintf("%s%d", letters[kk], 1:dim[kk]) x <- 1:prod(dim) x <- array(x, dim=dim, dimnames=dimnames) cat("Array 'x':\n") print(x) cat("\nReshape 'x' to its identity:\n") y <- wrap(x, map=list(1, 2, 3)) print(y) # Assert correctness of reshaping stopifnot(identical(y, x)) cat("\nReshape 'x' by swapping dimensions 2 and 3, i.e. aperm(x, perm=c(1,3,2)):\n") y <- wrap(x, map=list(1, 3, 2)) print(y) # Assert correctness of reshaping stopifnot(identical(y, aperm(x, perm=c(1,3,2)))) cat("\nWrap 'x' to a matrix 'y' by keeping dimension 1 and joining the others:\n") y <- wrap(x, map=list(1, NA)) print(y) # Assert correctness of reshaping for (aa in dimnames(x)[[1]]) { for (bb in dimnames(x)[[2]]) { for (cc in dimnames(x)[[3]]) { tt <- paste(bb, cc, sep=".") stopifnot(identical(y[aa,tt], x[aa,bb,cc])) } } } cat("\nUnwrap matrix 'y' back to array 'x':\n") z <- unwrap(y) print(z) stopifnot(identical(z,x)) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # An array with a random number of dimensions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - cat("\nWrap and unwrap a randomly sized and shaped array 'x2':\n") maxdim <- 5 dim <- sample(1:maxdim, size=sample(2:maxdim, size=1)) ndim <- length(dim) dimnames <- list() for (kk in 1:ndim) dimnames[[kk]] <- sprintf("%s%d", letters[kk], 1:dim[kk]) x2 <- 1:prod(dim) x2 <- array(x, dim=dim, dimnames=dimnames) cat("\nArray 'x2':\n") print(x) # Number of dimensions of wrapped array ndim2 <- sample(1:(ndim-1), size=1) # Create a random map for joining dimensions splits <- NULL if (ndim > 2) splits <- sort(sample(2:(ndim-1), size=ndim2-1)) splits <- c(0, splits, ndim) map <- list() for (kk in 1:ndim2) map[[kk]] <- (splits[kk]+1):splits[kk+1] cat("\nRandom 'map':\n") print(map) cat("\nArray 'y2':\n") y2 <- wrap(x2, map=map) print(y2) cat("\nArray 'x2':\n") z2 <- unwrap(y2) print(z2) stopifnot(identical(z2,x2)) ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/mout.R��������������������������������������������������������������������������������0000644�0001762�0000144�00000002527�14372747611�014105� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") show <- methods::show # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # General tests # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x <- letters[1:8] x2 <- c(x[-1], "\n") x3 <- x2[-1] y <- as.list(x[1:3]) cat("mprint():\n") print(x) mprint(x) print(y) mprint(y) cat("mcat():\n") cat(x, "\n") mcat(x, "\n") cat(x2) mcat(x2) cat(x3, sep=",") mcat(x3, sep=",") cat(x3, sep="\n") mcat(x3, sep="\n") cat("mstr():\n") str(x) mstr(x) str(y) mstr(y) cat("mshow():\n") show(x) mshow(x) show(y) mshow(y) cat("mprintf():\n") printf("x=%d\n", 1:3) mprintf("x=%d\n", 1:3) cat("mout():\n") writeLines(x) mout(writeLines(x)) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Tests related to closure # - - - - - - - - - - - -- - - - - - - - - - - - - - - - - - mfoo <- function(a=1) { mprintf("a=%s\n", a) } mbar <- function(...) { mfoo(...) } a <- 2 mfoo(a) mfoo(3) mbar(a) mbar(3) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Assert that "console" messages can be captured/sunk # via stderr but not stdout # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - res <- captureOutput({ mcat("Hello") }) str(res) stopifnot(length(res) == 0L) withSink({ mcat("Hello") }, file="foo.txt", type="message") res <- readLines("foo.txt") str(res) stopifnot(length(res) > 0L) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/withRepos.R���������������������������������������������������������������������������0000644�0001762�0000144�00000004200�14372747611�015073� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # Set new default repositories for this test orepos <- options(repos=c( CRAN="http://cran.r-project.org", EXAMPLE="http://example.org" )) message("Current repositories:") str(as.list(getOption("repos"))) message("All current repositories:") withRepos({ str(as.list(getOption("repos"))) }) message("All current repositories (explicit):") withRepos({ str(as.list(getOption("repos"))) }, repos="[[current]]") message("CRAN (only):") withRepos({ str(as.list(getOption("repos"))) }, repos="CRAN") message("braju.com (only):") withRepos({ str(as.list(getOption("repos"))) }, repos="braju.com") message("CRAN and braju.com (only):") withRepos({ str(as.list(getOption("repos"))) }, repos=c("CRAN", "braju.com")) message("braju.com and CRAN (only):") withRepos({ str(as.list(getOption("repos"))) }, repos=c("braju.com", "CRAN")) message("All CRAN replated repositories (only):") withRepos({ str(as.list(getOption("repos"))) }, repos="[[CRAN]]") message("Mainstream (CRAN and BioC related) repositories (only):") withRepos({ str(as.list(getOption("repos"))) }, repos="[[mainstream]]") message("braju.com and mainstream (only):") withRepos({ str(as.list(getOption("repos"))) }, repos="[[braju.com]]") message("R-Forge and mainstream (only):") withRepos({ str(as.list(getOption("repos"))) }, repos="[[R-Forge]]") message("An explicit repository URL:") withRepos({ str(as.list(getOption("repos"))) }, repos="http://r-forge.r-project.org") message("An explicit repository URL + mainstream:") withRepos({ str(as.list(getOption("repos"))) }, repos=c("http://r-forge.r-project.org", "[[mainstream]]")) message("All known:") withRepos({ str(as.list(getOption("repos"))) }, repos="[[all]]") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Visibility # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - res <- withVisible({ withRepos({ 1 }) }) str(res) stopifnot(all.equal(res$value, 1)) stopifnot(res$visible) x <- 0 res <- withVisible({ withRepos({ x <- 1 }) }) str(res) stopifnot(all.equal(res$value, 1)) stopifnot(!res$visible) stopifnot(all.equal(x, 1)) # Undo options(orepos) ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/sourceTo.R����������������������������������������������������������������������������0000644�0001762�0000144�00000003162�14372747611�014720� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") opager <- options(pager=mpager) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Example 1 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - cat("=== Example 1 ================================================\n") foo <- function(file, ...) { cat("Local objects before calling sourceTo():\n") print(ls()) res <- sourceTo(file, ...) cat("Local objects after calling sourceTo():\n") print(ls()) } cat("Global objects before calling foo():\n") lsBefore <- NA lsBefore <- ls() foo(file=textConnection(c('a <- 1', 'b <- 2'))) cat("Global objects after calling foo():\n") stopifnot(length(setdiff(ls(), lsBefore)) == 0) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Example 2 - with VComments preprocessor # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - cat("=== Example 2 ================================================\n") preprocessor <- function(lines, ...) { cat("-----------------------------------------\n") cat("Source code before preprocessing:\n") displayCode(code=lines) cat("-----------------------------------------\n") cat("Source code after preprocessing:\n") lines <- VComments$compile(lines) displayCode(code=lines) cat("-----------------------------------------\n") lines } oldHooks <- getHook("sourceTo/onPreprocess") setHook("sourceTo/onPreprocess", preprocessor, action="replace") code <- c( 'x <- 2', '#V1# threshold=-1', '#Vc# A v-comment log message', 'print("Hello world")' ) fh <- textConnection(code) sourceTo(fh) setHook("sourceTo/onPreprocess", oldHooks, action="replace") options(opager) ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/readWindowsShortcut.R�����������������������������������������������������������������0000644�0001762�0000144�00000000563�14372747611�017141� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") pathname <- system.file("data-ex/HISTORY.LNK", package="R.utils") lnk <- readWindowsShortcut(pathname, verbose=TRUE) # Print all information print(lnk) # Get the relative path to the target file history <- file.path(dirname(pathname), lnk$relativePath) # Alternatively, everything in one call history <- filePath(pathname, expandLinks="relative") ���������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/readBinFragments.R��������������������������������������������������������������������0000644�0001762�0000144�00000007170�14372747611�016333� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") if ("covr" %in% loadedNamespaces()) options("R.utils::onNonSeekable"="warning") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Create a data file # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - data <- 1:255 size <- 2 pathname <- tempfile("exampleReadBinFragments") writeBin(con=pathname, data, size=size) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Read and write using index vectors # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - cat("Read file...\n") # Read every 16:th byte in the file idxs <- seq(from=1, to=255, by=16) x <- readBinFragments(pathname, what="integer", size=size, signed=FALSE, idxs=idxs) stopifnot(identical(x, data[idxs])) print(x) # Read every 16:th byte in a connection starting with the 6th. idxs <- idxs + 5L x <- readBinFragments(pathname, what="integer", size=size, signed=FALSE, idxs=idxs) stopifnot(identical(x, data[idxs])) print(x) cat("Read file...done\n") cat("Write file...\n") # Update every 16:th byte in the file idxs <- seq(from=1, to=255, by=16) x0 <- data[idxs] writeBinFragments(pathname, idxs=idxs, rev(x0), size=size) x <- readBinFragments(pathname, what="integer", size=size, signed=FALSE, idxs=idxs) print(x) stopifnot(identical(rev(x0), x)) # Update every 16:th byte in the file idxs <- seq(from=1, to=255, by=16) writeBinFragments(pathname, idxs=idxs, rev(x), size=size) x <- readBinFragments(pathname, what="integer", size=size, signed=FALSE, idxs=idxs) print(x) stopifnot(identical(x0, x)) # Assert everything is as expected # Read the complete file x <- readBin(pathname, what="integer", size=size, signed=FALSE, n=length(data)) stopifnot(identical(x, data)) cat("Write file...done\n") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Ditto but via a connection # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - cat("Read connection...\n") # Read every 16:th byte in a connection con <- file(pathname, open="rb") idxs <- seq(from=1, to=255, by=16) x <- readBinFragments(con, what="integer", size=size, signed=FALSE, idxs=idxs) stopifnot(identical(x, data[idxs])) print(x) # Read every 16:th byte in a connection starting with the 6th. idxs <- idxs + 5L x <- readBinFragments(con, what="integer", size=size, signed=FALSE, idxs=idxs, origin="start") stopifnot(identical(x, data[idxs])) print(x) close(con) cat("Read connection...done\n") # Update every 16:th byte in a connection cat("Write connection...\n") con <- file(pathname, open="r+b") idxs <- seq(from=1, to=255, by=16) x0 <- data[idxs] writeBinFragments(pathname, idxs=idxs, rev(x0), size=size) x <- readBinFragments(pathname, what="integer", size=size, signed=FALSE, idxs=idxs) print(x) stopifnot(identical(rev(x0), x)) # Update every 16:th byte in the file idxs <- seq(from=1, to=255, by=16) writeBinFragments(pathname, idxs=idxs, rev(x), size=size) x <- readBinFragments(pathname, what="integer", size=size, signed=FALSE, idxs=idxs, origin="start") print(x) stopifnot(identical(x0, x)) close(con) # Assert everything is as expected # Read the complete file x <- readBin(pathname, what=integer(), size=size, signed=FALSE, n=length(data)) stopifnot(identical(x, data)) cat("Write connection...done\n") # Read bytes 1-4, 11-14, 21-24, ... idxs <- seq(from=1, to=255, by=10) idxs <- cbind(idxs, idxs+3) x <- readBinFragments(pathname, what="integer", size=size, signed=FALSE, idxs=idxs, verbose=TRUE) idxsX <- intervalsToSeq(idxs) stopifnot(identical(x, data[idxsX])) print(x) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Clean up # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - file.remove(pathname) ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/zzz_finalizer_crash.R�����������������������������������������������������������������0000644�0001762�0000144�00000001421�14372747611�017171� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# This script crashes in ~40s on R 2.15.3 patched and R 3.0.2 with # R.oo (< 1.18.0). It only does so when 'methods' is attached. It # does not crash on R 3.0.2 patched (2014-02-21 r65057) and beyond. # It appears to not crash with 'R CMD check' on 2.15.3 but if run # via 'Rscript' or similar. /HB 2014-02-22 library("methods") library("R.methodsS3") loadNamespace("R.utils") # Remove all existing variables rm(list=ls(all.names=TRUE)) gc() R.oo::setConstructorS3("Verbose2", function(con=stderr(), ...) { R.oo::extend(R.oo::Object(), "Verbose", .con = con ) }) print(sessionInfo()) message(Sys.time()) local({ Verbose2(file()) gctorture(TRUE) unloadNamespace("R.utils") unloadNamespace("R.oo") NULL }) gctorture(FALSE) message(Sys.time()) print(sessionInfo()) �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/subplots.R����������������������������������������������������������������������������0000644�0001762�0000144�00000000647�14372747611�014775� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") local({ dev.new() on.exit(dev.off()) subplots(4) for (kk in 1:4) plot(kk, main=kk) }) local({ dev.new() on.exit(dev.off()) subplots(1:4) for (kk in 1:4) plot(kk, main=kk) }) local({ dev.new() on.exit(dev.off()) subplots(4, nrow=2) for (kk in 1:4) plot(kk, main=kk) }) local({ dev.new() on.exit(dev.off()) subplots(nrow=2, ncol=4) for (kk in 1:4) plot(kk, main=kk) }) �����������������������������������������������������������������������������������������R.utils/tests/findFiles.R���������������������������������������������������������������������������0000644�0001762�0000144�00000002211�14372747611�015012� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������message("Testing findFiles()...") library("R.utils") path <- system.file(".", package="R.utils") pathname <- findFiles(paths=path, firstOnly=TRUE) print(pathname) pathnames <- findFiles(paths=path, firstOnly=FALSE) str(pathnames) pathnames <- findFiles(paths=path, recursive=TRUE, firstOnly=FALSE) str(pathnames) pathnames <- findFiles(pattern="[.]rds$", paths=path, recursive=TRUE, firstOnly=FALSE) str(pathnames) ## Recursive searching pathnames0 <- findFiles(paths=path, recursive=FALSE, firstOnly=FALSE) str(pathnames) pathnames <- findFiles(paths=path, recursive=0L, firstOnly=FALSE) str(pathnames) stopifnot(identical(pathnames, pathnames0)) pathnamesInf <- findFiles(paths=path, recursive=TRUE, firstOnly=FALSE) str(pathnamesInf) stopifnot(length(pathnamesInf) >= length(pathnames0)) pathnames <- findFiles(paths=path, recursive=+Inf, firstOnly=FALSE) str(pathnames) stopifnot(identical(pathnames, pathnamesInf)) pathnames2 <- findFiles(paths=path, recursive=2L, firstOnly=FALSE) str(pathnames2) stopifnot(length(pathnames2) >= length(pathnames0)) stopifnot(length(pathnames2) <= length(pathnamesInf)) message("Testing findFiles()...DONE") ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/withLocale.R��������������������������������������������������������������������������0000644�0001762�0000144�00000003005�14372747611�015204� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Basic tests # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # The current set of locales old <- Sys.getlocale("LC_ALL") # Vector cat("Original vector:\n") x <- c(letters[1:8], LETTERS[1:8]) print(x) cat("Sorting with 'C' locale:\n") y1 <- withLocale(sort(x), "LC_COLLATE", "C") print(y1) cat("Sorting with an 'English' locale:\n") y2 <- withLocale(sort(x), "LC_COLLATE", c("en_US", "en_US.UTF8", "English_United States.1252")) print(y2) # Sanity check curr <- Sys.getlocale("LC_ALL") if (!identical(curr, old)) { throw("Locale settings have changed: ", old, " != ", curr) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Nested calls # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - cat("Sorting with 'C' locale (nested inside a English one):\n") y3 <- withLocale({ withLocale({ sort(x) }, "LC_COLLATE", "C") }, "LC_COLLATE", c("en_US", "en_US.UTF8", "English_United States.1252")) print(y3) stopifnot(identical(y3, y1)) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Visibility # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - res <- withVisible({ withLocale({ 1 }, "LC_COLLATE", "C") }) str(res) stopifnot(all.equal(res$value, 1)) stopifnot(res$visible) x <- 0 res <- withVisible({ withLocale({ x <- 1 }, "LC_COLLATE", "C") }) str(res) stopifnot(all.equal(res$value, 1)) stopifnot(!res$visible) stopifnot(all.equal(x, 1)) ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/tempvar.R�����������������������������������������������������������������������������0000644�0001762�0000144�00000000421�14372747611�014566� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # Get a temporary variable name <- tempvar() print(name) # Get and assign a temporary variable name <- tempvar(value=base::letters) print(name) str(get(name)) # Get a temporary variable with custom prefix name <- tempvar(prefix=".hidden") print(name) �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/callHooks.R���������������������������������������������������������������������������0000644�0001762�0000144�00000003242�14372747611�015033� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Example 1 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # First, clean up if called more than once setHook("myFunction.onEnter", NULL, action="replace") setHook("myFunction.onExit", NULL, action="replace") runConference <- function(...) { callHooks("myFunction.onEnter") cat("Speaker A: Hello there...\n") callHooks("myFunction.onExit") } setHook("myFunction.onEnter", function(...) { cat("Chair: Welcome to our conference.\n") }) setHook("myFunction.onEnter", function(...) { cat("Chair: Please welcome Speaker A!\n") }) setHook("myFunction.onExit", function(...) { cat("Chair: Please thanks Speaker A!\n") }) runConference() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Example 2 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - setHook("randomNumber", NULL, action="replace") setHook("randomNumber", rnorm) # By function setHook("randomNumber", "rexp") # By name setHook("randomNumber", "runiff") # Non-existing name setHook("randomNumber", .GlobalEnv) # Not a function res <- callHooks("randomNumber", n=1, removeCalledHooks=TRUE) str(res) cat("Number of hooks: ", length(res), "\n") isErroneous <- unlist(lapply(res, FUN=function(x) !is.null(x$exception))) cat("Erroneous hooks: ", sum(isErroneous), "\n") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Exception handling # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - res <- try(callHooks(character(0L)), silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(callHooks(c("a", "b")), silent=TRUE) stopifnot(inherits(res, "try-error")) ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/absolute-relative-paths.R�������������������������������������������������������������0000644�0001762�0000144�00000004672�14525546077�017673� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") warnifnot <- egsub("stop", "warning", stopifnot, value=FALSE) message("Absolute and relative paths ...") message("- Absolute and relative path of getwd()") stopifnot(identical(getAbsolutePath("."), getwd())) stopifnot(identical(getRelativePath("."), ".")) message("- Tilde expansion") pathH0 <- normalizePath("~") print(pathH0) pathH <- normalizePath("~", winslash = "/") print(pathH) pathHA <- getAbsolutePath(pathH) print(pathHA) pathA <- getAbsolutePath("~", expandTilde=TRUE) print(pathA) warnifnot(identical(tolower(pathA), tolower(pathH))) pathR <- getRelativePath("~") print(pathR) warnifnot(identical(tolower(getAbsolutePath(pathR)), tolower(pathH))) pathR <- getRelativePath("~", caseSensitive=TRUE) print(pathR) message("- ~/../Documents") pathA <- getAbsolutePath("~/../Documents", expandTilde=TRUE) pathA0 <- file.path(getParent(pathH), "Documents") ## Account for the case when getParent(pathH) = "C:/", which in case ## we get C://Documents instead of C:/Documents pathA0 <- normalizePath(pathA0, winslash = "/") utils::str(list(pathA = pathA, pathA0 = pathA0)) stopifnot(pathA == pathA0) message("- /tmp/") pathA <- getAbsolutePath("/tmp/", expandTilde=TRUE) print(pathA) stopifnot(identical(pathA, "/tmp")) message("- Microsoft Windows UNC paths") stopifnot(identical(getAbsolutePath("//vinata/biomed"), "//vinata/biomed")) stopifnot(identical(getAbsolutePath("//vinata///biomed"), "//vinata/biomed")) message("- Vector of files") paths <- c(".", "..", getwd()) print(paths) pathsA <- getAbsolutePath(paths) print(pathsA) pathsR <- getRelativePath(paths) print(pathsR) pathsAR <- getRelativePath(pathsA) print(pathsAR) pathsRA <- getAbsolutePath(pathsR) print(pathsRA) # Sanity checks stopifnot(all(isAbsolutePath(pathsA))) stopifnot(all(!isAbsolutePath(pathsR))) stopifnot(all(pathsRA == pathsA)) stopifnot(all(pathsAR == pathsR)) message("- Paths relative to given directories") stopifnot(getRelativePath("foo", "foo") == ".") stopifnot(getRelativePath("foo/bar", "foo") == "bar") stopifnot(getRelativePath("foo/bar", "foo/bar/yah") == "..") stopifnot(getRelativePath("foo/bar/cool", "foo/bar/yah/sub/") == "../../cool") stopifnot(getRelativePath("/tmp/foo/", "/tmp/") == "foo") stopifnot(getRelativePath("/tmp/bar/", "/bar/foo/") == "../../tmp/bar") stopifnot(getRelativePath("C:/foo/bar/", "C:/bar/") == "../foo/bar") stopifnot(getRelativePath("C:/foo/bar/", "D:/bar/") == "C:/foo/bar") message("Absolute and relative paths ... DONE") ����������������������������������������������������������������������R.utils/tests/compressPDF.R�������������������������������������������������������������������������0000644�0001762�0000144�00000001105�14372747611�015275� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") oopts <- options(warn=1) message("*** compressPDF() ...") pathname <- file.path(R.home("doc"), "NEWS.pdf") if (file_test("-f", pathname)) { tryCatch({ pathnameZ <- compressPDF(pathname) print(pathnameZ) pathnameZ <- compressPDF(pathname, skip=TRUE) print(pathnameZ) pathnameZ <- compressPDF(pathname, overwrite=TRUE) print(pathnameZ) file.remove(pathnameZ) removeDirectory(dirname(pathnameZ)) }, error = function(ex) { warning("TEST ERROR: ", ex$message) }) } message("*** compressPDF() ...DONE") options(oopts) �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/NullVerbose.R�������������������������������������������������������������������������0000644�0001762�0000144�00000000225�14372747611�015352� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") verbose <- Verbose() cat(verbose, "A verbose messages") verbose <- NullVerbose() cat(verbose, "A verbose messages") # Ignored ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/useRepos.R����������������������������������������������������������������������������0000644�0001762�0000144�00000000337�14372747611�014723� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # Get current 'repos' option orepos <- useRepos() print(orepos) useRepos("http://cran.r-project.org") repos <- useRepos() print(repos) # Reset 'repos' useRepos(orepos) repos <- useRepos() print(repos) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/readWindowsShellLink.R����������������������������������������������������������������0000644�0001762�0000144�00000000322�14372747611�017204� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") pathname <- system.file("data-ex/HISTORY.LNK", package="R.utils") lnk <- readWindowsShellLink(pathname) str(lnk) str(lnk$pathname) lnk0 <- readWindowsShortcut(pathname) str(lnk0$pathname) ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/fileAccess.R��������������������������������������������������������������������������0000644�0001762�0000144�00000004207�14372747611�015157� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Current directory # - - - - - - - - - - - - - - - - - - - - - - - - - - - - path <- "." # Test for existence print(fileAccess(path, mode=0)) # Test for execute permission print(fileAccess(path, mode=1)) # Test for write permission print(fileAccess(path, mode=2)) # Test for read permission print(fileAccess(path, mode=4)) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - # A temporary file # - - - - - - - - - - - - - - - - - - - - - - - - - - - - pathname <- tempfile() cat(file=pathname, "Hello world!") # Test for existence print(fileAccess(pathname, mode=0)) # Test for execute permission print(fileAccess(pathname, mode=1)) # Test for write permission print(fileAccess(pathname, mode=2)) # Test for read permission print(fileAccess(pathname, mode=4)) file.remove(pathname) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - # The 'base' package directory # - - - - - - - - - - - - - - - - - - - - - - - - - - - - path <- system.file(package="base") # Test for existence print(fileAccess(path, mode=0)) # Test for execute permission print(fileAccess(path, mode=1)) # Test for write permission print(fileAccess(path, mode=2)) # Test for read permission print(fileAccess(path, mode=4)) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - # The 'base' package DESCRIPTION file # - - - - - - - - - - - - - - - - - - - - - - - - - - - - pathname <- system.file("DESCRIPTION", package="base") # Test for existence print(fileAccess(pathname, mode=0)) # Test for execute permission print(fileAccess(pathname, mode=1)) # Test for write permission print(fileAccess(pathname, mode=2)) # Test for read permission print(fileAccess(pathname, mode=4)) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Assert that RNG state does not change (mode = 2) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Make sure .Random.seed exists dummy <- sample(1:10) rng0 <- get(".Random.seed", envir = .GlobalEnv, inherits = FALSE) res <- fileAccess(tempdir(), mode=2) rng1 <- get(".Random.seed", envir = .GlobalEnv, inherits = FALSE) stopifnot(identical(rng1, rng0)) �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/withSeed.R����������������������������������������������������������������������������0000644�0001762�0000144�00000002130�14372747611�014663� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # Reset seed if (exists(".Random.seed", envir=globalenv())) { rm(list=".Random.seed", envir=globalenv()) } # Generate a random number y0 <- runif(1) print(y0) # Generate a random number using the same seed over and over yp <- NULL for (ii in 1:10) { y <- withSeed({ runif(1) }, seed=0x42) print(y) # Assert identical if (!is.null(yp)) stopifnot(identical(y, yp)) yp <- y } # Generate a random number y <- runif(1) print(y) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Visibility # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - res <- withVisible({ withSeed({ 1 }, seed=42L) }) str(res) stopifnot(all.equal(res$value, 1)) stopifnot(res$visible) x <- 0 res <- withVisible({ withSeed({ x <- 1 }, seed=42L) }) str(res) stopifnot(all.equal(res$value, 1)) stopifnot(!res$visible) stopifnot(all.equal(x, 1)) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # With RNG state reset # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - res <- withSeed(sample.int(100L, size=1L), seed=NULL) ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/findSourceTraceback.R�����������������������������������������������������������������0000644�0001762�0000144�00000002036�14372747611�017015� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Create two R script files where one source():s the other # and both lists the traceback of filenames source():d. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - path <- tempdir() pathnameA <- Arguments$getWritablePathname("foo.R", path=path) pathnameB <- Arguments$getWritablePathname("bar.R", path=path) code <- 'cat("BEGIN foo.R\n")' code <- c(code, 'print(findSourceTraceback());') code <- c(code, sprintf('source("%s");', pathnameB)) code <- c(code, 'cat("END foo.R\n")') code <- paste(code, collapse="\n") cat(file=pathnameA, code) code <- 'cat("BEGIN bar.R\n")' code <- c(code, 'x <- findSourceTraceback();') code <- c(code, 'print(x);') code <- c(code, 'cat("END bar.R\n")') code <- paste(code, collapse="\n") cat(file=pathnameB, code) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Source the first file # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - source(pathnameA, echo=TRUE) ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/countLines.R��������������������������������������������������������������������������0000644�0001762�0000144�00000005260�14372747611�015241� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") pathname <- tempfile() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Local functions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - writeString <- function(s, file) { raw <- charToRaw(s) writeBin(raw, con=file) if (is.character(file)) { # Sanity check stopifnot(file.info(file)$size == length(raw)) } } # writeString() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Empty file # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - cat("", file=pathname) # Sanity check stopifnot(file.info(pathname)$size == 0L) n <- countLines(pathname) stopifnot(n == 0L) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # File with one line # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # File: Ending with a new line writeString("Hello world!\n", file=pathname) n <- countLines(pathname) stopifnot(n == 1L) # File: Last line does not end with a new line writeString("Hello world!", file=pathname) n <- countLines(pathname) stopifnot(n == 1L) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Files with multiple lines # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - bfr <- letters[1:9] # File: All lines ending with a new line writeString(paste(c(bfr, ""), collapse="\n"), file=pathname) n <- countLines(pathname) stopifnot(n == length(bfr)) # File: Last line does not end with a new line writeString(paste(bfr, collapse="\n"), file=pathname) n <- countLines(pathname) stopifnot(n == length(bfr)) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Counting either CR, LF, or CRLF # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - for (newline in c("\r", "\n", "\r\n")) { cat("Newline sequence:\n") str(newline) writeString(paste(bfr, collapse=newline), file=pathname) # Reading from file n <- countLines(pathname) stopifnot(n == length(bfr)) # Reading from connection con <- file(pathname, open="rb") n <- countLines(con) close(con) stopifnot(n == length(bfr)) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Compressed files # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - pathnameGZ <- sprintf("%s.gz", pathname) for (newline in c("\r", "\n", "\r\n")) { cat("Newline sequence:\n") str(newline) con <- gzfile(pathnameGZ, open="wb") writeString(paste(bfr, collapse=newline), file=con) close(con) # Reading from file n <- countLines(pathnameGZ) stopifnot(n == length(bfr)) print(n) # Reading from connection con <- gzfile(pathname, open="rb") n <- countLines(con) close(con) print(n) stopifnot(n == length(bfr)) } # Cleanup file.remove(pathnameGZ) file.remove(pathname) ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/intToHex.R����������������������������������������������������������������������������0000644�0001762�0000144�00000003057�14372747611�014662� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") x <- c(7, 8, 15, 16) print(x) y <- intToHex(x) y_truth <- c("07", "08", "0f", "10") print(y) stopifnot(is.character(y), all(!is.na(y)), identical(y, y_truth)) y <- intToOct(x) y_truth <- c("07", "10", "17", "20") print(y) stopifnot(is.character(y), all(!is.na(y)), identical(y, y_truth)) y <- intToBin(x) y_truth <- c("00111", "01000", "01111", "10000") print(y) stopifnot(is.character(y), all(!is.na(y)), identical(y, y_truth)) x <- -3:3 print(x) y <- intToHex(x) y_truth <- c("fffffffd", "fffffffe", "ffffffff", "00000000", "00000001", "00000002", "00000003") print(y) stopifnot(is.character(y), all(!is.na(y)), identical(y, y_truth)) y <- intToOct(x) y_truth <- c("37777777775", "37777777776", "37777777777", "00000000000", "00000000001", "00000000002", "00000000003") print(y) stopifnot(is.character(y), all(!is.na(y)), identical(y, y_truth)) y <- intToBin(x) y_truth <- c("1111111111111111111111111111101", "1111111111111111111111111111110", "1111111111111111111111111111111", "0000000000000000000000000000000", "0000000000000000000000000000001", "0000000000000000000000000000010", "0000000000000000000000000000011") print(y) stopifnot(is.character(y), all(!is.na(y)), identical(y, y_truth)) ## Integer out of range x <- 2^31 y <- intToBin(x) print(y) stopifnot(is.character(y), is.na(y)) y <- intToHex(x) print(y) stopifnot(is.character(y), is.na(y)) y <- intToOct(x) print(y) stopifnot(is.character(y), is.na(y)) ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/listDirectory.R�����������������������������������������������������������������������0000644�0001762�0000144�00000001004�14372747611�015746� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") path <- system.file(package="R.utils") print(listDirectory(path)) print(listDirectory(path, pattern="DESCRIPTION")) print(listDirectory(path, recursive=TRUE)) print(listDirectory(path, recursive=+Inf)) print(listDirectory(path, recursive=FALSE)) print(listDirectory(path, recursive=0L)) print(listDirectory(path, recursive=1L)) print(listDirectory(path, recursive=2L)) ## Full names print(listDirectory(path, recursive=2L, fullNames=TRUE)) ## Non-existing print(listDirectory("unknown-path")) ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/VComments.R���������������������������������������������������������������������������0000644�0001762�0000144�00000000510�14372747611�015022� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") opager <- options(pager=mpager) filename <- system.file("data-ex/exampleVComments.R", package="R.utils") lines <- readLines(filename) cat("Code before preprocessing:\n") displayCode(code=lines) lines <- VComments$compile(lines) cat("Code after preprocessing:\n") displayCode(code=lines) options(opager) ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/env.R���������������������������������������������������������������������������������0000644�0001762�0000144�00000000444�14372747611�013705� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") x <- list() x$case1 <- env({ # Cut'n'pasted from elsewhere a <- 1 b <- 2 }) x$case2 <- env({ # Cut'n'pasted from elsewhere foo <- function(x) x^2 a <- foo(2) b <- 1 rm(foo) # Not needed anymore }) # Turn into a list of lists x <- lapply(x, FUN=as.list) str(x) ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/createLink.R��������������������������������������������������������������������������0000644�0001762�0000144�00000003073�14372747611�015177� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") verbose <- Verbose(threshold=-1) options(warn = 1L) pathname <- tempfile("foo_", fileext = ".txt") pathname <- getAbsolutePath(pathname) cat(file=pathname, "Hello world!\n") ## NOTE: Not all systems support creation of links, which is ## why we need to run the tests using tryCatch(). ## Try all methods at once link <- basename(pathname) tryCatch({ linkR <- createLink(link=link, target=pathname) verbose && cat(verbose, "Link returned: ", linkR) linkR <- normalizePath(linkR) link <- normalizePath(link) if (linkR != link) { throw("Requested and returned link are not the same: ", sQuote(linkR), " != ", sQuote(link)) } }, error = function(ex) { verbose && cat(verbose, "Failed to create link: ", ex$message) }) ## One method at the time methods <- c("unix-symlink", "windows-ntfs-symlink", "windows-shortcut") for (method in methods) { verbose && enterf(verbose, "Method '%s'", method) verbose && cat(verbose, "Target: ", pathname) link <- sprintf("%s-to-%s", method, basename(pathname)) verbose && cat(verbose, "Link to create: ", link) tryCatch({ linkR <- createLink(link=link, target=pathname, method=method) verbose && cat(verbose, "Link returned: ", linkR) linkR <- normalizePath(linkR) link <- normalizePath(link) if (linkR != link) { throw("Requested and returned link are not the same: ", sQuote(linkR), " != ", sQuote(link)) } }, error = function(ex) { verbose && cat(verbose, "Failed to create link: ", ex$message) }) verbose && exit(verbose) } if (isFile(pathname)) file.remove(pathname) ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/writeDataFrame.R����������������������������������������������������������������������0000644�0001762�0000144�00000001335�14372747611�016014� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # A data frame set.seed(42) n <- 5L data <- data.frame( index = 1:n, symbol = letters[1:n], x = runif(n), y = rnorm(n), stringsAsFactors=FALSE ) # Write to tab-delimited file (using a connection) pathname <- tempfile(fileext=".tsv") con <- file(pathname, open="w") writeDataFrame(data, file=con, createdBy="R.utils") close(con) # Append another set of rows writeDataFrame(data, file=pathname, append=TRUE) # There should only be one header and one set of column names print(readLines(pathname)) # Overwrite using a connection con <- file(pathname, open="w") writeDataFrame(data, file=con, overwrite=TRUE) close(con) # Overwrite using a filename writeDataFrame(data, file=pathname, overwrite=TRUE) ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/eget.R��������������������������������������������������������������������������������0000644�0001762�0000144�00000001046�14372747611�014040� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # Get variable 'a' if it exists, otherwise return the default value. value <- eget("a", default=42L) print(value) # 42L # Short version doing the same value <- eget(a=42L) print(value) # 42L # Same, but look for the variable in 'envir' (here a list) value <- eget("a", default=42L, envir=list(a=1)) print(value) # 1L # Get variable 'n', which defaults to command-line argument # 'n' ('-n' or '--n'), which in turn defaults to 42L. value <- eget(n=cmdArg(n=42L)) print(value) # Equivalently. value <- ecget(n=42L) print(value) ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/isUrl.R�������������������������������������������������������������������������������0000644�0001762�0000144�00000000644�14372747611�014215� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") urls <- c( "http://www.r-project.org/", "ftp://cran.r-project.org/", "htttp://www.r-project.org/", ## typo, but still a URL "", ## empty NA_character_ ## missing ) print(urls) res <- sapply(urls, FUN=isUrl) print(res) res <- isUrl(urls) print(res) stopifnot(is.logical(res)) stopifnot(length(res) == length(urls)) stopifnot(!any(is.na(res))) ��������������������������������������������������������������������������������������������R.utils/tests/System.R������������������������������������������������������������������������������0000644�0001762�0000144�00000000157�14372747611�014402� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") print(System$getHostname()) print(System$getUsername()) print(System$currentTimeMillis()) �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/TextStatusBar.R�����������������������������������������������������������������������0000644�0001762�0000144�00000002721�14372747611�015672� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Read all HTML files in the base package # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - path <- system.file(package="base") files <- list.files(path, recursive=TRUE, full.names=TRUE) files <- files[sapply(files, FUN=isFile)] nfiles <- length(files) cat(sprintf("Reading %d files in %s:\n", nfiles, path)) # Create a status bar with four labels sb <- TextStatusBar("File: %-*s [%3.0f%% %7.0f bytes %-8s]", hfill=1, file="", progress=0, nbytes=0L, time="") nbytes <- 0L for (kk in seq_len(nfiles)) { file <- files[kk] # Update the status bar if (sb) { setLabel(sb, "progress", 100*kk/nfiles) if (kk %% 10 == 1 || kk == nfiles) setLabel(sb, "file", substr(basename(file), 1, 44)) size <- file.info(file)$size # popMessage() calls update() too popMessage(sb, sprintf("Processing %s (%.2fkB)", basename(file), size/1024)) flush(sb) } # Read the file bfr <- readBin(file, what="raw", n=size) nbytes <- nbytes + size # Emulate a slow process if (interactive()) Sys.sleep(rexp(1, rate=60)) # Update the status bar if (sb) { setLabel(sb, "nbytes", nbytes) setLabel(sb, "time", format(Sys.time(), "%H:%M:%S")) update(sb) } } setLabel(sb, "file", "<done>") update(sb) cat("\n") ## Odds and ends print(getLabel(sb, "progress")) print(newline(sb)) updateLabels(sb) �����������������������������������������������R.utils/tests/commandArgs.R�������������������������������������������������������������������������0000644�0001762�0000144�00000005354�14372747611�015355� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") ###################################################################### # How R was invoked ###################################################################### cmd <- paste(commandArgs(), collapse=" ") cat("How R was invoked:\n") cat(cmd, "\n") # Get all arguments args <- commandArgs() print(args) # Get only "private" arguments and not the name of the R executable. args <- commandArgs(excludeReserved=TRUE)[-1] print(args) # Assert backward compatibility args0 <- base::commandArgs() args <- commandArgs() stopifnot(all.equal(args, args0)) ###################################################################### # Parsed command-line arguments ###################################################################### # Call #1: argsC <- c("R", "--encoding=ASCII", "--encoding", "ASCII", "DATAPATH=../data", "--args", "--root=do da", "--foo", "bar", "--details", "--a=2", "--src_file=foo.R") print(argsC) # Truth: args0 <- list("R", encoding="ASCII", encoding="ASCII", DATAPATH="../data", args=TRUE, root="do da", foo="bar", details=TRUE, a="2", "src_file"="foo.R") args <- commandArgs(asValues=TRUE, .args=argsC) str(args) stopifnot(all.equal(args, args0)) # Exclude reserved args <- commandArgs(asValues=TRUE, excludeReserved=TRUE, excludeEnvVars=TRUE, .args=argsC)[-1L] stopifnot(all.equal(args, args0[-(1:5)])) # Call #2: argsC <- c("R", "noname1", "DATAPATH=../data", "--args", "--root=do da", "noname2", "--foo", "bar", "--details", "--a=2", "noname3", "noname4", "noname5", "--b=pi", "--c:=pi") print(argsC) # Truth: args0 <- list("R", "noname1", DATAPATH="../data", args=TRUE, root="do da", "noname2", foo="bar", details=TRUE, a="2", "noname3", "noname4", "noname5", b="pi", c=structure("pi", class="CmdArgExpression")) args <- commandArgs(asValues=TRUE, .args=argsC) str(args) stopifnot(all.equal(args, args0)) # Truth (when evaluating expression): args0 <- list("R", "noname1", DATAPATH="../data", args=TRUE, root="do da", "noname2", foo="bar", details=TRUE, a=2, "noname3", "noname4", "noname5", b="pi", c=pi) args <- commandArgs(asValues=TRUE, adhoc=TRUE, .args=argsC) str(args) stopifnot(all.equal(args, args0)) for (asValues in c(TRUE, FALSE)) { # Argument 'defaults' args <- commandArgs(asValues=asValues, .args=argsC, defaults=c(a=1L, d=4L)) str(args) # Argument 'always' args <- commandArgs(asValues=asValues, .args=argsC, always=c(c=4L)) str(args) # Argument 'unique' args <- commandArgs(asValues=asValues, .args=argsC, unique=TRUE) str(args) # Argument 'os' args <- commandArgs(asValues=asValues, os="current") str(args) # Unusual option: -name=value args <- commandArgs(asValues=asValues, .args="-foo=4") str(args) # Default args <- commandArgs(asValues=asValues) str(args) } # for (asValues ...) ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/isZero.R������������������������������������������������������������������������������0000644�0001762�0000144�00000001243�14372747611�014366� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") x <- 0 print(x == 0) # TRUE print(isZero(x)) # TRUE x <- 1 print(x == 0) # FALSE print(isZero(x)) # FALSE x <- .Machine$double.eps print(x == 0) # FALSE print(isZero(x)) # FALSE x <- 0.9*.Machine$double.eps print(x == 0) # FALSE print(isZero(x)) # TRUE # From help(Comparisions) x1 <- 0.5 - 0.3 x2 <- 0.3 - 0.1 print(x1 - x2) print(x1 == x2) # FALSE on most machines print(identical(all.equal(x1, x2), TRUE)) # TRUE everywhere print(isZero(x1-x2)) # TRUE everywhere # Specifying tolerance by name print(isZero(x1-x2, eps="double.eps")) print(isZero(x1-x2, eps="single.eps")) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/sourceDirectory.R���������������������������������������������������������������������0000644�0001762�0000144�00000002171�14372747611�016301� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") ## Create a test folder with R scripts path <- file.path(tempdir(), "R.utils") dir.create(path, recursive = TRUE, showWarnings = FALSE) pathname <- file.path(path, "increment_x.R") cat(file = pathname, "x <- x + 1L\n") x <- 0L source(pathname) message("x = ", x) stopifnot(x == 1L) source(pathname) message("x = ", x) stopifnot(x == 2L) for (kk in 1:2) { sourceTo(pathname, modifiedOnly = TRUE) message("x = ", x) stopifnot(x == 3L) } Sys.sleep(1) touchFile(pathname) for (kk in 1:2) { sourceTo(pathname, modifiedOnly = TRUE) message("x = ", x) stopifnot(x == 4L) } sourceTo(pathname, modifiedOnly = FALSE) message("x = ", x) stopifnot(x == 5L) for (kk in 1:2) { sourceDirectory(path, modifiedOnly = TRUE) message("x = ", x) stopifnot(x == 5L) } sourceDirectory(path, modifiedOnly = FALSE) message("x = ", x) stopifnot(x == 6L) sourceDirectory(path, modifiedOnly = TRUE) message("x = ", x) stopifnot(x == 6L) Sys.sleep(1) touchFile(pathname) for (kk in 1:2) { sourceDirectory(path, modifiedOnly = TRUE) message("x = ", x) stopifnot(x == 7L) } ## Cleanup #unlink(path, recursive = TRUE) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/tests/copyRenameFile.R����������������������������������������������������������������������0000644�0001762�0000144�00000002633�14372747611�016021� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # Create file cat("Hello", file="hello.txt") stopifnot(isFile("hello.txt")) # Copy file copyFile("hello.txt", "hello2.txt", verbose=TRUE) stopifnot(isFile("hello2.txt")) # Copy file stopifnot(all(isFile(c("hello.txt", "hello2.txt")))) # Copy file by overwriting existing file copyFile("hello.txt", "hello2.txt", overwrite=TRUE) stopifnot(isFile("hello2.txt")) # Copy file to directory pathD <- tempdir() copyFile("hello.txt", pathD) pathnameD <- file.path(pathD, "hello.txt") stopifnot(isFile(pathnameD)) file.remove(pathnameD) # Rename file renameFile("hello2.txt", "hello3.txt", verbose=TRUE) stopifnot(!isFile("hello2.txt")) stopifnot(isFile("hello3.txt")) # Rename file by overwriting existing file renameFile("hello3.txt", "hello.txt", overwrite=TRUE) stopifnot(!isFile("hello3.txt")) stopifnot(isFile("hello.txt")) # Move file to directory (and back) # NOTE: We are not moving file to tempdir() just in case # that is on a different file system which in case we # risk getting error "cannot rename file reason 'Invalid # cross-device link' (some Unix problem) pathD <- "foo" mkdirs(pathD) renameFile("hello.txt", pathD) pathnameD <- file.path(pathD, "hello.txt") stopifnot(isFile(pathnameD)) renameFile(pathnameD, ".") ## Exception handling res <- try(copyFile("hello.txt", "hello.txt"), silent=TRUE) stopifnot(inherits(res, "try-error")) # Cleanup removeDirectory("foo") file.remove("hello.txt") �����������������������������������������������������������������������������������������������������R.utils/tests/pushBackupFile.R����������������������������������������������������������������������0000644�0001762�0000144�00000001661�14372747611�016024� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # Create a file pathname <- "foobar.txt" cat(file=pathname, "File v1\n") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # (a) Backup and restore a file # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Turn it into a backup file pathnameB <- pushBackupFile(pathname, verbose=TRUE) print(pathnameB) # Restore main file from backup pathnameR <- popBackupFile(pathnameB, verbose=TRUE) print(pathnameR) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # (b) Backup, create a new file and frop backup file # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Turn it into a backup file pathnameB <- pushBackupFile(pathname, verbose=TRUE) print(pathnameB) # Create a new file cat(file=pathname, "File v2\n") # Drop backup because a new main file was successfully created pathnameR <- popBackupFile(pathnameB, verbose=TRUE) print(pathnameR) file.remove(pathname) �������������������������������������������������������������������������������R.utils/tests/Settings.R����������������������������������������������������������������������������0000644�0001762�0000144�00000001477�14372747611�014724� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������library("R.utils") # Load settings from file, or create default settings basename <- "some.settings" settings <- Settings$loadAnywhere(basename) if (is.null(settings)) settings <- Settings(basename) print(isModified(settings)) # Set default options, if missing. setOption(settings, "graphics/verbose", TRUE, overwrite=FALSE) setOption(settings, "io/verbose", Verbose(threshold=-1), overwrite=FALSE) # Save and reload settings path <- tempdir() str(list(path=path, file.info(path), file_test("-d", path))) stopifnot(file_test("-d", path), isDirectory(path)) saveAnywhere(settings, path=path) settings2 <- Settings$loadAnywhere(basename, paths=path) print(isModified(settings2)) # Clean up file.remove(getLoadedPathname(settings2)) # Assert correctness stopifnot(equals(settings, settings2)) print(isModified(settings)) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/������������������������������������������������������������������������������������������0000755�0001762�0000144�00000000000�14525573024�012022� 5����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/reassignInPackage.R�����������������������������������������������������������������������0000644�0001762�0000144�00000004216�14525546077�015536� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault reassignInPackage # # @title "Re-assigns a new value to an existing object in a loaded package" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{name}{The name of the object to be replaced."} # \item{pkgName}{The name of the package where the object lives."} # \item{value}{The new value to be assigned.} # \item{keepOld}{If @TRUE, the old value is kept as attribute # \code{oldValue} in the new object.} # \item{...}{Not used.} # } # # \value{ # Returns (invisibly) the new object. # } # # @author # # \seealso{ # See \code{assignInNamespace()} in @see "utils::getFromNamespace". # } # # @keyword internal #*/########################################################################### setMethodS3("reassignInPackage", "default", function(name, pkgName, value, keepOld=TRUE, ...) { # Get the environment where to look for the function to replace envName <- sprintf("package:%s", pkgName) if (!envName %in% search()) throw("Package not loaded: ", pkgName) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Patch # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Get the object to be replaced # Workaround for the fact that getAnywhere() is not accepting a string! expr <- substitute(getAnywhere(name), list(name=name)) obj <- eval(expr, enclos = baseenv()) pos <- which(obj$where == sprintf("namespace:%s", pkgName)) if (length(pos) == 0) { throw("Argument 'name' does not refer to an existing object: ", name) } oldValue <- obj$objs[[pos]] # Get environment of this object env <- environment(oldValue) # Assign this environment to the new object environment(value) <- env # Keep the old value? if (keepOld) attr(value, "oldValue") <- oldValue unlockBindingT <- base::unlockBinding unlockBindingT(name, env) assignInNamespaceT <- utils::assignInNamespace assignInNamespaceT(name, value, ns=pkgName, envir=env) assign(name, value, envir=env) lockBinding(name, env) invisible(value) }, private=TRUE) # reassignInPackage() ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/pushTemporaryFile.R�����������������������������������������������������������������������0000644�0001762�0000144�00000006441�14372747611�015641� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������########################################################################/** # @RdocDefault pushTemporaryFile # # @title "Appends a temporary suffix to the pathname" # # @synopsis # # \description{ # @get "title" and, optionally, renames an existing file accordingly. # # In combination with @see "popTemporaryFile", this method is useful # for creating a file/writing data to file \emph{atomically}, by # first writing to a temporary file which is the renamed. If for # some reason the generation of the file was interrupted, for instance # by a user interrupt or a power failure, then it is only the temporary # file that is incomplete. # } # # \arguments{ # \item{filename}{The filename of the file.} # \item{path}{The path of the file.} # \item{suffix}{The suffix to be appended.} # \item{isFile}{If @TRUE, the file must exist and will be renamed # on the file system. If @FALSE, it is only the pathname string # that will be modified. For details, see below.} # \item{...}{Not used.} # \item{verbose}{A @logical or @see "Verbose".} # } # # \value{ # Returns the pathname with the suffix appended. # } # # \details{ # If \code{isFile} is @FALSE, the pathname where the suffix of the # temporary pathname has been added is returned. # If \code{isFile} is @TRUE, the file is also renamed. # Then, if the file does not exists or it was not successfully # renamed, an exception is thrown. # } # # @examples "../incl/pushTemporaryFile.Rex" # # @author # # \seealso{ # @see "popTemporaryFile". # } # # @keyword "utilities" # @keyword "programming" # @keyword "IO" #*/######################################################################### setMethodS3("pushTemporaryFile", "default", function(filename, path=NULL, suffix=".tmp", isFile=FALSE, ..., verbose=FALSE) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'isFile': isFile <- Arguments$getLogical(isFile) # Argument 'filename' & 'path': pathname <- Arguments$getWritablePathname(filename, path=path, mustExist=isFile, mustNotExist=!isFile) # Argument 'suffix': suffix <- Arguments$getCharacter(suffix) # Argument 'verbose': verbose <- Arguments$getVerbose(verbose) if (verbose) { pushState(verbose) on.exit(popState(verbose)) } verbose && enter(verbose, "Adding temporary suffix from file") verbose && cat(verbose, "Pathname: ", pathname) verbose && cat(verbose, "Suffix: ", suffix) verbose && cat(verbose, "Rename existing file?: ", isFile) pathnameT <- sprintf("%s%s", pathname, suffix) verbose && cat(verbose, "Temporary pathname: ", pathnameT) pathnameT <- Arguments$getWritablePathname(pathnameT, mustNotExist=TRUE) if (isFile) { verbose && enter(verbose, "Renaming existing file") res <- file.rename(pathname, pathnameT) verbose && cat(verbose, "Result: ", res) verbose && exit(verbose) if (!isFile(pathnameT)) { throw("Failed to rename file (final file does not exist): ", pathname, " -> ", pathnameT) } if (isFile(pathname)) { throw("Failed to rename file (file still exists): ", pathname, " -> ", pathnameT) } } # if (isFile) verbose && exit(verbose) pathnameT }) # pushTemporaryFile() �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/withTimeout.R�����������������������������������������������������������������������������0000644�0001762�0000144�00000014713�14525546077�014505� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocFunction withTimeout # # @title "Evaluate an R expression and interrupts it if it takes too long" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{expr}{The R expression to be evaluated.} # \item{substitute}{If @TRUE, argument \code{expr} is # \code{\link[base]{substitute}()}:ed, otherwise not.} # \item{envir}{The @environment in which the expression should # be evaluated.} # \item{timeout, cpu, elapsed}{A @numeric specifying the maximum number # of seconds the expression is allowed to run before being # interrupted by the timeout. The \code{cpu} and \code{elapsed} # arguments can be used to specify whether time should be measured # in CPU time or in wall time.} # \item{onTimeout}{A @character specifying what action to take if # a timeout event occurs.} # \item{...}{Not used.} # } # # \value{ # Returns the results of the expression evaluated. # If timed out, @NULL is returned if \code{onTimeout} was # \code{"warning"} or \code{"silent"}. # If \code{"error"} a @see "TimeoutException" is thrown. # } # # \details{ # This method utilizes @see "base::setTimeLimit" by first setting the # timeout limits, then evaluating the expression that may or may not # timeout. The method is guaranteed to reset the timeout limits to be # infinitely long upon exiting, regardless whether it returns normally # or preemptively due to a timeout or an error. # } # # \section{Known limitation: Not everything can be timed out}{ # In order to understand when this function works and when it does not, # it is useful to know that it utilizes R's built-in time-out mechanism, # which sets the limits on what is possible and not. # From @see "base::setTimeLimit", we learn that: # # \emph{"Time limits are checked whenever a user interrupt could occur. # This will happen frequently in R code and during Sys.sleep(*), but # only at points in compiled C and Fortran code identified by the # code author."} # # More precisely, if a function is implemented in native code (e.g. C) # and the developer of that function does not check for user interrupts, # then you cannot interrupt that function neither via a user interrupt # (e.g. Ctrl-C) \emph{nor via the built-in time out mechanism}. # To change this, you need to contact the developer of that piece of # code and ask them to check for R user interrupts in their native code. # # Furthermore, it is not possible to interrupt/break out of a "readline" # prompt (e.g. @see "base::readline" and @see "base::readLines") using # timeouts; the timeout exception will not be thrown until after the user # completes the prompt (i.e. after pressing ENTER). # # System calls via @see "base::system" and \code{system2()} cannot be # timed out via the above mechanisms. However, in \R (>= 3.5.0) these # functions have argument \code{timeout} providing their own independent # timeout mechanism. # # Other examples of calls that do \emph{not} support timeout are "atomic" # calls that may take very long such as large object allocation and # \code{rnorm(n)} where \code{n} is very large. # # (*) Note that on Unix and macOS, \code{Sys.sleep(time)} will signal a # timeout error only \emph{after} \code{time} seconds passed, # regardless of \code{timeout} limit (< \code{time}). # } # # \section{Known limitation: May fail when temporarily switching language}{ # \code{withTimeout()} does \emph{not} handle the case when the expression # evaluated \emph{temporarily} switches the language used by R, e.g. # assume we run in a non-French locale and call: # # \preformatted{ # withTimeout({ # olang <- Sys.getenv("LANGUAGE") # on.exit(Sys.setenv(LANGUAGE=olang)) # Sys.setenv(LANGUAGE="fr") # repeat Sys.sleep(0.1) # }, timeout = 1.0, onTimeout = "warning") # } # # In this case, the error message produced by @see "base::setTimeLimit" is # in French, i.e. `la limite de temps est atteinte`. However, when # \code{withTimeout()} inspects this message, it can \emph{not} know that # French was used, and will therefore not check against the French template # message for timeout errors. Because of this, \code{withTimeout()} fails # to detect the timeout error (and therefore also deescalate it to a # warning in this example). # # \emph{Comment}: This appears to only fail on MS Windows and macOS, # whereas on Linux, \code{withTimeout()} appears to work, but it is # unknown why there is a difference between operating systems in this # case. # } # # @author # # @examples "../incl/withTimeout.Rex" # # \seealso{ # Internally, @see "base::eval" is used to evaluate the expression and # @see "base::setTimeLimit" is used to control for timeout events. # } # # \references{ # [1] R help thread 'Time out for a R Function' on 2010-12-07. # \url{https://stat.ethz.ch/pipermail/r-help/2010-December/262316.html} \cr # } # # @keyword IO # @keyword programming #*/########################################################################### withTimeout <- function(expr, substitute=TRUE, envir=parent.frame(), timeout, cpu=timeout, elapsed=timeout, onTimeout=c("error", "warning", "silent"), ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'expr': if (substitute) expr <- substitute(expr) # Argument 'envir': if (!is.environment(envir)) throw("Argument 'envir' is not a list: ", class(envir)[1L]) # Argument 'cpu' and 'elapsed': cpu <- Arguments$getNumeric(cpu, range=c(0,Inf)) elapsed <- Arguments$getNumeric(elapsed, range=c(0,Inf)) # Argument 'onTimeout': onTimeout <- match.arg(onTimeout) setTimeLimit(cpu=cpu, elapsed=elapsed, transient=TRUE) on.exit({ setTimeLimit(cpu=Inf, elapsed=Inf, transient=FALSE) }) tryCatch({ eval(expr, envir = envir, enclos = baseenv()) }, error = function(ex) { msg <- ex$message # Was it a timeout? pattern <- gettext("reached elapsed time limit", "reached CPU time limit", domain="R") pattern <- paste(pattern, collapse = "|") if (regexpr(pattern, msg) != -1L) { ex <- TimeoutException(msg, cpu=cpu, elapsed=elapsed) if (onTimeout == "error") { throw(ex) } else if (onTimeout == "warning") { warning(getMessage(ex)) NULL } else if (onTimeout == "silent") { NULL } } else { # Rethrow error throw(ex) } }) } �����������������������������������������������������R.utils/R/getRelativePath.R�������������������������������������������������������������������������0000644�0001762�0000144�00000012474�14372747611�015252� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault getRelativePath # # @title "Gets the relative pathname relative to a directory" # # @synopsis # # \description{ # @get "title". # } # # \arguments{ # \item{pathname}{A @character string of the pathname to be converted into # an relative pathname.} # \item{relativeTo}{A @character string of the reference pathname.} # \item{caseSensitive}{If @TRUE, the comparison is case sensitive, otherwise # not. If @NULL, it is decided from the relative path.} # \item{...}{Not used.} # } # # \value{ # Returns a @character string of the relative pathname. # } # # \section{Non-case sensitive comparison}{ # If \code{caseSensitive == NULL}, the relative path is used to decide if # the comparison should be done in a case-sensitive mode or not. # The current check is if it is a Windows path or not, that is, if # the relative path starts with a device letter, then the comparison # is non-case sensitive. # } # # \details{ # In case the two paths are on different file systems, for instance, # C:/foo/bar/ and D:/foo/, the method returns \code{pathname} as is. # } # # \examples{ # getRelativePath("foo", "foo") # "." # getRelativePath("foo/bar", "foo") # "bar" # getRelativePath("foo/bar", "foo/bar/yah") # ".." # getRelativePath("foo/bar/cool", "foo/bar/yah/sub/") # "../../cool" # getRelativePath("/tmp/bar/", "/bar/foo/") # "../../tmp/bar" # # # Windows # getRelativePath("C:/foo/bar/", "C:/bar/") # "../foo/bar" # getRelativePath("C:/foo/bar/", "D:/bar/") # "C:/foo/bar" # } # # @author # # \seealso{ # @see "getAbsolutePath". # @see "isAbsolutePath". # } # # @keyword IO # @keyword programming #*/########################################################################### setMethodS3("getRelativePath", "default", function(pathname, relativeTo=getwd(), caseSensitive=NULL, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Local functions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - getWindowsDrivePattern <- function(fmtstr, ...) { # Windows drive letters drives <- "ABCDEFGHIJKLMNOPQRSTUVWXYZ" # Support also lower case drives <- paste(c(drives, tolower(drives)), collapse="") sprintf(fmtstr, drives) } # getWindowsDrivePattern() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'pathname': pathname <- as.character(pathname) # BACKWARD COMPATIBILITY: Treat empty path specially? pathname <- .getPathIfEmpty(pathname, where="getRelativePath") nPathnames <- length(pathname) # Nothing to do? if (nPathnames == 0L) return(logical(0L)) # Multiple pathnames to be checked? if (nPathnames > 1L) { res <- sapply(pathname, FUN=getRelativePath, relativeTo=relativeTo, caseSensitive=caseSensitive, ...) return(res) } # A missing pathname? if (is.na(pathname)) return(NA_character_) # A URL? if (isUrl(pathname)) return(pathname) # If not an absolute path, assume it is a relative path already. pathname <- getAbsolutePath(pathname, expandTilde=TRUE) if (!isAbsolutePath(pathname)) return(pathname) # Argument 'relativeTo': if (is.null(relativeTo)) relativeTo <- "." if (length(relativeTo) > 1L) { throw("Argument 'relativeTo' must be a single character string: ", hpaste(relativeTo)) } # Argument 'caseSensitive': if (is.null(caseSensitive)) { pattern <- getWindowsDrivePattern("^[%s]:") isWindows <- (regexpr(pattern, relativeTo) != -1L) caseSensitive <- !isWindows } else { caseSensitive <- as.logical(caseSensitive) if (!caseSensitive %in% c(FALSE, TRUE)) throw("Argument 'caseSensitive' must be logical: ", caseSensitive) } relativeTo <- getAbsolutePath(relativeTo, expandTilde=TRUE) # Split the two pathnames into their components relativeTo <- unlist(strsplit(relativeTo, split="[\\/]")) pathname <- unlist(strsplit(pathname, split="[\\/]")) pathnameC <- pathname # Case sensitive comparisons? if (!caseSensitive) { relativeTo <- tolower(relativeTo) pathnameC <- tolower(pathnameC) } # 1. Check that the pathnames are "compatible". if (!identical(relativeTo[1L], pathnameC[1L])) { pathname <- paste(pathname, collapse="/") # warning("Cannot infer relative pathname, because the two pathnames are not refering to the same root/device (will use absolute pathname instead): ", paste(relativeTo, collapse="/"), " != ", pathname) return(pathname) } # 2. Remove all matching components in 'relativeTo' and 'pathname'. # The removed parts constitute their common path. for (kk in seq_along(relativeTo)) { aPart <- relativeTo[1] bPart <- pathnameC[1] if (!identical(aPart, bPart)) break relativeTo <- relativeTo[-1L] pathname <- pathname[-1L] pathnameC <- pathnameC[-1L] } # 3. If there are more components in 'relativeTo', this means that the # rest of 'relativeTo' is in a different subdirectory than 'pathname'. prefix <- rep("..", length.out=length(relativeTo)) pathname <- c(prefix, pathname) pathname <- paste(pathname, collapse="/") if (pathname == "") pathname <- "." pathname }) ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/detachPlain.R�����������������������������������������������������������������������������0000644�0001762�0000144�00000001423�14372747611�014366� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������.detachPlain <- function(pos, ...) { env <- as.environment(pos) # Temporarily remove all of the package's detach hooks name <- attr(env, "name") pkgName <- gsub("^package:", "", name) hookName <- packageEvent(pkgName, "detach") hooks <- getHook(hookName) if (length(hooks) > 0) { on.exit({ setHook(hookName, hooks, action="replace") }, add=TRUE) setHook(hookName, list(), action="replace") } # Temporarily remove the package's library path in order to # prevent the package's .Last.lib() to be run. libpath <- attr(env, "path") if (!is.null(libpath)) { on.exit({ attr(env, "path") <- libpath }, add=TRUE) attr(env, "path") <- NULL } # Detach the package detach(pos=pos, unload=FALSE, force=TRUE) } # .detachPlain() ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/FileProgressBar.R�������������������������������������������������������������������������0000644�0001762�0000144�00000005133�14372747611�015205� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocClass FileProgressBar # # @title "A progress bar that sets the size of a file accordingly" # # \description{ # @classhierarchy # } # # @synopsis # # \arguments{ # \item{pathname}{The pathname of the output file.} # \item{...}{Other arguments accepted by the @see "ProgressBar" # constructor.} # } # # \section{Fields and Methods}{ # @allmethods # } # # \details{ # @get "title". This class useful to check the progress of a batch job by # just querying the size of a file, for instance, via ftp. # } # # \examples{ # \dontrun{ # @include "../incl/FileProgressBar.Rex" # } # } # # @author #*/########################################################################### setConstructorS3("FileProgressBar", function(pathname=NULL, ...) { this <- extend(ProgressBar(..., newlineWhenDone=FALSE), "FileProgressBar", pathname=as.character(pathname) ) if (!is.null(pathname)) { # Resets the progress bar and creates the file reset(this) } this }) #########################################################################/** # @RdocMethod update # # @title "Updates file progress bar" # # @synopsis # # \description{ # @get "title". # } # # \arguments{ # \item{visual}{If @TRUE, the file is resized according to the value of # the progress bar, otherwise not.} # \item{...}{Not used.} # } # # \value{ # Returns nothing. # } # # @author # # \seealso{ # @seeclass # } #*/######################################################################### setMethodS3("update", "FileProgressBar", function(object, visual=TRUE, ...) { # To please R CMD check... this <- object if (visual) { # Create bar string s <- getBarString(this) # Cut initial character representing value zero off. s <- substring(s, 2) # Creates an empty file cat(file=this$pathname, s) } }) #########################################################################/** # @RdocMethod cleanup # # @title "Removes the progress file for a file progress bar" # # @synopsis # # \description{ # @get "title". # } # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns (invisibly) @TRUE, if there is no progress file afterwards. # Otherwise, @FALSE is returned. # } # # @author # # \seealso{ # @seeclass # } #*/######################################################################### setMethodS3("cleanup", "FileProgressBar", function(object, ...) { # To please R CMD check... this <- object if (isFile(this$pathname)) file.remove(this$pathname) invisible(isFile(this$pathname)) }) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/999.package.R�����������������������������������������������������������������������������0000644�0001762�0000144�00000006752�14525546077�014113� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#########################################################################/** # @RdocPackage R.utils # # \description{ # @eval "getDescription(R.utils)" # # \emph{Warning}: # The Application Programming Interface (API) of the classes and methods # in this package may change. Classes and methods are considered either # to be stable, or to be in beta or alpha (pre-beta) stage. See list # below for details. # # The main reason for publishing this package on CRAN although it lacks # a stable API, is that its methods and classes are used internally by # other packages on CRAN that the author has published. # # For package history, see \code{showHistory(R.utils)}. # } # # \section{Requirements}{ # This package requires the \pkg{R.oo} package [1]. # } # # \section{Installation and updates}{ # # To install this package do:\cr # # \code{install.packages("R.utils")} # } # # \section{To get started}{ # \describe{ # \item{\link{Arguments}}{[alpha] Methods for common argument processing.} # \item{\link{Assert}}{[alpha] Methods for assertion of values and states.} # \item{\link{GString}}{[alpha] A character string class with methods for # simple substitution.} # \item{\link{Java}}{[beta] Reads and writes Java streams.} # \item{\link{Options}}{[alpha] Tree-structured options queried in a # file-system like manner.} # \item{\link{Settings}}{[alpha] An Options class for reading and writing # package settings.} # \item{\link{ProgressBar}}{[beta] Text-based progress bar.} # \item{\link{FileProgressBar}}{[beta] A ProgressBar that reports progress # as file size.} # \item{\link{System}}{[alpha] Methods for access to system.} # \item{\link{Verbose}}{[alpha] A class for verbose and log output. # Utilized by the VComments and LComments classes.} # \item{\link{SmartComments}, \link{VComments}, \link{LComments}}{[alpha] # Methods for preprocessing source code comments of certain # formats into R code.} # } # In addition to the above, there is a large set of function for file # handling such as support for reading/following Windows Shortcut links, # but also other standalone utility functions. # See package index for a list of these. # These should also be considered to be in alpha or beta stage. # } # # \section{How to cite this package}{ # Whenever using this package, please cite [1] as # # @howtocite "R.oo" # } # # \section{Wishlist}{ # Here is a list of features that would be useful, but which I have # too little time to add myself. Contributions are appreciated. # \itemize{ # \item Write a TclTkProgressBar class. # \item Improve/stabilize the GString class. # \item Mature the SmartComments classes. Also add AComments and # PComments for assertion and progress/status comments. # } # # If you consider implement some of the above, make sure it is not # already implemented by downloading the latest "devel" version! # } # # @author # # \section{License}{ # The releases of this package is licensed under # LGPL version 2.1 or newer. # # The development code of the packages is under a private licence # (where applicable) and patches sent to the author fall under the # latter license, but will be, if incorporated, released under the # "release" license above. # } # # \section{References}{ # [1] @include "../incl/BengtssonH_2003.bib.Rdoc" \cr # } #*/######################################################################### ����������������������R.utils/R/isSingle.R��������������������������������������������������������������������������������0000644�0001762�0000144�00000001377�14372747611�013737� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocFunction isSingle # @alias singles # # @title "Identifies all entries that exists exactly once" # # \description{ # @get "title". # } # # \usage{ # isSingle(x, ...) # singles(x, ...) # } # # \arguments{ # \item{x}{A @vector of length K.} # \item{...}{Additional arguments passed to @see "isReplicated".} # } # # \value{ # A @logical @vector of length K, # indicating whether the value is unique or not. # } # # @author # # \seealso{ # Internally @see "isReplicated" is used. # } #*/########################################################################### isSingle <- function(x, ...) { !isReplicated(x, ...) } singles <- function(x, ...) { x[isSingle(x, ...)] } �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/use.R�������������������������������������������������������������������������������������0000644�0001762�0000144�00000037005�14525546077�012756� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault use # # @title "Attaches or loads packages" # # \description{ # @get "title". # If a package is not installed, it (and its dependencies) will be # installed from one of the (known) repositories. # } # # @synopsis # # \arguments{ # \item{pkg}{A @character @vector specifying the package(s) to be used.} # \item{version}{(optional) Version constraint(s) on requested package(s).} # \item{how}{A @character string specifying whether the package should be attached or loaded.} # \item{quietly}{If @TRUE, minimal or no messages are reported.} # \item{warn.conflicts}{If @TRUE, warnings on namespace conflicts are reported, otherwise not.} # \item{install}{If @TRUE and the package is not installed or an too old version is installed, then tries to install a newer version, otherwise not.} # \item{repos}{(optional) A @character @vector specifying from which repositories # to install the package from, iff a requested package is not already installed.} # \item{...}{Additional \emph{named} arguments passed to # @see "base::require" or @see "base::requireNamespace".} # \item{verbose}{If @TRUE, verbose output is generated (regardless # of \code{quietly}).} # } # # \value{ # Returns a @vector of @see "base::package_version" for each package # attached/loaded. # If one of the requested packages/package versions is not available # and could not be installed, an error is thrown. # } # # \seealso{ # @see "base::library" and "base::install.packages". # To modify the set of known repositories, set option \code{repos} # (see @see "base::options"), # which can also be done via @see "utils::setRepositories". # } # # \examples{\dontrun{ # use("digest") # use("digest (>= 0.6.3)") # use("digest (>= 0.6.3)", repos=c("CRAN", "R-Forge")) # use("(CRAN|R-Forge)::digest (>= 0.6.3)") # use("BioCsoft::ShortRead") # use("digest, R.rsp (>= 0.9.17)") # }} # # @keyword programming # @keyword utilities # @keyword internal #*/########################################################################### setGenericS3("use") setMethodS3("use", "default", function(pkg="R.utils", version=NULL, how=c("attach", "load"), quietly=TRUE, warn.conflicts=!quietly, install=getOption("R.utils.use.install", Sys.getenv("R_R_UTILS_USE_INSTALL", "TRUE")), repos=getOption("use/repos", c("[[current]]", "[[mainstream]]")), ..., verbose=FALSE) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Local functions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## "Hide" all messages? if (quietly) { # Sink stdout and stderr, and rethrow errors. captureAll <- function(expr, envir=parent.frame(), echo=TRUE) { out <- NULL closeAll <- function(out) { if (!is.null(out)) { sink(type="message") sink(type="output") close(out) } NULL } # closeAll() bfr <- NULL; rm(list="bfr"); # To please R CMD check out <- textConnection("bfr", open="w", local=TRUE) sink(file=out, type="output") sink(file=out, type="message") on.exit({ out <- closeAll(out) # Output? if (echo && length(bfr) > 0L) { cat(paste(c(bfr, ""), collapse="\n")) } }) # Evaluate tryCatch({ eval(expr, envir = envir, enclos = baseenv()) }, error = function(ex) { out <<- closeAll(out) # If error, output all messages... if (length(bfr) > 0L) { echo <<- FALSE message(paste(c(bfr, ""), collapse="\n")) } # ...and rethrow the error throw(ex) }) # Close out <- closeAll(out) invisible(bfr) } # captureAll() } else { captureAll <- function(expr, envir=parent.frame(), echo=TRUE) { eval(expr, envir = envir, enclos = baseenv()) } } # if (quietly) installPkg <- function(pkg, version=NULL, repos=NULL, type=getOption("pkgType"), ..., quietly=FALSE, verbose=FALSE) { verbose && enter(verbose, "Trying to install package") # Already installed? (=should not have been called) if (isPackageInstalled(pkg)) { ver <- packageVersion(pkg) msg <- sprintf("INTERNAL ERROR: Package %s v%s is already installed. ", sQuote(pkg), ver) throw(msg) } # Parse/expand argument 'repos': if (is.null(repos)) repos <- "[[current]]" cat(verbose, "Repositories: ", paste(sQuote(repos), collapse=", ")) # Temporary set of repositories orepos <- useRepos(repos) on.exit(useRepos(orepos)) # Repositories being used repos <- getOption("repos") if (!identical(repos, orepos)) { cat(verbose, "Repositories (expanded): ", paste(sQuote(repos), collapse=", ")) } # Identify all available packages of this repository captureAll({ avail <- available.packages(type=type) }, echo=!quietly) # Does the package of interest exists? keep <- na.omit(match(pkg, rownames(avail))) availT <- avail[keep,, drop=FALSE] if (length(availT) == 0L) { throw(sprintf("Package '%s' is not available from any of the repositories: %s", pkg, paste(sQuote(repos), collapse=", "))) } verbose && print(verbose, availT[,c("Package", "Version")]) # Find a particular version? if (!is.null(version)) { vers <- availT[,"Version", drop=TRUE] keep <- sapply(vers, FUN=function(ver) version$test(ver)) availT <- availT[keep,,drop=FALSE] if (length(availT) == 0L) { throw(sprintf("Package '%s' (%s) is not available from any of the repositories: %s", pkg, version$label, paste(sQuote(repos), collapse=", "))) } verbose && print(verbose, availT[,c("Package", "Version")]) } verbose && enter(verbose, "Installing package") verbose && cat(verbose, "Type: ", type) verbose && cat(verbose, "Number of possible installation files available: ", nrow(availT)) # Detach/unload namespace first? if (is.element(pkg, loadedNamespaces())) { verbose && enter(verbose, "Unloading package namespace before installing") captureAll({ unloadNamespace(pkg) }, echo=!quietly) if (is.element(pkg, loadedNamespaces())) { throw("Cannot install package. Failed to unload namespace: ", pkg) } verbose && exit(verbose) } verbose && enter(verbose, "install.packages()") verbose && cat(verbose, "Arguments:") verbose && str(verbose, list(available=avail, type=type, quiet=quietly, ...)) output <- captureAll({ # install.packages(pkg, available=avail, type=type, quiet=quietly, ...) install.packages(pkg, type=type, quiet=quietly, ...) }, echo=!quietly) if (!quietly) verbose && print(verbose, output) verbose && exit(verbose) installed <- isPackageInstalled(pkg) if (!installed) { throw("Failed to install package: ", pkg) } verbose && exit(verbose) ver <- packageVersion(pkg) verbose && printf(verbose, "Installed version: %s v%s\n", pkg, ver) # Assert installed package version if (!is.null(version)) { if (!version$test(ver)) { throw(sprintf("[SANITY CHECK]: The package version ('%s') available after installation does not meet the request version specification ('%s'): %s", ver, version$label, pkg)) } } verbose && exit(verbose) invisible(ver) } # installPkg() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'pkg': pkg <- Arguments$getCharacters(pkg) pkg <- .splitBy(pkg, split=",") npkgs <- length(pkg) # Argument 'version': if (!is.null(version)) { version <- Arguments$getCharacters(version) version <- .splitBy(version, split=",") if (length(version) != npkgs) { throw("Arguments 'version' and 'pkg' are of different lengths: ", length(version), " != ", npkgs) } } # Argument 'repos': if (is.null(repos)) { repos <- Arguments$getCharacters(repos) } # Argument 'how': how <- match.arg(how) # Argument 'quietly': quietly <- Arguments$getLogical(quietly) # Argument 'install': install <- Arguments$getLogical(install, coerce = TRUE) # Argument 'verbose': verbose <- Arguments$getVerbose(verbose) if (verbose) { pushState(verbose) on.exit(popState(verbose)) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Vectorized call? # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (npkgs > 1L) { res <- NULL for (ii in seq_len(npkgs)) { resII <- use(pkg[ii], version=version[ii], how=how, quietly=quietly, install=install, repos=NULL, ..., verbose=verbose) if (ii == 1L) { res <- resII } else { res <- c(res, resII) } } return(invisible(res)) } if (quietly) { oopts <- options("install.packages.compile.from.source"="never") on.exit(options(oopts), add=TRUE) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # From now on we are only dealing with one package at the time # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - verbose && enterf(verbose, "%sing package", capitalize(how)) if (!is.null(version)) { version <- .parseVersion(version) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Parse package and repository names # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - verbose && enter(verbose, "Parsing package, version and repositories") pkgOrg <- pkg parts <- .splitBy(pkg, split="::") nparts <- length(parts) # Sanity check if (nparts == 0L || nparts > 2L) { throw("Syntax error (in usage of '::'): ", pkgOrg) } # Infer (repos,pkg) parameters if (nparts == 1L) { repos <- NULL pkg <- parts[1L] } else if (nparts == 2L) { repos <- parts[1L] pkg <- parts[2L] } patternO <- "<|<=|==|>=|>" patternV <- "[0-9]+[.-][0-9]+([.-][0-9]+)*" pattern <- sprintf("^([^ ]+)[ ]*(|[(]((|%s)[ ]*%s)[)])", patternO, patternV) if (regexpr(pattern, pkg) == -1L) { throw("Syntax error (in usage after '::'): ", pkgOrg) } versionT <- gsub(pattern, "\\2", pkg) hasVersion <- nzchar(versionT) if (hasVersion) { if (!is.null(version)) { throw(sprintf("Argument 'version' (%s) must not be given if argument 'pkg' specifies a version constraint as well: %s", version, pkg)) } version <- versionT version <- .parseVersion(version) } .stop_if_not(is.null(version) || is.list(version)) pkg <- gsub(pattern, "\\1", pkg) # Parse 'repos' if (!is.null(repos)) { if (length(repos) > 1L) { repos <- paste(repos, collapse="|") } repos <- .parseRepos(repos) repos <- unique(repos) } if (is.null(repos)) repos <- "[[current]]" if (verbose) { cat(verbose, "Package: ", sQuote(pkg)) if (is.null(version)) { cat(verbose, "Version constraint: <none>") } else { cat(verbose, "Version constraint: ", version$label) } cat(verbose, "Repositories: ", paste(sQuote(repos), collapse=", ")) } verbose && exit(verbose) verbose && enter(verbose, "Checking package installing") cat(verbose, "Package: ", sQuote(pkg)) installed <- isPackageInstalled(pkg) if (!installed && install) { ver <- installPkg(pkg, version=version, repos=repos, ..., quietly=quietly, verbose=verbose) installed <- isPackageInstalled(pkg) } if (!installed) { cat(verbose, "Package version: <not installed>") verbose && exit(verbose) verbose && exit(verbose) throw(sprintf("Failed to %s package:%s", how, pkg)) } ver <- packageVersion(pkg) verbose && cat(verbose, "Package version: ", ver) verbose && exit(verbose) verbose && enter(verbose, "Checking requested package version") if (!is.null(version)) { ver <- packageVersion(pkg) cat(verbose, "Package version: ", ver) cat(verbose, "Requested version: ", version$label) res <- version$test(ver) printf(verbose, "Result of test (%s %s): %s\n", ver, version$label, res) # Need to install a newer version? if (!res) { verbose && printf(verbose, "Installed version ('%s') does meet the version requirements (%s)\n", ver, version$label) if (install) { ver <- installPkg(pkg, version=version, repos=repos, ..., quietly=quietly, verbose=verbose) verbose && printf(verbose, "Installed %s v%s\n", pkg, ver) verbose && exit(verbose) } else { throw(sprintf("%s (%s) is not installed: %s", sQuote(pkg), version$label, ver)) } } } verbose && exit(verbose) verbose && enterf(verbose, "%sing package", capitalize(how)) ver <- packageVersion(pkg) cat(verbose, "Package: ", sQuote(pkg)) cat(verbose, "Package version: ", ver) cat(verbose, "How: ", how) if (how == "attach") { captureAll({ ## NB: do.call() is needed to avoid 'R CMD check' NOTE on ## "... may be used in an incorrect context". /HB 2013-08-31 res <- do.call(require, list(pkg, ..., quietly=quietly, warn.conflicts=warn.conflicts, character.only=TRUE)) if (!res) throw("Package not attached: ", pkg) }, echo=!quietly) } else if (how == "load") { captureAll({ res <- requireNamespace(pkg, ..., quietly=quietly) if (!res) throw("Package not loaded: ", pkg) }, echo=!quietly) } verbose && exit(verbose) verbose && exit(verbose) names(ver) <- pkg invisible(ver) }) .splitBy <- function(s, split=",", fixed=TRUE, ...) { trim <- function(s, ...) { s <- gsub("^[ \t\n\r]*", "", s) s <- gsub("[ \t\n\r]*$", "", s) s } # trim() s <- strsplit(s, split=split, fixed=fixed) s <- unlist(s, use.names=FALSE) trim(s) } # .splitBy() .parseVersion <- function(version, defaultOp="==", ...) { versionOrg <- version # Trim version <- gsub("^[ ]+", "", version) version <- gsub("[ ]+$", "", version) # Drop optional parenthesis pattern <- "^[(]([^)]*)[)]$" if (regexpr(pattern, version) != -1L) { version <- gsub(pattern, "\\1", version) } # (a) Just a version number? patternV <- "[0-9]+[.-][0-9]+([.-][0-9]+)*" pattern <- sprintf("^%s$", patternV) if (regexpr(pattern, version) != -1L) { version <- sprintf("%s %s", defaultOp, version) } patternO <- "<|<=|==|>=|>" pattern <- sprintf("^(%s)[ ]*(%s)$", patternO, patternV) if (regexpr(pattern, version) == -1L) { throw("Syntax error in specification of version constraint: ", versionOrg) } # Parse operation, version number op <- gsub(pattern, "\\1", version) version <- gsub(pattern, "\\2", version) version <- package_version(version) label <- sprintf("%s %s", op, version) # Create test function test <- function(other) { do.call(op, list(other, version)) } list(label=label, op=op, version=version, test=test) } # .parseVersion() .parseRepos <- function(repos, ...) { reposOrg <- repos # Trim repos <- gsub("^[ ]+", "", repos) repos <- gsub("[ ]+$", "", repos) # Drop optional parenthesis pattern <- "^[(]([^)]*)[)]$" if (regexpr(pattern, repos) != -1L) { repos <- gsub(pattern, "\\1", repos) } # Split repos <- .splitBy(repos, split="|") repos } # .parseRepos() ## # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- ## # Adjust repositories temporarily ## # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## if (length(repos) > 0L) { ## verbose && printf(verbose, "Using specific repositories (%s):\n", paste(sQuote(repos), collapse=", ")) ## orepos <- useRepos(repos) ## on.exit(options(orepos), add=TRUE) ## verbose && str(verbose, as.list(getOption("repos"))) ## } ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/systemR.R���������������������������������������������������������������������������������0000644�0001762�0000144�00000004246�14372747611�013626� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault systemR # @alias systemR # # @title "Launches another R process from within R" # # @synopsis # # \description{ # @get "title" via @see "base::system" by automatically locating the # R executable, cf [1]. # } # # \arguments{ # \item{command}{A @character string be appended to the @see "base::system" # call. If a @vector, then the strings are concatenated separated # with a space.} # \item{...}{Additional arguments passed to @see "base::system".} # \item{Rcommand}{A @character string specifying the basename of # the R executable.} # \item{verbose}{A @logical or a @see "Verbose" object.} # } # # \value{ # Returns what @see "base::system" returns. # } # # @examples "../incl/systemR.Rex" # # @author # # \references{ # [1] R-devel thread 'Best way to locate R executable from within R?', # May 22, 2012. # } # # \seealso{ # The R executable is located using @see "base::R.home", which # is then launched using @see "base::system". # } # # @keyword programming # @keyword IO #*/########################################################################### setMethodS3("systemR", "default", function(command="", ..., Rcommand="R", verbose=FALSE) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'command': command <- Arguments$getCharacters(command) # Locate the R executable, cf. help("R.home") and [1]. # NB: R.home() is guaranteed to return a path without spaces. Rpath <- R.home("bin") Rpath <- Arguments$getReadablePath(Rpath, mustExist=TRUE) # Argument 'Rcommand': Rcommand <- Arguments$getCharacter(Rcommand) verbose <- Arguments$getVerbose(verbose) if (verbose) { pushState(verbose) on.exit(popState(verbose), add=TRUE) } # Setup the full system command Rbin <- file.path(Rpath, Rcommand) command <- paste(command, collapse=" ") command <- paste(command, sep=" ") cmd <- sprintf('%s %s', shQuote(Rbin), command) verbose && cat(verbose, "System command: ", cmd) system(cmd, ...) }) ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/popBackupFile.R���������������������������������������������������������������������������0000644�0001762�0000144�00000010672�14372747611�014704� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������########################################################################/** # @RdocDefault popBackupFile # # @title "Drops a backup suffix from the backup pathname" # # @synopsis # # \description{ # @get "title" and, by default, restores an existing backup file # accordingly by renaming it. # } # # \arguments{ # \item{filename}{The filename of the backup file.} # \item{path}{The path of the file.} # \item{suffix}{The suffix of the filename to be dropped.} # \item{isFile}{If @TRUE, the backup file must exist and # will be renamed. If @FALSE, it is only the pathname string # that will be modified. For details, see below.} # \item{onMissing}{A @character string specifying what to do if the # backup file does not exist.} # \item{drop}{If @TRUE, the backup file will be dropped in case # the original file already exists or was successfully restored.} # \item{...}{Not used.} # \item{verbose}{A @logical or @see "Verbose".} # } # # \value{ # Returns the pathname with the backup suffix dropped. # } # # @author # # \seealso{ # See @see "pushBackupFile" for more details and an example. # } # # @keyword "utilities" # @keyword "programming" # @keyword "IO" #*/######################################################################### setMethodS3("popBackupFile", "default", function(filename, path=NULL, suffix=".bak", isFile=TRUE, onMissing=c("ignore", "error"), drop=TRUE, ..., verbose=FALSE) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'isFile': isFile <- Arguments$getLogical(isFile) # Argument 'onMissing': onMissing <- match.arg(onMissing) # Argument 'filename' & 'path': if (!is.null(filename)) { pathnameB <- Arguments$getWritablePathname(filename, path=path, mustExist=(isFile && (onMissing == "error"))) } else { pathnameB <- NULL } # Argument 'suffix': suffix <- Arguments$getCharacter(suffix) # Argument 'drop': drop <- Arguments$getLogical(drop) # Argument 'verbose': verbose <- Arguments$getVerbose(verbose) if (verbose) { pushState(verbose) on.exit(popState(verbose)) } # If file does not exist, silently ignore it and returns NULL? if ((onMissing == "ignore") && !isFile(pathnameB)) { return(invisible(NULL)) } verbose && enter(verbose, "Dropping backup suffix from file") verbose && cat(verbose, "Backup pathname: ", pathnameB) verbose && cat(verbose, "Suffix: ", suffix) # Drop suffix from backup pathname pattern <- sprintf("%s$", suffix) pattern <- gsub(".", "\\.", pattern, fixed=TRUE) pattern <- gsub("[\\$]+$", "$", pattern) pattern <- Arguments$getRegularExpression(pattern) verbose && cat(verbose, "Regular expression for suffix: ", pattern) # Assert that suffix exists in the temporary pathname if (!regexpr(pattern, "", pathnameB) == -1) { throw(sprintf("Cannot rename backup pathname. The specified temporary pathname does not contain the specified suffix ('%s'): %s", suffix, pathnameB)) } pathname <- gsub(pattern, "", pathnameB) verbose && cat(verbose, "Pathname: ", pathname) # If both backup and target pathname exists, should we drop the backup? if (drop && isFile(pathname) && isFile(pathnameB)) { verbose && enter(verbose, "Dropping backup file because target file already exists") res <- file.remove(pathnameB) verbose && cat(verbose, "Result: ", res) verbose && exit(verbose) verbose && exit(verbose) return(pathname) } pathname <- Arguments$getWritablePathname(pathname, mustNotExist=TRUE) if (isFile && isFile(pathnameB)) { if (drop) { verbose && enter(verbose, "Renaming existing backup file") res <- file.rename(pathnameB, pathname) verbose && cat(verbose, "Result: ", res) verbose && exit(verbose) } else { verbose && enter(verbose, "Copying existing backup file") res <- copyFile(pathnameB, pathname) verbose && cat(verbose, "Result: ", res) verbose && exit(verbose) } if (!isFile(pathname)) { throw("Failed to rename temporary file (final file does not exist): ", pathnameB, " -> ", pathname) } if (!drop) { if (isFile(pathnameB)) { throw("Failed to rename temporary file (temporary file still exists): ", pathnameB, " -> ", pathname) } } } # if (isFile) verbose && exit(verbose) pathname }) # popTemporaryFile() ����������������������������������������������������������������������R.utils/R/toCamelCase.R�����������������������������������������������������������������������������0000644�0001762�0000144�00000004705�14372747611�014340� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault toCamelCase # # @title "Converts a string of words into a merged camel-cased word" # # \description{ # @get "title", e.g. "a single espresso" is converted to "aSingleEspresso". # } # # @synopsis # # \arguments{ # \item{s}{A @character @vector.} # \item{capitalize}{If @TRUE, the first letter will be in upper case, # otherwise it will be in lower case.} # \item{preserveSameCase}{If @TRUE, words that are in all upper case # will remain as all same case words, e.g. acronyms.} # \item{split}{A pattern used to identify words. See @see "base::strsplit" # for more details.} # \item{...}{Not used.} # } # # \value{ # Returns a @character @vector. # } # # @examples "../incl/toCamelCase.Rex" # # @author # # \seealso{ # @see "R.utils::capitalize". # @see "base::chartr". # } # # @keyword programming # @keyword IO # @keyword internal #*/########################################################################### setMethodS3("toCamelCase", "default", function(s, capitalize=FALSE, preserveSameCase=FALSE, split="[ \t]+", ...) { # Argument 's': s <- as.character(s) # Nothing to do? if (length(s) == 0L) return(s) if (length(s) == 1L && (is.na(s) || nchar(s) == 0L)) return(s) # Split a single string ns <- nchar(s) s <- strsplit(s, split=split) s[ns == 0] <- "" if (preserveSameCase) { s <- lapply(s, FUN=function(s) { # Nothing to do? if (length(s) == 0L || identical(s, NA_character_)) return(s) # (a) Don't change case on all-upper case words sU <- toupper(s) isAllUpperCase <- is.element(s, sU) # (b) but for all others... s2 <- s[!isAllUpperCase] sL <- tolower(s2) isUpperCase <- (!is.element(s2, sL)) s3 <- capitalize(sL) s3[isUpperCase] <- s2[isUpperCase] s[!isAllUpperCase] <- s3 if (!capitalize) { if (!isAllUpperCase[1]) { s[1] <- decapitalize(s[1]) } else { s[1] <- tolower(s[1]) } } paste(s, collapse="") }) s <- unlist(s) } else { s <- lapply(s, FUN=function(s) { if (length(s) == 0L || identical(s, NA_character_)) return(s) s2 <- tolower(s) isUpperCase <- (!s %in% s2) s2 <- capitalize(s2) s2[isUpperCase] <- s[isUpperCase] paste(s2, collapse="") }) s <- unlist(s) if (!capitalize) { s <- decapitalize(s) } } s }, private=TRUE) �����������������������������������������������������������R.utils/R/intervalsToSeq.R��������������������������������������������������������������������������0000644�0001762�0000144�00000003010�14372747611�015127� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#########################################################################/** # @set "class=matrix" # @RdocMethod intervalsToSeq # # @title "Generates a vector of indices from a matrix of intervals" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{fromTo}{An Nx2 @integer @matrix.} # \item{sort}{If @TRUE, the returned indices are ordered.} # \item{unique}{If @TRUE, the returned indices are unique.} # \item{...}{Not used.} # } # # @author # # \examples{\dontrun{See example(seqToIntervals)}} # # \seealso{ # @see "seqToIntervals". # } # # @keyword "attribute" #*/#########################################################################t setMethodS3("intervalsToSeq", "matrix", function(fromTo, sort=FALSE, unique=FALSE, ...) { # Argument 'fromTo': if (ncol(fromTo) != 2) { throw("Argument 'fromTo' is not a two-column matrix: ", ncol(fromTo)) } if (!is.numeric(fromTo)) { throw("Argument 'fromTo' is not a numeric matrix: ", mode(fromTo)) } # Pre-allocate result vector ns <- fromTo[,2] - fromTo[,1] + as.integer(1) n <- sum(ns) res <- vector("integer", n) offset <- as.integer(0) for (rr in seq_len(nrow(fromTo))) { # Sequence for current interval idxs <- offset + 1:ns[rr] res[idxs] <- fromTo[rr,1]:fromTo[rr,2] # Not needed anymore idxs <- NULL # Next interval offset <- offset + ns[rr] } # Return unique indices? if (unique) { res <- unique(res) } # Return sorted indices? if (sort) { res <- sort(res) } res }) ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/isPackageLoaded.R�������������������������������������������������������������������������0000644�0001762�0000144�00000002115�14372747611�015151� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault isPackageLoaded # # @title "Checks if a package is loaded or not" # # \description{ # @get "title". # Note that, contrary to \code{\link[base:library]{require}()}, # this function does not load the package if not loaded. # } # # @synopsis # # \arguments{ # \item{package}{The name of the package.} # \item{version}{A @character string specifying the version to test for. # If @NULL, any version is tested for.} # \item{...}{Not used.} # } # # \value{ # Returns a @logical. # } # # @author # # \seealso{ # To check if a package is installed or not, see @see "isPackageInstalled". # } # # @keyword utilities # @keyword package #*/########################################################################### setMethodS3("isPackageLoaded", "default", function(package, version=NULL, ...) { s <- search() if (is.null(version)) { s <- sub("_[0-9.-]*", "", s) } else { package <- paste(package, version, sep="_") } pattern <- sprintf("package:%s", package) (pattern %in% s) }) ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/isAbsolutePath.R��������������������������������������������������������������������������0000644�0001762�0000144�00000002600�14372747611�015077� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault isAbsolutePath # # @title "Checks if this pathname is absolute" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{pathname}{A @character string of the pathname to be checked.} # \item{...}{Not used.} # } # # \value{ # Returns a @TRUE if the pathname is absolute, otherwise @FALSE. # } # # # # @author # # @keyword IO # @keyword programming #*/########################################################################### setMethodS3("isAbsolutePath", "default", function(pathname, ...) { # Argument 'pathname': pathname <- as.character(pathname) # BACKWARD COMPATIBILITY: Treat empty path specially? pathname <- .getPathIfEmpty(pathname, where="isAbsolutePath") nPathnames <- length(pathname) # Nothing to do? if (nPathnames == 0L) return(logical(0L)) # Multiple path to be checked? if (nPathnames > 1L) { res <- sapply(pathname, FUN=isAbsolutePath, ...) return(res) } # A missing pathname? if (is.na(pathname)) return(FALSE) # Recognize '~' paths if (regexpr("^~", pathname) != -1L) return(TRUE) # Windows paths if (regexpr("^.:(/|\\\\)", pathname) != -1L) return(TRUE) # Split pathname... components <- strsplit(pathname, split="[/\\]")[[1L]] if (length(components) == 0L) return(FALSE) (components[1L] == "") }) ��������������������������������������������������������������������������������������������������������������������������������R.utils/R/doCall.R����������������������������������������������������������������������������������0000644�0001762�0000144�00000005553�14372747611�013360� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#########################################################################/** # @RdocDefault doCall # # @title "Executes a function call with option to ignore unused arguments" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{.fcn}{A @function or a @character string specifying the name # of a @function to be called.} # \item{...}{Named arguments to be passed to the function.} # \item{args}{A @list of additional named arguments that will be appended # to the above arguments.} # \item{alwaysArgs}{A @list of additional named arguments that will be # appended to the above arguments and that will \emph{never} be ignore.} # \item{.functions}{A @list of @function:s or names of functions. This # can be used to control which arguments are passed.} # \item{.ignoreUnusedArgs}{If @TRUE, arguments that are not accepted by the # function, will not be passed to it. Otherwise, all arguments are passed.} # \item{envir}{An @environment in which to evaluate the call.} # } # # \examples{ # doCall("plot", x=1:10, y=sin(1:10), col="red", dummyArg=54, # alwaysArgs=list(xlab="x", ylab="y"), # .functions=c("plot", "plot.xy")) # } # # \seealso{ # @see "base::do.call". # } # # @author # # @keyword programming #*/######################################################################### setMethodS3("doCall", "default", function(.fcn, ..., args=NULL, alwaysArgs=NULL, .functions=list(.fcn), .ignoreUnusedArgs=TRUE, envir=parent.frame()) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument '.fcn': if (is.function(.fcn)) { } else if (is.character(.fcn)) { } else { stop("Argument '.fcn' must be a character string: ", mode(.fcn)) } # Argument '.functions': # Backward compatibility. /HB 2014-01-27 if (is.character(.functions)) { .functions <- as.list(.functions) } if (!is.list(.functions)) { stop("Argument '.functions' must be a list: ", mode(.functions)) } for (kk in seq_along(.functions)) { fcn <- .functions[[kk]] if (is.function(fcn)) next if (!exists(fcn, mode="function")) { stop("Argument '.functions' specifies a non-existing function: ", fcn) } fcn <- get(fcn, mode="function") .functions[[kk]] <- fcn } # Argument 'envir': .stop_if_not(is.environment(envir)) # Put all arguments in a list. args <- c(list(...), args) # Keep only arguments part accepted by a set of known functions if (.ignoreUnusedArgs && length(.functions) > 0L) { fcnArgs <- lapply(.functions, FUN=function(fcn) { names(formals(fcn)) }) fcnArgs <- unlist(fcnArgs, use.names=FALSE) keep <- intersect(names(args), fcnArgs) args <- args[keep] } args <- c(args, alwaysArgs) do.call(.fcn, args=args, envir=envir) }) # doCall() �����������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/saveObject.R������������������������������������������������������������������������������0000644�0001762�0000144�00000006371�14372747611�014246� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault saveObject # # @title "Saves an object to a file or a connection" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{object}{The object to be saved.} # \item{file}{A filename or @connection where the object should be saved. # If @NULL, the filename will be the hash code of the object plus ".xdr".} # \item{path}{Optional path, if \code{file} is a filename.} # \item{format}{File format.} # \item{compress}{If @TRUE, the file is compressed to, otherwise not.} # \item{...}{Other arguments accepted by \code{save()} in the base package.} # \item{safe}{If @TRUE and \code{file} is a file, then, in order to lower # the risk for incomplete files, the object is first written to a # temporary file, which is then renamed to the final name.} # } # # \value{ # Returns (invisibly) the pathname or the @connection. # } # # @author # # \seealso{ # @see "loadObject" to load an object from file. # @see "digest::digest" for how hash codes are calculated from an object. # See also @see "base::saveRDS". # } # # @keyword programming # @keyword IO #*/########################################################################### setMethodS3("saveObject", "default", function(object, file=NULL, path=NULL, format=c("auto", "xdr", "rds"), compress=TRUE, ..., safe=TRUE) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'format': format <- match.arg(format) # Infer 'format' from filename extension? Default is "xdr" if (format == "auto") { format <- tools::file_ext(file) format <- tolower(format) ## Here 'format' can be character(0L) or nchar(format) >= 0L if (!isTRUE(is.element(format, c("xdr", "rds")))) format <- "xdr" } # Argument 'file': if (is.null(file)) { requireNamespace("digest") || throw("Package not loaded: digest") file <- digest::digest(as.list(object)) # Might be slow. file <- sprintf("%s.%s", file, format) } saveToFile <- (!inherits(file, "connection")) if (saveToFile) { file <- filePath(path, file, expandLinks="any") } # Write to a temporary file? if (safe && saveToFile) { # Final pathname pathname <- file # Temporary pathname pathnameT <- sprintf("%s.tmp", pathname) if (file.exists(pathnameT)) { throw("Cannot save to file. Temporary file already exists: ", pathnameT) } # Write to a temporary file file <- pathnameT on.exit({ if (!is.null(pathnameT) && file.exists(pathnameT)) { file.remove(pathnameT) } }, add=TRUE) } if (format == "xdr") { saveLoadReference <- object base::save(saveLoadReference, file=file, ..., compress=compress, ascii=FALSE) } else if (format == "rds") { saveRDS(object, file=file, ascii=FALSE, compress=compress, ...) } # Rename temporary file? if (safe && saveToFile) { file.rename(pathnameT, pathname) if (!file.exists(pathname) || file.exists(pathnameT)) { throw("Failed to rename temporary file: ", pathnameT, " -> ", pathname) } pathnameT <- NULL file <- pathname } invisible(file) }) # saveObject() �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/mergeByCommonTails.R����������������������������������������������������������������������0000644�0001762�0000144�00000000573�14372747611�015717� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������mergeByCommonTails <- function(strs, collapse="", ...) { if (is.null(strs)) return(NULL) strs <- splitByCommonTails(strs) prefix <- strs[1,"prefix"] suffix <- strs[1,"suffix"] body <- strs[,"body"] # Collapse non-empty bodies body <- paste(body[nchar(body) > 0], collapse=collapse) str <- paste(prefix, body, suffix, sep="") str } # mergeByCommonTails() �������������������������������������������������������������������������������������������������������������������������������������R.utils/R/readTableIndex.R��������������������������������������������������������������������������0000644�0001762�0000144�00000003373�14372747611�015033� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������########################################################################/** # @RdocDefault readTableIndex # # @title "Reads a single column from file in table format" # # @synopsis # # \description{ # @get "title", which can then be used as a index-to-row (look-up) map # for fast access to a subset of rows using @see "readTable". # } # # \arguments{ # \item{indexColumn}{An single @integer of the index column.} # \item{colClass}{A single @character specifying the class of the # index column.} # \item{...}{Arguments passed to @see "readTable" used internally.} # \item{verbose}{A @logical or a @see "Verbose" object.} # } # # \value{ # Returns a @vector. # } # # \examples{\dontrun{ # # File containing data table to be access many times # filename <- "somefile.txt" # # # Create a look-up index # index <- readTableIndex(filename) # # # Keys of interest # keys <- c("foo", "bar", "wah") # # # Read only those keys and do it fast # df <- readTable(filename, rows=match(keys, index)) # }} # # @author # # \seealso{ # @see "readTable". # } # # @keyword IO #*/######################################################################### setMethodS3("readTableIndex", "default", function(..., indexColumn=1, colClass="character", verbose=FALSE) { # Argument 'indexColumn': if (is.numeric(indexColumn)) { indexColumn <- Arguments$getIndex(indexColumn) } else { indexColumn <- Arguments$getCharacter(indexColumn) } # Argument 'verbose': verbose <- Arguments$getVerbose(verbose) # Create column classes. readTable() will extend this to "NULL" if missing. colClasses <- c(rep("NULL", times=indexColumn-1), colClass) index <- readTable(..., colClasses=colClasses, defColClass="NULL", verbose=verbose) unname(index[[1]]) }) ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/LComments.R�������������������������������������������������������������������������������0000644�0001762�0000144�00000001440�14372747611�014052� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocClass LComments # # @title "The LComments class" # # \description{ # @classhierarchy # # @get "title". # # This class, is almost identical to the super class, except that the # constructor has different defaults. # } # # @synopsis # # \arguments{ # \item{letter}{The smart letter.} # \item{verboseName}{The name of the verbose object.} # \item{...}{Not used.} # } # # \section{Fields and Methods}{ # @allmethods # } # # @author # # @keyword programming # @keyword IO #*/########################################################################### setConstructorS3("LComments", function(letter="L", verboseName="log", ...) { extend(VComments(letter=letter, verboseName=verboseName), "LComments") }) ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/utils.R�����������������������������������������������������������������������������������0000644�0001762�0000144�00000000666�14372747611�013322� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������.stop_if_not <- function(...) { res <- list(...) n <- length(res) if (n == 0L) return() for (ii in 1L:n) { res_ii <- .subset2(res, ii) if (length(res_ii) != 1L || is.na(res_ii) || !res_ii) { mc <- match.call() call <- deparse(mc[[ii + 1]], width.cutoff = 60L) if (length(call) > 1L) call <- paste(call[1L], "...") stop(sQuote(call), " is not TRUE", call. = FALSE, domain = NA) } } } ��������������������������������������������������������������������������R.utils/R/zzz.R�������������������������������������������������������������������������������������0000644�0001762�0000144�00000005432�14525573024�013006� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������## covr: skip=all .onLoad <- function(libname, pkgname) { ns <- getNamespace(pkgname) pkg <- Package(pkgname) assign(pkgname, pkg, envir=ns, inherits=FALSE) # Set 'asGString' option via system environment variable value <- getOption("Arguments$getCharacters/args/asGString") if (is.null(value)) { value <- Sys.getenv("R.utils_asGString") if (nzchar(value)) { value <- isTRUE(as.logical(value)) options("Arguments$getCharacters/args/asGString"=value) } } # Set 'R.utils::onEmptyPath' option via system environment variable value <- getOption("R.utils::onEmptyPath") if (is.null(value)) { value <- Sys.getenv("R.utils_onEmptyPath") if (nzchar(value)) { options("R.utils::onEmptyPath"=value) } } } # .onLoad() .onAttach <- function(libname, pkgname) { pos <- which(sprintf("package:%s", pkgname) == search()) if (length(pos) == 1L) { # Add a default Verbose object at threshold -1. assign("verbose", Verbose(threshold=-1), pos=pos) # Patch for default parse() depending on R version # env <- as.environment("package:R.utils") # setMethodS3("parse", "default", appendVarArgs(base::parse), # conflict="quiet") # assign("parse.default", parse.default, pos=pos) # assignInNamespace("parse.default", parse.default, pos=pos) # Make .Last() call finalizeSession() when R finishes. tryCatch({ addFinalizerToLast() }, error=function(ex) { msg <- paste("The R.utils package may have failed to append a session finalizer to .Last(), because: ", ex$message, sep="") warning(msg, call.=FALSE, immediate.=TRUE) }) onSessionExit(function(...) detachPackage(pkgname)) } # if (length(pos) == 1L) pkg <- get(pkgname, envir=getNamespace(pkgname), inherits=FALSE) startupMessage(pkg) } # .onAttach() ########################################################################/** # @RdocFunction .Last.lib # @alias .Last.lib # # @title "Undo changed done by this package when detached" # # @synopsis # # \description{ # @get "title". # Reverts \code{.Last()} to the function that existed before this package # was attached. # } # # \arguments{ # \item{libpath}{a character string giving the complete path to the package.} # } # # \value{ # Returns nothing. # } # # @author # # @keyword "utilities" # @keyword "programming" # @keyword "internal" #*/######################################################################### .Last.lib <- function(libpath) { # Revert to original .Last() function .LastOriginal <- NULL # To please R CMD check R v2.6.0 if (exists(".LastOriginal", mode="function", envir=.GlobalEnv)) { env <- globalenv() # To please R CMD check assign(".Last", .LastOriginal, envir=env) rm(".LastOriginal", envir=.GlobalEnv) } } # .Last.lib() ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/hasUrlProtocol.R��������������������������������������������������������������������������0000644�0001762�0000144�00000001221�14372747611�015126� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault hasUrlProtocol # # @title "Checks if one or several pathnames has a URL protocol" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{pathname}{A @character @vector.} # \item{...}{Not used.} # } # # \value{ # Returns a @logical @vector. # } # # @author # # @keyword IO # @keyword programming #*/########################################################################### setMethodS3("hasUrlProtocol", "default", function(pathname, ...) { pattern <- "^([abcdefghijklmnopqrstuvwxyz]+)(://.*)" (regexpr(pattern, pathname) != -1) }) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/gcDLLs.R����������������������������������������������������������������������������������0000644�0001762�0000144�00000007221�14372747611�013264� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocFunction gcDLLs # @alias strayDLLs # # @title "Identifies and removes DLLs of packages already unloaded" # # \description{ # @get "title". # When packages are unloaded, they are ideally also unloading any # DLLs (also known as a dynamic shared object or library) they # have loaded. Unfortunately, not all package do this resulting # in "stray" DLLs still being loaded and occupying \R's limited # registry. These functions identifies and removes such DLLs. # } # # @synopsis # # \arguments{ # \item{gc}{If @TRUE, if there are stray DLLs, then the garbage collector is run before unloading those DLLs. This is done in order to trigger any finalizers, of which some may need those DLLs, to be called.} # \item{quiet}{If @FALSE, a message is outputted for every stray DLL that is unloaded.} # } # # \value{ # Returns (invisibly) the set of stray DLLs identified. # } # # \details{ # If a library fails to unload, an informative warning is generated. # } # # \section{How to unload DLLs in package (for package developers)}{ # To unload a package DLL whenever the package in unloaded, add the # following to your package: # \preformatted{ # .onUnload <- function(libpath) { # ## (1) Force finalizers to be called before removing the DLL # ## in case some of them need the DLL. # gc() # # ## (2) Unload the DLL for this package # library.dynam.unload(.packageName, libpath) # } # } # } # # @author # # \seealso{ # @see "base::getLoadedDLLs". # } #*/########################################################################### strayDLLs <- function() { ## All loaded DLLs dlls <- getLoadedDLLs() ## Drop R core DLLs ## Q. Is this really safe? Can there be other DLLs with these names? coreDLLs <- c("base", "graphics", "grDevices", "methods", "stats", "tools", "utils", "internet") keep <- !(names(dlls) %in% coreDLLs) dlls <- dlls[keep] ## Nothing to do? if (length(dlls) == 0) return(dlls) ## Identify DLLs part of packages files <- unlist(lapply(dlls, FUN = function(dll) dll[["path"]])) pkgdirs <- dirname(dirname(files)) metas <- file.path(pkgdirs, "Meta", "package.rds") keep <- utils::file_test("-f", metas) dlls <- dlls[keep] metas <- metas[keep] ## Nothing to do? if (length(dlls) == 0) return(dlls) ## Ignore those part of loaded namespaces pkgnames <- unlist(lapply(metas, FUN = function(meta) { readRDS(meta)$DESCRIPTION[["Package"]] })) keep <- !(pkgnames %in% loadedNamespaces()) dlls <- dlls[keep] pkgnames <- pkgnames[keep] dlls } ## strayDLLs() gcDLLs <- function(gc = TRUE, quiet = TRUE) { ## Find all package DLLs for which no package is loaded dlls <- strayDLLs() ## Nothing to do? if (length(dlls) == 0) return(dlls) ## Garbage collect to trigger finalizers that may still use some ## of these DLLs? See Karl Miller's comments in R-devel thread ## 'Request: Increasing MAX_NUM_DLLS in Rdynload.c' on 2016-12-20 ## https://stat.ethz.ch/pipermail/r-devel/2016-December/073537.html if (gc) gc(verbose = !quiet) ## Unload DLLs for (dll in dlls) { name <- dll[["name"]] path <- dll[["path"]] libpath <- dirname(dirname(path)) res <- tryCatch({ library.dynam.unload(name, libpath = libpath) TRUE }, error = identity) ## Failed to unload? if (inherits(res, "simpleError")) { msg <- sprintf("Failed to unload stray DLL %s (%s): %s", sQuote(name), path, conditionMessage(res)) warning(msg) } else if (!quiet) { message(sprintf("Unloaded stray DLL: %s (%s)", sQuote(name), path)) } } invisible(dlls) } �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/writeBinFragments.R�����������������������������������������������������������������������0000644�0001762�0000144�00000011000�14372747611�015574� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������########################################################################/** # @RdocDefault writeBinFragments # # @title "Writes binary data to disjoint sections of a connection or a file" # # @synopsis # # \description{ # @get "title". # } # # \arguments{ # \item{con}{A @connection or the pathname of an existing file.} # \item{object}{A @vector of objects to be written.} # \item{idxs}{A @vector of (non-duplicated) indices or a Nx2 @matrix # of N from-to index intervals specifying the elements to be read. # Positions are always relative to the start of the file/connection.} # \item{size}{The size of the data type to be read. If @NA, the natural # size of the data type is used.} # \item{...}{Additional arguments passed to # \code{\link[base:readBin]{writeBin}()}.} # } # # \value{ # Returns nothing. # } # # \examples{\dontrun{# See example(readBinFragments.connection)}} # # @author # # \seealso{ # @see "readBinFragments". # } # # @keyword IO #*/######################################################################### setMethodS3("writeBinFragments", "default", function(con, object, idxs, size=NA, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'con': if (is.character(con)) { pathname <- con pathname <- Arguments$getReadablePathname(pathname) con <- file(pathname, open="r+b") on.exit({ if (!is.null(con)) { close(con) con <- NULL } }) } else if (inherits(con, "connection")) { if (!isSeekable(con)) { t <- summary(con) t <- paste(sprintf("%s: %s", names(t), t), collapse=", ") msg <- sprintf("Argument 'con' is not a seekable connection: %s", t) action <- getOption("R.utils::onNonSeekable", "error") if (action == "warning") { warning(msg) } else { throw(msg) } } } # Argument 'idxs': if (is.matrix(idxs) || is.data.frame(idxs)) { if (ncol(idxs) != 2) { throw("When argument 'idxs' is a data frame, it must have exactly two columns: ", ncol(idxs)) } idxs <- as.matrix(idxs) } if (!is.numeric(idxs)) { stop("Argument 'idxs' must be numeric: ", class(idxs)[1]) } if (any(idxs < 0)) { throw("Argument 'idxs' contains negative indices: ", paste(head(idxs[idxs < 0]), collapse=", ")) } # Argument 'size': if (length(size) != 1) { stop("Argument 'size' must be a single value: ", length(size)) } if (is.na(size)) { # Calculating the natural size size <- as.integer(object.size(rep(object, length.out=1e4))/1e4) } else if (!is.numeric(size)) { stop("Argument 'size' must be numeric or NA: ", class(size)[1]) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Identify index intervals # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (is.matrix(idxs)) { oSeqs <- idxs # Sanity checks ## For now, we assume that non-overlapping intervals. /HB 2008-06-16 # Calculate lengths of intervals ns <- oSeqs[,2] - oSeqs[,1] + as.integer(1) nAll <- sum(ns) } else { # Number of elements to be written nAll <- length(idxs) # Order the indices o <- order(idxs) oIdxs <- as.integer(idxs)[o] # Reorder the input vector accordingly object <- object[o] # Not needed anymore o <- NULL # Identify contiguous fragments oSeqs <- seqToIntervals(oIdxs) # Calculate their lengths ns <- oSeqs[,2] - oSeqs[,1] + as.integer(1) # Sanity check if (nAll != sum(ns)) { stop("Argument 'idxs' does most likely contain replicated indices, which is currently not supported.") } } # Sanity check if (nAll != length(object)) { stop("The number of elements specified by argument 'idxs' does not match the number of objects written: ", nAll, " != ", size*length(object)) } # Starting positions (double in order to address larger vectors!) offset <- seek(con=con, origin="start", rw="write"); # Get current file offset froms <- as.double(oSeqs[,1])*size + (offset - size) # Not needed anymore oSeqs <- NULL outOffset <- 0 for (kk in seq_along(froms)) { n <- ns[kk] idx <- outOffset + 1:n seek(con=con, where=froms[kk], origin="start", rw="write") # print(list(idx=idx, where=froms[kk], n=n, values=object[idx])) writeBin(object[idx], con=con, size=size, ...) outOffset <- outOffset + n } # for (rr ...) invisible(NULL) }) # writeBinFragments() R.utils/R/isPackageInstalled.R����������������������������������������������������������������������0000644�0001762�0000144�00000001336�14372747611�015704� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault isPackageInstalled # # @title "Checks if a package is installed or not" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{package}{A @character @vector of package names.} # \item{...}{Not used.} # } # # \value{ # Returns a @logical @vector. # } # # @author # # \seealso{ # @see "isPackageLoaded". # } # # @keyword utilities # @keyword package #*/########################################################################### setMethodS3("isPackageInstalled", "default", function(package, ...) { suppressWarnings({ paths <- sapply(package, FUN=function(p) system.file(package=p)) }) (paths != "") }) ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/beta/�������������������������������������������������������������������������������������0000755�0001762�0000144�00000000000�14372747611�012742� 5����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/beta/Options.ui.Rtodo���������������������������������������������������������������������0000644�0001762�0000144�00000003166�14372747611�016030� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������setMethodS3("getArguments", "Options", function(static, method=NA, ...) { # Should return a named list of constructor arguments with elements # being character string vectors specifying the data types/classes # accepted by each argument. clazz <- Class$fromName(class(static)[1]); if (is.na(method)) { # The constructor args <- formals(clazz); } else { method <- as.character(method); # Any other method of the class } }, static=TRUE) setMethodS3("getProperties", "Options", function(static, ...) { }, static=TRUE) setMethodS3("setProperty", "Options", function(this, name, value, ...) { name <- as.character(name); if (length(name) != 1) throw("Argument 'name' must be a single character string: ", paste(name, collapse=", ")); # Assign the value to the property. this$name <- value; }) setMethodS3("fromProperties", "Options", function(static, properties, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'properties': if (!is.list(properties)) throw("Argument 'properties' is not a list: ", mode(properties)); # Create an instance of the same class as 'static'. clazz <- Class$fromName(class(static)[1]); object <- newInstance(clazz); # Populate it with the specified properties for (kk in seq_along(properties)) { name <- names(properties)[kk]; value <- properties[[kk]]; setProperty(object, name, value); } # Return the new instance object; }, static=TRUE) ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/beta/singularPlural.Rtrial����������������������������������������������������������������0000644�0001762�0000144�00000001066�14372747611�017130� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������setMethodS3("singularPlural", "numeric", function(count, singular, plural=NULL, pluralSuffix="s", fmtstr="%g", ...) { count <- sprintf(fmtstr, as.numeric(count)); if (as.integer(count) == as.integer(1)) { noun <- singular; } else { if (is.null(plural)) plural <- paste(singular, pluralSuffix, sep=""); noun <- plural; } sprintf("%s %s", count, noun); }) ########################################################################### # HISTORY: # 2005-07-07 # o Created. ########################################################################### ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/attachLocally.R���������������������������������������������������������������������������0000644�0001762�0000144�00000005261�14525572273�014742� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������########################################################################/** # @class list # @RdocMethod attachLocally # @alias attachLocally.data.frame # @alias attachLocally.environment # @alias attachLocally # # @title "Assigns an objects elements locally" # # @synopsis # # \description{ # @get "title". # } # # \arguments{ # \item{object}{An object with named elements such as an @environment, # a @list, or a @data.frame.} # \item{fields}{A @character @vector specifying elements to be copied. # If @NULL, all elements are considered.} # \item{excludeFields}{A @character @vector specifying elements not to # be copied. This has higher priority than \code{fields}.} # \item{overwrite}{If @FALSE, fields that already exists will not be # copied.} # \item{envir}{The @environment where elements are copied to.} # \item{...}{Not used.} # } # # \value{ # Returns (invisibly) a @character @vector of the fields copied. # } # # @examples "../incl/attachLocally.Rex" # # @author # # \seealso{ # \code{\link[R.oo:attachLocally.Object]{attachLocally}()} of class Object. # @see "base::attach". # } # # @keyword "utilities" # @keyword "programming" #*/######################################################################### setMethodS3("attachLocally", "list", function(object, fields=NULL, excludeFields=NULL, overwrite=TRUE, envir=parent.frame(), ...) { if (is.null(fields)) { fields <- names(object) # Don't try to attach non-named elements fields <- setdiff(fields, "") } # Note: we cannot do 'fields <- setdiff(fields, excludeFields)', because # that will also remove duplicates! attachedFields <- character(0L) for (field in fields) { if (field %in% excludeFields) next if (overwrite || !exists(field, envir=envir, inherits=FALSE)) { assign(field, object[[field]], envir=envir) # Remove field this way a 2nd field of the same name can # be attached (and overwrite the first one) object[[field]] <- NULL attachedFields <- c(attachedFields, field) } } invisible(attachedFields) }) setMethodS3("attachLocally", "environment", function(object, fields=NULL, excludeFields=NULL, overwrite=TRUE, envir=parent.frame(), ...) { if (is.null(fields)) { fields <- ls(envir=object) } fields <- setdiff(fields, excludeFields) attachedFields <- character(0L) for (field in fields) { if (overwrite || !exists(field, envir=envir, inherits=FALSE)) { assign(field, object[[field]], envir=envir) attachedFields <- c(attachedFields, field) } } invisible(attachedFields) }) setMethodS3("attachLocally", "data.frame", function(..., envir=parent.frame()) { attachLocally.list(..., envir=envir) }) �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/moveInSearchPath.R������������������������������������������������������������������������0000644�0001762�0000144�00000007202�14372747611�015353� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault moveInSearchPath # # @title "Moves a environment in the search path to another position" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{from}{An @integer specifying the position of the environment # to be moved, or a @character specifying the name of the environment # to be moved.} # \item{to}{The destination position like the \code{from} argument.} # \item{where}{A @character string specify where in relation to the # destination position the environment should be moved.} # \item{...}{Not used.} # } # # \value{ # Returns (invisibly) the name of the environment moved, if it was # moved, otherwise @NULL. # } # # \details{ # It is not possible to move the first environment in the search path, # i.e. the so called global environment. # } # # \examples{ # # Make package 'utils' come behind 'datasets' in the search path # moveInSearchPath("package:utils", "package:datasets", where="after") # } # # @author # # \seealso{ # @see "base::search". # } # # @keyword programming # @keyword internal #*/########################################################################### setMethodS3("moveInSearchPath", "default", function(from, to, where=c("before", "after"), ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Local functions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Please R CMD check attachX <- base::attach # WORKAROUND for R (<= 3.1.0) if (getRversion() <= "3.1.0") { # base::attach() sends messages about masked objects # to stdout and not to stderr. This redirects such messages. # See R-devel thread 'attach() outputs messages to stdout - should # it be stderr?' on 2014-04-06. # This was patched in R v3.1.0 r65385 (2014-04-08) attachX <- function(...) { msg <- capture.output({ res <- base::attach(...) }) if (length(msg) > 0L) cat(msg, sep="\n", file=stderr()) invisible(res) } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Get the current search path searchPath <- search() nPath <- length(searchPath) # Argument 'from': if (is.character(from)) { name <- from from <- match(name, searchPath) if (is.na(from)) throw("Argument 'from' specifies an environment not in the search path: ", name) } else { from <- Arguments$getIndices(from, range=c(2, nPath)) } # Argument 'to': if (is.character(to)) { name <- to to <- match(to, searchPath) if (is.na(to)) throw("Argument 'to' specifies an environment not in the search path: ", name) } else { to <- Arguments$getIndices(to, range=c(2, nPath)) } # Argument 'where': where <- match.arg(where) if (where == "after") to <- to + 1 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Move the environment # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Nothing to do? if (from == to) return(invisible()) # Get environment to be moved env <- pos.to.env(from) # Detach old position without side effects .detachPlain(from) if (to > from) to <- to - 1 # Attach at new position attachX(env, pos=to, name=attr(env, "name")) # Restore attributes (patch for bug in attach()? /HB 2007-09-17) attrs <- attributes(env) env <- as.environment(attr(env, "name")) attributes(env) <- attrs # Return the name of the environment moved. invisible(attr(env, "name")) }) ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/mapToIntervals.R��������������������������������������������������������������������������0000644�0001762�0000144�00000005700�14372747611�015124� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������########################################################################/** # @set "class=numeric" # @RdocMethod mapToIntervals # # @title "Maps values to intervals" # # @synopsis # # \description{ # @get "title" by returning an index @vector specifying the (first) # interval that each value maps to, if any. # } # # \arguments{ # \item{x}{A @numeric @vector of K values to be matched.} # \item{intervals}{The N intervals to be matched against. # If an Nx2 @numeric @matrix, the first column should be the lower # bounds and the second column the upper bounds of each interval. # If a @numeric @vector of length 2N, each consecutive pair should # be the lower and upper bounds of an interval. # } # \item{includeLower, includeUpper}{If @TRUE, the lower (upper) bound # of \emph{each} interval is included in the test, otherwise not.} # \item{...}{Not used.} # } # # \value{ # Returns an @integer @vector of length K. # Values that do not map to any interval have return value @NA. # } # # @author # # \seealso{ # @see "inAnyInterval". # @see "base::match". # @see "base::findInterval". # @see "base::cut". # } # # @keyword "utilities" # @keyword "programming" #*/######################################################################### setMethodS3("mapToIntervals", "numeric", function(x, intervals, includeLower=TRUE, includeUpper=TRUE, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'x': if (!is.numeric(x)) { throw("Argument 'x' is not numeric: ", mode(x)[1]) } # Argument 'intervals': if (length(intervals) %% 2 != 0) { throw("Argument 'intervals' does not contain an even number of values: ", length(intervals)) } asMatrix <- is.matrix(intervals) if (!asMatrix) { intervals <- matrix(intervals, ncol=2, byrow=TRUE) } else if (ncol(intervals) != 2) { throw("Argument 'intervals' is not a matrix with two columns: ", ncol(intervals)) } # Setup test function if (includeLower && includeUpper) { isInside <- function(x, interval, ...) { (interval[1] <= x & x <= interval[2]) } } else if (includeLower && !includeUpper) { isInside <- function(x, interval, ...) { (interval[1] <= x & x < interval[2]) } } else if (!includeLower && includeUpper) { isInside <- function(x, interval, ...) { (interval[1] < x & x <= interval[2]) } } else if (!includeLower && !includeUpper) { isInside <- function(x, interval, ...) { (interval[1] < x & x < interval[2]) } } map <- rep(NA_integer_, times=length(x)) nbrOfIntervals <- nrow(intervals) for (kk in seq_len(nbrOfIntervals)) { rr <- (nbrOfIntervals - kk + 1L) ll <- isInside(x, intervals[rr,]) map[ll] <- rr } map }) # mapToIntervals() ����������������������������������������������������������������R.utils/R/isReplicated.R����������������������������������������������������������������������������0000644�0001762�0000144�00000002440�14372747611�014562� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocFunction isReplicated # @alias replicates # # @title "Identifies all entries with replicated values" # # \description{ # @get "title", that is, with values that exist more than once. # } # # \usage{ # isReplicated(x, ...) # replicates(x, ...) # } # # \arguments{ # \item{x}{A @vector of length K.} # \item{...}{Additional arguments passed to @see "base::duplicated".} # } # # \value{ # A @logical @vector of length K, # where @TRUE indicates that the value exists elsewhere, # otherwise not. # } # # \details{ # Let \code{reps <- isReplicated(x)}. Then it always holds that: # \itemize{ # \item \code{reps == rev(isReplicated(rev(x)))} # \item \code{reps == duplicated(x) | duplicated(x, fromLast=TRUE)} # \item \code{reps == !is.element(x, setdiff(x, unique(x[duplicated(x)])))} # } # } # # @examples "../incl/isReplicated.Rex" # # @author # # \seealso{ # Internally @see "base::duplicated" is used. # See also @see "isSingle". # } #*/########################################################################### isReplicated <- function(x, ...) { dupsF <- duplicated(x, ...) dupsR <- duplicated(x, ..., fromLast=TRUE) (dupsF | dupsR) } replicates <- function(x, ...) { x[isReplicated(x, ...)] } ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/queryRCmdCheck.R��������������������������������������������������������������������������0000644�0001762�0000144�00000005506�14372747611�015031� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocFunction queryRCmdCheck # # @title "Gets the on R CMD check if the current R session was launched by it" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns @character string # \code{"checkingTests"} if 'R CMD check' runs one one of the package tests, # and \code{"checkingExamples"} if it runs one of the package examples. # If the current R session was not launched by 'R CMD check', # then \code{"notRunning"} is returned. # } # # \section{Limitations}{ # This function only works if the working directory has not been changed. # } # # @examples "../incl/queryRCmdCheck.Rex" # # @author #*/########################################################################### queryRCmdCheck <- function(...) { evidences <- list() # Memoization evidences[["R_CMD_CHECK"]] <- isTRUE(as.logical(Sys.getenv("R_CMD_CHECK"))) # Command line arguments args <- commandArgs() evidences[["vanilla"]] <- is.element("--vanilla", args) # Check the working directory; any components containing <pkg>.Rcheck/tests evidences[["pwd"]] <- FALSE path <- getwd() last_path <- "" while (path != last_path) { last_path <- path if (basename(path) == "tests") { if (grepl(".+[.]Rcheck$", dirname(path))) { evidences[["pwd"]] <- TRUE break } } path <- dirname(path) } # Is 'R CMD check' checking examples? evidences[["examples"]] <- is.element("CheckExEnv", search()) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Conclusions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (evidences$R_CMD_CHECK) { res <- "R_CMD_CHECK" } else if (!evidences[["vanilla"]]) { res <- "notRunning" } else if (evidences[["examples"]]) { res <- "checkingExamples" } else if (evidences[["pwd"]]) { res <- "checkingTests" } else { res <- "notRunning" } # Make it stick if (res != "notRunning") { Sys.setenv(R_CMD_CHECK = "true") } attr(res, "evidences") <- evidences if (isTRUE(as.logical(Sys.getenv("R_R_CACHE_DEBUG")))) { file <- file.path("~", ".cache", "R", sprintf("R.cache-%d.log", Sys.getpid())) dir.create(file, recursive = TRUE, showWarnings = FALSE) cat(paste(utils::capture.output({ cat(sprintf("Call: %s\n", paste(commandArgs(), collapse = " "))) cat(sprintf("PID: %s\n", Sys.getpid())) cat(sprintf("pwd: %s\n", getwd())) cat(sprintf("search(): %s\n", paste(sQuote(search()), collapse = ", "))) cat(sprintf("R_CMD_CHECK: %s\n", sQuote(Sys.getenv("R_CMD_CHECK", NA_character_)))) cat(sprintf("queryRCmdCheck(): %s\n", sQuote(queryRCmdCheck()))) cat("-------------\n") }), collapse = "\n"), "\n", file = file) } res } ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/FileListTree.R����������������������������������������������������������������������������0000644�0001762�0000144�00000003573�14372747611�014515� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������setMethodS3("toFileListTree", "character", function(x, depth=-1, dirsFirst=TRUE, ...) { if (length(x) == 0 || depth == 0) return() pattern <- "^([^/\\]*[/\\])(.*)" heads <- gsub(pattern, "\\1", x) tails <- gsub(pattern, "\\2", x) isLeave <- (tails == x) if (sum(isLeave) > 0) { leaves <- heads[isLeave] class(leaves) <- "FileListTree" leaves <- list(leaves) names(leaves) <- "." heads <- heads[!isLeave] tails <- tails[!isLeave] } else { leaves <- NULL } # Then children uheads <- sort(unique(heads)) tailOutput <- vector("list", length(uheads)) names(tailOutput) <- uheads for (head in uheads) { idxs <- which(heads == head) tree <- toFileListTree(tails[idxs], depth=depth-1, dirsFirst=dirsFirst, ...) tailOutput[[head]] <- tree } if (dirsFirst) { output <- c(tailOutput, leaves) } else { output <- c(leaves, tailOutput) } class(output) <- "FileListTree" output }, private=TRUE) setMethodS3("pasteTree", "FileListTree", function(x, indent=" ", nodeStr=" ", childStr="+-", collapse=NULL, .totalIndent="", ...) { if (length(x) == 0) return() s <- c() if (!is.list(x)) { x <- paste(.totalIndent, childStr, x, sep="") s <- c(s, x) if (!is.null(collapse)) s <- paste(s, collapse=collapse) return(s) } .nextTotalIndent <- paste(indent, .totalIndent, sep="") names <- names(x) for (kk in seq_along(x)) { values <- x[[kk]] name <- names[kk] if (name != ".") s <- c(s, paste(.totalIndent, nodeStr, name, sep="")) s <- c(s, pasteTree(values, indent=indent, .totalIndent=.nextTotalIndent, ...)) } if (!is.null(collapse)) s <- paste(s, collapse=collapse) s }, private=TRUE) setMethodS3("cat", "FileListTree", function(x, collapse="\n", ...) { s <- pasteTree(x, ..., collapse=collapse) cat(s, collapse=collapse) invisible(s) }, private=TRUE) �������������������������������������������������������������������������������������������������������������������������������������R.utils/R/Assert.R����������������������������������������������������������������������������������0000644�0001762�0000144�00000012074�14372747611�013417� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocClass Assert # # @title "The Assert class" # # \description{ # @classhierarchy # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \section{Fields and Methods}{ # @allmethods # } # # @author #*/########################################################################### setConstructorS3("Assert", function(...) { extend(Object(), "Assert" ) }) #########################################################################/** # @RdocMethod isScalar # # @title "Static method asserting that an object is a single value" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{x}{Object to be checked.} # \item{...}{Not used.} # } # # \value{ # Returns (invisibly) @TRUE, or throws an exception. # } # # @author # # \seealso{ # @seeclass # } #*/######################################################################### setMethodS3("isScalar", "Assert", function(static, x, ...) { name <- as.character(substitute(x)) if (length(x) != 1) throw("Argument '", name, "' is not a scalar.") if (is.matrix(x)) throw("Argument '", name, "' is not a scalar.") invisible(TRUE) }, static=TRUE) #########################################################################/** # @RdocMethod isVector # # @title "Static method asserting that an object is a vector" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{x}{Object to be checked.} # \item{length}{Required length. If @NULL, this is not checked.} # \item{...}{Not used.} # } # # \value{ # Returns (invisibly) @TRUE, or throws an exception. # } # # @author # # \seealso{ # @seeclass # } #*/######################################################################### setMethodS3("isVector", "Assert", function(static, x, length=NULL, ...) { name <- as.character(substitute(x)) if (!is.vector(x)) throw("Argument '", name, "' is not a vector.") if (!is.null(length) && length(x) != length) throw("Argument '", name, "' is not a vector of length ", length, ": ", length(x)) invisible(TRUE) }, static=TRUE) #########################################################################/** # @RdocMethod isMatrix # # @title "Static method asserting that an object is a matrix" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{x}{Object to be checked.} # \item{nrow}{Required number of rows. If @NULL, this is not checked.} # \item{ncol}{Required number of columns. If @NULL, this is not checked.} # \item{...}{Not used.} # } # # \value{ # Returns (invisibly) @TRUE, or throws an exception. # } # # @author # # \seealso{ # @seeclass # } #*/######################################################################### setMethodS3("isMatrix", "Assert", function(static, x, nrow=NULL, ncol=NULL, ...) { name <- as.character(substitute(x)) if (!is.matrix(x)) throw("Argument '", name, "' is not a matrix.") if (!is.null(nrow) && nrow(x) != nrow) { throw("Argument '", name, "' is not a matrix with ", nrow, " rows: ", nrow(x)) } if (!is.null(ncol) && ncol(x) != ncol) { throw("Argument '", name, "' is not a matrix with ", ncol, " columns: ", ncol(x)) } invisible(TRUE) }, static=TRUE) #########################################################################/** # @RdocMethod inheritsFrom # @alias inheritsFrom # # @title "Static method asserting that an object inherits from of a certain class" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{object}{Object to be checked.} # \item{class}{Name of class.} # \item{...}{Not used.} # } # # \value{ # Returns (invisibly) @TRUE, or throws an exception. # } # # @author # # \seealso{ # @seeclass # } #*/######################################################################### setMethodS3("inheritsFrom", "Assert", function(static, object, class, ...) { name <- as.character(substitute(x)) if (!inherits(object, class)) throw("Argument '", name, "' does not inherit from class '", class, "': ", paste(class(class), collapse=", ")) invisible(TRUE) }, static=TRUE) #########################################################################/** # @RdocMethod check # # @title "Static method asserting that a generic condition is true" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{condition}{A condition that should return @TRUE if ok, or something # else if not.} # \item{message}{The error message to be reported on failure. If @NULL, # a message is automatically created.} # \item{...}{Not used.} # } # # \value{ # Returns (invisibly) @TRUE, or throws an exception. # } # # @author # # \seealso{ # @seeclass # } #*/######################################################################### setMethodS3("check", "Assert", function(static, condition, message=NULL, ...) { if (!identical(condition, TRUE)) { if (is.null(message)) { message <- paste(as.character(substitute(condition)), collapse=" ") message <- paste("A condition was not met: ", message, sep="") } throw(message) } invisible(TRUE) }, static=TRUE) ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/shell.exec2.R�����������������������������������������������������������������������������0000644�0001762�0000144�00000005113�14372747611�014266� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocFunction shell.exec2 # # @title "Open a file or URL using Windows File Associations" # # @synopsis # # \description{ # @get "title" using \code{shell.exec()} but makes some tweaks # to filenames to make them more likely to be opened properly. # # \emph{This function is only applicable on Windows systems.} # } # # \arguments{ # \item{file}{A @character string specifying a file or an URL.} # } # # \value{ # Returns nothing. # } # # \details{ # Before passing a \emph{file} on the file system to # \code{shell.exec()}, this function: # (i) unmaps any mapped drive letters used in the pathname # (e.g. 'X:/foo.bar.html' to 'C:/Users/Joe/bar.html'), # (ii) and replaces any forward slashed with backward ones # (e.g. 'C:/Users/Joe/bar.html' to 'C:\\Users\\Joe\\bar.html'). # URLs are passed as is to \code{shell.exec()}. # # The reason for (i) is that some web browsers (e.g. Google Chrome) # will not open files on mapped drives. # The reason for (ii) is that if forward slashes are used, then # \code{shell.exec()} will give an error that the file was # not found (at least with the default Windows shell). # } # # \section{Setting on startup}{ # The intended usage of this function is to set it as the default # browser for @see "utils::browseURL". Just add the following to # your @see ".Rprofile" file: # \preformatted{ # if (.Platform$OS.type == "windows") # options(browser=function(...) R.utils::shell.exec2(...)) # } # This will only load (not attach) the \pkg{R.utils} package # when the browser function is actual used. # } # # @author # # @keyword file # @keyword IO #*/########################################################################### shell.exec2 <- function(file) { if (file_test("-f", file)) { ## WORKAROUND #1: Some web browser won't open files on ## mapped Windows drives. Here we "undo" those mappings, ## e.g. 'X:/foo/bar.html' -> 'C:/path/to/foo/bar.html'. file <- filePath(file, unmap=TRUE) ## WORKAROUND #2: browseURL('foo/bar.html') does not work ## on Windows, because it calls shell.exec('foo/bar.html') ## which only works if it's shell.exec('foo\bar.html'). opwd <- getwd() on.exit(setwd(opwd)) setwd(dirname(file)) file <- basename(file) } # To please R CMD check on non-Windows systems, we call # shell.exec() such that it looks like were' calling a # local function. shell.exec <- get("shell.exec", mode="function", envir=getNamespace("base")) shell.exec(file) } # shell.exec2() �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/lastModified.R����������������������������������������������������������������������������0000644�0001762�0000144�00000002130�14372747611�014552� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault lastModified # # @title "Gets the time when the file was last modified" # # \description{ # @get "title". The time is returned as a \code{POSIXct} object. # } # # @synopsis # # \arguments{ # \item{pathname}{A @character string of the pathname to be checked.} # \item{...}{Not used.} # } # # \value{ # Returns \code{POSIXct} object specifying when the file was last modified. # If the file does not exist or it is a directory, \code{0} is returned. # } # # \section{Symbolic links}{ # This function follows symbolic links (also on Windows) and returns a # value based on the link target (rather than the link itself). # } # # @author # # \seealso{ # Internally @see "base::file.info" is used. # } # # @keyword IO # @keyword programming #*/########################################################################### setMethodS3("lastModified", "default", function(pathname, ...) { pathname <- as.character(pathname) if (!file.exists(pathname)) return(0) info <- file.info2(pathname) info$mtime }) ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/mpager.R����������������������������������������������������������������������������������0000644�0001762�0000144�00000002747�14372747611�013437� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocFunction mpager # # @title "A \"pager\" function that outputs to standard error" # # \description{ # @get "title" and is compatible with @see "base::file.show". # } # # @synopsis # # \arguments{ # \item{files}{A @character @vector of K pathnames.} # \item{header}{A @character @vector of K headers.} # \item{title}{A @character string.} # \item{delete.file}{If @TRUE, the files are deleted after displayed, # otherwise not.} # } # # \value{ # Returns nothing. # } # # @author # # \seealso{ # @see "base::file.show" and argument \code{pager}. # } # # @keyword programming # @keyword IO # @keyword file #*/########################################################################### mpager <- function(files, header=NULL, title="R Information", delete.file=FALSE) { mbar <- function(ch="-", width=getOption("width")-1L) { mprintf("%s\n", paste(rep(ch, times=width), collapse="")) } if (length(title) > 0L && is.character(title) && nchar(title) > 0L) { mbar("=") mprintf("%s\n", title) mbar("=") mcat("\n") } for (ii in seq_along(files)) { file <- files[ii] hdr <- header[ii] if (length(hdr) > 0L && is.character(hdr) && nchar(hdr) > 0L) { if (ii > 1L) mcat("\n") mbar("-") mprintf("%s\n", hdr) mbar("-") } bfr <- readLines(file) mcat(bfr, sep="\n", collapse="\n") if (delete.file) { file.remove(file) } } } # mpager() �������������������������R.utils/R/extract.array.R���������������������������������������������������������������������������0000644�0001762�0000144�00000005527�14525546077�014755� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @set "class=array" # @RdocMethod extract # @alias extract.matrix # @alias extract.default # # @title "Extract a subset of an array, matrix or a vector with unknown dimensions" # # \description{ # @get "title". # # This method is useful when you do not know the number of dimensions # of the object your wish to extract values from, cf. example. # } # # @synopsis # # \arguments{ # \item{x}{An @array or a @matrix.} # \item{...}{These arguments are by default put into the # \code{indices} @list.} # \item{indices}{A @list of index @vectors to be extracted.} # \item{dims}{An @vector of dimensions - one per element # in \code{indices} - which will be coerced to @integers. # If @NULL, it will default to \code{seq_along(indices)}.} # \item{drop}{If @TRUE, dimensions of length one are dropped, # otherwise not.} # } # # \value{ # Returns an @array. # } # # @examples "../incl/extract.array.Rex" # # @author # # \seealso{ # @see "base::slice.index" # } # # @keyword programming #*/########################################################################### setMethodS3("extract", "array", function(x, ..., indices=list(...), dims=names(indices), drop=FALSE) { # Argument 'indices': nindices <- length(indices) if (nindices == 0L) { throw("Argument 'indices' is empty.") } # Argument 'dims': if (is.null(dims)) { dims <- seq_len(nindices) } else { # (i) Try to match to dimnames(x) dimnames <- dimnames(x) if (!is.null(dimnames)) { dimsT <- match(dims, names(dimnames)) if (!all(is.na(dimsT))) { dims <- dimsT } } if (!is.integer(dims)) { dims <- as.integer(dims) } } ndim <- length(dim(x)) if (any(dims < 1L | dims > ndim)) { throw("Argument 'dims' is out of bounds [1,", ndim, "]: ", paste(dims, collapse=", ")) } if (is.null(ndim)) throw("Argument 'x' is not an array: ", class(x)[1L]) args <- rep("", times=ndim) for (kk in seq_along(indices)) { dd <- dims[kk] args[dd] <- sprintf("indices[[%d]]", kk) } if (ndim > 1L) args <- c(args, sprintf("drop=%s", drop)) args <- paste(args, collapse=",") code <- paste("x[", args, "]", sep="") expr <- parse(text=code) eval(expr, enclos = baseenv()) }) setMethodS3("extract", "matrix", function(x, ...) { extract.array(x, ...) }) setMethodS3("extract", "default", function(x, ...) { if (is.vector(x) && !is.list(x)) { dim <- c(length(x), 1L) dimnames <- list(names(x), "") dim(x) <- dim dimnames(x) <- dimnames # Not needed anymore dim <- dimnames <- NULL x <- extract(x, ...) names <- dimnames(x)[[1L]] x <- as.vector(x) names(x) <- names x } else { throw("Do not know how to unwrap object: ", class(x)[1L]) } }) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/cmdArgs.R���������������������������������������������������������������������������������0000644�0001762�0000144�00000013446�14372747611�013542� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#########################################################################/** # @RdocFunction cmdArgs # @alias cmdArg # # @title "Simple access to parsed command-line arguments" # # \description{ # @get "title". # } # # \usage{ # cmdArgs(@eval "t<-formals(R.utils::cmdArgs);paste(gsub('=$', '', paste(names(t), t, sep='=')), collapse=', ')") # cmdArg(@eval "t<-formals(R.utils::cmdArg);paste(gsub('=$', '', paste(names(t), t, sep='=')), collapse=', ')") # } # # \arguments{ # \item{args}{A named @list of arguments.} # \item{names}{A @character @vector specifying the arguments to be # returned. If @NULL, all arguments are returned.} # \item{unique}{If @TRUE, only unique arguments are returned.} # \item{...}{ # For \code{cmdArgs()}, additional arguments passed to # @see "commandArgs", e.g. \code{defaults} and \code{always}. # For \code{cmdArg()}, named arguments \code{name} and # \code{default}, where \code{name} must be a @character string # and \code{default} is an optional default value (if not given, # it's @NULL). Alternatively, \code{name} and \code{default} can # be given as a named argument (e.g. \code{n=42}).} # \item{.args}{(advanced/internal) A named @list of parsed # command-line arguments.} # } # # \value{ # \code{cmdArgs()} returns a named @list with command-line arguments. # \code{cmdArg()} return the value of the requested command-line argument. # } # # \section{Coercing to non-character data types}{ # The value of each command-line argument is returned as a @character # string, unless an argument share name with ditto in the (optional) # arguments \code{always} and \code{default} in case the retrieved # value is coerced to that of the latter. # Finally, remaining character string command-line arguments are # coerced to @numerics (via @see "base::as.numeric"), if possible, # that is unless the coerced value becomes @NA. # } # # @author # # @examples "../incl/cmdArgs.Rex" # # \seealso{ # Internally, @see "commandArgs" is used. # } # # @keyword "programming" #*/######################################################################### cmdArgs <- function(args=NULL, names=NULL, unique=TRUE, ..., .args=NULL) { # Argument 'args': if (identical(args, "*")) args <- list("*") if (!is.null(args)) { if (!is.list(args)) { throw("Argument 'args' must a list or NULL: ", class(args)[1L]) } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Default call? # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (is.null(args)) { res <- commandArgs(asValues=TRUE, adhoc=TRUE, unique=unique, excludeReserved=TRUE, ..., .args=.args) res <- res[-1L] if (!is.null(names)) { res <- res[names] } return(res) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Split 'args' into 'defaults', 'args', and 'always' # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Find the asterisk ('*') if (length(args) == 0L) { idxA <- integer(0L) } else { idxA <- which(sapply(args, FUN=identical, "*")) # Use only first asterisk if more than one is used if (length(idxA) > 1L) { excl <- idxA[-1L] args <- args[excl] idxA <- idxA[1L] } } # None? if (length(idxA) == 0L) { defaults <- NULL always <- args args <- character(0L) } else { n <- length(args); # Here n >= 1 idxsD <- if (idxA == 1L) integer(0L) else 1:(idxA-1L) idxsF <- if (idxA == n) integer(0L) else (idxA+1L):n defaults <- args[idxsD] always <- args[idxsF] args <- .args } res <- commandArgs(asValues=TRUE, defaults=defaults, always=always, adhoc=TRUE, unique=unique, excludeReserved=TRUE, .args=args, ...) if (is.null(args)) { res <- res[-1L] } if (!is.null(names)) { res <- res[names] } res } # cmdArgs() cmdArg <- function(...) { # Argument '...' => (name, default, ...) pargs <- .parseArgs(list(...), defaults=alist(name=, default=NULL)) # Special short format, e.g. cmdArg(n=42)? args <- pargs$args if (!is.element("name", names(args))) { argsT <- pargs$namedArgs if (length(argsT) == 0L) { stop("Argument 'name' is missing (or NULL).") } args$name <- names(argsT)[1L] args$default <- argsT[[1L]] argsT <- argsT[-1L] pargs$args <- args pargs$namedArgs <- argsT } args <- Reduce(c, pargs) # Argument 'name': name <- as.character(args$name) .stop_if_not(length(name) == 1L) # Call cmdArgs(names=name, defaults=list(<name>=default), ...) args$names <- name args$name <- NULL args$defaults <- list(args$default) names(args$defaults) <- args$names args$default <- NULL res <- do.call(cmdArgs, args=args) res[[1]] } # cmdArg() #########################################################################/** # @RdocFunction cmdArgsCall # # @title "Calls an R function passing command-line arguments" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Arguments passed to @see "doCall", including the function # to be called.} # \item{args}{A @list of arguments to be passed to the function # being called.} # \item{.ignoreUnusedArgs}{Passed to @see "doCall".} # \item{envir}{An @environment in which to evaluate the call.} # } # # \value{ # Returns whatever the called function returns. # } # # @author # # \examples{\dontrun{ # Rscript -e R.utils::cmdArgsCall(rnorm) n=4 # }} # # \seealso{ # Internally, @see "cmdArgs" and @see "doCall" is used. # } # # @keyword programming # @keyword internal #*/######################################################################### cmdArgsCall <- function(..., args=cmdArgs(unique=FALSE), .ignoreUnusedArgs=FALSE, envir=parent.frame()) { doCall(..., args=args, .ignoreUnusedArgs=.ignoreUnusedArgs, envir=envir) } # cmdArgsCall() ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/insert.R����������������������������������������������������������������������������������0000644�0001762�0000144�00000012521�14372747611�013457� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#########################################################################/** # @RdocDefault insert # # @title "Insert values to a vector at certain positions" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{x}{The @vector of data values.} # \item{ats}{The indices of \code{x} where the values should be inserted.} # \item{values}{A @list or a @vector of the values to be inserted. # Should be of same length as \code{ats}, unless if a single value # when it is automatically extended without a warning.} # \item{useNames}{If @FALSE, the names attribute is dropped/ignored, # otherwise not. Only applied if argument \code{x} is named.} # \item{...}{Not used.} # } # # @examples "../incl/insert.Rex" # # \seealso{ # @see "base::append" takes argument \code{after} (a scalar). For example, # \code{append(x, y, after=after) == insert(x, values=y, ats=after+1)}. # Contrary to \code{append()}, \code{insert()} accepts a vector of insert indices. # } # # @author # # @keyword "manip" #*/#########################################################################t setMethodS3("insert", "default", function(x, ats, values=NA, useNames=TRUE, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Local functions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # For debug only! ## printFromTo <- function(from, to, x) { ## fromto <- matrix(c(from, to), ncol=2) ## colnames(fromto) <- c("from", "to") ## idx <- apply(fromto, MARGIN=1, FUN=function(i) seqToHumanReadable(i[1]:i[2])) ## xidx <- apply(fromto, MARGIN=1, FUN=function(i) paste(x[i[1]:i[2]], collapse=",")) ## print(data.frame(from=from, to=to, idx=idx, x.=xidx)) ## } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (!is.vector(x)) throw("Argument 'x' is not a vector: ", class(x)) len <- length(x) if (any(ats < 1 | ats > len+1)) throw("Argument 'ats' contains indices out of range: ", paste(ats, collapse=", ")) if (!is.vector(values) && !is.list(values)) throw("Argument 'values' is not a vector or a list: ", class(values)) alen <- length(ats) vlen <- length(values) if (vlen != alen && alen > 1L && vlen > 1L) { throw("Argument 'ats' and argument 'values' are of different lengths: ", alen, " != ", vlen) } # Argument 'useNames': useNames <- as.logical(useNames) # Deal with the names attribute too? if (useNames) { names <- names(x) useNames <- (!is.null(names)) } # Group 'ats'? dups <- duplicated(ats) if (any(dups)) { uats <- ats[!dups] alen <- length(uats) t <- vector("list", length = alen) for (kk in seq_len(alen)) { at <- uats[[kk]] t[[kk]] <- values[which(at == ats)] } ats <- uats values <- t at <- t <- uats <- NULL vlen <- length(values) if (vlen != alen) { throw("Argument 'ats' and argument 'values' are of different lengths: ", alen, " != ", vlen) } } dups <- NULL if (!is.list(values)) { if (alen == 1L) { values <- list(values) vlen <- 1L } else { values <- as.list(values) } } if (alen != vlen) { if (vlen == 1L) { values <- rep(values, length.out=alen) vlen <- alen } else { throw("Argument 'ats' and argument 'values' are of different lengths: ", alen, " != ", vlen) } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Setup # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Sort the 'ats' indicies o <- order(ats) ats <- ats[o] values <- values[o] nvalues <- unlist(lapply(values, FUN=length)) # Allocate the result vector n2 <- length(x) + sum(nvalues) x2 <- vector(mode=mode(x), length=n2) storage.mode(x2) <- storage.mode(x) if (useNames) names2 <- character(n2) # 'ats' positions in the result vector n <- length(ats) ats2 <- ats + c(0, cumsum(nvalues[-n])) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Assign inserted values # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - for (kk in 1:length(ats2)) { idx2 <- ats2[kk] + 0:(nvalues[kk]-1) valuesKK <- values[[kk]] x2[idx2] <- valuesKK if (useNames) { valueNames <- names(valuesKK) if (is.null(valueNames)) valueNames <- character(length(valuesKK)) names2[idx2] <- valueNames } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Assign original values # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - froms <- c(1, ats) tos <- c(ats-1, length(x)) froms2 <- c(1, ats2+nvalues) if (ats[1] == 1) { froms <- froms[-1] tos <- tos[-1] froms2 <- froms2[-1] } if (ats[n] > length(x)) { froms <- froms[-length(froms)] tos <- tos[-length(tos)] froms2 <- froms2[-length(froms2)] } ns <- tos-froms+1 tos2 <- froms2 + ns - 1 for (kk in seq_along(froms2)) { from <- froms[kk] to <- tos[kk] from2 <- froms2[kk] to2 <- tos2[kk] idx <- from:to idx2 <- from2:to2 x2[idx2] <- x[idx] if (useNames) names2[idx2] <- names[idx] } if (useNames) names(x2) <- names2 x2 }) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/withOptions.R�����������������������������������������������������������������������������0000644�0001762�0000144�00000004163�14525546077�014510� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocFunction withOptions # # @title "Evaluate an R expression with options set temporarily" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{expr}{The R expression to be evaluated.} # \item{...}{Named options to be used.} # \item{args}{(optional) Additional named options specified as a named @list.} # \item{substitute}{If @TRUE, argument \code{expr} is # \code{\link[base]{substitute}()}:ed, otherwise not.} # \item{envir}{The @environment in which the expression should be evaluated.} # } # # \value{ # Returns the results of the expression evaluated. # } # # \details{ # Upon exit (also on errors), this function will reset \emph{all} # options to the state of options available upon entry. This means # any options \emph{modified} but also those \emph{added} when # evaluating \code{expr} will also be undone upon exit. # } # # @author # # @examples "../incl/withOptions.Rex" # # \seealso{ # Internally, @see "base::eval" is used to evaluate the expression. # and @see "base::options" to set options. # } # # @keyword IO # @keyword programming #*/########################################################################### withOptions <- function(expr, ..., args=list(), substitute=TRUE, envir=parent.frame()) { # Argument 'expr': if (substitute) expr <- substitute(expr) # Argument 'args': if (!is.list(args)) { throw("Argument 'args' is not a list: ", class(args)[1L]) } # Argument 'envir': if (!is.environment(envir)) { throw("Argument 'envir' is not a list: ", class(envir)[1L]) } # All options specified new <- c(list(...), args) # Set options temporarily (restore *all* upon exit) prev <- options() on.exit({ # Reset existing options options(prev) # Drop any added ones added <- setdiff(names(options()), names(prev)) if (length(added) > 0L) { drop <- vector("list", length=length(added)) names(drop) <- added options(drop) } }) if (length(new) > 0L) options(new) eval(expr, envir = envir, enclos = baseenv()) } # withOptions() �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/displayCode.R�����������������������������������������������������������������������������0000644�0001762�0000144�00000013454�14372747611�014421� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault displayCode # # @title "Displays the contents of a text file with line numbers and more" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{con}{A @connection or a @character string filename. # If \code{code} is specified, this argument is ignored.} # \item{code}{A @character @vector of code lines to be displayed.} # \item{numerate}{If @TRUE, line are numbers, otherwise not.} # \item{lines}{If a single @numeric, the maximum number of lines to show. # If -1, all lines are shown. If a @vector of @numeric, the lines # numbers to display.} # \item{wrap}{The (output) column @numeric where to wrap lines.} # \item{highlight}{A @vector of line number to be highlighted.} # \item{pager}{If \code{"none"}, code is not displayed in a pager, but # only returned. For other options, see @see "base::file.show".} # \item{...}{Additional arguments passed to @see "base::file.show", # which is used to display the formatted code.} # } # # \value{ # Returns (invisibly) the formatted code as a @character string. # } # # @examples "../incl/displayCode.Rex" # # @author # # \seealso{ # @see "base::file.show". # } # # @keyword file # @keyword IO #*/########################################################################### setMethodS3("displayCode", "default", function(con=NULL, code=NULL, numerate=TRUE, lines=-1, wrap=79, highlight=NULL, pager=getOption("pager"), ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'lines': if (!is.numeric(lines)) throw("Argument 'lines' must be numeric: ", mode(lines)) lines <- unique(as.integer(lines)) if (length(lines) == 1) { if (is.na(lines)) lines <- -1 } else if (length(lines) > 1) { if (any(lines <= 0)) { throw("Argument 'lines' must be positive: [", min(lines), ",", max(lines), "]") } } # Argument 'code': if (!is.null(code)) { code <- Arguments$getCharacters(code, asGString=FALSE) code <- gsub("\r\n|\n\r|\r", "\n", code) code <- unlist(strsplit(code, split="\n")) pathname <- "R code" } # Argument 'con': if (is.null(code)) { if (is.character(con)) { pathname <- Arguments$getReadablePathname(con, mustExist=TRUE) code <- readLines(pathname, n=max(lines), warn=FALSE) } else if (inherits(con, "connection")) { pathname <- summary(con)$description code <- readLines(con, n=max(lines), warn=FALSE) } else { throw("Argument 'con' must be a filename or a connection: ", class(con)[1]) } } # Argument 'numerate': numerate <- Arguments$getLogical(numerate) # Argument 'wrap': if (length(wrap) != 1) { throw("Argument 'wrap' must be a single number: ", paste(wrap, collapse=", ")) } if (any(!is.finite(wrap))) throw("Argument 'wrap' is non-finite: ", wrap) # Argument 'highlight': if (is.character(highlight)) { # Find line number in 'highlight' string. For example, by passing # geterrmessage() we can automatigally highlight the erroneous line. pattern <- ".*(line|row)(|s) ([0-9][0-9]*).*" if (regexpr(pattern, highlight) != -1) { highlight <- gsub(pattern, "\\3", highlight) highlight <- as.integer(highlight) } } if (!is.null(highlight) && all(is.na(highlight))) { highlight <- NULL } else { highlight <- unique(as.integer(highlight)) } # Argument 'pager': if (is.function(pager)) { } else { pager <- Arguments$getCharacter(pager) } nlines <- length(code) if (nlines == 0) return() # Number the read lines numbers <- as.integer(seq_len(nlines)) # Prepare highlight marks marks <- rep(" ", times=nlines) marks[highlight] <- "*" if (length(lines) > 1) { # Ignore lines not read lines <- lines[lines <= length(code)] code <- code[lines] numbers <- numbers[lines] marks <- marks[lines] } if (all(marks == " ")) marks <- NULL # Create right-aligned line number strings if (numerate) { width <- nchar(as.character(nlines)) fmtstr <- paste("%", width, "d", sep="") numbers <- sprintf(fmtstr, numbers) } else { numbers <- NULL } # Create the line prefixes if (!is.null(marks) || !is.null(numbers)) { prefix <- paste(marks, numbers, "|", sep="") width <- nchar(prefix[1]) emptyPrefix <- paste(paste(rep(" ", times=width-1), collapse=""), "|", sep="") } else { prefix <- NULL width <- 0 emptyPrefix <- NULL } # Create output lines by wrapping the lines, but not the line numbers if (wrap > 0) { wrap <- wrap - width code2 <- c() for (kk in seq_along(code)) { if (nchar(code[kk]) <= wrap) { line <- paste(prefix[kk], code[kk], sep="") } else { # Wrap line at positions: wrapAt <- seq(from=1, to=nchar(code[kk]), by=wrap) line <- c() while (length(wrapAt) > 0) { line <- c(line, substr(code[kk], 1, wrap)) code[kk] <- substring(code[kk], wrap+1) wrapAt <- wrapAt[-1] } indent <- prefix[kk] if (length(emptyPrefix) > 0L) { indent <- c(indent, rep(emptyPrefix, length.out=length(line)-1)) } line <- paste(indent, line, sep="") } code2 <- c(code2, line) } code <- code2 } code <- paste(code, collapse="\n") code <- paste(code, "\n", sep="") if (!is.null(pager) && !identical(pager, "none")) { tmpfile <- tempfile() cat(file=tmpfile, code) file.show(tmpfile, title=pathname, delete.file=TRUE, pager=pager, ...) } invisible(code) }) ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/touchFile.R�������������������������������������������������������������������������������0000644�0001762�0000144�00000005705�14372747611�014103� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault touchFile # # @title "Updates the timestamp of a file" # # \description{ # @get "title". # Currently, it is only possible to change the timestamp specifying when # the file was last modified, and time can only be set to the current time. # } # # @synopsis # # \arguments{ # \item{pathname}{A @character @vector specifying files to be updated.} # \item{...}{Not used.} # } # # \value{ # Returns (invisibly) a @vector of the old timestamps. # } # # @examples "../incl/touchFile.Rex" # # @author # # \seealso{ # Internally, @see "base::Sys.setFileTime" (iff available) and # @see "base::file.info" are utilized. # } # # \references{ # [1] R-devel mailing list thread # \emph{Unix-like touch to update modification timestamp of file?}, # started on 2008-02-26. # \url{https://stat.ethz.ch/pipermail/r-devel/2008-February/048542.html}\cr # } # # @keyword programming # @keyword IO # @keyword file #*/########################################################################### setMethodS3("touchFile", "default", function(pathname, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Local functions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Sys.setFileTime() exists in R (>= 2.14.0) if (!exists("Sys.setFileTime", mode="function")) { Sys.setFileTime <- function(path, ...) { info <- file.info(pathname) if (info$isdir) { stop(sprintf("In R v%s, it is not possible to change the timestamp of a directory: %s", getRversion(), pathname)) } con <- NULL on.exit({ if (!is.null(con)) close(con) }) # Zero-sized files have to be treated specially if (info$size == 0) { con <- file(pathname, open="w") } else { con <- file(pathname, open="r+b") seek(con=con, where=0, origin="start", rw="read") bfr <- readBin(con=con, what=raw(), n=1) seek(con=con, where=0, origin="start", rw="write") writeBin(con=con, bfr) } invisible(TRUE) } # Sys.setFileTime() } # if (!exists("Sys.setFileTime", ...)) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'pathname': pathname <- as.character(pathname) nPathnames <- length(pathname) # Nothing to do? if (nPathnames == 0L) return(invisible(NULL)) # Multiple files? if (nPathnames > 1L) { res <- lapply(pathname, FUN=touchFile, ...) res <- Reduce(c, res) return(invisible(res)) } # Sanity check if (!file.exists(pathname)) stop("No such file: ", pathname) info <- file.info(pathname) oldTimestamp <- info$mtime if (!Sys.setFileTime(pathname, time=Sys.time())) { stop("Failed to set timestamp: ", pathname) } invisible(oldTimestamp) }) �����������������������������������������������������������R.utils/R/isFile.R����������������������������������������������������������������������������������0000644�0001762�0000144�00000003630�14372747611�013367� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault isFile # # @title "Checks if the file specification is a file" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{pathname}{A @character string of the pathname to be checked.} # \item{...}{Not used.} # } # # \value{ # Returns @TRUE if the file specification is a file, otherwise # @FALSE is returned. # } # # \section{Symbolic links}{ # This function follows symbolic links (also on Windows) and returns a # value based on the link target (rather than the link itself). # } # # @author # # \seealso{ # To check if it is a directory see @see "isDirectory". # Internally @see "base::file.info" is used. # See also @see "utils::file_test". # } # # @keyword IO # @keyword programming #*/########################################################################### setMethodS3("isFile", "default", function(pathname, ...) { # Argument 'pathname': pathname <- as.character(pathname) # BACKWARD COMPATIBILITY: Treat empty path specially? pathname <- .getPathIfEmpty(pathname, where="isFile") nPathnames <- length(pathname) # Nothing to do? if (nPathnames == 0L) return(logical(0L)) # Multiple pathnames to be checked? if (nPathnames > 1L) { res <- sapply(pathname, FUN=isFile, ...) return(res) } # A missing pathname? if (is.na(pathname)) return(FALSE) isdir <- file.info(pathname)$isdir if (identical(isdir, FALSE)) return(TRUE) if (is.na(isdir)) { if (!isAbsolutePath(pathname)) return(FALSE) # Try the relative pathname relPathname <- getRelativePath(pathname) # Avoid infinite recursive loops; check if succeeded in getting a # relative pathname? if (!identical(relPathname, pathname)) { return(isFile(relPathname)) } else { # At this point, we can only return FALSE. return(FALSE) } } return(FALSE) }) ��������������������������������������������������������������������������������������������������������R.utils/R/gcat.R������������������������������������������������������������������������������������0000644�0001762�0000144�00000002346�14372747611�013075� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault gcat # @alias gcat.GString # # @title "Parses, evaluates and outputs a GString" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{@character strings passed to @see "gstring".} # \item{file}{A @connection, or a pathname where to direct the output. # If \code{""}, the output is sent to the standard output.} # \item{append}{Only applied if \code{file} specifies a pathname # If @TRUE, then the output is appended to the file, otherwise # the files content is overwritten.} # \item{envir}{The @environment in which the @see "GString" is evaluated.} # } # # \value{ # Returns (invisibly) a @character string. # } # # @author # # \seealso{ # @see "gstring". # } #*/########################################################################### setMethodS3("gcat", "GString", function(..., file="", append=FALSE, envir=parent.frame()) { s <- gstring(..., envir=envir) cat(s, file=file, append=append) invisible(s) }) setMethodS3("gcat", "default", function(..., file="", append=FALSE, envir=parent.frame()) { s <- gstring(..., envir=envir) cat(s, file=file, append=append) invisible(s) }) ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/filePath.R��������������������������������������������������������������������������������0000644�0001762�0000144�00000031673�14372747611�013720� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault filePath # # @title "Construct the path to a file from components and expands Windows Shortcuts along the pathname from root to leaf" # # @synopsis # # \description{ # @get "title". This function is backward compatible with # @see "base::file.path" when argument \code{removeUps=FALSE} and # \code{expandLinks="none"}, except that a (character) @NA is # return if any argument is NA. # # This function exists on all platforms, not only Windows systems. # } # # \arguments{ # \item{...}{Arguments to be pasted together to a file path and then be # parsed from the root to the leaf where Windows shortcut files are # recognized and expanded according to argument \code{which} in each # step.} # \item{fsep}{the path separator to use.} # \item{removeUps}{If @TRUE, relative paths, for instance "foo/bar/../" # are shortened into "foo/", but also "./" are removed from the final # pathname, if possible.} # \item{expandLinks}{A @character string. If \code{"none"}, Windows # Shortcut files are ignored. If \code{"local"}, the absolute target # on the local file system is used. If \code{"relative"}, the relative # target is used. If \code{"network"}, the network target is used. If # \code{"any"}, first the local, then the relative and finally the # network target is searched for.} # \item{unmap}{If @TRUE, paths on mapped Windows drives are "followed" # and translated to their corresponding "true" paths.} # \item{mustExist}{If @TRUE and if the target does not exist, the original # pathname, that is, argument \code{pathname} is returned. In all other # cases the target is returned.} # \item{verbose}{If @TRUE, extra information is written while reading.} # } # # \value{ # Returns a @character string. # } # # \details{ # If \code{expandLinks != "none"}, each component, call it \emph{parent}, # in the absolute path is processed from the left to the right as follows: # 1. If a "real" directory of name \emph{parent} exists, it is followed. # 2. Otherwise, if Microsoft Windows Shortcut file with name # \emph{parent.lnk} exists, it is read. If its local target exists, that # is followed, otherwise its network target is followed. # 3. If no valid existing directory was found in (1) or (2), the expanded # this far followed by the rest of the pathname is returned quietly. # 4. If all of the absolute path was expanded successfully the expanded # absolute path is returned. # } # # \section{On speed}{ # Internal \code{file.exists()} is call while expanding the pathname. # This is used to check if there exists a Windows shortcut file named # 'foo.lnk' in 'path/foo/bar'. If it does, 'foo.lnk' has to be followed, # and in other cases 'foo' is ordinary directory. # The \code{file.exists()} is unfortunately a bit slow, which is why # this function appears slow if called many times. # } # # @examples "../incl/filePath.Rex" # # @author # # \seealso{ # @see "readWindowsShellLink". # @see "readWindowsShortcut". # @see "base::file.path". # } # # @keyword IO #*/########################################################################### setMethodS3("filePath", "default", function(..., fsep=.Platform$file.sep, removeUps=TRUE, expandLinks=c("none", "any", "local", "relative", "network"), unmap=FALSE, mustExist=FALSE, verbose=FALSE) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Local functions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - getWindowsDrivePattern <- function(fmtstr, ...) { # Windows drive letters drives <- "ABCDEFGHIJKLMNOPQRSTUVWXYZ" # Support also lower case drives <- paste(c(drives, tolower(drives)), collapse="") sprintf(fmtstr, drives) } # getWindowsDrivePattern() unmapOnWindows <- function(pathname, ...) { if (.Platform$OS.type != "windows") return(pathname) if (!file.exists(pathname)) return(pathname) isAbs <- isAbsolutePath(pathname) if (!isAbs) pathname <- getAbsolutePath(pathname) pattern <- getWindowsDrivePattern("^([%s]:)(/.*)$") drive <- gsub(pattern, "\\1", pathname) drive <- tolower(drive) # NOTE: Identifying mapped drives introduces a delay. # Should this be memomized? /HB 2014-10-02 drives <- System$getMappedDrivesOnWindows() names(drives) <- tolower(names(drives)) target <- drives[drive] if (!is.na(target)) { pathname <- paste(target, gsub(pattern, "\\2", pathname), sep="") } # Undo absolute path? if (!isAbs) pathname <- getRelativePath(pathname) pathname } # unmapOnWindows() removeEmptyDirs <- function(pathname) { # Check if it is a pathname on a Windows network isOnNetworkBwd <- (regexpr("^\\\\\\\\", pathname) != -1L) isOnNetworkFwd <- (regexpr("^//", pathname) != -1L) # Remove empty directories pathname <- gsub("///*", "/", pathname) pathname <- gsub("\\\\\\\\\\\\*", "\\\\", pathname) # If on a network, add the path back again. if (isOnNetworkBwd) { pathname <- paste("\\\\", pathname, sep="") pathname <- gsub("^\\\\\\\\\\\\*", "\\\\\\\\", pathname) } if (isOnNetworkFwd) { pathname <- paste("//", pathname, sep="") pathname <- gsub("^///*", "//", pathname) } pathname } # removeEmptyDirs() removeUpsFromPathname <- function(pathname, split=FALSE) { # Treat C:, ... special pattern <- getWindowsDrivePattern("^[%s]:$") if (regexpr(pattern, pathname) != -1L) return(pathname) # Treat C:/, C:\\, ... specially pattern <- getWindowsDrivePattern("^[%s]:[/\\]$") if (regexpr(pattern, pathname) != -1L) return(gsub("\\\\", "/", pathname)) # Split path into the individual components components <- strsplit(pathname, split="[/\\]")[[1L]] # Get the root, if it exists rootPath <- components[1] if (rootPath %in% c(".", "..")) rootPath <- NA_character_ # Remove all "." parts, because they are non-informative if (length(components) > 1L) { components <- components[components != "."] # But if they're all dropped (e.g. ././././) then # return '.' if (length(components) == 0L) return(".") } # Remove ".." and its parent by reading from the left(!) pos <- 2L while (pos >= 2L && pos <= length(components)) { if (components[pos] == ".." && components[pos-1L] != "..") { # Remove the ".." and its parent, if possible if (pos == 2L && identical(components[1], rootPath)) { ## Not possible, e.g. /foo/.. and C:/.. break } if (verbose) { message("Removing: ", paste(components[c(pos-1L,pos)], collapse=", ")) } components <- components[-c(pos-1L,pos)] pos <- pos - 1L } else { pos <- pos + 1L } } pathname <- components if (!split) { pathname <- paste(pathname, collapse=fsep) pattern <- getWindowsDrivePattern("^[%s]:$") if (regexpr(pattern, pathname) != -1L) { pathname <- sprintf("%s/", pathname) } } pathname } # removeUpsFromPathname() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Arguments '...': args <- list(...) # First, remove NULL and other empty arguments isEmpty <- unlist(lapply(args, FUN=function(x) (length(x) == 0L))) args <- args[!isEmpty] # Second, convert into character strings args <- lapply(args, FUN=as.character) # Argument 'expandLinks': expandLinks <- match.arg(expandLinks) # Argument 'unmap': unmap <- as.logical(unmap) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Create pathname # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (length(args) == 0L) { return(NULL) } if (any(sapply(args, FUN=is.na))) { return(NA_character_) } pathname <- paste(args, collapse=fsep) # Remove repeated '/' and '\\'. pathname <- removeEmptyDirs(pathname) if (expandLinks == "none") { if (removeUps) { pathname <- removeUpsFromPathname(pathname) } # Undo Windows drive mapping? if (unmap) pathname <- unmapOnWindows(pathname) return(pathname) } # Treat C:/, C:\\, ... special pattern <- getWindowsDrivePattern("^[%s]:[/\\]$") if (regexpr(pattern, pathname) != -1L) { pathname <- gsub("\\\\", "/", pathname) } # Undo Windows drive mapping? if (unmap) pathname <- unmapOnWindows(pathname) # Requires that the 'pathname' is a absolute pathname. pathname0 <- pathname # 1. Remove ".." and their parents and keep "splits". components <- removeUpsFromPathname(pathname, split=TRUE) # 3. Expand the components from the root into a new absolute pathname isFirst <- TRUE expandedPathname <- NULL while(length(components) > 0L) { # Get next component component <- components[1L] components <- components[-1L] # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # a. Create the pathname to check # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (isFirst) { pathname <- component } else { pathname <- paste(expandedPathname, component, sep=fsep) } if (verbose) { print(pathname) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # b. Is it an explicit Windows Shortcut? # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - isWindowsShortcut <- (regexpr("[.](lnk|LNK)$", pathname) != -1L) if (isWindowsShortcut) { # i. ...then follow it. lnkFile <- pathname } else { # ii. otherwise, check if the pathname exists if (file.exists(pathname)) { expandedPathname <- pathname isFirst <- FALSE next } if (isFirst) { isFirst <- FALSE if (file.exists(paste(pathname, "", sep=fsep))) { expandedPathname <- pathname next } } # iii. If not, assert that a Windows shortcut exists lnkFile <- paste(pathname, c("lnk", "LNK"), sep=".") lnkFile <- lnkFile[file.exists(lnkFile)] if (length(lnkFile) == 0L) { if (verbose) { message("Failed to expand pathname '", pathname0, "'. No target found for: ", pathname) } break } lnkFile <- lnkFile[1L] } # if (isWindowsShortcut) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # c. Try to read Windows shortcut # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - lnk <- tryCatch({ # (i) using new reader readWindowsShellLink(lnkFile) }, error=function(ex) { # (ii) using old reverse-enginered reader tryCatch({ readWindowsShortcut(lnkFile) }, error=function(ex) { if (verbose) { message("Invalid Windows shortcut found when expanding pathname '", pathname0, "': ", lnkFile) print(ex) } return(NULL) }) }) # Failed to read Windows Shell Link, then don't continue if (is.null(lnk)) { break } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # d. Check for a local pathname and then for a network pathname # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - pathname <- NULL if (expandLinks == "any") { pathname <- lnk$pathname if (is.null(pathname)) { pathname <- lnk$relativePathname if (is.null(pathname)) { pathname <- lnk$networkPathname } } } else if (expandLinks == "local") { pathname <- lnk$pathname } else if (expandLinks %in% c("relative")) { if (is.null(expandedPathname)) { expandedPathname <- removeUpsFromPathname(pathname0) } pathname <- paste(expandedPathname, lnk$relativePathname, sep=fsep) if (removeUps) { pathname <- removeUpsFromPathname(pathname) } } else if (expandLinks %in% c("network")) { pathname <- lnk$networkPathname } if (is.null(pathname)) { if (verbose) { message("No target found in Windows shortcut when expanding pathname '", pathname0, "': ", lnkFile) } break } expandedPathname <- pathname } # while(...) # Are there any remaining components. if (length(components) > 0L) { if (mustExist) { pathname <- pathname0 } else { pathname <- paste(pathname, paste(components, collapse=fsep), sep=fsep) } } if (is.null(pathname)) { if (mustExist) { pathname <- pathname0 } else { stop(sprintf("Failed to expand file path (expandLinks=c(%s)): %s", paste(sQuote(expandLinks), collapse=", "), pathname0)) } } if (removeUps && !is.null(pathname)) { pathname <- removeUpsFromPathname(pathname) } # Undo Windows drive mapping? if (unmap) pathname <- unmapOnWindows(pathname) pathname }) # filePath() ���������������������������������������������������������������������R.utils/R/hpaste.R����������������������������������������������������������������������������������0000644�0001762�0000144�00000005375�14372747611�013450� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault hpaste # # @title "Concatenating vectors into human-readable strings" # # \description{ # @get "title" such as "1, 2, 3, ..., 10". # } # # @synopsis # # \arguments{ # \item{...}{Arguments to be pasted.} # \item{sep}{A @character string used to concatenate the arguments # in \code{...}, if more than one.} # \item{collapse, lastCollapse}{The @character strings to collapse # the elements together, where \code{lastCollapse} is specifying # the collapse string used between the last two elements. # If \code{lastCollapse} is @NULL (default), it is corresponds # to using the default collapse.} # \item{maxHead, maxTail, abbreviate}{Non-negative @integers (also @Inf) # specifying the maximum number of elements of the beginning and # then end of the vector to be outputted. If \code{n = length(x)} # is greater than \code{maxHead+maxTail+1}, then \code{x} is # truncated to consist of \code{x[1:maxHead]}, \code{abbreviate}, # and \code{x[(n-maxTail+1):n]}.} # \item{empty}{A @character string, or \code{character(0)} (default), # to be returned in case the result is of length zero.} # } # # \value{ # Returns a @character string. # } # # \details{ # \code{hpaste(..., sep=" ", maxHead=Inf)} corresponds to # \code{paste(..., sep=" ", collapse=", ")}. # } # # @author # # @examples "../incl/hpaste.Rex" # # \seealso{ # Internally @see "base::paste" is used. # } # # @keyword programming #*/########################################################################### setMethodS3("hpaste", "default", function(..., sep="", collapse=", ", lastCollapse=NULL, maxHead=if (missing(lastCollapse)) 3 else Inf, maxTail=if (is.finite(maxHead)) 1 else Inf, abbreviate="...", empty = character(0L)) { # Argument 'maxHead': maxHead <- Arguments$getNumeric(maxHead, range=c(0, Inf)) # Argument 'maxTail': maxTail <- Arguments$getNumeric(maxTail, range=c(0, Inf)) # Argument 'empty': if (is.null(empty)) empty <- character(0L) stopifnot(is.character(empty), length(empty) <= 1L) if (is.null(lastCollapse)) { lastCollapse <- collapse } # Build vector 'x' x <- paste(..., sep=sep) n <- length(x) # Nothing todo? if (n == 0) return(empty) if (is.null(collapse)) return(x) # Abbreviate? if (n > maxHead + maxTail + 1) { head <- x[seq_len(maxHead)] tail <- rev(rev(x)[seq_len(maxTail)]) x <- c(head, abbreviate, tail) n <- length(x) } # Nothing todo? if (n == 0) return(empty) if (!is.null(collapse) && n > 1) { if (lastCollapse == collapse) { x <- paste(x, collapse=collapse) } else { xT <- paste(x[1:(n-1)], collapse=collapse) x <- paste(xT, x[n], sep=lastCollapse) } } x }) # hpaste() �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/copyDirectory.R���������������������������������������������������������������������������0000644�0001762�0000144�00000005577�14372747611�015027� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault copyDirectory # # @title "Copies a directory" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{from}{The pathname of the source directory to be copied.} # \item{to}{The pathname of the destination directory.} # \item{...}{Additional arguments passed to # \code{\link[base:files]{file.copy}}(), e.g. \code{overwrite}.} # \item{private}{If @TRUE, files (and directories) starting with # a period is also copied, otherwise not.} # \item{recursive}{If @TRUE, subdirectories are copied too, # otherwise not.} # } # # \value{ # Returns (invisibly) a @character @vector of pathnames copied. # } # # \details{ # Note that this method does \emph{not} use @see "copyFile" to # copy the files, but @see "base::file.copy". # } # # @author # # @keyword file #*/########################################################################### setMethodS3("copyDirectory", "default", function(from, to=".", ..., private=TRUE, recursive=TRUE) { # BACKWARD COMPATIBILITY: file.copy() gained argument copy.mode=TRUE in # R (>= 2.13.0) [April 2013]. Due to the default, this means that when # previously copying a read-only file, the new file would have write # permissions, whereas now it preserved the read-only permissions. # This private function silently drop argument 'copy.mode' and 'copy.date' # if passed older versions of R. .file.copy <- function(...) { args <- list(...) names <- names(args) if (!is.null(names)) { known <- names(formals(base::file.copy)) keep <- (nchar(names) == 0L | is.element(names, known)) args <- args[keep] } do.call(base::file.copy, args=args, envir=parent.frame()) } # .file.copy() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'from': if (!isDirectory(from)) throw("Argument 'from' is not a directory: ", from) # Argument 'to': to <- Arguments$getWritablePath(to, mkdirs=TRUE, absolute=FALSE) # Argument 'private': private <- Arguments$getLogical(private) # Argument 'recursive': recursive <- Arguments$getLogical(recursive) # Use relative pathnames files <- list.files(from, all.files=private, full.names=FALSE) files <- files[!basename(files) %in% c(".", "..")] files <- file.path(from, files) copiedFiles <- c() for (file in files) { basename <- basename(file) if (isFile(file)) { if (.file.copy(from=file, to=filePath(to, basename), ...)) { copiedFiles <- c(copiedFiles, file) } } else if (isDirectory(file)) { if (recursive) { copiedFiles <- c(copiedFiles, copyDirectory(file, to=filePath(to, basename), ..., recursive=TRUE)) } } } invisible(copiedFiles) }) ���������������������������������������������������������������������������������������������������������������������������������R.utils/R/createFileAtomically.R��������������������������������������������������������������������0000644�0001762�0000144�00000010321�14372747611�016231� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������########################################################################/** # @RdocDefault createFileAtomically # # @title "Creates a file atomically" # # @synopsis # # \description{ # @get "title" by first creating and writing to a temporary file which # is then renamed. # } # # \arguments{ # \item{filename}{The filename of the file to create.} # \item{path}{The path to the file.} # \item{FUN}{A @function that creates and writes to the pathname that # is passed as the first argument. This pathname is guaranteed # to be a non-existing temporary pathname.} # \item{...}{Additional arguments passed to @see "pushTemporaryFile" # and @see "popTemporaryFile".} # \item{skip}{If @TRUE and a file with the same pathname already exists, # nothing is done/written.} # \item{overwrite}{If @TRUE and a file with the same pathname # already exists, the existing file is overwritten. # This is also done atomically such that if the new file was not # successfully created, the already original file is restored. # If restoration also failed, the original file remains as # the pathname with suffix \code{".bak"} appended.} # \item{backup}{If @TRUE and a file with the same pathname already exists, # then it is backed up while creating the new file. If the new file # was not successfully created, the original file is restored from # the backup copy.} # \item{verbose}{A @logical or @see "Verbose".} # } # # \value{ # Returns (invisibly) the pathname. # } # # @examples "../incl/createFileAtomically.Rex" # # @author # # \seealso{ # Internally, # @see "pushTemporaryFile" and @see "popTemporaryFile" are used for # working toward a temporary file, and # @see "pushBackupFile" and @see "popBackupFile" are used for backing up # and restoring already existing file. # } # # @keyword "utilities" # @keyword "programming" # @keyword "IO" #*/######################################################################### setMethodS3("createFileAtomically", "default", function(filename, path=NULL, FUN, ..., skip=FALSE, overwrite=FALSE, backup=TRUE, verbose=FALSE) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'skip': skip <- Arguments$getLogical(skip) # Argument 'overwrite': overwrite <- Arguments$getLogical(overwrite) # Argument 'backup': backup <- Arguments$getLogical(backup) # Arguments 'filename' & 'path': pathname <- Arguments$getWritablePathname(filename, path=path, mustNotExist=(!skip && !overwrite)) # Argument 'FUN': if (!is.function(FUN)) { throw("Argument 'FUN' is not a function: ", mode(FUN)) } # Argument 'verbose': verbose <- Arguments$getVerbose(verbose) if (verbose) { pushState(verbose) on.exit(popState(verbose)) } verbose && enter(verbose, "Writes a file atomically") verbose && cat(verbose, "Pathname: ", pathname) verbose && cat(verbose, "Argument 'skip': ", skip) verbose && cat(verbose, "Argument 'overwrite': ", overwrite) if (skip && isFile(pathname)) { verbose && cat(verbose, "Returning already existing file (skip=TRUE).") verbose && exit(verbose) return(pathname) } # Back existing file, if it exists? if (backup) { pathnameB <- pushBackupFile(pathname, verbose=verbose) on.exit({ # Restore or drop backup file popBackupFile(pathnameB, drop=TRUE, verbose=verbose) }, add=TRUE) } # Write to a temporary pathname pathnameT <- pushTemporaryFile(pathname, ..., verbose=verbose) verbose && cat(verbose, "Writing to temporary file: ", pathname) tryCatch({ verbose && enter(verbose, "Calling write function (argument 'FUN')") FUN(pathnameT) verbose && exit(verbose) # Rename temporary pathname pathname <- popTemporaryFile(pathnameT, ..., verbose=verbose) }, interrupt = function(intr) { verbose && cat(verbose, "An interrupt occurred while writing to temporary file. File was not created.") }, error = function(ex) { verbose && cat(verbose, "An error occurred while writing to temporary file. File was not created.") }) verbose && exit(verbose) invisible(pathname) }) # createFileAtomically() ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/captureOutput.R���������������������������������������������������������������������������0000644�0001762�0000144�00000006426�14372747611�015046� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocFunction captureOutput # # @title "Evaluate an R expression and captures the output" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{expr}{The R expression to be evaluated.} # \item{file}{A file name or a @connection to where the output is # directed. Alternatively, if @NULL the output is captured to # and returned as a @character @vector.} # \item{append}{If @TRUE, the output is appended to the file or # the (unopened) connection, otherwise it overwrites.} # \item{collapse}{A @character string used for collapsing the captured # rows. If @NULL, the rows are not collapsed.} # \item{envir}{The @environment in which the expression is evaluated.} # } # # \value{ # Returns captured output as a @character @vector. # } # # \details{ # This method imitates @see "utils::capture.output" with the major # difference that it captures strings via a @raw connection rather # than via internal strings. The latter becomes exponentially slow # for large outputs [1,2]. # } # # @examples ../incl/captureOutput.Rex # # @author # # \seealso{ # Internally, @see "base::eval" is used to evaluate the expression. # and @see "utils::capture.output" to capture the output. # } # # \references{ # [1] R-devel thread 'capture.output(): Using a rawConnection() [linear] # instead of textConnection() [exponential]?', 2014-02-04. # \url{https://stat.ethz.ch/pipermail/r-devel/2014-February/068349.html} # [2] JottR blog post 'PERFORMANCE: captureOutput() is much faster than # capture.output()', 2015-05-26. # \url{https://www.jottr.org/2014/05/26/captureoutput/} # } # # @keyword IO # @keyword programming #*/########################################################################### captureOutput <- function(expr, file=NULL, append=FALSE, collapse=NULL, envir=parent.frame()) { # Argument 'file': # Default is to capture via a raw connection if (is.null(file)) file <- raw(0L) # It is still possible to capture via a string if (identical(file, character(0L))) file <- NULL # How to capture output? if (is.raw(file)) { # Via a temporary raw connection? [MUCH FASTER] res <- eval({ file <- rawConnection(raw(0L), open="w") on.exit({ if (!is.null(file)) close(file) }) capture.output(expr, file=file) res <- rawConnectionValue(file) close(file) file <- NULL; # Not needed anymore # Convert to character res <- rawToChar(res) res }, envir=envir, enclos=envir) } else { # Backward compatibility, i.e. capture to file res <- eval({ capture.output(expr, file=file, append=append) }, envir=envir, enclos=envir) return(invisible(res)) } ## At this point 'res' is a single character string if captured ## to a raw or file connection, whereas if captured to say ## "text" connection, then it is a character vector with elements ## split by '\n' newlines. ## In order to emulate capture.output() behavior as far as possible, ## we will split by '\n'. res <- unlist(strsplit(res, split="\n", fixed=TRUE), use.names=FALSE) ## Merge back using the collapse string? if (!is.null(collapse)) res <- paste(res, collapse=collapse) res } # captureOutput() ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/getAbsolutePath.R�������������������������������������������������������������������������0000644�0001762�0000144�00000007500�14372747611�015247� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault getAbsolutePath # # @title "Gets the absolute pathname string" # # @synopsis # # \description{ # @get "title". # } # # \arguments{ # \item{pathname}{A @character string of the pathname to be converted into # an absolute pathname.} # \item{workDirectory}{A @character string of the current working directory.} # \item{expandTilde}{If @TRUE, tilde (\code{~}) is expanded to the # corresponding directory, otherwise not.} # \item{...}{Not used.} # } # # \value{ # Returns a @character string of the absolute pathname. # } # # \details{ # This method will replace replicated slashes ('/') with a single one, # except for the double forward slashes prefixing a Microsoft Windows UNC # (Universal Naming Convention) pathname. # } # # @author # # \seealso{ # @see "isAbsolutePath". # } # # @keyword IO # @keyword programming #*/########################################################################### setMethodS3("getAbsolutePath", "default", function(pathname, workDirectory=getwd(), expandTilde=FALSE, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Local functions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - getName <- function(pathname, removeSuffix=FALSE, ...) { components <- strsplit(pathname, split="[/\\]")[[1]] len <- length(components) if (len == 0) { return("") } name <- components[len] if (name == ".") { return("") } reg <- regexpr("^.:", name) if (reg != -1) { name <- substring(name, attr(reg, "match.length")+1) } if (removeSuffix) { name <- gsub("[.][^.]*$", "", name); # Remove the suffix. } name } # getName() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'pathname': pathname <- as.character(pathname) # BACKWARD COMPATIBILITY: Treat empty path specially? pathname <- .getPathIfEmpty(pathname, where="getAbsolutePath") nPathnames <- length(pathname) # Nothing to do? if (nPathnames == 0L) return(logical(0L)) # Multiple pathnames to be checked? if (nPathnames > 1L) { res <- sapply(pathname, FUN=getAbsolutePath, workDirectory=workDirectory, expandTilde=expandTilde, ...) return(res) } # Missing path? if (is.na(pathname)) return(NA_character_) # A URL? if (isUrl(pathname)) return(pathname) if (!isAbsolutePath(pathname)) { workDirectory <- strsplit(workDirectory, split="[/\\]")[[1L]] name <- getName(pathname) if (name == "" || name == ".") name <- NULL; # Only, details, but as in Java! pathname <- strsplit(pathname, split="[/\\]")[[1L]] len <- length(pathname) if (len != 0L) { pathname <- pathname[-len] } pathname <- c(workDirectory, pathname, name) pathname <- paste(pathname, sep="", collapse=.Platform$file.sep) } if (expandTilde) { ## Can we replace this with base::path.expand()? /HB 2014-09-16 path <- dirname(pathname) # Does tilde expansion if (path == "/") path <- "" ## To avoid /tmp -> //tmp filename <- basename(pathname) pathname <- file.path(path, filename) } ## Drop '..' components if possible pathname <- filePath(pathname, removeUps=TRUE) # Especially expandTilde=TRUE may add an extra slash ('/'). # Replace all replicated slashes ('/') with single ones, except # if they are at the beginning of the path, because then they # are Microsoft Windows UNC paths. isWindowsUNC <- (regexpr("^//", pathname) != -1L) pathname <- gsub("//*", "/", pathname) if (isWindowsUNC) { # Make sure WindowsUNC starts with "//". pathname <- paste("/", pathname, sep="") } pathname }) ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/006.fixVarArgs.R��������������������������������������������������������������������������0000644�0001762�0000144�00000002454�14372747611�014537� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# Added '...' to some base functions. These will later be # turned into default functions by setMethodS3(). # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Methods in 'base' # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # USED TO DO: getOption <- appendVarArgs(getOption) getOption <- function(...) UseMethod("getOption") setMethodS3("getOption", "default", function(...) { base::getOption(...) }) # USED TO DO: isOpen <- appendVarArgs(isOpen) isOpen <- function(...) UseMethod("isOpen") setMethodS3("isOpen", "default", function(...) { base::isOpen(...) }) # USED TO DO: parse <- appendVarArgs(parse) parse <- function(...) UseMethod("parse") setMethodS3("parse", "default", function(...) { base::parse(...) }) # Other fixes to avoid .Internal() cat <- function(...) UseMethod("cat") setMethodS3("cat", "default", function(...) { base::cat(...) }) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Methods in 'base' # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (exists("timestamp", mode="function")) { # USED TO DO: timestamp <- appendVarArgs(timestamp) timestamp <- function(...) UseMethod("timestamp") setMethodS3("timestamp", "default", function(...) { utils::timestamp(...) }) } ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/stext.R�����������������������������������������������������������������������������������0000644�0001762�0000144�00000006016�14372747611�013324� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault stext # # @title "Writes text in the margin along the sides of a plot" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{text}{The text to be written. See @see "graphics::mtext" for details.} # \item{side}{An @integer specifying which side to write the text on. See @see "graphics::mtext" for details.} # \item{line}{A @numeric specifying on which line to write on.} # \item{pos}{A @numeric, often in [0,1], specifying the position # of the text relative to the left and right edges.} # \item{margin}{A @numeric @vector length two specifying the text margin.} # \item{charDim}{A @numeric @vector length two specifying the size of a # typical symbol.} # \item{cex}{A @numeric specifying the character expansion factor.} # \item{...}{Additional arguments passed to @see "graphics::mtext".} # } # # \value{ # Returns what @see "graphics::mtext" returns. # } # # @author # # \seealso{ # Internally @see "graphics::mtext" is used. # } #*/########################################################################### setMethodS3("stext", "default", function(text, side=1, line=0, pos=0.5, margin=c(0.2,0.2), charDim=c(strwidth("M", cex=cex), strheight("M", cex=cex)), cex=par("cex"), ...) { # Argument 'side': side <- Arguments$getInteger(side, range=c(1,4)) # Argument 'pos': pos <- Arguments$getNumeric(pos) # Argument 'margin': margin <- Arguments$getNumerics(margin) margin <- rep(margin, length.out=2) # dx, dy: # Assume side 1 or 3 (otherwise flip below) if (side %in% c(1,3)) { dx <- margin[1]*charDim[1] dy <- margin[2]*charDim[2] } else { dx <- margin[2]*charDim[1] dy <- margin[1]*charDim[2] } usr <- par("usr") xlim <- usr[1:2] ylim <- usr[3:4] if (line < 0) margin[2] <- -margin[2] if (side %in% c(1,3)) { xlim <- xlim - c(-1,+1)*dx if (line >= 0) dy <- -dy ylim <- ylim - c(-1,+1)*dy } else { if (line >= 0) dx <- -dx xlim <- xlim - c(-1,+1)*dx ylim <- ylim - c(-1,+1)*dy } # Debug # lines(x=xlim[c(1,1,2,2,1)], y=ylim[c(1,2,2,1,1)], col="red", xpd=TRUE) # 'at': if (side %in% c(1,3)) { at <- xlim[1] + pos*diff(xlim) } else { at <- ylim[1] + pos*diff(ylim) } # 'adj': if (side %in% c(1,3)) { adj <- sign(pos-0.5)/2 + 1/2 } else { adj <- sign(pos-0.5)/2 + 1/2 } line <- line + margin[2] # Rescale line according to font size if (side %in% c(1,3)) { lheight <- strheight("M", cex=cex)/strheight("M") } else { lheight <- strwidth("M", cex=cex)/strwidth("M") } if (line >= 0) { if (side %in% c(1,4)) { line <- line * lheight line <- line + (lheight-1) } else { line <- line * lheight } } else { if (side %in% c(1,4)) { line <- (line+1) * lheight - 1 } else { line <- (line+1) * lheight - 1 line <- line - (lheight-1) } } mtext(text=text, side=side, line=line, at=at, adj=adj, cex=cex, ..., xpd=TRUE) }) # stext() ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/tmpfile.R���������������������������������������������������������������������������������0000644�0001762�0000144�00000002042�14372747611�013610� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocFunction tmpfile # # @title "Creates a temporary file with content" # # \description{ # @get "title" that will auto delete as soon as there is no longer # any references to it. # } # # @synopsis # # \arguments{ # \item{content}{A @character string to be written to the file.} # \item{...}{Optional arguments passed to @see "base::tempfile".} # } # # \value{ # The absolute pathname to the temporary file. # } # # \examples{ # md5 <- tools::md5sum(tmpfile("Hello world!")) # print(md5) # } # # @author # # \seealso{ # @see "base::tempfile". # } # # @keyword programming # @keyword file # @keyword internal #*/########################################################################### tmpfile <- function(content=NULL, ...) { pathname <- tempfile(...) cat(content, file=pathname) env <- new.env(parent=emptyenv()) env$pathname <- pathname reg.finalizer(env, function(e) file.remove(e$pathname), onexit=TRUE) attr(pathname, "gc") <- env pathname } ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/seqToHumanReadable.R����������������������������������������������������������������������0000644�0001762�0000144�00000003766�14372747611�015672� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#########################################################################/** # @RdocDefault seqToHumanReadable # # @title "Gets a short human readable string representation of an vector of indices" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{idx}{A @vector of @integer indices.} # \item{tau}{A non-negative @integer specifying the minimum span of # of a contiguous sequences for it to be collapsed to # \code{<from>-<to>}.} # \item{delimiter}{A @character string delimiter.} # \item{collapse}{A @character string used to collapse subsequences.} # \item{...}{Not used.} # } # # @author # # \examples{ # print(seqToHumanReadable(1:2)) # "1, 2" # print(seqToHumanReadable(1:2, tau=1)) # "1-2" # print(seqToHumanReadable(1:10)) # "1-10" # print(seqToHumanReadable(c(1:10, 15:18, 20))) # "1-10, 15-18, 20" # } # # \seealso{ # Internally, @see "seqToIntervals" is used. # } # # @keyword "attribute" #*/######################################################################### setMethodS3("seqToHumanReadable", "default", function(idx, tau=2L, delimiter="-", collapse=", ", ...) { tau <- as.integer(tau) data <- seqToIntervals(idx) ## Nothing to do? n <- nrow(data) if (n == 0) return("") s <- character(length=n) delta <- data[,2L] - data[,1L] ## Individual values idxs <- which(delta == 0) if (length(idxs) > 0L) { s[idxs] <- as.character(data[idxs,1L]) } if (tau > 1) { if (tau == 2) { idxs <- which(delta == 1) if (length(idxs) > 0L) { s[idxs] <- paste(data[idxs,1L], data[idxs,2L], sep=collapse) } } else { idxs <- which(delta < tau) if (length(idxs) > 0L) { for (idx in idxs) { s[idx] <- paste(data[idx,1L]:data[idx,2L], collapse=collapse) } } } } ## Ranges idxs <- which(delta >= tau) if (length(idxs) > 0L) { s[idxs] <- paste(data[idxs,1L], data[idxs,2L], sep=delimiter) } paste(s, collapse=collapse) }) ����������R.utils/R/Verbose.R���������������������������������������������������������������������������������0000644�0001762�0000144�00000111250�14525546077�013562� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocClass Verbose # # @title "Class to writing verbose messages to a connection or file" # # \description{ # @classhierarchy # # @get "title". # } # # @synopsis # # \arguments{ # \item{con}{A @connection or a @character string filename.} # \item{on}{A @logical indicating if the writer is on or off.} # \item{threshold}{A @numeric threshold that the \code{level} argument # of any write method has to be equal to or larger than in order to the # message being written. Thus, the lower the threshold is the more and # more details will be outputted.} # \item{timestamp}{If @TRUE, each output is preceded with a timestamp.} # \item{removeFile}{If @TRUE and \code{con} is a filename, the file is # first deleted, if it exists.} # \item{asGString}{If @TRUE, all messages are interpreted as # @see "GString" before being output, otherwise not.} # \item{core}{Internal use only.} # \item{...}{Not used.} # } # # \section{Fields and Methods}{ # @allmethods # } # # \section{Output levels}{ # As a guideline, use the following levels when outputting verbose/debug # message using the Verbose class. For a message to be shown, the output # level must be greater than (not equal to) current threshold. # Thus, the lower the threshold is set, the more messages will be seen. # # \describe{ # \item{<= -100}{Only for debug messages, i.e. messages containing all # necessary information for debugging purposes and to find bugs in # the code. Normally these messages are so detailed so they will be # a pain for the regular user, but very useful for bug reporting and # bug tracking by the developer.} # \item{-99 -- -11}{Detailed verbose messages. These will typically be # useful for the user to understand what is going on and do some simple # debugging fixing problems typically due to themselves and not due to # bugs in the code.} # \item{-10 -- -1}{Verbose messages. For example, these will typically # report the name of the file to be read, the current step in a sequence # of analysis steps and so on. These message are not very useful for # debugging.} # \item{0}{Default level in all output methods and default threshold. # Thus, by default, messages at level 0 are not shown.} # \item{>= +1}{Message that are always outputted (if threshold is # kept at 0). We recommend not to output message at this level, because # methods should be quiet by default (at the default threshold 0).} # } # } # # \section{A compatibility trick and a speed-up trick}{ # If you want to include calls to Verbose in a package of yours in order # to debug code, but not use it otherwise, you might not want to load # R.utils all the time, but only for debugging. # To achieve this, the value of a reference variable to a Verbose class # is always set to @TRUE, cf. typically an Object reference has value @NA. # This makes it possible to use the reference variable as a first test # before calling Verbose methods. Example: # \preformatted{ # foo <- function(..., verbose=FALSE) { # # enter() will never be called if verbose==FALSE, thus no error. # verbose && enter(verbose, "Loading") # } # } # # Thus, R.utils is not required for \code{foo()}, but for # \code{foo(verbose==Verbose(level=-1))} it is. # # Moreover, if using the @see "NullVerbose" class for ignoring all verbose # messages, the above trick will indeed speed up the code, because # the value of a NullVerbose reference variable is always @FALSE. # } # # \section{Extending the Verbose class}{ # If extending this class, make sure to output messages via # @seemethod "writeRaw" or one of the other output methods (which in # turn all call the former). # This guarantees that @seemethod "writeRaw" has full control of the # output, e.g. this makes it possible to split output to standard # output and to file. # } # # @examples "../incl/Verbose.Rex" # # @author # # \seealso{ # @see "NullVerbose". # } # # @keyword programming # @keyword IO #*/########################################################################### setConstructorS3("Verbose", function(con=stderr(), on=TRUE, threshold=0, asGString=TRUE, timestamp=FALSE, removeFile=TRUE, core=TRUE, ...) { if (is.character(con)) { if (removeFile && isFile(con)) file.remove(con) } else if (inherits(con, "connection")) { } else if (!is.null(con)) { stop("Unknown type on argument 'con': ", class(con)) } if (!is.numeric(threshold) || length(threshold) != 1) throw("Argument 'threshold' must be a single numeric value.") # Argument 'threshold': threshold <- as.numeric(threshold) # Argument 'asGString': asGString <- as.logical(asGString) # Argument 'timestamp': timestamp <- as.logical(timestamp) # Argument 'core': if (!is.logical(core)) throw("Argument 'core' is not logical: ", mode(core)) # Argument 'on': on <- as.logical(on) extend(Object(core), "Verbose", .timestamp = timestamp, .timestampFormat = "%Y%m%d %H:%M:%S|", indentPos = 0, indentStep = 1, rightMargin = 75, threshold = threshold, defaultLevel = 0, asGString = asGString, .ignore = !on, .con = con, .stack = c(), .stackLevel = c() ) }) ###########################################################################/** # @RdocMethod "as.character" # # @title "Returns a character string version of this object" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns a @character string. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("as.character", "Verbose", function(x, ...) { # To please R CMD check this <- x s <- paste(class(this)[1], ": isOn()=", isOn(this), ", threshold=", this$threshold, sep="") s <- paste(s, ", timestamp=", this$.timestamp, sep="") s <- paste(s, ", timestampFormat=", this$.timestampFormat, sep="") s }) #########################################################################/** # @RdocMethod equals # # @title "Checks if this object is equal to another" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{other}{Another Object.} # \item{...}{Not used.} # } # # \value{Returns @TRUE if they are equal, otherwise @FALSE.} # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/######################################################################### setMethodS3("equals", "Verbose", function(this, other, ...) { res <- FALSE if (!inherits(other, "Verbose")) { attr(res, "reason") <- "Not same class" return(res) } fields <- getFields(this, private=TRUE) for (field in fields) { if (!equals(this[[field]], other[[field]])) { attr(res, "reason") <- field return(res) } } TRUE }, protected=TRUE) ###########################################################################/** # @RdocMethod setThreshold # # @title "Sets verbose threshold" # # \description{ # @get "title". Output requests below this threshold will be ignored. # } # # @synopsis # # \arguments{ # \item{threshold}{A @numeric threshold.} # \item{...}{Not used.} # } # # \value{ # Returns old threshold. # } # # @author # # \seealso{ # @seemethod "getThreshold" and @seemethod "isVisible". # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("setThreshold", "Verbose", function(this, threshold, ...) { ## Argument 'threshold': if (length(threshold) != 1) { throw("Argument 'threshold' must be a scalar.") } else if (is.na(threshold)) { throw("Argument 'threshold' must not be a missing value: ", threshold) } if (is.logical(threshold)) { threshold <- -as.integer(threshold) ## => FALSE = 0, TRUE = -1 } else if (!is.numeric(threshold)) { throw("Argument 'threshold' must be a logical or a numeric: ", mode(threshold)) } old <- this$threshold this$threshold <- threshold invisible(old) }) ###########################################################################/** # @RdocMethod setDefaultLevel # # @title "Sets the current default verbose level" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{level}{A @numeric value.} # \item{...}{Not used.} # } # # \value{ # Returns old default level. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("setDefaultLevel", "Verbose", function(this, level, ...) { if (is.na(as.numeric(level))) throw("Invalid value on argument 'level': ", level) oldLevel <- this$defaultLevel this$defaultLevel <- as.numeric(level) invisible(oldLevel) }) ###########################################################################/** # @RdocMethod getThreshold # # @title "Gets current verbose threshold" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns a @numeric value. # } # # @author # # \seealso{ # @seemethod "setThreshold" and @seemethod "isVisible". # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("getThreshold", "Verbose", function(this, ...) { threshold <- this$threshold # Assert that threshold is within the valid range. This is part of the # transition of move from negative to positive verbose levels: # 1. Disallow all positive value for a long time. # 2. Yet later, ignore the sign, i.e. abs(threshold). # 3. Much later, disallow all negative values for a long time. # 4. Possibly, allow negative values after all this. # /HB 2011-09-18 validRange <- getOption("R.utils::Verbose/validThresholdRanges", c(-Inf,Inf)) if (!is.null(validRange)) { validRange <- Arguments$getDoubles(validRange, length=c(2,2)) if (threshold < validRange[1] || threshold > validRange[2]) { throw(sprintf("The threshold is out of the valid range [%s,%s]: %s", validRange[1], validRange[2], threshold)) } } threshold }) ###########################################################################/** # @RdocMethod isVisible # # @title "Checks if a certain verbose level will be shown or not" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{level}{A @numeric value to be compared to the threshold.} # \item{...}{Not used.} # } # # \value{ # Returns @TRUE, if given level is greater than (not equal to) the current # threshold, otherwise @FALSE is returned. # } # # @author # # \seealso{ # @seemethod "getThreshold" and @seemethod "setThreshold". # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("isVisible", "Verbose", function(this, level=this$defaultLevel, ...) { isOn(this) && (is.null(level) || level > this$threshold) }) ###########################################################################/** # @RdocMethod as.logical # # @title "Gets a logical value of this object" # # \description{ # @get "title". Returns \code{isVisible(this, level=this$defaultLevel)}. # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns a @logical value. # } # # @author # # \seealso{ # @seemethod "isVisible". # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("as.logical", "Verbose", function(x, ...) { # To please R CMD check this <- x isVisible(this, level=this$defaultLevel) }) ###########################################################################/** # @RdocMethod as.double # # @title "Gets a numeric value of this object" # # \description{ # @get "title". Returns what @seemethod "getThreshold" returns. # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns a @numeric value. # } # # @author # # \seealso{ # @seemethod "getThreshold" and @seemethod "getThreshold". # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("as.double", "Verbose", function(x, ...) { # To please R CMD check this <- x getThreshold(this, ...) }) ###########################################################################/** # @RdocMethod on # # @title "Turn on the output" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns (invisibly) @TRUE. # } # # @author # # \seealso{ # @seemethod "off" and @seemethod "isOn". # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("on", "Verbose", function(this, ...) { this$.ignore <- FALSE invisible(TRUE) }) ###########################################################################/** # @RdocMethod off # # @title "Turn off the output" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns (invisibly) @FALSE. # } # # @author # # \seealso{ # @seemethod "on" and @seemethod "isOn". # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("off", "Verbose", function(this, ...) { this$.ignore <- TRUE invisible(FALSE) }) ###########################################################################/** # @RdocMethod isOn # # @title "Checks if the output is on" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns @TRUE if output is on, otherwise @FALSE. # } # # @author # # \seealso{ # @seemethod "on" and @seemethod "off". # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("isOn", "Verbose", function(this, ...) { !as.logical(this$.ignore) }) ###########################################################################/** # @RdocMethod writeRaw # # @title "Writes objects if above threshold" # # \description{ # @get "title". # This method is used by all other methods of this class for output. # } # # @synopsis # # \arguments{ # \item{...}{Objects to be passed to @see "base::paste".} # \item{sep}{The default separator @character string.} # \item{level}{A @numeric value to be compared to the threshold.} # } # # \value{ # Returns nothing. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("writeRaw", "Verbose", function(this, ..., sep="", level=this$defaultLevel) { if (!isVisible(this, level)) return(invisible(FALSE)) msg <- paste(..., sep="") if (this$asGString) { if (length(msg) > 1) { msg <- sapply(msg, FUN=function(s) { as.character(GString(s)) }) } else { msg <- as.character(GString(msg)) } } cat(file=this$.con, append=TRUE, msg) invisible(TRUE) }, protected=TRUE) ###########################################################################/** # @RdocMethod cat # # @title "Concatenates and prints objects if above threshold" # # \description{ # @get "title". # The output is indented according to @seemethod "enter"/@seemethod "exit" # calls. # } # # @synopsis # # \arguments{ # \item{...}{Objects to be passed to @see "base::cat".} # \item{sep}{The default separator @character string.} # \item{newline}{If @TRUE, a newline is added at the end, otherwise not.} # \item{level}{A @numeric value to be compared to the threshold.} # \item{timestamp}{A @logical indicating if output should start with a # timestamp, or not.} # } # # \value{ # Returns nothing. # } # # @author # # \seealso{ # @seemethod "timestampOn" and \code{timestampOff}(). # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("cat", "Verbose", function(this, ..., sep="", newline=TRUE, level=this$defaultLevel, timestamp=this$.timestamp) { if (!isVisible(this, level)) return(invisible(FALSE)) indent <- paste(rep(" ", length.out=this$indentPos), collapse="") msg <- paste(..., sep=sep) msg <- paste(indent, msg, sep="") if (timestamp) { fmt <- this$.timestampFormat if (is.function(fmt)) { stamp <- fmt() } else { stamp <- format(Sys.time(), fmt) } msg <- paste(stamp, msg, sep="") } if (newline) msg <- paste(msg, "\n", sep="") # Write output writeRaw(this, msg) }) ###########################################################################/** # @RdocMethod printf # # @title "Formats and prints object if above threshold" # # \description{ # @get "title". # The output is indented according to @seemethod "enter"/@seemethod "exit" # calls. # } # # @synopsis # # \arguments{ # \item{...}{Objects to be passed to @see "base::sprintf".} # \item{fmtstr}{A @character string specify the printf format string.} # \item{level}{A @numeric value to be compared to the threshold.} # \item{timestamp}{A @logical indicating if output should start with a # timestamp, or not.} # } # # \value{ # Returns nothing. # } # # @author # # \seealso{ # @seeclass # } #*/########################################################################### setMethodS3("printf", "Verbose", function(this, fmtstr, ..., level=this$defaultLevel, timestamp=this$.timestamp) { if (!isVisible(this, level)) return(invisible(FALSE)) cat(this, sprintf(fmtstr, ...), newline=FALSE, timestamp=timestamp) }) ###########################################################################/** # @RdocMethod enter # @aliasmethod enterf # # @title "Writes a message and indents the following output" # # \description{ # @get "title". # The output is indented according to @seemethod "enter"/@seemethod "exit" # calls. # } # # \usage{ # @usage "enter,Verbose" # @usage "enterf,Verbose" # } # # \arguments{ # \item{fmtstr}{An @see "base::sprintf" format string, which together with # \code{...} constructs the message.} # \item{...}{Objects to be passed to @seemethod "cat" # (or @see "base::sprintf").} # \item{indent}{The number of characters to add to the indentation.} # \item{sep}{The default separator @character string.} # \item{suffix}{A @character string to be appended to the end of the message.} # \item{level}{A @numeric value to be compared to the threshold.} # } # # \value{ # Returns nothing. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("enter", "Verbose", function(this, ..., indent=this$indentStep, sep="", suffix="...", level=this$defaultLevel) { msg <- paste(..., sep=sep) msg <- as.character(GString(msg)) cat(this, msg, suffix, sep=sep, level=level) this$.stack <- c(this$.stack, msg) this$.stackLevel <- c(this$.stackLevel, level) this$indentPos <- this$indentPos + indent invisible(TRUE) }) setMethodS3("enterf", "Verbose", function(this, fmtstr, ..., indent=this$indentStep, sep="", suffix="...", level=this$defaultLevel) { enter(this, sprintf(fmtstr, ...), indent=indent, sep=sep, suffix=suffix, level=level) }) ###########################################################################/** # @RdocMethod exit # # @title "Writes a message and unindents the following output" # # \description{ # @get "title". # The output is indented according to @seemethod "enter"/@seemethod "exit" # calls. # } # # @synopsis # # \arguments{ # \item{...}{Objects to be passed to @seemethod "cat". If not specified # the message used in the corresponding @seemethod "enter" call is used.} # \item{indent}{The number of characters to be removed from the indentation.} # \item{sep}{The default separator @character string.} # \item{suffix}{A @character string to be appended to the end of the message.} # \item{level}{A @numeric value to be compared to the threshold.} # } # # \value{ # Returns nothing. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("exit", "Verbose", function(this, ..., indent=-this$indentStep, sep="", suffix="...done", level=NULL) { args <- list(...) # Argument 'indent' if (this$indentPos + indent < 0) { throw("Cannot exit(): Argument 'indent' makes 'indentPos' negative: ", this$indentPos + indent) } len <- length(this$.stack) # Balance check if (length(len) == 0) { throw("Internal error: Cannot exit(). Unbalanced enter()/exit() stack - it is already empty.") } lastMsg <- this$.stack[len] this$.stack <- this$.stack[-len] lastLevel <- this$.stackLevel[len] this$.stackLevel <- this$.stackLevel[-len] this$indentPos <- this$indentPos + indent if (length(args) == 0) { msg <- lastMsg } else { msg <- paste(..., sep=sep) } if (is.null(level)) level <- lastLevel cat(this, msg, suffix, sep="", level=level) invisible(TRUE) }) ###########################################################################/** # @RdocMethod more # # @title "Creates a cloned instance with a lower threshold" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{dThreshold}{The amount the threshold should be lowered.} # \item{...}{Not used.} # } # # \value{ # Returns a cloned @see "Verbose" object. # } # # @author # # \seealso{ # @seemethod "less" # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("more", "Verbose", function(this, dThreshold=1, ...) { # Clone first! res <- clone(this) # Decrease the threshold res$threshold <- res$threshold - dThreshold # Return the clone res }) ###########################################################################/** # @RdocMethod less # # @title "Creates a cloned instance with a higher threshold" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{dThreshold}{The amount the threshold should be raised.} # \item{...}{Not used.} # } # # \value{ # Returns a cloned @see "Verbose" object. # } # # @author # # \seealso{ # @seemethod "more" # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("less", "Verbose", function(this, dThreshold=1, ...) { # Clone first! res <- clone(this) # Increase the threshold res$threshold <- res$threshold + dThreshold # Return the clone res }) ###########################################################################/** # @RdocMethod print # # @title "Prints objects if above threshold" # # \description{ # @get "title". # The output is \emph{not} indented. # } # # @synopsis # # \arguments{ # \item{...}{Objects to be passed to @see "base::print".} # \item{level}{A @numeric value to be compared to the threshold.} # } # # \value{ # Returns nothing. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("print", "Verbose", function(x, ..., level=this$defaultLevel) { # To please R CMD check this <- x # So that print(this), which often called when 'this' is typed, works. args <- list(...) if (length(args) == 0) { return(NextMethod()) } # ...otherwise... capture(this, print(...), level=level) }) ###########################################################################/** # @RdocMethod str # # @title "Prints the structure of an object if above threshold" # # \description{ # @get "title". # The output is \emph{not} indented. # } # # @synopsis # # \arguments{ # \item{...}{Objects to be passed to @see "utils::str".} # \item{level}{A @numeric value to be compared to the threshold.} # } # # \value{ # Returns nothing. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("str", "Verbose", function(object, ..., level=this$defaultLevel) { # To please R CMD check this <- object if (!isVisible(this, level)) return(invisible(FALSE)) capture(this, str(...)) }) ###########################################################################/** # @RdocMethod summary # # @title "Generates a summary of an object if above threshold" # # \description{ # @get "title". # The output is \emph{not} indented. # } # # @synopsis # # \arguments{ # \item{...}{Objects to be passed to @see "base::summary".} # \item{level}{A @numeric value to be compared to the threshold.} # } # # \value{ # Returns nothing. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("summary", "Verbose", function(object, ..., level=this$defaultLevel) { # To please R CMD check this <- object if (!isVisible(this, level)) return(invisible(FALSE)) capture(this, print(summary(...))) }) ###########################################################################/** # @RdocMethod evaluate # # @title "Evaluates a function and prints its results if above threshold" # # \description{ # @get "title". # The output is \emph{not} indented. # } # # @synopsis # # \arguments{ # \item{fun}{A @function to be evaluated (only if above threshold).} # \item{...}{Additional arguments passed to the function.} # \item{level}{A @numeric value to be compared to the threshold.} # } # # \value{ # Returns nothing. # } # # @author # # \seealso{ # @seeclass # } #*/########################################################################### setMethodS3("evaluate", "Verbose", function(this, fun, ..., level=this$defaultLevel) { if (!isVisible(this, level)) return(invisible(FALSE)) print(this, fun(...)) }) ###########################################################################/** # @RdocMethod capture # # @title "Captures output of a function" # # \description{ # @get "title". # Evaluates its arguments with the output being verbosed. # } # # @synopsis # # \arguments{ # \item{...}{Arguments to be captured.} # \item{level}{A @numeric value to be compared to the threshold.} # } # # \value{ # Returns a @vector of @character string. # } # # @author # # \seealso{ # @seeclass # } #*/########################################################################### setMethodS3("capture", "Verbose", function(this, ..., level=this$defaultLevel) { if (!isVisible(this, level)) return(invisible(FALSE)) args <- substitute(list(...))[-1] bfr <- NULL; # To please R CMD check R v2.6.0. file <- textConnection("bfr", "w", local=TRUE) sink(file) on.exit({ sink() close(file) }) pf <- parent.frame() evalVis <- function(expr) { withVisible(eval(expr, envir = pf, enclos = baseenv())) } for (kk in seq_along(args)) { expr <- args[[kk]] if (mode(expr) == "expression") { tmp <- lapply(expr, FUN=evalVis) } else if (mode(expr) == "call") { tmp <- list(evalVis(expr)) } else if (mode(expr) == "name") { tmp <- list(evalVis(expr)) } else { stop("Bad argument") } for (item in tmp) { if (item$visible) print(item$value) } } indent <- paste(rep(" ", length.out=this$indentPos), collapse="") bfr2 <- paste(indent, bfr, sep="") bfr2 <- paste(bfr2, collapse="\n") bfr2 <- paste(bfr2, "\n", sep="") writeRaw(this, bfr2) }) ###########################################################################/** # @RdocMethod newline # # @title "Writes one or several empty lines" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{n}{The number of empty lines to write.} # \item{...}{Not used.} # \item{level}{A @numeric value to be compared to the threshold.} # } # # \value{ # Returns nothing. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("newline", "Verbose", function(this, n=1, ..., level=this$defaultLevel) { if (!isVisible(this, level)) return(invisible(FALSE)) if (n < 0) stop("Argument 'n' must be zero or greater: ", n) if (n > 0) writeRaw(this, paste(rep("\n", n), collapse="")) invisible(TRUE) }) ###########################################################################/** # @RdocMethod ruler # # @title "Writes a ruler" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{char}{A @character string to make up the ruler.} # \item{toColumn}{The column number where the ruler should finish.} # \item{length}{The length of the ruler.} # \item{...}{Not used.} # \item{level}{A @numeric value to be compared to the threshold.} # } # # \value{ # Returns nothing. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("ruler", "Verbose", function(this, char="-", toColumn=this$rightMargin, length=toColumn-this$indentPos, level=this$defaultLevel, ...) { if (!isVisible(this, level)) return(invisible(FALSE)) char <- as.character(char) char <- strsplit(char, split="")[[1]] ruler <- rep(char, length.out=length) ruler <- paste(ruler, collapse="") cat(this, ruler) }) ###########################################################################/** # @RdocMethod header # # @title "Writes a header" # # \description{ # @get "title" surrounded by a frame. # The output is indented according to @seemethod "enter"/@seemethod "exit" # calls. # } # # @synopsis # # \arguments{ # \item{...}{The title.} # \item{char}{The @character string to make up the frame.} # \item{padding}{The number of rows and character to pad the title above, # below, and to the left.} # \item{prefix}{The prefix of all padded lines and the title line.} # \item{level}{A @numeric value to be compared to the threshold.} # } # # \value{ # Returns nothing. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("header", "Verbose", function(this, ..., char="-", padding=0, prefix=paste(char, paste(rep(" ", max(padding, 1)), collapse=""), sep=""), level=this$defaultLevel) { if (!isVisible(this, level)) return(invisible(FALSE)) ruler(this, char=char) for (kk in seq_len(padding)) writeRaw(this, prefix, "\n") cat(this, prefix, ..., sep="", collapse="\n") for (kk in seq_len(padding)) writeRaw(this, prefix, "\n") ruler(this, char=char) }) ###########################################################################/** # @RdocMethod timestamp # # @title "Writes a timestamp" # # \description{ # @get "title" with default format [2005-06-23 21:20:03]. # } # # @synopsis # # \arguments{ # \item{format}{A @function or a @character specifying the format of the timestamp.} # \item{...}{Not used.} # } # # \value{ # Returns nothing. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("timestamp", "Verbose", function(this, format=getTimestampFormat(this), ...) { if (is.function(format)) { stamp <- format() } else { stamp <- format(Sys.time(), format) } cat(this, stamp, ...) }) ###########################################################################/** # @RdocMethod getTimestampFormat # # @title "Gets the default timestamp format" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns a @character string or a @function. # } # # @author # # \seealso{ # @seemethod "setTimestampFormat". # @seemethod "timestampOn". # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("getTimestampFormat", "Verbose", function(this, ...) { this$.timestampFormat }) ###########################################################################/** # @RdocMethod setTimestampFormat # # @title "Sets the default timestamp format" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{format}{If a @function, this function is called (without arguments) # whenever a timestamp is generated. If a @character string, it used as # the format string in \code{format(Sys.date(), fmt)}.} # \item{...}{Not used.} # } # # \value{ # Returns (invisibly) the old timestamp format. # } # # @author # # \seealso{ # @seemethod "getTimestampFormat". # @seemethod "timestampOn". # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("setTimestampFormat", "Verbose", function(this, format="%Y%m%d %H:%M:%S|", ...) { if (!is.function(format)) format <- as.character(format) oldValue <- this$.timestampFormat this$.timestampFormat <- format invisible(oldValue) }) ###########################################################################/** # @RdocMethod timestampOn # @aliasmethod timestampOff # # @title "Turns automatic timestamping on and off" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns (invisibly) the old timestamp status. # } # # @author # # \seealso{ # @seemethod "setTimestampFormat". # @seemethod "timestampOn". # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("timestampOn", "Verbose", function(this, ...) { oldStatus <- this$.timestamp this$.timestamp <- TRUE invisible(oldStatus) }) setMethodS3("timestampOff", "Verbose", function(this, ...) { oldStatus <- this$.timestamp this$.timestamp <- FALSE invisible(oldStatus) }) ###########################################################################/** # @RdocMethod printWarnings # # @title "Outputs any warnings recorded" # # \description{ # @get "title". # The output is indented according to @seemethod "enter"/@seemethod "exit" # calls. # } # # @synopsis # # \arguments{ # \item{title}{A @character string to be outputted before the warnings, if # they exists.} # \item{...}{Arguments passed to @seemethod "cat".} # \item{level}{A @numeric value to be compared to the threshold.} # } # # \value{ # Returns nothing. # } # # @author # # \seealso{ # @seeclass # } # # @alias printWarnings # @alias warnings.Verbose # @keyword programming #*/########################################################################### setMethodS3("printWarnings", "Verbose", function(this, title="Warnings detected:", ..., level=this$defaultLevel) { if (!isVisible(this, level)) return(invisible(FALSE)) if (exists("last.warning", envir=.GlobalEnv)) { if (!is.null(title)) cat(this, title) txt <- paste(capture.output(base::warnings()), collapse="\n") cat(this, txt, ..., level=level) } invisible(TRUE) }) setMethodS3("warnings", "Verbose", function(this, ...) { .Deprecated(new = "printWarnings()", package = .packageName) printWarnings(this, ...) }, deprecated = TRUE) ###########################################################################/** # @RdocMethod pushState # @aliasmethod popState # # @title "Pushes the current indentation state of the Verbose object" # # \description{ # @get "title", which is controlled by @seemethod "enter" and # @seemethod "exit". By pushing the state when entering a function and # using @see "base::on.exit" to pop the state, the correct state will # set regardless of if the functions returned naturally or via an error. # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns (invisibly) @TRUE. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("pushState", "Verbose", function(this, ...) { if (is.null(this$.stackState)) this$.stackState <- list() stack <- list( stack = this$.stack, stackLevel = this$.stackLevel ) this$.stackState <- c(this$.stackState, list(stack)) invisible(TRUE) }) setMethodS3("popState", "Verbose", function(this, ...) { if (length(this$.stackState) == 0) throw("Stack empty!") n <- length(this$.stackState) stack <- this$.stackState[[n]] this$.stackState <- this$.stackState[-n] fromN <- length(this$.stack) toN <- length(stack$stack) if (fromN > toN) { for (kk in seq(from=fromN, to=toN+1, by=-1)) exit(this) } else { this$.stack <- stack$stack this$.stackLevel <- stack$stackLevel } invisible(TRUE) }) ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/colClasses.R������������������������������������������������������������������������������0000644�0001762�0000144�00000005747�14372747611�014262� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#########################################################################/** # @RdocDefault colClasses # # @title "Creates a vector of column classes used for tabular reading" # # \description{ # @get "title" based on a compact format string. # } # # @synopsis # # \arguments{ # \item{fmt}{A @character string specifying the column-class format. # This string is first translated by @see "base::sprintf".} # \item{...}{Optional arguments for the @see "base::sprintf" translation.} # } # # \value{ # Returns a @vector of @character strings. # } # # @author # # @examples "../incl/colClasses.Rex" # # \seealso{ # @see "utils::read.table". # } # # @keyword "programming" #*/######################################################################### setMethodS3("colClasses", "default", function(fmt, ...) { typesMap <- c( "-"="NULL", "?"="NA", "c"="character", "d"="double", "f"="factor", "i"="integer", "l"="logical", "n"="numeric", "r"="raw", "z"="complex", "D"="Date", "P"="POSIXct" ) # First, translate the format string with sprintf(). fmt <- sprintf(fmt, ...) # Parse format fmt <- unlist(strsplit(fmt, split="")) predefinedTypes <- names(typesMap) digits <- as.character(0:9) alphaNum <- c(letters, LETTERS, digits) alphaNumComma <- c(alphaNum, ",") colClasses <- c() state <- "start" times <- 1 type <- "NULL" while (length(fmt) > 0) { ch <- fmt[1] if (state == "start") { if (ch %in% digits) { state <- "parseInteger" times <- as.integer(ch) } else if (ch %in% "{") { type <- "" state <- "parseCustom" } else if (ch %in% predefinedTypes) { colClasses <- c(colClasses, rep(ch, times=times)) state <- "start" } else { state <- "error" } } else if (state == "parseInteger") { if (ch %in% digits) { times <- 10*times + as.integer(ch) } else if (ch %in% "{") { type <- "" state <- "parseCustom" } else if (ch %in% predefinedTypes) { colClasses <- c(colClasses, rep(ch, times=times)) state <- "start" } else { state <- "error" } } else if (state == "parseCustom") { if (ch %in% alphaNumComma) { type <- paste(type, ch, sep="") } else if (ch %in% "}") { if (type == "") throw("Parse error: ", paste(fmt, collapse="")) types <- unlist(strsplit(type, split=",")) colClasses <- c(colClasses, rep(types, times=times)) state <- "start" } else { state <- "error" } } if (state == "error") { throw("Parse error. Unexpected symbol: ", paste(fmt, collapse="")) } else if (state == "start") { times <- 1 type <- "NULL" } fmt <- fmt[-1] } # while(...) names(colClasses) <- NULL # Expand predefined types isPredefined <- which(colClasses %in% predefinedTypes) colClasses[isPredefined] <- typesMap[colClasses[isPredefined]] colClasses }) �������������������������R.utils/R/setOption.R�������������������������������������������������������������������������������0000644�0001762�0000144�00000001542�14372747611�014140� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#########################################################################/** # @RdocDefault setOption # # @title "Sets a option in R" # # \description{ # @get "title" by specifying its name as a @character string. # } # # @synopsis # # \arguments{ # \item{x}{The name of the option to be set.} # \item{value}{The new value of the option.} # \item{...}{Not used.} # } # # \value{ # Returns (invisibly) the previous value of the option. # } # # @author # # \seealso{ # See @see "base::getOption" and "base::options". # } # # @keyword "programming" #*/######################################################################### setMethodS3("setOption", "default", function(x, value, ...) { # Get the old option value ovalue <- getOption(x) # Set the new one opts <- list(value) names(opts) <- x options(opts) invisible(ovalue) }) # setOption() ��������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/splitByPattern.R��������������������������������������������������������������������������0000644�0001762�0000144�00000003332�14372747611�015137� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#########################################################################/** # @RdocDefault splitByPattern # # @title "Splits a single character string by pattern" # # \description{ # @get "title". The main difference compared to @see "base::strsplit" # is that this method also returns the part of the string that matched # the pattern. Also, it only takes a single character string. # } # # @synopsis # # \arguments{ # \item{str}{A single @character string to be split.} # \item{pattern}{A regular expression @character string.} # \item{...}{Not used.} # } # # \value{ # Returns a named @character @vector with names equal to \code{"TRUE"} # if element is a pattern part and \code{"FALSE"} otherwise. # } # # @examples "../incl/splitByPattern.Rex" # # @author # # \seealso{ # Compare to @see "base::strsplit". # } # # @keyword programming #*/######################################################################### setMethodS3("splitByPattern", "default", function(str, pattern, ...) { # Argument 'str': str <- Arguments$getCharacter(str) # Argument 'pattern': pattern <- Arguments$getCharacter(pattern) parts <- c() while(TRUE) { pos <- regexpr(pattern, str) if (pos == -1) break text <- substring(str, first=1, last=pos-1); # This is allowed! lastPos <- pos+attr(pos, "match.length")-1 flag <- substring(str, first=pos, last=lastPos) str <- substring(str, first=lastPos+1) parts <- c(parts, text, flag) } if (nchar(str) > 0) parts <- c(parts, str) # Add indicator if a pattern string or not. isPattern <- rep(c(FALSE, TRUE), length.out=length(parts)) names(parts) <- isPattern if (nchar(parts[1]) == 0) parts <- parts[-1] parts }) # splitByPattern() ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/finalizeSession.R�������������������������������������������������������������������������0000644�0001762�0000144�00000001470�14372747611�015321� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault finalizeSession # # @title "Function to call for finalizing the R session" # # \description{ # @get "title". When called, all registered "onSessionExit" hooks # (functions) are called. To define such hooks, use the # @see "onSessionExit" function. # # This method should not be used by the user. # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns (invisibly) the hooks successfully called. # } # # @author # # \seealso{ # @see "onSessionExit". # } # # @keyword programming #*/########################################################################### setMethodS3("finalizeSession", "default", function(...) { callHooks("onSessionExit", removeCalledHooks=TRUE) }, private=TRUE) ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/devel/������������������������������������������������������������������������������������0000755�0001762�0000144�00000000000�14372747611�013126� 5����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/devel/doCall.R����������������������������������������������������������������������������0000644�0001762�0000144�00000012455�14372747611�014456� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#########################################################################/** # @RdocDefault doCall # # @title "Executes a function call with option to ignore unused arguments" # # \description{ # @get "title". # # \emph{WARNING: This method is very much in an alpha stage. # Expect it to change.} # } # # @synopsis # # \arguments{ # \item{.fcn}{A @character string naming the function to be called.} # \item{...}{Named arguments to be passed to the function.} # \item{args}{A @list of additional named arguments that will be appended # to the above arguments.} # \item{alwaysArgs}{A @list of additional named arguments that will be # appended to the above arguments and that will \emph{never} be ignore. # This is useful if you want to pass arguments to a function that accepts # arguments via \code{...}.} # \item{.functions}{A @character @vector of function names whos arguments # should be kept. This is useful when one function passes \code{...} to # another, e.g. @see "stats::loess".} # \item{.ignoreUnusedArgs}{If @TRUE, arguments that are not accepted by the # function, will not be passed to it. Partial name matching is supported. # Otherwise, all arguments are passed.} # } # # \examples{ # doCall("plot", x=1:10, y=sin(1:10), col="red", dummyArg=54, # alwaysArgs=list(xlab="x", ylab="y"), # .functions=c("plot", "plot.xy")) # } # # \seealso{ # @see "base::do.call". # } # # @author # # @keyword programming #*/######################################################################### setMethodS3("doCall", "default", function(.fcn, ..., args=NULL, alwaysArgs=NULL, .functions=.fcn, .ignoreUnusedArgs=TRUE, .include=NULL, .exclude=NULL, .verbose=FALSE) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (is.character(.fcn)) { } else { stop("Argument '.fcn' must be a character string: ", mode(.fcn)); } .verbose <- Arguments$getVerbose(.verbose); # Put all arguments in a list. args <- c(list(...), args); nargs <- length(args); if (.ignoreUnusedArgs) { known <- getArguments(.fcn, args=args, .include=.include, .exclude=.exclude, .functions=.functions); print(known) keep <- (names(args) %in% names(known)); keep[names(args) == ""] <- TRUE; args <- args[keep]; } args <- c(args, alwaysArgs); .verbose && str(.verbose, list(.fcn=.fcn, args=args)); do.call(.fcn, args=args); }) # doCall() setMethodS3("doCallGenericS3", "default", function(.fcn, ..., .functions=.fcn, .ignoreUnusedArgs=TRUE) { args <- list(...); methods <- paste(.fcn, class(args[[1]]), sep="."); exists <- unlist(lapply(methods, FUN=exists, mode="function")); methods <- methods[exists]; .functions <- c(.functions, methods); doCall(.fcn, ..., .functions=.functions);} ) setMethodS3("getArguments", "default", function(.fcn, args=NULL, .functions=.fcn, .include=NULL, .exclude=NULL, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (is.character(.fcn)) { } else { stop("Argument '.fcn' must be a character string: ", mode(.fcn)); } if (is.list(args)) { nargs <- length(args); if (length(names(args)) == 0) return(rep(TRUE, nargs)); argnames <- names(args); } else if (is.character(args)) { } else { throw("Argument 'args' must be a list or a character vector: ", class(args)[1]); } # Gather all arguments of a list of functions. fcnArgs <- ""; for (fcnName in .functions) { if (!exists(fcnName, mode="function")) stop("Function not found: ", fcnName); fcn <- get(fcnName, mode="function"); fcnArgs <- c(fcnArgs, names(formals(fcn))); } fcnArgs <- setdiff(fcnArgs, "..."); # 1. Exact matching okArgs <- (argnames %in% fcnArgs); names(okArgs) <- argnames; # 2. Includes okArgs <- okArgs | (argnames %in% .include); # 3. Partial matching, immitate R's partial matching fcnArgs <- fcnArgs[!okArgs]; for (arg in argnames[!okArgs]) { pattern <- paste("^", arg, sep=""); if (length(grep(pattern, fcnArgs)) > 0) okArgs[arg] <- TRUE; } # 4. Excludes okArgs <- okArgs & !(argnames %in% .exclude); argnames <- argnames[okArgs]; if (is.list(args)) { keep <- (names(args) %in% argnames); keep[names(args) == ""] <- TRUE; } else { keep <- (args != ""); } args <- args[keep]; args; }) # getArguments() setMethodS3("getArgumentsGenericS3", "default", function(.fcn, object, .functions=.fcn, ...) { methods <- paste(.fcn, class(object), sep="."); exists <- unlist(lapply(methods, FUN=exists, mode="function")); methods <- methods[exists]; .functions <- c(.functions, methods); getArguments(.fcn, ..., .functions=.functions); }) ############################################################################ # HISTORY: # 2005-11-22 # o BUG FIX: doCall(..., .ignoreUnusedArgs=TRUE) did not work properly. # 2005-11-14 # o Added getArgumentsGenericS3(). # o Added getArguments(). # o Added doCallGenericS3(). # o Added support for partial matching of argument names. # o BUG FIX: doCall() removed non-named arguments. # 2004-12-28 # o Created. ############################################################################ �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/devel/fileSizeToHumanReadable.R�����������������������������������������������������������0000644�0001762�0000144�00000010001�14372747611�017727� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault fileSizeToHumanReadable # # @title "Construct the path to a file from components and expands Windows Shortcuts along the pathname from root to leaf" # # @synopsis # # \description{ # @get "title". This function is backward compatible with # @see "base::file.path" when argument \code{removeUps=FALSE} and # \code{expandLinks="none"}. # # This function exists on all platforms, not only Windows systems. # } # # \arguments{ # \item{...}{Arguments to be pasted together to a file path and then be # parsed from the root to the leaf where Windows shortcut files are # recognized and expanded according to argument \code{which} in each # step.} # \item{fsep}{the path separator to use.} # \item{removeUps}{If @TRUE, relative paths, for instance "foo/bar/../" # are shortend into "foo/", but also "./" are removed from the final # pathname, if possible.} # \item{expandLinks}{A @character string. If \code{"none"}, Windows # Shortcut files are ignored. If \code{"local"}, the absolute target # on the local file system is used. If \code{"relative"}, the relative # target is used. If \code{"network"}, the network target is used. If # \code{"any"}, the first the local, then the relative and finally the # network target is searched for.} # \item{mustExist}{If @TRUE and if the target does not exist, the original # pathname, that is, argument \code{pathname} is returned. In all other # cases the target is returned.} # \item{verbose}{If @TRUE, extra information is written while reading.} # } # # \value{ # Returns a @character string. # } # # \details{ # If \code{expandLinks==TRUE}, each component, call it \emph{parent}, in # the absolute path is processed from the left to the right as follows: # 1. If a "real" directory of name \emph{parent} exists, it is followed. # 2. Otherwise, if Microsoft Windows Shortcut file with name # \emph{parent.lnk} exists, it is read. If its local target exists, that # is followed, otherwise its network target is followed. # 3. If no valid existing directory was found in (1) or (2), the expanded # this far followed by the rest of the pathname is returned quietly. # 4. If all of the absolute path was expanded successfully the expanded # absolute path is returned. # } # # \section{On speed}{ # Internal \code{file.exists()} is call while expanding the pathname. # This is used to check if the exists a Windows shortcut file named # 'foo.lnk' in 'path/foo/bar'. If it does, 'foo.lnk' has to be followed, # and in other cases 'foo' is ordinary directory. # The \code{file.exists()} is unfortunately a bit slow, which is why # this function appears slow if called many times. # } # # @examples "../incl/filePath.Rex" # # @author # # \seealso{ # @see "readWindowsShortcut". # @see "base::file.path". # } # # @keyword IO #*/########################################################################### setMethodS3("fileSizeToHumanReadable", "numeric", function(size, fmtstr="%.3g %s", unit="auto", units=c(bytes=1, kb=1024, Mb=1024^2, Gb=1024^3, Tb=1024^4), ...) { if (unit != "auto") { unit <- match.arg(unit, names(units)); } # Find the closest unit for the filesize? if (unit == "auto") { units <- sort(units); if (size < units[1]) { pos <- 2; } else if (size >= units[length(units)]) { pos <- length(units) + 1; } else { pos <- which.min(size >= units); if (pos == 1) pos <- 2; } unit <- names(units)[pos-1]; } # Rescale according to units size <- size / units[unit]; sprintf(fmtstr, size, unit); }) setMethodS3("fileSizeToHumanReadable", "character", function(pathname, ...) { fileSizeToHumanReadable(file.size(pathname)$size, ...); }) ############################################################################ # HISTORY: # 2006-08-19 # o Created (again). ############################################################################ �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/devel/splitUrl.R��������������������������������������������������������������������������0000644�0001762�0000144�00000004651�14372747611�015075� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault splitUrl # # @title "Decomposes a URL into its components" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{pathname}{A @character string of a URL.} # \item{...}{Not used.} # } # # \value{ # Returns a named @list of URL components. # } # # @author # # \references{ # [1] \url{http://www.wikipedia.org/wiki/URI_scheme} # } # # @keyword IO # @keyword programming #*/########################################################################### setMethodS3("splitUrl", "default", function(url, ...) { # Argument 'url': url <- Arguments$getCharacter(url); if (length(url) == 0L) { return(NULL); } if (!hasUrlProtocol(url)) { throw("Can not split URL. Not a valid URL: ", url); } # Get the protocol pattern <- "^([abcdefghijklmnopqrstuvwxyz]+)(://)(.*)"; protocol <- gsub(pattern, "\\1", url, ignore.case=TRUE); tail <- gsub(pattern, "\\3", url, ignore.case=TRUE); host <- NULL; path <- NULL; query <- NULL; fragment <- NULL; parameters <- NULL; # Get the host parts <- strsplit(tail, split="/", fixed=TRUE)[[1L]]; if (length(parts) > 0L) { host <- parts[1L]; tail <- paste(parts[-1L], collapse="/"); # Get the path parts <- strsplit(tail, split="?", fixed=TRUE)[[1L]]; if (length(parts) > 0L) { path <- parts[1L]; tail <- paste(parts[-1L], collapse="/"); # Get the query and fragment parts <- strsplit(tail, split="#", fixed=TRUE)[[1L]]; query <- parts[1L]; fragment <- paste(parts[-1L], collapse="#"); # Get the parameters parts <- strsplit(query, split="&", fixed=TRUE)[[1L]]; if (length(parts) > 0L) { parts <- strsplit(parts, split="=", fixed=TRUE); if (length(parts) > 0L) { names <- unlist(lapply(parts, FUN=function(x) x[1L])); parameters <- lapply(parts, FUN=function(x) paste(x[-1L], collapse="=")); names(parameters) <- names; } } } } list(protocol=protocol, host=host, path=path, query=query, fragment=fragment, parameters=parameters); }) ########################################################################### # HISTORY: # 2013-07-17 # o Updated. Rename names of returned values. Now parsing 'query' and # 'fragment' as well. # 2005-07-21 # o Created. ########################################################################### ���������������������������������������������������������������������������������������R.utils/R/parseArgs.R�������������������������������������������������������������������������������0000644�0001762�0000144�00000002514�14372747611�014103� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������.parseArgs <- function(args, defaults=list()) { # Local functions names <- function(args) { keys <- base::names(args) if (is.null(keys)) keys <- rep("", times=length(args)) keys } # names() # Argument 'args': .stop_if_not(is.list(args)) # Argument 'defaults': .stop_if_not(is.list(defaults)) formals <- names(defaults) .stop_if_not(!is.null(formals)) # Split up named and unnamed arguments named <- (names(args) != "") argsN <- args[named] args <- args[!named] argsT <- list() # Get the arguments, if they are named for (kk in seq_along(formals)) { key <- formals[kk] keys <- names(argsN) if (is.element(key, keys)) { idx <- which(keys == key)[1L] argsT[[key]] <- argsN[[idx]] argsN <- argsN[-idx] formals[kk] <- NA } } formals <- formals[!is.na(formals)] # Get the remaining arguments by position for (kk in seq_along(formals)) { key <- formals[kk] if (length(args) > 0L) { value <- args[[1L]] argsT[[key]] <- value args <- args[-1L] } else { if (!is.symbol(defaults[[key]])) { value <- defaults[[key]] argsT[[key]] <- value } } formals[kk] <- NA } formals <- formals[!is.na(formals)] # Return parsed arguments list(args=argsT, namedArgs=argsN, unnamedArgs=args) } # .parseArgs() ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/dataFrame.R�������������������������������������������������������������������������������0000644�0001762�0000144�00000002304�14372747611�014035� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault dataFrame # # @title "Allocates a data frame with given column classes" # # @synopsis # # \description{ # @get "title". # } # # \arguments{ # \item{colClasses}{A @character @vector of column classes, # cf. @see "utils::read.table".} # \item{nrow}{An @integer specifying the number of rows of the # allocated data frame.} # \item{...}{Not used.} # } # # \value{ # Returns an NxK @data.frame where N equals \code{nrow} and # K equals \code{length(colClasses)}. # } # # \examples{ # df <- dataFrame(colClasses=c(a="integer", b="double"), nrow=10) # df[,1] <- sample(1:nrow(df)) # df[,2] <- rnorm(nrow(df)) # print(df) # } # # \seealso{ # @data.frame. # } # # @keyword manip # @keyword utilities #*/########################################################################### setMethodS3("dataFrame", "default", function(colClasses, nrow=1, ...) { df <- vector("list", length=length(colClasses)) names(df) <- names(colClasses) for (kk in seq_along(df)) { df[[kk]] <- vector(colClasses[kk], length=nrow) } attr(df, "row.names") <- seq_len(nrow) class(df) <- "data.frame" df }, private=TRUE) ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/loadObject.R������������������������������������������������������������������������������0000644�0001762�0000144�00000005105�14372747611�014221� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault loadObject # # @title "Method to load object from a file or a connection" # # \description{ # @get "title", which previously have been saved using @see "saveObject". # } # # @synopsis # # \arguments{ # \item{file}{A filename or @connection to read the object from.} # \item{path}{The path where the file exists.} # \item{format}{File format.} # \item{...}{Not used.} # } # # \value{ # Returns the saved object. # } # # \details{ # The main difference from this method and @see "base::load" in the # \pkg{base} package, is that this one returns the object read rather # than storing it in the global environment by its default name. # This makes it possible to load objects back using any variable name. # } # # @author # # \seealso{ # @see "saveObject" to save an object to file. # Internally @see "base::load" is used. # See also @see "loadToEnv". # See also @see "base::saveRDS". # } # # @keyword programming # @keyword IO #*/########################################################################### setMethodS3("loadObject", "default", function(file, path=NULL, format=c("auto", "xdr", "rds"), ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'file': if (!inherits(file, "connection")) { file <- Arguments$getReadablePathname(file, path=path, mustExist=TRUE) } # Argument 'format': format <- match.arg(format) # Infer 'format' from filename extension? Default is "xdr" if (format == "auto") { format <- tools::file_ext(file) format <- tolower(format) ## Here 'format' can be character(0L) or nchar(format) >= 0L if (!isTRUE(is.element(format, c("xdr", "rds")))) format <- "xdr" } if (format == "xdr") { # Declare variable saveLoadReference <- NULL # load.default() recognized gzip'ed files too. tryCatch({ vars <- base::load(file = file) }, error = function(ex) { throw(sprintf("Failed to load file %s. The reason was: %s", sQuote(file), conditionMessage(ex))) }) if (!"saveLoadReference" %in% vars) throw("The file was not saved by saveObject(): ", file) res <- saveLoadReference } else if (format == "rds") { tryCatch({ res <- readRDS(file) }, error = function(ex) { throw(sprintf("Failed to load file %s. The reason was: %s", sQuote(file), conditionMessage(ex))) }) } res }) # loadObject() �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/gstring.R���������������������������������������������������������������������������������0000644�0001762�0000144�00000002514�14372747611�013631� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault gstring # @alias gstring.GString # # @title "Parses and evaluates a GString into a regular string" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{@character strings.} # \item{file, path}{Alternatively, a file, a URL or a @connection from # with the strings are read. # If a file, the \code{path} is prepended to the file, iff given.} # \item{envir}{The @environment in which the @see "GString" is evaluated.} # } # # \value{ # Returns a @character string. # } # # @author # # \seealso{ # @see "gcat". # } #*/########################################################################### setMethodS3("gstring", "GString", function(s, envir=parent.frame(), ...) { evaluate(s, envir=envir, ...) }) setMethodS3("gstring", "default", function(..., file=NULL, path=NULL, envir=parent.frame()) { # Argument 'file' & 'path': if (inherits(file, "connection")) { } else if (is.character(file)) { if (!is.null(path)) { file <- file.path(path, file) } if (!isUrl(file)) { file <- Arguments$getReadablePathname(file, absolute=TRUE) } } if (is.null(file)) { s <- GString(...) } else { s <- readLines(file, warn=FALSE) s <- GString(s) } gstring(s, envir=envir) }) ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/seqToIntervals.R��������������������������������������������������������������������������0000644�0001762�0000144�00000003151�14372747611�015135� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#########################################################################/** # @RdocDefault seqToIntervals # # @title "Gets all contiguous intervals of a vector of indices" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{idx}{A @vector of N @integer indices.} # \item{...}{Not used.} # } # # \value{ # An Nx2 @integer @matrix. # } # # @author # # @examples "../incl/seqToIntervals.Rex" # # \seealso{ # @set "class=matrix" # @seemethod "intervalsToSeq". # To identify sequences of \emph{equal} values, see @see "base::rle". # } # # @keyword "attribute" #*/#########################################################################t setMethodS3("seqToIntervals", "default", function(idx, ...) { # Clean up sequence idx <- as.integer(idx) idx <- unique(idx) idx <- sort(idx) n <- length(idx) if (n == 0L) { res <- matrix(NA_integer_, nrow=0L, ncol=2L) colnames(res) <- c("from", "to") return(res) } # Identify end points of intervals d <- diff(idx) d <- (d > 1) d <- which(d) nbrOfIntervals <- length(d) + 1 # Allocate return matrix res <- matrix(NA_integer_, nrow=nbrOfIntervals, ncol=2L) colnames(res) <- c("from", "to") fromValue <- idx[1] toValue <- fromValue-1 lastValue <- fromValue count <- 1 for (kk in seq_along(idx)) { value <- idx[kk] if (value - lastValue > 1) { toValue <- lastValue res[count,] <- c(fromValue, toValue) fromValue <- value count <- count + 1 } lastValue <- value } if (toValue < fromValue) { toValue <- lastValue res[count,] <- c(fromValue, toValue) } res }) �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/ProgressBar.R�����������������������������������������������������������������������������0000644�0001762�0000144�00000022236�14372747611�014410� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocClass ProgressBar # # @title "Provides text based counting progress bar" # # \description{ # @classhierarchy # } # # @synopsis # # \arguments{ # \item{max}{The maximum number of steps.} # \item{ticks}{Put visual "ticks" every \code{ticks} step.} # \item{stepLength}{The default length for each increase.} # \item{newlineWhenDone}{If @TRUE, a newline is outputted when bar is # updated, when done, otherwise not.} # } # # \section{Fields and Methods}{ # @allmethods # } # # @examples "../incl/ProgressBar.Rex" # # @author #*/########################################################################### setConstructorS3("ProgressBar", function(max=100, ticks=10, stepLength=1, newlineWhenDone=TRUE) { if (length(ticks) == 1) ticks <- seq(from=0, to=max, by=10) if (stepLength <= 0) stop("Argument 'stepLength' is non-positive: ", stepLength) extend(Object(), "ProgressBar", value=0, max=max, stepLength=stepLength, ticks=ticks, newlineWhenDone=as.logical(newlineWhenDone), .allowCarryOver=FALSE, .lastBarString="" ) }) #########################################################################/** # @RdocMethod as.character # # @title "Gets a string description of the progress bar" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns a @character string. # } # # @author # # \seealso{ # @seeclass # } #*/######################################################################### setMethodS3("as.character", "ProgressBar", function(x, ...) { # To please R CMD check this <- x s <- paste(data.class(this), ": max=", this$max, ", value=", this$value, sep="") s }) #########################################################################/** # @RdocMethod getBarString # # @title "Gets the progress bar string to be displayed" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns a @character string. # } # # @author # # \seealso{ # @seeclass # } #*/######################################################################### setMethodS3("getBarString", "ProgressBar", function(this, ...) { count <- round(this$value) bfr <- rep(".", times=count+1) # First, set the ticks bfr[intersect(1:count, this$ticks)+1] <- "|" # Then set the starter bfr[1] <- "[" # ...and the stopper (and carry overs) if (count >= this$max) { bfr[this$max+1] <- "]" bfr[-(1:(this$max+1))] <- "?" } # Generate the string bfr <- paste(bfr, collapse="") bfr }) #########################################################################/** # @RdocMethod isDone # # @title "Checks if progress bar is completed" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns @TRUE or @FALSE. # } # # @author # # \seealso{ # @seeclass # } #*/######################################################################### setMethodS3("isDone", "ProgressBar", function(this, ...) { (this$value >= this$max) }) #########################################################################/** # @RdocMethod setStepLength # # @title "Sets default step length" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{stepLength}{New default step length.} # \item{...}{Not used.} # } # # \value{ # Returns on step length. # } # # @author # # \seealso{ # @seeclass # } #*/######################################################################### setMethodS3("setStepLength", "ProgressBar", function(this, stepLength, ...) { if (stepLength <= 0) stop("Argument 'stepLength' is non-positive: ", stepLength) oldStepLength <- this$stepLength this$stepLength <- stepLength invisible(oldStepLength) }) #########################################################################/** # @RdocMethod setMaxValue # # @title "Sets maximum value" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{maxValue}{New maximum value.} # \item{...}{Not used.} # } # # \value{ # Returns nothing. # } # # @author # # \seealso{ # @seeclass # } #*/######################################################################### setMethodS3("setMaxValue", "ProgressBar", function(this, maxValue, ...) { this$max <- maxValue }) #########################################################################/** # @RdocMethod setTicks # # @title "Sets values for which ticks should be visible" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{ticks}{Tick positions (values).} # \item{...}{Not used.} # } # # \value{ # Returns old tick positions. # } # # @author # # \seealso{ # @seeclass # } #*/######################################################################### setMethodS3("setTicks", "ProgressBar", function(this, ticks=10, ...) { if (length(ticks) == 1) { ticks <- seq(from=0, to=this$max, by=ticks) } oldTicks <- this$ticks this$ticks <- ticks invisible(oldTicks) }) #########################################################################/** # @RdocMethod setValue # # @title "Sets current value" # # \description{ # @get "title". # Note that this method does \emph{not} update the bar visually. # } # # @synopsis # # \arguments{ # \item{value}{A @numeric in [0,maxValue].} # \item{...}{Not used.} # } # # \value{ # Returns old value. # } # # @author # # \seealso{ # @seemethod "setProgress". # @seemethod "increase". # @seemethod "reset". # @seeclass # } #*/######################################################################### setMethodS3("setValue", "ProgressBar", function(this, value, ...) { if (value < 0) stop("Value out of range [0,", this$max, "]: ", value) if (!this$.allowCarryOver && value > this$max) stop("Value out of range [0,", this$max, "]: ", value) oldValue <- this$value this$value <- value invisible(oldValue) }) #########################################################################/** # @RdocMethod setProgress # # @title "Sets current progress" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{progress}{A @double in [0,1] specifying the relative progress.} # \item{visual}{If @TRUE, the progress bar is redraw, otherwise not.} # \item{...}{Not used.} # } # # \value{ # Returns old value. # } # # @author # # \seealso{ # @seemethod "setValue". # @seemethod "increase". # @seemethod "reset". # @seeclass # } #*/######################################################################### setMethodS3("setProgress", "ProgressBar", function(this, progress, visual=TRUE, ...) { if (length(progress) != 1) throw("Argument 'progress' must be a single value.") if (!is.numeric(progress) || progress < 0 || progress > 1) throw("Argument 'progress' out of range [0,1]: ", progress) oldValue <- setValue(this, progress*this$max) update(this, visual=visual) invisible(oldValue/this$max) }) #########################################################################/** # @RdocMethod reset # # @title "Reset progress bar" # # \description{ # @get "title" by setting the value to zero and updating the display. # } # # @synopsis # # \arguments{ # \item{visual}{If @TRUE, the progress bar is redraw, otherwise not.} # \item{...}{Not used.} # } # # \value{ # Returns nothing. # } # # @author # # \seealso{ # @seemethod "setValue". # @seeclass # } #*/######################################################################### setMethodS3("reset", "ProgressBar", function(this, visual=TRUE, ...) { this$value <- 0 this$.lastBarString <- "" update(this, visual=visual) invisible(this$value) }) #########################################################################/** # @RdocMethod increase # # @title "Increases (steps) progress bar" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{stepLength}{Positive or negative step length.} # \item{...}{Not used.} # } # # \value{ # Returns new value. # } # # @author # # \seealso{ # @seemethod "setValue". # @seeclass # } #*/######################################################################### setMethodS3("increase", "ProgressBar", function(this, stepLength=this$stepLength, visual=TRUE, ...) { value <- this$value + stepLength if (!this$.allowCarryOver && value >= this$max) { this$value <- this$max } else { this$value <- value } update(this, visual=visual) invisible(value) }, protected=TRUE) #########################################################################/** # @RdocMethod update # # @title "Updates progress bar" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{visual}{If @TRUE, the progress bar is redrawn, otherwise not.} # \item{...}{Not used.} # } # # \value{ # Returns nothing. # } # # @author # # \seealso{ # @seeclass # } #*/######################################################################### setMethodS3("update", "ProgressBar", function(object, visual=TRUE, ...) { # To please R CMD check... this <- object if (visual) { s <- getBarString(this) ls <- this$.lastBarString cat(substring(s, nchar(ls)+1)) this$.lastBarString <- s if (this$newlineWhenDone && isDone(this)) cat("\n") } }) ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/capitalize.R������������������������������������������������������������������������������0000644�0001762�0000144�00000004256�14525311762�014300� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#########################################################################/** # @RdocDefault capitalize # @alias decapitalize # @alias decapitalize.default # # @title "Capitalizes/decapitalizes each character string in a vector" # # \description{ # Capitalizes/decapitalized (making the first letter upper/lower case) of # each character string in a vector. # } # # \usage{ # @usage capitalize,default # @usage decapitalize,default # } # # \arguments{ # \item{str}{A @vector of @character strings to be capitalized.} # \item{...}{Not used.} # } # # \value{ # Returns a @vector of @character strings of the same length as the input # vector. # } # # @author # # @examples "../incl/capitalize.Rex" # # \seealso{ # @see "R.utils::toCamelCase". # } # # @keyword "programming" #*/######################################################################### setMethodS3("capitalize", "default", function(str, ...) { # Nothing to do? n <- length(str) if (n == 0L) { return(str) } # Missing values? nas <- is.na(str) idxs <- which(nas) # All missing values? => nothing to do. if (length(idxs) == n) { return(str) } # Allocate result res <- character(length=n) # Preserve missing values if (length(idxs) > 0L) { res[idxs] <- NA_character_ } # Capitilize idxs <- which(!nas) if (length(idxs) > 0L) { t <- str[idxs] first <- substring(t, first=1L, last=1L) tail <- substring(t, first=2L) first <- toupper(first) res[idxs] <- paste(first, tail, sep="") } res }) setMethodS3("decapitalize", "default", function(str, ...) { # Nothing to do? n <- length(str) if (n == 0L) { return(str) } # Missing values? nas <- is.na(str) idxs <- which(nas) # All missing values? => nothing to do. if (length(idxs) == n) { return(str) } # Allocate result res <- character(length=n) # Preserve missing values if (length(idxs) > 0L) { res[idxs] <- NA_character_ } # Decapitilize idxs <- which(!nas) if (length(idxs) > 0L) { t <- str[idxs] first <- substring(t, first=1L, last=1L) tail <- substring(t, first=2L) first <- tolower(first) res[idxs] <- paste(first, tail, sep="") } res }) ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/createWindowsShortcut.R�������������������������������������������������������������������0000644�0001762�0000144�00000014374�14372747611�016535� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault createWindowsShortcut # # @title "Creates a Microsoft Windows Shortcut (.lnk file)" # # @synopsis # # \description{ # @get "title". # } # # \arguments{ # \item{pathname}{The pathname (with file extension *.lnk) of the link # file to be created.} # \item{target}{The target file or directory to which the shortcut should # point to.} # \item{overwrite}{If @TRUE, an existing link file is overwritten, # otherwise not.} # \item{mustWork}{If @TRUE, an error is produced if the Windows Shortcut # link is not created, otherwise not.} # \item{...}{Not used.} # } # # \value{ # Returns (invisibly) the pathname. # } # # \section{Required privileges on Windows}{ # In order for this method, which utilizes Windows Script Host a VBScript, # to succeed on Windows, the client/R session must run with sufficient # privileges (it has been reported that Administrative rights are necessary). # } # # @examples "../incl/createWindowsShortcut.Rex" # # @author # # \seealso{ # @see "readWindowsShortcut" # } # # \references{ # [1] Create a windows shortcut (.LNK file), SS64.com, # \url{https://ss64.com/nt/shortcut.html} \cr # } # # @keyword file # @keyword IO #*/########################################################################### setMethodS3("createWindowsShortcut", "default", function(pathname, target, overwrite=FALSE, mustWork=FALSE, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Local functions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Reference: [1] makeVBScript <- function(target, link, description=basename(target)) { # Arguments 'target': target <- Arguments$getReadablePathname(target, mustExist=TRUE) target <- getAbsolutePath(target) # Arguments 'link': link <- getAbsolutePath(link) targetPath <- gsub("/", "\\\\", target) linkFile <- gsub("/", "\\\\", link) if (isDirectory(targetPath)) { workingDir <- targetPath } else { workingDir <- dirname(targetPath) } s <- "Set oWS = WScript.CreateObject(\"WScript.Shell\")" s <- c(s, sprintf("sLinkFile = \"%s.LNK\"", linkFile)) s <- c(s, "Set oLink = oWS.CreateShortcut(sLinkFile)") s <- c(s, sprintf("oLink.TargetPath = \"%s\"", targetPath)) # s <- c(s, "oLink.Arguments = \"\"") s <- c(s, sprintf("oLink.Description = \"%s\"", description)) # s <- c(s, "oLink.HotKey = \"\"") # s <- c(s, sprintf("oLink.IconLocation = \"%s, 1\"", targetPath)) # s <- c(s, "oLink.WindowStyle = \"1\"") # s <- c(s, sprintf("oLink.WorkingDirectory = \"%s\"", workingDir)) s <- c(s, "oLink.Save") s <- paste(s, collapse="\n") s } # makeVBScript createWindowsShortcutViaVBScript <- function(pathname, target, mustWork = FALSE) { link <- gsub("[.](lnk|LNK)$", "", pathname) # Generate VB code pd <- packageDescription("R.utils") pkgInfo <- sprintf("%s v%s", pd$Package, pd$Version) description <- sprintf("Windows Shortcut link created by %s", pkgInfo) code <- makeVBScript(target, link, description=description) tmpFile <- tempfile() pathnameT <- sprintf("%s.vbs", tmpFile) on.exit(file.remove(pathnameT)) cat(file=pathnameT, code) cmd <- sprintf("cscript \"%s\"", pathnameT) res <- tryCatch({ res <- shell(cmd, intern=TRUE, mustWork=TRUE, shell=Sys.getenv("COMSPEC")) status <- attr(res, "status") if (!is.null(status)) { msg <- sprintf("Shell command %s had status %d (using shell %s): %s", sQuote(cmd), status, sQuote(Sys.getenv("COMSPEC")), paste(res, collapse = "; ")) throw(msg) } res }, error = identity) if (inherits(res, "error")) { msg <- sprintf("An error occurred when calling VBScript (%s) to create Windows Shortcut link %s. The reason was: %s", sQuote(cmd), sQuote(pathname), conditionMessage(res)) throw(msg) } # Sanity check if (!isFile(pathname)) { if (!mustWork) return(NULL) msg <- sprintf("Failed to create Windows Shortcut link %s via VBScript (%s)", sQuote(pathname), sQuote(cmd)) if (inherits(res, "error")) { msg <- sprintf("%s. The reason was: %s", msg, conditionMessage(res)) } else if (inherits(res, "character")) { msg <- sprintf("%s. The reason was: %s", msg, paste(res, collapse="; ")) } throw(msg) } pathname } # createWindowsShortcutViaVBScript() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'overwrite': overwrite <- Arguments$getLogical(overwrite) # Argument 'mustWork': mustWork <- Arguments$getLogical(mustWork) # Argument 'pathname': if (!overwrite && isFile(pathname)) { throw("Cannot create Windows Shortcut link. File already exists: ", pathname) } # Argument 'target': target <- Arguments$getReadablePathname(target, mustExist=TRUE) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Create Windows Shortcut link # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - createWindowsShortcutViaVBScript(pathname, target=target, mustWork=mustWork) link <- gsub("[.](lnk|LNK)$", "", pathname) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate correctness # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Try to read Windows shortcut (throws a parsing error if so) lnk <- tryCatch({ # (i) Try using new reader... readWindowsShellLink(pathname) }, error = function(ex) { # (ii) ...using old reverse-enginered reader readWindowsShortcut(pathname) }) target0 <- getAbsolutePath(target) target1 <- Arguments$getReadablePathname(link, mustWork=mustWork) target1 <- getAbsolutePath(target1) # AD HOC: It may happen that the case of the drive letters differ. if (tolower(target1) != tolower(target0)) { throw("Failed to create a valid Windows Shortcut link. The link does not point the expected file: ", target1, " != ", target0) } # Return the LNK file invisible(pathname) }) # createWindowsShortcut() ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/resample.R��������������������������������������������������������������������������������0000644�0001762�0000144�00000002145�14372747611�013764� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault resample # # @title "Sample values from a set of elements" # # \description{ # @get "title". # Contrary to @see "base::sample", this function also works as # expected when there is only one element in the set to be sampled, cf. [1]. # This function originates from the example code of @see "base::sample" # as of R v2.12.0. # } # # @synopsis # # \arguments{ # \item{x}{A @vector of any length and data type.} # \item{...}{Additional arguments passed to @see "base::sample.int".} # } # # \value{ # Returns a sampled @vector of the same data types as argument \code{x}. # } # # @author # # \seealso{ # Internally @see "base::sample.int" is used. # } # # \references{ # [1] Henrik Bengtsson, # \emph{Using sample() to sample one value from a single value?}, # R-devel mailing list, 2010-11-03.\cr # } # # @keyword IO # @keyword programming #*/########################################################################### setMethodS3("resample", "default", function(x, ...) { x[sample.int(length(x), ...)] }) ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/inAnyInterval.R���������������������������������������������������������������������������0000644�0001762�0000144�00000001310�14372747611�014730� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������########################################################################/** # @set "class=numeric" # @RdocMethod inAnyInterval # # @title "Checks if a set of values are inside one or more intervals" # # @synopsis # # \description{ # @get "title". # } # # \arguments{ # \item{...}{Arguments passed to @seemethod "mapToIntervals".} # } # # \value{ # Returns a @logical @vector. # } # # @author # # \seealso{ # @see "mapToIntervals". # } # # @keyword "utilities" # @keyword "programming" #*/######################################################################### setMethodS3("inAnyInterval", "numeric", function(...) { idxs <- mapToIntervals(...) idxs <- is.finite(idxs) idxs }) # inAnyInterval() ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/GString-class.R���������������������������������������������������������������������������0000644�0001762�0000144�00000042253�14525546077�014643� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocClass "GString" # @set "name=GString-class" # # @title "Character string with advanced substitutions" # # \description{ # @classhierarchy # } # # @synopsis # # \arguments{ # \item{...}{one or more objects, to be coerced to @character vectors.} # \item{sep}{A @character string to separate the terms.} # } # # \section{Fields and Methods}{ # @allmethods # } # # @examples "../incl/GString.Rex" # # @author # # \seealso{ # For convenience, see functions @see "gstring" and @see "gcat". # } # # @visibility public #*/########################################################################### setConstructorS3("GString", function(..., sep="") { s <- paste(..., sep=sep) if (length(s) > 1L) { throw("Trying to coerce more than one character string to a GString, which is not supported.") } extend(s, "GString") }) ###########################################################################/** # @RdocMethod getRaw # # @title "Gets the unprocessed GString" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns a @character string. # } # # @author # # \seealso{ # @seemethod "as.character" # @seeclass # } #*/########################################################################### setMethodS3("getRaw", "GString", function(object, ...) { unclass(object) }) ###########################################################################/** # @RdocMethod print # # @title "Prints the processed GString" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Arguments passed to @see "base::print".} # } # # \value{ # Returns (invisibly) the process GString @character string. # } # # @author # # \seealso{ # @seeclass # } #*/########################################################################### setMethodS3("print", "GString", function(x, ...) { # To please R CMD check. object <- x print(as.character(object), ...) }) ###########################################################################/** # @RdocMethod getBuiltinPid # # @title "Gets the process id of the current R session" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns an @integer. # } # # @author # # \seealso{ # @seeclass # } #*/########################################################################### setMethodS3("getBuiltinPid", "GString", function(static, ...) { pid <- Sys.getpid() pid }, static=TRUE) ###########################################################################/** # @RdocMethod getBuiltinHostname # # @title "Gets the hostname of the system running R" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns a @character string. # } # # @author # # \seealso{ # @seeclass # } #*/########################################################################### setMethodS3("getBuiltinHostname", "GString", function(static, ...) { # 1. Try Sys.getenv() host <- Sys.getenv(c("HOST", "HOSTNAME", "COMPUTERNAME")) host <- host[host != ""] # 1. Try calling 'uname' if (length(host) == 0L) { tryCatch({ host <- readLines(pipe("/usr/bin/env uname -n")) host <- host[host != ""] }, error = function(ex) {}) } if (length(host) == 0L) host <- NA host[1L] }, static=TRUE) ###########################################################################/** # @RdocMethod getBuiltinUsername # # @title "Gets the username of the user running R" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns a @character string. # } # # @author # # \seealso{ # @seeclass # } #*/########################################################################### setMethodS3("getBuiltinUsername", "GString", function(static, ...) { # 1. Try Sys.info(), which returns NULL if not implemented. user <- Sys.info()["user"] user <- user[user != "unknown"] # 2. Try Sys.getenv() if (length(user) == 0L) { user <- Sys.getenv(c("USER", "USERNAME")) user <- user[user != ""] } # 3. Try calling 'whoami' if (length(user) == 0L) { tryCatch({ user <- readLines(pipe("/usr/bin/env whoami")) user <- user[user != ""] }, error = function(ex) {}) } if (length(user) == 0L) user <- NA user[1L] }, static=TRUE) ###########################################################################/** # @RdocMethod getBuiltinDate # # @title "Gets the current date" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{format}{A @character format string.} # \item{...}{Not used.} # } # # \value{ # Returns a @character string. # } # # @author # # \seealso{ # @seeclass # } #*/########################################################################### setMethodS3("getBuiltinDate", "GString", function(static, format="%Y-%m-%d", ...) { args <- list(Sys.time(), format=format) do.call(base::format, args) }, static=TRUE) ###########################################################################/** # @RdocMethod getBuiltinTime # # @title "Gets the current time" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{format}{A @character format string.} # \item{...}{Not used.} # } # # \value{ # Returns a @character string. # } # # @author # # \seealso{ # @seeclass # } #*/########################################################################### setMethodS3("getBuiltinTime", "GString", function(static, format="%H:%M:%S", ...) { args <- list(Sys.time(), format=format) do.call(base::format, args) }, static=TRUE) ###########################################################################/** # @RdocMethod getBuiltinDatetime # # @title "Gets the current date and time" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{format}{A @character format string.} # \item{...}{Not used.} # } # # \value{ # Returns a @character string. # } # # @author # # \seealso{ # @seeclass # } #*/########################################################################### setMethodS3("getBuiltinDatetime", "GString", function(static, format=NULL, ...) { args <- list(Sys.time(), format=format) do.call(base::format, args) }, static=TRUE) ###########################################################################/** # @RdocMethod getBuiltinRversion # # @title "Gets the current R version" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns a @character string. # } # # @author # # \seealso{ # @seeclass # } #*/########################################################################### setMethodS3("getBuiltinRversion", "GString", function(static, ...) { getRversion() }, static=TRUE) ###########################################################################/** # @RdocMethod getBuiltinRhome # # @title "Gets the path where R is installed" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns a @character string. # } # # @author # # \seealso{ # @seeclass # } #*/########################################################################### setMethodS3("getBuiltinRhome", "GString", function(static, ...) { R.home() }, static=TRUE) ###########################################################################/** # @RdocMethod getBuiltinOs # # @title "Gets the operating system of the running machine" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns a @character string. # } # # @author # # \seealso{ # @seeclass # } #*/########################################################################### setMethodS3("getBuiltinOs", "GString", function(static, ...) { .Platform$OS.type }, static=TRUE) ###########################################################################/** # @RdocMethod getVariableValue # # @title "Gets a variable value given a name and attributes" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{name}{The name of the variable or function to be queried.} # \item{attributes}{A @character string of the attributes.} # \item{where}{A @character @vector of where to search for the variable # or function.} # \item{envir}{An @environment.} # \item{inherits}{A @logical.} # \item{missingValue}{The value returned if not found.} # \item{...}{Not used.} # } # # \value{ # Returns a (@vector of) objects. # } # # @author # # \seealso{ # @seeclass # } #*/########################################################################### setMethodS3("getVariableValue", "GString", function(static, name, attributes="", where=c("builtin", "envir", "parent", "Sys.getenv", "getOption"), envir=parent.frame(), inherits=TRUE, missingValue=NA, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'name': if (is.null(name)) { throw("Argument 'name' is NULL.") } else if (!is.character(name)) { throw("Argument 'name' must be a character string: ", mode(name)) } # Argument 'envir': .stop_if_not(is.environment(envir)) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Process attributes # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - attrs <- strsplit(attributes, split=", ")[[1L]] if (length(attrs) > 0L) { isSimpleAttr <- (regexpr("^[abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0-9._]+=.*$", attrs) == -1L) simpleAttrs <- attrs[isSimpleAttr] if (length(simpleAttrs) == 0L) simpleAttrs <- NULL attrs <- paste(attrs[!isSimpleAttr], collapse=", ") attrs <- eval(parse(text=paste("list(", attrs, ")")), enclos = baseenv()) } else { attrs <- NULL simpleAttrs <- NULL } value <- NULL for (ww in where) { if (ww == "builtin") { capitalizedName <- paste(toupper(substr(name, start=1L, stop=1L)), substr(name, start=2L, stop=nchar(name)), sep="") builtInMethodName <- paste("getBuiltin", capitalizedName, sep="") tryCatch({ args <- list(static) args <- c(args, attrs) value <- do.call(builtInMethodName, args=args) }, error = function(ex) { }) } else if (ww == "Sys.getenv") { value <- Sys.getenv(name) if (nchar(value) == 0L) value <- NULL } else if (ww == "getOption") { value <- getOption(name) } else if (ww == "envir") { if (exists(name, envir=envir, inherits=inherits)) { value <- get(name, envir=envir, inherits=inherits) } } else if (ww == "parent") { envirL <- NULL n <- 0L while (TRUE) { n <- n + 1L envirP <- parent.frame(n=n) if (identical(envirP, envirL)) break envirL <- envirP if (exists("...abcdef", envir=envirP, inherits=FALSE)) next if (exists(name, envir=envirP, inherits=FALSE)) { value <- get(name, envir=envirP, inherits=FALSE) break } if (identical(envir, .GlobalEnv)) break } } else { if (exists(ww, mode="function")) { tryCatch({ args <- c(attrs, list(...)) value <- do.call(name, args=args) }, error = function(ex) {}) } else { throw("Unknown search location of variable '", name, "': ", ww) } } if (!is.null(value)) { tryCatch({ value <- as.character(value) }, error = function(ex) { value <<- NA }) # Apply simple attributes for (attr in simpleAttrs) { if (attr == "capitalize") { value <- paste(toupper(substring(value, first=1L, last=1L)), substring(value, first=2L), sep="") } else { tryCatch({ fcn <- get(attr, mode="function") value <- fcn(value) }, error = function(ex) {}) } } if (any(nchar(value) > 0L)) break } } # for (ww in ...) if (is.null(value)) { value <- missingValue } value }, static=TRUE, private=TRUE) ###########################################################################/** # @RdocMethod parse # # @title "Parses a GString" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns a @list structure. # } # # @author # # \seealso{ # @seeclass # } #*/########################################################################### setMethodS3("parse", "GString", function(object, ...) { s <- getRaw(object) # If there is no markup, then there is nothing to parse if (length(s) == 0L || !regexpr("${", s, fixed=TRUE) != -1L) { return(list(text=s)) } # Parse the GString into a list of 'strings' intermixed with 'gstrings'. parts <- list() # Formats: # ${expression} # $[attribute,attribute,...,attribute]{expression} while(TRUE) { pattern <- "^\\$(\\[.*\\]|)\\{([^\\}]*)\\}" pos <- regexpr(pattern, s) matchLen <- attr(pos, "match.length") pos <- pos[1L] if (pos != -1L) { text <- "" } else { pattern <- "[^\\\\$]\\$(\\[.*\\]|)\\{([^\\}]*)\\}" pos <- regexpr(pattern, s) matchLen <- attr(pos, "match.length") pos <- pos[1] if (pos != -1) { text <- substr(s, start=1L, stop=pos) text <- gsub("\\\\\\$", "$", text) } else { text <- s text <- gsub("\\\\\\$", "$", text) parts <- c(parts, list(text=text)) break } } prefix <- list(text=text) parts <- c(parts, prefix) last <- pos + matchLen - 1L var <- substr(s, start=pos, stop=last) attributes <- gsub(pattern, "\\1", var) attributes <- gsub("^\\[", "", attributes) attributes <- gsub("\\]$", "", attributes) name <- gsub(pattern, "\\2", var) searchReplace <- NULL patterns <- c("^[']([^']*)[']$", '^["]([^"]*)["]$') if (all(sapply(patterns, FUN=regexpr, name) == -1L)) { pattern <- "^(.*)/(.*)/(.*)" if (regexpr(pattern, name) != -1L) { searchPattern <- gsub(pattern, "\\2", name) replacePattern <- gsub(pattern, "\\3", name) name <- gsub(pattern, "\\1", name) searchReplace <- list(search=searchPattern, replace=replacePattern) } } else { for (pattern in patterns) { name <- gsub(pattern, "\\1", name) } } pattern <- "^`(.*)`" isExpression <- (regexpr(pattern, name) != -1L) if (isExpression) { call <- gsub(pattern, "\\1", name) part <- list(expression=list(call=call)) } else { part <- list(variable=list(name=name)) } part[[1L]]$attributes <- attributes part[[1L]]$searchReplace <- searchReplace parts <- c(parts, part) s <- substr(s, start=last+1L, stop=nchar(s)) if (nchar(s) == 0L) break } # while(TRUE) parts }, private=TRUE) ###########################################################################/** # @RdocMethod evaluate # # @title "Parses and evaluates a GString" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{envir}{The @environment in which the @see "GString" is evaluated.} # \item{...}{Additional arguments passed to @seemethod "parse".} # } # # \value{ # Returns a @character string. # } # # @author # # \seealso{ # @seeclass # } #*/########################################################################### setMethodS3("evaluate", "GString", function(object, envir=parent.frame(), ...) { # Argument 'envir': .stop_if_not(is.environment(envir)) # If there is no markup, then return alrady here. s <- unclass(object) # If there is no markup, then there is nothing to parse if (length(s) == 0L || !regexpr("${", s, fixed=TRUE) != -1L) { return(s) } parts <- parse(object, ...) keys <- names(parts) ...abcdef <- TRUE isVariable <- (keys == "variable") for (kk in which(isVariable)) { part <- parts[[kk]] value <- getVariableValue(object, name=part$name, attributes=part$attributes, envir=envir, ...) if (!is.null(part$searchReplace)) value <- gsub(part$searchReplace$search, part$searchReplace$replace, value) parts[[kk]] <- value } isExpression <- (keys == "expression") for (kk in which(isExpression)) { part <- parts[[kk]] expr <- parse(text=part$call) value <- eval(expr, enclos = baseenv()) if (!is.null(part$searchReplace)) value <- gsub(part$searchReplace$search, part$searchReplace$replace, value) parts[[kk]] <- value } s <- "" for (kk in seq_along(parts)) { part <- parts[[kk]] s <- paste(s, part, sep="") } s }, protected=TRUE) # evaluate() ###########################################################################/** # @RdocMethod as.character # # @title "Gets the processed character string" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns a @character string. # } # # @author # # \seealso{ # @seeclass # } #*/########################################################################### setMethodS3("as.character", "GString", function(x, envir=parent.frame(), ...) { evaluate(x, envir=envir, ...) }) �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/dimNA.R�����������������������������������������������������������������������������������0000644�0001762�0000144�00000003642�14372747611�013147� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������if (!exists("dimNA<-", mode="function")) { "dimNA<-" <- function(x, value) { UseMethod("dimNA<-") } } ###########################################################################/** # @RdocDefault "dimNA<-" # \alias{dimNA<-} # \alias{dimNA<-.default} # # @title "Sets the dimension of an object with the option to infer one dimension automatically" # # \description{ # @get "title". # If one of the elements in the dimension @vector is @NA, then its value # is inferred from the length of the object and the other elements in the # dimension vector. If the inferred dimension is not an @integer, an # error is thrown. # } # # @synopsis # # \arguments{ # \item{x}{An R object.} # \item{value}{@NULL of a positive @numeric @vector with one optional @NA.} # } # # \value{ # Returns (invisibly) what \code{dim<-()} returns # (see @see "base::dim" for more details). # } # # \examples{ # x <- 1:12 # dimNA(x) <- c(2,NA,3) # stopifnot(dim(x) == as.integer(c(2,2,3))) # } # # @author # # \seealso{ # @see "base::dim". # } # # @keyword file # @keyword IO #*/########################################################################### setMethodS3("dimNA<-", "default", function(x, value) { # Argument 'x': n <- length(x) # Argument 'value': if (!is.null(value)) { value <- as.integer(value) dimStr <- sprintf("c(%s)", paste(value, collapse=", ")) # Infer one dimension automatically? nas <- which(is.na(value)) if (length(nas) > 0) { if (length(nas) > 1) { throw("Argument 'value' may only have one NA: ", dimStr) } value[nas] <- as.integer(n / prod(value[-nas])) } # Validate the new dimension is compatible with the number of elements if (prod(value) != n) { stop("Argument 'dim' does not match the number of elements: ", "prod(", dimStr, ") == ", prod(value), " does not equal ", n) } } dim(x) <- value invisible(x) }) # dimNA<-() ����������������������������������������������������������������������������������������������R.utils/R/whichVector.R�����������������������������������������������������������������������������0000644�0001762�0000144�00000004277�14372747611�014451� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @set "class=logical" # @RdocMethod whichVector # @alias whichVector.matrix # # @title "Identifies TRUE elements in a logical vector" # # \description{ # @get "title". # # \emph{NOTE: @see "base::which" should be used instead of this method} ## unless you are running R (< 2.11.0), for which this method is faster # than @see "base::which" for @logical @vectors, especially when there # are no missing values. # } # # @synopsis # # \arguments{ # \item{x}{A @logical @vector of length N.} # \item{na.rm}{If @TRUE, missing values are treated as @FALSE, # otherwise they are returned as @NA.} # \item{use.names}{If @TRUE, the names attribute is preserved, # otherwise it is not return.} # \item{...}{Not used.} # } # # \value{ # Returns an @integer @vector of length less or equal to N. # } # # \section{Benchmarking}{ # In R v2.11.0 @see "base::which" was made approx. 10 times # faster via a native implementation. Because of this, this # method is of little use and approximately 3 times slower. # However, for earlier version of R, this method is still # significantly faster. For example, # simple comparison on R v2.7.1 on Windows XP, show that # this implementation can be more than twice as fast as # @see "base::which", especially when there are no missing # value (and \code{na.rm=FALSE}) is used. # } # # \examples{\dontrun{ # @include "../incl/whichVector.Rex" # }} # # @author # # \seealso{ # @see "base::which" # } # # @keyword programming # @keyword internal #*/########################################################################### setMethodS3("whichVector", "logical", function(x, na.rm=TRUE, use.names=TRUE, ...) { if (!is.vector(x)) { stop("Argument 'x' is not a vector: ", class(x)[1]) } idxs <- seq_along(x) # Identify TRUE and NA elements idxs <- idxs[x] # Remove missing values? if (na.rm) { idxs <- idxs[!is.na(idxs)] } # Use names if (use.names) { names(idxs) <- names(x)[idxs] } idxs }, private=TRUE) # whichVector() setMethodS3("whichVector", "matrix", function(x, ...) { x <- as.vector(x) whichVector(x, ...) }, private=TRUE) ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/999.NonDocumentedObjects.R����������������������������������������������������������������0000644�0001762�0000144�00000011213�14372747611�016555� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDocumentation "Non-documented objects" # # % The Arguments class # @alias getCharacter # @alias getCharacters # @alias getDirectory # @alias getDouble # @alias getDoubles # @alias getIndex # @alias getIndices # @alias getInteger # @alias getIntegers # @alias getLogical # @alias getLogicals # @alias getNumeric # @alias getNumerics # @alias getVector # @alias getVerbose # @alias getFilename # @alias getReadablePathname # @alias getReadablePathnames # @alias getWritablePathname # @alias getReadablePath # @alias getRegularExpression # @alias getWritablePath # % Devel methods # @alias getInstanceOf # @alias getDirectory.Arguments # @alias getReadablePath.Arguments # @alias getWritablePath.Arguments # # % The Assert class # @alias isMatrix # @alias isScalar # @alias isVector # # % The CmdArgsFunction class # @alias CmdArgsFunction # @alias print.CmdArgsFunction # # % The connection class # @alias isEof # # % The GenericSummary class # @alias GenericSummary # @alias [.GenericSummary # @alias c.GenericSummary # @alias print.GenericSummary # # % The GString class # @alias getBuiltinDate # @alias getBuiltinDatetime # @alias getBuiltinHostname # @alias getBuiltinOs # @alias getBuiltinPid # @alias getBuiltinRhome # @alias getBuiltinRversion # @alias getBuiltinTime # @alias getBuiltinUsername # @alias getRaw # @alias getVariableValue # @alias parse # @alias parse.default # # % The Java class # @alias asByte # @alias asInt # @alias asLong # @alias asShort # @alias readByte # @alias readInt # @alias readShort # @alias readUTF # @alias writeByte # @alias writeInt # @alias writeShort # @alias writeUTF # # % The Options class # @alias hasOption # @alias getOption # @alias getOption.default # @alias getLeaves # @alias nbrOfOptions # # % The ProgressBar and FileProgressBar classes # @alias cleanup # @alias getBarString # @alias increase # @alias isDone # @alias reset # @alias setMaxValue # @alias setProgress # @alias setStepLength # @alias setTicks # @alias setValue # # % The Settings class # @alias findSettings # @alias getLoadedPathname # @alias isModified # @alias loadAnywhere # @alias saveAnywhere # @alias promptAndSave # # % The System class # @alias currentTimeMillis # @alias findGhostscript # @alias findGraphicsDevice # @alias getHostname # @alias getUsername # @alias openBrowser # @alias parseDebian # @alias getMappedDrivesOnWindows # @alias getMappedDrivesOnWindows.System # @alias mapDriveOnWindows # @alias mapDriveOnWindows.System # @alias unmapDriveOnWindows # @alias unmapDriveOnWindows.System # # % The System class # @alias getLabel # @alias setLabel # # % The TextStatusBar class # @alias popMessage # @alias setLabels # @alias updateLabels # # % The Verbose class # @alias capture # @alias cat # @alias cat.default # @alias evaluate # @alias enter # @alias enterf # @alias exit # @alias popState # @alias pushState # @alias getThreshold # @alias getVariable # @alias header # @alias isOn # @alias isVisible # @alias less # @alias more # @alias newline # @alias on # @alias off # @alias ruler # @alias setDefaultLevel # @alias setThreshold # @alias warnings # @alias warnings.default # @alias writeRaw # @alias timestamp # @alias getTimestampFormat # @alias setTimestampFormat # @alias timestamp.default # @alias timestampOff # @alias timestampOn # # % The SmartComments class # @alias convertComment # @alias reset # @alias validate # # % The VComments class # % <none> # # % Intervals # @alias inAnyInterval # @alias mapToIntervals # @alias mergeIntervals # @alias intervalsToSeq # # % Misc. # @alias extract # @alias isOpen # @alias isOpen.default # @alias remove.default # @alias unwrap # @alias verbose # @alias withoutGString # @alias wrap # @alias whichVector # @alias draw # @alias swapXY # # % Private # @alias toFileListTree # @alias toFileListTree.character # @alias pasteTree # @alias pasteTree.FileListTree # @alias cat.FileListTree # @alias toAsciiRegExprPattern # @alias toAsciiRegExprPattern.character # @alias getCommonPrefix # @alias mergeByCommonTails # @alias splitByCommonTails # @alias print.CapturedEvaluation # # # \description{ # This page contains aliases for all "non-documented" objects that # \code{R CMD check} detects in this package. # # Almost all of them are \emph{generic} functions that have specific # document for the corresponding method coupled to a specific class. # Other functions are re-defined by \code{setMethodS3()} to # \emph{default} methods. Neither of these two classes are non-documented # in reality. # The rest are deprecated methods. # } # # @author # # @keyword internal #*/########################################################################### �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/GenericSummary.R��������������������������������������������������������������������������0000644�0001762�0000144�00000001776�14372747611�015117� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������setConstructorS3("GenericSummary", function(s="", ...) { class(s) <- "GenericSummary" s }, protected=TRUE) setMethodS3("print", "GenericSummary", function(x, ..., collapse="\n") { # To please R CMD check this <- x s <- as.character(this) s <- paste(s, collapse=collapse) cat(s, collapse, sep="") }, protected=TRUE) setMethodS3("c", "GenericSummary", function(x, ...) { s <- NextMethod() class(s) <- class(x) s }, protected=TRUE) setMethodS3("[", "GenericSummary", function(x, i, ...) { s <- NextMethod() class(s) <- class(x) s }, protected=TRUE) # setMethodS3("as.character", "GenericSummary", function(this, ..., indent=" ") { # toString <- function(s, currIndent="") { # if (is.list(s)) { # s <- sapply(s, FUN=function(x) { # paste(currIndent, # toString(x, currIndent=paste(currIndent, indent, sep="")), # sep="") # }) # unlist(s, use.names=FALSE) # } else { # s # } # } # # toString(this) # }) ��R.utils/R/isOpen.character.R������������������������������������������������������������������������0000644�0001762�0000144�00000004375�14372747611�015353� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������########################################################################/** # @class character # @RdocMethod isOpen # # @title "Checks if there is an open connection to a file" # # @synopsis # # \description{ # @get "title". # } # # \arguments{ # \item{pathname}{An @character @vector.} # \item{rw}{A @character @vector. # If \code{"read"}, a file is considered to be open if there exist an # open connection that can read from that file. # If \code{"write"}, a file is considered to be open if there exist an # open connection that can write to that file. # Both these values may be specified. # } # \item{...}{Not used.} # } # # \value{ # Returns a @logical @vector indicating for each file whether there # exists an open file @connection or not. # } # # @author # # \seealso{ # See \code{isOpen()} in @see "base::connections". # @see "base::showConnections". # } # # @keyword "IO" # @keyword "utilities" #*/######################################################################### setMethodS3("isOpen", "character", function(pathname, rw=c("read", "write"), ...) { # Arguments 'pathname': pathname <- as.character(pathname) nPathnames <- length(pathname) # Arguments 'rw': if (!all(rw %in% c("read", "write"))) { throw("Argument 'rw' contains unknown values: ", paste(rw, collapse=", ")) } # Nothing to do? if (nPathnames == 0L) return(logical(0L)) # Multiple pathnames? if (nPathnames > 1L) { res <- sapply(pathname, FUN=isOpen, rw=rw, ...) ## names(res) <- pathname return(res) } # Check single pathname pathname <- getAbsolutePath(pathname) # Get all (user) connections cons <- getAllConnections() cons <- cons[cons > 2] for (cc in cons) { info <- summary.connection(cc) # Look only for file connections if (!info$class %in% c("file")) next # Is is open? if (!info$opened %in% c("opened")) next # Is is open for reading? if (("read" %in% rw) && !(info[["can read"]] %in% c("yes"))) next # Is is open for writing? if (("write" %in% rw) && !(info[["can write"]] %in% c("yes"))) next # Is it opened to the same file? filename <- getAbsolutePath(info$description) if (identical(filename, pathname)) return(TRUE) } FALSE }) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/compressFile.R����������������������������������������������������������������������������0000644�0001762�0000144�00000023321�14372747611�014606� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#########################################################################/** # @RdocDefault compressFile # @alias decompressFile # @alias decompressFile.default # @alias isCompressedFile # @alias isCompressedFile.default # @alias bzip2 # @alias bzip2.default # @alias bunzip2 # @alias bunzip2.default # @alias isBzipped # @alias isBzipped.default # @alias gzip # @alias gzip.default # @alias gunzip # @alias gunzip.default # @alias isGzipped # @alias isGzipped.default # %% @alias xz # %% @alias xz.default # %% @alias unxz # %% @alias unxz.default # %% @alias isXzipped # %% @alias isXzipped.default # # @title "Compressing and decompressing files" # # \usage{ # @usage compressFile,default # @usage decompressFile,default # @usage isCompressedFile,default # @usage bzip2,default # @usage bunzip2,default # @usage gzip,default # @usage gunzip,default # } # # \description{ # @get "title" such as gzip:ed and bzip2:ed files. # # \emph{ # NOTE: The default (\code{remove=TRUE}) behavior is that # the input file is removed after that the output file # is fully created and closed. # } # } # # \arguments{ # \item{filename}{Pathname of input file.} # \item{destname}{Pathname of output file.} # \item{temporary}{If @TRUE, the output file is created in a # temporary directory.} # \item{skip}{If @TRUE and the output file already exists, # the output file is returned as is.} # \item{overwrite}{If @TRUE and the output file already exists, # the file is silently overwritten, otherwise an exception is # thrown (unless \code{skip} is @TRUE).} # \item{remove}{If @TRUE, the input file is removed afterward, # otherwise not.} # \item{BFR.SIZE}{The number of bytes read in each chunk.} # \item{...}{Passed to the underlying function or alternatively not used.} # \item{method}{A @character string specifying how to infer whether # a file is compressed or not.} # \item{ext, fileClass, FUN}{(internal) Filename extension, file class, # and a connection @function used to read from/write to file.} # } # # \value{ # Returns the pathname of the output file. # The number of bytes processed is returned as an attribute. # # \code{isCompressedFile()}, \code{isGzipped()} and \code{isBzipped()} # return a @logical. # Note that with \code{method = "extension"} (default), only the filename # extension is used to infer whether the file is compressed or not. # Specifically, it does not matter whether the file actually exists or not. # } # # \details{ # Internally \code{bzfile()} and \code{gzfile()} # (see @see "base::connections") are used to read (write) files. # If the process is interrupted before completed, the partially written # output file is automatically removed. # } # # \examples{ # ## bzip2 # cat(file="foo.txt", "Hello world!") # print(isBzipped("foo.txt")) # print(isBzipped("foo.txt.bz2")) # # bzip2("foo.txt") # print(file.info("foo.txt.bz2")) # print(isBzipped("foo.txt")) # print(isBzipped("foo.txt.bz2")) # # bunzip2("foo.txt.bz2") # print(file.info("foo.txt")) # # ## gzip # cat(file="foo.txt", "Hello world!") # print(isGzipped("foo.txt")) # print(isGzipped("foo.txt.gz")) # # gzip("foo.txt") # print(file.info("foo.txt.gz")) # print(isGzipped("foo.txt")) # print(isGzipped("foo.txt.gz")) # # gunzip("foo.txt.gz") # print(file.info("foo.txt")) # # ## Cleanup # file.remove("foo.txt") # } # # @author # # @keyword "file" # @keyword "programming" #*/######################################################################### setMethodS3("compressFile", "default", function(filename, destname=sprintf("%s.%s", filename, ext), ext, FUN, temporary=FALSE, skip=FALSE, overwrite=FALSE, remove=TRUE, BFR.SIZE=1e7, ...) { # Argument 'filename': if (!file.exists(filename)) { stop("No such file: ", filename) } # Argument 'ext': ext <- as.character(ext) # Argument 'FUN': if (!is.function(FUN)) { stop(sprintf("Argument 'FUN' is not a function: %s", mode(FUN))) } # Argument 'temporary': if (temporary) { destname <- file.path(tempdir(), basename(destname)) } attr(destname, "temporary") <- temporary # Argument 'filename' & 'destname': if (filename == destname) { stop(sprintf("Argument 'filename' and 'destname' are identical: %s", filename)) } # Already done? if (file.exists(destname)) { if (skip) { return(destname) } else if (overwrite) { file.remove(destname) } else { stop(sprintf("File already exists: %s", destname)) } } ## Compress to temporary file destnameT <- pushTemporaryFile(destname) # Create output directory, iff missing destpath <- dirname(destnameT) if (!isDirectory(destpath)) mkdirs(destpath, mustWork=TRUE) # Setup input and output connections inn <- file(filename, open="rb") on.exit(if (!is.null(inn)) close(inn)) outComplete <- FALSE out <- FUN(destnameT, open="wb", ...) on.exit({ if (!is.null(out)) close(out) # Remove incomplete file? if (!outComplete) file.remove(destnameT) }, add=TRUE) # Process nbytes <- 0 repeat { bfr <- readBin(inn, what=raw(0L), size=1L, n=BFR.SIZE) n <- length(bfr) if (n == 0L) break nbytes <- nbytes + n writeBin(bfr, con=out, size=1L) bfr <- NULL # Not needed anymore } outComplete <- TRUE close(out) out <- NULL ## Rename to final name destname <- popTemporaryFile(destnameT) # Return the output file attr(destname, "nbrOfBytes") <- nbytes # Cleanup if (remove) { close(inn) inn <- NULL file.remove(filename) } invisible(destname) }) # compressFile() setMethodS3("decompressFile", "default", function(filename, destname=gsub(sprintf("[.]%s$", ext), "", filename, ignore.case=TRUE), ext, FUN, temporary=FALSE, skip=FALSE, overwrite=FALSE, remove=TRUE, BFR.SIZE=1e7, ...) { # Argument 'filename': if (!file.exists(filename)) { stop("No such file: ", filename) } # Argument 'ext': ext <- as.character(ext) # Argument 'FUN': if (!is.function(FUN)) { stop(sprintf("Argument 'FUN' is not a function: %s", mode(FUN))) } # Argument 'temporary': if (temporary) { destname <- file.path(tempdir(), basename(destname)) } attr(destname, "temporary") <- temporary # Argument 'filename' & 'destname': if (filename == destname) { stop(sprintf("Argument 'filename' and 'destname' are identical: %s", filename)) } # Already done? if (file.exists(destname)) { if (skip) { return(destname) } else if (overwrite) { file.remove(destname) } else { stop(sprintf("File already exists: %s", destname)) } } ## Compress to temporary file destnameT <- pushTemporaryFile(destname) # Create output directory, iff missing destpath <- dirname(destname) if (!isDirectory(destpath)) mkdirs(destpath, mustWork=TRUE) # Setup input and output connections inn <- FUN(filename, open="rb") on.exit(if (!is.null(inn)) close(inn)) outComplete <- FALSE out <- file(destnameT, open="wb", ...) on.exit({ if (!is.null(out)) close(out) # Remove incomplete file? if (!outComplete) file.remove(destnameT) }, add=TRUE) # Process nbytes <- 0 repeat { bfr <- readBin(inn, what=raw(0L), size=1L, n=BFR.SIZE) n <- length(bfr) if (n == 0L) break nbytes <- nbytes + n writeBin(bfr, con=out, size=1L) bfr <- NULL # Not needed anymore } outComplete <- TRUE close(out) out <- NULL ## Rename to final name destname <- popTemporaryFile(destnameT) # Return the output file attr(destname, "nbrOfBytes") <- nbytes # Cleanup if (remove) { close(inn) inn <- NULL file.remove(filename) } invisible(destname) }) # decompressFile() setMethodS3("isCompressedFile", "default", function(filename, method=c("extension", "content"), ext, fileClass, ...) { # Argument 'method': method <- match.arg(method) # Argument 'ext': ext <- as.character(ext) # Argument 'filename': filename <- Arguments$getReadablePathname(filename, mustExist=(method == "content")) if (method == "extension") { res <- (regexpr(sprintf("[.]%s$", ext), filename, ignore.case=TRUE) != -1L) } else if (method == "content") { con <- file(filename) on.exit(close(con)) # Argument 'fileClass': fileClass <- as.character(fileClass) res <- (summary(con)$class == fileClass) } res }) # isCompressedFile() setMethodS3("bzip2", "default", function(filename, ..., ext="bz2", FUN=bzfile) { compressFile(filename=filename, ..., ext=ext, FUN=FUN) }) setMethodS3("gzip", "default", function(filename, ..., ext="gz", FUN=gzfile) { compressFile(filename=filename, ..., ext=ext, FUN=FUN) }) ## NOTE: Let's wait with and xz()/unxz(), because tests on Windows gives ## "Warning message: In readBin(inn, what = raw(0L), size = 1L, n = BFR.SIZE) : ## lzma decoder format error". /HB 2015-02-01 ## setMethodS3("xz", "default", function(filename, ..., ext="xz", FUN=bzfile) { ## compressFile(filename=filename, ..., ext=ext, FUN=FUN) ## }) setMethodS3("bunzip2", "default", function(filename, ..., ext="bz2", FUN=bzfile) { decompressFile(filename=filename, ..., ext=ext, FUN=FUN) }) setMethodS3("gunzip", "default", function(filename, ..., ext="gz", FUN=gzfile) { decompressFile(filename=filename, ..., ext=ext, FUN=FUN) }) ## setMethodS3("unxz", "default", function(filename, ..., ext="xz", FUN=xzfile) { ## decompressFile(filename=filename, ..., ext=ext, FUN=FUN) ## }) setMethodS3("isBzipped", "default", function(..., ext="bz2", fileClass="bzfile") { isCompressedFile(..., ext=ext, fileClass=fileClass) }) setMethodS3("isGzipped", "default", function(..., ext="gz", fileClass="gzfile") { isCompressedFile(..., ext=ext, fileClass=fileClass) }) ## setMethodS3("isXzipped", "default", function(..., ext="xz", fileClass="xzfile") { ## isCompressedFile(..., ext=ext, fileClass=fileClass) ## }) ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/withSink.R��������������������������������������������������������������������������������0000644�0001762�0000144�00000012107�14525546077�013756� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocFunction withSink # # @title "Evaluate an R expression while temporarily diverting output" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{expr}{The R expression to be evaluated.} # \item{file}{A writable @connection or a @character string naming the # file to write to.} # \item{append}{If @TRUE, the diverted output is appended to the file, # otherwise not.} # \item{type}{A @character string specifying whether to divert output # sent to the standard output or the standard error. # See @see "base::sink" for details.} # \item{substitute}{If @TRUE, argument \code{expr} is # \code{\link[base]{substitute}()}:ed, otherwise not.} # \item{envir}{The @environment in which the expression should be evaluated.} # } # # \value{ # Returns the results of the expression evaluated. # } # # \details{ # Upon exit (also on errors), this function will close the requested # "sink". If additional sinks (of any type) where also opened during # the evaluation, those will also be closed with a warning. # } # # @author # # @examples "../incl/withSink.Rex" # # \seealso{ # Internally, @see "base::sink" is used to divert any output. # } # # @keyword IO # @keyword programming #*/########################################################################### withSink <- function(expr, file, append=FALSE, type=c("output", "message"), substitute=TRUE, envir=parent.frame()) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'expr': if (substitute) expr <- substitute(expr) # Argument 'envir': if (!is.environment(envir)) throw("Argument 'envir' is not a list: ", class(envir)[1L]) # Argument 'append': append <- as.logical(append) # Argument 'type': type <- match.arg(type) # Argument 'file': fileT <- NULL if (is.null(file)) { throw("Argument 'file' must be either a connection of a character string: NULL") } else if (inherits(file, "connection")) { ## info <- summary(con) ## if (!info[["can write"]]) { ## throw("Argument 'file' is a connection but not writable: ", info[["description"]]) ## } } else { file <- as.character(file) file <- Arguments$getWritablePathname(file) # WORKAROUND: # sink(..., type="message") does not allow to sink to an unopen file. if (type == "message") { fileT <- file(file, open=ifelse(append, "wt", "w")) on.exit({ if (!is.null(fileT)) close(fileT) }) file <- fileT } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Record entry sinks # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - idx0 <- list() for (tt in c("message", "output")) { idx0[[tt]] <- sink.number(type=tt) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Divert output # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - sink(file=file, append=append, type=type) # Record index of the opened sink openedIdx <- sink.number(type=type) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Upon exit, close the requested sink and all other added sinks # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - on.exit({ # Close all opened sinks, including those opened while # evaluating 'expr'. maxTries <- 10L for (tt in c("message", "output")) { idx <- sink.number(type=tt) count <- 0L while (idx > idx0[[tt]]) { count <- count + 1L if (count > maxTries) { throw(sprintf("Failed to close temporarily opened sink %d of type '%s' after trying %d times", idx, tt, maxTries)) } # Warn if sink was opened by 'expr' if (idx != openedIdx || tt != type) { warning(sprintf("Closing unclosed sink #%d of type '%s' that was opened during evaluation.", idx, tt)) } sink(file=NULL, type=tt) # Currently opened sink? idx <- sink.number(type=tt) } } # for (tt ...) # Assert that exit sinks are the same as the entry ones for (tt in c("message", "output")) { idx <- sink.number(type=tt) if (idx != idx0[[tt]]) { msg <- sprintf("Failed to close temporarily opened sink #%d of type '%s'", idx, tt) if (tt == "message") { # Throwing an error when 'message':s are diverted may # pass unnoticed. At least report the prompt, if it exists. if (interactive()) { readline(sprintf("ERROR: %s. Press ENTER to continue...", msg)) } } throw(msg) } } if (!is.null(fileT)) { close(fileT) fileT <- NULL } }, add=FALSE) # on.exit() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Evaluate expression # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - eval(expr, envir = envir, enclos = baseenv()) } # withSink() ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/MultiVerbose.R����������������������������������������������������������������������������0000644�0001762�0000144�00000004337�14372747611�014601� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocClass MultiVerbose # # @title "A Verbose class ignoring everything" # # \description{ # @classhierarchy # # @get "title". # # \emph{This is a trial class}. # } # # @synopsis # # \arguments{ # \item{verboseList}{A @list of @see "Verbose" objects.} # \item{...}{Ignored.} # } # # \section{Fields and Methods}{ # @allmethods # } # # @examples "../incl/MultiVerbose.Rex" # # @author # # @keyword programming # @keyword IO # @keyword internal #*/########################################################################### setConstructorS3("MultiVerbose", function(verboseList=NULL, ...) { # Validate arguments if (!is.null(verboseList)) { for (arg in verboseList) { if (!inherits(arg, "Verbose")) { throw("One of the elements in argument 'verboseList' is not a Verbose object: ", class(arg)[1]) } } } extend(Verbose(...), "MultiVerbose", .verboseList = verboseList ) }) ###########################################################################/** # @RdocMethod as.list # # @title "Gets a list of Verbose objects" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns a @list of @see "Verbose" objects. # } # # @author # # \seealso{ # @seeclass # } #*/########################################################################### setMethodS3("as.list", "MultiVerbose", function(x, ...) { # To please R CMD check this <- x this$.verboseList }, protected=TRUE) ###########################################################################/** # @RdocMethod writeRaw # # @title "Writes to each of the Verbose objects" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Additional objects to be passed to \code{writeRaw()} for # each @see "Verbose" object.} # } # # \value{ # Returns (invisibly) @TRUE. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("writeRaw", "MultiVerbose", function(this, ...) { # Write output to each of the Verbose objects lapply(this, FUN=writeRaw, ...) invisible(TRUE) }) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/Java.R������������������������������������������������������������������������������������0000644�0001762�0000144�00000031227�14372747611�013040� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocClass Java # # @title "Static class for Java related methods" # # \description{ # @classhierarchy # # Static class that provides methods for reading and writing Java data types. # Currently the following data types are supported: byte, short and int. # R character strings can be written as UTF-8 formatted strings, which can # be read by Java. Currently on Java String's that contain ASCII characters # can be imported into \R. The reason for this is that other characters are # translated into non-eight bits data, e.g. 16- and 24-bits, which the # readChar() method currently does not support.\cr # # Furthermore, the Java class defines some static constants describing the # minimum and maximum value of some of the common Java data types: # \code{BYTE.MIN}, \code{BYTE.MAX} # \code{SHORT.MIN}, \code{SHORT.MAX} # \code{INT.MIN}, \code{INT.MAX} # \code{LONG.MIN}, and \code{LONG.MAX}. # } # # @synopsis # # \section{Fields and Methods}{ # @allmethods # } # # @examples "../incl/Java.Rex" # # @author #*/########################################################################### setConstructorS3("Java", function() { extend(Object(), "Java", BYTE.MIN = -128, # -2^7 BYTE.MAX = 127, # 2^7-1 SHORT.MIN = -32768, # -2^15 SHORT.MAX = 32767, # 2^15-1 INT.MIN = -2147483648, # -2^31 INT.MAX = 2147483647, # 2^31-1 LONG.MIN = -9223372036854775808, # -2^63 LONG.MAX = 9223372036854775807 # 2^63-1 ) }, static=TRUE) #########################################################################/** # @RdocMethod writeByte # # @title "Writes a byte (8 bits) to a connection in Java format" # # \description{ # Writes one or several byte's (8 bits) to a connection in Java # format so they will be readable by Java. # All data types in Java are signed, i.e. a byte can hold a value in # the range [-128,127]. Trying to write a value outside this range # will automatically be truncated without a warning. # } # # @synopsis # # \arguments{ # \item{con}{Binary connection to be written to.} # \item{b}{Vector of bytes to be written.} # } # # \details{ # This method is included for consistency reasons only. # } # # @author # # \seealso{ # @seeclass # } #*/######################################################################### setMethodS3("writeByte", "Java", function(static, con, b, ...) { writeBin(con=con, as.integer(b), size=1) }, static=TRUE) #########################################################################/** # @RdocMethod writeShort # # @title "Writes a short (16 bits) to a connection in Java format" # # \description{ # Writes one or several short's (16 bits) to a connection in Java # format so they will be readable by Java. # All data types in Java are signed, i.e. a byte can hold a value in # the range [-32768,32767]. Trying to write a value outside this range # will automatically be truncated without a warning. # } # # @synopsis # # \arguments{ # \item{con}{Binary connection to be written to.} # \item{s}{Vector of shorts to be written.} # } # # @author # # \seealso{ # @seeclass # } #*/######################################################################### setMethodS3("writeShort", "Java", function(static, con, s, ...) { writeBin(con=con, as.integer(s), size=2, endian="big") }, static=TRUE) #########################################################################/** # @RdocMethod writeInt # # @title "Writes a integer (32 bits) to a connection in Java format" # # \description{ # Writes one or several integer's (32 bits) to a connection in Java # format so they will be readable by Java. # All data types in Java are signed, i.e. a byte can hold a value in # the range [-2147483648,2147483647]. Trying to write a value outside # this range will automatically be truncated without a warning. # } # # @synopsis # # \arguments{ # \item{con}{Binary connection to be written to.} # \item{i}{Vector of integers to be written.} # } # # @author # # \seealso{ # @seeclass # } #*/######################################################################### setMethodS3("writeInt", "Java", function(static, con, i, ...) { i <- matrix(i, nrow=1) bfr <- apply(i, MARGIN=2, FUN=function(x) { c(x %/% 256^3, x %/% 256^2, x %/% 256, x %% 256) }) bfr <- as.vector(bfr) writeBin(con=con, as.integer(bfr), size=1) }, static=TRUE) #########################################################################/** # @RdocMethod writeUTF # # @title "Writes a string to a connection in Java format (UTF-8)" # # \description{ # @get "title" # so it will be readable by Java. At the beginning of each UTF-8 sequence # there is a short integer telling how many bytes (characters?) follows. # } # # @synopsis # # \arguments{ # \item{con}{Binary connection to be written to.} # \item{str}{String to be written.} # } # # @author # # \seealso{ # @seeclass # } #*/######################################################################### setMethodS3("writeUTF", "Java", function(static, con, str, ...) { str <- as.character(str) writeShort(static, con=con, nchar(str)) writeChar(con=con, str, eos=NULL) }, static=TRUE) #########################################################################/** # @RdocMethod readByte # # @title "Reads a Java formatted byte (8 bits) from a connection" # # \description{ # Reads one or several Java formatted byte's (8 bits) from a connection. # All data types in Java are signed, i.e. a byte can hold a value in # the range [-128,127]. # } # # @synopsis # # \arguments{ # \item{con}{Binary connection to be read from.} # \item{n}{Number of byte's to be read.} # \item{...}{Not used.} # } # # \value{ # Returns an @integer @vector. # } # # \details{ # This method is included for consistency reasons only. # } # # @author # # \seealso{ # @see "base::readBin". # @seeclass # } #*/######################################################################### setMethodS3("readByte", "Java", function(static, con, n=1, ...) { as.integer(readBin(con=con, what=integer(), size=1, n=n)) }, static=TRUE) #########################################################################/** # @RdocMethod readShort # # @title "Reads a Java formatted short (16 bits) from a connection" # # \description{ # Reads one or several Java formatted short's (16 bits) from a connection. # All data types in Java are signed, i.e. a byte can hold a value in # the range [-32768,32767]. # } # # @synopsis # # \arguments{ # \item{con}{Binary connection to be read from.} # \item{n}{Number of short's to be read.} # \item{...}{Not used.} # } # # \value{ # Returns an @integer @vector. # } # # @author # # \seealso{ # @see "base::readBin". # @seeclass # } #*/######################################################################### setMethodS3("readShort", "Java", function(static, con, n=1, ...) { # From java.io.DataOutput.writeShort(): # The byte values to be written, in the order shown, are: # (byte)(0xff & (v >> 8)) # (byte)(0xff & v) # readBin(con=con, what=integer(), size=2, n=n, endian="big") bfr <- readBin(con=con, what=integer(), size=1, n=2*n, signed=FALSE) bfr <- matrix(bfr, ncol=2, byrow=TRUE) bfr[,1] <- bfr[,1]*256 bfr <- rowSums(bfr) neg <- (bfr >= 2^15) bfr[neg] <- bfr[neg] - 2^16 as.integer(bfr) }, static=TRUE) #########################################################################/** # @RdocMethod readInt # # @title "Reads a Java formatted int (32 bits) from a connection" # # \description{ # Reads one or several Java formatted int's (32 bits) from a connection. # All data types in Java are signed, i.e. a byte can hold a value in # the range [-2147483648,2147483647]. # } # # @synopsis # # \arguments{ # \item{con}{Binary connection to be read from.} # \item{n}{Number of int's to be read.} # \item{...}{Not used.} # } # # \value{ # Returns a @vector of @doubles. Note that R @integers gives # NA is as.integer(-2147483648), which is the smallest Java int # available. # } # # @author # # \seealso{ # @see "base::readBin". # @seeclass # } #*/######################################################################### setMethodS3("readInt", "Java", function(static, con, n=1, ...) { # readBin(con=con, what=integer(), size=4, n=n, endian="big") bfr <- readBin(con=con, what=integer(), size=1, n=4*n, signed=FALSE) bfr <- matrix(bfr, ncol=4, byrow=TRUE) bfr[,1] <- bfr[,1] * 256^3 bfr[,2] <- bfr[,2] * 256^2 bfr[,3] <- bfr[,3] * 256 bfr <- rowSums(bfr) neg <- (bfr >= 2^31) bfr[neg] <- bfr[neg] - 2^32 bfr }, static=TRUE) #########################################################################/** # @RdocMethod readUTF # # @title "Reads a Java (UTF-8) formatted string from a connection" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{con}{Binary connection to be read from.} # \item{as.character}{If @TRUE, the read string converted, # i.e. translated, into an \R character string before # returned, otherwise an integer vector representation of # the Unicode string is returned.} # \item{...}{Not used.} # } # # \value{ # Returns a @character string or an @integer @vector. # } # # \details{ # Currently only 8-bit UTF-8 byte sequences are supported, i.e. plain # ASCII sequences, i.e. characters that take up more than one byte are # read \emph{incorrectly} without any warnings. # } # # @author # # \seealso{ # @see "base::readBin". # @seeclass # } #*/######################################################################### setMethodS3("readUTF", "Java", function(static, con, as.character=TRUE, ...) { # BUG: nbrOfBytes <- readShort(static, con) # Nothing to read? if (as.character) { if (length(nbrOfBytes) == 0L) return(character(0L)) readChar(con=con, nchars=nbrOfBytes) } else { if (length(nbrOfBytes) == 0L) return(integer(0L)) readBin(con=con, what=integer(), size=1, n=nbrOfBytes) } }, static=TRUE) #########################################################################/** # @RdocMethod asByte # # @title "Converts a numeric to a Java byte" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{x}{A @numeric @vector.} # \item{...}{Not used.} # } # # \value{ # Returns an @integer @vector. # } # # @author # # \seealso{ # @seeclass # } #*/######################################################################### setMethodS3("asByte", "Java", function(static, x, ...) { BYTE.MIN <- -128 BYTE.MAX <- 127 BYTE.RANGE <- BYTE.MAX-BYTE.MIN + 1 x <- (x-BYTE.MIN) %% BYTE.RANGE + BYTE.MIN as.integer(x) }, static=TRUE) #########################################################################/** # @RdocMethod asShort # # @title "Converts a numeric to a Java short" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{x}{A @numeric @vector.} # \item{...}{Not used.} # } # # \value{ # Returns an @integer @vector. # } # # @author # # \seealso{ # @seeclass # } #*/######################################################################### setMethodS3("asShort", "Java", function(static, x, ...) { # x <- as.integer(x) SHORT.MIN <- -32768 SHORT.MAX <- 32767 SHORT.RANGE <- SHORT.MAX-SHORT.MIN + 1 x <- (x-SHORT.MIN) %% SHORT.RANGE + SHORT.MIN as.integer(x) }, static=TRUE) #########################################################################/** # @RdocMethod asInt # # @title "Converts an numeric to a Java integer" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{x}{A @numeric @vector.} # \item{...}{Not used.} # } # # \value{ # Returns an @integer @vector. # } # # @author # # \seealso{ # @seeclass # } #*/######################################################################### setMethodS3("asInt", "Java", function(static, x, ...) { INT.MIN <- -2147483648 INT.MAX <- 2147483647 INT.RANGE <- INT.MAX-INT.MIN + 1 x <- (x-INT.MIN) %% INT.RANGE + INT.MIN as.integer(x) }, static=TRUE) #########################################################################/** # @RdocMethod asLong # # @title "Converts a numeric to a Java long" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{x}{A @numeric @vector.} # \item{...}{Not used.} # } # # \value{ # Returns an @integer @vector. # } # # @author # # \seealso{ # @seeclass # } #*/######################################################################### setMethodS3("asLong", "Java", function(static, x, ...) { # x <- as.integer(x) LONG.MIN <- -9223372036854775808 LONG.MAX <- 9223372036854775807 LONG.RANGE <- LONG.MAX-LONG.MIN + 1 x <- (x-LONG.MIN) %% LONG.RANGE + LONG.MIN as.integer(x) }, static=TRUE) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/popTemporaryFile.R������������������������������������������������������������������������0000644�0001762�0000144�00000007026�14372747611�015460� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������########################################################################/** # @RdocDefault popTemporaryFile # # @title "Drops a temporary suffix from the temporary pathname" # # @synopsis # # \description{ # @get "title" and, by default, renames an existing temporary file # accordingly. # } # # \arguments{ # \item{filename}{The filename of the temporary file.} # \item{path}{The path of the temporary file.} # \item{suffix}{The suffix of the temporary filename to be dropped.} # \item{isFile}{If @TRUE, the temporary file must exist and # will be renamed. If @FALSE, it is only the pathname string # that will be modified. For details, see below.} # \item{...}{Not used.} # \item{verbose}{A @logical or @see "Verbose".} # } # # \value{ # Returns the pathname with the temporary suffix dropped. # } # # \details{ # If \code{isFile} is @FALSE, the pathname where the suffix of the # temporary pathname has been dropped is returned. # If \code{isFile} is @TRUE, the temporary file is renamed. # Then, if the temporary file does not exists or it was not successfully # renamed, an exception is thrown. # } # # @author # # \seealso{ # See @see "pushTemporaryFile" for more details and an example. # } # # @keyword "utilities" # @keyword "programming" # @keyword "IO" #*/######################################################################### setMethodS3("popTemporaryFile", "default", function(filename, path=NULL, suffix=".tmp", isFile=TRUE, ..., verbose=FALSE) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'isFile': isFile <- Arguments$getLogical(isFile) # Argument 'filename' & 'path': pathnameT <- Arguments$getWritablePathname(filename, path=path, mustExist=isFile, mustNotExist=!isFile) # Argument 'suffix': suffix <- Arguments$getCharacter(suffix) # Argument 'verbose': verbose <- Arguments$getVerbose(verbose) if (verbose) { pushState(verbose) on.exit(popState(verbose)) } verbose && enter(verbose, "Dropping temporary suffix from file") verbose && cat(verbose, "Temporary pathname: ", pathnameT) verbose && cat(verbose, "Suffix: ", suffix) # Drop suffix from temporary pathname pattern <- sprintf("%s$", suffix) pattern <- gsub(".", "\\.", pattern, fixed=TRUE) pattern <- gsub("[\\$]+$", "$", pattern) pattern <- Arguments$getRegularExpression(pattern) verbose && cat(verbose, "Regular expression for suffix: ", pattern) # Assert that suffix exists in the temporary pathname if (!regexpr(pattern, "", pathnameT) == -1) { throw(sprintf("Cannot rename temporary pathname. The specified temporary pathname does not contain the specified suffix ('%s'): %s", suffix, pathnameT)) } pathname <- gsub(pattern, "", pathnameT) verbose && cat(verbose, "Pathname: ", pathname) pathname <- Arguments$getWritablePathname(pathname, mustNotExist=TRUE) if (isFile) { verbose && enter(verbose, "Renaming existing file") res <- file.rename(pathnameT, pathname) verbose && cat(verbose, "Result: ", res) verbose && exit(verbose) if (!isFile(pathname)) { throw("Failed to rename temporary file (final file does not exist): ", pathnameT, " -> ", pathname) } if (isFile(pathnameT)) { throw("Failed to rename temporary file (temporary file still exists): ", pathnameT, " -> ", pathname) } } # if (isFile) verbose && exit(verbose) pathname }) # popTemporaryFile() ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/mkdirs.R����������������������������������������������������������������������������������0000644�0001762�0000144�00000011743�14372747611�013451� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault mkdirs # # @title "Creates a directory including any necessary but nonexistent parent directories" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{pathname}{A @character string of the pathname to be checked.} # \item{mustWork}{If @TRUE and the directory does not already exists or # is failed to be created, an error is thrown, otherwise not.} # \item{maxTries}{A positive @integer specifying how many times the # method should try to create a missing directory before giving up.} # \item{...}{Not used.} # } # # \value{ # Returns @TRUE if the directory was successfully created, # otherwise @FALSE. # Note that if the directory already exists, @FALSE is returned. # } # # \section{Slow file systems}{ # On very rare occasions, we have observed on a large shared file # system that if one tests for the existence of a directory immediately # after creating it with @see "base::dir.create", it may appear not # to be created. We believe this is due to the fact that there is a # short delay between creating a directory and that information being # fully propagated on the file system. To minimize the risk for such # false assertions on "slow" file systems, this method tries to create # a missing directory multiple times (argument \code{maxTries}) (while # waiting a short period of time between each round) before giving up. # } # # @author # # \seealso{ # Internally \code{\link[base:files]{dir.create}}() is used. # } # # @keyword IO # @keyword programming #*/########################################################################### setMethodS3("mkdirs", "default", function(pathname, mustWork=FALSE, maxTries=5L, ...) { isLink <- function(pathname) { pathname <- getAbsolutePath(pathname) target <- Sys.readlink2(pathname) !is.na(target) && nzchar(target) } curdir <- function(pathname) { if (isAbsolutePath(pathname)) return(pathname) sprintf("%s (current directory is '%s')", pathname, getwd()) } ## Argument 'pathname': # Nothing to do? if (length(pathname) == 0L) return(TRUE) pathname <- as.character(pathname) ## Argument 'mustWork': mustWork <- Arguments$getLogical(mustWork) ## Argument 'maxTries': maxTries <- Arguments$getInteger(maxTries, range=c(1L,100L)) # If already is a directory, return FALSE if (isDirectory(pathname)) return(FALSE) # If already a file, return FALSE or give an error if (isFile(pathname)) { if (mustWork) { throw("Failed to create directory, because a file with the same pathname already exists: ", curdir(pathname)) } return(FALSE) } if (isLink(pathname)) { target <- Sys.readlink2(getAbsolutePath(pathname)) ## Should have been take care of above, but just in case if (isDirectory(target)) return(FALSE) if (mustWork) { if (isFile(target)) { throw(sprintf("Failed to create directory, because a link with the same pathname already exists and its target ('%s') appears to be a file: %s", target, curdir(pathname))) } else { throw(sprintf("Failed to create directory, because a link with the same pathname already exists but its target ('%s') appears to be missing: %s", target, curdir(pathname))) } } return(FALSE) } # Get the parent and make sure to delete it afterwards. parent <- getParent(pathname) if (identical(parent, pathname)) { if (mustWork) { throw("Could not create directory, because failed to get parent directory: ", curdir(pathname)) } return(FALSE) } # If the parent is a file, we can not create a directory! if (isFile(parent)) { if (mustWork) { throw(sprintf("Could not create directory, because parent ('%s') is a file not a directory: %s", parent, curdir(pathname))) } return(FALSE) } # If parent is not already a directory, create it if (!isDirectory(parent)) { if (!mkdirs(parent, mustWork=mustWork, maxTries=maxTries, ...)) return(FALSE) } # Finally, create this directory if (!isDirectory(pathname)) { for (tt in 1:maxTries) { suppressWarnings(dir.create(pathname)) res <- isDirectory(pathname) if (res) break # If failed, try to create it by its relative pathname pathnameR <- getRelativePath(pathname) suppressWarnings(dir.create(pathnameR)) res <- isDirectory(pathname) if (res) break # If not, wait a bit and try again... Sys.sleep(0.5) } if (!res && mustWork) { # Check if file permissions allow to create a directory parent <- ifelse(is.null(parent), ".", parent) if (fileAccess(parent, mode=2) == -1) { reason <- ", most likely because of lack of file permissions" } else { reason <- " for unknown reasons" } throw(sprintf("Failed to create directory (tried %d times)%s (directory '%s' exists but nothing beyond): %s", maxTries, reason, parent, curdir(pathname))) } return(res) } TRUE }) �����������������������������R.utils/R/getParent.R�������������������������������������������������������������������������������0000644�0001762�0000144�00000007013�14372747611�014104� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault getParent # # @title "Gets the string of the parent specified by this pathname" # # \description{ # @get "title". # This is basically, by default the string before the last path separator # of the absolute pathname. # } # # @synopsis # # \arguments{ # \item{pathname}{A @character string of the pathname to be checked.} # \item{depth}{An @integer specifying how many generations up the # path should go.} # \item{fsep}{A @character string of the file separator.} # \item{...}{Not used.} # } # # \value{ # Returns a @character string if the parent exists, otherwise @NULL. # } # # # # @author # # @keyword IO # @keyword programming #*/########################################################################### setMethodS3("getParent", "default", function(pathname, depth=1L, fsep=.Platform$file.sep, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Local functions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - getWindowsDrivePattern <- function(fmtstr, ...) { # Windows drive letters drives <- "ABCDEFGHIJKLMNOPQRSTUVWXYZ" # Support also lower case drives <- paste(c(drives, tolower(drives)), collapse="") sprintf(fmtstr, drives) } # getWindowsDrivePattern() getParentLocal <- function(pathname) { if (length(pathname) == 0L) return(NULL) # Windows drive letters # Treat C:/, C:\\, ... special, that is, not at all. pattern <- getWindowsDrivePattern("^[%s]:[/\\]$") if (regexpr(pattern, pathname) != -1) return(paste(gsub("[\\/]$", "", pathname), fsep=fsep, sep="")) # Split by '/' or '\\' components <- strsplit(pathname, split="[/\\]")[[1]] len <- length(components) if (len == 0L) return(NULL); # As in Java... if (len == 2L) { # Treat C:/, C:\\, ... special, that is, not at all. pattern <- getWindowsDrivePattern("^[%s]:$") if (regexpr(pattern, components[1L]) != -1L) return(paste(components[1L], fsep, sep="")) } name <- components[len] pattern <- getWindowsDrivePattern("^[%s]:") reg <- regexpr(pattern, name) if (reg != -1L) { components[len] <- substring(name, first=1, last=attr(reg, "match.length")) if (len == 1L) components[len+1L] <- "" } else { components <- components[-len] } if (length(components) == 0L) return(NULL) # Re-build path to string... paste(components, sep="", collapse=fsep) } # getParentLocal() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'pathname': pathname <- as.character(pathname) nPathnames <- length(pathname) # Nothing to do? if (nPathnames == 0L) return(character(0L)) # Multiple pathnames? if (nPathnames > 1L) { throw("Argument 'pathname' must be a single character string: ", hpaste(pathname)) } # A missing pathname? if (is.na(pathname)) return(NA_character_) # Argument 'depth': depth <- as.integer(depth) depth <- Arguments$getInteger(depth, range=c(0,Inf)) lastPath <- pathname path <- lastPath d <- depth while (d > 0L) { path <- getParentLocal(lastPath) if (is.null(path)) break if (identical(path, lastPath)) { path <- NULL break # throw("No such parent (depth=", depth, ") available: ", pathname) } lastPath <- path d <- d - 1L } path }) ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/Options.R���������������������������������������������������������������������������������0000644�0001762�0000144�00000032215�14372747611�013610� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#########################################################################/** # @RdocClass Options # # @title "The Options class" # # @synopsis # # \arguments{ # \item{options}{A tree @list structure of options.} # \item{...}{Not used.} # } # # \description{ # @classhierarchy # # A class to set and get either options stored in a @list tree structure. # # Each option has a pathname. The format of a pathname is similar to a # (Unix) filesystem pathname, e.g. "graphics/cex". See examples for # more details. # } # # \section{Fields and Methods}{ # @allmethods # } # # \value{ # The constructor returns an Options object. # } # # \details{ # Note, this class and its methods do \emph{not} operate on the global # options structure defined in \R (\link{options}). # } # # @examples "../incl/Options.Rex" # # @author # # @keyword programming #*/######################################################################### setConstructorS3("Options", function(options=list(), ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'options': if (!is.list(options)) throw("Argument 'options' must be a list: ", mode(options)) extend(Object(), "Options", .options = options ) }) ###########################################################################/** # @RdocMethod "as.character" # # @title "Returns a character string version of this object" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns a @character string. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("as.character", "Options", function(x, ...) { # To please R CMD check this <- x s <- paste(class(this)[1], ": ", nbrOfOptions(this), " options set.", sep="") s }) #########################################################################/** # @RdocMethod as.list # # @title "Gets a list representation of the options" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{Returns a tree @list structure.} # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/######################################################################### setMethodS3("as.list", "Options", function(x, ...) { # To please R CMD check this <- x as.list(this$.options) }) #########################################################################/** # @RdocMethod equals # # @title "Checks if this object is equal to another Options object" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{other}{Another Options object.} # \item{...}{Not used.} # } # # \value{Returns @TRUE if they are equal, otherwise @FALSE.} # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/######################################################################### setMethodS3("equals", "Options", function(this, other, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Local functions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - equals.list <- function(list1, list2) { if (length(list1) != length(list2)) return(FALSE) for (kk in seq_along(list1)) { obj1 <- list1[[kk]] obj2 <- list2[[kk]] if (is.list(obj1)) { comp <- equals.list(obj1, obj2) } else { comp <- equals(obj1, obj2) } if (!comp) return(comp) } # for (kk ...) TRUE } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Main comparison # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (!inherits(other, "Options")) return(FALSE) list1 <- as.list(this) list2 <- as.list(other) equals.list(list1, list2) }) ###########################################################################/** # @RdocMethod str # # @title "Prints the structure of the options" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{header}{A @character string header to be printed at the top.} # \item{...}{Not used.} # } # # \value{ # Returns nothing. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("str", "Options", function(object, header=paste(class(this)[1], ":\n", sep=""), ...) { # To please R CMD check this <- object cat(header) res <- list() for (name in names(this)) res[[name]] <- getOption(this, name) str(res) }) #########################################################################/** # @RdocMethod names # # @title "Gets the full pathname of all (non-list) options" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{Returns a @vector of @character strings.} # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/######################################################################### setMethodS3("names", "Options", function(x, ...) { # To please R CMD check this <- x names(getLeaves(this, ...)) }) #########################################################################/** # @RdocMethod getLeaves # # @title "Gets all (non-list) options in a flat list" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{Returns a flat @list structure.} # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/######################################################################### setMethodS3("getLeaves", "Options", function(this, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Local functions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - getLeaves <- function(list, ...) { if (length(list) == 0) return(NULL) names <- names(list) isList <- unlist(lapply(list, FUN=is.list)) leafs <- list[!isList] trees <- list[isList] treeNames <- names(trees) for (kk in seq_along(trees)) { tree <- trees[[kk]] treeName <- treeNames[kk] treeLeaves <- getLeaves(tree, ...) names(treeLeaves) <- paste(treeName, names(treeLeaves), sep="/") leafs <- c(leafs, treeLeaves) } leafs } getLeaves(as.list(this)) }) #########################################################################/** # @RdocMethod nbrOfOptions # # @title "Gets the number of options set" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{Returns an @integer.} # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/######################################################################### setMethodS3("nbrOfOptions", "Options", function(this, ...) { length(names(this)) }) #########################################################################/** # @RdocMethod hasOption # # @title "Checks if an option exists" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{pathname}{A single or a @vector of @character strings specifying # the paths to the options to be queried.} # \item{...}{Not used.} # } # # \value{Returns a @logical (@vector).} # # @author # # \seealso{ # @seemethod "getOption". # @seemethod "setOption". # @seeclass # } # # @keyword programming #*/######################################################################### setMethodS3("hasOption", "Options", function(this, pathname, ...) { if (length(pathname) > 1) { res <- c() for (kk in seq_along(pathname)) res[kk] <- hasOption(this, pathname[kk]) names(res) <- pathname return(res) } # Argument 'pathname': pathname <- as.character(pathname) if (length(pathname) != 1) { throw("Argument 'pathname' must be a single character string: ", paste(pathname, collapse=", ")) } if (regexpr("\\.", pathname) != -1) { throw("Argument 'pathname' must not contain a period: ", pathname) } pathname <- unlist(strsplit(pathname, split="/")) if (any(nchar(pathname, type="chars") == 0)) throw("Argument 'pathname' contains a zero length elements.") cur <- as.list(this) if (length(cur) == 0) return(FALSE) depth <- length(pathname) for (kk in seq_len(depth)) { key <- pathname[kk] keys <- names(cur) if (key %in% keys) { cur <- cur[[key]] if (kk == depth) return(TRUE) } else { return(FALSE) } if (!is.list(cur)) break } FALSE }) #########################################################################/** # @RdocMethod getOption # # @title "Gets an option" # # \description{ # @get "title" in the options tree structure or return a default value. # } # # @synopsis # # \arguments{ # \item{pathname}{A single or a @vector of @character strings specifying # the paths to the options to be queried. # By default the complete options structure is returned.} # \item{defaultValue}{The default value to be returned, if option is # missing. If multiple options are queried at the same times, multiple # default values may be specified as a @vector or a @list.} # \item{...}{Not used.} # } # # \value{If a single option is queried, a single value is returned. # If a @vector of options are queried, a @list of values are returned. # For non-existing options, the default value is returned.} # # @author # # \seealso{ # @seemethod "hasOption". # @seemethod "setOption". # @seeclass # } # # @keyword programming #*/######################################################################### setMethodS3("getOption", "Options", function(this, pathname=NULL, defaultValue=NULL, ...) { if (length(pathname) > 1) { defaultValue <- rep(defaultValue, length.out=length(pathname)) res <- list() for (kk in seq_along(pathname)) res[[kk]] <- getOption(this, pathname[kk], defaultValue[kk]) names(res) <- pathname return(res) } if (is.null(pathname)) return(as.list(this)) # Argument 'pathname': pathname <- as.character(pathname) if (length(pathname) != 1) { throw("Argument 'pathname' must be a single character string: ", paste(pathname, collapse=", ")) } # if (regexpr("\\.", pathname) != -1) { # throw("Argument 'pathname' must not contain a period: ", pathname) # } pathname <- unlist(strsplit(pathname, split="/")) if (any(nchar(pathname, type="chars") == 0)) throw("Argument 'pathname' contains a zero length elements.") cur <- as.list(this) if (length(pathname) == 0) return(cur) if (length(cur) == 0) return(defaultValue) depth <- length(pathname) for (kk in seq_len(depth)) { key <- pathname[kk] keys <- names(cur) if (key %in% keys) { cur <- cur[[key]] if (kk == depth) return(cur) } else { return(defaultValue) } if (!is.list(cur)) break } defaultValue }) #########################################################################/** # @RdocMethod setOption # # @title "Sets an option" # # \description{ # @get "title" in the options tree structure. # } # # @synopsis # # \arguments{ # \item{pathname}{A single @character string specifying the path to the # option.} # \item{value}{The value to be assigned to the option.} # \item{overwrite}{If @TRUE, already existing options are overwritten, # otherwise not.} # \item{...}{Not used.} # } # # \value{Returns (invisibly) the old option value.} # # @author # # \seealso{ # @seemethod "hasOption". # @seemethod "setOption". # @seeclass # } # # @keyword programming #*/######################################################################### setMethodS3("setOption", "Options", function(this, pathname, value, overwrite=TRUE, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Local functions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - setOptionList <- function(list, path, value) { if (length(path) == 1) { list[[path]] <- value } else { name <- path[1] if (!is.list(list[[name]])) list[[name]] <- list() list[[name]] <- setOptionList(list[[name]], path[-1], value) } list } # setOptionList() # Argument 'pathname': pathname <- as.character(pathname) if (length(pathname) != 1) { throw("Argument 'pathname' must be a single character string: ", paste(pathname, collapse=", ")) } # if (regexpr("\\.", pathname) != -1) { # throw("Argument 'pathname' must not contain a period: ", pathname) # } oldValue <- getOption(this, pathname) # If option is already set, should it be overwritten. if (!is.null(oldValue) && !overwrite) return(invisible(oldValue)) pathname <- unlist(strsplit(pathname, split="/")) if (any(nchar(pathname, type="chars") == 0)) throw("Argument 'pathname' contains a zero length elements.") if (is.null(this$.options)) this$.options <- list() this$.options <- setOptionList(this$.options, pathname, value) invisible(oldValue) }) �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/egsub.R�����������������������������������������������������������������������������������0000644�0001762�0000144�00000004720�14372747611�013262� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocFunction egsub # # @title "Global substitute of expression using regular expressions" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{pattern}{A @character string with the regular expression to be # matched, cf. @see "base::gsub".} # \item{replacement}{A @character string of the replacement to use # when there is a match, cf. @see "base::gsub".} # \item{x}{The @expression or a @function to be modified.} # \item{...}{Additional arguments passed to @see "base::gsub"} # \item{value}{If @TRUE, the value of the replacement itself is used # to look up a variable with that name and then using that variables # value as the replacement. Otherwise the replacement value is used.} # \item{envir, inherits}{An @environment from where to find the variable # and whether the search should also include enclosing frames, cf. # @see "base::get". Only use if \code{value} is @TRUE.} # } # # \value{ # Returns an @expression. # } # # @examples "../incl/egsub.Rex" # # @author # # @keyword utilities # @keyword programming #*/########################################################################### egsub <- function(pattern, replacement, x, ..., value=TRUE, envir=parent.frame(), inherits=TRUE) { expr <- x # Substitute? if (is.symbol(expr)) { code <- as.character(expr) if (regexpr(pattern, code, ...) != -1L) { name <- sub(pattern, replacement, code, ...) # Substitute with the *value* of a variable, or a variable? if (value) { expr <- get(name, envir=envir, inherits=inherits) } else { expr <- as.symbol(name) } } return(expr) } # Iterate? if (is.language(expr)) { for (ii in seq_along(expr)) { # If expr[[ii]] is "missing", ignore the error. This # happens with for instance expressions like x[,1]. # FIXME: Is there a better way?!? /HB 2014-05-08 tryCatch({ exprI <- expr[[ii]] # Nothing to do? if (!is.null(exprI)) { exprI <- egsub(pattern, replacement, exprI, ..., value=value, envir=envir, inherits=inherits) if (!is.null(exprI)) expr[[ii]] <- exprI } }, error=function(ex) {}) } } # Update the *body* of a function? if (is.function(expr)) { body(expr) <- egsub(pattern, replacement, body(expr), ..., value=value, envir=envir, inherits=inherits) } expr } # egsub() ������������������������������������������������R.utils/R/Arguments.R�������������������������������������������������������������������������������0000644�0001762�0000144�00000114533�14525546077�014131� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocClass Arguments # # @title "Static class to validate and process arguments" # # \description{ # @classhierarchy # } # # \section{Fields and Methods}{ # @allmethods # } # # @author # # @keyword programming #*/########################################################################### setConstructorS3("Arguments", function(...) { extend(Object(), "Arguments") }) #########################################################################/** # @RdocMethod getFilename # # @title "Gets and validates a filename" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{filename}{A @character string.} # \item{nchar}{An @integer @vector of length two specifying the range # of valid filename lengths.} # \item{class}{A @character string specifying the class of valid # filenames.} # \item{.name}{The name of the argument validated.} # \item{.type}{Not used.} # \item{...}{Not used.} # } # # \value{ # Returns a @character string if filename is valid, # otherwise an exception is thrown. # } # # \section{Missing values}{ # If \code{filename} is a missing value, then an exception is thrown. # } # # \details{ # When argument \code{class="safe"}, the following 86 ASCII characters # are allowed in filenames: # \preformatted{ # #$%&'()+,-.0123456789;= (24 including initial space) # @ABCDEFGHIJKLMNOPQRSTUVWXYZ[]^_ (31) # `abcdefghijklmnopqrstuvwxyz{|}~ (31) # } # This class of filenames has been extensively tested on for # cross-platform support on Microsoft Windows, macOS, and various # Unix flavors. # } # # \references{ # [1] Microsoft, \emph{Naming Files, Paths, and Namespaces}, 2018. # \url{https://learn.microsoft.com/en-us/windows/win32/fileio/naming-a-file}. # } # # @author # # \seealso{ # @seeclass # } #*/######################################################################### setMethodS3("getFilename", "Arguments", function(static, filename, nchar=c(1,128), class=c("safe"), .name=NULL, .type="filename", ...) { ## ## OLD NOTES: ## Valid filename characters: ## * The FTP RFCs require (7-bit) ASCII characters (and presumably not control ## characters either). The 95 printable ASCII characters are (note initial ## space): ## ## !"#$%&'()*+,-./0123456789:;<=>? (32) ## @ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_ (32) ## `abcdefghijklmnopqrstuvwxyz{|}~ (31) ## ## * On Windows the following 9 characters aren't allowed: \ / : * ? " < > !. ## This leaves us with: ## ## #$%&'()+,-.0123456789;= (24) ## @ABCDEFGHIJKLMNOPQRSTUVWXYZ[]^_ (31) ## `abcdefghijklmnopqrstuvwxyz{|}~ (31) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument '.name': if (is.null(.name)) { .name <- as.character(deparse(substitute(filename))) } # Argument 'filename': if (is.na(filename)) { throw("Argument 'filename' cannot be a missing value: ", filename) } filename <- getCharacter(static, filename, nchar=nchar, .name=.name) # Argument 'class': class <- match.arg(class) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Filter out valid characters # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - chars <- filename # Always valid characters chars <- gsub("[abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0-9_.,]", "", chars) chars <- gsub("[-]", "", chars) chars <- gsub("[+]", "", chars) # Filter out according to classes. if ("safe" %in% class) { chars <- gsub("[ ]", "", chars) chars <- gsub("[\\[\\]]", "", chars) chars <- gsub("[#$%&'()`{|}~]", "", chars) chars <- gsub("[=]", "", chars) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Check for remaining (=invalid) characters # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (nchar(chars, type="chars") > 0L) { chars <- unlist(strsplit(chars, split="")) chars <- sort(unique(chars)) chars <- sprintf("'%s'", chars) chars <- paste(chars, collapse=", ") throw(sprintf("Not a valid %s. Argument '%s' contains non-valid %s characters (%s): %s", .type, .name, .type, chars, filename)) } filename }, static=TRUE, private=TRUE) #########################################################################/** # @RdocMethod getReadablePathname # # @title "Gets a readable pathname" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{file}{A @character string specifying the file.} # \item{path}{A @character string specifying the path.} # \item{mustExist}{If @TRUE, the pathname must exists and be readable, # otherwise an exception is thrown. If @FALSE, no such test is # performed.} # \item{absolute}{If @TRUE, the absolute pathname is returned.} # \item{...}{Not used.} # } # # \value{ # Returns a @character string of the absolute pathname of the file. # } # # \section{Missing values}{ # If \code{file} or \code{path} is @NA and \code{mustExist} is @FALSE, # then (character) @NA is returned, otherwise an exception is thrown. # } # # \section{Windows}{ # If a too long pathname is detected on Windows, an informative warning # is given. # The maximum number of symbols in a Windows pathname is 256, including # file separators '/' or '\', but excluding the drive letter, and initial # file separator (e.g. 'C:/'), and the string terminator ('\\0'), cf. # 'MSDN - Naming a File or Directory', Microsoft. In R, the limit is # one symbol less, i.e. 255. # } # # @author # # \seealso{ # @seemethod "getWritablePathname" # @see "R.utils::filePath". # @seeclass # } # # @keyword IO #*/######################################################################### setMethodS3("getReadablePathname", "Arguments", function(static, file=NULL, path=NULL, mustExist=TRUE, absolute=FALSE, adjust=c("none", "url"), ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'file': if (!is.null(file)) { if (inherits(file, "connection")) { throw("In this context, argument 'file' cannot be a connection.") } file <- getCharacter(static, file, length=c(1,1)) } # Ignore 'path'? if (isAbsolutePath(file)) path <- NULL # Argument 'path': if (!is.null(path)) { path <- getCharacter(static, path, length=c(1,1)) } if (is.null(file) && is.null(path)) { throw("Both argument 'file' and 'path' are NULL.") } # Argument 'mustExist': mustExist <- getLogical(static, mustExist) # Backward compatibility (absolutePath -> absolute) absolutePath <- list(...)$absolutePath if (!is.null(absolutePath)) absolute <- absolutePath # Argument 'absolute': absolute <- getLogical(static, absolute) # Argument 'adjust': adjust <- match.arg(adjust) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Process arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (mustExist) { if (!is.null(file) && is.na(file)) { throw("No such file/directory because argument 'file' is NA.") } if (!is.null(path) && is.na(path)) { throw("No such file/directory because argument 'path' is NA.") } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Make sure <path>/<file> is properly split up # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (is.null(path)) { pathname <- file } else if (is.null(file)) { pathname <- path } else { pathname <- file.path(path, file) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Windows: The maximum number of symbols in a Windows pathname is 256, # in R it's 255. For more details, see: # https://msdn.microsoft.com/en-us/library/aa365247(VS.85).aspx # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (.Platform$OS.type == "windows") { if (!is.na(pathname) && nchar(pathname, type="chars") > 255L) { msg <- sprintf("A too long pathname (%d characters) was detected on Windows, where maximum number of symbols is 256 and in R it is one less: %s", nchar(pathname, type="chars"), pathname) warning(msg) } } path <- dirname(pathname) file <- basename(pathname) pathname <- NULL # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Adjust filename? # FIXME: Adjust also directory names. /HB 2014-05-04 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (adjust == "url") { # Decode non-problematic filename characters, e.g. '%20' -> ' ' file <- URLdecode(file) # But encode problematic ones, e.g. ':', '*' file <- gsub(":", "%3A", file, fixed=TRUE) file <- gsub("*", "%2A", file, fixed=TRUE) file <- gsub("\\", "%5C", file, fixed=TRUE) # Encode tilde (~) unless first character # FIX ME: Needed or not? /HB 2014-05-04 } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Expand links # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # NB: Here 'mustExist=TRUE' means that filePath() will always return # a pathname, not that it will give an error if file does not exist. pathname <- filePath(path, file, expandLinks="any", mustExist=TRUE) if (absolute) { pathname <- getAbsolutePath(pathname) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Windows: The maximum number of symbols in a Windows pathname is 256, # in R it's 255. For more details, see: # https://msdn.microsoft.com/en-us/library/aa365247(VS.85).aspx # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (.Platform$OS.type == "windows") { if (!is.na(pathname) && nchar(pathname, type="chars") > 255L) { msg <- sprintf("A too long pathname (%d characters) was detected on Windows, where maximum number of symbols is 256 and in R it is one less: %s", nchar(pathname, type="chars"), pathname) warning(msg) } } if (mustExist) { # Check if file exists if (!file.exists(pathname)) { # Locate the first parent directory that does not exist depth <- 1 while(TRUE) { parent <- getParent(pathname, depth=depth) if (is.na(parent) || is.null(parent) || isDirectory(parent)) break depth <- depth + 1 } # while() reason <- NULL if (is.na(parent) || is.null(parent)) { parent <- getParent(pathname) if (is.na(parent) || is.null(parent)) { reason <- "no such file in the current working directory" } else { reason <- sprintf("none of the parent directories [%s/] exist", parent) } } else { reason <- sprintf("%s/ exists, but nothing beyond", parent) } if (!is.null(reason) && !isAbsolutePath(pathname)) { reason <- sprintf("%s; current directory is '%s'", reason, getwd()) } reason <- sprintf(" (%s)", reason) throw("Pathname not found: ", pathname, reason) } # Check if file permissions allow reading if (fileAccess(pathname, mode=4) == -1) { throw("Pathname exists, but there is no permission to read file: ", pathname) } } # if (mustExist) pathname }, static=TRUE) setMethodS3("getReadablePath", "Arguments", function(static, path=NULL, mustExist=TRUE, ...) { if (is.null(path)) return(NULL) path <- getReadablePathname(static, path=path, mustExist=mustExist, ...) if (mustExist && !is.na(path) && !isDirectory(path)) { throw("Argument 'path' is not a directory: ", path) } path }, static=TRUE, protected=TRUE) #########################################################################/** # @RdocMethod getReadablePathnames # # @title "Gets a readable pathname" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{files}{A @character @vector of filenames.} # \item{paths}{A @character @vector of paths.} # \item{...}{Arguments passed to @seemethod "getReadablePathname".} # } # # \value{ # Returns a @character @vector of the pathnames for the files. # } # # @author # # \seealso{ # @seemethod "getReadablePathname" # @see "R.utils::filePath". # @seeclass # } # # @keyword IO #*/######################################################################### setMethodS3("getReadablePathnames", "Arguments", function(static, files=NULL, paths=NULL, ...) { nbrOfFiles <- length(files) # Argument 'paths': if (length(paths) > nbrOfFiles) { throw("Argument 'paths' is longer than argument 'files': ", length(paths), " > ", nbrOfFiles) } # Expand argument 'paths' to be of same length as 'files' if (!is.null(paths)) { paths <- rep(paths, length.out=nbrOfFiles) } pathnames <- list() for (kk in seq_len(nbrOfFiles)) { pathnames[[kk]] <- getReadablePathname(static, files[kk], path=paths[kk], ...) } unlist(pathnames) }, static=TRUE) #########################################################################/** # @RdocMethod getWritablePathname # # @title "Gets a writable pathname" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Arguments passed to @seemethod "getReadablePathname".} # \item{mustExist}{If @TRUE and the pathname does not exists, # an Exception is thrown, otherwise not.} # \item{mustNotExist}{If the file exists, and \code{mustNotExist} is # @TRUE, an Exception is thrown. If the file exists, and # \code{mustNotExist} is @FALSE, or the file does not exists, the # pathname is accepted.} # \item{mkdirs}{If @TRUE, \code{mustNotExist} is @FALSE, and the path to # the file does not exist, it is (recursively) created.} # \item{maxTries}{A positive @integer specifying how many times the # method should try to create a missing directory before giving up. # For more details, see @see "R.utils::mkdirs".} # } # # \value{ # Returns a @character string of the pathname of the file. # If the argument was invalid an @see "R.oo::Exception" is thrown. # } # # \section{Missing values}{ # If any argument in \code{...} is @NA, an exception is thrown. # } # # @author # # \seealso{ # @seemethod "getReadablePathname". # @see "R.utils::filePath". # @see "R.utils::mkdirs". # @seeclass # } # # @keyword IO #*/######################################################################### setMethodS3("getWritablePathname", "Arguments", function(static, ..., mustExist=FALSE, mustNotExist=FALSE, mkdirs=TRUE, maxTries=5L) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'mustExist': mustExist <- getLogical(static, mustExist) # Argument 'mustNotExist': mustNotExist <- getLogical(static, mustNotExist) # Argument 'mkdirs': mkdirs <- getLogical(static, mkdirs) # Create pathname pathname <- getReadablePathname(static, ..., mustExist=mustExist) if (is.na(pathname)) { throw("Cannot retrieve writable file/directory because it is NA.") } if (isFile(pathname)) { # Check if it is ok that the file already exists if (mustNotExist) { throw("File already exists: ", pathname) } # Check if file permissions allow to modify existing if (fileAccess(pathname, mode=2) == -1) { throw("No permission to modify existing file: ", pathname) } } else { # Check if directory exists path <- getParent(pathname) if (!isDirectory(path)) { # Does the directory have to exists (mkdirs=FALSE)? if (!mkdirs) { path <- getReadablePath(static, path, mustExist=TRUE) } # If not, first try to create the parent directory, iff missing. # This should give a more informative error message, if it fails. pathP <- getParent(path) createParent <- !isDirectory(pathP) if (createParent) { pathnameP <- getWritablePathname(static, file="dummy-not-tested", path=pathP, mustExist=FALSE, mustNotExist=FALSE, mkdirs=TRUE, maxTries=maxTries) } # Try to create the directory mkdirs(path, mustWork=TRUE, maxTries=maxTries) } filename <- basename(pathname) if (filename != "dummy-not-tested") { # Check if file permissions allow to create a file in the directory pathT <- ifelse(is.null(path), ".", path) if (fileAccess(pathT, mode=2) == -1) { throw("No write permission for directory: ", path) } # Try to create a file filenameT <- basename(tempfile()) pathnameT <- filePath(path, filenameT) on.exit({ if (isFile(pathnameT)) { # Try to remove the temporary file res <- FALSE suppressWarnings({ for (tt in 1:maxTries) { res <- file.remove(pathnameT) if (res) break # If not, wait a bit and try again... Sys.sleep(0.5) } }) if (!res) { warning("Failed to remove temporary file: ", sQuote(pathnameT)) } } }, add=TRUE) tryCatch({ cat(file=pathnameT, Sys.time()) }, error = function(ex) { throw("No permission to create a new file in directory: ", path) }) } # if (filename != "dummy-not-tested") } # if (isFile(pathname)) pathname }, static=TRUE) setMethodS3("getWritablePath", "Arguments", function(static, path=NULL, ...) { # Special case: If path == NULL, the skip if (is.null(path)) return(NULL) pathname <- getWritablePathname(static, file="dummy-not-created", path=path, ...) getParent(pathname) }, static=TRUE, protected=TRUE) setMethodS3("getDirectory", "Arguments", function(static, path=NULL, ..., mustExist=FALSE, mkdirs=TRUE) { # Argument 'mustExist': mustExist <- getLogical(static, mustExist) # Argument 'mkdirs': mkdirs <- getLogical(static, mkdirs) # Create pathname pathname <- getReadablePathname(static, path=path, ..., mustExist=mustExist) if (is.na(pathname)) { throw("Cannot retrieve directory because it is NA.") } # Nothing to do? if (isDirectory(pathname)) { return(pathname) } if (!mkdirs) { throw("Directory does not exist: ", pathname) } mkdirs(pathname, mustWork=TRUE) pathname }, static=TRUE, protected=TRUE) #########################################################################/** # @RdocMethod getVector # # @title "Validates a vector" # # \description{ # @get "title" by checking its length (number of elements). # } # # @synopsis # # \arguments{ # \item{x}{A single @vector.} # \item{length}{A @numeric @vector of length two or more. If two, it # is the minimum and maximum length of \code{x}. Otherwise, it is the # set of possible lengths of \code{x}.} # \item{.name}{A @character string for name used in error messages.} # \item{...}{Not used.} # } # # \value{ # Returns the same @vector, if it is valid. Otherwise an exception is # thrown. # } # # @author # # \seealso{ # @seeclass # } # # @keyword IO #*/######################################################################### setMethodS3("getVector", "Arguments", function(static, x, length=NULL, .name=NULL, ...) { if (length(length) == 0) return(x) if (is.null(.name)) .name <- as.character(deparse(substitute(x))) # See ?is.vector for how it is defined. /HB 2009-05-19 attrs <- attributes(x) attributes(x) <- attrs[intersect(names(attrs), c("names", "dim"))] if (length[1] > 0 && !is.vector(x)) { throw(sprintf("Argument '%s' is not a vector: %s", .name, storage.mode(x))) } xlen <- length(x) if (length(length) == 1) length <- c(1,length) if (length(length) == 2) { if (xlen < length[1] || xlen > length[2]) { if (length[1] == length[2] && length[1] == 1) { throw(sprintf("Argument '%s' should be a single value not %d values.", .name, xlen)) } else if (length[1] == length[2]) { throw(sprintf("Number of elements in argument '%s' should be exactly %d not %d value(s).", .name, length[1], xlen)) } else { throw(sprintf("Number of elements in argument '%s' is out of range [%d,%d]: %d", .name, length[1], length[2], xlen)) } } } else { if (!is.element(xlen, length)) { throw(sprintf("Number of elements in argument '%s' is not in {%s}: %d", .name, seqToHumanReadable(length), xlen)) } } attributes(x) <- attrs x }, static=TRUE, private=TRUE) #########################################################################/** # @RdocMethod getCharacters # @aliasmethod getCharacter # # @title "Coerces to a character vector and validates" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{s}{A @vector.} # \item{nchar}{A @numeric @vector of length one or two. If one, # the maximum number of characters ("length") in \code{s}. If two, # the minimum and maximum length of \code{s}.} # \item{useNames}{If @TRUE, the 'names' attribute is preserved, otherwise # it is dropped.} # \item{asGString}{If @TRUE, each string is treated as a @see "GString".} # \item{.name}{A @character string for name used in error messages.} # \item{...}{Not used.} # } # # \value{ # Returns a @character @vector, if it is valid. Otherwise an exception is # thrown. # } # # \section{Missing values}{ # If \code{s} contains missing values, and \code{nchar} is not @NULL, # then an exception is thrown. # } # # @author # # \seealso{ # @seeclass # } # # @keyword IO #*/######################################################################### setMethodS3("getCharacters", "Arguments", function(static, s, length=NULL, trim=FALSE, nchar=NULL, useNames=TRUE, asGString=getOption("Arguments$getCharacters/args/asGString", TRUE), .name=NULL, ...) { if (is.null(.name)) .name <- as.character(deparse(substitute(s))) s <- getVector(static, s, length=length, .name=.name) # Nothing to check? if (length(s) == 0L) return(s) # Coerce GString:s to character strings? if (asGString) { # Treat only strings with GString markup. This avoids lots of # GString overhead if there are no GStrings. hasMarkup <- (regexpr("${", s, fixed=TRUE) != -1) idxs <- which(hasMarkup & !is.na(s)) s[idxs] <- unlist(lapply(s[idxs], FUN=function(x) { x <- GString(x) as.character(x) }), use.names=FALSE) } if (trim) { # Trim the strings # (using s[] to preserve attributes) s[] <- unlist(lapply(s, FUN=trim), use.names=FALSE) } # Coerce to character strings # (using s[] to preserve attributes) s[] <- unlist(lapply(s, FUN=as.character), use.names=FALSE) if (!useNames) { names(s) <- NULL } # Nothing to check? if (is.null(nchar)) return(s) # At this point, missing values are not allowed if (any(is.na(s))) { throw("Argument 'nchar' cannot be specified if character vector contains missing values: ", hpaste(sQuote(s))) } if (length(nchar) == 1L) nchar <- c(1L, nchar) # Check the string length of each character string for (kk in seq_along(s)) { slen <- nchar(s[kk], type="chars") if (slen < nchar[1L] || slen > nchar[2L]) { throw(sprintf("String length of elements #%d in '%s' is out of range [%d,%d]: %d '%s'", kk, .name, nchar[1L], nchar[2L], slen, s[kk])) } } s }, static=TRUE) setMethodS3("getCharacter", "Arguments", function(static, ..., length=c(0,1)) { getCharacters(static, ..., length=length) }, static=TRUE) #########################################################################/** # @RdocMethod getNumerics # @aliasmethod getNumeric # # @title "Coerces to a numeric vector and validates" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{x}{A @vector.} # \item{range}{Two @numerics for the allowed ranged. If @NULL, range is # not checked.} # \item{asMode}{A @character specifying the mode to coerce to.} # \item{disallow}{A @character @vector specifying disallowed value sets, # i.e. \code{"NA"}, \code{"NaN"}, and/or \code{"Inf"}.} # \item{...}{Arguments passed to @method "getVector".} # \item{.name}{A @character string for name used in error messages.} # } # # \value{ # Returns a @numeric @vector. # } # # @author # # \seealso{ # @seeclass # } # # @keyword IO #*/######################################################################### setMethodS3("getNumerics", "Arguments", function(static, x, range=NULL, asMode=NULL, disallow=NULL, ..., .name=NULL) { # Argument '.name': if (is.null(.name)) { .name <- as.character(deparse(substitute(x))) } x <- getVector(static, x, ..., .name=.name) xMode <- storage.mode(x) # Coerce the mode of 'x' if (is.null(asMode)) { if (is.element(xMode, c("integer", "double"))) { asMode <- xMode } else { asMode <- "double" } } # Update/coerce mode? if (xMode != asMode) { storage.mode(x) <- asMode } # Nothing to do? if (length(x) == 0) return(x) if (!is.null(disallow)) { if (is.element("NaN", disallow) && any(is.nan(x))) { throw(sprintf("Argument '%s' contains %d NaN value(s).", .name, sum(is.nan(x)))) } if (is.element("NA", disallow) && any(is.na(x) & !is.nan(x))) { throw(sprintf("Argument '%s' contains %d NA value(s).", .name, sum(is.na(x)))) } # For conveniency, disallow 'Inf' here too; other range takes care of it. if (is.element("Inf", disallow) && any(is.infinite(x))) { throw(sprintf("Argument '%s' contains %d (-/+)Inf value(s).", .name, sum(is.infinite(x)))) } } # Nothing to check? if (is.null(range)) return(x) # Argument 'range': if (length(range) != 2) { throw("Argument 'range' should be of length 2: ", length(range)) } if (range[2] < range[1]) { throw(sprintf("Argument 'range' is not ordered: c(%s,%s)", range[1], range[2])) } # Suppress warnings when there are no finite values in x. suppressWarnings({ xrange <- range(x, na.rm=TRUE) }) if (xrange[1] < range[1] || xrange[2] > range[2]) { xrange <- as.character(xrange) range <- as.character(range) if (length(x) == 1) { throw(sprintf("Argument '%s' is out of range [%s,%s]: %s", .name, range[1], range[2], x)) } else { throw(sprintf("Range of argument '%s' is out of range [%s,%s]: [%s,%s]", .name, range[1], range[2], xrange[1], xrange[2])) } } x }, static=TRUE) setMethodS3("getNumeric", "Arguments", function(static, ..., length=1) { getNumerics(static, ..., length=length) }, static=TRUE) #########################################################################/** # @RdocMethod getDoubles # @aliasmethod getDouble # # @title "Coerces to a double vector and validates" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Arguments passed to @method "getNumeric".} # \item{disallow}{Disallowed values. See @method "getNumerics" for details.} # } # # \value{ # Returns a @double @vector. # } # # @author # # \seealso{ # @seeclass # } # # @keyword IO #*/######################################################################### setMethodS3("getDoubles", "Arguments", function(static, ..., disallow=c("NA","NaN")) { getNumerics(static, ..., asMode="double", disallow=disallow) }, static=TRUE) setMethodS3("getDouble", "Arguments", function(static, ..., length=1) { getDoubles(static, ..., length=length) }, static=TRUE) #########################################################################/** # @RdocMethod getIntegers # @aliasmethod getInteger # # @title "Coerces to a integer vector and validates" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Arguments passed to @method "getNumeric".} # \item{disallow}{Disallowed values. See @method "getNumerics" for details.} # } # # \value{ # Returns a @integer @vector. # } # # @author # # \seealso{ # @seeclass # } # # @keyword IO #*/######################################################################### setMethodS3("getIntegers", "Arguments", function(static, ..., disallow=c("NA","NaN")) { getNumerics(static, ..., asMode="integer", disallow=disallow) }, static=TRUE) setMethodS3("getInteger", "Arguments", function(static, ..., length=1) { getIntegers(static, ..., length=length) }, static=TRUE) #########################################################################/** # @RdocMethod getIndices # @aliasmethod getIndex # # @title "Coerces to a integer vector and validates" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{x}{A single @vector. If @logical, @see "base::which" is used.} # \item{...}{Arguments passed to @method "getIntegers".} # \item{range}{Allowed range. See @method "getNumerics" for details.} # \item{max}{The maximum of the default range.} # \item{.name}{A @character string for name used in error messages.} # } # # \value{ # Returns an @integer @vector. # } # # @author # # \seealso{ # @seeclass # } # # @keyword IO #*/######################################################################### setMethodS3("getIndices", "Arguments", function(static, x, ..., max=Inf, range=c(1*(max > 0L),max), .name=NULL) { if (is.null(.name)) .name <- as.character(deparse(substitute(x))) # Argument 'x': if (is.logical(x)) { x <- which(x) } # Argument 'max': if (length(max) != 1) { throw("Argument 'max' must be a single value: ", length(max)) } max <- as.numeric(max) if (is.na(max)) { throw("Argument 'max' is NA/NaN: ", max) } else if (max < 0) { throw("Argument 'max' must be positive: ", max) } # Argument 'range': if (!is.null(range)) { if (length(range) != 2) { throw("Argument 'range' should be of length 2: ", length(range)) } if (range[2] < range[1]) { throw(sprintf("Argument 'range' is not ordered: c(%s,%s)", range[1], range[2])) } } # Identify indices x <- getIntegers(static, x, ..., range=range, .name=.name) # Special dealing with range = c(0,0) if (!is.null(range)) { if (range[2] < 1L) { xt <- x[is.finite(x)] if (length(xt) > 0) { throw(sprintf("Argument 'x' contains %d non-missing indices although the range ([%s,%s]) implies that there should be none.", length(xt), range[1L], range[2L])) } } } x }, static=TRUE) setMethodS3("getIndex", "Arguments", function(static, ..., length=1) { getIndices(static, ..., length=length) }, static=TRUE) #########################################################################/** # @RdocMethod getLogicals # @aliasmethod getLogical # # @title "Coerces to a logical vector and validates" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{x}{A @vector.} # \item{disallow}{A @character @vector specifying disallowed value sets # after coercing, i.e. \code{"NA"}.} # \item{...}{Arguments passed to @method "getVector".} # \item{.name}{A @character string for name used in error messages.} # } # # \value{ # Returns a @numeric @vector. # } # # @author # # \seealso{ # @seeclass # } # # @keyword IO #*/######################################################################### setMethodS3("getLogicals", "Arguments", function(static, x, ..., disallow=c("NA", "NaN"), coerce=FALSE, .name=NULL) { if (is.null(.name)) .name <- as.character(deparse(substitute(x))) x <- getVector(static, x, ..., .name=.name) # Coerce to logicals? if (coerce) x <- as.logical(x) if (!is.null(disallow)) { if (is.element("NA", disallow) && any(is.na(x))) { throw(sprintf("Argument '%s' contains %d NA value(s).", .name, sum(is.na(x)))) } } # Assert that 'x' is logical before returning if (any(!is.logical(x))) throw(sprintf("Argument '%s' is non-logical: %s", .name, class(x))) x }, static=TRUE) setMethodS3("getLogical", "Arguments", function(static, ..., length=1) { getLogicals(static, ..., length=length) }, static=TRUE) #########################################################################/** # @RdocMethod getVerbose # # @title "Coerces to Verbose object" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{verbose}{A single object. If a @see "Verbose", it is immediately # returned. If a @numeric value, it is used as the threshold. # Otherwise the object is coerced to a @logical value and if @TRUE, # the threshold is \code{defaultThreshold}.} # \item{defaultThreshold}{A @numeric value for the default threshold, if # \code{verbose} was interpreted as a @logical value.} # \item{useNullVerbose}{If \code{verbose} can be interpreted as @FALSE, # return a @see NullVerbose object if @TRUE.} # \item{...}{Passed to the constructor of @see "Verbose".} # \item{.name}{A @character string for name used in error messages.} # } # # \value{ # Returns a @see Verbose (or a @see "NullVerbose") object. # } # # @author # # \seealso{ # @seeclass # } # # @keyword IO #*/######################################################################### setMethodS3("getVerbose", "Arguments", function(static, verbose, defaultThreshold=-1, useNullVerbose=TRUE, ..., .name=NULL) { if (inherits(verbose, "Verbose")) return(verbose) if (is.null(.name)) .name <- as.character(deparse(substitute(verbose))) if (is.numeric(verbose)) { verbose <- getDouble(static, verbose, .name=.name) verbose <- Verbose(threshold=verbose, ...) } else { verbose <- getLogical(static, verbose, .name=.name) if (!verbose && useNullVerbose) { verbose <- NullVerbose() } else { defaultThreshold <- getNumeric(static, defaultThreshold) verbose <- Verbose(threshold=defaultThreshold, ...) } } verbose }, static=TRUE) #########################################################################/** # @RdocMethod getRegularExpression # # @title "Gets a valid regular expression pattern" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{pattern}{A @character string to be validated.} # \item{.name}{A @character string for name used in error messages.} # \item{...}{Not used.} # } # # \value{ # Returns a @character string. # } # # @author # # \seealso{ # @see "base::grep". # @seeclass # } # # @keyword IO #*/######################################################################### setMethodS3("getRegularExpression", "Arguments", function(static, pattern=NULL, ..., .name=NULL) { if (is.null(.name)) { .name <- as.character(deparse(substitute(pattern))) } if (is.null(pattern)) { throw(sprintf("Argument '%s' is not a valid regular expression: NULL", .name)) } pattern <- getCharacter(static, pattern, .name=.name, length=c(1,1)) # Validate it tryCatch({ regexpr(pattern, "dummy string", ...) }, error = function(ex) { throw(sprintf("Argument '%s' is not a valid regular expression: %s. Error message from regexpr() was: %s", .name, pattern, ex$message)) }) pattern }, static=TRUE) #########################################################################/** # @RdocMethod getEnvironment # # @title "Gets an existing environment" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{envir}{An @environment, the name of a loaded package, or @NULL. # If @NULL, the global environment is returned.} # \item{.name}{A @character string for name used in error messages.} # \item{...}{Not used.} # } # # \value{ # Returns an @environment. # } # # @author # # \seealso{ # @seeclass # } # # @keyword IO #*/######################################################################### setMethodS3("getEnvironment", "Arguments", function(static, envir=NULL, .name=NULL, ...) { if (is.null(.name)) .name <- as.character(deparse(substitute(envir))) if (is.null(envir)) { return(.GlobalEnv) } if (is.character(envir)) { name <- getCharacter(static, envir, length=c(1,1)) envirs <- gsub("^package:", "", search()) pos <- which(name == envirs) if (length(pos) == 0) throw("Argument 'envir' is not the name of a loaded package: ", envir) envir <- pos.to.env(pos) } if (!is.environment(envir)) { throw(sprintf("Argument '%s' is not an environment: %s", .name, class(envir)[1])) } }, static=TRUE) #########################################################################/** # @RdocMethod getInstanceOf # # @title "Gets an instance of the object that is of a particular class" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{object}{The object that should be returned as an instance of # class \code{class}.} # \item{class}{A @character string specifying the name of the class that # the returned object should inherit from.} # \item{coerce}{If @TRUE and the object is not of the wanted class, then # method will be coerced to that class, if possible. Otherwise, # an error is thrown.} # \item{...}{Not used.} # \item{.name}{A @character string for name used in error messages.} # } # # \value{ # Returns an object inheriting from class \code{class}. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/######################################################################### setMethodS3("getInstanceOf", "Arguments", function(static, object, class, coerce=FALSE, ..., .name=NULL) { if (is.null(.name)) { .name <- as.character(deparse(substitute(object))) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'class': class <- getCharacter(static, class) # Argument 'coerce': coerce <- getLogical(static, coerce) # Argument 'object': if (!inherits(object, class)) { if (coerce) { object <- as(object, class, ...) } else { throw(sprintf("Argument '%s' is neither of nor inherits class %s: %s", .name, class[1], paste(class(object), collapse=", "))) } } # Return the object object }, static=TRUE, protected=TRUE) withoutGString <- function(..., envir=parent.frame()) { # Temporarily disable 'asGString' for Arguments$getCharacters() oopts <- options("Arguments$getCharacters/args/asGString"=FALSE) on.exit(options(oopts)) eval(..., envir = envir, enclos = baseenv()) } # withoutGString() ���������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/addFinalizerToLast.R����������������������������������������������������������������������0000644�0001762�0000144�00000005140�14372747611�015675� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault addFinalizerToLast # # @title "Modifies .Last() to call 'finalizeSession()" # # \description{ # @get "title" \emph{before} calling the default \code{.Last()} function. # # Note that \code{.Last()} is \emph{not} guaranteed to be called when # the \R session finished. For instance, the user may quit \R by calling # \code{quit(runLast=FALSE)} or run R in batch mode. # # Note that this function is called when the R.utils package is loaded. # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns (invisibly) @TRUE if \code{.Last()} was modified, # otherwise @FALSE. # } # # @author # # \seealso{ # @see "onSessionExit". # } # # @keyword programming #*/########################################################################### setMethodS3("addFinalizerToLast", "default", function(...) { # Modify existing .Last() or create a new one? if (exists(".Last", mode="function")) { # A) Modify .Last <- get(".Last", mode="function") # Already has finalizeSession()? if (identical(attr(.Last, "finalizeSession"), TRUE)) { # And a version from R.utils v0.8.5 or after? ver <- attr(.Last, "finalizeSessionVersion") if (!is.null(ver) && compareVersion(ver, "0.8.5") >= 0) { # ...then everything is fine. return(invisible(FALSE)) } # Otherwise, overwrite old buggy version. } else { # Rename original .Last() function env <- globalenv(); # To please R CMD check assign(".LastOriginal", .Last, envir=env) } # Define a new .Last() function .Last <- function(...) { tryCatch({ if (exists("finalizeSession", mode="function")) finalizeSession() if (exists(".LastOriginal", mode="function")) { .LastOriginal <- get(".LastOriginal", mode="function") .LastOriginal() } }, error = function(ex) { message("Ignoring error occured in .Last(): ", as.character(ex)) }) } } else { # B) Create a new one .Last <- function(...) { tryCatch({ if (exists("finalizeSession", mode="function")) finalizeSession() }, error = function(ex) { message("Ignoring error occured in .Last(): ", as.character(ex)) }) } } attr(.Last, "finalizeSession") <- TRUE attr(.Last, "finalizeSessionVersion") <- packageDescription("R.utils")$Version environment(.Last) <- globalenv() # Store it. env <- globalenv(); # To please R CMD check assign(".Last", .Last, envir=env) invisible(FALSE) }, private=TRUE) ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/installPackages.R�������������������������������������������������������������������������0000644�0001762�0000144�00000007126�14372747611�015265� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#########################################################################/** # @RdocDefault installPackages # # @title "Install R packages by name or URL" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{pkgs}{A @character @vector specifying the names and/or the URLs # of the R packages to be installed.} # \item{types}{A @character @vector of corresponding package types.} # \item{repos}{A @character @vector of package repository URLs.} # \item{...}{Additional arguments passed to @see "utils::install.packages".} # \item{destPath}{Path where any downloaded files are saved.} # \item{cleanup}{If @TRUE, downloaded and successfully installed package # files are removed, otherwise not.} # } # # \value{ # Returns nothing. # } # # \section{Limitations}{ # This method cannot install any packages that are already in use. # Certain packages are always in use when calling this method, e.g. # \pkg{R.methodsS3}, \pkg{R.oo}, and \pkg{R.utils}. # } # # \examples{\dontrun{ # installPackages("R.rsp") # installPackages("https://cran.r-project.org/src/contrib/Archive/R.rsp/R.rsp_0.8.2.tar.gz") # installPackages("https://cran.r-project.org/bin/windows/contrib/4.0/R.rsp_0.44.0.zip") # }} # # @author # # @keyword file #*/######################################################################### setMethodS3("installPackages", "default", function(pkgs, types="auto", repos=getOption("repos"), ..., destPath=".", cleanup=TRUE) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'pkgs': pkgs <- Arguments$getCharacters(pkgs) # Argument 'types': types <- Arguments$getCharacters(types) # Argument 'repos': if (!is.null(repos)) { repos <- Arguments$getCharacters(repos) } # Argument 'destPath': destPath <- Arguments$getWritablePath(destPath) # Argument 'cleanup': cleanup <- Arguments$getLogical(cleanup) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Infer 'type' for each package # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - defType <- getOption("pkgType") types <- rep(types, length.out=length(pkgs)) for (kk in seq_along(pkgs)) { if (types[kk] == "auto") { pkg <- pkgs[kk] if (isUrl(pkg)) { filename <- basename(pkg) ext <- gsub("(.*)[.](tar.gz|tgz|zip)$", "\\2", tolower(filename)) if (ext == "tar.gz") { types[kk] <- "source" } else if (ext == "tgz") { types[kk] <- "mac.binary.leopard" } else if (ext == "zip") { types[kk] <- "win.binary" } else { throw("Cannot install R package. Unknown filename extension: ", pkg) } } else { types[kk] <- defType } } } # for (kk ...) # Install each package requested for (kk in seq_along(pkgs)) { pkg <- pkgs[kk] type <- types[kk] if (isUrl(pkg)) { url <- pkg filename <- basename(url) # Download file pathname <- filePath(destPath, filename) downloadFile(url, filename=pathname, skip=TRUE) if (!isFile(pathname)) { throw("Failed to download package file: ", url) } install.packages(pathname, repos=NULL, type=type, ...) if (cleanup) { file.remove(pathname) if (isFile(pathname)) { throw("Failed to remove package file after installation: ", pathname) } } } else { install.packages(pkg, repos=repos, type=type, ...) } } # for (kk ...) invisible() }) # installPackages() ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/splitByCommonTails.R����������������������������������������������������������������������0000644�0001762�0000144�00000001161�14372747611�015745� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������splitByCommonTails <- function(strs, ...) { names <- names(strs) prefix <- getCommonPrefix(strs) suffix <- getCommonPrefix(strs, suffix=TRUE) # Cut out the prefix body <- substring(strs, nchar(prefix)+1) # Cut out the suffix body <- substring(body, 1, nchar(body)-nchar(suffix)) # Special case if (all(body == "")) { suffix <- "" } strs <- lapply(body, FUN=function(s) { c(prefix, s, suffix) }) strs <- unlist(strs, use.names=FALSE) strs <- matrix(strs, ncol=3, byrow=TRUE) colnames(strs) <- c("prefix", "body", "suffix") rownames(strs) <- names strs } # splitByCommonTails() ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/withCapture.R�����������������������������������������������������������������������������0000644�0001762�0000144�00000015270�14372747611�014456� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocFunction withCapture # @alias evalCapture # # @title "Evaluates an expression and captures the code and/or the output" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{expr}{The R expression to be evaluated.} # \item{replace}{An optional named @list used for substituting # symbols with other strings.} # \item{code}{If @TRUE, the deparsed code of the expression is echoed.} # \item{output}{If @TRUE, the output of each evaluated subexpression # is echoed.} # \item{...}{Additional arguments passed to @see "R.utils::sourceTo" # which in turn passes arguments to @see "base::source".} # \item{max.deparse.length}{A positive @integer specifying the maximum # length of a deparsed expression, before truncating it.} # \item{trim}{If @TRUE, the captured rows are trimmed.} # \item{newline}{If @TRUE and \code{collapse} is non-@NULL, a newline # is appended at the end.} # \item{collapse}{A @character string used for collapsing the captured # rows. If @NULL, the rows are not collapsed.} # \item{envir}{The @environment in which the expression is evaluated.} # } # # \value{ # Returns a @character string class 'CapturedEvaluation'. # } # # @examples "../incl/withCapture.Rex" # # @author # # \seealso{ # Internally, @see "base::eval" is used to evaluate the expression. # } # # @keyword utilities #*/########################################################################### withCapture <- function(expr, replace=getOption("withCapture/substitute", ".x."), code=TRUE, output=code, ..., max.deparse.length=getOption("max.deparse.length", 10e3), trim=TRUE, newline=getOption("withCapture/newline", TRUE), collapse="\n", envir=parent.frame()) { # Get code/expression without evaluating it expr2 <- substitute(expr) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Substitute? # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # (a) Substitute by "constant" symbols? if (is.list(replace) && (length(replace) > 0L)) { names <- names(replace) if (is.null(names)) throw("Argument 'replace' must be named.") expr2 <- do.call(base::substitute, args=list(expr2, replace)) } # (b) Replace code by regular expressions? if (is.character(replace) && (length(replace) > 0L)) { patterns <- names(replace) replacements <- replace # Predefined rules? if (is.null(patterns)) { patterns <- rep(NA_character_, times=length(replacements)) for (kk in seq_along(replacements)) { replacement <- replacements[kk] if (identical(replacement, ".x.")) { patterns[kk] <- "^[.]([a-zA-Z0-9_.]+)[.]$" replacements[kk] <- "\\1" } else if (identical(replacement, "..x..")) { patterns[kk] <- "^[.][.]([a-zA-Z0-9_.]+)[.][.]$" replacements[kk] <- "\\1" } } unknown <- replacements[is.na(patterns)] if (length(unknown) > 0L) { throw("Unknown substitution rules: ", paste(sQuote(unknown), collapse=", ")) } } if (is.null(patterns)) throw("Argument 'replace' must be named.") # (b) Replace via regular expression for (kk in seq_along(replacements)) { pattern <- patterns[kk] replacement <- replacements[kk] expr2 <- egsub(pattern, replacement, expr2, envir=envir) } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Deparse # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # WAS: ## sourceCode <- capture.output(print(expr2)) sourceCode <- deparse(expr2, width.cutoff=getOption("deparse.cutoff", 60L)) # Nothing todo? if (length(sourceCode) == 0L) { ## Can this ever happen? /HB 2015-05-27 return(structure(character(0L), class=c("CapturedEvaluation", "character"))) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Trim code # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Trim of surrounding { ... } if (sourceCode[1L] == "{") { sourceCode <- sourceCode[-c(1L, length(sourceCode))] # Nothing todo? if (length(sourceCode) == 0L) { return(structure(character(0L), class=c("CapturedEvaluation", "character"))) } # Drop shortest white space prefix prefix <- gsub("^([ \t]*).*", "\\1", sourceCode) minPrefix <- min(nchar(prefix), na.rm=TRUE) if (minPrefix > 0L) { sourceCode <- substring(sourceCode, first=minPrefix+1) } # WORKAROUND: Put standalone 'else':s together with previous statement. # This solves the problem described in R help thread "deparse() and the # 'else' statement" by Yihui Xie on 2009-11-09 # [https://stat.ethz.ch/pipermail/r-help/2009-November/410758.html], where # deparse puts 'else' on a new line iff if-else statement is enclosed # in an { ... } expression, e.g. # cat(deparse(substitute({if (T) 1 else 2})), sep="\n") gives: # { # if (T) # 1 # else 2 # } # whereas deparse(substitute(if (T) 1 else 2)) gives: # if (T) 1 else 2 # /HB 2014-08-12 idxs <- grep("^[ ]*else[ ]*", sourceCode) if (length(idxs) > 0L) { if (any(idxs == 1L)) { stop("INTERNAL ERROR: Detected 'else' statement at the very beginning: ", paste(sourceCode, collapse="\n")) } sourceCode[idxs-1L] <- paste(sourceCode[idxs-1L], sourceCode[idxs], sep=" ") sourceCode <- sourceCode[-idxs] } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Evalute code expression # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # WORKAROUND: The following will *not* evaluate in environment # 'envir' due to capture.output() *unless* we evaluate 'envir' # before. This sanity check will do that. /HB 2011-11-23 .stop_if_not(is.environment(envir)) # Evaluate the sourceCode via source() con <- textConnection(sourceCode, open="r") res <- captureOutput({ sourceTo(file=con, echo=code, print.eval=output, keep.source=TRUE, max.deparse.length=max.deparse.length, ..., envir=envir) }) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Cleanup captured output? # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Drop empty lines? if (trim) { res <- res[nchar(res) > 0L] } if (!is.null(collapse)) { if (newline) res <- c(res, "") res <- paste(res, collapse=collapse) } class(res) <- c("CapturedEvaluation", class(res)) res } # withCapture() # BACKWARD COMPATIBIILTY evalCapture <- withCapture setMethodS3("print", "CapturedEvaluation", function(x, ...) { cat(x) }) ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/nullfile.R��������������������������������������������������������������������������������0000644�0001762�0000144�00000002017�14372747611�013764� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#########################################################################/** # @RdocFunction nullfile # @alias nullcon # # @title "Gets the pathname or a connection to the NULL device on the current platform" # # \description{ # @get "title". # } # # \usage{ # @usage nullfile # @usage nullcon # } # # \value{ # \code{nullfile()} returns a @character string, which is \code{"/dev/null"} # except on Windows where it is \code{"nul:"}. # \code{nullcon()} returns a \emph{newly opened} (binary) @connection to # the NULL device - make sure to close it when no longer needed. # } # # \seealso{ # In R (>= 3.6.0), there exists \code{base::nullfile()}, which is # identical to \code{R.utils::nullfile()}. # } # # @author # # @keyword "programming" # @keyword "file" #*/######################################################################### nullfile <- function() { switch(.Platform$OS.type, windows="nul:", "/dev/null" ) } nullcon <- local({ nullfile <- nullfile() function() file(nullfile, open = "wb") }) �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/loadToEnv.R�������������������������������������������������������������������������������0000644�0001762�0000144�00000002236�14372747611�014050� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault loadToEnv # # @title "Method to load objects to a new environment" # # \description{ # @get "title" for objects previously stored by @see "base::save". # } # # @synopsis # # \arguments{ # \item{...}{Arguments passed to @see "base::load".} # \item{envir}{The @environment to load the objects to.} # } # # \value{ # Returns @environment \code{envir} containing all loaded objects. # } # # @author # # \seealso{ # Internally @see "base::load" is used. # See also @see "loadObject". # } # # @keyword IO # @keyword internal #*/########################################################################### setMethodS3("loadToEnv", "default", function(file, ..., envir = new.env()) { tryCatch({ base::load(file = file, envir = envir, ...) }, error = function(ex) { if (is.character(file)) { msg <- sprintf("Failed to load file %s.", sQuote(file)) } else { msg <- sprintf("Failed to load from %s.", sQuote(class(file)[1])) } msg <- sprintf("%s The reason was: %s", msg, conditionMessage(ex)) throw(msg) }) envir }, private=TRUE) # loadToEnv() ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/wrap.array.R������������������������������������������������������������������������������0000644�0001762�0000144�00000011407�14372747611�014243� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @set "class=array" # @RdocMethod wrap # @alias wrap.matrix # @alias wrap.data.frame # # @title "Reshape an array or a matrix by permuting and/or joining dimensions" # # \description{ # @get "title". # # A useful application of this is to reshape a multidimensional @array # to a @matrix, which then can be saved to file using for instance # \code{write.table()}. # } # # @synopsis # # \arguments{ # \item{x}{An @array or a @matrix.} # \item{map}{A @list of length equal to the number of dimensions in the # reshaped array. Each element should be an @integer @vectors specifying # the dimensions to be joined in corresponding new dimension. # One element may equal @NA to indicate that that dimension should be # a join of all non-specified (remaining) dimensions. # Default is to wrap everything into a @vector. # } # \item{sep}{A @character pasting joined dimension names.} # \item{...}{Not used.} # } # # \value{ # Returns an @array of \code{length(map)} dimensions, where the first # dimension is of size \code{prod(map[[1]])}, the second # \code{prod(map[[2]])}, and so on. # } # # \details{ # If the indices in \code{unlist(map)} is in a non-increasing order, # \link[base:aperm]{aperm()} will be called, which requires reshuffling # of array elements in memory. In all other cases, the reshaping of the # array does not require this, but only fast modifications of # attributes \code{dim} and \code{dimnames}. # } # # @examples "../incl/wrap.array.Rex" # # @author # # \seealso{ # @seemethod "unwrap". # See \link[base:aperm]{aperm()}. # } # # @keyword programming #*/########################################################################### setMethodS3("wrap", "array", function(x, map=list(NA), sep=".", ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'x': if (!is.array(x) && !is.matrix(x)) throw("Argument 'x' is not an array or a matrix: ", class(x)[1]) if (!is.list(map)) throw("Argument 'map' is not a list: ", class(map)[1]) umap <- unlist(map) if (any(duplicated(umap))) { throw("Argument 'map' contains duplicated dimension indices: ", paste(umap[duplicated(umap)], collapse=", ")) } # Extract information dim <- dim(x) ndims <- length(dim) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate dimension map # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Look for missing dimension indices missingDims <- setdiff(1:ndims, umap) if (length(missingDims) > 0) { wildcard <- is.na(map) if (any(wildcard)) { map[[which(wildcard)]] <- missingDims umap <- unlist(map) } else { throw("Argument 'map' miss some dimensions: ", paste(missingDims, collapse=", ")) } } # Look for non-existing dimension indices falseDims <- setdiff(umap, 1:ndims) if (length(falseDims) > 0) { throw("Argument 'map' contains non-existing dimensions: ", paste(falseDims, collapse=", ")) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Permute dimensions? # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (any(diff(umap) < 0)) { # Permute dimensions perm <- umap x <- aperm(x, perm=perm) # Remap old dimension indices to the new ones for the map map <- lapply(map, FUN=function(ii) match(ii, perm)) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Reshape array # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Calculate the dimension sizes of the new array dim <- dim(x) dim2 <- unlist(lapply(map, FUN=function(ii) prod(dim[ii])), use.names = FALSE) # Generate the new dimension names. # Note that the values in array 'x' are stored such that the *leftmost* # subscript moves fastest. When we change the reshape the array by # changing the dimensions, the dimension names must be consistent with # this rule. dimnames <- dimnames(x) dimnames2 <- lapply(map, FUN=function(iis) { names <- NULL for (ii in iis) { if (is.null(names)) { names <- dimnames[[ii]] } else { names <- paste(names, rep(dimnames[[ii]], each=length(names)), sep=sep) } } names }) # Now, reshape the array dim(x) <- dim2 dimnames(x) <- dimnames2 x }) setMethodS3("wrap", "matrix", function(x, ...) { wrap.array(x, ...) }) setMethodS3("wrap", "data.frame", function(x, ...) { wrap(as.matrix(x), ...) }) ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/getCommonPrefix.R�������������������������������������������������������������������������0000644�0001762�0000144�00000001656�14372747611�015270� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ getCommonPrefix <- function(strs, suffix=FALSE, ...) { # Split strings into character vectors nchars <- sapply(strs, FUN=nchar) chars <- strsplit(strs, split="") # Asked for the suffix? if (suffix) { chars <- lapply(chars, FUN=rev) } # Put the characters into a matrix naValue <- NA_character_ data <- matrix(naValue, nrow=length(chars), ncol=max(nchars)) for (kk in seq_along(chars)) { cc <- seq_len(nchars[kk]) data[kk,cc] <- chars[[kk]] } # Find first column with different characters count <- 0 for (cc in seq_len(ncol(data))) { uchars <- unique(data[,cc]) if (length(uchars) > 1) break count <- cc } # The common prefix as a character vector prefix <- chars[[1]][seq_len(count)] # Asked for the suffix? if (suffix) { prefix <- rev(prefix) } # The common prefix as a character string prefix <- paste(prefix, collapse="") prefix } # getCommonPrefix() ����������������������������������������������������������������������������������R.utils/R/mout.R������������������������������������������������������������������������������������0000644�0001762�0000144�00000007366�14372747611�013152� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocFunction mout # @alias mprint # @alias mshow # @alias mcat # @alias mstr # @alias mprintf # @alias cmsg # @alias cout # @alias cprint # @alias cshow # @alias ccat # @alias cstr # @alias cprintf # # @title "Miscellaneous functions for outputting via message()" # # \description{ # @get "title". # These "m*" methods work analogously to their corresponding "*" methods # @see "base::print", @see "base::cat", @see "methods::show", # @see "utils::str", and @see "printf" but uses @see "base::message" # to output the content, which in turn outputs to standard error. # The \code{mout()} method can be used for all other output methods, # e.g. \code{mout(write(x, file=stdout()))}. # } # # @synopsis # # \arguments{ # \item{...}{Arguments passed to the underlying output method.} # \item{appendLF}{A @logical specifying whether to append a newline at # the end or not.} # } # # \value{ # Returns what the @see "base::message" returns. # } # # \examples{ # print(letters[1:8]) # mprint(letters[1:8]) # # cat(c(letters[1:8], "\n")) # mcat(c(letters[1:8], "\n")) # # str(letters[1:8]) # mstr(letters[1:8]) # # printf("x=\%d\n", 1:3) # mprintf("x=\%d\n", 1:3) # } # # @author # # @keyword utilities #*/########################################################################### mout <- function(..., appendLF=FALSE) { bfr <- captureOutput(..., envir=parent.frame()) bfr <- paste(c(bfr, ""), collapse="\n") message(bfr, appendLF=appendLF) } mprint <- function(..., appendLF=FALSE) { bfr <- captureOutput(print(...), envir=parent.frame()) bfr <- paste(c(bfr, ""), collapse="\n") message(bfr, appendLF=appendLF) } mcat <- function(..., appendLF=FALSE) { bfr <- captureOutput(cat(...), envir=parent.frame()) bfr <- paste(c(bfr, ""), collapse="\n") message(bfr, appendLF=appendLF) } mstr <- function(..., appendLF=FALSE) { bfr <- captureOutput(str(...), envir=parent.frame()) bfr <- paste(c(bfr, ""), collapse="\n") message(bfr, appendLF=appendLF) } mshow <- function(..., appendLF=FALSE) { bfr <- captureOutput(show(...), envir=parent.frame()) bfr <- paste(c(bfr, ""), collapse="\n") message(bfr, appendLF=appendLF) } mprintf <- function(..., appendLF=FALSE) { bfr <- sprintf(...) message(bfr, appendLF=appendLF) } cmsg <- function(..., appendLF=FALSE) { ## Write output to a temporary file ## FIXME: Do we have worry about encoding?!? /HB 2015-02-01 fh <- tempfile() on.exit(file.remove(fh)) cat(..., file=fh) if (appendLF) cat("\n", file=fh, append=TRUE) ## Display file such that it cannot be ## captured/intercepted by R. if (.Platform$OS.type == "windows") { file.show(fh, pager="console", header="", title="", delete.file=FALSE) } else { system(sprintf("cat %s", fh)) } invisible() } cout <- function(..., appendLF=FALSE) { bfr <- captureOutput(..., envir=parent.frame()) bfr <- paste(c(bfr, ""), collapse="\n") cmsg(bfr, appendLF=appendLF) } cprint <- function(..., appendLF=FALSE) { bfr <- captureOutput(print(...), envir=parent.frame()) bfr <- paste(c(bfr, ""), collapse="\n") cmsg(bfr, appendLF=appendLF) } ccat <- function(..., appendLF=FALSE) { bfr <- captureOutput(cat(...), envir=parent.frame()) bfr <- paste(c(bfr, ""), collapse="\n") cmsg(bfr, appendLF=appendLF) } cstr <- function(..., appendLF=FALSE) { bfr <- captureOutput(str(...), envir=parent.frame()) bfr <- paste(c(bfr, ""), collapse="\n") cmsg(bfr, appendLF=appendLF) } cshow <- function(..., appendLF=FALSE) { bfr <- captureOutput(show(...), envir=parent.frame()) bfr <- paste(c(bfr, ""), collapse="\n") cmsg(bfr, appendLF=appendLF) } cprintf <- function(..., appendLF=FALSE) { bfr <- sprintf(...) cmsg(bfr, appendLF=appendLF) } ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/hsize.R�����������������������������������������������������������������������������������0000644�0001762�0000144�00000005613�14525546077�013304� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocFunction hsize # @alias hsize.numeric # @alias hsize.object_size # # @title "Convert byte sizes into human-readable byte sizes" # # \description{ # @get "title". # } # # \usage{ # @usage hsize,numeric # @usage hsize,object_size # } # # \arguments{ # \item{sizes}{A @numeric @vector of sizes.} # \item{digits}{Number of digits to be presented in the give unit.} # \item{units}{A @character string specifying type of units to use.} # \item{bytes}{The string used for units of bytes without a prefix. # Applied only if \code{units="auto"}.} # \item{...}{Not used.} # } # # \value{ # A @character @vector. # } # # @examples "../incl/hsize.Rex" # # @author # # \seealso{ # @see "utils::object.size". # } # # @keyword programming # @keyword internal #*/########################################################################### setMethodS3("hsize", "numeric", function(sizes, digits=1L, units="auto", standard=getOption("hsize.standard", "IEC"), bytes=getOption("hsize.bytes", "B"), ...) { standard <- match.arg(standard, choices=c("IEC", "JEDEC", "SI")) .stop_if_not(is.character(units), length(units) == 1L) .stop_if_not(is.numeric(digits), length(digits) == 1L) .stop_if_not(is.character(bytes), length(bytes) == 1L) nsizes <- length(sizes) kunits <- list( IEC = c(bytes=0, B=0, KiB=1, MiB=2, GiB=3, TiB=4, PiB=5, EiB=6, ZiB=7, YiB=8), JEDEC = c(bytes=0, B=0, KB=1, MB=2, GB=3), SI = c(bytes=0, B=0, kB=1, MB=2, GB=3, TB=4, PB=5, EB=6, ZB=7, YB=8) ) ## Infer standard from unit? if (units != "auto") { idx <- which(sapply(kunits, FUN=function(x) any(units == names(x)))) if (length(idx) == 0L) { stop(sprintf("Unknown units: %s", sQuote(units))) } standard <- names(idx[1]) } kunits <- kunits[[standard]] base <- switch(standard, IEC=1024, JEDEC=1024, SI=1000) if (units == "auto") { ## Keep the "bytes" alternative specified excl <- setdiff(c("bytes", "B"), bytes) kunits <- kunits[-which(names(kunits) == excl)] exps <- log(sizes, base=base) exps <- floor(exps) exps[exps < 0] <- 0 maxexp <- max(kunits) exps[exps > maxexp] <- maxexp units <- names(kunits)[exps+1L] positions <- rep(digits, length.out=nsizes) positions[exps == 0] <- 0L } else { exps <- kunits[units] if (is.na(exps)) { stop(sprintf("Unknown units for standard %s: %s", sQuote(standard), sQuote(units))) } units <- rep(units, times=nsizes) } ## Use '1 byte' (not '1 bytes') ones <- which(sizes == 1) if (length(ones) > 0) units[ones] <- gsub("s$", "", units[ones]) sizes <- round(sizes / base^exps, digits=digits) positions <- rep(digits, length.out=nsizes) positions[exps == 0] <- 0L sprintf("%.*f %s", positions, sizes, units) }) setMethodS3("hsize", "object_size", function(sizes, ...) { hsize(as.numeric(sizes), ...) }) ���������������������������������������������������������������������������������������������������������������������R.utils/R/unwrap.array.R����������������������������������������������������������������������������0000644�0001762�0000144�00000011705�14372747611�014607� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @set "class=array" # @RdocMethod unwrap # @alias unwrap.matrix # @alias unwrap.data.frame # @alias unwrap.default # # @title "Unwrap an array, matrix or a vector to an array of more dimensions" # # \description{ # @get "title". This is done by splitting up each dimension into several # dimension based on the names of that dimension. # } # # @synopsis # # \arguments{ # \item{x}{An @array or a @matrix.} # \item{split}{A @list or a @character @vector. # If a @list, it should contain @functions that takes a @character # @vector as the first argument and optional \code{...} arguments. # Each function should split the @vector into a @list of same length # and where all elements contains the same number of parts. # If a @character @vector, each element \code{split[i]} is replaced by # a @function call # \code{function(names, ...) strsplit(names, split=split[i])}. # } # \item{drop}{If @TRUE, dimensions of of length one are dropped, otherwise not.} # \item{...}{Arguments passed to the \code{split} @functions.} # } # # \value{ # Returns an @array. # } # # \details{ # Although not tested thoroughly, \code{unwrap()} should be the inverse # of \code{wrap()} such that \code{identical(unwrap(wrap(x)), x)} holds. # } # # \examples{\dontrun{See ?wrap.array for an example}} # # @author # # \seealso{ # @seemethod "wrap". # } # # @keyword programming #*/########################################################################### setMethodS3("unwrap", "array", function(x, split=rep("[.]", length(dim(x))), drop=FALSE, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'x': if (!is.array(x) && !is.matrix(x)) throw("Argument 'x' is not an array or a matrix: ", class(x)[1]) dim <- dim(x) ndims <- length(dim) # Argument 'split': if (is.character(split)) { split <- unlist(lapply(split, FUN=function(s) { Arguments$getRegularExpression(s) })) # Create split functions split <- lapply(split, FUN=function(s) { function(names, ...) strsplit(names, split=s, ...) }) } else if (is.list(split)) { if (length(split) != ndims) { throw("Length of argument 'split' (a list) does not match the number of dimensions of argument 'x': ", length(split), " != ", ndims) } for (fcn in split) { if (!is.function(fcn) && !is.null(fcn)) throw("Argument 'split' is a list, but does not contain functions.") } } else { throw("Argument 'split' is not an array: ", class(split)[1]) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Get the new dimension names # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - dimnames <- dimnames(x) dimnames2 <- list() for (kk in 1:ndims) { fcn <- split[[kk]] dnames <- dimnames[[kk]] if (is.null(dnames)) throw("Can not unwrap arrays with missing dimension names: dimension #", kk) if (is.function(fcn)) { snames <- fcn(dnames, ...) } else if (is.null(fcn)) { snames <- dnames } if (is.character(snames) && is.vector(snames)) { snames <- matrix(snames, ncol=1) ulen <- ncol(snames) } else if (is.matrix(snames)) { ulen <- ncol(snames) } else if (is.list(snames)) { len <- unlist(lapply(snames, FUN=length)) ulen <- unique(len) if (length(ulen) != 1) { throw("Failed to split names for dimension ", kk, ", because it resulted in unequal number of parts: ", snames) } snames <- unlist(snames) snames <- matrix(snames, nrow=length(snames), ncol=ulen, byrow=TRUE) } else { throw("Failed to split names for dimension ", kk, ", because split function returned an unsupported data type: ", class(snames)[1]) } dnames <- list() for (ll in 1:ulen) dnames[[ll]] <- unique(snames[,ll]) dimnames2 <- c(dimnames2, dnames) } dim2 <- unlist(lapply(dimnames2, FUN=length)) # Drop dimensions of length one? if (drop) { keep <- (dim2 > 1) dim2 <- dim2[keep] dimnames2 <- dimnames2[keep] } # Now, reshape the array dim(x) <- dim2 dimnames(x) <- dimnames2 x }) setMethodS3("unwrap", "matrix", function(x, ...) { unwrap.array(x, ...) }) setMethodS3("unwrap", "data.frame", function(x, ...) { ncol <- ncol(x) x <- as.matrix(x) # Special case if (ncol == 1L) { names <- rownames(x) x <- x[,1L] dim(x) <- length(x) dimnames(x) <- list(names) } unwrap(x, ...) }) setMethodS3("unwrap", "default", function(x, ...) { if (is.vector(x) && !is.list(x)) { dim <- c(length(x), 1) dimnames <- list(names(x), "dummy") dim(x) <- dim dimnames(x) <- dimnames # Not needed anymore dim <- dimnames <- NULL unwrap(x, ...) } else { throw("Do not know how to unwrap object: ", class(x)[1]) } }) �����������������������������������������������������������R.utils/R/withRepos.R�������������������������������������������������������������������������������0000644�0001762�0000144�00000004175�14525546077�014150� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocFunction withRepos # # @title "Evaluate an R expression with repositories set temporarily" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{expr}{The R expression to be evaluated.} # \item{repos}{A @character @vector of repositories to use.} # \item{...}{Additional arguments passed to @see "useRepos".} # \item{substitute}{If @TRUE, argument \code{expr} is # \code{\link[base]{substitute}()}:ed, otherwise not.} # \item{envir}{The @environment in which the expression should be evaluated.} # } # # \value{ # Returns the results of the expression evaluated. # } # # @author # # \examples{\dontrun{ # # Install from BioC related repositories only # withRepos(install.packages("edgeR"), repos="[[BioC]]") # # # Install from CRAN or BioC related repositories only # withRepos(install.packages("edgeR"), repos=c("CRAN", "[[BioC]]")) # # # Install from mainstream repositories only (same as previous) # withRepos(install.packages("edgeR"), repos="[[mainstream]]") # # # Install from R-Forge and mainstream repositories only # withRepos(install.packages("R.utils"), repos="[[R-Forge]]") # # # Update only CRAN packages # withRepos(update.packages(ask=FALSE), repos="[[CRAN]]") # # # Update only Bioconductor packages # withRepos(update.packages(ask=FALSE), repos="[[BioC]]") # }} # # \seealso{ # Internally, @see "base::eval" is used to evaluate the expression. # See also @see "base::options" and @see "utils::install.packages". # } # # @keyword IO # @keyword programming #*/########################################################################### withRepos <- function(expr, repos="[[mainstream]]", ..., substitute=TRUE, envir=parent.frame()) { # Argument 'expr': if (substitute) expr <- substitute(expr) # Argument 'envir': if (!is.environment(envir)) throw("Argument 'envir' is not a list: ", class(envir)[1L]) # Parse and set repositories temporarily prev <- useRepos(repos, ...) on.exit(useRepos(prev)) # Evaluate expression eval(expr, envir = envir, enclos = baseenv()) } # withOptions() ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/sourceTo.R��������������������������������������������������������������������������������0000644�0001762�0000144�00000012322�14525546077�013760� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault sourceTo # # @title "Parses and evaluates code from a file or a connection" # # @synopsis # # \description{ # @get "title". # This has the same effect as if \code{source(..., local=TRUE)} would have # been called from within the given environment. # This is useful when setting up a new local working environment. # } # # \arguments{ # \item{file}{A @connection or a @character string giving the pathname # of the file or URL to read from.} # \item{path}{An optional @character string giving the path to the file. # Ignored if \code{file} is a connection.} # \item{chdir}{If @TRUE and \code{file} is a pathname, the \R # working directory is temporarily changed to the directory # containing \code{file} for evaluating.} # \item{...}{Arguments to @see "base::source". If argument \code{file} is # not explicitly given, the first argument is assumed to be the # \code{file} argument. This argument is converted into a string by # \code{as.character()}. # } # \item{local}{If @FALSE, evaluation is done in the global environment, # otherwise in the calling environment.} # \item{envir}{An @environment in which @see "base::source" should be # called. If @NULL, the global environment is used.} # \item{modifiedOnly}{If @TRUE, the file is sourced only if modified # since the last time it was sourced, otherwise regardless.} # } # # \value{ # Return the result of @see "base::source". # } # # \section{Hooks}{ # This methods recognizes the hook \code{sourceTo/onPreprocess}, which # is called after the lines in file has been read, but before they have # been parsed by the \R parser, cf. @see "base::parse". # An \code{onPreprocess} hook function should take a @character @vector # of code lines and return a @character @vector of code lines. # This can for instance be used to pre-process R source code with special # directives such as @see "VComments". # # Note that only one hook function can be used for this function, otherwise # an error is generated. # } # # @examples "../incl/sourceTo.Rex" # # @author # # \seealso{ # @see "sourceDirectory". # @see "base::sys.source" and @see "base::source". # } # # @keyword programming # @keyword IO #*/########################################################################### setMethodS3("sourceTo", "default", function(file, path=NULL, chdir=FALSE, ..., local=TRUE, envir=parent.frame(), modifiedOnly=FALSE) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - lastSourced <- getOption("R.utils::sourceTo/lastSourced") if (is.null(lastSourced)) { lastSourced <- list() options("R.utils::sourceTo/lastSourced"=lastSourced) } if (is.character(file)) { # Argument 'path': if (!is.null(path)) { file <- file.path(path, file) } # A URL to be sourced? isUrl <- (length(grep("^(ftp|http|file)://", file)) > 0) if (!isUrl) { # Arguments 'file' & 'path': file <- Arguments$getReadablePathname(file, mustExist=TRUE) absPathname <- getAbsolutePath(file) if (modifiedOnly) { # Check if file has been modified since last time. lastSrcd <- lastSourced[[absPathname]] if (!is.null(lastSrcd) && (lastSrcd > lastModified(file))) { return(invisible(NULL)) } } lastSourced[[absPathname]] <- Sys.time() } # if (!isUrl) # Open file fh <- file(file, open="r") # Change R working directory temporarily? if (chdir && !isUrl) { path <- dirname(file) if (path != ".") { owd <- getwd() on.exit(setwd(owd), add=TRUE) setwd(path) } } } else { fh <- file if (!isOpen(fh, rw="read")) open(fh, open="r") } # Close opened connections on exit on.exit({ if (!is.null(fh)) { close(fh) fh <- NULL } }, add=TRUE) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # "main" # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Read all lines from the connection lines <- readLines(con=fh, warn=FALSE) hooks <- getHook("sourceTo/onPreprocess") if (length(hooks) > 0) { if (length(hooks) > 1) throw("Only one hook can be set for this function: sourceTo/onPreprocess") res <- callHooks("sourceTo/onPreprocess", lines=lines)[[1]] if (!is.null(res$result)) lines <- res$result } if (length(lines) == 0) { # Nothing more to do. return(NULL) } if (!is.null(fh)) { close(fh) fh <- NULL fh <- textConnection(lines, open="r") } # Wrap up the arguments to source args <- list(file=fh, ...) # Override any 'local' argument args$local <- local # Create a call expression to source(file=fh, ..., local=local) expr <- substitute({ do.call(source, args) }, list(args=args)) # Call source() res <- eval(expr, envir=envir, enclos = baseenv()) # If successfully sourced, record last modification date. if (is.character(file) && !isUrl) { options("R.utils::sourceTo/lastSourced"=lastSourced) } invisible(res) }) # sourceTo() ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/readWindowsShortcut.R���������������������������������������������������������������������0000644�0001762�0000144�00000053747�14372747611�016214� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault readWindowsShortcut # # @title "Reads a Microsoft Windows Shortcut (.lnk file)" # # @synopsis # # \description{ # @get "title". # } # # \arguments{ # \item{con}{A @connection or a @character string (filename).} # \item{verbose}{If @TRUE, extra information is written while reading.} # \item{...}{Not used.} # } # # \value{ # Returns a @list structure. # } # # @examples "../incl/readWindowsShortcut.Rex" # # \details{ # The MIME type for a Windows Shortcut file is # \code{application/x-ms-shortcut}. # } # # @author # # \seealso{ # @see "createWindowsShortcut" and # \code{\link{filePath}()} # } # # \references{ # [1] Wotsit's Format, \url{http://www.wotsit.org/}, 2005.\cr # [2] Hager J, \emph{The Windows Shortcut File Format} # (as reverse-engineered by), version 1.0.\cr # [3] Microsoft Developer Network, \emph{IShellLink Interface}, 2018. # \url{https://learn.microsoft.com/en-us/windows/win32/api/shobjidl_core/nn-shobjidl_core-ishelllinka} \cr # [4] Andrews D, \emph{Parsing Windows Shortcuts (lnk) files in java}, # comp.lang.java.help, Aug 1999. # \url{https://groups.google.com/d/topic/comp.lang.java.help/ouFHsH1UgKI} \cr # [5] Multiple authors, \emph{Windows shell links} (in Tcl), Tcler's Wiki, # April 2008. \url{https://wiki.tcl-lang.org/1844} \cr # [6] Daniel S. Bensen, \emph{Shortcut File Format (.lnk)}, Stdlib.com, # April 24, 2009. \cr # \url{https://web.archive.org/web/20110817051855/http://www.stdlib.com/art6-Shortcut-File-Format-lnk.html} (was http://www.stdlib.com/art6-Shortcut-File-Format-lnk.html)\cr # [7] [MS-SHLLINK]: Shell Link (.LNK) Binary File Format, Microsoft Inc., # September 25, 2009. \cr # } # # @keyword file # @keyword IO #*/########################################################################### # MORE REFERENCES: # An Unofficial Guide to the URL File Format, \url{http://www.cyanwerks.com/file-format-url.html} (contains info about Hotkeys) # xxmklink - create a shortcut, http://www.xxcopy.com/xxcopy38.htm # FILExt, \url{https://filext.com/file-extension/LNK}, 2005. setMethodS3("readWindowsShortcut", "default", function(con, verbose=FALSE, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Local functions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # dword - An 4-byte unsigned integer readByte <- function(con, n=1) { readBin(con=con, what=integer(), size=1, n=n, signed=FALSE, endian="little") } # word - A 2-byte unsigned integer readWord <- function(con, n=1) { readBin(con=con, what=integer(), size=2, n=n, signed=FALSE, endian="little") } # qword - A 4-byte unsigned integer (actually as signed integer) readDWord <- function(con, n=1) { readBin(con=con, what=integer(), size=4, n=n, signed=TRUE, endian="little") } # qword - An 8-byte unsigned integer (actually as signed integer) readQWord <- function(con, n=1) { readBin(con=con, what=integer(), size=8, n=n, signed=TRUE, endian="little") } readString <- function(con, nchars=-1, unicoded=FALSE) { if (nchars == -1) { bfr <- c() while ((byte <- readByte(con)) != 0) { bfr <- c(bfr, byte) } } else { if (unicoded) nchars <- 2*nchars bfr <- readByte(con, n=nchars) } # Since R does not support Unicoded strings, we (incorrectly) assume # (=hope) that it is only the unicode characters 0:255 that are used. if (unicoded) bfr <- bfr[bfr != 0] paste(intToChar(bfr), collapse="") } # readString() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'con': if (is.character(con)) { con <- file(con, open="") } if (inherits(con, "connection")) { if (!isOpen(con)) { open(con, open="rb") on.exit({ if (inherits(con, "connection") && isOpen(con)) close(con) }) } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # File header # Shell item ID list # Item 1 # Item 2 # etc.. # File locator info # Local path # Network path # Description string # Relative path string # Working directory string # Command line string # Icon filename string # Extra stuff # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # File header # # Offset Size/Type Contents # ------------------------- # 0h 1 dword Always 0000004Ch 'L' # 4h 16 bytes GUID of shortcut files # 14h 1 dword Flags # 18h 1 dword File attributes # 1Ch 1 qword Time 1 # 24h 1 qword Time 2 # 2Ch 1 qword Time 3 # 34h 1 dword File length # 38h 1 dword Icon number # 3Ch 1 dword ShowWnd value # 40h 1 dword Hot key # 44h 2 dwords Unknown, always zero # # The first 4 bytes of the file form a long integer that is always set # to 4Ch this it the ASCII value for the uppercase letter L. This is used # to identify a valid shell link file. # # Identifying Characters (in hex): # [ magic ] [ GUID ] # 4C 00 00 00 01 14 02 00 00 00 00 00 C0 00 00 00 00 00 00 46 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - header <- list( magic = readDWord(con), guid = readByte(con, n=16), flags = readDWord(con), fileAttributes = readDWord(con), creationTime = readQWord(con), modificationTime = readQWord(con), lastAccessTime = readQWord(con), fileLength = readDWord(con), iconNumber = readDWord(con), showWndValue = readDWord(con), hotKey = readDWord(con), unknown = readDWord(con, n=2) ) if (verbose) { message("File header read:") message(paste(capture.output(header), collapse="\n")) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Assert and parse header # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (header$magic != 76) { stop("File format error: Magic dword in header is not 0000004C (76): ", header$magic) } knownGuid <- c(1,20,2,0,0,0,0,0,192,0,0,0,0,0,0,70) if (!all.equal(header$guid, knownGuid)) { stop("File format error: Unknown GUID: ", paste(header$guid, collapse=",")) } flags <- intToBin(header$flags) flags <- rev(strsplit(flags, split="")[[1]]) flags <- as.integer(flags) flags <- as.logical(flags) knownFlagNames <- c("hasShellItemIdList", "pointsToFileOrDirectory", "hasDescription", "hasRelativePath", "hasWorkingDirectory", "hasCommandLineArguments", "hasCustomIcon", "unicodedStrings") if (length(flags) <= length(knownFlagNames)) { flags <- c(flags, rep(FALSE, length.out=length(knownFlagNames)-length(flags))) names(flags) <- knownFlagNames } else { extraFlags <- sprintf("unknown%d", 1:(length(flags)-length(knownFlagNames))) names(flags) <- c(knownFlagNames, extraFlags) if (!is.element(length(extraFlags), c(0,2))) { warning("Detected a possibly unsupported file format: There are unknown 'flags' in the Windows Shortcut link file: ", paste(paste(names(flags), flags, sep="="), collapse=", ")) } } header$flags <- flags if (header$flags["pointsToFileOrDirectory"]) { fileAttributes <- intToBin(header$fileAttributes) fileAttributes <- rev(strsplit(fileAttributes, split="")[[1]]) fileAttributes <- as.logical(as.integer(fileAttributes)) if (length(fileAttributes) > 13) stop("File format error: Too many bits in flags in header: ", length(fileAttributes)) fileAttributes <- c(fileAttributes, rep(FALSE, length.out=13-length(fileAttributes))) names(fileAttributes) <- c("isReadOnly", "isHidden", "isSystemFile", "isVolumeLabel", "isDirectory", "isModifiedSinceLastBackup", "isEncrypted", "isNormal", "isTemporary", "isSparseFile", "hasReparsePointData", "isCompressed", "isOffline") header$fileAttributes <- fileAttributes } else { # "If the target is not a file (see flags bit 1), then this is set # to zero." if (!all(header$fileAttributes == 0)) { stop("File format error: When shortcut is not pointing to a file or a directory all file attributes should be zero.") } header$fileAttributes <- NA } if (header$fileLength < 0) { stop("File format error: File length is negative: ", header$fileLength) } if (header$flags["hasCustomIcon"]) { } else { if (header$iconNumber != 0) stop("File format error: Expected zero icon number: ", header$iconNumber) } swNames <- c("SW_HIDE", "SW_NORMAL", "SW_SHOWMINIMIZED", "SW_SHOWMAXIMIZED", "SW_SHOWNOACTIVATE", "SW_SHOW", "SW_MINIMIZE", "SW_SHOWMINNOACTIVE", "SW_SHOWNA", "SW_RESTORE", "SW_SHOWDEFAULT") if (header$showWndValue %in% 0:10) { names(header$showWndValue) <- swNames[header$showWndValue+1] } else { stop("File format error: showWndValue in header is out of range [0:10]: ", header$showWndValue) } if (!all(header$unknown == 0)) { stop("File format error: Last 2 dwords in header are not zero: ", header$unknown, sep="") } lnk <- list(header=header) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # The Shell Item Id List # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (header$flags["hasShellItemIdList"]) { bytesToRead <- readWord(con) if (verbose) { message("bytesToRead=", bytesToRead) } dummy <- readByte(con, n=bytesToRead) bytesToRead <- 0 while(bytesToRead > 0) { itemLength <- readWord(con) if (verbose) { message("itemLength=", itemLength) } bytesToRead <- bytesToRead-2 item <- readByte(con, n=itemLength-2) print(paste(intToChar(item), collapse="")) str(item) bytesToRead <- bytesToRead-itemLength } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # File Location Info # # Offset Size Contents # 0h 1 dword This is the total length of this structure and all # following data # 4h 1 dword This is a pointer to first offset after this # structure. 1Ch # 8h 1 dword Flags # Ch 1 dword Offset of local volume info # 10h 1 dword Offset of base pathname on local system # 14h 1 dword Offset of network volume info # 18h 1 dword Offset of remaining pathname # # Notes: The first length value includes all the assorted pathnames and # other data structures. All offsets are relative to the start of this # structure. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (header$flags["pointsToFileOrDirectory"]) { fileLocationInfo <- list( length = readDWord(con), firstOffset = readDWord(con), flags = readDWord(con), offsetLocalVolumeInfo = readDWord(con), offsetBasePathname = readDWord(con), offsetNetworkVolumeInfo = readDWord(con), offsetRemainingPathname = readDWord(con), .offset = 7*4 # Current read position ) # Set current offset if (fileLocationInfo$flags %in% 0:3) { } else { stop("File format error: Unknown volume flag: ", fileLocationInfo$flags) } flags <- intToBin(fileLocationInfo$flags) flags <- rev(strsplit(flags, split="")[[1]]) flags <- as.logical(as.integer(flags)) flags <- c(flags, rep(FALSE, length.out=2-length(flags))) names(flags) <- c("availableOnLocalVolume", "availableOnNetworkShare") fileLocationInfo$flags <- flags if (fileLocationInfo$flags["availableOnLocalVolume"] != TRUE) { "Random garbage when bit 0 is clear in volume flags" [1] # fileLocationInfo$offsetLocalVolumeInfo <- NA # fileLocationInfo$offsetBasePathname <- NA } if (fileLocationInfo$flags["availableOnNetworkShare"] != TRUE) { "Random garbage when bit 1 is clear in volume flags" [1] # fileLocationInfo$offsetNetworkVolumeInfo <- NA } if (fileLocationInfo$firstOffset != fileLocationInfo$.offset) { warning("File format warning: First offset in File Location Info is not 0x1C (28): ", fileLocationInfo$firstOffset) # Skip to first offset skip <- fileLocationInfo$firstOffset-fileLocationInfo$.offset readBin(con, what=integer(), size=1, n=skip) fileLocationInfo$.offset <- fileLocationInfo$.offset + skip } if (verbose) { message("File location info:") message(paste(capture.output(fileLocationInfo), collapse="\n")) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # The local volume table # # Offset Size Contents # 0h 1 dword Length of this structure. # 4h 1 dword Type of volume # 8h 1 dword Volume serial number # Ch 1 dword Offset of the volume name (Always 10h) # 10h ASCIZ Volume label # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (fileLocationInfo$flags["availableOnLocalVolume"]) { if (verbose) { message("availableOnLocalVolume...") } # Skip to local volume table skip <- fileLocationInfo$offsetLocalVolumeInfo-fileLocationInfo$.offset readBin(con, what=integer(), size=1, n=skip) fileLocationInfo$.offset <- fileLocationInfo$.offset + skip table <- list( length = readDWord(con), typeOfVolume = readDWord(con), volumeSerialNumber = readDWord(con), offsetName = readDWord(con), volumeLabel = "", # To be read .offset = 4*4 ) if (table$typeOfVolume %in% 0:6) { names(table$typeOfVolume) <- c("Unknown", "No root directory", "Removable", "Fixed", "Remote", "CD-ROM", "Ram drive")[table$typeOfVolume+1] } else { stop("File format error: Unknown type of volume: ", table$typeOfVolume) } if (table$offsetName != table$.offset) { warning("File format warning: Offset to volume name in Local Volume Table is not 0x10 (16): ", table$offsetName) # Skip to volume label skip <- table$offsetName-table$.offset readBin(con, what=integer(), size=1, n=skip) table$.offset <- table$.offset + skip } table$volumeLabel <- readString(con) table$.offset <- table$.offset + nchar(table$volumeLabel, type="chars") + 1 if (table$.offset != table$length) { stop("File format error: Length of structure did not match the number of bytes read.") } # Update the offset for file location info fileLocationInfo$.offset <- fileLocationInfo$.offset + table$.offset # Remove obsolete information table$length <- NULL table$offsetName <- NULL table$.offset <- NULL fileLocationInfo$localVolumeTable <- table if (verbose) { message("File location info / Local Volume Table:") message(paste(capture.output(fileLocationInfo$localVolumeTable), collapse="\n")) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # The base pathname on local system # # "To find the filename of the file on the local volume, combine the # base path string and the final path string." [1] # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Skip to base pathname skip <- fileLocationInfo$offsetBasePathname-fileLocationInfo$.offset readBin(con, what=integer(), size=1, n=skip) fileLocationInfo$.offset <- fileLocationInfo$.offset + skip fileLocationInfo$basePathname <- readString(con) fileLocationInfo$.offset <- fileLocationInfo$.offset + nchar(fileLocationInfo$basePathname, type="chars") + 1 if (verbose) { message("basePathname='", fileLocationInfo$basePathname, "'") message("availableOnLocalVolume...done") } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # The network volume table # # Offset Size Contents # 0h 1 dword Length of this structure # 4h 1 dword Unknown, always 2h? # 8h 1 dword Offset of network share name (Always 14h) # Ch 1 dword Unknown, always zero? # 10h 1 dword Unknown, always 20000h? # 14h ASCIZ Network share name # # Note 1: The above unknown values are the same for a printer or file # share. # Note 2: The above values are for Microsoft Networks, I don't have a # NetWare server to test. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (fileLocationInfo$flags["availableOnNetworkShare"]) { if (verbose) { message("availableOnNetworkShare...") } # Skip to local volume table skip <- fileLocationInfo$offsetNetworkVolumeInfo-fileLocationInfo$.offset readBin(con, what=integer(), size=1, n=skip) fileLocationInfo$.offset <- fileLocationInfo$.offset + skip table <- list( length = readDWord(con), unknown1 = readDWord(con), offsetName = readDWord(con), unknown2 = readDWord(con), unknown3 = readDWord(con), networkShareName = "", # To be read .offset = 5*4 ) if (table$offsetName != table$.offset) { warning("File format warning: Offset to network share name in Network Volume Table is not 0x14 (20): ", table$offsetName) # Skip to volume label readBin(con, what=integer(), size=1, n=table$offsetName-table$.offset) } table$networkShareName <- readString(con) table$.offset <- table$.offset + nchar(table$networkShareName, type="chars") + 1 if (verbose) { message("File location info / Network Volume Table:") message(paste(capture.output(table), collapse="\n")) } # if (table$.offset != table$length) { if (table$.offset != table$unknown2) { warning("File format warning: Length of table structure did not match the number of bytes read: ", table$.offset, " != ", table$unknown2) } # Update the offset for file location info fileLocationInfo$.offset <- fileLocationInfo$.offset + table$.offset # Remove obsolete information table$length <- NULL table$offsetName <- NULL table$unknown1 <- table$unknown2 <- table$unknown3 <- NULL table$.offset <- NULL fileLocationInfo$networkVolumeTable <- table if (verbose) { message("File location info / Network Volume Table:") message(paste(capture.output(fileLocationInfo$networkVolumeTable), collapse="\n")) message("availableOnNetworkShare...done") } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # The remaining pathname on network system # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Skip to remaining pathname skip <- fileLocationInfo$offsetRemainingPathname-fileLocationInfo$.offset readBin(con, what=integer(), size=1, n=skip) fileLocationInfo$.offset <- fileLocationInfo$.offset + skip fileLocationInfo$remainingPathname <- readString(con) fileLocationInfo$.offset <- fileLocationInfo$.offset + nchar(fileLocationInfo$remainingPathname, type="chars") + 1 if (fileLocationInfo$length != fileLocationInfo$.offset) { stop("File format error: Expected to read ", fileLocationInfo$length, " bytes in File Location Info structure, but read ", fileLocationInfo$.offset) } # Remove obsolete information fileLocationInfo$length <- NULL fileLocationInfo$firstOffset <- NULL fileLocationInfo$offsetBasePathname <- NULL fileLocationInfo$offsetLocalVolumeInfo <- NULL fileLocationInfo$offsetNetworkVolumeInfo <- NULL fileLocationInfo$offsetRemainingPathname <- NULL fileLocationInfo$.offset <- NULL lnk$fileLocationInfo <- fileLocationInfo } else { lnk$fileLocationInfo <- NA } # if (header$flags["pointsToFileOrDirectory"]) unicoded <- header$flags["unicodedStrings"] if (header$flags["hasDescription"]) { nchars <- readWord(con) lnk$description <- readString(con, nchars=nchars, unicoded=unicoded) } if (header$flags["hasRelativePath"]) { nchars <- readWord(con) lnk$relativePath <- readString(con, nchars=nchars, unicoded=unicoded) } if (header$flags["hasWorkingDirectory"]) { nchars <- readWord(con) lnk$workingDirectory <- readString(con, nchars=nchars, unicoded=unicoded) } if (header$flags["hasCommandLineArguments"]) { nchars <- readWord(con) lnk$commandLineArguments <- readString(con, nchars=nchars, unicoded=unicoded) } if (header$flags["hasCustomIcon"]) { nbytes <- readWord(con) lnk$iconFilename <- readString(con, nchars=nchars, unicoded=unicoded) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # For convenience # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - value <- lnk$relativePath if (!is.null(value)) { lnk$relativePathname <- value } if (header$flags["pointsToFileOrDirectory"]) { if (lnk$fileLocationInfo$flags["availableOnLocalVolume"]) { lnk$pathname <- paste(lnk$fileLocationInfo$basePathname, lnk$fileLocationInfo$remainingPathname, sep="") } if (lnk$fileLocationInfo$flags["availableOnNetworkShare"]) { lnk$networkPathname <- paste(lnk$fileLocationInfo$networkVolumeTable$networkShareName, "\\", lnk$fileLocationInfo$remainingPathname, sep="") } } # if (header$flags["pointsToFileOrDirectory"]) lnk }) # readWindowsShortcut() �������������������������R.utils/R/readBinFragments.R������������������������������������������������������������������������0000644�0001762�0000144�00000013256�14372747611�015374� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������########################################################################/** # @RdocDefault readBinFragments # # @title "Reads binary data from disjoint sections of a connection or a file" # # @synopsis # # \description{ # @get "title". # } # # \arguments{ # \item{con}{A @connection or the pathname of an existing file.} # \item{what}{A @character string or an object specifying the the # data type (@see "base::mode") to be read.} # \item{idxs}{A @vector of (non-duplicated) indices or a Nx2 @matrix # of N from-to index intervals specifying the elements to be read. # Positions are either relative to the start or the current location # of the file/connection as given by argument \code{origin}.} # \item{origin}{A @character string specify whether the indices # in argument \code{idxs} are relative to the \code{"start"} or # the \code{"current"} position of the file/connection.} # \item{size}{The size of the data type to be read. If @NA, the natural # size of the data type is used.} # \item{...}{Additional arguments passed to @see "base::readBin".} # \item{verbose}{A @logical or a @see "Verbose" object.} # } # # \value{ # Returns a @vector of the requested @see "base::mode". # } # # @examples "../incl/readBinFragments.Rex" # # @author # # \seealso{ # @see "writeBinFragments". # } # # @keyword IO #*/######################################################################### setMethodS3("readBinFragments", "default", function(con, what, idxs=1, origin=c("current", "start"), size=NA, ..., verbose=FALSE) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'con': if (is.character(con)) { pathname <- con pathname <- Arguments$getReadablePathname(pathname) con <- file(pathname, open="rb") on.exit({ if (!is.null(con)) { close(con) con <- NULL } }) } else if (inherits(con, "connection")) { if (!isSeekable(con)) { t <- summary(con) t <- paste(sprintf("%s: %s", names(t), t), collapse=", ") msg <- sprintf("Argument 'con' is not a seekable connection: %s", t) action <- getOption("R.utils::onNonSeekable", "error") if (action == "warning") { warning(msg) } else { throw(msg) } } } # Argument 'what': if (!is.character(what) || length(what) != 1 || !(what %in% c("numeric", "double", "integer", "int", "logical", "complex", "character", "raw"))) { what <- typeof(what) } # Argument 'idxs': if (is.matrix(idxs) || is.data.frame(idxs)) { if (ncol(idxs) != 2) { throw("When argument 'idxs' is a data frame, it must have exactly two columns: ", ncol(idxs)) } idxs <- as.matrix(idxs) } if (!is.numeric(idxs)) { throw("Argument 'idxs' must be numeric: ", class(idxs)[1]) } if (any(idxs < 0)) { throw("Argument 'idxs' contains negative indices: ", paste(head(idxs[idxs < 0]), collapse=", ")) } # Argument 'origin': origin <- match.arg(origin) # Argument 'size': if (length(size) != 1) { throw("Argument 'size' must be a single value: ", length(size)) } if (is.na(size)) { # Calculating the natural size size <- as.integer(object.size(vector(mode=what, length=1e4))/1e4) } else if (!is.numeric(size)) { throw("Argument 'size' must be numeric or NA: ", class(size)[1]) } # Argument 'verbose': verbose <- Arguments$getVerbose(verbose) if (verbose) { pushState(verbose) on.exit(popState(verbose), add=TRUE) } # Intervals to index sequence? if (is.matrix(idxs)) { idxs <- intervalsToSeq(idxs) } idxs <- as.double(idxs) # Allocate return vector nAll <- length(idxs) # Order the indices o <- order(idxs) idxs <- idxs[o] # Read from the start of the connect? if (origin == "start") { seek(con=con, where=0, origin="start", rw="read") } ## The below is not working (at least on Windows), because it may induce ## negative 'where':s in seek() which doesn't seem to work. /HB 2010-11-07 ## # Starting positions (double in order to address larger vectors!) ## offset <- seek(con=con, origin="start", rw="read"); # Get current file offset ## if (offset > 0) { ## idxs <- idxs - offset ## } # Allocate return vector res <- vector(mode=what, length=nAll) CHUNK.SIZE <- floor(1024e3/size) destOffset <- srcOffset <- as.integer(0) while(length(idxs) > 0) { # Skip to first element to be read if (idxs[1] != 0) { skip <- idxs[1]-1 verbose && cat(verbose, "Number of elements skipped: ", skip) seek(con=con, where=skip*size, origin="current", rw="read") idxs <- idxs - skip } verbose && cat(verbose, "Remaining indices (relative to current position):") verbose && str(verbose, idxs) # Read data bfr <- readBin(con=con, what=what, n=CHUNK.SIZE, size=size, ...) n <- length(bfr) if (n == 0) break # The file offset of the next element to be read srcOffset <- n verbose && cat(verbose, "Data read:") verbose && str(verbose, bfr) # Keep only the indices requested keep <- match(idxs, 1:n) keep <- keep[is.finite(keep)] bfr <- bfr[keep] # Not needed anymore keep <- NULL # Store the results n <- length(bfr) idx <- 1:n res[destOffset+idx] <- bfr destOffset <- destOffset + n # Not needed anymore bfr <- NULL # Next chunk of elements idxs <- idxs[-idx] idxs <- idxs - srcOffset # Not needed anymore idx <- NULL } # while (length(idxs) > 0) if (!is.null(o)) { # order(o) can be optimized, cf. affxparser::invertMap(). /HB 2007-08-22 res <- res[order(o)] } res }) # readBinFragments() ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/isEof.connection.R������������������������������������������������������������������������0000644�0001762�0000144�00000002056�14372747611�015360� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @set "class=connection" # @RdocMethod isEof # # @title "Checks if the current file position for a connection is at the 'End of File'" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{con}{A @connection.} # \item{...}{Not used.} # } # # \value{ # Returns a @logical. # } # # \details{ # Internally @see base::seek is used, which according to to the \R help # is discouraged on Windows. However, after many years of large-scale # testing on various Windows versions and file systems we have yet to # experience issues with using \code{seek()} on Windows. # } # # @author # # \seealso{ # @seeclass # } #*/########################################################################### setMethodS3("isEof", "connection", function(con, ...) { # Remember position offset <- seek(con, rw="read") # Try to read next byte bfr <- readChar(con, nchars=1) # Reposition seek(con, where=offset, rw="read") # No more bytes? (nchar(bfr) == 0) }) # isEof() ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/printf.R����������������������������������������������������������������������������������0000644�0001762�0000144�00000002304�14372747611�013453� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault printf # # @title "C-style formatted output" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{fmt}{A @character vector of format strings. # See same argument for @see "base::sprintf".} # \item{...}{Additional arguments @see "base::sprintf".} # \item{sep}{A @character @vector of strings to append after each element.} # \item{file}{A @connection, or a @character of a file to print to. # See same argument for @see "base::cat".} # } # # \value{ # Returns nothing. # } # # \examples{ # cat("Hello world\n") # printf("Hello world\n") # # x <- 1.23 # cat(sprintf("x=\%.2f\n", x)) # printf("x=\%.2f\n", x) # # y <- 4.56 # cat(sprintf(c("x=\%.2f\n", "y=\%.2f\n"), c(x,y)), sep="") # printf(c("x=\%.2f\n", "y=\%.2f\n"), c(x,y)) # } # # @author # # \seealso{ # For C-style formatting of @character strings, see @see "base::sprintf". # } # # @keyword utilities #*/########################################################################### setMethodS3("printf", "default", function(fmt, ..., sep="", file="") { base::cat(base::sprintf(fmt, ...), file=file, sep=sep) }) ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/Sys.readlink2.R���������������������������������������������������������������������������0000644�0001762�0000144�00000011327�14372747611�014606� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������########################################################################/** # @RdocFunction Sys.readlink2 # # @title "Read File Symbolic Links (also on Windows)" # # \description{ # @get "title" and returns the target of each link. # This implementation is fully compatible with the # @see "base::Sys.readlink" implementation in the \pkg{base} package. # } # # @synopsis # # \arguments{ # \item{paths}{A @character @vector of file paths. # Tilde expansion is done: see @see "base::path.expand".} # \item{what}{A @character string specifying what to return.} # } # # \value{ # A @character @vector of the the same length as \code{paths}. # } # # @author # # @keyword file # @keyword IO # @keyword internal #**/####################################################################### Sys.readlink2 <- function(paths, what=c("asis", "corrected")) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Local functions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - readlink <- function(path) { if (!file.exists(path)) return(NA_character_) # Only files with zero size are candidates for symbolic file links info <- file.info(path) if (is.na(info$size) || info$size > 0) return("") # Temporarily change working directory path <- normalizePath(path, mustWork=FALSE) dir <- dirname(path) opwd <- setwd(dir) on.exit(setwd(opwd)) path <- basename(path) # List all files bfr <- shell("dir", shell=Sys.getenv("COMSPEC"), mustWork=TRUE, intern=TRUE) setwd(opwd) # Search for symbolic file or directory links pattern <- sprintf(".*[ ]+<SYMLINK(|D)>[ ]+(%s)[ ]+\\[(.+)\\][ ]*$", path) bfr <- grep(pattern, bfr, value=TRUE) # Not a symbolic link? if (length(bfr) == 0L) return("") # Sanity check link <- gsub(pattern, "\\2", bfr) .stop_if_not(identical(link, path)) # Extract the target target <- gsub(pattern, "\\3", bfr) # Relative path? if (!isAbsolutePath(target)) { # Prepend working directory target <- file.path(dir, target) # Return the relative pathname, iff possible target <- getRelativePath(target) } target } # readlink() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'return': what <- match.arg(what) # Workaround for Windows? if (.Platform$OS.type == "windows") { pathsR <- sapply(paths, FUN=readlink, USE.NAMES=FALSE) } else { pathsR <- Sys.readlink(paths) } # If target specify a filename without a path, append path if (what == "corrected") { isRel <- !is.na(pathsR) & (pathsR != "") & !sapply(pathsR, FUN=isAbsolutePath) if (any(isRel)) { dirs <- dirname(paths[isRel]) pathsR[isRel] <- file.path(dirs, pathsR[isRel]) } } pathsR } # Sys.readlink2() ########################################################################/** # @RdocFunction file.info2 # # @title "Extract File Information (acknowledging symbolic file links also on Windows)" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{A @character @vectors containing file paths. # Tilde expansion is done: see @see "base::path.expand".} # } # # \value{ # A @data.frame. See @see "base::file.info" for details. # } # # \seealso{ # Internally, @see "base::file.info" is used, which does not respect # symbolic links on Windows. Instead, on Windows, @see "Sys.readlink2" # is used for such link to identify the target file and retrieve the # file information on that instead. # } # # @author # # @keyword file # @keyword IO # @keyword internal #**/####################################################################### file.info2 <- function(...) { info <- file.info(...) # Nothing todo? if (.Platform$OS.type != "windows") { return(info) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Workaround for symbolic file links on Windows # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Only files with zero size are candidates for symbolic links idxs <- which(!is.na(info$size) & info$size == 0) # Nothing todo? if (length(idxs) == 0L) return(info) # Candidate pathnames pathnames <- rownames(info)[idxs] # Translate pathnames <- sapply(pathnames, FUN=Sys.readlink2) # Drop non-symbolic links keep <- (!is.na(pathnames) & nchar(pathnames, type="chars") > 0L) pathnames <- pathnames[keep] idxs <- idxs[keep] # Nothing todo? if (length(idxs) == 0L) return(info) # Update file info for the targets (preserving the link names) info[idxs,] <- file.info(pathnames) info } # file.info2() ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/toAsciiRegExprPattern.R�������������������������������������������������������������������0000644�0001762�0000144�00000003133�14372747611�016400� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# Parses a regular expression and replaces sets to ASCII sets. setMethodS3("toAsciiRegExprPattern", "character", function(pattern, ...) { bfr <- strsplit(pattern, split="")[[1]] bfr2 <- c() state <- "plain" while(length(bfr) > 0) { ch <- bfr[1] bfr <- bfr[-1] if (state == "plain") { if (ch == "[") { set <- c() state <- "set" } else { bfr2 <- c(bfr2, ch) } } else if (state == "set") { if (ch == "]") { # Expand set set2 <- c() ch <- NA setState <- "plain" while (length(set) > 0) { prevCh <- ch ch <- set[1] set <- set[-1] #print(list(setState=setState, ch=ch, prevCh=prevCh)) if (setState == "plain") { if (ch == "-") { if (is.na(prevCh)) { set2 <- c(set2, ch) } else { from <- prevCh setState <- "range" } } } else if (setState == "range") { to <- ch allLetters <- c(base::letters, base::LETTERS) if (all(c(from, to) %in% allLetters)) { from <- match(from, allLetters) to <- match(to, allLetters) set2 <- c(set2, allLetters[from:to]) } else { set2 <- c(set2, from, "-", to) } setState <- "plain" } } # while (length(set) > 0) bfr2 <- c(bfr2, "[", set2, "]") state <- "plain" } else { set <- c(set, ch) } } } pattern <- paste(bfr2, collapse="") pattern }) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/subplots.R��������������������������������������������������������������������������������0000644�0001762�0000144�00000005611�14372747611�014030� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#########################################################################/** # @RdocDefault subplots # # @title "Creates a grid of subplots" # # \description{ # @get "title" in the current figure. If arguments # \code{nrow} and \code{ncol} are given a \code{nrow}-by-\code{ncol} # grid of subplots are created. If only argument \code{n} is given # then a r-by-s grid is created where |r-s| <= 1, i.e. a square or almost # a square of subplots is created. If \code{n} and \code{nrow} is # given then a grid with \code{nrow} rows and at least \code{n} subplots # are created. Similar if \code{n} and \code{ncol} is given. # The argument \code{byrow} specifies if the order of the subplots # should be rowwise (\code{byrow=TRUE}) or columnwise. # } # # @synopsis # # \arguments{ # \item{n}{If given, the minimum number of subplots.} # \item{nrow}{If given, the number of rows the grid of subplots should # contain.} # \item{ncol}{If given, the number of columns the grid of subplots should # contain.} # \item{byrow}{If @TRUE, the panels are ordered row by row in the grid, # otherwise column by column.} # \item{...}{Not used.} # } # # \value{Returns the @matrix containing the order of plots.} # # @author # # \examples{ # subplots(nrow=2, ncol=3) # 2-by-3 grid of subplots # subplots(n=6, nrow=2) # 2-by-3 grid of subplots # subplots(n=5, ncol=2) # 3-by-2 grid of subplots # subplots(1) # (Reset) to a 1-by-1 grid of subplots # subplots(2) # 1-by-2 grid of subplots # subplots(3) # 2-by-2 grid of subplots # l <- subplots(8) # 3-by-3 grid of subplots # layout.show(length(l)) # } # # \seealso{ # @see "graphics::layout" and \code{layout.show}(). # } #*/######################################################################### setMethodS3("subplots", "default", function(n=1, nrow=NULL, ncol=NULL, byrow=TRUE, ...) { # If a vector was passed, then use the length of the vector for 'n' if (!missing(n) && length(n) > 1) n <- length(n) if (!is.null(nrow) && !is.null(ncol) && !missing(n)) { if (n != nrow*ncol) stop("Arguments 'nrow' and 'ncol' is incompatible with argument 'n'. Do you really want to specify all three?!") } if (missing(n)) { layout <- matrix(seq_len(nrow*ncol), nrow=nrow, ncol=ncol, byrow=byrow) } else { if (n == 1) { nrow <- ncol <- 1 } else if (!is.null(nrow)) { ncol <- ceiling(n / nrow) } else if (!is.null(ncol)) { nrow <- ceiling(n / ncol) } else { side <- sqrt(n) nrow <- floor(side) ncol <- ncol-1 ncol <- ceiling(n / nrow) if (ncol - nrow > 1) { nrow <- nrow+1 ncol <- ceiling(n / nrow) } } layout <- matrix(seq_len(nrow*ncol), nrow=nrow, ncol=ncol, byrow=byrow) } layout(layout, ...) invisible(layout) }) �����������������������������������������������������������������������������������������������������������������������R.utils/R/findFiles.R�������������������������������������������������������������������������������0000644�0001762�0000144�00000015073�14372747611�014063� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������########################################################################/** # @RdocDefault findFiles # # @title "Finds one or several files in multiple directories" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{pattern}{A regular expression file name pattern to match.} # \item{paths}{A @character @vector of paths to be searched.} # \item{recursive}{If @TRUE, subdirectories are recursively processed, # and not if @FALSE. Alternatively, the maximum recursive depth can # be specified as a non-negative @numeric, where @FALSE corresponds to # \code{0L} depth and @TRUE corresponds \code{+Inf} depth.} # \item{firstOnly}{If @TRUE, the method returns as soon as a matching # file is found, otherwise not.} # \item{allFiles}{If @FALSE, files and directories starting with # a period will be skipped, otherwise not.} # \item{...}{Arguments passed to @see "base::list.files".} # } # # \value{ # Returns a @vector of the full pathnames of the files found. # } # # \section{Search path}{ # The \code{paths} argument may also contain paths specified as # semi-colon (\code{";"}) separated paths, e.g. # \code{"/usr/;usr/bin/;.;"}. # } # # \section{Recursive searching}{ # Recursive searching of directory structure is done breath-first # in a lexicographic order. # } # # \section{Windows Shortcut links}{ # Windows Shortcut links (*.lnk) are recognized and can be used # to imitate links to directories elsewhere. # For more details, see @see "filePath". # } # # @author # # @keyword file # @keyword IO # @keyword internal #**/####################################################################### setMethodS3("findFiles", "default", function(pattern=NULL, paths=NULL, recursive=FALSE, firstOnly=TRUE, allFiles=TRUE, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Local functions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - splitPaths <- function(paths, ...) { if (length(paths) == 0) return(NULL) # If in format "path1; path2;path3", split it to multiple strings. paths <- unlist(strsplit(paths, split=";")) paths <- gsub("[ \t]*$", "", gsub("^[ \t]*", "", paths)) paths <- paths[nchar(paths, type="chars") > 0] if (length(paths) == 0) return(NULL) paths } # splitPaths() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'paths': paths <- splitPaths(paths) if (is.null(paths)) { paths <- "." } # Argument 'pattern': if (!is.null(pattern)) { pattern <- as.character(pattern) } # Argument 'recursive': depth <- Arguments$getNumeric(recursive, range=c(0,+Inf)) if (is.logical(recursive) && recursive) depth <- +Inf; ## TRUE => +Inf # Argument 'firstOnly': firstOnly <- as.logical(firstOnly) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Prepare list of paths to be scanned # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Don't search the same path twice paths <- unique(paths) # Don't search non-existing paths for (kk in seq_along(paths)) { path <- paths[kk] # Example any '~':s path <- file.path(dirname(path), basename(path)) path <- gsub("^[.][/\\]", "", path) # Follow Windows shortcut links # NB: Here 'mustExist=TRUE' means that filePath() will always return # a pathname, not that it will give an error if file does not exist. path <- filePath(path, expandLinks="any", mustExist=TRUE) # Does the path exist and is it a directory # Note, isdir is TRUE for directories, FALSE for files, # *and* NA for non-existing files, e.g. items found by # list.files() but are broken Unix links. if (!isDirectory(path)) { path <- NA } paths[kk] <- path } # Drop unknown paths if (length(paths) > 0) { paths <- paths[!is.na(paths)] } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Search for files # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - pathnames <- c() for (path in paths) { files <- list.files(path, all.files=allFiles, full.names=TRUE) # Exclude listings that are neither files nor directories files <- gsub("^[.][/\\]", "", files) files <- files[nchar(files, type="chars") > 0L] if (length(files) > 0) { excl <- (basename(files) %in% c(".", "..", "/", "\\")) files <- files[!excl] } # Nothing to do? if (length(files) == 0) { next } # Expand Windows shortcut links files0 <- files # Remember these files <- sapply(files, FUN=filePath, expandLinks="any", USE.NAMES=FALSE) # Keep only existing files and directories ok <- sapply(files, FUN=function(file) { (file.exists(path) && !is.na(file.info(file)$isdir)) }, USE.NAMES=FALSE) files <- files[ok] files0 <- files0[ok] # Nothing to do? if (length(files) == 0) { next } # First search the files, then the directories, so... # Note, isdir is TRUE for directories, FALSE for files, # *and* NA for non-existing files, e.g. items found by # list.files() but are broken Unix links. isDir <- sapply(files, FUN=function(file) { ## identical(file.info(file)$isdir, TRUE) file.info(file)$isdir }, USE.NAMES=FALSE) # In case some files are non-accessible, exclude them ok <- (!is.na(isDir)) files <- files[ok] files0 <- files0[ok] isDir <- isDir[ok] # Nothing to do? if (length(files) == 0) { next } # Directories and files in lexicographic order dirs <- files[isDir] files <- files[!isDir] files0 <- files0[!isDir] # Keep only files that match the filename pattern # of the non-expanded filename. if (!is.null(pattern)) { keep <- grep(pattern, basename(files0)) files <- files[keep] } if (length(files) > 0) { files <- sort(files) if (firstOnly) { return(files[1]) } # Store results pathnames <- c(pathnames, files) } # Search directories recursively? if (recursive) { if (length(dirs) == 0) { next } for (dir in sort(dirs)) { files <- findFiles(pattern=pattern, paths=dir, recursive=depth-1, firstOnly=firstOnly, ...) if (length(files) > 0 && firstOnly) { return(files[1]) } pathnames <- c(pathnames, files) } } } # for (path ...) pathnames }) # findFiles() ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/withLocale.R������������������������������������������������������������������������������0000644�0001762�0000144�00000004566�14525546077�014263� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocFunction withLocale # # @title "Evaluate an R expression with locale set temporarily" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{expr}{The R expression to be evaluated.} # \item{category}{A @character string specifying the category to use.} # \item{locale}{@character @vector specifying the locale to used. The # first successfully set one will be used.} # \item{...}{Not used.} # \item{substitute}{If @TRUE, argument \code{expr} is # \code{\link[base]{substitute}()}:ed, otherwise not.} # \item{envir}{The @environment in which the expression should be evaluated.} # } # # \value{ # Returns the results of the expression evaluated. # } # # @author # # @examples "../incl/withLocale.Rex" # # \seealso{ # Internally, @see "base::eval" is used to evaluate the expression. # and @see "base::Sys.setlocale" to set locale. # } # # @keyword IO # @keyword programming #*/########################################################################### withLocale <- function(expr, category, locale, ..., substitute=TRUE, envir=parent.frame()) { # Argument 'expr': if (substitute) expr <- substitute(expr) # Argument 'envir': if (!is.environment(envir)) { throw("Argument 'envir' is not a list: ", class(envir)[1L]) } # Set locale temporarily (undo afterwards) old <- Sys.getlocale(category=category) on.exit({ Sys.setlocale(category=category, locale=old) }) warns <- list() success <- FALSE for (kk in seq_along(locale)) { value <- locale[kk] # Same as before? Then nothing to be changed/set if (value == old) { warns <- list() break } # Try to set tryCatch({ Sys.setlocale(category=category, locale=value) }, warning = function(w) { warns <<- c(warns, list(w)) }) # Successful? new <- Sys.getlocale(category=category) if (new == value) { warns <- list() break } # Otherwise, try the next one } # for (kk ...) if (length(warns) > 0L) { msgs <- sapply(warns, FUN=function(w) w$message) msg <- sprintf("Failed to set locale for category %s to either of %s. Reason was: %s", sQuote(category), paste(sQuote(locale), collapse=", "), paste(sQuote(msgs), collapse=", ")) warning(msg) } eval(expr, envir = envir, enclos = baseenv()) } # withLocale() ������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/tempvar.R���������������������������������������������������������������������������������0000644�0001762�0000144�00000004331�14372747611�013631� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocFunction tempvar # # @title "Gets a unique non-existing temporary variable name" # # \description{ # @get "title", and optionally assigns it an initial value. # } # # @synopsis # # \arguments{ # \item{prefix}{A @character string specifying the prefix of the # temporary variable name.} # \item{value}{(optional) If given, a variable with the temporary # name is assigned this value. Only works if \code{envir} is an # environment.} # \item{envir}{An @environment, a named @list, or a named @data.frame, # whose elements the temporary variable should not clash with.} # \item{inherits}{A @logical specifying whether the enclosing frames # of the environment should be searched or not.} # } # # \value{ # Returns a @character string. # } # # @examples "../incl/tempvar.Rex" # # @author # # \seealso{ # @see "base::tempfile" and @see "base::assign". # } # # @keyword programming # @keyword internal #*/########################################################################### tempvar <- function(prefix="var", value, envir=parent.frame(), inherits=FALSE) { maxTries <- 1e6 maxInt <- .Machine$integer.max isEnv <- is.environment(envir) if (!isEnv) { names <- names(envir) if (is.null(names)) { stop("Argument 'envir' specifies an object without names attributes: ", mode(envir)) } if (!missing(value)) { stop("Can only assign a value to a temporary variables in an environment: ", mode(envir)) } } ii <- 0L while (ii < maxTries) { # Generate random variable name idx <- sample.int(maxInt, size=1L) name <- sprintf("%s%d", prefix, idx) # Is it available? if (isEnv) { if (!exists(name, envir=envir, inherits=inherits)) { # Assign a value? if (!missing(value)) { assign(name, value, envir=envir, inherits=inherits) } return(name) } } else { if (!is.element(name, names)) { return(name) } } # Next try ii <- ii + 1L } # Failed to find a unique temporary variable name throw(sprintf("Failed to generate a unique non-existing temporary variable with prefix '%s'", prefix)) } # tempvar() �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/callHooks.R�������������������������������������������������������������������������������0000644�0001762�0000144�00000006575�14372747611�014106� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault callHooks # # @title "Call hook functions by hook name" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{hookName}{A @character string of the hook name.} # \item{...}{Argument passed to each hook function.} # \item{removeCalledHooks}{If @TRUE, called hook functions are removed, # otherwise not.} # } # # \value{ # Returns (invisibly) whatever @see "callHooks.list" returns. # } # # @examples "../incl/callHooks.Rex" # # @author # # \seealso{ # Internally, after retrieving hook functions, @see "callHooks.list" is # called. # } # # @keyword programming #*/########################################################################### setMethodS3("callHooks", "default", function(hookName, ..., removeCalledHooks=FALSE) { # Argument 'hookName': hookName <- as.character(hookName) if (length(hookName) != 1) { throw("Argument 'hookName' must be a single character string: ", length(hookName)) } # Argument 'removeCalledHooks': removeCalledHooks <- as.logical(removeCalledHooks) hooks <- getHook(hookName) if (length(hooks) == 0) return() if (!is.list(hooks)) hooks <- list(hooks) if (removeCalledHooks) { on.exit(setHook(hookName, hooks[failedHooks], action="replace")) } res <- callHooks(hooks, ...) failedHooks <- attr(res, "failedHooks") invisible(res) }) ###########################################################################/** # @class "function" # @RdocMethod callHooks # @alias callHooks.list # # @title "Call hook functions" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{hooks}{A @function or a @list of hook @functions or names of such.} # \item{...}{Argument passed to each hook function.} # } # # \value{ # Returns (invisibly) a @list that is named with hook names, if possible. # Each element in the list is in turn a @list with three element: # \code{fcn} is the hook function called, \code{result} is its return # value, and \code{exception} is the exception caught or @NULL. # } # # @author # # \seealso{ # See @see "callHooks" to call hook function by name. # } # # @keyword programming #*/########################################################################### setMethodS3("callHooks", "list", function(hooks, ...) { # Argument 'hooks': nhooks <- length(hooks) if (nhooks == 0) return() res <- vector(nhooks, mode="list") failedHooks <- rep(TRUE, times=nhooks) hookNames <- character(nhooks) for (kk in seq_len(nhooks)) { # Get the hook function fcn <- hooks[[kk]] tmp <- list(fcn=fcn, result=NULL, exception=NULL) if (is.character(fcn)) { hookNames[[kk]] <- fcn tryCatch({ fcn <- get(fcn, mode="function") }, error = function(ex) { tmp[["fcn"]] <<- NA tmp[["exception"]] <<- ex }) } # Try to call the hook function if (!is.null(fcn)) { tryCatch({ result <- fcn(...) tmp[["result"]] <- result failedHooks[kk] <- FALSE }, error = function(ex) { tmp[["exception"]] <<- ex }) } res[[kk]] <- tmp } names(res) <- hookNames attr(res, "failedHooks") <- failedHooks invisible(res) }) setMethodS3("callHooks", "function", function(hooks, ...) { callHooks(list(hooks), ...) }) �����������������������������������������������������������������������������������������������������������������������������������R.utils/R/SmartComments.R���������������������������������������������������������������������������0000644�0001762�0000144�00000017772�14372747611�014764� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocClass SmartComments # # @title "Abstract class SmartComments" # # \description{ # @classhierarchy # # @get "title". # } # # @synopsis # # \arguments{ # \item{letter}{A single @character.} # \item{...}{Not used.} # } # # \section{Fields and Methods}{ # @allmethods # } # # \details{ # A "smart" source-code comment is an \R comment, which start with a '#', # but is followed by a single letter, then a single symbol and a second # '#' and then an option character string, and there must not be any code # before the comment on the same line. In summary, a smart comment line # has format: \code{<white spaces>#<letter><symbol># <some text>}. # # Example code with two smart comments (VComments): # \preformatted{ # x <- 2 # #V1# threshold=-1 # #Vc# A v-comment log message # cat("Hello world") # } # which after compilation becomes # \preformatted{ # x <- 2 # verbose <- Verbose(threshold=-1) # if (verbose) { cat(verbose, "A v-comment log message"); } # cat("Hello world") # } # } # # @author # # \seealso{ # @see "VComments". # } # # @keyword programming # @keyword IO #*/########################################################################### setConstructorS3("SmartComments", function(letter=NA, ...) { letter <- as.character(letter) extend(Object(), "SmartComments", resetLetter = letter, letter = letter ) }) ###########################################################################/** # @RdocMethod reset # # @title "Resets a SmartComments compiler" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns nothing. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("reset", "SmartComments", function(this, ...) { this$letter <- this$resetLetter }) ###########################################################################/** # @RdocMethod parse # # @title "Parses one single smart comment" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{lines}{A @character @vector of lines of code containing smart # comments (only).} # \item{currLine}{The line number on which to smart smart comment begins.} # \item{...}{Not used.} # \item{letter}{The letter of the smart comment. Available to avoid lookup # at every line.} # \item{pattern}{The pattern of the smart comment.} # } # # \value{ # Returns a @list structure. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("parse", "SmartComments", function(this, lines, currLine, ..., letter=this$letter, pattern=NULL) { if (is.null(pattern)) pattern <- paste("^([ \t]*)(#", letter, ")(.)(#)(.*)", sep="") # Get next line line <- lines[currLine] if (is.na(line)) return(NULL) if (regexpr(pattern, line) == -1) return(NULL) indent <- gsub(pattern, "\\1", line) cmd <- gsub(pattern, "\\3", line) args <- gsub(pattern, "\\5", line) args <- trim(args) multiline <- (regexpr(" \\\\$", args) != -1) currLine <- currLine + 1 # Peek ahead on the next lines to get the rest of 'args' while(multiline) { # Remove trailing ' \' args <- gsub(" \\\\$", "", args) args <- trim(args) vcom <- gsub(pattern, "\\2", lines[currLine]) if (vcom != paste("#", letter, sep="")) throw("Syntax error: Following line is not a VComment: ", lines[currLine]) args2 <- gsub(pattern, "\\5", lines[currLine]) lines[currLine] <- NA args2 <- trim(args2) multiline <- (regexpr(" \\\\$", args2) != -1) args <- paste(args, args2, sep=" ") args <- trim(args) currLine <- currLine + 1 } if (nchar(args) == 0) args <- NULL list(indent=indent, cmd=cmd, args=args, currLine=currLine) }, protected=TRUE) ###########################################################################/** # @RdocMethod compile # # @title "Preprocess a vector of code lines" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{lines}{A @character @vector of lines of code to be preprocessed.} # \item{trim}{If @TRUE, trailing whitespace characters are removed from # every line of code, and contiguous empty lines are replaced with a # single empty line.} # \item{excludeComments}{If @TRUE, comments in the input lines, that is, # also smart comments, are excluded.} # \item{...}{Not used.} # } # # \value{ # Returns a @character @vector. # } # # \details{ # When called, the compiler is reset. # # Just before trimming is done, the validate() method is called. In the # current class, this does nothing, but can be overridden in subclasses. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("compile", "SmartComments", function(this, lines, trim=TRUE, excludeComments=FALSE, ...) { # Reset the compiler reset(this) if (length(lines) == 0) return(NULL) # 1. Get all comments-only lines pattern <- "^[ \t]*#" isComments <- (regexpr(pattern, lines) != -1) idxComments <- which(isComments) if (length(idxComments) == 0) return(lines) if (excludeComments) { lines <- lines[!isComments] } else { comments <- lines[idxComments] # 2. Among these, check for "Smart" comments. letter <- this$letter pattern <- paste("^([ \t]*)(#", letter, ")(.)(#)(.*)", sep="") idxSmartComments <- which(regexpr(pattern, comments) != -1) if (length(idxSmartComments) == 0) return(lines) # 3. Parse the "Smart" comments smartComments <- comments[idxSmartComments] currLine <- 1 while (currLine <= length(smartComments)) { smartComment <- parse(this, smartComments, currLine, letter=letter, pattern=pattern) if (is.null(smartComment)) { throw("Internal error!") currLine <- currLine + 1 next } newLine <- convertComment(this, smartComment, .currLine=currLine, .line=trim(smartComments[currLine])) smartComments[currLine] <- newLine nextLine <- smartComment$currLine if (nextLine > currLine+1) smartComments[(currLine+1):(nextLine-1)] <- NA currLine <- nextLine } # while() # Update all comment lines comments[idxSmartComments] <- smartComments # Update all lines lines[idxComments] <- comments # Exclude removed lines, i.e. now NAs lines <- lines[!is.na(lines)] } lines <- validate(this, lines) if (trim) { lines <- gsub("[ \t]*$", "", lines) empty <- (nchar(lines) == 0) multi <- (diff(c(TRUE, empty)*1) == 0) keep <- !(empty & multi) lines <- lines[keep] } lines }) ###########################################################################/** # @RdocMethod convertComment # # @title "Converts a single smart comment to R code" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Should return single @character of valid \R code. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("convertComment", "SmartComments", abstract=TRUE, protected=TRUE) ###########################################################################/** # @RdocMethod validate # # @title "Validates the compiled lines" # # \description{ # @get "title" # } # # @synopsis # # \arguments{ # \item{lines}{A @character @vector of lines of code to validated.} # \item{...}{Not used.} # } # # \value{ # Returns a @character @vector. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("validate", "SmartComments", function(this, lines, ...) { lines }, protected=TRUE) ������R.utils/R/000.R�������������������������������������������������������������������������������������0000644�0001762�0000144�00000000313�14372747611�012446� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������## Look for existing generic functions also in imported namespaces. ## This will affect whether setGenericS3() creates a generic function ## or not. options("R.methodsS3:checkImports:setGenericS3"=TRUE) ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/onGarbageCollect.R������������������������������������������������������������������������0000644�0001762�0000144�00000002266�14372747611�015353� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault onGarbageCollect # # @title "Registers a function to be called when the R garbage collector # is (detected to be) running" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{fcn}{A @function to be called without argument.} # \item{action}{A @character string specifying how the hook function is # added to list of hooks.} # \item{...}{Not used.} # } # # \value{ # Returns (invisibly) the hooks successfully called. # } # # @author # # \examples{\dontrun{ # onGarbageCollect(function(...) { # message("The R garbage collector is running!") # }) # }} # # @keyword programming #*/########################################################################### setMethodS3("onGarbageCollect", "default", function(fcn, action=c("prepend", "append", "replace"), ...) { # Argument 'fcn': if (!is.function(fcn)) { throw("Argument 'fcn' is not a function: ", class(fcn)[1]) } # Argument 'action': action <- match.arg(action) ## setHook("onGarbageCollect", fcn, action=action) dummyEnv <- new.env() reg.finalizer(dummyEnv, fcn, onexit=FALSE) invisible() }) ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/density.EXTS.R����������������������������������������������������������������������������0000644�0001762�0000144�00000007272�14372747611�014423� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @set class=density # @RdocMethod swapXY # # @title "Swaps x and y coordinates of a density object" # # \description{ # @get "title" returned by @see "stats::density". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns a 'density' object of the same class with # elements 'x' and 'y' swapped. # } # # @author # # \seealso{ # See @see "stats::density" for estimating densities. # See @seemethod "draw" for plotting a density along one of the sides. # } # # @keyword internal #*/########################################################################### setMethodS3("swapXY", "density", function(object, ...) { d <- object d$x <- object$y d$y <- object$x d }) # swapXY() ###########################################################################/** # @set class=density # @RdocMethod draw # # @title "Draws a density curve" # # \description{ # @get "title" along one of the sides of the current plotting region. # } # # @synopsis # # \arguments{ # \item{side}{An @integer specifying which side to draw along. # See @see "graphics::mtext" for details.} # \item{height}{A @numeric scalar specifying the "height" of the curve, # where height means the maximum height of the density. # that is, how much the zero-density position should be shifted.} # \item{scale}{A @character specifying the scale of the curve, which # can be either absolute or relative.} # \item{xpd}{If @TRUE, the curve is not clipped, cf. @see "graphics::par".} # \item{...}{Not used.} # } # # \value{ # Returns the drawn 'density' object # (with the 'x' and 'y' coordinates as plotted). # } # # @author # # \seealso{ # See @see "stats::density" for estimating densities. # Internally @seemethod "swapXY" may be used. # } # # @keyword internal #*/########################################################################### # For some reason I cannot override lines() here setMethodS3("draw", "density", function(object, side=1, height=0.2, offset=0, scale=c("absolute", "relative"), xtrim=NULL, xpd=TRUE, ...) { # To please R CMD check # object <- x # Argument 'side': side <- Arguments$getIndex(side, range=c(1,4)) # Argument 'height': height <- Arguments$getDouble(height) # Argument 'offset': offset <- Arguments$getDouble(offset) # Argument 'scale': scale <- match.arg(scale) # Argument 'xtrim': if (!is.null(xtrim)) xtrim <- Arguments$getDoubles(xtrim, length=c(2L,2L)) # Argument 'xpd': xpd <- Arguments$getLogical(xpd) par <- par("usr") dx <- diff(par[1:2]) dy <- diff(par[3:4]) ## printf("(dx,dy)=(%f,%f)\n", dx,dy) # New 'density' object d <- object # Rescale d$y to [0,1] maxY <- max(d$y, na.rm=TRUE) d$y <- d$y / maxY ## printf("range(d$y)=(%f,%f)\n", min(d$y),max(d$y)) # Relative height and offset? if (scale == "relative") { if (side == 1 || side == 3) { height <- height * dy offset <- offset * dy } else if (side == 2 || side == 4) { height <- height * dx offset <- offset * dx } } # Rescale d$y to [0,height] d$y <- d$y * height ## printf("range(d$y)=(%f,%f)\n", min(d$y),max(d$y)) # Offset d$y <- d$y + offset # Truncate by 'x'? if (!is.null(xtrim)) { keep <- (xtrim[1] <= d$x & d$x < xtrim[2]) d$x <- d$x[keep] d$y <- d$y[keep] keep <- NULL; # Not needed anymore } # Direction, and (x,y) swap? if (side == 1) { d$y <- par[3] + d$y } else if (side == 2) { d$y <- par[1] + d$y d <- swapXY(d) } else if (side == 3) { d$y <- par[4] - d$y } else if (side == 4) { d$y <- par[2] - d$y d <- swapXY(d) } lines(d, xpd=xpd, ...) invisible(d) }) # draw() ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/isDirectory.R�����������������������������������������������������������������������������0000644�0001762�0000144�00000007222�14372747611�014455� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault isDirectory # # @title "Checks if the file specification is a directory" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{pathname}{A @character string of the pathname to be checked.} # \item{...}{Not used.} # } # # \value{ # Returns @TRUE if the file specification is a directory, otherwise # @FALSE is returned. # } # # \section{Symbolic links}{ # This function follows symbolic links (also on Windows) and returns a # value based on the link target (rather than the link itself). # } # # @author # # \seealso{ # To check if it is a file see @see "isFile". # Internally @see "base::file.info" is used. # See also @see "utils::file_test". # } # # @keyword IO # @keyword programming #*/########################################################################### setMethodS3("isDirectory", "default", function(pathname, ...) { # Argument 'pathname': pathname <- as.character(pathname) # BACKWARD COMPATIBILITY: Treat empty path specially? pathname <- .getPathIfEmpty(pathname, where="isDirectory") nPaths <- length(pathname) # Nothing to do? if (nPaths == 0L) return(logical(0L)) # Multiple paths to be checked? if (nPaths > 1L) { res <- sapply(pathname, FUN=isDirectory, ...) return(res) } # A missing path? if (is.na(pathname)) return(FALSE) # Consider an empty path ("") as ".". if (identical(pathname, "")) pathname <- "."; # As in Java. # Current working directory is a directory. if (pathname == ".") return(TRUE) # 1. Remove trailing '/' or '\\' and check if it is a directory pathname <- gsub("[/\\\\]$", "", pathname) isdir <- file.info(pathname)$isdir if (identical(isdir, TRUE)) return(TRUE) # It may be that we do not have the file rights to access the # information on the directory. In such cases, we can at least check # if it is equal to the current working directory, which must exists # since R is running in it. if (is.na(isdir)) { wd <- gsub("[/\\\\]$", "", getwd()) if (pathname == wd) { return(TRUE) } } # 2. Add trailing '/' and check if it is a directory, e.g. "C:/". pathnameD <- paste(pathname, "/", sep="") isdir <- file.info(pathnameD)$isdir if (identical(isdir, TRUE)) return(TRUE) if (identical(isdir, FALSE)) return(FALSE) # 2a. WORKAROUND: file.info("C:/") gives NA; use "C:/." instead. # See R problem #15302, cf. # https://bugs.r-project.org/bugzilla3/show_bug.cgi?id=15302 if (getRversion() < "3.0.2") { pathnameD <- paste(pathname, "/.", sep="") isdir <- file.info(pathnameD)$isdir if (identical(isdir, TRUE)) return(TRUE) if (identical(isdir, FALSE)) return(FALSE) } # Is it the same as working directory? wd <- gsub("[/\\\\]$", "", getwd()); # Remove trailing '/'. if (pathname == wd) return(TRUE) # Is it already a relative pathname? Then, if it was a directory, the # above code would have detected it as a directory, if it was. if (!isAbsolutePath(pathname)) return(FALSE) # 3. Try the relative pathname, because on some file systems we do not # have the permission to access file information via absolute # pathnames (file.info() returns NAs), but via relative pathnames. # [This is actually true on the BASE file system. /HB Summer 2005] relPathname <- getRelativePath(pathname) # Avoid infinite recursive loops; check if succeeded in getting a # relative pathname? if (!identical(relPathname, pathname)) { isDirectory(relPathname) } else { # At this point, we can only return FALSE. FALSE } }) # isDirectory() ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/getPathIfEmpty.R��������������������������������������������������������������������������0000644�0001762�0000144�00000001500�14372747611�015040� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Special case: Treat zero-length paths/pathnames specially? # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - .getPathIfEmpty <- function(pathname, where=NULL) { # Nothing to do? if (length(pathname) > 0L) return(pathname) onEmptyPath <- getOption("R.utils::onEmptyPath", ".") # Treat as the current working directory? (Backward compatibility) if (onEmptyPath == ".") return(".") # Warning or error? if (is.element(onEmptyPath, c("warning", "error"))) { if (is.null(where)) { msg <- "Argument 'pathname' is NULL." } else { msg <- sprintf("Argument 'pathname' of %s is NULL.", where) } if (onEmptyPath == "error") throw(msg) warning(msg) } pathname } # .getPathIfEmpty() ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/onSessionExit.R���������������������������������������������������������������������������0000644�0001762�0000144�00000003142�14372747611�014764� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault onSessionExit # # @title "Registers a function to be called when the R session finishes" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{fcn}{A @function to be called without argument.} # \item{action}{A @character string specifying how the hook function is # added to list of hooks.} # \item{...}{Not used.} # } # # \value{ # Returns (invisibly) the hooks successfully called. # } # # \details{ # Functions registered this way are called when @see "finalizeSession" is # called. Moreover, when this package is loaded, the \code{.Last()} # function is modified such that \code{finalizeSession()} is called. # However, note that \code{.Last()} is \emph{not} guaranteed to be called # when the \R session finished. For instance, the user may quit \R by # calling \code{quit(callLast=FALSE)}. # Moreover, when \R is run in batch mode, \code{.Last()} is never called. # } # # @author # # \examples{\dontrun{ # onSessionExit(function(...) { # message("Bye bye world!") # }) # # quit() # }} # # \seealso{ # \code{\link{.Last}()}. # @see "finalizeSession". # } # # @keyword programming #*/########################################################################### setMethodS3("onSessionExit", "default", function(fcn, action = c("prepend", "append", "replace"), ...) { # Argument 'fcn': if (!is.function(fcn)) throw("Argument 'fcn' is not a function: ", mode(fcn)) # Argument 'action': action <- match.arg(action) setHook("onSessionExit", fcn, action=action) }) ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/toUrl.R�����������������������������������������������������������������������������������0000644�0001762�0000144�00000006111�14372747611�013256� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault toUrl # # @title "Converts a pathname into a URL" # # \description{ # @get "title" starting with \code{file://}. # } # # @synopsis # # \arguments{ # \item{pathname}{A @character @vector of pathnames to be made into URLs.} # \item{safe}{If @TRUE, certain "unsafe" characters are escaped.} # \item{...}{Not used.} # } # # \value{ # Returns a @character @vector. # } # # @author # # \seealso{ # @see "utils::URLencode". # } # # @keyword IO # @keyword programming #*/########################################################################### setMethodS3("toUrl", "default", function(pathname, safe=TRUE, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Local functions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - toURLEncodedPath <- function(pathname, encodeUrlSyntax=FALSE, ...) { hexDigits <- c("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "A", "B", "C", "D", "E", "F") # "...Only alphanumerics [0-9a...zA...Z], the special characters # "$-_.+!*'()," [not including the quotes - ed], and reserved # characters used for their reserved purposes may be used unencoded # within a URL." [1] # "Further, to allow actual URLs to be encoded, this little converter # does not encode URL syntax characters (the ";", "/", "?", ":", "@", # "=", "#" and "&" characters)..." [1] # References: # [1] http://www.blooberry.com/indexdot/html/topics/urlencoding.htm # Note '-' must be last!!! if (encodeUrlSyntax == TRUE) { keepSet <- "[0-9abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ$_.+!*'(),-]" } else { keepSet <- "[0-9abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ$_.+!*'(),;/?:@=#&-]" } res <- NULL for (k in seq_len(nchar(pathname, type="chars"))) { ch <- substring(pathname, k, k) re <- regexpr(keepSet, ch) if (re == -1) { ch <- charToInt(ch) hi <- floor(ch/16) low <- ch - 16*hi hi <- hexDigits[hi+1] low <- hexDigits[low+1] ch <- paste("%", hi, low, sep="") } res <- c(res, ch) } paste(res, collapse="") } # toURLEncodedPath() # Argument 'pathname': url <- as.character(pathname) nUrls <- length(url) # Nothing to do? if (nUrls == 0L) return(character(0L)) # Multiple pathnames? if (nUrls > 1L) { res <- sapply(url, FUN=toUrl, safe=safe, ...) return(res) } # Convert backslashes to forward ones url <- gsub("[\\]", "/", url) # Anything that contains at least two alphabetic letters followed # by a colon is assumed to be a protocol, e.g. http:, file: and mailto:. hasProtocol <- (regexpr("^[abcdefghijklmnopqrstuvwxyz]+:", url) != -1L) # If prefix is missing, assume a file... if (!hasProtocol) { if (!isAbsolutePath(url)) url <- paste(getwd(), url, sep="/") url <- paste(sep="", "file://", url) } # Make a "safe" URL if (safe) url <- toURLEncodedPath(url) url }) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/compressPDF.R�����������������������������������������������������������������������������0000644�0001762�0000144�00000010426�14372747611�014342� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault compressPDF # # @title "Compresses a PDF (into a new PDF)" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{filename, path}{The filename and (optional) path of the # PDF to be compressed.} # \item{outFilename, outPath}{The generated PDF.} # \item{skip}{If @TRUE and an existing output file, then it is returned.} # \item{overwrite}{If @FALSE, an error is thrown if the output file # already exists, otherwise not.} # \item{compression}{A @character @vector of compression methods # to apply. This overrides any low-level arguments passed via # \code{...} that @see "tools::compactPDF".} # \item{...}{Additional arguments passed to @see "tools::compactPDF", # e.g. \code{gs_quality}.} # } # # \value{ # Returns the pathname of the generated PDF. # } # # \examples{\dontrun{ # pathnameZ <- compressPDF("report.pdf") # }} # # @author # # \seealso{ # Internally @see "tools::compactPDF" is utilized. # } # # @keyword file # @keyword IO #*/########################################################################### setMethodS3("compressPDF", "default", function(filename, path=NULL, outFilename=basename(pathname), outPath="compressedPDFs", skip=FALSE, overwrite=FALSE, compression="gs(ebook)+qpdf", ...) { ## Argument 'filename' and 'path': pathname <- Arguments$getReadablePathname(filename, path=path) ## Argument 'outFilename' and 'outPath': pathnameD <- Arguments$getWritablePathname(outFilename, path=outPath, mustNotExist=FALSE) ## Argument 'compression': if (!is.null(compression)) { compression <- Arguments$getCharacters(compression) compression <- trim(compression) compression <- compression[nzchar(compression)] } ## Skipping? if (isFile(pathnameD)) { if (skip) return(pathnameD) if (!overwrite) Arguments$getWritablePathname(pathnameD, mustNotExist=TRUE) } ## Parse 'compression' argument compress_args <- list() if (length(compression) > 0L) { compressionT <- unlist(strsplit(compression, split="+", fixed=TRUE)) compressionT <- trim(compressionT) compressionT <- compressionT[nzchar(compressionT)] cmethod <- gsub("[(].*", "", compressionT) carg <- gsub("[)].*", "", gsub(".*[(]", "", compressionT)) keep <- is.element(cmethod, c("gs", "qpdf")) if (any(!keep)) { warning("Ignoring unknown PDF compression method: ", paste(sQuote(cmethod[!keep]), collapse=", ")) compression <- compression[keep] cmethod <- cmethod[keep] carg <- carg[keep] } for (kk in seq_along(cmethod)) { if (cmethod[kk] == "gs") { opts <- unlist(strsplit(carg[kk], split=",", fixed=TRUE)) if (length(opts) > 0L) compress_args$gs_quality <- opts[1L] if (length(opts) > 1L) compress_args$gs_extras <- opts[-1L] } } } # if (length(compression) > 0L) ## WORKAROUND #1: tools::compactPDF(paths) compresses all PDFs in paths ## if length(paths) == 1 so working with a temporary directory. pathD <- dirname(pathnameD) pathT <- sprintf("%s.tmp", pathD) pathT <- Arguments$getWritablePath(pathT) on.exit(removeDirectory(pathT)) ## WORKAROUND #2: tools::compactPDF(paths) does not handle spaces ## in filenames. pathnameDT <- tempfile(tmpdir=pathT, fileext=".pdf") copyFile(pathname, pathnameDT) ## File size before size0 <- file.info(pathnameDT)$size ## Arguments to tools::compactPDF() args <- list(paths=pathT, ...) ## Override with 'compression' specifications for (name in names(compress_args)) { args[[name]] <- compress_args[[name]] } ## Call tools::compactPDF() res <- do.call(tools::compactPDF, args=args) ## File size after size1 <- file.info(pathnameDT)$size ## If compression < 10% or < 10kB, then considered not worth it ## by tools::compactPDF() if (nrow(res) == 0L) { warning(sprintf("PDF compression saved less than 10%% or less than 10kB on the original file size (%g bytes) so tools::compactPDF() decided to keep the PDF as is: %s", file.info(pathnameDT)$size, pathnameDT)) } renameFile(pathnameDT, pathnameD, overwrite=TRUE) ## Report on compression ratio comp <- c(size0, size1) names(comp) <- c(pathname, pathnameD) attr(pathnameD, "result") <- comp pathnameD }) ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/CmdArgsFunction.R�������������������������������������������������������������������������0000644�0001762�0000144�00000001722�14372747611�015202� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������############################################################################## # This code has to come first in a library. To do this make sure this file # is named "000.R" (zeros). ############################################################################## setConstructorS3("CmdArgsFunction", function(fcn=function() {}, output=print, ...) { # Argument 'fcn': .stop_if_not(is.function(fcn)) # Argument 'output': .stop_if_not(is.function(output)) attr(fcn, "output") <- output extend(fcn, "CmdArgsFunction") }) setMethodS3("print", "CmdArgsFunction", function(x, ..., call=!interactive(), envir=parent.frame()) { # Nothing todo? if (!call) return(NextMethod()) # Call function... res <- withVisible(cmdArgsCall(x, ..., envir=envir)) # Should the result be printed? if (res$visible) { output <- attr(x, "output") if (is.null(output)) output <- print output(res$value) } # Return nothing invisible(return()) }, protected=TRUE) ����������������������������������������������R.utils/R/NullVerbose.R�����������������������������������������������������������������������������0000644�0001762�0000144�00000006616�14372747611�014423� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocClass NullVerbose # # @title "A Verbose class ignoring everything" # # \description{ # @classhierarchy # # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Ignored.} # } # # \section{Fields and Methods}{ # @allmethods # } # # @examples "../incl/NullVerbose.Rex" # # @author # # @keyword programming # @keyword IO #*/########################################################################### setConstructorS3("NullVerbose", function(...) { extend(Verbose(core=FALSE, ...), "NullVerbose") }) ###########################################################################/** # @RdocMethod writeRaw # @aliasmethod cat # @aliasmethod printf # @aliasmethod enter # @aliasmethod exit # @aliasmethod print # @aliasmethod str # @aliasmethod summary # @aliasmethod evaluate # @aliasmethod newline # @aliasmethod ruler # @aliasmethod header # # @title "All output methods" # # \description{ # @get "title" of this class ignores their input arguments and outputs # nothing. # } # # @synopsis # # \arguments{ # \item{...}{Ignored.} # } # # \value{ # Returns nothing. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### # Create all methods that Verbose have, but make them ignore everything. setMethodS3("writeRaw", "NullVerbose", function(...) {invisible(FALSE)}, protected=TRUE) setMethodS3("cat", "NullVerbose", function(...) {invisible(FALSE)}, protected=TRUE) setMethodS3("printf", "NullVerbose", function(...) {invisible(FALSE)}, protected=TRUE) setMethodS3("enter", "NullVerbose", function(...) {invisible(FALSE)}, protected=TRUE) setMethodS3("exit", "NullVerbose", function(...) {invisible(FALSE)}, protected=TRUE) setMethodS3("print", "NullVerbose", function(...) {invisible(FALSE)}, protected=TRUE) setMethodS3("str", "NullVerbose", function(...) {invisible(FALSE)}, protected=TRUE) setMethodS3("summary", "NullVerbose", function(...) {invisible(FALSE)}, protected=TRUE) setMethodS3("evaluate", "NullVerbose", function(...) {invisible(FALSE)}, protected=TRUE) setMethodS3("newline", "NullVerbose", function(...) {invisible(FALSE)}, protected=TRUE) setMethodS3("ruler", "NullVerbose", function(...) {invisible(FALSE)}, protected=TRUE) setMethodS3("header", "NullVerbose", function(...) {invisible(FALSE)}, protected=TRUE) ###########################################################################/** # @RdocMethod isVisible # # @title "Checks if a certain verbose level will be shown or not" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns always @FALSE. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("isVisible", "NullVerbose", function(this, ...) { FALSE }) ###########################################################################/** # @RdocMethod isOn # # @title "Checks if the output is on" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns always @FALSE. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("isOn", "NullVerbose", function(this, ...) { FALSE }) ������������������������������������������������������������������������������������������������������������������R.utils/R/useRepos.R��������������������������������������������������������������������������������0000644�0001762�0000144�00000021465�14372747611�013767� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocFunction useRepos # @alias parseRepos # # @title "Sets package repositories" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{repos}{A @character @vector of repositories to use. # If @NULL, nothing is replaced.} # \item{where}{A @character string specifying how to add them to the # current set of repositories.} # \item{unique}{If @TRUE, only unique repositories are set.} # \item{fallback}{If @TRUE, any remaining non-specified repository value # of format '@...@' (e.g. '@CRAN@') than could not be recovered by # other means, will be assigned to a pre-defined known value, if possible. # If so, then an informative warning is given.} # \item{...}{Not used.} # } # # \value{ # Returns a @list with element 'repos' reflecting \code{options("repos")} # as the options where prior to calling this function. # } # # @author # # \seealso{ # @see "withRepos". # } # # @keyword IO # @keyword programming #*/########################################################################### useRepos <- function(repos=NULL, where=c("before", "after", "replace"), unique=TRUE, fallback=TRUE, ...) { # Nothing to do? if (is.null(repos)) { return(options("repos")) } # Reset to previous options? # (Example: old <- useRepos(), later useRepos(old).) if (is.list(repos)) { old <- options(repos) return(old) } repos <- parseRepos(sets=repos, where=where, fallback=fallback, ...) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Keep only unique ones? # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (unique) { names <- names(repos) if (length(names) > 0L) { dups <- (nzchar(names) & duplicated(names)) repos <- repos[!dups] } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Repositories, except '@...@' ones, should all be specified as URLs, # cf. help("install.packages"). reposT <- grep("^@[^@]+@$", repos, value=TRUE, invert=TRUE) isUrl <- isUrl(reposT) bad <- repos[!isUrl] if (length(bad) > 0L) { stop("Detected reposities that are not specified as URLs: ", bad) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Apply # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - old <- options(repos=repos) invisible(old) } # useRepos() parseRepos <- function(sets=NULL, where=c("before", "after", "replace"), fallback=TRUE, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Local functions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - reposKnownToR <- function() { p <- file.path(Sys.getenv("HOME"), ".R", "repositories") if (!file.exists(p)) p <- file.path(R.home("etc"), "repositories") ## Find .read_repositories() in 'utils' or 'tools' [R (< 4.3.0)] .read_repositories <- NULL for (pkg in c("utils", "tools")) { ns <- getNamespace(pkg) if (exists(".read_repositories", envir = ns)) { .read_repositories <- get(".read_repositories", envir = ns) break } } if (is.null(.read_repositories)) { stop("[INTERNAL ERROR] Failed to locate base-R function .read_repositories()") } a <- .read_repositories(p) repos <- a$URL names <- rownames(a) names(repos) <- names repos } # reposKnownToR() reposCustom <- function() { c("braju.com"="https://braju.com/R") } # reposCustom() reposFallback <- function() { c("CRAN"="https://cran.r-project.org") } # reposCustom() reposAll <- function() { c(reposKnownToR(), reposCustom()) } # reposAll() superPattern <- function(name="all") { known <- list( CRAN = "^(CRAN.*)$", BioC = "^(BioC.*)$", all = "", current = "<current>" ) known$`mainstream` <- c(known$CRAN, known$BioC) known$`braju.com` <- c("^braju[.]com$", known$mainstream) known$`R-Forge` <- c("^R-Forge$", known$mainstream) known$`rforge.net` <- c("^rforge[.]net$", known$mainstream) # Unknown? if (!is.element(name, names(known))) return(NULL) known[[name]] } # superPattern() reposSubst <- function(repos, known=repos) { pattern <- "^@[^@]+@$" subs <- grep(pattern, repos) if (length(subs) > 0L) { # Borrow from repositories that does not require substitution known <- grep(pattern, known, value=TRUE, invert=TRUE) # Names of repositories that requires substitution names <- names(repos)[subs] # Look them up in among the known ones? reposT <- known[names] .stop_if_not(length(reposT) == length(subs)) # Which can use? ok <- !is.na(reposT) reposT <- reposT[ok] # Patch if (length(reposT) > 0L) { idxs <- match(names(reposT), names) subs <- subs[idxs] repos[subs] <- reposT } } repos } # reposSubst() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'sets': # Nothing to do? if (is.null(sets)) return(getOption("repos")) .stop_if_not(is.character(sets)) # Argument 'where': where <- match.arg(where) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # How the order relative to the existing set of repositories? # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # All available/known repositories repos00 <- c(getOption("repos"), reposAll()) if (where == "after") { repos0 <- repos00 } else if (where == "before") { repos0 <- c(reposAll(), getOption("repos")) } else { # Don't the use the existing ones repos0 <- reposAll() } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Preprocess sets # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - sets <- unlist(strsplit(sets, split=",", fixed=TRUE), use.names=FALSE) names <- names(sets) sets <- sapply(sets, FUN=trim) names(sets) <- names # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Indentify new set of repositories # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Subset by name? if (is.character(sets)) { repos <- c() patternS <- "^\\[(.*)\\]$" for (kk in seq_along(sets)) { # Subsetting here will keep the names attribute set <- sets[kk] # Subset by regular expression? if (regexpr(patternS, set) != -1L) { # Identify the repository pattern used for scanning pattern <- gsub(patternS, "\\1", set) # A super set? if (regexpr(patternS, pattern) != -1L) { name <- gsub(patternS, "\\1", pattern) pattern <- superPattern(name) if (length(pattern) == 0L) { stop("Unknown repository super set: ", name) } } # Current set or pattern? if (identical(pattern, "<current>")) { repos <- getOption("repos") } else { # All known repositories with names matching the pattern(s) keep <- lapply(pattern, FUN=grep, names(repos0)) keep <- unique(unlist(keep)) repos <- c(repos, repos0[keep]) } } else if (isUrl(set)) { repos <- c(repos, set) } else { repos <- c(repos, repos0[set]) } } # for (set ...) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Try to substitute any @CRAN@ etc. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # First among the selected set repos <- reposSubst(repos) # Then among the all known repositories repos <- reposSubst(repos, known=repos00) # And finally among the fallback repositories? if (fallback) { repos0 <- repos repos <- reposSubst(repos, known=reposFallback()) if (!identical(repos, repos0)) { # Report on what was done idxs <- which(repos0 != repos) diff <- sprintf("%s -> %s", sQuote(repos0[idxs]), sQuote(repos[idxs])) keys <- names(repos[idxs]) if (!is.null(keys)) diff <- sprintf("%s: %s", keys, diff) diff <- paste(diff, collapse=", ") warning("Had to fall back to a set of predefined repositories (please make sure to set your package repositories properly, cf. ?setRepositories): ", diff) } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Drop (name,value) duplicates # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - keys <- paste(names(repos), repos, sep=":") repos <- repos[!duplicated(keys)] # Sanity check .stop_if_not(is.character(repos)) # Return repos } # parseRepos() �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/readWindowsShellLink.R��������������������������������������������������������������������0000644�0001762�0000144�00000075351�14372747611�016261� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault readWindowsShellLink # # @title "Reads a Microsoft Windows Shortcut (.lnk file)" # # @synopsis # # \description{ # @get "title". # } # # \arguments{ # \item{con}{A @connection or a @character string (filename).} # \item{clean}{If @TRUE, low-level file specific fields are dropped, # e.g. offsets on file locations.} # \item{verbose}{If @TRUE, extra information is written while reading.} # \item{...}{Not used.} # } # # \value{ # Returns a @list structure. # } # # @examples "../incl/readWindowsShellLink.Rex" # # \details{ # This function is implemented based on the official file format # specification [1]. # It is intended to replace @see "readWindowsShortcut", which was # written based on reverse engineering (before [1] was made available). # } # # @author # # \seealso{ # @see "readWindowsShortcut" # \code{\link{filePath}} # } # # \references{ # [1] [MS-SHLLINK]: Shell Link (.LNK) Binary File Format, Microsoft Inc., # September 25, 2009. \cr # } # # @keyword file # @keyword IO # @keyword internal #*/########################################################################### setMethodS3("readWindowsShellLink", "default", function(con, clean=TRUE, verbose=FALSE, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Local functions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - intToBits <- function(x, n=NULL, names=NULL, rev=TRUE, ...) { # Argument 'x': .stop_if_not(is.integer(x)) .stop_if_not(length(x) == 1L) # Argument 'n': if (!is.null(n)) { .stop_if_not(n > 0L) } # Argument 'names': if (!is.null(names)) { .stop_if_not(is.character(names)) if (!is.null(n)) { .stop_if_not(length(names) == n) } n <- length(names) } # Get binary represenation x <- intToBin(x) x <- unlist(strsplit(x, split=""), use.names=FALSE) .stop_if_not(length(x) <= n) x <- as.integer(x) x <- as.logical(x) x <- c(rep(FALSE, times=n-length(x)), x) .stop_if_not(length(x) == n) if (!is.null(names)) { x <- rev(x) names(x) <- names x <- rev(x) } if (rev) { x <- rev(x) } x } # intToBits() readBits <- function(con, n=32L, ...) { .stop_if_not(n %% 8 == 0) nbrOfBytes <- n %/% 8L if (nbrOfBytes <= 2L) { x <- readBin(con=con, what=integer(), size=nbrOfBytes, n=1L, signed=FALSE, endian="little") } else { x <- readBin(con=con, what=integer(), size=nbrOfBytes, n=1L, endian="little") } intToBits(x, n=n) } # readBits() # raw - An 1-byte unsigned integer readRaw <- function(con, n=1) { readBin(con=con, what=raw(), n=n) } # byte - An 1-byte unsigned integer readByte <- function(con, n=1) { readBin(con=con, what=integer(), size=1L, n=n, signed=FALSE, endian="little") } # word - A 2-byte unsigned integer readWord <- function(con, n=1) { readBin(con=con, what=integer(), size=2L, n=n, signed=FALSE, endian="little") } # qword - A 4-byte unsigned integer (actually as signed integer) readDWord <- function(con, n=1) { readBin(con=con, what=integer(), size=4L, n=n, signed=TRUE, endian="little") } # qword - An 8-byte unsigned integer (actually as signed integer) readQWord <- function(con, n=1) { readBin(con=con, what=integer(), size=4L, n=2*n, signed=TRUE, endian="little") } readString <- function(con, nchars=-1L, unicoded=FALSE) { if (nchars == -1) { bfr <- c() while ((byte <- readByte(con)) != 0L) { bfr <- c(bfr, byte) } } else { if (unicoded) nchars <- 2L*nchars bfr <- readByte(con, n=nchars) } # Since R does not support Unicoded strings, we (incorrectly) assume # (=hope) that it is only the unicode characters 0:255 that are used. if (unicoded) bfr <- bfr[bfr != 0] paste(intToChar(bfr), collapse="") } # readString() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # From [7]: # The Shell Link Binary File Format consists of a sequence of structures # that conform to the following ABNF rules [RFC5234]: # # SHELL_LINK = SHELL_LINK_HEADER [LINKTARGET_IDLIST] [LINKINFO] # [STRING_DATA] *EXTRA_DATA # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # The ShellLinkHeader structure contains identification information, # timestamps, and flags that specify the presence of optional structures, # including LinkTargetIdList (section 2.2), LinkInfo (section 2.3), # and StringData (section 2.4). # # [SHELL_LINK_HEADER] = # HeaderSize (4 bytes): # The size, in bytes, of this structure. MUST be 0x0000004C. # LinkCLSID (16 bytes): # A class identifier (CLSID). MUST be 00021401-0000-0000-C000-000000000046. # LinkFlags (4 bytes): # A LinkFlags structure (section 2.1.1) that specifies information about # the shell link and the presence of optional portions of the structure. # FileAttributes (4 bytes): # A FileAttributesFlags structure (section 2.1.2) that specifies # information about the link target. # CreationTime (8 bytes): # A FILETIME structure ([MS-DTYP] section 2.3.1) that specifies the # creation time of the link target in UTC (Coordinated Universal Time). # If the value is zero, there is no creation time set on the link target. # AccessTime (8 bytes): # A FILETIME structure ([MS-DTYP] section 2.3.1) that specifies the # access time of the link target in UTC (Coordinated Universal Time). # If the value is zero, there is no access time set on the link target. # WriteTime (8 bytes): # A FILETIME structure ([MS-DTYP] section 2.3.1) that specifies the # write time of the link target in UTC (Coordinated Universal Time). # If the value is zero, there is no write time set on the link target. # FileSize (4 bytes): # A 32-bit unsigned integer that specifies the size, in bytes, # of the link target. If the link target file is larger than # 0xFFFFFFFF, this value specifies the least significant 32 bits # of the link target file size. # IconIndex (4 bytes) # A 32-bit signed integer that specifies the index of an icon # within a given icon location. # ShowCommand (4 bytes): # A 32-bit unsigned integer that specifies the expected window state # of an application launched by the link. This value SHOULD be one # of the following. # SW_SHOWNORMAL = 0x00000001 # The application is open and its window is open in a normal fashion. # SW_SHOWMAXIMIZED = 0x00000003 # The application is open, and keyboard focus is given to the # application, but its window is not shown. # SW_SHOWMINNOACTIVE = 0x00000007 # The application is open, but its window is not shown. It is not # given the keyboard focus. # HotKey (2 bytes): # A HotKeyFlags structure (section 2.1.3) that specifies the keystrokes # used to launch the application referenced by the shortcut key. This # value is assigned to the application after it is launched, so that # pressing the key activates that application. # Reserved1 (2 bytes): A value that MUST be zero. # Reserved2 (4 bytes): A value that MUST be zero. # Reserved3 (4 bytes): A value that MUST be zero. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - parseLinkFlags <- function(flags, ...) { keys <- character(length=27L) keys[ 1] <- "HasLinkTargetIdList" keys[ 2] <- "HasLinkInfo" keys[ 3] <- "HasName" keys[ 4] <- "HasRelativePath" keys[ 5] <- "HasWorkingDir" keys[ 6] <- "HasArguments" keys[ 7] <- "HasIconLocation" keys[ 8] <- "IsUnicode" keys[ 9] <- "ForceNoLinkInfo" keys[10] <- "HasExpString" keys[11] <- "RunInSeparateProcess" keys[12] <- "Unused1" keys[13] <- "HasDarwinId" keys[14] <- "RunAsUser" keys[15] <- "HasExpIcon" keys[16] <- "NoPidlAlias" keys[17] <- "Unused2" keys[18] <- "RunWithShimLayer" keys[19] <- "ForceNoLinkTrack" keys[20] <- "EnableTargetMetadata" keys[21] <- "DisableLinkPathTracking" keys[22] <- "DisableKnownFolderTracking" keys[23] <- "DisableKnownFolderAlias" keys[24] <- "AllowLinkToLink" keys[25] <- "UnaliasOnSave" keys[26] <- "PreferEnvironmentPath" keys[27] <- "KeepLocalIdListForUNCTarget" flags <- intToBits(flags, names=keys) # Validation .stop_if_not(flags["IsUnicode"]) flags } # parseLinkFlags() parseFileAttributes <- function(attrs, ...) { keys <- character(length=15L) keys[ 1] <- "readOnly" keys[ 2] <- "hidden" keys[ 3] <- "system" keys[ 4] <- "reserved1" keys[ 5] <- "directory" keys[ 6] <- "archive" keys[ 7] <- "reserved2" keys[ 8] <- "normal" keys[ 9] <- "temporary" keys[10] <- "sparseFile" keys[11] <- "reparsePoint" keys[12] <- "compressed" keys[13] <- "offline" keys[14] <- "notContentIndexed" keys[15] <- "encrypted" attrs <- intToBits(attrs, names=keys) # Validate keys <- c("reserved1", "reserved2") for (key in keys) { if (attrs[key] != 0L) { stop(sprintf("File format error: File header field 'fileAttributes' flag '%s' must be FALSE: %d", key, attrs[key])) } } if (attrs["normal"] && sum(attrs) != 1L) { stop(sprintf("File format error: File header field 'fileAttributes' flag 'normal' is set, but still detected %d other flags also being set.", sum(attrs)-1L)) } attrs } # parseFileAttributes() parseShowCommand <- function(showCommand, ...) { # Argument 'showCommand': .stop_if_not(is.integer(showCommand)) .stop_if_not(length(showCommand) == 1L) showCommand } # parseShowCommand() parseHotKey <- function(hotKey, ...) { # Argument 'hotKey': .stop_if_not(is.integer(hotKey)) .stop_if_not(length(hotKey) == 1L) # Get binary represenation lowByte <- hotKey %% 256L highByte <- hotKey %/% 256L if (highByte < 0L || highByte > 7L) { stop(sprintf("File format error: File header field 'hotKey' has a 'highByte' out of range [0x00,0x07]: %d", highByte)) } hotKey <- c(lowByte=lowByte, highByte=highByte) hotKey } # parseHotKey() readShellLinkHeader <- function(con, ...) { hdr <- list( headerSize = readDWord(con), # 4 bytes linkCLSID = readRaw(con, n=16), # 16 bytes linkFlags = readDWord(con), # 4 bytes = 32 bits fileAttributes = readDWord(con), # 4 bytes = 32 bits creationTime = readQWord(con), # 8 bytes accessTime = readQWord(con), # 8 bytes writeTime = readQWord(con), # 8 bytes fileSize = readDWord(con), # 4 bytes iconIndex = readDWord(con), # 4 bytes showCommand = readDWord(con), # 4 bytes hotKey = readWord(con), # 2 bytes reserved1 = readWord(con), # 2 bytes reserved2 = readDWord(con), # 4 bytes reserved3 = readDWord(con) # 4 bytes ); # =76 bytes total # Validate if (hdr$headerSize != 76L) { stop("File format error: Shell link header size is not 76 bytes (0x0000004C): ", hdr$headerSize) } # Validate knownCLSID <- as.raw(c(0x01, 0x14, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x46)) if (!all.equal(hdr$linkCLSID, knownCLSID)) { knownCLSID <- paste(sprintf("%02x", as.integer(knownCLSID)), collapse=",") linkCLSID <- paste(sprintf("%02x", as.integer(hdr$linkCLSID)), collapse=",") stop("File format error: Shell link header has an unknown CLSID: ", knownCLSID, " != ", linkCLSID) } # Parse (and validate) hdr$linkFlags <- parseLinkFlags(hdr$linkFlags) # Parse (and validate) hdr$fileAttributes <- parseFileAttributes(hdr$fileAttributes) parseFileTime <- function(time, ...) { offset <- as.POSIXlt("1601-01-01") timeD <- as.double(time) timeD <- c(1, 2^32)*timeD timeD <- sum(timeD) secs <- 1.0e-7*timeD time <- offset + secs time } # parseFileTime() hdr$creationTime <- parseFileTime(hdr$creationTime) hdr$accessTime <- parseFileTime(hdr$accessTime) hdr$writeTime <- parseFileTime(hdr$writeTime) if (hdr$linkFlags["HasLinkInfo"]) { attrs <- hdr$fileAttributes # attrs <- names(attrs[attrs]) # if (length(attrs) > 0L) { # stop("File format error: When shortcut is not pointing to a file or a directory no other file attributes should be set: ", paste(attrs, collapse=", ")) # } } # Validate if (hdr$fileSize < 0L) { stop("File format error: File length is negative: ", header$fileLength) } # Parse (and validate) hdr$showCommand <- parseShowCommand(hdr$showCommand) # Parse (and validate) hdr$hotKey <- parseHotKey(hdr$hotKey) # Validate keys <- c("reserved1", "reserved2", "reserved3") for (key in keys) { if (hdr[[key]] != 0L) { stop(sprintf("File format error: File header field '%s' must be 0: %d", key, hdr[[key]])) } } if (clean) { hdr$headerSize <- NULL } hdr } # readShellLinkHeader() readLinkTargetIdList <- function(con, ...) { readIdList <- function(con, n) { .stop_if_not(n >= 2L) raw <- readRaw(con, n=n) terminalId <- raw[(n-1L):n] .stop_if_not(all(terminalId == 0L)) raw <- raw[1:(n-2L)] # Parse 'itemIdList' into list of 'ItemId':s itemIdList <- list() idx <- 1L while(length(raw) > 0L) { .stop_if_not(length(raw) >= 2L) itemIdSize <- readWord(raw) raw <- raw[-(1:2)] nbrOfBytesToRead <- itemIdSize - 2L if (nbrOfBytesToRead > 0L) { .stop_if_not(length(raw) >= nbrOfBytesToRead) Data <- readRaw(raw, n=nbrOfBytesToRead) itemIdList[[idx]] <- Data raw <- raw[-(1:nbrOfBytesToRead)] } else { Data <- raw(length=0L) } itemIdList[[idx]] <- Data idx <- idx + 1L } # while() # Sanity check .stop_if_not(length(raw) == 0L) ## itemIdList <- lapply(itemIdList, FUN=rawToChar) idList <- list(itemIdList=itemIdList, terminalId=terminalId) if (clean) { idList$terminalId <- NULL } idList } # readIdList() idListSize <- readWord(con) idList <- readIdList(con, n=idListSize) } # readLinkTargetIdList() readLinkInfo <- function(con, ...) { parseLinkInfoFlags <- function(flags, ...) { keys <- character(length=2L) keys[1] <- "VolumeIdAndLocalBasePath" keys[2] <- "CommonNetworkRelativeLinkAndPathSuffix" flags <- intToBits(flags, names=keys) flags } # parseLinkInfoFlags() readVolumeId <- function(con, ...) { id <- list( volumeIdSize = readDWord(con), # 4 bytes driveType = readDWord(con), # 4 bytes driveSerialNumber = readDWord(con), # 4 bytes volumeLabelOffset = readDWord(con) # 4 bytes ) nbrOfBytesRead <- 4*4L .stop_if_not(id$volumeIdSize > 0x00000010) .stop_if_not(id$volumeLabelOffset >= 0L) .stop_if_not(id$volumeLabelOffset < id$volumeIdSize) .stop_if_not(id$driveType >= 0L) .stop_if_not(id$driveType <= 6L) if (id$volumeLabelOffset == 0x00000014) { id$volumeLabelOffsetUnicode <- readDWord(con) nbrOfBytesRead <- nbrOfBytesRead + 4L offset <- id$volumeLabelOffsetUnicode } else { offset <- id$volumeLabelOffset } id$data <- readRaw(con, n=id$volumeIdSize-nbrOfBytesRead) offset <- offset - nbrOfBytesRead nbrOfBytesRead <- nbrOfBytesRead + length(id$data) # Parse the volume label data <- id$data if (offset > 0L) { data <- data[-c(1:offset)] } n <- which(data == as.raw(0x0))-1L if (n < length(data)) { data <- data[1:n] } id$volumeLabel <- rawToChar(data) # Sanity check .stop_if_not(nbrOfBytesRead == id$volumeIdSize) id } # readVolumeId() info <- list( size = readDWord(con), # 4 bytes headerSize = readDWord(con), # 4 bytes flags = readDWord(con), # 4 bytes = 32 bits volumeIdOffset = readDWord(con), # 4 bytes localBasePathOffset = readDWord(con), # 4 bytes commonNetworkRelativeLinkOffset = readDWord(con), # 4 bytes commonPathSuffixOffset = readDWord(con) # 4 bytes ) nbrOfBytesRead <- 7*4L .stop_if_not(info$size >= 0L) .stop_if_not(info$headerSize >= 0L) .stop_if_not(info$headerSize < info$size) .stop_if_not(info$volumeIdOffset < info$size) .stop_if_not(info$localBasePathOffset < info$size) .stop_if_not(info$commonNetworkRelativeLinkOffset < info$size) .stop_if_not(info$commonPathSuffixOffset < info$size) info$flags <- parseLinkInfoFlags(info$flags) # Validate if (info$flags["VolumeIdAndLocalBasePath"]) { } else { # Sanity checks .stop_if_not(info$volumeIdOffset == 0L) .stop_if_not(info$localBasePathOffset == 0L) if (info$headerSize >= 0x00000024) { .stop_if_not(info$localBasePathOffsetUnicode == 0L) } } # Validate if (info$flags["CommonNetworkRelativeLinkAndPathSuffix"]) { } else { # Sanity checks .stop_if_not(info$commonNetworkRelativeLinkOffset == 0L) } # LocalBasePathOffsetUnicode (optional) if (info$headerSize >= 0x00000024) { info$localBasePathOffsetUnicode <- readDWord(con) nbrOfBytesRead <- nbrOfBytesRead + 4L # Sanity check if (info$flags["VolumeIdAndLocalBasePath"]) { .stop_if_not(info$localBasePathOffsetUnicode >= 0L) } else { .stop_if_not(info$localBasePathOffsetUnicode == 0L) } } .stop_if_not(nbrOfBytesRead <= info$size) # CommonPathSuffixOffsetUnicode (optional) if (info$headerSize >= 0x00000024) { info$commonPathSuffixOffsetUnicode <- readDWord(con) nbrOfBytesRead <- nbrOfBytesRead + 4L # Sanity check if (info$flags["VolumeIdAndLocalBasePath"]) { .stop_if_not(info$commonPathSuffixOffsetUnicode >= 0L) } else { .stop_if_not(info$commonPathSuffixOffsetUnicode == 0L) } } .stop_if_not(nbrOfBytesRead <= info$size) # VolumeId (variable) if (info$flags["VolumeIdAndLocalBasePath"]) { offset <- info$volumeIdOffset - nbrOfBytesRead .stop_if_not(offset >= 0L) if (offset > 0L) { readRaw(con, n=offset) nbrOfBytesRead <- nbrOfBytesRead + offset } id <- readVolumeId(con) nbrOfBytesRead <- nbrOfBytesRead + id$volumeIdSize if (clean) { id$volumeIdSize <- NULL id$volumeLabelOffset <- NULL } info$volumeId <- id } .stop_if_not(nbrOfBytesRead <= info$size) # LocalBasePath (variable) if (info$flags["VolumeIdAndLocalBasePath"]) { offset <- info$localBasePathOffset .stop_if_not(offset >= 0L) if (offset > 0L) { offset <- offset - nbrOfBytesRead .stop_if_not(offset >= 0L) if (offset > 0L) { readRaw(con, n=offset) nbrOfBytesRead <- nbrOfBytesRead + offset } nextOffset <- info$commonNetworkRelativeLinkOffset if (nextOffset == 0L || is.null(nextOffset)) { nextOffset <- info$commonPathSuffixOffset if (nextOffset == 0L || is.null(nextOffset)) { stop("XXX") } } n <- nextOffset - nbrOfBytesRead localBasePath <- readRaw(con, n=n) nbrOfBytesRead <- nbrOfBytesRead + n info$localBasePath <- rawToChar(localBasePath) } } .stop_if_not(nbrOfBytesRead <= info$size) # CommonNetworkRelativeLink (variable) if (info$flags["CommonNetworkRelativeLinkAndPathSuffix"]) { readCommonNetworkRelativeLink <- function(con, ...) { parseCommonNetworkRelativeLinkFlags <- function(x, ...) { keys <- c("ValidDevice", "ValidNetType") x <- intToBits(x, names=keys) x } # parseCommonNetworkRelativeLinkFlags() link <- list( size = readDWord(con), # 4 bytes flags = readDWord(con), # 4 bytes netNameOffset = readDWord(con), # 4 bytes deviceNameOffset = readDWord(con), # 4 bytes networkProviderType = readDWord(con) # 4 bytes ) # Validate .stop_if_not(link$size >= 0x00000014) .stop_if_not(link$netNameOffset >= 0L) .stop_if_not(link$deviceNameOffset >= 0L) nbrOfBytesRead <- 5*4L link$flags <- parseCommonNetworkRelativeLinkFlags(link$flags) if (!link$flags["ValidDevice"]) { .stop_if_not(link$deviceNameOffset == 0L) } if (!link$flags["ValidNetType"]) { .stop_if_not(link$netProviderType == 0L) } if (link$netNameOffset > 0x00000014) { link$netNameOffsetUnicode <- readDWord(con) nbrOfBytesRead <- nbrOfBytesRead + 4L .stop_if_not(link$netNameOffsetUnicode >= 0L) link$deviceNameOffsetUnicode <- readDWord(con) nbrOfBytesRead <- nbrOfBytesRead + 4L .stop_if_not(link$deviceNameOffsetUnicode >= 0L) } # NetName (variable) nextOffset <- link$deviceNameOffset if (nextOffset == 0L) { nextOffset <- link$netNameOffsetUnicode if (is.null(nextOffset)) { nextOffset <- link$deviceNameOffsetUnicode if (is.null(nextOffset)) { nextOffset <- link$size + 1L } } } .stop_if_not(!is.null(nextOffset)) offset <- link$netNameOffset - nbrOfBytesRead .stop_if_not(offset >= 0L) if (offset > 0L) { readRaw(con, n=offset) nbrOfBytesRead <- nbrOfBytesRead + offset } n <- nextOffset - nbrOfBytesRead - 1L netName <- readRaw(con, n=n) nbrOfBytesRead <- nbrOfBytesRead + n link$netName <- rawToChar(netName) # DeviceName (variable) if (link$flags["ValidDevice"]) { nextOffset <- link$netNameOffsetUnicode if (is.null(nextOffset)) { nextOffset <- link$deviceNameOffsetUnicode if (is.null(nextOffset)) { nextOffset <- link$size + 1L } } .stop_if_not(!is.null(nextOffset)) offset <- link$deviceNameOffset - nbrOfBytesRead .stop_if_not(offset >= 0L) if (offset > 0L) { readRaw(con, n=offset) nbrOfBytesRead <- nbrOfBytesRead + offset } n <- nextOffset - nbrOfBytesRead - 1L netName <- readRaw(con, n=n) nbrOfBytesRead <- nbrOfBytesRead + n link$deviceName <- rawToChar(netName) } # NetNameOffsetUnicode (variable) if (!is.null(link$netNameOffsetUnicode)) { nextOffset <- link$deviceNameOffsetUnicode if (is.null(nextOffset)) { nextOffset <- link$size + 1L } .stop_if_not(!is.null(nextOffset)) offset <- link$netNameOffsetUnicode - nbrOfBytesRead .stop_if_not(offset >= 0L) if (offset > 0L) { readRaw(con, n=offset) nbrOfBytesRead <- nbrOfBytesRead + offset } n <- nextOffset - nbrOfBytesRead - 1L netName <- readRaw(con, n=n) nbrOfBytesRead <- nbrOfBytesRead + n link$netNameOffsetUnicode <- rawToChar(netName) } # DeviceNameOffsetUnicode (variable) if (!is.null(link$deviceNameOffsetUnicode)) { nextOffset <- link$size + 1L .stop_if_not(!is.null(nextOffset)) offset <- link$deviceNameOffsetUnicode - nbrOfBytesRead .stop_if_not(offset >= 0L) if (offset > 0L) { readRaw(con, n=offset) nbrOfBytesRead <- nbrOfBytesRead + offset } n <- nextOffset - nbrOfBytesRead - 1L value <- readRaw(con, n=n) nbrOfBytesRead <- nbrOfBytesRead + n link$deviceNameOffsetUnicode <- rawToChar(value) } link } # readCommonNetworkRelativeLink() offset <- info$commonNetworkRelativeLinkOffset - nbrOfBytesRead .stop_if_not(offset >= 0L) if (offset > 0L) { readRaw(con, n=offset) nbrOfBytesRead <- nbrOfBytesRead + offset } info$commonNetworkRelativeLink <- readCommonNetworkRelativeLink(con) n <- info$commonNetworkRelativeLink$size nbrOfBytesRead <- nbrOfBytesRead + n if (clean) { info$commonNetworkRelativeLink$flags <- NULL info$commonNetworkRelativeLink$size <- NULL info$commonNetworkRelativeLink$netNameOffset <- NULL info$commonNetworkRelativeLink$deviceNameOffset <- NULL } } .stop_if_not(nbrOfBytesRead <= info$size) # CommonPathSuffix (variable) offset <- info$commonPathSuffixOffset if (!is.null(offset) && (offset < info$size)) { offset <- offset - nbrOfBytesRead .stop_if_not(offset >= 0L) if (offset > 0L) { readRaw(con, n=offset) nbrOfBytesRead <- nbrOfBytesRead + offset } nextOffset <- info$localBasePathUnicode if (is.null(nextOffset)) { nextOffset <- info$commonPathSuffixUnicode if (is.null(nextOffset)) { nextOffset <- info$size + 1L } } .stop_if_not(!is.null(nextOffset)) n <- nextOffset - nbrOfBytesRead - 1L value <- readRaw(con, n=n) nbrOfBytesRead <- nbrOfBytesRead + n info$commonPathSuffix <- rawToChar(value) } .stop_if_not(nbrOfBytesRead <= info$size) # LocalBasePathUnicode (variable) offset <- info$localBasePathOffsetUnicode if (!is.null(offset) && (offset < info$size)) { offset <- offset - nbrOfBytesRead .stop_if_not(offset >= 0L) if (offset > 0L) { readRaw(con, n=offset) nbrOfBytesRead <- nbrOfBytesRead + offset } nextOffset <- info$commonPathSuffixUnicode if (is.null(nextOffset)) { nextOffset <- info$size + 1L } .stop_if_not(!is.null(nextOffset)) n <- nextOffset - nbrOfBytesRead - 1L value <- readRaw(con, n=n) nbrOfBytesRead <- nbrOfBytesRead + n info$localBasePathUnicode <- rawToChar(value) } .stop_if_not(nbrOfBytesRead <= info$size) # CommonPathSuffixUnicode (variable) offset <- info$commonPathOffsetUnicode if (!is.null(offset) && (offset < info$size)) { offset <- offset - nbrOfBytesRead .stop_if_not(offset >= 0L) if (offset > 0L) { readRaw(con, n=offset) nbrOfBytesRead <- nbrOfBytesRead + offset } nextOffset <- info$size + 1L n <- nextOffset - nbrOfBytesRead - 1L value <- readRaw(con, n=n) nbrOfBytesRead <- nbrOfBytesRead + n info$commonPathSuffixUnicode <- rawToChar(value) } .stop_if_not(nbrOfBytesRead <= info$size) .stop_if_not(nbrOfBytesRead == info$size) if (clean) { info$size <- NULL info$flags <- NULL info$headerSize <- NULL info$volumeIdOffset <- NULL info$localBasePathOffset <- NULL info$commonNetworkRelativeLinkOffset <- NULL info$commonPathSuffixOffset <- NULL } info } # readLinkInfo() readStringData <- function(con, ...) { data <- list( countCharacters = readWord(con) # 2 bytes ) value <- readRaw(con, n=2*data$countCharacters) value <- matrix(value, nrow=2L) value <- value[1L,] value <- rawToChar(value) data$string <- value .stop_if_not(nchar(data$string) == data$countCharacters) if (clean) { data <- data$string } data } # readStringData() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'con': if (is.character(con)) { con <- file(con, open="") } if (inherits(con, "connection")) { if (!isOpen(con)) { open(con, open="rb") on.exit({ if (inherits(con, "connection") && isOpen(con)) close(con) }) } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # File header # Shell item ID list # Item 1 # Item 2 # etc.. # File locator info # Local path # Network path # Description string # Relative path string # Working directory string # Command line string # Icon filename string # Extra stuff # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - lnk <- list() lnk$header <- readShellLinkHeader(con) if (verbose) { message("File header read:") message(paste(capture.output(lnk$header), collapse="\n")) } if (lnk$header$linkFlags["HasLinkTargetIdList"]) { lnk$idList <- readLinkTargetIdList(con) } if (lnk$header$linkFlags["HasLinkInfo"]) { lnk$linkInfo <- readLinkInfo(con) } keys <- c("HasName", "HasRelativePath", "HasWorkingDir", "HasArguments", "HasIconLocation") if (any(lnk$header$linkFlags[keys])) { lnk$stringData <- list() stringData <- list() if (lnk$header$linkFlags["HasName"]) { stringData$name <- readStringData(con) } if (lnk$header$linkFlags["HasRelativePath"]) { stringData$relativePath <- readStringData(con) } if (lnk$header$linkFlags["HasWorkingDir"]) { stringData$workingDir <- readStringData(con) } if (lnk$header$linkFlags["HasArguments"]) { stringData$commandLineArguments <- readStringData(con) } if (lnk$header$linkFlags["HasIconLocation"]) { stringData$iconLocation <- readStringData(con) } lnk$stringData <- stringData } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # For convenience # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - key <- "relativePath" if (is.element(key, names(lnk$stringData))) { value <- lnk$stringData[[key]] if (!clean) { value <- value$data } lnk$relativePathname <- value } key <- "localBasePath" if (is.element(key, names(lnk$linkInfo))) { path <- lnk$linkInfo[[key]] lnk$pathname <- file.path(path, lnk$linkInfo$commonPathSuffix, fsep="") } key <- "commonNetworkRelativeLink" if (is.element(key, names(lnk$linkInfo))) { path <- lnk$linkInfo[[key]]$netName lnk$networkPathname <- file.path(path, lnk$linkInfo$commonPathSuffix, fsep="\\") } lnk }) # readWindowsShellLink() ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/fileAccess.R������������������������������������������������������������������������������0000644�0001762�0000144�00000017250�14372747611�014220� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault fileAccess # # @title "Checks the permission of a file or a directory" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{pathname}{A @character string of the file or the directory # to be checked.} # \item{mode}{An @integer (0,1,2,4), cf. @see "base::file.access".} # \item{safe}{If @TRUE, the permissions are tested more carefully, # otherwise @see "base::file.access" is used.} # \item{...}{Not used.} # } # # \value{ # Returns an @integer; 0 if the permission exists, -1 if not. # } # # \details{ # In \R there is @see "base::file.access" for checking whether the # permission of a file. # Unfortunately, that function cannot be 100\% trusted depending on # platform used and file system queried, cf. [1]. # } # # \section{Symbolic links}{ # This function follows symbolic links (also on Windows) and returns a # value based on the link target (rather than the link itself). # } # # @examples "../incl/fileAccess.Rex" # # \seealso{ # @see "base::file.access" # } # # \references{ # [1] R-devel thread # \emph{file.access() on network (mounted) drive on Windows Vista?} # on Nov 26, 2008. # \url{https://stat.ethz.ch/pipermail/r-devel/2008-December/051461.html}\cr # [2] Filesystem permissions, Wikipedia, 2010. # \url{https://en.wikipedia.org/wiki/Filesystem_permissions}\cr # } # # @author # # @keyword IO # @keyword programming #*/########################################################################### setMethodS3("fileAccess", "default", function(pathname, mode=0, safe=TRUE, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'pathname': pathname <- Arguments$getCharacter(pathname) # Argument 'mode': if (!is.element(mode, c(0, 1, 2, 4))) { throw("Value of argument 'mode' is unknown: ", mode) } # Follow symbol file links pathname0 <- pathname pathnameT <- Sys.readlink2(pathname, what="corrected") if (!is.na(pathnameT) && nchar(pathnameT, type="chars") > 0L) { pathname <- pathnameT } # base::file.access() fa <- file.access(pathname, mode=mode) names(fa) <- NULL if (!safe) return(fa) # If file doesn't exists, then we have none of the permission either. fe <- file.exists(pathname) if (!fe) return(-1L) # This is a workaround to make sure any connection opened inside a # tryCatch() statement is closed again. con <- NULL on.exit({ if (!is.null(con)) close(con) }) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # mode = 0: Test for existence of file # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (mode == 0) { faSafe <- -as.integer(!fe) if (fa != faSafe) { warning("file.access(..., mode=0) and file.exists() gives different results (", fa, " != ", faSafe, "). Will use the file.exists() results: ", pathname0) } return(faSafe) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # mode = 1: Test for executable permission of file # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (mode == 1) { faSafe <- fa if (isDirectory(pathname)) { # No particular test exists for this case, rely on file.access(). } else if (isFile(pathname)) { fi <- file.info(pathname) # Specific test, if on Windows if (!is.null(fi$exe)) { isExecutable <- (fi$exe != "no") faSafe <- -as.integer(!isExecutable) if (fa != faSafe) { warning("file.access(..., mode=1) and file.info()$exe gives different results (", fa, " != ", faSafe, "). Will use the file.info() results: ", pathname0) } } } return(faSafe) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # mode = 2: Test for write permission of file # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (mode == 2) { # In case a symbolic link was followed pathname <- pathname0 if (isDirectory(pathname)) { # "The write permission, [...] for a directory, this permission # grants the ability to modify entries in the directory. This # includes creating files, deleting files, and renaming files." [2] # (a) Generate a random filename that does not already exist path <- pathname pathname <- NULL ## Produce random filename *without* changing the global RNG state withSeed({ for (n in 1:16) { for (k in 1:50) { chars <- sample(c(base::letters, base::LETTERS), size=n) filename <- paste(chars, collapse="") pathname <- file.path(path, filename) if (!file.exists(pathname)) break pathname <- NULL } if (!is.null(pathname)) break } # for (n ...) }, seed = NULL) if (is.null(pathname)) { stop("Failed to produce a non-existing random filename in folder ", sQuote(path)) } # (b) Try to open the random filename for writing faSafe <- -1L tryCatch({ suppressWarnings({ con <- file(pathname, open="ab") }) # If we get here, we have permission faSafe <- 0L }, error = function(ex) { # If we end up here, we do not have permissions }) # Close connection and remove temporary file if (!is.null(con) && file.exists(pathname)) { close(con) con <- NULL file.remove(pathname) } if (fa != faSafe) { warning("file.access(..., mode=2) and file(..., open=\"ab\") gives different results (", fa, " != ", faSafe, "). Will use the file() results: ", pathname) } return(faSafe) } # if (isDirectory(pathname)) # This is actually redundant, because of the above file.exists() test, # but we keep it here to make it explicit what we are doing. if (!isFile(pathname)) { # If the file does not exist, we have no permissions. return(fa) } faSafe <- -1L tryCatch({ # (a) Try to open the file for writing suppressWarnings({ con <- file(pathname, open="ab") }) # If we get here, we have permission faSafe <- 0L }, error = function(ex) { # If we end up here, we do not have permissions }) if (fa != faSafe) { warning("file.access(..., mode=2) and file(..., open=\"ab\") gives different results (", fa, " != ", faSafe, "). Will use the file() results: ", pathname) } return(faSafe) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # mode = 4: Test for read permission of file # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (mode == 4) { # In case a symbolic link was followed pathname <- pathname0 faSafe <- -1L tryCatch({ if (isFile(pathname)) { # (a) Try to open the file for reading con <- file(pathname, open="rb") # (b) Try even to read one byte bfr <- readBin(con, what=raw(), n=1L) } else { # (a) Try to list directory [Will this take a lot of time?!?] dummy <- list.files(path=pathname) } # If we get here, we have permission faSafe <- 0L }, error = function(ex) { # If we end up here, we do not have permissions }) if (fa != faSafe) { warning("file.access(..., mode=4) and file(..., open=\"rb\")+readBin() gives different results (", fa, " != ", faSafe, "). Will use the file()+readBin() results: ", pathname) } return(faSafe) } return(-1L) }) ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/downloadFile.R����������������������������������������������������������������������������0000644�0001762�0000144�00000017646�14372747611�014577� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @set "class=character" # @RdocMethod downloadFile # @alias downloadFile # # @title "Downloads a file" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{url}{A @character string specifying the URL to be downloaded.} # \item{filename, path}{(optional) @character strings specifying the # local filename and the path of the downloaded file.} # \item{skip}{If @TRUE, an already downloaded file is skipped.} # \item{overwrite}{If @TRUE, an already downloaded file is overwritten, # otherwise an error is thrown.} # \item{...}{Additional arguments passed to @see "utils::download.file".} # \item{username, password}{@character strings specifying the username # and password for authenticated downloads. The alternative is to # specify these via the URL.} # \item{binary}{If @TRUE, the file is downloaded exactly "as is", that is, # byte by byte (recommended).} # \item{dropEmpty}{If @TRUE and the downloaded file is empty, the file # is ignored and @NULL is returned.} # \item{verbose}{A @logical, @integer, or a @see "Verbose" object.} # } # # \value{ # Returns the local pathname to the downloaded filename, # or @NULL if no file was downloaded. # } # # \details{ # Currently arguments \code{username} and \code{password} are only used # for downloads via URL protocol 'https'. The 'https' protocol requires # that either of 'curl' or 'wget' are available on the system. # } # # \examples{\dontrun{ # pathname <- downloadFile("https://www.r-project.org/index.html", path="www.r-project.org/") # print(pathname) # }} # # @author # # \seealso{ # Internally @see "utils::download.file" is used. # That function may generate an empty file if the URL is not available. # } # # @keyword programming # @keyword file #*/########################################################################### setMethodS3("downloadFile", "character", function(url, filename=basename(url), path=NULL, skip=TRUE, overwrite=!skip, ..., username=NULL, password=NULL, binary=TRUE, dropEmpty=TRUE, verbose=FALSE) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'url': url <- Arguments$getCharacter(url) # Argument 'skip': skip <- Arguments$getLogical(skip) # Argument 'overwrite': overwrite <- Arguments$getLogical(overwrite) # Argument 'filename' & 'path': filename <- Arguments$getReadablePathname(filename, adjust="url", mustExist=FALSE) pathname <- Arguments$getWritablePathname(filename, path=path, mustNotExist=(!overwrite && !skip)) # Argument 'username': if (!is.null(username)) { username <- Arguments$getCharacter(username) } # Argument 'password': if (!is.null(password)) { password <- Arguments$getCharacter(password) } # Argument 'binary': binary <- Arguments$getLogical(binary) # Argument 'verbose': verbose <- Arguments$getVerbose(verbose) if (verbose) { pushState(verbose) on.exit(popState(verbose)) } verbose && enter(verbose, "Downloading URL") verbose && cat(verbose, "URL: ", url) protocol <- gsub("^([^:]*)://.*", "\\1", url, ignore.case=TRUE) protocol <- tolower(protocol) verbose && cat(verbose, "Protocol: ", protocol) # Is username and password given by the URL? pattern <- "^([^:]*)://([^:]*):([^:]*)@.*" if (regexpr(pattern, url) != -1) { if (!is.null(username)) { warning("Argument 'username' was overridden by username specified by argument 'url'.") } if (!is.null(password)) { warning("Argument 'password' was overridden by password specified by argument 'url'.") } username <- gsub(pattern, "\\2", url) password <- gsub(pattern, "\\3", url) } verbose && cat(verbose, "Pathname: ", pathname) if (isFile(pathname)) { if (skip) { verbose && cat(verbose, "Already downloaded. Skipping.") verbose && exit(verbose) return(pathname) } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Download to a temporary pathname # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - pathnameT <- sprintf("%s.tmp", pathname) pathnameT <- Arguments$getWritablePathname(pathnameT, mustNotExist=TRUE) on.exit({ if (isFile(pathnameT)) { file.remove(pathnameT) } }, add=TRUE) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Download file # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - verbose && enter(verbose, "Downloading") if (is.element(protocol, c("https"))) { verbose && enter(verbose, "Downloading via HTTPS") # Locate external executables bin <- Sys.which(c("curl", "wget")) verbose && cat(verbose, "Available external executables:") verbose && print(verbose, bin) keep <- nzchar(bin) if (!any(keep)) { throw("Cannot download file over HTTPS protocol. Failed to locate external download software (%s): %s", paste(sQuote(names(bin)), collapse=", "), url) } bin <- bin[keep] bin <- bin[1L] verbose && printf(verbose, "Using external download software %s: %s\n", sQuote(names(bin)), bin) verbose && enter(verbose, "Setting up command-line options") # Command-line options args <- NULL if (names(bin) == "curl") { # Less strict (=more likely to succeed) arg <- "--insecure" args <- c(args, arg) # Follow redirects arg <- "--location" args <- c(args, arg) if (!is.null(username)) { arg <- sprintf("--user %s", username) if (!is.null(password)) { arg <- sprintf("%s:%s", arg, password) } args <- c(args, arg) } # Output file arg <- sprintf("--output \"%s\"", pathnameT) args <- c(args, arg) # URL to download args <- c(args, url) } else if (names(bin) == "wget") { # Less strict (=more likely to succeed) arg <- "--no-check-certificate" args <- c(args, arg) if (!is.null(username)) { arg <- sprintf("--http-user=%s", username) args <- c(args, arg) } if (!is.null(password)) { arg <- sprintf("--http-passwd=%s", password) args <- c(args, arg) } # Output file arg <- sprintf("--output-document=\"%s\"", pathnameT) args <- c(args, arg) # URL to download args <- c(args, url) } verbose && print(verbose, args) verbose && exit(verbose) res <- system2(bin, args=args) verbose && exit(verbose) } else { mode <- ifelse(binary, "wb", "w") verbose && cat(verbose, "Download mode: ", mode) res <- download.file(url, destfile=pathnameT, mode=mode, quiet=!isVisible(verbose), ...) } verbose && cat(verbose, "Downloading finished\n") verbose && cat(verbose, "Download result:", res) verbose && exit(verbose) # Remove failed or "empty" downloads fi <- file.info2(pathnameT) verbose && cat(verbose, "Downloaded file:") verbose && str(verbose, fi) if (res != 0 || is.na(fi$size) || (dropEmpty && fi$size == 0)) { file.remove(pathnameT) verbose && cat(verbose, "Removed downloaded file because download failed or the file was empty: ", pathnameT) pathnameT <- NULL pathname <- NULL } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Rename temporary pathname # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (!is.null(pathnameT)) { file.rename(pathnameT, pathname) if (!isFile(pathname)) { throw("Failed to rename temporary filename: ", pathnameT, " -> ", pathname) } if (isFile(pathnameT)) { throw("Failed to remove temporary filename: ", pathnameT) } } verbose && exit(verbose) pathname }) ������������������������������������������������������������������������������������������R.utils/R/removeDirectory.R�������������������������������������������������������������������������0000644�0001762�0000144�00000005435�14372747611�015343� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault removeDirectory # # @title "Removes a directory" # # \description{ # @get "title", and if requested, also its contents. # } # # @synopsis # # \arguments{ # \item{path}{A @character string specifying the directory to be removed.} # \item{recursive}{If @TRUE, subdirectories and files are also removed. # If @FALSE, and directory is non-empty, an exception is thrown.} # \item{mustExist}{If @TRUE, and the directory does not exist, # an exception is thrown.} # \item{...}{Not used.} # } # # \value{ # Returns (invisibly) @TRUE, the directory was successfully removed, # otherwise @FALSE, unless an exception is thrown. # } # # \section{Symbolic links}{ # This function can also be used to remove symbolic links to directories # without removing the target. # Note that neither @see "base::file.remove" nor @see "base::unlink" # is capable of remove symbolic \emph{directory} links on Windows. # } # # @author # # \seealso{ # Internally @see "base::unlink" is used. # } # # @keyword IO # @keyword programming #*/########################################################################### setMethodS3("removeDirectory", "default", function(path, recursive=FALSE, mustExist=TRUE, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'path': path <- Arguments$getReadablePath(path, mustExist=mustExist) # WORKAROUND: base::unlink() does not support paths with leading tilde, # cf. https://stat.ethz.ch/pipermail/r-help/2010-October/254998.html # /HB 2010-11-17 path <- path.expand(path) path <- Arguments$getReadablePath(path, mustExist=mustExist) # Argument 'recursive': recursive <- Arguments$getLogical(recursive) # Check if a symbolic link pathT <- Sys.readlink2(path, what="corrected") isSymlink <- (!is.na(pathT) && nchar(pathT, type="chars") > 0L) if (isSymlink) { # Special case: Windows if (.Platform$OS.type == "windows") { cmd <- sprintf("rmdir %s", dQuote(normalizePath(path))) shell(cmd, shell=Sys.getenv("COMSPEC"), intern=TRUE, mustWork=TRUE) } else { file.remove(path) } return(invisible(!isDirectory(path))) } # Check if directory is empty pathnames <- list.files(path=path, all.files=TRUE, full.names=FALSE) pathnames <- setdiff(pathnames, c(".", "..")) isEmpty <- (length(pathnames) == 0) if (!isEmpty && !recursive) { throw("Cannot remove directory. Directory is not empty: ", path) } # Remove directory (if 'recursive' is FALSE, the actual directory # will not be removed). res <- unlink(path, recursive=TRUE) return(invisible(!isDirectory(path))) }) # removeDirectory() �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/withSeed.R��������������������������������������������������������������������������������0000644�0001762�0000144�00000005222�14525546077�013732� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocFunction withSeed # # @title "Evaluate an R expression with a temporarily set random set" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{expr}{The R expression to be evaluated.} # \item{seed, ...}{Arguments passed to @see "base::set.seed".} # \item{substitute}{If @TRUE, argument \code{expr} is # \code{\link[base]{substitute}()}:ed, otherwise not.} # \item{envir}{The @environment in which the expression should be evaluated.} # } # # \value{ # Returns the results of the expression evaluated. # } # # \details{ # Upon exit (also on errors), this function will restore # @see "base::.Random.seed" in the global environment to the value # it had upon entry. If it did not exist, it will be removed. # } # # @author # # @examples "../incl/withSeed.Rex" # # \seealso{ # Internally, @see "base::set.seed" is used to set the random seed. # } # # @keyword IO # @keyword programming #*/########################################################################### withSeed <- local({ if (getRversion() < "3.0.0") { set.seed <- function(seed, ...) { ## Re-initialize the RNG state? if (is.null(seed)) { if (exists(".Random.seed", envir=globalenv(), inherits=FALSE)) { rm(list=".Random.seed", envir=globalenv(), inherits=FALSE) } sample.int(1L) return(invisible()) } base::set.seed(seed=seed, ...) } } function(expr, seed, ..., substitute=TRUE, envir=parent.frame()) { # Argument 'expr': if (substitute) expr <- substitute(expr) # Argument 'envir': if (!is.environment(envir)) throw("Argument 'envir' is not a list: ", class(envir)[1L]) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Record entry seed # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - env <- globalenv() oseed <- env$.Random.seed # Restore on exit on.exit({ if (is.null(oseed)) { rm(list=".Random.seed", envir=env, inherits=FALSE) } else { assign(".Random.seed", value=oseed, envir=env, inherits=FALSE) } }) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Set temporary seed # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - set.seed(seed=seed, ...) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Evaluate expression # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - eval(expr, envir = envir, enclos = baseenv()) } # withSeed() }) ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/findSourceTraceback.R���������������������������������������������������������������������0000644�0001762�0000144�00000005033�14372747611�016054� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault findSourceTraceback # # @title "Finds all 'srcfile' objects generated by source() in all call frames" # # @synopsis # # \description{ # @get "title". This makes it possible to find out which files are # currently scripted by @see "base::source". # } # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns a named list of @see "base::srcfile" objects and/or # @character strings. # The names of the list entries corresponds to the 'filename' # value of each corresponding 'srcfile' object. # The returned list is empty if @see "base::source" was not called. # } # # @examples "../incl/findSourceTraceback.Rex" # # @author # # \seealso{ # See also @see "utils::sourceutils". # } # # @keyword IO # @keyword programming #*/########################################################################### setMethodS3("findSourceTraceback", "default", function(...) { # Identify the environment/frame of interest by making sure # it at least contains all the arguments of source(). argsToFind <- names(formals(base::source)) # Scan the call frames/environments backwards... srcfileList <- list() for (ff in sys.nframe():0) { env <- sys.frame(ff) # Does the environment look like a source() environment? exist <- sapply(argsToFind, FUN=exists, envir=env, inherits=FALSE) if (!all(exist)) { # Nope, then skip to the next one next } # Identity the source file if (exists("srcfile", envir=env, inherits=FALSE)) { srcfile <- get("srcfile", envir=env, inherits=FALSE) } else { ## AD HOC: Needed when for instance 'XML' is attached srcfile <- get("srcfile", envir=env, inherits=TRUE) ## Failed? if (!inherits(srcfile, "srcfile")) srcfile <- NULL } if (!is.null(srcfile)) { if (!is.function(srcfile)) { srcfileList <- c(srcfileList, list(srcfile)) } } } # for (ff ...) # Extract the pathnames to the files called pathnames <- sapply(srcfileList, FUN=function(srcfile) { if (inherits(srcfile, "srcfile")) { pathname <- srcfile$filename } else if (is.environment(srcfile)) { pathname <- srcfile$filename } else if (is.character(srcfile)) { # Occurs with source(..., keep.source=FALSE) pathname <- srcfile } else { pathname <- NA_character_ warning("Unknown class of 'srcfile': ", class(srcfile)[1L]) } pathname }) names(srcfileList) <- pathnames srcfileList }) # findSourceTraceback() �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/countLines.R������������������������������������������������������������������������������0000644�0001762�0000144�00000004773�14372747611�014310� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault countLines # # @title "Counts the number of lines in a text file" # # \description{ # @get "title" by counting the number of occurrences of platform-independent # newlines (CR, LF, and CR+LF [1]), including a last line with neither. # An empty file has zero lines. # } # # @synopsis # # \arguments{ # \item{file}{A @connection or a pathname.} # \item{chunkSize}{The number of bytes read in each chunk.} # \item{...}{Not used.} # } # # \value{ # Returns an non-negative @integer. # } # # \details{ # Both compressed and non-compressed files are supported. # } # # @author # # @examples "../incl/countLines.Rex" # # \references{ # [1] Page \emph{Newline}, Wikipedia, July 2008. # \url{https://en.wikipedia.org/wiki/Newline} # } # # @keyword programming #*/########################################################################### setMethodS3("countLines", "default", function(file, chunkSize=50e6, ...) { # Argument 'file': if (inherits(file, "connection")) { con <- file } else { file <- as.character(file) con <- gzfile(file, open="rb") on.exit(close(con)) } LF <- as.raw(0x0a) CR <- as.raw(0x0d) SPC <- as.raw(32L) isLastCR <- isLastLF <- FALSE isEmpty <- TRUE nbrOfLines <- 0L while(TRUE) { bfr <- readBin(con=con, what=raw(), n=chunkSize) if (isLastCR) { # Don't count LF following a CR in previous chunk. if (bfr[1L] == LF) bfr[1L] <- SPC } n <- length(bfr) if (n == 0L) break isEmpty <- FALSE # Replace all CRLF:s to become LF:s idxsCR <- which(bfr == CR) nCR <- length(idxsCR) if (nCR > 0L) { idxsCRLF <- idxsCR[(bfr[idxsCR + 1L] == LF)] if (length(idxsCRLF) > 0L) { bfr <- bfr[-idxsCRLF] n <- length(bfr) idxsCRLF <- NULL; # Not needed anymore nCR <- length(which(bfr == CR)) } } # Count all CR:s and LF:s nLF <- length(which(bfr == LF)) nbrOfLines <- nbrOfLines + (nCR + nLF) if (n == 0L) { isLastCR <- isLastLF <- FALSE } else { # If last symbol is CR it might be followed by a LF in # the next chunk. If so, don't count that next LF. bfrN <- bfr[n] isLastCR <- (bfrN == CR) isLastLF <- (bfrN == LF) } } # while() # Count any last line without newline too if (!isEmpty) { if (!isLastLF) nbrOfLines <- nbrOfLines + 1L attr(nbrOfLines, "lastLineHasNewline") <- isLastLF } nbrOfLines }) �����R.utils/R/intToHex.R��������������������������������������������������������������������������������0000644�0001762�0000144�00000005721�14372747611�013721� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������########################################################################/** # @RdocFunction format.binmode # @alias as.character.binmode # # @title "Converts a binary/octal/hexadecimal number into a string" # # \description{ # @get "title". # } # # \usage{ # @usage format,binmode # } # # \arguments{ # \item{x}{Object to be converted.} # \item{...}{Not used.} # } # # \value{ # Returns a @character. # } # # @author # # \seealso{ # \code{format.octmode()}, cf. @see "base::octmode". # @see "intToBin" (incl. \code{intToOct()} and \code{intToHex()}). # } # # @keyword manip # @keyword character # @keyword programming #*/######################################################################## setMethodS3("format", "binmode", function(x, ...) { isna <- is.na(x) y <- x[!isna] ans0 <- character(length = length(y)) ## Handle negative values specially; emulates octmode and hexmode neg <- which(y < 0) if (length(neg) > 0) { y[neg] <- y[neg] + 1L + .Machine$integer.max } z <- NULL while (any(y > 0) || is.null(z)) { z <- y %% 2 y <- floor(y / 2) ans0 <- paste(z, ans0, sep = "") } ans <- rep(NA_character_, times = length(x)) ans[!isna] <- ans0 ans }) setMethodS3("as.character", "binmode", function(x, ...) format(x, ...)) ########################################################################/** # @RdocFunction intToBin # @alias intToOct # @alias intToHex # # @title "Converts an integer to a binary/octal/hexadecimal number" # # \description{ # @get "title". # } # # \usage{ # intToBin(x) # intToOct(x) # intToHex(x) # } # # \arguments{ # \item{x}{A @numeric vector of integers to be converted.} # } # # \value{ # Returns a @character string of length \code{length(x)}. # For coercions out of range, \code{NA_character_} is returned for # such elements. # } # # \details{ # For \code{length(x)} > 1, the number of characters in each of returned # elements is the same and driven by the \code{x} element that requires # the highest number of character - all other elements are padded with # zeros (or ones for negative values). This is why we for instance get # \code{intToHex(15) == "f"} but \code{intToHex(15:16) == c("0f", "10")}. # # The supported range for \code{intToHex()}, \code{intToOct()}, and # \code{intToBin()} is that of \R integers, i.e. # \code{[-.Machine$integer.max, +.Machine$integer.max]} where. # \code{.Machine$integer.max} is \eqn{2^31-1}. # This limitation is there such that negative values can be converted too. # } # # @author # # @keyword manip # @keyword character # @keyword programming #*/######################################################################## intToBin <- function(x) { y <- as.integer(x) class(y) <- "binmode" y <- as.character(y) dim(y) <- dim(x) y } intToHex <- function(x) { y <- as.integer(x) class(y) <- "hexmode" y <- format(y) dim(y) <- dim(x) y } intToOct <- function(x) { y <- as.integer(x) class(y) <- "octmode" y <- format(y) dim(y) <- dim(x) y } �����������������������������������������������R.utils/R/readTable.R�������������������������������������������������������������������������������0000644�0001762�0000144�00000030335�14372747611�014041� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������########################################################################/** # @RdocDefault readTable # # @title "Reads a file in table format" # # @synopsis # # \description{ # @get "title" and creates a data frame from it, with cases corresponding # to lines and variables to fields in the file. # # \emph{WARNING: This method is very much in an alpha stage. # Expect it to change.} # # This method is an extension to the default @see "utils::read.table" # function in \R. It is possible to specify a column name to column class # map such that the column classes are automatically assigned from the # column header in the file. # # In addition, it is possible to read any subset of rows. # The method is optimized such that only columns and rows that are of # interest are parsed and read into \R's memory. This minimizes memory # usage at the same time as it speeds up the reading. # } # # \arguments{ # \item{file}{A @connection or a filename. If a filename, the path # specified by \code{path} is added to the front of the # filename. Unopened files are opened and closed at the end.} # \item{colClasses}{Either a named or an unnamed @character @vector. # If unnamed, it specified the column classes just as used by # @see "utils::read.table". # If it is a named vector, \code{names(colClasses)} are used to match # the column names read (this requires that \code{header=TRUE}) and # the column classes are set to the corresponding values. # } # \item{isPatterns}{If @TRUE, the matching of \code{names(colClasses)} to # the read column names is done by regular expressions matching.} # \item{defColClass}{If the column class map specified by a named # \code{colClasses} argument does not match some of the read column # names, the column class is by default set to this class. The # default is to read the columns in an "as is" way.} # \item{header}{If @TRUE, column names are read from the file.} # \item{skip}{The number of lines (commented or non-commented) to skip # before trying to read the header or alternatively the data table.} # \item{nrows}{The number of rows to read of the data table. # Ignored if \code{rows} is specified.} # \item{rows}{An row index @vector specifying which rows of the table # to read, e.g. row one is the row following the header. # Non-existing rows are ignored. Note that rows are returned in # the same order they are requested and duplicated rows are also # returned.} # \item{col.names}{Same as in \code{read.table()}.} # \item{check.names}{Same as in \code{read.table()}, but default value # is @FALSE here.} # \item{path}{If \code{file} is a filename, this path is added to it, # otherwise ignored.} # \item{...}{Arguments passed to @see "utils::read.table" used internally.} # \item{stripQuotes}{If @TRUE, quotes are stripped from values before # being parse. # This argument is only effective when \code{method=="readLines"}. # } # \item{method}{If \code{"readLines"}, \code{(readLines())} is used # internally to first only read rows of interest, which is then # passed to \code{read.table()}. # If \code{"intervals"}, contiguous intervals are first identified in # the rows of interest. These intervals are the read one by one # using \code{read.table()}. # The latter methods is faster and especially more memory efficient # if the intervals are not too many, where as the former is preferred # if many "scattered" rows are to be read.} # \item{verbose}{A @logical or a @see "Verbose" object.} # } # # \value{ # Returns a @data.frame. # } # # @author # # \seealso{ # @see "readTableIndex". # @see "utils::read.table". # @see "colClasses". # } # # @keyword IO #*/######################################################################### setMethodS3("readTable", "default", function(file, colClasses=NULL, isPatterns=FALSE, defColClass=NA, header=FALSE, skip=0, nrows=-1, rows=NULL, col.names=NULL, check.names=FALSE, path=NULL, ..., stripQuotes=TRUE, method=c("readLines", "intervals"), verbose=FALSE) { # Argument 'file' and 'path': if (inherits(file, "connection")) { } else if (is.character(file)) { pathname <- Arguments$getReadablePathname(file, path=path, mustExist=TRUE) file <- file(pathname) } else { throw("Unknown data type of argument 'file': ", mode(file)) } # Argument 'colClasses': # colClasses <- Arguments$getCharacters(colClasses) # Argument 'isPatterns': isPatterns <- Arguments$getLogical(isPatterns) # Argument 'defColClass': defColClass <- Arguments$getCharacter(defColClass, asGString=FALSE) # Argument 'skip': skip <- Arguments$getInteger(skip, range=c(0,Inf)) # Argument 'nrows': nrows <- Arguments$getInteger(nrows) # Argument 'rows': if (!is.null(rows)) rows <- Arguments$getIntegers(rows, range=c(1,Inf)) # Argument 'col.names': if (!is.null(col.names)) col.names <- Arguments$getCharacters(col.names) # Argument 'stripQuotes': stripQuotes <- Arguments$getLogical(stripQuotes) # Argument 'method': method <- match.arg(method) # Argument 'verbose': verbose <- Arguments$getVerbose(verbose) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # If file is not open, open it and close it when done. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (!isOpen(file)) { open(file, open="r") on.exit(close(file), add=TRUE) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Skip lines at the beginning? # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (skip > 0) { readLines(file, n=skip) verbose && cat(verbose, "Skipped the first ", skip, " lines.") skip <- 0 } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Get the formals of read.table() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - formals <- formals(read.table) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Read the header # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (header) { sep <- list(...)$sep if (is.null(sep)) sep <- formals$sep quote <- list(...)$quote if (is.null(quote)) quote <- formals$quote colnames <- scan(file=file, what=character(0), sep=sep, quote=quote, nlines=1, quiet=TRUE) # colnames <- readLines(file, n=1) # colnames <- unlist(strsplit(colnames, split=split)) colnames <- trim(colnames) # if (!is.null(quote) && nchar(quote) > 0) { # } names <- paste("'", colnames, "'", sep="") verbose && cat(verbose, "Read ", length(colnames), " column names: ", paste(names, collapse=", ")) } if (!is.null(col.names)) colnames <- col.names # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Create colClasses? # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - isMap <- !is.null(names(colClasses)) if (!is.null(colClasses) && isMap) { # Should colClasses be found using regular expression # patterns or as is? if (isPatterns) { colClasses2 <- rep(NA_character_, times=length(colnames)) for (kk in seq_along(colClasses)) { pattern <- names(colClasses)[kk] colClass <- colClasses[kk] # Find matching column names and assign the current column # class to those columns. incl <- (regexpr(pattern, colnames) != -1) colClasses2[incl] <- colClass } colClasses <- colClasses2 } else { colClasses <- colClasses[colnames] } colClasses[is.na(colClasses)] <- defColClass verbose && cat(verbose, "Column classes: ") verbose && print(verbose, colClasses) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Read full data table? # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (is.null(rows)) { verbose && enter(verbose, "Reading the complete data table") df <- read.table(file, colClasses=colClasses, header=FALSE, skip=0, nrows=nrows, check.names=check.names, col.names=colnames, ...) verbose && str(verbose, df) verbose && exit(verbose) # Return table return(df) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Read only certain rows? # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (method == "readLines") { # Skip certain lines if (skip > 0) { readLines(file, n=skip) verbose && cat(verbose, "Skipped the first ", skip, " lines.") } # Read all lines verbose && enter(verbose, "Reading lines of interest") t <- system.time({ lines <- readLines(file, n=max(rows)) }, gcFirst = FALSE) verbose && printf(verbose, "Read %d lines in %.2f seconds.\n", length(lines), t[3]) # Did we try to read non-existing rows? keep <- (rows <= length(lines)) rows <- rows[keep] if (verbose && any(!keep)) { verbose && cat(verbose, "Skipped ", sum(!keep), " non-existing rows.") } keep <- NULL; # Not needed anymore # Keep only those of interest lines <- lines[rows] verbose && cat(verbose, "Kept ", length(lines), " lines.") verbose && exit(verbose) if (stripQuotes) { quote <- list(...)$quote if (is.null(quote)) quote <- formals$quote if (nchar(quote) > 0) { verbose && enter(verbose, "Stripping quotes from all lines: ", quote) quotes <- unlist(strsplit(quote, split="")) for (kk in seq_along(quotes)) lines <- gsub(quotes[kk], "", lines, fixed=TRUE) verbose && exit(verbose) } } verbose && enter(verbose, "Re-reading the lines as a data table") con <- textConnection(lines) tryCatch({ t <- system.time({ df <- read.table(con, colClasses=colClasses, header=FALSE, skip=skip, nrows=nrows, check.names=check.names, col.names=colnames, ...) }, gcFirst = FALSE) verbose && printf(verbose, "Read a %dx%d table in %.2f seconds.\n", nrow(df), ncol(df), t[3]) }, finally = { close(con) }) lines <- NULL; # Not needed anymore verbose && exit(verbose) } else if (method == "intervals") { remap <- TRUE rows2 <- unique(rows) if (identical(rows, rows2)) { rows2 <- sort(rows2) if (identical(rows, rows2)) remap <- FALSE } # Get contiguous intervals of rows indices. intervals <- seqToIntervals(rows2) rows2 <- NULL; # Not needed anymore verbose && cat(verbose, "Reading row intervals: ") verbose && print(verbose, intervals) nextRow <- 1 df <- NULL rownames <- NULL ready <- FALSE for (ii in seq_len(nrow(intervals))) { from <- intervals[ii,"from"] to <- intervals[ii,"to"] verbose && cat(verbose, "Interval [", from, ",", to, "]") # Skip to the next row skip <- (from - nextRow) # Read 'nrows' from there on. nrows <- (to-from+1) tryCatch({ dfI <- read.table(file, colClasses=colClasses, header=FALSE, skip=skip, nrows=nrows, check.names=check.names, col.names=colnames, ...) }, error = function(ex) { # Ignore non-existing rows => we're done. ready <<- (regexpr("no lines available", ex$message) != -1) if (!ready) signalCondition(ex) }) if (ready) break # Did we read that many rows? to <- min(to, from+nrow(dfI)-1) # Assign rows names rownames(dfI) <- from:to rownames <- c(rownames, from:to) if (is.null(df)) { df <- dfI } else { df <- rbind(df, dfI) } dfI <- NULL; # Not needed anymore nextRow <- to+1 } # Finally, if 'rows' where not an order sets of unique row numbers, # return a table with rows in the same order as the requested ones. if (remap) { idx <- match(rows, rownames) idx <- idx[!is.na(idx)] df <- df[idx,] rownames <- rownames[idx] idx <- NULL; # Not needed anymore } } verbose && str(verbose, df) # Return table df }) ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/mergeIntervals.R��������������������������������������������������������������������������0000644�0001762�0000144�00000007166�14372747611�015153� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������########################################################################/** # @set "class=numeric" # @RdocMethod mergeIntervals # # @title "Merges intervals" # # @synopsis # # \description{ # @get "title" by returning an index @vector specifying the (first) # interval that each value maps to, if any. # } # # \arguments{ # \item{intervals}{The N intervals to be merged. # If an Nx2 @numeric @matrix, the first column should be the lower # bounds and the second column the upper bounds of each interval. # If a @numeric @vector of length 2N, each consecutive pair should # be the lower and upper bounds of an interval. # } # \item{...}{Not used.} # } # # \value{ # Returns a @matrix (or a @vector) of M intervals, where M <= N. # The intervals are ordered by their lower bounds. # The @mode of the returned intervals is the same as the mode of # the input intervals. # } # # \details{ # The upper and lower bounds are considered to be inclusive, that is, # all intervals are interpreted to be of form [a,b]. # There is currently no way to specify intervals with open bounds, # e.g. (a,b]. # # Furthermore, the bounds are currently treated as real values. # For instance, merging [0,1] and [2,3] will return the same intervals. # Note, if integer intervals were treated specially, we would merge # these intervals to integer interval [0,3] == \{0,1,2,3\}. # } # # @author # # \seealso{ # @see "inAnyInterval". # @see "base::match". # } # # @keyword "utilities" # @keyword "programming" #*/######################################################################### setMethodS3("mergeIntervals", "numeric", function(intervals, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'intervals': if (length(intervals) %% 2 != 0) { throw("Argument 'intervals' does not contain an even number of values: ", length(intervals)) } asMatrix <- is.matrix(intervals) if (!asMatrix) { intervals <- matrix(intervals, ncol=2, byrow=TRUE) } else if (ncol(intervals) != 2) { throw("Argument 'intervals' is not a matrix with two columns: ", ncol(intervals)) } # Sort intervals by the lower bounds o <- order(intervals[,1]) intervals <- intervals[o,,drop=FALSE] rownames(intervals) <- NULL # Not needed anymore o <- NULL # Merge intervals (assuming already ordered) intervals2 <- matrix(as.integer(0), nrow=0, ncol=2) colnames(intervals2) <- colnames(intervals) currInterval <- intervals[1,,drop=FALSE] for (kk in seq(from=2, to=nrow(intervals))) { nextInterval <- intervals[kk,] # Does the next interval overlap with the current one? if (nextInterval[1] <= currInterval[2]) { # Does it stretch beyond the current one? if (nextInterval[2] > currInterval[2]) { # Then merge the two currInterval[2] <- nextInterval[2] nextInterval <- NULL } else { # Drop the next interval because it is fully # included in the current one. nextInterval <- NULL } } else { # The next and current intervals are disjoint. intervals2 <- rbind(intervals2, currInterval) currInterval <- nextInterval } } # for (kk ...) intervals2 <- rbind(intervals2, currInterval) rownames(intervals2) <- NULL # Return intervals a vector of paired intervals if (!asMatrix) { intervals2 <- t(intervals2) intervals2 <- as.vector(intervals2) } intervals2 }) # mergeIntervals() ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/listDirectory.R���������������������������������������������������������������������������0000644�0001762�0000144�00000006157�14372747611�015023� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault listDirectory # # @title "Gets the file names in the directory" # # \description{ # @get "title". # # Contrary to \code{list.files()}, this method guarantees to work # recursively. Moreover, when subdirectories are processed recursively, # directory names are also returned. # } # # @synopsis # # \arguments{ # \item{path}{A path to be listed.} # \item{pattern}{A @character string of the filename pattern passed. See # @see "base::list.files" for more details.} # \item{recursive}{If @TRUE, subdirectories are recursively processed, # and not if @FALSE. Alternatively, the maximum recursive depth can # be specified as a non-negative @numeric, where @FALSE corresponds to # \code{0L} depth and @TRUE corresponds \code{+Inf} depth.} # \item{allNames}{If @TRUE, also files starting with a period are returned.} # \item{fullNames}{If @TRUE, the full path names are returned.} # \item{...}{Not used.} # } # # \value{ # Returns a @vector of file names. # } # # # \section{Recursive searching}{ # Recursive searching of directory structure is done breath-first # in a lexicographic order. # } # # @author # # \seealso{ # Internally @see "base::list.files" is used. # } # # @keyword IO # @keyword programming #*/########################################################################### setMethodS3("listDirectory", "default", function(path=".", pattern=NULL, recursive=FALSE, allNames=FALSE, fullNames=FALSE, ...) { # Argument 'path': path <- as.character(path) if (path == "") path <- "."; # As in Java. # Argument 'recursive': depth <- Arguments$getNumeric(recursive, range=c(0,+Inf)) if (is.logical(recursive) && recursive) depth <- +Inf; ## TRUE => +Inf # Nothing to do? if (!isDirectory(path)) return(NULL) path <- getAbsolutePath(path) # relPath <- getRelativePath(path) relPath <- path # Get the directories (and files) in the current directory dirs <- list.files(relPath, all.files=allNames, full.names=FALSE) dirs <- setdiff(dirs, c(".", "..")) if (length(dirs) == 0L) return(NULL) if (fullNames) { dirs <- file.path(path, dirs) } # Get the files in the current directory if (is.null(pattern)) { files <- dirs } else { files <- list.files(relPath, pattern=pattern, all.files=allNames, full.names=fullNames, ...) } if (depth > 0) { for (dir in dirs) { if (fullNames) { pathT <- dir } else { pathT <- filePath(relPath, dir) } if (isDirectory(pathT)) { # Protect against inifinite loops/depth if (identical(pathT, path) && is.infinite(depth)) { throw("Internal error: Detected infinite recursive call in listDirectory(): ", path) } subfiles <- listDirectory(pathT, pattern=pattern, recursive=depth-1, allNames=allNames, fullNames=fullNames, ...) if (!fullNames) { subfiles <- file.path(dir, subfiles) } files <- c(files, subfiles) } } # for (dir ...) } files }) �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/VComments.R�������������������������������������������������������������������������������0000644�0001762�0000144�00000017626�14525546077�014104� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocClass VComments # # @title "The VComments class" # # \description{ # @classhierarchy # # @get "title". # } # # @synopsis # # \arguments{ # \item{letter}{The smart letter.} # \item{verboseName}{The name of the verbose object.} # \item{...}{Not used.} # } # # \section{Fields and Methods}{ # @allmethods # } # # \details{ # The 'v' in VComments stands for 'verbose', because of its relationship # to the @see "Verbose" class. # # Here is a list of VComments and the \R code that replaces each of them # by the compiler: # # \bold{Constructors}\cr # \describe{ # \item{#V0#}{[<args>] - NullVerbose(<args>)} # \item{#V1#}{[<args>] - Verbose(<args>)} # } # # \bold{Controls}\cr # \describe{ # \item{#V=#}{[<variable>] - Sets the name of the <verbose> object. # Default is 'verbose'.} # \item{#V^#}{<threshold> - setThreshold(<verbose>, <threshold>)} # \item{#V?#}{<expression> - if (isVisible(<verbose>)) \{ <expression> \}} # \item{#V@#}{<level> - setDefaultLevel(<verbose>, <level>)} # \item{#Vm#}{<method> <args> - <method>(<verbose>, <args>)} # } # # \bold{Enters and exits}\cr # \describe{ # \item{#V+#}{[<message>] - enter(<verbose>, <message>)} # \item{#V-#}{[<message>] - exit(<verbose>, <message>)} # \item{#V!#}{[<message>] - pushState(<verbose>)\cr # on.exit(popState(<verbose>))\cr # If <message>, enter(<verbose>, <message>)} # } # # \bold{Simple output}\cr # \describe{ # \item{#Vn#}{<ignored> - newline(<verbose>)} # \item{#Vr#}{<ignored> - ruler(<verbose>)} # \item{#Vt#}{<ignored> - timestamp(<verbose>)} # \item{#Vw#}{[<title>] - warnings(<verbose>, <title>)} # } # # \bold{Output messages}\cr # \describe{ # \item{#Vc#}{[<message>] - cat(<verbose>, <message>)} # \item{#Ve#}{<expression> - eval(<verbose>, <expression>)} # \item{#Vh#}{<message> - header(<verbose>, <message>)} # \item{#Vp#}{<object> - print(<verbose>, <object>)} # \item{#Vs#}{<object> - summary(<verbose>, <object>)} # \item{#Vz#}{<object> - str(<verbose>, <object>)} # } # } # # @examples "../incl/VComments.Rex" # # @author # # @keyword programming # @keyword IO #*/########################################################################### setConstructorS3("VComments", function(letter="V", verboseName="verbose", ...) { verboseName <- as.character(verboseName) extend(SmartComments(letter=letter), "VComments", resetVerboseName = verboseName, verboseName = verboseName ) }) ###########################################################################/** # @RdocMethod reset # # @title "Resets a VComments compiler" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns nothing. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("reset", "VComments", function(this, ...) { NextMethod() this$verboseName <- this$resetVerboseName }) ###########################################################################/** # @RdocMethod convertComment # # @title "Converts a verbose comment to R code" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{vcomment}{A vcomment @list structure.} # \item{.currLine, .line}{A line number and the line currently processed. # Used for error message and warnings.} # \item{...}{Not used.} # } # # \value{ # Returns one @character string of \R code. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("convertComment", "VComments", function(this, vcomment, .currLine=NA, .line=NA, ...) { cmd <- vcomment$cmd args <- vcomment$args if (is.null(args)) { argsStr <- "" } else { argsStr <- sprintf(", \"%s\"", gsub("\"", "\\\"", args, fixed=TRUE)) } vcmd <- NULL if (cmd == "+") { vcmd <- sprintf("enter(<verbose>%s)", argsStr) } else if (cmd == "-") { vcmd <- sprintf("exit(<verbose>%s)", argsStr) } else if (cmd %in% c("0", "1")) { clazz <- ifelse(cmd == "1", "Verbose", "NullVerbose") if (is.null(args)) { vcmd <- sprintf("<verbose> <- %s()", clazz) } else { vcmd <- sprintf("<verbose> <- %s(%s)", clazz, args) } } else if (cmd == "=") { if (is.null(args)) { reset(this) } else { this$verboseName <- args } } else if (cmd == "^") { threshold <- as.integer(args) if (!is.na(threshold)) { vcmd <- sprintf("setThreshold(<verbose>, threshold=%d)", threshold) } else { throw("Invalid threshold value: ", threshold) } } else if (cmd == "?") { vcmd <- sprintf("if (isVisible(<verbose>)) { capture(<verbose>, %s) }", args) } else if (cmd == "@") { if (is.na(as.numeric(args))) { throw("VComment error: Invalid verbose level on line ", .currLine, ": ", .line) } vcmd <- sprintf("setDefaultVerboseLevel(<verbose>, %s)", as.double(args)) } else if (cmd == "!") { vcmd <- "pushState(<verbose>); on.exit(popState(<verbose>), add=TRUE)" if (!is.null(args)) vcmd <- sprintf("%s; enter(<verbose>, \"%s\")", vcmd, args) } else if (cmd == "c") { vcmd <- sprintf("cat(<verbose>%s)", argsStr) } else if (cmd == "e") { vcmd <- sprintf("evaluate(<verbose>, %s)", args) } else if (cmd == "m") { method <- gsub("^([^ ]*)([ ]*)(.*)", "\\1", args) args <- gsub("^([^ ]*)([ ]*)(.*)", "\\3", args) args <- trim(args) if (nchar(args) == 0) { vcmd <- sprintf("%s(<verbose>)", method) } else { vcmd <- sprintf("%s(<verbose>, %s)", method, args) } } else if (cmd == "n") { vcmd <- sprintf("newline(<verbose>)") } else if (cmd == "p") { vcmd <- sprintf("print(<verbose>, %s)", args) } else if (cmd == "s") { vcmd <- sprintf("summary(<verbose>, %s)", args) } else if (cmd == "t") { vcmd <- "timestamp(<verbose>)" } else if (cmd == "w") { if (nchar(args) == 0) { vcmd <- "warnings(<verbose>)" } else { vcmd <- sprintf("warnings(<verbose>, %s)", args) } } else if (cmd == "z") { vcmd <- sprintf("str(<verbose>, %s)", args) } else if (cmd == "r") { vcmd <- sprintf("ruler(<verbose>)") } else if (cmd == "h") { vcmd <- sprintf("header(<verbose>, \"%s\")", args) } else { vcmd <- NA } if (!is.null(vcmd)) { if (is.na(vcmd)) { newLine <- paste("# <?>", .line, "</?>", sep="") warning("Unknown VComment on line ", .currLine, ": ", .line) } else if (cmd %in% c("0", "1")) { newLine <- vcmd } else { newLine <- paste("if (<verbose>) { ", vcmd, " }", sep="") } newLine <- gsub("<verbose>", this$verboseName, newLine, fixed=TRUE) paste(vcomment$indent, newLine, sep="") } else { NA } }, protected=TRUE) ###########################################################################/** # @RdocMethod validate # # @title "Validates the compiled lines" # # \description{ # @get "title" # } # # @synopsis # # \arguments{ # \item{lines}{A @character @vector of lines of code to validated.} # \item{...}{Not used.} # } # # \value{ # Returns a @character @vector. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("validate", "VComments", function(this, lines, ...) { # Check number of enters and exits. pattern <- paste("enter(", this$verboseName, sep="") nbrOfEnters <- sum(regexpr(pattern, lines, fixed=TRUE) != -1) pattern <- paste("exit(", this$verboseName, sep="") nbrOfExits <- sum(regexpr(pattern, lines, fixed=TRUE) != -1) if (nbrOfEnters != nbrOfExits) { warning("Number of verbose enters and exits do not match: ", nbrOfEnters, " != ", nbrOfExits) } lines }, protected=TRUE) ����������������������������������������������������������������������������������������������������������R.utils/R/env.R�������������������������������������������������������������������������������������0000644�0001762�0000144�00000002312�14372747611�012740� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocFunction env # # @title "Creates a new environment, evaluates an expression therein, and returns the environment" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Arguments passed to @see "base::evalq", particularly a # @expression to be evaluated inside the newly created @environment.} # \item{hash, parent, size}{Arguments passed to @see "base::new.env".} # } # # \value{ # Returns an @environment. # } # # @examples "../incl/env.Rex" # # @author # # \seealso{ # Internally @see "base::new.env" and @see "base::evalq" are used. # } # # \references{ # [1] R-devel thread 'Create an environment and assign objects to it in # one go?' on March 9-10, 2011.\cr # } # # @keyword device # @keyword utilities #*/########################################################################### # NOTE: This must not be an S3 method, because we must *not* dispatch # on '...'; if done, then any expression therein is evaluated. env <- function(..., hash=FALSE, parent=parent.frame(), size=29L) { envir <- new.env(hash=hash, parent=parent, size=size) evalq(..., envir=envir) envir } # env() ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/createLink.R������������������������������������������������������������������������������0000644�0001762�0000144�00000022771�14372747611�014244� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault createLink # # @title "Creates a link to a file or a directory" # # @synopsis # # \description{ # @get "title". # This method tries to create a link to a file/directory on the # file system, e.g. a symbolic link and Windows Shortcut links. # It depends on operating and file system (and argument settings), # which type of link is finally created, but all this is hidden # internally so that links can be created the same way regardless # of system. # } # # \arguments{ # \item{link}{The path or pathname of the link to be created. # If \code{"."} (or @NULL), it is inferred from the # \code{target} argument, if possible.} # \item{target}{The target file or directory to which the shortcut should # point to.} # \item{skip}{If @TRUE and a file with the same name as argument # \code{link} already exists, then the nothing is done.} # \item{overwrite}{If @TRUE, an existing link file is overwritten, # otherwise not.} # \item{methods}{A @character @vector specifying what methods (and in # what order) should be tried for creating links.} # \item{...}{Not used.} # } # # \value{ # Returns (invisibly) the path or pathname to the link. # If no link was created, @NULL is returned. # } # # \section{Required privileges on Windows}{ # In order for \code{method="unix-symlink"} (utilizing # \code{\link[base:files]{file.symlink}()}), # \code{method="windows-ntfs-symlink"} (utilizing executable \code{mklink}), # and/or \code{method="windows-shortcut"} (utilizing # @see "createWindowsShortcut") to succeed on Windows, # the client/R session must run with sufficient privileges # (it has been reported that Administrative rights are necessary). # } # # @author # # \seealso{ # @see "createWindowsShortcut" and # \code{\link[base:files]{file.symlink}()} # } # # \references{ # Ben Garrett, \emph{Windows File Junctions, Symbolic Links and Hard Links}, # September 2009 [\url{https://devtidbits.com/2009/09/07/windows-file-junctions-symbolic-links-and-hard-links/}]\cr # } # # @keyword file # @keyword IO #*/########################################################################### setMethodS3("createLink", "default", function(link=".", target, skip=!overwrite, overwrite=FALSE, methods=getOption("createLink/args/methods", c("unix-symlink", "windows-ntfs-symlink", "windows-shortcut")), ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'skip': skip <- Arguments$getLogical(skip) # Argument 'overwrite': overwrite <- Arguments$getLogical(overwrite) # Argument 'target': target <- normalizePath(target) target <- Arguments$getReadablePathname(target, mustExist=TRUE) target <- getAbsolutePath(target) # Argument 'link': if (is.null(link) || link == ".") { # Infer from 'target' link <- basename(target) if (regexpr("^[a-zA-Z]:$", link) != -1) { throw("Cannot infer a valid link name from argument 'target': ", target) } } links <- c(link, sprintf("%s.LNK", link)) if (any(file.exists(links))) { if (skip) { pathnameL <- Arguments$getReadablePathname(link, mustExist=TRUE) equal <- identical(pathnameL, target) # Be more forgiving on Windows system, i.e. assume a # case-insensitive file system if (!equal && (.Platform$OS.type == "windows")) { equal <- identical(tolower(pathnameL), tolower(target)) } if (!equal) { pathnameLA <- getAbsolutePath(Sys.readlink2(pathnameL, what="corrected")) equal <- identical(pathnameLA, target) # Be more forgiving on Windows system, i.e. assume a # case-insensitive file system if (!equal && (.Platform$OS.type == "windows")) { equal <- identical(tolower(pathnameLA), tolower(target)) } } if (!equal) { warning(sprintf("Existing link (%s; current working directory: %s) was skipped, but it links to different target file than requested: %s != %s", sQuote(link), sQuote(getwd()), sQuote(pathnameLA), sQuote(target))) } # If a Windows Shortcut, avoid returning the target. if (file.exists(links[2L]) && !file.exists(link)) { pathnameL <- link attr(pathnameL, "linkType") <- "windows-shortcut" } return(pathnameL) } if (!overwrite) { throw(sprintf("Cannot create link. Link file already exists: %s (current working directory: %s)", sQuote(link), sQuote(getwd()))) } } # Argument 'methods': methods <- match.arg(methods, several.ok=TRUE) # Keep only 'methods' that are supported on the current platform if (.Platform$OS.type != "windows") { methods <- grep("windows-", methods, value=TRUE, invert=TRUE) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Create directory where link should be, if missing # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - path <- dirname(getAbsolutePath(link)) path <- Arguments$getWritablePath(path) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Overwrite? # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (overwrite) { linksS <- links[file.exists(links)] if (length(linksS) > 0) { linksD <- sprintf("%s.%s", linksS, basename(tempdir())) # Remove current link, by renaming to a temporary name. file.rename(linksS, linksD) on.exit({ # Undo if failing to create link below. if (length(linksS) > 0) { file.rename(linksD, linksS) } else if (length(linksD) > 0) { file.remove(linksD) } }) } } # Default result pathnameL <- NULL conditions <- list() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Unix: Try to create a symbolic link # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (is.element("unix-symlink", methods)) { targetF <- getAbsolutePath(target) tryCatch({ file.symlink(from=targetF, to=link) pathnameL <- Arguments$getReadablePathname(link, mustExist=TRUE) attr(pathnameL, "linkType") <- "unix-symlink" }, warning = function(w) { conditions[["unix-symlink"]] <<- w }) if (!is.null(pathnameL)) { if (overwrite) linksS <- NULL; # Don't undo above "overwrite" return(pathnameL) } # Cleanup, in case something was created but the link is not # working, which can happen on Windows. If it worked, then # 'pathnameL' should be non-NULL above. if (file.exists(link)) { file.remove(link) } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Windows Vista + NTFS: Try to create a symbolic link # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (is.element("windows-ntfs-symlink", methods)) { # Are we linking to a directory (or a file)? if (isDirectory(target)) { cmd <- sprintf("mklink /D \"%s\" \"%s\"", link, target) } else { cmd <- sprintf("mklink \"%s\" \"%s\"", link, target) } tryCatch({ res <- shell(cmd, intern=TRUE, mustWork=TRUE, ignore.stderr=FALSE, shell=Sys.getenv("COMSPEC")) status <- attr(res, "status") if (!is.null(status)) { msg <- sprintf("Shell command %s had status %d (using shell %s): %s", sQuote(cmd), status, sQuote(Sys.getenv("COMSPEC")), paste(res, collapse = "; ")) throw(msg) } pathnameL <- Arguments$getReadablePathname(link, mustExist=TRUE) attr(pathnameL, "linkType") <- "windows-ntfs-symlink" }, error = function(ex) { conditions[["windows-ntfs-symlink"]] <<- ex }) if (!is.null(pathnameL)) { if (overwrite) linksS <- NULL; # Don't undo above "overwrite" return(pathnameL) } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Windows: Try to create a Windows Shortcut link # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (is.element("windows-shortcut", methods)) { tryCatch({ pathname <- sprintf("%s.LNK", link) createWindowsShortcut(pathname, target=target, overwrite=overwrite, mustWork=TRUE) pathnameL <- Arguments$getReadablePathname(link, mustExist=TRUE) # Make sure to return the link and not the target pathnameL <- link attr(pathnameL, "linkType") <- "windows-shortcut" }, error = function(ex) { conditions[["windows-shortcut"]] <<- ex }) if (!is.null(pathnameL)) { if (overwrite) linksS <- NULL; # Don't undo above "overwrite" return(pathnameL) } } if (is.null(pathnameL)) { if (length(methods) == 0) { throw(sprintf("Failed to create file link (because 'methods' was empty; current working directory: %s): %s[.lnk] -> %s", sQuote(getwd()), sQuote(link), sQuote(target))) } else { msg <- sprintf("Failed to create file link (methods attempted: %s; current working directory: %s): %s[.lnk] -> %s", paste(sQuote(methods), collapse = ", "), sQuote(getwd()), sQuote(link), sQuote(target)) if (length(conditions) > 0) { classes <- sapply(conditions, FUN = function(cond) class(cond)[1]) reasons <- lapply(conditions, FUN = conditionMessage) details <- sprintf("%s produced %s: %s", names(conditions), classes, sQuote(reasons)) details <- paste(details, collapse = "; ") msg <- sprintf("%s\nWarnings and errors captured: %s", msg, details) } throw(msg) } } pathnameL }) # createLink() �������R.utils/R/writeDataFrame.R��������������������������������������������������������������������������0000644�0001762�0000144�00000013064�14372747611�015055� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������########################################################################/** # @set "class=data.frame" # @RdocMethod writeDataFrame # @alias writeDataFrame # # @title "Writes a data.frame to tabular text file" # # @synopsis # # \description{ # @get "title" with an optional header. # } # # \arguments{ # \item{data}{A @data.frame.} # \item{file}{A @connection or a filename to write to.} # \item{path}{The directory where the file will be written.} # \item{sep, quote, row.names, col.names, ...}{Additional arguments # passed to @see "utils::write.table".} # \item{header}{An optional named @list of header rows to be written # at the beginning of the file. If @NULL, no header will be written.} # \item{createdBy, createdOn, nbrOfRows}{If non-@NULL, common header # rows to be added to the header.} # \item{headerPrefix}{A @character string specifying the prefix of each # header row.} # \item{headerSep}{A @character string specifying the character # separating the header name and header values.} # \item{append}{If @TRUE, the output is appended to an existing file.} # \item{overwrite}{If @TRUE, an existing file is overwritten.} # } # # \value{ # Returns (invisibly) the pathname to the file written # (or the @connection written to). # } # # @author # # \seealso{ # @see "utils::write.table". # @see "readTable". # } # # @keyword IO #*/######################################################################### setMethodS3("writeDataFrame", "data.frame", function(data, file, path=NULL, sep="\t", quote=FALSE, row.names=FALSE, col.names=!append, ..., header=list(), createdBy=NULL, createdOn=format(Sys.time(), format="%Y-%m-%d %H:%M:%S %Z"), nbrOfRows=nrow(data), headerPrefix="# ", headerSep=": ", append=FALSE, overwrite=FALSE) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'file' & 'path': if (inherits(file, "connection")) { con <- file } else { pathname <- Arguments$getWritablePathname(file, path=path, mustNotExist=(!append && !overwrite)) con <- NULL } # Argument 'sep': if (!is.character(sep)) { throw("Argument 'sep' must be a character: ", mode(sep)) ## TO ADD? read.table() requires nchar(sep) == 1 /HB 2015-10-09 ## } else if (nchar(sep) != 1L) { ## throw("Argument 'sep' must be a single character: ", sQuote(sep)) } # Argument 'header': if (!is.null(header)) { if (!is.list(header)) { throw("Argument 'header' is not a list: ", class(header)[1]) } } # Argument 'headerPrefix': headerPrefix <- Arguments$getCharacter(headerPrefix) # Argument 'headerSep': headerSep <- Arguments$getCharacter(headerSep) # Argument 'createdBy': if (!is.null(createdBy)) { createdBy <- Arguments$getCharacter(createdBy) } # Argument 'createdOn': if (!is.null(createdOn)) { createdOn <- Arguments$getCharacter(createdOn) } # Argument 'nbrOfRows': if (!is.null(nbrOfRows)) { nbrOfRows <- Arguments$getInteger(nbrOfRows) } # Argument 'append': append <- Arguments$getLogical(append) if (append) { # Don't write headers when appending if (missing(header)) header <- NULL } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Pre-write assertions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Assert that none of the fields contains a 'sep' character if (is.logical(quote) && !quote) { for (kk in seq_along(data)) { value <- data[[kk]] if (any(grepl(sep, value))) { throw(sprintf("Cannot write data using this field separator (sep=%s) without quotes (quote=FALSE), because column #%d contains the same symbol", sQuote(sep), kk)) } } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Build header # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (!is.null(header)) { if (!is.null(createdBy)) { header$createdBy <- createdBy } if (!is.null(createdOn)) { header$createdOn <- createdOn } header$nbrOfRows <- nbrOfRows header$nbrOfColumns <- ncol(data) header$columnNames <- colnames(data) header$columnClasses <- sapply(data, FUN=function(x) class(x)[1L]) header <- lapply(header, FUN=paste, collapse=sep) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Write to file # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (is.null(con)) { # Remove existing file? if (!append && overwrite && isFile(pathname)) { file.remove(pathname) } # Write to a temporary file (which may be an existing file) pathnameT <- pushTemporaryFile(pathname, isFile=isFile(pathname)) # Open file connection open <- ifelse(append, "at", "wt") con <- file(pathnameT, open=open) on.exit({ if (!is.null(con)) { close(con) con <- NULL } }) } # Write header if (!is.null(header)) { bfr <- paste(headerPrefix, names(header), headerSep, header, sep="") cat(file=con, bfr, sep="\n") } # Write data section write.table(file=con, data, sep=sep, quote=quote, row.names=row.names, col.names=col.names, ...) if (inherits(file, "connection")) { res <- con } else { # Close opened file connection close(con) con <- NULL # Rename temporary file pathname <- popTemporaryFile(pathnameT) res <- pathname } invisible(res) }) # writeDataFrame() ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/copyFile.R��������������������������������������������������������������������������������0000644�0001762�0000144�00000015021�14372747611�013723� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault copyFile # # @title "Copies a file atomically" # # \description{ # @get "title", # by first copying to a temporary file and then renaming that file. # } # # @synopsis # # \arguments{ # \item{srcPathname}{The source file to be copied.} # \item{destPathname}{The destination file to be created. # If an \emph{existing directory}, then the destination file # becomes \code{file.path(destPathname, basename(srcPathname))}.} # \item{skip, overwrite}{If a destination file does not exist, these # arguments have no effect. # If such a file exists and \code{skip} is @TRUE, then no copying is # attempted and @FALSE is returned (indicating that no copying was made). # If such a file exists, both \code{skip} and \code{overwrite} are @FALSE # then an exception is thrown. # If a destination file exists, \code{skip} is @FALSE and # \code{overwrite} is @TRUE, then it is overwritten and @TRUE is returned. # If the copying/overwriting failed, for instance due to non sufficient # file permissions, an informative exception is thrown.} # \item{...}{Additional \emph{named} arguments passed to @see "base::file.copy". # Non-named or unknown arguments are ignored.} # \item{validate}{If @TRUE, validation of the copied file is applied, # otherwise not.} # \item{verbose}{See @see "R.utils::Verbose".} # } # # \value{ # Returns a @logical indicating whether a successful file copy was # completed or not, or equivalently. In other words, @TRUE is returned # if the file was successfully copied, and @FALSE if not. # If an error occurs, an informative exception is thrown. # If the error occurs while renaming the temporary file to the final name, # the temporary file will remain in the destination directory. # } # # \details{ # If the source file does not exists (or is not a file), then an # informative exception is thrown. # # If the source and destination pathnames are the same, it is not safe # to copy (which can lead to either corrupt or lost files) and an # informative exception is thrown. # # If (and only if) the file is successfully copied and argument # \code{validate} is @TRUE, then this method also asserts that the # file size of the destination matches that of the source, otherwise # an informative exception is thrown. # } # # @author # # \seealso{ # \code{\link[base:files]{file.copy}()}. # } # # @keyword internal #*/########################################################################### setMethodS3("copyFile", "default", function(srcPathname, destPathname, skip=FALSE, overwrite=FALSE, ..., validate=TRUE, verbose=FALSE) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'srcPathname': srcPathname <- Arguments$getCharacter(srcPathname, nchar=c(1,512)) # Argument 'destPathname': destPathname <- Arguments$getCharacter(destPathname, nchar=c(1,512)) # Argument 'verbose': verbose <- Arguments$getVerbose(verbose) if (verbose) { pushState(verbose) on.exit(popState(verbose)) } verbose && enter(verbose, "Copying file safely") verbose && cat(verbose, "Source: ", srcPathname) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Special case: Copying to an existing directory? # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (isDirectory(destPathname)) { destPath <- destPathname destPath <- Arguments$getWritablePath(destPath) verbose && cat(verbose, "Destination directory: ", destPath) destPathname <- file.path(destPath, basename(srcPathname)) } verbose && cat(verbose, "Destination: ", destPathname) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Initial validation # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (!isFile(srcPathname)) { throw("Failed to copy file. No such file: ", srcPathname) } if (srcPathname == destPathname) { throw("Failed to copy file. Source and destination are identical: ", srcPathname) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Destination file already exists? # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (isFile(destPathname)) { # Nothing to do? if (skip) return(FALSE) # Overwrite or not? if (!overwrite) { throw("Failed to copy file. Destination file already exists (with skip=FALSE, overwrite=FALSE): ", destPathname) } } # 1. Copy to a temporary file verbose && enter(verbose, "Copying to temporary file using file.copy()") tmpPathname <- paste(destPathname, "tmp", sep=".") if (isFile(tmpPathname)) { throw("Failed to copy file. Temporary copy file exists: ", tmpPathname) } # Setup arguments to file.copy() args <- list(from=srcPathname, to=tmpPathname, ...) # Keep only named arguments args <- args[nzchar(names(args))] # Keep only arguments known to file.copy() args <- args[is.element(names(args), names(formals(file.copy)))] # Call file.copy() res <- do.call(file.copy, args=args) # Failed to copy? if (!res) { throw("Failed to copy file: ", srcPathname, " -> ", tmpPathname) } verbose && exit(verbose) # 2. Overwrite? if (isFile(destPathname)) { verbose && enter(verbose, "Removing existing destination file") res <- file.remove(destPathname) if (!res) throw("Cannot overwrite file: ", destPathname) verbose && exit(verbose) } # 3. Rename temporary file verbose && enter(verbose, "Renaming temporary file to destination name") res <- file.rename(tmpPathname, destPathname) if (!res) { throw("Failed to rename temporary file: ", tmpPathname, " -> ", destPathname) } verbose && exit(verbose) # 4. Make sure it is file if (!isFile(destPathname)) { throw("Failed to copy file: ", destPathname) } if (validate) { verbose && enter(verbose, "Validating destination file") # 5. Validate file size srcSize <- file.info2(srcPathname)$size destSize <- file.info2(destPathname)$size if (!identical(srcSize, destSize)) { throw("File copy got a different size than the source file: ", destSize, " !=", srcSize) } verbose && exit(verbose) } # if (validate) verbose && exit(verbose) TRUE }) # copyFile() ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/eget.R������������������������������������������������������������������������������������0000644�0001762�0000144�00000006511�14372747611�013101� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocFunction eget # @alias ecget # # @title "Gets a variable by name" # # \description{ # @get "title". If non-existing, the default value is returned. # } # # @synopsis # # \arguments{ # \item{...}{Named arguments \code{name} and \code{default}, where # \code{name} must be a @character string and \code{default} is # an optional default value (if not given, it's @NULL). # Alternatively, \code{name} and \code{default} can be given as # a named argument (e.g. \code{n=42}).} # \item{coerce}{If @TRUE, the returned value is coerced to the class # of the default value (unless @NULL) using @see "methods::as".} # \item{envir}{A @environment or a named @list where to look # for the variable. Only if \code{envir} is an @environment.} # \item{inherits}{A @logical specifying whether the enclosing frames # of the environment should be searched or not.} # \item{mode}{A @character string specifying the mode of the object to # retrieve. Only if \code{envir} is an @environment.} # \item{cmdArg}{If @TRUE, the corresponding command-line argument # is used as the default value.} # } # # \value{ # Returns an object. # } # # \details{ # \code{ecget(...)} is short for \code{eget(..., cmdArg=TRUE)}. # } # # @examples "../incl/eget.Rex" # # @author # # \seealso{ # To retrieve command-line arguments, see @see "R.utils::cmdArg". # See also @see "base::mget". # } # # @keyword file # @keyword IO # @keyword internal #*/########################################################################### eget <- function(..., coerce=TRUE, envir=parent.frame(), inherits=FALSE, mode="default", cmdArg=FALSE) { # Argument '...' => (name, default, ...) pargs <- .parseArgs(list(...), defaults=alist(name=, default=NULL)) # Special short format, e.g. eget(n=42)? args <- pargs$args if (!is.element("name", names(args))) { argsT <- pargs$namedArgs if (length(argsT) == 0L) { stop("Argument 'name' is missing (or NULL).") } args$name <- names(argsT)[1L] default <- argsT[[1L]] args$default <- default argsT <- argsT[-1L] pargs$args <- args pargs$namedArgs <- argsT } args <- Reduce(c, pargs) # Argument 'name': name <- as.character(args$name) .stop_if_not(length(name) == 1L) # Argument 'default': default <- args$default # Set default according to corresponding command-line argument? if (cmdArg) { defaultT <- cmdArg(...) if (!is.null(defaultT)) default <- defaultT } # Argument 'envir': if (is.list(envir)) { } else { envir <- as.environment(envir) .stop_if_not(is.environment(envir)) } # Retrieve the variable, if available. value <- default if (is.list(envir)) { if (is.element(name, names(envir))) { value <- envir[[name]] } } else { if (mode == "default") { mode <- mode(value) if (mode == "NULL") mode <- "any" } if (exists(name, mode=mode, envir=envir, inherits=inherits)) { value <- get(name, mode=mode, envir=envir, inherits=inherits) } } # Coerce? if (coerce) { if (!identical(value, default) && !is.null(default)) { value <- as(value, Class=class(default)[1L]) } } value } # eget() ecget <- function(..., envir=parent.frame()) { eget(..., envir=envir, cmdArg=TRUE) } # ecget() ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/isUrl.R�����������������������������������������������������������������������������������0000644�0001762�0000144�00000001172�14372747611�013251� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault isUrl # # @title "Checks if one or several pathnames is URLs" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{pathname}{A @character @vector.} # \item{...}{Not used.} # } # # \value{ # Returns a @logical @vector of either @TRUE or @FALSE. # } # # @author # # @keyword IO # @keyword programming #*/########################################################################### setMethodS3("isUrl", "default", function(pathname, ...) { res <- hasUrlProtocol(pathname, ...) res[is.na(res)] <- FALSE res }) ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/System.R����������������������������������������������������������������������������������0000644�0001762�0000144�00000072042�14372747611�013443� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocClass System # # @title "Static class to query information about the system" # # \description{ # @classhierarchy # # The System class contains several useful class fields and methods. It # cannot be instantiated. # } # # \section{Fields and Methods}{ # @allmethods # } # # @author #*/########################################################################### setConstructorS3("System", function() { extend(Object(), "System") }) ########################################################################/** # @RdocMethod getHostname # # @title "Retrieves the computer name of the current host" # # \description{ # @get "title". # } # # @synopsis # # \value{ # Returns a @character string. # } # # \details{ # First, this function checks the system environment variables \code{HOST}, # \code{HOSTNAME}, and \code{COMPUTERNAME}. # Second, it checks \code{Sys.info()["nodename"]} for host name details. # Finally, it tries to query the system command \code{uname -n}. # } # # \seealso{ # @seemethod "getUsername". # } #**/####################################################################### setMethodS3("getHostname", "System", function(static, ...) { host <- Sys.getenv(c("HOST", "HOSTNAME", "COMPUTERNAME")) host <- host[host != ""] if (length(host) == 0) { # Sys.info() is not implemented on all machines, if not it returns NULL, # which the below code will handle properly. host <- Sys.info()["nodename"] host <- host[host != ""] if (length(host) == 0) { host <- readLines(pipe("/usr/bin/env uname -n")) } } host[1] }, static=TRUE) ########################################################################/** # @RdocMethod getUsername # # @title "Retrieves the name of the user running R" # # \description{ # @get "title". # } # # @synopsis # # \value{ # Returns a @character string. # } # # \details{ # First, this function checks the system environment variables \code{USER}, # and \code{USERNAME}. # Second, it checks \code{Sys.info()["user"]} for user name details. # Finally, it tries to query the system command \code{whoami}. # } # # \seealso{ # @seemethod "getHostname". # } #**/####################################################################### setMethodS3("getUsername", "System", function(static, ...) { user <- Sys.getenv(c("USER", "USERNAME")) user <- user[user != ""] if (length(user) == 0) { # Sys.info() is not implemented on all machines, if not it returns NULL, # which the below code will handle properly. user <- Sys.info()["user"] user <- user[user != "" & user != "unknown"] if (length(user) == 0) { user <- readLines(pipe("/usr/bin/env whoami")) } } user[1] }, static=TRUE) ###########################################################################/** # @RdocMethod currentTimeMillis # # @title "Get the current time in milliseconds" # # @synopsis # # \description{ # @get "title". # } # # \value{ # Returns an @integer. # } # # @author # # \seealso{ # @see "base::Sys.time". # @see "base::proc.time". # @seeclass # } #*/########################################################################### setMethodS3("currentTimeMillis", "System", function(this, ...) { secs <- as.numeric(Sys.time()) times <- proc.time() time <- times[2]; # System CPU time # CPU time is not available on Win 98/Me if (is.na(time)) time <- times[3]; # Total elapsed times (secs + time %% 1)*1000 }, static=TRUE) ###########################################################################/** # @RdocMethod parseDebian # # @title "Parses a string, file or connection for Debian formatted parameters" # # @synopsis # # \arguments{ # \item{text}{The text to be parsed. Default value is @NULL.} # \item{file}{Name file, a \code{File} object or connection to be parsed. # Default value is @NULL.} # \item{keys}{The keys (names of the parameters) to be retrieved. # If @NULL all fields are returned. Default value is @NULL.} # # Either, \code{text} or \code{file} must be given. # } # # \description{ # Parses a text, file or a connection for Debian formatted parameters. # A file in Debian format contains rows with parameters of the form # \code{KEY=VALUE}. It is allowed to have duplicated keys. # } # # \value{ # Returns a named @list of parameter values. # } # # \examples{ # file <- file.path(Package("R.utils")$path, "DESCRIPTION") # l <- System$parseDebian(file=file) # print(l) # } # # @author # # \seealso{ # @seeclass # } #*/########################################################################### setMethodS3("parseDebian", "System", function(this, text=NULL, file=NULL, keys=NULL, ...) { if (is.null(text) && is.null(file)) throw("Either argument text or argument file must be specified.") # Retrieve the text to be parsed. if (is.null(text)) { file <- as.character(file) text <- scan(file=file, what="", sep="\n", quiet=TRUE) text <- paste(text, "", sep="") } else { text <- unlist(text) text <- strsplit(text, "\n") text <- unlist(text) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Get the keys (names) and values of the parameters # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - nbrOfLines <- length(text) keyMatches <- regexpr("^[^:]*:", text) keyLines <- which(keyMatches == 1) keyLengths <- attr(keyMatches, "match.length")[keyLines]-1 pkeys <- substring(text[keyLines], 1, keyLengths) text[keyLines] <- substring(text[keyLines], keyLengths+2) valueNbrOfLines <- c(keyLines, 0) - c(0, keyLines) valueNbrOfLines <- valueNbrOfLines[-length(valueNbrOfLines)] valueNbrOfLines <- valueNbrOfLines[-1] len <- length(valueNbrOfLines) valueNbrOfLines[len+1] <- keyLines[len+1]-length(text)+1 values <- c() for (k in 1:length(keyLines)) { valueLines <- keyLines[k] + 1:valueNbrOfLines[k] - 1 value <- paste(text[valueLines], sep="", collapse="\n") values <- c(values, value) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Some cleanup of values # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # 1. Replace all '\r' with '\n'. values <- gsub("\r", "\n", values) # 2. At the end of each line, remove all whitespaces and add a space. values <- gsub("[ \t]*\n", " \n", values) # 3. At the beginning of each line, remove all whitespaces. values <- gsub("\n[ \t]*", "\n", values) # 4. Replace all lines that contains a single '.' with '\r'. values <- gsub("\n[.] \n", "\n\r\n", values) values <- gsub("\n[.] \n", "\n\r\n", values); # since we miss every second! # 4. Remove all '\n'. values <- gsub("\n", "", values) # 1. Replace all '\r' with '\n' (single '.' lines). values <- gsub("\r", "\n", values) # 4. Removes prefix whitespaces values <- gsub("^[ \t]", "", values) # 5. Removes suffix whitespaces # For some reason, the gsub below crashes once in a while, i.e. once every # 20:th time. Strange! But, I think I tracked it down to happen when one # of the strings in values has zero length. So, by making all zero length # strings equal to " " the gsub call won't crash. I think! /hb 2001-05-11 values[nchar(values) == 0] <- " " values <- gsub("[ \t]*$", "", values) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Return the wanted parameters # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (is.null(keys)) { parameters <- as.list(values) names(parameters) <- pkeys } else { idx <- na.omit(match(keys, pkeys)) parameters <- as.list(values[idx]) names(parameters) <- pkeys[idx] } parameters }, static=TRUE) ###########################################################################/** # @RdocMethod openBrowser # # @title "Opens an HTML document using the OS default HTML browser" # # @synopsis # # \arguments{ # \item{query}{The path to document to be opened by the browser.} # } # # \description{ # @get "title". Note that this # call is dependent on the operating system (currently only Windows and # Unix are supported). # The document given by \code{query} can either be a local file or a # web page. If the \code{query} was given as non-url string, i.e. as a # standard file pathname, the method will automatically check if the # file exists and conform the query to a correct url starting with # \code{file:}. The used url will be returned as a string. # # Any suggestion how implement this on Apple system are welcome! # } # # \value{ # Returns the url of the \code{query}. # } # # \details{ # It is hard to create a good cross-platform \code{openBrowser()} method, # but here is one try. # # In the following text \code{<browser>} is the value returned by # \code{getOption("browser")} and \code{<url>} is the URL conformed # query, which starts with either \code{file:} or \code{http:}. # # On a \emph{Windows} system, if \code{<browser>} is not @NULL, # first # # \code{shell.exec(<browser> <url>)} # # is tried. If this fails, then # # \code{shell.exec(<url>)} # # is tried. Using this latter approach will \emph{not} guarantee that # an HTML browser will open the url, e.g. depending on the Windows file # associations, a \code{*.txt} file might be opened by NotePad. However, # it will most likely open something. # If \code{<browser>} contains spaces, make sure it is quoted. # # On \emph{Unix} systems, \code{system()} will be used to call: # # \code{ <browser> -remote "openURL(<url>)" 2> /dev/null || <browser> <url> &} # # } # # \examples{\dontrun{ # System$openBrowser("https://www.r-project.org/") # }} # # @author # # \seealso{ # @seeclass # } #*/########################################################################### setMethodS3("openBrowser", "System", function(this, query, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Local functions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - startsWith <- function(prefix, s, ...) { res <- regexpr(paste("^", prefix, sep=""), as.character(s)) (res[[1]] != -1) } endsWith <- function(suffix, s, ...) { res <- regexpr(paste(suffix, "$", sep=""), as.character(s)) (res[[1]] != -1) } url <- as.character(query) if (regexpr("^[abcdefghijklmnopqrstuvwxyz]+:", url) == -1) { # Assume we are dealing with a file file <- filePath(url) if (!file.exists(file)) throw("File not found: ", file) url <- toUrl(file) } browser <- getOption("browser") if (!is.null(browser)) { # Check if 'browser' contains spaces, but the user forgot to quote it. if (regexpr(" ", browser) != -1) { if (regexpr("^\"", browser) == -1 || regexpr("\"$", browser) == -1) { browser <- paste("\"", browser, "\"", sep="") msg <- paste("getOption(\"browser\") contains spaces, but it is not quoted:", browser) warning(msg) } } } OST <- .Platform$OS.type # --------------------------------------------------------------------- # W i n d o w s # --------------------------------------------------------------------- if (OST == "windows") { first <- 1 tmp <- tolower(url) if (is.null(browser) && !startsWith(tmp, "http:") && !startsWith(tmp, "file:") && !endsWith(tmp, ".html") && !endsWith(tmp, ".htm")) { first <- 2 msg <- paste("The extension of the URL might not be opened in a HTML browser on your Windows system: ", url, sep="") warning(msg) } if (first == 1) { # 1. Try to call <url> shell.exec(url) } else { # 2a. Try to call <browser> <url> loaded <- FALSE if (!is.null(browser)) { # 2a.i. cmd <- paste(browser, url) res <- system(cmd, wait=FALSE) loaded <- (res == 0) if (!loaded) { # 2a.ii. Check if "start" exists, because that might help us start <- "start /minimized" tryCatch({ system(start, intern=TRUE) }, error = function(ex) { start <<- NULL }) cmd <- paste(start, browser, url) res <- system(cmd, wait=FALSE) loaded <- (res == 0) } if (!loaded) { warning("Could not find the browser specified in options(). Please make sure it is specified with the absolute path *and* if it contains spaces, it has to be quoted.") } } # 2b. Try to call <url> if (!loaded) shell.exec(url) } } # --------------------------------------------------------------------- # U n i x # --------------------------------------------------------------------- else if (OST == "unix") { if (is.null(browser)) throw("options(\"browser\") not set.") # 1. Try to call <browser> -remote "openURL(<url>)", which opens the # document in an already existing browser. cmd1 <- paste(browser, " -remote \"openURL(", url, ")\" 2>/dev/null", sep="") # 2. Try to call <browser> <url>, which opens the document in a new # browser. cmd2 <- paste(browser, url) # If 1 fails, try 2. cmd <- paste(cmd1, "||", cmd2) system(cmd) } else { throw("Don't know how to open the browser on", OST) } # Return the url, which was tried to be opened. invisible(url) }, static=TRUE) #########################################################################/** # @RdocMethod findGhostscript # # @title "Searches for a Ghostview executable on the current system" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{updateRGSCMD}{If @TRUE and Ghostscript is found, then the system # environment variable @see "base::R_GSCMD" is set to the (first) path # found.} # \item{firstOnly}{If @TRUE, only the first executable is returned.} # \item{force}{If @TRUE, existing @see "base::R_GSCMD" is ignored, # otherwise not.} # \item{...}{Not used.} # } # # # \value{ # Returns a @character @vector of full and normalized pathnames # where Ghostscript executables are found. # } # # \examples{\dontrun{ # print(System$findGhostscript()) # }} # # @author # # \references{ # [1] \emph{How to use Ghostscript}, Ghostscript, 2022 # \url{https://ghostscript.com/docs/9.55.0/Use.htm}\cr # [2] \emph{Environment variable}, Wikipedia, 2013. # \url{https://en.wikipedia.org/wiki/Environment_variable}\cr # [3] \emph{Environment.SpecialFolder Enumeration}, # Microsoft, 2013. # \url{https://docs.microsoft.com/en-us/dotnet/api/system.environment.specialfolder}\cr # } # # \seealso{ # @seeclass # } #*/######################################################################### setMethodS3("findGhostscript", "System", function(static, updateRGSCMD=TRUE, firstOnly=TRUE, force=FALSE, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Local functions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - isFileX <- function(pathname, ...) { if (length(pathname) == 0L) return(logical(0L)) (nchar(pathname, type="chars") > 0L) & sapply(pathname, FUN=isFile) } # isFileX() isDirectoryX <- function(path, ...) { if (length(path) == 0L) return(logical(0L)) (nchar(path, type="chars") > 0L) & sapply(path, FUN=isDirectory) } # isDirectoryX() findGSBySysEnv <- function(names=c("R_GSCMD"), ...) { pathnames <- Sys.getenv(names, "") pathnames <- pathnames[isFileX(pathnames)] pathnames } # findGSBySysEnv() findGSByWhich <- function(names=c("gswin64c", "gswin32c", "gs"), ...) { pathnames <- Sys.which(names) pathnames <- pathnames[isFileX(pathnames)] pathnames } # findGSByWhich() findGSOnWindows <- function(patterns=c("^gswin64c.exe$", "^gswin32c.exe$"), ...) { # (a) Look in "Program Files" directories paths <- Sys.getenv(c("ProgramFiles(X86)", "ProgramFiles", "Programs")) # (b) Look also in C:\ and %SystemDrive% paths <- c(paths, "C:", Sys.getenv("SystemDrive")) # (c) Drop non-existing directories paths <- unique(paths) paths <- paths[isDirectoryX(paths)] if (length(paths) == 0L) return(NULL) # Assume Ghostscript is installed under <path>\gs\ paths <- file.path(paths, "gs") paths <- paths[isDirectoryX(paths)] if (length(paths) == 0L) return(NULL) # Now search each of the directories for Ghostscript executables pathnames <- NULL for (pattern in patterns) { for (path in paths) { pathnamesT <- list.files(pattern=pattern, ignore.case=TRUE, path=path, recursive=TRUE, full.names=TRUE) pathnamesT <- pathnamesT[isFileX(pathnamesT)] pathnames <- c(pathnames, pathnamesT) } # for (path ...) } # for (pattern ...) pathnames } # findGSOnWindows() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Check environment variable 'R_GSCMD' # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - pathnames <- findGSBySysEnv("R_GSCMD") if (!force && firstOnly && length(pathnames) > 0L) { return(pathnames[1L]) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Search for Ghostscript # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - OST <- .Platform$OS.type if (OST == "windows") { # (1) Check environment variable 'GSC' pathnames <- findGSBySysEnv("GSC") # (2) Search executable on the system PATH pathnames <- c(pathnames, findGSByWhich(c("gswin64c", "gswin32c"))) # (3) Search known Windows locations pathnames <- c(pathnames, findGSOnWindows()) } else { # Search executable on the system PATH pathnames <- c(pathnames, findGSByWhich("gs")) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Found Ghostscript? # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Cleanup and normalize paths if (length(pathnames) > 0L) { pathnames <- unique(pathnames) pathnames <- normalizePath(pathnames) } # Return only first one found? if (firstOnly && length(pathnames) > 0L) { pathnames <- pathnames[1L] } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Update environment variable R_GSCMD? # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (updateRGSCMD) { if (length(pathnames) > 0L) { pathnameT <- pathnames[1L] if (OST == "windows" && exists("shortPathName", mode="function")) { # To please R CMD check shortPathName <- NULL; rm(list="shortPathName") pathnameT <- shortPathName(pathnameT) } Sys.setenv("R_GSCMD"=pathnameT) } else { warning("R_GSCMD not set, because Ghostscript was not found.") } } pathnames }, static=TRUE) #########################################################################/** # @RdocMethod findGraphicsDevice # # @title "Searches for a working PNG device" # # \description{ # @get "title". # # On Unix, the png device requires that X11 is available, which it is not # when running batch scripts or running \R remotely. In such cases, an # alternative is to use the \code{bitmap()} device, which generates an # EPS file and the uses Ghostscript to transform it to a PNG file. # # Moreover, if identical looking bitmap and vector graphics (EPS) files # are wanted for the same figures, in practice, \code{bitmap()} has # to be used. # # By default, this method tests a list of potential graphical devices and # returns the first that successfully creates an image file. # By default, it tries to create a PNG image file via the built-in # \code{png()} device. # } # # @synopsis # # \arguments{ # \item{devices}{A @list of graphics device driver @functions to be # tested.} # \item{maxCount}{The maximum number of subsequent tests for the # the existences of \code{bitmap()} generated image files.} # \item{sleepInterval}{The time in seconds between above subsequent # tests.} # \item{findGhostscript}{If @TRUE, Ghostscript, which is needed by # the \code{bitmap()} device, is searched for on the current system. # If found, its location is recorded.} # \item{...}{Not used.} # } # # \value{ # Returns a @function that generates images, or @NULL. # } # # @author # # \examples{ # fcn <- System$findGraphicsDevice() # if (identical(fcn, png)) { # cat("PNG device found: png()") # } else if (identical(fcn, bitmap)) { # cat("PNG device found: bitmap()") # } else { # cat("PNG device not found.") # } # } # # \seealso{ # For supported graphical devices, see @see "capabilities". # @see "grDevices::png", # \code{bitmap()} and @see "grDevices::dev2bitmap". # @seemethod "findGhostscript". # @seeclass # } # # @keyword device #*/######################################################################### setMethodS3("findGraphicsDevice", "System", function(static, devices=list(png), maxCount=100, sleepInterval=0.1, findGhostscript=TRUE, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'devices': devices <- as.list(devices) for (device in devices) { if (!is.function(device)) { throw("Argument 'devices' specifies a non-function element: ", mode(device)) } } # Argument 'maxCount': maxCount <- Arguments$getInteger(maxCount, range=c(1,Inf)) # Argument 'sleepInterval': sleepInterval <- Arguments$getDouble(sleepInterval, range=c(0,60)) # Argument 'findGhostscript': findGhostscript <- Arguments$getLogical(findGhostscript) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Check for a valid ghostscript installation # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (findGhostscript) System$findGhostscript() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Temporary output file for testing # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - file <- tempfile("findGraphicsDevice-testFile") on.exit({ if (file.exists(file)) { file.remove(file) } }) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Find the first functional device # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - for (device in devices) { # Check capabilities if (identical(device, png)) { if (!capabilities("png")) next } if (identical(device, jpeg)) { if (!capabilities("jpeg")) next } tryCatch({ device(file) plot(0) dev.off() # The following wait-and-poll code is typically only necessary for # the bitmap() device since it calls Ghostscript, which is called # without waiting for it to finish. The default is to poll for the # dummy image file for 10 seconds in intervals of 0.1 seconds. # If not found by then, the device is considered not to be found. # Hopefully, this is never the case. count <- 0L while (count < maxCount) { if (file.exists(file)) { size <- file.info2(file)$size if (!is.na(size) && size > 0L) { return(device) } } Sys.sleep(sleepInterval) count <- count + 1L } }, error = function(error) { }) } # for (device in ...) NULL }, static=TRUE) setMethodS3("mapDriveOnWindows", "System", function(static, drive, path=getwd(), ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Local functions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - isWindowsUncPath <- function(path, ...) { (regexpr("^(//|\\\\)", path) != -1L) } # isWindowsUncPath() getWindowsDrivePattern <- function(fmtstr, ...) { # Windows drive letters drives <- "ABCDEFGHIJKLMNOPQRSTUVWXYZ" # Support also lower case drives <- paste(c(drives, tolower(drives)), collapse="") sprintf(fmtstr, drives) } # getWindowsDrivePattern() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'drive': drive <- Arguments$getCharacter(drive, length=c(1L,1L), nchar=2L) pattern <- getWindowsDrivePattern("[%s]:") if (regexpr(pattern, toupper(drive)) == -1L) { drive0 <- drive # Add a colon, in case user forgot drive <- sprintf("%s:", drive) if (regexpr(pattern, toupper(drive)) == -1L) { throw("Argument 'drive' is not a valid drive (e.g. 'Y:'): ", drive0) } } # Argument 'path': if (isWindowsUncPath(path)) { path <- gsub("\\", "/", path, fixed=TRUE) # Network drives cannot have trailing slashes path <- gsub("[/\\\\]*$", "", path) } else { path <- Arguments$getReadablePath(path, mustExist=TRUE) } # New path, if successful newPath <- sprintf("%s/", drive) # Already mapped? mapped <- System$getMappedDrivesOnWindows() mappedTo <- mapped[drive] if (!is.na(mappedTo)) { if (!isWindowsUncPath(path)) { mappedTo <- Arguments$getReadablePath(mappedTo) } if (path != mappedTo) { throw(sprintf("Drive letter %s is already mapped to another path ('%s'), which is different from the requested one: %s", drive, mappedTo, path)) } # If mapped to the same path, nothing to do return(invisible(newPath)) } # UNC paths should be mapped by 'net', # cf. http://support.microsoft.com/kb/218740 if (isWindowsUncPath(path)) { # Map using 'net use', which: # (i) only recognized backslashes pathT <- gsub("/", "\\", path, fixed=TRUE) cmd <- sprintf("net use %s \"%s\"", toupper(drive), pathT) res <- system(cmd, intern=FALSE) if (res != 0L) { res <- "???" throw(sprintf("Failed to map drive '%s' to path '%s': %s (using '%s')", drive, path, res, cmd)) } } else { # Map using 'subst' cmd <- sprintf("subst %s \"%s\"", toupper(drive), path) res <- system(cmd, intern=TRUE) if (length(res) > 0L) { throw(sprintf("Failed to map drive '%s' to path '%s': %s (using '%s')", drive, path, res, cmd)) } } # Return new path invisible(newPath) }, static=TRUE) setMethodS3("unmapDriveOnWindows", "System", function(static, drive, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Local functions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - isWindowsUncPath <- function(path, ...) { (regexpr("^(//|\\\\)", path) != -1L) } # isWindowsUncPath() getWindowsDrivePattern <- function(fmtstr, ...) { # Windows drive letters drives <- "ABCDEFGHIJKLMNOPQRSTUVWXYZ" # Support also lower case drives <- paste(c(drives, tolower(drives)), collapse="") sprintf(fmtstr, drives) } # getWindowsDrivePattern() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'drive': drive <- Arguments$getCharacter(drive, length=c(1L,1L), nchar=2L) pattern <- getWindowsDrivePattern("[%s]:") if (regexpr(pattern, toupper(drive)) == -1L) { drive0 <- drive # Add a colon, in case user forgot drive <- sprintf("%s:", drive) if (regexpr(pattern, toupper(drive)) == -1L) { throw("Argument 'drive' is not a valid drive (e.g. 'Y:'): ", drive) } } # Get old paths maps <- getMappedDrivesOnWindows(static) oldPath <- maps[toupper(drive)] if (is.na(oldPath)) { return(invisible(NULL)) } # Unmap if (isWindowsUncPath(oldPath)) { # Unmap using 'net use' cmd <- sprintf("net use /delete \"%s\"", toupper(drive)) res <- system(cmd, intern=FALSE) if (res != 0L) { res <- "???" throw(sprintf("Failed to unmap drive '%s': %s (using '%s')", drive, res, cmd)) } } else { # Unmap using 'subst' cmd <- sprintf("subst \"%s\" /D", toupper(drive)) res <- system(cmd, intern=TRUE) if (length(res) > 0L) { throw(sprintf("Failed to unmap drive '%s': %s (using '%s')", drive, res, cmd)) } } # Return old path invisible(oldPath) }, static=TRUE) setMethodS3("getMappedDrivesOnWindows", "System", function(static, ...) { # (1) By 'subst' mounts <- system("subst", intern=TRUE) pattern <- "^(.:).*[ ]*=>[ ]*(.*)[ ]*" drives <- gsub(pattern, "\\1", mounts) paths <- gsub(pattern, "\\2", mounts) paths <- trim(paths) names(paths) <- drives paths1 <- paths # (1) By 'net use' mounts <- system("net use", intern=TRUE) pattern <- "^(.*)[ ]+(.:)[ ]+(.*)[ ]+(.*)$" mounts <- grep(pattern, mounts, value=TRUE) drives <- gsub(pattern, "\\2", mounts) paths <- gsub(pattern, "\\3", mounts) paths <- trim(paths) names(paths) <- drives paths2 <- paths paths <- c(paths1, paths2) # Standardize paths <- gsub("\\", "/", paths, fixed=TRUE) # Order by drive letters if (length(paths) > 1L) { o <- order(names(paths)) paths <- paths[o] } paths }, static=TRUE) ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/TextStatusBar.R���������������������������������������������������������������������������0000644�0001762�0000144�00000017774�14372747611�014747� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocClass TextStatusBar # # @title "A status bar at the R prompt that can be updated" # # \description{ # @classhierarchy # # @get "title". # } # # @synopsis # # \arguments{ # \item{fmt}{A @character format string to be used by @see "base::sprintf". # Default is a left-aligned string of full width.} # \item{...}{Named arguments to be passed to @see "base::sprintf" together # with the format string.} # } # # \section{Fields and Methods}{ # @allmethods # } # # \details{ # A label with name \code{hfill} can be used for automatic horizontal # filling. It must be @numeric and be immediate before a string # label such that a \code{hfill} label and the following string label # together specifies an sprintf format such as \code{"\%*-s"}. # The value of \code{hfill} will be set such that the resulting status # bar has width equal to \code{getOption("width")-1} (the reason for the # -1 is to prevent the text status bar from writing into the next line). # If more than one \code{hfill} label is used their widths will be # uniformly distributed. Left over spaces will be distributed between # \code{hfill} labels with initial values of one. # } # # @examples "../incl/TextStatusBar.Rex" # # @author # # @keyword programming # @keyword IO #*/########################################################################### setConstructorS3("TextStatusBar", function(fmt=paste("%-", getOption("width")-1, "s", sep=""), ...) { extend(Object(core=TRUE), "TextStatusBar", .lastStr = "", .fmt = fmt, .args = list(...) ) }) ###########################################################################/** # @RdocMethod update # # @title "Updates the status bar (visually)" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns nothing. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("update", "TextStatusBar", function(object, ...) { # To please R CMD check this <- object fmt <- this$.fmt args <- this$.args isHFill <- which(names(args) == "hfill") nHFill <- length(isHFill) if (nHFill > 0) { # First, use zero width to figure out the total width without "hfillers". argsT <- args argsT[isHFill] <- 0 argsT[isHFill+1] <- "" str <- do.call(sprintf, args=c(list(fmt=fmt), argsT)) nfill <- (getOption("width")-1) - nchar(str) if (nfill > 0) { # Distribute the horizontal fillers evenly. spcs <- rep(nfill %/% nHFill, times=nHFill) ndiff <- nfill - sum(spcs) if (ndiff > 0) { # For the left overs, distribute them evenly between the hfillers # with values 1. incr <- rep(FALSE, times=nHFill) incr[args[isHFill] == 1] <- TRUE spcs[incr] <- spcs[incr] + 1 } args[isHFill] <- spcs } } str <- do.call(sprintf, args=c(list(fmt=fmt), args)) lastStr <- this$.lastStr this$.lastStr <- str backspaces <- paste(rep("\b", nchar(lastStr)), collapse="") cat(backspaces, str, sep="") }) ###########################################################################/** # @RdocMethod setLabels # # @title "Sets new values of given labels" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{A set of named arguments.} # } # # \value{ # Returns nothing. # } # # @author # # \seealso{ # @seemethod "setLabel". # @seemethod "updateLabels". # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("setLabels", "TextStatusBar", function(this, ...) { pars <- list(...) args <- this$.args for (label in names(pars)) { args[[label]] <- pars[[label]] } this$.args <- args }) ###########################################################################/** # @RdocMethod setLabel # # @title "Sets the value of a label" # # \description{ # @get "title" address either by its index or its names. # } # # @synopsis # # \arguments{ # \item{label}{The index or the name of the label.} # \item{value}{The value of the label.} # \item{...}{Not used.} # } # # \value{ # Returns nothing. # } # # @author # # \seealso{ # @seemethod "setLabels" # @seemethod "getLabel" # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("setLabel", "TextStatusBar", function(this, label, value, ...) { args <- this$.args args[[label]] <- value this$.args <- args }) ###########################################################################/** # @RdocMethod getLabel # # @title "Gets the current value of a label" # # \description{ # @get "title" address either by its index or its names. # } # # @synopsis # # \arguments{ # \item{label}{The index or the name of the label.} # \item{...}{Not used.} # } # # \value{ # Returns the value. # } # # @author # # \seealso{ # @seemethod "setLabel" and @seemethod "setLabels". # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("getLabel", "TextStatusBar", function(this, label, ...) { args <- this$.args .subset2(args, label) }) ###########################################################################/** # @RdocMethod newline # # @title "Writes a newline" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns nothing. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("newline", "TextStatusBar", function(this, ...) { this$.lastStr <- "" cat("\n") }) ###########################################################################/** # @RdocMethod updateLabels # # @title "Sets the new values of given labels and updates the status bar" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{A set of named arguments.} # } # # \value{ # Returns nothing. # } # # @author # # \seealso{ # @seemethod "setLabels". # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("updateLabels", "TextStatusBar", function(this, ...) { setLabels(this, ...) update(this) }) ###########################################################################/** # @RdocMethod popMessage # # @title "Adds a message above the status bar" # # \description{ # @get "title" by scrolling up previous messages popped. # } # # @synopsis # # \arguments{ # \item{...}{Arguments passed to @see "base::cat".} # \item{collapse, sep}{Default values to @see "base::cat".} # } # # \value{ # Returns nothing. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("popMessage", "TextStatusBar", function(this, ..., collapse="", sep="") { lastStr <- this$.lastStr # Erase current statusbar backspaces <- rep("\b", nchar(lastStr)) erazor <- c(backspaces, rep(" ", nchar(lastStr)), backspaces) cat(erazor, sep="") this$.lastStr <- "" cat(..., collapse=collapse, sep=sep) cat("\n") update(this) }) ###########################################################################/** # @RdocMethod flush # # @title "Flushes the output" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Arguments passed to @see "base::cat".} # } # # \value{ # Returns nothing. # } # # \details{ # All this methods does is to call @see "utils::flush.console", which # flushes the output to the console. # } # # @author # # \seealso{ # @see "utils::flush.console". # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("flush", "TextStatusBar", function(con, ...) { # To please R CMD check this <- con flush.console() }) ����R.utils/R/commandArgs.R�����������������������������������������������������������������������������0000644�0001762�0000144�00000055667�14372747611�014430� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#########################################################################/** # @RdocFunction commandArgs # # @title "Extract command-line arguments" # # @synopsis # # \description{ # Provides access to a copy of the command-line arguments supplied when # this \R session was invoked. This function is backward compatible with # @see "base::commandArgs" of the \pkg{base} package, but adds more # features. # } # # \arguments{ # \item{trailingOnly}{If @TRUE, only arguments after \code{--args} # are returned.} # \item{asValues}{If @TRUE, a named @list is returned, where command # line arguments of type \code{--foo} will be returned as @TRUE with # name \code{foo}, and arguments of type \code{-foo=value} will be # returned as @character string \code{value} with name \code{foo}. # In addition, if \code{-foo value} is given, this is interpreted # as \code{-foo=value}, as long as \code{value} does not start with # a double dash (\code{--}).} # \item{defaults}{A @character @vector or a named @list of default # arguments. Any command-line or fixed arguments will override # default arguments with the same name.} # \item{always}{A @character @vector or a named @list of fixed # arguments. These will override default and command-line # arguments with the same name.} # \item{adhoc}{(ignored if \code{asValues=FALSE}) If @TRUE, then # additional coercion of @character command-line arguments to # more specific data types is performed, iff possible.} # \item{unique}{If @TRUE, the returned set of arguments contains only # unique arguments such that no two arguments have the same name. # If duplicates exists, it is only the last one that is kept.} # \item{excludeReserved}{If @TRUE, arguments reserved by \R are excluded, # otherwise not. Which the reserved arguments are depends on operating # system. For details, see Appendix B on "Invoking R" in # \emph{An Introduction to R}.} # \item{excludeEnvVars}{If @TRUE, arguments that assigns environment # variable are excluded, otherwise not. As described in \code{R --help}, # these are arguments of format <key>=<value>.} # \item{os}{A @vector of @character strings specifying which set of # reserved arguments to be used. Possible values are \code{"unix"}, # \code{"mac"}, \code{"windows"}, \code{"ANY"} or \code{"current"}. # If \code{"current"}, the current platform is used. If \code{"ANY"} or # @NULL, all three OSs are assumed for total cross-platform # compatibility.} # \item{args}{A named @list of arguments.} # \item{.args}{A @character @vector of command-line arguments.} # \item{...}{Passed to @see "base::commandArgs" of the \pkg{base} package.} # } # # \value{ # If \code{asValue} is @FALSE, a @character @vector is returned, which # contains the name of the executable and the non-parsed user-supplied # arguments. # # If \code{asValue} is @TRUE, a named @list containing is returned, which # contains the the executable and the parsed user-supplied arguments. # # The first returned element is the name of the executable by which # \R was invoked. As far as I am aware, the exact form of this element # is platform dependent. It may be the fully qualified name, or simply # the last component (or basename) of the application. # The returned attribute \code{isReserved} is a @logical @vector # specifying if the corresponding command-line argument is a reserved # \R argument or not. # } # # \section{Backward compatibility}{ # This function should be fully backward compatible with the same # function in the \pkg{base} package, except when littler is used # (see below). # } # \section{Compatibility with littler}{ # The littler package provides the \code{r} binary, which parses # user command-line options and assigns them to character vector # \code{argv} in the global environment. # The \code{commandArgs()} of this package recognizes \code{argv} # arguments as well. # } # # \section{Coercing to non-character data types}{ # When \code{asValues} is @TRUE, the command-line arguments are # returned as a named @list. By default, the values of these # arguments are @character strings. # However, any command-line argument that share name with one of # the 'always' or 'default' arguments, then its value is coerced to # the corresponding data type (via @see "methods::as"). # This provides a mechanism for specifying data types other than # @character strings. # # Furthermore, when \code{asValues} and \code{adhoc} are @TRUE, any # remaining character string command-line arguments are coerced to more # specific data types (via @see "utils::type.convert"), if possible. # } # # @author # # @examples "../incl/commandArgs.Rex" # # \seealso{ # For a more user friendly solution, see @see "cmdArgs". # Internally @see "base::commandArgs" is used. # } # # @keyword "programming" # @keyword "internal" #*/######################################################################### commandArgs <- function(trailingOnly=FALSE, asValues=FALSE, defaults=NULL, always=NULL, adhoc=FALSE, unique=FALSE, excludeReserved=FALSE, excludeEnvVars=FALSE, os=NULL, .args=NULL, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Local functions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - getReserved <- function(os, patterns=FALSE) { rVer <- getRversion() # General arguments if (rVer >= "4.0.0") { # According to R v4.0.0: reservedArgs <- c("--help", "-h", "--version", "--encoding=(.*)", "--encoding (.*)", "--save", "--no-save", "--no-environ", "--no-site-file", "--no-init-file", "--restore", "--no-restore", "--no-restore-data", "--no-restore-history", "--vanilla", "-f (.*)", "--file=(.*)", "-e (.*)", "--min-vsize=(.*)", "--max-vsize=(.*)", "--min-nsize=(.*)", "--max-nsize=(.*)", "--max-ppsize=(.*)", "--quiet", "--silent", "--no-echo", "-q", "--slave", "--verbose", "--args") } else if (rVer >= "2.13.0") { # According to R v2.13.1: reservedArgs <- c("--help", "-h", "--version", "--encoding=(.*)", "--encoding (.*)", "--save", "--no-save", "--no-environ", "--no-site-file", "--no-init-file", "--restore", "--no-restore", "--no-restore-data", "--no-restore-history", "--vanilla", "-f (.*)", "--file=(.*)", "-e (.*)", "--min-vsize=(.*)", "--max-vsize=(.*)", "--min-nsize=(.*)", "--max-nsize=(.*)", "--max-ppsize=(.*)", "--quiet", "--silent", "-q", "--slave", "--verbose", "--args") } else if (rVer >= "2.7.0") { # According to R v2.7.1: reservedArgs <- c("--help", "-h", "--version", "--encoding=(.*)", "--save", "--no-save", "--no-environ", "--no-site-file", "--no-init-file", "--restore", "--no-restore", "--no-restore-data", "--no-restore-history", "--vanilla", "-f (.*)", "--file=(.*)", "-e (.*)", "--min-vsize=(.*)", "--max-vsize=(.*)", "--min-nsize=(.*)", "--max-nsize=(.*)", "--max-ppsize=(.*)", "--quiet", "--silent", "-q", "--slave", "--interactive", "--verbose", "--args") } else { # According to R v2.0.1: reservedArgs <- c("--help", "-h", "--version", "--save", "--no-save", "--no-environ", "--no-site-file", "--no-init-file", "--restore", "--no-restore", "--no-restore-data", "--no-restore-history", "--vanilla", "--min-vsize=(.*)", "--max-vsize=(.*)", "--min-nsize=(.*)", "--max-nsize=(.*)", "--max-ppsize=(.*)", "--quiet", "--silent", "-q", "--slave", "--verbose", "--args") } # a) Unix (and macOS?!? /HB 2011-09-14) if ("unix" %in% os) { reservedArgs <- c(reservedArgs, "--no-readline", "--debugger-args=(.*)", "--debugger=(.*)", "-d", "--gui=(.*)", "-g", "--interactive", "--arch=(.*)") if (rVer >= "3.0.0") { # Source: R 3.0.0 NEWS (but did not appear in R --help until R 3.2.0) reservedArgs <- c(reservedArgs, "--min-nsize=(.*)", "--min-vsize=(.*)") } } # b) Macintosh if ("mac" %in% os) { # Nothing special here. } # c) Windows if ("windows" %in% os) { reservedArgs <- c(reservedArgs, "--no-Rconsole", "--ess", "--max-mem-size=(.*)") # Additional command-line options for RGui.exe reservedArgs <- c(reservedArgs, "--mdi", "--sdi", "--no-mdi", "--debug") } # If duplicates where created, remove them reservedArgs <- unique(reservedArgs) if (patterns) { # Create regular expression patterns out of the reserved arguments args <- gsub("^(-*)([-a-zA-Z]+)", "\\1(\\2)", reservedArgs) args <- sprintf("^%s$", args) reservedArgs <- list() # Identify the ones that has an equal sign idxs <- grep("=(.*)", args, fixed=TRUE) reservedArgs$equals <- args[idxs] args <- args[-idxs] # Identify the ones that has an extra argument idxs <- grep(" (.*)", args, fixed=TRUE) reservedArgs$pairs <- gsub(" .*", "$", args[idxs]) args <- args[-idxs] # The rest are flags reservedArgs$flags <- args } reservedArgs } # getReserved() # Parse reserved pairs ('-<key>', '<value>') and ('--<key>', '<value>') # arguments into '-<key> <value>' and '--<key> <value>', respectively. parseReservedArgs <- function(args, os) { nargs <- length(args) reservedArgs <- getReserved(os=os, patterns=TRUE) # Set user arguments to start after '--args', otherwise # all arguments are considered user arguments user <- FALSE startU <- which(args == "--args")[1L] if (is.na(startU)) user <- TRUE argsT <- list() idx <- 1L while (idx <= nargs) { # A user argument? user <- !user && isTRUE(idx > startU) # Argument to be investigates arg <- args[idx] # A flag argument? idxT <- unlist(sapply(reservedArgs$flags, FUN=grep, arg)) if (length(idxT) == 1L) { argsT[[idx]] <- list(arg=arg, user=user, reserved=!user, merged=FALSE, envvar=FALSE) idx <- idx + 1L next } # A '--<key> <value>' argument? idxT <- unlist(sapply(reservedArgs$pairs, FUN=grep, arg)) if (length(idxT) == 1L) { arg <- c(args[idx], args[idx+1L]) argsT[[idx]] <- list(arg=arg, user=user, reserved=!user, merged=TRUE, envvar=FALSE) idx <- idx + 2L next } # A '--<key>=<value>' argument? idxT <- unlist(sapply(reservedArgs$equals, FUN=grep, arg)) if (length(idxT) == 1L) { pattern <- reservedArgs$equals[idxT] argsT[[idx]] <- list(arg=arg, user=user, reserved=!user, merged=FALSE, envvar=FALSE) idx <- idx + 1L next } # An environment variable? envvar <- !user && (regexpr("^([^=-]*)(=)(.*)$", arg) != -1L) if (envvar) { argsT[[idx]] <- list(arg=arg, user=FALSE, reserved=FALSE, merged=FALSE, envvar=TRUE) idx <- idx + 1L next } # Otherwise a non-reserved argument argsT[[idx]] <- list(arg=arg, user=user, reserved=FALSE, merged=FALSE, envvar=FALSE) idx <- idx + 1L } # while (idx <= nargs) argsT <- argsT[!sapply(argsT, FUN=is.null)] argsT } # parseReservedArgs() assertNamedList <- function(x, .name=as.character(substitute(x))) { # Nothing todo? if (length(x) == 0L) return(x) keys <- names(x) if (is.null(keys)) { throw(sprintf("None of the elements in '%s' are named.", .name)) } if (any(nchar(keys) == 0L)) { throw(sprintf("Detected one or more non-named arguments in '%s' after parsing.", .name)) } x } # assertNamedList() coerceAs <- function(args, types) { types <- types[types != "NULL"] todo <- which(is.element(names(args), names(types)) & !sapply(args, FUN = inherits, "CmdArgExpression")) if (length(todo) > 0L) { argsT <- args[todo] typesT <- types[names(argsT)] suppressWarnings({ for (jj in seq_along(argsT)) { argT <- argsT[[jj]] value <- as(argT, Class=typesT[jj]) argsT[[jj]] <- value if (length(value) != 1L || !is.na(value)) argsT[[jj]] <- value } }) args[todo] <- argsT } args } # coerceAs() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'defaults': if (asValues) { defaults <- as.list(defaults) defaults <- assertNamedList(defaults) } else { if (is.list(defaults)) { throw("Argument 'defaults' must not be a list when asValues=FALSE.") } } # Argument 'always': if (asValues) { always <- as.list(always) always <- assertNamedList(always) } else { if (is.list(always)) { throw("Argument 'always' must not be a list when asValues=FALSE.") } } # Argument 'os': if (is.null(os) || toupper(os) == "ANY") { os <- c("unix", "mac", "windows") } else if (tolower(os) == "current") { os <- .Platform$OS.type } os <- tolower(os) if (any(is.na(match(os, c("unix", "mac", "windows"))))) { throw("Argument 'os' contains unknown values.") } # Argument '.args': if (is.null(.args)) { .args <- base::commandArgs(trailingOnly=trailingOnly) ## Also support 'littler' (https::cran.r-project.org/package=littler) ## command-line options 'argv' character vector. If it exists, then ## append it to the above vector of arguments. if (exists("argv", mode='character', envir=globalenv())) { argv <- get("argv", mode='character', envir=globalenv()) .args <- c(.args, argv) } } else if (!is.character(.args)) { throw("Argument '.args' must be a character vector: ", class(.args)[1L]) } args <- .args # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # (1) Parse into user, paired, reserved arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - argsT <- parseReservedArgs(args, os=os) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # (2) Identify which arguments not to drop # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - keep <- unlist(lapply(argsT, FUN=function(arg) { !(excludeReserved && arg$reserved) && !(excludeEnvVars && arg$envvar) })) argsT <- argsT[keep] # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # (3) Coerce arguments to a named list? # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (asValues) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # (a) Parse key-value pairs # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # An argument name cannot start with a hypen ('-'). keyPattern <- "[[:alnum:]_.][[:alnum:]_.-]*" nargsT <- length(argsT) for (ii in seq_len(nargsT)) { argI <- argsT[[ii]] arg <- argI$arg ## printf("Argument #%d: '%s' [n=%d]\n", ii, arg, length(arg)) if (length(arg) == 2L) { argsT[[ii]]$key <- gsub("^[-]*", "", arg[1L]) argsT[[ii]]$value <- arg[2L] next } # Sanity check .stop_if_not(length(arg) == 1L) # --<key>(=|:=)<value> pattern <- sprintf("^--(%s)(=|:=)(.*)$", keyPattern) if (regexpr(pattern, arg) != -1L) { key <- gsub(pattern, "\\1", arg) what <- gsub(pattern, "\\2", arg) value <- gsub(pattern, "\\3", arg) if (what == ":=") class(value) <- c("CmdArgExpression") argsT[[ii]]$key <- key argsT[[ii]]$value <- value next } # --<key> pattern <- sprintf("^--(%s)$", keyPattern) if (regexpr(pattern, arg) != -1L) { key <- gsub(pattern, "\\1", arg) argsT[[ii]]$key <- key next } # -<key>(=|:=)<value> pattern <- sprintf("^-(%s)(=|:=)(.*)$", keyPattern) if (regexpr(pattern, arg) != -1L) { key <- gsub(pattern, "\\1", arg) what <- gsub(pattern, "\\2", arg) value <- gsub(pattern, "\\3", arg) if (what == ":=") class(value) <- c("CmdArgExpression") argsT[[ii]]$key <- key argsT[[ii]]$value <- value next } # -<key> pattern <- sprintf("^-(%s)$", keyPattern) if (regexpr(pattern, arg) != -1L) { key <- gsub(pattern, "\\1", arg) argsT[[ii]]$key <- key next } # <key>(=|:=)<value> pattern <- sprintf("^(%s)(=|:=)(.*)$", keyPattern) if (regexpr(pattern, arg) != -1L) { key <- gsub(pattern, "\\1", arg) what <- gsub(pattern, "\\2", arg) value <- gsub(pattern, "\\3", arg) if (what == ":=") class(value) <- c("CmdArgExpression") argsT[[ii]]$key <- key argsT[[ii]]$value <- value next } argsT[[ii]]$value <- arg } # for (ii ...) # Rescue missing values if (nargsT > 1L) { for (ii in 1:(nargsT-1L)) { if (length(argsT[[ii]]) == 0L) next key <- argsT[[ii]]$key value <- argsT[[ii]]$value # No missing value? if (!is.null(value)) { ## This is what makes "R" into R=NA. Is that what we want? /HB 2014-01-26 if (is.null(key)) { argsT[[ii]]$key <- value argsT[[ii]]$value <- NA_character_ } next } # Missing value - can we rescue it? nextKey <- argsT[[ii+1L]]$key nextValue <- argsT[[ii+1L]]$value if (is.null(nextKey)) { # Definitely! argsT[[ii]]$value <- nextValue argsT[[ii+1L]] <- list(); # Drop next next } # Otherwise, interpret as a flag argsT[[ii]]$value <- TRUE } # for (ii ...) # Special case: Rescue missing value in argsT[[<last>]]? argT <- argsT[[nargsT]] if (length(argT) > 0L && is.null(argT$value)) { argsT[[nargsT]]$value <- TRUE } # Drop empty keep <- (sapply(argsT, FUN=length) > 0L) argsT <- argsT[keep] nargsT <- length(argsT) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # (b) Revert list(a="1", key=NA) to list(a="1", "key") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - for (ii in seq_along(argsT)) { if (identical(argsT[[ii]]$value, NA_character_)) { argsT[[ii]]$value <- argsT[[ii]]$key argsT[[ii]]$key <- "" } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # (c) Make sure everything has a key # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - for (ii in seq_along(argsT)) { if (is.null(argsT[[ii]]$key)) { argsT[[ii]]$key <- "" } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # (d) Coerce to key=value list # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - keys <- unlist(lapply(argsT, FUN=function(x) x$key)) args <- lapply(argsT, FUN=function(x) x$value) names(args) <- keys argsT <- NULL; # Not needed anymore # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # (e) Coerce arguments to known data types? # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (length(args) > 0L && length(defaults) + length(always) > 0L) { # First to the 'always', then remaining to the 'defaults'. types <- sapply(c(defaults, always), FUN=storage.mode) keep <- !duplicated(names(types), fromLast=TRUE) types <- types[keep] args <- coerceAs(args, types=types) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # (f) Ad hoc coercion of numerics? # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (adhoc && length(args) > 0L) { modes <- sapply(args, FUN=storage.mode) idxs <- which(modes == "character") if (length(idxs) > 0L) { argsT <- args[idxs] # Try to coerce / evaluate... for (kk in seq_along(argsT)) { arg <- argsT[[kk]] # (a) Try to evaluate expression using eval(parse(...)) if (inherits(arg, "CmdArgExpression")) { value <- tryCatch({ expr <- parse(text=arg) value <- eval(expr, envir=globalenv()) }, error=function(ex) { value <- arg class(value) <- c("FailedCmdArgExpression", class(value)) value }) argsT[kk] <- list(value); ## Also NULL next } # (b) Don't coerce 'T' and 'F' to logical if (is.element(arg, c("T", "F"))) next # (c) Try to coerce to "logical, integer, numeric, complex # or factor as appropriate." using utils::type.convert() tryCatch({ value <- type.convert(arg, as.is=TRUE) argsT[[kk]] <- value }, error=function(ex) {}) } args[idxs] <- argsT } } # if (adhoc) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # (g) Coerce arguments to known data types? # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (length(args) > 0L && length(defaults) + length(always) > 0L) { # First to the 'always', then remaining to the 'defaults'. types <- sapply(c(defaults, always), FUN=storage.mode) keep <- !duplicated(names(types), fromLast=TRUE) types <- types[keep] args <- coerceAs(args, types=types) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # (h) Prepend defaults, if not already specified # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (length(defaults) > 0L) { # Any missing? idxs <- which(!is.element(names(defaults), names(args))) if (length(idxs) > 0L) { args <- c(args[1L], defaults[idxs], args[-1L]) } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # (i) Override by/append 'always' arguments? # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (length(always) > 0L) { args <- c(args, always) } # Keep only unique arguments? if (unique && length(args) > 1L) { # Keep only those with unique names keep <- !duplicated(names(args), fromLast=TRUE) # ...and those without names keep <- keep | !nzchar(names(args)) args <- args[keep] } } else { # if (asValue) args <- unlist(lapply(argsT, FUN=function(x) x$arg)) argsT <- NULL; # Not needed anymore # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # (a) Prepend defaults, if not already specified # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (length(defaults) > 0L) { # Any missing? idxs <- which(!is.element(defaults, args)) if (length(idxs) > 0L) { args <- c(args[1L], defaults[idxs], args[-1L]) } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # (b) Append 'always' argument, if not already specified # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (length(always) > 0L) { args <- c(args, setdiff(always, args)) } # Keep only unique arguments? if (unique && length(args) > 0L) { keep <- !duplicated(args, fromLast=TRUE) args <- args[keep] } } # if (asValues) args } # commandArgs() �������������������������������������������������������������������������R.utils/R/isZero.R����������������������������������������������������������������������������������0000644�0001762�0000144�00000003470�14372747611�013431� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#########################################################################/** # @RdocDefault isZero # # @title "Checks if a value is (close to) zero or not" # # @synopsis # # \description{ # Checks if a value (or a vector of values) is (close to) zero or not # where "close" means if the absolute value is less than \code{neps*eps}. # \emph{Note that \code{x == 0} will not work in all cases.} # # By default \code{eps} is the smallest possible floating point value # that can be represented by the running machine, i.e. # \code{.Machine$double.eps} and \code{neps} is one. # By changing \code{neps} it is easy to adjust how close to zero "close" # means without having to know the machine precision (or remembering how # to get it). # } # # \arguments{ # \item{x}{A @vector of values.} # \item{eps}{The smallest possible floating point.} # \item{neps}{A scale factor of \code{eps} specifying how close to zero # "close" means. If \code{eps} is the smallest value such that # \code{1 + eps != 1}, i.e. \code{.Machine$double.eps}, \code{neps} must # be greater or equal to one.} # \item{...}{Not used.} # } # # \value{Returns a @logical @vector indicating if the elements are zero or not.} # # @author # # \seealso{ # @see "base::all.equal". # @see "base::Comparison". # \code{\link[base:zMachine]{.Machine}}. # } # # @examples "../incl/isZero.Rex" # # @keyword "logic" #*/######################################################################### setMethodS3("isZero", "default", function(x, neps=1, eps=.Machine$double.eps, ...) { if (is.character(eps)) { eps <- match.arg(eps, choices=c("double.eps", "single.eps")) if (eps == "double.eps") { eps <- .Machine$double.eps } else if (eps == "single.eps") { eps <- sqrt(.Machine$double.eps) } } (abs(x) < neps*eps) }) ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/sourceDirectory.R�������������������������������������������������������������������������0000644�0001762�0000144�00000014234�14372747611�015343� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������########################################################################/** # @RdocDefault sourceDirectory # # @title "Sources files recursively to either local or global environment" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{path}{A path to a directory to be sourced.} # \item{pattern}{A regular expression file name pattern to identify # source code files.} # \item{recursive}{If @TRUE, subdirectories are recursively sourced # first, otherwise not.} # \item{envir}{An @environment in which the code should be evaluated.} # \item{onError}{If an error occurs, the error may stop the job, # give a warning, or silently be skipped.} # \item{modifiedOnly}{If @TRUE, only files that are modified since the # last time they were sourced are sourced, otherwise regardless.} # \item{...}{Additional arguments passed to @see "sourceTo".} # \item{verbose}{A @logical or a @see "Verbose" object.} # } # # \value{ # Returns a @vector of the full pathnames of the files sourced. # } # # \section{Details}{ # Subdirectories and files in each (sub-)directory are sourced # in lexicographic order. # } # # \section{Hooks}{ # This method does not provide hooks, but the internally used # @see "sourceTo" does. # } # # \seealso{ # @see "sourceTo" and compare to @see "base::source". # } # # @author # # @keyword IO # @keyword programming #**/####################################################################### # Create a filename pattern for R files and Windows shortcuts too such. # sourceTo() will automatically recognize those too. setMethodS3("sourceDirectory", "default", function(path, pattern=".*[.](r|R|s|S|q)([.](lnk|LNK))*$", recursive=TRUE, envir=parent.frame(), onError=c("error", "warning", "skip"), modifiedOnly=TRUE, ..., verbose=FALSE) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'path': path <- filePath(path) if (!isDirectory(path)) return(NULL) # Argument 'onError' onError <- match.arg(onError) # Argument 'verbose' verbose <- Arguments$getVerbose(verbose) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # start... # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Store files that get sourced. sourcedFiles <- c() # First, if recursive, follow all directories... if (recursive) { verbose && cat(verbose, "Sourcing directory recursively: ", path) dirs <- list.files(path=path, recursive=FALSE, all.files=TRUE, full.names=TRUE) dirs <- dirs[!(basename(dirs) %in% c(".", ".."))] # Source directories in lexicographic order if (length(dirs) > 0) # To avoid warning():s dirs <- sort(dirs) for (dir in dirs) { pathname <- filePath(dir) if (isDirectory(pathname)) { verbose && cat(verbose, "Entering: ", pathname) sourcedFiles <- c(sourcedFiles, sourceDirectory(pathname, pattern=pattern, recursive=recursive, envir=envir, onError=onError, verbose=verbose, modifiedOnly=modifiedOnly, ...) ) } } # for (dir ...) } else { verbose && cat(verbose, "Sourcing directory (non-recursively): ", path) } # Then, get all files in current directory... files <- listDirectory(path, pattern=pattern, recursive=FALSE, allNames=TRUE, fullNames=TRUE) # Source files in lexicographic order if (length(files) > 0) # To avoid warning():s files <- sort(files) if (verbose) { if (length(files) > 0) { cat(verbose, "Found *.R scripts:") readable <- (sapply(files, FUN=file.access, mode=4) == 0) bytes <- sapply(files, FUN=function(x) file.info(x)$size) df <- data.frame(filename=basename(files), bytes=bytes, readable=readable, row.names=NULL, stringsAsFactors = FALSE) print(verbose, df) # Not needed anymore df <- bytes <- readable <- NULL } else { cat(verbose, "Found no *.R scripts.") } } for (file in files) { pathname <- filePath(file) if (!isDirectory(pathname)) { # If the parent directory is called 'global' then source to # the global environment, otherwise the local job environment. parent <- basename(dirname(pathname)) local <- (parent != "global") type <- ifelse(local, "local", "global") tryCatch({ verbose && enter(verbose, "Loading (", type, ") source file: ", basename(pathname)) # output <- capture.output({ sourceTo(pathname, ..., local=local, chdir=FALSE, envir=envir, modifiedOnly=modifiedOnly) # }) # print(ll(envir=envir)) sourcedFiles <- c(sourcedFiles, pathname) # if (length(output) > 0) # verbose && cat(verbose, output , collapse="\n") verbose && exit(verbose) }, error = function(ex) { if (verbose) { print(verbose, ex) tryCatch({ # Display source code with erroneous line highlighted. cat(verbose, displayCode(pathname, highlight=ex$message, pager="none")) }, error = function(ex) {}) } verbose && exit(verbose, suffix="...failed") # An error was detected, but always log it. verbose && cat(verbose, "Error when sourcing file ", pathname, ": ", ex$message) if (onError == "skip") { # Ignore the error, but log it. } else if (onError == "warning") { # Give a warning. warning(ex$message) } else { # Rethrow error. signalCondition(ex) msg <- sprintf("sourceDirectory() failed to source '%s': %s", pathname, ex$message) stop(msg) } }) # tryCatch() } } # for (file ...) # Return files that was sourced. invisible(sourcedFiles) }) # sourceDirectory() ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/renameFile.R������������������������������������������������������������������������������0000644�0001762�0000144�00000006526�14372747611�014232� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault renameFile # # @title "Renames a file (or a directory) atomically/safely" # # \description{ # @get "title", # by also asserting that it was successfully renamed without side effects. # If failing to rename and overwrite an existing file, the original file # is kept. # } # # @synopsis # # \arguments{ # \item{pathname}{The pathname of the file to be renamed.} # \item{newPathname}{The new pathname. # If an \emph{existing directory} and the source is a file, then the # destination becomes \code{file.path(newPathname, basename(pathname))}.} # \item{overwrite}{If @TRUE and there exists a file with new pathname, # then it is overwritten.} # \item{...}{Not used.} # \item{verbose}{See @see "R.utils::Verbose".} # } # # \value{ # Returns @TRUE if the file was successfully renamed. # If it failed, an exception is thrown. # } # # @author # # \seealso{ # \code{\link[base:files]{file.rename}()}. # } # # @keyword internal #*/########################################################################### setMethodS3("renameFile", "default", function(pathname, newPathname, overwrite=FALSE, ..., verbose=FALSE) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'pathname': pathname <- Arguments$getCharacter(pathname, nchar=c(1,512)) pathname <- Arguments$getWritablePathname(pathname, mustExist=TRUE) # Argument 'newPathname': newPathname <- Arguments$getCharacter(newPathname, nchar=c(1,512)) # Special case: Source is a file and destination is an existing directory? if (isFile(pathname) && isDirectory(newPathname)) { newPathname <- file.path(newPathname, basename(pathname)) } newPathname <- Arguments$getWritablePathname(newPathname, mustNotExist=!overwrite) if (newPathname == pathname) { throw("Cannot rename file. Source and target are identical: ", pathname) } # Argument 'verbose': verbose <- Arguments$getVerbose(verbose) if (verbose) { pushState(verbose) on.exit(popState(verbose)) } isDir <- isDirectory(pathname) pType <- if (isDir) "directory" else "file" pExists <- if (isDir) isDirectory else isFile verbose && enterf(verbose, "Renaming %s safely", pType) verbose && cat(verbose, "Pathname: ", pathname) verbose && cat(verbose, "New pathname: ", newPathname) if (overwrite && pExists(newPathname)) { newPathnameB <- pushBackupFile(newPathname, verbose=verbose) on.exit({ popBackupFile(newPathnameB, verbose=verbose) }) } verbose && enter(verbose, "Renaming file using file.rename()") res <- file.rename(pathname, newPathname) verbose && cat(verbose, "Result: ", res) if (!res) { throw(sprintf("Failed to rename %s: %s -> %s", pType, pathname, newPathname)) } verbose && exit(verbose) verbose && enter(verbose, "Validating") if (!pExists(newPathname)) { throw(sprintf("Failed to rename %s (target does not exist): %s -> %s", pType, pathname, newPathname)) } if (pExists(pathname)) { throw(sprintf("Failed to rename %s (source still exists): %s -> %s", pType, pathname, newPathname)) } verbose && exit(verbose) verbose && exit(verbose) TRUE }) # renameFile() ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/detachPackage.R���������������������������������������������������������������������������0000644�0001762�0000144�00000002572�14372747611�014664� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault detachPackage # # @title "Detaches packages by name" # # \description{ # @get "title", if loaded. # } # # @synopsis # # \arguments{ # \item{pkgname}{A @character @vector of package names to be detached.} # \item{...}{Not used.} # } # # \value{ # Returns (invisibly) a named @logical @vector indicating whether # each package was detached or not. # } # # @author # # \seealso{ # @see "base::detach". # } # # @keyword programming #*/########################################################################### setMethodS3("detachPackage", "default", function(pkgname, ...) { # Argument 'pkgname' pkgname <- as.character(pkgname) # Nothing to do? npkgs <- length(pkgname) if (npkgs == 0L) return(invisible(logical(0L))) # Detach multiple packages? if (npkgs > 1L) { return(invisible(sapply(pkgname, FUN=detachPackage, ...))) } # Detach a single package searchName <- paste("package:", pkgname, sep="") pos <- match(searchName, search()) if (is.na(pos)) { # Return FALSE if package is not loaded res <- FALSE names(res) <- pkgname return(invisible(res)) } # Detach package detach(pos=pos) # Return TRUE if package was detached, otherwise FALSE. pos <- match(searchName, search()) res <- is.na(pos) names(res) <- pkgname invisible(res) }) ��������������������������������������������������������������������������������������������������������������������������������������R.utils/R/TimeoutException.R������������������������������������������������������������������������0000644�0001762�0000144�00000003202�14372747611�015454� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocClass TimeoutException # # @title "TimeoutException represents timeout errors" # # \description{ # @classhierarchy # # @get "title" occurring when a set of R expressions executed did not # finish in time. # } # # @synopsis # # \arguments{ # \item{...}{Any arguments accepted by @see "Exception"}. # \item{cpu, elapsed}{The maximum time the R expressions were allowed # to be running before the timeout occurred as measured in CPU time # and (physically) elapsed time.} # } # # \section{Fields and Methods}{ # @allmethods # } # # @author # # \seealso{ # For detailed information about exceptions see @see "Exception". # } # # \keyword{programming} # \keyword{methods} # \keyword{error} #*/########################################################################### setConstructorS3("TimeoutException", function(..., cpu=NA, elapsed=NA) { extend(Exception(...), "TimeoutException", cpu = cpu, elapsed = elapsed ) }) ###########################################################################/** # @RdocMethod getMessage # # @title "Gets the message of the exception" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns a @character string. # } # # @author # # \seealso{ # @seeclass # } # # \keyword{programming} # \keyword{methods} # \keyword{error} #*/########################################################################### setMethodS3("getMessage", "TimeoutException", function(this, ...) { sprintf("%s [cpu=%ss, elapsed=%ss]", this$.msg, this$cpu, this$elapsed) }) ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/pushBackupFile.R��������������������������������������������������������������������������0000644�0001762�0000144�00000007457�14372747611�015074� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������########################################################################/** # @RdocDefault pushBackupFile # # @title "Appends a backup suffix to the pathname" # # @synopsis # # \description{ # @get "title" and, optionally, renames an existing file accordingly. # # In combination with @see "popBackupFile", this method is useful # for creating a backup of a file and restoring it. # } # # \arguments{ # \item{filename}{The filename of the file to backup.} # \item{path}{The path of the file.} # \item{suffix}{The suffix to be appended.} # \item{isFile}{If @TRUE, the file must exist and will be renamed # on the file system. If @FALSE, it is only the pathname string # that will be modified. For details, see below.} # \item{onMissing}{A @character string specifying what to do if the # file does not exist.} # \item{copy}{If @TRUE, an existing original file remains after # creating the backup copy, otherwise it is dropped.} # \item{overwrite}{If @TRUE, any existing backup files are overwritten, # otherwise an exception is thrown.} # \item{...}{Not used.} # \item{verbose}{A @logical or @see "Verbose".} # } # # \value{ # Returns the pathname with the suffix appended. # } # # @examples "../incl/pushBackupFile.Rex" # # @author # # \seealso{ # @see "popBackupFile". # } # # @keyword "utilities" # @keyword "programming" # @keyword "IO" #*/######################################################################### setMethodS3("pushBackupFile", "default", function(filename, path=NULL, suffix=".bak", isFile=TRUE, onMissing=c("ignore", "error"), copy=FALSE, overwrite=TRUE, ..., verbose=FALSE) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'isFile': isFile <- Arguments$getLogical(isFile) # Argument 'onMissing': onMissing <- match.arg(onMissing) # Argument 'overwrite': overwrite <- Arguments$getLogical(overwrite) # Argument 'filename' & 'path': pathname <- Arguments$getWritablePathname(filename, path=path, mustExist=(isFile && (onMissing == "error"))) # Argument 'suffix': suffix <- Arguments$getCharacter(suffix) # Argument 'copy': copy <- Arguments$getLogical(copy) # Argument 'verbose': verbose <- Arguments$getVerbose(verbose) if (verbose) { pushState(verbose) on.exit(popState(verbose)) } # If file does not exist, returns NULL? if ((onMissing == "ignore") && !isFile(pathname)) { return(invisible(NULL)) } verbose && enter(verbose, "Adding backup suffix from file") verbose && cat(verbose, "Pathname: ", pathname) verbose && cat(verbose, "Suffix: ", suffix) verbose && cat(verbose, "Rename existing file?: ", (isFile && !copy)) pathnameB <- sprintf("%s%s", pathname, suffix) verbose && cat(verbose, "Backup pathname: ", pathnameB) pathnameB <- Arguments$getWritablePathname(pathnameB, mustNotExist=!overwrite) if (overwrite && isFile(pathnameB)) { file.remove(pathnameB) } if (isFile) { if (copy) { verbose && enter(verbose, "Copy existing file") res <- copyFile(pathname, pathnameB) verbose && cat(verbose, "Result: ", res) verbose && exit(verbose) } else { verbose && enter(verbose, "Renaming existing file") res <- file.rename(pathname, pathnameB) verbose && cat(verbose, "Result: ", res) verbose && exit(verbose) } if (!isFile(pathnameB)) { throw("Failed to copy/rename file (final file does not exist): ", pathname, " -> ", pathnameB) } if (!copy) { if (isFile(pathname)) { throw("Failed to rename file (file still exists): ", pathname, " -> ", pathnameB) } } } # if (isFile) verbose && exit(verbose) pathnameB }) # pushBackupFile() �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/R/patchCode.R�������������������������������������������������������������������������������0000644�0001762�0000144�00000012676�14372747611�014060� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������########################################################################/** # @RdocDefault patchCode # # @title "Patches installed and loaded packages and more" # # @synopsis # # \description{ # @get "title". # } # # \arguments{ # \item{paths}{The path to the directory (and subdirectories) which # contains source code that will patch loaded packages. # If @NULL, the patch path is given by the option \code{R_PATCHES}, # If the latter is not set, the system environment with the same name # is used. If neither is given, then \code{~/R-patches/} is used.} # \item{recursive}{If @TRUE, source code in subdirectories will also # get loaded. } # \item{suppressWarnings}{If @TRUE, @warnings will be suppressed, # otherwise not.} # \item{knownExtensions}{A @character @vector of filename extensions # used to identify source code files. All other files are ignored.} # \item{verbose}{If @TRUE, extra information is printed while patching, # otherwise not.} # \item{...}{Not used.} # } # # \value{ # Returns (invisibly) the number of files sourced. # } # # \details{ # The method will look for source code files (recursively or not) that # match known filename extensions. Each found source code file is # then @see "base::source"d. # # If the search is recursive, subdirectories are entered if and only if # either (1) the name of the subdirectory is the same as a \emph{loaded} # (and installed) package, or (2) if there is no installed package # with that name. The latter allows common code to be organized in # directories although it is still not assigned to packages. # # Each of the directories given by argument \code{paths} will be # processed one by one. This makes it possible to have more than one # file tree containing patches. # # To set an options, see @see "base::options". To set a system # environment, see @see "base::Sys.setenv". # The character \code{;} is interpreted as a separator. Due to # incompatibility with Windows pathnames, \code{:} is \emph{not} a # valid separator. # } # # \examples{\dontrun{ # # Patch all source code files in the current directory # patchCode(".") # # # Patch all source code files in R_PATCHES # options("R_PATCHES"="~/R-patches/") # # alternatively, Sys.setenv("R_PATCHES"="~/R-patches/") # patchCode() # }} # # @author # # \seealso{ # @see "base::source". # @see "base::library". # } # # @keyword "utilities" # @keyword "programming" #*/######################################################################### setMethodS3("patchCode", "default", function(paths=NULL, recursive=TRUE, suppressWarnings=TRUE, knownExtensions=c("R","r","S","s"), verbose=FALSE, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (is.null(paths)) { paths <- getOption("R_PATCHES") if (is.null(paths)) { paths <- Sys.getenv("R_PATCHES") if (is.null(paths)) { paths <- "~/R-patches/" } } } paths <- as.character(paths) paths <- unlist(strsplit(paths, split="[;]")) if (is.null(paths) || length(paths) == 0 || identical(paths, "")) { paths <- "." } # Number of files sourced. count <- 0 # Loaded packages loadedPackages <- gsub("package:", "", search()[-1]) # Installed packages # installedPackages <- library()$results[,"Package"]; # Too slow! installedPackages <- NULL for (libpath in .libPaths()) installedPackages <- c(installedPackages, list.files(libpath)) # Regular expression to match source code files. pattern <- paste(knownExtensions, collapse="|") pattern <- paste("\\.(", pattern, ")$", collapse="", sep="") # if (verbose) { # message("Patch paths: ", paste(paths, collapse=", ")) # } # For each path in the list of paths, ... for (path in paths) { # Get all files and directories in the current path pathnames <- list.files(path=path, full.names=TRUE) excl <- grep("patchAll.R", pathnames) if (length(excl)) pathnames <- pathnames[-excl] # For each file or directory... for (pathname in pathnames) { isDirectory <- isDirectory(pathname) isSourceCodeFile <- (regexpr(pattern, pathname) != -1) if (!isDirectory && isSourceCodeFile) { # ...for each R source file... if (verbose) message("Patching ", pathname) if (suppressWarnings) { suppressWarnings(source(pathname)) } else { source(pathname) } count <- count + 1 } else if (isDirectory && recursive) { # ...for each directory... pkgname <- basename(pathname) isPkgLoaded <- (pkgname %in% loadedPackages) isPkgInstalled <- (pkgname %in% installedPackages) if (isPkgLoaded || !isPkgInstalled) { if (verbose) { if (isPkgInstalled) { message("Loaded and installed package found: ", pkgname) } else { message("Non-installed package found: ", pkgname) } } count <- count + patchCode(pathname, recursive=recursive, suppressWarnings=suppressWarnings, knownExtensions=knownExtensions, verbose=verbose) } else { if (verbose) message("Ignore non-loaded package: ", pkgname) } } } # for (pathname in pathnames) } # for (path in paths) # Return nothing. invisible(count) }) # patchCode() ������������������������������������������������������������������R.utils/R/readRdHelp.R������������������������������������������������������������������������������0000644�0001762�0000144�00000005623�14372747611�014172� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocDefault readRdHelp # # @title "Reads one or more Rd help files in a certain format" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Arguments passed to @see "utils::help".} # \item{format}{A @character string specifying the return type.} # \item{drop}{If @FALSE or more than one help entry is found, the result # is returned as a @list.} # } # # \value{ # Returns a @list of @character strings or a single @character string. # } # # @author # # @keyword programming #*/########################################################################### setMethodS3("readRdHelp", "default", function(..., format=c("text", "html", "latex", "rd"), drop=TRUE) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Local functions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - readRdHelpTextPreR210 <- function(...) { stdoutPager <- function(con, ...) { cat(readLines(con), sep="\n") } capture.output({ do.call(help, args=list(..., pager=stdoutPager)) }) } # readRdHelpTextPreR210() getHelpFile <- get(".getHelpFile", mode="function", envir=getNamespace("utils")) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'format': format <- match.arg(format) # Argument 'drop': drop <- Arguments$getLogical(drop) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # For R versions before v2.10.0 only # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - rVer <- as.character(getRversion()) if (compareVersion(rVer, "2.10.0") < 0) { if (format == "text") { res <- readRdHelpTextPreR210(...) if (!drop) { res <- list(res) } return(res) } else { throw("Unsupported format for R v", rVer, ": ", format) } } # Find the help x <- help(..., help_type="text") # Read the Rd file(s) paths <- as.character(x) rdList <- lapply(paths, FUN=getHelpFile) if (format == "rd") { res <- rdList } else { if (format == "text") { fcn <- tools::Rd2txt } else if (format == "html") { fcn <- tools::Rd2HTML } else if (format == "latex") { fcn <- tools::Rd2latex } else { throw("Unsupported format: ", format) } # Translate # To please R CMD check bfr <- NULL; rm(list="bfr") res <- lapply(rdList, FUN=function(rd) { con <- textConnection("bfr", open="w", local=TRUE) on.exit(close(con)) fcn(rd, out=con) bfr }) } # If only one item was found, should we return that and not a list? if (drop && length(res) == 1) { res <- res[[1]] } res }) # readRdHelp() �������������������������������������������������������������������������������������������������������������R.utils/R/Settings.R��������������������������������������������������������������������������������0000644�0001762�0000144�00000026364�14372747611�013765� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������###########################################################################/** # @RdocClass Settings # # @title "Class for applicational settings" # # \description{ # @classhierarchy # # @get "title". # } # # @synopsis # # \arguments{ # \item{basename}{A @character string of the basename of the settings file.} # \item{...}{Arguments passed to constructor of superclass \link{Options}.} # } # # \section{Fields and Methods}{ # @allmethods # } # # \section{Load settings with package and save on exit}{ # Here is a generic \code{.First.lib()} function for loading settings # with package. It also (almost) assures that the package is detached # when R finishes. See @see "onSessionExit" why it is not guaranteed! # # The almost generic \code{.Last.lib()} function, which will prompt # user to save settings, is called when a package is detached. # # It is custom to put these functions in a file named \code{zzz.R}. # # \bold{.First.lib():} # \preformatted{ # .First.lib <- function(libname, pkgname) { # # Write a welcome message when package is loaded # pkg <- Package(pkgname) # assign(pkgname, pkg, pos=getPosition(pkg)) # # # Read settings file ".<pkgname>Settings" and store it in package # # variable '<pkgname>Settings'. # varname <- paste(pkgname, "Settings") # basename <- paste(".", varname, sep="") # settings <- Settings$loadAnywhere(basename, verbose=TRUE) # if (is.null(settings)) # settings <- Settings(basename) # assign(varname, settings, pos=getPosition(pkg)) # # # Detach package when R finishes, which will save package settings too. # onSessionExit(function(...) detachPackage(pkgname)) # # packageStartupMessage(getName(pkg), " v", getVersion(pkg), # " (", getDate(pkg), ") successfully loaded. See ?", pkgname, # " for help.\n", sep="") # } # .First.lib() # } # # \bold{.Last.lib():} # \preformatted{ # .Last.lib <- function(libpath) { # pkgname <- "<package name>" # # # Prompt and save package settings when package is detached. # varname <- paste(pkgname, "Settings", sep="") # if (exists(varname)) { # settings <- get(varname) # if (inherits(settings, "Settings")) # promptAndSave(settings) # } # } # .Last.lib() # } # } # # @examples "../incl/Settings.Rex" # # @author # # @keyword programming # @keyword IO #*/########################################################################### setConstructorS3("Settings", function(basename=NULL, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'basename': if (!is.null(basename)) { basename <- as.character(basename) } extend(Options(...), "Settings", .basename = basename, .loadedPathname = NULL ) }) ###########################################################################/** # @RdocMethod getLoadedPathname # # @title "Gets the pathname of the settings file loaded" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns the absolute pathname (@character string) of the settings file # loaded. If no file was read, @NULL is returned. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("getLoadedPathname", "Settings", function(this, ...) { this$.loadedPathname }) ###########################################################################/** # @RdocMethod isModified # # @title "Checks if settings has been modified compared to whats on file" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{...}{Not used.} # } # # \value{ # Returns @TRUE if settings have been modified since lasted loaded, or if # they never have been loaded. Otherwise @FALSE is returned. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("isModified", "Settings", function(this, ...) { file <- getLoadedPathname(this) if (is.null(file)) return(FALSE) settingsOnFile <- Settings$load(file) !equals(this, settingsOnFile) }) ###########################################################################/** # @RdocMethod findSettings # # @title "Searches for the settings file in one or several directories" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{basename}{A @character string of the basename of the settings file.} # \item{paths}{A @vector of @character string specifying the directories to # be searched.} # \item{...}{Not used.} # } # # \value{ # Returns the absolute pathname (@character string) of the first settings # file found, otherwise @NULL. # } # # @author # # \seealso{ # @seeclass # } # # @keyword programming #*/########################################################################### setMethodS3("findSettings", "Settings", function(static, basename, paths=c(".", "~"), ...) { # Search for the settings file for (path in paths) { pathname <- filePath(path, basename) if (file.exists(pathname)) return(pathname) } return(NULL) }, static=TRUE) #########################################################################/** # @RdocMethod saveAnywhere # # @title "Saves settings to file" # # \description{ # @get "title". If the settings was read from file, they are by default # written back to the same file. If this was not the case, it defaults # to the settings file in the home directory of the current user. # } # # @synopsis # # \arguments{ # \item{file}{A @character string or a @connection where to write too. # If @NULL, the file from which the settings were read is used. If # this was not the case, argument \code{path} is used.} # \item{path}{The default path, if no settings files are specified. # This defaults to the current user's home directory.} # \item{...}{Arguments passed to # \code{\link[R.oo:save.Object]{save}()} in superclass Object.} # } # # \value{ # Returns (invisibly) the pathname to the save settings file. # } # # @author # # \seealso{ # @seemethod "loadAnywhere". # @seeclass # } # # @keyword programming #*/######################################################################### setMethodS3("saveAnywhere", "Settings", function(this, file=NULL, path="~", ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'path': path <- as.character(path) if (!isDirectory(path)) throw("Argument 'path' is not a directory: ", path) # Get file location if (is.null(file)) file <- this$.loadedPathname if (is.null(file)) file <- filePath(path, this$.basename) # Save Object save(this, file=file, ...) invisible(file) }) #########################################################################/** # @RdocMethod loadAnywhere # # @title "Loads settings from file" # # \description{ # @get "title". If the settings was read from file, they are by default # written back to the same file. If this was not the case, it defaults # to the settings file in the home directory of the current user. # } # # @synopsis # # \arguments{ # \item{file}{A @character string or a @connection from which settings # should be read. If @NULL, the settings file is searched for by # @seemethod "findSettings".} # \item{...}{Arguments passed to @seemethod "findSettings".} # \item{verbose}{If @TRUE, verbose information is written while reading, # otherwise not.} # } # # \value{Returns a \link{Settings} object if file was successfully read, # otherwise @NULL.} # # @author # # \seealso{ # @seemethod "saveAnywhere". # @seeclass # } # # @keyword programming #*/######################################################################### setMethodS3("loadAnywhere", "Settings", function(static, file=NULL, ..., verbose=FALSE) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'file': if (is.null(file)) { file <- static$.basename } if (inherits(file, "connection")) { } else { file <- as.character(file) if (!file.exists(file)) { file <- findSettings(static, basename=file, ...) if (is.null(file)) return(NULL) } } settings <- NULL tryCatch({ settings <- Settings$load(file=file) settings$.loadedPathname <- getAbsolutePath(file) if (verbose) { message("Loaded settings: ", file, " (", format(lastModified(file), "%Y-%m-%d %H:%M:%S"), ")") } }, error = function(ex) { if (verbose) message("Failed to load settings: ", file) }) settings }) #########################################################################/** # @RdocMethod promptAndSave # # @title "Prompt user to save modified settings" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{saveOption}{A @character string of the option used to set # if user is prompted or not.} # \item{...}{Arguments passed to @see "saveAnywhere".} # } # # \value{ # Returns @TRUE if settings were successfully written to file, # otherwise @FALSE is returned. An exception may also be thrown. # } # # \details{ # If settings has been modified since loaded, the user is by default # prompted to save the settings (if \R runs interactively). # To save or not save without asking or when \R runs non-interactively, # set option \code{"saveSettings"} to "yes" or "no", respectively. # For prompting the user, use "prompt". # } # # @author # # \seealso{ # @seemethod "isModified". # @see "base::interactive". # @seeclass # } # # @keyword programming #*/######################################################################### setMethodS3("promptAndSave", "Settings", function(this, saveOption="saveSettings", settingsName=NULL, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'saveOption': saveOption <- as.character(saveOption) if (length(saveOption) != 1) { throw("Argument 'saveOption' should be a single character string: ", paste(saveOption, collapse=", ")) } # Check if settings have been updated since last read. if (!isModified(this)) return(invisible(FALSE)) answer <- getOption(this, saveOption, "prompt") if (answer == "prompt" && interactive()) { # Prompt user... msg <- "Do you wish to save modified" if (!is.null(settingsName)) msg <- paste(msg, settingsName) msg <- paste(msg, "settings?") msg <- paste(msg, "[y/N]: ") answer <- readline(msg) answer <- tolower(answer) neverAskAgain <- (regexpr("!$", answer) != -1) if (neverAskAgain) { answer <- gsub("!$", "", answer) if (answer %in% c("y", "yes")) { answer <- "yes" } else { answer <- "no" } setOption(this, saveOption, answer) } } if (answer %in% c("y", "yes")) { saveAnywhere(this, ...) invisible(TRUE) } else { invisible(FALSE) } }) ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/NEWS.md�������������������������������������������������������������������������������������0000644�0001762�0000144�00000262322�14525546112�012724� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# Version 2.12.3 [2022-11-16] ## Documentation * Fix various Rd issues. ## Miscellaneous * The unit tests on absolute and relative paths would fail on MS Windows where the `HOME` folder was a subfolder directly under the drive, e.g. `HOME=C:\msys64`. ## Bug Fixes * Package would fail to install in R-devel when it introduces the new **base** package function `use()`. # Version 2.12.2 [2022-11-11] ## Documentation * Drop duplicated arguments from `help("parse.SmartComments")`. ## Deprecated and Defunct * S3 method `warnings()` for `Verbose`, and the corresponding generic function, has been deprecated in favor of the `printWarnings()`. # Version 2.12.1 [2022-10-30] ## Documentation * Documented the limitation that `withTimeout()` may fail to detect the timeout error if the language is temporarily switched during evaluation. * Updated moved and broken URLs in help pages. ## Bug Fixes * `filePath()` could produce `Error in if (components[pos] == ".." && components[pos - 1L] != "..") { : missing value where TRUE/FALSE needed` when there were too many `..` components in the specified path, e.g. `filePath("C:/foo/../bar/../..")`. Now it returns the maximum pruned path, e.g. `"C:/.."`. * `withTimeout()` did not return NULL on timeouts when `onTimeout` was `"warning"` or `"silent"`. * `parseRepos()` would produce `"Error in get(".read_repositories", envir = ns) : object '.read_repositories' not found"` in R-devel (>= rev 83148). # Version 2.12.0 [2022-06-27] ## New Features * Added support for lists and data frames to `tempvar()`. ## Deprecated and Defunct * Remove defunct `Asserts$inherits()` and S3 generic `inherits()`. Use `Asserts$inheritsFrom()` instead. * Remove defunct argument `substitute` from `withCapture()`. Use argument `replace` instead. # Version 2.11.0 [2021-09-25] ## New Features * Now `insert()` support duplicates in `ats`, which then results in the corresponding `values` being inserted in order at those duplicated indices. * Relaxed `insert()` to accept a `values` argument that is a list but not necessarily a formal vector. * Now `queryRCmdCheck()` sets environment variable `R_CMD_CHECK=true` if it detects `R CMD check` is running. * Added `format()` for `binmode`. * `hpaste()` gained argument `empty`, which can be used to control what to return in case the output is of length zero. ## Bug Fixes * `queryRCmdCheck()` failed to identify when `R CMD check` was running test scripts located in a subfolder under tests/, e.g. tests/testthat/. * `gcDLLs()` produced a "In sprintf(...) : argument not used by format" warning when giving an error message on what DLLs it failed to unload. * `Arguments$getVector()` could produce an error on "argument is missing, with no default" while trying to signal an assertion error. * `intToHex()` and `intToOct()` would no longer pad with zero on recent R-devel (to become R 4.2.0) versions. # Version 2.10.1 [2020-08-25] ## New Features * Updated legacy function `useRepos()` to use HTTPS instead of HTTP. ## Documentation * Update URLs with 301 redirects. Most of them were HTTP to HTTPS redirects. # Version 2.10.0 [2020-08-24] ## New Features * `R.utils::commandArgs()` recognizes new `--no-echo` option in R (>= 4.0.0). ## Bug Fixes * `R.utils::getAbsolutePath("~/../Documents", expandTilde = TRUE)` would adjust for `..` before adjusting for `~` resulting in an incorrect path. Thanks to Dean Attali for reporting on this. # Version 2.9.2 [2019-12-07] * CRAN POLICY CRAN: The help example for FileProgressBar and its package tests wrote to the user`s home directory. They are now writing to a temporary directory instead. # Version 2.9.1 [2019-12-05] ## Bug Fixes * `wrap()` for arrays used a list - not a numeric vector - to assign dimensions. This would produce an error in R (>= 4.0.0). * `withSeed(..., seed = NULL)` did not work for R (< 3.0.0). * `fileAccess(..., mode = 2)` would update `.Random.seed`. * `fileAccess(path, mode = 2)` could end up in an endless loop if the `path` folder contained all files of `a, b, ..., z, A, B, ... Z`. # Version 2.9.0 [2019-06-11] ## Bug Fixes * `sourceDirectory()` did not respect argument `modifiedOnly`. Thanks to Anton Krasikov for the report and the fix. * `createLink()` could produce a spurious warning on MS Windows. ## Deprecated and Defunct * Previously defunct `arrayIndex()`, `evalWithTimeout()`, and `resetWarnings()` have been removed. * `Assert$inherits()` is defunct - use `Assert$inheritsFrom()` instead. * Argument `substitute` of `withCapture()` is defunct - use `replace` instead. # Version 2.8.0 [2019-02-13] ## New Features * `createWindowsShortcut()` gained argument `mustWork`. * When `createLink()` fails, the error message now also report on the methods attempted. ## Bug Fixes * `displayCode()`, `commandArgs()` and `toCamelCase()` used `&&` and `||` on logical vectors that might not necessarily be of length one. * `createWindowsShortcut()` and `createLink(method="windows-shortcut")` failed to create Windows Shortcut links because `filePath(..., expandLinks = "any")` did not expand Windows Shortcut links. This bug was introduced in **R.utils** 1.34.0 (2014-10-07) due to a cut'n'paste mistake. # Version 2.7.0 [2018-08-26] ## New Features * Added `nullcon()` that returns a (binary) connection to the `nullfile()`. ## Performance * `readTable()` no longer runs the garbage collector - was done so implicitly through an internal `system.time()` call without using `gcFirst = FALSE`. ## Bug Fixes * `Rscript -e "R.utils::cmdArg(a=42L)" -a:=1:3` would set `a` to `NA_integer_`. ## Deprecated and Defunct * `evalWithTimeout()` is now defunct. Use `withTimeout()` instead. * `arrayIndex()` is now defunct. Use `base::arrayInd()` instead. * `Assert$inherits()` is deprecated - renamed to `Assert$inheritsFrom()`. * Removed deprecated and ignored argument `reset` of `warnings()` for Verbose. # Version 2.6.0 [2017-11-05] ## New Features * Argument `install` of `use()` now defaults to option `R.utils.use.install`, which in turn defaults to environment variable `R_R_UTILS_USE_INSTALL`. If neither is set, the default is TRUE. * ROBUSTNESS: Now `gcDLLs()` runs the garbage collector before removing stray DLLs in order for any finalizers who rely on the DLL to be called before the DLL is removed. * `loadObject()` and `loadToEnv()` give more informative error message if an error occurs while reading from a file / connection. * All `withNnn()` functions gained argument `substitute` making it possible to pass an expression object, e.g. `withTimeout(expr, subsitute = FALSE, ...)`. The exception is `withCapture()`, where, the now deprecated (see below), argument `substitute` means something else for legacy reasons. ## Bug Fixes * `withTimeout()` would produce a regular error but not a TimeoutException for timeouts reaching the _total_ CPU time limit while it would work for those reaching the _elapsed_ CPU time limit. Thanks to Alexej Gossmann at Tulane University for troubleshooting and provide a fix. * `findSourceTraceback()` could fail and give an obscure error when for instance the **XML** package was attached. It now tries a bit harder to locate the internal `srcfile` object. * Forgot to register S3 method `[()` for GenericSummary. * `intToOct()` would convert to hexadecimals. * `intToBin()` would output garbage for negative values. ## Deprecated and Defunct * Argument `substitute` of `withCapture()` has been renamed to `replace`. Code that calls `withCapture(..., substitute = ...)` will still work, but the use of `substitute` is deprecated and will later become defunct. The purpose of this change of argument name is so that the meaning of `substitute` can be harmonized with the other `withNnn()` functions. * Deprecated `evalWithTimeout()`; use `withTimeout()` - the preferred name. # Version 2.5.0 [2016-11-07] ## Bug Fixes * `withCapture(x <- 1L)` would drop integer suffix `L` from the output when run in non-interactive mode. ## Deprecated and Defunct * CLEANUP: Removed operator `%<-%` which was defunct since 2.4.0. An alternative is to use ditto of the **future** package. * CLEANUP: Made `resetWarnings()` defunct. # Version 2.4.0 [2016-09-13] ## New Features * Added `strayDLLs()` and `gcDLLs()` to identify and unload stray DLLs that was left behind by packages that have already been unloaded. * Added `nullfile()`. * Now `setThreshold()` for Verbose accepts also logical values. * Argument `absolutePath` for `Arguments$getReadablePathname()` was renamed to `absolute`. For backward compatibililty, the old name will still work for some time. ## Deprecated and Defunct * CLEANUP: Defunct `%<-%` in favor of `%<-%` in the **future** package. * CLEANUP: Deprecated `arrayIndex()`. `arrayInd()` in **base** (>= 2.11.0) provides the same functionality. CODE REFACTORING: * Package now formally requires R (>= 2.14.0) released October 2011. # Version 2.3.0 [2016-04-13] ## New Features * Added `hsize()`. * Added `tmpfile()` for creating temporary files with content that is deleted automatically by the garbage collector unless there is a reference to it. * ROBUSTNESS: Now `compressFile()` and `decompressFile()`, and therefore also functions such as `gzip()` and `gunzip()`, output atomically by writing to a temporary file which is only renamed when completed. ## Deprecated and Defunct * CLEANUP: Deprecated `%<-%` in favor of `%<-%` in the **future** package. ## Code Refactoring * Package now formally requires R (>= 2.14.0) released Oct 2011. # Version 2.2.0 [2015-12-09] ## New Features * `loadObject()` and `saveObject()` gained argument `format` in order to support also RDS files (in addition to XDR files). File formats XDR and RDS are supported. The default format is inferred from the filename extension. If this is not possible, then the XDR format is assumed (default; backward compatible). * `mkdirs()` gained arguments `mustWork` and `maxTries`. * `seqToHumanReadable()` gained argument `tau`. * `R.utils::commandArgs()` now also ackowledges `argv` set by the `littler` executable. * `R.utils::commandArgs()` recognizes more reserved command-line arguments, e.g. `--debugger-args=N`, `--min-vsize=N`, and `--min-nsize=N`. * ROBUSTNESS: Now `writeDataFrame(..., sep, quote = FALSE)` asserts that none of the columns contains the field separator `sep`, because then the written file would be corrupt/invalid. * ROBUSTNESS: Explicit import of all **graphics**, **grDevices**, **stats** and **utils** functions. ## Documentation * Clarified in help for `compressFile()` et al. that these functions remove the input file by default after the output file is generated. Thanks to Ben Bond-Lamberty (Pacific Northwest National Laboratory) for pointing out this potential pitfall. ## Bug Fixes * `seqToHumanReadable(c(1:2, 4:5))` gave `"1-2, 4, 5"`. * `withTimeout()` did not work in non-English locales. Thanks to Arnaud Malapert at University Nice Sophia Antipolis for reporting on this. * GString ignored "simple" attributes, e.g. `$[tolower]{y}`. Thanks to Andre Mikulec for reporting on this. * `downloadFile()` via `https://<user>:<pwd>@<domain>/` gave an error. ## Deprecated and Defunct * CLEANUP: Deprecated `resetWarnings()`. # Version 2.1.0 [2015-05-27] ## New Features * Added `compressPDF()` to compress PDFs. * If, and only if, `path` is an existing directory, then `copyFile(pathname, path)` copies file `pathname` to the `path` directory (previously destination always had to be a file). Analogously, `renameFile(pathname, path)` moves file `pathname` (not a directory though) to destination directory `path`. * CLEANUP: `createLink(..., skip = TRUE)` would give a false warning if a proper link already existed and the target was elsewhere than the current directory. * INCONSISTENCY: `captureOutput(..., collapse = "\n")` did not drop newline of the last line as `captureOutput(..., collapse = "\r")` and any other `collapse != "\n"` strings. Added package tests. ## Bug Fixes * `captureOutput(..., file = "foo.txt")` gave an error. # Version 2.0.2 [2015-04-27] ## Bug Fixes * `Arguments$getReadablePathname(NA, mustExist = FALSE)` no longer gives an error with recent R devel (>= 2015-04-23) related to an update on how `nchar()` handles missing values. This bug affected only Windows. ## Code Refactoring * ROBUSTNESS: Now `nchar(..., type = "chars")` is used internally for all file and directory names. # Version 2.0.1 [2015-04-24] ## New Features * **R.utils** no longer generates a warning if the R session is saved when R exits. Thanks to Jose Alquicira Hernandez for reporting on this. ## Bug Fixes * `toCamelCase()` with missing values would give an error in R devel (>= 2015-04-23) due to an update how `nchar()` handles missing values. # Version 2.0.0 [2015-02-28] ## New Features * ROBUSTNESS: Now `%<-%` evaluates the expression in a `local()` environment, and it assign to environments, e.g. `env$a %<-% 1`. * Added `compressFile()`, `decompressFile()` and `isCompressedFile()` methods, which `gzip()`/`gunzip()` and the new `bzip2()`/`bunzip2()` now use. Thanks to Peter Hickey for pushing for this. * Now `eget()` uses `inherits = FALSE` (was TRUE) and `mode = "default"` (was `"any"`), where `"default"` corresponds to the mode of argument `default`, unless it's NULL when `mode = "any"` is used. * Now `commandArgs(asValues = TRUE, adhoc = TRUE)` interprets `x:=1:10` such that `x` become the integer vector `1:10`. Likewise, you can do `x:=seq(1,3, by = 0.1)` and `x:=pi`. To get the string `"pi"`, use quotation marks, i.e. `x:="pi"`, or just `x=pi`. * Added `cmsg()`, `cout()`, `ccat()`, `cprintf()`, `cprint()`, `cstr()`, `cshow()` for outputting to "console", which is neither R stdout nor stderr and can therefor not be intercepted via `capture.output()`, `sink()` or similar. These functions are useful for outputting messages that requires user's attention and are often followed by a prompt via `readline()`, which also cannot be captured. * Added `mpager()` which is a "pager" function compatible with `file.show()` that will display file contents on standard error. * Just like for `listDirectory()`, argument `recursive` of `findFiles()` can in addition to be FALSE (`depth = 0`) and TRUE (`depth = +Inf`), be any non-negative numeric number specifying how deeply the recursive search should be done. * On Windows, `Arguments$getReadablePathname()` now gives an informative warning if a pathname of length 256 or longer is used/generated, which are not supported on Windows. ## Documentation * Fixed mistake in `help("captureOutput")`. Thanks to Mikko Korpela (Issue #4) for reporting on this. ## Bug Fixes * `use(..., quietly = FALSE)` no longer captures/buffers the output, which prevented it from displaying full prompt messages that required a user response. `use(..., quietly = TRUE)`, which is the default, no longer tries to ask user of Windows and OS X if they wish to install from source if the binary is older. * Now the returned value of all `withNnn()` functions preserves the "visibility" of the `eval()`:uated expression. Added package tests. * `withCapture({})` no longer generates a warning. * Now `isUrl(NA)` returns FALSE (instead of NA). * `seqToIntervals(integer(0))` gave error "object res not found". * `attachLocally()` on an environment would remove the attached fields/variables from that environment. ## Code Refactoring * ROBUSTNESS: Forgot to declare "default" `warnings()` as an S3 method. * `R.utils::use()` without arguments attaches **R.utils**. * ROBUSTNESS: Package test coverage is 66%. # Version 1.34.0 [2014-10-07] ## Code Refactoring * Added URL and BugReports fields to DESCRIPTION. * Submitted to CRAN. # Version 1.33.10 [2014-10-03] ## New Features * Added `shell.exec2()`, which does a better job than `shell.exec()` in opening pathnames with forward slashes and files on mapped drives, which may or may not open depending software, e.g. Google Chrome fails to open the latter. Add `options(browser = function(...)` `R.utils::shell.exec2(...))` to your ~/.Rprofile file to make `browseURL()` use this function instead of `shell.exec()`. This function is only useful on Windows. ## Bug Fixes * Now Arguments$getReadablePathname(file, path) ignores `path` if `file` specifies an absolute pathname. # Version 1.33.9 [2014-10-03] ## New Features * Now `countLines()` automatically supports gzipped files as well. Thanks to Sarah Nelson at Dept of Biostatistics at University of Washington for the suggestion. * Now `downloadFile("https://...")` will use `curl`, and if not available `wget`, to download the file over the HTTPS protocol. Previously only `wget` was used. The `curl` software is available on more operating systems, include OS X, whereas `wget` sometimes needs a separate installation. # Version 1.33.8 [2014-10-02] ## New Features * Added argument `unmap` to `filePath()` for "following" paths that are on mapped Windows drives. * CLEANUP: `use()` would try temporarily set package repository options even when not needed. This could trigger unnecessary warnings for users who haven't set a default CRAN mirror and using `use()` to load/attach an already installed package. # Version 1.33.7 [2014-09-18] ## New Features * New default for `writeDataFrame()` - argument `col.names = !append`. Also, if `append = TRUE`, header comments are only written if specified. Added package system test for `writeDataFrame()`. # Version 1.33.6 [2014-09-16] ## Bug Fixes * `getAbsolutePath("/tmp", expandTilde = TRUE)` returned `"//tmp"`. This would in turn have implications on `getRelativePath()`, e.g. `getRelativePath("/tmp/a", relativeTo = "/tmp")` returned `"../../tmp/a"`. # Version 1.33.5 [2014-09-15] ## New Features * Added `withSeed()` and `withSink()`. * ROBUSTNESS: Now `withOptions()` also resets all the options available upon entry even if no explicit options were specified. This covers the case when `expr` changes the options and/or adds new options, e.g. `withOptions({ options(width = 10, foo = "new"); str(letter) })`. # Version 1.33.4 [2014-09-05] ## Bug Fixes * ROBUSTNESS: `Arguments$getWritablePathname()` could sometimes generate warning "file.remove(pathnameT) : cannot remove file 'file...', reason 'Permission denied'." Now it tries to remove that files several times before giving up. # Version 1.33.3 [2014-09-04] ## New Features * ROBUSTNESS: Now `copyDirectory()`, just as `copyFile()` already did, silently drops arguments `copy.mode` and `copy.date` for older R versions where `base::file.copy()` does not support them. # Version 1.33.2 [2014-09-01] ## Bug Fixes * `mkdirs()` could return "object 'res' not found" error. # Version 1.33.1 [2014-08-25] ## Bug Fixes * `countLines()` would not count the last line if it did not contain a newline. It would also give an error if the newline characters were only CR. This despite it was documented that both cases were supported. Added package system tests for them. # Version 1.33.0 [2014-08-24] ## New Features * Added `mprint()`, `mcat()`, `mstr()`, `mshow()` and `mprintf()` that work like the corresponding `print()`, `cat()`, etc., but output using `message()`, which in turn sends to standard error (instead of standard output). See also `mout()`. * Added `withLocale()`. * Now the test for target discrepancies by `createLink(..., skip = TRUE)` is more forgiving on Windows (by assuming a case-insensitive file system) before generating a warning. * Now `useRepos(..., fallback = TRUE)`, and hence `use()`, will fallback to known/predefined CRAN repositories in case `@CRAN@` is not set. If done, it will give an informative warning message. ## Bug Fixes * `commandArgs()` would drop command-line arguments with periods, hyphens, or underscores in their names, e.g. `--src_file=x`. # Version 1.32.6 [2014-08-12] ## Bug Fixes * `withCapture({ if (T) 1 else 2 })` would give a parse error on "unexpected 'else'", because the internal deparsing puts the 'else' statement on a new line whenever an if-else statement is enclosed in an { ... } expression. This problem is also described in R help thread "deparse() and the 'else' statement" by Yihui Xie on 2009-11-09 [http://tolstoy.newcastle.edu.au/R/e8/help/09/11/4204.html]. The workaround is to detect standalone 'else' statements and merge them with the previous line. Added package system test for this case. # Version 1.32.5 [2014-05-15] ## Bug Fixes * `egsub()` would return an invalid expression if the input had definitions of functions without arguments, e.g. `egsub("x", "x", substitute(y <- function() 0))`, which would throw "Error: badly formed function expression" if deparsed/printed. Added package test for this. # Version 1.32.4 [2014-05-14] ## New Features * Now `egsub()` also works with functions, in case it substitutes on the body of the function. ## Documentation * Added clarification to `help("withTimeout")` on the limitations of the function and when it is/is not possible to interrupt a function via timeouts. ## Software Quality * Made the package test on absolute and relative paths less conservative, because it gave an error on Windows systems that have set `R_USER` to a Cygwin-flavored directory, which causes `normalizePath("~")` to return a non-existing directory. Thanks Uwe Ligges (CRAN) for reporting on this. # Version 1.32.3 [2014-05-08] ## Bug Fixes * `filePath("./././././")` now returns `"."` (was `""`). Added package system tests for `filePath()`. # Version 1.32.2 [2014-05-07] ## New Features * Added support for substitution of expressions in `withCapture()` based on regular expressions utilizing new `egsub()`. * Added `egsub()`, which is `gsub()` for expressions with some bells and whistles. # Version 1.32.1 [2014-05-04] ## New Features * Now `downloadFile()` "adjusts" the output filename by decoding URL encoded characters, e.g. `Hello%20world.txt` becomes `Hello world.txt`. Also, unsafe filename characters (`:`, `*`, `\`) are encoded, e.g. `How_to:_RSP.txt` becomes `How_to%3A_RSP.txt`. * Added argument `adjust` to `Arguments$getReadablePathname()`. When `adjust = "url"` it decodes and encodes the filename the same way as `downloadFile()` now adjusts it (see above). # Version 1.32.0 [2014-05-01] ## New Features * Added `captureOutput()` which is much faster than `capture.output()` for large outputs. `withCapture()` utilizes this now. Added package system tests for both functions. * `use()` now installs missing packages from all set repositories (as before) and uses the mainstream (CRAN and Bioconductor) ones as fall backs. * Added `withRepos()` for installing/updating packages using a set of temporarily set repositories. It is possible to specify repositories by names, which are then selected from a set of known repositories, e.g. `withRepos(install.packages("edgeR"), repos = "[[BioC]]")`. * Added `withOptions()` for evaluating an expression with a set of options temporarily set. * Renamed `evalCapture()` to `withCapture()` and `evalWithTimeout()` and `withTimeout()`. The old name is kept for backward compatibility, but will eventually be deprecated. # Version 1.31.1 [2014-04-29] ## New Features * Now `use("<repos>::<pkg>")` will detect when a repository is unknown and give an informative error message on how to update option `repos`. # Version 1.31.0 [2014-04-26] ## New Features * Added assignment operator `%<-%` for delayed assignments. * Added option `evalCapture/newline`. # Version 1.30.7 [2014-04-26] ## New Features * Added argument `xtrim` to `draw()` for density object. * CLEANUP: `createLink(..., skip = TRUE)` no longer warns if the link file was skipped. Now it only warns if the skipped link file links to a different file than the intended target file. ## Code Refactoring * CLEANUP: Dropping `::` in calls where possible. # Version 1.30.6 [2014-04-24] ## New Features * Added argument `newline` to `evalCapture()`. # Version 1.30.5 [2014-04-22] ## New Features * Added argument `substitute` to `evalCapture()` for substituting symbols "on the fly" in the expression before it is evaluated. # Version 1.30.4 [2014-04-18] ## New Features * Added argument `modifiedOnly` to `sourceDirectory()`, which was previously passed via `...` to `sourceTo()`, and it now defaults to TRUE. # Version 1.30.3 [2014-04-15] ## Bug Fixes * `use()` would not install package dependencies. # Version 1.30.2 [2014-04-08] ## New Features * Added argument `max.deparse.length` to `evalCapture()`. # Version 1.30.1 [2014-04-06] ## New Features * Now `evalCapture()` utilizes `deparse()` to get the source code and acknowledges options `deparse.cutoff` to control the code wrapping. Previously `capture.output(print())` was used. ## Bug Fixes * WORKAROUND: `moveInSearchPath()` redirects any messages to stderr that `base::attach()` sent to stdout. UPDATE: This `attach()` issue has been fixed in R 3.1.0 patched. # Version 1.30.0 [2014-04-06] ## New Features * Vectorized `detachPackage()`, `getAbsolutePath()`, `getRelativePath()`, `isAbsolutePath()`, `isDirectory()`, `isFile()`, `isOpen()`, `isPackageInstalled()`, `touchFile()` and `toUrl()`. Added package system tests for several of them. For backward compatibility, `getAbsolutePath()`, `getRelativePath()`, `isAbsolutePath()`, `isFile()`, and `isDirectory()` treats an empty vector of path/pathnames equal to `"."`. However, in a future version, empty results will returned by these too. ## Bug Fixes * `toCamelCase(character(0L))` gave an error. # Version 1.29.11 [2014-04-02] ## Bug Fixes * `str()` and `summary()` for Verbose did not acknowledge argument `level`. # Version 1.29.10 [2014-02-28] ## Documentation * Added a help section on privileges required on Windows in order for `createLink()` to work. # Version 1.29.9 [2014-02-24] ## New Features * ROBUSTNESS: Added a package redundancy test for a bug occurring in **R.oo** (< 1.18.0) causing R to core dump (with `"Error: SET_VECTOR_ELT() can only be applied to a `list`, not a `integer`"`) or gives an error (with "Error: not a weak reference") under certain conditions when a registered finalizer tried to reload **R.oo** if it was unloaded. This occurred only on R prior to R 3.0.2 patched (2014-02-21 r65057). Also, the **methods** package needs to be attached, so it is still not clear what is the true cause of the bug. In **R.oo** (>= 1.18.0) this bug is avoided. # Version 1.29.8 [2014-01-27] ## Bug Fixes * Although `eget(K = 2, cmdArgs = TRUE)` would use command-line argument `K = 1` as the default (instead of `K = 2`), calling `eget("K", 2, cmdArgs = TRUE)` would not. * `commandArgs(excludeReserved = TRUE)` failed to drop reserved arguments of type `--<key>=<value>`, e.g. `--encoding=ASCII`. # Version 1.29.7 [2014-01-27] ## New Features * Added trial version of the CmdArgsFunction class. # Version 1.29.6 [2014-01-27] ## New Features * Added `cmdArgsCall()` for easy calling of functions from the command line, e.g. `Rscript -e R.utils::cmdArgsCall(rnorm) n=4`. # Version 1.29.5 [2014-01-27] ## New Features * `doCall()` gained argument `envir`, which also means that the new behavior is to evaluate the call within the calling frame. Also, `doCall()` now accepts call a function object in addition to a name of a function. # Version 1.29.4 [2014-01-26] ## New Features * Added argument `unique` to `cmdArgs()`. * Now `commandArgs(asValues = TRUE)` returns no-named arguments as a list element with the argument as the value and with a `""` name. For instance, in the past one would get `list(R = NA, a = "1", noname = NA)`, whereas now one gets `list("R", a = "1", "noname")`. ## Bug Fixes * Now `attachLocally()` no longer tries to attach elements with an empty name, e.g. `list(a = 1, 2)`. Previously it gave an error. Added a package system test for `attachLocally()`. # Version 1.29.3 [2014-01-19] ## New Features * CONSISTENCY: Now `createLink(..., method = "windows-shortcut")` returns the path/pathname to the link (and not the target) just like it does for the other types of file links. By link we here mean the path/pathname without the \*.lnk extension. ## Software Quality * ROBUSTNESS: Added package system tests for `createLink()`. # Version 1.29.2 [2014-01-12] ## New Features * Now `Arguments$getCharacters()` preserves attributes. Also, made argument `useNames` defaults to TRUE. * Added `[()` for GenericSummary. # Version 1.29.1 [2014-01-10] ## New Features * Added argument `what` to `Sys.readlink2()`, where `what = "corrected"` makes sure to return the proper target path (not just the one relative to where the link lives). # Version 1.29.0 [2014-01-07] * The following file I/O methods follows symbolic links (also on Windows) and returns information based on the target file/directory (rather than the link itself): `fileAccess()`, `file.info2()`, `isDirectory()`, `isFile()`, and `lastModified()`. * Added `file.info2()` for retrieving file information such that symbolic file links are also acknowledged on Windows. * Added `Sys.readlink2()` for reading symbolic file links also on Windows. * `removeDirectory()` can now be used to remove symbolic directory links (also on Windows where neither `file.remove()` nor `unlink()` work). The target directory will never be removed. * BUG FIX: `renameFile()` would give an error on directories. * Added package system tests for `copyFile()` and `renameFile()`. * ROBUSTNESS: `createLink()` will no longer try to create Windows file links on non-Windows platforms. * ROBUSTNESS: Updated a `shell()` calls that assume the Windows command interpreter to explicitly specify `shell = Sys.getenv("COMSPEC")`. # Version 1.28.6 [2014-01-06] * Added argument `skip` (in addition to existing `overwrite`) to `copyFile()` to allow for better control on how to handle existing destination files. For backward compatibilities, it defaults to FALSE, but may be changed to `skip = !overwrite` in a future version. Furthermore, `copyFile()` now passes (known) arguments `...` to `base::file.copy()` making it possible to copy with or without file permissions etc. Thanks Taku Tokuyasu (UCSF) for reporting on this. # Version 1.28.5 [2013-12-15] * Now argument `asGString` for `Arguments$getCharacters()` defaults to `getOption("Arguments$getCharacters/args/asGString", TRUE)`. This makes it possible to disable this feature, even when it is not possible to directly pass that argument. This will also make it possible to set the default to FALSE in the future (instead of TRUE as today). * Added argument `inherits` to `evaluate()` for GString. Default is TRUE for backward compatibility. # Version 1.28.4 [2013-11-20] * Minor updates to NAMESPACE file. # Version 1.28.3 [2013-11-15] * Added method `c()` for GenericSummary. # Version 1.28.2 [2013-11-15] * CLEANUP: `Arguments$getNumerics(NA, range = c(0,1))` no longer gives warnings on "no non-missing arguments to min()" etc. # Version 1.28.1 [2013-10-30] * BUG FIX: `System$getMappedDrivesOnWindows()` failed to return the proper path for `net use` mounted drives, iff the path contained spaces. # Version 1.28.0 [2013-10-20] * CLEANUP: Removed a few non-used internal objects. * Forgot to declare `enterf()` for Verbose as an S3 method. # Version 1.27.6 [2013-10-13] * CLEANUP: Some methods had to attach **R.utils** in the past in order to work properly. These are no longer attaching **R.utils**: `copyDirectory()`, `createLink()`, `createWindowsShortcut()`, `downloadFile()`, `installPackages()`, `removeDirectory()`, and `sourceDirectory()`. * Bumped up package dependencies. # Version 1.27.5 [2013-10-07] * CLEANUP: Now explicitly importing only what is needed in NAMESPACE. * CLEANUP: Dropped obsolete `autoload()`:s. * ROBUSTNESS: The overriding of `getOption()` to become a generic function does now call `base::getOption()` in the default, instead of copy the latter. * Bumped up package dependencies. # Version 1.27.4 [2013-09-28] * Now argument `recursive` of `listDirectory()` can also specify the maximum recursive depth, e.g `listDirectory(..., recursive = 5L)`. * Now the `R.utils` Package object is also available when the package is only loaded (but not attached). # Version 1.27.3 [2013-09-20] * ROBUSTNESS: Forgot to import `R.methodsS3::appendVarArgs()`. # Version 1.27.2 [2013-09-15] * TYPO: An error message of `dimNA<-()` was referring to `files` rather than to `elements`. # Version 1.27.1 [2013-09-10] * BUG FIX: `commandArgs(asValues = TRUE)` failed to set the value of the very last argument to TRUE if it was a flag, e.g. `R --args --bar`. Thanks to Stijn van Dongen at EMBL-EBI in Cambridge/Hinxton, UK for reporting on this. # Version 1.27.0 [2013-08-30] * Added `use()` for easy attaching/loading and automatic installation of packages. * Now `isPackageInstalled()` suppresses warnings. # Version 1.26.4 [2013-08-27] * CLEANUP: `Arguments$getReadablePathnames(files, paths = NULL)` no longer warns about "rep(paths, length.out = nbrOfFiles) : 'x' is NULL so the result will be NULL" if `length(files) > 0`. * CLEANUP: Package no longer utilizes `:::`. * DOCUMENTATION: Help for `installPackages()` was missing. Thanks Gabor Grothendieck for reporting on this. # Version 1.26.3 [2013-08-20] * Forgot to declare default `inherits()` as an S3 method. # Version 1.26.2 [2013-07-30] * ROBUSTNESS/BUG FIX: `System$findGhostscript()` could still give errors. Completely rewrote how Ghostscripts is searched. On Windows, environment variable `GSC` is now also searched. Thanks to Brian Ripley for the feedback. # Version 1.26.1 [2013-07-29] * BUG FIX: `System$findGhostscript()` would give `Error in pathname [sapply(pathname, FUN = isFile)]: invalid subscript type 'list'` if no device was found. # Version 1.26.0 [2013-07-27] * Added `tempvar()` for creating non-existing temporary variables. * Added `enterf()` to Verbose, which is an sprintf-like `enter()`. * Now `System$findGhostscript()` returns system variable `R_GSCMD` if set and it refers to an existing executable (and unless `force = TRUE`). It then checks with `Sys.which()`. On Windows, it finally searches for `gswin64c.exe` and `gswin32c.exe` on known locations. Added arguments `firstOnly` and `force`. * Now `getAbsolutePath()` shortens paths if possible, e.g. `"C:/foo/.."` becomes `"C:/"`. * Added argument `skip` to `gzip()` and `gunzip()`. * BUG FIX: `gunzip()` would ignore argument `overwrite`. * BUG FIX: `filePath("C:/foo/..")` returned `"C:"`, which should be `"C:/"`. # Version 1.25.3 [2013-07-27] * BUG FIX: `findSourceTraceback()` would give an error "Unknown class of 'srcfile': character" for `source(..., keep.source = FALSE)` in recent R devel and R v3.0.1 patched. Thanks Duncan Murdoch for the report. # Version 1.25.2 [2013-07-03] * Now `installPackages()` may also install from https URLs. * Now more methods can be used without attaching ("loading") the package: `copyFile()`, `copyDirectory()`, `removeDirectory()`, `createLink()`, `createWindowsShortcut()`, `downloadFile()`, `sourceDirectory()`, and `installPackages()`, e.g. `R.utils::downloadFile()`. * Now `touchFile()` utilizes `base::Sys.setFileTime()`, iff available. # Version 1.25.1 [2013-07-01] * Bumped up package dependencies. # Version 1.25.0 [2013-06-27] * UPDATE: Now `gzip()`/`gunzip()` returns the output file (was number of output bytes processed which are now returned as an attribute). * Added argument `temporary` to `gzip()`/`gunzip()`. * Added `isGzipped()` for testing whether a file is gzipped or not. # Version 1.24.4 [2013-06-17] * Now argument `dims` of `extract()` can also be dimension names. # Version 1.24.3 [2013-05-25] * Minor speedups by replacing `rm()` calls with NULL assignments. * SPEEDUP: `readTable()` no longer calls `gc()`. # Version 1.24.2 [2013-05-20] * CRAN POLICY: Now all Rd `\usage{}` lines are at most 90 characters long. * CRAN POLICY: Now all Rd example lines are at most 100 characters long. # Version 1.24.1 [2013-05-13] * The workaround needed by `isDirectory()` due to a bug in `file.info()` is now applied only for R (< 3.0.2), since the bug was been fixed in R 3.0.1 patched (PR#15302). # Version 1.24.0 [2013-04-18] * Several methods now output messages and verbose output to standard error (instead of standard output), including `addFinalizerToLast()`, `filePath()`, `patchCode()`, `readWindowsShellLink()`, `readWindowsShortcut()`, and `loadAnywhere()` for Settings. # Version 1.23.4 [2013-04-15] * BUG FIX: `capitalize()`/`decapitalize()` would return `"NANA"` for missing values. Reported by Liviu Andronic. # Version 1.23.3 [2013-03-29] * BUG FIX: `downloadFile("https://...")` did not work if `username` or `password` was NULL. # Version 1.23.2 [2013-03-22] * BUG FIX: Previous update caused `commandArgs(..., adhoc = TRUE)` to coerce `T` and `F` to logicals TRUE and FALSE. They are now preserved as character string. # Version 1.23.1 [2013-03-21] * Now `commandArgs(..., adhoc = TRUE)` utilizes `utils::type.convert()`. # Version 1.23.0 [2013-03-20] * Added `ecget()` which is like `eget()` with the default value corresponding to the command-line argument. * Added `eget()` for retrieving a single variable, with a fallback to a default value, e.g. `n <- eget(n = 42)`. * Added support for `cmdArg(n = 42)` as an alias to `cmdArg("n", 42)`. # Version 1.22.0 [2013-03-14] * Added `cmdArg()` for retrieving a single command line argument with a default value and type, e.g. `n <- cmdArg("n", 42)`. # Version 1.21.2 [2013-03-11] * Bumped up package dependencies. # Version 1.21.1 [2013-03-08] * Added an Authors@R field to the DESCRIPTION. # Version 1.21.0 [2013-03-07] * Major improvement of `commandArgs()`. For instance, now it never consider arguments after `--args` to be reserved or environment variable arguments; they are always user arguments. It is also doing a better job on interpreting `-*<key>=<value>` arguments; previously it could happen that it would split the `<value>`. Added systems test for `commandArgs()` and `cmdArgs()`. # Version 1.20.2 [2013-03-07] * Now argument `eps` for `isZero()` may also be a character string specifying either `"double.eps"` or `"single.eps"`. # Version 1.20.1 [2013-03-04] * DOCUMENTATION: Updated the help usage section for all static methods. # Version 1.20.0 [2013-02-24] * Added `cmdArgs()` which is short for `R.utils::commandArgs(asValues = TRUE, adhoc = TRUE, unique = TRUE, excludeReserved = TRUE, ...)[-1L]`. * Now it is possible to specify default arguments in `commandArgs()`. In addition, if `asValues = TRUE`, then the values of the parsed command-line arguments will be coerced to the data type of the default ones if they share names. If `adhoc = TRUE`, arguments will be coerced to numerics unless the result is NA. * For conveniency, `getAbsolutePath()` and `getRelativePath()` returns the same pathname if it is a URL. * Added `gstring()` and `gcat()`. * Now it is possible to escape the sed-like search replace format for GString:s via quoting, e.g. `${R.rsp/HttpDaemon/RspVersion}`. * BUG FIX: `getParent()` and `filePath()` as well as `System$mapDriveOnWindows()` and `System$unmapDriveOnWindows()` did not handle paths with a lower case Windows drive letter. Oddly, it is only now that we have received an single report (on a Windows 7 system) that such `getwd()` may return such drive letters, e.g. `c:/path/` instead of `C:/path/`. * BUG FIX: `evaluate(..., where = "parent")` for GString would result in an endless loop. * BUG FIX: `displayCode(code)` incorrectly processed `code` as GString:s. # Version 1.19.5 [2013-01-11] * BUG FIX: Specifying argument `version` to `isPackageLoaded()` would give "Error: 'manglePackageName` is defunct." in recent versions of R. Thanks to Brian Ripley (R core) for reporting on this. # Version 1.19.4 [2013-01-07] * Now `.Last.lib` is exported. * Bumped up package dependencies. # Version 1.19.3 [2012-12-19] * Utilizing new `startupMessage()` of **R.oo**. # Version 1.19.2 [2012-12-18] * `R CMD check` for R devel no longer gives a NOTE on `attach()`. # Version 1.19.1 [2012-12-02] * CLEANUP: `R CMD check` no longer warns on global assignments. * BUG FIX: `Arguments$getIndices(x, max = 0, disallow = "NaN")` where `x` contains only `NA_integer_`, would give "Exception: Argument 'x' is of length 1 although the range ([0,0]) implies that is should be empty." although it should return `x` as-is. # Version 1.19.0 [2012-11-29] * CLEANUP: Dropped `lapply()` for MultiVerbose. * Added `as.list()` to MultiVerbose. # Version 1.18.4 [2012-11-21] * Now declaring all S3 methods in the namespace. # Version 1.18.3 [2012-11-06] * BUG FIX: `queryRCmdCheck()` did not detect "tests" evidences when `R CMD check` was testing multiple architectures. # Version 1.18.2 [2012-11-04] * CLEANUP: Replaced all `whichVector()` with `which()`, because the latter is now the fastest again. * CLEANUP: Dropped pre-R 2.3.0 patch of `as.character.hexmode()`. * CLEANUP: Dropped pre-R 2.5.0 patch of `Sys.setenv()`. * BUG FIX: The `columnClasses` header field created by `writeDataFrame()` would contain "integer" for "factor":s. Now using `class(x)[1]` instead of `storage.mode(x)` to infer column classes. * BUG FIX: Despite documented header fields `createdBy` and `createdOn` to be ignored if NULL, they did set the corresponding` element in `header` argument to NULL if they were NULL. # Version 1.18.1 [2012-10-31] * Now `gzip()`/`gunzip()`/`bunzip2()` creates the directory of destination pathname `destfile`, iff missing. # Version 1.18.0 [2012-10-29] * Added trial version of `readWindowsShellLink()`, which eventually will replace `readWindowsShortcut()`. * GENERALIZATION: Now `filePath()` does a better job reading Windows Shell Links/Windows Shortcut (\*.lnk) files. * ROBUSTNESS: Now `createWindowsShortcut()` uses an improved validation strategy of the created \*.lnk file. # Version 1.17.4 [2012-10-26] * BUG FIX: `example(createWindowsShortcut)` could throw an error on some systems. The exact reason for this is unknown, so for now it's instead generating a warning rather that an error. # Version 1.17.3 [2012-10-26] * RECOMMENDATION: Since R v2.11.0, you should use `base::which()` instead of `whichVector()`, which now `help("whichVector")` also explains. Also, `whichVector()` was removed from the help index of the package. * CRAN POLICY: Made the examples run faster for `R CMD check`. # Version 1.17.2 [2012-10-21] * ROBUSTNESS: Added argument `maxTries` to `Arguments$getWritablePathname()` to have the method try to create missing directories multiple times before giving up. This also means that it will take a longer for this method to fail creating a directory. * Now `Arguments$getWritablePathname()` gives a more informative error if failed, analogously to `Arguments$getReadablePathname()`. # Version 1.17.1 [2012-10-19] * `mkdirs(path)` could generate a warning if the path was created by another process as a race condition. Now it always checks to see if the directory already exists just before trying to create the directory. # Version 1.17.0 [2012-10-16] * Moved `Arguments$getFilename()` from **R.filesets** to **R.utils**. Added Rd help. * ROBUSTNESS: Bumped up package dependencies. # Version 1.16.6 [2012-10-09] * BUG FIX: `evalWithTimeout()` would not reset the time limits after returning. Thanks to Gregory Ryslik at Yale University for reporting on this. # Version 1.16.5 [2012-09-26] * Added argument `skip` to `createLink()`. * ROBUSTNESS: Now `createLink(..., overwrite = TRUE)` will try to undo the overwrite, iff it failed to create the new link. * BUG FIX: `createLink(..., overwrite = TRUE)` would give an error saying "file already exists" (iff that is true) when it tries to create a `"unix-symlink"` link. Thanks Taku Tokuyasu at UCSF for the report. # Version 1.16.4 [2012-09-24] * BUG FIX: `Arguments$getReadablePath(..., mustExist = FALSE)` did not work. # Version 1.16.3 [2012-09-21] * Now `insert()` silently expands `values` to be of the same length as `ats`, iff `length(values) == 1`. * `toCamelCase(..., preserveSameCase = TRUE)` makes all-upper-case words into same-case words, e.g. `toCamelCase("HTML View", preserveSameCase = TRUE)` outputs `"htmlView"` (not `"hTMLView"`). Added system tests for `toCamelCase()`. # Version 1.16.2 [2012-09-12] * ROBUSTNESS/CRAN POLICY: `moveInSearchPath()` no longer calls `.Internal(detach(...))` but instead `base::detach()` in such a way that neither detach hooks nor `.Last.lib()` are called. # Version 1.16.1 [2012-09-07] * Now `createLink()` also supports targets with `~` in the path. * ROBUSTNESS: `createLink(target = "C:/")` would try to create a link with name `C:`, which is not valid resulting is the somewhat confusing error on "cannot symlink 'S:' to 'S:', reason 'Access is denied'". Now it instead throws "Cannot infer a valid link name from argument 'target': C:/". * ROBUSTNESS/BUG FIX: On Windows, it could happen that `createLink()` would generate a zero-size link file that did not link to the target as a result of a failed `file.symlink()`. This is now tested for such that if an invalid link file was created, it is removed again. # Version 1.16.0 [2012-07-11] * CLEANUP: Dropped the graphics device related functions that were moved to **R.devices**. * `System$findGraphicsDevice()` no longer tries to create a PNG device using `png2()`, because that has now moved to **R.devices**. * Updated package dependencies. # Version 1.15.1 [2012-06-16] * Now package only imports/no longer depends on the **utils** package. This means that all packages that depends on **R.utils** for loading **utils** for them need to explicitly load it themselves. # Version 1.15.0 [2012-05-22] * Added `systemR()` for launching an external R process. * Package no longer loads (via a DESCRIPTION Depends) the **R.devices** package, because that would cause a circular package dependency. Instead, we're keeping the graphical device functions here until all reverse dependent packages have been set to explicitly use **R.devices**. # Version 1.14.0 [2012-05-01] * Copied all functions related to graphics devices to new package **R.devices** (v2.1.1), which is now on CRAN. For backward compatibility, the **R.utils** package will for now depend and hence load the **R.devices** package. # Version 1.13.1 [2012-04-16] * Added `findFiles()`, which orginates from the **affxparser** package. # Version 1.13.0 [2012-04-07] * Added `toBMP()` and `toTIFF()`. # Version 1.12.2 [2012-04-05] * Now it is possible to have `devEval()` rename incompletely generated image files, by using argument `onIncomplete = "rename"`. This will simplify troubleshooting. The default is still to remove incomplete files. * ROBUSTNESS: Updated package dependencies. # Version 1.12.1 [2012-03-20] * BUG FIX: `.onAttach()` would try to call `getMessage(ex)` on an `error` if there was a problem adding a finalizer, resulting in "no applicable method for 'getMessage' applied to an object of class "c('simpleError', 'error', 'condition')". Now using `ex$message` instead. # Version 1.12.0 [2012-03-08] * CRAN POLICY: Renamed `remove()` for FileProgressBar to `cleanup()`, because otherwise it would be inevitable to create an internal copy of `base::remove()` which contains an `.Internal()` call. This move may break existing code that calls `remove()` on an FileProgressBar object. * CRAN POLICY: Removed all internal copies of **base** and **utils** functions that have `.Internal()` calls. * CLEANUP: Removed `relibrary()` function, because it has not worked properly since R introduced namespaces, which is several years. # Version 1.11.2 [2012-02-29] * CRAN POLICY: Now `capture()` for Verbose uses `withVisible()` instead of an `.Internal(eval.with.vis())` call. # Version 1.11.1 [2012-02-28] * ROBUSTNESS: The creation of image files by `devEval()` is now close to being "atomic". That is, if the code for plotting the figure is interrupted (e.g. by a user interrupt or an error), then any created image file is removed. This avoids leaving incomplete/blank image files behind. # Version 1.11.0 [2012-02-26] * GENERALIZATION: Now `devOptions()` accepts passing a device function in addition a string, e.g. `devOptions(png)` and `devOptions("png")`. * Added argument `scale` to `devNew()`. * BUG FIX: Before `devNew(..., aspectRatio = 1)` would ignore `devOptions(...)$width` if neither argument `width` nor `height` was given. # Version 1.10.0 [2012-02-23] * Added `swapXY()` and `draw()` for `density` objects. Used to be in the **aroma.core** package. * ROBUSTNESS: Package now explicitly depends on **utils** and **R.methodsS3**. Before it relied on **R.oo** to load those. # Version 1.9.11 [2012-01-17] * ROBUSTNESS: Now `System$findGraphicsDevice()` not only assert that an image file is generated, but also that its filesize is non-zero. This avoids returning a device that generates empty image files. Also updated the time out to 10 secs (was 30 secs). # Version 1.9.10 [2012-01-12] * CLEANUP: `reassignInPackage()` calls function that are considered "unsafe" by the new CRAN policies, i.e. `unlockBinding()` and `assignInNamespace()`. However, we still wish to keep this method available to advanced users. In order to avoid getting NOTEs from `R CMD check`, we have "hidden" those unsafe function calls. # Version 1.9.9 [2012-01-11] * BUG FIX: `writeRaw()` for Verbose would throw error "Trying to coerce more than one character string to a GString, which is not supported." iff passing a vector of strings. # Version 1.9.8 [2011-12-30] * DOCUMENTATION: The help now explains that `evalWithTimeout(readline())` does not throw a timeout exception until after `readline()` returns. # Version 1.9.7 [2011-12-16] * BUG FIX: `evalWithTimeout()` would not detect timeouts in R sessions that use a non-English locale. * BUG FIX: Now `evalWithTimeout(..., onTimeout = "silent")` works. Thanks Nicholas Beeton (Univ. of Tasmania, Australia) for reporting on this. # Version 1.9.6 [2011-11-23] * BUG FIX: `evalCapture()` with argument `envir` defaulting to `parent.frame()` would not be evaluated in the parent frame as it should. It appears that the internal `capture.output()` prevents this from happening, unless argument `envir` is explictly evaluated within `evalCapture()`. # Version 1.9.5 [2011-11-19] * ROBUSTNESS: Now `parse()` and `as.character()` handles "empty" GString:s. * ROBUSTNESS: Now `GString()` asserts that it only holds one string. # Version 1.9.4 [2011-11-15] * SPEEDUP: Now `Arguments$getCharacters(s, asGString = TRUE)` is much faster for elements of `s` that are non-GStrings. For long character vectors the speedup is 100-200x times. * SPEEDUP: Now `as.character()` and `parse()` for GString return faster if the string is a plain string without markup etc. This made `as.character()` about 10-15 times faster. # Version 1.9.3 [2011-11-07] * Added `quarts` to the list of (possible) devices for `devOptions()`. * BUG FIX: `devOptions()` assumed that all devices exist on all platforms, causing it to give an error on some. # Version 1.9.2 [2011-11-06] * Added `evalCapture()` for evaluating an expression and capturing its deparsed code and/or output. # Version 1.9.1 [2011-11-05] * Added `toEPS()`, `toPDF()`, `toPNG()`, and `toSVG()`. * Added `devOptions()`. * Added default `width` and `height` values to `eps()`. * Turned `png2()` and `jpeg2()` into plain functions without a generic. This is consistent with how `eps()` is defined. * GENERALIZATION: Now the default `width` is inferred from `devOptions()` if needed. * DOCUMENTATION: Added an example to `help(devEval)`. # Version 1.9.0 [2011-11-03] * Added `queryRCmdCheck()`, which retrieves the status of `R CMD check`, iff it is running. # Version 1.8.8 [2011-11-01] * Added argument `dims` to `extract()` for arrays. Also, argument `drop` was moved to the end. # Version 1.8.7 [2011-11-01] * CLEANUP: Fixed a `R CMD check` NOTE that would show up in R v2.15.0 devel. # Version 1.8.6 [2011-10-31] * Added argument `field` to `devEval()`. # Version 1.8.5 [2011-10-16] * CORRECTION: `Arguments$getNumerics(c(Inf), disallow = "Inf")` would report that it contains `NA` instead of `Inf` values. # Version 1.8.4 [2011-10-08] * Now the default for argument `methods` of `createLink()` can be set via option `createLink/args/methods`. # Version 1.8.3 [2011-09-30] * Added `installPackages()` for installing R packages by names or URLs. This method was previously in the hbLite.R script of **braju.com**. # Version 1.8.2 [2011-09-24] * `devNew()` no longer gives a warning about argument `aspectRatio` is specified when both or neither of `width` and `height` are given, and `aspectRatio` is 1. * Internal `readDWord()` and `readQWord()` of `readWindowsShortcut()` would try read 4- and 8-byte integers as non-signed, which is not supported by `base::readBin()` and hence instead read as signed integers. Starting with R v2.13.1 this would generate a lot of warnings. # Version 1.8.1 [2011-09-19] * Now `System$mapDriveOnWindows()`, `System$unmapDriveOnWindows()`, and `System$getMappedDrivesOnWindows()` also handles Windows UNC paths (i.e. network resource). This was triggered by a discussion with Keith Jewell at Campden BRI Group, UK. * WORKAROUND: `isDirectory("C:/")` would not return TRUE due to a bug in `file.info("C:/")` causing it to return NAs. * Now `attachLocally()` returns a character vector also of length zero. Before NULL was returned. # Version 1.8.0 [2011-09-14] * Added `writeDataFrame()`. * ROBUSTNESS: Added sanity checks to `example(capitalize)`. * DOCUMENTATION: Improved `example(commandArgs)`. * BUG FIX: `commandArgs()` would not handle `-<key> <value>` and `--<key> <value>` properly in all cases. # Version 1.7.8 [2011-07-24] * Undoing v1.7.7 to again exports `.conflicts.OK` in order to avoid several warnings when loading package. # Version 1.7.7 [2011-07-23] * `.conflicts.OK` is no longer exported, because it would cause other "downstream" packages to generate a WARNING in `R CMD check`. # Version 1.7.6 [2011-04-30] * Added `isReplicated()` and `replicates()` for identifying entries in a vector that are non-unique. Corresponding `isSingle()` and `singles()` identifies entries that exists only once. # Version 1.7.5 [2011-04-12] * Now `devEval("jpg", ...)` is recognized as `devEval("jpeg", ...)`. # Version 1.7.4 [2011-04-03] * Now `hpaste(..., sep = " ", maxHead = Inf)` corresponds to `paste(..., sep = " ", collapse = ", ")`. Added to example. # Version 1.7.3 [2011-04-02] * Added `hpaste()` for human-readable pasting, e.g. `"1, 2, 3, ..., 10"`. * Now argument `force` of `devEval()` defaults to `getOption("devEval/args/force", TRUE)`. # Version 1.7.2 [2011-03-18] * Now argument `path` of `devEval()` defaults to `getOption("devEval/args/path", "figures/")`. * Now `devEval()` does a better job of "cleaning up" `name` and `tags`. # Version 1.7.1 [2011-03-18] * `devNew()` gained option `devNew/args/par`, which can be used to specify the default graphical parameters for `devNew()`. Any additional parameters passed via argument `par` will override such default ones, if both specifies the same parameter. * The automatic archiving of `devEval()` is not considered unless the **R.archive** package is loaded, regardless of option settings. * DOCUMENTATION: The title of `help(devDone)` was incorrect. # Version 1.7.0 [2011-03-10] * Now argument `aspectRatio` of `devNew()` defaults to 1 (not NULL). * Added `setOption()`, the "set version" of `getOption()`. * Added `env()` for creating an environment and evaluating an expression inside of it in one go. * Added argument `path` to `sourceTo()`. * REPRODUCIBLE RESEARCH: Now `devEval()` archives any generated image files if **R.archive** option `devEval` is TRUE. * BUG FIX: `sourceTo()` would not work for URLs. # Version 1.6.6 [2011-03-08] * Now `Arguments$getWritablePath(NULL)` returns NULL without asserting write permission, which is analogue to how it is done with `Arguments$getReadablePath(NULL)`. * Added argument `timestamp` to `printf()` for Verbose so that the timestamp can be turned off/on explicitly as for `cat()`. # Version 1.6.5 [2011-03-03] * Added trial version of `createFileAtomically()` for creating files atomically, by writing to a temporary file which is then renamed. * Added trial versions of `push-`, `popBackupFile()` for backing up and restoring a file. * Added trial versions of `push-`, `popTemporaryFile()` for working toward a temporary file. * Added trial version of `renameFile()`, which to additional validation afterward. # Version 1.6.4 [2011-02-28] * (Incomplete revision submitted to CRAN by mistake) # Version 1.6.3 [2011-02-20] * Added argument `par` to `devNew()` for applying graphical parameters at the same time as the device is opened, which is especially useful when using `devEval()`. * Changed argument `force` of `devEval()` to default to TRUE. # Version 1.6.2 [2011-02-14] * Added trial version of `devEval()` for simple creation of images. * Added argument `aspectRatio` to `devNew()`, which updates/sets the `height` or the `width`, if the one of the other is not given. # Version 1.6.1 [2011-02-01] * ROBUSTNESS: Now using argument `fixed` (not `fix`) in `regexpr()` calls. # Version 1.6.0 [2010-12-07] * Added `evalWithTimeout()`. # Version 1.5.8 [2010-11-21] * ROBUSTNESS: Now `loadObject()` asserts that the file exists. If file doesn`t exist, an informative error message is thrown. * ROBUSTNESS: Now `System$mapDriveOnWindows()` does not give an error if trying to map the same drive letter to the same path multiple times. * TYPO: Static methods `getVector()` and `getRegularExpression()` of Arguments would report the incorrect argument name. * BUG FIX: `System$mapDriveOnWindows()` and `System$unmapDriveOnWindows()` did not work if the path contained a space. Now the path is quoted. * BUG FIX: Now `removeDirectory()` also works for paths starting with a tilde (`~`). The reason was/is that `base::unlink()` used internally does not support that. We now use `base::path.expand()` first. # Version 1.5.7 [2010-11-07] * ROBUSTNESS: Now `read-`/`writeBinFragments()` assert that argument `idxs` contains only non-negative indices. * Added support to `readBinFragments()` to start reading from either the current file position (default; as previously) or from the start of the connection. For backward compatibility, we keep the default to be relative to the current position, but this may change in the future. # Version 1.5.6 [2010-11-03] * Added `resample()`, which contrary to `sample()` also works when drawing from a single element. # Version 1.5.5 [2010-10-26] * Now argument `which` to `devSet()` can be any object. If not a single numeric or a single character string, then a checksum character string is generated using `digest::digest(which)`. # Version 1.5.4 [2010-10-13] * Now the `link` argument of `createLink()` is inferred from the `target` argument if it is `"."` (or NULL). # Version 1.5.3 [2010-09-29] * Added an example to `help(findSourceTraceback)`. * BUG FIX: Each entry identified by `findSourceTraceback()` would be duplicated. # Version 1.5.2 [2010-09-15] * `fileAccess()` no longer returns a named value if `file.access()` is used. * ROBUSTNESS: Added a more robust test for `fileAccess(path, mode = 2)` when `path` is a directory. Thanks Chao Chen at University of Chicago for reporting issues with this. * BUG FIX: Now `fileAccess(..., mode = 1)` only utilizes `file.info()$exe` if it is a file and on Windows, otherwise it relies on `file.access()`. * DOCUMENTATION: Added an example to `help(fileAccess)`. * MISC: Added support for `readRdHelp(..., format = "text")` in R < 2.10.0. # Version 1.5.1 [2010-08-28] * Added `readRdHelp()` for locating and reading installed Rd help pages in various formats. * Now `downloadFile()` supports authentication, if `wget` is available on the system. # Version 1.5.0 [2010-08-04] * Added `stext()`, which previously was in the **aroma.core** package. # Version 1.4.4 [2010-07-05] * Now `arrayIndex()` returns an integer matrix. * DOCUMENTATION: Now the help of `arrayIndex()` links to the new `arrayInd()` in the **base** package. # Version 1.4.3 [2010-06-23] * BUG FIX: `getAbsolutePath("//server/dir/")` would incorrectly drop the initial double-slashes (`//`) and return `"/server/dir/"`. Thanks Richard Cotton at Health and Safety Laboratory (HSL), UK, for reporting this. # Version 1.4.2 [2010-06-09] * Added `printf()`, as a convenient wrapper for `cat(sprintf(...))`. # Version 1.4.1 [2010-05-26] * Added `downloadFile()` for safer and more convenient downloads. # Version 1.4.0 [2010-03-24] * Now **R.utils** requires R v2.5.0 (circa 2007) or newer. This is because there was a change in `base::parse()` from R v2.4.1 and R v2.5.0. See news for **R.utils** v0.9.3. * Added a NAMESPACE. # Version 1.3.4 [2010-03-02] * Added alpha version of an `onGarbageCollect()` method. * BUG FIX: `findSourceTraceback()` stopped working; probably due to some recent updates in `base::source()`. # Version 1.3.3 [2010-01-25] * ROBUSTNESS: Added validation of argument `range` in Arguments methods. # Version 1.3.2 [2010-01-09] * `sourceTo(..., modifiedOnly = FALSE)` followed by a `sourceTo(..., modifiedOnly = TRUE)` will now work as expected. Before you had to do at least one `modifiedOnly = TRUE` call before for it to work. * `sourceTo()` no longer gives a warning if there is a missing EOL. # Version 1.3.1 [2010-01-08] * Added `System$mapDriveOnWindows()`, `System$unmapDriveOnWindows()`, and `System$getMappedDrivesOnWindows()` for associating drive letters with paths on Windows. # Version 1.3.0 [2010-01-02] * Added argument `max` to `Arguments$getIndices()`. * Added `Arguments$getInstanceOf(...)`. * Now `Arguments$getWritablePath()` and `Arguments$getWritablePathname()` throws an error is an NA file/directory is specified. * Now `Arguments$getReadablePath()` and `Arguments$getReadablePathname()` throws an error is an NA file/directory is specified, unless `mustExist` is FALSE. * Moved private GenericSummary from **aroma.core** to **R.utils**. * ROBUSTNESS: Now `getParent()`, `getAbsolutePath()` and `getRelativePath()` returns a (character) NA if the input is NA. * ROBUSTNESS: Any NA arguments in `...` to `filePath(...)` would be parsed as `"NA"` resulting in paths such as `"NA/foo/NA"` (just as `file.path()` does it). Now a (character) NA is returned. * BUG FIX: The `example(GString)` code escaped a backslash incorrectly. * BUG FIX: `Arguments$getCharacters(s)` would return a _logical_ instead of a _character_ vector if `s` contained all NAs. * BUG FIX: Now `isFile(NA)` and `isDirectory(NA)` return FALSE. Before it gave an unexpected error. # Version 1.2.6 [2009-12-19] * Added argument `envir = new.env()` to `loadToEnv()`. # Version 1.2.5 [2009-11-20] * If `x` is a logical vector, `Arguments$getIndices(x)` will now return the same as if `x <- which(x)`. # Version 1.2.4 [2009-10-30] * ROBUSTIFICATION: Lowered the risk for `saveObject()` to leave an incomplete file due to say power failures, etc. This is done by first writing to a temporary file, which is then renamed. If the temporary file already exists, an exception is thrown. * ROBUSTIFICATION: Now `Arguments$getWritablePathname(path)` validates that there is enough file permissions so that a file can be created in the `path` directory. * CLEAN UP: On Windows Vista, `createLink()` produced a stderr message "You do not have sufficient privilege to perform this operation", when trying to use Windows `mklink` command. Those message are now silenced. # Version 1.2.3 [2009-10-20] * Added `findSourceTraceback()`, which finds the pathnames of all files currently being `source()`:ed. # Version 1.2.2 [2009-10-16] * Some cleanup of Rd files to meet the stricter requirements. # Version 1.2.1 [2009-10-03] * Added `createLink()`. * Added `createWindowsShortcut()`. Currently it only works on Windows and version of Windows that runs VB scripts. # Version 1.2.0 [2009-09-09] * Fixed broken/missing Rd links. # Version 1.1.9 [2009-06-29] * Added argument `useNames = FALSE` to `getCharacters()` of Arguments. For forgotten reasons, before (the default now) `names` attributes were always dropped. Now they can be kept, if wanted. * Added `dimNA<-()`. # Version 1.1.8 [2009-06-07] * BUG FIX: `getParent(..., depth = 0)` gave an error, instead of returning the input path. # Version 1.1.7 [2009-05-30] * BUG FIX: Argument `dThreshold` of `less()` for Verbose had to be named in order to be mapped. # Version 1.1.6 [2009-05-19] * UPDATE: Now `getEnvironment()`, `getRegularExpression()`, and `getReadablePathname()` give clearer error messages if more the input contains more than one element. * Now `Arguments$getWritablePathname()` better explains why a file cannot be opened for creation/modification due to wrong file permissions. # Version 1.1.5 [2009-05-16] * Changed argument `asMode` for `Arguments$getNumerics()` to default to NULL instead of `"numeric"`. This will case the method to return integer if the input is integer, and double if the input is double. The previous default was alway returning doubles, cf. notes on common misconception of how `as.numeric()` works. In the case when the input is neither integer or double, the default is to coerce to doubles. # Version 1.1.4 [2009-04-04] * Now `getReadablePathname(..., mustExist = TRUE)` of Arguments reports also the working directory if the a relative pathname is missing. * BUG FIX: `getReadablePathname(..., mustExist = TRUE)` of Arguments gave an internal error if the pathname was in the current directory and did not exist. # Version 1.1.3 [2009-01-12] * Added `isPackageInstalled()`. * FIXUP: There were some Rd warnings with the new R v2.9.0. # Version 1.1.2 [2008-12-27] * Now `getReadablePathname(..., mustExist = TRUE)` and `getWritablePathname(..., mkdirs = FALSE)` of Arguments report which of the parent directories exists when the requested pathname is not found. This will help troubleshooting missing pathnames. * Added `removeDirectory()` for a convenient and safe way to remove directories. * Added argument `useNames` to `insert()`, which is now aware of names of the input object. * Added `subplots()` originating from (obsolete) **R.graphics**. # Version 1.1.1 [2008-12-03] * Now `getReadablePathname()` and `getWritablePathname()` of Arguments, and `sourceTo()` use the more trusted `fileAccess()` instead of `file.access()` of **base**. This will hopefully solve some problems where these methods incorrectly gives an error reporting lack of file permissions; this could happen when some OSs mounted to other external file systems. * Added `fileAccess()` which is intended to give tries harder than `file.access()` to infer file permissions. * STABILITY: Added balance and sanity checks for `exit()` of Verbose. * Now `gzip()` and `gunzip()` removes the partially written output file if the process is interrupted. * BUG FIX: `readWindowsShortcut()` would not work with some Windows shortcut files linking to a Windows network file system and generated on Windows Vista. Their "flags" in the file headers had more than the 8 known bits, which was reported as a file format error. Although we don`t know what these unknown bits are for, we now accept them quitely accepted so at least the known part of the file format is returned. * BUG FIX: `filePath("\\\\shared/foo")` would return `"\\shared/foo"`. # Version 1.1.0 [2008-10-24] * Now `sourceDirectory()` also searches for source files with extensions \*.r, \*.q, \*.s, and \*.S, cf. R manual 'Writing R Extensions'. # Version 1.0.9 [2008-10-17] * BUG FIX: `commandArgs()` gave "Error in !attr(args, "isEnvVars") : invalid argument type" if both arguments `excludeReserved = TRUE` and `excludeEnvVars = TRUE` were used. # Version 1.0.8 [2008-10-16] * Now `devDone(which = 1)` does nothing. Before it gave an error. * BUG FIX: Argument `type` of `devNew()` did not take function:s. # Version 1.0.7 [2008-09-20] * Added `mapToIntervals()`, `inAnyInterval()`, and `mergeIntervals()`. # Version 1.0.6 [2008-09-08] * Now `devNew()` filters out arguments `file` and `filename`, if the device is interactive. # Version 1.0.5 [2008-08-04] * Now `commandArgs(...)` pass `...` to `base::commandArgs()` making it fully backward compatible. It is also updated to recognize all R command line options as of R v2.7.1 and R v2.8.0 devel. # Version 1.0.4 [2008-08-01] * Now `sourceDirectory()` is guaranteed to source directories and files in lexicographic order. * Added `countLines()` for counting number of lines in a text file. * Added several functions for extending the current functions dealing with devices. All added functions can address a device by a label in addition to the standard device index. The `devGetLabel()` and `devSetLabel()` gets and sets the label of a give device. `devList()` lists the indices of existing device named by their labels, cf. `dev.list()`. The functions `devSet()` and `devOff()` work like `dev.set()` and `dev.off()` but accept labels as well. Furthermore, `devSet(idx)` will open a device with index `idx` if it does not exists, and `devSet(label)` a device with that label if not already opened. The `devIsOpen()` checks if a device is open or not. The `devDone()` function calls `devOff()` except for screen devices. # Version 1.0.3 [2008-07-10] * Added `readBinFragments()` and `writeBinFragments()` to read and write binary data scattered across a connection or a file. These methods moved from the **R.huge** package. * Added `intervalsToSeq()`, which is bijective to `seqToIntervals()`. * Added `whichVector()`, which is almost twice as fast `which()` for logical vectors, especially when there are no missing values. * IMPROVEMENT: Major speed up of `seqToIntervals()`. * Added `gzip()`. * Renamed inst/HISTORY to inst/NEWS according to new R standards. * CLEAN UP: `as.character()` for `hexmode` is only added if missing. * BETA: Added (for now internal) `toAsciiRegExprPattern()`. # Version 1.0.2 [2008-03-31] * BUG FIX: If `x` in `insert(x, ...)` had zero length, an "Error in from:to : NA/NaN argument" was thrown. # Version 1.0.1 [2008-03-06] * BUG FIX: Regular expression pattern `a-Z` is illegal on (at least) some locale, e.g. `C` (where `A-z` works). The only way to specify the ASCII alphabet is to list all characters explicitly, which we now do in all methods of the package. See the R-devel thread "invalid regular expression `[a-Z]`" on 2008-03-05 for details. # Version 1.0.0 [2008-02-26] * Added `touchFile()` for updating the timestamp of a file. * Added `colClasses()` for creating "colClasses" vectors. * Added `isPackageLoaded()`. * The default filename for `eps()` had extension \*.ps not \*.eps. * Cleaned out empty sections from the Rd help pages. * Now the `...` arguments to `Arguments$getVerbose()` are passed to the constructor of Verbose. This allows constructs such as `Arguments$getVerbose(-10, timestamp = TRUE)`. * BUG FIX: When argument `values` of `insert()` was a non-list its values were placed in a single-element list even when `ats` contained more than one element. Should have been `as.list()` in those cases. # Version 0.9.8 [2007-11-26] * Added `copyFile()` which safely copies a file by copying to a temporary file, which is then renamed. * Added `isEof()` for connections to test for "End of File". * Added `reassignInPackage()`. * Added `dataFrame()`, which allocated a data frame of given size and column classes. * BUG FIX: `writeRaw()` of MultiVerbose returned a list of logicals. Now it returns TRUE (invisibly). # Version 0.9.7 [2007-09-17] * BUG FIX/WORKAROUND: `moveInSearchPath()` would make the package environment loose the `path` attribute, which is for instance is needed by `packageDescription()`. This would in turn cause `sessionInfo()` to throw an error. Now `moveInSearchPath()` makes sure to set all attributes on a moved package environment to what it used to be. # Version 0.9.6 [2007-08-29] * Made documentation for `saveObject()` and `loadObject()` public. * Now the startup message when loading the package is generated with `packageStartupMessage()` so that it can be suppressed. * Added `flush()` to TextStatusBar. Added `flush()` to `example(TextStatusBar)` so it displays correctly on Rgui on Windows. * Added `bunzip2()`, cf. `gunzip()`. * Added argument `remove` to `gunzip()`. * BUG FIX: There was a typo in `readWindowsShortcut()` causing field `iconFilename` to potentially be invalid. Thanks Tony Plate for reporting this. # Version 0.9.5 [2007-06-09] * Updated code to pass the more strict `R CMD check` R v2.6.0. * BUG FIX: Used `omit.na()` instead of `na.omit()` in static method `parseDebian()` of System. # Version 0.9.4 [2007-05-10] * BUG FIX: `readTable()` tried to access `base::read.table()` but that was moved to **utils** as of R v2.5.0. # Version 0.9.3 [2007-05-09] * BUG FIX: Using the R v2.4.x build of **R.utils** in R v2.5.0 gives "Error in parse.default(text = src) : 4 arguments passed to `parse` which requires 6". This is because the internal call in `base::parse()` use different sets of arguments in R v2.4.1 and R v2.5.0. The fix was to dynamically assign `patch.default()` when the package is loaded. # Version 0.9.2 [2007-04-26] * Added trial version of a MultiVerbose class. With this class it is possible to write verbose output via multiple Verbose objects through one MultiVerbose object, e.g. writing to standard output and to log file at the same time. # Version 0.9.1 [2007-04-12] * BUG FIX: `findGhostscript()` would give error "paste(path0, collapse = ", ") : object "path0" not found" on Windows if Ghostscript was not found. This error was caught by CRAN. These problems have not been detected locally where Ghostscript is installed. # Version 0.9.0 [2007-04-11] * BUG FIX: `findGhostscript()` of System would give error on "invalid subscript type" if non of the paths to be searched exist. This error was caught by CRAN. # Version 0.8.9 [2007-04-07] * Removed never needed `require(R.io)` in `openBrowser()` for System. # Version 0.8.8 [2007-04-03] * Added `saveObject()` and `loadObject()`. * Removed the warning in `getRelativePath()` about "Cannot infer relative pathname, because the two pathnames are not refering to the same root/device". The warning was more confusing than helpful. * BUG FIX: `getAbsolutePath("C:/foo/", expandTilde = TRUE)` would return `"C://foo"` and not `"C:/foo"`. Now the method also replace all multiple occurances of slashes with a single one. This bug cause `getRelativePath("C:/foo", "C:/")` to return the wrong thing. * BUG FIX: `toCamelCase(toCamelCase(s))` would not be equal to `toCamelCase(s)`, but instead result in all lower case letters. * BUG FIX: Default value of argument `format` of `timestamp()` was invalid. # Version 0.8.7 [2007-03-24] * Added `moveInSearchPath()` to reshuffle the search path. Useful to change the order of packages after they have loaded. * Added `toCamelCase()` to convert strings. * Added `loadToEnv()` for loading saved data to a new environment. * The warning message on "cannot refer relative pathname" for `getRelativePath()` didn't paste the path resulting in a funny looking warning. # Version 0.8.6 [2007-02-27] * An **R.utils** (v0.8.4) modified `.Last()` function saved in .RData from previous R sessions will be updated with the new modifactions according to **R.utils** v0.8.5. # Version 0.8.5 [2007-02-26] * Added argument `depth` to `getParent()`. * BUG FIX: Added `tryCatch()` and explicit check for `finalizeSession()`. Otherwise if, under special circumstance, one might get the error `Error in .Last() : could not find function "finalizeSession"` when trying to quit R with `quit()`. Thanks Elizabeth Purdum at UC Berkeley for reporting this. * When running R v2.5.0, `Sys.getenv()` is used instead of deprecated `Sys.putenv()`. # Version 0.8.4 [2007-01-10] * Now `System$findGhostscript()` searches all `Program Files` directories too, if on Windows. # Version 0.8.3 [2006-11-10] * Added `arrayIndex()` to get the multi-dimensional index of an array from a one-dimensional index. # Version 0.8.2 [2006-10-05] * Added `popMessage()` to TextStatusBar. See `example()`. * Added argument `modifiedOnly` to `sourceTo()` so that a file is only sourced if it has been modified since the last call. Note that this argument is passed on by `sourceDirectory()` too. # Version 0.8.1 [2006-09-16] * BUG FIX: `sourceDirectory(..., onError = "error")` would quietly ignore errors in `source()`. * Added methods `more()` and `less()` to the Verbose class. # Version 0.8.0 [2006-08-21] * Added `isOpen()` to check if there is another connection opened to a specific file. * `pushState()` of Verbose generated an unnecessary warning due to a typo. # Version 0.7.9 [2006-07-17] * The `capture()` method in Verbose modified a text connection while it was still open; from R v2.4.0 this is not allowed. Thanks Brian Ripley for pointing this out. # Version 0.7.8 [2006-05-22] * Added the TextStatusBar class. # Version 0.7.7 [2006-03-30] * The method list in the class-overview help page was missing for several classes. * Added `as.double()` to Verbose. * `saveAnywhere()` of Settings now returns (invisibly) the pathname where the settings were saved. # Version 0.7.6 [2006-02-15] * Since the `png2()` and `jpeg2()` devices are in this package, the `eps()` device from **R.graphics** has been moved here for consistency. # Version 0.7.5 [2006-02-09] * `as.character.hexmode()` is available in R v2.3.0 and forward. Thus, the method is only added by this package for pre-R v2.3.0. # Version 0.7.4 [2005-12-23] * Updated `getHostname()` and `getUsername()` in System to first try to find the details using `Sys.info()`. After that system environment variable and so on are checked. * Added argument `expandTilde = FALSE` to `getAbsolutePath()` so that tildes (`~`) are expanded to there corresponding path. * Now relative paths handle tildes too. * Added optional automatic timestamping for the Verbose class. This is useful for Verbose objects writing to log files. * BUG FIX: Added protection against infinite loops in `isFile()`, where relative path is the same as the absolute path. # Version 0.7.3 [2005-11-24] * Added `extract()` for arrays, matrices, and vectors. # Version 0.7.2 [2005-11-22] * BUG FIX: `filePath(..., expandLinks = "any")` would return the relative link instead of the network pathname, even if there were no local pathname. * BUG FIX: Now using `scan()` instead of `readLines()` to parse header. This way the header can now also be quoted. * BUG FIX: Missing object `ndim` in `wrap()`; should be `ndims`. * BUG FIX: Sequences of length one was given as intervals by `seqToHumanReadable()`, e.g. `"10-10"`. * Static Arguments class: Added `getReadablePathnames()`. Now `getCharacter()` accepts vectors of length zero or one only. # Version 0.7.1 [2005-11-12] * Added functions `wrap()` and `unwrap()` to reshape arrays (and matrices) by joining and splitting dimensions, respectively, and optionally by permuting dimensions too. This is for instance useful when storing multidimensional arrays in tabular formats. # Version 0.7.0 [2005-11-10] * Added trial version of `readTable()`. It extends the `read.table()` in two major ways. First it allows you to specify `colClasses` as a column name to column class map. Second, it allows you you to read any subset of rows, which substantially improves speed and decrease memory usage. Use `readTableIndex()` to create a look-up index for rows of interest. * Added `seqToIntervals()`, which finds all contigous (integer) regions in a set of integers, cf. `seqToHumanReadable()`. * BUG FIX: `isDirectory()` on a file would result in an infinite recursive loop to itself. * Added inifite recursive call detection to `listDirectory()`. * Now `sourceDirectory()` returns the source files invisibly. * Gathered files recursively in `sourceDirectory()`, but it was not needed since `sourceDirectory()` itself is recursive. # Version 0.6.3 [2005-10-26] * Renamed argument `overwrite` in `getWritablePathname()` in Arguments to `mustNotExist`. Renamed all `mustExists` to `mustExist` in all methods of class Arguments. # Version 0.6.2 [2005-10-20] * Update `loadAnywhere()` for the Settings clas so that it works on objects too for which the default basename is the static basename. * BUG FIX: `getLeaves()` would give an error for empty Options objects. * BUG FIX: `filePath(".")` would return `""`. * BUG FIX: `filePath("//shared/foo")` would return `"/shared/foo"`. # Version 0.6.1 [2005-10-17] * BUG FIX: `readWindowsShortcut()` failed on some Network-only links. # Version 0.6.0 [2005-09-24] * Now `filePath()` removes repeated `/` and `\\`, except for network files such as `\\server\foo\bar`. * BUG FIX: Argument `pager` of `displayCode()` did not support functions. * Updated Options class to make it easier for subclasses to retrieve options more easy. This was needed for the future ROptions class to map to `options()`. * BUG FIX: `System$openBrowser()` was broken, because `startsWith()` and `endsWith()` were missing. * Added trial version of `jpeg2()` and `png2()`. # Version 0.5.9 [2005-09-18] * Added static function `findGraphicsDevice()` to System. The methods search for a working device among a list of potential ones. This is for instance useful if it is known in advance that the PNG device is available (then the `bitmap()` device is an option). # Version 0.5.8 [2005-09-06] * Added argument `asGString = TRUE` to the Verbose constructor. * Added `remove()` to FileProgressBar. * Replace argument `gString` of `getCharacters()` to `asGString`, cf. Verbose class. * Now `Arguments$getReadablePathname()` follows Windows shortcut files. * BUG FIX: `displayCode()` was interpreting the code as GString:s. * Now making use of relative pathnames internally in `copyDirectory()`. Sometimes relative pathnames will work when the absolute ones does not (because of missing file access rights). * BUG FIX: `copyDirectory()` would not return copied files if `recursive == TRUE`. * BUG FIX: Smart comments preceeded by TABs would not be recognized. * GString's `parse()` could return warning because it was incorrectly assumed that `regexpr()` did not return more than one value. # Version 0.5.7 [2005-08-12] * Function `filePath()` returns NULL, if no arguments or only NULL arguments are passed to it. # Version 0.5.6 [2005-08-02] * BUG FIX: `splitByPattern()` tried to access non-existing class Argument. * Arguments' `getReadablePathname()` no longer returns the absolute pathname by default. This is because on some systems the relative pathname can be queried wheras the absolute one may not be access due to missing file permissions. * `isFile()` and `isDirectory()` is now comparing to current working directory if no file information is available (due to missing file permissions); assumes that the current working directory always exists. * `getParent()` now returns NULL instead of `""`. * Added argument `caseSensitive` to `getRelativePath()`. * `isAbsolutePath(NULL)` returns FALSE. * `mkdirs()` tries to create directory with relative path if absolute path fails. This sometimes works when the file permission are missing. * Added argument `code` to `displayCode()`. The function now also used `file.show()` to display the code. * Added `isUrl()` and `hasUrlProtocol()`. * Added `copyDirectory()`. * Added `getEnvironment()` and `getRegularExpression()` to Arguments. # Version 0.5.5 [2005-07-21] * BUG FIX: Example illustrating Windows Shortcut methods tried to access `HISTORY.lnk` and not `HISTORY.LNK`, which would fail on Unix. * BUG FIX: `getCharacters()` would not coerce Object:s correctly. * Now `sourceDirectory()` does `chdir = FALSE` instead of `chdir = FALSE`. * Now `mkdirs()` has an internal check for infinit-recursive calls. # Version 0.5.4 [2005-07-19] * BUG FIX: If there are no files to source in a directory, and verbose is active, `basefile()` on NULL was called generating an error. * BUG FIX: `sourceTo(..., chdir = TRUE)` would generate an error. This would for instance make `sourceDirectory()` useless. # Version 0.5.3 [2005-07-18] * Added `resetWarnings()` and `splitByPattern()`. * Added `summary()` to class Verbose and a corresponding VComments tag. * `Arguments$getCharacters()` returned attribute `names` too. Removed. * `sourceDirectory()` is no longer catching warnings in `tryCatch()`, because otherwise it will interrupt the call as if the warnings were errors. # Version 0.5.2 [2005-06-27] * Added `getRelativePath()`. * Added LComments which is a VComments class with different defaults. * Made SmartComments classes and methods non-static. * Escaping double quotes in VComments messages. # Version 0.5.1 [2005-06-23] * Package passes `R CMD check` for R v2.1.0. * Added trial version of SmartComments and subclass VComments where the latter are R comments with a special format generating verbose output if source is first pre-processed by `compile()` method. If not preprocessed, they are just regular comments, adding no overhead in processing speed. I can imagine to add, say, AComments that Asserts conditions at given test points in code; when code works, just source code without pre-processing them! * Now it is possible to set the default verbose level used by all Verbose methods if not explicitly given. * Now all Verbose messages are GString:ed. This makes VComments slim. # Version 0.5.0 [2005-06-19] * Package passes `R CMD check` for R v2.1.0. * Now `commandArgs()` recognizes environment variables. * Added `attachLocally()`. * When package is loaded, `.Last()` is modified so that `onSessionExit` hooks are called when R finishes. * Added `onSessionExit()`, `finalizeSession()` and `addFinalizerToLast()`. * Added `callHooks()`. * Added the `NullVerbose()` class. * Moved (de-)capitalize() and `seqToHumanReadable()` from **R.basic** to here. * Added new GString class. * Added the Assert class. * Moved the System class from **R.lang** to this package. System was also cleaned out from several never used methods and fields. * Added `filePath()` together with file methods `isFile()`, `isDirectory()`, `isAbsolutePath()`, `mkdirs()`, `lastModified()`, and `toUrl()`. * Moved `sourceTo()` from **R.io** to this package. * Moved `doCall()` from **R.basic** to this package. * Created the Options class. * Added several methods to the Verbose class. Also added support for indentation by `enter()` and `exit()` of Verbose. * Moved the Java and Verbose class from **R.matlab** to this package. This requires that this package is on CRAN before **R.matlab** is updated. * Moved the ProgressBar and FileProgressBar from the **R.ui** package, which then becomes more or less empty. * Created. ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/MD5�����������������������������������������������������������������������������������������0000644�0001762�0000144�00000070770�14526006222�012134� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������f8d4740d80bf64aee978acda350d69ea *DESCRIPTION d6383dc737c9cc14e1c502477e9c91de *NAMESPACE 219eb33731f2c3c2bd4142787cb705c5 *NEWS.md 5b3e0291bcc049d9ada9005162c5259a *R/000.R 084f5fef1ad9ded4c99ca3a087ef0d20 *R/006.fixVarArgs.R 73362ebcfc5b9092dc96948d43c43087 *R/999.NonDocumentedObjects.R 13baed0fd191b9940300bd6397610fe9 *R/999.package.R 65a18b7c5ede979bc0fec27c31a59454 *R/Arguments.R 214814967bc916701323f8eb043de5a8 *R/Assert.R 48f811cd91497f439600d813f8301bbc *R/CmdArgsFunction.R f15a2b2aaeec5e207014fd737b949821 *R/FileListTree.R 153326b425f2fa4b2f02d2756adbd959 *R/FileProgressBar.R b81cf3f634735e6c127c37e549e790e9 *R/GString-class.R 19a31792ff0dd3da2e712b23364c8b65 *R/GenericSummary.R 26e7376bd4aedfb5a4c71f316c773697 *R/Java.R 37636532e8f5fb6cef377274bc2e0ca0 *R/LComments.R 449faac0226bdf5b65dac57c3a8bea3b *R/MultiVerbose.R 27222dd2773c26c1cef8e7c3e9d4741d *R/NullVerbose.R cae3d2e0c747316e467521185f63bd02 *R/Options.R a3c755ed5242ea85d968a0fb8c805bb4 *R/ProgressBar.R 7464eb0b64098816fb1b2eb0a401a222 *R/Settings.R 5a93d5ff881ed9d966423a56b729293c *R/SmartComments.R 0f9a1511f08523c56b29604b126a573a *R/Sys.readlink2.R decd4efb67958c472d114632aa50b408 *R/System.R fb9b7c1ded05d714f77e29361cb99c46 *R/TextStatusBar.R 981f44919568d657e6daea1861351c37 *R/TimeoutException.R ac18b3a5e1071bbbc89c5885ab3ddf4e *R/VComments.R 154455e1cd430e5ff71139c5059cbec0 *R/Verbose.R 125af8581fd3e27cc93bcb50888f5286 *R/addFinalizerToLast.R 78b974018e05d94361d47c5aa62c94ef *R/attachLocally.R 09644c2c8db98b4d0f874e3544598be7 *R/beta/Options.ui.Rtodo 35d3d8c87a0fd1f892dad747ecf4b856 *R/beta/singularPlural.Rtrial ce2dc0230be35e159edf51d3231caf34 *R/callHooks.R d9277881cb116ead1ac1ba1cef828a57 *R/capitalize.R b75522af0b2584369f9d593cbaec0547 *R/captureOutput.R 26d10ea27b278a99875862484f466d54 *R/cmdArgs.R 53d6095d8210e6a0f0626a52c2890b80 *R/colClasses.R a4b1b73f5ebefc62de2da7f19e070572 *R/commandArgs.R 16bdadeeeffa48ca49931dc243fcf09f *R/compressFile.R 28df7c4f8ecc5d646e883874cfb60b33 *R/compressPDF.R 16fa643fb616da16991ec1f3d3770269 *R/copyDirectory.R c3c01785551bc555584ed4e8c061e05f *R/copyFile.R 749804b58f650bffb671f384e74d7ede *R/countLines.R 40539abaf8821db23cae0478933170ae *R/createFileAtomically.R 8cac49df1b1fe32a0c5b38a54608b657 *R/createLink.R e1c09c0828ea97d58758e6ee94b00fc1 *R/createWindowsShortcut.R bd381c99ac3802832f8f0b75e2e7cf03 *R/dataFrame.R 317e2bbdf5e148b0d7486cc8f49b3b0f *R/density.EXTS.R 9ed2f621eeb5e8827130ef65fbc32096 *R/detachPackage.R 96686481cac450696814a007dca53c3a *R/detachPlain.R c7566b3f1b72b9cc57ceae8a3db15a88 *R/devel/doCall.R 51c2f3f9d27280388f82d49ff21277d8 *R/devel/fileSizeToHumanReadable.R 5ebed4a1a8a146b85e0f9d7d9d5f3410 *R/devel/splitUrl.R a6ef193702b4768dd8f36a34aae49b89 *R/dimNA.R 19a532b97c43b2cdd201e2db7288b120 *R/displayCode.R cca5ba24b18e56bc47522d39db959c11 *R/doCall.R 67134caf328a7b379930db20021fc655 *R/downloadFile.R f1e73c2bf2b2620753cfaf6803426e79 *R/eget.R a4157e3916f30d816c331e49a2abe435 *R/egsub.R 8eafadf361fd10de2ef53657d3487784 *R/env.R 4557f670d31dabc6245603231ef63e0a *R/extract.array.R 3abdfe77e668f081f2eb978553fc31f3 *R/fileAccess.R 3ea0666687b115840899b04cc6bf6643 *R/filePath.R 99f5f7106c07077c6c2fe2004a6e6bf1 *R/finalizeSession.R 6bf476f8487dcfcaa82d02094cb715e9 *R/findFiles.R c8c48d9785f528128d45306641ca8ce9 *R/findSourceTraceback.R eac0f6410c7569c5db8296d09b5ad406 *R/gcDLLs.R 7c2f62416d3b42c482e34909552ff937 *R/gcat.R 8278b1c2288509a3f65862145bce72f8 *R/getAbsolutePath.R 18068b0861d9cafd9f35ea6131c13b8a *R/getCommonPrefix.R 6ea0293453413f406d3083ff2998e9e0 *R/getParent.R 6a2d31b83f993aba9c76a12d7d5b7c8f *R/getPathIfEmpty.R 6448507b7e95d88ef6ad241ca8e21780 *R/getRelativePath.R eab28efaa1fb59599e5b7921e97e53bf *R/gstring.R 875e87d67fb03536a4b296185504fdd5 *R/hasUrlProtocol.R 123437a531b1bb34d95690baedd7a7c2 *R/hpaste.R eaceb526bdcc16823f19dc4bce3609ca *R/hsize.R 041de0efc388d4f0ff856dbafa844465 *R/inAnyInterval.R c00383b54909ec73b3d7ef19f2637be8 *R/insert.R 749cb381502c398b768f46666ced794d *R/installPackages.R 581406349f161ab7fb83eaa57fafbf05 *R/intToHex.R 7d59477970a5adffbda3367e121c63ba *R/intervalsToSeq.R 701cbf33a1012b52eea81acca32c3af0 *R/isAbsolutePath.R 5225089f55043f1b283b8b38ddf3afb9 *R/isDirectory.R 94e2e9558ec7ca41a0fb023a87afc8b3 *R/isEof.connection.R e2e52b80c147535a8ba0a3638720602f *R/isFile.R 075dc15dedeee0a0f06a2a52ff0b8bee *R/isOpen.character.R 4f854e74565a13302a777deead0dea30 *R/isPackageInstalled.R 45118eb74675a644648f3aaa359d44c5 *R/isPackageLoaded.R 107555122dfd85d6e32192e14fff24c7 *R/isReplicated.R 32e324595973f6c8b337669fa4058f11 *R/isSingle.R 3c53208a242d37ee74a521bce89d4348 *R/isUrl.R ad1c7b74ce8e79075ee07ab730f37db2 *R/isZero.R a09268fb3abc98d913d9972e7deb7f4a *R/lastModified.R b46c17051335fc41e376e29010a8582e *R/listDirectory.R ed753beea8d365690937ca2d27236b41 *R/loadObject.R 04553d849d3af2833b752a3a522c76a9 *R/loadToEnv.R 6f43531b4bf069e80e8fe99f0a28e95f *R/mapToIntervals.R a8a85fc5306428578d6eecbb94012a2f *R/mergeByCommonTails.R 4b47f6b15cd82115841a6eefb6f2e1a3 *R/mergeIntervals.R 846be973f6273e6bcf72ff1912367c88 *R/mkdirs.R e23fb020223a8bb1c8fb169a2a776155 *R/mout.R 4a5f28178327218c1937c105d6a4c4eb *R/moveInSearchPath.R de63bbbc15eed57f20cfc3a2dcb4b604 *R/mpager.R 85b33b04073e28baee5dbbbe5e135219 *R/nullfile.R f14d69f7134be46ca47df78bd9fb035f *R/onGarbageCollect.R c5abd013ab2c8ddb793db393a6099518 *R/onSessionExit.R 2ecd60f46aff984fd422991494d5390e *R/parseArgs.R f6458414c964b3a6e4acab5cd39a20bc *R/patchCode.R 81b5f6675c183e8ceb80884b10747340 *R/popBackupFile.R fb11ea7fa7dc1bfd8c6d6e157a17a7d5 *R/popTemporaryFile.R ce159c9746f2555883987a65b84c719e *R/printf.R 2d439b549feb601b97c4fa8206adce6a *R/pushBackupFile.R 6f87bfe10e607fb6b1f2ab25f2e6b772 *R/pushTemporaryFile.R a7187a3089cbf1f9ab7e0e1029e2bbe0 *R/queryRCmdCheck.R 206e8f6a528ae9dfe77177adf381bb32 *R/readBinFragments.R 619b4a9cc048617d416fc5d40948cebb *R/readRdHelp.R a7563d34c4be027ac6d2fe6a6c25b2fa *R/readTable.R 770edf2c95aba989dc3152d83213cf12 *R/readTableIndex.R 7eada7626f87a1f0caecdc79c8e29640 *R/readWindowsShellLink.R ebc583dc1ab5f9b59c182db3b7a575f7 *R/readWindowsShortcut.R e6007aa7e9b12c600b46c898725e9f5e *R/reassignInPackage.R 43dd2e37b935388354748625dfa0abaa *R/removeDirectory.R 47580f4d5bccf89ba428f61e7d2ca7c9 *R/renameFile.R a977334bbf5a0697d00dd284a04eece2 *R/resample.R 82d724d3b47c92db3776d7852f880de6 *R/saveObject.R 3d72eab62f14cbf6c6812d662315d466 *R/seqToHumanReadable.R fab1752663a9e459353b84cb53e04899 *R/seqToIntervals.R 15a7e7cf7ea977fe07a78568b4bbd2c2 *R/setOption.R 038e08a1016199ea634c29decc23ff7a *R/shell.exec2.R fe2ea7f51ff1ecbd0d37e5c1317bd46b *R/sourceDirectory.R 2a6e446bf508be557bb66155d2e73035 *R/sourceTo.R 273eef6742421d5cf3d72339b9a75985 *R/splitByCommonTails.R 7a756731208f880746d4ff2deba0282b *R/splitByPattern.R 14d0af09e0c8f5f28ea598c5ae95d667 *R/stext.R d5f1644530528a8306945639798d1c0a *R/subplots.R 40579e6fb388cc4e8a57a79d4c016a30 *R/systemR.R 986a0f64600503e293a48d1dfd42f40d *R/tempvar.R 320efe5a2131d26585e245ade9439c14 *R/tmpfile.R 959ab5030d750e2311f558c92fa32483 *R/toAsciiRegExprPattern.R 35d2d93e4fb11f0c02c4c05a7cc807a3 *R/toCamelCase.R 697f76853818ad544eb789c2a07f83d7 *R/toUrl.R b650347bcbc9b83bb56152cfbfa09afa *R/touchFile.R 3f6051c1b61db0d840e6c637904bc7d0 *R/unwrap.array.R 4f3c7b9f5b7ec4e6659512eba2c7ea9b *R/use.R dc910054ec0e3f6bba4e36a114b625d0 *R/useRepos.R 5d70959a9e051a5666c0524ad97022d9 *R/utils.R 5fc530e624bb558f7df5ceeb27bb6c2e *R/whichVector.R b2649ce1f6324b1fa48be66928379e55 *R/withCapture.R 9e99926bf9c32812d7840fe24185a55c *R/withLocale.R 12bb56f357bee89fb75f1a8d87eaf19b *R/withOptions.R 1eaa04562a09fb5d1898a60c7cb051fe *R/withRepos.R 3ffd91dac1773a4ffd193c0f30da6f20 *R/withSeed.R c72ff0d9ad024d1c24a9140ccd5fa3d2 *R/withSink.R 85fabce9d68e5e3dea492498cf17065d *R/withTimeout.R 0caa0b615bd896ef3288a35b5cc1dbac *R/wrap.array.R 6d12cc8e1df282f9cd92ac874ede60b6 *R/writeBinFragments.R 59252ec83a39398928add900e7a06d6d *R/writeDataFrame.R 3c03482e0fa0885d982ead6e7fd6da9e *R/zzz.R 094a0a9397437ce080424faaea209af4 *inst/WORDLIST 97b23af5ae2ec44f41b1340c85efccf6 *inst/data-ex/HISTORY.LNK 637b485d438f840b23761205cd3963ac *inst/data-ex/NEWS.LNK 7f850ac9c29ed473c440080f9ab26f44 *inst/data-ex/exampleVComments.R 7d30d107dbcee8a415ba69362f2eae9b *inst/data-ex/lnkFileWith10BitsInFlag.lnk b377942643fcf93832012078e9857c21 *man/000.Last.lib.Rd 080fe850b9cf4c5b29e4aa589dc68a1f *man/Arguments.Rd f820c685d925eea3c4f939e7f681aee9 *man/Assert.Rd db9f59dbcdbe3b7d647e4905f7213dea *man/FileProgressBar.Rd 2e15778799a5e596ce5d8529e8990bc0 *man/GString-class.Rd 2db16df8bce3503a48e447286f0edc34 *man/Java.Rd 39061a29de8384d08f0c7033dd8e61bd *man/LComments.Rd 4f06e7024f450d64ec46ca2de7a4b25c *man/MultiVerbose.Rd 5981e8ae741933d2e5c7f9e8a9c2e2fc *man/Non-documented_objects.Rd 260fc2df465c1e8126b4527b7a57af0d *man/NullVerbose.Rd de827a98f7954836a8ba48a283242746 *man/Options.Rd 2c8d404cebdf6d35e7923f831ae2fc23 *man/ProgressBar.Rd 2f4dd517f23bdbbca789d699a3b5e383 *man/R.utils-package.Rd 398e238652eb9fcc97e2856cfcdfeb64 *man/Settings.Rd 01ad358b17e431bd902313727657d02c *man/SmartComments.Rd 38364aa41846fbd022617a7f93786b5a *man/Sys.readlink2.Rd b25340f8fd0fd2ff5cca17a81b48c88e *man/System.Rd 678f0539315d1a2588051590eed0ab4d *man/TextStatusBar.Rd 0d9728ff9d3c9c4dea3f83985b30dc17 *man/TimeoutException.Rd aab638d49c239c01b203d66043a802d6 *man/VComments.Rd f403d976081886c33214326049fa405c *man/Verbose.Rd c366c029b7c251644fcf76d5821a535b *man/addFinalizerToLast.Rd 781576574d1a10e529cce2d3fac68ec7 *man/as.character.GString.Rd dfa29f5299da734576c2b9ef81322646 *man/as.character.Options.Rd a1dfac301e5392c6bf76a2ca63f460ed *man/as.character.ProgressBar.Rd 4e58c75b8e908562aaea2bae326eb920 *man/as.character.Verbose.Rd 1ee83d26a7bfef402e8772bb5f5ee5d1 *man/as.double.Verbose.Rd 4274a2ee6e785c512d9af83566694ff6 *man/as.list.MultiVerbose.Rd 4393d45c6ee5267b1a91d60c67a4cea1 *man/as.list.Options.Rd 7964c30b7d09751d2cc671c17d6c4a3c *man/as.logical.Verbose.Rd 6d32bb23b82b377848e7f2448e7a7210 *man/asByte.Java.Rd 215ff4fda907e057b26582ff72c063eb *man/asInt.Java.Rd c9fe99e2f0b04f2c436f871075964248 *man/asLong.Java.Rd 182e3248144d77b4ffdcf72aea4f0d64 *man/asShort.Java.Rd cafb41d6b5bd08b67d86c9a37ad24853 *man/attachLocally.list.Rd a9fefc8b9f34904edeaec40eb2b27fa5 *man/callHooks.Rd 3e8bc7981f430452d1a4b6d07f8ec80a *man/callHooks.function.Rd faf3d7dc565e0a56a70dc6978675069f *man/capitalize.Rd f63777d4a9c4639fe9f12141fca937d6 *man/capture.Verbose.Rd 2f6bd65823e89421f6a24a1396aaec7c *man/captureOutput.Rd a90c9bbbbff09d258ac0e8600807f23b *man/cat.Verbose.Rd da825fef5a0d8745e1dbcf2893c86e3e *man/check.Assert.Rd b92b029744a6c44f2b7d2adca74ef495 *man/cleanup.FileProgressBar.Rd f31acaefc8030e38057f4e0026fdd36e *man/cmdArgs.Rd 883e8d84d743cad7893a806b92662c39 *man/cmdArgsCall.Rd 2b685382ce094ecf0b8389638c364684 *man/colClasses.Rd 0a17f2ba8d4d29fcc9569343f89622e7 *man/commandArgs.Rd 38a9c7776a64d4b1984222b57fe8237e *man/compile.SmartComments.Rd 122973a5f256429b6099ce9a139b7cd0 *man/compressFile.Rd b242af88983f5705acf5c4dc1986da00 *man/compressPDF.Rd a11749b463ff39b65939fb934bdd96c0 *man/convertComment.SmartComments.Rd 9e3d14b2f1f94b72ccceddf2e83361cb *man/convertComment.VComments.Rd 6fa5739f6a4b4502eb3c6f4f6b7d305b *man/copyDirectory.Rd ac6b4a8d1954673f2874c7ba507e4c34 *man/copyFile.Rd 0a4a82d6ed1059a45fd85ef5a15ee122 *man/countLines.Rd 8bb1f0264769bed8417fcce10097c0ea *man/createFileAtomically.Rd 2f2306140da5b22602af2c06dfff1d3f *man/createLink.Rd acdb0dbeb90e782b0e6ef13f97e10f83 *man/createWindowsShortcut.Rd 83b9900df8b6bf057c8df692f24f6b81 *man/currentTimeMillis.System.Rd 1082a6007c60ecb1e12fd64af572dcde *man/dataFrame.Rd ebb3459c1bd2d09df97bdf23f2f27444 *man/detachPackage.Rd 94f79f25d04f764cda701f5951be87b3 *man/dimNALT_-.Rd 01f0f6de8ad32da8744d1e19277a469b *man/displayCode.Rd 12a7994a98574f7a76c2bc6cbe98f854 *man/doCall.Rd f683236346b5781d75da4abef06d9684 *man/downloadFile.character.Rd 177c72dc6378d1eced3f9931c2e0a01b *man/draw.density.Rd 245dcf814d588bb29c9da516b4442fe4 *man/eget.Rd c690b529e0c7c071f30626366daf8c1d *man/egsub.Rd 038e4fc5fba4a515bc16fa41b287fbf5 *man/enter.Verbose.Rd 47d99d391499634f47ce1c4ee09921d6 *man/env.Rd eeb87a74fff7beeea276ecd25dd13826 *man/equals.Options.Rd 8cf1adae1b79e16d4251cf0b630be07e *man/equals.Verbose.Rd a20873e3799b53f3bb03ad9cc5c18933 *man/evaluate.GString.Rd 5ba3182528aa26cc78e5d186ece2c401 *man/evaluate.Verbose.Rd a27608db1b994303687d7cfe9f42178c *man/exit.Verbose.Rd 71205565a290410adae12a3382feb4f7 *man/extract.array.Rd ab73bbf146cf6162f26542c99ceef785 *man/file.info2.Rd 20c1013de001a7547e264d7681d7c51d *man/fileAccess.Rd e419c7b2cd6376d54c6e4a42eff2b1d6 *man/filePath.Rd c296c9f5490cc0d0b1bcf0656e24dd71 *man/finalizeSession.Rd ff97dd68d72e9cb6374be778cac155d9 *man/findFiles.Rd 5c44b2969d5f9ccabc57ea559308c46c *man/findGhostscript.System.Rd 610620750f480d6c1496e0720c02a87b *man/findGraphicsDevice.System.Rd d53cb36d56dc8042605e707be691ddf4 *man/findSettings.Settings.Rd 00493d5ee4250772e9711661720afcf1 *man/findSourceTraceback.Rd 5ff260dbc288c4821c477c5eb26d6c93 *man/flush.TextStatusBar.Rd 4b0f98b737dd366dc0ee2ce1a881de1c *man/format.binmode.Rd 97be4fd348881a4ddc87223df907813f *man/gcDLLs.Rd e52ee90006b99a0c4dabc90300974b30 *man/gcat.Rd afd5299bc4c69c3b8aada2ab0d846ea6 *man/getAbsolutePath.Rd 957b30ec9f988eb20cc249c12268d7ab *man/getBarString.ProgressBar.Rd 6fc08095b679b1f7fddb18abd524ea6a *man/getBuiltinDate.GString.Rd 4e060c9497225f189ad8ed4572b6abf7 *man/getBuiltinDatetime.GString.Rd 4487a16c6c9b6eec64a96072c2aa0930 *man/getBuiltinHostname.GString.Rd e0b35b67cb0f6e9ecc6133452f69e26c *man/getBuiltinOs.GString.Rd ff5f683695d7f5692f2a6cb58478d303 *man/getBuiltinPid.GString.Rd da9190b9ab19f830e9154c45413f4e2c *man/getBuiltinRhome.GString.Rd 0a21bdf201df08aa44dbdd2b9d4f3fe0 *man/getBuiltinRversion.GString.Rd 8dbb1e035c67b4ceee857079f8b18e53 *man/getBuiltinTime.GString.Rd 9c23c120e5c69ee759d97b043b2de913 *man/getBuiltinUsername.GString.Rd 4ef52cebc6d483f40784744e3620abe6 *man/getCharacters.Arguments.Rd 7be1a62b4b7ab039d49c6b343cd11259 *man/getDoubles.Arguments.Rd 5510c638a9e9f0d07f317e126176b279 *man/getEnvironment.Arguments.Rd 43ae5a6a534888f522106984abcbea06 *man/getFilename.Arguments.Rd f6b8fcd1a30c80d2fccfc0b9f2b36054 *man/getHostname.System.Rd 5a3eb7a493787441c55f10e8d5fa1aa1 *man/getIndices.Arguments.Rd 4eb6cf1d7b0893117c594a9618bc4a43 *man/getInstanceOf.Arguments.Rd b950a7ad29be07a2837dd92474f61def *man/getIntegers.Arguments.Rd f65f5d6b92ffff17409d9bf3cccf59bd *man/getLabel.TextStatusBar.Rd cb562c5b4755f3c65679f4cb245fc890 *man/getLeaves.Options.Rd e91a512853a0b792bbe772cfc01af09a *man/getLoadedPathname.Settings.Rd 02dca95ca1f3ca42e02579407895ed20 *man/getLogicals.Arguments.Rd 3cd40acc6a31820cb0aa8e23b4ffd1f7 *man/getMessage.TimeoutException.Rd 4123100936f54b24cc3bda402db06ff9 *man/getNumerics.Arguments.Rd d1d770d72489014cd2a1441c266ee49c *man/getOption.Options.Rd 335d84ae38efc6364cca908e038ed3a5 *man/getParent.Rd 388a20be290853e7316427dad5d4b586 *man/getRaw.GString.Rd 784998f427c6a21bf11ced9d78cf6c0d *man/getReadablePathname.Arguments.Rd 7578fa85bbefb13a190f3f1196cb989f *man/getReadablePathnames.Arguments.Rd 8c603cf36d74d051e62b14910985fced *man/getRegularExpression.Arguments.Rd 05560ea9ddd67a27f2a93e94c0867961 *man/getRelativePath.Rd afe52ba398c9b89274f428fbd7d8adf0 *man/getThreshold.Verbose.Rd 7df836d6501234bdc7e42fc28538fc52 *man/getTimestampFormat.Verbose.Rd bc3a11c2f870628334cd36877abc9b9f *man/getUsername.System.Rd aee6c7f3cb24d58bed97fafcac867eb3 *man/getVariableValue.GString.Rd 874d24e49a87f43e7638c03e71ecddd7 *man/getVector.Arguments.Rd 8b28e4762fa8e716a3586415718dd71a *man/getVerbose.Arguments.Rd 393751479a9730b648310de92fc30c3b *man/getWritablePathname.Arguments.Rd 51d08c0701ca4a098578709a5d04ba35 *man/gstring.Rd ced5ccc7810e1e28b75b61432c21f9cb *man/hasOption.Options.Rd 0ebe206fe5f3eed5f5705ff720dd9b8f *man/hasUrlProtocol.Rd 89cb323104457dc5ebbb1e88334042e8 *man/header.Verbose.Rd ff57ba59e2cd55fdea19bc261c9a5d8c *man/hpaste.Rd 4cb7e8e78b926cab7f3851a677532bdb *man/hsize.Rd 9fc50ea17695945758e45496021d1ee9 *man/inAnyInterval.numeric.Rd 2e0833a62210f83c068eb4c87b943ae3 *man/increase.ProgressBar.Rd 88f30547adf67f36c603768c05964c8a *man/inheritsFrom.Assert.Rd 4d15f9a8ba58aadcfdad0d7fbbcc45ea *man/insert.Rd 2c81c1bf81c1d24a1d896f5b742ce7d0 *man/installPackages.Rd c6c908d26b9ea08d68f09f8c30a5631a *man/intToBin.Rd f8b69a0a4afa099b1ff0d7890c1c6745 *man/intervalsToSeq.matrix.Rd de0d54f119c661059750a615283dd60a *man/isAbsolutePath.Rd 8ed02e65889d3ae432bed7b400085bf4 *man/isDirectory.Rd 11a67bdd46e3b6c5cb9e200d1fa53626 *man/isDone.ProgressBar.Rd ec4a0fb8421d795eab0e60213042fbb1 *man/isEof.connection.Rd d043f1004e392fe97e17b41ab243adcd *man/isFile.Rd 4d3d032906625e942c148d88755d6b7e *man/isMatrix.Assert.Rd aa9b98c472e10dbd372121cafecf281a *man/isModified.Settings.Rd c9fe74525a06b1fe42701402756ea2cb *man/isOn.NullVerbose.Rd 3f6e33a616d4c4d9c680c8a28ee5ba6e *man/isOn.Verbose.Rd 282a02e81c24f0df950b55a1d2ca89cd *man/isOpen.character.Rd fd07008f20f2068c0b1b085a405c62c1 *man/isPackageInstalled.Rd 85c02449e8e99dd399806c16d8c51208 *man/isPackageLoaded.Rd 67aeaaf34b378fd8d3fdf50fcd58e0cd *man/isReplicated.Rd 3e8cdf524b9dd771a571eec35d39027e *man/isScalar.Assert.Rd 399378239c303326b4e1de6218736ebd *man/isSingle.Rd 8d64987abac7766467bb6186a3ee4fb9 *man/isUrl.Rd f5187ac96be3d27e47da87eedef46b2d *man/isVector.Assert.Rd 65c3880ef2f554d4a6088a53bc7d08d9 *man/isVisible.NullVerbose.Rd 7a5875b748451a418b080ea99bed1861 *man/isVisible.Verbose.Rd 7a4b2c37f16e7e9349a9c20379d238a8 *man/isZero.Rd 219befe52eb5c466eb18d674ecb0e26a *man/lastModified.Rd a636c3ab5dee6ee62da4033155a7855b *man/less.Verbose.Rd cab3ca0a0527d00f83c86b314c3e4924 *man/listDirectory.Rd 3134ae47e6d8b5d7fe4f8b60a1f1e2f1 *man/loadAnywhere.Settings.Rd a563155223e05773868bc955bcf0aab3 *man/loadObject.Rd a5ecc8c98689d1d13cc56f9408fb8933 *man/loadToEnv.Rd 16b058342778268b827c236a61af333f *man/mapToIntervals.numeric.Rd 6e51be00789219f57bfdeb217240c3a4 *man/mergeIntervals.numeric.Rd 2803885c3cb4a9f56131f66e3b69f6a0 *man/mkdirs.Rd f4008a5b6dce38af6903fe52f1ff74ec *man/more.Verbose.Rd c1014affeee4ad34e39d6eded4ccde83 *man/mout.Rd f091ff97f2e4dfc07975fe14cf3014ca *man/moveInSearchPath.Rd 68b9444a3cb16a16910fe04ec249a7a5 *man/mpager.Rd 98771530ab6540200b87e03c0861d6c4 *man/names.Options.Rd 861f03d04270f6f7d5043e25eb061284 *man/nbrOfOptions.Options.Rd 9c62d7ad633f32bf453755c0538ad7d0 *man/newline.TextStatusBar.Rd 84b15a62b961682198e9fcf2b2f861fb *man/newline.Verbose.Rd 1a10accf545b5a261be1ce6aaf747427 *man/nullfile.Rd 9251ce2e7651c50a875791da883db340 *man/off.Verbose.Rd 19e5fcda8159fa72aa7304551482d783 *man/on.Verbose.Rd b703af8ae44946e21c3ce4f225ecaa31 *man/onGarbageCollect.Rd c0daadba672edd075b1b6e196c20785e *man/onSessionExit.Rd 3e71219a6db65ed42c7f460122a3826a *man/openBrowser.System.Rd fc882b8b7ae43186dec07f5134ecf298 *man/parse.GString.Rd 535acd818049fd29c49695e06466e55a *man/parse.SmartComments.Rd e83a5b82bb71efd55a4ff3daa54d7cba *man/parseDebian.System.Rd 4e2513c3f2da9604731357907ed7c414 *man/patchCode.Rd b27ef8f1604680ad4600acad99062b11 *man/popBackupFile.Rd 643c2d8e85e6079420ae5a56a89d8a26 *man/popMessage.TextStatusBar.Rd c326c2cb8b456e2dc1f3d78fa9273c49 *man/popTemporaryFile.Rd 3bc70e67b86d9ab7706bb782865e8b89 *man/print.GString.Rd 1f988953661ddff98cdf8182de60a0d2 *man/print.Verbose.Rd f6584c22217f8136f6a3642ece07aca8 *man/printWarnings.Verbose.Rd 4f36d70952c274155e04a52f43333bbb *man/printf.Rd 0c009dc50256193bc9933e41f07a357b *man/printf.Verbose.Rd 00380954458e78a9e45245e19befcb0e *man/promptAndSave.Settings.Rd 97ab76726c1a3a29b185b9c11eb8fd77 *man/pushBackupFile.Rd 1d643fe2fb5412f03573fbf46be5d231 *man/pushState.Verbose.Rd 7620913ed1fdd12c5e100ca82faf71e9 *man/pushTemporaryFile.Rd e92e82115a9ea42d7c39330f0ae8e177 *man/queryRCmdCheck.Rd 32a5c8a51f73e6e8b7a2fd4efdd2cb81 *man/readBinFragments.Rd fb8615ebc5cbcef7df9ba58fd8278940 *man/readByte.Java.Rd 7a6205f626adf8551eae3febb17ca9e1 *man/readInt.Java.Rd a238fcea6b6984892277ccfd267fdae1 *man/readRdHelp.Rd 2bde2b32a78f3b70bd441d416ec41421 *man/readShort.Java.Rd 1e7f53b458f5d83e600cd6e8bc7fb674 *man/readTable.Rd 616b3b4e800a2383822903a6aa54ecc0 *man/readTableIndex.Rd 287e4c3c098dbf34d81b98437e0ac414 *man/readUTF.Java.Rd c1697fab420f61ab76ebb0b0ea6498e9 *man/readWindowsShellLink.Rd 23a5089bda7e40b2a4ed4761b6f285c4 *man/readWindowsShortcut.Rd ebd21fc2fb6116d71ab01caf5940a058 *man/reassignInPackage.Rd 71a202f543a77dd1aa0e84ecd1a0f59d *man/removeDirectory.Rd e2c2ce24eb2acbcd971bc3647d11516b *man/renameFile.Rd 958c68a482b02a3bc8d5a59374a0b80a *man/resample.Rd 3c8d4e1214fd5dddef8c342eaa58a60f *man/reset.ProgressBar.Rd d80126be1bc6e376c5543791820a2fa1 *man/reset.SmartComments.Rd 16b9964094c3f54d597a5d9b6822cf76 *man/reset.VComments.Rd 0fa36a3c310a30c270662fd800e8d686 *man/ruler.Verbose.Rd 32b67ffec940167e9a009ac5b5b1910d *man/saveAnywhere.Settings.Rd 967d6334450f49dd665202315a98d505 *man/saveObject.Rd 0f4c61017b052bc8febf37219aa41ea1 *man/seqToHumanReadable.Rd 2e7384d88d9b4703501c268129254a06 *man/seqToIntervals.Rd afbf27e4b0684ff74b468ffbd18e1f96 *man/setDefaultLevel.Verbose.Rd 5d563f3140461152350493094dd21624 *man/setLabel.TextStatusBar.Rd 0676637c064cbe7a0b20d4f02de967e3 *man/setLabels.TextStatusBar.Rd 4fd7aaa89a3d61dbe5b5d202543871bb *man/setMaxValue.ProgressBar.Rd 2a8503c2f381809d3de63a4a3ad87ef4 *man/setOption.Options.Rd f4541c1dc5f58299d333d4e0f623f7b5 *man/setOption.Rd 7f8a3ae54fbc02bea0cf1fcfc80d44ae *man/setProgress.ProgressBar.Rd ea957410cbc7cf0c1aeda6c527cc7e78 *man/setStepLength.ProgressBar.Rd 78f10268f2e7313a3a0ecd6f7da6e22e *man/setThreshold.Verbose.Rd 4bc859d15df948bfdf27b9cb4d22b598 *man/setTicks.ProgressBar.Rd 98146ae96fd66418a9ea75ad949a386c *man/setTimestampFormat.Verbose.Rd 63b9612bb5b281427c66b167515777c9 *man/setValue.ProgressBar.Rd 3887c4b2d7a14286253f6be288d6e121 *man/shell.exec2.Rd d5188ff0eaa4bd2c8cc2b82b124c8418 *man/sourceDirectory.Rd 3b8ea70f4ff4e9cfa551776e3ce87397 *man/sourceTo.Rd a1e0c2bb204f7bb4a4ef6eee47067bec *man/splitByPattern.Rd 5924ec0a3d8ec2c03ddfd24181056cc2 *man/stext.Rd 6dfb4e5fe2981eafef4356e4be593adc *man/str.Options.Rd 7b6ce9844132f32aa62b142208387186 *man/str.Verbose.Rd 9e683d8ab0a7521ac0c14d24e9eadb2d *man/subplots.Rd 88942082c8f2c9bd3b08d27fe8f9bfa7 *man/summary.Verbose.Rd 68387c8fd4e494a9bf05a1c8c566ec2f *man/swapXY.density.Rd fe105e4f6d7798730e5b2e14119fa5a1 *man/systemR.Rd a3b2edc9498a2cd51e3750696bd492b7 *man/tempvar.Rd b47bc90e93ae475b8d5e82fb3da74cc5 *man/timestamp.Verbose.Rd b5611c8ba9f6d3a20e3890fd6a708fad *man/timestampOn.Verbose.Rd bf20f527399595dd701853cd15b99ac6 *man/tmpfile.Rd 021c30352aceabeeaae310e7eaeada89 *man/toCamelCase.Rd 28f3dd0baa84676a67404b6ecbb89c04 *man/toUrl.Rd b1e41b5092d91a8972620495f05ff864 *man/touchFile.Rd 5f751883342f5b0b3595e7e5fa230dbc *man/unwrap.array.Rd 433b24e2cf936368a1b94f06c920a9a6 *man/update.FileProgressBar.Rd ff458aa7f19ecf86a06640230be8909f *man/update.ProgressBar.Rd 71a78c510f478eb6733d3e71e8f37692 *man/update.TextStatusBar.Rd ec2ffdd6f3e8b1a0021cd982a6be0da2 *man/updateLabels.TextStatusBar.Rd a360b8982948dd1f60310210ac604414 *man/use.Rd d2cc11a3f15df972e4efedc16692cc92 *man/useRepos.Rd ff26588b099baf948ca5ca87dd7518ab *man/validate.SmartComments.Rd 6af991e15355e4853892834bfcf8e192 *man/validate.VComments.Rd 84c5b1157dd561a87500672f3eb8507c *man/whichVector.logical.Rd dfa0eaf257073c077e8d69127bf33b77 *man/withCapture.Rd 5cfc890f51bf3fe3bbdf6aca06578ee8 *man/withLocale.Rd cfac4c6bb8b67b623ce487e1b5e7b5fc *man/withOptions.Rd 044754db05680d00f554eaf04ddb6105 *man/withRepos.Rd 71c7d5dfa0e6afc0a7f24695511feb37 *man/withSeed.Rd 2f1c064fbdb63579f8923b01047f56a7 *man/withSink.Rd e9c952880eb1f983746674c618162984 *man/withTimeout.Rd 10da0eab23112b2cd3506aae370c0c2c *man/wrap.array.Rd e748a256e5c8fd1154b5547d3f4672d0 *man/writeBinFragments.Rd 937af8b9679438990e355f6d2e18c8cf *man/writeByte.Java.Rd 084225ec04e65c16b45186a6aec0ed73 *man/writeDataFrame.data.frame.Rd 4d98cbdf19edc3965fa285a17e706080 *man/writeInt.Java.Rd 1d3fb4b404549b7e1de00bd0986b472a *man/writeRaw.MultiVerbose.Rd 717671ab5520db4d75063b4d1756558f *man/writeRaw.NullVerbose.Rd 7be53d4e9e258f90c9dad951c3d85e2b *man/writeRaw.Verbose.Rd 8bea6a3c00fa7b8905580a8fcc45f44b *man/writeShort.Java.Rd bfa88b9488b31ffa53aaad33858f725e *man/writeUTF.Java.Rd e0c0c3409dd64aa0cdbda485386f8c0c *tests/Arguments-FILES.R 3abe6f9d16044d4ac93ee989c1942743 *tests/FileProgressBar.R e99b92e5479f5157600ac40975c5d09c *tests/GString.R 727adaa0df33a2bd528fe401d4ee81e1 *tests/Java.R 2ee06e2e4bba653b5746fd85ae79c3a8 *tests/MultiVerbose.R aee20372d95dd57cc4270ac176aaaad5 *tests/NullVerbose.R d13b407a5435b94399da227917296d67 *tests/Options.R 3726553f767ea5868fbe7d89bcd5988c *tests/ProgressBar.R 9f2c0635644adc91d584c4c05944b86f *tests/Settings.R 4ae7ac9fcf19676f15d0e990a4a6bef5 *tests/System.R 73b0565d0ce616408491ff79f754a685 *tests/TextStatusBar.R 5cb624febf4f541cf4fb8ae9e662dcda *tests/VComments.R 3028c3f435992168f227bebfb969dfad *tests/Verbose.R b57d6175e2db21d2289bc64b23f1418e *tests/absolute-relative-paths.R f4a00f773932cdd5ca4ab087bd331245 *tests/attachLocally.R 8ee8169f726d80f9d5f152220a2e8ce9 *tests/callHooks.R a747624373f822ac7ef99e4dfeb0d105 *tests/capitalize.R c998fbcc4d2aec9f16f1a0c3ad6a7244 *tests/captureOutput.R affe26a37b2cf68fda15ab98b0e93437 *tests/cmdArgs.R cff2de3251b2b7fc3002c5c996e136be *tests/colClasses.R 5397035a68c803d08b25ea84da0a5dee *tests/commandArgs.R dbe219586657a4b1fdf9a9773513c7b2 *tests/compressFile.R 3f9ba2723c36524813de51e06f5d1571 *tests/compressPDF.R 9622d38ede285a5dc5eccd4340a8700d *tests/copyRenameFile.R b2a952d5e9c6414b845916909466dcd1 *tests/countLines.R 33e6eb4740978544ab317db8a01c0185 *tests/cout.R e2e15cd59b070b67cdf1fdb81488f47c *tests/createFileAtomically.R 5309be77da0e537e22dbbeb6c36515b3 *tests/createLink.R c3a0573d7355d4001c1d12c75f1b8eb7 *tests/dataFrame.R 045373e11d83a8beefbd99d1bba342aa *tests/dimNA.R f1426919ae7e4a45d8288a65b0b4a07d *tests/displayCode.R 5f0c6f143d242f1fd2c0efcdc75e993e *tests/doCall.R 3705f5c3ca3f261d7058df65bf24c952 *tests/eget.R 99523adcaea700e56b3e274b9eb4ba34 *tests/egsub.R 7d667e96e14b81282aed8bd7547ec01b *tests/env.R b963293a22eb9eb98c0e024310403e19 *tests/extract.array.R d7afe1d65d5836c66c44d598ff912ea0 *tests/fileAccess.R 66ee03a7703081dfaf9ff688313a377a *tests/filePath.R f2cf49873a6138acc58e57119730042f *tests/findFiles.R 0314b27a216d7fa49a609987550f6e89 *tests/findSourceTraceback.R ae291e4a8ccaca5bbfe9ae9151cee1cb *tests/gcDLLs.R 7316ba0e18d969e1b96670a35bcd6c96 *tests/gcat.R e0c08f51d22240b1997972ca0e694f78 *tests/getOption.R 748b1fa844820112d8ce3069569ec2ec *tests/getParent.R d34745a8c6e9d4cf779e442bbfc036ea *tests/hpaste.R 70cbff8412721cce5d1703388eb5f4ce *tests/insert.R 7ab249c5082fcee89795aa69a9d4942d *tests/intToHex.R 8e30d7476c7b3d5d9b3fd71fff8b6f3a *tests/isPackageLoaded.R f917873152716fc629ac2191a0d4f13d *tests/isReplicated.R df6848e2c00461c1937db1bb1a8640c5 *tests/isUrl.R 578176f80e651163f9ccaec2cf7ff2c1 *tests/isZero.R 23c87e748cff781bb26a63e9aeca5eda *tests/listDirectory.R 7da952a9e82bba3d0b017294316d043e *tests/loadObject.R b3cf5d5157121387d849cc28fd3fa644 *tests/loadToEnv.R d3b66d5438125c325be258f703db4e1a *tests/mkdirs.R 9ed41150019a9a4bd23b1519e101d87f *tests/mout.R 9aa7f3ff98259d90f9668fe76d1e2bb5 *tests/mpager.R ef8863916e34245ff9a74e08f84a6e57 *tests/nullfile.R 94b0c66364a8ed939bc3de70abc10c21 *tests/parseRepos.R 890d16f09fdd963cb642d71809341cbb *tests/pushBackupFile.R cb61dec46188558db99c7ec419682e14 *tests/pushTemporaryFile.R 66bbcb92a015242a219fda91d0269ff5 *tests/queryRCmdCheck.R 52fa9427e9c1fc2efbbe889617033bcd *tests/readBinFragments.R b042e5513403949714028e00e777d027 *tests/readWindowsShellLink.R e81abde49e1ce611d5ab5a8f3a74694a *tests/readWindowsShortcut.R ea11b5ab54c78497ee33aa298a9db0e7 *tests/resample.R 05c19c6183fc703542262fd6fdde5304 *tests/seqToHumanReadable.R dd556e486d0616df82b70d60c151c0d9 *tests/seqToIntervals.R ec6464e16b2c025205997c1415302f92 *tests/sourceDirectory.R 49fcec14b8a6aeae1e5aedbeccc52da7 *tests/sourceTo.R bbf0c7d1ba45fd93f3a6493a0c0bd44b *tests/splitByPattern.R 4eac4d6b9327308c782e0ea0878dc08a *tests/subplots.R bdd86d58ecf5017c477ba4047008c32e *tests/symlinks,dirs.R feb305c9f506888267f1241dd27e70fb *tests/symlinks,files.R 2e205ff4db55b6a4e6a146cedadc71a3 *tests/systemR.R fef92152fdeadf9f1546696b2e6152ae *tests/tempvar.R e069d9d0afbf1988d8f99d092ba5fbe9 *tests/tmpfile.R 812e8686ddfe343629873162d3ded8ae *tests/toCamelCase.R 600a095475e6d4ca326fd0c2b4fa858f *tests/touchFile.R fee35af25a4071d25865343b6c2e3bce *tests/use.R 3b31277725c97bc3d57491a7ea990f0e *tests/useRepos.R 2958c72c21b285b370aabc0258a008c4 *tests/whichVector.R b9c174f31723e22da9c82f95448537f2 *tests/withCapture.R ed0c9f673fbd73d7c17a2bc0fb578b7b *tests/withLocale.R e010e122955a78dde55795f875b7a5e3 *tests/withOptions.R 0b5aadcaa780f666429520045fcf2602 *tests/withRepos.R 7bf388f9e7d268b5aec36e90cb182225 *tests/withSeed.R 777ac19bf7bcb0029d73aa110e14aaaa *tests/withSink.R 8a8b154f0735635b20593cd8c6f8b44b *tests/withTimeout.R e8f3a0700bf2a7ab6d52e70559032312 *tests/wrap.array.R 21b9f51280af498f487603743dd28899 *tests/writeDataFrame.R 84ed613188920118b43ffce5cf1432e6 *tests/zzz_finalizer_crash.R ��������R.utils/inst/���������������������������������������������������������������������������������������0000755�0001762�0000144�00000000000�14372747611�012603� 5����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/inst/data-ex/�������������������������������������������������������������������������������0000755�0001762�0000144�00000000000�14372747611�014126� 5����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/inst/data-ex/exampleVComments.R�������������������������������������������������������������0000644�0001762�0000144�00000001731�14372747611�017542� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#V1# threshold=-1 foo <- function(label="A") { #V!# #V+# Entering foo(${label}) #V+# Analysis ${label} for (kk in 1:10) { #Vc# step ${kk} @ [${time}] if (kk == 4) { #Vc# Turning OFF verbose messages #Vm# on } else if (kk == 6) { #Vm# off #Vc# Turned ON verbose messages } if (kk %in% c(5,8)) { #V+# Sub analysis ${kk} for (jj in c("i", "ii", "iii")) { #Vc# part ${jj} } #V-# } } #Vc# All steps completed! #Vc# Returning without explicitly exiting verbose levels } # foo() #### - - - - - - - - - - - - - - - - - - - - - - - - - - - - #Vh# A verbose writer example #### - - - - - - - - - - - - - - - - - - - - - - - - - - - - foo("A") #Vn# #Vh# All output is indented, even str(), print() etc #V+# deeper #V+# and deeper #V+# and even deeper #Vc# Demo of some other methods: #Vz# c(a=1, b=2, c=3) #Vp# c(a=1, b=2, c=3) #Vs# c(a=1, b=2, c=3) #V?# rnorm(n=3, mean=2, sd=3) #V-# #V-# #V-# ���������������������������������������R.utils/inst/data-ex/HISTORY.LNK��������������������������������������������������������������������0000644�0001762�0000144�00000002100�14372747611�015626� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������L��������À������FŸ��� ���p-6bÅ îI–cÅ -6bÅ^���������������������ñ�PàOÐ ê:i¢Ø�+00�/C:\�������������������\�1�����}1}x�DOCUME~1��D���ᄎ0à+»2t¼���D�o�c�u�m�e�n�t�s� �a�n�d� �S�e�t�t�i�n�g�s����.�1�����»2z’�hb�����ï¾¼0±l»2r¼���h�b����H�1�����º2Iœ�BRAJUC~1.R��.���ᆲ2�Ÿ»2(¸���b�r�a�j�u�.�c�o�m�.�R����@�1�����»2 k�R85F0~1.UTI�&���ᄎ2g›»2Џ���R�.�u�t�i�l�s����@�1�����º2·¡�R85F0~1.UTI�&���ᄎ2q›»2‹¸���R�.�u�t�i�l�s����4�1�����»2$»�inst�� ���ᄎ2# »2$»���i�n�s�t����<�2�^��º2D¨ �HISTORY�&���ᄎ2D¨»2¹���H�I�S�T�O�R�Y������������������8�������~���������C³%„���IBM_PRELOAD�C:\Documents and Settings\hb\braju.com.R\R.utils\R.utils\inst\HISTORY��E�C�:�\�D�o�c�u�m�e�n�t�s� �a�n�d� �S�e�t�t�i�n�g�s�\�h�b�\�b�r�a�j�u�.�c�o�m�.�R�\�R�.�u�t�i�l�s�\�R�.�u�t�i�l�s�\�i�n�s�t�\�H�I�S�T�O�R�Y� �.�.�\�H�I�S�T�O�R�Y�=�C�:�\�D�o�c�u�m�e�n�t�s� �a�n�d� �S�e�t�t�i�n�g�s�\�h�b�\�b�r�a�j�u�.�c�o�m�.�R�\�R�.�u�t�i�l�s�\�R�.�u�t�i�l�s�\�i�n�s�t�`����� X�������hb-laptop�������Há¶L×ZI§ƒFóŽ{ù~ß½JËÙªz�ÐYÍ‚ˆHá¶L×ZI§ƒFóŽ{ù~ß½JËÙªz�ÐYÍ‚ˆ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/inst/data-ex/NEWS.LNK�����������������������������������������������������������������������0000644�0001762�0000144�00000002210�14372747611�015243� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������L��������À������F��� ���XšL_Ë#“ƒÏ¼‰Ë2ñ {Ì…���������������������ð�DGYr?§D‰ÅU•þk0îŠ�t� �CFSF�1�����8?›�BRAJUC~1.R����tY^–ßÓHg3¼î(ºÅÍúߟgVA‰GÅÇkÀ¶D���ï¾<=U+8?›*���d¿���/���������������b�r�a�j�u�.�c�o�m�.�R���F�f�1�����/?ÕŒ�RFD3F~1.UTI�L���ï¾<={£/?ÕŒ*���·Ù������������������R�.�u�t�i�l�s�,�R�-�f�o�r�g�e����V�1�����ž>Ù½�RBD29~1.UTI�<���ï¾<=¹£ž>Ù½*���«á������������������R�.�u�t�i�l�s����J�1�����2?z”�inst��6���ï¾<=å£2?z”*���iä������������������i�n�s�t����J�2�…��8?Ä« �NEWS��6���ï¾<=å£u={¥*���û����®��������������N�E�W�S������™������������8���D���h���������ÌQ8à���Windows7_OS�C:\Users\���$����������������\\HB-X201\Users�hb\braju.com.R\R.utils,R-forge\R.utils\inst\NEWS�/�W�i�n�d�o�w�s� �S�h�o�r�t�c�u�t� �l�i�n�k� �c�r�e�a�t�e�d� �b�y� �R�.�u�t�i�l�s� �v�1�.�8�.�2��.�\�R�.�u�t�i�l�s�\�i�n�s�t�\�N�E�W�S������ ÿÿÿÿ������ �� |ÎóIÌJ†HÕÔKï���™��� �� ���1SPSâŠXF¼L8C»ü“&˜mÎq����������/���S�-�1�-�5�-�2�1�-�3�5�1�1�8�9�1�4�7�7�-�3�4�3�9�6�9�1�1�1�2�-�2�5�5�6�7�3�8�4�7�2�-�1�0�0�0�������������`����� X�������hb-x201���������R%ól‚RŸJ§Áâà-Ö®­âgBòåà«¢Ý6ïbrÜR%ól‚RŸJ§Áâà-Ö®­âgBòåà«¢Ý6ïbrÜ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/inst/data-ex/lnkFileWith10BitsInFlag.lnk����������������������������������������������������0000644�0001762�0000144�00000002324�14372747611�021121� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������L��������À������F–�����€YA/úOÉ�uâÑÄUÉ€YA/úOÉ�����������������������O��������������������@���$���������!������\\cisco\data�Q:�annotationData��Q�:�\�a�n�n�o�t�a�t�i�o�n�D�a�t�a��Q�:�\�•��� �� �PàOÐ ê:i¢Ø�+00�/Q:\�������������������^�1�����z9æ˜�AC5BQH~E��F���ï¾z9昄9 &�����I�����������a�n�n�o�t�a�t�i�o�n�D�a�t�a���������� Q:\annotationData���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Q�:�\�a�n�n�o�t�a�t�i�o�n�D�a�t�a�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������`����� X�������cisco�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R.utils/inst/WORDLIST�������������������������������������������������������������������������������0000644�0001762�0000144�00000003160�14372747611�013775� 0����������������������������������������������������������������������������������������������������ustar �ligges��������������������������users������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Achim AComments aperm applicational AppVeyor args aSingleEspresso attachLocally Benchmarking Bensen bzip CapturedEvaluation captureOutput cex clearCache clearLookupCache CMD coercions conditionCall conditionMessage convertComment Ctrl decapitalized decapitalizes downloadFile DSC enterf eval FileProgressBar filesystem Filesystem finalizers finalizeSession Friedrich getBarString getCall getCalls getDLLRegisteredRoutines getEnvironment getFieldModifier getFieldModifiers getFields getInstantiationTime getIntegers getLastException getLeaves getMessage getNumeric getNumerics getOption getStackTrace getStaticInstance getThreshold getTimestampFormat getVector getWhen Ghostview GString gzip Hager hasField hashCode hasOption Hornik hostname http https int's isDone IShellLink isOn isOpen isVisible JottR lang LComments Leisch LF licence lnk LNK macOS maxValue MSDN MultiVerbose nbrOfOptions nonStructure NotePad nt NullVerbose Nx NxK objectSize ObjectsWithPackage onSessionExit oo OSs PComments png popState POSIXlt pre Pre Preprocess preprocessed printf printStackTrace ProgressBar pushState rawConnection readChar readline repos rowwise setDefaultLevel setMaxValue setOption setProgress setStepLength setThreshold setTicks setTimestampFormat setValue SHLLINK SmartComments SpecialFolder sprintf srcfile ss stdlib Stdlib str subclasses SuperClassMethod Sys Tcler's TclTkProgressBar textConnection TextStatusBar TimeoutException timestamping timestampOff timestampOn toAsciiRegExprPattern toFileListTree toLatex UNC unindents unmaps VBScript Vc vcomment VComments Ve verbosed Vh Vm Vn Vp Vr Vw Vz wget Wishlist Wotsit's writeRaw www xdr XP Zeileis ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������