Question

您好，我试图通过ui中的操作按钮来控制服务器功能中的输入，但是我只是无法做到这一点。该输入将提交到textser中的serer函数中观察到的文本输入，然后读取一个csv文件。然后，应将某些操作后的csv文件呈现为表格。观察事件按预期方式工作，但是不会呈现表。

下面是r代码

library(shiny)
library(shinydashboard)
library(dplyr)
library(ggplot2)
library(bigrquery)
library(dplyr)
library(readr)
library(reticulate)
library(tidyverse)
library(memisc) 

if (interactive()) {
  ui <- dashboardPage(
    dashboardHeader(),
    dashboardSidebar(),
    dashboardBody())
  server <- function(input, output) {}


#Dashboard header carrying the title of the dashboard
header <- dashboardHeader(title = "Video Analyser", titleWidth = 250)  
#Sidebar content of the dashboard
sidebar <- dashboardSidebar(disable = FALSE, 
                            sidebarMenu(
                              textInput('link', label = "Enter Valid Youtube URL"),
                              actionButton("update" ,"Run Analysis", icon("analysis"),
                                           class = "btn btn-primary")
                              )
                            )

frow1 <- fluidRow( 

  box(
    title = "Retention Labels"
    ,status = "primary"
    ,solidHeader = TRUE 
    ,collapsible = FALSE
    ,width = 4
    ,height = 400
    ,tableOutput('label')
    ,collapsed = FALSE
    ,br()

  ))
)

# combine the two fluid rows to make the body
body <- dashboardBody(frow1, frow2)

ui <- dashboardPage(title = 'Serato Audience Builder', header, sidebar, body, skin='blue')

server <- function(input, output) {
  source_python("pytho_for_r.py")
  observe({
    input$update
    x <- isolate(input$link)
    if(x == ""){
      print(x)}
    else{
      label_retention <- read.csv("label_retention.csv", header = TRUE)
      print(label_retention)

    }
  })

  output$label <- renderTable({
    if(!is.null(label_retention)){
      datatable(label_retention %>%
                  dplyr::select(Description, sum) %>%
                  mutate_if(is.character, str_to_upper) %>%
                  dplyr::mutate(sum = round(sum, 8)) %>%
                  dplyr::rename_at(1, ~ "Labels") %>%
                  dplyr::rename_at(2, ~ "Relative Audience Retention") %>%
                  dplyr::arrange_at("Relative Audience Retention", desc),
                  spacing = c("s"), striped = TRUE, bordered = TRUE, colnames = TRUE,
                  hover = TRUE)}
    else{print("No Video Available")}
  })
  # 
}
shinyApp(ui = ui, server = server)
}

我希望有人帮助我了解我在这里缺少什么，并帮助我解决此问题。

非常感谢！

dput的输出-

structure(list(Start = c(0, 0, 0, 0, 0, 0), End = c(2.333333, 
2.333333, 2.333333, 2.333333, 2.333333, 2.333333), Description..Con = structure(c(25L, 
10L, 13L, 15L, 12L, 4L), .Label = c("3d modeling", "black", "black and white", 
"brand", "computer program", "computer terminal", "editing", 
"eyewear", "film noir", "font", "glasses", "graphic design", 
"graphics", "graphics software", "logo", "monochrome", "monochrome photography", 
"multimedia", "multimedia software", "picture editor", "software", 
"song", "sound design", "symbol", "text", "trademark", "tutorial", 
"video editing software", "video editor"), class = "factor"), 
    sum = c(0.53732, 0.484516, 0.648579, 0.457803, 0.475811, 
    0.373938)), row.names = c(NA, 6L), class = "data.frame")

  Start      End Description..Con      sum
1     0 2.333333             text 0.537320
2     0 2.333333             font 0.484516
3     0 2.333333         graphics 0.648579
4     0 2.333333             logo 0.457803
5     0 2.333333   graphic design 0.475811
6     0 2.333333            brand 0.373938

Answer 1

您需要在我的代码中标记的server部分中进行更改。 -

server <- function(input, output) {
  source_python("pytho_for_r.py")
  label_retention <- eventReactive(input$update, { # use eventReactive()
    x <- input$link # isolate not needed anymore
    if(x == ""){
      print(x)
      return(NULL)
    }
    else{
      label_retention <- read.csv("label_retention.csv", header = T, stringsAsFactors = F)
      print(label_retention)
      return(label_retention)
    }
  })

  output$label <- renderTable({
    validate( # use validate() for checks
      need(!is.null(label_retention()), "No Video Available") # use label_retention()
    )
    label_retention() %>%             # use label_retention() to call reactive
      select(Labels = Description..Con, Relative_Audience_Retention = sum) %>%
      mutate_if(is.character, str_to_upper) %>%
      mutate(Relative_Audience_Retention = round(Relative_Audience_Retention, 8)) %>%
      arrange(desc(Relative_Audience_Retention)) 
      # datatable( # need to use DT::renderDT() for this
      # removed datatable(); some args probably need to go in options = list(); see docs
      #   spacing = c("s"), striped = TRUE, bordered = TRUE, colnames = TRUE,
      #   hover = TRUE
      # )
  })
}

无法根据闪亮的仪表板中的textinput呈现表

1 个答案: