R version 2.8.0 (2008-10-20) Copyright (C) 2008 The R Foundation for Statistical Computing ISBN 3-900051-07-0 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > x <- c(17,17,18,21,20,28,19,22,16,18,25,17,14,11,27,20,22,22,21,23,17,24,14,17,23,24,24,8,22,23,25,21,24,15,22,21,25,16,28,23,21,21,26,22,21,18,12,25,17,24,15,13,26,16,24,21,20,14,25,25,20,22,20,26,18,22,24,17,24,20,19,20,15,23,26,22,20,24,26,21,25,13,20,22,23,28,22,20,6,21,20,18,23,20,24,22,21,18,21,23,23,15,21,24,23,21,21,20,11,22,27,25,18,20,24,10,27,21,21,18,15,24,22,14,28,18,26,17,19,22,18,24,15,18,26,11,26,21,23,23,15,22,26,16,20,18,22,16,19,20,19,23,24,25,21,21,23,27,23,18,16,16) > par2 = '0' > par1 = '8' > ylab = 'density' > xlab = 'value of data series' > main = 'Histogram and Fitted Normal Density' > #'GNU S' R Code compiled by R2WASP v# 1#0#44 ## > #Author: Prof# Dr# P# Wessa > #To cite this work: AUTHOR#S#, #YEAR#, YOUR SOFTWARE TITLE #vNUMBER# in Free Statistics Software #v$_version#, Office for Research Development and Education, URL http://www#wessa#net/rwasp_YOURPAGE#wasp/ > #Source of accompanying publication: Office for Research, Development, and Education > #Technical description: Write here your technical program description #don't use hard returns!# > library#MASS# function (package, help, pos = 2, lib.loc = NULL, character.only = FALSE, logical.return = FALSE, warn.conflicts = TRUE, keep.source = getOption("keep.source.pkgs"), verbose = getOption("verbose"), version) { paste0 <- function(...) paste(..., sep = "") testRversion <- function(pkgInfo, pkgname, pkgpath) { current <- getRversion() if (length(Rdeps <- pkgInfo$Rdepends2)) { for (dep in Rdeps) if (length(dep) > 1) { target <- as.numeric_version(dep$version) res <- eval(parse(text = paste("current", dep$op, "target"))) if (!res) stop(gettextf("This is R %s, package '%s' needs %s %s", current, pkgname, dep$op, target), call. = FALSE, domain = NA) } } else if (length(Rdeps <- pkgInfo$Rdepends) > 1) { target <- as.numeric_version(Rdeps$version) res <- eval(parse(text = paste("current", Rdeps$op, "target"))) if (!res) stop(gettextf("This is R %s, package '%s' needs %s %s", current, pkgname, Rdeps$op, target), call. = FALSE, domain = NA) } if (!is.null(built <- pkgInfo$Built)) { R_version_built_under <- as.numeric_version(built$R) if (R_version_built_under < "2.0.0") stop(gettextf("package '%s' was built before R 2.0.0: please re-install it", pkgname), call. = FALSE, domain = NA) if (R_version_built_under > current) warning(gettextf("package '%s' was built under R version %s", pkgname, as.character(built$R)), call. = FALSE, domain = NA) if (.Platform$OS.type == "unix") { platform <- built$Platform r_arch <- .Platform$r_arch if (!nzchar(r_arch) && length(grep("\\w", platform)) && !testPlatformEquivalence(platform, R.version$platform)) stop(gettextf("package '%s' was built for %s", pkgname, platform), call. = FALSE, domain = NA) if (nzchar(r_arch) && file.exists(file.path(pkgpath, "libs")) && !file.exists(file.path(pkgpath, "libs", r_arch))) stop(gettextf("package '%s' is not installed for 'arch=%s'", pkgname, r_arch), call. = FALSE, domain = NA) } } else stop(gettextf("package '%s' has not been installed properly\n", pkgname), gettext("See the Note in ?library"), call. = FALSE, domain = NA) } checkNoGenerics <- function(env, pkg) { nenv <- env ns <- .Internal(getRegisteredNamespace(as.name(libraryPkgName(pkg)))) if (!is.null(ns)) nenv <- asNamespace(ns) if (exists(".noGenerics", envir = nenv, inherits = FALSE)) TRUE else { length(objects(env, pattern = "^\\.__[MT]", all.names = TRUE)) == 0 } } checkConflicts <- function(package, pkgname, pkgpath, nogenerics, env) { dont.mind <- c("last.dump", "last.warning", ".Last.value", ".Random.seed", ".First.lib", ".Last.lib", ".packageName", ".noGenerics", ".required", ".no_S3_generics") sp <- search() lib.pos <- match(pkgname, sp) ob <- objects(lib.pos, all.names = TRUE) if (!nogenerics) { these <- objects(lib.pos, all.names = TRUE) these <- these[substr(these, 1, 6) == ".__T__"] gen <- gsub(".__T__(.*):([^:]+)", "\\1", these) from <- gsub(".__T__(.*):([^:]+)", "\\2", these) gen <- gen[from != package] ob <- ob[!(ob %in% gen)] } fst <- TRUE ipos <- seq_along(sp)[-c(lib.pos, match(c("Autoloads", "CheckExEnv"), sp, 0))] for (i in ipos) { obj.same <- match(objects(i, all.names = TRUE), ob, nomatch = 0) if (any(obj.same > 0)) { same <- ob[obj.same] same <- same[!(same %in% dont.mind)] Classobjs <- grep("^\\.__", same) if (length(Classobjs)) same <- same[-Classobjs] same.isFn <- function(where) sapply(same, exists, where = where, mode = "function", inherits = FALSE) same <- same[same.isFn(i) == same.isFn(lib.pos)] if (length(same)) same <- same[sapply(same, function(.) !identical(get(., i), get(., lib.pos)))] if (length(same)) { if (fst) { fst <- FALSE packageStartupMessage(gettextf("\nAttaching package: '%s'\n", package), domain = NA) } packageStartupMessage(paste("\n\tThe following object(s) are masked", if (i < lib.pos) "_by_" else "from", sp[i], ":\n\n\t", paste(same, collapse = ",\n\t "), "\n")) } } } } libraryPkgName <- function(pkgName, sep = "_") unlist(strsplit(pkgName, sep, fixed = TRUE))[1] libraryPkgVersion <- function(pkgName, sep = "_") { splitName <- unlist(strsplit(pkgName, sep, fixed = TRUE)) if (length(splitName) > 1) splitName[2] else NULL } libraryMaxVersPos <- function(vers) { if (length(vers) == 0) return(integer(0)) vers <- package_version(vers) min(which(vers == max(vers))) } runUserHook <- function(pkgname, pkgpath) { hook <- getHook(packageEvent(pkgname, "attach")) for (fun in hook) try(fun(pkgname, pkgpath)) } bindTranslations <- function(pkgname, pkgpath) { popath <- file.path(pkgpath, "po") if (!file.exists(popath)) return() bindtextdomain(pkgname, popath) bindtextdomain(paste("R", pkgname, sep = "-"), popath) } if (!missing(package)) { if (is.null(lib.loc)) lib.loc <- .libPaths() lib.loc <- lib.loc[file.info(lib.loc)$isdir %in% TRUE] if (!character.only) package <- as.character(substitute(package)) if (length(package) != 1) stop("'package' must be of length 1") if (is.na(package) || (package == "")) stop("invalid package name") if (package %in% c("ctest", "eda", "modreg", "mva", "nls", "stepfun", "ts")) { have.stats <- "package:stats" %in% search() if (!have.stats) require("stats") old <- "stats" warning(gettextf("package '%s' has been merged into '%s'", package, old), call. = FALSE, domain = NA) return(if (logical.return) TRUE else invisible(.packages())) } if (package == "mle") { have.stats4 <- "package:stats4" %in% search() if (!have.stats4) require("stats4") old <- "stats4" warning(gettextf("package '%s' has been merged into '%s'", package, old), call. = FALSE, domain = NA) return(if (logical.return) TRUE else invisible(.packages())) } if (package == "lqs") { warning("package 'lqs' has been moved back to package 'MASS'", call. = FALSE, immediate. = TRUE) have.VR <- "package:MASS" %in% search() if (!have.VR) { if (require("MASS", quietly = TRUE)) warning("package 'MASS' has now been loaded", call. = FALSE, immediate. = TRUE) else { if (logical.return) return(FALSE) else stop("package 'MASS' seems to be missing from this R installation") } } return(if (logical.return) TRUE else invisible(.packages())) } if (!missing(version)) { package <- manglePackageName(package, version) } else { pkgDirs <- list.files(lib.loc, pattern = paste0("^", package)) if (length(pkgDirs) > 0) { if (!(package %in% pkgDirs)) { vers <- unlist(lapply(pkgDirs, libraryPkgVersion)) vpos <- libraryMaxVersPos(vers) if (length(vpos) > 0) package <- pkgDirs[vpos] } } } pkgname <- paste("package", package, sep = ":") newpackage <- is.na(match(pkgname, search())) if (newpackage) { pkgpath <- .find.package(package, lib.loc, quiet = TRUE, verbose = verbose) if (length(pkgpath) == 0) { if (length(lib.loc)) { vers <- libraryPkgVersion(package) txt <- if (!is.null(vers)) gettextf("there is no package called '%s', version %s", libraryPkgName(package), vers) else gettextf("there is no package called '%s'", libraryPkgName(package)) } else { txt <- gettext("no library trees found in 'lib.loc'") } if (logical.return) { warning(txt, domain = NA) return(FALSE) } else stop(txt, domain = NA) } which.lib.loc <- dirname(pkgpath) pfile <- system.file("Meta", "package.rds", package = package, lib.loc = which.lib.loc) if (!nzchar(pfile)) stop(gettextf("'%s' is not a valid package -- installed < 2.0.0?", libraryPkgName(package)), domain = NA) pkgInfo <- .readRDS(pfile) testRversion(pkgInfo, package, pkgpath) if (is.character(pos)) { npos <- match(pos, search()) if (is.na(npos)) { warning(gettextf("'%s' not found on search path, using pos = 2", pos), domain = NA) pos <- 2 } else pos <- npos } .getRequiredPackages2(pkgInfo) if (packageHasNamespace(package, which.lib.loc)) { tt <- try({ ns <- loadNamespace(package, c(which.lib.loc, lib.loc), keep.source = keep.source) dataPath <- file.path(which.lib.loc, package, "data") env <- attachNamespace(ns, pos = pos, dataPath = dataPath) }) if (inherits(tt, "try-error")) if (logical.return) return(FALSE) else stop(gettextf("package/namespace load failed for '%s'", libraryPkgName(package)), call. = FALSE, domain = NA) else { on.exit(do.call("detach", list(name = pkgname))) nogenerics <- !.isMethodsDispatchOn() || checkNoGenerics(env, package) if (warn.conflicts && !exists(".conflicts.OK", envir = env, inherits = FALSE)) checkConflicts(package, pkgname, pkgpath, nogenerics, ns) runUserHook(package, pkgpath) on.exit() if (logical.return) return(TRUE) else return(invisible(.packages())) } } dependsMethods <- "methods" %in% names(pkgInfo$Depends) if (dependsMethods && pkgInfo$Built$R < "2.4.0") stop("package was installed prior to 2.4.0 and must be re-installed") codeFile <- file.path(which.lib.loc, package, "R", libraryPkgName(package)) loadenv <- new.env(hash = TRUE, parent = .GlobalEnv) assign(".packageName", package, envir = loadenv) if (file.exists(codeFile)) { res <- try(sys.source(codeFile, loadenv, keep.source = keep.source)) if (inherits(res, "try-error")) stop(gettextf("unable to load R code in package '%s'", libraryPkgName(package)), call. = FALSE, domain = NA) } else if (verbose) warning(gettextf("package '%s' contains no R code", libraryPkgName(package)), domain = NA) dbbase <- file.path(which.lib.loc, package, "data", "Rdata") if (file.exists(paste0(dbbase, ".rdb"))) lazyLoad(dbbase, loadenv) dbbase <- file.path(which.lib.loc, package, "R", "sysdata") if (file.exists(paste0(dbbase, ".rdb"))) lazyLoad(dbbase, loadenv) env <- attach(NULL, pos = pos, name = pkgname) on.exit(do.call("detach", list(name = pkgname))) attr(env, "path") <- file.path(which.lib.loc, package) .Internal(lib.fixup(loadenv, env)) bindTranslations(libraryPkgName(package), pkgpath) if (exists(".First.lib", mode = "function", envir = env, inherits = FALSE)) { firstlib <- get(".First.lib", mode = "function", envir = env, inherits = FALSE) tt <- try(firstlib(which.lib.loc, package)) if (inherits(tt, "try-error")) if (logical.return) return(FALSE) else stop(gettextf(".First.lib failed for '%s'", libraryPkgName(package)), domain = NA) } if (!is.null(firstlib <- getOption(".First.lib")[[package]])) { tt <- try(firstlib(which.lib.loc, package)) if (inherits(tt, "try-error")) if (logical.return) return(FALSE) else stop(gettextf(".First.lib failed for '%s'", libraryPkgName(package)), domain = NA) } nogenerics <- !.isMethodsDispatchOn() || checkNoGenerics(env, package) if (warn.conflicts && !exists(".conflicts.OK", envir = env, inherits = FALSE)) checkConflicts(package, pkgname, pkgpath, nogenerics, env) if (!nogenerics) methods::cacheMetaData(env, TRUE, searchWhere = .GlobalEnv) runUserHook(package, pkgpath) on.exit() } if (verbose && !newpackage) warning(gettextf("package '%s' already present in search()", libraryPkgName(package)), domain = NA) } else if (!missing(help)) { if (!character.only) help <- as.character(substitute(help)) pkgName <- help[1] pkgPath <- .find.package(pkgName, lib.loc, verbose = verbose) docFiles <- c(file.path(pkgPath, "Meta", "package.rds"), file.path(pkgPath, "INDEX")) if (file.exists(vignetteIndexRDS <- file.path(pkgPath, "Meta", "vignette.rds"))) docFiles <- c(docFiles, vignetteIndexRDS) pkgInfo <- vector(length = 3, mode = "list") readDocFile <- function(f) { if (basename(f) %in% "package.rds") { txt <- .readRDS(f)$DESCRIPTION if ("Encoding" %in% names(txt)) { to <- if (Sys.getlocale("LC_CTYPE") == "C") "ASCII//TRANSLIT" else "" tmp <- try(iconv(txt, from = txt["Encoding"], to = to)) if (!inherits(tmp, "try-error")) txt <- tmp else warning("'DESCRIPTION' has 'Encoding' field and re-encoding is not possible", call. = FALSE) } nm <- paste0(names(txt), ":") formatDL(nm, txt, indent = max(nchar(nm, "w")) + 3) } else if (basename(f) %in% "vignette.rds") { txt <- .readRDS(f) if (is.data.frame(txt) && nrow(txt)) cbind(basename(gsub("\\.[[:alpha:]]+$", "", txt$File)), paste(txt$Title, paste0(rep.int("(source", NROW(txt)), ifelse(txt$PDF != "", ", pdf", ""), ")"))) else NULL } else readLines(f) } for (i in which(file.exists(docFiles))) pkgInfo[[i]] <- readDocFile(docFiles[i]) y <- list(name = pkgName, path = pkgPath, info = pkgInfo) class(y) <- "packageInfo" return(y) } else { if (is.null(lib.loc)) lib.loc <- .libPaths() db <- matrix(character(0), nrow = 0, ncol = 3) nopkgs <- character(0) for (lib in lib.loc) { a <- .packages(all.available = TRUE, lib.loc = lib) for (i in sort(a)) { file <- system.file("Meta", "package.rds", package = i, lib.loc = lib) title <- if (file != "") { txt <- .readRDS(file) if (is.list(txt)) txt <- txt$DESCRIPTION if ("Encoding" %in% names(txt)) { to <- if (Sys.getlocale("LC_CTYPE") == "C") "ASCII//TRANSLIT" else "" tmp <- try(iconv(txt, txt["Encoding"], to, "?")) if (!inherits(tmp, "try-error")) txt <- tmp else warning("'DESCRIPTION' has 'Encoding' field and re-encoding is not possible", call. = FALSE) } txt["Title"] } else NA if (is.na(title)) title <- " ** No title available (pre-2.0.0 install?) ** " db <- rbind(db, cbind(i, lib, title)) } if (length(a) == 0) nopkgs <- c(nopkgs, lib) } dimnames(db) <- list(NULL, c("Package", "LibPath", "Title")) if ((length(nopkgs) > 0) && !missing(lib.loc)) { pkglist <- paste(sQuote(nopkgs), collapse = ", ") msg <- sprintf(ngettext(length(nopkgs), "library %s contains no packages", "libraries %s contain no packages"), pkglist) warning(msg, domain = NA) } y <- list(header = NULL, results = db, footer = NULL) class(y) <- "libraryIQR" return(y) } if (logical.return) TRUE else invisible(.packages()) } > par1 <- as#numeric#par1# > if #par2 == '0'# par2 = 'Sturges' else par2 <- as#numeric#par2# + x <- as#ts#x# #otherwise the fitdistr function does not work properly Error: unexpected symbol in: "if #par2 == '0'# par2 = 'Sturges' else par2 <- as#numeric#par2# x" Execution halted