Question

我一直在忙于制作一个闪亮的应用程序，感觉好像我在以正确的方式做所有事情以使表格能够呈现，但没有运气。在我的应用中，您应该上传一个csv，然后转到“数据框”标签。我尝试了许多小的更改，但似乎无济于事。我想像这与服务器部分有关，但我看不到它。

R ui：

library(readxl)
library(plyr)
library(dplyr)
library(plotly)
library(readr)
library(RColorBrewer)
library(data.table)
library(shiny)
library(shinydashboard)
library(shinythemes)
library(leaflet)
library(DT)
library(xtable)

ui <- fluidPage(theme = shinytheme("slate"), mainPanel(
  navbarPage(
    "Permian Plots", collapsible = TRUE, fluid = TRUE,
    navbarMenu(
      "County Plot",
      tabPanel( 
        sidebarPanel( fileInput(
          'file1',
          'Choose CSV File',
          accept = c('text/csv', 'text/comma-separated-values,text/plain', '.csv')
        ),
        tags$hr(),
        checkboxInput('header', 'Header', TRUE),
        # App buttons comma and quote
        radioButtons('sep', 'Separator',
                     c(
                       Comma = ',',
                       Semicolon = ';',
                       Tab = '\t'
                     ), ','),
        radioButtons(
          'quote',
          'Quote',
          c(
            None = '',
            'Double Quote' = '"',
            'Single Quote' = "'"
          ),
          '"'
        ))
      ),

      tabPanel("Data Frame",
               fluidRow(box(DT::dataTableOutput("contents")))),

      tabPanel("County Plot", plotlyOutput(
        "plotMap", height = 1200, width = 1200
      ),
      actionButton("btn", "Plot")
               )
    )
  )
)

)

服务器：

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

  options(shiny.maxRequestSize = 200*1024^2) 

  dsnames <- c()

  data_set <- reactive({
    inFile <- input$file1

    if (is.null(inFile)){
      return()
    }

    data_set <- read.csv(
      inFile$datapath,
      header = input$header,
      sep = input$sep,
      quote = input$quote

    )
  })

  output$contents <- DT::renderDataTable({
    withProgress(message = 'loading...', value = 0.1, {

      datatable(data_set(), 
                options = list(
        "pageLength" = 40))
      extensions = 'Responsive' 
      setProgress(1)

    })

  })

  output$choose_dataset <- renderUI({
    selectInput("dataset", "Data set", as.list(data_sets))
  })


  observeEvent(
    input$btn,
    {
      output$plotMap <- renderPlotly({withProgress(message = 'Plotting...', value = 0.1,{
        plot <- Plots(data_set(),
                      "Martin County", 
                      "~/Work/permin/martin county/martin data/f1.csv",
                      "~/Work/permin/BestMartinPlotSat.html",
                      32.1511, -101.5715)
        setProgress(1)

      })

      })
    }
  )

}

shinyApp(ui = ui, server = server)

功能：不应是造成问题的原因。

Plots <- function(df, C_name, PathCSV, PathWidg, Lat, Lon){

  f1 <- df

  f1$Date <- as.POSIXct(f1$Date)

  f1$year <- format(as.POSIXct(f1$Date,format="%y-%m-%d"), "%y")
  f1$month <- format(as.POSIXct(f1$Date,format="%y-%m-%d"), "%m")

  f1$Cell <- as.factor(f1$Cell)

  z <- ddply(f1, c("year", "month", "Cell"), summarise,
             yearMonth_Max_sum = max(`Cell Sum (Norm)`))

  f1 <- inner_join(f1,z, by = c("year", "month", "Cell"))


  f1$Changed <- as.numeric(as.factor(f1$Changed))
  f1$Changed[f1$Changed == 1] <- 0
  f1$Changed[f1$Changed == 2] <- 1

  z <- ddply(f1, c("year", "month", "Cell"), summarise,
             ChangedX = max(Changed))

  f1 <- inner_join(f1,z, by = c("year", "month", "Cell"))

  f1$MY <- paste(f1$year, f1$month, sep = "-")

  #preapring data for plotly

  q <- matrix(quantile(f1$StdDev))

  f1$qunat <- NA

  up <- matrix(quantile(f1$StdDev, probs = .95))

  up

  f1$qunat <- ifelse((f1$StdDev > q[4:4,1]) & (f1$StdDev < up[1,1]), 1, 0)

  z <- group_by(f1, Cell) %>%
    summarize(Median_Cell = median(`Cell Sum (Norm)`, na.rm = FALSE))

  f1 <- inner_join(f1,z, by = c("Cell"))

  quantile(round(f1$Median_Cell))

  f1$NewMedian <- NA
  f1$NewMedian[f1$Median_Cell > 4000] <- 0
  f1$NewMedian[f1$Median_Cell <= 4000] <- 1

  f1$NewSum <- NA
  f1$NewSum <- f1$yearMonth_Max_sum * f1$ChangedX * f1$qunat * f1$NewMedian

  write_csv(f1, PathCSV )

  f2 <- f1[!duplicated(f1$yearMonth_Max_sum), ]

  #plolty plot

  Sys.setenv('MAPBOX_TOKEN' = 'pk.eyJ1IjoiY3dvb2RzMjIiLCJhIjoiY2prMnlycmduMDJvNjNxdDEzczNjdGt3YSJ9.RNuCSlHyKZpkTQ8mJmg4aw')

  p <- f2[which(f2$yearMonth_Max_sum < 9000),] %>%
    plot_mapbox(
      lon = ~Lon, 
      lat = ~Lat, 
      size = ~yearMonth_Max_sum,
      color = ~(NewSum), 
      frame = ~MY, 
      type = 'scattermapbox',
      mode = 'markers',
      colors = c("green","blue")
    ) %>%
    add_markers(text = ~paste("Sum", yearMonth_Max_sum, "/<br>", 
                              "Standard Dev", StdDev, "/<br>", 
                              "Mean", Average, "/<br>", 
                              "Median", Median_Cell, "/<br>",
                              "Changed", ChangedX, "/<br>", 
                              "Latitude", Lat , "/<br>", 
                              "Longitude", Lon)) %>%
    layout(title = C_name,
           font = list(color = "black"),
           mapbox = list(style = "satellite", zoom = 9,
                         center = list(lat = Lat,
                                       lon = Lon)))


  p
  htmlwidgets::saveWidget(p, PathWidg)

}

Answer 1

函数中的最后一件事是返回的内容。您将setprogress(1)返回到renderdatatable()

 output$contents <- DT::renderDataTable({
    withProgress(message = 'loading...', value = 0.1, {

      datatable(data_set(), 
                options = list(
        "pageLength" = 40))
      extensions = 'Responsive' 
      setProgress(1)

    })

试试看

 output$contents <- DT::renderDataTable({
    withProgress(message = 'loading...', value = 0.1, {

     datatab <- datatable(data_set(), 
                options = list(
        "pageLength" = 40))
      extensions = 'Responsive' 
      setProgress(1)
     datatab

    })

表格不会以Shiny呈现

1 个答案: