fix fuzzy search

.Rbuildignore

@@ -23,3 +23,4 @@
 ^tests/testthat/apps$
 ^Dockerfile$
 ^test_debian.sh$
+^dev$

.gitignore

@@ -16,3 +16,5 @@ docs
 rsconnect
 test_debian.sh
 Dockerfile
+# development
+dev

DESCRIPTION

@@ -32,8 +32,6 @@ Suggests:
     cffr,
     covr,
     curl,
-    devtools (>= 2.4.3),
-    diffviewer (>= 0.1.1),
     globals (>= 0.14.0),
     knitr,
     rmarkdown,
@@ -63,7 +61,7 @@ Imports:
     maps (>= 3.4.0),
     ncmeta (>= 0.3.0),
     RNetCDF (>= 2.6.1),
-    dplyr (>= 1.0.9)
+    dplyr
 Config/testthat/edition: 3
 VignetteBuilder: knitr
 Depends: 

R/filter_NOAA.R

@@ -174,14 +174,10 @@ extract_coords <- function(plane, coords, depth, epsg, fuzzy = 0, bilinear = is.
 
   # add coordinates in case of matrix
   if (inherits(coords , "matrix")) {
-
     tb <- sf::st_as_sf(cbind(tb, coords), coords = c("lon", "lat"), crs = epsg)
-
   # change coordinate system of sfc class if needed
   } else if (inherits(coords, c("sf", "sfc")) & sf::st_crs(tb) != epsg) {
-
     tb <- sf::st_transform(tb, epsg)
-
   }
 
   if (any(is.na(tb[[1]])) & fuzzy > 0) {
@@ -199,18 +195,19 @@ extract_coords <- function(plane, coords, depth, epsg, fuzzy = 0, bilinear = is.
         bilinear = FALSE
       )
     )
+
     tb_ft$id <- ft$id
 
     # replace NAs
-    tb <- rbind(tb, sf::st_as_sf(tb_ft)) |>
-      dplyr::group_by(.data$id) |>
-      dplyr::summarise(
-        dplyr::across(-.data$geometry, .fns = ~mean(.x, na.rm = TRUE)),
-        .groups = "drop"
-      ) |>
-      dplyr::mutate(geometry_search = .data$geometry, geometry = tb$geometry)
+    tb <- rbind(tb,  sf::st_as_sf(tb_ft))
+    tb <- tb[!is.na(tb[[1]]),]
+  }
 
+  if (inherits(tb, "stars")) {
+    tb <- tb[names(tb) != "id"]
+  } else {
+    tb <- tb[, colnames(tb) != "id"]
   }
-  dplyr::select(tb, -.data$id)
+  tb
 }
 

R/filter_module.R

@@ -195,11 +195,19 @@ filter_server <- function(id, NOAA, external, ivars = c("depth", "lon", "lat"),
         ) {
 
         req(NOAA)
+
+        # fuzzy search value
+        if (input$search == "point") {
+          fz = 0
+        } else if (input$search == "fuzzy") {
+          fz = 50
+        }
         # execute
         filter_NOAA(
           NOAA(),
           input2$depth,
-          list(lon = input2$lon, lat = input2$lat)
+          list(lon = input2$lon, lat = input2$lat),
+          fuzzy = fz
         )
       }
     })
@@ -296,9 +304,10 @@ filter_server <- function(id, NOAA, external, ivars = c("depth", "lon", "lat"),
                    "and \"fuzzy\", where the former results in a very precise ",
                    "search, the latter option searches in an area with a ",
                    "circumference of 50 km around the selected coordinate ",
-                   "point. The returned value of a fuzzy search is therefore ",
-                   "an average of the search area. Currently, fuzzy search is ",
-                   "not yet implemented."),
+                   "point. Fuzzy search is only applied for points that don't ",
+                   "return a value for the normal point search. The returned ",
+                   "value of a fuzzy search is therefore an average of the ",
+                   "search area."),
           )
         )
       )

R/plot_NOAA.R

@@ -82,9 +82,9 @@ plot_NOAA <- function(NOAA, depth = 0, points = NULL, epsg = NULL, rng = NULL) {
     stars::geom_stars(data = NOAA) +
     ggplot2::geom_sf(data = wmap, fill = "grey")
 
-  if (!is.null(points)) {
+  if (!is.null(points) && nrow(points) != 0) {
     base <- base +
-      ggplot2::geom_sf(data = points)
+      ggplot2::geom_sf(data = points, fill = "black", linewidth = 2)
   }
 
   if (epsg == 3031 | epsg == 3995 | epsg == sf::st_crs(3031) |
@@ -109,7 +109,7 @@ plot_NOAA <- function(NOAA, depth = 0, points = NULL, epsg = NULL, rng = NULL) {
       panel.grid.major = ggplot2::element_line(
         color = grDevices::gray(.25),
         linetype = 'dashed',
-        size = 0.5
+        linewidth = 0.5
       ),
       panel.ontop = TRUE,
       axis.line = ggplot2::element_blank(),

R/table_utils.R

@@ -20,8 +20,8 @@ format_coord <- function(NOAA, coord) {
 
   # split coords in long and lat
   coords <- strsplit(sf::st_as_text(NOAA$geometry), "[^[:alnum:]|.|-]+")
-  coords <- do.call(Map, c(f = c, coords)) |>
-    stats::setNames(c("geometry", "longitude", "latitude"))
+  coords <- Map(coords_df, coords)
+  coords <- do.call(rbind, coords)
 
   # remove old geometry
   NOAA <- as.data.frame(NOAA)
@@ -30,3 +30,12 @@ format_coord <- function(NOAA, coord) {
   # combine new
   cbind(NOAA_sc, coords)
 }
+
+coords_df <- function(x) {
+  subset_x <- x[2:length(x)]
+  data.frame(
+    geometry = x[1],
+    longitude = I(list(subset(subset_x, seq_along(subset_x) %% 2 != 0))),
+    latitude = I(list(subset(subset_x, seq_along(subset_x) %% 2 == 0)))
+  )
+}