barcodelabel/app.R

# * Author:    Bangyou Zheng ([email protected])
# * Created:   01:16 PM Wednesday, 17 June 2015
# * Copyright: AS IS

library(shiny)
library(dplyr)
library(magrittr)
library(ggplot2)
library(readxl)

source('barcode.R')
source('labels.R')



designs <- read_excel('design.xlsx', 'Design') 
names(designs) <- tolower(names(designs))
traits <- read_excel('design.xlsx', 'Traits')
names(traits) <- tolower(names(traits))


trials_name <- unique(designs$trial)
genotypes <- unique(designs$genotype)

measurements <- traits$measurement %>% unique
researchers <- read_excel('design.xlsx', 'Researchers') %>% use_series('name')

traits_sel <- traits %>%
    filter(measurement %in% measurements[1]) %>%
    use_series(name)

# Create the basic plot
pd_grid <- expand.grid(
    row = seq(min(designs$row), max(designs$row)),
    column = seq(min(designs$column), max(designs$column))) %>%
    mutate(row = as.factor(row),
           column = as.factor(column))

p_grid <- ggplot(pd_grid) +
    geom_tile(aes(row, column),
              colour = 'gray',
              alpha = 0) +
#     geom_tile(aes(row, column),
#               colour = 'gray',
#               alpha = 0.3, data = pd_fill) +
    guides(fill = FALSE,
           colour = FALSE) +
    theme_bw() +
    xlab('Row') + ylab('Column') +
    theme(panel.grid = element_blank(),
          legend.position = 'bottom')
# Product id of avery
avery_product <- c('L7163', 'L7651')


ui <- pageWithSidebar(
    # Application title
    headerPanel('Labels with barcode'),

    # Sidebar with a slider input for number of observations
    sidebarPanel(
        # wellPanel(
        # submitButton('Update View')),
        wellPanel(
            selectInput('measurement', 'Select a measurement',
                    measurements),
            selectInput('trial', 'Select trials:', trials_name,
                        selected = trials_name[1],
                        multiple = TRUE),
            radioButtons('double_plot', 'Filter double plot',
                         c('min', 'max', 'all'), 'min', inline = TRUE),
            selectInput('genotype', 'Select genotypes:', genotypes,
                        selected = genotypes,
                        multiple = TRUE),
            selectInput('trait', 'Select a traits:', traits_sel,
                        selected = traits_sel,
                        multiple = TRUE),

            # measurement date
            dateInput('measure_date', 'Measurement date',
                      format = 'dd/mm/yyyy'),
            # Names of researchers
            textInput('researcher', 'Type in researcher', researchers),
            # Product of avery
            selectInput('product', 'Select a product of Avery', avery_product),
            # File name without extensions
            textInput('filename', 'Type in filename without extension',
                      'measurement'),
            # Download label
            downloadButton('download_excel', 'Download excel file'),
            # Download label
            downloadButton('download_label', 'Download labels')
        ),

        wellPanel(
            helpText(p('Bangyou Zheng'))
        )
    ),
    mainPanel(

            plotOutput('labels_plot', height = '1000px')
    )
)



server <- function(input, output, session)
{
    # Render the table for design
    # Change genotype by measurement and trials
    observe({
#         mearsure <- input$measurement
#         trial_sel <- input$trial
#         genotypes <- designs %>%
#             filter(trial %in% trial_sel) %>%
#             select(genotype) %>%
#             distinct() %>%
#             use_series(genotype)
#
#         if (mearsure == 'qh_key')
#         {
#             g <- c('7770', '7770tin', 'Hartog', 'HartogNoVigour')
#             g <- g[g %in% genotypes]
#         } else {
#             g <- genotypes
#         }
#
#         updateSelectInput(session, 'genotype',
#                           selected = g)
    })

    # Change traits by measurement
    observe({
#         traits <- traits_qh
#         if (input$measurement == 'head_dev') {
#             traits <- traits_head_dev
#         }
#         updateSelectInput(session, 'trait',
#                           choices = traits,
#                           selected = traits)
    })

    # Filter by trial
    r_trials <- reactive({
        i_trial <- input$trial
        
        designs %>%
            filter(trial %in% i_trial)
    })

    # Filter by double plot
    r_doubleplot <- reactive({
       
        doubleplot <- r_trials()
        
        # save(list = ls(), file = 'tmp.Rdata')
        # stop('AAAAAAAAAAAAAAA')
        # load('tmp.Rdata')
        # 
        
        if (input$double_plot == 'min') {
            doubleplot <- doubleplot %>%
                group_by(year, site, trial,
                         genotype, treatment, replicate) %>%
                filter(row == min(row),
                       column == min(column)) %>%
                ungroup()
        } else if (input$double_plot == 'max') {
            doubleplot <- doubleplot %>%
                group_by(year, site, trial,
                         genotype, treatment, replicate) %>%
                filter(row == max(row),
                       column == max(column)) %>%
                ungroup()
        }
        doubleplot
    })

    # Filter by genotypes
    r_genotypes <- reactive({
        # r_trials() %>%
        r_doubleplot() %>%
            filter(genotype %in% input$genotype)
    })



    # Filter by measurement
    r_measurement <- reactive({
        measurement <- r_genotypes()
        if (grepl('^qh.*', input$measurement)) {
            measurement <- measurement %>%
                group_by(year, site, trial,
                         replicate, management,
                         density, genotype) %>%
                filter(row == min(row),
                       column == min(column))
        } else if ('head_dev' == input$measurement) {
            measurement <- measurement %>%
                group_by(year, site, trial,
                         replicate, management,
                         density, genotype) %>%
                filter(row == max(row),
                       column == max(column))
        }
        measurement %>%
            arrange(column, row)


    })

    # Get the sie index
    r_siteidx <- reactive({
        return(2)
    })
    # Generate Barcode
    r_barcode <- reactive({
        designs <- r_measurement()
        measure_date = input$measure_date
        site_idx = r_siteidx()
        measure_traits = input$trait
        sample_num = 1
#         measure_traits_map = traits
#         save(list = ls(), file = 'tmp.Rdata')
#         stop()
#         load('Shiny/tmp.Rdata')
        bc <- createBarcode(
            designs = r_measurement(),
            measure_date = input$measure_date,
            site_idx = r_siteidx(),
            measure_traits = input$trait,
            sample_num = 1,
            measure_traits_map = traits
        )
        bc
    })

    # Show a table of plots for measurements
    output$labels_design = renderDataTable({

        labels_df <- r_measurement()
        labels_df %>%
            select(year, site, trial, row, column,
                   replicate,
                   management, density, genotype)
    })

    # plot the selected plots
    output$labels_plot <- renderPlot({
        library(ggplot2)
        
        labels_df <- r_measurement()


        labels_df <- labels_df %>%
            ungroup() %>%
            mutate(
                row = as.factor(row),
                column = as.factor(column),
                treatment = as.factor(treatment))
        p_grid +
            geom_tile(aes(row, column,
                          fill = treatment),
                      data = labels_df) +
            geom_text(aes(row, column, label = treatment),
                      data = labels_df)


    })
    # Download excel file
    output$download_excel <- downloadHandler(
        filename = function() {
            paste0(input$filename,'.xlsx')
        },
        content = function(file) {
            bc <- r_barcode() %>%
                mutate(Value = '') %>%
                select(
                    Year = year,
                    Site = site,
                    TrialCode = trial,
                    Row = row,
                    Column = column,
                    Replicate = replicate,
                    Density = density,
                    Genotype = genotype,
                    MeasureTrait,
                    MeasureDate,
                    Barcode,
                    Value
                    )

            library(XLConnect)

            newWB <- loadWorkbook(filename = file, create = TRUE)
            createSheet(newWB, name = 'Measurement')
            writeWorksheet(
                newWB,
                data = as.data.frame(bc),
                sheet = 'Measurement',
                header = TRUE,
                rownames = NULL)
            saveWorkbook(newWB)
        }
    )
    # Download labels
    output$download_label <- downloadHandler(
        filename = function() {
            paste0(input$filename,'.pdf')
            },
        content = function(file) {
            bc <- r_barcode()
            measure_traits <- input$trait
            researcher <- input$researcher
            product <- input$product
            bc$researcher <- researcher

            designs <- r_measurement()
#                     save(list = ls(), file = 'tmp.RData')
#                     stop('A')
#                     load('Shiny/tmp.RData')

            averyLabel(
                bc, file,
                product = product)
        }
    )

}

shinyApp(ui = ui, server = server)