I have written this code in order to bookmark inputs from dynamically created elements.
As you can see i have managed to do it with the first table (output$othertable) but no with the output$ratings. Is this because of the renderUI?
I found this https://github.com/rstudio/shiny/pull/2139 so i installed the latest package in order to overcome this.
Unfortunately this was not the solution.
Any ideas??
library(shiny)
library(shinydashboard)
library(htmlwidgets)
library(data.table)
ui <- function(request){dashboardPage(
skin="blue",
dashboardHeader(
title="sth",
titleWidth = 300),
dashboardSidebar(
width = 300,
sidebarMenu(
menuItem(
"Gathering Information",
tabName = "gatheringinformation",
icon=icon("github")
)
)),
dashboardBody(
tabItem(tabName = "gatheringinformation",
h2("Gathering Information"),
bookmarkButton(),
fluidRow(
box(
width = 4,
title = "Inputs",
status= "primary",
solidHeader = TRUE,
h5("Please specify the number of alternatives, criteria and experts"),
numericInput("alternatives", h3("Alternatives"),
value = "1"),
numericInput("criteria", h3("Criteria"),
value = "1"),
numericInput("experts", h3("Experts"),
value = "1")
),
box(title = "Alternatives",
width = 4,
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
div(style = 'overflow-x: scroll'),
splitLayout(tableOutput("othertable"))
),
box(title = "View Data",
width = 12,
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
div(style = 'overflow-x: scroll'),
splitLayout(uiOutput("ratings"))
))
)))}
####################################
############ SERVER ############
####################################
server <- function(input, output, session) {
onBookmark(function(state) {
for (i in 1:input$alternatives){
state$values$alternativestable[i] <- input[[paste0("data_alternatives_r",i,"c1")]]}
for (i in 1:input$criteria){
state$values$criteriatable[i] <- input[[paste0("data_criteria_r",i,"c1")]]}
someData <- rep(NaN, input$alternatives*input$criteria*input$experts);
state$values$viewdatatable<-array(someData, c(input$alternatives, input$criteria, input$experts))
for (i in 1:input$experts){
for (m in 1:input$criteria){
for (n in 1:input$alternatives){
state$values$viewdatatable[n,m,i] <- input[[paste0("t",i,"r",n,"c",m)]]
l<-state$values$viewdatatable[n,m,i]<-input[[paste0("t1r1c1")]]
}}
}
})
onRestore(function(state) {
for (i in 1:input$alternatives){
Y <- state$values$alternativestable[i]
updateNumericInput(session, paste0("data_alternatives_r",i,"c1"), value = Y)
}
for (i in 1:input$experts){
for (m in 1:input$criteria){
for (n in 1:input$alternatives){
Y <- state$values$viewdatatable[n,m,i]
updateNumericInput(session, paste0("t",i,"r",n,"c",m), value = Y)
}}}
})
isolate({
output$othertable <-
renderTable({
text.inputs.col1 <- paste0("<input id='data_alternatives_r", 1:input$alternatives, "c", 1, "' class='shiny-bound-input' type='text' value=''>")
df_data_alternatives <- data.frame(text.inputs.col1)
colnames(df_data_alternatives) <- paste0("Alternatives")
df_data_alternatives
},sanitize.text.function = function(x) x)})
isolate({
output$ratings <- renderUI({lapply(1:input$experts,function(j){
renderTable({
num.inputs.col1 <- paste0("<input id='t",j, "r", 1:input$alternatives, "c", 1, "' class='shiny-bound-input' type='number' value='1'>")
#num.inputs.col2 <- paste0("<input id='t",j, "r", 1:input$alternatives, "c", 2, "' class='shiny-bound-input' type='number' value='1'>")
df <- data.frame(num.inputs.col1)
if (input$criteria >= 2){
for (i in 2:input$criteria){
num.inputs.coli <- paste0("<input id='t",j, "r", 1:input$alternatives, "c", i, "' class='shiny-bound-input' type='number' value='1'>")
df <- cbind(df,num.inputs.coli)
}
}
colnames(df) <- paste0("Criteria ",as.numeric(1:input$criteria))
rownames(df) <- paste0("Alternative ",as.numeric(1:input$alternatives))
df
},align = 'c',rownames = TRUE,caption = paste("Expert " ,j), caption.placement = getOption("xtable.caption.placement", "top"), sanitize.text.function = function(x) x)})})
})
}
# Run the application
shinyApp(ui = ui, server = server,enableBookmarking = "url")