server.R

server <- function(input, output, session) {
  rescale <- function(x, new_min, new_max) {
    old_min <- min(x, na.rm = TRUE)
    old_max <- max(x, na.rm = TRUE)
    
    new_range <- new_max - new_min
    old_range <- old_max - old_min
    
    ((x - old_min) * new_range) / old_range + new_min
  }
  
  # Rescale 'Stress.Level' and 'Quality.of.Sleep' to new ranges (1-6)
  data$Stress.Level <- rescale(data$Stress.Level, 1, 6)
  data$Quality.of.Sleep <- rescale(data$Quality.of.Sleep, 1, 6)
  
  filtered_data <- reactive({
    filter_data <- data
    
    if (!is.null(input$occupation)) {
      if (input$occupation != "Everyone") {
        filter_data <- filter(filter_data, Occupation == input$occupation)
      }
    }
    
    
    if (!is.null(input$gender)) {
      if (input$gender != "Everyone") {
        filter_data <- filter(filter_data, Gender == input$gender)
      }
    }
    
    age_range <- input$age_range
    if (!is.null(input$age_range)) {
      filter_data <- filter(filter_data, Age >= age_range[1] & Age <= age_range[2])
    }
    
    #### Sleep Disorder + Physical Activity ###
    
    if (!is.null(input$sleep_disorder)) {
      if (input$sleep_disorder != "All") {
        filter_data <- filter(filter_data, Sleep.Disorder == input$sleep_disorder)
      }
    }
    
    if (!is.null(input$physical_activity)) {
      if (input$physical_activity != "All") {
        filter_data <- filter(filter_data, Physical.Activity.Level == input$physical_activity)
      }
    }
    
    return(filter_data)
  })
  
  total_people <- reactive({
    nrow(filtered_data())
  })
  
  sleep_counts <- reactive({
    filtered_data() %>% 
      count(Quality.of.Sleep)
  })  
  
  sleep_stress_counts <- reactive({
    filtered_data() %>% 
      count(Quality.of.Sleep, Stress.Level)
  })
  
  lowest_quality_occupation <- reactive({
    filtered_data <- filtered_data()
    
    if (is.null(filtered_data())) {
      return(NULL)
    }
    
    avg_quality_by_occupation <- filtered_data %>%
      group_by(Occupation) %>%
      summarise(avg_quality_sleep = mean(Quality.of.Sleep, na.rm = TRUE)) %>%
      arrange(avg_quality_sleep)  # Arrange by ascending average quality of sleep so it appears more natural to thr user
    
    # Get the lowest sleep occupation and the lowest average sleep
    lowest_quality_occupation <- avg_quality_by_occupation$Occupation[1]  
    lowest_avg_quality_sleep <- avg_quality_by_occupation$avg_quality_sleep[1]  
    
    return(list(occupation = lowest_quality_occupation, avg_quality_sleep = lowest_avg_quality_sleep))
    
  })
  
  output$plot <- renderPlot({
    stress_colors <- c("1" = "lightgreen", "2" = "yellowgreen", "3" = "gold",
                       "4" = "orange", "5" = "tomato", "6" = "red")
    
    
    sleep_stress_counts_plot <- 
      ggplot(sleep_stress_counts(), aes(x = Quality.of.Sleep, y = n, fill = fct_rev(factor(Stress.Level)))) +
      geom_bar(stat = "identity") +
      scale_fill_manual(values = stress_colors, 
                        name = "Stress Level",
                        breaks = c("1", "2", "3", "4", "5", "6"),
                        labels = c("Very Low Stress", "Low Stress", "Moderate Stress", 
                                   "High Stress", "Very High Stress", "Highest Stress")) +
      labs(title = paste("Quality of Sleep segmented by Stress Level for", input$occupation),
           y = "Number of People", 
           x = "Sleep Quality (1-6 scale)"
      ) +
      theme_minimal()
    
    return(sleep_stress_counts_plot)
  })
  
  output$lowest_quality_occupation_view <- renderText({
    lowest_occupation <- lowest_quality_occupation()
    
    # Display the occupation with the lowest quality of sleep
    if (!is.null(lowest_occupation)) {
      paste("Occupation with the lowest average quality of sleep is", lowest_occupation$occupation,
            "with an average quality of sleep of ", round(lowest_occupation$avg_quality_sleep, 2))
    } else {
      "No data available"
    }
  })
  
  # Pie chart for Sleep Disorder
  output$pie_chart <- renderPlotly({
    radar_data <- filtered_data()
    
    if (!is.null(radar_data)) {
      radar_data$Sleep.Disorder <- factor(
        radar_data$Sleep.Disorder,
        levels = c("None", "Insomnia", "Sleep Apnea")
      )
      
      colors <- c("None" = "#00FF00", "Insomnia" = "#FFA500", "Sleep Apnea" = "#FF0000")
      
      pie_chart <- plot_ly(
        labels = names(table(radar_data$Sleep.Disorder)),
        values = table(radar_data$Sleep.Disorder),
        type = "pie",
        marker = list(colors = colors)
      ) %>%
        layout(
          title = list(
            text = "Sleep Disorder Distribution (%)",
            font = list(size = 12)
          ),
          showlegend = TRUE
        )
      
      return(pie_chart)
    } else {
      # Empty plot if there's no data
      empty_pie <- plot_ly(
        labels = "No data available",
        values = 1,
        type = "pie"
      )
      
      return(empty_pie)
    }
  })
  
  # boxplot for Sleep Disorder vs. Physical Activity Level
  output$boxplot <- renderPlotly({
    radar_data <- filtered_data()  
    
    if (!is.null(radar_data)) {
      box_plot <- plot_ly(
        data = radar_data,
        x = ~Sleep.Disorder,
        y = ~Physical.Activity.Level,
        type = "box",
        boxmean = TRUE,
        color = ~Sleep.Disorder,
        colors = c("None" = "#00FF00", "Insomnia" = "#FFA500", "Sleep Apnea" = "#FF0000")
        
      ) %>%
        layout(
          title = list(
            text = "Relationship between Sleep Disorder and Physical Activity Level",
            font = list(size = 12) 
          ),
          xaxis = list(title = "Sleep Disorder"),
          yaxis = list(title = "Physical Activity Level (minutes/day)")
        )
      
      return(box_plot)
    } else {
      empty_boxplot <- plot_ly(
        x = "No data available",
        type = "box"
      )
      
      return(empty_boxplot)
    }
  })
  
  # heatmap for Health and Sleep factors
  output$heatmap <- renderPlotly({
    data <- filtered_data()  
    
    # Encode Sleep.Disorder and BMI.Category using label encoding
    # Separate Blood.Pressure into Systolic and Diastolic columns and convert to numeric
    data$Sleep.Disorder <- as.integer(factor(data$Sleep.Disorder))
    data$BMI.Category <- as.integer(factor(data$BMI.Category))
    data <- data %>%
      separate(Blood.Pressure, into = c("Systolic", "Diastolic"), sep = "/") %>%
      mutate(
        Systolic = as.numeric(Systolic),
        Diastolic = as.numeric(Diastolic)
      )
    
    # The columns of interest for the correlation map
    health_factors <- c("Heart.Rate", "Systolic", "Diastolic", "BMI.Category")
    sleep_factors <- c("Sleep.Duration", "Quality.of.Sleep", "Sleep.Disorder")
    
    correlation_matrix <- cor(data[, c(health_factors, sleep_factors)])
    if (any(is.na(correlation_matrix))) {
      return(NULL)
    }
    
    heatmap <- plot_ly(
      z = correlation_matrix,
      x = health_factors,
      y = sleep_factors,
      type = "heatmap",
      colors = "Purples"
    ) %>%
      layout(
        title = "Correlation Heatmap between Health Factors and Sleep Patterns",
        xaxis = list(title = "Health Factors"),
        yaxis = list(title = "Sleep Patterns")
      )
    
    return(heatmap)
  })
  
  kmedoids_clusters <- function(data, columns, num_clusters) {
    if (num_clusters < 2 || num_clusters >= nrow(data)) {
      # Return NULL if the number of clusters is not within the valid range
      return(NULL)
    }
    print(columns) # Check the columns being used for clustering
    
    clusters <- pam(data[, columns], k = num_clusters)
    list(clusters = clusters, selected_data = data)
  }
  
  clustered_data <- reactive({
    data <- filtered_data()
    
    req(input$first_variable, input$second_variable, input$num_clusters)
    
    first_var <- input$first_variable
    second_var <- input$second_variable
    num_clusters <- input$num_clusters
    
    # luster using the custom k-medoids method
    columns <- c(first_var, second_var)
    clustered <- kmedoids_clusters(data, columns, num_clusters)
    
    if (is.null(clustered)) {
      return(NULL)
    }
    
    result <- clustered$selected_data
    result$cluster <- as.factor(clustered$clusters$clustering)
    
    return(result)
  })
  
  # cluster visualization
  output$cluster_plot <- renderPlot({
    req(clustered_data())
    
    dataset <- clustered_data()
    if (is.null(dataset)) {
      return(NULL)
    }
    
    units <- list(
      Heart.Rate = "BPM",
      Quality.of.Sleep = "1-6 scale",
      Sleep.Duration = "hours",
      Physical.Activity.Level = "minutes per day",
      Daily.Steps = "number",
      Stress.Level = "1-6 scale"
    )
    
    x_axis_label <- paste(input$first_variable, "(", units[[input$first_variable]], ")")
    y_axis_label <- paste(input$second_variable, "(", units[[input$second_variable]], ")")
    
    ggplot(dataset, aes_string(x = input$first_variable, y = input$second_variable)) +
      geom_point(aes(color = cluster), size = 5) +
      stat_ellipse(aes(fill = cluster), 
                   type = "norm", level = 0.85, geom = "polygon", alpha = 0.2, color = "blue") +
      labs(
        title = "Dynamic Clustering Results",
        x = x_axis_label,
        y = y_axis_label,
        color = "Cluster",
        fill = "Cluster"
      ) +
      theme_minimal()
  })  
    
  # helper function to calculate dendrogram heights
  dendrogram_height <- function(dend) {
    heights <- vector(mode = "numeric", length = length(dend))
    for (i in 1:length(dend)) {
      heights[i] <- attr(dend[[i]], "height")
    }
    return(heights)
  }
  
  # The dendrogram plot used to help gauge the "appropriate" number of clusters
  output$dendrogram_plot <- renderPlot({
    req(clustered_data())
    
    # hierarchical clustering
    hc <- hclust(dist(clustered_data()[, c(input$first_variable, input$second_variable)]))
    
    dend <- as.dendrogram(hc)
    par(mar = c(5, 8, 4, 2))
    plot(dend, main = "Dendrogram", 
         xlab = "Distance", ylab = "Clusters",
         leaflab = "none", hang = -1)  # Set labels and orientation
    
    # Calculate height for the desired number of clusters and add the horizontal red line
    desired_clusters <- as.numeric(input$desired_clusters)
    heights <- dendrogram_height(dend)
    height_for_desired_clusters <- heights[length(heights) - desired_clusters + 1]
    abline(h = height_for_desired_clusters, col = "red", lty = 2)
  })
  
  output$choroplethMap <- renderPlotly({
    
    dataset <- filtered_data()
    if (nrow(dataset) == 0) {
      return(NULL)
    }
    selected_var <- input$variable
    
    units <- list(
      Heart.Rate = "BPM",
      Quality.of.Sleep = "1-6 scale",
      Sleep.Duration = "hours",
      Physical.Activity.Level = "minutes per day",
      Daily.Steps = "number", 
      Stress.Level="1-6 scale"
    )
    
    # For the selected variable, do the mean for each state 
    agg_data <- aggregate(dataset[[selected_var]], by = list(state = dataset$state, code = dataset$code), FUN = mean)
    if (nrow(agg_data) == 0) {
      return(NULL)
    }
    names(agg_data) <- c("state", "code", selected_var)
    
    rescaled_min <- min(agg_data[[selected_var]], na.rm = TRUE)
    rescaled_max <- max(agg_data[[selected_var]], na.rm = TRUE)
    
    # Create hover text based on the aggregated data
    agg_data$hover <- with(agg_data, paste(state, '<br>', selected_var, get(selected_var)))
    
    fig <- plot_geo(agg_data, locationmode = 'USA-states')
    if (selected_var == "Heart.Rate") { 
      # For Heart.Rate, keep the natural order of colorscale for higher values to be darker
      fig <- fig %>% add_trace(
        z = ~get(selected_var), text = ~hover, locations = ~code,
        color = ~get(selected_var), colors="Purples", 
        zmin = rescaled_min, zmax = rescaled_max
      )
    } else {
      # For other variables, use the reversed colorscale (lower values = darker shades)
      fig <- fig %>% add_trace(
        z = ~get(selected_var), text = ~hover, locations = ~code,
        color = ~get(selected_var), colors="Purples", 
        reversescale = TRUE, 
        zmin = rescaled_min, zmax = rescaled_max
      )
    }
    fig <- fig %>% colorbar(title = paste(selected_var, "(", units[[selected_var]], ")"))
    fig <- fig %>% layout(
      title = paste("Map of", selected_var, "Across the USA<br>(Hover for details)"),
      geo = list(
        scope = 'usa',
        projection = list(type = 'albers usa'),
        showlakes = TRUE,
        lakecolor = toRGB('white')
      )
    )
    
    fig
  })
  
}