# ------------------------------------------------------------------------------------------------------------------------- # # ----------------------------------------------------------------------------------------------------------------------- # # # # File Name : ggLinegraph_OLD.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 # # # # ----------------------------------------------------------------------------------------------------------------------- # # # # gg_findScaleAutomatically ( vec, nm.vec=substitute(vec), DT=NULL, percent.allowed=TRUE ) # # ggLinegraph_OLD ( DT, x=names(DT)[[1]], y=names(DT)[[2]], color=NULL, fill=NULL, alpha=1 # # , dict.colors=NULL, size=1, linetype=NULL, thickness=size, line_alpha=alpha # # , dotsize=max(2.25, 2.25 * thickness), dot_alpha=alpha, dot_color=color # # , smooth=FALSE, smooth_se=FALSE, smooth_alpha=0.25 * alpha, smooth_method="loess" # # , label=NULL, labelcolor=NULL, labelsize=2 * size # # , labelface=c("plain", "bold", "italic", "bolditalic"), label_y_up=0.05 # # , label_x_up=0, labeljitter=0, labeljitter_x=labeljitter # # , labeljitter_y=labeljitter, labelalpha=1 # # , xscale=gg_findScaleAutomatically(DT=DT, nm=x) # # , yscale=gg_findScaleAutomatically(DT=DT, nm=y), xlims=NULL, ylims=NULL, xlab=NULL # # , ylab=NULL, xlab_append=NULL, ylab_append=NULL, title=NULL, title_append=NULL # # , title_size_rel=1, angledtext.degrees=0, x_angledtext=angledtext.degrees # # , y_angledtext=angledtext.degrees, relativetext.size=1 # # , x_relativetext=relativetext.size - (0.25 * facet_has_free_xy$x) # # , y_relativetext=relativetext.size - (0.25 * facet_has_free_xy$y) # # , facet_formula=NULL # # , facet_scales=c("fixed", "free_x", "free_y", "free"), vline=NULL, vline_value=vline # # , vline_color="#5786ff", vline_alpha=line_alpha * 0.75 # # , vline_thickness=thickness * vline_scale, vline_scale=0.75, hline=NULL # # , hline_value=hline, hline_color="#5786ff", hline_alpha=line_alpha * 0.75 # # , hline_thickness=thickness * hline_scale, hline_scale=0.75 # # , legend=c("right", "bottom", "top", "left", "off"), legend_title_off=FALSE # # , legend_font_size_rel=0.7, legend_key_size_rel=legend_font_size_rel ) # # # # # # # # ----------------------------------------------------------------------------------------------------------------------- # # ------------------------------------------------------------------------------------------------------------------------- # if (FALSE) ggShowLineTypes() if (FALSE) ggLinegraph_OLD <- function(DT , x=names(DT)[[1]] , y=names(DT)[[2]] , color=NULL , fill=NULL ## Not yet used in ggLinegraph , alpha = 1 , dict.colors=NULL ## These parameters are unique to this graph ## ## ----------------------------------------- ## , size=1 , linetype=NULL , thickness=size , line_alpha = alpha , dotsize=max(2.25, 2.25 * thickness) , dot_alpha = alpha , dot_color = color , smooth=FALSE , smooth_se = FALSE , smooth_alpha = .25 * alpha , smooth_method = "loess" ## These parameters are common to all graphs ## ## ----------------------------------------- ## ## label parameters , label = NULL , labelcolor = NULL ## can have length > 1, which will cause a "shadow" effect , labelsize = 2 * size , labelface = c("plain", "bold", "italic", "bolditalic") , label_y_up = 0.05 , label_x_up = 0 , labeljitter = 0 , labeljitter_x = labeljitter , labeljitter_y = labeljitter # diff(range(DT[[y]])) / 25 , labelalpha = 1 ## scale and limits , xscale=gg_findScaleAutomatically(DT=DT, nm=x) , yscale=gg_findScaleAutomatically(DT=DT, nm=y) , xlims=NULL , ylims=NULL ## labs and titles , xlab = NULL , ylab = NULL , xlab_append = NULL , ylab_append = NULL , title=NULL , title_append = NULL , title_size_rel = 1.0 ## angledtext & relativetext affect the x/y axis text , angledtext.degrees = 0 , x_angledtext = angledtext.degrees , y_angledtext = angledtext.degrees , relativetext.size = 1 , x_relativetext = relativetext.size - (0.25 * facet_has_free_xy$x) , y_relativetext = relativetext.size - (0.25 * facet_has_free_xy$y) ## facets , facet_formula = NULL , facet_scales = c("fixed", "free_x", "free_y", "free") ## vline and hline , vline = NULL # synonym to avoid multiple matches , vline_value = vline , vline_color = "#5786ff" , vline_alpha = line_alpha * .75 , vline_thickness = thickness * vline_scale , vline_scale = .75 , hline = NULL # synonym to avoid multiple matches , hline_value = hline , hline_color = "#5786ff" , hline_alpha = line_alpha * .75 , hline_thickness = thickness * hline_scale , hline_scale = .75 ## legend params , legend = c("right", "bottom", "top", "left", "off") , legend_title_off = FALSE , legend_font_size_rel = 0.7 , legend_key_size_rel = legend_font_size_rel ) { ## dotsize :: set to 0 or NULL to turn off dots ## label :: set to a column name (which itslef has the text labels to use) ## labelcolor :: set to NULL to use same as default. Set to a color value to override ## smooth_method :: replaces geom_line with geom_smooth ## h / vline_value :: a value where to insert a verticle line lib(ggplot, quiet=TRUE) ## --------------------------------------------- ## ## ERROR CHECK (this should be standard amongst all premade gg plot funcitons) ## --------------------------------------------- ## if ((!is.null(xscale) && !(xscale %in% gg_scale_functions)) || (!is.null(yscale) && !(yscale %in% gg_scale_functions))) stop (warningCols("xscale and yscale should be NULL or one of the following values:", gg_scale_functions)) args.aes <- c("x", "y", "color", "linetype", "label") for (arg in args.aes) { arg.got <- try(get(arg), silent=TRUE) if (isErr(arg.got) || (!is.null(arg.got) && !is.character(arg.got))) stop ("\nAll aes arguments (", pasteQand(args.aes), ") should be quoted characters or NULL. EG use\n x='date' not x=date\n\nHINT: Offending argument is '", arg, "'") if (!is.null(arg.got) && arg.got %ni% names(DT)) stop ("The ", arg, " aesthetic ('", arg.got, "') is not a column in the DT") } if (!identical(smooth, "+") && !any(c(TRUE, FALSE) %in% smooth)) stop ("'smooth' should be TRUE or FALSE") facet_scales <- match.arg(facet_scales) ## --------------------------------------------- ## ## CLEAN UP LABS ## --------------------------------------------- ## if (missing(ylab)) { ylab <- topropper_keywords(gsub("_", " ", as.character(y))) if (ylab=="Rows") ylab <- "Rows of Data" if (!is.null(yscale)) { if (grepl("percent", yscale)) ylab <- sprintf("%s (%%)", ylab) else if (!grepl("dollar", yscale)) ylab <- sprintf("%s (in %ss)", ylab, gsub("s$", "", yscale)) } } if (!is.null(ylab_append)) ylab <- paste0(ylab, "\n", ylab_append) if (missing(xlab)) { xlab <- topropper_keywords(gsub("_", " ", as.character(x))) if (!is.null(xscale)) { if (grepl("percent", xscale)) xlab <- sprintf("%s (%)", xlab) else if (!grepl("dollar", xscale)) xlab <- sprintf("%s (in %ss)", xlab, gsub("s$", "", xscale)) } } if (!is.null(xlab_append)) xlab <- paste0(xlab, "\n", xlab_append) if (!is.null(title_append)) title <- paste0(title, "\n", title_append) # title <- subtext(title, title_append, body.sub="plain") ## Modify xlab and ylab based on facetting ## Determine if there are x/y facets. If so, we wil add a note to x/y_lab facet_has_free_xy <- doesFacetHaveXY(facet_formula) facet_has_free_xy$x <- facet_has_free_xy$x & facet_scales %in% c("free", "free_x") facet_has_free_xy$y <- facet_has_free_xy$y & facet_scales %in% c("free", "free_y") if (facet_has_free_xy$x) xlab <- subtext(main=xlab, subtext(main="", subtext="Note the different scales on each facet")) if (facet_has_free_xy$y) ylab <- subtext(main=ylab, line3=subtext(main="", subtext="", line3="Note the different scales on each facet")) # ylab <- subtext(main=ylab, subtext=" ", line3="Note the different scales on each facet") ## --------------------------------------------- ## ## Base function P <- ggplot(DT) + aes_string(x = x, y=y) if (!is.null(color)) { P <- P + aes_string(color=color) ## Add a name for the legend if (is.null(names(color))) names(color) <- gg_cleanColumnName(color) } ## Possibly add smoothing on top of if (identical(smooth, "+")) { P <- P + geom_smooth(se=smooth_se, alpha=smooth_alpha, method=smooth_method) } ## Add line ## ------------------------------------------ ## ## If smoothing *insteaad* of geom_line, this function will replace geom_line with geom_smooth geom_line_func <- if (!isTRUE(smooth)) geom_line else function(..., alpha) geom_smooth(..., se=smooth_se, alpha=smooth_alpha, method=smooth_method) if (!is.null(linetype)) P <- P + geom_line_func(aes_string(linetype = linetype), size=thickness, alpha=line_alpha) else P <- P + geom_line_func(size=thickness, alpha=line_alpha) if (!is.null(dotsize) && dotsize > 0) { if (!is.null(dot_color) && !identical(color, dot_color)) P <- P + geom_point(size=dotsize, alpha=dot_alpha, aes_string(color=dot_color)) else P <- P + geom_point(size=dotsize, alpha=dot_alpha) } ## Scale each axis if (!is.null(yscale)) { scale.func.nm <- sprintf("%s.%s", yscale, "y") scale.func <- try(match.fun(scale.func.nm), silent=TRUE) if (isErr(scale.func)) warning("scale function '", scale.func.nm, "' not found") else P <- P + scale.func(limits=ylims) } if (!is.null(xscale)) { scale.func.nm <- sprintf("%s.%s", xscale, "x") scale.func <- try(match.fun(scale.func.nm), silent=TRUE) if (isErr(scale.func)) warning("scale function '", scale.func.nm, "' not found") else P <- P + scale.func(limits=xlims) } if (!is.null(dict.colors)) { if (is.null(color)) stop ("cannot specifiy 'dict.colors' without specifying the 'color' column") ## TODO: Check that if (length(wh.colors.missing <- setdiff(unique(DT[[color]]), names(dict.colors)) )) warning (warningCols("There are unrepresented values for colors", wh.colors.missing)) P <- P + scale_color_manual(values=dict.colors, name=names(color)) } else if (!is.null(names(color))) { ## Different scaling function for discrete vs continuous column in DT if (is.numeric(DT[[color]])) P <- P + scale_color_continuous(name=names(color)) else P <- P + scale_color_discrete(name=names(color)) } if (!is.null(label)) { ## NOTE: Since we are using 'get(label)' inside of the DT, if the DT has a column also named label, scoping will force the wrong label to be used. ## Thus, we are creating the new var ._label. ._label. <- copy(label) labelface <- match.arg(labelface) tmp_DT.label <- DT[!is.na(get(._label.))] if (nrow(tmp_DT.label)) { if (length(labelalpha) < length(labelcolor)) labelalpha <- rev(c(labelalpha, rep(0.3, length(labelcolor))))[seq(labelcolor)] if (label_y_up) tmp_DT.label[, (y) := get(y) + (diff(range(get(y))) * label_y_up) ] if (label_x_up) tmp_DT.label[, (x) := get(x) + (diff(range(get(x))) * label_x_up) ] for (i in unique(c(1, seq_along(labelcolor)))) { # cat(sprintf("%02i : alpha = %s, color = '%s' \n", i, labelalpha[[i]], ifelse(is.null(labelcolor[[i]]), "NULL", labelcolor[[i]] ))) ## I cant find a clean way to include color without redoing the whole line of code if (!is.null(labelcolor[[i]])) P <- P + geom_text(data=tmp_DT.label, aes_string(label=._label.), size=labelsize * (1 -(i-1)*.02), fontface=labelface, position=position_jitter(w=labeljitter_x, h=labeljitter_y), alpha=labelalpha[[i]], show_guide = FALSE, color=labelcolor[[i]]) else P <- P + geom_text(data=tmp_DT.label, aes_string(label=._label.), size=labelsize * (1 -(i-1)*.02), fontface=labelface, position=position_jitter(w=labeljitter_x, h=labeljitter_y), alpha=labelalpha[[i]], show_guide = FALSE) } } # ## using geom_dl # # P + directlabels::geom_dl(aes_string(label="date"), method="top.qp") # if (!is.null(labelcolor)) # P <- P + geom_text(data=DT[!is.na(get(._label.))][, (y) := get(y) + diff(range(total_streams)) / 25 ], aes_string(label=._label.), size=labelsize, fontface=labelface, position=position_jitter(w=labeljitter_x, h=labeljitter_y), color=labelcolor) # else # P <- P + geom_text(data=DT[!is.na(get(._label.))][, (y) := get(y) + diff(range(total_streams)) / 25 ], aes_string(label=._label.), size=labelsize, fontface=labelface, position=position_jitter(w=labeljitter_x, h=labeljitter_y)) } ## Add axis and plot labs P <- P + labs(title=title, x=xlab, y=ylab) + theme(plot.title=element_text(size=rel(title_size_rel))) + angledtext(x=x_angledtext, y=y_angledtext) + relativetext(x=x_relativetext, y=y_relativetext) ## Add vline if (!is.null(vline_value)) { ## If DT$x is a date/time, convert the value to numeric if (is.date_or_time(DT[[x]])) { if (is.Date(DT[[x]]) && !is.Date(vline_value)) vline_value <- as.Date(vline_value, origin=.origin) if (is.POSIXct(DT[[x]]) && !is.POSIXct(vline_value)) vline_value <- as.POIXct(vline_value, origin=.origin.utc) if (is.POSIXlt(DT[[x]]) && !is.POSIXlt(vline_value)) vline_value <- as.POIXlt(vline_value, origin=.origin.utc) vline_value <- as.numeric(vline_value) } P <- P + geom_vline(xintercept=vline_value, alpha=vline_alpha, color=vline_color, linetype=6, size=vline_thickness) } ## Add hline if (!is.null(hline_value)) { ## If DT$y is a date/time, convert the value to numeric if (is.date_or_time(DT[[y]])) { if (is.Date(DT[[y]]) && !is.Date(hline_value)) hline_value <- as.Date(hline_value, origin=.origin) if (is.POSIXct(DT[[y]]) && !is.POSIXct(hline_value)) hline_value <- as.POIXct(hline_value, origin=.origin.utc) if (is.POSIXlt(DT[[y]]) && !is.POSIXlt(hline_value)) hline_value <- as.POIXlt(hline_value, origin=.origin.utc) hline_value <- as.numeric(hline_value) } P <- P + geom_hline(yintercept=hline_value, alpha=hline_alpha, color=hline_color, linetype=6, size=hline_thickness) } ## Set Legend { legend <- match.arg(legend) if (legend == "off") P <- P + theme(legend.position="none") else if (isTRUE(legend_title_off)) P <- P + theme(legend.position=legend, legend.key=element_rect(size=rel(legend_key_size_rel)), legend.text=element_text(size=rel(legend_font_size_rel)), legend.title = element_blank()) else P <- P + theme(legend.position=legend, legend.key=element_rect(size=rel(legend_key_size_rel)), legend.text=element_text(size=rel(legend_font_size_rel))) } ## Facet if (!is.null(facet_formula)) { P <- P + facet_grid(as.formula(facet_formula), scales=facet_scales) } return(P) }