Imputing into a custom function for a shiny app. R - r

Question

Hello i am trying to make an app in shiny that will take 3 vectors from a data frame and two entered inputs. I would like the five entries to pass threw the function I have maid below and give the output that the function is maid to give. This would be 4 plots set in a grid (two heat maps, one point plot and a simivariogram). I feel that I have the bulk of the app together but I am having trouble getting my five inputs from the ui to pass threw my function and give out the plots. The function works great in R without shiny i just want it to work as an app now. Also I am pretty new to shiny so i might be missing something simple.
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:
I have boxed off my function but I need help passing my arguments into the function.
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)
What I get
What i want in the plot box

Answer 1

It appears you need a observe to tie this all together. Try this at the end of your server function.
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...)
})
}
)