# ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ # # ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- # # # # File Name : ggHeatGrid.r # # Last Updated Funclist : 19 Feb 2015, 1:05 PM (Thursday) # # # # Author Name : Rick Saporta # # Author Email : RickSaporta@gmail.com # # Author URL : www.github.com/rsaporta # # # # Packages Called : NA # # Packages Used via NS : NA # # # # ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- # # # # ggHeatGrid ( DT, xval, yval, byCols=NULL # # , aggFunc=c("count", "sum", "sumn", "mean", "meann"), colToAgg=setdiff(names(DT), c(xval, yval, byCols)), scale=c("scale", "scaleunif", "identity", "log10"), xgrid, ygrid, reverse_x=FALSE # # , reverse_y=FALSE, dontFactor_x=FALSE, dontFactor_y=FALSE, filter.namedlist=list() # # , xlab=gsub("^dl_", "", xval), ylab=gsub("^dl_", "", yval), title="Spotify Downloads" # # , legend.title="downloads" ) # # gridVal ( m ) # # makeFactor ( col.nm, val=get(col.nm), reverse=FALSE ) # # # # # # # # ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- # # ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ # ## --------------------------------------------------- ## NOTE Jan 2015: ## --------------------------------------------------- ## This file was formally in ## "~/git/orch/src/SpotifyAdds/supportFiles/" ## and has otherwise not been touched since Nov 2013 ## --------------------------------------------------- ggHeatGrid <- function(DT, xval, yval , byCols=NULL , aggFunc = c("count", "sum", "sumn", "mean", "meann") , colToAgg=setdiff(names(DT), c(xval, yval, byCols)) , scale=c("scale", "scaleunif", "identity", "log10") , xgrid, ygrid , reverse_x=FALSE , reverse_y=FALSE , dontFactor_x = FALSE , dontFactor_y = FALSE , filter.namedlist=list() , xlab = gsub("^dl_", "", xval) , ylab = gsub("^dl_", "", yval) , title="Spotify Downloads", legend.title="downloads") { # x/ygrid :: What column to facet by. For now, each of xgrid and ygrid must be at most, one item. lib(ggplot2, quietly=TRUE) aggFunc <- match.arg(aggFunc) scale <- match.fun(match.arg(scale)) if (missing(colToAgg) && length(colToAgg) > 1) { numberCol <- nwhich(sapply(intersect(colToAgg, names(DT)), is.numeric)) if (length(numberCol) == 1) colToAgg <- numberCol else if (aggFunc == "count") colToAgg <- colToAgg[[1]] } # browser() ## Check that all the cols are in DT if (!(err <- isValidColumnName(DT, xval, min=1, max=1))) stop(getErrMsg(err)) if (!(err <- isValidColumnName(DT, yval, min=1, max=1))) stop(getErrMsg(err)) if (!(err <- isValidColumnName(DT, byCols, min=NULL, max=NULL, allow_null=TRUE))) stop(getErrMsg(err)) if (!(err <- isValidColumnName(DT, colToAgg, min=NULL, max=1))) stop(getErrMsg(err)) if (!(err <- isValidColumnName(DT, xgrid, min=NULL, max=1, allow_null=TRUE))) stop(getErrMsg(err)) if (!(err <- isValidColumnName(DT, ygrid, min=NULL, max=1, allow_null=TRUE))) stop(getErrMsg(err)) ## include xgrid and ygrid in byCols byCols <- unique(c(byCols, xgrid, ygrid)) gridVal <- function(m) { if (length(m) > 1) stop("Invalid input for ", substitute(m) , ". It must have length of at most 1 .") if (!length(m) || is.na(m) || m==0) return(".") if (is.character(m)) return(m) if (is.numeric(m) && m <= length(byCols) && m > 0 ) return(byCols[[m]]) ## ELSE stop("Invalid input for ", substitute(m) , ". Valid values are:\n", " An integer index to `byCols`; A character name of a column; A period, `.` ; or NA or NULL.") } xgrid <- gridVal(xgrid) ygrid <- gridVal(ygrid) makeFactor <- function(col.nm, val=get(col.nm), reverse=FALSE) { if (is.factor(val)) return(val) func.nm <- paste0("factor.", gsub("^dl_", "", col.nm), "s") if (exists(func.nm, mode="function")) { func <- match.fun(func.nm) ret <- func(val) } else ret <- factor(val) if (reverse) ret <- reverseFactor(ret) return(ret) } kCols <- unique(c(byCols, xval, yval)) if (aggFunc == "count") DT.plot <- unique(DT[, list(value=.N), keyby=kCols]) else { aggFunc <- match.fun(aggFunc) DT.plot <- unique(DT[, list(value = aggFunc(get(colToAgg))), keyby=kCols]) } ## Scale the value if (!identical(scale, identity)) DT.plot[, value.scaled := scale(value), by=byCols] else DT.plot[, value.scaled := list(value)] ## Convert to factors if (!dontFactor_x) DT.plot[, c(xval) := makeFactor(xval, get(xval), reverse=reverse_x)] if (!dontFactor_y) DT.plot[, c(yval) := makeFactor(yval, get(yval), reverse=reverse_y)] # DT.plot[, c(xval, yval) := list( makeFactor(xval, get(xval), reverse=reverse_x) # , makeFactor(yval, get(yval), reverse=reverse_y) ) ] ## FILTERING TO ONLY A GIVEN SUBSET if (length(filter.namedlist)) { if (is.null(names(filter.namedlist))) stop ("filter.namedlist must be a named list") if (!all(names(filter.namedlist) %in% names(DT.plot))) stop ("Some values of filter.namedlist are not in the subset of DT that has been selected.") ## ELSE ## set key to the names, then use CJ to grab all combinations. Take a backup of the key then set it back key.bak <- key(DT.plot) setkeyIfNot(DT.plot, names(filter.namedlist)) DT.plot <- DT.plot[do.call(CJ, filter.namedlist)] setkeyIfNot(DT.plot, key.bak) } if (!nrow(DT.plot)) stop("DT.plot has zero length") if (any(c(xgrid, ygrid) %ni% c(".", names(DT.plot)))) stop("xgrid or ygrid is not a valid name of DT.plot") P <- ggplot(DT.plot, aes_string(x=xval, y=yval)) + geom_tile(aes(fill=value.scaled), alpha=0.75) + scale_fill_continuous(low="blue", high="red", name=legend.title) + xlab(xlab) + ylab(ylab) + theme(panel.grid.major=element_blank() , axis.text.x = element_text(angle=65, vjust=0.20, size=rel(.8)) , axis.text.y = element_text(angle=18, size=rel(.8)) , legend.position = "bottom" , legend.text = element_text(size = rel(.7), colour = "#333333", angle = 60) # , legend.title = element_text(size = rel(.8), colour = "#555555", angle = 30, vjust= 1, hjust=12) , legend.title = element_text(size = rel(.8), colour = "#555555", angle = 00, vjust= 1, hjust=12) ) + ggtitle(title) if (!all("." == c(xgrid, ygrid))) P <- P + facet_grid(as.formula(paste(xgrid, "~", ygrid))) return(P) } # countries <- c("GB", "CA", "SE", "CH", "ES", "DE", "FR", "NO", "FI", "IL","AU", "NL") # setkey(DT.plot, user_country) # DT.plot <- DT.plot[.(countries)] # EXAMPLE 1 if (FALSE) { ## LOAD DATA if (!exists("DB.raw")) { loadFromJesus(file="~/git/orch/data/SpotifyAdds/SAMP/SAMP.DB.raw-!499992x63!-20131109_0029.RDS") DB.raw <- SAMP.DB.raw; rm (SAMP.DB.raw) } ## This is an example of the params needed for ggHeatGrid ## and the resulting DT that will be used timeCol <- "dl_time" wdayCol <- "dl_wday" ydayCol <- "dl_yday" hourCol <- "dl_hour" byCols <- c("upc", "genre", "artist_country", "user_country") colToAgg <- "userid" DT <- copy(DB.raw[, .SD, .SDcols=c(timeCol, wdayCol, ydayCol, hourCol, byCols, colToAgg)]) # eg: DT[, list(value=.N), by=c(wdayCol, hourCol)] ggHeatGrid(DT[user_country %in% c("US", "GB")], yval="dl_wday", xval="dl_hour", xgrid="genre", ygrid="user_country", byCols="genre", aggFunc="count", scale=c("scale") , title="Spotify Downloads", legend.title="downloads", reverse_x=TRUE) last_plot() + scale_x_discrete(breaks=c(" 6 PM", " 6 AM", c("12 PM", "Noon"), "12 AM")) + xlab("") + ylab("") ## Note that for this particular example, the time needs to be shifted for each country's time zone } ## EXAMPLE 2 if (FALSE) { loadIfNotExists("DT.userCounts", srcDir=srcOther("Spotify_Accounting_ETL")) loadIfNotExists("DT.country", srcDir=srcOther("Spotify_Accounting_ETL")) if (!exists("countries_using")) countries_using <- DT.country[!is.na(region_group), country_code] ggHeatGrid(DT.userCounts[country_code %in% countries_using], yval="country_code", xval="month", xgrid="product_description", ygrid=NULL, aggFunc="sumn", scale=c("log10"), colToAgg="active_users", title="User Counts by Country", legend.title="(Log of) Active Users", reverse_x=TRUE, dontFactor_x=TRUE) } # | # mid | # | # 6am | # | # 12pm | # | # 6pm | # | # | # ------|------------------------------------ # # | We Th Fr Sa Su Mo Tu