Question

您好我正在尝试制作一个闪亮的应用程序，它将从数据框和两个输入的输入中获取3个向量。我希望传递的五个条目抛出我下面的maid函数并给出函数为maid的输出。这将是在网格中设置的4个图（两个热图，一个点图和一个单一图）。我觉得我有大量的应用程序在一起但是我无法从ui获得我的五个输入来传递我的功能并给出了这些情节。该功能在R中运行良好而没有闪亮我只想让它现在作为应用程序工作。此外，我是新的闪亮所以我可能会错过一些简单的东西。

UI：

    library(shiny)
    library(shinydashboard)
    library(ggplot2)
    library(leaflet)
    library(data.table)
    library(dplyr)

   ################

# App interface
ui <- fluidPage(
# App csv input
  headerPanel("Kriging"),
  sidebarPanel(
    fileInput('file1', 'Choose CSV File',
              accept=c('text/csv','text/comma-separated-values,text/plain','.csv')),
    tags$hr(),
    checkboxInput('header', 'Header', TRUE),
# App button selection for var, lat, lon
    fluidRow(
      column(6,radioButtons("xaxisGrp","Var:", c("1"="1","2"="2"))),
      column(6,checkboxGroupInput("yaxisGrp","Lat/Lon:", c("1"="1","2"="2")))
    ),
# App buttons comma and quote
    radioButtons('sep', 'Separator',
                 c(Comma=',', Semicolon=';',Tab='\t'), ','),
    radioButtons('quote', 'Quote',
                 c(None='','Double Quote'='"','Single Quote'="'"),'"'),
    uiOutput("choose_columns")
  ),
  mainPanel(
    tabsetPanel(
      tabPanel("Plot",plotOutput("plot")),
      tabPanel("Data", tableOutput('contents'))
    )
  )
# App sliders for values of definition
  ,
  sliderInput(inputId = "num",
              label = "choose x",
              value = 0.1, min = 0.01, max = 1),
  sliderInput(inputId = "num",
              label = "choose y",
              value = 0.1, min = 0.01, max = 1)

  #initiating kriging
  , actionButton("btn", "Krige")
)



 ##################################################

