diff --git a/NAMESPACE b/NAMESPACE index 8ff01a8..e40a598 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,6 +10,8 @@ export(dataOutputServer) export(dataOutputUI) export(dataSelectServer) export(dataSelectUI) +export(dataSyncServer) +export(dataSyncUI) export(data_edit) importFrom(htmltools,HTML) importFrom(htmltools,br) diff --git a/NEWS.md b/NEWS.md index 13cdacd..9221646 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,6 +3,9 @@ * Display hints when user hovers cursor over buttons. * Make sure R objects containing `.` can be loaded into the data editor. * Turn on highlighting for columns and rows. +* Add `dataSync` module to handle synchronisation of an edited data subset with the complete dataset. +* Improved support for tibbles. +* Fix `dataFilter` to ensure the logic and levels are always updated when the column selection changes. # DataEditR 0.1.2 @@ -12,7 +15,7 @@ # DataEditR 0.1.1 -* Ensure `dataInput()` searches for data outside `data_edit()`. +* Ensure `dataInput` searches for data outside `data_edit()`. * Prevent loading of highlighted data object in RStudio when data has been supplied to `data_edit()` directly. * Allow saving by `write_fun` whenever `save_as` is supplied. diff --git a/R/dataFilter.R b/R/dataFilter.R index d1bb90f..7296f15 100644 --- a/R/dataFilter.R +++ b/R/dataFilter.R @@ -6,7 +6,7 @@ #' making multiple calls to this shiny module. #' @param data an array wrapped in \code{reactive()} containing the data to be #' filtered. -#' @param hide logical indicating whether the data sfiltering user interface +#' @param hide logical indicating whether the data filtering user interface #' should be hidden from the user, set to FALSE by default. #' @param hover_text text to display on download button when user hovers cursor #' over button, set to NULL by default to turn off hover text. @@ -95,7 +95,7 @@ dataFilterServer <- function(id, if(!is.null(hover_text)) { addTooltip(session = session, id = ns("filter"), - title = "filter rows") + title = hover_text) } } @@ -184,10 +184,11 @@ dataFilterServer <- function(id, # VALUES values$filters[[filter_name]]$column <- input[[paste0(filter_name, "-col")]] - - # LEVELS - if (!is.numeric(values$data[, input[[paste0(filter_name, "-col")]]])) { - + + # LEVELS - DROP REQUIRED FOR TIBBLES + if (!is.numeric( + values$data[, input[[paste0(filter_name, "-col")]], + drop = TRUE])) { # UPDATE LOGIC updateSelectInput( session, @@ -207,16 +208,45 @@ dataFilterServer <- function(id, paste0(filter_name, "-levels"), choices = as.vector( unique( - values$data[, input[[paste0(filter_name, "-col")]]] + values$data[, input[[paste0(filter_name, "-col")]], + drop = TRUE] ) - ) + ), + server = TRUE + ) + # NUMERIC + } else { + # UPDATE LOGIC + updateSelectInput( + session, + paste0(filter_name, "-logic"), + choices = c( + "equal", + "not equal", + "greater than", + "less than", + "greater than or equal", + "less than or equal", + "between", + "not between", + "contain", + "not contain" + ), + selected = "equal" + ) + # UPDATE SELECT INPUT + updateSelectizeInput( + session, + paste0(filter_name, "-levels"), + choices = NULL, + selected = NULL, + server = TRUE ) } }), # LOGIC logic = observeEvent(input[[paste0(filter_name, "-logic")]], { - # VALUES values$filters[[filter_name]]$logic <- input[[paste0(filter_name, "-logic")]] @@ -224,7 +254,6 @@ dataFilterServer <- function(id, # LEVELS levels = observeEvent(input[[paste0(filter_name, "-levels")]], { - # VALUES values$filters[[filter_name]]$levels <- input[[paste0(filter_name, "-levels")]] @@ -232,22 +261,37 @@ dataFilterServer <- function(id, # DELETE delete = observeEvent(input[[paste0(filter_name, "-remove")]], { - # COLUMN removeUI( - selector = paste0("div:has(>> #", ns(paste0(filter_name, "-col")), ")") + selector = paste0( + "div:has(>> #", + ns(paste0(filter_name, "-col")), + ")" + ) ) # LOGIC removeUI( - selector = paste0("div:has(>> #", ns(paste0(filter_name, "-logic")), ")") + selector = paste0( + "div:has(>> #", + ns(paste0(filter_name, "-logic")), + ")" + ) ) # LEVELS removeUI( - selector = paste0("div:has(>> #", ns(paste0(filter_name, "-levels")), ")") + selector = paste0( + "div:has(>> #", + ns(paste0(filter_name, "-levels")), + ")" + ) ) # DELETE removeUI( - selector = paste0("div:has(>> #", ns(paste0(filter_name, "-remove")), ")") + selector = paste0( + "div:has(>> #", + ns(paste0(filter_name, "-remove")), + ")" + ) ) # VALUES values$filters[[filter_name]] <- NULL @@ -303,7 +347,6 @@ dataFilterServer <- function(id, lapply(names(values$filters), function(z){ filter_id <- gsub("filter-", "", z) - filter_ns_name <- ns(z) # ARGUMENTS @@ -421,8 +464,10 @@ dataFilterServer <- function(id, values$filters[[filter_name]]$column <- input[[paste0(filter_name, "-col")]] - # VALIDATE NUMERIC - if (!is.numeric(values$data[, input[[paste0(filter_name, "-col")]]])) { + # CHARACTER/FACTOR + if (!is.numeric( + values$data[, input[[paste0(filter_name, "-col")]], + drop = TRUE])) { # UPDATE LOGIC updateSelectInput( @@ -443,16 +488,45 @@ dataFilterServer <- function(id, paste0(filter_name, "-levels"), choices = as.vector( unique( - values$data[, input[[paste0(filter_name, "-col")]]] + values$data[, input[[paste0(filter_name, "-col")]], + drop = TRUE] ) - ) + ), + server = TRUE + ) + # NUMERIC + } else { + # UPDATE LOGIC + updateSelectInput( + session, + paste0(filter_name, "-logic"), + choices = c( + "equal", + "not equal", + "greater than", + "less than", + "greater than or equal", + "less than or equal", + "between", + "not between", + "contain", + "not contain" + ), + selected = "equal" + ) + # UPDATE SELECT INPUT + updateSelectizeInput( + session, + paste0(filter_name, "-levels"), + choices = NULL, + selected = NULL, + server = TRUE ) } }), # LOGIC logic = observeEvent(input[[paste0(filter_name, "-logic")]], { - # VALUES values$filters[[filter_name]]$logic <- input[[paste0(filter_name, "-logic")]] @@ -460,7 +534,6 @@ dataFilterServer <- function(id, # LEVELS levels = observeEvent(input[[paste0(filter_name, "-levels")]], { - # VALUES values$filters[[filter_name]]$levels <- input[[paste0(filter_name, "-levels")]] @@ -468,22 +541,37 @@ dataFilterServer <- function(id, # DELETE delete = observeEvent(input[[paste0(filter_name, "-remove")]], { - # COLUMN removeUI( - selector = paste0("div:has(>> #", ns(paste0(filter_name, "-col")), ")") + selector = paste0( + "div:has(>> #", + ns(paste0(filter_name, "-col")), + ")" + ) ) # LOGIC removeUI( - selector = paste0("div:has(>> #", ns(paste0(filter_name, "-logic")), ")") + selector = paste0( + "div:has(>> #", + ns(paste0(filter_name, "-logic")), + ")" + ) ) # LEVELS removeUI( - selector = paste0("div:has(>> #", ns(paste0(filter_name, "-levels")), ")") + selector = paste0( + "div:has(>> #", + ns(paste0(filter_name, "-levels")), + ")" + ) ) # DELETE removeUI( - selector = paste0("div:has(>> #", ns(paste0(filter_name, "-remove")), ")") + selector = paste0( + "div:has(>> #", + ns(paste0(filter_name, "-remove")), + ")" + ) ) # VALUES values$filters[[filter_name]] <- NULL @@ -535,86 +623,91 @@ dataFilterServer <- function(id, # REMOVE FILTERS observeEvent(input$filter_reset, { - # REMOVE FILTER UI lapply(names(values$filters), function(z) { # COLUMN removeUI( - selector = paste0("div:has(>> #", ns(paste0(z, "-col")), ")") + selector = paste0( + "div:has(>> #", + ns(paste0(z, "-col")), + ")" + ) ) # LOGIC removeUI( - selector = paste0("div:has(>> #", ns(paste0(z, "-logic")), ")") + selector = paste0( + "div:has(>> #", + ns(paste0(z, "-logic")), + ")" + ) ) # LEVELS removeUI( - selector = paste0("div:has(>> #", ns(paste0(z, "-levels")), ")") + selector = paste0( + "div:has(>> #", + ns(paste0(z, "-levels")), + ")" + ) ) # DELETE removeUI( - selector = paste0("div:has(>> #", ns(paste0(z, "-remove")), ")") + selector = paste0( + "div:has(>> #", + ns(paste0(z, "-remove")), + ")" + ) ) }) - # FLUSH OBSERVERS filter_observers <- list() - # FLUSH FILTERS values$filters <- NULL - # FLUSH ROWS values$rows <- NULL - }) # UPDATE & FILTER observeEvent(input$close, { - # DATA TO FILTER subset <- values$data - # FILTER DATA if(length(values$filters) != 0) { - # FILTER INDICES - ENTIRE DATASET ind <- unlist( lapply(names(values$filters), function(z) { - col <- values$filters[[z]]$column logic <- values$filters[[z]]$logic levels <- values$filters[[z]]$levels vals <- subset[, col] - # NUMERIC LEVELS if (is.numeric(vals)) { levels <- as.numeric(levels) } - - # LEVELS REQUIRED + # LEVELS REQUIRED - DROP REQUIRED FOR TIBBLES if (!is.null(levels)) { # EQUAL if (logic == "equal") { - return(which(values$data[, col] %in% levels)) + return(which(values$data[, col, drop = TRUE] %in% levels)) # NOT EQUAL } else if (logic == "not equal") { - return(which(!values$data[, col] %in% levels)) + return(which(!values$data[, col, drop = TRUE] %in% levels)) # GREATER THAN } else if (logic == "greater than") { - return(which(values$data[, col] > levels)) + return(which(values$data[, col, drop = TRUE] > levels)) # LESS THAN } else if (logic == "less than") { - return(which(values$data[, col] < levels)) + return(which(values$data[, col, drop = TRUE] < levels)) # GREATER THAN OR EQUAL } else if (logic == "greater than or equal") { - return(which(values$data[, col] >= levels)) + return(which(values$data[, col, drop = TRUE] >= levels)) # LESS THAN OR EQUAL } else if (logic == "less than or equal") { - return(which(values$data[, col] <= levels)) + return(which(values$data[, col, drop = TRUE] <= levels)) # BETWEEN | NOT BETWEEN } else if (logic %in% c("between", "not between")) { ind <- which( - values$data[, col] > levels[1] & - values$data[, col] < levels[2] + values$data[, col, drop = TRUE] > levels[1] & + values$data[, col, drop = TRUE] < levels[2] ) # BETWEEN if (logic == "between") { @@ -628,7 +721,7 @@ dataFilterServer <- function(id, ind <- unique( unlist( lapply(levels, function(z) { - which(grepl(z, subset[, col])) + which(grepl(z, subset[, col, drop = TRUE])) }) ) ) @@ -657,7 +750,6 @@ dataFilterServer <- function(id, } values$subset <- values$data[values$rows, ] } - # CLOSE POPUP removeModal() }) diff --git a/R/dataOutput.R b/R/dataOutput.R index 9901c22..040c02a 100644 --- a/R/dataOutput.R +++ b/R/dataOutput.R @@ -120,6 +120,7 @@ dataOutputServer <- function(id, enable("save") # FORMAT if (!nzchar(trimws(colnames(values$data)[1]))) { + # WARNING - SETTING ROWNAMES ON TIBBLES rownames(values$data) <- values$data[, 1] values$data <- values$data[, -1] } diff --git a/R/dataSelect.R b/R/dataSelect.R index 4dccc9b..ea8d9bf 100644 --- a/R/dataSelect.R +++ b/R/dataSelect.R @@ -94,7 +94,7 @@ dataSelectServer <- function(id, if(!is.null(hover_text)) { addTooltip(session = session, id = ns("select"), - title = "select columns") + title = hover_text) } } diff --git a/R/dataSync.R b/R/dataSync.R new file mode 100644 index 0000000..bcc8b80 --- /dev/null +++ b/R/dataSync.R @@ -0,0 +1,163 @@ +## DATA SYNC MODULE ------------------------------------------------------------ + +#' A shiny module to synchronise datasets +#' +#' The purpose of this module is to merge changes made to a subset of the data +#' with the master copy of the data. +#' +#' @param id unique identifier for the module to prevent namespace clashes when +#' making multiple calls to this shiny module. +#' @param data master copy of the data. +#' @param data_subset subset of \code{data} with altered entries. +#' @param rows the row indices of \code{data_subset} within \code{data}. +#' @param columns the column indices of \code{data_subset} within \code{data}. +#' @param hide logical indicating whether the data synchronisation user +#' interface should be hidden from the user, set to FALSE by default. +#' @param hover_text text to display on download button when user hovers cursor +#' over button, set to NULL by default to turn off hover text. +#' +#' @importFrom shinyjs hidden show +#' @importFrom shinyBS addTooltip +#' @importFrom shiny actionButton icon moduleServer eventReactive is.reactive +#' reactive +#' +#' @author Dillon Hammill, \email{Dillon.Hammill@anu.edu.au} +#' +#' @examples +#' if(interactive()){ +#' library(shiny) +#' library(rhandsontable) +#' library(shinyjs) +#' +#' ui <- fluidPage( +#' useShinyjs(), +#' dataInputUI("input1"), +#' dataFilterUI("filter1"), +#' dataSyncUI("sync1"), +#' dataEditUI("edit1") +#' ) +#' +#' server <- function(input, +#' output, +#' session) { +#' +#' values <- reactiveValues( +#' data = NULL, +#' data_subset = NULL +#' ) +#' +#' data_input <- dataInputServer("input1") +#' +#' data_edit <- dataEditServer( +#' "edit1", +#' data = data_input +#' ) +#' +#' data_sync <- dataSyncServer( +#' "sync1", +#' data = data_input, +#' data_subset = data_edit, +#' rows = NULL, +#' columns = NULL +#' ) +#' +#' } +#' shinyApp(ui, server) +#' } +#' +#' @name dataSync +NULL + +#' @rdname dataSync +#' @export +dataSyncUI <- function(id) { + + hidden( + actionButton( + NS(id, "sync"), + label = NULL, + icon = icon("sync") + ) + ) + +} + +#' @rdname dataSync +#' @export +dataSyncServer <- function(id, + data = reactive(NULL), + data_subset = reactive(NULL), + rows = reactive(NULL), + columns = reactive(NULL), + hide = FALSE, + hover_text = NULL) { + + moduleServer(id, function(input, output, session){ + + # NAMESPACE + ns <- session$ns + + # HIDE USER INTERFACE + if (!hide) { + show("sync") + if(!is.null(hover_text)) { + addTooltip(session = session, + id = ns("sync"), + title = hover_text) + } + } + + # SYNCHRONISE + data_sync <- eventReactive(input$sync, { + data_old <- data() + data_new <- data_subset() + # ROW INDICES + if(is.reactive(rows)) { + row_ind <- rows() + } else { + row_ind <- rows + } + # COLUMN INDICES + if(is.reactive(columns)) { + col_ind <- columns() + } else { + col_ind <- columns + } + # ENTIRE DATA + if(length(row_ind) == 0 & length(col_ind) == 0) { + data_old <- data_new + # DATA SUBSET + } else { + # VALUES + if(length(row_ind) != 0 & length(col_ind) == 0) { + data_old[row_ind, ] <- data_new + } else if(length(row_ind) == 0 & length(col_ind) != 0) { + data_old[ , col_ind] <- data_new + } else if(length(row_ind) != 0 & length(col_ind) != 0) { + data_old[row_ind, col_ind] <- data_new + } + # ROW/COLUMN NAMES + if(!is.null(data_new)) { + # ROW NAMES + if(!all(rownames(data_new) == rownames(data_old)[row_ind])) { + rownames(data_old)[row_ind] <- rownames(data_new) + } + # COLUMN NAMES + if(!all(colnames(data_new) == colnames(data_old)[col_ind])) { + colnames(data_old)[col_ind] <- colnames(data_new) + } + } + } + return(data_old) + }) + + # RETURN SYNCHRONISED DATA + return( + reactive({ + data_sync() + }) + ) + + }) + +} diff --git a/R/data_edit.R b/R/data_edit.R index be52a0c..2bbd052 100644 --- a/R/data_edit.R +++ b/R/data_edit.R @@ -238,11 +238,7 @@ data_edit <- function(x = NULL, style = "padding-left: 5px; margin-top: 35px;", dataSelectUI("select1"), dataFilterUI("filter1"), - hidden( - actionButton("sync", - label = NULL, - icon = icon("sync")) - ), + dataSyncUI("sync1"), dataOutputUI("output-active"), dataOutputUI("output-update", icon = "file-download"), @@ -373,36 +369,15 @@ data_edit <- function(x = NULL, }) # SYNC - observeEvent(input$sync, { - # ENTIRE DATA - if(length(values$rows) == 0 & length(values$columns) == 0) { - values$data <- values$data_active - # DATA - } else { - # VALUES - if(length(values$rows) != 0 & length(values$columns) == 0) { - values$data[values$rows, ] <- values$data_active - } else if(length(values$rows) == 0 & length(values$columns) != 0) { - values$data[ , values$columns] <- values$data_active - } else if(length(values$rows) != 0 & length(values$columns) != 0) { - values$data[values$rows, values$columns] <- values$data_active - } - # ROW/COLUMN NAMES - if(!is.null(values$data_active)) { - # ROW NAMES - if(!all(rownames(values$data_active) == - rownames(values$data)[values$rows])) { - rownames(values$data)[values$rows] <- - rownames(values$data_active) - } - # COLUMN NAMES - if(!all(colnames(values$data_active) == - colnames(values$data)[values$columns])) { - colnames(values$data)[values$columns] <- - colnames(values$data_active) - } - } - } + data_sync <- dataSyncServer("sync1", + data = reactive(values$data), + data_subset = reactive(values$data_active), + rows = reactive(values$rows), + columns = reactive(values$cols), + hide = hide, + hover_text = "synchronise") + observe({ + values$data <- data_sync() }) # DATA OUTPUT - DATA ACTIVE diff --git a/docs/articles/DataEditR.html b/docs/articles/DataEditR.html index 7b43575..b4b4d38 100644 --- a/docs/articles/DataEditR.html +++ b/docs/articles/DataEditR.html @@ -77,7 +77,7 @@ -
+

