# Today I Learned: ____

#### trinker

##### ggplot2orBust
TIRL: I think TE showed us this a while back but I forgot to ever play with it. the sos package is a nicely formatted way of searching for R functions for a particular topic and the results are scored to help you make choices.

Code:
library(sos)
findFn("venn")
findFn("correlation")

#### trinker

##### ggplot2orBust
TIL: Hash tables can be created inside of a function. Previously I was under the impression that a hash table has to be created outside of a function because I thought you were creating a new environment. Not so as seen in the code below (The hash function is compliments of bryangoodrich):

Code:
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)

#### Lazar

##### Phineas Packard
TIL: You can nest ifelse calls. Seems somewhat obvious but never really thought about it before. For example

Code:
x<- rep(c('M', 'F', 'I'), each=10)

y<- ifelse(x=='M', 1, ifelse(x=='F', 2, 3))

#### Dason

TIL: .packages(all = TRUE) give a list of all the packages available to you.

You can also use library() with no parameters to get the name and a small summary of all the packages available. The function .installed.packages() gives a lot of info about each package but the output is harder to read.

#### trinker

##### ggplot2orBust
I knew about library() and installed.packages() but not .packages(all=TRUE). The .packages() doesn't seem to do anything on my system. Thanks for sharing.

EDIT:
Incidentally, last night I was creating a backup of all my non primary install packages and used:
Code:
list.files(.libPaths()[1])
It seems that:
Code:
list.files(.libPaths())
Is almost the same as .packages(all=TRUE)

2nd EDIT:
To make .packages() show something wrap it with parenthesis. It actually shows what packages are currently loaded:
Code:
(.packages())

#### Dason

Oops you're right! I meant to put installed.packages() and was going to move it to a different sentence describing what it does. I had it there at first but I already knew about that so I wanted to move it. Looks like I messed that post up. Time for some edits.

#### trinker

##### ggplot2orBust
TIL: From SO ...

menu can be used more as a gwidgets type interface. It's pretty cool : )

Code:
df <- data.frame(a=1:100,b=runif(100))
df[menu(apply(df,1,paste,collapse="  "), graphics=TRUE), ]
EDIT: Dason didn't see the potential for this function but he'll soon come to my way of thinking after using an advertising function he proposed earlier.
Code:
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){
"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)
EDIT 2
I added a title to the menu with the title = argument.

Also I found out select.list() is exactly like menu with the graphics = TRUE but instead of returning the numeric rank on the list it returns a character string version of what ever was selected from the list.

Code:
select.list(title = "packages", sort(.packages(all.available = TRUE)))

#### trinker

##### ggplot2orBust
TIL: How to make a clock (a real plot window one) in R compliments of Paul Murrell (A great resource)

Code:
library(grid)
while (TRUE) {
grid.newpage()
grid.text(format(Sys.time(), format="%H:%M:%S"),
gp=gpar(cex=8))
}
Note sure of the use but fun

#### Dason

TIL: How to make a clock (a real plot window one) in R compliments of Paul Murrell (A great resource)

Code:
library(grid)
while (TRUE) {
grid.newpage()
grid.text(format(Sys.time(), format="%H:%M:%S"),
gp=gpar(cex=8))
}
Note sure of the use but fun
But analog clocks are much more fun...
Code:
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()

#### bukharin

##### RoboStataRaptor
So I tried Dason's clock and after the screen flashing crazily for a few seconds I got this:
Code:
 *** caught segfault ***
address 0x0, cause 'unknown'
"For quality you can trust" indeed!!

#### bryangoodrich

##### Probably A Mammal
Trinker, since you're only displaying seconds, you might as well put a Sys.sleep(1) in there; otherwise, it just blinks a lot on my slow PC. Is there any way to listen for a user input to cancel the clock? Like, once any key is pressed, turn off the device and break out of the loop?

#### trinker

##### ggplot2orBust
bryangoodrich said:
Is there any way to listen for a user input to cancel the clock? Like, once any key is pressed, turn off the device and break out of the loop?
You can use escape on a windows machine(maybe others too) any other key stroke seems to freeze R.

#### Dason

Trinker, since you're only displaying seconds, you might as well put a Sys.sleep(1) in there; otherwise, it just blinks a lot on my slow PC. Is there any way to listen for a user input to cancel the clock? Like, once any key is pressed, turn off the device and break out of the loop?
The only way I know of to do something like that is to use something like gWidgets.

So I tried Dason's clock and after the screen flashing crazily for a few seconds I got this:
Code:
 *** caught segfault ***
address 0x0, cause 'unknown'
"For quality you can trust" indeed!!
I have no idea why that would happen. This is the first time I've used grid though.

#### bryangoodrich

##### Probably A Mammal
No, that doesn't work in a Linux terminal.

#### Dason

I just tested it on my linux laptop and yeah it's pretty choppy without a Sys.sleep(1) in there. I had one originally but sometimes it would skip 2 seconds ahead so I took it out.

To make it stop make sure you're at the console and Ctrl-C should kill loop.

#### ledzep

##### Point Mass at Zero
That was an awesome analog clock. Can we have the option of setting alarm?

#### trinker

##### ggplot2orBust
TIL: You can left justify items using:
Code:
sprintf("%-6s", x)
An extension for me would be in using it for my discourse analysis package as seen below. I am thinking of a way to make the adding apaces to the cells and column name one smooth function. Not sure how to approach. Ideas?

Code:
#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