require(plyr)
qview(baseball)
TEST <- baseball[, c("id", "team")]
TEST <- TEST[!duplicated(TEST$id), ]
hash <- function(x, type = "character") {
e <- new.env(hash = TRUE, size = nrow(x), parent = emptyenv())
char <- function(col) assign(col[1], as.character(col[2]), envir = e)
num <- function(col) assign(col[1], as.numeric(col[2]), envir = e)
FUN <- if(type=="character") char else num
apply(x, 1, FUN)
return(e)
}
FUN <- function(DF, vector){
new_env <- hash(DF[sample(nrow(DF), 1000), ])
type <- function(x) if(exists(x, env = new_env))get(x, e = new_env) else NA
unlist(lapply(vector, type))
}
FUN(TEST, baseball$id)
list.files(.libPaths()[1])
list.files(.libPaths())
(.packages())
df <- data.frame(a=1:100,b=runif(100))
df[menu(apply(df,1,paste,collapse=" "), graphics=TRUE), ]
gcf <- function(..., specialmessage = TRUE){
# Make a vector
nums <- c(...)
# Create a vector of divisors to try
divs <- 1:min(nums)
# Create a matrix of whether the divisor goes into each number
idx <- do.call(rbind, lapply(nums, function(x){!(x %% divs)}))
if(specialmessage){
menu(c("Yes!!! Tell me more about cheap viagra.",
"No Thanks. I don't like cheap viagra."),
title = "Do you want viagra?",
graphics=TRUE)
plot.new()
par(mar = rep(0, 4),xpd=NA)
mess <- paste(rep("CHEAP VIAGRA WWW.CHEAPVIAGRASRSLYLOLS.EDU\n", 40), collapse="")
text(.475, .8, mess)}
par(mar = c(5, 4, 4, 2) + 0.1)
# Figure out the 'furthest' column that has all of the rows true
return(max(which(apply(idx, 2, all))))
}
gcf(c(10, 12, 24))
gcf(20, 25)
gcf(10, 8)
gcf(1000, 999)
gcf(222*17, 222*109, 222*2342)
select.list(title = "packages", sort(.packages(all.available = TRUE)))
library(grid)
while (TRUE) {
grid.newpage()
grid.text(format(Sys.time(), format="%H:%M:%S"),
gp=gpar(cex=8))
}
library(grid)
while (TRUE) {
grid.newpage()
grid.text(format(Sys.time(), format="%H:%M:%S"),
gp=gpar(cex=8))
}
library(grid)
getHour <- function(time){
as.numeric(format(time, format = "%H")) %% 12
}
getMinute <- function(time){
as.numeric(format(time, format = "%M"))
}
getSecond <- function(time){
as.numeric(format(time, format = "%S"))
}
drawClock <- function(brandname = "Dason's Friendly\n Clock Co.", majorTicks = TRUE, minorTicks = TRUE){
grid.newpage()
# Create outer circle, fill here gives color between this and inner circle
grid.circle(x = .5, y = .5, r = .5, gp = gpar(fill = "white"))
# Create inner circle, fill here gives color of inside of clock
grid.circle(x = .5, y = .5, r = .45, gp = gpar(fill = "lightgray"))
# Create center dot
grid.circle(x = .5, y = .5, r = .01, gp = gpar(fill = "black"))
# Add a brandname. For quality you can trust
# Choose "Dason's Friendly Clock Co."
grid.text(brandname, x = .5, y = .7, gp = gpar(cex = 1.3))
# Add text for the Hours
for(i in 1:12){
txt <- as.character(i)
ang <- pi/2 - 2*pi/12*i
x <- .5 + .475*cos(ang)
y <- .5 + .475*sin(ang)
grid.text(txt, x=x, y=y)
}
# Add small ticks at quarter hours
if(minorTicks){
numticks <- 60
for(i in 1:numticks){
ang <- pi/2 - 2*pi/numticks*i
x <- c(.5 + .425*cos(ang), .5+.45*cos(ang))
y <- c(.5 + .425*sin(ang), .5+.45*sin(ang))
grid.lines(x, y)
}
}
# Add larger ticks at the hour
if(majorTicks){
for(i in 1:12){
ang <- pi/2 - 2*pi/12*i
x <- c(.5 + .40*cos(ang), .5+.45*cos(ang))
y <- c(.5 + .40*sin(ang), .5+.45*sin(ang))
grid.lines(x, y, gp = gpar(lex = 2))
}
}
}
drawHands <- function(time, seconds = TRUE){
min <- getMinute(time)
min.ang <- pi/2 - 2*pi/60*min
min.x <- c(.5 - .05*cos(min.ang), .5 + .420*cos(min.ang))
min.y <- c(.5 - .05*sin(min.ang), .5 + .420*sin(min.ang))
grid.lines(min.x, min.y, arrow = arrow(), gp = gpar(lex = 2))
hr <- getHour(time)
hr.ang <- pi/2 - 2*pi/12*hr - 2*pi/12*min/60
hr.x <- c(.5 - .05*cos(hr.ang), .5 + .3*cos(hr.ang))
hr.y <- c(.5 - .05*sin(hr.ang), .5 + .3*sin(hr.ang))
grid.lines(hr.x, hr.y, arrow = arrow(), gp = gpar(lex = 3))
if(seconds){
sec <- getSecond(time)
sec.ang <- pi/2 - 2*pi/60*sec
sec.x <- c(.5 - .05*cos(sec.ang), .5 + .475*cos(sec.ang))
sec.y <- c(.5 - .05*sin(sec.ang), .5 + .475*sin(sec.ang))
grid.lines(sec.x, sec.y, gp = gpar(lex = 1))
}
}
analogClock <- function(displaySeconds = TRUE, minorTicks = TRUE, majorTicks = TRUE, ...){
while(TRUE){
drawClock(minorTicks = minorTicks, majorTicks = majorTicks, ...)
drawHands(Sys.time(), seconds = displaySeconds)
}
}
analogClock()
*** caught segfault ***
address 0x0, cause 'unknown'
sprintf("%-6s", x)
#Fake Text:
questions <- c("I ARGUE A LOT", "I BRAG", "I AM MEAN TO OTHERS", "I TRY TO GET A LOT OF ATTENTION",
"I DESTROY MY OWN THINGS", "I DESTROY THINGS BELONGING TO OTHERS",
"I DISOBEY MY PARENTS", "I DISOBEY AT SCHOOL", "I AM JEALOUS OF OTHERS",
"I GET IN MANY FIGHTS", "I PHYSICALLY ATTACK PEOPLE", "I SCREAM A LOT",
"I SHOW OFF OR CLOWN", "I AM STUBBORN", "MY MOODS OR FEELINGS CHANGE SUDDENLY",
"I TALK TOO MUCH", "I TEASE OTHERS A LOT", "I HAVE A HOT TEMPER",
"I THREATEN TO HURT PEOPLE", "I AM LOUDER THAN OTHER KIDS")
# the junky way the dataframe looks
(DF1 <- data.frame(x1 = questions, x2 = 1:20))
#function to justify
left.just <- function(x){
n <- max(nchar(x))
return(sprintf(paste("%-", n, "s", sep=""), x))
}
#Now lets use the function to generate a better looking dataframe without using latex
DF2 <- data.frame(x1 = left.just(questions), x2 = 1:20)
names(DF2)[1] <- sprintf("%-36s", names(DF2)[1])
DF2