diff options
| -rw-r--r-- | Longevity_app_offline_version.R | 415 |
1 files changed, 415 insertions, 0 deletions
diff --git a/Longevity_app_offline_version.R b/Longevity_app_offline_version.R new file mode 100644 index 0000000..cfa8dd9 --- /dev/null +++ b/Longevity_app_offline_version.R @@ -0,0 +1,415 @@ +## This code works, but if you have a case where the same strain has two samples with the same mean then only one DOI is shown.
+## David Ashbrook
+## dashbroo@UTHSC.edu
+## 18 June 2024
+
+library("xlsx")
+library(shiny)
+library(ggplot2)
+library(dplyr)
+library(plotly)
+library(shinyjs) # Added library for JavaScript interaction.
+
+
+#Strains_longevity_data <- read.xlsx("D:/University of Tennessee/University of Tennessee/Ashbrook Lab - Documents/Longevity_data_collection/Summary_of_data_MASTER.xlsx", header=TRUE, sheetIndex = 1, startRow = 3)
+
+github_link <- "https://github.com/Dashbrook/Mouse_Longevity_app/raw/main/Summary_of_data_MASTER.xlsx"
+library(httr)
+temp_file <- tempfile(fileext = ".xlsx")
+req <- GET(github_link,
+ # authenticate using GITHUB_PAT
+ authenticate(Sys.getenv("GITHUB_PAT"), ""),
+ # write result to disk
+ write_disk(path = temp_file))
+Strains_longevity_data <- read.xlsx(temp_file, header=TRUE, sheetIndex = 1, startRow = 3)
+Strains_longevity_data
+
+unlink(temp_file)
+rm(temp_file)
+
+
+#url <- "https://github.com/genenetwork/gn-docs/raw/master/general/brand/aging/Summary_of_data_15_Sept_2023_freeze.csv"
+
+#Strains_longevity_data <- read.csv(file = url, header = TRUE, skip = 2)
+
+#Strains_longevity_data <- read.csv(file = "C57L_JxA_HeJF1.csv", header = TRUE, na.strings = c("", " ", "NA"))
+
+
+
+# Load Shiny and other required libraries
+library("xlsx")
+library(shiny)
+library(ggplot2)
+library(dplyr)
+library(plotly)
+require(tidyr)
+library(shinyjs) # Added library for JavaScript interaction.
+
+# Data preprocessing: Convert columns to appropriate data types
+Strains_longevity_data$lab <- as.factor(Strains_longevity_data$Where.mice.maintained)
+Strains_longevity_data$Sex <- as.factor(Strains_longevity_data$Sex)
+Strains_longevity_data$First.author <- as.factor(Strains_longevity_data$First.Author)
+
+Strains_longevity_data$mean <- as.numeric(Strains_longevity_data$mean)
+Strains_longevity_data$SE <- as.numeric(Strains_longevity_data$SE)
+Strains_longevity_data$N <- as.numeric(Strains_longevity_data$N)
+Strains_longevity_data$Maximum.lifespan <- as.numeric(Strains_longevity_data$Maximum.lifespan)
+Strains_longevity_data$median <- as.numeric(Strains_longevity_data$median)
+Strains_longevity_data$years <- as.numeric(Strains_longevity_data$Year.paper.published)
+Strains_longevity_data$SD <- as.numeric(Strains_longevity_data$SD)
+Strains_longevity_data$CV <- as.numeric(Strains_longevity_data$CV)
+Strains_longevity_data$Age.started..estimated.approx..days. <- as.numeric(Strains_longevity_data$Age.started..estimated.approx..days.)
+Strains_longevity_data$Year.paper.published <- as.numeric(Strains_longevity_data$Year.paper.published)
+
+Strains_longevity_data$Strain_by_Sex <- interaction(Strains_longevity_data$Strain, Strains_longevity_data$Sex)
+
+
+Strains_longevity_data$Who_and_where <- interaction(Strains_longevity_data$Strain, Strains_longevity_data$Where.mice.maintained)
+
+
+
+Strains_longevity_data %>% drop_na(SD)
+
+# Define the Shiny UI layout
+ui <- fluidPage(
+ titlePanel("Mouse Longevity Data Explorer"),
+ fluidRow(
+ column(width = 2,
+ selectInput("x_axis", "X-Axis Column:", choices = colnames(Strains_longevity_data), selected = "Strain")
+ ),
+ column(width = 2,
+ selectInput("y_axis", "Y-Axis Column:", choices = colnames(Strains_longevity_data), selected = "mean")
+ ),
+ column(width = 2,
+ selectInput("error_bar", "Error Bar Column:", choices = c("SE", "SD", "CV"))
+ ),
+ column(width = 2,
+ selectInput("plot_type", "Plot Type:", choices = c("scatter", "boxplot"))
+ ),
+ column(width = 2,
+ selectInput("filter_column", "Filter Column:", choices = colnames(Strains_longevity_data), selected = "Where.mice.maintained")
+ ),
+ column(width = 2,
+ selectInput("filter_value", "Filter Value:", choices = NULL)
+ ),
+ column(width = 2,
+ selectInput("color_by", "Color By:", choices = colnames(Strains_longevity_data), selected = "Sex")
+ ),
+ column(width = 2,
+ checkboxInput("filter_checkbox", "Turn Filtering On", value = FALSE)
+ ),
+ column(width = 2,
+ selectInput("intervention_filter_column", "Intervention Filter Column:", choices = colnames(Strains_longevity_data), selected = "Intervention")
+ ),
+ column(width = 2,
+ selectInput("intervention_filter_value", "Intervention Filter Value:", choices = NULL, selected = "Control")
+ ),
+ column(width = 2,
+ checkboxInput("intervention_filter_checkbox", "Turn Intervention Filtering On", value = TRUE)
+ ),
+ column(width = 2,
+ selectInput("shape_by", "Shape By:", choices = colnames(Strains_longevity_data), selected = "Where.mice.maintained")
+ ),
+ column(width = 2,
+ actionButton("reset_button", "Reset to Defaults")
+ ),
+ column(width = 2,
+ textInput("search_term", "Search Term:")
+ ),
+ # Add a checkbox to enable/disable the Age Cutoff (Days) filter
+ column(width = 2,
+ checkboxInput("age_cutoff_checkbox", "Use Age Cutoff Filter", value = FALSE)
+ ),
+ # Add a numeric input for age cutoff with a default value of 3650
+ column(width = 2,
+ numericInput("age_cutoff", "Max age at start cutoff (Approx. Days):", value = 3650, min = 0, step = 1)
+ ),
+
+ column(width = 2,
+ sliderInput("year_range", "Select Year Range:",
+ min = min(Strains_longevity_data$Year.paper.published, na.rm = TRUE),
+ max = max(Strains_longevity_data$Year.paper.published, na.rm = TRUE),
+ value = c(min(Strains_longevity_data$Year.paper.published, na.rm = TRUE),
+ max(Strains_longevity_data$Year.paper.published, na.rm = TRUE)),
+ step = 1,
+ sep = "")
+ ),
+
+
+ column(width = 2,
+ sliderInput("N", "N mice in cohort:",
+ min = min(Strains_longevity_data$N, na.rm = TRUE),
+ max = max(Strains_longevity_data$N, na.rm = TRUE),
+ value = c(min(Strains_longevity_data$N, na.rm = TRUE),
+ max(Strains_longevity_data$N, na.rm = TRUE)),
+ step = 1,
+ sep = "")
+ )
+ ),
+
+ fluidRow(
+ column(width = 12,
+ textOutput("doi_url_display"), # Move this line above the plot
+ plotlyOutput("plot")
+ )
+ )
+)
+
+# Define the Shiny server logic
+server <- function(input, output, session) {
+
+ # Define default values for input fields
+ default_values <- reactive({
+ list(
+ x_axis = "Strain",
+ y_axis = "mean",
+ error_bar = "SE",
+ plot_type = "scatter",
+ filter_column = "Where.mice.maintained",
+ filter_value = NULL,
+ color_by = "Sex",
+ filter_checkbox = FALSE,
+ intervention_filter_column = "Intervention",
+ intervention_filter_value = "Control",
+ intervention_filter_checkbox = TRUE,
+ shape_by = "Where.mice.maintained"
+ )
+ })
+
+ # Reset button click event
+ observeEvent(input$reset_button, {
+ default <- default_values()
+ updateSelectInput(session, "x_axis", selected = default$x_axis)
+ updateSelectInput(session, "y_axis", selected = default$y_axis)
+ updateSelectInput(session, "error_bar", selected = default$error_bar)
+ updateSelectInput(session, "plot_type", selected = default$plot_type)
+ updateSelectInput(session, "filter_column", selected = default$filter_column)
+ updateSelectInput(session, "filter_value", selected = default$filter_value)
+ updateSelectInput(session, "color_by", selected = default$color_by)
+ updateCheckboxInput(session, "filter_checkbox", value = default$filter_checkbox)
+ updateSelectInput(session, "intervention_filter_column", selected = default$intervention_filter_column)
+ updateSelectInput(session, "intervention_filter_value", selected = default$intervention_filter_value)
+ updateCheckboxInput(session, "intervention_filter_checkbox", value = default$intervention_filter_checkbox)
+ updateSelectInput(session, "shape_by", selected = default$shape_by)
+ updateNumericInput(session, "age_cutoff", value = NULL)
+ })
+
+ observe({
+ # Update filter values based on selected filter column
+ filter_column_values <- unique(Strains_longevity_data[, input$filter_column])
+ updateSelectInput(session, "filter_value", choices = filter_column_values)
+ })
+
+ observe({
+ # Update intervention filter values based on selected intervention filter column
+ intervention_filter_column_values <- unique(Strains_longevity_data[, input$intervention_filter_column])
+ updateSelectInput(session, "intervention_filter_value", choices = intervention_filter_column_values)
+ })
+
+ filtered_data <- reactive({
+ filtered_data <- Strains_longevity_data
+
+ if (input$filter_checkbox) {
+ if (!is.null(input$filter_column) && input$filter_column != "" && !is.null(input$filter_value) && input$filter_value != "") {
+ filtered_data <- filtered_data %>%
+ filter(!!sym(input$filter_column) == input$filter_value)
+ }
+ }
+
+ # Apply intervention filter if the checkbox is checked
+ if (input$intervention_filter_checkbox) {
+ if (!is.null(input$intervention_filter_column) && input$intervention_filter_column != "" &&
+ !is.null(input$intervention_filter_value) && input$intervention_filter_value != "") {
+ filtered_data <- filtered_data %>%
+ filter(!!sym(input$intervention_filter_column) == input$intervention_filter_value)
+ }
+ }
+
+ # Filter the data to exclude rows with NA or blank values in x and y axes
+ filtered_data <- filtered_data %>%
+ filter(!is.na(!!sym(input$x_axis)) & !is.na(!!sym(input$y_axis)) & !!sym(input$x_axis) != "" & !!sym(input$y_axis) != "")
+
+ filtered_data <- filtered_data %>%
+ filter(Year.paper.published >= input$year_range[1] & Year.paper.published <= input$year_range[2])
+
+
+ filtered_data <- filtered_data %>%
+ filter(N >= input$N[1] & N <= input$N[2])
+
+
+ # Add the search term filter
+ search_term <- input$search_term
+ if (!is.null(search_term) && search_term != "") {
+ filtered_data <- filtered_data %>%
+ filter(grepl(search_term, Strain) | grepl(search_term, Maternal.strain) | grepl(search_term, Paternal.strain))
+ }
+
+ # Add the age cutoff filter if the checkbox is checked and a value is entered
+ if (input$age_cutoff_checkbox) {
+ age_cutoff <- input$age_cutoff
+ if (!is.null(age_cutoff)) {
+ filtered_data <- filtered_data %>%
+ filter(!!sym("Age.started..estimated.approx..days.") <= age_cutoff)
+ }
+ }
+
+ # Check the order of columns in filtered_data
+ print(names(filtered_data))
+
+ # Select columns in the desired order
+ select_cols <- c("DOI", colnames(filtered_data)[-which(names(filtered_data) %in% c("DOI"))])
+ filtered_data <- filtered_data %>%
+ select(select_cols)
+
+ filtered_data
+ })
+
+ output$plot <- renderPlotly({
+ x_axis_col <- input$x_axis
+ y_axis_col <- input$y_axis
+ error_bar_col <- input$error_bar
+ color_by <- input$color_by
+ shape_by <- input$shape_by
+
+ p <- ggplot(filtered_data(), aes_string(x = x_axis_col, y = y_axis_col, color = color_by, shape = shape_by))
+
+ if (input$plot_type == "scatter") {
+ p <- p + geom_point()
+ } else if (input$plot_type == "boxplot") {
+ p <- p + geom_boxplot()
+ }
+
+ if (error_bar_col == "SE") {
+ p <- p + geom_errorbar(aes_string(ymin = paste0(y_axis_col, " - SE"), ymax = paste0(y_axis_col, " + SE")))
+ } else if (error_bar_col == "SD") {
+ p <- p + geom_errorbar(aes_string(ymin = paste0(y_axis_col, " - SD"), ymax = paste0(y_axis_col, " + SD")))
+ } else if (error_bar_col == "CV") {
+ p <- p + geom_errorbar(aes_string(ymin = paste0(y_axis_col, " - CV"), ymax = paste0(y_axis_col, " + CV")))
+ }
+
+ p <- p + labs(x = x_axis_col, y = y_axis_col)
+
+ p <- p + theme(axis.text.x = element_text(angle = 45, hjust = 1))
+
+ unique_shapes <- seq_len(length(unique(filtered_data()[[shape_by]])))
+
+ p <- p + scale_shape_manual(values = unique_shapes)
+
+ p <- ggplotly(p, key = ~DOI) # Use the DOI column as the key
+
+ # Observe the plotly click event and register the event once the plot is rendered
+ observe({
+ observeEvent(input$plot_click, {
+ event_register("plot", "plotly_click")
+ })
+ })
+
+ p <- p %>%
+ layout(
+ legend = list(
+ orientation = "h",
+ x = 0.5,
+ y = -0.5,
+ traceorder = "normal",
+ title = list(text = "Legend"),
+ xanchor = "center",
+ yanchor = "top",
+ itemsizing = "constant"
+ )
+ )
+
+ p <- p %>%
+ layout(height = 800)
+
+ p
+ })
+
+ observe({
+ event_data <- event_data("plotly_click")
+ if (!is.null(event_data)) {
+ # Extract selected values from the event data
+ selected_strain <- event_data$x
+ selected_mean <- event_data$y
+
+ # Tolerance level for matching means
+ tolerance <- 0.0000001 # Adjust this value based on your preference
+
+ # Check if selected_strain is a valid index
+ if (!is.na(selected_strain) && selected_strain >= 1 && selected_strain <= length(unique(filtered_data()$Strain))) {
+ # Extract the selected strain based on the index
+ selected_strain_value <- sort(unique(filtered_data()$Strain))[selected_strain]
+
+ # Filter the data based on the selected values
+ clicked_point_data <- Strains_longevity_data %>%
+ filter(Strain == selected_strain_value)
+
+ # Find the row with the closest mean value to the clicked point
+ closest_rows <- clicked_point_data[which.min(abs(clicked_point_data$mean - selected_mean)), ]
+
+ # If there are multiple rows with the same closest mean, prioritize based on "Sex" and "Where.mice.maintained."
+ if (nrow(closest_rows) > 1) {
+ # Prioritize based on "Sex"
+ closest_rows <- closest_rows[which.min(abs(closest_rows$Sex - unique(closest_rows$Sex))), ]
+
+ # If there are still multiple rows with the same "Sex," prioritize based on "Where.mice.maintained."
+ if (nrow(closest_rows) > 1) {
+ closest_rows <- closest_rows[which.min(abs(closest_rows$Where.mice.maintained - unique(closest_rows$Where.mice.maintained))), ]
+ }
+ }
+
+ # Extract the DOI from the closest row
+ doi <- closest_rows$DOI
+
+ # Check if DOI is non-empty before rendering
+ if (!is.null(doi) && length(doi) > 0) {
+ # Return the DOI as text to be rendered
+ output$doi_url_display <- renderText({
+ paste("Clicked point link:\n", doi)
+ })
+ } else {
+ output$doi_url_display <- renderText({
+ "DOI not found for the clicked point."
+ })
+ }
+ } else {
+ # Use the first index as a fallback
+ selected_strain_value <- sort(unique(filtered_data()$Strain))[1]
+ clicked_point_data <- Strains_longevity_data %>%
+ filter(Strain == selected_strain_value)
+
+ # Find the row with the closest mean value to the clicked point
+ closest_rows <- clicked_point_data[which.min(abs(clicked_point_data$mean - selected_mean)), ]
+
+ # If there are multiple rows with the same closest mean, prioritize based on "Sex" and "Where.mice.maintained."
+ if (nrow(closest_rows) > 1) {
+ # Prioritize based on "Sex"
+ closest_rows <- closest_rows[which.min(abs(closest_rows$Sex - unique(closest_rows$Sex))), ]
+
+ # If there are still multiple rows with the same "Sex," prioritize based on "Where.mice.maintained."
+ if (nrow(closest_rows) > 1) {
+ closest_rows <- closest_rows[which.min(abs(closest_rows$Where.mice.maintained - unique(closest_rows$Where.mice.maintained))), ]
+ }
+ }
+
+ # Extract the DOI from the closest row
+ doi <- closest_rows$DOI
+
+ # Check if DOI is non-empty before rendering
+ if (!is.null(doi) && length(doi) > 0) {
+ # Return the DOI as text to be rendered
+ output$doi_url_display <- renderText({
+ paste("Clicked point link:\n", doi)
+ })
+ } else {
+ output$doi_url_display <- renderText({
+ "DOI not found for the clicked point."
+ })
+ }
+ }
+ }
+ })
+}
+
+
+# Run the Shiny app
+shinyApp(ui, server)
\ No newline at end of file |