R Custom Visual - Setting colours for each value in a field/column

source('./r_files/flatten_HTML.r')

############### Library Declarations ###############
libraryRequireInstall("ggplot2");
libraryRequireInstall("plotly");
libraryRequireInstall("stringr");
libraryRequireInstall("reshape2");
libraryRequireInstall("ggplotify");
libraryRequireInstall("grid");
libraryRequireInstall("readxl");
####################################################

#Enable debugging in RStudio
fileRda = "C:/Users/biedermannf/Temp/tempData.Rda"
if(file.exists(dirname(fileRda)))
{
  if(Sys.getenv("RSTUDIO")!="")
    load(file= fileRda)
  else
    save(list = ls(all.names = TRUE), file=fileRda)
}

###############Internal function definitions#################
# Functions used only for this visual 
#############################################################


#############################################################
# Set up parameters/report variables
#############################################################

validToPlot <- TRUE

# Data
if(!exists("columnGroups")){
	columnGroups <- NULL
	validToPlot <- FALSE
}
if(!exists("overlayGroups") && validToPlot){
	# Set up a dummy variable with a single value
	overlayGroups <- data.frame(OG = factor(rep("Dummy Value", length(columnGroups[, 1])), levels = "Dummy Value"))
}
if(!exists("stackingGroups")){
	stackingGroups <- NULL
}
if(!exists("heights")){
	heights <- NULL
	validToPlot <- FALSE
}
#############################################################
# Column grouping parameters
#############################################################
# Default the column group labels to be slanted at 45 degrees
# and split into lines 30 chars wide.
x.axis.offset.labels <- FALSE
x.axis.labels.srt <- 45
x.axis.hjust <- 1
x.axis.maxwidth <- 30

# overlapping column parameters

# Min and max alpha - bottom column will have min alpha,
# graduating to max alpha for top column
alphaMin <- 0.2
if(exists("settings_overlay_params_alphaMin")){
	alphaMin <- min(1.0, max(0.0, settings_overlay_params_alphaMin))
}

alphaMax <- 0.8
if(exists("settings_overlay_params_alphaMax")){
	alphaMax <- min(1.0, max(0.0,settings_overlay_params_alphaMax))
}

overlay <- 0.8
if(exists("settings_overlay_params_overlay")){
	overlay <- min(1.0, max(0.0, settings_overlay_params_overlay))
}
#############################################################
# Stacking parameters
#############################################################


#############################################################

# Check inputs
if((!exists("columnGroups") ||!exists("heights"))) # invalid input 
{
  validToPlot <- FALSE
}

if(validToPlot){
	# Set up variables to hold the names of the supplied data columns (there'll only be one column in each incoming data frame)
	cGrpsName <- names(columnGroups)[[1]]
	oGrpsName <- names(overlayGroups)[[1]]
	heightsName <- names(heights)[[1]]

	# Set up column groups
    columnGroups[, cGrpsName] <- str_wrap(columnGroups[, cGrpsName], width = 30)
	colGrps <- factor(columnGroups, levels = unique(columnGroups), ordered = T)
	
	# Set up overlay groups
	oGrps <- NULL
	nGrps <- 1
	if(exists("overlayGroups")){
		oGrps <- levels(overlayGroups[, oGrpsName])
		nGrps <- length(oGrps)
	}
  columnWidth <- 0.9 / (nGrps - (nGrps - 1) * overlay)
}
	
if(validToPlot){
	# Base ggplot
	g <- ggplot(data=data.frame(columnGroups, overlayGroups, heights), aes(x = get(cGrpsName), y = get(heightsName), fill = get(oGrpsName)))

	# Loop through each overlay group (there should be at least a dummy group here) and add to plot
    for(i in 1:nGrps){
      g <- g + geom_col(data = data.frame(columnGroups, overlayGroups, heights)[overlayGroups[, oGrpsName] == oGrps[i], ], aes(x = get(cGrpsName), y = get(heightsName), fill = get(oGrpsName)), width = columnWidth, position = position_nudge(x = 0.9*((i-1)/(nGrps-1)-1/2) + columnWidth * (1/2-(i-1)/(nGrps-1))) )
 	}	 

	if(nGrps == 1){
		
		# Don't produce a legend as it'll just display "Dummy Value"
		# ToDo: this won't necessarily be the case if data coming only has one value in a supplied overlayGroups column - needs to be fixed
		
		g <- g + theme(legend = element_blank())

		# Set the colours of the columns
		g <- g + scale_fill_manual(values=alpha(c("springgreen4", "cornflowerblue"), c(alphaMin, alphaMax)), breaks = oGrps)
		
	} else {
		
		# Set the colours of the columns
		g <- g + scale_fill_manual(values=alpha(c("springgreen4", "cornflowerblue"), seq(alphaMin, alphaMax, length = nGrps)), breaks = oGrps)

		# Add the correct axis labelling
		g <- g + labs(x = cGrpsName, y = heightsName);

		# Rotate the x axis text labels (if required)
		g <- g + theme(axis.text.x = element_text(size = 6, angle = x.axis.labels.srt, hjust = x.axis.hjust, vjust = 1), legend.title = element_blank(), axis.title.x = element_blank());
	
	}
	
	#
	g <- g + theme(plot.margin = unit(c(0, 0, 0, 0), "native"))

	# plotly doesn't currently like mucking around with grobs - leave it commented out for now.
	# if (x.axis.offset.labels == TRUE){
	  
	  # # Adjust alternate tick lengths to be longer

	  # gg <- ggplotGrob(g)
	  
	  # xaxis <- gg$grobs[[which(gg$layout$name == "axis-b")]]
	  
	  # # Get the tick marks and tick mark labels   
	  # ticks <- xaxis$children[[2]]
	  
	  # # Get the tick marks
	  # marks = ticks$grobs[[1]]
	  
	  # # change the length in an alternating way
	  
	  # long <- unit.c(unit(1, "npc") - unit(18, "pt"), unit(1, "npc"))
	  # short <- unit.c(unit(1, "npc") - unit(4, "pt"), unit(1, "npc"))
	  
	  # # update the length
	  # marks$y = unit.c(rep(unit.c(short, long), 4), short)
	  
	  # # Put the tick marks back into the plot
	  # ticks$grobs[[1]] <- marks
	  # xaxis$children[[2]] <- ticks
	  # gg$grobs[[which(gg$layout$name == "axis-b")]] <- xaxis
	  
	  # g <- as.ggplot(gg)
	# }
	
} else {
	g <- ggplot() + theme(axis.line = element_blank()) + labs(title = "Invalid data - cannot produce plot")
}

p <- ggplotly(g);

####################################################

############# Create and save widget ###############
internalSaveWidget(p, 'out.html');
####################################################