R Markdown

This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.

When you click the Knit button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:

summary(cars)
##      speed           dist       
##  Min.   : 4.0   Min.   :  2.00  
##  1st Qu.:12.0   1st Qu.: 26.00  
##  Median :15.0   Median : 36.00  
##  Mean   :15.4   Mean   : 42.98  
##  3rd Qu.:19.0   3rd Qu.: 56.00  
##  Max.   :25.0   Max.   :120.00

Including Plots

=============================

Set the working directory

=============================

setwd(“C:/Users/artur/Downloads”)

=============================

Load necessary libraries

=============================

library(readxl) library(tidyverse) library(tidygeocoder) library(leaflet) library(htmltools) library(rnaturalearth) library(rnaturalearthdata) library(sf) library(base64enc) # for embedding images library(ggplot2) # for nicer charts

=============================

1) Convert local icon files to Base64

=============================

encode_icon <- function(filepath) { dataURI(file = filepath, mime = “image/png”) }

icon_map <- list( “pool” = encode_icon(“pool.png”), “theatre” = encode_icon(“theatre.png”), “museum” = encode_icon(“museum.png”), “opera” = encode_icon(“opera.png”), “concerthall” = encode_icon(“concerthall.png”) )

=============================

2) Read your main Excel data (full_experimental_data.xlsx)

=============================

main_data <- read_excel(“full_experimental_data.xlsx”, sheet = “Sheet1”)

Rename columns for convenience

main_data <- main_data %>% rename( country = Country, town = town, cultural_places = cultural_places, young_share = Young Share, old_share = Old Share, avg_age = Average Age, employment_rate = Employment Rate, education = Educational, troop_orchestra = Troop_Orchestra, hospital = Hospital, population = Population, description = Description )

Convert percentage strings to numeric values (Young/Old Share).

main_data <- main_data %>% mutate( young_share_num = as.numeric(gsub(“%”, ““, young_share)), old_share_num = as.numeric(gsub(”%“,”“, old_share)) )

Convert employment rate (if using commas as decimals)

main_data <- main_data %>% mutate(employment_rate = as.numeric(gsub(“,”, “.”, employment_rate)))

=============================

3) Read sector data from stacked_bar.xlsx

=============================

sector_data <- read_excel(“stacked_bar.xlsx”)

If your file has “Jūrmala” as a column header, rename it

sector_data <- sector_data %>% rename(“Jurmala” = “Jūrmala”)

=============================

Custom logic for labeling

=============================

If the Sector starts with “B+C” => label “B+C”

If the Sector starts with “D+E” => label “D+E”

If the Sector starts with “M+N” => label “M+N”

If the Sector starts with “R+S+T+U” => label “R+S+T+U”

Otherwise, just take the first letter.

sector_data <- sector_data %>% mutate(SectorLetter = case_when( str_starts(Sector, “B\+C”) ~ “B+C”, str_starts(Sector, “D\+E”) ~ “D+E”, str_starts(Sector, “M\+N”) ~ “M+N”, str_starts(Sector, “R\+S\+T\+U”) ~ “R+S+T+U”, TRUE ~ substr(Sector, 1, 1) ))

Preserve the order of the ‘Sector’ factor

sector_data\(Sector <- factor(sector_data\)Sector, levels = sector_data$Sector)

=============================

4) Geocode each row of main_data

=============================

main_data <- main_data %>% mutate(full_address = paste(town, country, sep = “,”)) %>% geocode(address = full_address, method = “osm”, lat = latitude, long = longitude)

=============================

5) Get country boundaries

=============================

countries <- ne_countries(scale = “medium”, returnclass = “sf”)

=============================

6) Create a horizontal stacked bar chart

=============================

create_stacked_bar <- function(city_name) { if (! city_name %in% colnames(sector_data)) { return(NULL) }

city_sector_data <- sector_data %>% select(Sector, SectorLetter, all_of(city_name)) %>% rename(Value = !!city_name)

p <- ggplot(city_sector_data, aes(x = 1, y = Value, fill = Sector)) + geom_bar(stat = “identity”, width = 0.7) + geom_text( aes(label = SectorLetter), position = position_stack(vjust = 0.5), color = “black”, size = 6, check_overlap = FALSE # show all letters even if they overlap ) + scale_fill_brewer(palette = “Paired”, guide = “none”) + theme_void() + # Flip coordinates horizontally coord_flip(clip = “off”) + # Slight expansion so letters near edges aren’t clipped scale_y_continuous(expand = expansion(mult = c(0.01, 0.01))) + theme( plot.title = element_text(hjust = 0.5, size = 14, face = “bold”), plot.margin = margin(20, 20, 20, 20) # extra space to avoid clipping ) + ggtitle(paste(“Sector Distribution -”, city_name))

# Save with bigger dimensions tmp_file <- tempfile(fileext = “.png”) ggsave(tmp_file, p, width = 10, height = 4, dpi = 96)

dataURI(file = tmp_file, mime = “image/png”) }

=============================

7) Build the Leaflet map

=============================

map <- leaflet() %>% addProviderTiles(providers$CartoDB.PositronNoLabels) %>% addPolygons( data = countries, color = “black”, weight = 3, fill = NA, opacity = 1 )

=============================

8) Build the top-right legend for cultural icons

=============================

