如何使用具有傳遞函數的功能在輸出閃爍時具有反應

Question

我沒有什麼問題。我已經構建了一個名爲d3K的包，可以跨不同的儀表板使用。其中一個函數如下：

conditionalRenderValueBox <- function(value, title, red_limit, yellow_limit){ 
     renderValueBox( valueBox(value, title, 
     color = if(class(value)=="character" | is.na(value)){ 
     "blue" 
     }else if(value>red_limit){ 
     "red" 
     }else if(value>yellow_limit){ 
     "yellow" 
     }else{ 
     "green" 
     } 
    )) 
} 

現在我試圖在函數中傳遞值參數，其中參數是無效值。

server.R

library(lubridate) 
# library(googleVis) 
# library(readr) 
library(shinyjs) 
library(ggplot2) 
library(plotly) 
library(d3K) 
library(dplyr) 
server <- function(input, output, session) { 

    v1 = reactive({ 
     input$v1 
    }) 

    f <- reactive({ 
     if(is.na(v1())){ 
      "WAI" 
     }else{ 
      runif(1, 1, 10) 
     } 
     }) 
output$t <- conditionalRenderValueBox(f(), "Possible Value", 15, 10) 
} 

ui.R

library(shinydashboard) 
library(shiny) 
library(shinyjs) 
library(plotly) 

ui <- dashboardPage(

    dashboardHeader(title = "DashBoard") 
    ,skin = 'yellow' 
    ,dashboardSidebar(
     tags$head(
     tags$style(HTML(" 
         .sidebar { height: 90vh; overflow-y: auto; } 
         ") 
    ) 
    ), 

     sidebarMenu(

      menuItem("R", tabName = "R", icon = icon("cog")) 
      , selectInput("v1", label = h3("Select box"), 
choices = list(1, 11, 15), 
selected = 1), 


    ) 

    ) 


    ,dashboardBody(
     tabItems(
      tabItem(
      tabName = "R" 
      , br() 
      , fluidRow(
        valueBoxOutput("t") 
       ) 

) 
) 
) 
) 

我不能看到數值框閃亮的儀表板。

但是，如果使用後在服務器輸出$ T plase代碼，它的工作原理

output$t <- renderValueBox( valueBox(f(), "title", 
      color = if(class(f())=="character" | is.na(f())){ 
      "blue" 
      }else if(f()>red_limit){ 
      "red" 
      }else if(f()>yellow_limit){ 
      "yellow" 
      }else{ 
      "green" 
      } 
     )) 

然後我能看到結果如預期

Answer 1

我發現它運行，如果你定義conditionalRenderValueBox在腳本中像這樣：

library(lubridate) 
# library(googleVis) 
# library(readr) 
library(shinyjs) 
library(ggplot2) 
library(plotly) 
# library(d3K) I don't have access to this package obviously 
library(dplyr) 
library(shinydashboard) 
library(shiny) 
library(shinyjs) 
library(plotly) 

conditionalRenderValueBox <- function(value, title, red_limit, yellow_limit){ 
    renderValueBox( valueBox(value, title, 
           color = if(class(value)=="character" | is.na(value)){ 
           "blue" 
           }else if(value>red_limit){ 
           "red" 
           }else if(value>yellow_limit){ 
           "yellow" 
           }else{ 
           "green" 
           } 
} 

server <- function(input, output, session) { 

    v1 = reactive({ 
    input$v1 
    }) 
    f <- reactive({ 
    if(is.na(v1())){ 
     "WAI" 
    }else{ 
     runif(1, 1, 10) 
    } 
    }) 
    output$t <- conditionalRenderValueBox(f(), "Possible Value", 15, 10) 

)) 
} 

ui <- dashboardPage(
    dashboardHeader(title = "DashBoard") 
    ,skin = 'yellow' 
    ,dashboardSidebar(
    tags$head(
     tags$style(HTML(" 
         .sidebar { height: 90vh; overflow-y: auto; } 
         ") 
    ) 
    ), 
    sidebarMenu(
     menuItem("R", tabName = "R", icon = icon("cog")) 
     , selectInput("v1", label = h3("Select box"), 
        choices = list(1, 11, 15), 
        selected = 1)  
    )  
) 
    ,dashboardBody(
    tabItems(
     tabItem(
     tabName = "R" 
     , br() 
     , fluidRow(
      valueBoxOutput("t") 
     ) 

    ) 
    ) 
) 
) 

runApp(shinyApp(server=server,ui=ui)) 

我猜問題是如何使你的包出口的功能，但它是我很難知道沒有看到鱈魚即

希望這會有所幫助。

編輯：嘿，我不知道你的d3K軟件包的確切功能，如果你已經得到它的工作，但據我可以告訴你不想寫包裝渲染*閃亮功能的函數。下面這個程序將無法正常工作：

myFunc <- function(x) { 
    renderTable({ 
    head(x) 
    }) 
} 

shinyApp(
    ui=fluidPage(
    selectInput("select","Choose dataset",c("mtcars","iris")), 
    tableOutput("table") 
    ), 
    server=function(input,output) { 

    dataset <- reactive({ 
     get(input$select) 
    }) 

    output$table <- myFunc(dataset()) 

    }) 

功能在啓動時運行一次，並呈現初始表，但因爲myFunc不明白樣反應渲染*函數後做永遠不會改變。

我覺得你的函數應該包住valueBox元素，然後你給你的功能renderValueBox像這樣：只有在第一次

library(lubridate) 
# library(googleVis) 
# library(readr) 
library(shinyjs) 
library(ggplot2) 
library(plotly) 
# library(d3K) I don't have access to this package obviously 
library(dplyr) 
library(shinydashboard) 
library(shiny) 
library(shinyjs) 
library(plotly) 

conditionalRenderValueBox <- function(value, title, red_limit, yellow_limit){ 

    #renderValueBox( 
    valueBox(value, title, 
          color = if(class(value)=="character" | is.na(value)){ 
           "blue" 
           }else if(value>red_limit){ 
           "red" 
           }else if(value>yellow_limit){ 
           "yellow" 
           }else{ 
           "green" 
           } 
) 
    #) 
} 

server <- function(input, output, session) { 

    v1 = reactive({ 
    input$v1 
    }) 
    f <- reactive({ 
    v1 <- v1() 
    print("Hey") 
    if(is.na(v1)){ 
     "WAI" 
    }else{ 
     runif(1, 1, 10) 
    } 
    }) 
    observe({ 
    output$t <- renderValueBox(conditionalRenderValueBox(f(), "Possible Value", 15, 10)) 
    }) 

} 

ui <- dashboardPage(
    dashboardHeader(title = "DashBoard") 
    ,skin = 'yellow' 
    ,dashboardSidebar(
    tags$head(
     tags$style(HTML(" 
         .sidebar { height: 90vh; overflow-y: auto; } 
         ") 
    ) 
    ), 
    sidebarMenu(
     menuItem("R", tabName = "R", icon = icon("cog")) 
     , selectInput("v1", label = h3("Select box"), 
        choices = list(1, 11, 15), 
        selected = 1)  
    )  
    ) 
    ,dashboardBody(
    tabItems(
     tabItem(
     tabName = "R" 
     , br() 
     , fluidRow(
      valueBoxOutput("t") 
     ) 

    ) 
    ) 
) 
) 

runApp(shinyApp(server=server,ui=ui))