reveal-js and r on [2013-05-22 Wed 16:37]

I haven't been doing web programming lately. It seems like most of my time is spent in emacs and R.

I leveled up my R skills today with a productive use of org-mode and org-babel to create a reproducible presentation. What made it truly magical was that the org-babel code output other org markup which was then exported to reveal-js for an amazing presentation.

Here is some of the crazy code:

You can see some crazy ggplot, r mustache code and egregious use of globals.


    #+begin_src R :session *R* :results output drawer :exports results
    data.woe <- calcWOEWithResults("xxxx")
    #+end_src

    #+RESULTS:
    :RESULTS:
    [1] "Pct of bads captured: 35.90"
    [1] "KS: 0.2533"
    :END:

    #+begin_src R :session *R* :results org output :exports results
    calcWOEPerformance()
    #+end_src


plotROC <- function() {
    plot1 <- ggplot(rr,aes(x=cutoff,y=tpr,colour="true positive")) + geom_line() + geom_line(aes(x=cutoff,y=fpr,colour="false positive")) +
        scale_x_continuous(breaks=seq(from=0,to=1,by=.05), expand = c(0, 0), limits=c(0,.5)) +
        scale_y_continuous("detection rate", breaks=seq(from=0,to=1,by=.1), expand = c(0, 0)) +
        geom_text(aes(.2,.9, label=paste0("KS: ", round(data.woe$model.confusion$ks,3), " , Optimal Cutoff: ", round(data.woe$model.confusion$cutoff,3))), size=4, show_guide=F) +
        theme(legend.title=element_blank())

    plot2 <- ggplot(rr,aes(x=fpr,y=tpr,colour="performance")) + geom_line() +
        geom_abline(aes(colour="random"), intercept=0,slope=1) +
        scale_x_continuous(breaks=seq(from=0,to=1,by=.1), expand = c(0, 0)) +
        scale_y_continuous(breaks=seq(from=0,to=1,by=.1), expand = c(0, 0)) +
        geom_text(aes(.1,.9, label=paste0("AUC: ", round(auc,3))), size=4,show_guide=F) +
        theme(legend.title=element_blank())

    gp <- arrangeGrob(plot1,plot2,ncol=1)
    grid.draw(gp)

    file <-  gsub("\\\\", "/", tempfile(paste0("auc-",col),tmpdir=paste0(getwd(),"/charts"), fileext=".png"))
    ggsave(file, gp, height=6.8,width=6.8, dpi=100)
    cat(paste0("[[file:", file, "]]\n"))


}

calcWOEWithResults <- function(label) {
    data.woe <- calcWOE(data.bins)

    results[[label]] <<- data.woe

    print(paste0("Pct of bads captured (lower two deciles): ", format(round(100*data.woe$bads_captured_in_lower_two_deciles,1), nsmall=2)))
    print(paste0("KS: ",  round(data.woe$model.confusion$ks, 4)))
    data.woe
}

calcWOEPerformance <- function() {
tpl <- '
     * Attrition {{AttritionPct}}% out of {{MerchantCt}} Merchants
     * KS: {{KS}}, Decile 1-2 % of Bads {{BadRate}}
'
    cat(whisker.render(tpl, list(
    MerchantCt=nrow(data.woe$data),
    AttritionPct=round(100.0*data.woe$data[,sum(ifelse(Attrition==1,1,0))/.N],2),
    KS=round(data.woe$model.confusion$ks, 3),
    BadRate=format(round(100*data.woe$bads_captured_in_lower_two_deciles,1), nsmall=2)
    )))

    plotROC()


    for(i in 1:length(data.woe$count_tables)) {
        col <- data.woe$cols[(i+1)]
        col <- gsub("_Bin", "", col)
        if (!is.factor(eval(parse(text=paste0("data$", col))))) {
            suppressWarnings(plotVar(col))
        }

        tbl <- data.woe$count_tables[[i]]
        cat(paste0("\n*** ", names(tbl)[1], "\n"))
        print(ascii(tbl), type="org")
    }

    cat(paste0("\n"))
    cat(paste0("\n** Results\n"))
    tab <- tableTotal(data.woe$data_deciles)
    tab[11,AttritionPct:=sum(AttritionCt)/sum(TotalCt)]
    print(ascii(tab[, list(AttritionPct=format(round(AttritionPct*100,2)), PctOfBads=format(round(PctOfBads*100,2)), AttritionCt=format(AttritionCt, nsmall=0), TotalDIAAP=format(TotalDIAAP,nsmall=0,big.mark=","), TotalNetSales=format(TotalNetSales,nsmall=0,big.mark=","))]), type="org")

}



Prev: Posting from qemu on my phone under emacs  Next: New Phone