使用 leafpm 在闪亮的应用程序中处理多边形编辑

Question

我正在开发一个闪亮的应用程序，它可以让用户使用“leafpm”包在传单地图上交互地绘制多边形，计算森林生物特征，报告它们，并使这些多边形可供下载。我想我的应用程序几乎已经完成，但我正在努力处理对多边形的编辑。

我从 Stack Overflow post 改编了我的代码，它使用现已弃用的“sp”包来处理多边形。我改为使用“sf”包。在我的

observeEvent()

函数中，我尝试处理多边形编辑，方法是从

input$MAP_draw_edited_features$properties$layerId

中删除具有与反应式闪亮对象

polys$out

提供的相同唯一标识符的特征（这是我定义用于存储所有内容的

reactiveValues()

对象）绘制的多边形），然后使用

rbind()

将编辑后的特征添加回来。我将反应性闪亮对象的唯一标识符存储为

polys$out

中的行名称。我将编辑后的要素存储为名为

sfp

的“sf”对象，该对象还将其唯一标识符存储为其行名称。我的想法是，我可以根据不匹配的行名称进行查询，以从

polys$out

中删除已编辑功能的旧版本，然后使用

rbind()

将

sfp

添加回具有相同唯一标识符的

polys$out

，以便用户只能看到几何形状的变化。奇怪的是，当我对此进行测试时，我的编辑似乎会导致已编辑的特征依次覆盖未编辑的特征的几何形状。

首先，我运行了一些

isolate(print(row.names(polys$out)))

语句来查看我查询行名称的方法是否有缺陷。事实证明，使用

rbind()

覆盖了行名称，因此我按照上述模式明确地重新定义了行名称。完成此操作后，我能够确保删除已编辑要素的正确行名称，然后将其添加回来。但是，几何图形仍然会被覆盖。我是否需要在每次编辑后以某种方式破坏

observeEvent()

以防止这种情况发生？我是否以某种方式将错误的行名称覆盖到错误的功能？

下面是我的完整可重现示例。请绘制至少 3 - 4 个多边形，检查表中的值，然后对多边形至少进行两次编辑，然后再次检查表以重现我描述的行为。

library(leaflet)
library(shiny)
library(leafpm)
library(terra)
library(shinydashboard)
library(sf)
library(dplyr)

set.seed(56)

BAA<-rast(xmin= -124.0, xmax=-121.0, ymin=44.0, ymax=46.0, nrows=500, ncols=500, crs="epsg:4326")
values(BAA)<-rnorm(250000, 150, 40)

rastpath<-tempdir()

if(!dir.exists(rastpath)){
  dir.create(tempdir)
}

writeRaster(BAA, paste(normalizePath(rastpath,"/"), "Basal Area per Acre.tif", sep="/"), overwrite=TRUE)

SPP<-BAA
species<-c("THPL", "ALRU2", "ACMA3", 
           "PSME", "TSHE", "PISI", "ABPR")

values(SPP)<-sample(species, 250000, replace=TRUE)
writeRaster(SPP, paste(normalizePath(rastpath,"/"), "Species Composition.tif", sep="/"), overwrite=TRUE)

ui<-dashboardPage(
  title = "EFI Interactive Mapper",# Start Dashboard Page
  header = dashboardHeader(
    tags$li(class = "dropdown",
            tags$style(".main-header {max-height: 100px}"),
            tags$style(".main-header .logo {height: 100px} .primary-title height {100px}"),
            tags$style(".sidebar-toggle {height: 20px; padding-top: 150px !important;}"),
            tags$style(".navbar {min-height:20px !important}")
    ),
    titleWidth='100%',
    title = span(
      tags$img(src="Rlogo.png", width = '5%', align='right'), 
      column(12, class="title-box", 
             tags$h1(class="primary-title", style='margin-top:5px;', 'EFI Interactive Mapper')
      ))),#End Header
  dashboardSidebar(tags$style(".left-side, .main-sidebar {padding-top: 150px} "),selectInput(inputId = "BIO", "Select a Biometric", 
                                                                                             choices = c("Basal Area per Acre", "Species Composition", "All Biometrics"),
                                                                                             selected = "Basal Area Per Acre"), tags$style(".skin-blue .sidebar a { color: #444; }"),
                   downloadButton('downloadData', 'Download Polygon')
  ),
  dashboardBody(
    fluidRow(
      tabBox(
        tabPanel('Map', div(style='height:63.0vh', leafletOutput(outputId = "MAP", height="100%"))),
        tabPanel('Table', div(style='overflow-x: auto; overflow-y: auto; max-height:63.0vh', uiOutput("TABLE"))),
        width=12, selected='Table'
      )
    )
  )
)

server<-function(input, output, session){
  
  Bios<-c( "Species Composition", "Basal Area per Acre")
  
  
  tifnames<-c('Species Composition.tif', "Basal Area Per Acre.tif")
  

  rastdf<-data.frame(Bio=Bios[order(Bios)],  paths=paste(normalizePath(rastpath, "/"), tifnames, sep="/"))
  tmp<-lapply(rastdf$paths, rast)
  bio_ras<-c(tmp)
  names(bio_ras)<-rastdf$Bio
  

  
  output$MAP<-renderLeaflet({
    leaflet() %>% addTiles() %>% 
      setView(lng=-123.5, lat=45.5, zoom = 10) %>% 
  
      addWMSTiles(
        "https://gis.odf.oregon.gov/ags3/rest/services/Basemaps/ProtectionMap/MapServer/tile/{z}/{y}/{x}",
        layers = "0",
        options = WMSTileOptions(format = "image/png", transparent = TRUE),
        attribution = "") %>% 
      
      addPmToolbar(
        toolbarOptions = pmToolbarOptions(drawPolygon = T,
                                          drawCircle = F,
                                          drawPolyline = F,
                                          drawRectangle = F,
                                          editMode = T,
                                          cutPolygon = T,
                                          removalMode = F,
                                          position="topleft"))
  })
  
  proxy <- leafletProxy("MAP", session)
  
  poly<-reactiveValues()
  coords<-reactiveValues()

  
  bio_extract<-reactive({
    if(!is.null(poly$out)){
      
      if(input$BIO=="All Biometrics"){
        bio_use<-bio_ras
      } else{ 
        bio_use<-bio_ras[names(bio_ras)==input$BIO][[1]]
      }  

      fnx<-function(x){
        themean<-mean(x, na.rm=TRUE)
        thesd<-sqrt(var(x, na.rm=TRUE))
        out<-list(mean=round(themean,2), sd=round(thesd,2))
        return(out)
      }
      shapevect<-poly$out
      if(input$BIO=="Species Composition"){
        fqt<-freq(bio_use, zones=vect(shapevect)) %>% mutate(pct_comp = 100*count/sum(count))
        
        all_spp<-as.data.frame(expand.grid(levels(bio_use)[[1]][,2], unique(fqt$zone)))
        colnames(all_spp)[1:2]<-c("Species", "ID")
        use_cols<-c("value", "zone", "pct_comp")
        all_spp<-merge(all_spp, fqt[,use_cols], by.x=c("Species", "ID"), by.y=c("value", "zone"), all.x=TRUE, all.y=FALSE)
        all_spp$pct_comp[is.na(all_spp$pct_comp)]<-0
        spp_out<-tidyr::pivot_wider(all_spp, id_cols=ID, names_from = Species, values_from = pct_comp) %>% as.data.frame()
        e<-cbind(shapevect, as.data.frame(spp_out))
        #cbind(shapevect, spp_out)
        
      }else{
        if(input$BIO=="All Biometrics"){
          ext_ras<-bio_use[names(bio_use)!= "Species Composition"]
          
          e <- lapply(ext_ras, extract, shapevect, fnx, bind = FALSE, raw=FALSE)
          
          spp_ras<-bio_use[names(bio_use)== "Species Composition"][[1]]
          fqt<-freq(spp_ras, zones=vect(shapevect)) %>% mutate(pct_comp = 100*count/sum(count))
          
          all_spp<-as.data.frame(expand.grid(levels(spp_ras)[[1]][,2], unique(fqt$zone)))
          colnames(all_spp)[1:2]<-c("Species", "ID")
          use_cols<-c("value", "zone", "pct_comp")
          all_spp<-merge(all_spp, fqt[,use_cols], by.x=c("Species", "ID"), by.y=c("value", "zone"), all.x=TRUE, all.y=FALSE)
          all_spp$pct_comp[is.na(all_spp$pct_comp)]<-0
          spp_out<-tidyr::pivot_wider(all_spp, id_cols=ID, names_from = Species, values_from = pct_comp) %>% as.data.frame()
          e[[length(e)+1]]<-spp_out
          names(e)[length(e)]<-"Species Composition"
          e<-lapply(e, function(X, Y){cbind(Y, as.data.frame(X))}, shapevect) 
        }else{
          e <- terra::extract(bio_use, shapevect, fnx, bind = FALSE)
          
          e<-cbind(shapevect, as.data.frame(e))
          #   st_as_sf(cbind(shapevect, e[, -1, drop = FALSE]))
        }
      } 
      
      return(e)
    }
  })
  
  observeEvent(input$MAP_draw_new_feature, {
    req(input$BIO)
    coords$dtf<-data.frame(do.call( rbind, do.call(cbind,input$MAP_draw_new_feature$geometry$coordinates)))
    colnames(coords$dtf)<-c("long", "lat")
    sfp <- coords$dtf %>%
      st_as_sf(coords = c("long", "lat"), crs = 4326) %>%
      summarise(geometry = st_combine(geometry)) %>%
      st_cast("POLYGON") %>% st_transform(crs=6557) %>% st_as_sf()
    
    row.names(sfp)<-input$MAP_draw_new_feature$properties$layerId
    if(is.null(poly$out)){
      poly$out<-sfp
      isolate(print(row.names(poly$out)))
    }else{
      rn<-row.names(poly$out)
      poly$out<-rbind(poly$out, sfp)
      row.names(poly$out)[-nrow(poly$out)]<-rn
      row.names(poly$out)[nrow(poly$out)]<-row.names(sfp)
      isolate(print(row.names(poly$out)))
    }
    
  })
  
  observeEvent(input$MAP_draw_edited_features, {
    
    dtf<-data.frame(do.call(rbind, do.call(cbind, input$MAP_draw_edited_features$geometry$coordinates)))
    colnames(dtf)<-c("long", "lat")
    
    sfp <- coords$dtf %>%
      st_as_sf(coords = c("long", "lat"), crs = 4326) %>%
      summarise(geometry = st_combine(geometry)) %>%
      st_cast("POLYGON") %>% st_transform(crs=6557) %>% st_as_sf()
    
    row.names(sfp)<-input$MAP_draw_edited_features$properties$layerId
    rn<-row.names(poly$out)
    isolate(poly$out)
    poly$out<-poly$out[!row.names(poly$out) %in% row.names(sfp),]
    
    row.names(poly$out)<-rn[!rn %in% rownames(sfp)]
    isolate(poly$out)
    poly$out<-rbind(poly$out, sfp)
    row.names(poly$out)[1:(nrow(poly$out)-1)]<-rn[!rn %in% rownames(sfp)]
    row.names(poly$out)[nrow(poly$out)]<-row.names(sfp)
    
    isolate(poly$out)
    
  })
  
  
  observeEvent(input$drawnPoly_deleted_features, { 
    
    f <- input$drawnPoly_deleted_features
    ids<-lapply(f$features, function(x){unlist(x$properties$layerId)})
    polys$out<-polys$out[!row.names(polys$out) %in% ids ,]
    
  }) 
  
  output$TABLE<-renderUI({
    req(input$BIO)
    if(!is.null(poly$out)){
      data.out<-bio_extract() 
      
      if(input$BIO=="All Biometrics"){
        
        for(i in 1:length(data.out)){
          if(i < length(data.out)){
            data.out[[i]]<-as.data.frame(data.out[[i]] %>% st_drop_geometry())
            
            colnames(data.out[[i]])<-c("Area of Interest","Estimate Mean", "Estimate Standard Deviation",
                                       "Lower Bound <br> 95% Prediction Interval <br> Mean", "Lower Bound <br> 95% Prediction Interval <br> Standard Deviation",
                                       "Upper Bound <br> 95% Prediction Interval <br> Mean", "Upper Bound <br> 95% Prediction Interval <br> Standard Deviation")
          }else{
            data.out[[i]]<-data.out[[i]] %>% st_drop_geometry() %>% mutate(across(.cols=everything(), ~paste(round(.x, 1), "%"))) %>% as.data.frame()
            
            colnames(data.out[[i]])[1]<-"Area of Interest"
          }
          
        }
        
        kbl_out<-lapply(data.out, function(X){
          kbl(X, format="html", align="c", escape=FALSE, col.names=colnames(X)) %>% 
            column_spec(column=c(1:ncol(X)), width_min="3.5cm") %>% 
            kable_styling()
        })
        
        table_formatter<-function(tname, tkbl){
          paste0("<center><b><u><font size = '+2'>", tname, "</font></u></b></center>",
                 "<br><center>", tkbl, "</center><br>")}
        
        HTML(table_formatter(names(data.out), kbl_out))
        
      }else{
        data.out<-data.out %>% st_drop_geometry()
        table_formatter<-function(tname, tkbl){
          paste0("<center><b><u><font size = '+2'>", tname, "</font></u></b></center>",
                 "<br><center>", tkbl, "</center><br>")}
        
        if(input$BIO!="Species Composition"){
          use_names<-c("Area of Interest","Estimate Mean", "Estimate Standard Deviation",
                       "Lower Bound <br> 95% Prediction Interval <br> Mean", "Lower Bound <br> 95% Prediction Interval <br> Standard Deviation",
                       "Upper Bound <br> 95% Prediction Interval <br> Mean", "Upper Bound <br> 95% Prediction Interval <br> Standard Deviation")
        }else{
          
          use_names<-colnames(data.out)
          data.out<-data.out %>% mutate(across(.cols=everything(), ~paste(round(.x, 1), "%")))
        }
        kbl_out<-kbl(data.out, format="html", escape = FALSE, col.names=use_names, align="c") %>% 
          column_spec(column=c(1:ncol(data.out)), width_min = "3.5cm") %>% 
          kable_styling()
        HTML(table_formatter(input$BIO, kbl_out))
      }
    }  
  })
  
  output$downloadData<-downloadHandler(
    
    filename <- function(){
      fname<-input$BIO
      paste(fname, "Polygon.gpkg", sep="_")}, 
    
    content = function(file) {
      #   req(polys$out)
      if (length(Sys.glob(paste(input$BIO, "*", sep=".")))>0){
        file.remove(Sys.glob(paste(input$BIO, "*", sep=".")))
      }
      
      owd<-setwd(tempdir())
      on.exit(setwd(owd))
      polys_out<-bio.extract()
      if(input$BIO=="All Biometrics"){
        polys_out2<-rapply(polys_out, function(X){merge(X, X, by=names(X)[1])}, how="replace")
      }else{
        polys_out2<-polys_out
      }
      st_write(polys_out2, "polyExport.gpkg", "GPKG", append=FALSE)  
      file.rename("polyExport.gpkg", file)  
      
      if (length(Sys.glob("polyExport.*"))>0){
        file.remove(Sys.glob("polyExport.*"))
      }
    })
}

