Today I Learned: ____

[trinker]

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.

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

 

[trinker]

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

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]

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

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]

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:

list.files(.libPaths()[1])

It seems that:

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:

(.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]

TIL: From SO ...

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

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.

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)

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.

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

 

[trinker]

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

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)

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...

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()

 

[trinker]

That's awesome and I see you got an advertisement in

 

[bukharin]

So I tried Dason's clock and after the screen flashing crazily for a few seconds I got this:

 *** caught segfault ***
address 0x0, cause 'unknown'

"For quality you can trust" indeed!!

 

[bryangoodrich]

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]

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:

 *** 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]

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]

That was an awesome analog clock. Can we have the option of setting alarm?

 

[trinker]

TIL: You can left justify items using:

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?

#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

 

[Dason]

That was an awesome analog clock. Can we have the option of setting alarm?

Wouldn't be too hard. What kind of alarm are you thinking? System beep or something like an mp3?

 

[ledzep]

mp3 would be awesome.