在 R shiny 中如何渲染反应数据 table？
In R shiny how to render a reactive data table?
下面的 MWE 代码按预期工作，除了在“按余额”选项卡中单击“矢量值”操作按钮时数据 table 输出未在主面板中呈现（首先默认显示的选项卡）。
现在我想在不使用 table 包（例如 DT）的情况下在 base Shiny 中渲染 table。
我认为下面的 vectorsAll 函数不是必需的，我已经用 yield() 函数尝试过，但它仍然不起作用。
我做错了什么？这应该是一件很简单的事情，渲染一个 60 行的数据 table，我确定我忽略了一些非常明显的东西。
与以下 MWE 配套的 vectorPlot 函数：
vectorPlot <- function(w,x,y,z){plot(w,main=x,xlab=y,ylab=z,type="b",col="blue",pch=19,cex=1.25)}
MWE：
library(shiny)
library(shinyMatrix)
library(shinyjs)
button2 <- function(x,y){actionButton(x,y,style="width:90px;margin-bottom:5px;font-size:80%")}
matrix1Input <- function(x){
matrixInput(x,
value = matrix(c(0.2), 4, 1, dimnames = list(c("A","B","C","D"),NULL)),
rows = list(extend = FALSE, names = TRUE),
cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
class = "numeric")}
vectorBase <- function(x,y){
a <- rep(y,x)
b <- seq(1:x)
c <- data.frame(x = b, y = a)
return(c)}
ui <-
pageWithSidebar(
headerPanel("Model..."),
sidebarPanel(
fluidRow(helpText(h5(strong("Base Input Panel")),align="center",
style="margin-top:-15px;margin-bottom:5px")),
# Panels rendered with uiOuput & renderUI in server to stop flashing at invocation
uiOutput("Panels")
), # close sidebar panel
mainPanel(
tabsetPanel(
tabPanel("By balances", value=2,
fluidRow(h5(strong(helpText("Select model output to view:")))),
fluidRow(
button2('showVectorPlotBtn','Vector plots'),
button2('showVectorValueBtn','Vector values'),
), # close fluid row
div(style = "margin-top: 5px"),
# Shows outputs on each page of main panel
uiOutput('showResults'),
), # close tab panel
tabPanel("By accounts", value=3),
tabPanel("Liabilities module", value=4),
id = "tabselected"
) # close tabset panel
) # close main panel
) # close page with sidebar
server <- function(input,output,session)({
base_input <- reactive(input$base_input)
showResults <- reactiveValues()
yield <- function(){vectorBase(60,input$base_input[1,1])} # Must remain in server section
# --- Conditional panels rendered here rather than in UI to eliminate invocation flashing ---------->
output$Panels <- renderUI({
tagList(
conditionalPanel(
condition="input.tabselected==2",
matrix1Input("base_input"),
div(style = "margin-top: 0px"),
useShinyjs(),
), # close conditional panel
conditionalPanel(condition="input.tabselected==3"),
conditionalPanel(condition="input.tabselected==4")
) # close tagList
}) # close renderUI
# --- Below produces vector plots as default view when first invoking App ----------------------------->
output$graph1 <-renderPlot(vectorPlot(yield(),"A Variable","Period","Rate"))
# --- Below produces vector plots after having clicked "Vector Plot" button; see above for pre-click ->
observeEvent(input$showVectorPlotBtn,
{showResults$showme <-
tagList(plotOutput("graph1"))
},ignoreNULL = FALSE)
# --- Below produces vector values table ------------------------------------------------------------->
vectorsAll <- reactive({cbind(Period = 1:60,Yld_Rate = pct(yield()[,2]))})
output$table1 <- renderTable({vectorsAll()})
observeEvent(input$showVectorValueBtn,{showResults$showme <- show("table1")})
# --- Below sends both vector plots and vector values to UI section above ---------------------------->
output$showResults <- renderUI({showResults$showme})
}) # close server
shinyApp(ui, server)
错误是在上面发布的原始 MWE 代码的最后 observeEvent 中使用 show("table1") 而不是 tableOutput("table1")。原始 MWE 中的两个自定义函数也被错误地省略了：“pct”和“vectorPlot”。下面修改后的 MWE 代码现在使用正确的 table 输出语法并包括所有必需的函数。现在它按预期运行。感谢YBS评论指出错误
library(shiny)
library(shinyMatrix)
library(shinyjs)
button2 <- function(x,y){actionButton(x,y,style="width:90px;margin-bottom:5px;font-size:80%")}
matrix1Input <- function(x){
matrixInput(x,
value = matrix(c(0.2), 4, 1, dimnames = list(c("A","B","C","D"),NULL)),
rows = list(extend = FALSE, names = TRUE),
cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
class = "numeric")}
pct <- function(x){paste(format(round(x*100,digits=1),nsmall=1),"%",sep="")} # convert to percentage
vectorBase <- function(x,y){
a <- rep(y,x)
b <- seq(1:x)
c <- data.frame(x = b, y = a)
return(c)}
vectorPlot <- function(w,x,y,z){plot(w,main=x,xlab=y,ylab=z,type="b",col="blue",pch=19,cex=1.25)}
ui <-
pageWithSidebar(
headerPanel("Model..."),
sidebarPanel(
fluidRow(helpText(h5(strong("Base Input Panel")),align="center",
style="margin-top:-15px;margin-bottom:5px")),
# Panels rendered with uiOuput & renderUI in server to stop flashing at invocation
uiOutput("Panels")
), # close sidebar panel
mainPanel(
tabsetPanel(
tabPanel("By balances", value=2,
fluidRow(h5(strong(helpText("Select model output to view:")))),
fluidRow(
button2('showVectorPlotBtn','Vector plots'),
button2('showVectorValueBtn','Vector values'),
), # close fluid row
div(style = "margin-top: 5px"),
# Shows outputs on each page of main panel
uiOutput('showResults'),
), # close tab panel
tabPanel("By accounts", value=3),
tabPanel("Liabilities module", value=4),
id = "tabselected"
) # close tabset panel
) # close main panel
) # close page with sidebar
server <- function(input,output,session)({
base_input <- reactive(input$base_input)
showResults <- reactiveValues()
yield <- function(){vectorBase(60,input$base_input[1,1])} # Must remain in server section
# --- Conditional panels rendered here rather than in UI to eliminate invocation flashing ---------->
output$Panels <- renderUI({
tagList(
conditionalPanel(
condition="input.tabselected==2",
matrix1Input("base_input"),
div(style = "margin-top: 0px"),
useShinyjs(),
), # close conditional panel
conditionalPanel(condition="input.tabselected==3"),
conditionalPanel(condition="input.tabselected==4")
) # close tagList
}) # close renderUI
# --- Below produces vector plots as default view when first invoking App ----------------------------->
output$graph1 <-renderPlot(vectorPlot(yield(),"A Variable","Period","Rate"))
# --- Below produces vector plots after having clicked "Vector Plot" button; see above for pre-click ->
observeEvent(input$showVectorPlotBtn,
{showResults$showme <-
tagList(plotOutput("graph1"))
},ignoreNULL = FALSE)
# --- Below produces vector values table ------------------------------------------------------------->
vectorsAll <- reactive({cbind(Period = 1:60,Yld_Rate = pct(yield()[,2]))})
output$table1 <- renderTable({vectorsAll()})
observeEvent(input$showVectorValueBtn,{showResults$showme <- tableOutput("table1")})
# --- Below sends both vector plots and vector values to UI section above ---------------------------->
output$showResults <- renderUI({showResults$showme})
}) # close server
shinyApp(ui, server)
下面的 MWE 代码按预期工作，除了在“按余额”选项卡中单击“矢量值”操作按钮时数据 table 输出未在主面板中呈现（首先默认显示的选项卡）。
现在我想在不使用 table 包（例如 DT）的情况下在 base Shiny 中渲染 table。
我认为下面的 vectorsAll 函数不是必需的，我已经用 yield() 函数尝试过，但它仍然不起作用。
我做错了什么？这应该是一件很简单的事情，渲染一个 60 行的数据 table，我确定我忽略了一些非常明显的东西。
与以下 MWE 配套的 vectorPlot 函数：
vectorPlot <- function(w,x,y,z){plot(w,main=x,xlab=y,ylab=z,type="b",col="blue",pch=19,cex=1.25)}
MWE：
library(shiny)
library(shinyMatrix)
library(shinyjs)
button2 <- function(x,y){actionButton(x,y,style="width:90px;margin-bottom:5px;font-size:80%")}
matrix1Input <- function(x){
matrixInput(x,
value = matrix(c(0.2), 4, 1, dimnames = list(c("A","B","C","D"),NULL)),
rows = list(extend = FALSE, names = TRUE),
cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
class = "numeric")}
vectorBase <- function(x,y){
a <- rep(y,x)
b <- seq(1:x)
c <- data.frame(x = b, y = a)
return(c)}
ui <-
pageWithSidebar(
headerPanel("Model..."),
sidebarPanel(
fluidRow(helpText(h5(strong("Base Input Panel")),align="center",
style="margin-top:-15px;margin-bottom:5px")),
# Panels rendered with uiOuput & renderUI in server to stop flashing at invocation
uiOutput("Panels")
), # close sidebar panel
mainPanel(
tabsetPanel(
tabPanel("By balances", value=2,
fluidRow(h5(strong(helpText("Select model output to view:")))),
fluidRow(
button2('showVectorPlotBtn','Vector plots'),
button2('showVectorValueBtn','Vector values'),
), # close fluid row
div(style = "margin-top: 5px"),
# Shows outputs on each page of main panel
uiOutput('showResults'),
), # close tab panel
tabPanel("By accounts", value=3),
tabPanel("Liabilities module", value=4),
id = "tabselected"
) # close tabset panel
) # close main panel
) # close page with sidebar
server <- function(input,output,session)({
base_input <- reactive(input$base_input)
showResults <- reactiveValues()
yield <- function(){vectorBase(60,input$base_input[1,1])} # Must remain in server section
# --- Conditional panels rendered here rather than in UI to eliminate invocation flashing ---------->
output$Panels <- renderUI({
tagList(
conditionalPanel(
condition="input.tabselected==2",
matrix1Input("base_input"),
div(style = "margin-top: 0px"),
useShinyjs(),
), # close conditional panel
conditionalPanel(condition="input.tabselected==3"),
conditionalPanel(condition="input.tabselected==4")
) # close tagList
}) # close renderUI
# --- Below produces vector plots as default view when first invoking App ----------------------------->
output$graph1 <-renderPlot(vectorPlot(yield(),"A Variable","Period","Rate"))
# --- Below produces vector plots after having clicked "Vector Plot" button; see above for pre-click ->
observeEvent(input$showVectorPlotBtn,
{showResults$showme <-
tagList(plotOutput("graph1"))
},ignoreNULL = FALSE)
# --- Below produces vector values table ------------------------------------------------------------->
vectorsAll <- reactive({cbind(Period = 1:60,Yld_Rate = pct(yield()[,2]))})
output$table1 <- renderTable({vectorsAll()})
observeEvent(input$showVectorValueBtn,{showResults$showme <- show("table1")})
# --- Below sends both vector plots and vector values to UI section above ---------------------------->
output$showResults <- renderUI({showResults$showme})
}) # close server
shinyApp(ui, server)
错误是在上面发布的原始 MWE 代码的最后 observeEvent 中使用 show("table1") 而不是 tableOutput("table1")。原始 MWE 中的两个自定义函数也被错误地省略了：“pct”和“vectorPlot”。下面修改后的 MWE 代码现在使用正确的 table 输出语法并包括所有必需的函数。现在它按预期运行。感谢YBS评论指出错误
library(shiny)
library(shinyMatrix)
library(shinyjs)
button2 <- function(x,y){actionButton(x,y,style="width:90px;margin-bottom:5px;font-size:80%")}
matrix1Input <- function(x){
matrixInput(x,
value = matrix(c(0.2), 4, 1, dimnames = list(c("A","B","C","D"),NULL)),
rows = list(extend = FALSE, names = TRUE),
cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
class = "numeric")}
pct <- function(x){paste(format(round(x*100,digits=1),nsmall=1),"%",sep="")} # convert to percentage
vectorBase <- function(x,y){
a <- rep(y,x)
b <- seq(1:x)
c <- data.frame(x = b, y = a)
return(c)}
vectorPlot <- function(w,x,y,z){plot(w,main=x,xlab=y,ylab=z,type="b",col="blue",pch=19,cex=1.25)}
ui <-
pageWithSidebar(
headerPanel("Model..."),
sidebarPanel(
fluidRow(helpText(h5(strong("Base Input Panel")),align="center",
style="margin-top:-15px;margin-bottom:5px")),
# Panels rendered with uiOuput & renderUI in server to stop flashing at invocation
uiOutput("Panels")
), # close sidebar panel
mainPanel(
tabsetPanel(
tabPanel("By balances", value=2,
fluidRow(h5(strong(helpText("Select model output to view:")))),
fluidRow(
button2('showVectorPlotBtn','Vector plots'),
button2('showVectorValueBtn','Vector values'),
), # close fluid row
div(style = "margin-top: 5px"),
# Shows outputs on each page of main panel
uiOutput('showResults'),
), # close tab panel
tabPanel("By accounts", value=3),
tabPanel("Liabilities module", value=4),
id = "tabselected"
) # close tabset panel
) # close main panel
) # close page with sidebar
server <- function(input,output,session)({
base_input <- reactive(input$base_input)
showResults <- reactiveValues()
yield <- function(){vectorBase(60,input$base_input[1,1])} # Must remain in server section
# --- Conditional panels rendered here rather than in UI to eliminate invocation flashing ---------->
output$Panels <- renderUI({
tagList(
conditionalPanel(
condition="input.tabselected==2",
matrix1Input("base_input"),
div(style = "margin-top: 0px"),
useShinyjs(),
), # close conditional panel
conditionalPanel(condition="input.tabselected==3"),
conditionalPanel(condition="input.tabselected==4")
) # close tagList
}) # close renderUI
# --- Below produces vector plots as default view when first invoking App ----------------------------->
output$graph1 <-renderPlot(vectorPlot(yield(),"A Variable","Period","Rate"))
# --- Below produces vector plots after having clicked "Vector Plot" button; see above for pre-click ->
observeEvent(input$showVectorPlotBtn,
{showResults$showme <-
tagList(plotOutput("graph1"))
},ignoreNULL = FALSE)
# --- Below produces vector values table ------------------------------------------------------------->
vectorsAll <- reactive({cbind(Period = 1:60,Yld_Rate = pct(yield()[,2]))})
output$table1 <- renderTable({vectorsAll()})
observeEvent(input$showVectorValueBtn,{showResults$showme <- tableOutput("table1")})
# --- Below sends both vector plots and vector values to UI section above ---------------------------->
output$showResults <- renderUI({showResults$showme})
}) # close server
shinyApp(ui, server)