Elispots-app/app.R

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)