add north arrow in timeline map

sebastien-plutniak · Jan 13, 2024 · 7ca6a23 · 7ca6a23
1 parent a6bc1da
commit 7ca6a23
Show file tree

Hide file tree

Showing 4 changed files with 44 additions and 10 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, 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)
+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)
diff --git a/NEWS.md b/NEWS.md
@@ -1,7 +1,7 @@
 # archeoViz 1.3.4
 Released: 2024-01-
 
-* 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 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 for map and timeline plots).
 * 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

diff --git a/R/app_server.R b/R/app_server.R
@@ -372,8 +372,8 @@ app_server <- function(input, output, session) {
     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_y <- factor(squares$square_y,
-                                 labels = rev(levels(squares$square_y)) )
+      squares$square_x <- factor(squares$square_x,
+                                 labels = rev(levels(squares$square_x)) )
     }
     if(grepl("y", getShinyOption("reverse.square.names"))){
       squares$square_y <- factor(squares$square_y)
@@ -584,7 +584,6 @@ app_server <- function(input, output, session) {
                  colour = "grey70" ) +
       geom_hline(yintercept =  after_scale(seq(0.5, length(axis.labels$yaxis$breaks) + .5, 1)),
                  colour = "grey70" ) +
-      coord_fixed() +
       scale_fill_manual("State:",
                         values = c(grDevices::rgb(0,0,0,0), 
                                    grDevices::rgb(.43, .54, .23, .7))) +
@@ -1787,14 +1786,12 @@ app_server <- function(input, output, session) {
   #  : main timeline ----
   timeline.map.plot <- reactive({
     req(timeline.data)
-
     time.df <- timeline.data()
 
     time.sub.df <- time.df[time.df$year == input$history.date, ]
 
     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))
@@ -1810,14 +1807,12 @@ app_server <- function(input, output, session) {
       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 = FALSE) 
 
-
     if(is.null(axis.labels$xaxis$labels)){
       timeline.map.out <- timeline.map.out +
         theme(axis.text.x = element_blank())
@@ -1826,6 +1821,44 @@ app_server <- function(input, output, session) {
       timeline.map.out <- timeline.map.out + 
         theme(axis.text.y = element_blank())
     }
+    # browser()
+    # : - add scale ----
+    timeline.map.out <- timeline.map.out +
+      annotate("text",
+               x = length(unique(time.sub.df$square_x)) / 3 ,
+               y = -0.5 ,
+               size  = 4,  
+               label = grid.legend) +
+      coord_fixed(ylim = c(1, length(unique(time.sub.df$square_y))), 
+                  clip = 'off') 
+
+    # : - add north arrow ----
+    if( ! is.null(getShinyOption("grid.orientation"))){
+      arrow.x.origin <- length(unique(time.sub.df$square_x)) * 2/3
+
+      arrow.coords <- matrix(c(arrow.x.origin,
+                               arrow.x.origin,
+                                0, - .5),
+                             ncol=2) 
+
+      arrow.coords <- .rotate(coords = arrow.coords,  # rotate arrow
+                     degrees = getShinyOption("grid.orientation"),
+                     pivot = c(arrow.x.origin,
+                               median(c(arrow.coords[, 2])))
+                     )
+
+      timeline.map.out <- timeline.map.out +
+        annotate("text",
+                 x = arrow.x.origin,
+                 y = arrow.coords[2,2] - .25, size  = 4,  
+                 label = "N") +      
+        annotate("segment",
+                 x = arrow.coords[1,1], xend = arrow.coords[2,1],
+                 y = arrow.coords[2,2], yend = arrow.coords[1,2],
+                 arrow = ggplot2::arrow(length = ggplot2::unit(0.2, "cm"))
+                 ) 
+    }
+
 
     timeline.map.out
   })
@@ -1861,6 +1894,7 @@ app_server <- function(input, output, session) {
                 aes(x = .data[["square_x"]], y = .data[["square_y"]], 
                     fill = .data[["excavation"]]), 
                 show.legend = FALSE) +
+      coord_fixed() +
       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/do_r_command.R b/R/do_r_command.R
@@ -22,7 +22,7 @@
 
   # static parameters: ----
   static.params <- list("reverse.axis.values", "reverse.square.names", "square.size",
-                     "title", "lang", "set.theme", "run.plots", "html.export")
+                    "grid.orientation", "title", "lang", "set.theme", "run.plots", "html.export")
   static.params <- sapply(static.params, .get.shiny.param)
   static.params <- static.params[ ! sapply(static.params, is.null) ]