From 7ca6a23ac6a4eebc63e5d1a686c4f8365f9dfa00 Mon Sep 17 00:00:00 2001 From: sebastien-plutniak Date: Sat, 13 Jan 2024 15:39:53 +0100 Subject: [PATCH] add north arrow in timeline map --- NAMESPACE | 2 +- NEWS.md | 2 +- R/app_server.R | 48 +++++++++++++++++++++++++++++++++++++++++------- R/do_r_command.R | 2 +- 4 files changed, 44 insertions(+), 10 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 1be2bd3..0d03d92 100644 --- 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 index 0408abb..3552b39 100644 --- 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 index 03693a5..8863be4 100644 --- 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 index 9f5f564..cb8cd66 100644 --- 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) ]