блестящее приложение с собственной функцией

Question

Я хочу реализовать функцию в приложении Shiny. Моя собственная функция get_calculate() имеет данные аргументов и допуска в качестве входных данных и возвращает list с data.frame и plot.

Я хочу показать выход в зависимости от допуска. В моей функции сервера я использую reactive() для запуска get_calculate(), но он не работает.

Если я пишу в renderPlot() и renderDataTable()get_calculate() работ. Для больших наборов данных, однако, это неэффективно, потому что Shiny должен будет запустить get_calculate() дважды.

library(shiny) 
library(shinydashboard) 
library(foreign) 
#load my own function 
source("01-get_calculate.R") 


ui <- dashboardPage(

    dashboardHeader(title = "Analysis"), 
    dashboardSidebar(
    sidebarMenu(
     menuItem("Load data", tabName = "data", icon = icon("database")), 
     menuItem("Mainboard", tabName = "Mainboard", icon = icon("dashboard")) 
    ) 
), 
    dashboardBody(
    tabItems(
     tabItem(tabName = "data", 
       fileInput("datafile", "Choose file", 
         accept = c("text/csv/rds/dbf", 'text/comma-separated-values,text/plain')), 

       dataTableOutput("mytable") 

    ), 
     tabItem(tabName = "Mainboard", 
       fluidRow(
       box(
        title = "Input", status = "primary", solidHeader = TRUE, collapsible = TRUE, 
        sliderInput(inputId = "tol", 
           label = "Tolerance", 
           value = 4, min = 1, max = 15, step = 1) 
       )), 
       fluidRow(
       box(
        title = "Adherence Curve", status = "warning", solidHeader = TRUE, collapsible = TRUE, 
        plotOutput("plot_kpm") 
       ), 

       box(
        title = "Overview Table", status = "primary", solidHeader = TRUE, collapsible = TRUE, 
        tableOutput("table_kpm") 
      ) 
    ) 
    ) 
) 
) 
) 



server <- function(input, output) { 


    filedata <- reactive({ 
    infile <- input$datafile 
    if (is.null(infile)) { 
     return(NULL) 
    } 
    read.dbf(infile$datapath) 
    }) 



    output$mytable <- renderDataTable({ 
    filedata() 
    }) 

    **test <- reactive({ 
    get_calculate(filedata(), tolerance = input$tol) 
    }) 

    output$plot_kpm <- renderPlot({ 
    test$kpm_chart 
    }) 

    output$table_kpm <- renderDataTable({ 
    test$data_kpm[, c("Time", "numbers", "Percent")] 
    })** 


} 

shinyApp(ui = ui, server = server) 

Answer 1

Ошибка вы упомянули, скорее всего, из renderDataTable, где вы пытаетесь выбрать пару колонок из теста $ data_kpm. Проверьте данные для точных имен столбцов.

Answer 2

Эта версия моего блестящего приложения работает. Но это неэффективно, потому что блестящий должен бежать get_calculate дважды.

server <- function(input, output) { 

    #This function is repsonsible for loading in the selected file 
    filedata <- reactive({ 
    infile <- input$datafile 
    if (is.null(infile)) { 
     # User has not uploaded a file yet 
     return(NULL) 
    } 
    read.dbf(infile$datapath) 
    }) 



    output$mytable <- renderDataTable({ 
    filedata() 
    }) 

    output$plot_kpm <- renderPlot({ 
    get_calculate(filedata(), tolerance = input$tol)$kpm_chart 
    }) 

output$table_kpm <- renderTable({ 
    get_calculate(filedata(), tolerance = input$tol)$data_kpm[, c("Time", "Percent", "Patients")] 
    }) 


output$download_mainboard_adherence_table <- downloadHandler(
               filename = paste("adherence_table", '.csv', sep=''), 
               content = function(file) { 
               write.csv(get_calculate(filedata(), tolerance = input$tol)$data_kpm[, c("Time", "Percent", "Patients")], file) 
    } 
) 

} 

Answer 3

Почему вы не используете реактивное выражение для запуска get_calculate только один раз? А затем используйте результат в вашем выходе $ plot_kpm и выведите $ table_kpm? Это оптимизирует ваш код.