## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----setup, message = FALSE---------------------------------------------------
library(ForestElementsR)
library(tibble)
library(dplyr)
library(ggplot2)

## ----view_species_master_table------------------------------------------------
species_master_table

# Also show the tail of the table
species_master_table |> tail(10)

## ----view_species_codings-----------------------------------------------------
species_codings

## ----get_coding_table---------------------------------------------------------
fe_species_get_coding_table("tum_wwk_short")

## ----view_coding_compact------------------------------------------------------
fe_species_get_coding_table("tum_wwk_short") |>
  select(species_id, name_eng) |> # English names only for clarity
  distinct()

## ----view_species_numbers_in_coding-------------------------------------------
fe_species_get_coding_table("tum_wwk_short") |>
  group_by(species_id, name_eng) |>
  summarise(n_species = n()) |>
  arrange(as.numeric(species_id)) # not required, but output is nicely sorted

## ----view_quercus_group-------------------------------------------------------
fe_species_get_coding_table("tum_wwk_short") |>
  select(species_id, genus, species_no, name_eng) |>
  filter(species_id == "6")

## ----get_quercus_group_names--------------------------------------------------
species_master_table |>
  filter(genus == "quercus" & species_no %in% c("001", "002")) |>
  select(-deciduous_conifer)

## ----view_hierarchy_levels----------------------------------------------------
fe_species_get_coding_table("bavrn_state") |>
  filter(species_id %in% c("54", "55", "70")) |>
  select(species_id, genus, species_no, name_eng, level)

## ----finest_node_cast---------------------------------------------------------
as_fe_species_bavrn_state(fe_species_master("quercus_001")) |> unclass()

## ----non_tree_helpers---------------------------------------------------------
fe_species_non_tree_codes("bavrn_state")

spec_ids <- fe_species_bavrn_state(c("10", "60", "99"))
fe_species_is_tree(spec_ids)

## ----field_table_demo---------------------------------------------------------
fe_species_get_field_table("tum_wwk_short")

## ----create_species_code_vectors----------------------------------------------
spec_ids_1 <- fe_species_tum_wwk_short(c(1, 1, 1, 5, 5, 5, 5, 3, 3, 8, 9, 8))
spec_ids_2 <- fe_species_ger_nfi_2012(
  c(10, 10, 10, 100, 100, 100, 100, 20, 20, 190, 290, 190)
)

spec_ids_1
spec_ids_2

## ----bad_code_input, error = TRUE---------------------------------------------
try({
fe_species_tum_wwk_short(c(1, 321, 1, 9999))
fe_species_ger_nfi_2012(c("100", "290", "Peter", "Paul", "Mary"))
})

## ----check_object_if_species_codes--------------------------------------------
spec_ids <- c(1:10)
is_fe_species_tum_wwk_short(spec_ids)
spec_ids <- fe_species_tum_wwk_short(c(1:10))
is_fe_species_tum_wwk_short(spec_ids)
is_fe_species_bavrn_state(spec_ids)

## ----option_spec_lang---------------------------------------------------------
spec_ids_1 <- fe_species_tum_wwk_short(c(1, 1, 5, 5, 5, 5, 3, 3))
spec_ids_2 <- fe_species_ger_nfi_2012(c(100, 100, 20, 20, 30, 110))
spec_ids_3 <- fe_species_bavrn_state(c(60, 60, 30, 30, 84, 86))
spec_ids_4 <- fe_species_master(c("abies_001", "tilia_002", "ulmus_001"))

## ----reset_spec_lang_option, echo = FALSE-------------------------------------
op_help <- options(fe_spec_lang = NULL) # catch user's actual setting

## ----display_default_codes, echo = FALSE--------------------------------------
spec_ids_1
spec_ids_2
spec_ids_3
spec_ids_4

## ----display_scientific_names-------------------------------------------------
options(fe_spec_lang = "sci") # Display scientific species names

spec_ids_1
spec_ids_2
spec_ids_3
spec_ids_4

## ----display_english_names----------------------------------------------------
options(fe_spec_lang = "eng") # Display English species names

spec_ids_1
spec_ids_2
spec_ids_3
spec_ids_4

## ----set_spec_lang_option_to_original, echo = FALSE---------------------------
options(fe_spec_lang = op_help)

