Add all files

.Rbuildignore

+^.*\.Rproj$
+^\.Rproj\.user$

.gitignore

+.DS_Store
+.Rproj.user/
+.Rhistory
+

ContrastImportanceDrivenColorAssign.Rproj

+Version: 1.0
+
+RestoreWorkspace: Default
+SaveWorkspace: Default
+AlwaysSaveHistory: Default
+
+EnableCodeIndexing: Yes
+UseSpacesForTab: Yes
+NumSpacesForTab: 2
+Encoding: UTF-8
+
+RnwWeave: Sweave
+LaTeX: pdfLaTeX
+
+AutoAppendNewline: Yes
+StripTrailingWhitespace: Yes
+
+BuildType: Package
+PackageUseDevtools: Yes
+PackageInstallArgs: --no-multiarch --with-keep.source
+PackageRoxygenize: rd,collate,namespace

DESCRIPTION

+Package: ContrastImportanceDrivenColorAssign
+Type: Package
+Title: Contrast Color Driven Assignment For Categorical Visualization
+Version: 0.1.0
+Author: Eric Languenou
+Maintainer: Eric Languenou <eric.languenou@univ-nantes.fr>
+Description: Choose colors from a colormap to be assigned 
+    to object classes in categorical visualizations,
+    using color contrast driven optimization.
+License: GPL-3
+Encoding: UTF-8
+Imports: 
+    R6,
+    GA,
+    gtools,
+    farver,
+    numbers,
+    REdaS,
+    dplyr,
+    spdep,
+    sp,
+    spData,
+    rgdal,
+    rapportools,
+    purrr,
+    ggplot2
+RoxygenNote: 7.2.1

Examples/ChordDiagram/exampleChordDiagram.R

+##############################################
+######### testing chord diagrams #############
+#########  (only directed chord diagrams) ####
+##############################################
+######### many thanks to Yan Holtz from data-to-viz website
+#########  for providing R source for chord-diagrams
+######### (https://www.data-to-viz.com/graph/chord.html)
+##############################################
+######## data coming from a paper by Guy J. Abel
+######## "Estimates of Global Bilateral Migration Flows by Gender between 1960 and 2015"
+######## https://onlinelibrary.wiley.com/doi/abs/10.1111/imre.12327
+
+# Libraries
+library(dplyr) # to obtain %>% operator
+library(tidyverse)
+library(hrbrthemes)
+library(circlize)
+library(kableExtra)
+options(knitr.table.format = "html")
+library(viridis)
+library(igraph)
+library(ggraph)
+library(colormap)
+library(farver)
+
+library(patchwork)
+library(chorddiag)  #devtools::install_github("mattflor/chorddiag") #not in CRAN
+
+library(ContrastImportanceDrivenColorAssign)
+
+############ preparing data ###########
+# Load dataset from github
+data <- read.table("https://raw.githubusercontent.com/holtzy/data_to_viz/master/Example_dataset/13_AdjacencyDirectedWeighted.csv",
+                   header = TRUE)
+
+# short names
+colnames(data) <- c("Africa", "East Asia", "Europe", "Latin Ame.", "North Ame.",
+                    "Oceania", "South Asia", "South East Asia", "Soviet Union", "West.Asia")
+rownames(data) <- colnames(data)
+
+# I need a long format
+data_long <- data %>% rownames_to_column %>% gather(key = "key", value = "value",
+                                                    -rowname)
+
+########### computing importance matrix ###########
+ nb = length(colnames(data))
+ chordImp = ChordDiagramImportance$new(nb)
+ chordImp$calculateImportanceMatrix(data,"DIRECTIONAL")
+ chordImp
+impMatrix <- chordImp$getImportanceMatrix()
+
+######## choosing colormap  ###########
+chordColor <- viridis(nb, alpha = 1, begin = 0, end = 1, option = "D")
+chordColor <- chordColor[sample(1:nb)]
+chordColorRGB <- t(col2rgb(chordColor))
+
+###########  color distance Matrix  (using farver) ###########
+colorDistanceMatrix <- compare_colour(chordColorRGB, chordColorRGB, 'rgb', method = 'cie2000')[1:nb, 1:nb]
+
+
+############### setting the optimizer #################
+clao = ColorGroupAssignmentOptimizer$new(nb)
+clao$setImportanceMatrix(impMatrix)
+clao$setColorDistanceMatrix(colorDistanceMatrix)
+
+nbGeneration <- 100  #5000
+nbPopulation <- 400
+clao$associateByGA(nbGeneration,nbPopulation)
+bestPerm <- clao$getBestPermutation()
+bestChordColor <- clao$getBestAssignmentColormap(chordColor)
+
+########### display of the chord diagram   ###########
+circos.clear()
+circos.par(start.degree = 90, gap.degree = 4, track.margin = c(-0.1, 0.1), points.overflow.warning = FALSE)
+par(mar = rep(0, 4))
+
+# Base plot
+chordDiagram(
+  x = data_long,
+  grid.col = bestChordColor,
+  transparency = 0.25,
+  directional = 1,
+  direction.type = c("arrows", "diffHeight"),
+  diffHeight  = -0.04,
+  annotationTrack = "grid",
+  annotationTrackHeight = c(0.05, 0.1),
+  link.arr.type = "big.arrow",
+  link.sort = TRUE,
+  link.largest.ontop = TRUE)
+
+# Add text and axis
+circos.trackPlotRegion(
+  track.index = 1,
+  bg.border = NA,
+  panel.fun = function(x, y) {
+
+    xlim = get.cell.meta.data("xlim")
+    sector.index = get.cell.meta.data("sector.index")
+
+    # Add names to the sector.
+    circos.text(
+      x = mean(xlim),
+      y = 3.2,
+      labels = sector.index,
+      facing = "bending",
+      cex = 0.7 #font size
+    )
+
+    # Add graduation on axis
+    circos.axis(
+      h = "top",
+      major.at = seq(from = 0, to = xlim[2], by = ifelse(test = xlim[2]>10, yes = 2, no = 1)),
+      minor.ticks = 1,
+      major.tick.length = mm_y(1),
+      #major.tick.percentage = 0.5,
+      labels.niceFacing = FALSE)
+  }
+)
+
+########### exporting some matrices visus ###########
+######### Europe elementary matrix
+#elemImpMatrix<-chordImp$getElementaryImportancesForGroup(3)
+#clao$exportGgplotMatrixVisuAsPdf("visuEuropeElemImpMatrix.pdf",elemImpMatrix,colnames(data),14,20,20)
+######### importance synthesis matrix
+#clao$exportGgplotMatrixVisuAsPdf("visuChordDiagImpMatrix.pdf",clao$getImportanceMatrix(),colnames(data),14,20,20)
+######### comparison visu
+#clao$exportGgplotComparisonVisuAsPdf("visuChordDiagComparisonOptimPermComp.pdf", chordColor, colnames(data),14,20,20)
+#clao$exportGgplotComparisonVisuNoPermutationAsPdf("visuChordDiagComparisonOptimNOPermComp.pdf", chordColor, colnames(data),14,20,20)
+#clao$exportGgplotComparisonVisuRandomPermutationAsPdf("visuChordDiagComparisonOptimRANDOMPermComp.pdf", chordColor, colnames(data),14,20,20)
+
+
+