shinyApp(ui=ui, server=server)

Answer 1

事实证明这只是我的一个错字。在对

observeEvent()

的调用中，我有这段代码用于创建编辑多边形的简单特征版本

sfp <- coords$dtf %>%
      st_as_sf(coords = c("long", "lat"), crs = 4326) %>%
      summarise(geometry = st_combine(geometry)) %>%
      st_cast("POLYGON") %>% st_transform(crs=6557) %>% st_as_sf()
    

coords$dtf

实际上是来自之前新绘制的多边形的观察者。将该对象更改为

dtf

（用于编辑多边形的对象）解决了问题。如果对其他人有帮助，这里是完整的可重现的解决方案：

library(leaflet)
library(shiny)
library(leafpm)
library(terra)
library(shinydashboard)
library(sf)
library(dplyr)

set.seed(56)

BAA<-rast(xmin= -124.0, xmax=-121.0, ymin=44.0, ymax=46.0, nrows=500, ncols=500, crs="epsg:4326")
values(BAA)<-rnorm(250000, 150, 40)

rastpath<-tempdir()

if(!dir.exists(rastpath)){
  dir.create(tempdir)
}

writeRaster(BAA, paste(normalizePath(rastpath,"/"), "Basal Area per Acre.tif", sep="/"), overwrite=TRUE)

