Trying to use selectInput in a form.
the choices are fetched from a collection in mongodB.
when user
completes the form and submits (which inserts to another collection
in mongo), data in selectInput is not captured.
tried to make it reactive or use observeEvent /updateSelectInput in the server but could not make it work.
here is the entire code:
library(shiny)
library(mongolite)
library(jsonlite)
# which fields get saved
fieldsAll <- c("Name", "selectOne", "tags")
saveData <- function(data) {
# Connect to the database
}
# load all responses into a data.frame
loadData <- function() {
# Connect to the database
}
fetchData <- function() {
# Connect to the database
}
shinyApp(
ui = tagList(
navbarPage(
tabPanel("Technology",
sidebarPanel(
textInput("Name",label ='Name:'),
selectInput('selectOne',
label ='Select One:',
choices=head(fetchData()),
selected = "",
multiple = FALSE),
selectizeInput("tags", "Tags:", NULL, multiple = TRUE, options=list(create=TRUE)),
actionButton("submit", "Submit", class = "btn-primary")
),
mainPanel(
tabsetPanel(
tabPanel("Table",
uiOutput("adminPanelContainer")
)
)
)
)
)
),
server = function(input, output, session) {
formData <- reactive({
fieldsAll
data <- sapply(fieldsAll, function(x) input[[x]])
data <- t(data)
data
})
observeEvent(input$submit, {
saveData(formData())
},
)
# render the admin panel
output$adminPanelContainer <- renderUI({
DT::dataTableOutput("responsesTable")
})
# Update the responses table whenever a new submission is made
responses_data <- reactive({
input$submit
data <- loadData()
data
})
# Show the responses in the admin table
output$responsesTable <- DT::renderDataTable({
DT::datatable(
responses_data(),
rownames = FALSE,
options = list(searching = TRUE, lengthChange = FALSE)
)
})
}
)
adding a column to the df with selected value worked:
formData <- reactive({
fieldsAll
data <- sapply(fieldsAll, function(x) input[[x]])
data <- c(data,selectOne= input$selectOne) #added line
data <- t(data)
data
})
Related
I have created a user interface for a mongodb database but am having trouble saving the data to the database. I would like the users to be able to submit form data and then for the app to display this immediately. The form fields also need to be mandatory. I am having trouble submitting the data at present - any help would be greatly appreciated.
library(shiny)
library(jsonlite)
library(mongolite)
## insert into database
DB <- mongo(collection = "test",db = "DB", url = "mongodb://XXX")
fieldsmandatory <- c("name", "data", "Type", "Data ID" )
#func. to labe mandatory fields *
labelMandatory <- function(label) {
tagList(
label,
span("*", class = "mandatory_star")
)
}
appCSS <- ".mandatory_star { color: red; }"
allrownames <- c("name","data", "Type", "Data ID")
ui <- fluidPage(
fluidRow(column(8, "Test_dataset",
dataTableOutput(outputId = "dataset"))),
fluidRow(column(8,
"Add Data",
id = "form",
textInput("name", labelMandatory("Name")),
textInput("date", labelMandatory("date")),
textInput("Type", labelMandatory("Type")),
textInput("DataID", labelMandatory("Data ID")),
actionButton("Submit", "Submit", class = "btn-primary"),
)))
server <- function(input, output, sessiom){
formData <- reactive({
formData <- data.frame(name = input$name,
date = input$date,
Type = input$Type,
DataID = input$DataID,
stringsAsFactors = FALSE)
return(formData)
})
#load dataset
output$dataset <- renderDataTable({
alldata<- DB$find('{}')
print(alldata)
})
#observe if all mandatory fields are filled.
observe({
mandatoryFilled <-
vapply(fieldsMandatory,
function(x) {
!is.null(input[[x]]) && input[[x]] != ""
},
logical(1))
mandatoryFilled <- all(mandatoryFilled)
shinyjs::toggleState(id = "submit",
condition = mandatoryFilled)
})
#Updata Data in the tables fufnction
saveData <- function(data){
DB <- mongo(collection = "test", db = "DB", url = "mongodb://XXX")
data <- as.data.frame(t(data))
DB$insert(data)
}
#Call update to form
observeEvent(input$Submit, {
saveData(formData())
})
}
shinyApp(ui, server)
I am trying to make a module that accepts a data frame and produces an editable datatable out of it. This worked until I made the module able to accept multiple edits by making the following change:
editTable <- reactive({
datatable(
reactives$input,
#editable = T #PREVIOUS (working fine)
editable = list(target = "all"), #NEW (problem-causing)
rownames = F
)
})
Once the code labelled #NEW is included, clicking labelDo (in this case "Edit") causes the app to crash with this error message:
Warning: Error in split.default: first argument must be a vector
The closest problem I could find to this one is here . This user's problem is the same but mine is not solved (as theirs allegedly is) by putting rownames = FALSE into their datatable() equivalent of the snippet above.
Please go ahead and run the following module and app together and attempt to edit one of the numbers in the table. Click 'edit' and you will get the same result.
Module:
editrUI <- function(id, labelDo, labelUndo) {
ns <- NS(id)
tagList(
dataTableOutput(ns("out")),
actionButton(
inputId = ns("do"),
label = labelDo
),
actionButton(
inputId = ns("undo"),
label = labelUndo
)
)
}
editrServer <- function(id, dataFrame) {
moduleServer(
id,
function(input, output, session){
reactives <- reactiveValues()
reactives$input <- NULL
observe({
reactives$input <- dataFrame
})
editTable <- reactive({
datatable(
reactives$input,
#editable = T #old
editable = list(target = "all"), #new
rownames = F
)
})
output$out <- renderDataTable(
editTable()
)
observeEvent(input$do , {
reactives$input <<- editData(reactives$input, input$out_cell_edit, rownames = F)
})
observeEvent(input$undo , {
reactives$input <- dataFrame
})
return(reactive({reactives$input}))
}
)
}
App:
library(shiny)
source(
#source of module
)
a <- 1:5
df <- tibble(a, a*2)
ui <- fluidPage(
editrUI(id = "id", labelDo = "Edit", labelUndo = "Undo")
)
server <- function(input, output) {
editrServer(id = "id", dataFrame = df)
}
# Run the application
shinyApp(ui = ui, server = server)
It seems this error is caused when input$out_cell_edit is NULL (no cell has been edited).
You can fix it with req(input$out_cell_edit) that will cancel the event in case input$out_cell_edit is NULL.
Also you don't need to use <<- to assign to the reactiveValues.
observeEvent(input$do , {
req(input$out_cell_edit)
reactives$input <- editData(reactives$input, input$out_cell_edit, rownames = F)
})
I am developing a shiny app which stores the arbitrary data. I have referred This link for the same. I can able to display all the responses including previous responses, but i want to display only the current response, not all response. My code snippet is as given below:
library(shiny)
outputDir <- "C:\\Users/dell/Desktop/"
saveData <- function(data) {
data <- as.data.frame(t(data))
if (exists("responsesiq")) {
responsesiq <<- rbind(responsesiq, data)
} else {
responsesiq <<- data
}
fileName <- "test_irty.csv"
write.csv(
x = responsesiq, sep = ",",
file = file.path(outputDir, fileName),
row.names = FALSE, quote = TRUE
)
}
loadData <- function() {
if (exists("responsesiq")) {
responsesiq
}
}
fields <- c("acc", "staff_name")
shinyApp(
ui = fluidPage(
titlePanel(" System"),
DT::dataTableOutput("responsesiq", width = 300), tags$hr(),
numericInput("acc", "Acc Number", ""),
selectInput("staff_name", "Staff Name",
c("Rajivaksh " = "RT",
"Arvind " = "AKS",
"Ashutosh " = "AS")),
actionButton("submit", "Submit")
),
server = function(input, output, session) {
formData <- reactive({
data <- sapply(fields, function(x) input[[x]])
data
})
observeEvent(input$submit, {
saveData(formData())
})
# Show the previous responses
# (update with current response when Submit is clicked)
output$responsesiq <- DT::renderDataTable({
input$submit
loadData()
})
}
)
Create reactiveValues to hold the current entry, which will trigger when clicking submit
shinyApp(
ui = fluidPage(
titlePanel(" System"),
DT::dataTableOutput("responsesiq", width = 300), tags$hr(),
numericInput("acc", "Acc Number", ""),
selectInput("staff_name", "Staff Name",
c("Rajivaksh " = "RT",
"Arvind " = "AKS",
"Ashutosh " = "AS")),
actionButton("submit", "Submit")
),
server = function(input, output, session) {
formData <- reactive({
data <- sapply(fields, function(x) input[[x]])
data
})
tmp <- reactiveValues(df=NULL)
observeEvent(input$submit, {
saveData(formData())
tmp$df <- t(formData())
})
# Show the previous responses
# (update with current response when Submit is clicked)
output$responsesiq <- DT::renderDataTable({
input$submit
#loadData()
data.frame(tmp$df)
})
}
)
I have a question regarding R shiny and the observ function. Is it possible to save the selected factors and the state of the work? For Example I created a programm which can choose colnames from the input data. After using bookmark and reopening the programm with the link in the browser the input data are loaded but the select factors of the colnames are reset. But I want to save the chosen colnames. Has anyone an idea? Thank you for your help!
ui <- function(request) {
fluidPage(
sidebarLayout(
sidebarPanel(
radioButtons(
"fileType_Input",
label = h5(""),
choices = list(".csv" = 1, ".xlsx" = 2),
selected = 1,
inline = TRUE
),
fileInput('file1', '' ),
selectInput("letters", label=NULL, factors, multiple = TRUE),
bookmarkButton()
),
mainPanel(
tableOutput("contents")
)
)
)
}
server <- function(input, output,session) {
myData <- reactive({
inFile <- input$file1
# Get the upload file
if (is.null(inFile)) {
return(NULL) }
if (input$fileType_Input == "1") {
read.csv2(inFile$datapath,
header = TRUE,
stringsAsFactors = FALSE)
} else {
read_excel(inFile$datapath)
}
})
observe({
if(is.null(input$letters)){
data <- myData()
if(is.null(data)){
}else{
factors <- colnames(data)
t$choices <- input$letters # append(u$choices,input$letters2)
updateSelectInput(session, "letters",
choices = factors #[!factors2 %in% u$choices)]
)}
}
})
#Display all input Data
output$contents <- renderTable(digits = NULL,{
df <-myData()
df
})
}
enableBookmarking("server")
shinyApp(ui, server)
You can save all needed inputs in a file, and then reapply them with functions like updateRadioButtons() and others.
Saving it to the file could look like this:
observeEvent(input$someRadioButton, {
states <- list()
states$someRadioButton <- input$someRadioButton
#you can save all the needed inputs like this
...
save(states, file = paste0(getwd(), "/myfile"))
})
I am new to the shiny, I would like to edit different multiple data frames by radio button or selectinput by using rhandsontable package. However, my script can not show other data frame but only the first one, I don't know what is the problem.
ui.R:
library(rhandsontable)
fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("select2", label = h3("Choose to edit"),
choices = list("003.csv", "004.csv", "005.csv",
"006.csv", "007.csv"),
selected = "003.csv"),
actionButton("saveBtn", "Save changes")
),
mainPanel(
rHandsontableOutput("hot")
)))
server.R
values <- reactiveValues()
setHot <- function(x) values[["hot"]] <<- x
function(input, output, session) {
fname <- reactive({
x <- input$select2
return(x)
})
observe({
input$saveBtn # update csv file each time the button is pressed
if (!is.null(values[["hot"]])) {
write.csv(x = values[["hot"]], file = fname(), row.names = FALSE)
}
})
output$hot <- renderRHandsontable({
if (!is.null(input$hot)) { # if there is an rhot user input...
DF <- hot_to_r(input$hot) # convert rhandsontable data to R object
and store in data frame
setHot(DF) # set the rhandsontable values
} else {
DF <- read.csv(fname(), stringsAsFactors = FALSE) # else pull table from the csv (default)
setHot(DF) # set the rhandsontable values
}
rhandsontable(DF) %>% # actual rhandsontable object
hot_table(highlightCol = TRUE, highlightRow = TRUE, readOnly = TRUE) %>%
hot_col("Status", readOnly = FALSE)
})}
I can edit and save the dataframe that it shows the first one 003.csv, however when i use the drop down list to 004.csv, it didn't show the dataframe. please advise.
This will write (and possibly overwrite ⚠ any existing file with) dummy data:
for (i in c("003.csv", "004.csv", "005.csv", "006.csv", "007.csv")) {
write.csv(cbind(V1 = rep(i, 3), Status = "foo"), i, row.names = FALSE)
}
I overhauled server a bit:
library(shiny)
library(rhandsontable)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput(
"select2", label = h3("Choose to edit"), selected = "003.csv",
choices = list("003.csv", "004.csv", "005.csv", "006.csv", "007.csv")
),
actionButton("saveBtn", "Save changes")
),
mainPanel(
rHandsontableOutput("hot")
)
)
)
server <- function(input, output, session) {
DF <- reactiveVal()
observe({
DF(read.csv(input$select2, stringsAsFactors = FALSE))
})
observe({
if (!is.null(input$hot)) DF(hot_to_r(input$hot))
})
observeEvent(input$saveBtn, {
if (!is.null(DF())) write.csv(DF(), input$select2, row.names = FALSE)
})
output$hot <- renderRHandsontable({
rhandsontable(DF()) %>%
hot_table(highlightCol = TRUE, highlightRow = TRUE, readOnly = TRUE) %>%
hot_col("Status", readOnly = FALSE)
})
}
shinyApp(ui, server)