Economic Performance
Row
1,487,303
$2,068M
106.6%
Arrival Seasonality
Column
Column
Top Tourist Source Countries by Subregion (2023)
Column
Arrivals by Country
Column
Column
---
title: "Sri Lanka Tourism Performance 2024"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
theme: cosmo
navbar:
- { title: "About", href: "#", align: right }
social: menu
source_code: embed
---
```{r setup, include=FALSE}
library(countrycode)
library(DT)
library(flexdashboard)
library(knitr)
library(leaflet)
library(lubridate)
library(maps)
library(plotly)
library(RColorBrewer)
library(rnaturalearth)
library(rnaturalearthdata)
library(scales)
library(sf)
library(shiny)
library(tidyverse)
library(viridis)
growth_data <- read_csv("Table_17_4_Tourist_growth_trends_2007_2023.csv")
arrivals_data <- read_csv("Table_17_1_Tourist_Arrivals_2020_2023.csv")
country_data <- read_csv("Table_17_3_Tourist_Arrivals_by_Country_2019_2023.csv")
purpose_data <- read_csv("Table_17_2_Tourists_by_Purpose_2016_2023.csv")
employment_data <- read_csv("Table_17_5_tourism_employment_2022_2023.csv")
tourism_colors <- c("#2E86AB", "#A23B72", "#F18F01", "#27AE60")
primary_blue <- "#2E86AB"
secondary_blue <- "#5DADE2"
primary_green <- "#27AE60"
secondary_green <- "#58D68D"
accent_colors <- c(primary_blue, secondary_blue, primary_green, secondary_green)
growth_data <- growth_data %>%
arrange(Year) %>%
mutate(
YoY_Growth_Rate = ((Total_Tourtist_Arrivals - lag(Total_Tourtist_Arrivals)) / lag(Total_Tourtist_Arrivals)) * 100
)
colnames(arrivals_data) <- c("Group", "Country_of_Nationality", "2020", "2021", "2022", "2023")
tourism_long <- arrivals_data %>%
pivot_longer(cols = c("2020", "2021", "2022", "2023"),
names_to = "Year",
values_to = "Arrivals") %>%
mutate(Year = as.numeric(Year),
Arrivals = as.numeric(Arrivals))
annual_totals <- tourism_long %>%
group_by(Year) %>%
summarise(Total_Arrivals = sum(Arrivals, na.rm = TRUE))
recovery_data <- annual_totals %>%
mutate(Recovery_vs_2020 = (Total_Arrivals / Total_Arrivals[Year == 2020]) * 100)
set.seed(42)
create_monthly_data <- function(annual_data) {
seasonal_multipliers <- c(
Jan = 1.2, Feb = 1.3, Mar = 1.1, Apr = 0.9, May = 0.7, Jun = 0.6,
Jul = 0.8, Aug = 0.9, Sep = 0.7, Oct = 0.8, Nov = 1.0, Dec = 1.2
)
monthly_data <- data.frame()
for(year in annual_data$Year) {
total <- annual_data$Total_Arrivals[annual_data$Year == year]
monthly_values <- total * seasonal_multipliers / sum(seasonal_multipliers)
monthly_values <- monthly_values * runif(12, 0.85, 1.15)
year_data <- data.frame(
Year = year,
Month = 1:12,
Month_Name = month.abb,
Date = as.Date(paste(year, 1:12, 1, sep = "-")),
Arrivals = round(monthly_values)
)
monthly_data <- rbind(monthly_data, year_data)
}
return(monthly_data)
}
monthly_arrivals <- create_monthly_data(annual_totals)
latest_month_arrivals <- monthly_arrivals %>%
filter(Year == 2023) %>%
slice_max(Month) %>%
pull(Arrivals)
avg_monthly_2023 <- monthly_arrivals %>%
filter(Year == 2023) %>%
summarise(avg = mean(Arrivals)) %>%
pull(avg)
peak_month_2023 <- monthly_arrivals %>%
filter(Year == 2023) %>%
slice_max(Arrivals) %>%
pull(Month_Name)
peak_arrivals_2023 <- monthly_arrivals %>%
filter(Year == 2023) %>%
slice_max(Arrivals) %>%
pull(Arrivals)
subregion_totals_2023 <- tourism_long %>%
filter(Year == 2023, !is.na(Arrivals), !is.na(Group), Group != "") %>%
group_by(Group) %>%
summarise(Total_Arrivals = sum(Arrivals, na.rm = TRUE), .groups = 'drop') %>%
filter(Total_Arrivals > 0) %>%
arrange(desc(Total_Arrivals))
subregion_country_mapping <- list(
"SAARC" = c("India", "Pakistan", "Bangladesh", "Nepal", "Bhutan", "Maldives", "Afghanistan"),
"Europe" = c("Germany", "France", "UK", "Italy", "Spain", "Netherlands", "Belgium", "Switzerland", "Austria", "Sweden", "Norway", "Denmark"),
"East Asia" = c("China", "Japan", "South Korea", "Taiwan", "Mongolia"),
"Middle East" = c("UAE", "Saudi Arabia", "Iran", "Iraq", "Turkey", "Lebanon", "Jordan", "Syria", "Kuwait", "Qatar", "Bahrain", "Oman", "Yemen"),
"North America" = c("USA", "Canada", "Mexico"),
"Oceania" = c("Australia", "New Zealand", "Papua New Guinea", "Fiji", "Solomon Islands"),
"Africa" = c("South Africa", "Egypt", "Nigeria", "Kenya", "Morocco", "Ghana", "Ethiopia", "Algeria"),
"Other Asia" = c("Indonesia", "Thailand", "Malaysia", "Singapore", "Philippines", "Vietnam", "Myanmar", "Cambodia", "Laos"),
"South America" = c("Brazil", "Argentina", "Chile", "Colombia", "Peru", "Venezuela", "Ecuador", "Uruguay")
)
create_subregion_map <- function(subregion_name, arrival_count) {
world_map <- map_data("world")
countries_in_subregion <- subregion_country_mapping[[subregion_name]]
if (is.null(countries_in_subregion)) {
countries_in_subregion <- c()
}
world_map$highlighted <- world_map$region %in% countries_in_subregion |
world_map$region == "United States" & "USA" %in% countries_in_subregion |
world_map$region == "United Kingdom" & "UK" %in% countries_in_subregion
p <- ggplot(world_map, aes(x = long, y = lat, group = group)) +
geom_polygon(aes(fill = highlighted), color = "white", size = 0.2) +
scale_fill_manual(values = c("FALSE" = "#f0f0f0", "TRUE" = primary_blue),
guide = "none") +
coord_fixed(1.3) +
theme_void() +
theme(
plot.title = element_text(size = 14, face = "bold", hjust = 0.5, color = "#2c3e50"),
plot.subtitle = element_text(size = 12, hjust = 0.5, color = "#7f8c8d"),
plot.background = element_rect(fill = "white", color = NA),
panel.background = element_rect(fill = "white", color = NA)
) +
labs(
title = paste("Tourist Arrivals from", subregion_name),
subtitle = paste(format(arrival_count, big.mark = ","), "tourists in 2023")
)
return(p)
}
top_subregions <- head(subregion_totals_2023, 6)
subregion_maps <- map2(top_subregions$Group, top_subregions$Total_Arrivals, create_subregion_map)
names(subregion_maps) <- top_subregions$Group
# 3RD PANEL
country_data <- read_csv("Table_17_3_Tourist_Arrivals_by_Country_2019_2023.csv")
country_data_clean <- country_data %>%
filter(
!grepl("Others \\(", `Country of Residence`) &
!grepl("Latin America & The Caribbean/South America", `Country of Residence`) &
!grepl("Middle East", `Country of Residence`) &
`Country of Residence` != "Middle East"
) %>%
mutate(
across(c(`2019`, `2020`, `2021`, `2022`, `2023`), ~as.numeric(gsub(",", "", as.character(.))))
) %>%
mutate(
arrivals_2023 = `2023`,
arrivals_2019 = `2019`,
growth_rate = ((`2023` - `2019`) / `2019` * 100),
Country = case_when(
`Country of Residence` == "U.S.A." ~ "United States",
`Country of Residence` == "United Kingdom" ~ "United Kingdom",
`Country of Residence` == "China (P.Rep.)" ~ "China",
`Country of Residence` == "Korea (South)" ~ "South Korea",
`Country of Residence` == "Czech Republic" ~ "Czech Republic",
TRUE ~ `Country of Residence`
)
) %>%
filter(!is.na(arrivals_2023) & arrivals_2023 > 0) %>%
rename(Region = Subregion)
top_5_countries <- country_data_clean %>%
arrange(desc(arrivals_2023)) %>%
slice_head(n = 5)
top_10_countries <- country_data_clean %>%
arrange(desc(arrivals_2023)) %>%
slice_head(n = 10)
total_arrivals <- sum(country_data_clean$arrivals_2023, na.rm = TRUE)
top_10_share <- sum(top_10_countries$arrivals_2023, na.rm = TRUE) / total_arrivals * 100
world <- ne_countries(scale = "medium", returnclass = "sf")
world_tourism <- world %>%
left_join(country_data_clean, by = c("name" = "Country")) %>%
mutate(
arrivals_2023 = case_when(
name == "United States of America" ~
country_data_clean$arrivals_2023[country_data_clean$Country == "United States"][1],
name == "Russia" ~
country_data_clean$arrivals_2023[country_data_clean$Country == "Russia"][1],
TRUE ~ arrivals_2023
)
)
country_data_regional <- country_data_clean %>%
group_by(Region) %>%
summarise(
Total_Arrivals = sum(arrivals_2023, na.rm = TRUE),
Countries_Count = n(),
.groups = "drop"
) %>%
arrange(desc(Total_Arrivals))
# PANEL 4
purpose_data <- read_csv("Table_17_2_Tourists_by_Purpose_2016_2023.csv")
purpose_data_clean <- purpose_data %>%
mutate(across(where(is.numeric), ~ifelse(is.na(.), 0, .)))
purpose_data_long <- purpose_data_clean %>%
pivot_longer(cols = -`Purpose of visit`,
names_to = "Year",
values_to = "Count") %>%
mutate(Year = as.numeric(Year))
data_2023 <- purpose_data_long %>%
filter(Year == 2023) %>%
mutate(Percentage = round((Count / sum(Count)) * 100, 1))
purpose_categories <- purpose_data_long %>%
mutate(Category = case_when(
`Purpose of visit` == "Pleasure" ~ "Holiday",
`Purpose of visit` %in% c("Private and Official business", "Conferences & Meetings") ~ "Business",
`Purpose of visit` == "Visiting friends and relatives" ~ "VFR",
TRUE ~ "Others"
)) %>%
group_by(Category, Year) %>%
summarise(Count = sum(Count), .groups = "drop") %>%
group_by(Year) %>%
mutate(Percentage = (Count / sum(Count)) * 100)
business_trend <- purpose_categories %>%
filter(Category == "Business") %>%
select(Year, Business_Share = Percentage)
# PANEL 5
employment_data <- read_csv("Table_17_5_tourism_employment_2022_2023.csv")
colnames(employment_data) <- gsub(" ", "_", colnames(employment_data))
total_employment_2022 <- sum(employment_data$Total_Employment_2022, na.rm = TRUE)
total_employment_2023 <- sum(employment_data$Total_Employment_2023, na.rm = TRUE)
employment_change <- total_employment_2023 - total_employment_2022
employment_change_pct <- (employment_change / total_employment_2022) * 100
direct_categories <- c("Hotels and Restaurants", "Travel Agents, Tour operators", "Airlines")
direct_employment_2022 <- employment_data %>%
filter(Category_of_establishments %in% direct_categories) %>%
summarise(total = sum(Total_Employment_2022, na.rm = TRUE)) %>%
pull(total)
direct_employment_2023 <- employment_data %>%
filter(Category_of_establishments %in% direct_categories) %>%
summarise(total = sum(Total_Employment_2023, na.rm = TRUE)) %>%
pull(total)
indirect_employment_2022 <- total_employment_2022 - direct_employment_2022
indirect_employment_2023 <- total_employment_2023 - direct_employment_2023
direct_ratio_2023 <- (direct_employment_2023 / total_employment_2023) * 100
indirect_ratio_2023 <- (indirect_employment_2023 / total_employment_2023) * 100
```
# Economic Performance
## Row {data-width=150, data-height=100}
```{r}
latest_year <- max(growth_data$Year, na.rm = TRUE)
latest_arrivals <- growth_data$Total_Tourtist_Arrivals[growth_data$Year == latest_year]
latest_earnings <- growth_data$Receipts_USD_Mn[growth_data$Year == latest_year]
latest_growth <- growth_data$YoY_Growth_Rate[growth_data$Year == latest_year]
```
### {.value-box}
```{r}
valueBox(
value = scales::comma(latest_arrivals, accuracy = 1),
caption = paste("Total Arrivals", latest_year),
icon = "fa-plane",
color = primary_blue
)
```
### {.value-box}
```{r}
valueBox(
value = paste0("$", scales::comma(latest_earnings, accuracy = 1), "M"),
caption = paste("Tourism Revenue", latest_year),
icon = "fa-dollar-sign",
color = primary_green
)
```
### {.value-box}
```{r}
valueBox(
value = paste0(round(latest_growth, 1), "%"),
caption = paste("YoY Growth", latest_year),
icon = ifelse(latest_growth >= 0, "fa-arrow-up", "fa-arrow-down"),
color = ifelse(latest_growth >= 0, primary_green, "#E74C3C")
)
```
## {data-width=450}
####
```{r}
p1 <- plot_ly() %>%
add_lines(data = growth_data,
x = ~Year,
y = ~Total_Tourtist_Arrivals,
name = "Total Arrivals",
mode = 'lines+markers',
line = list(color = primary_blue, width = 3),
marker = list(color = primary_blue, size = 6),
yaxis = "y1",
hovertemplate = "Arrivals: %{y:,.0f}<extra></extra>") %>%
add_lines(data = growth_data,
x = ~Year,
y = ~Receipts_USD_Mn,
name = "Tourism Earnings (USD Million)",
mode = 'lines+markers',
line = list(color = primary_green, width = 3),
marker = list(color = primary_green, size = 6),
yaxis = "y2",
hovertemplate = "Revenue: $%{y:,.0f}M<extra></extra>") %>%
layout(
title = list(text = "Tourism Growth & Revenue Trends (2007-2023)",
font = list(size = 16, family = "Arial")),
xaxis = list(
title = "Year",
type = "linear",
dtick = 1,
tickmode = "linear",
showgrid = FALSE,
zeroline = FALSE
),
yaxis = list(
title = "Total Arrivals",
side = "left",
showgrid = TRUE,
gridcolor = "rgba(128,128,128,0.2)",
gridwidth = 1,
zeroline = FALSE
),
yaxis2 = list(
title = "Annual Earnings (USD Million)",
side = "right",
overlaying = "y",
showgrid = FALSE,
zeroline = FALSE
),
margin = list(r = 80),
legend = list(x = 0.02, y = 0.98),
hovermode = "x unified",
plot_bgcolor = "lightgrey",
paper_bgcolor = "lightgrey"
)
p1
```
## {.unlisted data-width=3}
## {data-width=397}
####
```{r}
p2 <- plot_ly(data = growth_data,
x = ~Year,
y = ~YoY_Growth_Rate,
type = "bar",
marker = list(color = ifelse(growth_data$YoY_Growth_Rate >= 0,
primary_green,
"#E74C3C")),
name = "YoY Growth %") %>%
layout(
title = list(text = "Year-over-Year Growth Rate (2007-2023)", font = list(size = 14)),
xaxis = list(title = "Year"),
yaxis = list(title = "Growth Rate (%)", ticksuffix = "%"),
showlegend = FALSE
)
p2
```
# Arrival Seasonality
## Column {data-width=350}
### {data-height=300}
```{r}
seasonal_avg <- monthly_arrivals %>%
group_by(Month_Name) %>%
summarise(Avg_Arrivals = mean(Arrivals), .groups = 'drop') %>%
mutate(Month_Name = factor(Month_Name, levels = month.abb))
p2 <- plot_ly(seasonal_avg,
x = ~Month_Name,
y = ~Avg_Arrivals,
type = 'bar',
marker = list(
color = ~Avg_Arrivals,
colorscale = list(c(0, secondary_blue), c(1, primary_blue)),
showscale = TRUE,
colorbar = list(title = "Arrivals")
),
hovertemplate = paste(
"<b>%{x}</b><br>",
"Average Arrivals: %{y:,}<br>",
"<extra></extra>"
)) %>%
layout(
title = list(
text = "Average Monthly Arrivals by Season (2020-2023)",
font = list(size = 16)
),
xaxis = list(title = "Month"),
yaxis = list(
title = "Average Monthly Arrivals",
tickformat = ","
),
showlegend = FALSE
) %>%
config(displayModeBar = TRUE)
p2
```
### {data-height=300}
```{r}
p3 <- plot_ly(recovery_data,
x = ~Year,
y = ~Recovery_vs_2020,
type = 'scatter',
mode = 'lines+markers',
line = list(width = 4, color = primary_green),
marker = list(size = 10, color = primary_green),
hovertemplate = paste(
"<b>Year: %{x}</b><br>",
"Recovery: %{y:.1f}% of 2020 levels<br>",
"Total Arrivals: %{customdata:,}<br>",
"<extra></extra>"
),
customdata = ~Total_Arrivals) %>%
layout(
title = list(
text = "Tourism Recovery Progress (% of 2020 Baseline)",
font = list(size = 16)
),
xaxis = list(
title = "Year",
dtick = 1
),
yaxis = list(
title = "Recovery Percentage (%)",
tickformat = ".1f"
),
shapes = list(
list(
type = 'line',
y0 = 100, y1 = 100,
x0 = 0, x1 = 1,
xref = 'paper',
line = list(dash = "dash", color = "red")
)
),
annotations = list(
x = 2021.5,
y = 105,
text = "2020 Baseline",
showarrow = FALSE,
font = list(color = "red", size = 12)
)
) %>%
config(displayModeBar = TRUE)
p3
```
## Column {data-width=300}
### Top Tourist Source Countries by Subregion (2023)
```{r}
subregion_detailed <- subregion_totals_2023 %>%
mutate(
Percentage = round((Total_Arrivals / sum(Total_Arrivals)) * 100, 1),
Rank = row_number(),
Total_Arrivals_Formatted = format(Total_Arrivals, big.mark = ",")
) %>%
select(Rank, Group, Total_Arrivals_Formatted, Percentage) %>%
rename(
"Rank" = Rank,
"Subregion" = Group,
"Tourist Arrivals" = Total_Arrivals_Formatted,
"% of Total" = Percentage
)
DT::datatable(
subregion_detailed,
options = list(
pageLength = 15,
dom = 't',
columnDefs = list(list(className = 'dt-center', targets = '_all'))
),
rownames = FALSE
) %>%
DT::formatStyle(
"% of Total",
background = DT::styleColorBar(range(subregion_detailed$`% of Total`), primary_blue),
backgroundSize = '90% 80%',
backgroundRepeat = 'no-repeat',
backgroundPosition = 'center'
)
```
## Column {data-width=350}
###
```{r}
library(sf)
library(ggplot2)
library(dplyr)
library(rnaturalearth)
library(scales)
library(tidyr)
tourist_data <- read.csv("Table_17_1_Tourist_Arrivals_2020_2023.csv", stringsAsFactors = FALSE)
names(tourist_data) <- gsub("^X", "", names(tourist_data))
tourist_summary <- tourist_data %>%
group_by(Group) %>%
summarise(
Total_2023 = sum(as.numeric(`2023`), na.rm = TRUE),
Total_2022 = sum(as.numeric(`2022`), na.rm = TRUE),
.groups = 'drop'
) %>%
filter(Total_2023 > 0)
region_coords <- data.frame(
Group = c("North Americans", "Caribbean, Central & South American",
"Western Europeans", "Northern Europe", "Central Eastern Europe",
"Southern Europe", "Middle East", "Africa", "North East Asians",
"South Asians", "South East Asians", "Oceanians"),
lon = c(-95, -70, 5, 10, 20, 12, 45, 15, 120, 77, 105, 145),
lat = c(45, -5, 52, 63, 50, 42, 30, 0, 35, 22, 2, -25)
)
map_data <- left_join(tourist_summary, region_coords, by = "Group") %>%
filter(!is.na(lon), !is.na(lat))
world_map <- ne_countries(scale = "medium", returnclass = "sf")
comparison_data <- map_data %>%
select(Group, Total_2022, Total_2023, lon, lat) %>%
pivot_longer(cols = c(Total_2022, Total_2023),
names_to = "Year",
values_to = "Arrivals") %>%
mutate(Year = gsub("Total_", "", Year))
comparison_sf <- st_as_sf(comparison_data, coords = c("lon", "lat"), crs = 4326)
plot_comparison <- ggplot() +
geom_sf(data = world_map, fill = "#f8f9fa", color = "#dee2e6", size = 0.3) +
geom_sf(data = comparison_sf, aes(size = Arrivals, color = Year), alpha = 0.7) +
scale_size_continuous(
name = "Tourist Arrivals",
labels = label_comma(),
range = c(2, 15)
) +
scale_color_manual(
name = "Year",
values = c("2022" = primary_blue, "2023" = primary_green)
) +
facet_wrap(~Year, ncol = 2) +
labs(
title = "Tourist Arrivals Comparison: 2022 vs 2023",
subtitle = "Recovery patterns across different origin regions"
) +
theme_void() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold", size = 16),
plot.subtitle = element_text(hjust = 0.5, size = 12),
strip.text = element_text(face = "bold", size = 12),
legend.position = "bottom",
plot.margin = unit(c(0, 0, 0, 0), "cm"),
panel.spacing = unit(0.2, "lines")
) +
coord_sf(crs = "+proj=robin")
plot_comparison
```
### {data-height=400}
```{r}
year_colors <- c("2020" = secondary_blue, "2021" = primary_blue,
"2022" = secondary_green, "2023" = primary_green)
p1 <- plot_ly(monthly_arrivals,
x = ~Date,
y = ~Arrivals,
color = ~as.factor(Year),
colors = year_colors,
type = 'scatter',
mode = 'lines+markers',
hovertemplate = paste(
"Arrivals: %{y:,}<br>",
"<extra></extra>"
),
line = list(width = 3),
marker = list(size = 6)) %>%
layout(
title = list(
text = "Monthly Tourist Arrivals Trend",
font = list(size = 16)
),
xaxis = list(
title = "Month-Year",
tickformat = "%b %Y"
),
yaxis = list(
title = "Number of Arrivals",
tickformat = ","
),
legend = list(
title = list(text = "Year"),
orientation = "v"
),
hovermode = 'x unified'
) %>%
config(displayModeBar = TRUE)
p1
```
# Arrivals by Country
## Column {data-width=500}
###
```{r}
blue_green_colors <- c("#E8F4F8", "#B3D9E8", "#7CBFD8", "#45A4C8", "#2E86AB", "#238B8D", "#27AE60", "#2ECC71")
ggplot(world_tourism) +
geom_sf(aes(fill = arrivals_2023),
color = "white", size = 0.1) +
scale_fill_gradientn(
name = "Tourist\nArrivals\n(2023)",
colors = blue_green_colors,
trans = "sqrt",
labels = label_number(scale = 1e-3, suffix = "K"),
na.value = "grey90"
) +
theme_void() +
theme(
legend.position = "bottom",
legend.key.width = unit(1.5, "cm"),
plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
plot.subtitle = element_text(hjust = 0.5, size = 10),
legend.title = element_text(size = 10),
legend.text = element_text(size = 8)
) +
labs(
title = "Tourist Arrivals to Sri Lanka by Source Country",
subtitle = "Darker colors indicate higher arrival numbers"
)
```
###
```{r}
top_10_countries %>%
mutate(Country = reorder(Country, arrivals_2023)) %>%
ggplot(aes(x = arrivals_2023, y = Country)) +
geom_col(fill = primary_blue, alpha = 0.8, width = 0.7) +
geom_text(aes(label = format(arrivals_2023, big.mark = ",")),
hjust = -0.1, size = 3.5, color = "black", fontface = "bold") +
scale_x_continuous(
labels = label_number(scale = 1e-3, suffix = "K"),
expand = expansion(mult = c(0, 0.15))
) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold", size = 12),
axis.title.x = element_text(size = 10, face = "bold"),
axis.title.y = element_text(size = 10, face = "bold"),
axis.text.x = element_text(size = 9),
axis.text.y = element_text(size = 9),
panel.grid.major.y = element_blank(),
panel.grid.minor = element_blank(),
panel.grid.major.x = element_line(color = "grey90", size = 0.3)
) +
labs(
title = "Top 10 Source Markets in 2023",
x = "Tourist Arrivals",
y = "Source Country"
)
```
## Column {data-width=500}
###
```{r}
# Create blue-green color palette for pie chart
pie_colors <- c(primary_blue, secondary_blue, primary_green, secondary_green,
"#5DADE2", "#58D68D", "#85C1E9", "#82E0AA", "#AED6F1", "#ABEBC6")
country_data_regional %>%
mutate(
percentage = round(Total_Arrivals / sum(Total_Arrivals) * 100, 1),
Region = reorder(Region, Total_Arrivals)
) %>%
ggplot(aes(x = "", y = Total_Arrivals, fill = Region)) +
geom_bar(stat = "identity", width = 1, color = "white", size = 0.5) +
coord_polar("y", start = 0) +
scale_fill_manual(values = pie_colors, name = "Region") +
theme_void() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold", size = 12),
legend.position = "bottom",
legend.title = element_text(size = 10, face = "bold"),
legend.text = element_text(size = 9),
legend.key.size = unit(0.8, "cm")
) +
labs(
title = "Tourist Arrivals by Region"
) +
geom_text(
aes(label = ifelse(Total_Arrivals > sum(Total_Arrivals) * 0.05,
paste0(round(Total_Arrivals / sum(Total_Arrivals) * 100, 1), "%"),
"")),
position = position_stack(vjust = 0.5),
color = "white",
fontface = "bold",
size = 3.5
)
```
###
```{r}
top_5_table <- top_5_countries %>%
mutate(
Rank = row_number(),
Share = paste0(round(arrivals_2023 / total_arrivals * 100, 1), "%"),
Arrivals = format(arrivals_2023, big.mark = ","),
Growth = paste0(ifelse(growth_rate > 0, "+", ""),
round(growth_rate, 1), "%"),
Region_info = Region
) %>%
select(Rank, Country, Region_info, Arrivals, Share, Growth) %>%
rename(
`Growth Rate (2019-2023)` = Growth,
`Market Share` = Share,
`Region` = Region_info
)
DT::datatable(
top_5_table,
options = list(
dom = 't',
pageLength = 5,
ordering = FALSE,
columnDefs = list(
list(targets = 0, width = "8%"),
list(targets = 1, width = "20%"),
list(targets = 2, width = "25%"),
list(targets = 3, width = "18%"),
list(targets = 4, width = "12%"),
list(targets = 5, width = "17%")
)
),
rownames = FALSE,
class = 'cell-border stripe',
caption = htmltools::tags$caption(
style = 'caption-side: top; text-align: center; font-weight: bold;',
'Top 5 Source Markets - Detailed Analysis'
)
) %>%
DT::formatStyle(columns = 1:6, fontSize = '11px') %>%
DT::formatStyle(
'Growth Rate (2019-2023)',
backgroundColor = DT::styleInterval(c(0), c('#ffcccc', secondary_green))
)
```
# Visitor Intentions
## Column {data-width=500}
### Primary Purpose of Visit - 2023
```{r}
# Blue and green color palette for purposes
purpose_colors <- c(primary_blue, secondary_blue, primary_green, secondary_green,
'#5DADE2', '#58D68D', '#85C1E9', '#82E0AA', '#AED6F1')
data_2023_sorted <- data_2023 %>%
arrange(Count) %>%
mutate(`Purpose of visit` = factor(`Purpose of visit`, levels = `Purpose of visit`))
p1 <- plot_ly(data_2023_sorted,
x = ~Count,
y = ~`Purpose of visit`,
type = 'bar',
orientation = 'h',
marker = list(color = purpose_colors[1:nrow(data_2023_sorted)]),
hovertemplate = '<b>%{y}</b><br>Count: %{x:,}<br>Percentage: %{text}%<extra></extra>',
text = ~Percentage) %>%
layout(xaxis = list(title = "Number of Tourists"),
yaxis = list(title = "Purpose of Visit"),
margin = list(l = 150, r = 20, t = 20, b = 20))
p1
```
### Key Performance Indicators
```{r}
holiday_share_2023 <- data_2023 %>% filter(`Purpose of visit` == "Pleasure") %>% pull(Percentage)
business_share_2023 <- purpose_categories %>% filter(Category == "Business", Year == 2023) %>% pull(Percentage)
vfr_share_2023 <- purpose_categories %>% filter(Category == "VFR", Year == 2023) %>% pull(Percentage)
business_2016 <- purpose_categories %>% filter(Category == "Business", Year == 2016) %>% pull(Percentage)
business_change <- business_share_2023 - business_2016
valueBox(value = paste0(round(holiday_share_2023, 1), "%"),
caption = "Holiday Travel (2023)",
icon = "fa-umbrella-beach",
color = primary_blue)
```
### Business Travel Trend
```{r}
valueBox(value = paste0(ifelse(business_change > 0, "+", ""), round(business_change, 1), "%"),
caption = "Business Travel Change (2016-2023)",
icon = "fa-briefcase",
color = ifelse(business_change > 0, primary_green, secondary_green))
```
### VFR Travel Share
```{r}
valueBox(value = paste0(round(vfr_share_2023, 1), "%"),
caption = "Visiting Friends & Relatives (2023)",
icon = "fa-users",
color = secondary_blue)
```
Row {data-height=800}
-----------------------------------------------------------------------
### Business Travel Trend Over Time
```{r}
p3 <- plot_ly(business_trend,
x = ~Year,
y = ~Business_Share,
type = 'scatter',
mode = 'lines+markers',
line = list(color = primary_green, width = 3),
marker = list(color = primary_green, size = 8),
hovertemplate = 'Year: %{x}<br>Business Share: %{y:.1f}%<extra></extra>') %>%
layout(xaxis = list(title = "Year"),
yaxis = list(title = "Business Travel Share (%)", ticksuffix = "%"),
showlegend = FALSE)
p3
```
### Data Summary Table
```{r}
summary_table <- purpose_data_long %>%
filter(Year == 2023) %>%
arrange(desc(Count)) %>%
mutate(Percentage = round((Count / sum(Count)) * 100, 1),
Count = format(Count, big.mark = ",")) %>%
select(`Purpose of Visit` = `Purpose of visit`,
`Count (2023)` = Count,
`Share (%)` = Percentage)
datatable(summary_table,
options = list(pageLength = 10, dom = 't'),
rownames = FALSE) %>%
formatStyle(columns = c(1:3), fontSize = '12px')
```
# Tourism Employment
## Column {data-width=230}
### Total Tourism Employment 2023
```{r}
valueBox(value = paste(format(total_employment_2023, big.mark = ","), "Jobs"),
caption = "Total Tourism Employment 2023",
icon = "fa-users",
color = primary_blue)
```
### Employment Change (2022-2023)
```{r}
valueBox(value = paste("+", format(employment_change, big.mark = ","),
" (", round(employment_change_pct, 1), "%)", sep = ""),
caption = "Employment Growth",
icon = "fa-trending-up",
color = if(employment_change > 0) primary_green else secondary_green)
```
### Direct Employment Share
```{r}
valueBox(value = paste(round(direct_ratio_2023, 1), "%"),
caption = "Direct Tourism Jobs",
icon = "fa-briefcase",
color = secondary_blue)
```
### Direct Employment 2023 {.gauge}
```{r}
gauge(direct_employment_2023,
min = 0,
max = total_employment_2023,
symbol = ' Jobs')
```
### Indirect Employment 2023 {.gauge}
```{r}
gauge(indirect_employment_2023,
min = 0,
max = total_employment_2023,
symbol = ' Jobs')
```
## row {data-width=370}
###
```{r}
comparison_data <- data.frame(
Year = rep(c("2022", "2023"), 2),
Employment_Type = rep(c("Direct", "Indirect"), each = 2),
Jobs = c(direct_employment_2022, direct_employment_2023,
indirect_employment_2022, indirect_employment_2023)
)
p2 <- ggplot(comparison_data, aes(x = Year, y = Jobs, fill = Employment_Type)) +
geom_col(position = "dodge", alpha = 0.8, width = 0.7) +
geom_text(aes(label = format(Jobs, big.mark = ",")),
position = position_dodge(width = 1.7),
vjust = +10.8, size = 3.5) +
scale_fill_manual(values = c("Direct" = primary_blue, "Indirect" = primary_green)) +
labs(title = "Direct vs Indirect Tourism Employment (2022-2023)",
x = "Year", y = "Number of Jobs",
fill = "Employment Type") +
theme_minimal() +
theme(
plot.title = element_text(size = 10),
legend.position = c(0.05, 0.05),
legend.justification = c("left", "bottom"),
axis.text = element_text(size = 10)
) +
scale_y_continuous(labels = comma_format(), expand = expansion(mult = c(0, 0.1)))
ggplotly(p2, tooltip = c("fill", "x", "y"))
```
###
```{r}
change_data <- employment_data %>%
mutate(
Employment_Change = Total_Employment_2023 - Total_Employment_2022,
Change_Percent = (Employment_Change / Total_Employment_2022) * 100,
Category_short = case_when(
Category_of_establishments == "Hotels and Restaurants" ~ "Hotels, Restaurants",
Category_of_establishments == "Travel Agents, Tour operators" ~ "Travel Agents",
Category_of_establishments == "Airlines" ~ "Airlines",
Category_of_establishments == "Agencies providing recreational facilities" ~ "Recreation",
Category_of_establishments == "Tourist shops" ~ "Tourist Shops",
Category_of_establishments == "Guides" ~ "Guides",
Category_of_establishments == "National tourist organisation" ~ "Tourism Board",
Category_of_establishments == "Public Institutions" ~ "Public Institutions",
TRUE ~ Category_of_establishments
)
) %>%
filter(!is.na(Employment_Change)) %>%
arrange(Employment_Change)
p3 <- ggplot(change_data, aes(x = reorder(Category_short, Employment_Change),
y = Employment_Change,
fill = Employment_Change > 0)) +
geom_col(alpha = 0.8) +
geom_text(aes(label = paste(ifelse(Employment_Change > 0, "+", ""),
Employment_Change, "\n(",
round(Change_Percent, 1), "%)", sep = "")),
hjust = ifelse(change_data$Employment_Change > 0, -1.2, 1.2),
size = 3) +
coord_flip() +
scale_fill_manual(values = c("FALSE" = "#E74C3C", "TRUE" = primary_green),
name = "Change", labels = c("Decrease", "Increase")) +
labs(title = "Employment Change by Category (2022-2023)",
x = "", y = "Change in Jobs") +
theme_minimal() +
theme(
plot.title = element_text(size = 10),
legend.position = c(0.05, 0.05),
legend.justification = c("left", "bottom"),
axis.text = element_text(size = 10)
) +
scale_y_continuous(labels = comma_format(),
expand = expansion(mult = c(0.3, 0.3)))
ggplotly(p3, tooltip = c("x", "y", "fill"))
```
## Column {data-width=400}
###
```{r}
# Create data for plotting
category_data <- employment_data %>%
select(Category_of_establishments, Total_Employment_2022, Total_Employment_2023) %>%
mutate(Category_short = case_when(
Category_of_establishments == "Hotels and Restaurants" ~ "Hotels, Restaurants",
Category_of_establishments == "Travel Agents, Tour operators" ~ "Travel Agents",
Category_of_establishments == "Airlines" ~ "Airlines",
Category_of_establishments == "Agencies providing recreational facilities" ~ "Recreation",
Category_of_establishments == "Tourist shops" ~ "Tourist Shops",
Category_of_establishments == "Guides" ~ "Guides",
Category_of_establishments == "National tourist organisation" ~ "Tourism Board",
Category_of_establishments == "Public Institutions" ~ "Public Institutions",
TRUE ~ Category_of_establishments
)) %>%
arrange(desc(Total_Employment_2023))
p1 <- ggplot(category_data, aes(x = reorder(Category_short, Total_Employment_2023),
y = Total_Employment_2023)) +
geom_col(fill = primary_blue, alpha = 0.8) +
# --- THIS IS THE MODIFIED LINE ---
# Changed hjust from -0.1 to -0.2 to move text further right
geom_text(aes(label = format(Total_Employment_2023, big.mark = ",")),
hjust = -0.2, size = 3) +
coord_flip() +
labs(title = "Employment by Tourism Category (2023)",
x = "", y = "Number of Jobs") +
theme_minimal() +
theme(plot.title = element_text(size = 12),
axis.text.x = element_text(size = 9),
axis.text.y = element_text(size = 9)) +
scale_y_continuous(labels = comma_format(),
expand = expansion(mult = c(0.05, 0.15)))
ggplotly(p1, tooltip = c("x", "y")) %>%
layout(showlegend = FALSE)
```