library(tidyverse)
library(readxl)
library(scales)
library(DT)
library(gt)
library(ggplot2)
library(plyr)
library(dplyr)
library(tidyr)
library(plotly)
library(leaflet)
library(leaflet.extras)
library(crosstalk)
library(htmlwidgets)
library(waffle)
theme_set(theme_minimal(base_size = 24, base_family = "Atkinson Hyperlegible"))
data <- read.csv("U:/ManWin/My Documents/music_dashboard/data/final_dataset.csv")
unique_data <- read_excel("U:/ManWin/My Documents/music_dashboard/data/unique_data.xlsx")

Overall

Column

data$Gender<-as.factor(data$Gender)


num_males <- sum(data$Gender == "Male", na.rm = TRUE)
p_males <- (num_males / (nrow(data)- sum(is.na(data$Gender)))) 
p_males_color <- "primary"  

num_whiteuk <- sum(data$Ethnicity == "White UK", na.rm = TRUE)
p_ethnicity <-  (num_whiteuk / (nrow(data)- sum(is.na(data$Ethnicity)))) 
p_ethnicity_color <- "success"  



age_median <- median(data$Age, na.rm = TRUE)
p_age <- age_median
p_age_color <- "info"

Row

list(
  icon = "gender-male",
  color = p_males_color,
  value = label_percent(accuracy = 0.1)(p_males)
)
## $icon
## [1] "gender-male"
## 
## $color
## [1] "primary"
## 
## $value
## [1] "49.1%"
list(
  icon = "globe-americas",
  color = p_ethnicity_color,
  value = label_percent(accuracy = 0.1)(p_ethnicity)
)
## $icon
## [1] "globe-americas"
## 
## $color
## [1] "success"
## 
## $value
## [1] "88.9%"
list(
  icon = "graph-up-arrow",
  color = p_age_color,
  value = (p_age)
)
## $icon
## [1] "graph-up-arrow"
## 
## $color
## [1] "info"
## 
## $value
## [1] 65

Row

# Create a histogram for Age distribution
age_hist <- plot_ly(data, x = ~Age, type = 'histogram',
                    marker = list(color = 'rgba(0, 123, 255, 0.7)'),
                    name = "Age Distribution") %>%
  layout(xaxis = list(title = "Age"),
         yaxis = list(title = "Count"),
         bargap = 0.2)

# Display the plot
age_hist
## Warning: Ignoring 24 observations
age_plot <- data %>%
  plot_ly(x = ~Age, color = ~Gender, type = "histogram") %>%
  layout(
    xaxis = list(title = "Age", tickangle = 0),  # Rotate x-axis labels to be vertical
    yaxis = list(title = "Count")
  )

age_plot
## Warning: Ignoring 24 observations
gender_donut <- 
  plot_ly(
    data = subset(data, !is.na(Gender)),
    labels = ~Gender,
    type = "pie",
    hole = 0.4,  # Set the size of the hole for a donut effect
    marker = list(colors = c( "yellow", "violet"))  # Customize colors as needed
  ) %>%
  layout(
    showlegend = TRUE  # Set to FALSE if you don't want to show the legend
  )

# Print the plot
gender_donut
# Create a pie chart for Gender distribution without NA values
gender_pie <- plot_ly(data = subset(data, !is.na(Gender)), labels = ~Gender, type = 'pie',
                      marker = list(colors = c("lightblue","hotpink","purple"),
                                    line = list(color = 'rgba(255, 255, 255, 1)', width = 5))) %>%
  layout(  showlegend = TRUE)

# Display the plot
gender_pie
s<- c(Straight= 646,Bisexual=43, Gay = 5, Lesbian=10, Queer=22, Questioning= 6, Other =65)
waffle(s, size = 0, rows = 18)

# Count occurrences of each Ethnicity
ethnicity_counts <- table(data$Ethnicity)

# Create plotly donut chart
plot_ly(labels = names(ethnicity_counts), values = ethnicity_counts, type = 'pie',
        textinfo = 'percent', hole = 0.6) %>%
  layout(xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
         yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
age_sexuality_plot <- subset(data, !is.na(Sexuality)) %>%
  plot_ly(x = ~Age, color = ~Sexuality, type = "histogram",xbins = list(size = 15)) %>%
  layout(
    xaxis = list(title = "Age", tickangle = 0),
    yaxis = list(title = "Count"))
 
age_sexuality_plot
age_ethnicity_plot <- subset(data, !is.na(Ethnicity)) %>%
  plot_ly(x = ~Age, color = ~Ethnicity, type = "histogram",xbins = list(size = 15)) %>%
  layout(
    xaxis = list(title = "Age", tickangle = 0),
    yaxis = list(title = "Count"))
 
age_ethnicity_plot
age_disability_plot <- subset(data, !is.na(Disability)) %>%
  plot_ly(x = ~Age, color = ~Disability, type = "histogram",xbins = list(size = 15)) %>%
  layout(
    xaxis = list(title = "Age", tickangle = 0),
    yaxis = list(title = "Count"))
 
age_disability_plot

Column

# Create a basic leaflet map with tiles
map <- leaflet(unique_data) %>%
  addTiles() %>%
  
  # Add marker clusters with count labels
  addMarkers(
    lng = ~longitude,
    lat = ~latitude,
    label = ~as.character(Count),  # Display count as label
    clusterOptions = markerClusterOptions(
      showCoverageOnHover = FALSE,  # Disable coverage display on hover
      spiderfyOnMaxZoom = FALSE     # Disable spiderfy on max zoom
    )
  ) %>%
  
  # Customize marker cluster appearance
  addLegend(
    "bottomright",
    title = "Cluster Count",
    colors = c("lightgreen","#FFFF99","#FFC266"),
    labels = c("1-10", "11-100", ">100"),
    opacity = 1
  )

# Print the map
map

Folk Singing Types

Folk Events

Preference

Political Affiliation

Data

data |>
  datatable(
    colnames = c("Age","Ethnicity","Sexuality","Political", "Organiser", "Gender", "Disability" , "PoliticalParty" ),
    options = list(dom = 'ftp', paging = TRUE)
    )
## Warning in instance$preRenderHook(instance): It seems your data is too big for
## client-side DataTables. You may consider server-side processing:
## https://rstudio.github.io/DT/server.html