Question

我使用以下数据：

Database<-c("Composite","DB","TC","RH","DGI","DCH","DCH","DCH","LDP")
Organism<-c("Human","Human","Human","Human","Human","Human","Mouse","Rat","Human")
Unique_Drugs<-c(12672,5130,1425,3090,6100,2019,250,736,1182)
Unique_Targets<-c(3987,2175,842,2308,2413,1441,198,327,702)
Mean_S.D.Targets_per_Drug<-c("5.87 ± 6.72","2.60 ± 6.87","2.28 ± 3.76","3.29 ± 5.03","3.60 ± 5.21","6.28 ± 14.29"
                             ,"1.92 ± 1.83"
                             ,"4.11 ± 5.32"
                             ,"4.27 ± 8.25"
)
Mean_S.D.Drugs_per_Target<-c("11.63 ± 15.59",
                             "12.52 ± 23.93",
                             "10.71 ± 8.37",
                             "12.98 ± 17.57",
                             "23.44 ± 25.65",
                             "13.87 ± 34.23",
                             "8.20 ± 18.44",
                             "14.82 ± 9.36",
                             "17.43 ± 9.34"
)
Unique_Drug_Target_Associations<-c(
45276,
14598,
3599,
12439,
23048,
13872,
594,
2876,
3915)

db<-data.frame(Database,Organism,Unique_Drugs,Unique_Targets,Mean_S.D.Drugs_per_Target,Mean_S.D.Targets_per_Drug, Unique_Drug_Target_Associations)

创建此可运行的闪亮应用程序。问题是，尽管（在浏览器中打开时）文件已正确创建和下载，但它们为空，或者确切地说，它们仅包含列名。从数据表中可以看到，动态数据框得到了很好的更新。可能是反应式数据框与downloadhandler()之间的通信错误，还是downloadhandler()内部的错误？

#ui.r
library(shiny)
library(shinydashboard)
library(DT)
ui <- dashboardPage(
  dashboardHeader(
    title = "Stats Table"
  ),
  dashboardSidebar(
    uiOutput("dbase"),
    tags$hr(),
    uiOutput("stats"),
    tags$hr(),
    h4(strong("Download Data in Table")),
    textInput("filename","Specify Filename"),
    #Added .json in the list
    selectInput("extension","File Format", choices = c("txt","csv","tsv","json")),

    column(1, align="center",
           # Style font family as well in addition to background and font color
           tags$style(type="text/css", "#downloadData {background-color:white;color: black;font-family: Arial}"),
           downloadButton("downloadData", "Download",class = "butt1"),
           tags$style(type='text/css', "#downloadData { vertical-align: middle;}")
    ) 

  ),
  dashboardBody(
    DTOutput('tbl')
  )
)
#server.r
library(shiny)
library(shinydashboard)
library(DT)
server <- function(input, output,session) { 
  #Create the static dataframe below

  Database<-c("Composite","DB","TC","RH","DGI","DCH","DCH","DCH","LDP")
  Organism<-c("Human","Human","Human","Human","Human","Human","Mouse","Rat","Human")
  Unique_Drugs<-c(12672,5130,1425,3090,6100,2019,250,736,1182)
  Unique_Targets<-c(3987,2175,842,2308,2413,1441,198,327,702)
  Mean_S.D.Targets_per_Drug<-c("5.87 ± 6.72","2.60 ± 6.87","2.28 ± 3.76","3.29 ± 5.03","3.60 ± 5.21","6.28 ± 14.29"
                               ,"1.92 ± 1.83"
                               ,"4.11 ± 5.32"
                               ,"4.27 ± 8.25"
  )
  Mean_S.D.Drugs_per_Target<-c("11.63 ± 15.59",
                               "12.52 ± 23.93",
                               "10.71 ± 8.37",
                               "12.98 ± 17.57",
                               "23.44 ± 25.65",
                               "13.87 ± 34.23",
                               "8.20 ± 18.44",
                               "14.82 ± 9.36",
                               "17.43 ± 9.34"
  )
  Unique_Drug_Target_Associations<-c(
    45276,
    14598,
    3599,
    12439,
    23048,
    13872,
    594,
    2876,
    3915)

  db<-data.frame(Database,Organism,Unique_Drugs,Unique_Targets,Mean_S.D.Drugs_per_Target,Mean_S.D.Targets_per_Drug, Unique_Drug_Target_Associations)

  #Create the databases checkbox group
  output$dbase<-renderUI({
    checkboxGroupInput("base", label = "Specify dataset(s)",
                       choices = list("Composite","DB","TC","RH","DGI","DCH","LDP"),
                       selected = c("Composite","DB","TC","RH","DGI","DCH","LDP")
    )
  })
  #Create the stats check box group
  output$stats<-renderUI({
    checkboxGroupInput("sta", label = "Specify statistic(s)",
                       choices = list("# Unique Drugs"="Unique_Drugs",
                                      "# Unique Targets"="Unique_Targets",
                                      "# of Drugs per Target"="Mean_S.D.Drugs_per_Target",
                                      "# of Targets per Drug"="Mean_S.D.Targets_per_Drug",
                                      "# Unique Drug-Target Associations"="Unique_Drug_Target_Associations"
                       ),
                       selected = c("Unique_Drugs","Unique_Targets","Mean_S.D.Drugs_per_Target","Mean_S.D.Targets_per_Drug","Unique_Drug_Target_Associations")
    )
  })
  #Subset the data based on user choices
  df_subset <- reactive({
    #By database
    a <- subset(db, Database %in% input$base)
    #By stats
    keeps <- c("Database","Organism",input$sta)

    # assigning the subset of db to tmp
    tmp <- a[ , which(names(a) %in% keeps)]

    # returning tmp
    return(tmp)

  })


  #Download files with quotes or not depending on the quote=input$quotes which has value TRUE or FALSE.
  output$downloadData <- downloadHandler(

    filename = function() {
      paste(input$filename, input$extension, sep = ".")
    },

    # This function should write data to a file given to it by
    # the argument 'file'.
    content = function(file) {
      sep <- switch(input$extension,"txt"=",", "csv" = ",", "tsv" = "\t","json"=",")
      # Write to a file specified by the 'file' argument
      write.table(data.frame(df_subset())[input[["table_rows_all"]],], file, sep = sep,
                  row.names = FALSE) 

    }

  )

  output$tbl = renderDT(
    df_subset(), options = list(lengthChange = FALSE),selection = list(target = 'row+column')
  )



  }

Answer 1

不知道为什么，但是我不得不删除[input[["table_rows_all"]],]

Downloadhandler（）下载仅包含RShiny中实际数据帧的列名的文件

1 个答案: