barcodelabel/labels.R

# * Author:    Bangyou Zheng ([email protected])
# * Author:    Bangyou Zheng ([email protected])
# * Created:   04:21 PM Monday, 28 April 2014
# * Copyright: AS IS
# *


#' Create labels with barcode
#'
#' @param designs A data.frame of design file, which has to include several columns
#' @param file A output pdf file
#' @param measure_date Date of measurement
#' @param site_idx Index of site
#' @param sample_num Number of sample in each plot
#' @param product Product ID of lables
#' @export
createBarcode <- function(
    designs,
    measure_date,
    site_idx,
    measure_traits,
    sample_num = 1,
    measure_traits_map = NULL) {
    # Convert into small case to avoid problems
    names(designs) <- tolower(names(designs))
    library(readr)
    library(dplyr)
    library(magrittr)
    names(measure_traits_map) <- tolower(names(measure_traits_map))
    measure_trait_idx <- measure_traits_map$measurementindex[
        match(measure_traits, measure_traits_map$name)]

    bc_plot <- designs %>%
        mutate(Barcode = paste0(
            format(measure_date, '%y%m%d'),
            site_idx,
            formatC(row, width = 2, flag = '0'),
            formatC(column, width = 2, flag = '0')
        ))

    bc <- expand.grid(
        Barcode = bc_plot$Barcode,
        measure_trait = measure_trait_idx,
        sample = seq(length = sample_num),
        stringsAsFactors = FALSE
    ) %>%
        left_join(bc_plot, by = 'Barcode') %>%
        left_join(measure_traits_map,
                  by = c('measure_trait' = 'measurementindex')) %>%
        mutate(
            Barcode = paste0(
                Barcode,
                formatC(measure_trait, width = 2, flag = '0'),
                sample)) %>%
        rename(MeasureTrait = name) %>%
        mutate(MeasureDate = measure_date,
               Researcher = researcher) %>%
        arrange(column, row)
    bc
}



#' Generate labels for avery products
#'
#' @param labels A character vector will be used to genearte labels
#' @param file the file name to export
#' @param product The product ID of Avery
#' @param researcher Name of researcher
#' @param researcher Name of researcher
#' @export
averyLabel <- function(
    labels, file,
    product = 'L7163')
{
    names(labels) <- tolower(names(labels))
    # Total number of labels
    num_label <- nrow(labels)
    # Check the labels
    if (num_label == 0)
    {
        stop('NO label specified')
    }
    # Read teh AveryDB
    averydb <- read.csv('data/dbavery.csv')

    # Check the product ID
    if (!(product %in% averydb$ID))
    {
        stop(paste0('Product ID ', product, ' don\'t support.'))
    }
    # Get the design
    a_design <- averydb[averydb$ID == product,]

    # Define the page size (A4)
    page_height <- 297
    page_width <- 210

    # Calculate label width and height
    a_design$LabelHeight <- (page_height - a_design$TopBorder -
        a_design$BottomBorder -
        a_design$MarginRow * (a_design$LabelRows - 1)) /
        a_design$LabelRows
    a_design$LabelWidth <- (page_width - a_design$LeftBorder -
        a_design$RightBorder -
        a_design$MarginCol * (a_design$LabelCols - 1)) /
        a_design$LabelCols

    # load the library
    library(grid)
    # page_border <- 0.25 * 25.4
    # Printed labels
    num_printed <- 1

    # Create all labels
    # Calculate total pages
    pages <- ceiling(num_label / (a_design$LabelRows * a_design$LabelCols))
    pdf(file, width = page_width / 25.4, height = page_height / 25.4)
    op <- par(mar = rep(0, 4))
    for (k in seq(length = pages))
    {
        grid.newpage()
        grid.rect()
        for (i in seq(length = a_design$LabelRows))
        {
            for (j in seq(length =  a_design$LabelCols))
            {
                # Check if all labels is printed
                if (num_printed > num_label)
                {
                    break
                    return(NULL)
                }

                # Calculate the viewport
                vp_x <- unit(
                    # Left border
                    a_design$LeftBorder +
                    # Page border
                    # page_border +
                    # Size for labels in the left
                    a_design$LabelWidth * (j - 1) +
                    # Middle of this label
                    a_design$LabelWidth / 2 +
                    # Margins between labels in the left
                    a_design$MarginCol * (j - 1),
                    'mm')
                vp_y <- unit(
                    # Print from the top
                    page_height - (
                    # Top border
                    a_design$TopBorder +
                    # Page border

                    # Size for labels in the top
                    a_design$LabelHeight * (i - 1) +
                    # Middle of this label
                    a_design$LabelHeight / 2 +
                    # Margins between labels in the top
                    a_design$MarginRow * (i - 1)),
                    'mm')

                # Create viewport
                vp <- viewport(vp_x, vp_y,
                    unit(a_design$LabelWidth, 'mm'),
                    unit(a_design$LabelHeight, 'mm'))

                pushViewport(vp)
                grid.rect()


                # keep a 3 mm border
                # canvas
                canvas_width <- a_design$LabelWidth - 6
                canvas_height <- a_design$LabelHeight - 6
                vp <- viewport(
                    0.5, 0.5,
                    unit(canvas_width, 'mm'),
                    unit(canvas_height, 'mm'))

                pushViewport(vp)
                
                #reate label
                do.call(eval(parse(text = paste0('label_', product))),
                        args = list(labels = labels, num_printed = num_printed,
						canvas_width = canvas_width, canvas_height = canvas_height))
                
                popViewport()
                popViewport()
                num_printed <- num_printed + 1
            }
        }
    }
    par(op)
    dev.off()
}

