В R shining как отобразить таблицу реактивных данных?

avatar
Curious Jorge - user9788072
9 августа 2021 в 06:18
225
1
0

Приведенный ниже код MWE работает должным образом, за исключением того, что вывод таблицы данных не отображается на главной панели при нажатии кнопки действия «Векторные значения» на вкладке «По балансам» (первая вкладка, которая отображается по умолчанию) .

На данный момент я хотел бы отобразить таблицу в базе Shiny без использования пакета таблиц, такого как DT.

Я не думаю, что указанная ниже функция vectorsAll необходима, вместо нее я пробовал использовать функцию yield(), и она все равно не работает.

Что я делаю не так? Это должна быть такая простая вещь, визуализация таблицы данных из 60 строк, я уверен, что упускаю из виду что-то очень очевидное.

функция vectorPlot, которая соответствует MWE ниже:

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)
Источник
Maurits Evers
9 августа 2021 в 06:42
0

Я получаю сообщение об ошибке при попытке запустить MWE: Error: could not find function "vectorPlot".

Curious Jorge - user9788072
9 августа 2021 в 08:23
0

Я боялся, что пропущу функцию! Вот vectorPlot: vectorPlot <- function(w,x,y,z){plot(w,main=x,xlab=y,ylab=z,type="b",col="blue",pch=19 ,секс=1,25)}

YBS
9 августа 2021 в 11:38
0

Попробуйте observeEvent(input$showVectorValueBtn,{showResults$showme <- tableOutput("table1")})

Curious Jorge - user9788072
20 августа 2021 в 16:15
0

Спасибо YBS, это работает. Так что моя ошибка заключалась в том, что я использовал show("table1") вместо tableOutput("table1"). Также я упустил еще одну пользовательскую функцию «pct» в исходном MWE, который я опубликовал. Я отвечу на вопрос, используя ваше исправление, и укажу все функции, необходимые для правильной работы.

Ответы (1)

avatar
Curious Jorge - user9788072
20 августа 2021 в 16:23
0

Ошибка заключалась в использовании show("table1") вместо tableOutput("table1") в последнем observeEvent в исходном коде MWE, опубликованном выше. Также были ошибочно опущены две пользовательские функции в оригинальном MWE: «pct» и «vectorPlot». Пересмотренный код MWE ниже теперь использует правильный синтаксис вывода таблицы и включает все необходимые функции. Теперь работает как задумано. Спасибо комментарию 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)