glänzende App mit eigener Funktion

Question

Ich möchte eine Funktion in einer Shiny App implementieren. Meine eigene Funktion get_calculate() hat die Argumente Daten und Toleranz als Eingabe und retruns list mit data.frame und plot.

Ich möchte die Ausgabe in Abhängigkeit von der Toleranz zeigen. In meiner Serverfunktion verwende ich reactive(), um get_calculate() zu laufen, aber es funktioniert nicht.

Wenn ich schreibe in renderPlot() und renderDataTable()get_calculate() funktioniert. Für große Datensätze ist es jedoch ineffizient, weil Shiny zweimal get_calculate() ausführen muss.

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

Der Fehler, den Sie erwähnt ist höchstwahrscheinlich aus renderDataTable wo Sie versuchen, einige Spalten von Test $ data_kpm zu holen. Überprüfen Sie den Datenrahmen auf genaue Spaltennamen.

Answer 2

Diese Version meiner glänzenden App läuft. Aber es ist ineffzient, weil glänzend zweimal get_calculate laufen muss.

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

Warum verwenden Sie nicht einen reaktiven Ausdruck, um Ihre get_calculate nur einmal auszuführen? Und dann verwenden Sie das Ergebnis in Ihrer Ausgabe $ plot_kpm und Ausgabe $ table_kpm? Dies wird Ihren Code optimieren.