Examples/LineGraphs/exampleLineGraphs.R

+#######################################################
+###########  line graphs testing
+#######################################################
+
+library(dplyr)
+library(tibble)
+library(viridis)
+library(data.table) # for transpose
+library(ggplot2)
+library(ggdark)
+library(stats)
+library(purrr)
+library(farver)
+
+library(ContrastImportanceDrivenColorAssign)
+#######################################################
+# Remove the full list of R objects in session
+rm(list = ls())
+
+#####-final visu aspect ratio is necessary to slope computation
+finalWindowAspectRatio <- 1.5    #1/2
+#####
+lineWidth = 0.5
+########### loading brut data  #################
+### data coming from our world in data
+###  https://ourworldindata.org/grapher/percentage-of-americans-living-alone-by-age
+### Data published by	Steven Ruggles, Sarah Flood, Ronald Goeken, Josiah Grover, Erin Meyer, Jose Pacas, and Matthew Sobek.
+### IPUMS USA: Version 8.0 [dataset]. Minneapolis, MN: IPUMS, 2018. https://doi.org/10.18128/D010.V8.0
+### https://usa.ipums.org/usa/
+gBrut <-
+  read.csv(
+    '/Users/languenou-e/Dev/Dev_R/ProjectColorLayerContrastAssign/ImportanceDrivenColorAssign/Examples/LineGraphs/percentage-of-americans-living-alone-by-age.csv'
+  )
+
+gBrut <- gBrut[, c(1, 3, 4)]
+colnames(gBrut)
+colnames(gBrut) = c(colnames(gBrut[1:2]), "Percent") #reducing colname percent..
+colnames(gBrut)
+########### data for importance #################@
+
+##### long to wide using spread() function of tidyr package
+library(tidyr)
+colnames(gBrut)
+groupNames = unique(gBrut$Entity)
+
+dataImportance = spread(gBrut, Entity, Percent)
+dataImportance
+print(ncol(dataImportance))
+
+########### importance evaluation #################
+nb <- (ncol(dataImportance)) - 1
+print(paste("nb lines :", nb, sep = " "))
+lineGraphImp <- LigneGraphImportance$new(nb)
+lineGraphImp$setAngleDegreeLimit(20)
+lineGraphImp$setProximityLimitPercentage(10 / 100)
+lineGraphImp$calculateImportanceMatrix(dataImportance, "Year", finalWindowAspectRatio)
+myImpMatrix <- lineGraphImp$getImportanceMatrix()
+#View(myImpMatrix)
+
+########### getting data ratio  #################
+dataRatio <- lineGraphImp$getDataRatio()
+print("dataRatio")
+print(dataRatio)
+########### setting the colormap #######################
+colPalette = viridis(nb)
+
+########### data for plot #################@
+dataPlot <- gBrut ## already in long format
+
+########### aspect ratio #########
+ratioGraphic <- finalWindowAspectRatio / dataRatio
+
+
+######### color matrix ########
+spectrum2 <- t(col2rgb(colPalette))
+colorDistanceMatrix <-
+  compare_colour(spectrum2, spectrum2, 'rgb', method = 'cie2000')[1:nb, 1:nb]
+
+########## assignment optim ########
+clao = ColorGroupAssignmentOptimizer$new(nb)
+clao$setImportanceMatrix(myImpMatrix)
+clao$setColorDistanceMatrix(colorDistanceMatrix)
+
+nbGeneration <- 1000
+nbPopulation <- 200
+clao$optimizeAuto()
+bestPerm <- clao$getBestPermutation()
+print(bestPerm)
+newSpectArray <- clao$getBestAssignmentColormap(colPalette)
+
+########## exporting comparison ##########
+#clao$exportGgplotComparisonVisuAsPdf("ageAloneTestOptimPermComp.pdf", colPalette, groupNames,16)
+
+########## displaying ##########
+plottingWithOptimizedPalette <- function() {
+  thePlot <- ggplot(data = dataPlot, aes(x = Year, y = Percent, group = Entity)) +
+    #,colour=country))+
+    geom_line(aes(color = Entity),  size = lineWidth) +
+    scale_colour_manual(values = newSpectArray)
+  thePlot <- thePlot + coord_fixed(ratio = ratioGraphic) #x/Y
+  #thePlot <- thePlot + dark_mode()
+
+  #thePlot<-thePlot+ theme_linedraw()
+
+  print(thePlot)
+}
+############
+plottingWithOptimizedPalette()
+#ggsave("AmericanAgeAloneVisuWithOptim.pdf")    #width = 16.5, height = 16.5, units = "cm")

