Shiny R Application That Allows Users to Modify Data

Shiny R Application to let users modify dataframe by lasso selection

I was able to get this working as I originally intended once I understood how scoping assignment works in Shiny in relation to reactive statements. This app now mostly does everything I want it do, though I feel the code is really just cobbled together at this point and needs to be fixed in many areas. In particular I have a very janky solution to finding the selected items in my original dataframe as I really don't like the curvenumber/pointnumber index system.

library(plotly)
library(shiny)
library(knitr)
library(kableExtra)

theme_set(theme_light())

myApp <- function(attributes,dat1) {

dataset <- cbind(attributes,dat1)
vv <- NULL

ui <- fluidPage(
  plotlyOutput('plot', width='1000px', height='600px'),
  fluidRow(
  column(2,
      selectInput('xvar','X',names(dat1),selected='cs'),
      selectInput('yvar','Y',names(dat1),selected='ta')),
  column(3,offset=0.5,
      selectInput('Code','GROUP',names(attributes),selected='CORE'),
      checkboxInput('Conf','Confidence Elipse',value=TRUE),
      sliderInput('int.set','Set Confidence Interval',min=0.80,max=0.99,step=0.01,value=0.95)),
  column(3,offset=0.5,
      br(),
      actionButton('Change','Change Group Assignment'),
      textInput('NewGroup', label = 'Enter new group designation')),
  column(3,offset=0.5,
      br(),
      actionButton('refresh', label='Refresh Plot with New Assignments'),
      br(),br(),
      actionButton("exit", label = "Return to R and write data"))),
  verbatimTextOutput('brush')
)

server <- function(input, output) {

  values <- reactiveValues(vv = NULL)

  data.sel <- reactive({
    dataset[,c(input$xvar,input$yvar,input$Code)]
  })

  output$plot <- renderPlotly({
    g1 <- data.sel()
    p <- ggplot(g1, aes(x=g1[,1], y=g1[,2], color=g1[,3], shape=g1[,3])) + 
      geom_point() +
      labs(x=input$xvar,y=input$yvar,color=input$Code,shape=input$Code) 
      if(input$Conf) {p <- p + stat_ellipse(level=input$int.set)}
    ggplotly(p) %>% layout(dragmode = 'select')
  })

  output$brush<- renderPrint({
    g1 <- data.sel()
    d <- event_data('plotly_selected')
    dd <- round(cbind(d[[3]],d[[4]]),3)
    vv <- attributes[which(round(g1[,1],3) %in% dd[,1] & round(g1[,2],3) %in% dd[,2]),]
    vv <<- vv
    if (is.null(vv)) "Click and drag events (i.e., select/lasso) appear here (double-click to clear)" else kable(vv)
  })

  observeEvent(input$Change > 0, {
  if (!is.null(vv)) {
    dataset[which(row.names(dataset) %in% row.names(vv)),]$CORE <<- 
input$NewGroup
      }})

  observe({
  if(input$exit > 0)
  stopApp()})

  }

runApp(shinyApp(ui, server))
return(dataset)
}

And some test data

data(iris)

iris2 <- cbind(iris,rep('a',nrow(iris)))
names(iris2)[6] <- 'CORE'

out <- myApp(iris2[,5:6],iris2[,1:4])

shiny app for multiple users to edit

I found the following pattern working for me: Create a reactiveVal object outside the server and then access/update it in the app. Here, I wrote a wrapper for getting and appending massages to a chat. (code below)

However, I think this pattern only works if all users share the same R session and the data will be lost if the current R session ends (all users disconnect). Therefore, you might want to look into this article to get a hang of persistent storage methods. Also, look at the documentation of reactiveFileReader for a more conveniet way of accessing files.

library(shiny)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      textInput("msg", "Message", placeholder = "type a message in the chat"),
      actionButton("submit", "submit")
    ),
    mainPanel(
      verbatimTextOutput("text")
    )
  )
)

