0
こんにちは、私は光沢のあるアプリケーションを作成しようとしています。これはデータフレームから3つのベクトルと2つの入力を受け取ります。私は5つのエントリーを渡して、私が下に作った関数を投げて、その関数が与えようとしている出力を与えたいと思います。これは、グリッドに4つのプロット（2つのヒートマップ、1つの点プロット、およびシミバリオグラム）を設定します。私は一緒にアプリの大部分を持っていると感じるが、私は私の機能をスローし、プロットを出すために渡すために私の5つの入力を取得するのに問題があります。この関数は光沢がなくても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