我正在构建一个应用,允许用户从selectizeInput
或checkboxInput
传递值以形成数据帧。我搜索了一段时间,发现这些来源与我的期望相似:
来自这里:https://github.com/jrowen/rhandsontable。我和这个例子很相似:
shiny::runGitHub("jrowen/rhandsontable",
subdir = "inst/examples/rhandsontable_portfolio")
但我想使用闪亮的小部件将值传递给数据帧。它应该能够添加/删除行,如下例所示:
代码在这里:
library("shiny")
library('devtools')
install_github('shiny-incubator', 'rstudio')
library("shinyIncubator")
# initialize data with colnames
df <- data.frame(matrix(c("0","0"), 1, 2))
colnames(df) <- c("Input1", "Input2")
server = shinyServer(
function(input, output) {
# table of outputs
output$table.output <- renderTable(
{ res <- matrix(apply(input$data,1,prod))
res <- do.call(cbind, list(input$data, res))
colnames(res) <- c("Input 1","Input 2","Product")
res
}
, include.rownames = FALSE
, include.colnames = TRUE
, align = "cccc"
, digits = 2
, sanitize.text.function = function(x) x
)
}
)
ui = shinyUI(
pageWithSidebar(
headerPanel('Simple matrixInput example')
,
sidebarPanel(
# customize display settings
tags$head(
tags$style(type='text/css'
, "table.data { width: 300px; }"
, ".well {width: 80%; background-color: NULL; border: 0px solid rgb(255, 255, 255); box-shadow: 0px 0px 0px rgb(255, 255, 255) inset;}"
, ".tableinput .hide {display: table-header-group; color: black; align-items: center; text-align: center; align-self: center;}"
, ".tableinput-container {width: 100%; text-align: center;}"
, ".tableinput-buttons {margin: 10px;}"
, ".data {background-color: rgb(255,255,255);}"
, ".table th, .table td {text-align: center;}"
)
)
,
wellPanel(
h4("Input Table")
,
matrixInput(inputId = 'data', label = 'Add/Remove Rows', data = df)
,
helpText("This table accepts user input into each cell. The number of rows may be controlled by pressing the +/- buttons.")
)
)
,
mainPanel(
wellPanel(
wellPanel(
h4("Output Table")
,
tableOutput(outputId = 'table.output')
,
helpText("This table displays the input matrix together with the product of the rows of the input matrix")
)
)
)
)
)
runApp(list(ui = ui, server = server))
该值应由用户从selectizeInput
,checkboxInput
或textInput
等闪亮小部件输入,并在用户点击actionButton
后传递给数据框。我想要的是与上述功能的组合非常相似,但我不知道该怎么做。有什么建议吗?
非常感谢提前。
答案 0 :(得分:6)
虽然我最终没有使用这两个软件包,但这很好用:
library(shiny)
server = shinyServer(function(input, output, session){
values <- reactiveValues()
values$DT <- data.frame(Name = NA,
status = NA,
compare = NA,
stringsAsFactors = FALSE)
newEntry <- observeEvent(input$addrow, {
newLine <- c(input$textIn, input$boxIn, input$selectIn)
values$DT <- rbind(values$DT, newLine)
})
newEntry <- observeEvent(input$revrow, {
deleteLine <- values$DT[-nrow(values$DT), ]
values$DT <- deleteLine
})
output$table <- renderTable({
values$DT
})
})
ui = shinyUI(navbarPage(
"Backtest System", inverse = TRUE, id = "navbar",
tabPanel("Strategy",
sidebarLayout(
sidebarPanel(
h4("Indicator"),
textInput("textIn", "Text", "try"),
checkboxInput("boxIn", "Box", TRUE),
selectizeInput("selectIn", "Select",
choices = c(">" = ">",
">=" = ">=",
"<" = "<",
"<=" = "<=")),
actionButton("addrow", "Add Row"),
actionButton("revrow", "Remove Row")
),
mainPanel(
tableOutput("table")
)
)
)
)
)
runApp(list(ui = ui, server = server))