mgt_measures_ltree.Rmd

---
title: "Management Measures using ltree"
output: 
  html_document:
    toc: true
    # number_sections: true
editor_options: 
  chunk_output_type: console
---

```{r setup, include=F}
if (!require(librarian)){
  remotes::install_github("DesiQuintans/librarian")
  library(librarian)
}
shelf(
  # database
  DBI, RPostgres,
  # tidyverse
  dplyr, purrr, readr, stringr, tibble, tidyr,
  # report
  DT, gt, htmltools, htmlwidgets, kableExtra, knitr, markdown, rmarkdown,
  # utility
  fs, glue, here, png, scales, stringr, urltools, rlist
)
here <- here::here

# CAREFUL - THIS SCRIPT WILL DROP AND RECREATE TABLES 

not_linux <- Sys.info()[["sysname"]] != "Linux"

if (not_linux){
  # presumably Caleb's machine
  db_params <- list(
    dbname  = "dev",
    host    = "localhost",
    user    = "cgrant",
    pwd_txt = "../../pwd.txt")
} else {
  # presumably server
  db_params <- list(
    dbname  = "gis",
    host    = "postgis",
    user    = "admin",
    pwd_txt = "/share/.password_mhk-env.us") 
}

# Ben's laptop
if (Sys.info()[["user"]] == "bbest" & Sys.info()[["user"]] == "Darwin"){
  db_params <- list(
    dbname  = "gis",
    host    = "marineenergy.app",
    user    = "admin",
    pwd_txt = "~/private/dbpass_marineenergy.app.txt") 
}

db = dbConnect(
  RPostgres::Postgres(),
  dbname   = db_params$dbname,
  host     = db_params$host,
  port     = 5432,
  user     = db_params$user,
  password = readLines(db_params$pwd_txt))
con <- db
knitr::opts_chunk$set(echo = T, warning = F, message = F, connection = "db")
```

## redo

```{r}
d_mgt <- read_csv("data/tethys_mgt.csv")

dbWriteTable(con, "tethys_mgt", d_mgt)
```

```{r}
d_mgt_tags <- d_mgt %>% 
  select(
    Technology, Stressor, 
    Management = `Management Measure Category`,
    Phase = `Phase of Project`) %>% 
  pivot_longer(everything(), names_to="category", values_to="tag_mgt") %>% 
  group_by(category, tag_mgt) %>% 
  summarise(.groups="drop") %>% 
  bind_rows(
    d_mgt %>% 
      select(
        Receptor, ReceptorSpecifics = `Specific Receptor`) %>% 
      group_by(Receptor, ReceptorSpecifics) %>% 
      summarise(.groups="drop") %>% 
      mutate(
        category = "Receptor") %>% 
      select(category, tag_mgt = Receptor, ReceptorSpecifics)) %>% 
  arrange(category, tag_mgt, ReceptorSpecifics)

write_csv(d_mgt_tags, "data/tethys_mgt_tags.csv")
View(d_mgt_tags)
```

```{r}
tbl(con, "tethys_mgt") %>% 
  arrange(id)

dbSendStatement(con, "ALTER TABLE tethys_mgt ADD COLUMN tags LTREE[];")
dbSendStatement(con, "ALTER TABLE tethys_mgt DROP COLUMN tags;")
dbSendStatement(con, '
  UPDATE tethys_mgt
   SET tags = \'{"Technology.Tidal", "Management.Mitigation", "Receptor.Habitat"}\'
   WHERE id = 1;')
dbSendStatement(con, '
  UPDATE tethys_mgt
   SET tags = \'{"Technology.Tidal", "Management.DesignFeature", "Receptor.Benthic"}\'
   WHERE id = 2;')


dbGetQuery(con, "SELECT * from tethys_mgt WHERE 'Technology.Tidal' = ANY(tags);")
dbGetQuery(con, "SELECT * from tethys_mgt WHERE tags @> {\"Technology.Tidal\", \"Receptor.Habitat\"};")

x <- tbl(con, "tethys_mgt") %>% 
  filter(id==1) %>% 
  collect()
as.character(x$tags)


tbl(con, "mgt")
DBI::dbListTables(con) %>% sort()
```