DataEditR

diff --git a/docs/articles/DataEditR_files/header-attrs-2.9/header-attrs.js b/docs/articles/DataEditR_files/header-attrs-2.9/header-attrs.js new file mode 100644 index 0000000..dd57d92 --- /dev/null +++ b/docs/articles/DataEditR_files/header-attrs-2.9/header-attrs.js @@ -0,0 +1,12 @@ +// Pandoc 2.9 adds attributes on both header and div. We remove the former (to +// be compatible with the behavior of Pandoc < 2.8). +document.addEventListener('DOMContentLoaded', function(e) { + var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); + var i, h, a; + for (i = 0; i < hs.length; i++) { + h = hs[i]; + if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 + a = h.attributes; + while (a.length > 0) h.removeAttribute(a[0].name); + } +}); diff --git a/docs/news/index.html b/docs/news/index.html index c44f5f3..293d70f 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -133,6 +133,9 @@

  • Display hints when user hovers cursor over buttons.
  • Make sure R objects containing . can be loaded into the data editor.
  • Turn on highlighting for columns and rows.
    • +
  • Add dataSync module to handle synchronisation of an edited data subset with the complete dataset.
    • +
  • Improved support for tibbles.
    • +
  • Fix dataFilter to ensure the logic and levels are always updated when the column selection changes.

    • @@ -151,7 +154,7 @@

    DataEditR 0.1.1 2021-05-10

      -
    • Ensure dataInput() searches for data outside data_edit().
      • +
    • Ensure dataInput searches for data outside data_edit().
    • Prevent loading of highlighted data object in RStudio when data has been supplied to data_edit() directly.
    • Allow saving by write_fun whenever save_as is supplied.
    diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml index 3738743..8d0131b 100644 --- a/docs/pkgdown.yml +++ b/docs/pkgdown.yml @@ -3,5 +3,5 @@ pkgdown: 1.6.1 pkgdown_sha: ~ articles: DataEditR: DataEditR.html -last_built: 2021-05-27T07:44Z +last_built: 2021-07-09T04:53Z diff --git a/docs/reference/dataEdit.html b/docs/reference/dataEdit.html index 092b78b..e73bba9 100644 --- a/docs/reference/dataEdit.html +++ b/docs/reference/dataEdit.html @@ -258,11 +258,11 @@

    Examp server <- function(input, output, session) { data_to_edit <- dataInputServer("input-1") - data_to_edit <- dataEditServer("edit-1", + data_edit <- dataEditServer("edit-1", data = data_to_edit ) dataOutputServer("output-1", - data = data_to_edit + data = data_edit ) } diff --git a/docs/reference/dataFilter.html b/docs/reference/dataFilter.html index 7904f03..77dfaee 100644 --- a/docs/reference/dataFilter.html +++ b/docs/reference/dataFilter.html @@ -150,7 +150,7 @@

    Arg hide -

    logical indicating whether the data sfiltering user interface +

    logical indicating whether the data filtering user interface should be hidden from the user, set to FALSE by default.

    diff --git a/docs/reference/dataSync.html b/docs/reference/dataSync.html new file mode 100644 index 0000000..83f18c2 --- /dev/null +++ b/docs/reference/dataSync.html @@ -0,0 +1,258 @@ + + + + + + + + +A shiny module to synchronise datasets — dataSync • DataEditR + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    +
    + + + + +
    + +
    +
    +
    +

    A shiny module to synchronise datasets

    + Source: R/dataSync.R + +
    + +
    +

    The purpose of this module is to merge changes made to a subset of the data +with the master copy of the data.

    +
    + + 
    dataSyncUI(id, ...)
+
+dataSyncServer(
+  id,
+  data = reactive(NULL),
+  data_subset = reactive(NULL),
+  rows = reactive(NULL),
+  columns = reactive(NULL),
+  hide = FALSE,
+  hover_text = NULL
+)
    + +

    Arguments

    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    id

    unique identifier for the module to prevent namespace clashes when +making multiple calls to this shiny module.

    data

    master copy of the data.

    data_subset

    subset of data with altered entries.

    rows

    the row indices of data_subset within data.

    columns

    the column indices of data_subset within data.

    hide

    logical indicating whether the data synchronisation user +interface should be hidden from the user, set to FALSE by default.

    hover_text

    text to display on download button when user hovers cursor +over button, set to NULL by default to turn off hover text.

    + +

    Author

    + +

    Dillon Hammill, Dillon.Hammill@anu.edu.au

    + +

    Examples

    + 
    if(interactive()){
+ library(shiny)
+ library(rhandsontable)
+ library(shinyjs)
+
+ ui <- fluidPage(
+   useShinyjs(),
+   dataInputUI("input1"),
+   dataFilterUI("filter1"),
+   dataSyncUI("sync1"),
+   dataEditUI("edit1")
+ )
+
+ server <- function(input,
+                    output,
+                    session) {
+ 
+   values <- reactiveValues(
+     data = NULL,
+     data_subset = NULL
+   )
+  
+   data_input <- dataInputServer("input1")
+ 
+  data_edit <- dataEditServer(
+     "edit1",
+     data = data_input
+   )
+ 
+   data_sync <- dataSyncServer(
+     "sync1",
+     data = data_input,
+     data_subset = data_edit,
+     rows = NULL,
+     columns = NULL
+   )
+ 
+  }
+ shinyApp(ui, server)
+}
+
+
    +
    + +
    + + +
    +
    +

    Developed by Dillon Hammill.

    +
    + +
    +

    Site built with pkgdown 1.6.1.

    +
    + +
    +
    + + + + + + + + diff --git a/docs/reference/index.html b/docs/reference/index.html index 47b185e..3c891f1 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -176,6 +176,12 @@

    dataSyncUI() dataSyncServer()

    + +

    A shiny module to synchronise datasets

    + +

    data_edit()

    diff --git a/man/dataFilter.Rd b/man/dataFilter.Rd index ce40067..9ba79c8 100644 --- a/man/dataFilter.Rd +++ b/man/dataFilter.Rd @@ -17,7 +17,7 @@ making multiple calls to this shiny module.} \item{data}{an array wrapped in \code{reactive()} containing the data to be filtered.} -\item{hide}{logical indicating whether the data sfiltering user interface +\item{hide}{logical indicating whether the data filtering user interface should be hidden from the user, set to FALSE by default.} \item{hover_text}{text to display on download button when user hovers cursor diff --git a/man/dataSync.Rd b/man/dataSync.Rd new file mode 100644 index 0000000..8164325 --- /dev/null +++ b/man/dataSync.Rd @@ -0,0 +1,88 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dataSync.R +\name{dataSync} +\alias{dataSync} +\alias{dataSyncUI} +\alias{dataSyncServer} +\title{A shiny module to synchronise datasets} +\usage{ +dataSyncUI(id) + +dataSyncServer( + id, + data = reactive(NULL), + data_subset = reactive(NULL), + rows = reactive(NULL), + columns = reactive(NULL), + hide = FALSE, + hover_text = NULL +) +} +\arguments{ +\item{id}{unique identifier for the module to prevent namespace clashes when +making multiple calls to this shiny module.} + +\item{data}{master copy of the data.} + +\item{data_subset}{subset of \code{data} with altered entries.} + +\item{rows}{the row indices of \code{data_subset} within \code{data}.} + +\item{columns}{the column indices of \code{data_subset} within \code{data}.} + +\item{hide}{logical indicating whether the data synchronisation user +interface should be hidden from the user, set to FALSE by default.} + +\item{hover_text}{text to display on download button when user hovers cursor +over button, set to NULL by default to turn off hover text.} +} +\description{ +The purpose of this module is to merge changes made to a subset of the data +with the master copy of the data. +} +\examples{ +if(interactive()){ + library(shiny) + library(rhandsontable) + library(shinyjs) + + ui <- fluidPage( + useShinyjs(), + dataInputUI("input1"), + dataFilterUI("filter1"), + dataSyncUI("sync1"), + dataEditUI("edit1") + ) + + server <- function(input, + output, + session) { + + values <- reactiveValues( + data = NULL, + data_subset = NULL + ) + + data_input <- dataInputServer("input1") + + data_edit <- dataEditServer( + "edit1", + data = data_input + ) + + data_sync <- dataSyncServer( + "sync1", + data = data_input, + data_subset = data_edit, + rows = NULL, + columns = NULL + ) + + } + shinyApp(ui, server) +} + +} +\author{ +Dillon Hammill, \email{Dillon.Hammill@anu.edu.au} +}