update HL inventory construction #64 #83 #111

runners/02_reference_to_parquet.R

@@ -1,16 +1,15 @@
 source("runners/config.R")
 
-ref_gpkg   <- '/Users/mjohnson/Downloads/reference_CONUS.gpkg'
-ref_poi <- '/Users/mjohnson/Downloads/reference_CONUS_poigeom.gpkg'
-ref_div   <- '/Users/mjohnson/Downloads/reference_catchments.gpkg'
+s <- '/Users/mikejohnson/hydrofabric/v2.2'
 
+ref_gpkg   <- glue('{s}/reference_CONUS.gpkg')
+# ref_poi    <- glue('/Users/mjohnson/Downloads/reference_CONUS_poigeom.gpkg'
+ref_div    <- glue('{s}/reference_catchments.gpkg')
 
-ref_net_out    <- glue('/Users/mjohnson/hydrofabric/v2.2/reference/conus_network')
-
-
-ref_div_out    <- glue('/Users/mjohnson/hydrofabric/v2.2/reference/conus_divides')
-ref_fl_out     <- glue('/Users/mjohnson/hydrofabric/v2.2/reference/conus_flowlines')
-ref_hl_out     <- glue('/Users/mjohnson/hydrofabric/v2.2/reference/conus_hydrolocations')
+ref_net_out    <- glue('{s}/reference/conus_network')
+ref_div_out    <- glue('{s}/reference/conus_divides')
+ref_fl_out     <- glue('{s}/reference/conus_flowlines')
+ref_hl_out     <- glue('{s}/reference/gfv2_hydrolocations')
 
 # Reference Fabric --------------------------------------------------------
 
@@ -35,15 +34,23 @@ fl = as_sqlite(ref_gpkg, 'reference_flowline') %>%
 
 g = nhdplusTools::get_node(fl, position = "end") %>%
   mutate(outlet_X = st_coordinates(.)[,1], 
-         outlet_Y = st_coordinates(.)[,2])
+         outlet_Y = st_coordinates(.)[,2]) %>% 
+  st_drop_geometry()
 
-fl = bind_cols(fl, st_drop_geometry(g))
+g2 = nhdplusTools::get_node(fl, position = "start") %>%
+  mutate(inlet_X = st_coordinates(.)[,1], 
+         inlet_Y = st_coordinates(.)[,2]) %>% 
+  st_drop_geometry()
+
+fl = bind_cols(fl, bind_cols(g, g2))
 
 div = as_sqlite(ref_div, 'reference_catchments') %>%
   select(divide_id = featureid, vpuid, areasqkm, geom) %>%
   read_sf_dataset_sqlite()
 
-poi_geom = read_sf(ref_poi, "poi_geometry") %>% 
+div = st_set_crs(div, st_crs(fl))
+
+poi_geom = read_sf(ref_gpkg, "poi_geometry") %>% 
   mutate(X = st_coordinates(.)[,1], 
          Y = st_coordinates(.)[,2]) %>% 
   st_drop_geometry() %>% 
@@ -66,9 +73,6 @@ hl = as_sqlite(ref_gpkg, 'poi_data') %>%
 filter(hl, hl_reference == "Gages", hl_link == "06752260") %>% 
   st_as_sf(coords = c("X", "Y"), crs = 5070) %>% 
   mapview::mapview()
-
-filter(net, hl_uri == "Gages-06752260")
-filter(hl,  hl_uri == "Gages-06752260")
 
 net = st_drop_geometry(div) %>% 
   mutate(id = divide_id, vpuid = NULL) %>% 
@@ -82,7 +86,7 @@ mutate(div,
        has_flowline = ifelse(divide_id %in% fl$id, TRUE, FALSE),
        id = ifelse(has_flowline, divide_id, NA)) %>% 
   group_by(vpuid) %>% 
