library(googleVis) fbDTnms <- lsos("fb_agg", type=DT)[, Name] # ~~~~~~~~~~~~~~~~# ## Create namesParsed keepOnlyThoseWithDates <- FALSE namesParsed <- createNamesParsed(fbDTnms, keepOnlyThoseWithDates=keepOnlyThoseWithDates) # - ## If needed, can use # - namesParsed[, list(list(aggdBy)), by=DT.nm] ## Collect all of the unique aggdBy values aggdByVlues <- attr(namesParsed, "unique.aggdBy") ## Create index list out of all the possible combinations maxGroupSize <- length( setdiff(aggdByVlues,"") ) categ.cols.using <- createIndsMatrix(aggdByVlues, maxGroupSize=maxGroupSize) ## Do I want to throw a warning when none-unique rows? uniqueCheck <- TRUE ## POSSIBLE TODO: I might need to create a new table for each combination of "TOTALS" cls(10) s.t({ # -------------- YES DATES ------------------ # names(categ.cols.using) <- lapply(categ.cols.using, makeAggName, date=TRUE) # ---------- # resetCounter("getDTwithTotals") ALL.DTs.yes.totals.yes.dates <- lapply(categ.cols.using, getDTwithTotals, useDate=TRUE, removeUnknownGend=TRUE, addGVisID=TRUE, cleanCamp=FALSE, uniqueCheck=uniqueCheck, iter=FALSE) ALL.DTs.no.totals.yes.dates <- lapply(categ.cols.using, getDTwithTotals, useDate=TRUE, removeUnknownGend=TRUE, addGVisID=TRUE, cleanCamp=FALSE, add.totals.for=NULL, uniqueCheck=uniqueCheck) # -------------- YES DATES ------------------ # }, "Creating Dates Tables") s.t({ # -------------- NO DATES ------------------ # names(categ.cols.using) <- lapply(categ.cols.using, makeAggName, date=FALSE) # ---------- # resetCounter("getDTwithTotals") ALL.DTs.yes.totals.no.dates <- lapply(categ.cols.using, getDTwithTotals, useDate=FALSE, removeUnknownGend=TRUE, addGVisID=TRUE, cleanCamp=FALSE, uniqueCheck=uniqueCheck, debug=FALSE, browser=FALSE, iter=FALSE) print(" ", quote=FALSE); resetCounter("getDTwithTotals") ALL.DTs.no.totals.no.dates <- lapply(categ.cols.using, getDTwithTotals, useDate=FALSE, removeUnknownGend=TRUE, addGVisID=TRUE, cleanCamp=FALSE, add.totals.for=NULL, uniqueCheck=uniqueCheck, iter=TRUE) # -------------- NO DATES ------------------ # }, "Creating No-Dates Tables") DTNameIs <- function(x, main=FALSE, names=FALSE) { if (is.list(x) && !is.twodim(x)) { f <- if (!names) unname else identity return(f(sapply(x, DTNameIs, main=main))) } if (main) return(attributes(x)$aggInfo$mainDT.nm) return(attributes(x)$aggInfo$totsDT.nm) } # ~~~ # # ~# ~ # ~ # 05 Gvis on Date.r PullPlot <- function(PLOTS, cols, date=TRUE, totals=NULL, graph=FALSE) { # IDColNames are simply strings of colu,n names that if the column exists, so should the ID analogue. # if ("label" %in% tolower(categ.cols.using)) # browser() DT.nm <- makeAggName(cols, date=date) if (length(totals) && !is.na(totals)) DT.nm <- paste(c(DT.nm, paste0("Tots4", totals)), collapse="_") nms <- names(PLOTS) DT.m <- nms[match(DT.nm, nms)] if (is.na(DT.m)) { warning("Searching in the names of `", substitute(PLOTS), "`, could not find \n\t", DT.nm, "\nSimilar options will be returned instead\n\n\t") mtchs <- rowSums(sapply(cols, grepl, nms)) match.all <- mtchs == length(cols) if (any(match.all)) nms[which(match.all)] else { warning("Could not find any names that matched all cols. Extending to ± 1 element\n\t") nms[which( abs(length(cols) - mtchs) == 1 )] } } else { cat("Pulling plot for \n\t", DT.m,"\n\n") } if (graph) plot(PLOTS[[DT.m]]) return(DT.m) } # -------------------------------------------------------------------- # # -------------------- PARAMETERS # -------------------------------------------------------------------- # useDate = TRUE # TRUE # useGVisID = TRUE byCols = c("Gender") # -------------------------------------------------------------------- # GVisStateSettings <- '{"xLambda":0,"duration":{"timeUnit":"D","multiplier":1},"xZoomedDataMin":0,"yZoomedDataMax":1807,"yAxisOption":"10","orderedByX":false,"nonSelectedAlpha":0.4,"xZoomedIn":false,"orderedByY":false,"playDuration":29500,"xZoomedDataMax":300,"dimensions":{"iconDimensions":["dim0"]},"xAxisOption":"3","iconKeySettings":[],"yLambda":0,"yZoomedIn":false,"iconType":"BUBBLE","uniColorForNonSelected":false,"colorOption":"2","showTrails":false,"yZoomedDataMin":0,"sizeOption":"16","time":"2013-05-01"}' # GVis Options. A Named list gvisOpts <- list(NULL # gvis.editor = "GvisEditor" , height = 480 , width = 600 , state = GVisStateSettings , showSelectListComponent = FALSE ) # -------------------------------------------------------------------- # ## Determine how to setup byCols if (useDate & !useGVisID) { byCols <- c(byCols, "Date") } else if (useGVisID & !useDate) { byCols <- c("GVisID", byCols) } else { byCols <- c("GVisID", "Date") } ## Put all of the tables together into a single list nms.ALL.DTs.using <- paste0("ALL.DTs.", c("yes", "no"), ".totals.", ifelse(useDate, "yes", "no"), ".dates" ) ALL.DTs <- do.call(c, lapply(nms.ALL.DTs.using, get) ) ALL.DTs <- ALL.DTs[!sapply(ALL.DTs, is.null)] rm(nms.ALL.DTs.using) ## Grab the attirbute Information info.ALL.DTs <- sapply(ALL.DTs, function(x) attributes(x)[c("aggInfo")]) ## Grab the full DT nm (ie, "full" == after appending totals columns) totsDT.nm.ALL.DTs <- sapply(info.ALL.DTs, `[[`, "totsDT.nm") names(totsDT.nm.ALL.DTs) <- gsub("\\.aggInfo$", "", names(totsDT.nm.ALL.DTs)) ## TODO: This should happen at the point getDTwithTotals assigns names names(ALL.DTs) <- totsDT.nm.ALL.DTs ## If any duplicated, remove ALL.DTs <- ALL.DTs [!(duplicated(ALL.DTs))] ### --- INTROSPECTION --- ### ## ## ## This is purely for debugging & tracking ## ## ## dims <- dimCompare(ALL.DTs) dims <- as.data.table(dims, keep.rownames=TRUE) setnames(dims, "rn", "DT.nm") # dims[ , totsDT.nm := (totsDT.nm.ALL.DTs)] dims[, hasTots := grepl("Tots", DT.nm)] dims[, grpByRowCnt := LETTERS[.GRP], by=rows] cat(apply(dims[grpByRowCnt > 1, center(.SD, all=FALSE, align="l", add.endl=TRUE), .SDcols=c("cols", "rows", "DT.nm") ], 1, paste0, collapse="")) ### --- END INTROSPECTION --- ### ## Confirm that they do not have more than one row per unique identifier. readyForGVis <- function(DT, byCols=c("GVisID", "Date"), checkDT=FALSE, track.i=FALSE) { if (track.i) iter.debug() byCols <- names(DT)[ pmatch(byCols, noDot(names(DT)) ) ] # if any columns are missing, then not ready if (any(is.na(byCols))) return (FALSE) # check which rows in DT have more than 1 row per by col {ideally none} ret <- DT[, .N, by=byCols][N > 1, c(byCols, "N"), with=FALSE] ## Can't remember why I wanted this feature if(!checkDT) return(ret) ## Check for labels (troubleshooting) if (nrow(ret) != 0 && any(grepl("label", c(byCols, key(DT)), ignore.case=TRUE))) warning("DT with label not ready for Gvis. ByCols: ", paste0(byCols, collapse=", "), "\n") ## There should be no rows. Rediness is based on this being TRUE return(nrow(ret) == 0) } # Confirm appropriate col names stopifnot(all(sapply(ALL.DTs, function(x) "GVisID" %in% names(x) ))) stopifnot(all(sapply(ALL.DTs, function(x) !".GVisID" %in% names(x) ))) ## Capture all the tables resetCounter(name="readyForGVis", verbose=TRUE) areReadyForGVis <- sapply(ALL.DTs, readyForGVis, checkDT=TRUE, byCols=byCols, track.i=TRUE) # Crop out the bad ones ## WE CAN ALWAYS RECALCULATE! ALL.DTs.unready <- ALL.DTs[!areReadyForGVis] ALL.DTs <- ALL.DTs[areReadyForGVis] # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # Params idvar = byCols[[1]] timevar = byCols[[2]] subFolder = timeStamp("GVisGraphs") # = NULL fixTimeVar = TRUE GraphFolder <- as.path(outDir, {if (is.character(subFolder)) subFolder}) dir.create(GraphFolder, showWarnings=FALSE) GVisPlots <- list() chartids <- list() Gfiles <- list() seconds <- any(duplicated(names(ALL.DTs))) # the time stamp needs seconds only if there are duplicated values. Otherwise, minutes is fine. ## Hasing for chart names... not needed. # LLL <- paste(LETTERS, sort(do.call(paste0, expand.grid(LETTERS, letters[1:3], stringsAsFactors=FALSE))), LETTERS, sep="") # hashes <- setNames(LLL[seq_along(ALL.DTs)], names(ALL.DTs)) for(nm in names(ALL.DTs)) { DT <- ALL.DTs[[nm]] cat("processing ", nm, " ... \n") # nm <- hashes[[nm]] chartid <- timeStamp(nm, seconds=seconds) ## The javascript goes wacky if there are dots ('.') in variable names. ## They should already be removed, but just in case, we make sure they are. chartid <- noDot(chartid) setnames(DT, noDot(names(DT))) ## More than 97% of the results are below 11. Lots of small impressions throwing off the CTR. Should clean this earlier. DT <- DT[CTR < 11] if ("Campaign" %chin% names(DT)) { DT[, Campaign := NULL] # DT[, Campaign := cleanCampName(Campaign)] } ## Convert timevar to a factor if (fixTimeVar) { if (!lubridate::is.Date( DT[[timevar]] ) && !is.numeric( DT[[timevar]] )) { ## If Total is in the column, relevel it so that TOTAL comes first if ( "TOTAL" %in% DT[[timevar]] ) DT[, c(timevar) := as.numeric(relevel(as.factor(DT[[timevar]]), "TOTAL")) ] else DT[, c(timevar) := as.numeric(as.factor(DT[[timevar]])) ] } } GVisPlots[[nm]] <- gvisMotionChart(DT, options=gvisOpts , idvar=idvar, timevar=timevar, chartid=chartid ) ## save to file f.out <- as.path(outDir, {if (is.character(subFolder)) subFolder}, chartid, ext="html") print(GVisPlots[[nm]], file=f.out) # bank the chartid chartids[[nm]] <- chartid Gfiles[[nm]] <- f.out } msgBox("Graphs created in ", GraphFolder) clipCopy(GraphFolder) # ~~~~~~~~~~~~~~~~~ # 06 Ship To Shiny.r shinyFolder <- as.path(srcDir, "FBShiny_app") file.nm <- "Gplots.RDS" f.out <- as.path(shinyFolder, file.nm, expand=FALSE) using <- c( "fb_agg_date" , "fb_agg_date_label" , "fb_agg_date_campaign" , "fb_agg_date_age" , "fb_agg_date_gender" ) # this is what is going to shiny GPlots <- GVisPlots[using] # Temporary, til I establish a better system names(GPlots) <- c("Overview", "Label", "Campaign", "Age", "Gender") saveRDS(GPlots, file=f.out) cat("\nFILE LOCATION: \n\n\t", f.out, "\n\n")