Examples/LineGraphs/exampleLineGraphsBis.R

+#######################################################
+###########  line graphs testing
+#######################################################
+
+library(dplyr)
+library(tibble)
+library(viridis)
+library(data.table) # for transpose
+library(ggplot2)
+library(ggdark)
+library(stats)
+library(purrr)
+library(farver)
+
+library(ContrastImportanceDrivenColorAssign)
+#######################################################
+# Remove the full list of R objects in session
+rm(list = ls())
+
+#####-final visu aspect ratio is necessary to slope computation
+finalWindowAspectRatio <- 1.5    #1/2
+#####
+lineWidth = 0.5
+########### loading brut data  #################
+### data coming from our world in data
+###  https://ourworldindata.org/grapher/percentage-of-americans-living-alone-by-age
+### Data published by	Steven Ruggles, Sarah Flood, Ronald Goeken, Josiah Grover, Erin Meyer, Jose Pacas, and Matthew Sobek.
+### IPUMS USA: Version 8.0 [dataset]. Minneapolis, MN: IPUMS, 2018. https://doi.org/10.18128/D010.V8.0
+### https://usa.ipums.org/usa/
+gBrut <-
+  read.csv(
+    '/Users/languenou-e/Dev/Dev_R/ProjectColorLayerContrastAssign/ImportanceDrivenColorAssign/Examples/LineGraphs/percentage-of-americans-living-alone-by-age.csv'
+  )
+
+gBrut <- gBrut[, c(1, 3, 4)]
+colnames(gBrut)
+colnames(gBrut) = c(colnames(gBrut[1:2]), "Percent") #reducing colname percent..
+colnames(gBrut)
+########### data for importance #################@
+
+##### long to wide using spread() function of tidyr package
+library(tidyr)
+colnames(gBrut)
+groupNames = unique(gBrut$Entity)
+
+dataImportance = spread(gBrut, Entity, Percent)
+dataImportance
+print(ncol(dataImportance))
+
+########### importance evaluation #################
+nb <- (ncol(dataImportance)) - 1
+print(paste("nb lines :", nb, sep = " "))
+lineGraphImp <- LigneGraphImportance$new(nb)
+lineGraphImp$setAngleDegreeLimit(20)
+lineGraphImp$setProximityLimitPercentage(10 / 100)
+lineGraphImp$calculateImportanceMatrix(dataImportance, "Year", finalWindowAspectRatio)
+myImpMatrix <- lineGraphImp$getImportanceMatrix()
+#View(myImpMatrix)
+
+########### getting data ratio  #################
+dataRatio <- lineGraphImp$getDataRatio()
+print("dataRatio")
+print(dataRatio)
+########### setting the colormap #######################
+colPalette = viridis(nb)
+
+########### data for plot #################@
+dataPlot <- gBrut ## already in long format
+
+########### aspect ratio #########
+ratioGraphic <- finalWindowAspectRatio / dataRatio
+
+
+######### color matrix ########
+spectrum2 <- t(col2rgb(colPalette))
+colorDistanceMatrix <-
+  compare_colour(spectrum2, spectrum2, 'rgb', method = 'cie2000')[1:nb, 1:nb]
+
+########## assignment optim ########
+clao = ColorGroupAssignmentOptimizer$new(nb)
+clao$setImportanceMatrix(myImpMatrix)
+clao$setColorDistanceMatrix(colorDistanceMatrix)
+
+nbGeneration <- 1000
+nbPopulation <- 200
+clao$optimizeAuto()
+bestPerm <- clao$getBestPermutation()
+print(bestPerm)
+newSpectArray <- clao$getBestAssignmentColormap(colPalette)
+
+########## exporting comparison ##########
+#clao$exportGgplotComparisonVisuAsPdf("ageAloneTestOptimPermComp.pdf", colPalette, groupNames,16)
+
+########## displaying ##########
+plottingWithPalette <- function(colPal) {
+  thePlot <- ggplot(data = dataPlot, aes(x = Year, y = Percent, group = Entity)) +
+    #,colour=country))+
+    geom_line(aes(color = Entity),  size = lineWidth) +
+    scale_colour_manual(values = colPal)
+  thePlot <- thePlot + coord_fixed(ratio = ratioGraphic) #x/Y
+  #thePlot <- thePlot + dark_mode()
+
+  #thePlot<-thePlot+ theme_linedraw()
+
+  print(thePlot)
+}
+############
+#plottingWithPalette(colPalette)#without optim
+plottingWithPalette(newSpectArray)#with optim
+
+#ggsave("AmericanAgeAloneVisuWithOptim.pdf")    #width = 16.5, height = 16.5, units = "cm")