createChat <- function(initVal) {
  chat_text <- reactiveVal(initVal)
  list(
    get = function(){ chat_text() },
    append = function(val) {
      chat_text(paste0(isolate(chat_text()), "\n", val))
    }
  )
}

myChat <- createChat("## This is a chat ##\n")

server <- function(input, output) {
  observeEvent(input$submit, {
    myChat$append(input$msg)
  })
  output$text <- renderText(myChat$get())
}

shinyApp(ui = ui, server = server)

How to let user pick the data in R-shiny?

"chosen_prod" is not a column in df. Try this instead.

plot(df$ds, df[[chosen_prod]])

Allow users to add new variables to a dataset in Shiny App

Using eval(parse(text=input$addVar)) should work.

You could also add a default text for the textInput() to make the (unconventional but interesting) use of textInput() more clear.

textInput("addVar", "New attribute definition", 
          "curr$df$Value <- ifelse(curr$df$colD == 'Value', 1, 0)")

The complete app (including a textOutput to check the result) would read:

colA <- c('1','2','3','3','2')
colB <- c('1','1','3','3','2')
colC <- c('14','12','33','33','26')
colD <- c('Value','Mainstream','Value','Premium','Premium')
colE <- c(1,2,3,4,5)
rawdata <- as.data.frame(cbind(colA, colB, colC, colD, colE))

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      textInput("addVar", "New attribute definition", "curr$df$Value <- ifelse(curr$df$colD == 'Value', 1, 0)"),
      helpText("Note: Type the attribute definition using R code."),
      helpText("For example:"), 
      helpText("data$Value <- ifelse (data$price_tiers_new == 'Value', 1, 0)"),
      br(),
      actionButton("addButton", strong("Add!")),
      width = 3
    ),

    mainPanel(
      verticalLayout(
        br(),
        verbatimTextOutput("txt")
        #Will display histogram of the newly added variables       
      )
    )
  )
)

server <- function(input, output, session) {
  output$txt <- renderPrint(curr$df)
  curr <- reactiveValues()
  curr$df <- rawdata

  observeEvent(input$addButton, {
    eval(parse(text=input$addVar))
  })
}

shinyApp(ui, server)

Shiny Screening App - User Filter / Mutate / Modify

This is a slightly different approach, but maybe you'll find it useful. I'm using sqldf as an SQL query engine, and users can manipulate the data using ad-hoc SQL queries on the given dataset. If this isn't what you're after, I at least hope it will give you some hints on how to do it with dplyr syntax.

If you still go for the dplyr option and you have a string with the requested manipulation, you can use the reactive method getDataset to evaluate the expression you received from the user, manipulate your dataset. Then call getDataset in the renderDataTable method, like I did in the attached code.

Example for evaluating a string expression:

eval(parse(text="res <- mtcars %>% filter(mpg < 20)"))

For the SQL option:

library(shiny)
library(shinydashboard)
library(DT)
library(dplyr)
library(sqldf)
# Header ------------------------------------------------
header <- dashboardHeader(title = "Example Screening")
# Sidebar ------------------------------------------------
sidebar <- dashboardSidebar(collapsed = TRUE)
# Body ------------------------------------------------
body <-
  dashboardBody(
    fluidRow(
      #column(6,h3("Screening Parameters")),
      column(6,h3("Filtered/Modified Results"))),
    fluidRow(
      textInput("sql","SQL Query",value = "SELECT * FROM dataset"),
      DT::dataTableOutput(("filtered_results"))
    )
  )
# APP ------------------------------------------------
shinyApp(ui <- dashboardPage(
  header,
  sidebar,
  body
),
# Server ----------------------------------------------------------
shinyServer(function(input,output){

  ## A new function to load data and perform the SQL query on it
  getDataset <- reactive({
    query <- input$sql
    dataset <- mtcars
    sqldf::sqldf(query)
  })

  output$filtered_results <- renderDataTable({
    getDataset() %>%
      DT::datatable()

  })

})) 

---

Related Topics