SPP<-BAA
species<-c("THPL", "ALRU2", "ACMA3", 
           "PSME", "TSHE", "PISI", "ABPR")

values(SPP)<-sample(species, 250000, replace=TRUE)
writeRaster(SPP, paste(normalizePath(rastpath,"/"), "Species Composition.tif", sep="/"), overwrite=TRUE)

ui<-dashboardPage(
  title = "EFI Interactive Mapper",# Start Dashboard Page
  header = dashboardHeader(
    tags$li(class = "dropdown",
            tags$style(".main-header {max-height: 100px}"),
            tags$style(".main-header .logo {height: 100px} .primary-title height {100px}"),
            tags$style(".sidebar-toggle {height: 20px; padding-top: 150px !important;}"),
            tags$style(".navbar {min-height:20px !important}")
    ),
    titleWidth='100%',
    title = span(
      tags$img(src="Rlogo.png", width = '5%', align='right'), 
      column(12, class="title-box", 
             tags$h1(class="primary-title", style='margin-top:5px;', 'EFI Interactive Mapper')
      ))),#End Header
  dashboardSidebar(tags$style(".left-side, .main-sidebar {padding-top: 150px} "),selectInput(inputId = "BIO", "Select a Biometric", 
                                                                                             choices = c("Basal Area per Acre", "Species Composition", "All Biometrics"),
                                                                                             selected = "Basal Area Per Acre"), tags$style(".skin-blue .sidebar a { color: #444; }"),
                   downloadButton('downloadData', 'Download Polygon')
  ),
  dashboardBody(
    fluidRow(
      tabBox(
        tabPanel('Map', div(style='height:63.0vh', leafletOutput(outputId = "MAP", height="100%"))),
        tabPanel('Table', div(style='overflow-x: auto; overflow-y: auto; max-height:63.0vh', uiOutput("TABLE"))),
        width=12, selected='Table'
      )
    )
  )
)

