R/datexp_match.R

In NicolasJBM/datexp: Interface to facilitate data exploration

#' Interface to select and then join two files based on an approximate (rather than perfect) matching of two columns.
#' @return A tibble resulting for the matching of two files.
#' @importFrom miniUI miniPage
#' @importFrom miniUI gadgetTitleBar
#' @importFrom miniUI miniTabstripPanel
#' @importFrom miniUI miniTabPanel
#' @importFrom miniUI miniContentPanel
#' @importFrom shiny fillCol
#' @importFrom shiny fillRow
#' @importFrom shiny icon
#' @importFrom shiny fileInput
#' @importFrom shiny textInput
#' @importFrom shiny dateInput
#' @importFrom shiny numericInput
#' @importFrom shiny textAreaInput
#' @importFrom shiny selectInput
#' @importFrom shiny checkboxInput
#' @importFrom shiny downloadButton
#' @importFrom shiny downloadHandler
#' @importFrom shiny stopApp
#' @importFrom shiny runGadget
#' @importFrom shiny callModule
#' @importFrom shiny conditionalPanel
#' @importFrom shiny tags
#' @importFrom shiny dataTableOutput
#' @importFrom shiny htmlOutput
#' @importFrom shiny uiOutput
#' @importFrom shiny plotOutput
#' @importFrom shiny actionButton
#' @importFrom shiny renderDataTable
#' @importFrom shiny renderUI
#' @importFrom shiny renderPlot
#' @importFrom shiny renderText
#' @importFrom shiny reactive
#' @importFrom shiny reactiveValues
#' @importFrom shiny observe
#' @importFrom shiny observeEvent
#' @importFrom shiny withProgress
#' @importFrom shiny incProgress
#' @importFrom shiny h3
#' @importFrom shiny isolate
#' @importFrom shiny reactiveValuesToList
#' @importFrom shiny tableOutput
#' @importFrom shiny renderTable
#' @importFrom shiny HTML
#' @importFrom dplyr select
#' @importFrom dplyr filter
#' @importFrom dplyr group_by
#' @importFrom dplyr summarize_all
#' @importFrom dplyr mutate
#' @importFrom dplyr %>%
#' @importFrom dplyr case_when
#' @importFrom dplyr arrange
#' @importFrom dplyr bind_rows
#' @importFrom dplyr everything
#' @importFrom purrr map
#' @importFrom utils write.csv
#' @export

datexp_match <- function() {
  
  # Increase the size of the memory allocated to the documents
  options(shiny.maxRequestSize = 500 * 1024 ^ 2)
  
  # Interface
  ui <- miniPage(
    gadgetTitleBar("Merge two files (approximative matching)"),
    
    miniTabstripPanel(
      miniTabPanel(
        "Upload",
        icon = icon("upload"),
        miniContentPanel(
          fillCol(
            flex = c(8,1,1,1,1),
            fillRow(
              flex = c(1, 1),
              fillCol(
                flex = c(1, 6, 1, 2),
                h3("First set of files"),
                importFilesInput("files_x", "Select files to import"),
                actionButton("import_x", "Import"),
                uiOutput("in_match_x")
              ),
              fillCol(
                flex = c(1, 6, 1, 2),
                h3("Second set of files"),
                importFilesInput("files_y", "Select files to import"),
                actionButton("import_y", "Import"),
                uiOutput("in_match_y")
              )
            ),
            tags$hr(),
            uiOutput("in_groups"),
            numericInput("maxdist", "Maximum number of differences", value = 100)
          )
        )
      ),
      
      miniTabPanel(
        "Download",
        icon = icon("download"),
        miniContentPanel(
          downloadButton("downloadData", "Download"),
          tags$hr(),
          tableOutput("matched")
        )
      )
    )
  )

  server <- function(input, output, session) {
    options(shiny.maxRequestSize = 50 * 1024 ^ 2)

    ################
    # Import data
    x <- callModule(
      importFiles, "files_x",
      stringsAsFactors = FALSE
    )

    y <- callModule(
      importFiles, "files_y",
      stringsAsFactors = FALSE
    )

    ################
    # Specify the matching variables

    output$in_match_x <- renderUI({
      if (input$import_x == 0) {
        return()
      }
      isolate({
        variables <- names(x())
        ui <- selectInput(
          "match_x",
          "Variable used for the matching",
          choices = variables,
          selected = variables[1]
        )
      })
    })

    output$in_match_y <- renderUI({
      if (input$import_y == 0) {
        return()
      }
      isolate({
        variables <- names(y())
        ui <- selectInput(
          "match_y",
          "Variable used for the matching",
          choices = variables,
          selected = variables[1]
        )
      })
    })

    output$in_groups <- renderUI({
      if (is.null(input$match_x) | is.null(input$match_y)) {
        return()
      }
      isolate({
        variables <- c("None", intersect(names(x()), names(y())))
        ui <- selectInput(
          "groups",
          "Variable used for grouping",
          choices = variables,
          selected = variables[1],
          multiple = T
        )
      })
    })

    ################
    # Join data
    merger <- reactive({
      proxim_join(
        x = x(),
        y = y(),
        match_x = input$match_x,
        match_y = input$match_y,
        maxdist = input$maxdist,
        groups = input$groups
      )
    })
    
    output$matched <- renderTable({ as.data.frame(merger()) })
    
    #################
    # On exit
    output$downloadData <- downloadHandler(
      filename = "merger.csv",
      content = function(file) {
        write.csv(merger(), file, row.names = F)
      }
    )

    observeEvent(input$done, {
      stopApp(merger())
    })
  }
  runGadget(ui, server)
}