app.R

library(shiny)
library(imager)
library(colocr)

# Define UI for application that draws a histogram
ui <- navbarPage(
  title = 'colocr',
  tabPanel(
    'Main',
    sidebarLayout(
      sidebarPanel(
        tags$h3('Input Panel'),
        tags$p('Get started by uploading the merge image. Then adjust the
                                      parameters to fit the regions of interest. Finally, assign a
                                      name to probe used in this image to be used in the output'),
        tags$hr(),
        fileInput('image1', 'Merge Image'),
        tags$hr(),
        sliderInput('threshold', 'Threshold', 1, 100, 50, 1),
        sliderInput('shrink', 'Shrink', 1, 10, 5, 1),
        sliderInput('grow', 'Grow', 1, 10, 5, 1),
        sliderInput('fill', 'Fill', 1, 10, 5, 1),
        sliderInput('clean', 'Clean', 1, 10, 5, 1),
        sliderInput('tolerance', 'Tolerance', 0, .99, .1, .1),
        numericInput('roi_num', 'ROI Num', 1, 1, 50, 1),
        tags$hr(),
        textInput('name', 'Probe Name')
      ),
      mainPanel(
        fluidRow(
          tags$h2('What are the different tabs for?'),
          tags$br(),
          tags$p('Each of the below tabs provide a view of your image, data
                                       and analysis output. The different tabs are connected and are
                                       updated automatically whenever the input panel is used.'),
          tags$li('Select ROI: Choose regions of interst by adjusting the input
                                        parameters.'),
          tags$li('Pixel Intensities: Check the scatter and density distribution
                                         of the pixel intensities from the two channels.'),
          tags$li('Tabular Output: View the different colocalization
                                        co-efficients in tabular format.'),
          tags$li('Graph View: View the co-localization co-efficients in graphical
                                        format.'),
          tags$br(),
          tags$br(),
          tabsetPanel(
            tabPanel('Select ROI',
                     plotOutput("image_plot"),
                     textOutput('cor')
            ),
            tabPanel('Pixel Intensities', plotOutput('scatter')),
            tabPanel('Tabular View',
                     tags$br(),
                     tags$h3('Co-localization stats table.'),
                     actionButton('add', 'Add'),
                     actionButton('remove', 'Remove'),
                     tableOutput('tab'),
                     tags$br(),
                     tags$h3('Input parameters'),
                     actionButton('add2', 'Add'),
                     actionButton('remove2', 'Remove'),
                     tableOutput('tab2')
            ),
            tabPanel('Graph View', plotOutput('res_plot'))
          )
        )
      )
    )),
  tabPanel('GitHub',
           "Comments, issues and contributions are welcomed.",
           tags$a(href='https://github.com/MahShaaban/colocr_app',
                  'https://github.com/MahShaaban/colocr_app')),
  tabPanel('About',
           includeMarkdown('README.md')),
  tabPanel('Contact us',
           tags$p('Department of Biochemistry and Convergence Medical Sciences
                                 Institute of Health Sciences,'),
           tags$p('Gyeonsange National University School of Medicine'),
           tags$p('861 Beongil 15 jinju-daero, jinju, Gyeongnam 660-751,'),
           tags$p('Republic of Korea'),
           tags$p('Mob:+82-10-4045-1767')))


# Define server
server <- function(input, output) {
  # intiate interactive values
  # values <- reactiveValues(img1 = '', labs.px = 0,
  #                          px = 0, corr = list(4))
  values <- reactiveValues()
  # load images
  img1 <- reactive({
    load.image(input$image1$datapath)
  })

  # calculate the pixset
  px <- reactive({
    roi_select(img1(),
               threshold = input$threshold,
               shrink = input$shrink,
               grow = input$grow,
               fill = input$fill,
               clean = input$clean)
  })

  # calculate labels
  labs.px <- reactive({
    roi_select(img1(),
               threshold = input$threshold,
               shrink = input$shrink,
               grow = input$grow,
               fill = input$fill,
               clean = input$clean,
               tolerance = input$tolerance,
               n = input$roi_num)
  })

  # get pixel intensities
  pix_int <- reactive({
    intensity_get(img1(),
                  px = labs.px())
  })
  # calculate correlations
  corr <- reactive({
    coloc_test(pix_int(),
               type = 'all')
  })

  # choose ROI view
  ## plot images
  output$image_plot <- renderPlot({
    req(input$image1)
    par(mfrow=c(2,2), mar = rep(1, 4))
    roi_show(img = img1(),
             px = px(),
             labels = labs.px())
  })

  ## text output of the calculated correlations
  output$cor <- renderText({
    req(input$image1)
    paste("Average Pearson's Correlation Coefficient:", round(mean(corr()$p, na.rm = TRUE), 2),
          ' and ',
          "Average Manders Overlap Coefficient: ", round(mean(corr()$r, na.rm = TRUE), 2))
  })

  # quality control view
  output$scatter <- renderPlot({
    req(input$image1)
    par(mfrow=c(1,2), mar = c(4,4,1,1))
    intensity_show(pix_int())
  })

  # tabular view
  ## co-localization stats table

  ## who really knows why this should be generated differently?!
  values$df = data.frame()


  ## add button
  observeEvent((input$add), {
    newLine <- data.frame(name = input$name,
                          image = input$image1$name,
                          roi = as.integer(unique(pix_int()$labels)),
                          pearson = corr()$p,
                          manders = corr()$r)
    values$df <- rbind(values$df, newLine)
  })

  ## remove button
  observeEvent((input$remove), {
    n <- nrow(values$df)
    values$df <- values$df[-n, ]
  })

  ## table
  output$tab <- renderTable({values$df})

  # input parameters table
  values$df2 = data.frame()
  ## add button
  observeEvent((input$add2), {
    newLine <- data.frame(name = input$name,
                          image = input$image1$name,
                          threshold = input$threshold,
                          shrink = input$shrink,
                          grow = input$grow,
                          fill = input$fill,
                          clean = input$clean,
                          tolerance = input$tolerance,
                          roi_num = input$roi_num)
    values$df2 <- rbind(values$df2, newLine)
  })

  ## remove button
  observeEvent((input$remove2), {
    n <- nrow(values$df2)
    values$df2 <- values$df2[-n, ]
  })

  ## table
  output$tab2 <- renderTable({values$df2})

  # import in r button
  #  observeEvent((input$return), {
  #    stopApp(values$df)
  #  })

  ## download button
  #  output$download <- downloadHandler(
  #    filename = function() {
  #      paste0(sample(letters, 10), '.csv')
  #    },
  #    content = function(con) {
  #      write.csv(values$df, con)
  #    }
  #  )

  ## graph view
  output$res_plot <- renderPlot({
    if (nrow(values$df) == 0) return(NULL)
    par(mfrow = c(1, 2))
    x <- as.numeric(values$df$name)
    plot(x, values$df$pearson,
         type = 'n', xaxt = 'n',
         xlab = '', ylab = 'PCC',
         ylim = c(0,1))
    points(x, y = values$df$pearson, pch = 16)
    axis(1, unique(x), labels = unique(values$df$name))

    plot(x, values$df$manders,
         type = 'n', xaxt = 'n',
         xlab = '', ylab = 'MOC',
         ylim = c(0,1))
    points(x, y = values$df$manders, pch = 16)
    axis(1, unique(x), labels = unique(values$df$name))
  })
}

# Run the application
shinyApp(ui = ui, server = server)