library(shiny) library(openxlsx) library(readxl) library(ggplot2) library(reshape2) library(dplyr) library(ggbeeswarm) library(magrittr) library(flextable) source("funcions.R") ui <- fluidPage( #Navbar navbarPage("ELISPOTS", tabPanel("Diseño", sidebarPanel( fileInput(inputId = "file1", label = "Dades", multiple = F), selectInput(inputId = "test", "Test Estadístic", selected = "Ttest", choices = c("T-test (adj Holm)","Wilcoxon (adj Holm)")), sliderInput(inputId = "umbral_pos", "Mínimo para positivo:", min = 0, max=100, step = 5, value = 10), checkboxInput(inputId = "positive", label = "Mostrar positivitat", value = F), checkboxInput(inputId = "showstats", label = "Mostrar estadística", value = F), downloadButton("downloadData", "Descarregar Informe") ), mainPanel( plotOutput("distPlot"), uiOutput("flexstats") ) ), tabPanel("Exportar", sidebarPanel(width=2, sliderInput("width", "Ancho", min=1000, max=20000, step=1000, value=10000), sliderInput("height", "Altura", min=1000, max=20000, step=1000, value=6000), textInput("colors", label="Colors", value=""), sliderInput("boxplot-width", "% Ancho Boxplots", min=0.1, max=1, step=0.1, value=0.7), sliderInput("point-size", "Tamaño puntos", min=1, max=10, step=1, value=3), sliderInput("font-size", "Tamaño textos", min=5, max=30, step=1, value=11), checkboxInput(inputId = "stats2", label = "Mostrar estadística", value = F), checkboxInput(inputId = "legend", label = "Mostrar llegenda", value = T), selectInput("theme", "Seleccionar Tema", selected="BW", choices=c("BW", "Default", "Classic")), downloadButton("downloadPicture", "Exportar") ), mainPanel( uiOutput("expPlotUI") ) ) ) ) # Define server logic required to draw a histogram server <- function(input, output) { dades<-reactiveValues() dades$taula<-NULL dades$stats<-NULL dades$final<-NULL dades$maps<-NULL dades$plot<-NULL observe({ if (!is.null(input$file1)){ dades$taula<-read_xlsx(input$file1$datapath) } }) output$distPlot <- renderPlot({ observeEvent(dades$taula, {}) if (!is.null(dades$taula)){ ctrl<-"Ctrl+" mock<-"Mock" table<-dades$taula[,colnames(dades$taula) != "Groups"] t_mean<-dcast(melt(table, id="Mice"),Mice~variable, mean, na.rm=T) if (length(grep("Mock", colnames(t_mean))) == 1){ t_substr<-data.frame("Mice"=t_mean[,1], as.data.frame(t(apply(t_mean[,2:ncol(table)], 1, function(x) x-x[mock]))) ) t_mean_group<-merge(t_mean, unique(dades$taula[c("Mice","Groups")]), id="Mice") t_mean_group$Groups<-as.factor(t_mean_group$Groups) mock_mean<-dcast(t_mean_group, Groups~., value.var=mock, mean) mock_mean[,2]<-mock_mean[,2]*2 mock_mean[mock_mean$. < input$umbral_pos,2]<-input$umbral_pos t_substr<-merge(t_substr, unique(dades$taula[c("Mice","Groups")]), id="Mice") t_substr<-t_substr[,c(1, ncol(t_substr), 2:(ncol(t_substr)-1))] t_substr<-t_substr[,c("Mice", "Groups", colnames(t_substr)[!colnames(t_substr) %in% c("Mice", "Groups")])] t_substr[,3:ncol(t_substr)]<-apply(t_substr[,3:ncol(t_substr)],2, function(x) replace(x, which(x < 0),0)) colnames(t_substr)<-c("Mice", "Groups", colnames(t_mean)[2:ncol(t_mean)]) }else{ t_especifica<-t_mean[,grep("Mock_", colnames(t_mean), invert=T)] t_mock<-t_mean[,c(which(colnames(t_mean) == "Mice"),grep("Mock_", colnames(t_mean)))] t_temp<-melt(t_especifica, variable.name = "condition", value.name = "spots") t_temp["spots_mock"]<-melt(t_mock, variable.name = "condition")[,"value"] t_substr<-data.frame(t_temp[c("Mice","condition")], "spots"=t_temp["spots"]-t_temp["spots_mock"]) t_substr<-dcast(t_substr, Mice~condition) t_substr<-merge(t_substr, unique(dades$taula[c("Mice","Groups")]), id="Mice") t_substr$Groups<-as.factor(t_substr$Groups) } t_substr_gp<-t_substr t_substr_gp[3:ncol(t_substr)]<-apply(t_substr[3:ncol(t_substr)], 2, function(x) gsub(".",",",x, fixed=T)) t_substr_gp<-t_substr_gp[order(factor(t_substr_gp$Mice, levels = unique(table$Mice))),] doc<-t(t_substr_gp) write.xlsx(doc, "data4graphpad.xlsx",rowNames=T) t<-melt(t_substr[,!colnames(t_substr) %in% c(ctrl, mock)]) if (input$showstats == F){ t_stats<-as.data.frame(matrix(nrow=0, ncol=6)) colnames(t_stats)<-c("variable", "group1", "group2", "p.adj", "p.signif", "Method") t_maps<-list() t_maps[["label"]]<-as.data.frame(matrix(nrow = 0, ncol=2)) colnames(t_maps$label)<-c("x", "y") t_maps[["brackets"]]<-as.data.frame(matrix(nrow = 0, ncol=4)) colnames(t_maps$brackets)<-c("y1", "y2", "x1", "x2") dades$stats<<-t_stats dades$maps<<-t_maps }else{ if (input$test == "T-test (adj Holm)"){ t_stats<-multi_stats(t, "value", "variable", "Groups", stat.test = "ttest") } if (input$test == "Wilcoxon (adj Holm)"){ t_stats<-multi_stats(t, "value", "variable", "Groups", stat.test = "wilcox") } dades$stats<<-t_stats t_stats<-t_stats %>% filter(p.signif != "ns") t_maps<-generate_labstats(t_stats, t, "value", "variable", "Groups") dades$maps<<-t_maps } if (length(unique(dades$taula[,"Groups"])) < 2){ dades$stats<<-1 } c(ctrl, mock)[c(ctrl, mock) %in% colnames(t_substr)] dades$final<<-t_substr %>% select(-c(ctrl, mock)[c(ctrl, mock) %in% colnames(t_substr)]) set.seed(123) if (input$positive == T){ ids=c("Mice", "Groups", c(ctrl, mock)[c(ctrl, mock) %in% colnames(t_substr)]) validate( need(exists("mock_mean"), "No se puede elegir positividad con múltiples mocks") ) if (exists("mock_mean")){ ggplot(melt(t_substr, id=ids), aes(variable, value))+ labs(x="", y="Spots/2.5*10^5 cells")+ # geom_errorbar(stat="summary", position=position_dodge(width=0.9), width=0.5, aes(fill=Groups))+ geom_hline(data=mock_mean, aes(color=Groups, yintercept = `.`))+ # geom_bar(stat="summary", position="dodge", color="black", aes(fill=Groups))+ geom_boxplot(color="black", aes(fill=Groups), alpha=0.4, outlier.alpha = 0)+ geom_jitter(position=position_jitterdodge(jitter.width = 0.2), shape=21, aes(fill=Groups), size=3)+ # geom_quasirandom(position = position_quasirandom(), shape=21)+ scale_x_discrete(limits=colnames(t_substr)[!colnames(t_substr) %in% c("Mice", "Groups", ctrl, mock)])+ geom_segment(data=t_maps$brackets, aes(x=x1, xend=x2, y=y1, yend=y2), color="black")+ geom_text(data=t_stats, aes(t_maps$label$x, t_maps$label$y, label=p.signif), color="black")+ theme_bw()+ theme(axis.text.x=element_text(angle=45, hjust=1)) } }else{ ids=c("Mice", "Groups", c(ctrl, mock)[c(ctrl, mock) %in% colnames(t_substr)]) ggplot(melt(t_substr, id=ids), aes(variable, value))+ labs(x="", y="Spots/2.5*10^5 cells")+ # geom_errorbar(stat="summary", position=position_dodge(width=0.9), width=0.5, aes(fill=Groups))+ # geom_bar(stat="summary", position="dodge", color="black", aes(fill=Groups))+ geom_boxplot(color="black", aes(fill=Groups), alpha=0.4, outlier.alpha = 0)+ geom_jitter(position=position_jitterdodge(jitter.width = 0.2), shape=21, aes(fill=Groups), size=3)+ # geom_quasirandom(width=0.2, position=position_dodge(), shape=21)+ scale_x_discrete(limits=colnames(t_substr)[!colnames(t_substr) %in% c("Mice", "Groups", ctrl, mock)])+ geom_segment(data=t_maps$brackets, aes(x=x1, xend=x2, y=y1, yend=y2), color="black")+ geom_text(data=t_stats, aes(t_maps$label$x, t_maps$label$y, label=p.signif), color="black")+ theme_bw()+ theme(axis.text.x=element_text(angle=45, hjust=1)) } } }) output$flexstats <- renderUI({ observeEvent(dades$stats, {}) t_stats<-dades$stats if (!is.null(dades$stats)){ if (t_stats == 1){ validate( need(t_stats == 1, "Con un sólo grupo no se puede hacer estadística") ) }else{ return( t_stats %>% flextable() %>% theme_vanilla() %>% fontsize(size=14, part="all") %>% padding(padding=10, part="all") %>% color(~ p.adj < 0.05, color = "red")%>% autofit() ) %>% htmltools_value() } } }) output$expPlotUI<- renderUI({ if (!is.null(dades$final)){ plotOutput("expPlot", width=paste0(input$width/10,"px"), height = paste0(input$height/10, "px")) } }) output$expPlot <- renderPlot({ observeEvent(dades$final, {}) if (!is.null(dades$final)){ t_substr<-dades$final t_stats<-dades$stats %>% filter(p.signif != "ns") t_maps<-dades$maps ids<-c("Mice", "Groups") set.seed(123) g<-ggplot(melt(t_substr, id=ids), aes(variable, value))+ labs(x="", y="Spots/2.5*10^5 cells")+ geom_boxplot(color="black", aes(fill=Groups), alpha=0.4, outlier.alpha = 0, position=position_dodge(width=0.8),width=input$`boxplot-width`)+ geom_jitter(position=position_jitterdodge(jitter.width = 0.2), shape=21, aes(fill=Groups), size=input$`point-size`)+ scale_x_discrete(limits=colnames(t_substr)[!colnames(t_substr) %in% c("Mice", "Groups")]) if (input$theme == "BW"){ g<-g+theme_bw(base_size = input$`font-size`) } if (input$theme == "Classic"){ g<-g+theme_classic(base_size = input$`font-size`) } if (input$theme == "Default"){ g<-g+theme_gray(base_size = input$`font-size`) } g<-g+theme(axis.text.x=element_text(angle=45, hjust=1)) if (input$stats2 == T){ g<-g+geom_segment(data=t_maps$brackets, aes(x=x1, xend=x2, y=y1, yend=y2), color="black")+ geom_text(data=t_stats, aes(t_maps$label$x, t_maps$label$y, label=p.signif), color="black") } if (input$legend == F){ g<-g+guides(color=FALSE, fill=FALSE) } if (input$colors != ""){ v_col<-strsplit(input$colors, ",")[[1]] g<-g+scale_color_manual(values=v_col)+ scale_fill_manual(values=v_col) } dades$plot<<-g g } }, res=72) output$downloadData <- downloadHandler( filename = function() { paste("elispot", ".zip", sep="") }, content = function(file){ print(file) # tempReport <- file.path(tempdir(), "elispots.Rmd") # file.copy("elispots.Rmd", tempReport, overwrite = TRUE) params=list(file=input$file1$datapath, positive=input$positive, showstats=input$showstats, test=input$test, umbral_pos=input$umbral_pos) rmarkdown::render("elispots.Rmd", output_file="Results_elispot.html", params=params, envir = new.env(parent = globalenv())) zip(file, c("Results_elispot.html","data4graphpad.xlsx") ) }, contentType="application/zip" ) output$downloadPicture <- downloadHandler( filename = function() { paste("Figura", ".png", sep="") }, content = function(file){ print(file) # tempReport <- file.path(tempdir(), "elispots.Rmd") # file.copy("elispots.Rmd", tempReport, overwrite = TRUE) png(file, width = input$width, height=input$height, units = "px", res=720) plot(dades$plot) dev.off() } ) } # Run the application shinyApp(ui = ui, server = server)