Examples/LineGraphs/percentage-of-americans-living-alone-by-age.csv

+Entity,Code,Year,"Percentage of Americans living alone, by age, total (IPUMS)"
+Age 18,,1900,0.2826103
+Age 18,,1920,0.29753187
+Age 18,,1940,0.16828842
+Age 18,,1960,0.50808835
+Age 18,,1980,1.0791981
+Age 18,,2000,0.88557899
+Age 18,,2018,0.54856783
+Age 21,,1900,0.8530516
+Age 21,,1920,0.61699224
+Age 21,,1940,0.65782249
+Age 21,,1960,1.6465194
+Age 21,,1980,5.5592036
+Age 21,,2000,4.7959294
+Age 21,,2018,3.7633936
+Age 30,,1900,1.4475262
+Age 30,,1920,1.0820333
+Age 30,,1940,1.5331241
+Age 30,,1960,2.4077144
+Age 30,,1980,8.9690161
+Age 30,,2000,9.7933722
+Age 30,,2018,9.47083
+Age 45,,1900,2.0883126
+Age 45,,1920,2.2757423
+Age 45,,1940,2.8379524
+Age 45,,1960,3.8069024
+Age 45,,1980,6.1046829
+Age 45,,2000,10.512973
+Age 45,,2018,9.170002
+Age 60,,1900,4.2898355
+Age 60,,1920,4.8850908
+Age 60,,1940,6.3180275
+Age 60,,1960,10.958211
+Age 60,,1980,13.569151
+Age 60,,2000,15.704637
+Age 60,,2018,17.681852
+Age 75,,1900,6.4125099
+Age 75,,1920,8.3861637
+Age 75,,1940,12.162309
+Age 75,,1960,20.639933
+Age 75,,1980,31.746202
+Age 75,,2000,28.880363
+Age 75,,2018,24.76524
+Age 89,,1900,3.0029743
+Age 89,,1920,5.5308571
+Age 89,,1940,8.7714338
+Age 89,,1960,14.518483
+Age 89,,1980,29.159912
+Age 89,,2000,40.842579
+Age 89,,2018,41.961132
\ No newline at end of file

Examples/PolygonsMap/examplePolygonMap.R

+library(farver) # color distance
+library(spdep)#Spatial Dependence: Weighting Schemes and Statistics
+library(sp)
+library(spData)# data for sp
+library(rgdal)
+library(ggplot2)# for qplot
+
+library(ContrastImportanceDrivenColorAssign)
+
+###########  data ###############
+columbus <- st_read(system.file("shapes/columbus.shp", package="spData")[1], quiet=TRUE)
+col.gal.nb <- read.gal(system.file("weights/columbus.gal", package="spData")[1])
+coords <- st_coordinates(st_centroid(st_geometry(columbus))) # centroids of polygons
+neighboorMatrix <- poly2nb(as(columbus, "Spatial"))
+
+#nb polygons
+nb = length(columbus$AREA)
+
+######## colormap #######
+library(viridis)
+colormapViridis <- viridis(nb)
+colormapViridisRGB <- t(col2rgb(viridis(nb)))
+
+######## color distance Matrix  #######
+colorDistanceMatrix <- compare_colour(colormapViridisRGB, colormapViridisRGB, 'rgb', method = 'cie2000')[1:nb, 1:nb]
+
+######## importance matrix #######
+pmi = PolygonMapImportance$new(nb)
+pmi$calculateImportanceMatrix(columbus)
+impMatrix <-pmi$getImportanceMatrix()
+
+########### setting the optimizer  #######
+clao = ColorGroupAssignmentOptimizer$new(nb)
+clao$setImportanceMatrixExpansionFactors(50,800)
+clao$setNbPrintIter(40)
+
+clao$setImportanceMatrix(impMatrix)
+clao$setColorDistanceMatrix(colorDistanceMatrix)
+nbGeneration <- 300
+nbPopulation <- 200
+
+######## optimization ###############
+clao$associateByGA(nbGeneration,nbPopulation)
+bestPerm <- clao$getBestPermutation()
+newSpectArray <- clao$getBestAssignmentColormap(colormapViridis)
+
+################# plotting results ##############
+plot(st_geometry(columbus), border=NA, col=newSpectArray)
+mtext(paste("nbGeneration=",nbGeneration,", nbPopulation=",nbPopulation,sep=" "), side = 1,line = - 2)
+invisible(text(coords, labels=as.character(columbus$POLYID), cex=1))
+
+
+
+
+

Examples/SimpleNeighborDiagram/exampleSimpleNeighbor.R

