Merge pull request #27 from onaio/feb3-cleanup

Feb3 cleanup

Author: mberg

fn-adaptive-sampling-0.3.1/fn-adaptive-sampling/function.R

@@ -1,92 +1,43 @@
 suppressPackageStartupMessages({
   library(RANN)
-  library(sf)
-  library(jsonlite)
 })
 
 function(params) {
-  # 1. Handle input
-  # NOTE: from preprocess_params
-  point_data = params[['point_data']]
-  batch_size = params[['batch_size']]
-  uncertainty_fieldname = params[['uncertainty_fieldname']]
+  coords <- params[['coordinates']]      # matrix of [lon, lat] from preprocessing
+  uncertainty <- params[['uncertainty']]  # numeric vector from preprocessing
+  batch_size <- params[['batch_size']]
 
+  n <- nrow(coords)
 
-  # 2. Process
-  candidates_copy <- point_data
+  # Replace zero uncertainty with small value to allow inclusion
+  uncertainty[uncertainty == 0] <- 0.0001
+  uncertainty_prob <- uncertainty / sum(uncertainty)
 
-  # Filter out points that have already been visited (have n_positive value)
-  # Store original row indices for later mapping
-  if ("n_positive" %in% names(point_data)) {
-    # Exclude points where n_positive is not NA (already surveyed)
-    # Keep only points where n_positive is NA (not yet visited)
-    candidate_indices <- which(is.na(point_data$n_positive))
-    candidates <- point_data[candidate_indices, ]
-  } else {
-    candidate_indices <- 1:nrow(point_data)
-    candidates <- point_data
-  }
-
-  # Change any 0 probabilities to 0.0001 to allow them to be included (effectively randomly)
-  candidates[[uncertainty_fieldname]] [candidates[[uncertainty_fieldname]]==0] <- 0.0001
-
-  candidates$uncertainty_prob <- as.data.frame(candidates)[, uncertainty_fieldname] / sum(as.data.frame(candidates)[, uncertainty_fieldname])
-
-  # Give each an id (for internal tracking during sampling)
-  candidates$temp_id <- 1:nrow(candidates)
-  in_sample <- sample(1:nrow(candidates), 1, prob = candidates$uncertainty_prob)
-  
+  # Select first point by uncertainty probability
+  in_sample <- sample(1:n, 1, prob = uncertainty_prob)
 
-  # Loop
+  # Iteratively select remaining points using uncertainty * spatial diversity
   if (batch_size > 1) {
     for (i in 1:(batch_size - 1)) {
-      
-      # Define which is in and out of sample
-      candidates_in_sample <- candidates[in_sample, , drop = FALSE]
-      candidates_not_in_sample <- candidates[-in_sample, , drop = FALSE]
+      not_in_sample <- setdiff(1:n, in_sample)
 
-      # First calc distance between the in_sample and the rest
-      # Use centroids for both points and polygons
-      # st_centroid works on any geometry type (points return themselves)
-      # Suppress warnings about attributes being discarded
-      coords_in_sample <- suppressWarnings(st_coordinates(st_centroid(candidates_in_sample)))
-      coords_not_in_sample <- suppressWarnings(st_coordinates(st_centroid(candidates_not_in_sample)))
-      nn <- nn2(coords_in_sample, coords_not_in_sample)
-      
-      # convert distances to selection probability
-      min_dist_to_other_points <- apply(nn$nn.dists, 1, min)
-      min_dist_to_other_points <- min_dist_to_other_points / sum(min_dist_to_other_points)
-      
-      # Multiply by entropy
-      candidates_not_in_sample$pen_uncertainty <- 
-        candidates_not_in_sample$uncertainty_prob * min_dist_to_other_points
-      
-      candidates_not_in_sample$uncertainty_prob <- 
-        candidates_not_in_sample$pen_uncertainty / sum(candidates_not_in_sample$pen_uncertainty)
-      
-      # Sample
-      uncertainty_sample <- sample(1:nrow(candidates_not_in_sample), 1, prob = candidates_not_in_sample$uncertainty_prob)
-      in_sample <- c(in_sample, candidates_not_in_sample$temp_id[uncertainty_sample])
-    }
-  }
+      # Nearest-neighbor distances from sampled to unsampled points
+      nn <- nn2(coords[in_sample, , drop = FALSE], coords[not_in_sample, , drop = FALSE])
 
-  # 3. Package response
+      # Min distance from each unsampled point to any sampled point
+      min_dist <- apply(nn$nn.dists, 1, min)
+      min_dist <- min_dist / sum(min_dist)
 
-  # Return points with additional column
-  # Initialize adaptively_selected if it doesn't exist, or preserve existing values
-  if (!"adaptively_selected" %in% names(candidates_copy)) {
-    candidates_copy$adaptively_selected <- 0
+      # Combine distance diversity with uncertainty
+      pen_uncertainty <- uncertainty_prob[not_in_sample] * min_dist
+      pen_uncertainty <- pen_uncertainty / sum(pen_uncertainty)
+
+      # Sample next point
+      selected <- sample(1:length(not_in_sample), 1, prob = pen_uncertainty)
+      in_sample <- c(in_sample, not_in_sample[selected])
+    }
   }
 
-  # Mark newly selected points - map from candidates temp_ids back to original indices
-  original_indices <- candidate_indices[in_sample]
-  candidates_copy$adaptively_selected[original_indices] <- 1
-  
-  # Convert to geojson and handle NA values properly
-  result <- geojson_list(candidates_copy)
-  
-  # Convert the geo_list to a regular list to avoid serialization issues
-  result_list <- unclass(result)
-  
-  return(result_list)
+  # Return 0-indexed selected indices for Python
+  return(list(selected_indices = as.integer(in_sample - 1)))
 }

fn-adaptive-sampling-0.3.1/fn-adaptive-sampling/install_packages.R

@@ -3,4 +3,4 @@
 
 # For some reason `geojsonio` is not yet in rocker/geospatial. 
 # Remove from below if you don't need it.
-install.packages(c('geojsonio', 'RANN'))
+install.packages('RANN')

fn-adaptive-sampling-0.3.1/fn-adaptive-sampling/preprocess_params.R

@@ -1,48 +1,46 @@
-suppressPackageStartupMessages(library(sf))
-
 function(params) {
-  # if batch_size exists, must be a number > 0
+  # Validate batch_size
   if (!is.null(params[['batch_size']])) {
     if (!is.numeric(params[['batch_size']])) {
       stop('Parameter `batch_size` is not numeric')
     }
-
     if (params[['batch_size']] < 1) {
       stop('Parameter `batch_size` must be greater than zero')
     }
   } else {
     params[['batch_size']] = 1
   }
 
-
-
-  # Individual check for each parameter
-  if (is.null(params[['point_data']])) {
-    stop('Missing required `point_data` parameter')
+  # Validate required parameters
+  if (is.null(params[['coordinates']])) {
+    stop('Missing required `coordinates` parameter')
   }
 
-  if (is.null(params[['uncertainty_fieldname']])) {
-    stop('Mising required `uncertainty_fieldname` parameter')
+  if (is.null(params[['uncertainty']])) {
+    stop('Missing required `uncertainty` parameter')
   }
 
-  point_data = st_read(as.json(params[['point_data']]), quiet=T)
-  params[['point_data']] = point_data
+  # Convert coordinates to matrix and uncertainty to numeric vector.
+  # fromJSON may return a matrix (uniform array) or a list (ragged),
+  # so handle both.
+  coords <- params[['coordinates']]
+  if (!is.matrix(coords)) {
+    coords <- do.call(rbind, coords)
+  }
+  params[['coordinates']] <- coords
+  params[['uncertainty']] <- as.numeric(unlist(params[['uncertainty']]))
 
-  # Check
-  uncertainty_fieldname = params[['uncertainty_fieldname']]
+  n_coords <- nrow(params[['coordinates']])
+  n_uncertainty <- length(params[['uncertainty']])
 
-  # Check if uncertainty field exists in the data
-  point_data_df = as.data.frame(point_data)
-  if (!(uncertainty_fieldname %in% names(point_data_df))) {
-    stop(paste0('Uncertainty field "', uncertainty_fieldname, '" not found in data. Available fields: ', paste(names(point_data_df), collapse=', ')))
+  if (n_coords != n_uncertainty) {
+    stop(paste0('coordinates (', n_coords, ') and uncertainty (', n_uncertainty, ') must have same length'))
   }
 
-  rows_we_can_sample = sum(!is.na(point_data_df[, uncertainty_fieldname]))
-  if (params[['batch_size']] > rows_we_can_sample) {
-    stop('Batch size is larger than the number of points for which uncertainty is available (not NA)')
+  rows_available <- sum(!is.na(params[['uncertainty']]))
+  if (params[['batch_size']] > rows_available) {
+    stop('Batch size is larger than the number of points with non-NA uncertainty')
   }
 
-
-  # NOTE: Not all DiSARM functions use a `main.R` file that mutates the params. This one does.
   return(params)
-}
+}