Merge pull request #11 from uribo/v0.2.0

CRANへの登録

.Rbuildignore

@@ -1,8 +1,5 @@
-^\.env$
 ^jmastats\.Rproj$
 ^\.Rproj\.user$
-^Dockerfile$
-^docker-compose\.yml$
 ^data-raw$
 ^LICENSE\.md$
 ^\.DS_Store$
@@ -12,3 +9,5 @@
 ^\.github$
 ^inst/\.gitignore$
 ^inst/real$
+^cran-comments\.md$
+^CRAN-SUBMISSION$

DESCRIPTION

@@ -1,16 +1,16 @@
 Package: jmastats
-Version: 0.1.0.9000
+Version: 0.2.0
 Title: Download Weather Data from Japan Meteorological Agency Website
-Description: This package provides features that allow users to download 
-  weather data published by the Japan Meteorological Agency website 
+Description: Provides features that allow users to download 
+  weather data published by the Japan Meteorological Agency (JMA) website 
   (<https://www.jma.go.jp/jma/index.html>). The data includes information 
   dating back to 1976 and aligns with the categories available on the website. 
   Additionally, users can process the best track data of typhoons and easily 
   handle earthquake record files.
 Authors@R: c(person(given = "Shinya",
                                      family = "Uryu",
                                      email = "[email protected]",
-                                     role  = c("aut", "cre"),
+                                     role  = c("aut", "cph", "cre"),
                                      comment = c(ORCID = "0000-0002-0493-6186")))
 Depends: 
     R (>= 4.1)
@@ -19,10 +19,11 @@ BugReports: https://github.com/uribo/jmastats/issues
 URL: https://github.com/uribo/jmastats
 Imports: 
     cli (>= 3.4.0),
-    crayon (>= 1.3.4), 
+    crayon (>= 1.3.4),
     dplyr (>= 1.1.0),
     forcats (>= 0.4.0),
     ggplot2 (>= 2.2.1),
+    lifecycle (>= 1.0.3),
     lubridate (>= 1.7.4),
     purrr (>= 1.0.2),
     rappdirs (>= 0.3.3),
@@ -44,6 +45,5 @@ Suggests:
 Encoding: UTF-8
 LazyData: true
 ByteCompile: true
-VignetteBuilder: knitr
 RoxygenNote: 7.2.3
 Roxygen: list(markdown = TRUE)

LICENSE

@@ -1,2 +1,2 @@
-YEAR: 2022
+YEAR: 2022-2023
 COPYRIGHT HOLDER: jmastats authors

LICENSE.md

@@ -1,6 +1,6 @@
 # MIT License
 
-Copyright (c) 2022 Shinya Uryu
+Copyright (c) 2022-2023 Shinya Uryu
 
 Permission is hereby granted, free of charge, to any person obtaining a copy
 of this software and associated documentation files (the "Software"), to deal

NAMESPACE

@@ -35,6 +35,7 @@ importFrom(dplyr,ungroup)
 importFrom(forcats,fct_inorder)
 importFrom(ggplot2,scale_color_gradientn)
 importFrom(ggplot2,scale_fill_gradientn)
+importFrom(lifecycle,deprecated)
 importFrom(lubridate,ymd_h)
 importFrom(purrr,keep)
 importFrom(purrr,map)
@@ -70,6 +71,7 @@ importFrom(tidyselect,all_of)
 importFrom(tidyselect,where)
 importFrom(units,as_units)
 importFrom(units,set_units)
+importFrom(utils,askYesNo)
 importFrom(utils,read.table)
 importFrom(xml2,read_html)
 importFrom(xml2,url_parse)

NEWS.md

@@ -1,4 +1,19 @@
-# jmastats (development version)
+# jmastats 0.2.0
+
+* Initial release for CRAN.
+
+## Features
+
+* Added an interval when executing `jma_collect()` for reducing the load on the server.
+* A message is displayed when the data obtained by `jma_collect()` contains values such as missing values.
+
+## Fixes
+
+* Fixed an issue with parameters when acquiring data with `jma_collect()`.
+
+## Datasets
+
+* Various datasets handled by the package have been updated to the latest version in March 2023.
 
 # jmastats 0.1.0
 

R/appdir.R

@@ -1,9 +1,18 @@
-#' Remove cache files
+#' Remove all cache files
 #'
-#' @description Remove all package cache files.
+#' @description
+#' `r lifecycle::badge("experimental")`
+#'
+#' Remove all package cache files.
+#' @importFrom utils askYesNo
+#' @examples
+#' if (interactive())
+#'   reset_cache()
 #' @rdname reset_cache
 #' @export
+#' @return None
 reset_cache <- function() {
+if (utils::askYesNo("Delete all cache files. Is it OK?"))
   unlink(rappdirs::user_cache_dir("jmastats"),
          recursive = TRUE)
 }
@@ -22,10 +31,8 @@ pick_out_cache <- function(item = NULL,
 }
 
 search_cache_file <- function(item, station_type, param) {
-  cache_dir <- rappdirs::user_cache_dir("jmastats")
-  if (!file.exists(cache_dir)) {
-    dir.create(cache_dir, recursive = TRUE)
-  }
+  cache_dir <-
+    rappdirs::user_cache_dir("jmastats")
   file.path(
       cache_dir,
       paste0(item, "_",

R/ggplot2_scales.R

@@ -1,4 +1,8 @@
 #' Scales to use for ggplot2
+#'
+#' @description
+#' `r lifecycle::badge("experimental")`
+#'
 #' @param type Display item
 #' @param ... Arguments to pass on to [ggplot2::scale_color_gradientn] or
 #' [ggplot2::scale_fill_gradientn]
@@ -7,22 +11,19 @@
 #' @name ggplot2-scales
 #' @rdname ggplot2-scales
 #' @examples
-#' \dontrun{
-#' library(dplyr)
 #' d <-
-#' jma_collect("daily", block_no = "47646", year = 2017, month = 9, pack = FALSE) |>
-#' select(date, `precipitation_sum(mm)`, starts_with("temperature"), starts_with("sunshine")) |>
-#' parse_unit()
+#' data.frame(
+#'   date = as.Date(c(17410, 17411, 17412, 17413, 17414, 17415), origin = "1970-01-01"),
+#'   precipitation_sum = units::set_units(c(3.5, 9.5, 0, 0, 0, 5), "mm"))
 #'
 #' library(ggplot2)
 #' library(units)
-#' ggplot(d, aes(date, precipitation_sum_mm,
-#'           color = units::drop_units(precipitation_sum_mm),
-#'           fill = units::drop_units(precipitation_sum_mm))) +
+#' ggplot(d, aes(date, precipitation_sum,
+#'           color = drop_units(precipitation_sum),
+#'           fill = drop_units(precipitation_sum))) +
 #'   geom_bar(stat = "identity") +
 #'   scale_color_jma_absolute(type = "precipitation") +
 #'   scale_fill_jma_absolute(type = "precipitation")
-#' }
 #' @export
 scale_color_jma_absolute <- function(type = "precipitation", ...) {
 

R/jma_collect.R

@@ -1,6 +1,8 @@
 #' Collect JMA Historical Weather Data
 #'
 #' @description
+#' `r lifecycle::badge("stable")`
+#'
 #' Refer to the data available in the JMA Historical Weather Data Search.
 #' Executed by specifying the target location and date.
 #' Currently, not all types of data acquisition are supported.
@@ -36,17 +38,19 @@
 #' - rank: Values of the largest in the history of observations
 #' for each location.
 #' @examples
-#' \dontrun{
-#' jma_collect(item = "annually", "1284", year = 2017, month = 11)
-#' # daily
-#' jma_collect(item = "daily", block_no = "0010", year = 2017, month = 11)
-#' jma_collect(item = "daily", "0422", year = 2017, month = 11)
-#' # hourly
-#' jma_collect("hourly", "0010", 2018, 7, 30)
-#' # ranking
-#' jma_collect("rank", block_no = "47646", year = 2020)
+#' \donttest{
+#' # Annually
+#' jma_collect(item = "annually", "1284", year = 2017, month = 11, cache = FALSE)
+#' # Daily
+#' jma_collect(item = "daily", block_no = "0010", year = 2017, month = 11, cache = FALSE)
+#' jma_collect(item = "daily", "0422", year = 2017, month = 11, cache = FALSE)
+#' # Hourly
+#' jma_collect("hourly", "0010", 2018, 7, 30, cache = FALSE)
+#' # Historical Ranking
+#' jma_collect("rank", block_no = "47646", year = 2020, cache = FALSE)
 #' }
 #' @export
+#' @return a `tbl` object
 jma_collect <- function(item = NULL,
                         block_no, year, month, day,
                         cache = TRUE, pack = TRUE, quiet = FALSE) {
@@ -107,8 +111,7 @@ pack_df <- function(df, unpack = FALSE) {
   }
 }
 
-jma_collect_raw <- function(item = NULL,
-                        block_no, year, month, day, quiet) {
+jma_collect_raw <- function(item = NULL, block_no, year, month, day, quiet) {
 
   target <-
     detect_target(item, block_no, year, month, day)
@@ -360,8 +363,7 @@ detect_station_info <- function(.blockid) {
                                                intToUtf8(c(32701, 30000)),
                                                intToUtf8(c(38745, 23713, 31354, 28207)),
                                                intToUtf8(c(26494, 23665, 21335, 21513, 30000)),
-                                               intToUtf8(c(36196, 27743))
-  ),
+                                               intToUtf8(c(36196, 27743))),
   # Special pattern
   "a",
   station_type)
@@ -419,9 +421,8 @@ note_vars <- function(var) {
 }
 
 note_message <- function(var) {
-  res <-
-    note_vars(var) |>
-    purrr::keep(~ length(.x) > 0)
+  note_vars(var) |>
+    purrr::keep(\(x) length(x) > 0)
 }
 
 jma_vars <- list(atmosphere = paste0("atmosphere_",

R/jmastats-package.R

@@ -0,0 +1,7 @@
+#' @keywords internal
+"_PACKAGE"
+
+## usethis namespace: start
+#' @importFrom lifecycle deprecated
+## usethis namespace: end
+NULL

R/kishou_feed.R

@@ -1,4 +1,7 @@
 #' Read Kishou Disaster Prevention Information Feed
+#'
+#' @description
+#' `r lifecycle::badge("experimental")`
 #' @param frequency Release frequency. Select either high frequency ("high") or
 #' long term ("low")
 #' @param type Feed type. Specify the item to be retrieved as a string.
@@ -8,13 +11,13 @@
 #' - extra: It will be announced at any time.
 #' - eqvol: Earthquakes and Volcanoes.
 #' - other: Other informations.
-#' @seealso [https://xml.kishou.go.jp/index.html](https://xml.kishou.go.jp/index.html)
+#' @seealso <https://xml.kishou.go.jp>
 #' @examples
-#' \dontrun{
+#' \donttest{
 #' read_kishou_feed("high", type = "regular")
 #' read_kishou_feed("low", "other")
 #' }
-#' @return data.frame
+#' @return a `tbl` object
 #' @export
 read_kishou_feed <- function(frequency, type) {
   x <-

R/nearest_station.R

@@ -1,14 +1,15 @@
 #' Find out neighborhood stations
 #'
-#' @description Return the nearest [stations] information
-#' to the given coordinates.
+#' @description
+#' `r lifecycle::badge("stable")`
+#'
+#' Return the nearest [stations] information to the given coordinates.
 #'
 #' @details
 #' * `nearest_station()`: Return single station data.
 #' * `pick_neighbor_stations()`: Pick-up neighbourhood stations.
 #' * `pick_neighbor_tide_stations()`: Pick-up neighbourhood tidal observation stations.
 #' Filter by distance from target point.
-#' @return sf
 #' @param longitude Longitude.
 #' @param latitude Latitude.
 #' @param geometry XY [sf::sf] object.
@@ -22,7 +23,6 @@
 #' @importFrom sf st_distance st_point st_set_geometry st_sfc
 #' @importFrom units as_units set_units
 #' @examples
-#' \dontrun{
 #' nearest_station(142.9313, 43.70417)
 #'
 #' pick_neighbor_stations(140.10, 36.08, 300000)
@@ -35,7 +35,6 @@
 #' pick_neighbor_tide_stations(longitude = 133.4375, latitude = 34.45833,
 #'                             year = 2020,
 #'                             distance = 100, .unit = "km")
-#' }
 #' @name nearest_station
 NULL
 
@@ -45,6 +44,7 @@ NULL
   area <- distance <- NULL
 
 #' @rdname nearest_station
+#' @return an object of class `sf`.
 #' @export
 nearest_station <- function(longitude, latitude, geometry = NULL) {
   coords <-
@@ -99,16 +99,18 @@ pick_neighbor_stations <- function(longitude, latitude, distance = 1, .unit = "m
     sf::st_point(c(coords$longitude,
                    coords$latitude)),
     crs = 4326)
-  stations[which(sf::st_is_within_distance(
-    coords,
-    stations,
-    dist = units::as_units(distance, value = unit),
-    sparse = FALSE)[1, ]), ] |>
-    dplyr::mutate(
-      distance = sf::st_distance(
-        geometry,
-        coords)[, 1]
-    ) |>
+  tgt_st <-
+    stations[which(sf::st_is_within_distance(
+      coords,
+      stations,
+      dist = units::as_units(distance, value = unit),
+      sparse = FALSE)[1, ]), ]
+  tgt_st$distance <-
+    sf::st_distance(
+      coords,
+      sf::st_transform(tgt_st$geometry, 4326),
+      by_element = FALSE)[1, ]
+  tgt_st |>
     dplyr::select(
       area,
       station_no,
@@ -141,6 +143,7 @@ pick_neighbor_tide_stations <- function(year, longitude, latitude,
                                            stations,
                                            dist = units::as_units(distance, value = unit),
                                            sparse = FALSE)[1, ]), ] |>
+    sf::st_transform(crs = 4326) |>
     dplyr::mutate(distance = sf::st_distance(
       geometry,
       coords)[, 1]) |>