## Installation of Packages if(!require(shiny)){ install.packages("shiny") } if(!require(shinyalert)){ install.packages("shinyalert") } if(!require(data.table)){ install.packages("data.table") } if(!require(ggplot2)){ install.packages("ggplot2") } if(!require(shinyWidgets)){ install.packages("shinyWidgets") } if(!require(shinythemes)){ install.packages("shinythemes") } if(!require(dplyr)){ install.packages("dplyr") } if(!require(forcats)){ install.packages("forcats") } if(!require(wesanderson)){ install.packages("wesanderson") } if(!require(shinycssloaders)){ install.packages("shinycssloaders") } if(!require(magick)){ install.packages("magick") } if(!require(corrplot)){ install.packages("corrplot") } if(!require(ggcorrplot)){ install.packages("ggcorrplot") } if(!require(cowplot)){ install.packages("cowplot") } ## Load Packages library(shiny) library(shinyalert) library(data.table) library(ggplot2) library(shinyWidgets) library(shinythemes) library(dplyr) library(forcats) library(wesanderson) library(shinycssloaders) library(magick) library(corrplot) library(ggcorrplot) library(cowplot) ## Download Reference Distributions File epigen <- fread("./Training_Proteins.csv", check.names = F) epigen = as.data.frame(epigen) tmp <- read.csv("./Shiny_Mean_Methylation_Dataset_Proteins.csv") out <- fread("./Methylation_Scores_for_GSw3_Proteins.csv", check.names = F) out = as.data.frame(out) timeoutSeconds <- 180 inactivity <- sprintf("function idleTimer() { var t = setTimeout(logout, %s); window.onmousemove = resetTimer; // catches mouse movements window.onmousedown = resetTimer; // catches mouse movements window.onclick = resetTimer; // catches mouse clicks window.onscroll = resetTimer; // catches scrolling window.onkeypress = resetTimer; //catches keyboard actions function logout() { Shiny.setInputValue('timeOut', '%ss') } function resetTimer() { clearTimeout(t); t = setTimeout(logout, %s); // time is in milliseconds (1000 is 1 second) } } idleTimer();", timeoutSeconds*1000, timeoutSeconds, timeoutSeconds*1000) ## User Interface Portion ui <- fluidPage( tags$head( tags$style( ".title {margin-left: 550px; width: 500px}", HTML(".shiny-notification { position:fixed; top: calc(50%); left: calc(50%); } " ), ".modal-body {padding: 20px} .modal-header {background-color: #8ae9ff} .modal { text-align: center}" ) ), tags$div(class="title", titlePanel("MethylDetectR")), tags$script(inactivity), theme = shinytheme("united"), sidebarLayout( sidebarPanel( useShinyalert(), fileInput("file1", "Choose CSV File", multiple = TRUE, accept = c("text/csv", "text/comma-separated-values,text/plain", ".csv")), conditionalPanel(condition = "input.tabs == 1", selectInput("var", label = "Choose an Epigenetic Predictor to Display", choices = list("Age" = c("Age"), "Lifestyle" = c("Alcohol", "Body Fat %", "Body Mass Index", "HDL Cholesterol", "Smoking", "Waist:Hip Ratio"), "Proteins" =c("CASP.8", "CCL11", "CCL20", "CCL23", "CD5", "CD6","CSF.1","CXCL10", "CXCL5","CXCL9", "EN.RAGE","FGF.19","FGF.21","FGF.23","Flt3L","HGF", "IL.12B","IL.18R1","IL6","IL8","LIF.R","MCP.2", "MCP.4","MMP.1","MMP.10","OSM","ST1A1","TGF.alpha", "TNFRSF9","TNFSF14","VEGFA","ADAM.22","CNTN5","CRTAM" , "DDR1", "Dkk.4","EDA2R","EPHB6","EZR","FcRL2", "G.CSF", "gal.8" ,"GDF.8","GFR.alpha.1","GZMA", "IL.5R.alpha", "IL12", "JAM.B", "MATN3","MDGA1", "N.CDase","NAAA", "NEP","NMNAT1", "Nr.CAM","NTRK3", "SIGLEC1","SKR3" , "SMPD1","SPOCK1" ,"TN.R","TNFRSF12A")), multiple = F, selected = NULL)), conditionalPanel(condition = "input.tabs == 2", selectizeInput("var1", label = "Choose up to 10 Epigenetic Predictors to Display", choices = list("Lifestyle" = c("Alcohol", "Body Fat %", "Body Mass Index", "HDL Cholesterol", "Smoking", "Waist:Hip Ratio"), "Proteins" =c("CASP.8", "CCL11", "CCL20", "CCL23", "CD5", "CD6","CSF.1","CXCL10", "CXCL5","CXCL9", "EN.RAGE","FGF.19","FGF.21","FGF.23","Flt3L","HGF", "IL.12B","IL.18R1","IL6","IL8","LIF.R","MCP.2", "MCP.4","MMP.1","MMP.10","OSM","ST1A1","TGF.alpha", "TNFRSF9","TNFSF14","VEGFA","ADAM.22","CNTN5","CRTAM" , "DDR1", "Dkk.4","EDA2R","EPHB6","EZR","FcRL2", "G.CSF", "gal.8" ,"GDF.8","GFR.alpha.1","GZMA", "IL.5R.alpha", "IL12", "JAM.B", "MATN3","MDGA1", "N.CDase","NAAA", "NEP","NMNAT1", "Nr.CAM","NTRK3", "SIGLEC1","SKR3" , "SMPD1","SPOCK1" ,"TN.R","TNFRSF12A")), multiple = T,options = list(maxItems = 10), selected = NULL)), uiOutput("var_ui"), selectInput("sexInput", "Sex", choices = c("NULL", "Male", "Female"), selected = NULL), sliderInput("ageInput", "Age", min = 0, max = 100, value = c(0,100))), mainPanel(tabsetPanel(id="tabs", tabPanel("Density Plot", value = 1, withSpinner(plotOutput("plot"), type = 8), br(), uiOutput("downloadinput"), br(), br(), br(), uiOutput("message1")), tabPanel("Percentile Plot", value = 2, withSpinner(plotOutput("results"),type=8), textOutput("text"), br(), uiOutput("downloadgs"), br(), br(), br(), uiOutput("message2")), tabPanel("Correlation between Predictors", value = 2, withSpinner(plotOutput("corrplot"),type = 8), br(), br(), br(), uiOutput("message3")), tabPanel("Correlation between Predictors and Traits", value = 1, withSpinner(plotOutput("corrplot2"), type = 8), br(), br(), br(), uiOutput("message4")))) )) ## Server Portion server <- function(input, output,session) { predictors <- names(epigen)[4:ncol(epigen)] df1 <- reactive({ req(input$file1) df1 <- fread(input$file1$datapath, check.names = F) df1 = as.data.frame(df1) return(df1) }) observeEvent(input$file1, { means1 = sapply(df1()[,3:9], is.numeric) means1 = as.data.frame(means1) if(nrow(df1()) == 0){ shinyalert("Sorry, An Error Has Occurred","There Are No Individuals In The Dataset!",type = "warning", showCancelButton = TRUE, inputId = "foo1") } else if(length(which(means1[,1] %in% "FALSE")) > 0) { # show pop-up ... shinyalert("Sorry, An Error Has Occurred","Non-Numeric Values Are Detected For the Predictors!",type = "warning", showCancelButton = TRUE, inputId = "foo1") observeEvent(input$foo1, { session$reload() }) } else if(length(which(!names(df1()) %in% names(epigen))) > 0) { # show pop-up ... shinyalert("Sorry, An Error Has Occurred", paste("The Following Column Names Are Not Present in the Correct Format:", paste(names(epigen)[-which(names(epigen) %in% names(df1()))], collapse = ", "), sep = " "),type = "warning", showCancelButton = TRUE, inputId = "foo") observeEvent(input$foo, { session$reload() }) } else { NULL } } ) df2 <- reactive({ req(input$file1) df2 <- read.csv(input$file1$datapath, check.names=F) return(df2) }) output$message1 <- renderUI(HTML(paste( "Please remember to cite McCartney & Hillary", em("et al."), "(2018)", "and Zhang", em("et al."), "(2019)" ))) output$message2 <- renderUI(HTML(paste( "Please remember to cite McCartney & Hillary", em("et al."), "(2018)", "and Zhang", em("et al."), "(2019)" ))) output$message3 <- renderUI(HTML(paste( "Please remember to cite McCartney & Hillary", em("et al."), "(2018)", "and Zhang", em("et al."), "(2019)" ))) output$message4 <- renderUI(HTML(paste( "Please remember to cite McCartney & Hillary", em("et al."), "(2018)", "and Zhang", em("et al."), "(2019)" ))) output$var_ui <- renderUI({ selectInput("IDInput", "ID", choices = df1()$ID) }) dat <- reactive({ if (input$sexInput %in% "NULL") { test1 <- df1()[which(df1()$Age >= input$ageInput[1] & df1()$Age <= input$ageInput[2]),] return(test1) } else test2 <- df1()[which(df1()$Age >= input$ageInput[1] & df1()$Age <= input$ageInput[2] & df1()$Sex %in% input$sexInput),] return(test2) }) dat1 <- reactive({ dat_input <- dat()[which(dat()$ID %in% input$IDInput),] if (input$sexInput %in% "NULL") { epigen1 <- epigen[which(epigen$Age >= input$ageInput[1] & epigen$Age <= input$ageInput[2]),] bind1 <- rbind(dat_input, epigen1) return(bind1)} else epigen2 <- epigen[which(epigen$Age >= input$ageInput[1] & epigen$Age <= input$ageInput[2] & epigen$Sex %in% input$sexInput),] bind2 <- rbind(dat_input,epigen2) return(bind2) }) dat_epigen <- reactive({ if (input$sexInput %in% "NULL") { epigen1 <- epigen[which(epigen$Age >= input$ageInput[1] & epigen$Age <= input$ageInput[2]),] return(epigen1)} else epigen2 <- epigen[which(epigen$Age >= input$ageInput[1] & epigen$Age <= input$ageInput[2] & epigen$Sex %in% input$sexInput),] return(epigen2) }) dat2 <- reactive({ dat_input <- dat()[which(dat()$ID %in% input$IDInput),] full_set <- rbind(dat_input,epigen) return(full_set) }) id <- reactive({ individual <- which(dat1()$ID %in% input$IDInput) return(individual) }) id1 <- reactive({ individual1 <- which(df1()$ID %in% input$IDInput) return(individual1) }) id2 <- reactive({ individual2 <- which(dat()$ID %in% input$IDInput) return(individual2) }) dat_for_plot <- reactive({ dat_plot <- rbind(df1()[which(df1()$ID %in% input$IDInput),], dat()) return(dat_plot) }) table_input_rbind <- reactive({ reference = cbind(dat_for_plot()$ID, as.data.frame(apply(dat_for_plot()[,predictors], 2, function(x) percent_rank(x)*100))) row.names(reference) <- reference[,1] reference[,1] <- NULL reference <- as.data.frame(t(reference)) return(reference) }) id_plot <- reactive({ id_ggplot <- which(dat_for_plot()$ID %in% input$IDInput) return(id_ggplot) }) table_input <- reactive({ if(nrow(dat()) > 0) { reference = cbind(dat()$ID, as.data.frame(apply(dat()[,predictors], 2, function(x) percent_rank(x)*100))) row.names(reference) <- reference[,1] reference[,1] <- NULL reference <- as.data.frame(t(reference)) return(reference) } else print("0") }) dat_for_table <- reactive({ dat_table <- rbind(df1()[which(df1()$ID %in% input$IDInput),], dat_epigen()) return(dat_table) }) id_table <- reactive({ id_table1 <- which(dat_for_table()$ID %in% input$IDInput) return(id_table1) }) id_table2 <- reactive({ id_table2 <- which(dat_for_plot()$ID %in% input$IDInput) return(id_table2) }) table_rbind <- reactive({ reference = cbind(dat_for_table()$ID, as.data.frame(apply(dat_for_table()[,predictors], 2, function(x) percent_rank(x)*100))) row.names(reference) <- reference[,1] reference[,1] <- NULL reference <- as.data.frame(t(reference)) return(reference) }) table <- reactive({ reference = cbind(dat1()$ID, as.data.frame(apply(dat1()[,predictors], 2, function(x) percent_rank(x)*100))) row.names(reference) <- reference[,1] reference[,1] <- NULL reference <- as.data.frame(t(reference)) return(reference) }) rounded_rbind <- reactive({ rounded_value_rbind <- round(table_rbind()[,id_table()]) return(rounded_value_rbind) }) rounded <- reactive({ rounded_value <- round(table()[,id()]) return(rounded_value) }) ## Update Mean Methylation Predictor Value by demograph and clinical category tmp_dat <- reactive({ if (input$sexInput %in% "NULL") { tmp1 <- tmp[which(tmp$age >= input$ageInput[1] & tmp$age <= input$ageInput[2]),] return(tmp1)} else tmp2 <- tmp[which(tmp$age >= input$ageInput[1] & tmp$age <= input$ageInput[2] & tmp$sex %in% input$sexInput),] return(tmp2) }) output$plot <- renderPlot({ switcher <- switch(input$var, "Age" = dat()$Age, "Alcohol" = dat()$Alcohol, "Smoking" = dat()$Smoking, "Body Mass Index" = dat()$`Body Mass Index`, "Body Fat %" = dat()$`Body Fat %`, "Waist:Hip Ratio" = dat()$`Waist:Hip Ratio`, "HDL Cholesterol" = dat()$`HDL Cholesterol`, "CASP.8" = dat()$CASP.8, "CCL11" = dat()$CCL11, "CCL20" = dat()$CCL20, "CCL23" = dat()$CCL23, "CD5" = dat()$CD5, "CD6" = dat()$CD6, "CSF.1" = dat()$CSF.1, "CXCL10" = dat()$CXCL10, "CXCL5" = dat()$CXCL5, "CXCL9" = dat()$CXCL9, "EN.RAGE" = dat()$EN.RAGE, "FGF.19" = dat()$FGF.19, "FGF.21" = dat()$FGF.21, "FGF.23" = dat()$FGF.23, "Flt3L" = dat()$Flt3L, "HGF" = dat()$HGF, "IL.12B" = dat()$IL.12B, "IL.18R1" = dat()$IL.18R1, "IL6" = dat()$IL6, "IL8" = dat()$IL8, "LIF.R" = dat()$LIF.R, "MCP.2" = dat()$MCP.2, "MCP.4" = dat()$MCP.4, "MMP.1" = dat()$MMP.1, "MMP.10" = dat()$MMP.10, "OSM" = dat()$OSM, "ST1A1" = dat()$ST1A1, "TGF.alpha" = dat()$TGF.alpha, "TNFRSF9" = dat()$TNFRSF9, "TNFSF14" = dat()$TNFSF14, "VEGFA" = dat()$VEGFA, "ADAM.22" = dat()$ADAM.22, "CNTN5" = dat()$CNTN5, "CRTAM" = dat()$CRTAM, "DDR1" = dat()$DDR1, "Dkk.4" = dat()$Dkk.4, "EDA2R" = dat()$EDA2R, "EPHB6" = dat()$EPHB6, "EZR" = dat()$EZR, "FcRL2" = dat()$FcRL2, "G.CSF" = dat()$G.CSF, "gal.8" = dat()$gal.8, "GDF.8" = dat()$GDF.8, "GFR.alpha.1" = dat()$GFR.alpha.1, "GZMA" = dat()$GZMA, "IL.5R.alpha" = dat()$IL.5R.alpha, "IL12" = dat()$IL12, "JAM.B" = dat()$JAM.B, "MATN3" = dat()$MATN3, "MDGA1" = dat()$MDGA1, "N.CDase" = dat()$N.CDase, "NAAA" = dat()$NAAA, "NEP" = dat()$NEP, "NMNAT1" = dat()$NMNAT1, "Nr.CAM" = dat()$Nr.CAM, "NTRK3" = dat()$NTRK3, "SIGLEC1" = dat()$SIGLEC1, "SKR3" = dat()$SKR3, "SMPD1" = dat()$SMPD1, "SPOCK1" = dat()$SPOCK1, "TN.R" = dat()$TN.R, "TNFRSF12A" = dat()$TNFRSF12A) pick <- switch(input$var, "Alcohol" = "Alcohol", "Smoking" = "Smoking", "Body Mass Index" = "Body Mass Index", "Body Fat %" = "Body Fat %", "HDL Cholesterol" = "HDL Cholesterol", "Waist:Hip Ratio" = "Waist:Hip Ratio", "CASP.8"="CASP.8", "CCL11"="CCL11", "CCL20"="CCL20", "CCL23"="CCL23", "CD5"="CD5", "CD6"="CD6", "CSF.1"="CSF.1", "CXCL10"="CXCL10", "CXCL5"="CXCL5", "CXCL9"="CXCL9", "EN.RAGE"="EN.RAGE", "FGF.19"="FGF.19", "FGF.21"="FGF.21", "FGF.23"="FGF.23", "Flt3L"="Flt3L", "HGF"="HGF", "IL.12B"="IL.12B", "IL.18R1"="IL.18R1", "IL6"="IL6", "IL8"="IL8", "LIF.R"="LIF.R", "MCP.2"="MCP.2", "MCP.4"="MCP.4", "MMP.1"="MMP.1", "MMP.10"="MMP.10", "OSM"="OSM", "ST1A1"="ST1A1", "TGF.alpha"="TGF.alpha", "TNFRSF9"="TNFRSF9", "TNFSF14"="TNFSF14", "VEGFA"="VEGFA", "ADAM.22"="ADAM.22", "CNTN5"="CNTN5", "CRTAM"="CRTAM", "DDR1"="DDR1", "Dkk.4"="Dkk.4", "EDA2R"="EDA2R", "EPHB6"="EPHB6", "EZR"="EZR", "FcRL2"="FcRL2", "G.CSF"="G.CSF", "gal.8"="gal.8", "GDF.8"="GDF.8", "GFR.alpha.1"="GFR.alpha.1", "GZMA"="GZMA", "IL.5R.alpha"="IL.5R.alpha", "IL12"="IL12", "JAM.B"="JAM.B", "MATN3"="MATN3", "MDGA1"="MDGA1", "N.CDase"="N.CDase", "NAAA"="NAAA", "NEP"="NEP", "NMNAT1"="NMNAT1", "Nr.CAM"="Nr.CAM", "NTRK3"="NTRK3", "SIGLEC1"="SIGLEC1", "SKR3"="SKR3", "SMPD1"="SMPD1", "SPOCK1"="SPOCK1", "TN.R"="TN.R", "TNFRSF12A"="TNFRSF12A") literal <- switch(input$var, "Alcohol" = "Alcohol", "Smoking" = "Smoking", "Body Mass Index" = "Body Mass Index", "Body Fat %" = "Body Fat %", "HDL Cholesterol" = "HDL Cholesterol", "Waist:Hip Ratio" = "Waist:Hip Ratio", "CASP.8"="CASP.8", "CCL11"="CCL11", "CCL20"="CCL20", "CCL23"="CCL23", "CD5"="CD5", "CD6"="CD6", "CSF.1"="CSF.1", "CXCL10"="CXCL10", "CXCL5"="CXCL5", "CXCL9"="CXCL9", "EN.RAGE"="EN.RAGE", "FGF.19"="FGF.19", "FGF.21"="FGF.21", "FGF.23"="FGF.23", "Flt3L"="Flt3L", "HGF"="HGF", "IL.12B"="IL.12B", "IL.18R1"="IL.18R1", "IL6"="IL6", "IL8"="IL8", "LIF.R"="LIF.R", "MCP.2"="MCP.2", "MCP.4"="MCP.4", "MMP.1"="MMP.1", "MMP.10"="MMP.10", "OSM"="OSM", "ST1A1"="ST1A1", "TGF.alpha"="TGF.alpha", "TNFRSF9"="TNFRSF9", "TNFSF14"="TNFSF14", "VEGFA"="VEGFA", "ADAM.22"="ADAM.22", "CNTN5"="CNTN5", "CRTAM"="CRTAM", "DDR1"="DDR1", "Dkk.4"="Dkk.4", "EDA2R"="EDA2R", "EPHB6"="EPHB6", "EZR"="EZR", "FcRL2"="FcRL2", "G.CSF"="G.CSF", "gal.8"="gal.8", "GDF.8"="GDF.8", "GFR.alpha.1"="GFR.alpha.1", "GZMA"="GZMA", "IL.5R.alpha"="IL.5R.alpha", "IL12"="IL12", "JAM.B"="JAM.B", "MATN3"="MATN3", "MDGA1"="MDGA1", "N.CDase"="N.CDase", "NAAA"="NAAA", "NEP"="NEP", "NMNAT1"="NMNAT1", "Nr.CAM"="Nr.CAM", "NTRK3"="NTRK3", "SIGLEC1"="SIGLEC1", "SKR3"="SKR3", "SMPD1"="SMPD1", "SPOCK1"="SPOCK1", "TN.R"="TN.R", "TNFRSF12A"="TNFRSF12A") legend <- switch(input$var, "Alcohol" = "Alcohol Predictor (units/week)", "Smoking" = "Smoking Predictor (status)", "Body Mass Index" = "Body Mass Index Predictor (index)", "Body Fat %" = "Body Fat Percentage Predictor (%)", "Waist:Hip Ratio" = "Waist:Hip Ratio Predictor (ratio)", "HDL Cholesterol" = "HDL Cholesterol Predictor (mmol/L)") legend_2 <- list("Alcohol" = "Average Scores for Light (<7), Medium (7-14) and Heavy Drinkers (>14)", "Smoking" = "Average Scores for Never, Former (Quit > 1 year), Former (Quit < 1 year) and Current Smokers", "Body Mass Index" = "Average Scores for Underweight (<18), Healthy (18-25), Overweight (25-30) and Obese (>30) Individuals", "Body Fat %" = c("Female" = c("Average Scores for Fit (<24%), Average (24-32%) and At Risk (>32%) Females"), "Male" = c("Average Scores for Fit (<17%), Average (17-25%) and At Risk (>25%) Males"), "NA" = c("Average Scores for Fit (<21%), Average (21-29%) and At Risk (>29%) Individuals")), "Waist:Hip Ratio" = c("Female" = c("Average Scores for Healthy (<0.95), Average (0.96-1.0) and At Risk (>1.0) Females"), "Male" = c("Average Scores for Healthy (<0.80), Average (0.81-0.85) and At Risk (>0.86) Males"), "NA" = c("Average Scores for Fit (<0.88), Average (0.89-0.93) and At Risk (>0.94) Individuals")), "HDL Cholesterol" = "Average Scores for At Risk (< 1 mmol/L) and Healthy (> 1 mmol/L) Individuals") ## Smoking smoking <- list() smoking[1] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$ever_smoke %in% 4),"Basename"]),"Smoking"]) smoking[2] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$ever_smoke %in% 3),"Basename"]),"Smoking"]) smoking[3] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$ever_smoke %in% 2),"Basename"]),"Smoking"]) smoking[4] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$ever_smoke %in% 1),"Basename"]),"Smoking"]) ## BMI bmi <- list() bmi[1] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$bmi < 18),"Basename"]),"Body Mass Index"]) bmi[2] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$bmi > 18 & tmp_dat()$bmi < 25),"Basename"]),"Body Mass Index"]) bmi[3] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$bmi > 25 & tmp_dat()$bmi < 30),"Basename"]),"Body Mass Index"]) bmi[4] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$bmi > 30),"Basename"]),"Body Mass Index"]) ## WHR whr <- list() whr[1] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$whr <= 0.8 & tmp_dat()$sex %in% "Female"),"Basename"]),"Waist:Hip Ratio"]) whr[2] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$whr > 0.8 & tmp_dat()$whr <= 0.85 & tmp_dat()$sex %in% "Female"),"Basename"]),"Waist:Hip Ratio"]) whr[3] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$whr > 0.86 & tmp_dat()$sex %in% "Female"),"Basename"]),"Waist:Hip Ratio"]) whr[4] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$whr < 0.95 & tmp_dat()$sex %in% "Male"),"Basename"]),"Waist:Hip Ratio"]) whr[5] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$whr > 0.96 & tmp_dat()$whr <= 1.0 & tmp_dat()$sex %in% "Male"),"Basename"]),"Waist:Hip Ratio"]) whr[6] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$whr > 1.0 & tmp_dat()$sex %in% "Male"),"Basename"]),"Waist:Hip Ratio"]) whr[7] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$whr < 0.89),"Basename"]),"Waist:Hip Ratio"]) whr[8] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$whr >= 0.89 & tmp_dat()$whr <= 0.94),"Basename"]),"Waist:Hip Ratio"]) whr[9] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$whr > 0.94),"Basename"]),"Waist:Hip Ratio"]) ## Body Fat body_fat <- list() body_fat[1] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$body_fat <= 24 & tmp_dat()$sex %in% "Female"),"Basename"]),"Body Fat %"]) body_fat[2] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$body_fat > 24 & tmp_dat()$body_fat < 32 & tmp_dat()$sex %in% "Female"),"Basename"]),"Body Fat %"]) body_fat[3] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$body_fat >= 32 & tmp_dat()$sex %in% "Female"),"Basename"]),"Body Fat %"]) body_fat[4] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$body_fat <= 17 & tmp_dat()$sex %in% "Male"),"Basename"]),"Body Fat %"]) body_fat[5] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$body_fat > 17 & tmp_dat()$body_fat < 25 & tmp_dat()$sex %in% "Male"),"Basename"]),"Body Fat %"]) body_fat[6] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$body_fat >= 25 & tmp_dat()$sex %in% "Male"),"Basename"]),"Body Fat %"]) body_fat[7] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$body_fat <= 21),"Basename"]),"Body Fat %"]) body_fat[8] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$body_fat > 21 & tmp_dat()$body_fat < 29),"Basename"]),"Body Fat %"]) body_fat[9] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$body_fat >= 29),"Basename"]),"Body Fat %"]) ## Alcohol alcohol <- list() alcohol[1] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$units >= 0 & tmp_dat()$units < 7 & tmp_dat()$usual %in% 2),"Basename"]),"Alcohol"]) alcohol[2] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$units > 7 & tmp_dat()$units <= 14 & tmp_dat()$usual %in% 2),"Basename"]),"Alcohol"]) alcohol[3] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$units > 14 & tmp_dat()$usual %in% 2),"Basename"]),"Alcohol"]) ## HDL Cholesterol hdl_chol <- list() hdl_chol[1] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$HDL_cholesterol >= 1),"Basename"]),"HDL Cholesterol"]) hdl_chol[2] <- mean(out[which(out$ID %in% tmp_dat()[which(tmp_dat()$HDL_cholesterol < 1),"Basename"]),"HDL Cholesterol"]) cutoffs = list("Alcohol" = c(alcohol[[1]], alcohol[[2]], alcohol[[3]]), "Smoking" = c(smoking[[1]], smoking[[2]], smoking[[3]], smoking[[4]]), "Body Fat %" = c("Female" = c(body_fat[[1]], body_fat[[2]], body_fat[[3]]), "Male" = c(body_fat[[4]], body_fat[[5]], body_fat[[6]]), "NA"=c(body_fat[[7]], body_fat[[8]], body_fat[[9]])), "Body Mass Index" = c(bmi[[1]], bmi[[2]], bmi[[3]], bmi[[4]]), "HDL Cholesterol" = c(hdl_chol[[1]], hdl_chol[[2]]), "Waist:Hip Ratio" = c("Female" = c(whr[[1]], whr[[2]], whr[[3]]), "Male" = c(whr[[4]], whr[[5]], whr[[6]]), "NA" = c(whr[[7]],whr[[8]],whr[[9]]))) labels = list("Alcohol" = c("Light", "Medium", "Heavy"), "Smoking" = c("Never", "Former (quit \n > 12 months)", "Former (quit \n < 12 months)", "Current"), "Body Fat %" = c("Female" = c("Fit", "Average", "At Risk"),"Male"=c("Fit", "Average", "At Risk"),"NA"=c("Fit", "Average", "At Risk")), "Body Mass Index" = c("Underweight", "Healthy", "Overweight", "Obese"),"HDL Cholesterol" = c("Healthy", "At Risk"), "Waist:Hip Ratio" = c("Female" = c("Fit", "Average", "At Risk"), "Male" = c("Fit", "Average", "At Risk"), "NA"= c("Fit", "Average", "At Risk"))) called <- labels switcher2 <- switch(input$var, "Age" = dat_for_plot()$Age, "Alcohol" = dat_for_plot()$Alcohol, "Smoking" = dat_for_plot()$Smoking, "Body Mass Index" = dat_for_plot()$`Body Mass Index`, "Body Fat %" = dat_for_plot()$`Body Fat %`, "Waist:Hip Ratio" = dat_for_plot()$`Waist:Hip Ratio`, "HDL Cholesterol" = dat_for_plot()$`HDL Cholesterol`, "CASP.8" = dat_for_plot()$CASP.8, "CCL11" = dat_for_plot()$CCL11, "CCL20" = dat_for_plot()$CCL20, "CCL23" = dat_for_plot()$CCL23, "CD5" = dat_for_plot()$CD5, "CD6" = dat_for_plot()$CD6, "CSF.1" = dat_for_plot()$CSF.1, "CXCL10" = dat_for_plot()$CXCL10, "CXCL5" = dat_for_plot()$CXCL5, "CXCL9" = dat_for_plot()$CXCL9, "EN.RAGE" = dat_for_plot()$EN.RAGE, "FGF.19" = dat_for_plot()$FGF.19, "FGF.21" = dat_for_plot()$FGF.21, "FGF.23" = dat_for_plot()$FGF.23, "Flt3L" = dat_for_plot()$Flt3L, "HGF" = dat_for_plot()$HGF, "IL.12B" = dat_for_plot()$IL.12B, "IL.18R1" = dat_for_plot()$IL.18R1, "IL6" = dat_for_plot()$IL6, "IL8" = dat_for_plot()$IL8, "LIF.R" = dat_for_plot()$LIF.R, "MCP.2" = dat_for_plot()$MCP.2, "MCP.4" = dat_for_plot()$MCP.4, "MMP.1" = dat_for_plot()$MMP.1, "MMP.10" = dat_for_plot()$MMP.10, "OSM" = dat_for_plot()$OSM, "ST1A1" = dat_for_plot()$ST1A1, "TGF.alpha" = dat_for_plot()$TGF.alpha, "TNFRSF9" = dat_for_plot()$TNFRSF9, "TNFSF14" = dat_for_plot()$TNFSF14, "VEGFA" = dat_for_plot()$VEGFA, "ADAM.22" = dat_for_plot()$ADAM.22, "CNTN5" = dat_for_plot()$CNTN5, "CRTAM" = dat_for_plot()$CRTAM, "DDR1" = dat_for_plot()$DDR1, "Dkk.4" = dat_for_plot()$Dkk.4, "EDA2R" = dat_for_plot()$EDA2R, "EPHB6" = dat_for_plot()$EPHB6, "EZR" = dat_for_plot()$EZR, "FcRL2" = dat_for_plot()$FcRL2, "G.CSF" = dat_for_plot()$G.CSF, "gal.8" = dat_for_plot()$gal.8, "GDF.8" = dat_for_plot()$GDF.8, "GFR.alpha.1" = dat_for_plot()$GFR.alpha.1, "GZMA" = dat_for_plot()$GZMA, "IL.5R.alpha" = dat_for_plot()$IL.5R.alpha, "IL12" = dat_for_plot()$IL12, "JAM.B" = dat_for_plot()$JAM.B, "MATN3" = dat_for_plot()$MATN3, "MDGA1" = dat_for_plot()$MDGA1, "N.CDase" = dat_for_plot()$N.CDase, "NAAA" = dat_for_plot()$NAAA, "NEP" = dat_for_plot()$NEP, "NMNAT1" = dat_for_plot()$NMNAT1, "Nr.CAM" = dat_for_plot()$Nr.CAM, "NTRK3" = dat_for_plot()$NTRK3, "SIGLEC1" = dat_for_plot()$SIGLEC1, "SKR3" = dat_for_plot()$SKR3, "SMPD1" = dat_for_plot()$SMPD1, "SPOCK1" = dat_for_plot()$SPOCK1, "TN.R" = dat_for_plot()$TN.R, "TNFRSF12A" = dat_for_plot()$TNFRSF12A) if(input$var %in% "Age"){ plot(0,0, axes = F, xlab = "", ylab= "", pch = NA) text(0,0,paste("We predict that you are","\n", round(df1()$Age[id1()],1), "years old!", sep = " "), cex = 1.7) } else if (nrow(dat_epigen()) <= 10 ) { plot(0,0, axes = F, xlab = "", ylab= "", pch = NA) text(0,0,"Sorry, the number of reference individuals must be above 10!", cex = 1.7) } else if (!input$var %in% c("Alcohol", "Body Fat %", "Body Mass Index", "HDL Cholesterol", "Smoking", "Waist:Hip Ratio") & length(which(dat()$ID %in% input$IDInput))==0) { p = ggplot(dat_for_plot(), aes(dat_for_plot()[,as.character(pick)])) + geom_density(aes(fill = "blue"),alpha=0.2) + ylab("Density") p= p + theme(legend.title = element_text(size = 13), legend.text = element_text(size=12), axis.text = element_text(size = 14), axis.title.y = element_text(size = 13), axis.title.x=element_text(size = 14, margin=margin(t=10,r=0,b=10,l=0))) to_fill <- tibble( x = ggplot_build(p)$data[[1]]$x, y = ggplot_build(p)$data[[1]]$y) minimum <- if(min(dat_epigen()[,as.character(pick)], na.rm = T) < min(dat_for_plot()[,as.character(pick)], na.rm = T)) { min(dat_epigen()[,as.character(pick)], na.rm =T)} else {min(dat_for_plot()[,as.character(pick)], na.rm = T)} maximum <- if(max(dat_epigen()[,as.character(pick)], na.rm = T) > max(dat_for_plot()[,as.character(pick)], na.rm = T)) { max(dat_epigen()[,as.character(pick)], na.rm =T)} else {max(dat_for_plot()[,as.character(pick)], na.rm = T)} p + geom_vline(xintercept = switcher2[id_plot()], linetype = "dashed") + theme(legend.title = element_text(hjust = 0.5)) + geom_segment(aes(x=minimum, xend = maximum, y=0, yend = 0), size=1, arrow = arrow(length = unit(0.6,"cm"))) + xlab(paste("Methylation-based Scores for", as.character(pick))) + theme(panel.grid.minor = element_blank(), panel.grid.major = element_blank(), panel.background = element_blank(), axis.line = element_line("black")) + scale_x_continuous(limits = c(minimum-0.001,maximum+0.001)) + geom_density(data = dat_epigen(), aes(dat_epigen()[,as.character(pick)], fill = "pink"), alpha = 0.2) + scale_fill_discrete(name = "Dataset",labels = c(paste(paste(paste("Input", "(n = ", sep = " "), nrow(dat()), ")", sep = ""),"\n Percentile vs Input: ", ifelse(nrow(dat()) > 0, as.character(round(table_input_rbind()[literal,id_plot()]),2), "NA")), paste(paste(paste("Generation Scotland", "(n = ", sep = " "),nrow(dat_epigen()), ")", sep = ""), "\n Percentile vs GS: ", as.character(round(table_rbind()[literal,id_table()]),2), sep= ""))) } else if(!input$var %in% c("Alcohol", "Body Fat %", "Body Mass Index", "HDL Cholesterol", "Smoking", "Waist:Hip Ratio") & length(which(dat()$ID %in% input$IDInput))>0){ p = ggplot(dat(), aes(dat()[,as.character(pick)])) + geom_density(aes(fill = "blue"),alpha=0.2) + ylab("Density") p= p + theme(legend.title = element_text(size = 13), legend.text = element_text(size=12), axis.text = element_text(size = 14), axis.title.y = element_text(size = 13), axis.title.x=element_text(size = 14, margin=margin(t=10,r=0,b=10,l=0))) to_fill <- tibble( x = ggplot_build(p)$data[[1]]$x, y = ggplot_build(p)$data[[1]]$y) minimum <- if(min(dat_epigen()[,as.character(pick)], na.rm = T) < min(dat()[,as.character(pick)], na.rm = T)) { min(dat_epigen()[,as.character(pick)], na.rm =T)} else {min(dat()[,as.character(pick)], na.rm = T)} maximum <- if(max(dat_epigen()[,as.character(pick)], na.rm = T) > max(dat()[,as.character(pick)], na.rm = T)) { max(dat_epigen()[,as.character(pick)], na.rm =T)} else {max(dat()[,as.character(pick)], na.rm = T)} p + geom_vline(xintercept = switcher[id2()], linetype = "dashed") + theme(legend.title = element_text(hjust = 0.5)) + geom_segment(aes(x=minimum, xend = maximum, y=0, yend = 0), size=1, arrow = arrow(length = unit(0.6,"cm"))) + xlab(paste("Methylation-based Scores for", as.character(pick))) + theme(panel.grid.minor = element_blank(), panel.grid.major = element_blank(), panel.background = element_blank(), axis.line = element_line("black")) + scale_x_continuous(limits = c(minimum-0.001,maximum+0.001)) + geom_density(data = dat_epigen(), aes(dat_epigen()[,as.character(pick)], fill = "pink"), alpha = 0.2) +scale_fill_discrete(name = "Dataset",labels = c(paste(paste(paste("Input", "(n = ", sep = " "), nrow(dat()), ")", sep = ""),"\n Percentile vs Input: ", ifelse(nrow(dat()) > 0, as.character(round(table_input()[literal,id2()])), "0")), paste(paste(paste("Generation Scotland", "(n = ", sep = " "),nrow(dat_epigen()), ")", sep = ""), "\n Percentile vs GS: ", as.character(round(table()[literal,id()]),2), sep= ""))) } else if (length(which(dat()$ID %in% input$IDInput))==0) { p = ggplot(dat_for_plot(), aes(dat_for_plot()[,as.character(pick)])) + geom_density(aes(fill = "blue"),alpha=0.2) + ylab("Density") list = cutoffs[[which(names(cutoffs) %in% as.character(pick))]] axis = called[[which(names(called) %in% as.character(pick))]] legend_2 = legend_2[[which(names(legend_2) %in% as.character(pick))]] minimum <- if(min(dat_epigen()[,as.character(pick)], na.rm = T) < min(dat_for_plot()[,as.character(pick)], na.rm = T)) { min(dat_epigen()[,as.character(pick)], na.rm =T)} else {if(min(dat_for_plot()[,as.character(pick)], na.rm = T) < list[1]) {min(dat_for_plot()[,as.character(pick)], na.rm = T)} else {list[1]}} maximum <- if(max(dat_epigen()[,as.character(pick)], na.rm = T) > max(dat_for_plot()[,as.character(pick)], na.rm = T)) { max(dat_epigen()[,as.character(pick)], na.rm =T)} else {if(max(dat_for_plot()[,as.character(pick)], na.rm = T) > list[length(list)]) {max(dat_for_plot()[,as.character(pick)], na.rm = T)} else {list[length(list)]}} p= p + theme(legend.title = element_text(size = 13), legend.text = element_text(size=12), axis.text = element_text(size = 14), axis.title.y = element_text(size = 13), axis.title.x=element_text(size = 14, margin=margin(t=10,r=0,b=10,l=0))) to_fill <- tibble( x = ggplot_build(p)$data[[1]]$x, y = ggplot_build(p)$data[[1]]$y) if(length(list) == 3){ p + geom_vline(xintercept = switcher2[id_plot()], linetype = "dashed") + labs(fill = "Average Scores for \n Individuals described as") + theme(legend.title = element_text(hjust = 0.5)) + geom_segment(aes(x=minimum, xend = maximum, y=0, yend = 0), size=1, arrow = arrow(length = unit(0.6,"cm"))) + scale_x_continuous(limits = c(minimum-0.001,maximum+0.001), breaks = list, labels = axis) + theme(panel.grid.minor = element_blank(), panel.grid.major = element_blank(), panel.background = element_blank(), axis.line = element_line("black")) + geom_density(data = dat_epigen(), aes(dat_epigen()[,as.character(pick)], fill = "pink"), alpha = 0.2)+ theme(axis.text.x = element_text(angle = 75, hjust = 1)) +scale_fill_discrete(name = "Dataset",labels = c(paste(paste(paste("Input", "(n = ", sep = " "), nrow(dat()), ")", sep = ""),"\n Percentile vs Input: ", ifelse(nrow(dat()) > 0, as.character(round(table_input_rbind()[literal,id_plot()]),2), "NA")), paste(paste(paste("Generation Scotland", "(n = ", sep = " "),nrow(dat_epigen()), ")", sep = ""), "\n Percentile vs GS: ", as.character(round(table_rbind()[literal,id_table()]),2), sep= ""))) + xlab(paste(as.factor(legend), "\n", legend_2, sep = " ")) } else { if(length(list)== 4) { p + geom_vline(xintercept = switcher2[id_plot()], linetype = "dashed") + labs(fill = "Average Scores for \n Individuals described as") + theme(legend.title = element_text(hjust = 0.5)) + geom_segment(aes(x=minimum, xend = maximum, y=0, yend = 0), size=1, arrow = arrow(length = unit(0.6,"cm"))) + scale_x_continuous(limits = c(minimum-0.001,maximum+0.001), breaks = list, labels = axis) + theme(panel.grid.minor = element_blank(), panel.grid.major = element_blank(), panel.background = element_blank(), axis.line = element_line("black")) + geom_density(data = dat_epigen(), aes(dat_epigen()[,as.character(pick)], fill = "pink"), alpha = 0.2)+ theme(axis.text.x = element_text(angle = 75, hjust = 1)) +scale_fill_discrete(name = "Dataset",labels = c(paste(paste(paste("Input", "(n = ", sep = " "), nrow(dat()), ")", sep = ""),"\n Percentile vs Input: ", ifelse(nrow(dat()) > 0, as.character(round(table_input_rbind()[literal,id_plot()]),2), "NA")), paste(paste(paste("Generation Scotland", "(n = ", sep = " "),nrow(dat_epigen()), ")", sep = ""), "\n Percentile vs GS: ", as.character(round(table_rbind()[literal,id_table()]),2), sep= ""))) + xlab(paste(as.factor(legend), "\n", legend_2, sep = " ")) } else { if(length(list) == 2) { p + geom_vline(xintercept = switcher2[id_plot()], linetype = "dashed") + labs(fill = "Average Score for \n Individuals described as") + theme(legend.title = element_text(hjust = 0.5)) + geom_segment(aes(x=minimum, xend = maximum , y=0, yend = 0), size=1, arrow = arrow(length = unit(0.6,"cm"))) + scale_x_continuous(limits = c(minimum-0.001,maximum+0.001), breaks = list, labels = axis) + theme(panel.grid.minor = element_blank(), panel.grid.major = element_blank(), panel.background = element_blank(), axis.line = element_line("black")) + geom_density(data = dat_epigen(), aes(dat_epigen()[,as.character(pick)], fill = "pink"), alpha = 0.2) + theme(axis.text.x = element_text(angle = 75, hjust = 1)) +scale_fill_discrete(name = "Dataset",labels = c(paste(paste(paste("Input", "(n = ", sep = " "), nrow(dat()), ")", sep = ""),"\n Percentile vs Input: ", ifelse(nrow(dat()) > 0, as.character(round(table_input_rbind()[literal,id_plot()]),2), "NA")), paste(paste(paste("Generation Scotland", "(n = ", sep = " "),nrow(dat_epigen()), ")", sep = ""), "\n Percentile vs GS: ", as.character(round(table_rbind()[literal,id_table()]),2), sep= ""))) + xlab(paste(as.factor(legend), "\n", legend_2, sep = " ")) } else { if(input$sexInput %in% "Female") { p + geom_vline(xintercept = switcher2[id_plot()], linetype = "dashed") + labs(fill = "Average Score for \n Individuals described as") + theme(legend.title = element_text(hjust = 0.5)) + geom_segment(aes(x=minimum, xend = maximum , y=0, yend = 0), size=1, arrow = arrow(length = unit(0.6,"cm"))) + scale_x_continuous(limits = c(minimum-0.001,maximum+0.001), breaks = list[c(1,2,3)], labels = axis[c(1,2,3)]) + theme(panel.grid.minor = element_blank(), panel.grid.major = element_blank(), panel.background = element_blank(), axis.line = element_line("black")) + geom_density(data = dat_epigen(), aes(dat_epigen()[,as.character(pick)], fill = "pink"), alpha = 0.2) + theme(axis.text.x = element_text(angle = 75, hjust = 1)) +scale_fill_discrete(name = "Dataset",labels = c(paste(paste(paste("Input", "(n = ", sep = " "), nrow(dat()), ")", sep = ""),"\n Percentile vs Input: ", ifelse(nrow(dat()) > 0, as.character(round(table_input_rbind()[literal,id_plot()]),2), "NA")), paste(paste(paste("Generation Scotland", "(n = ", sep = " "),nrow(dat_epigen()), ")", sep = ""), "\n Percentile vs GS: ", as.character(round(table_rbind()[literal,id_table()]),2), sep= ""))) + xlab(paste(as.factor(legend), "\n", legend_2[c(1)], sep = " ")) } else { if(input$sexInput %in% "Male") { p + geom_vline(xintercept = switcher2[id_plot()], linetype = "dashed") + labs(fill = "Average Score for \n Individuals described as") + theme(legend.title = element_text(hjust = 0.5)) + geom_segment(aes(x=minimum, xend = maximum , y=0, yend = 0), size=1, arrow = arrow(length = unit(0.6,"cm"))) + scale_x_continuous(limits = c(minimum-0.001,maximum+0.001), breaks = list[c(4,5,6)], labels = axis[c(4,5,6)]) + theme(panel.grid.minor = element_blank(), panel.grid.major = element_blank(), panel.background = element_blank(), axis.line = element_line("black")) + geom_density(data = dat_epigen(), aes(dat_epigen()[,as.character(pick)], fill = "pink"), alpha = 0.2) + theme(axis.text.x = element_text(angle = 75, hjust = 1)) +scale_fill_discrete(name = "Dataset",labels = c(paste(paste(paste("Input", "(n = ", sep = " "), nrow(dat()), ")", sep = ""),"\n Percentile vs Input: ", ifelse(nrow(dat()) > 0, as.character(round(table_input_rbind()[literal,id_plot()]),2), "NA")), paste(paste(paste("Generation Scotland", "(n = ", sep = " "),nrow(dat_epigen()), ")", sep = ""), "\n Percentile vs GS: ", as.character(round(table_rbind()[literal,id_table()]),2), sep= ""))) + xlab(paste(as.factor(legend), "\n", legend_2[c(2)], sep = " ")) } else { p + geom_vline(xintercept = switcher2[id_plot()], linetype = "dashed") + labs(fill = "Average Score for \n Individuals described as") + theme(legend.title = element_text(hjust = 0.5)) + geom_segment(aes(x=minimum, xend = maximum , y=0, yend = 0), size=1, arrow = arrow(length = unit(0.6,"cm"))) + scale_x_continuous(limits = c(minimum-0.001,maximum+0.001), breaks = list[c(7,8,9)], labels = axis[c(7,8,9)]) + theme(panel.grid.minor = element_blank(), panel.grid.major = element_blank(), panel.background = element_blank(), axis.line = element_line("black")) + geom_density(data = dat_epigen(), aes(dat_epigen()[,as.character(pick)], fill = "pink"), alpha = 0.2) + theme(axis.text.x = element_text(angle = 75, hjust = 1)) +scale_fill_discrete(name = "Dataset",labels = c(paste(paste(paste("Input", "(n = ", sep = " "), nrow(dat()), ")", sep = ""),"\n Percentile vs Input: ", ifelse(nrow(dat()) > 0, as.character(round(table_input_rbind()[literal,id_plot()]),2), "NA")), paste(paste(paste("Generation Scotland", "(n = ", sep = " "),nrow(dat_epigen()), ")", sep = ""), "\n Percentile vs GS: ", as.character(round(table_rbind()[literal,id_table()]),2), sep= ""))) + xlab(paste(as.factor(legend), "\n", legend_2[c(3)], sep = " ")) } } } } } } else { p = ggplot(dat(), aes(dat()[,as.character(pick)])) + geom_density(aes(fill = "blue"),alpha=0.2) + ylab("Density") list = cutoffs[[which(names(cutoffs) %in% as.character(pick))]] axis = called[[which(names(called) %in% as.character(pick))]] legend_2 = legend_2[[which(names(legend_2) %in% as.character(pick))]] minimum <- if(min(dat_epigen()[,as.character(pick)], na.rm = T) < min(dat()[,as.character(pick)], na.rm = T)) { min(dat_epigen()[,as.character(pick)], na.rm =T)} else {if(min(dat()[,as.character(pick)], na.rm = T) < list[1]) {min(dat()[,as.character(pick)], na.rm = T)} else {list[1]}} maximum <- if(max(dat_epigen()[,as.character(pick)], na.rm = T) > max(dat()[,as.character(pick)], na.rm = T)) { max(dat_epigen()[,as.character(pick)], na.rm =T)} else {if(max(dat()[,as.character(pick)], na.rm = T) > list[length(list)]) {max(dat()[,as.character(pick)], na.rm = T)} else {list[length(list)]}} p= p + theme(legend.title = element_text(size = 13), legend.text = element_text(size=12), axis.text = element_text(size = 14), axis.title.y = element_text(size = 13), axis.title.x=element_text(size = 14, margin=margin(t=10,r=0,b=10,l=0))) to_fill <- tibble( x = ggplot_build(p)$data[[1]]$x, y = ggplot_build(p)$data[[1]]$y) if(length(list) == 3){ p + geom_vline(xintercept = switcher[id2()], linetype = "dashed") + labs(fill = "Average Scores for \n Individuals described as") + theme(legend.title = element_text(hjust = 0.5)) + geom_segment(aes(x=minimum, xend = maximum, y=0, yend = 0), size=1, arrow = arrow(length = unit(0.6,"cm"))) + scale_x_continuous(limits = c(minimum-0.001,maximum+0.001), breaks = list, labels = axis) + theme(panel.grid.minor = element_blank(), panel.grid.major = element_blank(), panel.background = element_blank(), axis.line = element_line("black")) + geom_density(data = dat_epigen(), aes(dat_epigen()[,as.character(pick)], fill = "pink"), alpha = 0.2)+ theme(axis.text.x = element_text(angle = 75, hjust = 1)) +scale_fill_discrete(name = "Dataset",labels = c(paste(paste(paste("Input", "(n = ", sep = " "), nrow(dat()), ")", sep = ""),"\n Percentile vs Input: ", ifelse(nrow(dat()) > 0, as.character(round(table_input()[literal,id2()])), "0")), paste(paste(paste("Generation Scotland", "(n = ", sep = " "),nrow(dat_epigen()), ")", sep = ""), "\n Percentile vs GS: ", as.character(round(table()[literal,id()]),2), sep= ""))) + xlab(paste(as.factor(legend), "\n", legend_2, sep = " ")) } else { if(length(list)== 4) { p + geom_vline(xintercept = switcher[id2()], linetype = "dashed") + labs(fill = "Average Scores for \n Individuals described as") + theme(legend.title = element_text(hjust = 0.5)) + geom_segment(aes(x=minimum, xend = maximum, y=0, yend = 0), size=1, arrow = arrow(length = unit(0.6,"cm"))) + scale_x_continuous(limits = c(minimum-0.001,maximum+0.001), breaks = list, labels = axis) + theme(panel.grid.minor = element_blank(), panel.grid.major = element_blank(), panel.background = element_blank(), axis.line = element_line("black")) + geom_density(data = dat_epigen(), aes(dat_epigen()[,as.character(pick)], fill = "pink"), alpha = 0.2)+ theme(axis.text.x = element_text(angle = 75, hjust = 1)) +scale_fill_discrete(name = "Dataset",labels = c(paste(paste(paste("Input", "(n = ", sep = " "), nrow(dat()), ")", sep = ""),"\n Percentile vs Input: ", ifelse(nrow(dat()) > 0, as.character(round(table_input()[literal,id2()])), "0")), paste(paste(paste("Generation Scotland", "(n = ", sep = " "),nrow(dat_epigen()), ")", sep = ""), "\n Percentile vs GS: ", as.character(round(table()[literal,id()]),2), sep= ""))) + xlab(paste(as.factor(legend), "\n", legend_2, sep = " ")) } else { if(length(list) == 2) { p + geom_vline(xintercept = switcher[id2()], linetype = "dashed") + labs(fill = "Average Score for \n Individuals described as") + theme(legend.title = element_text(hjust = 0.5)) + geom_segment(aes(x=minimum, xend = maximum , y=0, yend = 0), size=1, arrow = arrow(length = unit(0.6,"cm"))) + scale_x_continuous(limits = c(minimum-0.001,maximum+0.001), breaks = list, labels = axis) + theme(panel.grid.minor = element_blank(), panel.grid.major = element_blank(), panel.background = element_blank(), axis.line = element_line("black")) + geom_density(data = dat_epigen(), aes(dat_epigen()[,as.character(pick)], fill = "pink"), alpha = 0.2) + theme(axis.text.x = element_text(angle = 75, hjust = 1)) +scale_fill_discrete(name = "Dataset",labels = c(paste(paste(paste("Input", "(n = ", sep = " "), nrow(dat()), ")", sep = ""),"\n Percentile vs Input: ", ifelse(nrow(dat()) > 0, as.character(round(table_input()[literal,id2()])), "0")), paste(paste(paste("Generation Scotland", "(n = ", sep = " "),nrow(dat_epigen()), ")", sep = ""), "\n Percentile vs GS: ", as.character(round(table()[literal,id()]),2), sep= ""))) + xlab(paste(as.factor(legend), "\n", legend_2, sep = " ")) } else { if(input$sexInput %in% "Female") { p + geom_vline(xintercept = switcher[id2()], linetype = "dashed")+ labs(fill = "Average Score for \n Individuals described as") + theme(legend.title = element_text(hjust = 0.5)) + geom_segment(aes(x=minimum, xend = maximum , y=0, yend = 0), size=1, arrow = arrow(length = unit(0.6,"cm"))) + scale_x_continuous(limits = c(minimum-0.001,maximum+0.001), breaks = list[c(1,2,3)], labels = axis[c(1,2,3)]) + theme(panel.grid.minor = element_blank(), panel.grid.major = element_blank(), panel.background = element_blank(), axis.line = element_line("black")) + geom_density(data = dat_epigen(), aes(dat_epigen()[,as.character(pick)], fill = "pink"), alpha = 0.2)+theme(axis.text.x = element_text(angle = 75, hjust = 1)) +scale_fill_discrete(name = "Dataset",labels = c(paste(paste(paste("Input", "(n = ", sep = " "), nrow(dat()), ")", sep = ""),"\n Percentile vs Input: ", ifelse(nrow(dat()) > 0, as.character(round(table_input()[literal,id2()])), "0")), paste(paste(paste("Generation Scotland", "(n = ", sep = " "),nrow(dat_epigen()), ")", sep = ""), "\n Percentile vs GS: ", as.character(round(table()[literal,id()]),2), sep= ""))) + xlab(paste(as.factor(legend), "\n", legend_2[c(1)], sep = " ")) } else {if(input$sexInput %in% "Male") { p + geom_vline(xintercept = switcher[id2()], linetype = "dashed")+ labs(fill = "Average Score for \n Individuals described as") + theme(legend.title = element_text(hjust = 0.5)) + geom_segment(aes(x=minimum, xend = maximum , y=0, yend = 0), size=1, arrow = arrow(length = unit(0.6,"cm"))) + scale_x_continuous(limits = c(minimum-0.001,maximum+0.001), breaks = list[c(4,5,6)], labels = axis[c(4,5,6)]) + theme(panel.grid.minor = element_blank(), panel.grid.major = element_blank(), panel.background = element_blank(), axis.line = element_line("black")) + geom_density(data = dat_epigen(), aes(dat_epigen()[,as.character(pick)], fill = "pink"), alpha = 0.2)+theme(axis.text.x = element_text(angle = 75, hjust = 1)) +scale_fill_discrete(name = "Dataset",labels = c(paste(paste(paste("Input", "(n = ", sep = " "), nrow(dat()), ")", sep = ""),"\n Percentile vs Input: ", ifelse(nrow(dat()) > 0, as.character(round(table_input()[literal,id2()])), "0")), paste(paste(paste("Generation Scotland", "(n = ", sep = " "),nrow(dat_epigen()), ")", sep = ""), "\n Percentile vs GS: ", as.character(round(table()[literal,id()]),2), sep= ""))) + xlab(paste(as.factor(legend), "\n", legend_2[c(2)], sep = " ")) } else { p + geom_vline(xintercept = switcher[id2()], linetype = "dashed") + labs(fill = "Average Score for \n Individuals described as") + theme(legend.title = element_text(hjust = 0.5)) + geom_segment(aes(x=minimum, xend = maximum , y=0, yend = 0), size=1, arrow = arrow(length = unit(0.6,"cm"))) + scale_x_continuous(limits = c(minimum-0.001,maximum+0.001), breaks = list[c(7,8,9)], labels = axis[c(7,8,9)]) + theme(panel.grid.minor = element_blank(), panel.grid.major = element_blank(), panel.background = element_blank(), axis.line = element_line("black")) + geom_density(data = dat_epigen(), aes(dat_epigen()[,as.character(pick)], fill = "pink"), alpha = 0.2) + theme(axis.text.x = element_text(angle = 75, hjust = 1)) +scale_fill_discrete(name = "Dataset",labels = c(paste(paste(paste("Input", "(n = ", sep = " "), nrow(dat()), ")", sep = ""),"\n Percentile vs Input: ", ifelse(nrow(dat()) > 0, as.character(round(table_input()[literal,id2()])), "0")), paste(paste(paste("Generation Scotland", "(n = ", sep = " "),nrow(dat_epigen()), ")", sep = ""), "\n Percentile vs GS: ", as.character(round(table()[literal,id()]),2), sep= ""))) + xlab(paste(as.factor(legend), "\n", legend_2[c(3)], sep = " ")) } } } } } } }) table_rbind2 <- reactive({ t2 <- table_rbind()[which(row.names(table_rbind()) %in% input$var1),] return(t2) }) table2 <- reactive({ tab2 <- table()[which(row.names(table()) %in% input$var1),] return(tab2) }) rounded_rbind2 <- reactive({ rounded_value_rbind <- round(table_rbind2()[,id_table()]) return(rounded_value_rbind) }) rounded2 <- reactive({ rounded_value <- round(table2()[,id()]) return(rounded_value) }) predictions <- reactive({ p <- predictors[which(predictors %in% input$var1)] return(p) }) output$results <- renderPlot({ if(length(predictions()) < 1) { plot(0,0, axes = F, xlab = "", ylab= "", pch = NA) text(0,0,"Please select up to 10 predictors to view percentile ranks!", cex = 1.7) } else if (nrow(dat_epigen()) <= 10 ) { plot(0,0, axes = F, xlab = "", ylab= "", pch = NA) text(0,0,"Sorry, the number of reference individuals must be above 10!", cex = 1.7) } else if (length(which(dat()$ID %in% input$IDInput))==0) { ggplot(table_rbind2(), aes(x = table_rbind2()[,id_table()], y = fct_rev(row.names(table_rbind2())), colour = row.names(table_rbind2()))) + geom_point(size = 14) + geom_text(label = rounded_rbind2(), colour = "white", size = 6.3) + theme(axis.text = element_text(size = 14), axis.title = element_text(size = 14), axis.title.y=element_text(margin = margin(t=0,r=15,b=0,l=0))) + xlab(paste("Percentile for",names(table_rbind2())[id_plot()])) + ylab("Epigenetic Predictor") + theme(legend.position = "none") + xlim(c(0,100)) + scale_y_discrete(limits = levels(row.names(table_rbind2())))} else ggplot(table2(), aes(x = table2()[,id()], y = fct_rev(row.names(table2())), colour = row.names(table2()))) + geom_point(size = 14) + geom_text(label = rounded2(), colour = "white", size = 6.3) + theme(axis.text = element_text(size = 14), axis.title = element_text(size = 14), axis.title.y=element_text(margin = margin(t=0,r=15,b=0,l=0))) + xlab(paste("Percentile for",names(table2())[id()])) + ylab("Epigenetic Predictor") + theme(legend.position = "none") + xlim(c(0,100)) + scale_y_discrete(limits = levels(row.names(table2()))) }) output$corrplot <- renderPlot({ if(length(predictions()) < 2) { plot(0,0, axes = F, xlab = "", ylab= "", pch = NA) text(0,0,"Please select between 2 and 10 predictors to view their relationships!", cex = 1.7) } else if (nrow(dat_epigen()) <= 10 ) { plot(0,0, axes = F, xlab = "", ylab= "", pch = NA) text(0,0,"Sorry, the number of reference individuals must be above 10!", cex = 1.7) } else if(nrow(dat_epigen()) > 10 & nrow(dat()) >= 3) { cormatrix_gs <- cor(dat_epigen()[,predictions()]) cormatrix_input <- cor(dat()[,predictions()]) corrplot_gs <- ggcorrplot(cormatrix_gs,type="lower", legend.title = "Correlation", colors = rev(c("#6b81ff", "white", "#E46726")), lab = T) + ggplot2::ggtitle("Generation Scotland Dataset") + ggplot2::theme(plot.title = element_text(hjust =0.5, size = 16.5)) + ggplot2::theme(legend.position = "none") corrplot_input <- ggcorrplot(cormatrix_input,type="lower", colors = rev(c("#6b81ff", "white", "#E46726")), lab = T) + ggplot2::ggtitle("Input Dataset") + ggplot2::theme(plot.title = element_text(hjust =0.5, size = 16.5)) + ggplot2::theme(legend.position = "none") legend_corr <- (get_legend(ggcorrplot(cormatrix_gs,type="lower", legend.title = "Correlation", colors = rev(c("#6b81ff", "white", "#E46726")), lab = T) + ggplot2::ggtitle("Generation Scotland Dataset") + ggplot2::theme(plot.title = element_text(hjust =0.5)) + ggplot2::theme(legend.position = "right") + ggplot2::theme(legend.title.align = 0.5))) corr_together <- plot_grid(plot_grid(corrplot_input, corrplot_gs, ncol = 2),legend_corr, rel_widths = c(3, 0.4)) print(corr_together)} else { cormatrix_gs <- cor(dat_epigen()[,predictions()]) corrplot_gs <- ggcorrplot(cormatrix_gs,type="lower", legend.title = "Correlation",colors = rev(c("#6b81ff", "white", "#E46726")), lab = T) + ggplot2::ggtitle("Generation Scotland Dataset") + ggplot2::theme(plot.title = element_text(hjust =0.5, size = 16.5)) + ggplot2::theme(legend.position = "none") legend_corr <- (get_legend(ggcorrplot(cormatrix_gs,type="lower", legend.title = "Correlation",colors = rev(c("#6b81ff", "white", "#E46726")), lab = T) + ggplot2::ggtitle("Generation Scotland Dataset") + ggplot2::theme(plot.title = element_text(hjust =0.5)) + ggplot2::theme(legend.position = "right") + ggplot2::theme(legend.title.align = 0.5))) x <- matrix(nrow = 1, ncol = 2) x[1,1] <- 0 x[1,2] <- 0 x <- as.data.frame(x) p <- ggplot(x, aes(x[,1],x[,2])) p <- p + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(), panel.background = element_blank(), axis.line = element_line(colour = "white")) p <- p + theme(axis.title.x=element_blank(),axis.text.x=element_blank(),axis.ticks.x=element_blank()) + theme(axis.title.y=element_blank(),axis.text.y=element_blank(),axis.ticks.y=element_blank()) p <- p + annotate("text", label = "Sorry, the number of individuals in the input dataset \n must be at least 3 \n \n Correlation matrix cannot be calculated!", 0,0, cex = 5.4) plot_together <- plot_grid(plot_grid(p, corrplot_gs, ncol = 2),legend_corr, rel_widths = c(3, 0.4)) print(plot_together) } }) output$corrplot2 <- renderPlot({ if (nrow(dat_epigen()) <= 10 ) { plot(0,0, axes = F, xlab = "", ylab= "", pch = NA) text(0,0,"Sorry, the number of reference individuals must be above 10!", cex = 1.7) } else { ## Correlation between Predictors and Respective Traits in GS corr<-merge(tmp, out, by.x = "Basename", by.y="ID") corr = corr[which(corr$Basename %in% dat_epigen()$ID),] corrmatrix <- matrix(nrow = 6, ncol = 2) corrmatrix[1,2] <- cor(corr$Alcohol[corr$usual %in% 2], corr$units[corr$usual %in% 2], use = "complete.obs") corrmatrix[2,2] <- cor(corr$`Body Fat %`, corr$body_fat, use = "complete.obs") corrmatrix[3,2] <- cor(corr$`Body Mass Index`, corr$bmi, use = "complete.obs") corrmatrix[4,2] <- cor(corr$`HDL Cholesterol`, corr$HDL_cholesterol, use = "complete.obs") corrmatrix[5,2] <-cor(corr$Smoking, corr$pack_years, use = "complete.obs") corrmatrix[6,2] <-cor(corr$`Waist:Hip Ratio`, corr$whr, use = "complete.obs") corrmatrix[1,1] <- "Alcohol" corrmatrix[2,1] <- "Body Fat %" corrmatrix[3,1] <- "Body Mass Index" corrmatrix[4,1] <- "HDL Cholesterol" corrmatrix[5,1] <- "Smoking" corrmatrix[6,1] <- "Waist:Hip Ratio" corrmatrix <- as.data.frame(corrmatrix) names(corrmatrix) <- c("Trait", "r") corrmatrix$r <- as.numeric(as.character(corrmatrix$r)) row.names(corrmatrix) <- corrmatrix$Trait corrmatrix$Trait <- NULL corr_gs <- ggcorrplot(as.matrix(corrmatrix), lab = TRUE, hc.order = F) + ggplot2::theme(legend.position = "bottom" ,legend.key.width = unit(3, "cm")) + scale_fill_gradient2(breaks = c(0,0.2,0.4,0.6,0.8,1.0), limit=c(0, 1), low = "white", mid = "cyan",high = "blue") + scale_y_discrete(labels =expression(paste(italic("r"), " coefficient", sep = " "))) + ggtitle("Correlation between Traits and their Epigenetic Predictors in Generation Scotland") + theme(plot.title = element_text(hjust = 0.5)) print(corr_gs) } }) percentile <- list() thedata <- reactive({ withProgress(message = "Generating Percentiles vs. Generation Scotland for Download", value = 0, { for(i in 1:nrow(df1())){ incProgress(1/nrow(df1()), detail = paste((i/nrow(df1()))*100, "% complete")) Sys.sleep(0.005) binder = rbind(df1()[i,],epigen) reference2 = cbind(binder$ID, as.data.frame(apply(binder[,predictors], 2, function(x) percent_rank(x)*100))) reference3 = reference2[1,] percentile[[i]] <- reference3 } }) percentile_output <- do.call("rbind",percentile) names(percentile_output)[1] <- "ID" percentile_output <- merge(percentile_output, df1()[,c("ID","Age")], by = "ID") percentile_output <- cbind(percentile_output$ID,round(percentile_output[,2:ncol(percentile_output)], 2)) names(percentile_output)[1] <- "ID" return(percentile_output) }) thedata2 <- reactive({ n =nrow(df2()) withProgress(message = "Generating Input Percentiles for Download", value = 0, { for(i in 1:n){ incProgress(1/n, detail = paste((i/n)*100, "% complete")) Sys.sleep(0.005) } reference_data = cbind(df2()$ID, as.data.frame(apply(df2()[,predictors], 2, function(x) percent_rank(x)*100))) }) names(reference_data)[1] <- "ID" reference_data <- merge(reference_data, df2()[,c("ID","Age")], by = "ID") reference_data <- cbind(reference_data$ID,round(reference_data[,2:ncol(reference_data)], 2)) names(reference_data)[1] <- "ID" return(reference_data) }) output$dto <- renderDataTable({thedata()}) output$download <- downloadHandler( filename = function(){paste("Percentiles_against_GS_including_age", ".csv", sep= "")}, content = function(file){ fwrite(thedata(), file, row.names = F, dateTimeAs = "write.csv") } ) output$downloadinput <- renderUI({ if(!is.null(input$file1)) { downloadButton("download1", "Download Percentile Ranks for Individuals within Input Dataset") } }) output$downloadgs <- renderUI({ if(!is.null(input$file1)) { downloadButton("download", "Download Percentile Ranks for Individuals compared against Generation Scotland") } }) output$dto1 <- renderDataTable({thedata2()}) output$download1 <- downloadHandler( filename = function(){paste("Percentiles_Comparing_Input_including_age", ".csv", sep= "")}, content = function(file1){ fwrite(thedata2(), file1, row.names = F,dateTimeAs = "write.csv") } ) observeEvent(input$timeOut, { print(paste0("Session (", session$token, ") timed out at: ", Sys.time())) showModal(modalDialog( title = "Timeout", paste("Session Time Due To", input$timeOut, "Inactivity -", Sys.time()), footer = NULL )) session$close() stopApp() }) } shinyApp(ui=ui,server=server)