#' Subset a Data Frame.
#'
#' Interactively subset a \code{data.frame}. The resulting
#' code will be emitted as a call to the \code{\link{subset}}
#' function.
#'
#' This addin can be used to interactively subset a \code{data.frame}.
#' The intended way to use this is as follows:
#'
#' 1. Highlight a symbol naming a \code{data.frame} in your R session,
#' e.g. \code{mtcars},
#' 2. Execute this addin, to interactively subset it.
#'
#' When you're done, the code performing this operation will be emitted
#' at the cursor position.
#'
#' @export
subsetAddin <- function() {
# Get the document context.
context <- rstudioapi::getActiveDocumentContext()
# Set the default data to use based on the selection.
text <- context$selection[[1]]$text
defaultData <- text
# Generate UI for the gadget.
ui <- miniPage(
gadgetTitleBar("Subset a data.frame"),
miniContentPanel(
stableColumnLayout(
textInput("data", "Data", value = defaultData),
textInput("subset", "Subset Expression")
),
uiOutput("pending"),
dataTableOutput("output")
)
)
# Server code for the gadget.
server <- function(input, output, session) {
reactiveData <- reactive({
# Collect inputs.
dataString <- input$data
subsetString <- input$subset
# Check to see if there is data called 'data',
# and access it if possible.
if (!nzchar(dataString))
return(errorMessage("data", "No dataset available."))
if (!exists(dataString, envir = .GlobalEnv))
return(errorMessage("data", paste("No dataset named '", dataString, "' available.")))
data <- get(dataString, envir = .GlobalEnv)
if (!nzchar(subsetString))
return(data)
# Try evaluating the subset expression within the data.
condition <- try(parse(text = subsetString)[[1]], silent = TRUE)
if (inherits(condition, "try-error"))
return(errorMessage("expression", paste("Failed to parse expression '", subsetString, "'.")))
call <- as.call(list(
as.name("subset.data.frame"),
data,
condition
))
eval(call, envir = .GlobalEnv)
})
output$pending <- renderUI({
data <- reactiveData()
if (isErrorMessage(data))
h4(style = "color: #AA7732;", data$message)
})
output$output <- renderDataTable({
data <- reactiveData()
if (isErrorMessage(data))
return(NULL)
data
})
# Listen for 'done'.
observeEvent(input$done, {
# Emit a subset call if a dataset has been specified.
if (nzchar(input$data) && nzchar(input$subset)) {
code <- paste("subset(", input$data, ", ", input$subset, ")", sep = "")
rstudioapi::insertText(text = code)
}
invisible(stopApp())
})
}
# Use a modal dialog as a viewr.
viewer <- dialogViewer("Subset", width = 1000, height = 800)
runGadget(ui, server, viewer = viewer)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.