## ----format_example-----------------------------------------------------------
format(spec_ids_1, spec_lang = "eng")
format(spec_ids_2, spec_lang = "sci")
format(spec_ids_3, spec_lang = "code")
format(spec_ids_4, spec_lang = "ger")

## ----do_not_try_to_generate_from_names, error = TRUE--------------------------
try({
spec_names <- c("Abies alba", "Picea abies")
fe_species_ger_nfi_2012(spec_names)
})

## ----assigning_species_codes, error = TRUE------------------------------------
try({
spec_vec <- fe_species_bavrn_state(c("10", "10", "10", "50", "50", "50"))
format(spec_vec, "eng")

# Safest way, same class on both sides of the '<-'
spec_vec[3] <- fe_species_bavrn_state("40")
is_fe_species_bavrn_state(spec_vec)
format(spec_vec, "eng")

# Character vector is converted
spec_vec[3:4] <- c("40", "70")
is_fe_species_bavrn_state(spec_vec)
format(spec_vec, "eng")

# Numerical vector is converted
spec_vec[3:4] <- c(60, 87)
is_fe_species_bavrn_state(spec_vec)
format(spec_vec, "eng")

# Species code not supported by goal coding - no assignment and error
spec_vec[1:2] <- c("3333", "12")
is_fe_species_bavrn_state(spec_vec)
format(spec_vec, "eng")

# Vectors of other species codings are converted, if possible
spec_vec[5:6] <- fe_species_tum_wwk_short(c("3", "3")) # "3" Scots pine in rhs
# coding
is_fe_species_bavrn_state(spec_vec)
format(spec_vec, "code") # "3" becomes "20" ...
format(spec_vec, "eng") # ... which is Scots pine in the goal coding
})

## ----unproblematic_conversion-------------------------------------------------
spec_ids <- as_fe_species_tum_wwk_short(c("1", "3", "5"))
as_fe_species_ger_nfi_2012(spec_ids) |> format("eng")

## ----conversion_with_information_loss-----------------------------------------
spec_ids_1 <- as_fe_species_ger_nfi_2012(c("170", "150", "140"))
spec_ids_1 |> format("eng")

# Backward ambiguous cast (possibly, but with information loss)
spec_ids_2 <- as_fe_species_tum_wwk_short(spec_ids_1)
spec_ids_2 |> format("eng")

## ----finest_node_cast_usage---------------------------------------------------
# Pedunculate and sessile oak resolve to the single codes 54 and 55,
# not to the group code 70
as_fe_species_bavrn_state(fe_species_master(c("quercus_001", "quercus_002"))) |>
  format("code")

## ----impossible_conversion_no_match, error = TRUE-----------------------------
try({
spec_ids <- as_fe_species_bavrn_state(c("11", "11", "11"))
spec_ids |> format("eng")

# No Serbian spruce in the tum_wwk_long coding
spec_ids |> as_fe_species_tum_wwk_long()
})

## ----forward_ambiguous_cast, error = TRUE-------------------------------------
try({
# Each of these codes comprises many single species
spec_ids <- fe_species_tum_wwk_short(c("8", "9", "10"))
spec_ids |> format("eng")

# Conversion attempt terminates with error
spec_ids |> as_fe_species_ger_nfi_2012()

# Similar
as_fe_species_master(fe_species_ger_nfi_2012("90"))
})

## ----cast_override------------------------------------------------------------
species_cast_overrides

# ger_nfi_2012 code 290 has no single match in tum_wwk_short, but the
# override resolves it to code 8
as_fe_species_tum_wwk_short(fe_species_ger_nfi_2012("290")) |> format("code")

## ----non_tree_cast------------------------------------------------------------
as_fe_species_tum_wwk_short(fe_species_bavrn_state(c("10", "99"))) |>
  unclass()

## ----good_and_bad_conversions_between_same_types, error = TRUE----------------
try({
# Conversion from tum_wwk_short to ger_nfi_2012 - works
spec_ids_1 <- fe_species_tum_wwk_short(c("1", "3", "5"))
spec_ids_1 |> format("eng")

spec_ids_2 <- as_fe_species_ger_nfi_2012(spec_ids_1)
spec_ids_2 |> format("eng")

# Conversion from tum_wwk_short to ger_nfi_2012 - fails
spec_ids_1 <- fe_species_tum_wwk_short(c("8", "9", "10"))
spec_ids_1 |> format("eng")

spec_ids_2 <- as_fe_species_ger_nfi_2012(spec_ids_1)
})