+#######################################################
+######### testing simple neighbors diagrams ###########
+#######################################################
+# Libraries
+
+library(viridis)
+library(farver)# for DE2000 color distance evaluation
+
+library(ContrastImportanceDrivenColorAssign)
+
+######## dummy data ########
+A <- c(65, 50, 3, 5, 17, 32, 3, 8, 3, 5, 67, 53, 1)
+
+######### setting the colormap ########
+nbGroup = length(A)
+myColor = viridis(nbGroup)
+
+######## setting the type of diagram #####
+######## cyclic neighboring dependent importance  ######
+#barChartFigure <- TRUE
+barChartFigure <- FALSE
+
+######## compute importance matrix #######
+sndi = SimpleNeighborDiagramImportance$new(nbGroup)
+
+if (barChartFigure) {
+  sndi$calculateImportanceMatrix(A,FALSE)
+} else {
+  sndi$calculateImportanceMatrix(A,TRUE)
+}
+
+impMatrix<- sndi$getImportanceMatrix()
+
+######## colormap reduced for a stress test #######
+colPalette = viridis(40)
+colPaletteStart <- 15
+barPlotColor= colPalette[colPaletteStart:(colPaletteStart+nbGroup-1)]
+
+
+###############  color distance Matrix ##############
+barPlotColorRGB <- t(col2rgb(barPlotColor))
+colorDistanceMatrix <- compare_colour(barPlotColorRGB, barPlotColorRGB, 'rgb', method = 'cie2000')[1:nbGroup, 1:nbGroup]
+
+############## setting the optimizer ##################
+clao = ColorGroupAssignmentOptimizer$new(nbGroup)
+clao$setImportanceMatrixExpansionFactors(10,50)
+clao$setImportanceMatrix(impMatrix)
+clao$setColorDistanceMatrix(colorDistanceMatrix)
+
+nbGeneration <- 500
+nbPopulation <- 200
+clao$associateByGA(nbGeneration,nbPopulation)
+#clao$associateExhaustive()
+bestPerm <- clao$getBestPermutation()
+bestPerm
+bestBarPlotColor <- clao$getBestAssignmentColormap(barPlotColor)
+
+############## plotting result ##############
+
+if (barChartFigure) {
+  barplot(A, xlab = "X-axis", ylab = "Y-axis", main ="Bar-Chart",col= bestBarPlotColor,border = bestBarPlotColor)
+} else {
+  pie(A,col= bestBarPlotColor,border = bestBarPlotColor)
+}
+

Examples/Streamgraphs/dataMusic10layers.csv

+hour,Air,Ellie_Goulding,Empire_of_the_Sun,Fever_Ray,Foals,Foster_the_People,Frankmusik,Is_Tropical,Junior_Senior,Justice
+7,0.0,0.0,0.0,0.0,0.0,0.0,3.0,0.0,0.0,0.0
+8,0.0,0.0,0.0,1.0,0.0,0.0,2.0,0.0,0.0,0.0
+9,0.0,0.0,0.0,2.0,2.0,0.0,1.0,0.0,0.0,0.0
+10,0.0,1.0,0.0,1.0,5.0,2.0,1.0,0.0,0.0,0.0
+11,0.0,2.0,1.0,1.0,7.0,0.0,1.0,0.0,0.0,0.0
+12,0.0,1.0,1.0,1.0,2.0,0.0,2.0,1.0,0.0,0.0
+13,0.0,1.0,2.0,1.0,0.0,1.0,4.0,2.0,0.0,0.0
+14,0.0,1.0,2.0,2.0,0.0,2.0,6.0,2.0,0.0,1.0
+15,0.0,1.0,1.0,1.0,5.0,1.0,5.0,2.0,1.0,2.0
+16,0.0,1.0,1.0,1.0,1.0,1.0,1.0,4.0,2.0,5.0
+17,0.0,1.0,1.0,1.0,1.0,6.0,0.0,2.0,2.0,7.0
+18,0.0,1.0,1.0,0.0,1.0,1.0,0.0,6.0,2.0,5.0
+19,0.0,1.0,1.0,0.0,2.0,2.0,0.0,1.0,1.0,2.0
+20,0.0,1.0,1.0,0.0,1.0,1.0,0.0,0.0,0.0,1.0
+21,1.0,1.0,1.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0
+22,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0

Examples/Streamgraphs/dataMusic11layers.csv

+hour,Air,Ellie_Goulding,Empire_of_the_Sun,Fever_Ray,Foals,Foster_the_People,Frankmusik,Is_Tropical,Junior_Senior,Justice,M83
+7,0.0,0.0,0.0,0.0,0.0,0.0,3.0,0.0,0.0,0.0,0.0
+8,0.0,0.0,0.0,1.0,0.0,0.0,2.0,0.0,0.0,0.0,0.0
+9,0.0,0.0,0.0,2.0,2.0,0.0,1.0,0.0,0.0,0.0,0.0
+10,0.0,1.0,0.0,1.0,5.0,2.0,1.0,0.0,0.0,0.0,0.0
+11,0.0,2.0,1.0,1.0,7.0,0.0,1.0,0.0,0.0,0.0,0.0
+12,0.0,1.0,1.0,1.0,2.0,0.0,2.0,1.0,0.0,0.0,5.0
+13,0.0,1.0,2.0,1.0,0.0,1.0,4.0,2.0,0.0,0.0,6.0
+14,0.0,1.0,2.0,2.0,0.0,2.0,6.0,2.0,0.0,1.0,9.0
+15,0.0,1.0,1.0,1.0,5.0,1.0,5.0,2.0,1.0,2.0,3.0
+16,0.0,1.0,1.0,1.0,1.0,1.0,1.0,4.0,2.0,5.0,0.0
+17,0.0,1.0,1.0,1.0,1.0,6.0,0.0,2.0,2.0,7.0,0.0
+18,0.0,1.0,1.0,0.0,1.0,1.0,0.0,6.0,2.0,5.0,0.0
+19,0.0,1.0,1.0,0.0,2.0,2.0,0.0,1.0,1.0,2.0,0.0
+20,0.0,1.0,1.0,0.0,1.0,1.0,0.0,0.0,0.0,1.0,0.0
+21,1.0,1.0,1.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0
+22,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0