legend_html <- paste0( “
“,”Legend
“,” Pool
“,” Theatre
“,” Museum
“,” Opera
“,” Concert Hall”, “

” )

map <- map %>% addControl(html = legend_html, position = “topright”)

=============================

9) Build the bottom-right legend for letters

=============================

legend_sector <- “

Sector Legend
”

Each row => Letter: Full Sector

for (i in seq_len(nrow(sector_data))) { letter <- sector_data\(SectorLetter[i] full_name <- sector_data\)Sector[i] legend_sector <- paste0(legend_sector, letter, “:”, full_name, “
”) }

legend_sector <- paste0(legend_sector, “

“)

map <- map %>% addControl(html = legend_sector, position = “bottomright”)

=============================

10) Add label-only markers for each row in main_data

=============================

target_countries <- c(“Norway”, “Denmark”, “Sweden”, “Finland”, “Estonia”, “Lithuania”, “Latvia”)

for (i in seq_len(nrow(main_data))) {

# Adjust this condition as you like if(main_data\(country[i] %in% target_countries || !main_data\)country[i] %in% target_countries) {

# Cultural place icons
places_raw <- main_data$cultural_places[i]
places_vec <- strsplit(places_raw, ",\\s*")[[1]]

icons_html <- lapply(places_vec, function(place) {
  place_key <- gsub("\\s+", "", tolower(place))
  if (place_key %in% names(icon_map)) {
    paste0("<img src='", icon_map[[place_key]], 
           "' width='24' height='24' style='margin-right:4px;'>")
  } else {
    place
  }
})
icons_html <- paste(icons_html, collapse = " ")

# Pie chart (Young vs Old)
pie_df <- data.frame(
  group = c("Young", "Old"),
  value = c(main_data$young_share_num[i], main_data$old_share_num[i])
) %>%
  mutate(label = paste0(group, " (", value, "%)"))

tmp_file_pie <- tempfile(fileext = ".png")
p_pie <- ggplot(pie_df, aes(x = "", y = value, fill = group)) +
  geom_bar(stat = "identity", width = 1) +
  coord_polar(theta = "y") +
  scale_fill_manual(values = c("#1f78b4", "#33a02c")) +
  theme_void() +
  theme(
    plot.title      = element_text(hjust = 0.5, size = 10, face = "bold"),
    legend.position = "none"
  ) +
  geom_text(aes(label = label), position = position_stack(vjust = 0.5), size = 3) +
  ggtitle("Age Distribution")

ggsave(tmp_file_pie, p_pie, width = 2.2, height = 2.2, dpi = 96)
pie_data64 <- dataURI(file = tmp_file_pie, mime = "image/png")

# Horizontal stacked bar
city_name <- main_data$town[i]
bar_data64 <- create_stacked_bar(city_name)

# Additional strings
troop_str <- ""
if (!is.na(main_data$troop_orchestra[i]) && nchar(main_data$troop_orchestra[i]) > 0) {
  troop_str <- paste0("<strong>Troop/Orchestra:</strong> ", main_data$troop_orchestra[i], "<br>")
}

hospital_str <- ""
if (toupper(main_data$hospital[i]) == "YES") {
  hospital_str <- "<strong>Hospital:</strong> Available<br>"
} else if (toupper(main_data$hospital[i]) == "NO") {
  hospital_str <- "<strong>Hospital:</strong> Not available<br>"
}

employment_str <- ""
if (!is.na(main_data$employment_rate[i])) {
  employment_str <- paste0("<strong>Employment Rate:</strong> ", main_data$employment_rate[i], "%<br>")
}

population_str <- ""
if (!is.na(main_data$population[i])) {
  population_str <- paste0(" (Population: ", main_data$population[i], ")")
}

description_str <- ""
if (!is.na(main_data$description[i]) && nchar(main_data$description[i]) > 0) {
  description_str <- paste0(main_data$description[i], "<br><br>")
}

# Popup HTML
label_html <- HTML(
  paste0(
    "<div style='font-family: Helvetica, Arial, sans-serif; font-size: 14px; color: #333; 
    background-color: #fff; padding: 8px 12px; border: 1px solid #ccc; border-radius: 8px; 
    max-width: 400px;'>",
    
    "<strong>", main_data$town[i], ", ", main_data$country[i], "</strong>",
    population_str, "<br>",
    description_str,
    
    icons_html, "<br><br>",
    
    # Pie chart
    "<img src='", pie_data64, "' width='140' height='140' style='display:block; margin-bottom:5px;'>",
    
    "<em>Average Age: ", main_data$avg_age[i], "</em><br>",
    employment_str,
    "<strong>Education:</strong> ", main_data$education[i], "<br>",
    troop_str,
    hospital_str,
    "<br>",
    
    if(!is.null(bar_data64)) {
      paste0("<img src='", bar_data64, 
             "' width='400' height='160' style='display:block; margin-bottom:5px;'>")
    } else {
      "<em>No sector data for this city</em><br>"
    },
    
    "</div>"
  )
)

map <- map %>%
  addLabelOnlyMarkers(
    lng = main_data$longitude[i],
    lat = main_data$latitude[i],
    label = label_html,
    labelOptions = labelOptions(
      noHide = TRUE,
      direction = "auto",
      textOnly = FALSE
    )
  )

} }

=============================

11) Display the final map

=============================

map