label_L7651 <- function(labels, num_printed, canvas_width, canvas_height) {
    bc_img <- zint_barcode(
        labels$barcode[num_printed],
        height = 100,
        border = 0,
        is_show_text = TRUE)
    vp_img <- viewport(
        x = unit(0.5, "npc"),
        y = unit(0.6, "npc"),
        width = unit(1, "npc"),
        height = unit(0.8, "npc")
    )
    pushViewport(vp_img)
    #grid.rect()
    grid.raster(bc_img[[1]], 
                width = unit(1, 'npc'),
                height = unit(1, 'npc'))
    popViewport()
    vp_txt <- viewport(
        x = unit(0.5, "npc"),
        y = unit(0.1, "npc"),
        width = unit(1, "npc"),
        height = unit(0.2, "npc")
    )
    pushViewport(vp_txt)
    grid.text(label = labels$label[num_printed],
              gp = gpar(cex = 0.3))
    popViewport()
}

label_L7163 <- function(labels, num_printed, canvas_width, canvas_height) {
    
    #grid.rect()
    # Barcode
    bc_img <- zint_barcode(
        labels$barcode[num_printed],
        height = 30,
        border = 0)
    vp_img <- viewport(
        unit(0.25 * canvas_width, 'mm'),
        unit(3 * 1 / 4 * canvas_height, 'mm'),
        unit(1 / 2 * canvas_width, 'mm'),
        unit(1 / 2 * canvas_height, 'mm'))
    pushViewport(vp_img)
    #grid.rect()
    grid.raster(bc_img[[1]])
    popViewport()
    
    # column
    vp_row <- viewport(
        unit(0.5 / 8 * canvas_width, 'mm'),
        unit((1 / 4) * canvas_height, 'mm'),
        unit(0.5 / 4 * canvas_width, 'mm'),
        unit(0.5 / 4 * canvas_width, 'mm'))
    pushViewport(vp_row)
    grid.rect()
    grid.text(paste0('Col\n', labels$column[num_printed]))
    popViewport()
    
    
    
    # row
    vp_col <- viewport(
        unit(3 * 0.5 / 8 * canvas_width, 'mm'),
        unit((1 / 4) * canvas_height, 'mm'),
        unit(0.5 / 4 * canvas_width, 'mm'),
        unit(0.5 / 4 * canvas_width, 'mm'))
    pushViewport(vp_col)
    grid.rect()
    grid.text(paste0('Row\n', labels$row[num_printed]))
    popViewport()
    
    
    
    # replicate
    vp_rep <- viewport(
        unit(5 * 0.5 / 8 * canvas_width, 'mm'),
        unit((1 / 4) * canvas_height, 'mm'),
        unit(0.5 / 4 * canvas_width, 'mm'),
        unit(0.5 / 4 * canvas_width, 'mm'))
    pushViewport(vp_rep)
    grid.rect()
    grid.text(paste0('Rep\n', labels$replicate[num_printed]))
    popViewport()
    
    # Sample
    vp_sam <- viewport(
        unit(7 * 0.5 / 8 * canvas_width, 'mm'),
        unit((1 / 4) * canvas_height, 'mm'),
        unit(0.5 / 4 * canvas_width, 'mm'),
        unit(0.5 / 4 * canvas_width, 'mm'))
    pushViewport(vp_sam)
    grid.rect()
    grid.text(paste0('Sam\n', labels$sample[num_printed]))
    popViewport()
    
    # Traits
    vp_traits <- viewport(
        unit(0.75 * canvas_width, 'mm'),
        10 / 12,
        0.5,
        2 / 6)
    pushViewport(vp_traits)
    #grid.rect()
    grid.text(labels$measuretrait[num_printed],
              gp = gpar(cex = 1.1))
    popViewport()
    
    # TrialCode
    vp_trialcode <- viewport(
        unit(0.75 * canvas_width, 'mm'),
        7 / 12,
        0.5,
        1 / 6)
    pushViewport(vp_trialcode)
    #grid.rect()
    grid.text(labels$trial[num_printed])
    popViewport()
    
    
    # Genotype
    vp_genotype <- viewport(
        unit(0.75 * canvas_width, 'mm'),
        5 / 12,
        0.5,
        1 / 6)
    pushViewport(vp_genotype)
    #grid.rect()
    grid.text(labels$genotype[num_printed])
    popViewport()
    
    # Site
    vp_site <- viewport(
        unit(0.75 * canvas_width, 'mm'),
        3 / 12,
        0.5,
        1 / 6)
    pushViewport(vp_site)
    #grid.rect()
    grid.text(labels$site[num_printed])
    popViewport()
    
    # Researcher and date
    vp_res_date <- viewport(
        unit(0.75 * canvas_width, 'mm'),
        1 / 12,
        0.5,
        1 / 6)
    pushViewport(vp_res_date)
    #grid.rect()
    grid.text(paste0(
        'by ',
        labels$researcher[num_printed],
        ' on ',
        labels$measuredate[num_printed]),
        x = 0.9,
        gp = gpar(cex = 0.5),
        hjust = 1)
    popViewport()
}