Examples/Streamgraphs/dataMusicFilterAlternativeDanceGroupArtisTimeHour.csv

+hour,Air,Ellie_Goulding,Empire_of_the_Sun,Fever_Ray,Foals,Foster_the_People,Frankmusik,Is_Tropical,Junior_Senior,Justice,M83,MGMT,Metric,Metronomy,Mr_Oizo,Passion_Pit,Phoenix,Ratatat,The_Naked_and_Famous,The_Postal_Service,The_xx
+7,0.0,0.0,0.0,0.0,0.0,0.0,3.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,1.0,0.0,0.0
+8,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,5.0,0.0,0.0
+9,0.0,0.0,0.0,0.0,2.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,4.0,0.0,0.0
+10,0.0,0.0,0.0,0.0,17.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0
+11,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0
+12,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,4.0,0.0,0.0
+13,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,6.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0
+14,0.0,1.0,0.0,0.0,0.0,0.0,6.0,0.0,0.0,0.0,9.0,3.0,0.0,4.0,0.0,0.0,1.0,0.0,0.0,1.0,0.0
+15,0.0,0.0,1.0,0.0,5.0,1.0,5.0,0.0,0.0,0.0,0.0,2.0,0.0,20.0,0.0,0.0,0.0,0.0,0.0,0.0,1.0
+16,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,11.0,0.0,5.0,1.0,0.0,7.0,1.0,0.0,0.0,2.0
+17,0.0,0.0,0.0,0.0,0.0,6.0,0.0,2.0,2.0,11.0,3.0,2.0,0.0,2.0,1.0,0.0,0.0,0.0,0.0,0.0,1.0
+18,0.0,0.0,0.0,0.0,0.0,1.0,0.0,6.0,0.0,0.0,0.0,1.0,0.0,5.0,0.0,0.0,0.0,0.0,2.0,0.0,0.0
+19,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,2.0,0.0,0.0,2.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0
+20,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,4.0,0.0,0.0,0.0
+21,1.0,0.0,0.0,1.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,1.0,0.0,0.0,0.0,0.0,1.0,0.0,0.0,0.0
+22,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,1.0,0.0,0.0,0.0,1.0,1.0,0.0,1.0,0.0,0.0

Examples/Streamgraphs/exampleStreamgraph.R

+####################################
+###### testing streamgraphs #######
+
+##### data coming from a music usage survey made thanks to
+##### an european project ANR "Musimorphose" (Resp. Philippe Le Guern)
+##### https://musimorphe.hypotheses.org/
+##### the file contains the number of tracks played by hour
+##### limited to the artist of the "alternative dance" music genre
+##### and for streamgraph lexicographic order "asis"
+####################################
+
+#install.packages("devtools")
+#devtools::install_github("hrbrmstr/streamgraph")
+library(streamgraph)
+packageVersion("streamgraph")
+
+library(dplyr)
+library(tibble)
+library(viridis)
+library(farver)
+
+library(ContrastImportanceDrivenColorAssign)
+
+
+##### set the path to your file location
+#setwd('')
+####### loading data ########
+## data categories must be ordered in lexicographic order
+dataMusic <- read.csv('./Examples/Streamgraphs/dataMusicFilterAlternativeDanceGroupArtisTimeHour.csv',header = TRUE)
+
+########### displaying artists
+print(colnames(dataMusic)[-1])
+groupName<-colnames(dataMusic)[-1]
+
+############ reducing the colormap #######################
+nb<- (ncol(dataMusic))-1
+colPalette = viridis(30)
+colPaletteStart <- 6
+colPaletteReduced= colPalette[colPaletteStart:(colPaletteStart+nb-1)]
+
+
+
+
+
+############ color distance matrix #######################
+spectrum2 <- t(col2rgb(colPaletteReduced))
+colorDistanceMatrix <- compare_colour(spectrum2, spectrum2, 'rgb', method = 'cie2000')[1:nb, 1:nb]
+
+############ importance matrix #######################
+streamgraphImp = StreamgraphImportance$new(nb)
+streamgraphImp$setImportanceSynthesisMode("MAXIMUM")
+streamgraphImp$calculateImportanceMatrix(dataMusic)
+
+impMatrix = streamgraphImp$getImportanceMatrix()
+print(impMatrix)
+
+############ optimizer #######################
+clao = ColorGroupAssignmentOptimizer$new(nb)
+clao$setImportanceMatrixExpansionFactors(20,150) #50,400
+clao$setImportanceMatrix(impMatrix)
+clao$setColorDistanceMatrix(colorDistanceMatrix)
+nbGeneration <- 750 #500
+nbPopulation <- 100 #200
+clao$associateByGA(nbGeneration,nbPopulation)
+
+bestPerm <-clao$getBestPermutation()
+newSpectArray <- clao$getBestAssignmentColormap(colPaletteReduced)
+
+#####################################
+# method which reorganizes data to fit with streamgraph vizu package
+#####################################
+reOrganizeForStreamgraphPk<- function(dtIn,indexTimeIn,timeName,groupName){
+  allNamesArtist <- names(dtIn)
+
+  nbColMat <- as.numeric(3) #hour, artist, nb
+  nbRowMat <- (length(dtIn[indexTimeIn])*(length(names(dtIn))-as.numeric(1)))
+  mat <- matrix(as.numeric(0),nbRowMat,nbColMat)
+  print(paste("reOrganizeForStreamgraphPk(): created matrix of " , nbRowMat," rows and ", nbColMat, "columns",sep=" "))
+  dtOut <- data.frame(mat)
+  names(dtOut)[1] <- timeName
+  names(dtOut)[2] <- groupName
+  names(dtOut)[3] <- "n"
+
+  nbTimeValueIn <- as.numeric(length(dtIn[,indexTimeIn]))
+  nbArtist <- as.numeric(length(names(dtIn)))-1
+  indexDtOut <- 1
+  for(indexTime in 1:nbTimeValueIn){
+    # through artist column
+    for(indexArtist in 2:(nbArtist+1)){
+      value <- dtIn[indexTime,indexArtist]
+      dtOut[indexDtOut,1]<- dtIn[indexTime,1]
+      dtOut[indexDtOut,2]<- allNamesArtist[indexArtist]
+      dtOut[indexDtOut,3]<- value
+      indexDtOut<- indexDtOut +1
+    }
+  }
+  return(dtOut)
+}# end definition
+
+###################################
+# displaying streamgraph "listened artists of alternativeDance over the day"
+###################################
+
+dataMusicForStreamgraphPk <- reOrganizeForStreamgraphPk(dataMusic,1,"hour","artist")
+
+dataMusicForStreamgraphPk  %>%
+  group_by(hour,artist) %>%
+  tally(wt=n) %>%
+  streamgraph("artist","n","hour", order="asis", scale = "continuous") %>%
+  sg_axis_x(10,"hour") %>%
+  sg_fill_manual(newSpectArray)%>%
+  sg_annotate("Tracks played per artist of \"alternative-dance\" along the day",8,35,size =12)#%>%
+  #htmlwidgets::saveWidget(p,"graph.html")
+
+testStream <- dataMusicForStreamgraphPk  %>%
+  group_by(hour,artist) %>%
+  tally(wt=n) %>%
+  streamgraph("artist","n","hour", order="asis", scale = "continuous")%>%
+  sg_axis_x(10,"hour") %>%
+  sg_fill_manual(newSpectArray)%>%
+  sg_annotate("Tracks played per artist of \"alternative-dance\" along the day",8,35,size =12)
+
+htmlwidgets::saveWidget(testStream, file="streamgraph.html")
+
+
+
+##################################
+### to export in pdf      ########
+##################################
+
+#from https://r-graph-gallery.com/159-save-interactive-streamgraph-to-static-image-png.html
+library(webshot)
+#install phantom:
+webshot::install_phantomjs()
+# Make a webshot in pdf : high quality but can not choose printed zone
+webshot("streamgraph.html" , "streamgraph.pdf", delay = 0.2)
+
+# Make a webshot in png : Low quality - but you can choose shape
+#webshot("paste_your_html_here" , "output.png", delay = 0.2 , cliprect = c(440, 0, 1000, 10))
+
+##################################
+### matrix comparison     ########
+##################################
+#clao$exportGgplotComparisonVisuAsPdf("streamgraphComparisonOptimPermComp.pdf", newSpectArray, groupName,7,20,20)
+#clao$exportGgplotMatrixVisuAsPdf("visuColMatrix.pdf",clao$getColorDistanceMatrix(),colPaletteReduced,7,20,20)
+#clao$exportGgplotMatrixVisuAsPdf("visuImpMatrix.pdf",clao$getImportanceMatrix(),groupName,7,20,20)
+

Examples/Streamgraphs/exampleStreamgraph20sept2022.R

