add background.map

sebastien-plutniak · Feb 15, 2024 · cd893ec · cd893ec
1 parent 0f0336e
commit cd893ec
Show file tree

Hide file tree

Showing 9 changed files with 410 additions and 335 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -14,4 +14,4 @@ importFrom(grDevices, rainbow, rgb)
 importFrom(stats, predict, complete.cases, median)
 importFrom(reshape2, dcast)
 importFrom(plotly, plotlyOutput, renderPlotly, plot_ly, ggplotly, config, add_markers, add_segments, add_surface, add_paths, add_mesh, layout, event_data)
-importFrom(ggplot2, aes, after_scale, annotate, arrow, coord_fixed, element_rect, element_text, element_blank, facet_wrap, geom_density2d, geom_hline, geom_point, geom_rect, geom_segment, geom_tile, geom_vline, ggplot, ggsave, guides, scale_color_manual, scale_fill_manual, scale_x_continuous, scale_x_reverse, scale_y_continuous, scale_y_reverse, scale_x_discrete, scale_y_discrete, unit, theme, theme_dark, theme_minimal)
+importFrom(ggplot2, aes, after_scale, annotate, arrow, coord_fixed, element_rect, element_text, element_blank, facet_wrap, geom_density2d, geom_hline, geom_point, geom_rect, geom_path, geom_segment, geom_tile, geom_vline, ggplot, ggsave, guides, scale_color_manual, scale_fill_manual, scale_x_continuous, scale_x_reverse, scale_y_continuous, scale_y_reverse, scale_x_discrete, scale_y_discrete, unit, theme, theme_dark, theme_minimal)
diff --git a/NEWS.md b/NEWS.md
@@ -1,6 +1,8 @@
 # archeoViz 1.3.5
 
-*
+* New feature: archeoViz can now display a background drawing (e.g. a map outline) in the 3D and 'Map' plots, using the new 'background.map' parameter.
+* New 'unit' parameter to define the metric unit (one of: cm, m, km). The internal automatic conversion of units for the scale grid has been revised (from centimeter to meter and meter to kilometer).
+
 
 # archeoViz 1.3.4
 Released: 2024-01-13

diff --git a/R/app_server.R b/R/app_server.R
@@ -276,14 +276,36 @@ app_server <- function(input, output, session) {
   # Coordinate system ----
 
   # : grid legend ----
-  scale.value <- getShinyOption("square.size") / 100
-  scale.unit <- " m"
-  if(scale.value < 1){
-    scale.value <- scale.value * 100
-    scale.unit <- " cm"
-  }
+  scale.value <- getShinyOption("square.size")  
+  user.unit <- getShinyOption("unit")
+
+  if(user.unit == "cm"){
+    if(scale.value >= 100){
+      scale.value <- scale.value / 100
+      scale.unit <- " m"
+    } else {
+      scale.unit <- " cm"
+    }
+  } 
+
+  if(user.unit == "m"){
+     if(scale.value >= 1000){
+       scale.value <- scale.value / 1000
+       scale.unit <- " km"
+     } else {
+       scale.unit <- " m"
+     }
+  } 
+
+  if(user.unit == "km"){ 
+    scale.unit <- " km" 
+    }
+
   grid.legend <- paste0(.term_switcher("grid"), ": ",
-                        scale.value, " x ", scale.value, scale.unit)
+                        scale.value, 
+                        " x ", 
+                        scale.value,
+                        scale.unit)
 
   # : coords min/max coordinates ----
   coords.min.max <- reactive({
@@ -619,8 +641,9 @@ app_server <- function(input, output, session) {
       size.scale <- input$point.size
     }
 
-    # : plot initial ----
+    # : add points and create plot ----
     fig <- plot_ly(dataset, x = ~x, y = ~y, z = ~z,
+                   type = "scatter3d", mode = "markers",
                    color = ~group.variable,
                    colors = colors.list(),
                    size  = ~point.size,
@@ -642,8 +665,15 @@ app_server <- function(input, output, session) {
                   )
     )
 
-    # : add points ----
-    fig <- add_markers(fig)
+    # : add background map ----
+    fig <- add_paths(fig, x= ~x, y= ~y,
+                     z = coords$zmax,
+                     split = ~group,
+                     data = getShinyOption("background.map"),
+                     color = I("black"),
+                     hoverinfo = "skip",
+                     showlegend = FALSE, inherit = F)
+
 
     # : add refits lines  ----
     plot3d.refits <- sum(c(input$plot3d.refits,
@@ -911,7 +941,7 @@ app_server <- function(input, output, session) {
                     aspectmode = "manual", 
                     aspectratio = list(x = 1, 
                                        y = (coords$ymax - coords$ymin) / (coords$xmax - coords$xmin), 
-                                       z = ratio3D.value() * ((coords$zmax - coords$zmin) / (coords$xmax - coords$xmin)))
+                                       z = abs(ratio3D.value() * ((coords$zmax - coords$zmin) / (coords$xmax - coords$xmin))))
                   ))  #end layout
     # fig <- plotly::event_register(fig, 'plotly_click')
   }, ignoreNULL = ( ! getShinyOption("run.plots")) ) #  end plot3d