服务器：我已经把我的功能搞砸了，但我需要帮助将我的参数传递给函数。

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

  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 <- renderTable({data_set()})

  #controlling our buttons
  observe({
    dsnames <- names(data_set())
    cb_options <- list()
    cb_options[ dsnames] <- dsnames
    updateRadioButtons(session, "xaxisGrp",
                       label = "Var",
                       choices = cb_options,
                       selected = "")
    updateCheckboxGroupInput(session, "yaxisGrp",
                             label = "Lat/Lon",
                             choices = cb_options,
                             selected = "")
  })
  output$choose_dataset <- renderUI({
    selectInput("dataset", "Data set", as.list(data_sets))
  })

  ##############################################################
  #My function

  kri <- function(var, lat, lon, defx, defy){

    options(warn = -1)

    #internal function for kriging
    kri3 <- function(var, lat, lon, defx, defy){

      #making a data frame out of the given vector
      spdf <- data.frame(var,lat,lon)

      #makeing spatial point data frame coords
      sp::coordinates(spdf) <- ~ lon + lat
      bbox <- sp::bbox(spdf)

      #variogram stuff
      lzn.vgm <- gstat::variogram(var ~ 1, spdf)

      lzn.fit1 <- gstat::fit.variogram(lzn.vgm, model = gstat::vgm(1, "Sph", 900, 1))

      lzn.fit = automap::autofitVariogram(var ~ 1,
                                          spdf,
                                          model = c("Sph", "Exp", "Gau", "Ste"),
                                          kappa = c(0.05, seq(0.2, 2, 0.1), 5, 10),
                                          fix.values = c(NA, NA, NA),
                                          start_vals = c(NA,NA,NA),
                                          verbose = T)


      #making our grid
      cs <- c(defx, defy)
      bb <- sp::bbox(spdf)
      cc <- bb[,1] + (cs/2)
      cd <- ceiling(diff(t(bb))/cs)
      gold_grd <- sp::GridTopology(cellcentre.offset = cc, cellsize = cs, cells.dim = cd)
      gold_grd
      p4s <- sp::CRS(sp::proj4string(spdf))
      gold_sg <- sp::SpatialGrid(gold_grd, proj4string = p4s)
      summary(gold_sg)

      #kringing and auto kriging
      lzn.kriged <- as.data.frame(gstat::krige(var ~ 1, spdf, gold_sg , model=lzn.fit1))
      lzn.Akriged <- automap::autoKrige(var ~ 1, spdf, gold_sg)

      lzn.Akriged.pred <- lzn.Akriged$krige_output$var1.pred
      lzn.Akriged.var <- lzn.Akriged$krige_output$var1.var

      #making a data frame to use in return
      kriw <- data.frame(lzn.kriged, lzn.Akriged.var, lzn.Akriged.pred)
      return(kriw)
    }

    kriw <- kri3(var, lat, lon, defx, defy)

    #internal function for maping
    Kmap <-  function(var, lat, lon, kriw){

      #making a data spatial point data frame for out variogram plot
      spdf <- data.frame(var,lat,lon)

      #makeing spatial point data frame coords
      sp::coordinates(spdf) <- ~ lon + lat
      bbox <- sp::bbox(spdf)

      #variogram stuff
      lzn.vgm <- gstat::variogram(var ~ 1, spdf)

      lzn.fit = automap::autofitVariogram(var ~ 1,
                                          spdf,
                                          model = c("Sph", "Exp", "Gau", "Ste"),
                                          kappa = c(0.05, seq(0.2, 2, 0.1), 5, 10),
                                          fix.values = c(NA, NA, NA),
                                          start_vals = c(NA,NA,NA),
                                          verbose = T)
      varplot <- plot(lzn.vgm, lzn.fit$var_model, main = "Fitted variogram")

      #making a dataframe for ggplot
      kriw <- as.data.frame(kriw)

      #making a maps
      bbox1 <- ggmap::make_bbox(lon, lat, f = 1.4)
      map <- ggmap::get_map(bbox1)

      #making a heat map
      M1 <- ggmap::ggmap(map) + 
        ggplot2::geom_tile(data = kriw, ggplot2::aes(x = lon,
                                                     y = lat, alpha = var1.pred), fill = "red") + ggplot2::ggtitle("Prediction Heat Map")

      M2 <- ggmap::ggmap(map) + 
        ggplot2::geom_tile(data = kriw, ggplot2::aes(x = lon, 
                                                     y = lat, alpha = var1.var), fill = "red") + ggplot2::ggtitle("Variance Heat Map")
      var2 <- data.frame(var, lat, lon)

      Dplot <- ggmap::ggmap(map) +  ggplot2::geom_point(data = var2,  ggplot2::aes(size=var, color=var, alpha=var)) + 
        ggplot2::coord_equal() + ggplot2::ggtitle("Desnisty map") + ggplot2::theme_bw()


      #Placing both heat maps together
      heat <- gridExtra::grid.arrange(M1,M2,varplot,Dplot, ncol=2)

      return(heat)

    }

    #mapping output
    Kmap(var, lat, lon, kriw)

    options(warn = 0)

  }
 ############################################### 
 # end of my fucntion


}

shinyApp(ui = ui, server = server)

我得到了什么

我想要的情节框

Answer 1

看来你需要一个observe将这一切联系在一起。请在server功能结束时尝试此操作。

observeEvent(
  # react to button press
  input$btn,
  {
    # to show the input values
    str(input$xaxisGrp)
    str(input$yaxisGrp)
    # you have defined num for both x and y
    #  so I think you will want to change the
    #  inputId to numX and numY in ui
    str(input$num)

    # translate all the inputs into
    #   suitable arguments for kri

    # send the output from kri
    output$plot <- renderPlot({
      kri(...allyourtranslatedargument...)
    })
  }
)

为闪亮的应用程序投入自定义功能。 [R

1 个答案: