下面的代码从shapefile文件生成散点图。它正在正常生成(请参阅附件图像)。但是,我不是将文件目录直接插入代码中,而是想通过fileInput插入文件。我在下面插入了fileInput,但是我需要帮助来调整我的服务器。我认为有必要调整与反应性有关的东西。
非常感谢!
library(shiny)
library(ggplot2)
library(shinythemes)
library(rdist)
library(geosphere)
library(rgdal)
function.cl<-function(df,k){
shape<-readOGR(dsn="C:/Users/Jose Souza/Documents/Test",layer="Export_Output_3")
df<-shape@data
#clusters
coordinates<-df[c("Latitude","Longitude")]
d<-as.dist(distm(coordinates[,2:1]))
fit.average<-hclust(d,method="average")
clusters<-cutree(fit.average, k)
nclusters<-matrix(table(clusters))
df$cluster <- clusters
#all cluster data df1 and specific cluster df_spec_clust
df1<-df[c("Latitude","Longitude")]
df1$cluster<-as.factor(clusters)
#Colors
my_colors <- rainbow(length(df1$cluster))
names(my_colors) <- df1$cluster
#Scatter Plot for all clusters
g <- ggplot(data = df1, aes(x=Longitude, y=Latitude, color=cluster)) +
geom_point(aes(x=Longitude, y=Latitude), size = 4) +
scale_color_manual("Legend", values = my_colors)
plotGD <- g
return(list(
"Plot" = plotGD
))
}
ui <- bootstrapPage(
navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
"Cl",
tabPanel("Solution",
fileInput("shp", h3("Shapefile Import"), multiple = TRUE, accept = c('.shp', '.dbf','.sbn', '.sbx', '.shx', '.prj')),
sidebarLayout(
sidebarPanel(
sliderInput("Slider", h5(""),
min = 2, max = 4, value = 3),
),
mainPanel(
tabsetPanel(
tabPanel("Solution", plotOutput("ScatterPlot"))))
))))
server <- function(input, output, session) {
Modelcl<-reactive({
function.cl(df,input$Slider)
})
output$ScatterPlot <- renderPlot({
Modelcl()[[1]]
})
}
shinyApp(ui = ui, server = server)
path
向function.cl添加一个新参数,删除df
不使用的参数,因为该参数直接在函数中分配 Modelcl <- eventReactive(input$shp,{
req(input$shp)
mydir <- tempdir()
on.exit(unlink(mydir))
print(paste("names:",input$shp$name))
file.copy(input$shp$datapath,file.path(mydir, input$shp$name) )
function.cl(input$Slider,mydir)
})
困难之处在于readOGR需要一个路径但fileInput
返回文件。
解决方法是创建一个临时目录以获取路径(在服务器上),将fileInput
文件复制到该目录中,并将该临时目录的路径提供给readOGR
进一步处理。
这适用于您提供的示例文件:
library(shiny)
library(ggplot2)
library(shinythemes)
library(rdist)
library(geosphere)
library(rgdal)
function.cl<-function(k,path,filename){
print(dir(path))
shape<-readOGR(dsn=path,layer=filename)
df<-shape@data
#clusters
coordinates<-df[c("Latitude","Longitude")]
d<-as.dist(distm(coordinates[,2:1]))
fit.average<-hclust(d,method="average")
clusters<-cutree(fit.average, k)
nclusters<-matrix(table(clusters))
df$cluster <- clusters
#all cluster data df1 and specific cluster df_spec_clust
df1<-df[c("Latitude","Longitude")]
df1$cluster<-as.factor(clusters)
#Colors
my_colors <- rainbow(length(df1$cluster))
names(my_colors) <- df1$cluster
#Scatter Plot for all clusters
g <- ggplot(data = df1, aes(x=Longitude, y=Latitude, color=cluster)) +
geom_point(aes(x=Longitude, y=Latitude), size = 4) +
scale_color_manual("Legend", values = my_colors)
plotGD <- g
return(list(
"Plot" = plotGD
))
}
ui <- bootstrapPage(
navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
"Cl",
tabPanel("Solution",
fileInput("shp", h3("Shapefile Import"), multiple = TRUE, accept = c('.shp', '.dbf','.sbn', '.sbx', '.shx', '.prj')),
sidebarLayout(
sidebarPanel(
sliderInput("Slider", h5(""),
min = 2, max = 4, value = 3),
),
mainPanel(
tabsetPanel(
tabPanel("Solution", plotOutput("ScatterPlot"))))
))))
server <- function(input, output, session) {
# Modelcl<-reactive({
# function.cl(df,input$Slider,input$Filter1)
# })
Modelcl <- eventReactive(c(input$shp, input$Slider),{
req(input$shp)
tmpdir <- tempdir()
on.exit(unlink(tmpdir))
filename <- substr(input$shp$name[1],1,nchar(input$shp$name[1])-4)
file.copy(input$shp$datapath,file.path(tmpdir,input$shp$name) )
function.cl(input$Slider,tmpdir,filename)
})
output$ScatterPlot <- renderPlot({
Modelcl()[[1]]
})
observeEvent(input$Slider, {
abc <- req(Modelcl()$Data)
updateSelectInput(session,'Filter1',
choices=sort(unique(abc$cluster)))
})
}
shinyApp(ui = ui, server = server)
本文收集自互联网,转载请注明来源。
如有侵权,请联系[email protected] 删除。
我来说两句