Permalink
Cannot retrieve contributors at this time
Name already in use
A tag already exists with the provided branch name. Many Git commands accept both tag and branch names, so creating this branch may cause unexpected behavior. Are you sure you want to create this branch?
Eat4Genes/app/app.R
Go to fileThis commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
1437 lines (1211 sloc)
78.4 KB
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| if (!require("shiny")) { | |
| install.packages("shiny") | |
| library(shiny)} | |
| if (!require("tidyverse")) { | |
| install.packages("tidyverse") | |
| library(tidyverse) | |
| } | |
| if (!require("plotrix")) { | |
| install.packages("plotrix") | |
| library(plotrix) | |
| } | |
| if (!require("dplyr")) { | |
| install.packages("dplyr") | |
| library(dplyr) | |
| } | |
| if (!require("glue")) { | |
| install.packages("glue") | |
| library(glue) | |
| } | |
| if (!require("tidyr")) { | |
| install.packages("tidyr") | |
| library(tidyr) | |
| } | |
| if (!require("shinythemes")) { | |
| install.packages("shinythemes") | |
| library(shinythemes) | |
| } | |
| if (!require("DT")) { | |
| install.packages("DT") | |
| library(DT) | |
| } | |
| if (!require("viridis")) { | |
| install.packages("viridis") | |
| library(viridis) | |
| } | |
| if (!require("flextable")) { | |
| install.packages("flextable") | |
| library(flextable) | |
| } | |
| if (!require("shinycssloaders")) { | |
| install.packages("shinycssloaders") | |
| library(shinycssloaders) | |
| } | |
| if (!require("bslib")) { | |
| install.packages("bslib") | |
| library(bslib) | |
| } | |
| if (!require("shinyalert")) { | |
| install.packages("shinyalert") | |
| library(shinyalert) | |
| } | |
| if (!require("highcharter")) { | |
| install.packages("highcharter") | |
| library(highcharter) | |
| } | |
| if (!require("ggplot2")) { | |
| install.packages("ggplot2") | |
| library(ggplot2) | |
| } | |
| if (!require("plotly")) { | |
| install.packages("plotly") | |
| library(plotly) | |
| } | |
| # --------------------------------------------------------------------------- | |
| tempStudy <- readRDS("data/studydata/tempstudydata.Rds") | |
| disease2gene <- readRDS("data/disease2gene.Rds") | |
| genedata <- readRDS("data/genedata/genedata.Rds") | |
| diseases <- disease2gene$Disease | |
| studydata <- readRDS("data/studydata/studydata.Rds") | |
| levels(studydata$Type) <- c(levels(studydata$Type), "phytochemical") | |
| studydata$Type[studydata$Type=="polyphenol"] <- "phytochemical" | |
| studydata$Type[grepl('extract', studydata$Type)] <- "whole food extract" | |
| studydata$Type[grepl('extract', studydata$Nutrient)] <- "whole food extract" | |
| studydata$Type[grepl('blackberry', studydata$Nutrient)] <- "whole food extract" | |
| studydata$Type[studydata$Nutrient=="egg yolks"] <- "whole food" | |
| levels(studydata$Nutrient) <- c(levels(studydata$Nutrient), "soy extract") | |
| levels(studydata$Nutrient) <- c(levels(studydata$Nutrient), "rosemary extract") | |
| levels(studydata$Nutrient) <- c(levels(studydata$Nutrient), "yellow onion extract") | |
| levels(studydata$Nutrient) <- c(levels(studydata$Nutrient), "aspera leaves extract") | |
| levels(studydata$Nutrient) <- c(levels(studydata$Nutrient), "passionfruit extract") | |
| studydata$Nutrient[studydata$Nutrient=="rosemary"] <- "rosemary extract" | |
| studydata$Nutrient[studydata$Nutrient=="yellow onion"] <- "yellow onion extract" | |
| studydata$Nutrient[studydata$Nutrient=="aaspera leaves"] <- "aspera leaves extract" | |
| studydata$Nutrient[studydata$Nutrient=="passionfruit juice"] <- "passionfruit extract" | |
| studydata$Type[studydata$Nutrient=="aspera leaves extract"] <- "whole food extract" | |
| studydata$Type[studydata$Nutrient=="cinnamon"] <- "phytochemical" | |
| studydata$Nutrient[studydata$Nutrient=="soy"] <- "soy extract" | |
| studydata$Type[studydata$Nutrient=="soy extract"] <- "whole food extract" | |
| print(studydata$Nutrient) | |
| studydata <- studydata %>% drop_na(Nutrient) | |
| nutrient_info <- read_csv("data/nutrient_info_lesscategories.csv") | |
| nutrient_info$Category[grepl('extract', nutrient_info$Nutrient)] <- "whole food extract" | |
| nutrient_info$Description[nutrient_info$Nutrient=="orange juice"] <- "Orange juice is a popular beverage that is enjoyed worldwide. Nutritionally, it is high in potassium, folate, and vitamin C as well as other antioxidants and important nutrients. At least some studies have associated its regular consumption with numerous health benefits including anti-inflammation, heart health, prevention of kidney stones, and wound healing. However, it is also high in sugar and calories and so should be taken in moderation. | |
| " | |
| levels(nutrient_info$Nutrient) <- c(levels(nutrient_info$Nutrient), "grape extract") | |
| nutrient_info$Type[nutrient_info$Nutrient=="grape"] <- "grape extract" | |
| levels(nutrient_info$Nutrient) <- c(levels(nutrient_info$Nutrient), "casei") | |
| nutrient_info$Type[nutrient_info$Nutrient=="casei"] <- "l. casei" | |
| levels(nutrient_info$Nutrient) <- c(levels(nutrient_info$Nutrient), "rosemary extract") | |
| nutrient_info$Nutrient[nutrient_info$Nutrient=="rosemary"] <- "rosemary extract" | |
| join.gene <- inner_join(disease2gene, genedata, c('Gene'='Gene', 'Expression'='Expression')) | |
| diseases_with_matches <- as.factor(unique(as.character(join.gene$Disease))) | |
| genes_with_matches <- c(c("select all"), c(unique(as.character(join.gene$Gene)))) | |
| nutrients_with_matches <- c(c("select all"), c(unique(as.character(join.gene$Nutrient)))) | |
| genes_all <- unique(as.character(genedata$Gene)) | |
| cancer_choices <- subset(join.gene, | |
| Category == "Cancer") | |
| aging_choices <- subset(join.gene, | |
| Category == "Aging") | |
| alzheimers_choices <- subset(join.gene, | |
| Category == "Alzheimer's") | |
| other_choices <- subset(join.gene, | |
| Category == "Other") | |
| inflammation_choices <- subset(join.gene, | |
| Category == "Inflammation") | |
| diabetes_choices <- subset(join.gene, | |
| Category == "Diabetes") | |
| dropdown_choices <- list( | |
| Alzheimers = list(unique(alzheimers_choices$Disease)), | |
| Aging = list(unique(aging_choices$Disease)), | |
| Cancer = unique(cancer_choices$Disease), | |
| Diabetes = list(unique(diabetes_choices$Disease)), | |
| Inflammation = unique(inflammation_choices$Disease), | |
| Other = unique(other_choices$Disease) | |
| ) | |
| # --------------------------------------------------------------------------- | |
| Eat4Genes_theme <- bs_add_variables( | |
| bs_theme(bootswatch = "materia", primary = "#1b568f"), | |
| "navbar-light-color" = "#2C8BE6", | |
| "navbar-light-hover-color" = "#1b568f", | |
| "navbar-light-active-color" = "#1b568f", | |
| "btn-border-width" = "#2C8BE6") | |
| bs_theme_update(Eat4Genes_theme, base_font = font_collection("-apple-system", | |
| "BlinkMacSystemFont", "Segoe UI", font_google("Roboto"), | |
| "Helvetica Neue", "Arial", font_google("Noto Sans"), "Liberation Sans", | |
| "sans-serif", "Apple Color Emoji", "Segoe UI Emoji", "Segoe UI Symbol", | |
| "Noto Color Emoji"), font_scale = 1.2125) | |
| shinyOptions(plot.autocolors = TRUE) | |
| # --------------------------------------------------------------------------- | |
| ui <- fluidPage(theme = Eat4Genes_theme, | |
| navbarPage(id = "main", | |
| title = actionLink("title", | |
| div(h3('Eat4Genes', style="margin: 0;"), h4('Targeting Disease Risk-Gene Expression with Healthy Diet', style="margin: 0;"))), | |
| #Begin Home Page | |
| tabPanel("", value = "home-page", | |
| #useShinyalert(), | |
| sidebarLayout( | |
| sidebarPanel( | |
| tags$style(".well {background-color:#818589;}"), | |
| h1("Our Mission:", style = "color:white"), | |
| p("Much of the world’s population has one or more chronic diseases with resultant | |
| pain and suffering as well as the vast majority of health care spending. Drug | |
| treatments are often expensive and can include a wide range of side- and long term- effects. Alternative approaches such as diet that reduce cost and improve health thus have major potential value in health care.", style = "color:white"), | |
| p("Eat4Genes is a dietary guide for patients, community, healthcare providers, and researchers to aid in the | |
| selection of healthy diet to help treat and prevent numerous pathologies and | |
| conditions. It is based on the evaluation of clinically-relevant gene expression in | |
| response to healthy diet with an emphasis on whole foods and whole food extracts.", style = "color:white"), | |
| p("This online platform app will identify foods that modulate disease and condition risk | |
| genes (and other genes) of interest as well as parallel protein and enzyme expression, | |
| pathways, relevant epidemiological studies, and basic dietary information.", style = "color:white"), | |
| p("Our approach is focused on the strategic use of diet to regulate key risk gene | |
| expression, which we call “dietary rational gene targeting”. These studies involve | |
| assessing the use of healthy diet to alter disease-causing gene expression back toward | |
| the normal to treat various diseases and conditions. Compared with pharmaceutical | |
| drugs, our approach is low-cost and healthy, and ultimately emphasizes precision | |
| nutrition in the form of personalized confirmation of our suggested diet.", style = "color:white") | |
| ), | |
| mainPanel( | |
| fluidRow( | |
| column(6,align="center", | |
| img(src = "picOfWholeFoodsTweak.jpg", width = 450), | |
| br(), | |
| br(), | |
| h3("Sixty percent of Americans have at least one chronic disease and a third of the world’s population has more than one. These are responsible for the vast majority of health care spending."), | |
| h3("Eat4Genes is a dietary guide that aids in | |
| the selection of healthy diet to help treat and prevent | |
| numerous pathologies and conditions.") | |
| ), | |
| column(6,align="center", | |
| plotOutput("piePlot"), | |
| plotOutput("gdpPlot"), | |
| #plotOutput("gdpPlot2") | |
| ) | |
| ) | |
| ) | |
| ) | |
| ), | |
| #end Home Page | |
| #Begin Disease/Condition Page | |
| tabPanel("By Condition/Disease", value = "condition/disease", | |
| selectInput(inputId = "disease", | |
| label = "Choose a Condition or Disease:", | |
| choices = dropdown_choices, | |
| multiple = FALSE), | |
| tabsetPanel( | |
| tabPanel("Food Guide",value = "foodrecs", | |
| sidebarLayout( | |
| sidebarPanel( | |
| tags$style(".well {background-color:#818589;}"), | |
| tags$h3(title="More information about the dietary nutrient categories can be found on the About page.", | |
| htmlOutput("foods_title", style = "color:white"), | |
| icon("info-circle") | |
| , style = "color:white"), | |
| htmlOutput("foods", style = "color:white"), | |
| h3("Navigate Page:", style = "color:white"), | |
| p("The plots to the right relate the nutrients with their associated ranking.", style = "color:white"), | |
| p("The ranking represents the strength of the evidence | |
| presented for that dietary nutrient based on the details of the study(s) the | |
| data is from.", style = "color:white"), | |
| p("Click the 'Toggle Plot/Bubble View' button to switch between a Bar graph and a Bubble Plot.", style = "color:white"), | |
| p("For more information about each dietary nutrient, see table below.", style = "color:white"), | |
| ), | |
| mainPanel( | |
| actionButton("t", "Toggle Plot/Bubble View"), | |
| conditionalPanel( | |
| condition = "input.t % 2 != 0 ", | |
| h2("Plot View"), | |
| withSpinner(plotlyOutput("food_plot", height = "550px"), type = 6, size = 2)), | |
| conditionalPanel( | |
| condition = "input.t % 2 == 0", | |
| withSpinner(highchartOutput("bubblechart_hc", height = "600px"), type = 6, size = 2), | |
| h4("Interact with Plot:"), | |
| p("Click on the bubbles in the plot to learn more about the dietary nutrient."), | |
| p("The larger the circle is, the stronger the evidence for that dietary nutrient. | |
| You can click on the category names in the legend at the top to view the bubbles of different categories."), | |
| ) | |
| ) | |
| ), | |
| br(), | |
| br(), | |
| DTOutput("foodstable"), | |
| p("The Ranking represents the strength of the evidence | |
| presented for that dietary nutrient based on the study the | |
| data is from. See “Ranking System” under homepage “About” menu for details."), | |
| #actionButton("jump2genes","Next"), | |
| ), | |
| tabPanel("Targeted Genes", value = "genes", | |
| sidebarLayout( | |
| sidebarPanel( | |
| tags$style(".well {background-color:#818589;}"), | |
| tags$h3(title="This table shows which specific gene each dietary nutrient influences to potentially benefit the condition you selected", | |
| "Gene Regulation", | |
| icon("info-circle") | |
| , style = "color:white"), | |
| br(), | |
| p(icon("arrow-down"), | |
| strong("Downregulation"), | |
| "is the process by which a cell decreases the quantity | |
| of a gene product, most commonly RNA.", style = "color:white"), | |
| p(icon("arrow-up"), | |
| strong("Upregulation"), | |
| "is the process by which a cell increases the quantity | |
| of a gene product, most commonly RNA.", style = "color:white"), | |
| br(), | |
| h5(textOutput("riskgene_string"), style = "color:white"), | |
| br(), | |
| p(icon("arrow-down"), | |
| strong("Downregulated:"), | |
| textOutput("riskgenes_down"), style = "color:white"), | |
| p(icon("arrow-up"), | |
| strong("Upregulated:"), | |
| textOutput("riskgenes_up"), style = "color:white") | |
| #DTOutput("genes")) | |
| ), | |
| mainPanel( | |
| p("Click on the up and down arrows by column names to change the order that risk genes and | |
| dietary nutrients are sorted"), | |
| fluidRow(DTOutput("gene_link")), | |
| #actionButton("jump2studies","Next") | |
| ) | |
| ), | |
| ), | |
| tabPanel("Full Report", value = "details", | |
| h1(textOutput("intro_title")), | |
| textOutput("intro"), | |
| p("This page is intended to be more detailed information for | |
| healtcare providers and others interested in a more | |
| in-depth review of the data pooled to create the food guide | |
| given."), | |
| downloadButton("report", "Download A Detailed Report"), | |
| br(), | |
| br(), | |
| h2(" Targeted Genes and Desired Expressions"), | |
| br(), | |
| p("The key genes analyzed for this selected disease or condition include:"), | |
| uiOutput("genes"), | |
| textOutput("gene_reg"), | |
| br(), | |
| br(), | |
| h2("Mined studies showing preferred modulation of target genes."), | |
| br(), | |
| p("Now we have the fold change. The fold change is a ratio | |
| of the initial and final values from each study. Below you | |
| will find a table showing all of the log2 fold changes of | |
| each gene for each study. Once again, you will also be able | |
| to see a visual representation of the same data. We do this | |
| because it is easier to compare the values when they are | |
| represented visually."), | |
| uiOutput("log_table"), | |
| plotlyOutput("log_plot"), | |
| br(), | |
| br(), | |
| h2("Statistical Significance"), | |
| br(), | |
| p("Significance is assessed using P value, a numerical representation | |
| of how significant the results were. Ideally, we want the | |
| P value to be less that 0.05. The respective P value for | |
| all relevant studies are found in the table below."), | |
| uiOutput("p_table"), | |
| plotlyOutput("p_plot"), | |
| br(), | |
| br(), | |
| h2("Other Analysis"), | |
| br(), | |
| p("Here, we have a plot displaying both the p value and the fold change. | |
| This plot is very strong because you can see visually where the significance lies."), | |
| p("As you can see we have the p values on the y axis and the fold change on the x axis. | |
| It is very important to notice that the p values have been transformed by -log10. | |
| There is a horizontal line on the plot that separates the significant p values from | |
| the insignificant ones. Since there is a transformation of -log10, all the | |
| p values with significance are above the horizontal line."), | |
| plotlyOutput("nutrient_plot", height = "600px"), | |
| br(), | |
| textOutput("other"), | |
| br(), | |
| br(), | |
| h2("Studies Analyzed"), | |
| br(), | |
| textOutput("studies_analyzed"), | |
| uiOutput("studies_table") | |
| ), | |
| tabPanel("Data Sources", value = "studies", | |
| p("This is a table with the studies referenced | |
| to created the food guide from the Eat4Genes database. | |
| More about the ranking can be found on the About page."), | |
| DTOutput("studies")) | |
| ) | |
| ), | |
| #end Condition/Disease | |
| #start Gene | |
| tabPanel("By Gene", value = "gene", | |
| fluidRow( | |
| selectizeInput(inputId = "gene", | |
| label = "Choose a Gene:", | |
| choices = genes_all, | |
| multiple = FALSE), | |
| uiOutput("expression_select"), | |
| # selectInput(inputId = "expression", | |
| # label = "Choose an Expression:", | |
| # choices = unique(as.character(genedata$Expression)), | |
| # multiple = FALSE) | |
| ), | |
| tabsetPanel( | |
| tabPanel("Food Guide",value = "foodrecs", | |
| sidebarLayout( | |
| sidebarPanel( | |
| tags$style(".well {background-color:#818589;}"), | |
| tags$h3(title="More information about the dietary nutrient categories can be found on the About page.", | |
| htmlOutput("foods_title_g", style = "color:white"), | |
| icon("info-circle") | |
| , style = "color:white"), | |
| htmlOutput("foods_g", style = "color:white"), | |
| h3("Navigate Page:", style = "color:white"), | |
| p("The plots to the right relate the nutrients with their associated ranking.", style = "color:white"), | |
| p("The ranking represents the strength of the evidence | |
| presented for that dietary nutrient based on the details of the study(s) the | |
| data is from.", style = "color:white"), | |
| p("Click the 'Toggle Plot/Bubble View' button to switch between a Bar graph and a Bubble Plot.", style = "color:white"), | |
| p("For more information about each dietary nutrient, see table below.", style = "color:white"), | |
| ), | |
| mainPanel( | |
| actionButton("tg", "Toggle Plot/Bubble View"), | |
| conditionalPanel( | |
| condition = "input.tg % 2 != 0 ", | |
| h2("Plot View"), | |
| withSpinner(plotlyOutput("food_plot_g", height = "550px"), type = 6, size = 2)), | |
| conditionalPanel( | |
| condition = "input.tg % 2 == 0", | |
| withSpinner(highchartOutput("bubblechart_hc_g", height = "600px"), type = 6, size = 2), | |
| h4("Interact with Plot:"), | |
| p("Click on the bubbles in the plot to learn more about the dietary nutrient."), | |
| p("The larger the circle is, the stronger the evidence for that dietary nutrient. | |
| You can click on the category names in the legend at the top to view the bubbles of different categories."), | |
| ) | |
| ) | |
| ), | |
| br(), | |
| br(), | |
| DTOutput("foodstable_g"), | |
| p("The Ranking represents the strength of the evidence | |
| presented for that dietary nutrient based on the study the | |
| data is from. See “Ranking System” under homepage “About” menu for details.") | |
| ), | |
| tabPanel("Data Sources", value = "studies", | |
| p("This is a table with the studies referenced | |
| to created the food guide from the Eat4Genes database. | |
| More about the ranking can be found on the About page."), | |
| DTOutput("studies_g") | |
| ) | |
| )), | |
| #end Gene | |
| #start About Page | |
| navbarMenu("About", | |
| tabPanel("Eat4Genes", value = "appinfo", | |
| h1("About the app"), | |
| p("Eat4Genes is an online dietary guide app constructed with the purpose of eventually assisting patients, healthcare providers, community and researchers in treating and preventing numerous health conditions."), | |
| p("For app use, users first navigate to the home page that describes the app, then select either a condition by using the By Condition/Disease menu or a specific gene by using the By Gene menu. Dietary nutrient suggestions and bioinformatically-mined study information are then presented in four views: Food Guide, Targeted Genes, Full Report, and Data Sources."), | |
| p("This project was developed by the combined work of Data Analytics Research students and mentors Dr. Dana Crawford, Dr. Kristin Bennett, and Dr. John Erickson. To learn more, visit our wiki: "), | |
| img(src = "eat4genes2.jpeg", height = 400, width = 400), | |
| ), | |
| tabPanel("Ranking System", value = "rankinfo", | |
| h1("About the Ranking System"), | |
| p("The ranking system was developed as a way to numerically assess the quality of each dietary suggestion. This is presently a “relative” ranking with numbers a reflection of their confidence as a gene expression-modulating nutrient compared with other mined studies. Thus these app numbers are not useful per se as absolute indictors of a study’s ranking but rather in comparison with other studies. Each study in our database is given its own ranking based on several characteristics about the study and reflecting the following priorities:"), | |
| tags$ol(tags$li("The type of dietary nutrient used in the study, with whole foods most preferred"), | |
| tags$li("Whether the study was in vivo oral consumption or in vitro, with in vivo studies preferred"), | |
| tags$li("Whether the study observed statistically significant gene expression modulations for a given gene at p < .05"), | |
| tags$li("The concentration of the dietary nutrient given compared to the daily recommended value or serving size, with moderate concentration preferred"), | |
| tags$li("The relative sample size of the study, with higher sample size preferred"), | |
| tags$li("Reported and repeatable gene expression studies for a dietary nutrient with more studies preferred"), | |
| )), | |
| tabPanel("Nutrient Categories", value = "nutinfo", | |
| h1("Dietary Nutrient Categories"), | |
| p("Dietary nutrients in the Eat4Genes food guide are presented as one of three categories:"), | |
| fluidRow(column(4,align="center", | |
| h4("Whole Foods:"), | |
| p("The gold standard for Eat4Genes."), | |
| img(src = "wholefood.jpg", height = 100, width = 100)), | |
| column(4,align="center", | |
| h4("Whole Food Extracts:"), | |
| p("Whole foods that are made using an extraction process or extracts from whole foods."), | |
| img(src = "wholefoodextract.jpg", height = 100, width = 100)), | |
| column(4,align="center", | |
| h4("Phytochemicals:"), | |
| p("Purified plant nutrients such as commercial polyphenol supplements."), | |
| img(src = "phytochemical.jpg", height = 100, width = 100))), | |
| ))), | |
| #end About | |
| #start Footer | |
| hr(), | |
| fluidRow( | |
| column(4, align="center", | |
| a(href = "https://www.amc.edu/Profiles/CrawfoD.cfm", | |
| img(src = "dsciencelogo.png", height = "45%") | |
| ) | |
| ), | |
| column(4, align="center", | |
| h4("Contact Information", style = "color:red"), | |
| htmlOutput("footer") | |
| ), | |
| column(4, align="center", | |
| a(href = "https://idea.rpi.edu/research/projects/data-incite", | |
| img(src = "IDEA_logo_500.png", height="45%")) | |
| ) | |
| ), | |
| tags$style(type = 'text/css', '.navbar { background-color: #cfcfcf ; | |
| font-size: 24px; | |
| color: #FF0000; | |
| }' | |
| ) | |
| #end Footer | |
| ) | |
| # --------------------------------------------------------------------------- | |
| server <- function(input,output, session){ | |
| observeEvent(input$title, { | |
| updateNavbarPage(session, "main", "home-page") | |
| }) | |
| #footer IDEA contact info | |
| output$footer <- renderUI(HTML("Institute for Data Exploration and Applications (IDEA) <br> 110 8th Street, Rensselaer Polytechnic Institute, 12180 <br> Phone (518) 276-4400, Fax (518) 276-2148")) | |
| # -------------------------------------------------------------------------- | |
| #render home-page plots | |
| #render pie chart | |
| piedata <- data.frame(typePie = c('With Chronic Conditions', 'Without Chronic Conditions'),percentPie = c(100*1/3,100*2/3)) | |
| output$piePlot <- renderPlot({ ggplot(data = data.frame(typePie = c('With Chronic Conditions', 'Without Chronic Conditions'),percentPie = c(100*1/3,100*2/3)), | |
| aes(x="", y=percentPie, fill=typePie)) + | |
| geom_bar(width = 1, stat = "identity", color = "white") + | |
| coord_polar("y", start = 0) + | |
| theme_void() + | |
| scale_fill_viridis(discrete = TRUE, option = "D") + | |
| theme(legend.position="bottom", | |
| legend.title = element_blank(), | |
| plot.title = element_text(size = 20, | |
| face = "bold", | |
| hjust = 0.5, | |
| lineheight = 0.9), | |
| plot.caption = element_text(hjust = 0.5)) + | |
| labs(title = "Percent of World Population \nwith Multiple Chronic Conditions", | |
| caption = "From: Hajat C, Stein E. The global burden of multiple chronic conditions: \n A narrative review. Prev Med Rep. 2018 Oct 19;12:284-293.") | |
| }, | |
| height = 300) | |
| #render bar plot | |
| output$gdpPlot <- renderPlot({ | |
| ggplot(data = data.frame(years = c('1960', '1990','2020'),costs = c(5,12,19.7)), | |
| aes(x=years, y=costs, fill = years)) + | |
| geom_bar(width = 1, stat = "identity", color = "white")+ | |
| theme(legend.position = "none", | |
| axis.title.y = element_text(size = 15), | |
| axis.text.x = element_text(size = 20), | |
| plot.title = element_text(size = 20, | |
| face = "bold", | |
| hjust = 0.5, | |
| lineheight = 0.9), | |
| plot.caption = element_text(hjust = 0.5))+ | |
| labs(x = "", | |
| y = "U.S.Health Care Costs (% GDP)" )+ | |
| scale_fill_viridis(discrete = TRUE, option = "D") + | |
| labs(title ="Rising U.S. Health Care Costs", | |
| caption = "From: U.S. Center for Medicare & Medicaid Services, NHE Table 01: \n Accessed: February 24, 2022: \n https://www.cms.gov/Research-Statistics-Data-and-Systems/Statistics-Trends-and-Reports/ \n NationalHealthExpendData/NationalHealthAccountsHistorical")+ | |
| theme(panel.background = element_rect(fill = 'white')) | |
| }, | |
| height = 300) | |
| #render line graph | |
| output$gdpPlot2 <- renderPlot({ | |
| ggplot(data = data.frame(years = c('1960', '1990','2020'),costs = c(5,12,19.7)), | |
| aes(x=years, y=costs, group = 1)) + | |
| theme(legend.position = "none", | |
| axis.title.y = element_text(size = 15), | |
| axis.text.x = element_text(size = 20), | |
| plot.title = element_text(size = 20, | |
| face = "bold", | |
| hjust = 0.5, | |
| lineheight = 0.9), | |
| plot.caption = element_text(hjust = 0.5)) + | |
| labs(x = "", | |
| y = "U.S.Health Care Costs (% GDP)" ) + | |
| labs(title ="Rising U.S. Health Care Costs", | |
| caption = "From: U.S. Center for Medicare & Medicaid Services, NHE Table 01: \n Accessed: February 24, 2022: \n https://www.cms.gov/Research-Statistics-Data-and-Systems/Statistics-Trends-and-Reports/ \n NationalHealthExpendData/NationalHealthAccountsHistorical")+ | |
| theme(panel.background = element_rect(fill = 'white')) + | |
| geom_path(lwd = 1.5) + | |
| scale_fill_viridis(discrete = TRUE, option = "D") + | |
| geom_point(aes(size = 2)) + | |
| ylim(0, 20) | |
| }, | |
| height = 300, width = 350) | |
| # --------------------------------------------------------------------------- | |
| disease2gene_reduced <- reactive( | |
| disease2gene[disease2gene$Disease == input$disease,] | |
| ) #filters out for just wanted disease | |
| target_genes <- reactive(subset(disease2gene_reduced(), select = -c(Category, Disease))) #finds the risk genes | |
| target_genes_icons <- reactive(target_genes() %>% #created chart of risk genes with icons | |
| mutate(Expression = ifelse(Expression == "up", | |
| as.character(icon("arrow-up")), | |
| as.character(icon("arrow-down")) | |
| ))) | |
| matching <- reactive(inner_join(target_genes(), genedata)) #finds any data about risk genes in studies | |
| output$testing <- renderPrint(print(matching())) | |
| # --------------------------------------------------------------------------- | |
| observeEvent(input$jump2foods, { | |
| updateTabsetPanel(session, "mainpage", | |
| selected = "foods") | |
| }) | |
| #output$input <- renderText(input$disease) | |
| output$input_text <- renderText(glue("You have selected : {input$disease}")) | |
| shinyalert( | |
| title = "Welcome to Eat4Genes", | |
| text = "PLEASE NOTE: This application is the result of the efforts of students at Rensselaer’s Data INCITE Lab. It is presented here to showcase the talents of our students. The application may not meet all of the standards one might expect of a production commercial product.", | |
| size = "l", | |
| closeOnEsc = TRUE, | |
| closeOnClickOutside = TRUE, | |
| html = FALSE, | |
| type = "", | |
| showConfirmButton = TRUE, | |
| showCancelButton = FALSE, | |
| confirmButtonText = "Continue with EAT4GENES app", | |
| confirmButtonCol = "#AEDEF4", | |
| timer = 0, | |
| imageUrl = "", | |
| animation = TRUE | |
| ) | |
| # --------------------------------------------------------------------------- | |
| #Food Guide Page | |
| foods <- reactive(as.character(matching()$Nutrient)) #finds the foods | |
| #find the nutrients and rankings from matching studies | |
| study_info_1 <- reactive(inner_join(matching(), studydata, by = c("Study"))) | |
| study_info <- reactive(study_info_1() %>% | |
| mutate(Nutrient = Nutrient.x) %>% | |
| dplyr::select(-Nutrient.x, -Nutrient.y)) | |
| #finds each unique nutrients and the combo ranking | |
| foods_info <- reactive(study_info() %>% | |
| dplyr::group_by(Nutrient) %>% | |
| dplyr::summarise_at(vars(Ranking), list( Num.Studies = length, Avg.Ranking = mean)) %>% | |
| mutate(Rank.Sum = case_when(Num.Studies == 1 ~ round(.3 * 25 + .7 * Avg.Ranking, 0), | |
| Num.Studies == 2 ~ round(.3 * 50 + .7 * Avg.Ranking, 0), | |
| Num.Studies <= 5 ~ round(.3 * 75 + .7 * Avg.Ranking, 0), | |
| TRUE ~ round(.3 * 100 + .7 * Avg.Ranking, 0))) %>% | |
| dplyr::select(Nutrient, Rank.Sum) | |
| ) | |
| #adds information about nutrients and formats link | |
| foods_complete <- reactive(inner_join(foods_info(), nutrient_info)) | |
| foods_complete_link <- reactive(foods_complete() %>% #create hyperlinks from link value | |
| mutate(Link = paste0("<a href='",Link,"'>",Link,"</a>"))) | |
| #creates foods table | |
| output$foodstable <- renderDT(subset(foods_complete_link(), select = -c(Img.Link)), | |
| options = list( dom = 'Bfrtip', | |
| buttons = c('csv', 'excel', 'pdf'), | |
| order = list(1, "desc"), | |
| columnDefs = list(list(width = '700px', targets = c(4))), | |
| pageLength = 3), | |
| rownames = FALSE, | |
| extensions = "Buttons", | |
| colnames = c("Nutrient", "Ranking", "Category", "Description", "Link"), | |
| caption = htmltools::tags$caption( | |
| style = 'caption-side: top; | |
| text-align: center; | |
| color:white; | |
| font-size:100% ;', | |
| glue('Nutrient guide for {input$disease} from Eat4Gene Database')), | |
| escape = FALSE) | |
| #---------------------------------------------------------------------------- | |
| #Creating Food Strings by Category | |
| # Add a column with the text you want to hover display for each bubble: | |
| foods_info_text <- reactive(foods_complete() %>% | |
| mutate(text = paste0("<p> <b>Dietary Nutrient:</b> ", | |
| Nutrient, " <img src = '", | |
| Img.Link, | |
| "', style='width:25px;height:25px;'> </p>", | |
| "<p> <b>Ranking:</b>", Rank.Sum, | |
| "</p> <p>", Description, "</p>"))) | |
| #Checking if categories are empty and creating subsets | |
| foods_info_wf <- reactive(subset(foods_info_text(), Category == "whole food")) | |
| check_wf <- reactive(nrow(foods_info_wf()) != 0) | |
| foods_info_wfex <- reactive(subset(foods_info_text(), Category == "whole food extract")) | |
| check_wfex <- reactive(nrow(foods_info_wfex()) != 0) | |
| foods_info_ph <- reactive(subset(foods_info_text(), Category == "phytochemical")) | |
| check_ph <- reactive(nrow(foods_info_ph()) != 0) | |
| #Creating strings for each category | |
| foods_string <- "" | |
| foods_stringwf <- reactive(if (check_wf()) {paste0(foods_string, "<p>", | |
| "<h5><span style='color:white'> Whole Foods:</span></h5> ", | |
| glue_collapse(as.character(unique(foods_info_wf()$Nutrient)), | |
| ", ", last = " and "), "</p>")} | |
| else {foods_string}) | |
| foods_stringwfex <- reactive(if (check_wfex()) {paste0(foods_stringwf(),"<p>", | |
| "<h5><span style='color:white'> Whole Food Extracts:</span></h5> ", | |
| glue_collapse(as.character(unique(foods_info_wfex()$Nutrient)), | |
| ", ", last = " and "),"</p>")} | |
| else {foods_stringwf()}) | |
| foods_stringph <- reactive(if (check_ph()) {paste0(foods_stringwfex(),"<p>", | |
| "<h5><span style='color:white'> Phytochemicals:</span></h5> ", | |
| glue_collapse(as.character(unique(foods_info_ph()$Nutrient)), | |
| ", ", last = " and "),"</p>")} | |
| else {foods_stringwfex()}) | |
| output$foods <- renderText(foods_stringph()) | |
| output$foods_title <- renderText(paste0("The dietary nutrient(s) in our food guide for ", {input$disease}, " include the following depending on the patients' aberrant gene expression:")) | |
| #---------------------------------------------------------------------------- | |
| # Creating packed bubble graph | |
| bubble_hc <- reactive(highchart() %>% | |
| hc_chart(type = 'packedbubble') %>% | |
| hc_title(text = paste0("Dietary Nutrients in our Food Guide for ",{input$disease}), align = 'center') %>% | |
| hc_tooltip(useHTML = T, | |
| pointFormat = '{point.description}') %>% | |
| hc_plotOptions(packedbubble = list( | |
| minSize = '5%', | |
| maxSize = '100%', | |
| zMin = 0, | |
| zMax = 100, | |
| cursor = "pointer", | |
| point = list( | |
| events = list( | |
| click = JS("function(self) { | |
| window.open(self.point.url); | |
| }") | |
| ) | |
| ), | |
| dataLabels = list( | |
| enabled = T, | |
| format = "{point.name}" | |
| ), | |
| layoutAlgorithm = list( | |
| gravitationalConstant = 0.10, | |
| splitSeries = T, | |
| seriesInteraction = F, | |
| dragBetweenSeries = F, | |
| enableSimulation = F, | |
| parentNodeLimit = T))) %>% | |
| hc_legend(enabled = T, verticalAlign = "top") %>% | |
| hc_exporting(enabled = T)) | |
| #adding each category as a series only if it isn't empty | |
| bubble_wf <- reactive(if (check_wf()) {hc_add_series(bubble_hc(), | |
| name = "Whole Food", | |
| foods_info_wf(), | |
| 'packedbubble', | |
| hcaes(name = Nutrient, | |
| value = Rank.Sum, | |
| description = text, | |
| url = Link))} | |
| else {bubble_hc()}) | |
| bubble_wfex <- reactive ( if (check_wfex()) {hc_add_series(bubble_wf(), | |
| name = "Whole Food Extract", | |
| foods_info_wfex(), | |
| 'packedbubble', | |
| visible = TRUE, | |
| hcaes(name = Nutrient, | |
| value = Rank.Sum, | |
| description = text, | |
| url = Link))} | |
| else {bubble_wf()}) | |
| bubble_ph <- reactive ( if (check_ph()) {hc_add_series(bubble_wfex(), | |
| name = "Phytochemical", | |
| foods_info_ph(), | |
| 'packedbubble', | |
| visible = FALSE, | |
| hcaes(name = Nutrient, | |
| value = Rank.Sum, | |
| description = text, | |
| url = Link))} | |
| else {bubble_wfex()}) | |
| output$bubblechart_hc <- renderHighchart(bubble_ph()) | |
| #---------------------------------------------------------------------------- | |
| # Plot View | |
| output$food_plot <- renderPlotly({ | |
| l <- nrow(foods_info_text()) | |
| p <- ggplot(data = foods_info_text(), | |
| aes(x = reorder(Nutrient, -Rank.Sum), | |
| y = Rank.Sum, | |
| fill = Category)) + | |
| geom_bar(stat = "identity") + | |
| theme(axis.title.x = element_blank(), | |
| axis.text.x=element_text(angle = 45, | |
| size = 10), | |
| axis.ticks.x=element_blank()) + | |
| scale_fill_viridis(discrete = TRUE, option = "D") + | |
| labs(title = paste0("Dietary Nutrients in our Food Guide for ",{input$disease}), | |
| caption = "Plot of the Ranking for each dietary nutrient that was found as a match from a study.", | |
| y = "Ranking") | |
| ggplotly(p) %>% | |
| layout(plot_bgcolor='transparent') %>% | |
| layout(paper_bgcolor='transparent') | |
| }) | |
| observeEvent(input$jump2genes, { | |
| updateTabsetPanel(session, "mainpage", | |
| selected = "genes") | |
| }) | |
| # --------------------------------------------------------------------------- | |
| #Targeted Genes | |
| # Get matching gene data and icons | |
| matching_genes <- reactive(unique(subset(study_info(), select = c(Gene, Expression, Nutrient, Ranking, Type)))) #finds the genes with matches to study | |
| matching_genes_icons1 <- reactive(matching_genes() %>% #created table with icons | |
| mutate(Expression = ifelse(Expression == "up", | |
| as.character(icon("arrow-up")), | |
| as.character(icon("arrow-down")) | |
| ), | |
| Type = ifelse(Type == "whole food" | Type == "whole food extract" | Type == "complex extract", | |
| 1, | |
| 0))) | |
| # Get matching nutrient data and icons | |
| matching_nutrient <- reactive(unique(subset(study_info(), select = c(Nutrient, Gene, Expression, Ranking, Type)))) | |
| matching_nutrient_icons1 <- reactive(matching_nutrient() %>% #created table with icons | |
| mutate(Expression = ifelse(Expression == "up", | |
| as.character(icon("arrow-up")), | |
| as.character(icon("arrow-down")) | |
| ), | |
| Type = ifelse(Type == "whole food" | Type == "whole food extract" | Type == "complex extract", | |
| 1, | |
| 0) )) | |
| # Update select input | |
| observeEvent( input$disease, { | |
| updateSelectInput( | |
| session = getDefaultReactiveDomain(), | |
| "Nutrient", | |
| label = "Select a nutrient:", | |
| choices = c(c("select all"), unique(as.character(matching_nutrient()$Nutrient)))) | |
| updateSelectInput( | |
| session = getDefaultReactiveDomain(), | |
| "Gene", | |
| label = "Select a risk gene:", | |
| choices = c(c("select all"), unique(as.character(matching_genes()$Gene)))) | |
| } | |
| ) | |
| # Update table to output selected values | |
| #matching_nutrient_icons <- reactive(if (input$Nutrient != "select all") filter(matching_nutrient_icons1(), Nutrient == input$Nutrient) | |
| # else matching_nutrient_icons1()) | |
| #matching_genes_icons <- reactive(if (input$Gene != "select all") filter(matching_genes_icons1(), Gene == input$Gene) | |
| # else matching_genes_icons1()) | |
| matching_genes <- reactive(unique(subset(study_info(), select = c(Gene, Expression, Nutrient, Ranking, Type)))) #finds the genes with matches to study | |
| matching_genes_icons <- reactive(matching_genes() %>% #created table with icons | |
| mutate(Expression = ifelse(Expression == "up", | |
| as.character(icon("arrow-up")), | |
| as.character(icon("arrow-down")) | |
| ))) | |
| matching_nutrient <- reactive(unique(subset(study_info(), select = c(Nutrient, Gene, Expression, Ranking, Type)))) | |
| matching_nutrient_icons <- reactive(matching_nutrient() %>% #created table with icons | |
| mutate(Expression = ifelse(Expression == "up", | |
| as.character(icon("arrow-up")), | |
| as.character(icon("arrow-down")) | |
| ))) | |
| # Output risk genes | |
| output$riskgene_string <- renderText(glue("The key risk genes found for {input$disease} and their desired regulations are: ")) | |
| output$riskgenes_up <- renderText(glue_collapse(as.character(subset(target_genes(), Expression == "up")$Gene),", ", last = " and "), | |
| ) | |
| output$riskgenes_down <- renderText(glue_collapse(as.character(subset(target_genes(), Expression == "down")$Gene),", ", last = " and "), | |
| ) | |
| headerCallbackRemoveHeaderFooter <- c( | |
| "function(thead, data, start, end, display){", | |
| " $('th', thead).css('display', 'none');", | |
| "}" | |
| ) | |
| # Output gene and nutrient tables | |
| output$gene_link <- DT::renderDataTable({ | |
| dat <- datatable(matching_genes_icons(), | |
| options = list( | |
| dom = 'Bfrtip', | |
| autoWidth = TRUE, | |
| order = list(list(4, "desc"), list(3, "desc"), list(0, "asc")), | |
| #columnDefs = list (list(className = "dt-left", targets = "_all"), list( ordertable = TRUE), list(visible = FALSE, targets = list(4))), | |
| buttons = c('csv', 'excel', 'pdf') | |
| ), | |
| rownames = FALSE, | |
| extensions = "Buttons", | |
| class = "display", | |
| escape = FALSE | |
| ) %>% | |
| formatStyle("Type", target = 'row', backgroundColor = styleEqual(c(1), c('#DBE1FE'))) | |
| return(dat) | |
| } ) | |
| output$nutrient_link <- DT::renderDataTable({ | |
| dat <- datatable(matching_nutrient_icons(), | |
| options = list( | |
| dom = 'Bfrtip', | |
| autoWidth = TRUE, | |
| order = list(list(4, "desc"), list(3, "desc"), list(0, "asc")), | |
| #columnDefs = list(list(className = "dt-left", targets = "_all"),list(ordertable = TRUE), list(visible = FALSE, targets = list(4))), | |
| buttons = c('csv', 'excel', 'pdf') | |
| ), | |
| rownames = FALSE, | |
| extensions = "Buttons", | |
| class = "display", | |
| escape = FALSE | |
| ) %>% | |
| formatStyle("Type", target = 'row', backgroundColor = styleEqual(c(1), c('#DBE1FE'))) | |
| return(dat) | |
| } ) | |
| observeEvent(input$jump2studies, { | |
| updateTabsetPanel(session, "mainpage", | |
| selected = "studies") | |
| }) | |
| # --------------------------------------------------------------------------- | |
| #Who Says I Should Eat It? | |
| study_info_link <- reactive(study_info() %>% #create hyperlinks from link value | |
| mutate(Link = paste0("<a href='",Link,"'>",Link,"</a>"))) | |
| study_info_cut_l <- reactive(subset(study_info_link(), | |
| select = c(Ranking, Nutrient, Study.name, Link, Summary, VitViv, Type, Conc., Sample.size))) #studies table | |
| output$studies <- renderDT(unique(study_info_cut_l()), | |
| options = list( order = list(0, "desc"), | |
| dom = 'Bfrtip', | |
| buttons = c('csv', 'excel', 'pdf')), | |
| caption = htmltools::tags$caption( | |
| style = 'caption-side: top; | |
| text-align: center; | |
| color:black; | |
| font-size:200% ;', | |
| 'Studies Referenced for Food Guide'), | |
| extensions = "Buttons", | |
| colnames = c("Ranking", "Nutrient", "Study Name", "Link", "Summary", "In vitro / In vivo", "Type of Nutrient", "Concentration", "Sample Size"), | |
| escape = FALSE, | |
| rownames = FALSE) | |
| # --------------------------------------------------------------------------- | |
| #More Details | |
| #To fix the number of sig figs | |
| round_and_format <- function(number) { | |
| rr <- round(number,digits=3) | |
| as.character(rr) | |
| } | |
| #To count the number of p values > 0.05 and find the lowest value | |
| sig_genes <- function(p.list) { | |
| l <- 0 | |
| for(p in p.list) { | |
| if(!is.na(p) && p <= 0.05) { | |
| l = l + 1 | |
| } | |
| } | |
| m <- min(p.list, na.rm = TRUE) | |
| return(c(l, m)) | |
| } | |
| #Variables | |
| tab.content <- reactive(subset(study_info(), select = c(Gene, P.value, Log2fc, Study.name, Nutrient))) | |
| study_table_var <- reactive(unique(subset(study_info(), select = c(Study.name, Summary, Link)))) | |
| output$num_genes <- renderText({ | |
| paste("As you can see the number of significant genes is", nrow(target_genes()), ".") | |
| }) | |
| #Narrative | |
| output$intro_title <- renderText({ | |
| input$disease | |
| }) | |
| output$intro <- renderText({ | |
| "On this page you will see a summary of the data given to you on this app." | |
| }) | |
| output$gene_reg <- renderText({ | |
| paste0( | |
| "Gene expression can either be induced or reduced. A reduction is a downward | |
| modulation where an induction is an upward regulation. This table shows the | |
| intended direction of gene expression modulation that would be therapeutic | |
| for this given disease or condition. For example, “Expression” is listed | |
| as '", target_genes()$Expression[1], "' for ", target_genes()$Gene[1],". | |
| This means that ", target_genes()$Expression[1], " modulation of | |
| ", target_genes()$Gene[1]," can potentially help treat ", input$disease,"." | |
| ) | |
| }) | |
| output$other <- renderText({ | |
| paste0( | |
| "According to the table, there are ", sig_genes(tab.content()$P.value)[1], " genes that show significant change | |
| with the lowest P value being ", sig_genes(tab.content()$P.value)[2], "." | |
| ) | |
| }) | |
| output$studies_analyzed <- renderText({ | |
| paste0( | |
| "Here is a list of all the relevant studies that has guided these results. | |
| There is a total of ", nrow(study_table_var()), " studies that formed the data for | |
| this page. To read more on each of these studies, please see the respective link." | |
| ) | |
| }) | |
| output$genes <- renderUI({ | |
| target_genes() %>% | |
| flextable() %>% | |
| theme_zebra() %>% | |
| # theme_zebra(odd_header = "#04A61B", | |
| # odd_body = "#9ADBA3", | |
| # even_body = "#CCEDD1") %>% OR | |
| # theme_zebra(odd_header = "#2C8BE6", | |
| # odd_body = "#BFDCF7", | |
| # even_body = "#E9F3FC") %>% | |
| font(fontname = "Arial", part = "all") %>% | |
| autofit() %>% | |
| add_header_lines(values = "Targeted Genes and Desired Expressions", top = TRUE) %>% | |
| htmltools_value()}) | |
| output$p_table <- renderUI({ | |
| p_tab.content <- reactive(subset(tab.content(), select = -c(Log2fc))) | |
| table_1 <- flextable(p_tab.content()) %>% | |
| theme_zebra() %>% | |
| set_header_labels(Study.name = "Study Name", P.value = "P Value") %>% | |
| set_formatter(P.value = round_and_format) %>% | |
| autofit() %>% | |
| add_header_lines(values = "P values for each study", top = TRUE) %>% | |
| htmltools_value()}) | |
| output$p_plot <- renderPlotly({ | |
| l <- nrow(matching()) | |
| p <- ggplot(data = matching(), | |
| aes(x = c(1:l), y = P.value, fill = Gene)) + | |
| geom_bar(stat = "identity") + | |
| theme(axis.title.x = element_blank(), | |
| axis.text.x=element_blank(), | |
| axis.ticks.x=element_blank()) + | |
| scale_fill_viridis(discrete = TRUE, option = "D") + | |
| labs(title = paste0("P Value for Matching Genes of ", input$disease), | |
| caption = "Plot of the P values from each study of each gene that was found as a match from a study.", | |
| y = "P value") | |
| ggplotly(p)%>% | |
| layout(plot_bgcolor='transparent') %>% | |
| layout(paper_bgcolor='transparent') | |
| }) | |
| output$log_table <- renderUI({ | |
| l_tab.content <- reactive(subset(tab.content(), select = -c(P.value))) | |
| table_2 <- flextable(l_tab.content()) %>% | |
| theme_zebra() %>% | |
| set_header_labels(Study.name = "Study Name", Log2fc = "Fold Change") %>% | |
| set_formatter(Log2fc = round_and_format) %>% | |
| add_header_lines(values = "Log2 fold change for each study", top = TRUE) %>% | |
| autofit() %>% | |
| htmltools_value() | |
| }) | |
| output$log_plot <- renderPlotly({ | |
| l <- nrow(matching()) | |
| l_plot <- ggplot(data = matching(), | |
| aes(x = c(1:l), | |
| y = Log2fc, | |
| fill = Gene)) + | |
| geom_bar(stat = "identity") + | |
| theme(axis.title.x = element_blank(), | |
| axis.text.x=element_blank(), | |
| axis.ticks.x=element_blank()) + | |
| scale_fill_viridis(discrete = TRUE, option = "D") + | |
| labs(title = paste0("Fold Change for Matching Genes of ", input$disease), | |
| caption = "Plot of the log base 2 of the 2-fold change of each gene that was found as a match from a study.", | |
| y = "Log2fc") | |
| ggplotly(l_plot)%>% | |
| layout(plot_bgcolor='transparent') %>% | |
| layout(paper_bgcolor='transparent') | |
| }) | |
| output$nutrient_plot <- renderPlotly({ | |
| nutrient <- ggplot(data = tab.content(), | |
| aes(x = Log2fc, y = -log10(P.value), label = Gene, color = Nutrient)) + | |
| geom_text()+ | |
| ylim(NA, 10) + | |
| theme(legend.position="bottom") + | |
| scale_color_viridis(discrete = TRUE, option = "D") + | |
| labs(title = paste0("Fold change and p value by nutrient for ", input$disease), | |
| caption = "The values that are statistically significant | |
| (p value < 0.05) are all the points that lie above the horizontal line.", | |
| y = "-log10(p value)", x = "Log2 Fold Change" ) + | |
| geom_abline(slope = 0, intercept = -log10(0.05), color = "red") | |
| ggplotly(nutrient) %>% | |
| layout(plot_bgcolor='transparent') %>% | |
| layout(paper_bgcolor='transparent') | |
| }) | |
| output$studies_table <- renderUI({ | |
| study_table_var() %>% | |
| flextable() %>% | |
| compose(j = "Link", value = as_paragraph(hyperlink_text(x = Link, url = Link))) %>% | |
| set_header_labels(Study.name = "Study Name") %>% | |
| autofit() %>% | |
| theme_zebra() %>% | |
| htmltools_value() | |
| }) | |
| output$report <- downloadHandler( | |
| filename = glue("reportgenerated{Sys.Date()}_{input$disease}.pdf"), | |
| content = function(file) { | |
| tempReport <- file.path(tempdir(), "report.Rmd") | |
| file.copy("report.Rmd", tempReport, overwrite = TRUE)#TODO | |
| params <- list(d = input$disease, | |
| m = matching(), | |
| g = target_genes(), | |
| s = unique(subset(study_info(), select = c(Study.name, Nutrient, Summary)))) | |
| rmarkdown::render(tempReport, output_file = file, | |
| params = params, | |
| envir = new.env(parent = globalenv()) | |
| ) | |
| } | |
| ) | |
| #-------------------------------------------------------------------------- | |
| target_genes_g <- reactive(data.frame(Gene = input$gene, | |
| Expression = input$expression)) | |
| genedata_subset <- reactive(subset(genedata, as.character(Gene) == input$gene)) | |
| expression_choices <- reactive(unique(as.character(genedata_subset()$Expression))) | |
| output$expression_select <- renderUI( | |
| selectInput(inputId = "expression", | |
| label = "Choose an Expression:", | |
| choices = expression_choices(), | |
| multiple = FALSE) | |
| ) | |
| matching_g <- reactive(inner_join(target_genes_g(), genedata)) | |
| output$testing_g <- renderPrint(print(matching_g())) | |
| #Food Guide Page | |
| foods_g <- reactive(as.character(matching_g()$Nutrient)) #finds the foods | |
| #find the nutrients and rankings from matching studies | |
| study_info_1_g <- reactive(inner_join(matching_g(), studydata, by = c("Study"))) | |
| study_info_g <- reactive(study_info_1_g() %>% | |
| mutate(Nutrient = Nutrient.x) %>% | |
| dplyr::select(-Nutrient.x, -Nutrient.y)) | |
| #finds each unique nutrients and the combo ranking | |
| foods_info_g <- reactive(study_info_g() %>% | |
| dplyr::group_by(Nutrient) %>% | |
| dplyr::summarise_at(vars(Ranking), list( Num.Studies = length, Avg.Ranking = mean)) %>% | |
| mutate(Rank.Sum = case_when(Num.Studies == 1 ~ round(.3 * 25 + .7 * Avg.Ranking, 0), | |
| Num.Studies == 2 ~ round(.3 * 50 + .7 * Avg.Ranking, 0), | |
| Num.Studies <= 5 ~ round(.3 * 75 + .7 * Avg.Ranking, 0), | |
| TRUE ~ round(.3 * 100 + .7 * Avg.Ranking, 0))) %>% | |
| dplyr::select(Nutrient, Rank.Sum) | |
| ) | |
| #adds information about nutrients and formats link | |
| foods_complete_g <- reactive(inner_join(foods_info_g(), nutrient_info)) | |
| foods_complete_link_g <- reactive(foods_complete_g() %>% #create hyperlinks from link value | |
| mutate(Link = paste0("<a href='",Link,"'>",Link,"</a>"))) | |
| #creates foods table | |
| output$foodstable_g <- renderDT(subset(foods_complete_link_g(), select = -c(Img.Link)), | |
| options = list( dom = 'Bfrtip', | |
| buttons = c('csv', 'excel', 'pdf'), | |
| order = list(1, "desc"), | |
| columnDefs = list(list(width = '700px', targets = c(4))), | |
| pageLength = 3), | |
| rownames = FALSE, | |
| extensions = "Buttons", | |
| colnames = c("Nutrient", "Ranking", "Category", "Description", "Link"), | |
| caption = htmltools::tags$caption( | |
| style = 'caption-side: top; | |
| text-align: center; | |
| color:white; | |
| font-size:100% ;', | |
| glue('Nutrient guide for {input$gene} modulated {input$expression} from Eat4Gene Database')), | |
| escape = FALSE) | |
| #---------------------------------------------------------------------------- | |
| #Creating Food Strings by Category | |
| # Add a column with the text you want to hover display for each bubble: | |
| foods_info_text_g <- reactive(foods_complete_g() %>% | |
| mutate(text = paste0("<p> <b>Dietary Nutrient:</b> ", | |
| Nutrient, " <img src = '", | |
| Img.Link, | |
| "', style='width:25px;height:25px;'> </p>", | |
| "<p> <b>Ranking:</b>", Rank.Sum, | |
| "</p> <p>", Description, "</p>"))) | |
| #Checking if categories are empty and creating subsets | |
| foods_info_wf_g <- reactive(subset(foods_info_text_g(), Category == "whole food")) | |
| check_wf_g <- reactive(nrow(foods_info_wf_g()) != 0) | |
| foods_info_wfex_g <- reactive(subset(foods_info_text_g(), Category == "whole food extract")) | |
| check_wfex_g <- reactive(nrow(foods_info_wfex_g()) != 0) | |
| foods_info_ph_g <- reactive(subset(foods_info_text_g(), Category == "phytochemical")) | |
| check_ph_g <- reactive(nrow(foods_info_ph_g()) != 0) | |
| #Creating strings for each category | |
| foods_string_g <- "" | |
| foods_stringwf_g <- reactive(if (check_wf_g()) {paste0(foods_string_g, "<p>", | |
| "<h5><span style='color:white'> Whole Foods:</span></h5> ", | |
| glue_collapse(as.character(unique(foods_info_wf_g()$Nutrient)), | |
| ", ", last = " and "), "</p>")} | |
| else {foods_string_g}) | |
| foods_stringwfex_g <- reactive(if (check_wfex_g()) {paste0(foods_stringwf_g(),"<p>", | |
| "<h5><span style='color:white'> Whole Food Extracts:</span></h5> ", | |
| glue_collapse(as.character(unique(foods_info_wfex_g()$Nutrient)), | |
| ", ", last = " and "),"</p>")} | |
| else {foods_stringwf_g()}) | |
| foods_stringph_g <- reactive(if (check_ph_g()) {paste0(foods_stringwfex_g(),"<p>", | |
| "<h5><span style='color:white'> Phytochemicals:</span></h5> ", | |
| glue_collapse(as.character(unique(foods_info_ph_g()$Nutrient)), | |
| ", ", last = " and "),"</p>")} | |
| else {foods_stringwfex_g()}) | |
| output$foods_g <- renderText(foods_stringph_g()) | |
| output$foods_title_g <- renderText(paste0("The dietary nutrient(s) in our food guide for ", {input$gene}, " modulated ", {input$expression}, " include the following:")) | |
| #---------------------------------------------------------------------------- | |
| # Creating packed bubble graph | |
| bubble_hc_g <- reactive(highchart() %>% | |
| hc_chart(type = 'packedbubble') %>% | |
| hc_title(text = paste0("Dietary Nutrients in our Food Guide for ",{input$gene}, " modulated ", {input$expression}), align = 'center') %>% | |
| hc_tooltip(useHTML = T, | |
| pointFormat = '{point.description}') %>% | |
| hc_plotOptions(packedbubble = list( | |
| minSize = '5%', | |
| maxSize = '100%', | |
| zMin = 0, | |
| zMax = 100, | |
| cursor = "pointer", | |
| point = list( | |
| events = list( | |
| click = JS("function(self) { | |
| window.open(self.point.url); | |
| }") | |
| ) | |
| ), | |
| dataLabels = list( | |
| enabled = T, | |
| format = "{point.name}" | |
| ), | |
| layoutAlgorithm = list( | |
| gravitationalConstant = 0.10, | |
| splitSeries = T, | |
| seriesInteraction = F, | |
| dragBetweenSeries = F, | |
| enableSimulation = F, | |
| parentNodeLimit = T))) %>% | |
| hc_legend(enabled = T, verticalAlign = "top") %>% | |
| hc_exporting(enabled = T)) | |
| #adding each category as a series only if it isn't empty | |
| bubble_wf_g <- reactive(if (check_wf_g()) {hc_add_series(bubble_hc_g(), | |
| name = "Whole Food", | |
| foods_info_wf_g(), | |
| 'packedbubble', | |
| hcaes(name = Nutrient, | |
| value = Rank.Sum, | |
| description = text, | |
| url = Link))} | |
| else {bubble_hc_g()}) | |
| bubble_wfex_g <- reactive ( if (check_wfex_g()) {hc_add_series(bubble_wf_g(), | |
| name = "Whole Food Extract", | |
| foods_info_wfex_g(), | |
| 'packedbubble', | |
| visible = TRUE, | |
| hcaes(name = Nutrient, | |
| value = Rank.Sum, | |
| description = text, | |
| url = Link))} | |
| else {bubble_wf_g()}) | |
| bubble_ph_g <- reactive ( if (check_ph_g()) {hc_add_series(bubble_wfex_g(), | |
| name = "Phytochemical", | |
| foods_info_ph_g(), | |
| 'packedbubble', | |
| visible = FALSE, | |
| hcaes(name = Nutrient, | |
| value = Rank.Sum, | |
| description = text, | |
| url = Link))} | |
| else {bubble_wfex_g()}) | |
| output$bubblechart_hc_g <- renderHighchart(bubble_ph_g()) | |
| #---------------------------------------------------------------------------- | |
| # Plot View | |
| output$food_plot_g <- renderPlotly({ | |
| l <- nrow(foods_info_text_g()) | |
| p <- ggplot(data = foods_info_text_g(), | |
| aes(x = reorder(Nutrient, -Rank.Sum), | |
| y = Rank.Sum, | |
| fill = Category)) + | |
| geom_bar(stat = "identity") + | |
| theme(axis.title.x = element_blank(), | |
| axis.text.x=element_text(angle = 45, | |
| size = 10), | |
| axis.ticks.x=element_blank()) + | |
| scale_fill_viridis(discrete = TRUE, option = "D") + | |
| labs(title = paste0("Dietary Nutrients in our Food Guide for ",{input$gene}, " modulated ", {input$expression}), | |
| caption = "Plot of the Ranking for each dietary nutrient that was found as a match from a study.", | |
| y = "Ranking") | |
| ggplotly(p) %>% | |
| layout(plot_bgcolor='transparent') %>% | |
| layout(paper_bgcolor='transparent') | |
| }) | |
| #---------------------------------------------------------------------------- | |
| #Studies | |
| study_info_link_g <- reactive(study_info_g() %>% #create hyperlinks from link value | |
| mutate(Link = paste0("<a href='",Link,"'>",Link,"</a>"))) | |
| study_info_cut_l_g <- reactive(subset(study_info_link_g(), | |
| select = c(Ranking, Nutrient, Study.name, Link, Summary, VitViv, Type, Conc., Sample.size))) #studies table | |
| output$studies_g <- renderDT(unique(study_info_cut_l_g()), | |
| options = list( order = list(0, "desc"), | |
| dom = 'Bfrtip', | |
| buttons = c('csv', 'excel', 'pdf')), | |
| caption = htmltools::tags$caption( | |
| style = 'caption-side: top; | |
| text-align: center; | |
| color:black; | |
| font-size:200% ;', | |
| 'Studies Referenced for Food Guide'), | |
| extensions = "Buttons", | |
| colnames = c("Ranking", "Nutrient", "Study Name", "Link", "Summary", "In vitro / vivo", "Type of Nutrient", "Concentration", "Sample Size"), | |
| escape = FALSE, | |
| rownames = FALSE) | |
| } | |
| shinyApp(ui=ui,server=server) |