将输入ID设置为数据框-闪亮

时间:2018-08-16 09:21:58

标签: r dataframe input shiny shinydashboard

我想从一个tableOutput(criteriaweights)获取值,对其进行修改,然后将其放入另一个tableOutput(criterianormalisedweights)

我遇到了问题,因为无法为它们设置输入ID,以便以后可以访问它们。

这是我的代码

# import all necessary packages
library(shiny)
library(shinydashboard)
library(htmlwidgets) 
library(data.table) 


####################################
##############   UI   ##############
####################################


ui <- dashboardPage(

skin="blue",

dashboardHeader(
title="dd",
titleWidth = 300
),

dashboardSidebar(
width = 300,
sidebarMenu(
  menuItem(
    "Gathering Information",
    tabName = "gatheringinformation",
    icon=icon("github")
  )

)),

dashboardBody(
tabItems(
  tabItem(tabName = "gatheringinformation",
          h2("Gathering Information"),

          # 1st row of boxes
          fluidRow(

              box(
                width = 4, 
                title = "Inputs",
                status= "primary",
                solidHeader = TRUE,
                h5("Please specify the number of alternatives, criteria and experts"),

                numericInput("criteria", h3("Criteria"), 
                             value = "1")
              ),

            box(title = "Weights of Criteria", 
                width = 12,
                status = "primary", 
                solidHeader = TRUE,
                collapsible = TRUE,
                div(style = 'overflow-x: scroll'),
                splitLayout(tableOutput("criteriaweights"))

            ),

            box(title = "Normalised Weights of Criteria", 
                width = 12,
                status = "primary", 
                solidHeader = TRUE,
                collapsible = TRUE,
                div(style = 'overflow-x: scroll'),
                splitLayout(tableOutput("criterianormalisedweights"))

            )

          )
  )  
)))

server <- function(input, output, session) {
isolate({
output$criteriaweights <- renderTable({
num.inputs.col1 <- paste0("<input id='cr_r", 1, "c", 1, "' 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='cr_r", 1, "c", i, "' class='shiny-bound-input' type='number' value='1'>")
    df <- cbind(df,num.inputs.coli)
  }
}
colnames(df) <- paste0("time ",as.numeric(1:input$criteria))
df
}, sanitize.text.function = function(x) x)
})


isolate({
output$criterianormalisedweights <- renderTable({
  num.inputs.col1 <- paste0("<input id='crn_r1c1'    value =  ",input[[paste0("cr_r1c1")]],">")
  df <- data.frame(num.inputs.col1)
  if (input$criteria >= 2){
    for (i in 2:input$criteria){
      num.inputs.coli <- paste0("<input id='crn_r1c",i,"'   value =  ",input[[paste0("cr_r1c",i,"")]],">")
      df <- cbind(df,num.inputs.coli)
    }
  }
  df[,] = apply(df[,,],1,function(x){as.numeric(x)/sum(as.numeric(x))})
  colnames(df) <- paste0("time ",as.numeric(1:input$criteria))
  if (length(df)==0)
    return(NULL)
  df
  })
})


 }

 # Run the application 
 shinyApp(ui = ui, server = server)

我可以做到

library(shiny)
library(shinydashboard)
library(htmlwidgets) 
library(data.table) 


####################################
##############   UI   ##############
####################################


ui <- dashboardPage(

skin="blue",

dashboardHeader(
title="dd",
titleWidth = 300
),

dashboardSidebar(
width = 300,
sidebarMenu(
  menuItem(
    "Gathering Information",
    tabName = "gatheringinformation",
    icon=icon("github")
  )

)),

dashboardBody(
tabItems(
  tabItem(tabName = "gatheringinformation",
          h2("Gathering Information"),

          # 1st row of boxes
          fluidRow(

              box(
                width = 4, 
                title = "Inputs",
                status= "primary",
                solidHeader = TRUE,
                h5("Please specify the number of alternatives, criteria and experts"),

                numericInput("criteria", h3("Criteria"), 
                             value = "1")
              ),

            box(title = "Weights of Criteria", 
                width = 12,
                status = "primary", 
                solidHeader = TRUE,
                collapsible = TRUE,
                div(style = 'overflow-x: scroll'),
                splitLayout(tableOutput("criteriaweights"))

            ),

            box(title = "Normalised Weights of Criteria", 
                width = 12,
                status = "primary", 
                solidHeader = TRUE,
                collapsible = TRUE,
                div(style = 'overflow-x: scroll'),
                splitLayout(tableOutput("criterianormalisedweights"))

            )

          )
  )  
)))

server <- function(input, output, session) {
isolate({
output$criteriaweights <- renderTable({
num.inputs.col1 <- paste0("<input id='cr_r", 1, "c", 1, "' 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='cr_r", 1, "c", i, "' class='shiny-bound-input' type='number' value='1'>")
    df <- cbind(df,num.inputs.coli)
  }
}
colnames(df) <- paste0("time ",as.numeric(1:input$criteria))
df
}, sanitize.text.function = function(x) x)
})




isolate({
output$criterianormalisedweights <- renderTable({
  num.inputs.col1 <- paste0(input[[paste0("cr_r1c1")]])
  df <- data.frame(num.inputs.col1)
  if (input$criteria >= 2){
    for (i in 2:input$criteria){
      num.inputs.coli <- paste0(input[[paste0("cr_r1c",i,"")]])
      df <- cbind(df,num.inputs.coli)
    }
  }

  df[,] = apply(df[,,drop=F],1,function(x){as.numeric(x)/sum(as.numeric(x))})
  colnames(df) <- paste0("time ",as.numeric(1:input$criteria))
  if (length(df)==0)
    return(NULL)
  df
})
})
}

# Run the application 
shinyApp(ui = ui, server = server)

但是后来我无法访问数据进行进一步的计算,因为它们没有输入ID。

关于如何克服这个问题的任何想法?

0 个答案:

没有答案