add north arrow - revise timeline map

sebastien-plutniak · Jan 13, 2024 · a6bc1da · a6bc1da
1 parent 98d7224
commit a6bc1da
Show file tree

Hide file tree

Showing 19 changed files with 1,608 additions and 1,476 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -2,7 +2,7 @@ Package: archeoViz
 Type: Package
 Title: Visualisation, Exploration, and Web Communication of Archaeological Spatial Data
 Version: 1.3.4
-Date: 2023-12-14
+Date: 2024-01-13
 Authors@R: c(person("Sebastien", "Plutniak", email = "[email protected]", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-6674-3806")),
              person("Renata", "Araujo", email = "[email protected]", role = "ctb", comment = c(ORCID = "0000-0001-8874-2858")),
              person("Laura", "Coltofean", email = "[email protected]", role = "ctb", comment = c(ORCID = "0000-0002-2233-3565")),
@@ -40,7 +40,7 @@ Suggests:
     testthat (>= 3.0.0)
 Config/testthat/edition: 3
 VignetteBuilder: knitr
-URL: https://archeoviz.hypotheses.org/, https://github.com/sebastien-plutniak/archeoviz
+URL: https://archeoviz.hypotheses.org, https://github.com/sebastien-plutniak/archeoviz
 BugReports: https://github.com/sebastien-plutniak/archeoviz/issues
 
 
diff --git a/NAMESPACE b/NAMESPACE
@@ -11,7 +11,7 @@ importFrom(mgcv, gam)
 importFrom(svglite, svglite)
 importFrom(utils, packageVersion, read.csv, write.csv)
 importFrom(grDevices, rainbow, rgb)
-importFrom(stats, predict, complete.cases)
+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, 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, guide_legend, guides, scale_color_manual, scale_fill_manual, scale_x_continuous, scale_x_reverse, scale_y_continuous, scale_y_reverse, theme, theme_dark, theme_minimal, xlab, ylab)
+importFrom(ggplot2, aes, after_scale, 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, theme, theme_dark, theme_minimal)
diff --git a/NEWS.md b/NEWS.md
@@ -1,7 +1,10 @@
 # archeoViz 1.3.4
-Released: 
+Released: 2024-01-
 
-* Add a function to rotate the points, in the 'Input' tab.
+* Add a north arrow in the map plot, and the 'grid.orientation' parameter in the archeoViz() function to set the orientation of the grid (used to define the orientation of the north arrow).
+* Add a function to rotate the point cloud, in the 'Input' tab.
+* Fix the step value of the slider in the 'Map' tab (step = 1).
+* Add tests for the .do_r_command() and .do_square_list() functions, and the 'reverse.axis.values' parameter in the .do_section_plot() function
 
 # archeoViz 1.3.3
 Released: 2023-11-23

diff --git a/R/app_server.R b/R/app_server.R
@@ -141,7 +141,8 @@ app_server <- function(input, output, session) {
     #   function parameter > objects table > timeline table
     timeline <- .do_timelinedata(from.param.time.df, 
                                  objects.df, 
-                                 timeline.ui.df) # this is the reactive object
+                                 timeline.ui.df # this is the reactive object
+                                 )
     # notification disabled
     # showNotification(.term_switcher(timeline$notif.text),
     #                  type = timeline$notif.type)
@@ -307,27 +308,11 @@ app_server <- function(input, output, session) {
                                  coords.max = coords.min.max$ymax, 
                                  square.list = df$square_y, axes="Y")
 
-    # max.nr.of.Xsquares <- length(unique(trunc(seq(coords.min.max$xmin, coords.min.max$xmax) / square.size) * square.size)) - 1
-    # square.Xlabels <- levels(df$square_x)
-    # if(max.nr.of.Xsquares == length(square.Xlabels) ){
-    #   square_x <- square.Xlabels
-    # }  else {
-    #   message(paste0(max.nr.of.Xsquares, " X squares, but ",
-    #                  length(square.Xlabels), " X labels provided: ", 
-    #                  paste0(square.Xlabels, collapse = ", "), ".\n"))
-    # }
-    # 
-    # max.nr.of.Ysquares <- length(unique(trunc(seq(coords.min.max$ymin, coords.min.max$ymax) / square.size) * square.size)) - 1
-    # square.Ylabels <- levels(df$square_y)
-    # if(max.nr.of.Ysquares == length(square.Ylabels) ){
-    #   square_y <- square.Ylabels
-    # } else {
-    #   message(paste0(max.nr.of.Ysquares, " Y squares, but ",
-    #                  length(square.Ylabels), " Y labels provided: ", 
-    #                  paste0(square.Ylabels, collapse = ", "), ".\n"))
-    # }
-
-    list("square_x" = squares_x, "square_y" = squares_y)
+    list("square_x" = squares_x$squares.print,
+         "square_x.save" = squares_x$squares.save,
+         "square_y" = squares_y$squares.print,
+         "square_y.save" = squares_y$squares.save
+    )
   })
 
   # : ranges ----
