Greek sites | Dr. Michael C. Zeller

Figure 1: Greek sites

#| standalone: true
#| viewerHeight: 400
library(shiny)
library(bslib)

theme <- bs_theme(font_scale = 1.5)

# Define UI for app that draws a histogram ----
ui <- page_sidebar(theme = theme,
  sidebar = sidebar(open = "open",
    numericInput("n", "Sample count", 100),
    checkboxInput("pause", "Pause", FALSE),
  ),
  plotOutput("plot", width=500)
)

server <- function(input, output, session) {
  data <- reactive({
    input$resample
    if (!isTRUE(input$pause)) {
      invalidateLater(1000)
    }
    rnorm(input$n)
  })
  
  output$plot <- renderPlot({
    hist(data(),
      breaks = 40,
      xlim = c(-2, 2),
      ylim = c(0, 1),
      lty = "blank",
      xlab = "value",
      freq = FALSE,
      main = ""
    )
    
    x <- seq(from = -2, to = 2, length.out = 500)
    y <- dnorm(x)
    lines(x, y, lwd=1.5)
    
    lwd <- 5
    abline(v=0, col="red", lwd=lwd, lty=2)
    abline(v=mean(data()), col="blue", lwd=lwd, lty=1)

    legend(legend = c("Normal", "Mean", "Sample mean"),
      col = c("black", "red", "blue"),
      lty = c(1, 2, 1),
      lwd = c(1, lwd, lwd),
      x = 1,
      y = 0.9
    )
  }, res=140)
}

# Create Shiny app ----
shinyApp(ui = ui, server = server)

--- title: Greek sites filters: - shinylive date: 2024-09-17 description: "..." image: delphi.png twitter-card: image: "delphi.png" open-graph: image: "delphi.png" categories: - misc ---      ```{r fig-gr-map, message = FALSE, warning=FALSE, echo=FALSE, fig.cap="Greek sites"} library(tidyverse) library(tidygeocoder) library(ggplot2) library(sf) library(rnaturalearth) library(mapview) library(dplyr) library(spatstat) library(leafpop) library(readxl) library(lubridate) gr <- read_excel("greek_sites.xlsx") # https://github.com/tidyverse/lubridate/issues/2 parse_bce_ymd <- function(str) { regex <- "(\\d{4})(-\\d{2}-\\d{2})" match <- stringr::str_match(str, regex) years_n <- readr::parse_number(match[, 2]) - 1 # Beware the -1 here right_side <- match[, 3] date <- ymd(paste0("0000-",right_side)) - years(years_n) return(date) } gr$START <- parse_bce_ymd(gr$START) gr$END <- ymd(gr$END) gr_sf <- gr %>% st_as_sf( coords = c("LON", "LAT"), crs = st_crs("EPSG:2100") # CRS for Greece ) grc = ne_countries(scale = 50, returnclass = "sf") |> filter(admin == "Greece") mapData <- ne_countries(scale = 10, continent = c("Europe"), returnclass = "sf") grc_states <- ne_states(country = "greece", returnclass = "sf") grc_states <- dplyr::select(grc_states, name, geometry) tr_states <- ne_states(country = "turkey", returnclass = "sf") st_crs(gr_sf) <- st_crs(grc) pp = st_geometry(gr_sf) window = st_geometry(grc) crs = st_crs("EPSG:2100") # CRS for Greece pp = st_transform(pp, crs)[!st_is_empty(pp)] window = st_transform(window, crs) wt = as.ppp(c(window, pp)) # Smooth points density_spatstat <- density(wt, dimyx = 500) # Convert density_spatstat into a stars object. density_stars <- stars::st_as_stars(density_spatstat) # Convert density_stars into an sf object density_sf <- st_as_sf(density_stars) %>% st_set_crs(2100) gr_density <- ggplot() + geom_sf(data = density_sf, aes(fill = v), col = NA) + # scale_fill_viridis_c(option = "magma") + # scale_fill_gradientn(colours = c("grey80", "grey10")) + geom_sf(data = st_boundary(grc_states)) + geom_sf(data = gr_sf, shape = 1, size = 5, colour = "red", stroke = 1, fill = NA) + theme_void() + theme(legend.position="none") # gr_density mapview(gr_sf, col.regions = "lightblue", label = "PLACE", legend = T, layer.name = 'Greek sites', map.types = c("CartoDB.Positron","CartoDB.DarkMatter"), popup = popupTable(gr_sf, zcol = c("CATEGORY","START","END","PLACE", "GOD","POEM"))) ``` ```{shinylive-r} #| standalone: true #| viewerHeight: 400 library(shiny) library(bslib) theme <- bs_theme(font_scale = 1.5) # Define UI for app that draws a histogram ---- ui <- page_sidebar(theme = theme, sidebar = sidebar(open = "open", numericInput("n", "Sample count", 100), checkboxInput("pause", "Pause", FALSE), ), plotOutput("plot", width=500) ) server <- function(input, output, session) { data <- reactive({ input$resample if (!isTRUE(input$pause)) { invalidateLater(1000) } rnorm(input$n) }) output$plot <- renderPlot({ hist(data(), breaks = 40, xlim = c(-2, 2), ylim = c(0, 1), lty = "blank", xlab = "value", freq = FALSE, main = "" ) x <- seq(from = -2, to = 2, length.out = 500) y <- dnorm(x) lines(x, y, lwd=1.5) lwd <- 5 abline(v=0, col="red", lwd=lwd, lty=2) abline(v=mean(data()), col="blue", lwd=lwd, lty=1) legend(legend = c("Normal", "Mean", "Sample mean"), col = c("black", "red", "blue"), lty = c(1, 2, 1), lwd = c(1, lwd, lwd), x = 1, y = 0.9 ) }, res=140) } # Create Shiny app ---- shinyApp(ui = ui, server = server) ```