# Caleb's original...

## Initialize ltree extension
```{r initialize_ltree}
dbExecute(db, glue("create extension if not exists ltree"))
```

## Notes

[PostgreSQL ltree documentation](https://www.postgresql.org/docs/current/ltree.html)

Each element in the ltree path is called a _label_.

> A label is a sequence of alphanumeric characters and underscores (for example, in C locale the characters A-Za-z0-9_ are allowed). Labels must be less than 256 characters long.

Examples: `42`, `Personal_Services`

> A _label path_ is a sequence of zero or more labels separated by dots, for example L1.L2.L3, representing a path from the root of a hierarchical tree to a particular node. The length of a label path cannot exceed 65535 labels.

Example: `Top.Countries.Europe.Russia`



---



## Caleb's hack way of ingesting a CSV and doing string replacement

Cant use the following characters for ltree data type:

- " "
- "-"
- "&"
- ":"

```{r}
# List of source CSVs that contain management measure categories
data <- list(
  "receptor"   = "https://raw.githubusercontent.com/marineenergy/apps/master/data/ferc_lookup_receptor.csv",
  "stressor"   = "https://raw.githubusercontent.com/marineenergy/apps/master/data/ferc_lookup_stressor.csv",
  "technology" = "https://raw.githubusercontent.com/marineenergy/apps/master/data/ferc_lookup_technology.csv")
# ,"phase" = "https://raw.githubusercontent.com/marineenergy/apps/master/data/ferc_tags_phase_lut.csv"

d <- tibble(
  category = names(data),
  csv      = unlist(data)) %>% 
  mutate(
    data = purrr::map(
      csv, 
      function(x){
        read_csv(x, col_types = cols()) %>% 
          select(tag0 = 1)})) %>% 
  unnest(data) %>% 
  mutate(
    tag = glue("{str_to_title(category)}.{tag0}") %>% 
      str_replace_all("[^A-Za-z0-9_.]", ""),
    label = tag0 %>% 
      str_replace(".*\\.(.+)$", "\\1"),
    level = tag %>% 
      str_count("\\.")) %>% 
  select(
    tag, label, level) 
#    x_cat = category, x_tag = tag0, x_csv = csv)

# Create database table
dbExecute(db, glue("DROP TABLE IF EXISTS tags CASCADE"))
dbExecute(db, glue("CREATE TABLE tags (tag LTREE PRIMARY KEY, label VARCHAR, level INT4)"))
dbWriteTable(db, "tags", d, overwrite = F, append = T, row.names = F)

tbl(db, "tags") %>% 
  collect() %>% 
  datatable()
```


## Query ltree

`@  Match case-insensitively, for example a@ matches A`

`*  Match any label with this prefix, for example foo* matches foobar`

`%  Match initial underscore-separated words`


### Inheritance

#### Example 1
```{r ltree_inheritance1}
dbGetQuery(db, glue("SELECT * FROM tags WHERE tag ~ '*.Birds.*'")) %>%
# dbGetQuery(db, glue("SELECT * FROM tags WHERE tag @ '*Birds*'")) %>%
  datatable()
```

#### Example 2
```{r ltree_inheritance2}
dbGetQuery(db, glue("SELECT * FROM tags WHERE tag <@ 'Receptor.Birds'")) %>%
  datatable()
```

#### Example 3
```{r ltree_inheritance3}
dbGetQuery(db, glue("SELECT * FROM tags WHERE tag @ 'GroundNestingBirds'")) %>%
  datatable()
```

#### Example 4
```{r ltree_inheritance4}
dbGetQuery(db, glue("SELECT * FROM tags WHERE tag = 'Receptor.Birds'")) %>%
  datatable()
```

## Conclusion

Unfortunately, we cant query ltree without doing string replacement of the selected management measure.

For example, if we are looking for receptor `Ground-Nesting Birds`, we will need to do something like this: `... where receptor @ Ground_Nesting_Birds`