uribo / jpmesh
1
#' @title Get from mesh code to latitude and longitude
2
#' @description mesh centroid
3
#' @param meshcode `character`. mesh code
4
#' @param ... other parameters
5
#' @references Akio Takenaka: [http://takenaka-akio.org/etc/j_map/index.html](http://takenaka-akio.org/etc/j_map/index.html) # nolint
6
#' @seealso [coords_to_mesh()] for convert from coordinates to meshcode.
7
#' @examples
8
#' mesh_to_coords("64414277")
9
#' @export
10
mesh_to_coords <- function(meshcode, ...) { # nolint
11 6
  if (rlang::is_false(is_meshcode(meshcode)))
12 6
    rlang::abort("Unexpect meshcode value")
13 6
  size <- mesh_size(meshcode) # nolint
14 6
  if (size <= units::as_units(80, "km")) {
15 6
    code12 <- as.numeric(substring(meshcode, 1, 2))
16 6
    code34 <- as.numeric(substring(meshcode, 3, 4))
17 6
    lat_width  <- 2 / 3
18 6
    long_width <- 1
19
  }
20 6
  if (size <= units::as_units(10, "km")) {
21 6
    code5 <- as.numeric(substring(meshcode, 5, 5))
22 6
    code6 <- as.numeric(substring(meshcode, 6, 6))
23 6
    lat_width  <- lat_width / 8
24 6
    long_width <- long_width / 8
25
  }
26 6
  if (size == units::as_units(5, "km")) {
27 6
    km5_code7 <- as.numeric(substring(meshcode, 7, 7))
28
  }
29 6
  if (size <= units::as_units(1, "km")) {
30 6
    code7 <- as.numeric(substring(meshcode, 7, 7))
31 6
    code8 <- as.numeric(substring(meshcode, 8, 8))
32 6
    lat_width  <- lat_width / 10
33 6
    long_width <- long_width / 10
34
  }
35 6
  if (size <= units::as_units(0.5, "km"))
36 6
    code9 <- as.numeric(substring(meshcode, 9, 9))
37 6
  if (size <= units::as_units(0.25, "km"))
38 6
    code10 <- as.numeric(substring(meshcode, 10, 10))
39 6
  if (size <= units::as_units(0.125, "km"))
40 6
    code11 <- as.numeric(substring(meshcode, 11, 11))
41 6
    lat  <- code12 * 2 / 3
42 6
    long <- code34 + 100
43 6
  if (exists("code5") && exists("code6")) {
44 6
    lat  <- lat  + (code5 * 2 / 3) / 8
45 6
    long <- long +  code6 / 8
46
  }
47 6
  if (exists("code7") && exists("code8")) {
48 6
    lat  <- lat  + (code7 * 2 / 3) / 8 / 10
49 6
    long <- long +  code8 / 8 / 10
50
  }
51 6
  lat_c  <- as.numeric(sprintf("%.10f", lat  + lat_width  / 2))
52 6
  long_c <- as.numeric(sprintf("%.10f", long + long_width / 2))
53 6
  res <- data.frame(lng_center  = long_c,
54 6
                    lat_center  = lat_c,
55 6
                    lng_error   = long_c - long,
56 6
                    lat_error   = lat_c - lat)
57 6
  finename_centroid <- function(df, last_code) {
58 6
    if (last_code == 1) {
59 6
      df$lat_center <-
60 6
        (df$lat_center + df$lat_error) - (df$lat_error / 2) * 3
61 6
      df$lng_center <-
62 6
        (df$lng_center + df$lng_error) - (df$lng_error / 2) * 3
63 6
    } else if (last_code == 2) {
64 6
      df$lat_center <-
65 6
        (df$lat_center + df$lat_error) - (df$lat_error / 2) * 3
66 6
      df$lng_center <-
67 6
        (df$lng_center + df$lng_error) - (df$lng_error / 2)
68 6
    } else if (last_code == 3) {
69 6
      df$lat_center <-
70 6
        (df$lat_center + df$lat_error) - (df$lat_error / 2)
71 6
      df$lng_center <-
72 6
        (df$lng_center + df$lng_error) - (df$lng_error / 2) * 3
73 6
    } else if (last_code == 4) {
74 6
      df$lat_center <-
75 6
        (df$lat_center + df$lat_error) - (df$lat_error / 2)
76 6
      df$lng_center <-
77 6
        (df$lng_center + df$lng_error) - (df$lng_error / 2)
78
    }
79 6
    df$lat_error <- df$lat_error / 2
80 6
    df$lng_error <- df$lng_error / 2
81 6
    res <- df
82 6
    return(res)
83
  }
84 6
  if (exists("km5_code7"))
85 6
    res <- finename_centroid(res, km5_code7)
86 6
  if (exists("code9"))
87 6
    res <- finename_centroid(res, code9)
88 6
  if (exists("code10"))
89 6
    res <- finename_centroid(res, code10)
90 6
  if (exists("code11"))
91 6
    res <- finename_centroid(res, code11)
92 6
  tibble::as_tibble(res)
93
}

Read our documentation on viewing source code .

Loading