Better search filtering, add 'target' marker to maps, fix some catalo…

…gue column types

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: senamhiR
 Type: Package
 Title: A Collection of Functions to Obtain Peruvian Climate Data
-Version: 0.5.0
+Version: 0.5.1
 Date: 2017-10-08
 Authors@R: c(person(given = c("Conor", "I."), family = "Anderson", 
            role = c("aut","cre"), email = "[email protected]"),

NAMESPACE

@@ -12,10 +12,14 @@ importFrom(DBI,dbGetQuery)
 importFrom(DBI,dbListTables)
 importFrom(DBI,dbReadTable)
 importFrom(RMySQL,MySQL)
+importFrom(dplyr,arrange)
 importFrom(dplyr,filter)
+importFrom(dplyr,mutate)
+importFrom(dplyr,rowwise)
 importFrom(dplyr,select)
 importFrom(geosphere,distGeo)
 importFrom(leaflet,addAwesomeMarkers)
+importFrom(leaflet,addCircleMarkers)
 importFrom(leaflet,addTiles)
 importFrom(leaflet,awesomeIcons)
 importFrom(leaflet,leaflet)

R/map_stations.R

@@ -5,7 +5,8 @@
 ##' @param station character; one or more station id numbers to show on the map.
 ##' @param zoom numeric; the level to zoom the map to.
 ##' 
-##' @importFrom leaflet addAwesomeMarkers addTiles awesomeIcons leaflet setView 
+##' @importFrom dplyr filter
+##' @importFrom leaflet addAwesomeMarkers addCircleMarkers addTiles awesomeIcons leaflet setView 
 ##' @importFrom magrittr %>%
 ##' 
 ##' @export
@@ -22,31 +23,24 @@
 
 map_stations <- function(station, zoom) {
 
-  if (inherits(station, "data.frame")) {
-    station <- station$StationID
+  if (!inherits(station, "data.frame")) {
+    if (any(nchar(station) < 6)) {
+      station[nchar(station) < 6] <- suppressWarnings(
+        try(sprintf("%06d", as.numeric(station[nchar(station) < 6])),
+            silent = TRUE))
+    }
+
+    if (inherits(station, "try-error") || !station %in% catalogue$StationID) {
+      stop("One or more requested stations invalid.")
+    }
+
+    station <- filter(catalogue, StationID %in% station)
   }
 
-  if (any(nchar(station) < 6)) {
-    station[nchar(station) < 6] <- suppressWarnings(
-      try(sprintf("%06d", as.numeric(station[nchar(station) < 6])),
-          silent = TRUE))
-  }
-
-  if (inherits(station, "try-error") || !station %in% catalogue$StationID) {
-    stop("One or more requested stations invalid.")
-  }
-
-  poi <- NULL
-
-  for (i in station) {
-    poi <- c(poi, which(catalogue$StationID == i))
-  }
-  poi <- catalogue[poi,]
-
-  hilat <- ceiling(max(poi$Latitude))
-  lolat <- floor(min(poi$Latitude))
-  hilon <- ceiling(max(poi$Longitude))
-  lolon <- floor(min(poi$Longitude))
+  hilat <- ceiling(max(station$Latitude))
+  lolat <- floor(min(station$Latitude))
+  hilon <- ceiling(max(station$Longitude))
+  lolon <- floor(min(station$Longitude))
   lats <- (hilat + lolat)/2
   lons <- (hilon + lolon)/2
   if (missing(zoom)) {
@@ -83,14 +77,22 @@ map_stations <- function(station, zoom) {
   }
 
   icons <- awesomeIcons(
-    icon = defIcons(poi),
+    icon = defIcons(station),
     iconColor = 'black', 
     library = 'ion',
-    markerColor = defColours(poi)
+    markerColor = defColours(station)
   )
 
-  leaflet(poi) %>% addTiles() %>% 
+  map <- leaflet(station) %>% addTiles() %>% 
     setView(lng = lons, lat = lats, zoom = zoom)  %>% 
     addAwesomeMarkers(~Longitude, ~Latitude, icon = icons,  
-      label = paste0(poi$StationID, " - ", poi$Station, " (", poi$Configuration, ")")) 
+      label = paste0(station$StationID, " - ", station$Station, " (", station$Configuration, ")"))
+
+  # Add a target if it exists
+  target <- c(attr(station, "target_lon"), attr(station, "target_lat"))
+  if (!is.null(target)) {
+    map <- map %>% addCircleMarkers(lng = target[1], lat = target[2], color = "red", label = "target")
+  }
+
+  map
 }

R/station_search.R

@@ -6,7 +6,7 @@
 ##' @param ignore.case logical; by default the search for station names is not case-sensitive.
 ##' @param glob logical; whether to allow regular expressions in the \code{name}. See \code{\link{glob2rx}}.
 ##' @param region character; optional character string to filter results by region.
-##' @param baseline vector; optional vector with a start and end year for a desired baseline.
+##' @param period numeric; optional, either a range of years or the total number of years of data that must be available.
 ##' @param config character; the configuration of the station ((m)eteorological or (h)ydrological)
 ##' @param target numeric; optional station ID of a target station, or a vector of length 2 containing latitude and longitude (in that order).
 ##' @param dist numeric; vector with a range of distance from the target in km. Only used if a target is specified. (default is 0:100)
@@ -15,6 +15,7 @@
 ##'
 ##' @return A data frame containing the details of matching stations.
 ##' 
+##' @importFrom dplyr arrange filter mutate rowwise
 ##' @importFrom geosphere distGeo 
 ##' @importFrom utils glob2rx
 ##' 
@@ -30,14 +31,14 @@
 ##' station_search(name = "San*", glob = TRUE)
 ##' 
 ##' # Find stations with data available from 1971 to 2000.
-##' station_search(baseline = 1971:2000)
+##' station_search(period = 1971:2000)
 ##' 
 ##' # Find all stations between 0 and 100 km from Station '000401'
 ##' station_search(target = '000401', dist = 0:100)
 ##' 
 
 station_search <- function(name = NULL, ignore.case = TRUE, glob = FALSE, region = NULL, 
-  baseline = NULL, config = NULL, target = NULL, dist = 0:100, sort = TRUE, ...) {
+  period = NULL, config = NULL, target = NULL, dist = 0:100, sort = TRUE, ...) {
 
   if (!is.null(target) && length(target) == 1L && nchar(target) < 6) {
     target <- suppressWarnings(try(sprintf("%06d", as.numeric(target)), silent = TRUE))
@@ -46,65 +47,56 @@ station_search <- function(name = NULL, ignore.case = TRUE, glob = FALSE, region
     }
   }
 
+  filt <- catalogue
+
   # If `name` is not NULL, filter by name
   if (!is.null(name)) {
     if (glob) name <- glob2rx(name)
-    index <- grep(name, catalogue$Station, ignore.case = ignore.case, ...)
-  } else {
-    index <- 1:nrow(catalogue)
-  }
+    filt <- filter(filt, grepl(name, Station, ignore.case = ignore.case, ...))
+  } 
 
   # If `region` is not NULL, filter by name
   if (!is.null(region)) {
-    index <- index[which(catalogue$Region == toupper(region))]
-    if (length(index) == 0) {
+    filt <- filter(filt, Region == toupper(region))
+    if (nrow(filt) == 0) {
       stop("No data found for that region. Did you spell it correctly?")
     }
   }
 
-  # If `config` is not NULL, filter by name
+  # If `config` is not NULL, filter by config
   if (!is.null(config)) {
-    index <- index[grep(config, catalogue$Configuration[index], ignore.case = ignore.case, 
-      ...)]
-    if (length(index) == 0) {
+    filt <- filter(filt, grepl(config, Configuration, ignore.case = ignore.case, ...))
+    if (nrow(filt) == 0) {
       stop("No data found for that config. Did you pass \"m\" or \"h\"?")
     }
   }
 
-  # Make a table with the info we want
-  df <- catalogue[index, ]
-
-  # If `baseline` is not NULL, filter by available data
-  if (!is.null(baseline)) {
-    index = NULL
-    # Identify all stations outside of our baseline
-    for (i in 1:nrow(df)) {
-      if (is.na(df$`Data Start`[i]) | df$`Data Start`[i] > min(baseline)) 
-        index <- c(index, i) else if (is.na(df$`Data End`[i]) | df$`Data End`[i] < max(baseline)) 
-        index <- c(index, i)
+  # If `period` is not NULL, filter by available data
+  if (!is.null(period)) {
+    if (length(period) == 1) {
+      filt <- filter(filt, `Period (Yr)` >= period)
+    } else {
+      filt <- filter(filt, `Data Start` <= min(period) & `Data End` >= max(period))  
+    }
+    if (nrow(filt) == 0) {
+      stop("No station was found for the specified period.")
     }
-    # Delete those stations
-    if (!is.null(index)) 
-      df <- df[-index, ]
   }
-  
+
   # If `target` is not NULL, filter by distance to target
   if (!is.null(target)) {
     if (length(target) == 1L) {
-      p1 <- c(df$Longitude[grep(paste0("\\b", as.character(target), "\\b"), 
-        df$StationID)], df$Latitude[grep(paste0("\\b", as.character(target), 
-        "\\b"), df$StationID)])
+      p1 <- filt %>% filter(StationID == target) %>% select(Longitude, Latitude) %>% unlist
     } else if (length(target) == 2L) {
       p1 <- c(target[2], target[1])
     } else stop("error: check target format")
-    df$Dist <- rep(NA, nrow(df))
-    for (j in 1:nrow(df)) {
-      df$Dist[j] <- (distGeo(p1, c(df$Longitude[j], df$Latitude[j]))/1000)
-    }
-    df <- df[(!is.na(df$Dist) & (df$Dist >= min(dist)) & (df$Dist <= max(dist))), 
-      ]
-    if (sort == TRUE) 
-      df <- df[order(df$Dist), ]
+    filt <-  rowwise(filt) %>%
+      mutate(Dist = distGeo(p1, c(Longitude, Latitude))/1000) %>%
+      filter(Dist >= min(dist) & Dist <= max(dist))
+    if (sort == TRUE) filt <- arrange(filt, Dist)
+    attr(filt, "target_lon") <- p1[1]
+    attr(filt, "target_lat") <- p1[2]
   }
-  df
+
+  filt
 }

README.Rmd

@@ -50,15 +50,15 @@ Note that you can also use wildcards as supported by the `glob2rx()` from the `u
 station_search("San*", glob = TRUE)
 ```
 
-You can filter your search results by region, by station type, by a given baseline period, and by proximity to another station or a vector of coordinates. You can use any combination of these four filters in your search. The function is fully documented, so take a look at `?station_search`. Let's see some examples.
+You can filter your search results by region, by station type, by a given period, and by proximity to another station or a vector of coordinates. You can use any combination of these four filters in your search. The function is fully documented, so take a look at `?station_search`. Let's see some examples.
 
 #### Find all stations in the San Martín Region
 ```{r}
 station_search(region = "SAN MARTIN")
 ```
-#### Find stations named "Santa", with data available between  1971 to 2000
+#### Find stations named "Santa", with data available between 1971 to 2000
 ```{r}
-station_search("Santa", baseline = 1971:2000)
+station_search("Santa", period = 1971:2000)
 ```
 #### Find all stations between 0 and 100 km from Station No. 000401
 ```{r}