Merge pull request #116 from stevenpbachman/map_issues

Sorts out #101 zoom level, #98 GBIF field update and #59 polygon draw…
stevenpbachman · Dec 16, 2023 · ab955e9 · ab955e9
2 parents 98b3ca3 + d76634c
commit ab955e9
Show file tree

Hide file tree

Showing 5 changed files with 52 additions and 25 deletions.
diff --git a/R/analysis.R b/R/analysis.R
@@ -34,6 +34,7 @@
 #' Joppa, L.N., Butchart, S.H.M., Hoffmann, M., Bachman, S.P., Akçakaya, H.R., Moat, J.F., Böhm, M., Holland, R.A., Newton, A., Polidoro, B., Hughes, A., 2016. Impact of alternative metrics on estimates of extent of occurrence for extinction risk assessment. Conserv. Biol. 30, 362–370. doi:10.1111/cobi.12591
 library(pracma)
 library (sf)
+library (smoothr) #probably change to terra at some point, but this is lightwieght
 
 eoosh <- function(points) {
   if (! "X" %in% colnames(points) | ! "Y" %in% colnames(points)) {
@@ -54,6 +55,8 @@ eoosh <- function(points) {
   p1 <- sf::st_polygon(list(p1))
   #set projection
   p1 <- sf::st_sfc(p1, crs = attr(points,'crs'))
+  #densify polygon to deal with real curves etc (ie not point to point lines)
+  p1 <- densify(p1,n=10)
   #to geographic
   p1 <- sf::st_transform(p1,4326)
   #dealing with dateline

diff --git a/R/app.R b/R/app.R
@@ -386,13 +386,14 @@ geocatApp <- function(...) {
     prot_planet_url <- "https://data-gis.unep-wcmc.org/server/rest/services/ProtectedSites/The_World_Database_of_Protected_Areas/MapServer/tile/{z}/{y}/{x}"
 
     output$mymap <- leaflet::renderLeaflet({
-      leaflet::leaflet(options = leaflet::leafletOptions(minZoom = 2, attributionControl=FALSE)) %>%
+      leaflet::leaflet(options = leaflet::leafletOptions(minZoom = 1, attributionControl=FALSE,worldCopyJump=TRUE)) %>%
         leaflet.extras::addSearchOSM(options = leaflet.extras::searchOptions(
           autoCollapse = F,
           collapsed = F,
           minLength = 2,
           position = "topright"
         )) %>%
+        leaflet::setView(0 ,0,zoom = 2) %>%
 
         leaflet::addScaleBar(position = "bottomright") %>%
 
@@ -487,7 +488,7 @@ geocatApp <- function(...) {
       msg <- format_new_point(input$mymap_draw_new_feature)
       values$messages <- c(values$messages, info_message(paste(msg)))
     })
-
+    #I DONT THINK THIS IS USED IN ANYWAY
     observeEvent(input$`key-add-point`, {
       long <- input$`custom-long`
       lat <- input$`custom-lat`
@@ -497,20 +498,7 @@ geocatApp <- function(...) {
       msg <- format_new_point(feature)
       values$messages <- c(values$messages, info_message(paste(msg)))   
 
-      leaflet::leafletProxy("mymap") %>% 
-        leaflet::addCircleMarkers(
-          group = "mappoints",
-          lng = long,
-          lat = lat,
-          color="#FFFFFF",
-          radius = circleRadius,
-          stroke=T,
-          weight=2.5,
-          fill=T,
-          fillColor=customCol,
-          opacity=1,
-          fillOpacity=0.5
-        )
+
     })
 
     observeEvent(input$reload, {

diff --git a/R/edit-data.R b/R/edit-data.R
@@ -32,10 +32,23 @@ create_point_feature <- function(long, lat) {
 add_point <- function(feature) {
   id <- paste0("user", feature$properties[["_leaflet_id"]])
   note <- format_new_point(feature)
+  #################################
+  #JM this corrects any outside of -180 or 180 points in the data, but not the drawing
+  if (feature$geometry$coordinates[[1]] > 180){
+    longituder <- feature$geometry$coordinates[[1]]-360
+  } else if (feature$geometry$coordinates[[1]] < -180) {
+    longituder <- feature$geometry$coordinates[[1]] + 360
+  } else {
+    longituder <- feature$geometry$coordinates[[1]]
+  }
+  #################################
 
   tibble::tibble(
     latitude=feature$geometry$coordinates[[2]],
-    longitude=feature$geometry$coordinates[[1]],
+    #longitude=feature$geometry$coordinates[[1]],
+    longitude=longituder,
+    spatialref="WGS84",
+    yrcompiled=as.integer(format(Sys.Date(), "%Y")),
     geocat_use=TRUE,
     geocat_deleted=FALSE,
     geocat_source="User point",

diff --git a/R/import-data.R b/R/import-data.R
@@ -16,6 +16,10 @@
 import_csv <- function(path) {
   data <- read_csv(path, show_col_types=FALSE, progress=FALSE)
   data <- rename_with(data, str_to_lower)
+  ############check for lat or long fields and rename
+  colnames(data)[which("lat"== colnames(data))] <- "latitude"
+  colnames(data)[which("long"== colnames(data))] <- "longitude"
+  ###############
 
   template <- empty_tbl_()
   template_names <- colnames(template)

diff --git a/R/validate-data.R b/R/validate-data.R
@@ -21,17 +21,36 @@ validate_csv <- function(df) {
     geocat_notes=ifelse(is.na(longitude) | is.na(latitude), "Missing coordinates", geocat_notes)
   )
 
-  msg <- c(msg, warn_message(check_range_(df, "longitude", -180, 180)))
+  #deals with the case of points 0-360 or -360-0 for longitude and forces them to between -180-180
+  #JM 12 2023
+  #should send a message, but I can't work out Baz's code
   validated <- mutate(
-    validated, 
-    geocat_use=case_when(longitude < -180 ~ FALSE,
-                         longitude > 180 ~ FALSE, 
+      validated,
+      geocat_notes=case_when(longitude < -180 & longitude > -360 ~ "Longitude below -180, forced to between -180-180",
+                             longitude > 180 & longitude < 360 ~ "Longitude above 180, forced to between -180-180",
+                            .default = ""),
+
+      longitude=case_when(longitude < -180 & longitude > -360 ~ longitude + 360,
+                            longitude > 180 & longitude < 360 ~ longitude - 360,
+                          .default = longitude),
+  )
+
+
+  msg <- c(msg, warn_message(check_range_(df, "longitude", -360, 360)))
+  validated <- mutate(
+    validated,
+
+
+    geocat_use=case_when(longitude < -360 ~ FALSE,
+                         longitude > 360 ~ FALSE, 
                          TRUE ~ geocat_use),
-    geocat_deleted=case_when(longitude < -180 ~ TRUE,
-                             longitude > 180 ~ TRUE, 
+    geocat_deleted=case_when(longitude < -36 ~ TRUE,
+                             longitude > 360 ~ TRUE, 
                              TRUE ~ geocat_deleted),
-    geocat_notes=case_when(longitude < -180 ~ "Longitude out of range",
-                           longitude > 180 ~ "Longitude out of range", 
+
+
+    geocat_notes=case_when(longitude < -360 ~ "Longitude out of range",
+                           longitude > 360 ~ "Longitude out of range", 
                            TRUE ~ geocat_notes)
     )