Nothing
## These functions handle plots of somRes objects
## ----------------------------------------------------------------------------
theme_facet <- function (base_size = 11, base_family = "") {
theme_bw() %+replace%
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.text.x = element_text(angle = 90, hjust = 1),
strip.background = element_blank(),
strip.text = element_text(size = 8, lineheight = 6),
panel.border = element_rect(fill = NA, colour = "grey"),
panel.spacing = unit(0,'lines')
)
}
### Plots (ggplot2 version) grid-like: one graph using parameters$the.grid$coord as coordinates on the plan
#############################################################################################
ggplotGrid <- function(what, type, values, clustering, show.names,
names, the.grid, args = NULL) {
# Axes labels
################################################
if (is.null(args$varname)) {
varname <- colnames(values)[1]
} else varname <- args$varname
labelcolor <- ""
if (is.null(args$labelcolor)) {
if (is.null(args$sc) | type == "color") {
if (type == "hitmap" | type == "poly.dist") {
labelcolor <- "Number of\nobservations"
} else if (what == "prototypes") {
labelcolor <- paste0("value of\n", varname, "\nfor each prototype")
} else {
labelcolor <- paste0("mean of\n", varname)
}
} else {
labelcolor <- "Super_Clusters"
}
} else {
labelcolor <- args$labelcolor
}
# Data
################################################
if (type != "poly.dist")
dataplot <- data.frame("varname" = as.matrix(values)[, 1],
"SOMclustering" = clustering,
the.grid$coord[clustering,],
"Nb" = 1)
# Plot
################################################
if (type == "poly.dist") {
maxi <- max(unlist(values))
mini <- min(unlist(values))
# reverse scale (big distance = small proximity)
values <- lapply(values, function(x) (maxi - x) / (maxi - mini))
# Project on [0.05 - 0.45] interval
values <- lapply(values, function(x) x * (0.45 - 0.05) + 0.05)
#values <- lapply(values, function(x) 0.429 * ((maxi-x)/maxi+0.05))
dataplot <- lapply(1:length(values), function(x)
coords_polydist(x, values, the.grid))
dataplot <- data.frame(do.call("rbind", dataplot))
if (is.null(args$sc)) {
datacolor <- data.frame(table(clustering), stringsAsFactors = FALSE)
colnames(datacolor) <- c("id", "varcolor")
} else {
datacolor <- data.frame("id" = 1:length(args$sc),
"varcolor" = as.character(args$sc))
}
dataplot$numrow <- rownames(dataplot)
dataplot <- merge(dataplot, datacolor, by = "id", all.x = TRUE, sort = FALSE)
dataplot <- dataplot[order(dataplot$numrow), ]
if (is.null(args$sc)) {
dataplot$varcolor <- ifelse(is.na(dataplot$varcolor), 0, dataplot$varcolor)
}
tp <- ggplot(dataplot, aes(x = .data$x, y = .data$y)) +
geom_polygon(data = dataplot,
aes(fill = .data$varcolor, group = .data$id))
}
if (type == "hitmap") {
if (is.null(args$sc)) {
dataplot <- aggregate(data = dataplot, Nb ~ SOMclustering + x + y, length)
dataplot$varname <- dataplot$Nb
} else {
dataplot <- aggregate(data = dataplot,
Nb ~ SOMclustering + x + y + varname, length)
dataplot$varname <- as.factor(dataplot$varname)
}
tp <- ggplot(dataplot, aes(x = .data$x, y = .data$y)) +
geom_point(aes(size = .data$Nb, color = .data$varname)) +
scale_size_area(breaks = c(min(dataplot$Nb), median(dataplot$Nb),
max(dataplot$Nb)),
max_size = min(25,max(dataplot$Nb))) +
labs(size = "Number of\nobservations") + labs(color = labelcolor)
}
if (type == "color") {
dataplot <- aggregate(data = dataplot, varname ~ SOMclustering + x + y,
mean)
if (the.grid$topo == "square") {
tp <- ggplot(dataplot, aes(x = .data$x, y = .data$y, fill = .data$varname)) +
geom_bin2d(stat = "identity", linetype = 1, color = "grey")
} else {
if (requireNamespace("hexbin", quietly = TRUE)) {
tp <- ggplot(dataplot, aes(x = .data$x, y = .data$y, fill = .data$varname)) +
geom_hex(stat = "identity", linetype = 1, color = "grey")
} else {
stop("'hexbin' package required for this plot.", call. = TRUE)
}
}
}
if (type == "grid") {
dataplot <- aggregate(data = dataplot, varname ~ SOMclustering + x + y, mean)
if (the.grid$topo == "square") {
dataplot$varname <- factor(dataplot$varname)
tp <- ggplot(dataplot, aes(x = .data$x, y = .data$y, fill = .data$varname)) +
geom_bin2d(stat = "identity", linetype = 1, color = "grey", size = 0.6)
} else {
dataplot$varname <- factor(dataplot$varname)
if (requireNamespace("hexbin", quietly = TRUE)) {
tp <- ggplot(dataplot,
aes(x = .data$x, y = .data$y, fill = .data$varname,
group = 1)) +
geom_hex(stat = "identity", linetype = 1, color = "grey", size = 0.6)
} else {
stop("'hexbin' package required for this plot.", call. = TRUE)
}
}
}
if (type != "poly.dist") {
tp <- tp + xlim(0.5, max(dataplot$x) + 0.5) + ylim(0.5, max(dataplot$y) + 0.5)
}
tp <- tp + ggtitle(myTitle(args, what)) + coord_fixed() +
labs(fill = labelcolor) + theme_void() +
theme(panel.border = element_rect(fill = NA, colour = "grey"))
if (show.names) {
datagrid <- data.frame(the.grid$coord, names)
tp <- tp + geom_text(data = datagrid,
aes(x = .data$x, y = .data$y, label = .data$names,
fill = NULL))
}
tp
}
### Plots (ggplot2 version) using facet_wraps : need to have one graph by cluster
#############################################################################################
ggplotFacet <- function(what, type, values, clustering = NULL, show.names,
names, is.scaled, the.grid, args){
ordered.index <- orderIndexes(the.grid, type)
# Axes labels
################################################
vary <- "values"
if (!(type %in% c("names", "words", "pie"))) {
if (is.scaled) {
values <- scale(values, is.scaled, is.scaled)
vary <- "scaled_values"
}
}
labely <- vary
if (what %in% c("obs", "add") & type %in% c("barplot", "meanline")) {
labely <- paste0("mean of ", labely)
}
if (what == "prototypes") {
labely <- "values for each prototype"
}
if (type == "names") {
labely <- "frequency of values"
if (type == "names" & !is.null(args$varname)) {
labely <- paste("frequency of", args$varname, "values")
}
if (type == "names" & args$varname %in% c("row.names", "names")) {
labely <- paste("repartition of", args$varname, "values")
}
}
# Data (ggplot way)
################################################
dataplot <- data.frame(values)
nbvar <- ncol(dataplot)
colnames(dataplot)[1:nbvar] <- paste0(vary, "-", colnames(dataplot)[1:nbvar])
dataplot$ind <- rownames(dataplot)
dataplot$SOMclustering <- factor(clustering, levels = ordered.index)
if (is.null(args$sc)) {
dataplot <- reshape(dataplot, varying = 1:nbvar,
idvar = c("ind", "SOMclustering"), sep = "-",
direction = "long", timevar = "variable")
dataplot$variable <- as.factor(dataplot$variable)
labelcolor <- "variable"
} else {
dataplot$varcolor <- args$sc
dataplot <- reshape(dataplot, varying = 1:nbvar,
idvar = c("ind", "SOMclustering", "varcolor"),
sep = "-", direction = "long", timevar = "variable")
dataplot$varcolor <- as.factor(dataplot$varcolor)
labelcolor <- "Super_Clusters"
colnames(dataplot)[match("varcolor", colnames(dataplot))] <- labelcolor
}
# Plot
################################################
if (type == "barplot") {
tp <- ggplot(dataplot,
aes(x = .data$variable, y = !! sym(vary),
fill = !! sym(labelcolor))) +
geom_bar(stat = "summary", fun = mean, fun.args = list(na.rm = TRUE)) +
ylab(labely)
}
if (type == "boxplot") {
tp <- ggplot(dataplot,
aes(x = .data$variable, y = !! sym(vary),
fill = !! sym(labelcolor))) +
geom_boxplot()
}
if (type == "lines") {
if (is.null(args$sc)) {
tp <- ggplot(dataplot,
aes(x = .data$variable, y = !! sym(vary), group = .data$ind)) +
geom_line(alpha = 0.8) + ylab(labely)
} else {
tp <- ggplot(dataplot,
aes(x = .data$variable, y = !! sym(vary),
color = !! sym(labelcolor), group = .data$ind)) +
geom_line(alpha = 0.8) + ylab(labely)
}
}
if (type == "meanline") {
tp <- ggplot(dataplot, aes(x = .data$variable, y = !! sym(vary), group = 1,
colour = !! sym(labelcolor))) +
geom_point(stat = "summary", fun = mean, fun.args = list(na.rm = TRUE)) +
ylab(labely)
if (is.null(args$sc)) {
tp <- tp + stat_summary(fun = mean, fun.args = list(na.rm = TRUE),
geom = "line", colour = "black")
} else {
tp <- tp + stat_summary(fun = mean, fun.args = list(na.rm = TRUE),
geom = "line",
mapping = aes(colour = !! sym(labelcolor)),
show.legend = FALSE)
}
}
if (type == "names") {
dataplot$nb <- 1
sizewords <- 4
if (!is.null(args$size)) sizewords <- args$size
dataplot <- aggregate(data = dataplot, nb ~ values + SOMclustering, length)
tp <- ggplot(dataplot, aes(label = .data$values, size = .data$nb)) +
geom_text_wordcloud(stat = "identity", alpha = 0.7, size = sizewords) +
labs(subtitle = labely)
}
if (type == "words") {
dataplot <- aggregate(data = dataplot, values ~ variable + SOMclustering,
sum)
tp <- ggplot(dataplot, aes(label = .data$variable, size = .data$values)) +
geom_text_wordcloud(stat = "identity", alpha = 0.7) +
labs(subtitle = "sum of values by variable")
}
if (type == "pie") {
if (!is.null(args$varname)) labelcolor <- args$varname
dataplot$Nb <- 1
dataplot$Nbcluster <- 1
datatot <- aggregate(data = dataplot, Nbcluster ~ SOMclustering, sum)
dataplot <- aggregate(data = dataplot, Nb ~ SOMclustering + values, sum)
dataplot <- merge(dataplot, datatot, by = "SOMclustering", all.x = TRUE)
labely <- "Number of observations in the cluster"
dataplot$Share <- dataplot$Nb/dataplot$Nbcluster
# change scale to have proportional areas
dataplot$Nbcluster <- sqrt(dataplot$Nbcluster)/pi
if (!args$proportional) {
labely <- ""
dataplot$Nbcluster <- max(dataplot$Nbcluster)
}
dataplot$halfNbcluster <- dataplot$Nbcluster/2
tp <- ggplot(dataplot,
aes(x = .data$halfNbcluster, y = .data$Share,
fill = .data$values, width = .data$Nbcluster)) +
geom_bar(position = "fill", stat = "identity") + coord_polar("y") +
ylab(NULL) + xlab("Number of individuals in the cluster") +
guides(fill = guide_legend(title = labelcolor))
}
# Handling of the grid order
mylabels <- names[ordered.index]
names(mylabels) <- levels(dataplot$SOMclustering)
tp <- tp + facet_wrap(SOMclustering ~ .,
drop = FALSE,
nrow = the.grid$dim[2],
labeller = labeller(SOMclustering = mylabels),
dir = "h") +
ggtitle(myTitle(args, what)) +
theme_facet()
if (type == "pie") {
tp <- tp + theme(axis.text.x = element_blank(),
axis.title.y = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank())
}
# Clusters titles
if (!show.names) {
tp <- tp + theme(strip.text = element_blank())
}
return(tp)
}
ggplotEnergy <- function(sommap) {
# possible only if some intermediate backups have been done
if (is.null(sommap$backup)) {
stop("no intermediate backups have been registered\n", call. = TRUE)
} else {
dataenergy <- data.frame("Steps" = sommap$backup$steps,
"Energy" = sommap$backup$energy)
p <- ggplot(dataenergy, aes(x = .data$Steps, y = .data$Energy)) +
geom_line() + geom_point() + ggtitle("Energy evolution") + theme_bw()
p
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.