- Thread starter trinker
- Start date
- Tags analysis data fundamental graphics

gave me the idea to try adding

Code:

`setInternet2(TRUE)`

Code:

```
"[" <- function(x, y){base::`[`(x, y+1)}
"[<-" <- function(x, i, value){base::`[<-`(x, i+1, value)}
```

Code:

```
> x <- rnorm(5)
> x
[1] 1.0696787 0.9464659 -0.3197787 -0.4608032 1.0657153
> x[0]
[1] 1.069679
> x[0] <- 1
> x
[1] 1.0000000 0.9464659 -0.3197787 -0.4608032 1.0657153
```

Function for efficiently creating headings when you're working on a big project.

E.G.

1) Type h("main heading",1) into R

2) Press CTRL+V

Code:

```
h <- function(char,type=c(1,2,3)){
if(type==1){
writeClipboard(paste("#%-------------#",toupper(char),"#-------------%#"))
}
if(type==2){
writeClipboard(paste("#------#",char,"#------#"))
}
if(type==3){
writeClipboard(paste("#---",char,"---#"))
}
}
```

1) Type h("main heading",1) into R

2) Press CTRL+V

Last edited:

Code:

```
indexcreation <- function(filename){
con <- file(filename,"r",blocking=FALSE)
file <- readLines(con)
loc1 <- grep("#%-------------#",file,fixed=TRUE)
loc2 <- grep("#------#",file,fixed=TRUE)
loc3 <- grep("#--- ",file,fixed=TRUE)
names1 <- file[loc1]
names2 <- file[loc2]
names3 <- file[loc3]
names1 <- sapply(seq(length(loc1)),function(i) { strsplit(names1," ")[[i]][2] })
names2 <- sapply(seq(length(loc2)),function(i) { strsplit(names2," ")[[i]][2] })
names3 <- sapply(seq(length(loc3)),function(i) { strsplit(names3," ")[[i]][2] })
names <- list(names1,names2,names3)
linenumber <- list(loc1,loc2,loc3)
numberdots <- unlist(sapply(1:length(linenumber),function(i) { rep(length(linenumber)+1-i,length(linenumber[[i]]))*3 }))
numberdots <- sapply(seq(unlist(linenumber)),function(i) { numberdots[i] - length(strsplit(as.character(unlist(linenumber)[i]),"")[[1]]) })
dots <- sapply(1:length(numberdots),function(i) { paste(rep(".",numberdots[i]),collapse="") })
index <- sapply(seq(length(unlist(linenumber))),function(i) { paste(unlist(linenumber)[i],dots[i],unlist(names)[i],sep="") })
locations <- unlist(linenumber)
locations <- match(sort(locations),locations)
index <- unlist(index)[locations]
writeClipboard(matrix(index))
}
```

Code:

```
dput2 <- function(x, indents = 4) {
z <- capture.output(dput(x))
y <- as.character(substitute(x))
y <- y[length(y)]
z[1] <- paste(y, "<-", z[1])
z[-1] <- paste0(paste(rep(" ", indents), collapse=""), z[-1])
zz <- as.matrix(as.data.frame(z))
dimnames(zz) <- list(c(rep("", nrow(zz))), c(""))
if (Sys.info()["sysname"] == "Windows") {
writeClipboard(z, format = 1)
}
if (Sys.info()["sysname"] == "Darwin") {
j <- pipe("pbcopy", "w")
writeLines(z, con = j)
close(j)
}
noquote(zz)
}
#try it:
dput2(mtcars)
dput2(head(mtcars))
```

Code:

`dput2(head(head(mtcars, 20)))`

Code:

```
v.outer <-
function(x, FUN, digits = 3, ...){
FUN <- match.fun(FUN)
if (is.matrix(x)) {
x <- as.data.frame(x)
}
if (is.list(x) & !is.data.frame(x)){
if (is.null(names(x))) {
names(x) <- paste0("X", seq_along(x))
}
nms <- names(x)
} else {
nms <- colnames(x)
}
z <- outer(
nms,
nms,
Vectorize(function(i,j) FUN(unlist(x[[i]]), unlist(x[[j]]), ...))
)
dimnames(z) <- list(nms, nms)
if (is.numeric(z)) {
z <- round(z, digits = digits)
}
z
}
v.outer(mtcars, cor)
v.outer(mtcars, cor, method="kendall")
```

Code:

```
pooled.sd <- function(x, y) {
n1 <- length(x)
n2 <- length(y)
s1 <- sd(x)
s2 <- sd(y)
sqrt(((n1-1)*s1 + (n2-1)*s2)/((n1-1) + (n2-1)))
}
v.outer(mtcars, pooled.sd)
```

1) a function that renames the column names to latex math format for my lab reports - yes I'm an undergrad

2) a search function that returns the first occurrences of unique values in a data.frame column

Code:

```
#################################################
# 1)
# puts $dollar signs in front and behind all column names col_{sub} -> $col_{sub}$
#
###################################################
amscols <- function(x){ colnames(x) <- paste( "$" , colnames(x) , "$" , sep = "" ) x }
#################################################
# 2)
# Returns a data.frame of the first occurances of all unique values of the "search" column
#
###############################################
getfirsts <- function(data, searchcol){
# Receives a data.frame and a "search" column
# Returns a data.frame of the first occurances of all unique values of the "search" column
rows <- as.data.frame(match(unique(data[[searchcol]]), data[[searchcol]]))
firsts = data[rows[[1]],]
return(firsts)
}
```