RShiny: доступ и загрузка объекта из таблицы рендеринга, реактивный - PullRequest
0 голосов
/ 16 апреля 2020

Я создал блестящее приложение в R. Следующее - выдержка из сервера. R Цель - создать ссылку в UI.R через downloadhandler, который загрузит содержимое dataframe bevrl1, созданного в renderTable

output $ contents3 <- renderTable ({....}) </p>

Либо content3, либо bevrl1, созданный в renderTable, должны загружаться через downloadhandler.

Я добавил часть server.R. На данный момент при нажатии на ссылку загружаются html теги и т. Д. c, а не содержимое bevrl1, возможно, потому что я поместил content3 в downloadHandler.

Я что-то упустил в правильном направлении.

server <- function(input, output, session){
library("shiny")
library("readxl")
library("dplyr")
library("fuzzyjoin")


output$contents1 <- renderTable({
    inFile1 <- input$file1

    if(is.null(inFile1))
        return(NULL)
    file.rename(inFile1$datapath,
                paste(inFile1$datapath, ".xlsx", sep=""))
    read_excel(paste(inFile1$datapath, ".xlsx", sep=""), "R1")

})

######################
# Wait for input$file to change so we know there is data available
observeEvent(input$file1, {
    # store all the input$file objects on the_f
    the_f <- as.data.frame(input$file1)
    # Create the new file name for downloading
    new_name <- sprintf("NEW_%s.csv", the_f[['name']])
    # Go ahead and read in
    new_dat <- read_excel(paste(the_f$datapath, ".xlsx", sep=""), "R1")
    # DL handler
    output$downloadData_zen_CSV_ <- downloadHandler(
        filename = function(){
            # Just use the name from outside the handler we already created
            new_name
        },
        # Handle content as follows
        content = function(file){
            write.csv(new_dat, file = file, row.names = FALSE)
        }
    )
})





output$contents2 <- renderTable({
    inFile2 <- input$file2

    if(is.null(inFile2))
        return(NULL)
    file.rename(inFile2$datapath,
                paste(inFile2$datapath, ".xls", sep=""))
    read_excel(paste(inFile2$datapath, ".xls", sep=""), sheet = "TS")
})


######################
# Wait for input$file to change so we know there is data available
observeEvent(input$file2, {
    # store all the input$file objects on the_f
    the_f <- as.data.frame(input$file1)
    # Create the new file name for downloading
    new_name <- sprintf("NEW_%s.csv", the_f[['name']])
    # Go ahead and read in
    new_dat <- read_excel(paste(the_f$datapath, ".xlsx", sep=""), "R1")
    # DL handler
    output$downloadData_BE_Vitals_Report <- downloadHandler(
        filename = function(){
            # Just use the name from outside the handler we already created
            new_name
        },
        # Handle content as follows
        content = function(file){
            write.csv(new_dat, file = file, row.names = FALSE)
        }
    )
})





################################   
output$contents3 <- renderTable({


    ###################
    ################################################# Code For Output #######################
    inFile1 <- input$file1

    if(is.null(inFile1))
        return(NULL)
    file.rename(inFile1$datapath,
                paste(inFile1$datapath, ".xlsx", sep=""))
    read_excel(paste(inFile1$datapath, ".xlsx", sep=""), "R1")

    ##############################################################################
    inFile2 <- input$file2

    if(is.null(inFile2))
        return(NULL)
    file.rename(inFile2$datapath,
                paste(inFile2$datapath, ".xls", sep=""))
    read_excel(paste(inFile2$datapath, ".xls", sep=""), sheet = "TS")




    zen <- read_excel(paste(inFile1$datapath, ".xlsx", sep=""), "R1")
    bevrl <- read_excel(paste(inFile2$datapath, ".xls", sep=""), sheet = "TS")

    #########################
    descr <- strsplit(bevrl$"Employee Name(Number)", split='[()]')

    ### First part of description
    name <- vapply(descr, "[", "",1)
    empid <- vapply(descr, "[", "",2)

    bevrl$Name <- name
    bevrl$empid <- empid

    #bevrl1 <- bevrl[,c(1:4,13,14,5:12)]
    bevrl1 <- bevrl

    ##substring(x, first, last=1000000) last is default
    bevrl1$Name <- tolower(substring(bevrl1$Name,4))
    bevrl1$Quantity <- as.numeric(bevrl1$Quantity )
    bevrl1 <- bevrl1 %>% group_by(Name) %>% summarise(Quantity = sum(Quantity))
    bevrl1

})


output$downloadData_zen_CS  <- downloadHandler(
    filename = function() {
        paste("LL.csv")
    },
    content = function(file) {
        write.csv(content3(), file, row.names = FALSE)
    }
 )
 }


###################
ui.R


ui <- fluidPage(
titlePanel("Display "),
sidebarLayout(
    sidebarPanel(
        fileInput('file1', 'Choose pmc_.xlsx', accept = c(".xlsx")),
        fileInput('file2', 'Choose MGD_.xls', accept = c(".xlsx")), width = 3

    ),
    mainPanel(
        tabsetPanel(
            tabPanel(strong("Data"),

                     h5(div(strong("Report_MGD_.xls"),style = "color:grey")),
                     tableOutput('contents3'),
                     downloadLink('downloadData_zen_CS', 'downloadData_zen_CS')
            )

        ),width = 9
    )
 )
 )
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...