# -------------------------------------------------------------------------------------------------------------------------------------------------------------------------- # # ------------------------------------------------------------------------------------------------------------------------------------------------------------------------ # # # # File Name : ggScatterPlot.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 : RColorBrewer # # # # ------------------------------------------------------------------------------------------------------------------------------------------------------------------------ # # # # ggScatterPlot ( DB.Plot, x=names(DB.Plot)[[1]], y=names(DB.Plot)[[2]], color="genre", shape=color # # , scalex=scale_x_log10() # # , colpalette=c(RColorBrewer::brewer.pal(8, "Set2"), RColorBrewer::brewer.pal(8, "Accent"), RColorBrewer::brewer.pal(8, "Dark2")), shapepalette=NULL # # , dontResetAlpha=FALSE, mute=list() # # , pointSize=ifelse(any(shapepalette %in% LETTERS), 3.5, 2), title=NULL # # , facet.formula=formula(.eg ~ .eg), white.empha.filter=expression() # # , black.empha.filter=expression(), bottom.perc.cutoff=0, top.perc.cutoff=100 # # , x.bottom.perc.cutoff=bottom.perc.cutoff, x.top.perc.cutoff=top.perc.cutoff # # , y.bottom.perc.cutoff=bottom.perc.cutoff, y.top.perc.cutoff=top.perc.cutoff, na.rm=TRUE # # , x.na.rm=na.rm, y.na.rm=na.rm, debug=FALSE ) # # # # # # # # ------------------------------------------------------------------------------------------------------------------------------------------------------------------------ # # -------------------------------------------------------------------------------------------------------------------------------------------------------------------------- # ## --------------------------------------------------- ## NOTE Jan 2015: ## --------------------------------------------------- ## This file was formally in ## "~/git/orch/src/SpotifyAdds/supportFiles/gg_scatterplot.r" ## and has otherwise not been touched since Nov 2013 ## (also, has been renamed without the underscore, and camelcase added) ## --------------------------------------------------- # ============= # # ScatPlot <- function(...) { # warning("ScatPlot() has been deprecated.\nUSE ggScatterPlot()") # ggScatterPlot(...) # } ggScatterPlot <- function(DB.Plot ## AESTHETICS , x=names(DB.Plot)[[1]] , y=names(DB.Plot)[[2]] , color="genre" , shape=color , scalex=scale_x_log10() , colpalette=c(RColorBrewer::brewer.pal(8, "Set2"), RColorBrewer::brewer.pal(8, "Accent"), RColorBrewer::brewer.pal(8, "Dark2")) , shapepalette=NULL, dontResetAlpha=FALSE , mute=list() , pointSize = ifelse(any(shapepalette %in% LETTERS), 3.5, 2) , title=NULL , facet.formula=formula(.eg~.eg) , white.empha.filter=expression(), black.empha.filter=expression() , bottom.perc.cutoff = 0, top.perc.cutoff = 100 , x.bottom.perc.cutoff = bottom.perc.cutoff, x.top.perc.cutoff = top.perc.cutoff , y.bottom.perc.cutoff = bottom.perc.cutoff, y.top.perc.cutoff = top.perc.cutoff , na.rm=TRUE, x.na.rm=na.rm, y.na.rm=na.rm , debug=FALSE ) { lib(ggplot, quiet=TRUE) lib(RColorBrewe, quiet=TRUE) browser(expr={identical(debug, 0)}, text="at the very top of ggScatterPlot()") ## SET alpha if (!dontResetAlpha) DB.Plot[, alpha := 1] for (nms in names(mute)) DB.Plot[get(get(nms)) %in% mute[[nms]], alpha := 0.4 ] if (!is.null(color) && any(is.na(DB.Plot[[color]]))) warning("There are ", sum(is.na(DB.Plot[[color]])), " NAs in", color) if(!is.null(shape) && any(is.na(DB.Plot[[shape]]))) warning("There are ", sum(is.na(DB.Plot[[shape]])), " NAs in", shape) en <- parent.frame() if (missing(shapepalette) && !is.null(shape)) { shape.clean <- if (grepl("genre", shape)) "genre" else if (grepl("country", shape)) "country" else shape lets.nm <- paste0("letters.", shape.clean) shap.nm <- paste0("shapes.", shape.clean) if (exists(lets.nm, envir=en)) shapepalette <- get(lets.nm, envir=en) else if (exists(shap.nm, envir=en)) shapepalette <- get(shap.nm, envir=en) } if (missing(colpalette) && !is.null(color)) { color.clean <- if (grepl("genre", color)) "genre" else if (grepl("country", color)) "country" else color cols.nm <- paste0("colors.", color.clean) if (exists(cols.nm, envir=en)) colpalette <- get(cols.nm, envir=en) } # ## 2015-01-27: Not sure what 'defaultColPal' or 'drop.bottom.perc' was for...? # ## possibly inside some other script originally calling ggScatterPlot() Commenting out # if (!is.null(color) && identical(colpalette, defaultColPal)) # setattr(defaultColPal, "names", unique(DB.Plot[[color]])) # # if (!is.finite(drop.bottom.perc)) # drop.bottom.perc <- 0 # drop.bottom.perc <- validPercentage(drop.bottom.perc, 0, 100) browser(expr={debug==1}, text="checkpoint 1 in ggScatterPlot()") # -- DEBUG CHECKPOINT 1 -- # toKeep <- DB.Plot[, { if (x.na.rm) !is.na(get(x)) else TRUE } & { if (y.na.rm) !is.na(get(y)) else TRUE } & withinCutoff(get(x), x.bottom.perc.cutoff, x.top.perc.cutoff) & withinCutoff(get(y), y.bottom.perc.cutoff, y.top.perc.cutoff) ] toKeep <- NAtoFALSE(toKeep) facetting <- (!is.null(facet.formula) && !identical(facet.formula, formula(.eg~.eg))) browser(expr={debug==2}, text="checkpoint 2 in ggScatterPlot()") # -- DEBUG CHECKPOINT 2 -- # ## SETUP THE BASE LAYER OF THE PLOT ## P <- ggplot(DB.Plot[toKeep], aes_string(x=x, y=y, color=color, shape=shape, alpha="alpha")) + scale_alpha(guide='none') + scale_y_log10() ##### -------- OPTIONALLY ADD EMPHASIS ---------- ##### if (!is.null(white.empha.filter) && !identical(white.empha.filter, expression())) { if (!is.expression(white.empha.filter)) stop("`white.empha.filter` should be an expression.") browser(expr={debug=="w"}, text="checkpoint w in ggScatterPlot()") # -- DEBUG CHECKPOINT w -- # toKeep2 <- indexToLogical(DB.Plot[, eval(white.empha.filter)]) & toKeep & !is.na(DB.Plot[[x]]) & !is.na(DB.Plot[[y]]) if (!any(toKeep2, na.rm=TRUE)) stop("`white.empha.filter` results in 0 rows selected.") P <- P + geom_point(data=DB.Plot[toKeep2], aes_string(x=x, y=y), size=rel(3), alpha=0.1, color="white") + geom_point(data=DB.Plot[toKeep2], aes_string(x=x, y=y), size=rel(2), alpha=0.4, color="red") } if (!is.null(black.empha.filter) && !identical(black.empha.filter, expression())) { if (!is.expression(black.empha.filter)) stop("`black.empha.filter` should be an expression.") browser(expr={debug=="b"}, text="checkpoint b in ggScatterPlot()") # -- DEBUG CHECKPOINT b -- # toKeep2 <- indexToLogical(DB.Plot[, eval(black.empha.filter)]) & toKeep & !is.na(DB.Plot[[x]]) & !is.na(DB.Plot[[y]]) if (!any(toKeep2, na.rm=TRUE)) stop("`black.empha.filter` results in 0 rows selected.") P <- P + geom_point(data=DB.Plot[toKeep2], aes_string(x=x, y=y), size=rel(3), alpha=0.1, color="green") + geom_point(data=DB.Plot[toKeep2], aes_string(x=x, y=y), size=rel(2), alpha=0.4, color="green") } ##### -------- OPTIONALLY ADD EMPHASIS ---------- ##### browser(expr={debug==3}, text="checkpoint 3 in ggScatterPlot()") # -- DEBUG CHECKPOINT 3 -- # ## ------ MAIN PLOT ------ ## P <- P + geom_point(aes_string(size=as.character(pointSize))) + scalex + theme(legend.text=element_text(size=rel(0.6))) if (!is.null(colpalette)) { if (!is.null(names(colpalette))) P <- P + scale_color_manual(values=colpalette) else P <- P + scale_color_brewer(palette=colpalette) } if (!is.null(shapepalette)) P <- P + scale_shape_manual(values=shapepalette) if (facetting) P <- P + facet_grid(facet.formula) browser(expr={debug=="t"}, text="checkpoint t in ggScatterPlot()") # -- DEBUG CHECKPOINT t -- # if (is.null(title)) title <- paste(topropper(y), "by", topropper(x) , if (!is.null(color)) paste0("[",color, ifelse(is.null(shape), "]", " &")) , if (!is.null(shape)) paste0(ifelse(is.null(color), "[", " "),shape,"]") , if(facetting) paste0("\n (", as.ch.as.exp(facet.formula), ")")) P + ggtitle(title) }