server<-function(input, output, session){
  
  Bios<-c( "Species Composition", "Basal Area per Acre")
  
  
  tifnames<-c('Species Composition.tif', "Basal Area Per Acre.tif")
  

  rastdf<-data.frame(Bio=Bios[order(Bios)],  paths=paste(normalizePath(rastpath, "/"), tifnames, sep="/"))
  tmp<-lapply(rastdf$paths, rast)
  bio_ras<-c(tmp)
  names(bio_ras)<-rastdf$Bio
  

  
  output$MAP<-renderLeaflet({
    leaflet() %>% addTiles() %>% 
      setView(lng=-123.5, lat=45.5, zoom = 10) %>% 
  
      addWMSTiles(
        "https://gis.odf.oregon.gov/ags3/rest/services/Basemaps/ProtectionMap/MapServer/tile/{z}/{y}/{x}",
        layers = "0",
        options = WMSTileOptions(format = "image/png", transparent = TRUE),
        attribution = "") %>% 
      
      addPmToolbar(
        toolbarOptions = pmToolbarOptions(drawPolygon = T,
                                          drawCircle = F,
                                          drawPolyline = F,
                                          drawRectangle = F,
                                          editMode = T,
                                          cutPolygon = T,
                                          removalMode = F,
                                          position="topleft"))
  })
  
  proxy <- leafletProxy("MAP", session)
  
  poly<-reactiveValues()
  coords<-reactiveValues()

  
  bio_extract<-reactive({
    if(!is.null(poly$out)){
      
      if(input$BIO=="All Biometrics"){
        bio_use<-bio_ras
      } else{ 
        bio_use<-bio_ras[names(bio_ras)==input$BIO][[1]]
      }  

      fnx<-function(x){
        themean<-mean(x, na.rm=TRUE)
        thesd<-sqrt(var(x, na.rm=TRUE))
        out<-list(mean=round(themean,2), sd=round(thesd,2))
        return(out)
      }
      shapevect<-poly$out
      if(input$BIO=="Species Composition"){
        fqt<-freq(bio_use, zones=vect(shapevect)) %>% mutate(pct_comp = 100*count/sum(count))
        
        all_spp<-as.data.frame(expand.grid(levels(bio_use)[[1]][,2], unique(fqt$zone)))
        colnames(all_spp)[1:2]<-c("Species", "ID")
        use_cols<-c("value", "zone", "pct_comp")
        all_spp<-merge(all_spp, fqt[,use_cols], by.x=c("Species", "ID"), by.y=c("value", "zone"), all.x=TRUE, all.y=FALSE)
        all_spp$pct_comp[is.na(all_spp$pct_comp)]<-0
        spp_out<-tidyr::pivot_wider(all_spp, id_cols=ID, names_from = Species, values_from = pct_comp) %>% as.data.frame()
        e<-cbind(shapevect, as.data.frame(spp_out))
        #cbind(shapevect, spp_out)
        
      }else{
        if(input$BIO=="All Biometrics"){
          ext_ras<-bio_use[names(bio_use)!= "Species Composition"]
          
          e <- lapply(ext_ras, extract, shapevect, fnx, bind = FALSE, raw=FALSE)
          
          spp_ras<-bio_use[names(bio_use)== "Species Composition"][[1]]
          fqt<-freq(spp_ras, zones=vect(shapevect)) %>% mutate(pct_comp = 100*count/sum(count))
          
          all_spp<-as.data.frame(expand.grid(levels(spp_ras)[[1]][,2], unique(fqt$zone)))
          colnames(all_spp)[1:2]<-c("Species", "ID")
          use_cols<-c("value", "zone", "pct_comp")
          all_spp<-merge(all_spp, fqt[,use_cols], by.x=c("Species", "ID"), by.y=c("value", "zone"), all.x=TRUE, all.y=FALSE)
          all_spp$pct_comp[is.na(all_spp$pct_comp)]<-0
          spp_out<-tidyr::pivot_wider(all_spp, id_cols=ID, names_from = Species, values_from = pct_comp) %>% as.data.frame()
          e[[length(e)+1]]<-spp_out
          names(e)[length(e)]<-"Species Composition"
          e<-lapply(e, function(X, Y){cbind(Y, as.data.frame(X))}, shapevect) 
        }else{
          e <- terra::extract(bio_use, shapevect, fnx, bind = FALSE)
          
          e<-cbind(shapevect, as.data.frame(e))
          #   st_as_sf(cbind(shapevect, e[, -1, drop = FALSE]))
        }
      } 
      
      return(e)
    }
  })
  
  observeEvent(input$MAP_draw_new_feature, {
    req(input$BIO)
    coords$dtf<-data.frame(do.call( rbind, do.call(cbind,input$MAP_draw_new_feature$geometry$coordinates)))
    colnames(coords$dtf)<-c("long", "lat")
    sfp <- coords$dtf %>%
      st_as_sf(coords = c("long", "lat"), crs = 4326) %>%
      summarise(geometry = st_combine(geometry)) %>%
      st_cast("POLYGON") %>% st_transform(crs=6557) %>% st_as_sf()
    
    row.names(sfp)<-input$MAP_draw_new_feature$properties$layerId
    if(is.null(poly$out)){
      poly$out<-sfp
      isolate(print(row.names(poly$out)))
    }else{
      rn<-row.names(poly$out)
      poly$out<-rbind(poly$out, sfp)
      row.names(poly$out)[-nrow(poly$out)]<-rn
      row.names(poly$out)[nrow(poly$out)]<-row.names(sfp)
      isolate(print(row.names(poly$out)))
    }
    
  })
  
  observeEvent(input$MAP_draw_edited_features, {
    
    dtf<-data.frame(do.call(rbind, do.call(cbind, input$MAP_draw_edited_features$geometry$coordinates)))
    colnames(dtf)<-c("long", "lat")
    
    sfp <- dtf %>%
      st_as_sf(coords = c("long", "lat"), crs = 4326) %>%
      summarise(geometry = st_combine(geometry)) %>%
      st_cast("POLYGON") %>% st_transform(crs=6557) %>% st_as_sf()
    
    row.names(sfp)<-input$MAP_draw_edited_features$properties$layerId
    rn<-row.names(poly$out)
    isolate(poly$out)
    poly$out<-poly$out[!row.names(poly$out) %in% row.names(sfp),]
    
    row.names(poly$out)<-rn[!rn %in% rownames(sfp)]
    isolate(poly$out)
    poly$out<-rbind(poly$out, sfp)
    row.names(poly$out)[1:(nrow(poly$out)-1)]<-rn[!rn %in% rownames(sfp)]
    row.names(poly$out)[nrow(poly$out)]<-row.names(sfp)
    
    isolate(poly$out)
    
  })
  
  
  observeEvent(input$drawnPoly_deleted_features, { 
    
    f <- input$drawnPoly_deleted_features
    ids<-lapply(f$features, function(x){unlist(x$properties$layerId)})
    polys$out<-polys$out[!row.names(polys$out) %in% ids ,]
    
  }) 
  
  output$TABLE<-renderUI({
    req(input$BIO)
    if(!is.null(poly$out)){
      data.out<-bio_extract() 
      
      if(input$BIO=="All Biometrics"){
        
        for(i in 1:length(data.out)){
          if(i < length(data.out)){
            data.out[[i]]<-as.data.frame(data.out[[i]] %>% st_drop_geometry())
            
            colnames(data.out[[i]])<-c("Area of Interest","Estimate Mean", "Estimate Standard Deviation",
                                       "Lower Bound <br> 95% Prediction Interval <br> Mean", "Lower Bound <br> 95% Prediction Interval <br> Standard Deviation",
                                       "Upper Bound <br> 95% Prediction Interval <br> Mean", "Upper Bound <br> 95% Prediction Interval <br> Standard Deviation")
          }else{
            data.out[[i]]<-data.out[[i]] %>% st_drop_geometry() %>% mutate(across(.cols=everything(), ~paste(round(.x, 1), "%"))) %>% as.data.frame()
            
            colnames(data.out[[i]])[1]<-"Area of Interest"
          }
          
        }
        
        kbl_out<-lapply(data.out, function(X){
          kbl(X, format="html", align="c", escape=FALSE, col.names=colnames(X)) %>% 
            column_spec(column=c(1:ncol(X)), width_min="3.5cm") %>% 
            kable_styling()
        })
        
        table_formatter<-function(tname, tkbl){
          paste0("<center><b><u><font size = '+2'>", tname, "</font></u></b></center>",
                 "<br><center>", tkbl, "</center><br>")}
        
        HTML(table_formatter(names(data.out), kbl_out))
        
      }else{
        data.out<-data.out %>% st_drop_geometry()
        table_formatter<-function(tname, tkbl){
          paste0("<center><b><u><font size = '+2'>", tname, "</font></u></b></center>",
                 "<br><center>", tkbl, "</center><br>")}
        
        if(input$BIO!="Species Composition"){
          use_names<-c("Area of Interest","Estimate Mean", "Estimate Standard Deviation",
                       "Lower Bound <br> 95% Prediction Interval <br> Mean", "Lower Bound <br> 95% Prediction Interval <br> Standard Deviation",
                       "Upper Bound <br> 95% Prediction Interval <br> Mean", "Upper Bound <br> 95% Prediction Interval <br> Standard Deviation")
        }else{
          
          use_names<-colnames(data.out)
          data.out<-data.out %>% mutate(across(.cols=everything(), ~paste(round(.x, 1), "%")))
        }
        kbl_out<-kbl(data.out, format="html", escape = FALSE, col.names=use_names, align="c") %>% 
          column_spec(column=c(1:ncol(data.out)), width_min = "3.5cm") %>% 
          kable_styling()
        HTML(table_formatter(input$BIO, kbl_out))
      }
    }  
  })
  
  output$downloadData<-downloadHandler(
    
    filename <- function(){
      fname<-input$BIO
      paste(fname, "Polygon.gpkg", sep="_")}, 
    
    content = function(file) {
      #   req(polys$out)
      if (length(Sys.glob(paste(input$BIO, "*", sep=".")))>0){
        file.remove(Sys.glob(paste(input$BIO, "*", sep=".")))
      }
      
      owd<-setwd(tempdir())
      on.exit(setwd(owd))
      polys_out<-bio.extract()
      if(input$BIO=="All Biometrics"){
        polys_out2<-rapply(polys_out, function(X){merge(X, X, by=names(X)[1])}, how="replace")
      }else{
        polys_out2<-polys_out
      }
      st_write(polys_out2, "polyExport.gpkg", "GPKG", append=FALSE)  
      file.rename("polyExport.gpkg", file)  
      
      if (length(Sys.glob("polyExport.*"))>0){
        file.remove(Sys.glob("polyExport.*"))
      }
    })
}

shinyApp(ui=ui, server=server)