npm - @r-universe/webr - Versions diffs - 2023.6.11 → 2023.6.21 - Mend

@r-universe/webr 2023.6.11 → 2023.6.21

This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.

Files changed (1649) hide show

package/dist/vfs/usr/lib/R/doc/html/resources.html ADDED Viewed

@@ -0,0 +1,235 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<html>
+<!-- Created by GNU Texinfo 6.7, http://www.gnu.org/software/texinfo/ -->
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>R Resources</title>
+<meta name="description" content="R Resources">
+<meta name="keywords" content="R Resources">
+<meta name="resource-type" content="document">
+<meta name="distribution" content="global">
+<meta name="Generator" content="texi2any">
+<link href="#Top" rel="start" title="Top">
+<link href="dir.html#Top" rel="up" title="(dir)">
+<style type="text/css">
+<!--
+a.summary-letter {text-decoration: none}
+blockquote.indentedblock {margin-right: 0em}
+div.display {margin-left: 3.2em}
+div.example {margin-left: 3.2em}
+div.lisp {margin-left: 3.2em}
+kbd {font-style: oblique}
+pre.display {font-family: inherit}
+pre.format {font-family: inherit}
+pre.menu-comment {font-family: serif}
+pre.menu-preformatted {font-family: serif}
+span.nolinebreak {white-space: nowrap}
+span.roman {font-family: initial; font-weight: normal}
+span.sansserif {font-family: sans-serif; font-weight: normal}
+ul.no-bullet {list-style: none}
+@media screen {
+    .container {
+	padding-right: 10px;
+	padding-left: 10px;
+	margin-right: auto;
+	margin-left: auto;
+	max-width: 900px;
+    }
+}
+.rimage img { /* from knitr - for examples and demos */
+    width: 96%;
+    margin-left: 2%;
+}
+.katex { font-size: 1.1em; }
+code {
+    color: inherit;
+    background: inherit;
+}
+body {
+    line-height: 1.4;
+    background: white;
+    color: black;
+}
+a:link {
+    background: white;
+    color: blue;
+}
+a:visited {
+    background: white;
+    color: rgb(50%, 0%, 50%);
+}
+h1 {
+    background: white;
+    color: rgb(55%, 55%, 55%);
+    font-family: monospace;
+    font-size: 1.4em; /* x-large; */
+    text-align: center;
+}
+h2 {
+    background: white;
+    color: rgb(40%, 40%, 40%);
+    font-family: monospace;
+    font-size: 1.2em; /* large; */
+    text-align: center;
+}
+h3 {
+    background: white;
+    color: rgb(40%, 40%, 40%);
+    font-family: monospace;
+    font-size: 1.2em; /* large; */
+}
+h4 {
+    background: white;
+    color: rgb(40%, 40%, 40%);
+    font-family: monospace;
+    font-style: italic;
+    font-size: 1.2em; /* large; */
+}
+h5 {
+    background: white;
+    color: rgb(40%, 40%, 40%);
+    font-family: monospace;
+}
+h6 {
+    background: white;
+    color: rgb(40%, 40%, 40%);
+    font-family: monospace;
+    font-style: italic;
+}
+img.toplogo {
+    width: 4em;
+    vertical-align: middle;
+}
+img.arrow {
+    width: 30px;
+    height: 30px;
+    border: 0;
+}
+span.acronym {
+    font-size: small;
+}
+span.env {
+    font-family: monospace;
+}
+span.file {
+    font-family: monospace;
+}
+span.option{
+    font-family: monospace;
+}
+span.pkg {
+    font-weight: bold;
+}
+span.samp{
+    font-family: monospace;
+}
+div.vignettes a:hover {
+    background: rgb(85%, 85%, 85%);
+}
+tr {
+    vertical-align: top;
+}
+span.rlang {
+    font-family: Courier New, Courier;
+    color: #666666;
+}
+-->
+</style>
+</head>
+<body lang="en">
+<h1 class="settitle" align="center">R Resources</h1>
+<h1>Other Resources
+<img class="toplogo" src="Rlogo.svg" alt="[R logo]">
+</h1>
+<hr width="100%">
+<span id="Top"></span><h1 class="node-heading">Top</h1>
+<hr>
+<span id="FAQ"></span><span id="FAQ-1"></span><h3 class="section">1 FAQ</h3>
+<p>A collection of <a href="faq.html">Frequently Asked Questions</a> and their
+answers is maintained by <a href="mailto:Kurt.Hornik@R-project.org">Kurt Hornik</a>
+and can be found at the <acronym>URL</acronym>
+</p>
+<blockquote>
+<p><a href="https://CRAN.R-project.org/doc/FAQ/R-FAQ.html">https://CRAN.R-project.org/doc/FAQ/R-FAQ.html</a>
+</p></blockquote>
+<hr>
+<span id="Mailing-lists"></span><span id="Mailing-lists-1"></span><h3 class="section">2 Mailing lists</h3>
+<p>Thanks to <a href="mailto:Martin.Maechler@R-project.org">Martin Maechler</a> there
+are a number of mailing lists which are used by R users and developers.
+See
+</p>
+<blockquote>
+<p><a href="https://www.R-project.org/mail.html">https://www.R-project.org/mail.html</a>
+</p></blockquote>
+<p>for details.
+</p>
+<hr>
+<span id="Archives"></span><span id="Archives-1"></span><h3 class="section">3 Archives</h3>
+<p>The Comprehensive R Archive Network (<acronym>CRAN</acronym>) is a collection of
+sites which carry identical material, consisting of the R
+distribution(s), the contributed extensions, documentation for R, and
+binaries, with the master site at <a href="https://CRAN.R-project.org/">https://CRAN.R-project.org/</a> and
+information on daily mirrors available from
+</p>
+<blockquote>
+<p><a href="https://CRAN.R-project.org/mirrors.html">https://CRAN.R-project.org/mirrors.html</a>
+</p></blockquote>
+<hr>
+<span id="Bug_002dtracking-system"></span><span id="Bug_002dtracking-system-1"></span><h3 class="section">4 Bug-tracking system</h3>
+<p>R has a bug-tracking system (or perhaps a bug-filing system is a more
+precise description) available on the net at
+</p>
+<blockquote>
+<p><a href="https://bugs.R-project.org/">https://bugs.R-project.org/</a>
+</p></blockquote>
+<hr>
+</body>
+</html>

package/dist/vfs/usr/lib/R/doc/html/right.jpg ADDED Viewed

Binary file

package/dist/vfs/usr/lib/R/doc/html/up.jpg ADDED Viewed

Binary file

package/dist/vfs/usr/lib/R/doc/manual/images/QQ.png ADDED Viewed

Binary file

package/dist/vfs/usr/lib/R/doc/manual/images/ecdf.png ADDED Viewed

Binary file

package/dist/vfs/usr/lib/R/doc/manual/images/fig11.png ADDED Viewed

Binary file

package/dist/vfs/usr/lib/R/doc/manual/images/fig12.png ADDED Viewed

Binary file

package/dist/vfs/usr/lib/R/doc/manual/images/hist.png ADDED Viewed

Binary file

package/dist/vfs/usr/lib/R/doc/manual/images/ice.png ADDED Viewed

Binary file

package/dist/vfs/usr/lib/R/library/base/demo/error.catching.R ADDED Viewed

@@ -0,0 +1,101 @@
+	##================================================================##
+	###  In longer simulations, aka computer experiments,		 ###
+	###  you may want to						 ###
+	###  1) catch all errors and warnings (and continue)		 ###
+	###  2) store the error or warning messages			 ###
+	###								 ###
+	###  Here's a solution	(see R-help mailing list, Dec 9, 2010):	 ###
+	##================================================================##
+##' Catch *and* save both errors and warnings, and in the case of
+##' a warning, also keep the computed result.
+##'
+##' @title tryCatch both warnings (with value) and errors
+##' @param expr an \R expression to evaluate
+##' @return a list with 'value' and 'warning', where
+##'   'value' may be an error caught.
+##' @author Martin Maechler;
+##' Copyright (C) 2010-2023  The R Core Team
+tryCatch.W.E <- function(expr)
+{
+    W <- NULL
+    w.handler <- function(w) { # warning handler
+	W <<- w
+	invokeRestart("muffleWarning")
+    }
+    list(value = withCallingHandlers(tryCatch(expr, error = function(e) e),
+				     warning = w.handler),
+	 warning = W)
+}
+str( tryCatch.W.E( log( 2 ) ) )
+str( tryCatch.W.E( log( -1) ) )
+str( tryCatch.W.E( log("a") ) )
+##' @title Catch *all* warnings and the value
+##' @param expr an \R expression to evaluate
+##' @return a list with 'value' and 'warnings'
+##' @author Luke Tierney (2004), R-help post
+##'	https://stat.ethz.ch/pipermail/r-help/2004-June/052132.html
+withWarnings <- function(expr) {
+    W <- NULL
+    wHandler <- function(w) {
+	W <<- c(W, list(w))
+	invokeRestart("muffleWarning")
+    }
+    val <- withCallingHandlers(expr, warning = wHandler)
+    list(value = val, warnings = W)
+}
+withWarnings({ warning("first"); warning("2nd"); pi })
+r <- withWarnings({ log(-1) + sqrt(-4); exp(1) })
+str(r, digits=14)
+##' @title tryCatch *all* warnings and messages, and an error or the final value
+##' @param expr an \R expression to evaluate
+##' @return a list with `messages`, `warnings`, and
+##'         `value` which may be an error caught.
+##' @author Martin Maechler (combining the above)
+tryCatch_WEMs <- function(expr)
+{
+    W <- M <- NULL
+    w.handler <- function(w) { # warning handler
+	W <<- c(W, list(w)); invokeRestart("muffleWarning")
+    }
+    m.handler <- function(m) { # message handler
+	M <<- c(M, list(m)); invokeRestart("muffleMessage")
+    }
+    list(value = withCallingHandlers(tryCatch(expr, error = function(e) e),
+				     warning = w.handler, message = m.handler),
+	 messages = M,
+	 warnings = W)
+}
+f3 <- function(x) {
+    r <- log(-x) + sqrt(-x) # produce warnings when x >= 0
+    if(anyNA(r)) message(sprintf("%d NA's produced by log(.) + sqrt(.)", sum(is.na(r))))
+    r <- exp(-x)
+    if(any(ii <- is.infinite(r))) message(sprintf("Got +/- Inf from x[%s]", deparse(which(ii))))
+    r
+}
+str( r0 <- tryCatch_WEMs(f3("A")) ) # just an error from '-x'
+stopifnot(exprs = {
+    inherits (r0$value, "error")
+    identical(r0$value$call, quote(-x))
+    sapply(r0[c("messages","warnings")], is.null)
+})
+(x <- c(-1:1, (-1:1)/0))
+str( rI <- tryCatch_WEMs(f3(x) ))
+stopifnot(exprs = {
+    identical(lengths(rI), c(value = length(x), messages = 2L, warnings = 2L))
+    rI$value[4] == Inf
+    all.equal(rI$value, exp(-x))
+    length(rI$messages) == 2; sapply(rI$messages, inherits, what="message")
+    length(rI$warnings) == 2; sapply(rI$warnings, inherits, what="warning")
+})

package/dist/vfs/usr/lib/R/library/base/demo/is.things.R ADDED Viewed

@@ -0,0 +1,143 @@
+#  Copyright (C) 1997-2018 The R Core Team
+### The Base package has a couple of non-functions:
+##
+## These may be in "base" when they exist;  discount them here
+## (see also  'dont.mind' in checkConflicts() inside library()) :
+xtraBaseNms <- c("last.dump", "last.warning", ".Last.value",
+                 ".Random.seed", ".Traceback")
+ls.base <- Filter(function(nm) is.na(match(nm, xtraBaseNms)),
+                  ls("package:base", all=TRUE))
+base.is.f <- sapply(ls.base, function(x) is.function(get(x)))
+cat("\nNumber of all base objects:\t", length(ls.base),
+    "\nNumber of functions from these:\t", sum(base.is.f),
+    "\n\t starting with 'is.' :\t  ",
+    sum(grepl("^is\\.", ls.base[base.is.f])), "\n", sep = "")
+## R ver.| #{is*()}
+## ------+---------
+## 0.14  : 31
+## 0.50  : 33
+## 0.60  : 34
+## 0.63  : 37
+## 1.0.0 : 38
+## 1.3.0 : 41
+## 1.6.0 : 45
+## 2.0.0 : 45
+## 2.7.0 : 48
+## 3.0.0 : 49
+if(interactive()) {
+    nonDots <- function(nm) substr(nm, 1L, 1L) != "."
+    cat("Base non-functions not starting with \".\":\n")
+    Filter(nonDots, ls.base[!base.is.f])
+}
+## Do we have a method (probably)?
+is.method <- function(fname) {
+    isFun <- function(name) (exists(name, mode="function") &&
+                             is.na(match(name, c("is", "as"))))
+    np <- length(sp <- strsplit(fname, split = "\\.")[[1]])
+    if(np <= 1 )
+        FALSE
+    else
+        (isFun(paste(sp[1:(np-1)], collapse = '.')) ||
+         (np >= 3 &&
+          isFun(paste(sp[1:(np-2)], collapse = '.'))))
+}
+is.ALL <- function(obj, func.names = ls(pos=length(search())),
+		   not.using = c("is.single", "is.real", "is.loaded",
+                     "is.empty.model", "is.R", "is.element", "is.unsorted"),
+		   true.only = FALSE, debug = FALSE)
+{
+    ## Purpose: show many 'attributes' of  R object __obj__
+    ## -------------------------------------------------------------------------
+    ## Arguments: obj: any R object
+    ## -------------------------------------------------------------------------
+    ## Author: Martin Maechler, Date: 6 Dec 1996
+    is.fn <- func.names[substring(func.names,1,3) == "is."]
+    is.fn <- is.fn[substring(is.fn,1,7) != "is.na<-"]
+    use.fn <- is.fn[ is.na(match(is.fn, not.using))
+                    & ! sapply(is.fn, is.method) ]
+    r <- if(true.only) character(0)
+    else structure(vector("list", length= length(use.fn)), names= use.fn)
+    for(f in use.fn) {
+	if(any(f == c("is.na", "is.finite"))) {
+	    if(!is.list(obj) && !is.vector(obj) && !is.array(obj)) {
+		if(!true.only) r[[f]] <- NA
+		next
+	    }
+	}
+	if(any(f == c("is.nan", "is.finite", "is.infinite"))) {
+	    if(!is.atomic(obj)) {
+	    	if(!true.only) r[[f]] <- NA
+	    	next
+	    }
+	}
+	if(debug) cat(f,"")
+	fn <- get(f)
+	rr <- if(is.primitive(fn) || length(formals(fn))>0)  fn(obj) else fn()
+	if(!is.logical(rr)) cat("f=",f," --- rr	 is NOT logical	 = ",rr,"\n")
+	##if(1!=length(rr))   cat("f=",f," --- rr NOT of length 1; = ",rr,"\n")
+	if(true.only && length(rr)==1 && !is.na(rr) && rr) r <- c(r, f)
+	else if(!true.only) r[[f]] <- rr
+    }
+    if(debug)cat("\n")
+    if(is.list(r)) structure(r, class = "isList") else r
+}
+print.isList <- function(x, ..., verbose = getOption("verbose"))
+{
+    ## Purpose:	 print METHOD  for `isList' objects
+    ## ------------------------------------------------
+    ## Author: Martin Maechler, Date: 12 Mar 1997
+    if(is.list(x)) {
+        if(verbose) cat("print.isList(): list case (length=",length(x),")\n")
+	nm <- format(names(x))
+	rr <- lapply(x, stats::symnum, na = "NA")
+	for(i in seq_along(x)) cat(nm[i],":",rr[[i]],"\n", ...)
+    } else NextMethod("print", ...)
+}
+is.ALL(NULL)
+##fails: is.ALL(NULL, not.using = c("is.single", "is.loaded"))
+is.ALL(NULL,   true.only = TRUE)
+all.equal(NULL, pairlist())
+## list() != NULL == pairlist() :
+is.ALL(list(), true.only = TRUE)
+(pl <- is.ALL(pairlist(1,    list(3,"A")), true.only = TRUE))
+(ll <- is.ALL(    list(1,pairlist(3,"A")), true.only = TRUE))
+all.equal(pl[pl != "is.pairlist"],
+          ll[ll != "is.vector"])## TRUE
+is.ALL(1:5)
+is.ALL(array(1:24, 2:4))
+is.ALL(1 + 3)
+e13 <- expression(1 + 3)
+is.ALL(e13)
+is.ALL(substitute(expression(a + 3), list(a=1)), true.only = TRUE)
+is.ALL(y ~ x) #--> NA	 for is.na & is.finite
+is0 <- is.ALL(numeric(0))
+is0.ok <- 1 == (lis0 <- sapply(is0, length))
+is0[!is0.ok]
+is0 <- unlist(is0)
+is0
+ispi <- unlist(is.ALL(pi))
+all(ispi[is0.ok] == is0)
+is.ALL(numeric(0), true=TRUE)
+is.ALL(array(1,1:3), true=TRUE)
+is.ALL(cbind(1:3), true=TRUE)
+is.ALL(structure(1:7, names = paste("a",1:7,sep="")))
+is.ALL(structure(1:7, names = paste("a",1:7,sep="")), true.only = TRUE)
+x <- 1:20 ; y <- 5 + 6*x + rnorm(20)
+lm.xy <- lm(y ~ x)
+is.ALL(lm.xy)
+is.ALL(structure(1:7, names = paste("a",1:7,sep="")))
+is.ALL(structure(1:7, names = paste("a",1:7,sep="")), true.only = TRUE)

package/dist/vfs/usr/lib/R/library/base/demo/recursion.R ADDED Viewed

@@ -0,0 +1,82 @@
+#  Copyright (C) 1997-2005 The R Core Team
+## Adaptive integration:	 Venables and Ripley pp. 105-110
+## This is the basic integrator.
+area <- function(f, a, b, ..., fa = f(a, ...), fb = f(b, ...), limit
+		 = 10, eps = 1.e-5)
+{
+    h <- b - a
+    d <- (a + b)/2
+    fd <- f(d, ...)
+    a1 <- ((fa + fb) * h)/2
+    a2 <- ((fa + 4 * fd + fb) * h)/6
+    if(abs(a1 - a2) < eps)
+	return(a2)
+    if(limit == 0) {
+	warning(paste("iteration limit reached near x = ",
+		      d))
+	return(a2)
+    }
+    area(f, a, d, ..., fa = fa, fb = fd, limit = limit - 1,
+	 eps = eps) + area(f, d, b, ..., fa = fd, fb =
+	 fb, limit = limit - 1, eps = eps)
+}
+## The function to be integrated
+fbeta <- function(x, alpha, beta)
+{
+    x^(alpha - 1) * (1 - x)^(beta - 1)
+}
+## Compute the approximate integral, the exact integral and the error
+b0 <- area(fbeta, 0, 1, alpha=3.5, beta=1.5)
+b1 <- exp(lgamma(3.5) + lgamma(1.5) - lgamma(5))
+c(b0, b1, b0-b1)
+## Modify the function so that it records where it was evaluated
+fbeta.tmp <- function (x, alpha, beta)
+{
+    val <<- c(val, x)
+    x^(alpha - 1) * (1 - x)^(beta - 1)
+}
+## Recompute and plot the evaluation points.
+val <- NULL
+b0 <- area(fbeta.tmp, 0, 1, alpha=3.5, beta=1.5)
+plot(val, fbeta(val, 3.5, 1.5), pch=0)
+## Better programming style -- renaming the function will have no effect.
+## The use of "Recall" as in V+R is VERY black magic.  You can get the
+## same effect transparently by supplying a wrapper function.
+## This is the approved Abelson+Sussman method.
+area <- function(f, a, b, ..., limit=10, eps=1e-5) {
+    area2 <- function(f, a, b, ..., fa = f(a, ...), fb = f(b, ...),
+		      limit = limit, eps = eps) {
+	h <- b - a
+	d <- (a + b)/2
+	fd <- f(d, ...)
+	a1 <- ((fa + fb) * h)/2
+	a2 <- ((fa + 4 * fd + fb) * h)/6
+	if(abs(a1 - a2) < eps)
+	    return(a2)
+	if(limit == 0) {
+	    warning(paste("iteration limit reached near x =", d))
+	    return(a2)
+	}
+	area2(f, a, d, ..., fa = fa, fb = fd, limit = limit - 1,
+	      eps = eps) + area2(f, d, b, ..., fa = fd, fb =
+	      fb, limit = limit - 1, eps = eps)
+    }
+    area2(f, a, b, ..., limit=limit, eps=eps)
+}