## ----option_2a, echo = FALSE--------------------------------------------------
opt_help <- getOption("fe_spec_lang")
options(fe_spec_lang = "code")

## ----get_the_char_vector------------------------------------------------------
spec_ids <- fe_species_ger_nfi_2012(c("10", "10", "100", "170"))
spec_ids

chars_1 <- unclass(spec_ids)
chars_1
chars_2 <- vctrs::vec_data(spec_ids)
chars_2

is_fe_species_ger_nfi_2012(chars_1)
is_fe_species_ger_nfi_2012(chars_2)

is.character(chars_1)
is.character(chars_2)

## ----option_2b, echo = FALSE--------------------------------------------------
options(fe_spec_lang = opt_help)

## ----option_3a, echo = FALSE--------------------------------------------------
opt_help <- getOption("fe_spec_lang")
options(fe_spec_lang = "code")

## ----demo_with_selection_forest_1---------------------------------------------
dat <- selection_forest_1_fe_stand$trees |> select(
  tree_id, species_id, time_yr, dbh_cm, height_m
)
dat

## ----option_3b, echo = FALSE--------------------------------------------------
options(fe_spec_lang = opt_help)

## ----option_4a, echo = FALSE--------------------------------------------------
opt_help <- getOption("fe_spec_lang")
options(fe_spec_lang = "code")

## ----demo_with_selection_forest_2---------------------------------------------
dat |> summary()

## ----option_4b, echo = FALSE--------------------------------------------------
options(fe_spec_lang = opt_help)

## ----option_5a, echo = FALSE--------------------------------------------------
opt_help <- getOption("fe_spec_lang")
options(fe_spec_lang = "code")

## ----demo_with_selection_forest_3---------------------------------------------
# Set option to display colloquial English species names, and store the
# previous setting in opt_prev
opt_prev <- getOption("fe_spec_lang")
options(fe_spec_lang = "eng")

# Display dat
dat

# Display a summary of dat
dat |> summary()

# Reset option to previous value
options(fe_spec_lang = opt_prev)

## ----option_5b, echo = FALSE--------------------------------------------------
options(fe_spec_lang = opt_help)

## ----option_6a, echo = FALSE--------------------------------------------------
opt_help <- getOption("fe_spec_lang")
options(fe_spec_lang = "code")

## ----single_tree_volumes------------------------------------------------------
opt_prev <- getOption("fe_spec_lang")
options(fe_spec_lang = "eng")

dat <- dat |>
  mutate(v_cbm = v_gri(species_id, dbh_cm, height_m))

# Note that the summary of species_id does not preserve the original order of
# the codes (species are alphabetically sorted, dependent on language setting)
dat |> summary()

options(fe_spec_lang = opt_prev)

## ----option_6b, echo = FALSE--------------------------------------------------
options(fe_spec_lang = opt_help)

## ----option_7a, echo = FALSE--------------------------------------------------
opt_help <- getOption("fe_spec_lang")
options(fe_spec_lang = "code")

## ----mean_volumes-------------------------------------------------------------
# Set option for displaying scientific species names
opt_prev <- getOption("fe_spec_lang")
options(fe_spec_lang = "sci")

dat |>
  group_by(species_id) |>
  summarise(
    mean_stem_volume_cbm = mean(v_cbm),
    sd_stem_volume_cbm = sd(v_cbm)
  )
# In contrast to summary, summarise keeps the original order of the species
# codes, no matter the language setting

options(fe_spec_lang = opt_prev)

## ----option_7b, echo = FALSE--------------------------------------------------
options(fe_spec_lang = opt_help)

## ----plot_1, fig.cap=, fig.dim=c(4.9, 3.5), fig.align = 'center', fig.cap = 'Stem volume over diameter by species in log-log display'----
# Note: Using simply 'format(species_id)' below would use the current setting
# of the option fe_spec_lang
dat |>
  ggplot() +
  geom_point(aes(x = dbh_cm, y = v_cbm, col = format(species_id, "eng"))) +
  scale_color_discrete("Species") +
  scale_x_log10() +
  scale_y_log10()

## ----all_inherit_from_vctrs---------------------------------------------------
fe_species_bavrn_state("30") |> class()
fe_species_ger_nfi_2012("20") |> class()
fe_species_tum_wwk_long("87") |> class()
fe_species_tum_wwk_short("7") |> class()
fe_species_master("abies_004") |> class()