@@ -379,26 +364,31 @@ app_server <- function(input, output, session) {
 
   # : axis labels ----
   axis.labels <- reactive({
+
     square.coords <- square.coords.ranges()
     square.size <- getShinyOption("square.size")
     squares <- squares()
 
     if(grepl("x", getShinyOption("reverse.square.names"))){
-      squares$square_x <-factor(squares$square_x)
-      levels(squares$square_x) <- rev(levels(squares$square_x))
+      squares$square_x <- factor(squares$square_x)
+      # levels(squares$square_x) <- rev(levels(squares$square_x))
+      squares$square_y <- factor(squares$square_y,
+                                 labels = rev(levels(squares$square_y)) )
     }
     if(grepl("y", getShinyOption("reverse.square.names"))){
-      squares$square_y <-factor(squares$square_y)
-      levels(squares$square_y) <- rev(levels(squares$square_y))
+      squares$square_y <- factor(squares$square_y)
+      # levels(squares$square_y) <- rev(levels(squares$square_y))
+      squares$square_y <- factor(squares$square_y,
+                                 labels = rev(levels(squares$square_y)) )
     }
 
     list(
       "xaxis" = list(
-        "breaks" = (square.coords$range.x + square.size / 2)[ seq_len(length(squares$square_x)) ],
+        "breaks" = (square.coords$range.x + square.size / 2)[ seq_len(length(squares$square_x.save)) ],
         "labels" =  squares$square_x
       ),
       "yaxis" = list(
-        "breaks" = (square.coords$range.y + square.size / 2)[ seq_len(length(squares$square_y)) ],
+        "breaks" = (square.coords$range.y + square.size / 2)[ seq_len(length(squares$square_y.save)) ],
         "labels" =  squares$square_y
       )
     )
@@ -588,28 +578,17 @@ app_server <- function(input, output, session) {
   timeline.map <- reactive({
     axis.labels <- axis.labels()
 
-    map.grid <- expand.grid("square_x" = axis.labels$xaxis$labels,
-                            "square_y" = axis.labels$yaxis$labels)
-
-    # reverse squares if needed:
-    reverse <- getShinyOption("reverse.axis.values")
-    if(grepl("x", reverse)){ 
-      levels(map.grid$square_x) <- rev(levels(map.grid$square_x))
-    }
-    if(grepl("y", reverse)){ 
-      levels(map.grid$square_y) <- rev(levels(map.grid$square_y))
-    }
-
     timeline.map <- ggplot() +
       theme_minimal(base_size = 12) +
-      geom_tile(data = map.grid,
-                aes(x = .data[["square_x"]], y = .data[["square_y"]]), alpha=0) +
-      geom_vline(xintercept =  seq(0.5, length(axis.labels$xaxis$labels) + .5, 1),
+      geom_vline(xintercept =  after_scale(seq(0.5, length(axis.labels$xaxis$breaks) + .5, 1)),
                  colour = "grey70" ) +
-      geom_hline(yintercept =  seq(0.5, length(axis.labels$yaxis$labels) + .5, 1),
+      geom_hline(yintercept =  after_scale(seq(0.5, length(axis.labels$yaxis$breaks) + .5, 1)),
                  colour = "grey70" ) +
       coord_fixed() +
-      xlab("") + ylab("")
+      scale_fill_manual("State:",
+                        values = c(grDevices::rgb(0,0,0,0), 
+                                   grDevices::rgb(.43, .54, .23, .7))) +
+      scale_x_discrete("") + scale_y_discrete("") 
 
     timeline.map
   })   
@@ -1085,10 +1064,12 @@ app_server <- function(input, output, session) {
     map.refits <- sum(c(input$map.refits,
                         getShinyOption("params")$map.refits))
 
-    do_map_plot(site.map(), planZ.df,
+    .do_map_plot(site.map(), planZ.df,
                 map.point.size, color.var, col,
                 input$map.density,
-                map.refits, refitting.df(), grid.legend)
+                map.refits, refitting.df(),
+                grid.legend,
+                grid.orientation = getShinyOption("grid.orientation"))
 
   }, ignoreNULL = ( ! getShinyOption("run.plots"))
   )   # end eventReactive
@@ -1175,7 +1156,7 @@ app_server <- function(input, output, session) {
     sliderInput("map.z.val", "Z: min/max",  width="100%", sep = "",
                 min = min(coords$zmin, coords$zmax), 
                 max = max(coords$zmin, coords$zmax),
-                round = T,
+                step = 1, round = T,
                 value = init.values()$valuesZ
     )
   })
@@ -1805,25 +1786,48 @@ app_server <- function(input, output, session) {
   #  Timeline ----
   #  : main timeline ----
   timeline.map.plot <- reactive({
-
     req(timeline.data)
 
     time.df <- timeline.data()
-    if(is.null(time.df)) return()
-
-    # year <- input$history.date
-    # if(is.null(input$history.date)){ year <- min(time.df$year, na.rm=T)}
 
     time.sub.df <- time.df[time.df$year == input$history.date, ]
 
-    timeline.map() +
+    if(nrow(time.sub.df) == 0) return()
+    axis.labels <- axis.labels()
+    # browser()
+
+    if("x" %in% getShinyOption("reverse.square.names")){
+      levels(time.sub.df$square_x) <- rev(levels(time.sub.df$square_x))
+    }
+    if("y" %in% getShinyOption("reverse.square.names")){
+      levels(time.sub.df$square_y) <- rev(levels(time.sub.df$square_y))
+    }
+    if("x" %in% getShinyOption("reverse.axis.values")){
+      time.sub.df$square_x <- factor(time.sub.df$square_x,
+                        levels = rev(levels(time.sub.df$square_x)))
+    }
+    if("y" %in% getShinyOption("reverse.axis.values")){
+      time.sub.df$square_y <- factor(time.sub.df$square_y,
+                          levels = rev(levels(time.sub.df$square_y)))
+    }
+
+    timeline.map.out <- timeline.map() +
       geom_tile(data = time.sub.df,
                 aes(x = .data[["square_x"]], y = .data[["square_y"]],
                     fill = .data[["excavation"]]),
-                show.legend = F) +
-      scale_fill_manual("State:",
-                        values = c(grDevices::rgb(0,0,0,0), 
-                                   grDevices::rgb(.43, .54, .23, .7)) )
+                show.legend = FALSE) 
+
+
+    if(is.null(axis.labels$xaxis$labels)){
+      timeline.map.out <- timeline.map.out +
+        theme(axis.text.x = element_blank())
+    }
+    if(is.null(axis.labels$yaxis$labels)){
+      timeline.map.out <- timeline.map.out + 
+        theme(axis.text.y = element_blank())
+    }
+
+    timeline.map.out
   })
 
   output$timeline.map <- renderPlot({ timeline.map.plot() })
@@ -1843,14 +1847,20 @@ app_server <- function(input, output, session) {
 
     if(is.null(time.df)) return()
 
+    if("x" %in% getShinyOption("reverse.axis.values")){
+      time.df$square_x <- factor(time.df$square_x,
+                                     levels = rev(levels(time.df$square_x)))
+    }
+    if("y" %in% getShinyOption("reverse.axis.values")){
+      time.df$square_y <- factor(time.df$square_y,
+                                     levels = rev(levels(time.df$square_y)))
+    }
+
     timeline.map() +
       geom_tile(data = time.df,
                 aes(x = .data[["square_x"]], y = .data[["square_y"]], 
-                    fill = .data[["excavation"]]),
-                show.legend = F)  +
-      scale_fill_manual("State:",
-                        values = c(grDevices::rgb(0, 0, 0, 0),
-                                   grDevices::rgb(.43, .54, .23, 1)) ) +
+                    fill = .data[["excavation"]]), 
+                show.legend = FALSE) +
       facet_wrap(~year) +
       theme(axis.text.x = element_text(color="white", size = .1),
             axis.text.y = element_text(color="white", size = .1),

diff --git a/R/archeoViz.R b/R/archeoViz.R
@@ -1,6 +1,6 @@
 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,
+                      square.size = 100, rotation = 0, grid.orientation = 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,
@@ -26,6 +26,13 @@ archeoViz <- function(objects.df = NULL, refits.df = NULL, timeline.df = NULL,
     stop("The 'lang' parameter must be one of 'de', 'en', 'es', 'fr', 'it', 'pt', 'ro'.")
   }
 
+  # : test grid.orientation ----
+  if( ! is.null(grid.orientation)){
+    if( ! is.numeric(grid.orientation)){
+      stop("'grid.orientation' must be numerical.")
+    }
+  }
+
   # : test square.size ----
   if( ! is.numeric(square.size)){
     stop("The 'square.size' parameter must be a positive numerical value.")
@@ -60,7 +67,7 @@ archeoViz <- function(objects.df = NULL, refits.df = NULL, timeline.df = NULL,
                  "plot3d.surfaces" = plot3d.surfaces, "plot3d.refits" = plot3d.refits,
                  "sectionX.x.val" = sectionX.x.val, "sectionX.y.val" = sectionX.y.val, "sectionX.refits" = sectionX.refits,
                  "sectionY.x.val" = sectionY.x.val, "sectionY.y.val" = sectionY.y.val, "sectionY.refits" = sectionY.refits,
-                 "point.size" = point.size, "rotation" = rotation,
+                 "point.size" = point.size, "rotation" = rotation, 
                  "camera.center" = camera.center, "camera.eye" = camera.eye)
 
   # define shiny options ----
@@ -72,6 +79,7 @@ archeoViz <- function(objects.df = NULL, refits.df = NULL, timeline.df = NULL,
                "reverse.square.names" = reverse.square.names,
                "add.x.square.labels" = add.x.square.labels,
                "add.y.square.labels" = add.y.square.labels,
+               "grid.orientation" = grid.orientation,
                "params" = params,
                "title"       = title,
                "home.text"   = home.text,