0
你好,我正試圖做一個閃亮的應用程序,將從數據框和兩個輸入的輸入需要3個向量。我想通過下面的五個參數來拋出我有女僕的函數並給出函數給女傭的輸出。這將在網格中設置4個圖(兩個熱圖,一個點圖和一個同變圖)。我覺得我擁有大部分的應用程序,但是我很難從UI中獲得我的五個輸入來傳遞我的功能併發布這些情節。這個功能在R中沒有閃亮效果很好,我只是希望它現在可以用作應用程序。另外我對閃亮相當新,所以我可能會錯過簡單的東西。輸入一個閃亮的應用程序的自定義函數。 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)
我得到
我想在情節箱
請將您的代碼降低到一個最小可重現的例子,包括假數據。添加一個清晰的聲明,說明生成的內容和期望的內容 – HubertL