package/dist/vfs/usr/lib/R/library/base/demo/scoping.R ADDED Viewed

@@ -0,0 +1,50 @@
+## Here is a little example which shows a fundamental difference between
+## R and S.  It is a little example from Abelson and Sussman which models
+## the way in which bank accounts work.	It shows how R functions can
+## encapsulate state information.
+##
+## When invoked, "open.account" defines and returns three functions
+## in a list.  Because the variable "total" exists in the environment
+## where these functions are defined they have access to its value.
+## This is even true when "open.account" has returned.  The only way
+## to access the value of "total" is through the accessor functions
+## withdraw, deposit and balance.  Separate accounts maintain their
+## own balances.
+##
+## This is a very nifty way of creating "closures" and a little thought
+## will show you that there are many ways of using this in statistics.
+#  Copyright (C) 1997-8 The R Core Team
+open.account <- function(total) {
+    list(
+	 deposit = function(amount) {
+	     if(amount <= 0)
+		 stop("Deposits must be positive!\n")
+	     total <<- total + amount
+	     cat(amount,"deposited. Your balance is", total, "\n\n")
+	 },
+	 withdraw = function(amount) {
+	     if(amount > total)
+		 stop("You don't have that much money!\n")
+	     total <<- total - amount
+	     cat(amount,"withdrawn.  Your balance is", total, "\n\n")
+	 },
+	 balance = function() {
+	     cat("Your balance is", total, "\n\n")
+	 }
+	 )
+}
+ross <- open.account(100)
+robert <- open.account(200)
+ross$withdraw(30)
+ross$balance()
+robert$balance()
+ross$deposit(50)
+ross$balance()
+try(ross$withdraw(500)) # no way..