为fileInput(shapefile)插入反应式

约瑟

下面的代码从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)

在此处输入图片说明

瓦尔迪
  1. path向function.cl添加一个新参数,删除df不使用的参数,因为该参数直接在函数中分配
  2. 在服务器中使用`eventReactive':
  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] 删除。

编辑于
0

我来说两句

0条评论
登录后参与评论

相关文章

来自分类Dev

如何创建反应式和非反应式流星模板?

来自分类Dev

RxJS反应式编程

来自分类Dev

Meteor和AngularJS反应式订阅

来自分类Dev

如何将闪亮的应用程序中的反应式输入值插入MySQL数据库?

来自分类Dev

HashMaps与反应式编程

来自分类Dev

使用RxSwift创建“反应式” API

来自分类Dev

反应式(RX)油门无损失

来自分类Dev

在Slick中反应式流如何用于插入数据

来自分类Dev

我为反应式MVC Razor界面使用什么模式/技术

来自分类Dev

将输入返回为反应式闪亮列表中的列表-插入UI中的动态UI

来自分类Dev

如何使用以元组为参数的变量创建反应式绑定

来自分类Dev

聆听清单中的反应式

来自分类Dev

Spring反应式文件集成

来自分类Dev

如何在Shiny中为反应式数据帧分配行名?

来自分类Dev

无法在Vue.js中将对象属性设置为反应式

来自分类Dev

Flash反应式编程吗?

来自分类Dev

RxJS反应式编程

来自分类Dev

Meteor和AngularJS反应式订阅

来自分类Dev

延迟启用/禁用反应式命令

来自分类Dev

使用RxScala进行反应式编程

来自分类Dev

闪亮的反应式SQL:WHERE子句

来自分类Dev

反应式设计:抛出与发布错误

来自分类Dev

什么代表不能做反应式?

来自分类Dev

Vue.js 反应式概念

来自分类Dev

Angular 5 反应式主键

来自分类Dev

为反应式角度形式的不同验证器显示不同的错误消息

来自分类Dev

无法创建嵌套的反应式表单

来自分类Dev

角度虚拟滚动未检测到为反应式 FormArray 添加项目的更改

来自分类Dev

Vue 中的反应式导航组件