@@ -1070,6 +1100,7 @@ app_server <- function(input, output, session) {
                 input$map.density,
                 map.refits, refitting.df(),
                 grid.legend,
+                background.map = getShinyOption("background.map"),
                 grid.orientation = getShinyOption("grid.orientation"))
 
   }, ignoreNULL = ( ! getShinyOption("run.plots"))
@@ -1105,7 +1136,7 @@ app_server <- function(input, output, session) {
 
   output$ratio3D <- renderUI({
     sliderInput("ratio", .term_switcher("ratio"), width="100%", sep = "",
-                min=.5, max=2,
+                min=.1, max=2,
                 value = ratio3D.value(),
                 step=.1)
   })

diff --git a/R/archeoViz.R b/R/archeoViz.R
@@ -1,6 +1,7 @@
 archeoViz <- function(objects.df = NULL, refits.df = NULL, timeline.df = NULL,
                       title = NULL, home.text = NULL, lang = "en", set.theme = "cosmo",
-                      square.size = 100, rotation = 0, grid.orientation = NULL,
+                      square.size = 100, unit = "cm", rotation = 0, grid.orientation = NULL,
+                      background.map = NULL,
                       reverse.axis.values = NULL, reverse.square.names = NULL,
                       add.x.square.labels = NULL, add.y.square.labels = NULL,
                       class.variable = NULL, class.values = NULL,
@@ -38,6 +39,22 @@ archeoViz <- function(objects.df = NULL, refits.df = NULL, timeline.df = NULL,
     stop("The 'square.size' parameter must be a positive numerical value.")
   }
 
+  # : test unit ----
+  if( ! unit %in% c("cm", "m", "km")){
+    stop("The 'unit' parameter must be one of 'cm', 'm', 'km'.")
+  }
+
+  # : test background.map ----
+  if( ! is.null(background.map)){
+    if(! (is.matrix(background.map) | is.data.frame(background.map))){
+      stop("'background.map' must be a matrix or a data frame.")
+    }
+    if(ncol(background.map) == 2){
+      background.map <- cbind(background.map, 1)
+    }
+    colnames(background.map)[1:3] <- c("x", "y", "group")
+  }
+
   # : test reverse.axis.values ----
   if(is.null(reverse.axis.values)){
     reverse.axis.values <- ""
@@ -75,6 +92,7 @@ archeoViz <- function(objects.df = NULL, refits.df = NULL, timeline.df = NULL,
                "refits.df"   = refits.df,
                "timeline.df" = timeline.df,
                "square.size" = square.size,
+               "unit" = unit,
                "reverse.axis.values" = reverse.axis.values,
                "reverse.square.names" = reverse.square.names,
                "add.x.square.labels" = add.x.square.labels,
@@ -89,7 +107,8 @@ archeoViz <- function(objects.df = NULL, refits.df = NULL, timeline.df = NULL,
                "background.col" = background.col,
                "run.plots" = run.plots,
                "html.export" = html.export,
-               "table.export" = table.export)
+               "table.export" = table.export,
+               "background.map" = background.map)
 
   shinyApp(ui = app_ui, server = app_server)
 }
diff --git a/R/do_map_plot.R b/R/do_map_plot.R
@@ -1,11 +1,22 @@
 .do_map_plot <- function(site.map, planZ.df, map.point.size, color.var, col,
                         map.density, map.refits, refitting.df, grid.legend, 
-                        grid.orientation){
+                        grid.orientation, background.map){
 
   .data <- NULL
 
-  # base point plot ----
-  map <- site.map +
+
+  map <- site.map
+
+  # add background map ----
+  if(! is.null(background.map)){
+    map <- map +
+      geom_path(data = background.map,
+                aes(x = .data[["x"]], y = .data[["y"]], group = .data[["group"]]), 
+                colour = "black", size = .2) 
+  }
+
+  # add points ----
+  map <- map +
     geom_point(data = planZ.df,
                aes(x = .data[["x"]], y = .data[["y"]],
                    color = .data[[color.var]],

diff --git a/R/do_timelinedata.R b/R/do_timelinedata.R
@@ -2,10 +2,14 @@
   # sources selection:  ----
   #            function parameter > objects table > timeline table
 
+  condition <- (is.null(full.dataset$year) | 
+                ("" %in% unique(full.dataset$square) & length(unique(full.dataset$square)) == 1)  |
+                length(unique(full.dataset$square)) == 1)
+
   if (! is.null(from.func.time.df)){
     time.df <- from.func.time.df
   } 
-  else if( ! (is.null(full.dataset$year) | ("" %in% unique(full.dataset$square) & length(unique(full.dataset$square)) == 1) ) ){
+  else if( ! condition ){
     time.df <- table(full.dataset$square, full.dataset$year)
     time.df <- as.data.frame(time.df)
     time.df$square_x <- as.character(gsub("(.*)-(.*)", "\\1", time.df[, 1]))