+####################################
+###### testing streamgraphs #######
+
+##### data coming from a music usage survey made thanks to
+##### an european project ANR "Musimorphose" (Resp. Philippe Le Guern)
+##### https://musimorphe.hypotheses.org/
+##### the file contains the number of tracks played by hour
+##### limited to the artist of the "alternative dance" music genre
+##### anf for streamgraph order "asis"
+####################################
+
+#install.packages("devtools")
+#devtools::install_github("hrbrmstr/streamgraph")
+library(streamgraph)
+packageVersion("streamgraph")
+
+library(dplyr)
+library(tibble)
+library(viridis)
+library(farver)
+
+library(ContrastImportanceDrivenColorAssign)
+
+####### loading data ########
+##### set the path to your file location
+dataMusic <- read.csv('/Users/languenou-e/Dev/Dev_R/ProjectColorLayerContrastAssign/ImportanceDrivenColorAssign/Examples/Streamgraphs/dataMusicFilterAlternativeDanceGroupArtisTimeHour.csv',header = TRUE)
+
+########### displaying artists
+print(colnames(dataMusic)[-1])
+groupName<-colnames(dataMusic)[-1]
+
+############ reducing the colormap #######################
+nb<- (ncol(dataMusic))-1
+colPalette = viridis(30)
+colPaletteStart <- 4
+colPaletteReduced= colPalette[colPaletteStart:(colPaletteStart+nb-1)]
+
+
+
+
+
+############ color distance matrix #######################
+spectrum2 <- t(col2rgb(colPaletteReduced))
+colorDistanceMatrix <- compare_colour(spectrum2, spectrum2, 'rgb', method = 'cie2000')[1:nb, 1:nb]
+
+############ importance matrix #######################
+streamgraphImp = StreamgraphImportance$new(nb)
+streamgraphImp$setImportanceSynthesisMode("MAXIMUM")
+streamgraphImp$calculateImportanceMatrix(dataMusic)
+
+impMatrix = streamgraphImp$getImportanceMatrix()
+print(impMatrix)
+
+############ optimizer #######################
+clao = ColorGroupAssignmentOptimizer$new(nb)
+clao$setImportanceMatrixExpansionFactors(50,400)
+clao$setImportanceMatrix(impMatrix)
+clao$setColorDistanceMatrix(colorDistanceMatrix)
+nbGeneration <- 750 #500
+nbPopulation <- 100 #200
+clao$associateByGA(nbGeneration,nbPopulation)
+
+bestPerm <-clao$getBestPermutation()
+newSpectArray <- clao$getBestAssignmentColormap(colPaletteReduced)
+
+#####################################
+# method which reorganizes data to fit with streamgraph vizu package
+#####################################
+reOrganizeForStreamgraphPk<- function(dtIn,indexTimeIn,timeName,groupName){
+  allNamesArtist <- names(dtIn)
+
+  nbColMat <- as.numeric(3) #hour, artist, nb
+  nbRowMat <- (length(dtIn[indexTimeIn])*(length(names(dtIn))-as.numeric(1)))
+  mat <- matrix(as.numeric(0),nbRowMat,nbColMat)
+  print(paste("reOrganizeForStreamgraphPk(): created matrix of " , nbRowMat," rows and ", nbColMat, "columns",sep=" "))
+  dtOut <- data.frame(mat)
+  names(dtOut)[1] <- timeName
+  names(dtOut)[2] <- groupName
+  names(dtOut)[3] <- "n"
+
+  nbTimeValueIn <- as.numeric(length(dtIn[,indexTimeIn]))
+  nbArtist <- as.numeric(length(names(dtIn)))-1
+  indexDtOut <- 1
+  for(indexTime in 1:nbTimeValueIn){
+    # through artist column
+    for(indexArtist in 2:(nbArtist+1)){
+      value <- dtIn[indexTime,indexArtist]
+      dtOut[indexDtOut,1]<- dtIn[indexTime,1]
+      dtOut[indexDtOut,2]<- allNamesArtist[indexArtist]
+      dtOut[indexDtOut,3]<- value
+      indexDtOut<- indexDtOut +1
+    }
+  }
+  return(dtOut)
+}# end definition
+
+###################################
+# displaying streamgraph "listened artists of alternativeDance over the day"
+###################################
+
+dataMusicForStreamgraphPk <- reOrganizeForStreamgraphPk(dataMusic,1,"hour","artist")
+
+dataMusicForStreamgraphPk  %>%
+  group_by(hour,artist) %>%
+  tally(wt=n) %>%
+  streamgraph("artist","n","hour", order="asis", scale = "continuous") %>%
+  sg_axis_x(10,"hour") %>%
+  sg_fill_manual(newSpectArray)%>%
+  sg_annotate("Tracks played per artist of \"alternative-dance\" along the day",8,35,size =12)#%>%
+  #htmlwidgets::saveWidget(p,"graph.html")
+
+testStream <- dataMusicForStreamgraphPk  %>%
+  group_by(hour,artist) %>%
+  tally(wt=n) %>%
+  streamgraph("artist","n","hour", order="asis", scale = "continuous")%>%
+  sg_axis_x(10,"hour") %>%
+  sg_fill_manual(newSpectArray)%>%
+  sg_annotate("Tracks played per artist of \"alternative-dance\" along the day",8,35,size =12)
+
+htmlwidgets::saveWidget(testStream, file="streamgraph.html")
+#from https://r-graph-gallery.com/159-save-interactive-streamgraph-to-static-image-png.html
+library(webshot)
+
+#install phantom:
+webshot::install_phantomjs(force=TRUE)
+# Make a webshot in pdf : high quality but can not choose printed zone
+webshot("streamgraph.html" , "streamgraph.pdf", delay = 0.2)
+
+# Make a webshot in png : Low quality - but you can choose shape
+#webshot("paste_your_html_here" , "output.png", delay = 0.2 , cliprect = c(440, 0, 1000, 10))
+##################################
+
+#clao$exportGgplotComparisonVisuAsPdf("streamgraphComparisonOptimPermComp.pdf", newSpectArray, groupName,7,20,20)
+#clao$exportGgplotMatrixVisuAsPdf("visuColMatrix.pdf",clao$getColorDistanceMatrix(),colPaletteReduced,7,20,20)
+#clao$exportGgplotMatrixVisuAsPdf("visuImpMatrix.pdf",clao$getImportanceMatrix(),groupName,7,20,20)
+

LICENSE

+YEAR: 2022
+COPYRIGHT HOLDER: Eric Languenou
\ No newline at end of file