-  write_sf_dataset(path  = ref_div_out,  
+  write_sf_dataset(path  = ref_div_out, 
                    version = 2.6,
                    hf_version = "2.2")
 
@@ -95,17 +99,13 @@ mutate(fl,
                    hf_version = "2.2")
 
 group_by(net, vpuid) %>% 
-  arrow::write_dataset(ref_net_out, 
-                       version = 2.6)
+  arrow::write_dataset(ref_net_out, version = 2.6)
 
 group_by(hl, vpuid) %>% 
   arrow::write_dataset(path  = ref_hl_out,  
                    version = 2.6)
 
-
-system("aws s3 sync /Users/mjohnson/hydrofabric/v2.2/reference s3://lynker-spatial/hydrofabric/v2.2/reference/")
-
-
+system(glue("aws s3 sync {s}/reference s3://lynker-spatial/hydrofabric/v2.2/reference/"))
 
 # Hawaii ------------------------------------------------------------------
 
@@ -199,7 +199,8 @@ hl %>%
                        version = 2.6)
 
 
-system("aws s3 sync /Users/mjohnson/hydrofabric/v2.2/reference s3://lynker-spatial/hydrofabric/v2.2/reference/")
+system("aws s3 sync {s}/reference s3://lynker-spatial/hydrofabric/v2.2/reference/")
+system("aws s3 sync s3://lynker-spatial/hydrofabric/v2.2/reference/ {s}/reference")
 
 
 open_dataset('s3://lynker-spatial/hydrofabric/v2.2/reference/hawaii_divides') %>% 
@@ -211,67 +212,3 @@ open_dataset('s3://lynker-spatial/hydrofabric/v2.2/reference/hawaii_divides') %>
 
 
 
-# Refactor Fabric --------------------------------------------------------
-
-rfc_gpkg   <- glue("{base}/refactor/refactor_CONUS.gpkg")
-rfc_net    <- glue("{base}/refactor/conus_network")
-rfc_div    <- glue("{base}/refactor/conus_divides")
-rfc_fl     <- glue("{base}/refactor/conus_flowlines")
-
-
-ref = as_sqlite(ref_gpkg, 'reference_network') %>% 
-  select(hf_id = comid, 
-         mainstemlp = levelpathi, 
-         hf_hydroseq = hydroseq) %>% 
-  collect() 
-
-lu = as_sqlite(rfc_gpkg, "lookup_table") %>% 
-  select(hf_id = nhdplusv2_comid, 
-         id = nat_id,
-         member_comid) %>% 
-  collect()
-
-lu2 = distinct(left_join(lu, ref, by = "hf_id")) 
-
-lu3 = group_by(lu2, id) %>% 
-  arrange(hf_hydroseq) %>% 
-  #rank order member comid from outlet to upstream
-  mutate(member_comid = paste(member_comid, collapse = ','))  %>% 
-  ungroup()
-
-lu4 = arrange(lu3, id, hf_hydroseq) %>% 
-  filter(!duplicated(id)) %>% 
-  mutate(hydroseq = rank(hf_hydroseq), hf_id = NULL, hf_hydroseq = NULL)
-
-rm(lu); rm(lu2); rm(lu3); rm(ref); gc()
-
-divide = as_sqlite(rfc_gpkg, 'refactored_divides') %>% 
-  collect() %>% 
-  rename(id = nat_id, areasqkm = inc_areasqkm, vpuid = vpu) %>% 
-  st_as_sf() %>% 
-  st_set_crs(5070)
-
-group_by(divide, vpuid) %>% 
-  write_sf_dataset(path  = rfc_div,  format = "parquet", hf_version = version,  hive_style = TRUE)
-
-flowpath = as_sqlite(rfc_gpkg, 'reconciled_flowpaths') %>% 
-  collect() %>% 
-  rename(id = nat_id, toid = to_nat_id, vpuid = vpu) %>% 
-  st_as_sf() %>% 
-  st_set_crs(5070)
-
-fps = left_join(flowpath, lu4, by = "id") %>% 
-  select(id, toid, vpuid, lengthkm, totdasqkm, mainstemlp, hydroseq)
-
-group_by(fps, vpuid) %>% 
-  write_sf_dataset(path  = rfc_fl,  format = "parquet", hf_version = version, hive_style = TRUE)
-
-net = st_drop_geometry(divide) %>% 
-  select(id, areasqkm) %>% 
-  mutate(divide_id = id, vpuid = NULL) %>% 
-  full_join(st_drop_geometry(fps), by = "id")
-
-group_by(net, vpuid) %>% 
-  arrow::write_dataset(ref_net_out)
-
-gc()