################################################### ### chunk: assign1 ################################################### x = 10 y = x ################################################### ### chunk: nonstandNames ################################################### `_foo` = 10 "10:10" = 20 ls() ################################################### ### chunk: attrEx ################################################### x = 1:10 attr(x, "foo") = 11 x ################################################### ### chunk: genericEx ################################################### mean ################################################### ### chunk: getmeths ################################################### methods("mean") ################################################### ### chunk: NULL ################################################### length(NULL) c(1, NULL) list("a", NULL) ################################################### ### chunk: NAtypes ################################################### typeof(NA) as.character(NA) as.integer(NA) typeof(as.integer(NA)) ################################################### ### chunk: charNA ################################################### is.na("NA") ################################################### ### chunk: infandnan ################################################### y = 1/0 y -y y-y ################################################### ### chunk: types ################################################### typeof(y) typeof(is.na) typeof(mean) mode(NA) storage.mode(letters) ################################################### ### chunk: testis ################################################### is.integer(y) is.character(y) is.double(y) is.numeric(y) ################################################### ### chunk: colon ################################################### 1:3 1.3:3.2 6:3 x=11:20 x[4:5] ################################################### ### chunk: avec ################################################### x = c(1,2,3,4) x dim(x) = c(2,2) x typeof(x) y = letters[1:10] y dim(y) = c(2,5) y typeof(y) ################################################### ### chunk: createVecs ################################################### c(1, 3:5) c(1, "c") numeric(2) character(2) seq(1, 10, by = 2) seq_len(2.2) seq_along(numeric(0)) sample(1:100, 5) ################################################### ### chunk: simpleFuns ################################################### sum(numeric()) prod(numeric()) ################################################### ### chunk: numericalProb ################################################### a = sqrt(2) a * a == 2 a * a - 2 ################################################### ### chunk: .Machine ################################################### .Machine$integer.max .Machine$integer.max + 1L -.Machine$integer.max -.Machine$integer.max - 1L ################################################### ### chunk: factorEx1 ################################################### set.seed(123) x=sample(letters[1:5], 10, replace=TRUE) y=factor(x) y attributes(y) ################################################### ### chunk: factorEx ################################################### y=sample(letters[1:5], 20, rep=T) v = as.factor(y) xx=list(I=c("a","e"), II=c("b", "c", "d")) levels(v) = xx v ################################################### ### chunk: ordFact ################################################### z= ordered(y) class(z) ################################################### ### chunk: listex ################################################### y = list(a=1, 17, b=4:5, c="a") y names(y) ################################################### ### chunk: listex2 ################################################### l2 = list(mn = mean, var = var) l3 = list(l2, y) ################################################### ### chunk: dimonlist ################################################### tl = list(1:3, "a", 3:9, mean) dim(tl) = c(2,2) tl ################################################### ### chunk: envEx ################################################### e1 = new.env(hash=TRUE) e1$a = 10 ls(e1) e1[["a"]] ################################################### ### chunk: evnAttr ################################################### e1 = new.env() attr(e1, "foo") = 10 e1 e2 = e1 attr(e2, "foo") = 20 e1 ################################################### ### chunk: env1 ################################################### e1 = new.env() e1$z = 10 f = function(x) { x+z} environment(f) = e1 f(10) e1$z = 20 f(10) ################################################### ### chunk: rmEnv ################################################### rm(e1) f(10) f ################################################### ### chunk: capabilities ################################################### capabilities() ################################################### ### chunk: searchLs ################################################### library("geneplotter") search() ls(2) ################################################### ### chunk: strEx ################################################### class(cars) typeof(cars) str(cars) object.size(cars) ################################################### ### chunk: headEx ################################################### head(cars) tail(cars) ################################################### ### chunk: simpleFun ################################################### colSums ################################################### ### chunk: simpFun2 ################################################### get("+") ################################################### ### chunk: add ################################################### x=1:4 x+5 myP = get("+") myP myP(x, 5) ################################################### ### chunk: myPaste ################################################### "%p%" = function(x, y) paste(x, y, sep="") "hi" %p% "there" ################################################### ### chunk: sqbisafun ################################################### myl = list(a1 = 10, b=20, c=30) myl[c(2,3)] myl$a myl["a"] f = "b" myl[[f]] myl$f ################################################### ### chunk: subpos ################################################### x= 11:20 x[c(1,3,5)] ################################################### ### chunk: posind ################################################### x= 1:10 x[1:3] x[9:11] x[0:1] x[c(1,2,NA)] ################################################### ### chunk: charSub ################################################### x=1:5 names(x) = letters[1:5] x[c("a", "d")] names(x)[3] = "a" x["a"] x[c("a", "a")] names(x) %in% "a" ################################################### ### chunk: logicalSubs ################################################### (letters[1:10])[c(TRUE, FALSE, NA)] (1:5)[rep(NA,6)] ################################################### ### chunk: emptySub ################################################### x=matrix(1:9,nc=3) x[,1] x[1,] ################################################### ### chunk: dropSubs ################################################### x[,1,drop=FALSE] x[1,,drop=FALSE] ################################################### ### chunk: arraySubs ################################################### x = 11:20 dim(x) = c(5,2) x[7] ################################################### ### chunk: arrayMatrixSub ################################################### x=array(1:27, dim=c(3,3,3)) y= matrix(c(1,2,3,2,2,2,3,2,1), byrow=TRUE, ncol=3) x[y] ################################################### ### chunk: posassign ################################################### x[1:3] = 10 x ################################################### ### chunk: negassignb ################################################### x=1:10 x[-(2:4)] = 10 x ################################################### ### chunk: NAsubs ################################################### x = 1:5 names(x) = letters[1:5] names(x)[1] = NA x[NA]=20 x[as.character(NA)] = 20 ################################################### ### chunk: subassignall ################################################### x=matrix(1:10, nc=2) x[] = sort(x) ################################################### ### chunk: simpleVect ################################################### x= 11:15 x + 3 ################################################### ### chunk: Vect2 ################################################### nchar(month.name) ################################################### ### chunk: simpRecyc ################################################### 1:10 + 1:3 ################################################### ### chunk: recyc2 ################################################### 1:3 + numeric() 1:3 + NULL x = matrix(1:10, nc=2) x+(1:2) ################################################### ### chunk: replaceEx ################################################### x = 1:4 #x[2] = 10 x = "[<-"(x, 2, value=10) x ################################################### ### chunk: replaceEx ################################################### names(x) = letters[1:4] names(x) x = "names<-"(x, LETTERS[1:4]) x ################################################### ### chunk: Ex eval=FALSE ################################################### ## "rowrep<-" = function(x, i, value) { ## x[i,] = value ## x ## } ################################################### ### chunk: FP ################################################### Map(paste, 1:4, letters[1:4], sep="_") ################################################### ### chunk: FP2 ################################################### set.seed(123) x = rnorm(1000) x = ifelse(abs(x) > 2.2, NA, x) y = x[!is.na(x)] y2 = Filter(Negate(is.na), x) all(y == y2) ################################################### ### chunk: simpleFun ################################################### sq1 = function(x) return(x*x) sq2 = function(x) x*x ################################################### ### chunk: ppc ################################################### ppc = function(x) paste("^", x, sep="") ################################################### ### chunk: forloop ################################################### for(i in 1:3) print(i) for(i in 1:5) if(i > 3 ) break i ################################################### ### chunk: ifelse ################################################### x = matrix(1:10, nc=2) ifelse( x < 2, x, c(10, 11, 12)) ################################################### ### chunk: switchEx ################################################### centre = function(x, type) { switch(type, mean = mean(x), median = median(x), trimmed = mean(x, trim = .1)) } x = rcauchy(10) centre(x, "mean") centre(x, "median") centre(x, "trimmed") ################################################### ### chunk: swDefault ################################################### sw1 = function(x) { switch(x, "10" = 11, "20" = 21, NA) } sw1("10") sw1("x") sw1(10) ##notice the NULL ################################################### ### chunk: swDef2 ################################################### sw2 = function(x) { switch(x, 11, 21, NA) } sw2(1) sw2(4) sw2("a") ##matches to position 1, for some reason ################################################### ### chunk: showErr eval=FALSE ################################################### ## { top = options(show.error.messages=FALSE) ## test = try(readLines(biocURL)[1]) ## options(top) ## if (inherits(test,"try-error")) ## return(FALSE) ## else ## close(biocURL) ## return(TRUE) ## } ################################################### ### chunk: tryCatchEx ################################################### foo = function(x) { if( x < 3 ) list() + x else { if(x < 10 ) warning("ouch") else 33 } } tryCatch(foo(2), error=function(e) "an error", warning = function(e) "a warning") tryCatch(foo(5), error=function(e) "an error", warning = function(e) "a warning") tryCatch(foo(29)) ################################################### ### chunk: filenotfound ################################################### FNFcondition = function (message, call = NULL){ class = c("fileNotFound", "error", "condition") structure(list(message = as.character(message), call = call), class = class) } v1 = FNFcondition("file not found") tryCatch( signalCondition(v1), fileNotFound = function(e) e ) tryCatch( signalCondition(v1), condition = function(e) "condition" ) ################################################### ### chunk: tryCint eval=FALSE ################################################### ## tryCatch(repeat(readline()), ## interrupt=function(e) print("howdy")) ################################################### ### chunk: Restarts ################################################### downloadWithRestarts = function(url, destfile, ...){ repeat withRestarts(return(download.file(url, destfile, ...)), retryDownload = function() NULL, tryNewUrl = function(newUrl) url <<- newUrl) } ################################################### ### chunk: restarts2 eval=FALSE ################################################### ## withCallingHandlers(downloadWithRestarts("http://foo.bar.org", "xyz"), ## error=function(e) { ## cat("Error:", conditionMessage(e),"\n") ## browser()} ## ) ################################################### ### chunk: anotherVariant ################################################### even = function(i) i %% 2 == 0 testEven = function(i) if (even(i) ) i else stop("not even") vals = NULL withCallingHandlers({ for (i in seq_len(10)) { val = withRestarts(testEven(i), skipError=function() return(NULL)) if (!is.null(val)) vals = c(vals, val) }}, error=function(e) invokeRestart("skipError")) vals ################################################### ### chunk: findandget ################################################### find("+") get("+") ################################################### ### chunk: ################################################### assign("+", function(e1, e2) print("howdy")) 1+10 rm("+") 1+10 ################################################### ### chunk: simpleEx ################################################### library(tools) ################################################### ### chunk: getEx ################################################### b = get("foo") b(23) ################################################### ### chunk: printex ################################################### print("a") v = print("a") v ################################################### ### chunk: evalEx ################################################### x=expression(1:10) x eval(x) evalq(x) eval(quote(x)) ################################################### ### chunk: evalEx2 ################################################### e = new.env() e$x = 10 evalq(x, envir=e) ################################################### ### chunk: usesoflocal ################################################### gg = local({ k = function(y) f(y) f = function(x) if(x) x*k(x-1) else 1 }) gg ls(environment(gg)) for (i in 1:5) print( gg(i) ) ################################################### ### chunk: namespaces ################################################### loadedNamespaces() MASS::lda loadedNamespaces() search() ################################################### ### chunk: simpleEx ################################################### foo = function() { y = 10 function(x) x+y } bar = foo() bar is.function(bar) bar(3) ################################################### ### chunk: ex2 ################################################### bar2 = function(x) x + z e1 = new.env() e1$z = 20 tryCatch(bar2(11), error=function(x) "bar2 failed") environment(bar2) = e1 tryCatch(bar2(11), error=function(x) "bar2 failed") ################################################### ### chunk: mlfun ################################################### Rmlfun = function(x) { sumx = sum(x) n = length(x) function(mu) n * log(mu) - mu * sumx } ################################################### ### chunk: mleval ################################################### efun = Rmlfun(1:10) # efun is a function! efun(3) efun2 = Rmlfun(20:30) efun2(3) efun(3) # nothing has changed for efun ################################################### ### chunk: mklike ################################################### Rmklike = function(data) { n = length(data) sumx = sum(data) lfun = function(mu) n * log(mu) - mu * sumx score = function(mu) n / mu - sumx d2 = function(mu) -n / mu^2 list(lfun = lfun, score = score, d2 = d2) } ################################################### ### chunk: newton ################################################### newton = function(lfun, est, tol = 1e-7, niter = 500) { cscore = lfun$score(est) if (abs(cscore) < tol) return(est) for (i in 1:niter) { new = est - cscore / lfun$d2(est) cscore = lfun$score(new) if (abs(cscore) < tol) return(new) est = new } stop("exceeded allowed number of iterations") } ################################################### ### chunk: lexEx2 ################################################### e1 = new.env() e1$a = 10 foo = function(x) x+a environment(foo) = e1 foo(4) ################################################### ### chunk: lexEx2cont ################################################### e1$a = 20 foo(4) e1[["a"]]