5 Map ring data

5.1 Read temporary ring data

Import temporary bird data from birds.tsv:

birds <- read_tsv(
  here::here("data", "interim", "birds.tsv"),
  col_types = cols(
    .default = col_character()
  )
)

5.1.1 Read observation data

Import temporary observation data from obs_and_actions.tsv:

obs_and_acts <- read_tsv(
  here::here("data", "interim", "obs_and_actions.tsv"),
  col_types = cols(
    .default = col_character(),
    Nummer = col_double(),
    Datum = col_datetime(format = ""),
    WaarnemerNummer = col_double(),
    PlaatsLengtegraadGraden = col_double(),
    PlaatsLengtegraadMinuten = col_double(),
    PlaatsLengtegraadSeconden = col_double(),
    PlaatsBreedtegraadGraden = col_double(),
    PlaatsBreedtegraadMinuten = col_double(),
    PlaatsBreedtegraadSeconden = col_double(),
    BevestigingDatum = col_datetime(format = ""),
    AanmaakDatum = col_datetime(format = ""),
    WijzigDatum = col_datetime(format = "")
  )
)

5.1.2 Read action data

Import action codes and relative meaning:

actions_meaning <- read_tsv(here::here("data", "input", "actions_meaning.tsv"))

## Parsed with column specification:
## cols(
##   Code = col_character(),
##   Beschrijving = col_character(),
##   BeschrijvingUK = col_character(),
##   CodeExtern = col_character(),
##   CodeExternUK = col_character(),
##   Kolom = col_character()
## )

5.1.3 Read ring position data

ring_position_table <- read_tsv(
  here::here("data", "input", "ring_position_table.tsv")
)

## Parsed with column specification:
## cols(
##   Code = col_character(),
##   Beschrijving = col_character(),
##   BeschrijvingUK = col_character(),
##   Aktief = col_logical()
## )

5.1.4 Read user data

Import user data as we have still to map the field user_role:

crbirding_users <- read_csv(
  here::here("data", "processed", "crbirding_users.csv")
)

## Parsed with column specification:
## cols(
##   user_id = col_logical(),
##   user_reference = col_double(),
##   user_email = col_character(),
##   user_first_name = col_character(),
##   user_last_name = col_character(),
##   user_address = col_character(),
##   user_postal_code = col_character(),
##   user_place = col_character(),
##   user_country = col_character(),
##   user_language = col_logical()
## )

5.1.5 Read color data

Import ring color codes and relative meaning:

color_table <- read_tsv(here::here("data", "input", "color_table.tsv"))

## Parsed with column specification:
## cols(
##   Code = col_character(),
##   Beschrijving = col_character(),
##   BeschrijvingUK = col_character(),
##   Aktief = col_logical()
## )

5.2 Map color ring data

5.2.1 Extract action codes

Actions present in obs_and_acts :

acts <- actions_meaning$Code
acts <- acts[acts %in% names(obs_and_acts)]
acts

##  [1] "rngkl" "rngme" "klgev" "br"    "vang"  "dood"  "klweg" "veld"  "meweg"
## [10] "me"    "vangl" "ziek"

5.2.2 Bird reference & bird shorthand

In SOVON table crbirding_birds each row identifies a ring. By assigning a bird reference as unique integer to a bird they can link any color ring to the bird it belongs to.

birds <-
  birds %>%
  mutate(sovon_bird_reference = seq_len(nrow(birds))) %>%
  select(
    sovon_bird_reference, first_Nummer, NummerNieuw,
    NummerDesc, everything()
  )

## mutate: new variable 'sovon_bird_reference' (integer) with 11,224 unique values and 0% NA

## select: columns reordered (sovon_bird_reference, first_Nummer, NummerNieuw, NummerDesc, Nummer, …)

head(birds)

Birds with lack of unicity of sovon_bird_reference:

birds %>%
  group_by(first_Nummer) %>%
  add_tally() %>%
  ungroup() %>%
  filter(n > 1) %>%
  select(
    sovon_bird_reference,
    first_Nummer,
    NummerNieuw,
    NummerDesc,
    Nummer
  )

## group_by: one grouping variable (first_Nummer)

## add_tally (grouped): new variable 'n' (integer) with one unique value and 0% NA

## ungroup: no grouping variables

## filter: removed all rows (100%)

## select: dropped 11 variables (Plaats, RingKleurCode, InscriptieKleurCode, EuringCode, GeslachtCode, …)

In such cases we assign the lower sovon_bird_reference:

birds <-
  birds %>%
  group_by(first_Nummer) %>%
  mutate(sovon_bird_reference = min(sovon_bird_reference)) %>%
  ungroup()

## group_by: one grouping variable (first_Nummer)

## mutate (grouped): no changes

## ungroup: no grouping variables

Check:

birds %>%
  group_by(first_Nummer) %>%
  add_tally() %>%
  ungroup() %>%
  filter(n > 1) %>%
  select(
    sovon_bird_reference,
    first_Nummer,
    NummerNieuw,
    NummerDesc,
    Nummer
  )

## group_by: one grouping variable (first_Nummer)

## add_tally (grouped): new variable 'n' (integer) with one unique value and 0% NA

## ungroup: no grouping variables

## filter: removed all rows (100%)

## select: dropped 11 variables (Plaats, RingKleurCode, InscriptieKleurCode, EuringCode, GeslachtCode, …)

We add column sovon_bird_reference to obs_and_acts as it will be needed to map the dates of ringing. The link is made by the columns Nummer (birds data) and KleurringNummer (observation data):

obs_and_acts <-
  obs_and_acts %>%
  left_join(birds %>% select(Nummer, sovon_bird_reference),
    by = c("KleurringNummer" = "Nummer")
  ) %>%
  select(sovon_bird_reference, everything())

## select: dropped 13 variables (first_Nummer, NummerNieuw, NummerDesc, Plaats, RingKleurCode, …)

## left_join: added one column (sovon_bird_reference)

##            > rows only in x         0

##            > rows only in y  (      0)

##            > matched rows     150,843

##            >                 =========

##            > rows total       150,843

## select: columns reordered (sovon_bird_reference, Nummer, Datum, EuringCode, LeeftijdCode, …)

Check whether there are observations without link to any bird:

filter(obs_and_acts, is.na(sovon_bird_reference))

## filter: removed all rows (100%)

We will also add column first_Nummer from birds to observations as well:

obs_and_acts <-
  obs_and_acts %>%
  left_join(
    birds %>%
      select(sovon_bird_reference, first_Nummer, Nummer),
    by = c("sovon_bird_reference",
      "KleurringNummer" = "Nummer"
    )
  )

## select: dropped 12 variables (NummerNieuw, NummerDesc, Plaats, RingKleurCode, InscriptieKleurCode, …)

## left_join: added one column (first_Nummer)

##            > rows only in x         0

##            > rows only in y  (      0)

##            > matched rows     150,843

##            >                 =========

##            > rows total       150,843

The reconstruction of the series of color rings for each bird is made by using columns first_Nummer (very first color ring), NummerNieuw (very last color ring) and the information from spreadsheets of experts. We will collect the needed information in a new dataframe, called crbirding_birds which will grow up to become the end product containing the ring data to deliver to SOVON.

First step is to gather first_Nummer and NummerNieuw in new column sovon_bird_shorthand:

crbirding_birds <-
  birds %>%
  select(
    sovon_bird_reference, first_Nummer,
    NummerNieuw, NummerDesc, sovon_bird_notes
  ) %>%
  pivot_longer(
    cols = c(first_Nummer, NummerNieuw),
    names_to = "col_nummer",
    values_to = "sovon_bird_shorthand"
  ) %>%
  select(-col_nummer) %>%
  select(sovon_bird_reference, sovon_bird_shorthand, NummerDesc, sovon_bird_notes)

## select: dropped 10 variables (Nummer, Plaats, RingKleurCode, InscriptieKleurCode, EuringCode, …)

## pivot_longer: reorganized (first_Nummer, NummerNieuw) into (col_nummer, sovon_bird_shorthand) [was 11224x5, now 22448x5]

## select: dropped one variable (col_nummer)

## select: columns reordered (sovon_bird_reference, sovon_bird_shorthand, NummerDesc, sovon_bird_notes)

We can also assign the color ring version with point (sovon_bird_shorthand_pt) by matching columns sovon_bird_shorthand and NummerDesc where possible. Note that sovon_bird_shorthand_pt may contain points, but for old rings it is equal to sovon_bird_shorthand:

crbirding_birds <-
  crbirding_birds %>%
  mutate(sovon_bird_shorthand_pt = ifelse(
    str_remove_all(
      string = NummerDesc,
      pattern = "\\."
    ) == sovon_bird_shorthand,
    NummerDesc,
    sovon_bird_shorthand
  )) %>%
  distinct() %>%
  select(sovon_bird_reference, sovon_bird_shorthand, sovon_bird_shorthand_pt, sovon_bird_notes)

## mutate: new variable 'sovon_bird_shorthand_pt' (character) with 11,559 unique values and 0% NA

## distinct: removed 10,889 rows (49%), 11,559 rows remaining

## select: dropped one variable (NummerDesc)

## to map correctly MKAU (sovon_bird_reference: 4531)
## group_by(sovon_bird_reference, sovon_bird_shorthand) %>%
## filter(sovon_bird_shorthand ==
##          sovon_bird_shorthand[which.max(nchar(sovon_bird_shorthand))]) %>%
## ungroup()

Example of mapping: the bird with sovon_bird_reference 14 is associated to the following two rings:

birds %>%
  filter(sovon_bird_reference == 14) %>%
  select(sovon_bird_reference, first_Nummer, NummerNieuw, NummerDesc)

## filter: removed 11,223 rows (>99%), one row remaining

## select: dropped 11 variables (Nummer, Plaats, RingKleurCode, InscriptieKleurCode, EuringCode, …)

and will be mapped as follows:

crbirding_birds %>%
  filter(sovon_bird_reference == 14) %>%
  select(sovon_bird_reference, sovon_bird_shorthand, sovon_bird_shorthand_pt)

## filter: removed 11,557 rows (>99%), 2 rows remaining

## select: dropped one variable (sovon_bird_notes)

5.2.3 Bird ringing date

The date of applying a ring should be mapped as sovon_bird_date_begin. The date of applying the first ring can be found in data frame obs_and_acts in the column Datum for actions rngkl (code action of applying very first color ring):

obs_and_acts %>%
  filter(!is.na(rngkl)) %>%
  select(
    sovon_bird_reference, first_Nummer,
    Datum, rngkl
  ) %>%
  head(n = 10)

## filter: removed 139,619 rows (93%), 11,224 rows remaining

## select: dropped 37 variables (Nummer, EuringCode, LeeftijdCode, KleurringNummer, KleurringPlaats, …)

5.2.3.1 Date of applying first ring

We can add automatically the date of the very first ring for each bird (sovon_bird_reference), based on date of action code rngkl. In fact, there should be just one observation with action rngkl for each bird (sovon_bird_reference). Exceptions:

exceptions_one_bird_one_rngkl <-
  obs_and_acts %>%
  filter(!is.na(rngkl)) %>%
  group_by(sovon_bird_reference) %>%
  add_tally() %>%
  ungroup() %>%
  filter(n > 1) %>%
  filter(!is.na(rngkl)) %>%
  left_join(crbirding_birds %>%
    select(sovon_bird_reference, sovon_bird_shorthand),
  by = "sovon_bird_reference"
  ) %>%
  # distinct() %>%
  select(-n)

## filter: removed 139,619 rows (93%), 11,224 rows remaining

## group_by: one grouping variable (sovon_bird_reference)

## add_tally (grouped): new variable 'n' (integer) with one unique value and 0% NA

## ungroup: no grouping variables

## filter: removed all rows (100%)

## filter: no rows removed

## select: dropped 2 variables (sovon_bird_shorthand_pt, sovon_bird_notes)

## left_join: added one column (sovon_bird_shorthand)

##            > rows only in x        0

##            > rows only in y  (11,559)

##            > matched rows          0

##            >                 ========

##            > rows total            0

## select: dropped one variable (n)

exceptions_one_bird_one_rngkl

In case exceptions are present, they should best be solved at database level. In any case, we will manage them later.

Assign the date of first ringing:

crbirding_birds <-
  obs_and_acts %>%
  filter(!is.na(rngkl)) %>%
  select(sovon_bird_reference, first_Nummer, Datum) %>%
  group_by(sovon_bird_reference, first_Nummer) %>%
  summarize(sovon_bird_date_begin = min(Datum)) %>%
  right_join(crbirding_birds,
    by = c("sovon_bird_reference",
      "first_Nummer" = "sovon_bird_shorthand"
    )
  ) %>%
  rename(sovon_bird_shorthand = first_Nummer) %>%
  select(
    sovon_bird_reference,
    sovon_bird_shorthand,
    sovon_bird_shorthand_pt,
    sovon_bird_date_begin,
    sovon_bird_notes
  ) %>%
  ungroup()

## filter: removed 139,619 rows (93%), 11,224 rows remaining

## select: dropped 38 variables (Nummer, EuringCode, LeeftijdCode, KleurringNummer, KleurringPlaats, …)

## group_by: 2 grouping variables (sovon_bird_reference, first_Nummer)

## summarize: now 11,224 rows and 3 columns, one group variable remaining (sovon_bird_reference)

## right_join: added 2 columns (sovon_bird_shorthand_pt, sovon_bird_notes)

##             > rows only in x  (     0)

##             > rows only in y      335

##             > matched rows     11,224

##             >                 ========

##             > rows total       11,559

## rename: renamed one variable (sovon_bird_shorthand)

## select: columns reordered (sovon_bird_reference, sovon_bird_shorthand, sovon_bird_shorthand_pt, sovon_bird_date_begin, sovon_bird_notes)

## ungroup: no grouping variables

Some examples (birds with sovon_bird_reference 1, 14 and 4107):

crbirding_birds %>%
  filter(sovon_bird_reference %in% c(1, 14, 4107)) %>%
  arrange(sovon_bird_reference, sovon_bird_date_begin)

## filter: removed 11,555 rows (>99%), 4 rows remaining

Check date of birds in exceptions:

crbirding_birds %>%
  filter(sovon_bird_shorthand %in% exceptions_one_bird_one_rngkl$sovon_bird_shorthand)

## filter: removed all rows (100%)

And in case solve:

# if (nrow(exceptions_one_bird_one_rngkl) > 0) {
#   crbirding_birds <-
#     crbirding_birds %>%
#     mutate(sovon_bird_date_begin = case_when(
#       sovon_bird_shorthand == "MKAU" ~ sovon_bird_date_begin,
#       sovon_bird_shorthand == "CZOZ" ~ as.POSIXct(NA_character_),
#       TRUE ~ sovon_bird_date_begin
#     ))
# }

Summary of rings with date (sovon_bird_date_begin):

crbirding_birds %>%
  mutate(date_is_present = !is.na(sovon_bird_date_begin)) %>%
  group_by(date_is_present) %>%
  count()

## mutate: new variable 'date_is_present' (logical) with 2 unique values and 0% NA

## group_by: one grouping variable (date_is_present)

## count: now 2 rows and 2 columns, one group variable remaining (date_is_present)

5.2.3.2 Date of applying last ring

The rings without date are the rings of birds ringed more than once.

birds_multiple_rings <-
  crbirding_birds %>%
  group_by(sovon_bird_reference) %>%
  add_tally() %>%
  ungroup() %>%
  filter(n > 1)

## group_by: one grouping variable (sovon_bird_reference)

## add_tally (grouped): new variable 'n' (integer) with 2 unique values and 0% NA

## ungroup: no grouping variables

## filter: removed 10,889 rows (94%), 670 rows remaining

birds_multiple_rings

Not only, the structure of our database limits to 2 the maximum number of rings linked to the same bird, as two are the columns containing such information (Nummer and NummerNieuw). Check:

birds_two_rings <-
  crbirding_birds %>%
  group_by(sovon_bird_reference) %>%
  add_tally() %>%
  ungroup() %>%
  filter(n == 2)

## group_by: one grouping variable (sovon_bird_reference)

## add_tally (grouped): new variable 'n' (integer) with 2 unique values and 0% NA

## ungroup: no grouping variables

## filter: removed 10,889 rows (94%), 670 rows remaining

all(birds_two_rings$sovon_bird_reference ==
  birds_multiple_rings$sovon_bird_reference)

## [1] TRUE

Experts explained us that the very first and the very last ring are mapped in birds. By consulting the spreadsheet of the experts we will later fill the gap by adding intermediate rings.

We can try to retrieve the date of applying last ring based on observations/actions with code vang (caught at the nest) or vangl (caught otherwise). Birds ringed twice and linked to one vang/vangl action only:

bird_one_vang <-
  obs_and_acts %>%
  filter(sovon_bird_reference %in%
    birds_multiple_rings$sovon_bird_reference &
    (!is.na(vang) | !is.na(vangl))) %>%
  group_by(sovon_bird_reference) %>%
  add_tally() %>%
  ungroup() %>%
  filter(n == 1) %>%
  rename(sovon_bird_date_begin = Datum) %>%
  select(-n) %>%
  arrange(sovon_bird_reference)

## filter: removed 150,482 rows (>99%), 361 rows remaining

## group_by: one grouping variable (sovon_bird_reference)

## add_tally (grouped): new variable 'n' (integer) with 2 unique values and 0% NA

## ungroup: no grouping variables

## filter: removed 62 rows (17%), 299 rows remaining

## rename: renamed one variable (sovon_bird_date_begin)

## select: dropped one variable (n)

bird_one_vang %>%
  select_if(function(x) any(!is.na(x)))

## select_if: dropped 7 variables (BevestigingDatum, rngkl, veld, dood, klgev, …)

As you cannot change a ring to a bird without catching him, we can use these unique dates as date of ringing, sovon_bird_date_begin:

bird_one_vang_with_date <-
  crbirding_birds %>%
  filter(sovon_bird_reference %in% bird_one_vang$sovon_bird_reference &
    sovon_bird_reference %in% birds_two_rings$sovon_bird_reference) %>%
  group_by(sovon_bird_reference) %>%
  filter(is.na(sovon_bird_date_begin)) %>%
  select(-sovon_bird_date_begin) %>%
  ungroup() %>%
  left_join(bird_one_vang,
    by = c("sovon_bird_reference")
  ) %>%
  select(names(crbirding_birds))

## filter: removed 10,961 rows (95%), 598 rows remaining

## group_by: one grouping variable (sovon_bird_reference)

## filter (grouped): removed 299 rows (50%), 299 rows remaining

## select: dropped one variable (sovon_bird_date_begin)

## ungroup: no grouping variables

## left_join: added 40 columns (Nummer, sovon_bird_date_begin, EuringCode, LeeftijdCode, KleurringNummer, …)

##            > rows only in x     0

##            > rows only in y  (  0)

##            > matched rows     299

##            >                 =====

##            > rows total       299

## select: dropped 39 variables (Nummer, EuringCode, LeeftijdCode, KleurringNummer, KleurringPlaats, …)

crbirding_birds <-
  crbirding_birds %>%
  anti_join(bird_one_vang_with_date,
    by = c("sovon_bird_reference", "sovon_bird_shorthand")
  ) %>%
  bind_rows(bird_one_vang_with_date) %>%
  arrange(sovon_bird_reference)

## anti_join: added no columns

##            > rows only in x   11,260

##            > rows only in y  (     0)

##            > matched rows    (   299)

##            >                 ========

##            > rows total       11,260

Examples of date mapping (birds with sovon_bird_reference 11 and 14):

crbirding_birds %>%
  filter(sovon_bird_reference %in% c(11, 14))

## filter: removed 11,555 rows (>99%), 4 rows remaining

Some birds have been catched twice:

bird_two_vang <-
  obs_and_acts %>%
  filter(sovon_bird_reference %in% birds_two_rings$sovon_bird_reference &
    (!is.na(vang) | !is.na(vangl))) %>%
  group_by(sovon_bird_reference) %>%
  add_tally() %>%
  ungroup() %>%
  filter(n == 2) %>%
  rename(sovon_bird_date_begin = Datum) %>%
  select(-n) %>%
  arrange(sovon_bird_reference)

## filter: removed 150,482 rows (>99%), 361 rows remaining

## group_by: one grouping variable (sovon_bird_reference)

## add_tally (grouped): new variable 'n' (integer) with 2 unique values and 0% NA

## ungroup: no grouping variables

## filter: removed 299 rows (83%), 62 rows remaining

## rename: renamed one variable (sovon_bird_date_begin)

## select: dropped one variable (n)

bird_two_vang %>%
  select_if(function(x) any(!is.na(x)))

## select_if: dropped 9 variables (rngkl, veld, dood, klgev, br, …)

In the expert spreadsheet, we can see that the color ring is typically applied during the last vang/vangl action. We will assign the most recent date by default as first step, correcting the exceptions later:

bird_two_vang_get_date <-
  crbirding_birds %>%
  filter(sovon_bird_reference %in% bird_two_vang$sovon_bird_reference &
    sovon_bird_reference %in% birds_two_rings$sovon_bird_reference) %>%
  group_by(sovon_bird_reference) %>%
  filter(is.na(sovon_bird_date_begin)) %>%
  select(-sovon_bird_date_begin) %>%
  left_join(bird_two_vang %>%
    group_by(sovon_bird_reference) %>%
    filter(sovon_bird_date_begin == max(sovon_bird_date_begin)),
  by = c("sovon_bird_reference")
  ) %>%
  select_if(function(x) any(!is.na(x)))

## filter: removed 11,497 rows (99%), 62 rows remaining

## group_by: one grouping variable (sovon_bird_reference)

## filter (grouped): removed 31 rows (50%), 31 rows remaining

## select: dropped one variable (sovon_bird_date_begin)

## group_by: one grouping variable (sovon_bird_reference)

## filter (grouped): removed 31 rows (50%), 31 rows remaining

## left_join: added 40 columns (Nummer, sovon_bird_date_begin, EuringCode, LeeftijdCode, KleurringNummer, …)

##            > rows only in x    0

##            > rows only in y  ( 0)

##            > matched rows     31

##            >                 ====

##            > rows total       31

## select_if: dropped 16 variables (KleurringPlaats, MetaalringNummer_obs, MetaalringPlaats_obs, MetaalringLandCode_obs, BevestigingDatum, …)

bird_two_vang_get_date

By consulting the spreadsheet we can find that the following rings have been applied during the earliest vang/vangl action, so they are exceptions:

bird_shorthand_exceptions <- c(
  "NGAP", "NGAX", "GVAR",
  "KPAZ", "KAAK", "KAAN"
)
bird_exceptions <-
  crbirding_birds %>%
  filter(sovon_bird_shorthand %in% bird_shorthand_exceptions)

## filter: removed 11,553 rows (>99%), 6 rows remaining

We set sovon_bird_date_begin equal to the date of the earliest vang/vangl action:

bird_two_vang_get_date <-
  bird_two_vang %>%
  filter(sovon_bird_reference %in% bird_exceptions$sovon_bird_reference) %>%
  group_by(sovon_bird_reference) %>%
  filter(sovon_bird_date_begin == min(sovon_bird_date_begin)) %>%
  ungroup() %>%
  left_join(bird_exceptions %>%
    select(-sovon_bird_date_begin), by = "sovon_bird_reference") %>%
  select(names(bird_two_vang_get_date)) %>%
  bind_rows(bird_two_vang_get_date %>%
    filter(!sovon_bird_shorthand %in%
      bird_exceptions$sovon_bird_shorthand)) %>%
  select(names(crbirding_birds))

## filter: removed 50 rows (81%), 12 rows remaining

## group_by: one grouping variable (sovon_bird_reference)

## filter (grouped): removed 6 rows (50%), 6 rows remaining

## ungroup: no grouping variables

## select: dropped one variable (sovon_bird_date_begin)

## left_join: added 3 columns (sovon_bird_shorthand, sovon_bird_shorthand_pt, sovon_bird_notes)

##            > rows only in x   0

##            > rows only in y  (0)

##            > matched rows     6

##            >                 ===

##            > rows total       6

## select: dropped 16 variables (KleurringPlaats, MetaalringNummer_obs, MetaalringPlaats_obs, MetaalringLandCode_obs, BevestigingDatum, …)

## filter (grouped): removed 6 rows (19%), 25 rows remaining

## select: dropped 23 variables (Nummer, EuringCode, LeeftijdCode, KleurringNummer, PlaatsGemeente, …)

bird_two_vang_get_date

Add this information to crbirding_birds:

crbirding_birds <-
  crbirding_birds %>%
  anti_join(bird_two_vang_get_date,
    by = c(
      "sovon_bird_reference",
      "sovon_bird_shorthand",
      "sovon_bird_shorthand_pt"
    )
  ) %>%
  bind_rows(bird_two_vang_get_date) %>%
  arrange(sovon_bird_reference)

## anti_join: added no columns

##            > rows only in x   11,528

##            > rows only in y  (     0)

##            > matched rows    (    31)

##            >                 ========

##            > rows total       11,528

crbirding_birds

Rings still without date:

crbirding_birds %>%
  mutate(date_is_present = !is.na(sovon_bird_date_begin)) %>%
  filter(!date_is_present)

## mutate: new variable 'date_is_present' (logical) with 2 unique values and 0% NA

## filter: removed 11,554 rows (>99%), 5 rows remaining

Based on spreadsheet and observation data, we found that the dates of applying the rings FAAG, YCAF, FHOV and HSOW are linked to actions ziek, i.e. the ring has been applied while taking care of the birds.

The date of applying FAAG:

info_faag <-
  crbirding_birds %>%
  filter(sovon_bird_shorthand == "FAAG") %>%
  mutate(
    sovon_bird_date_begin =
      obs_and_acts %>%
        filter(
          first_Nummer == "ALAU",
          !is.na(ziek)
        ) %>%
        ## get the second "ziek" action (2006-07-07)
        filter(Datum == max(Datum)) %>%
        pull(Datum)
  )

## filter: removed 11,558 rows (>99%), one row remaining

## filter: removed 150,841 rows (>99%), 2 rows remaining

## filter: removed one row (50%), one row remaining

## mutate: changed one value (100%) of 'sovon_bird_date_begin' (1 fewer NA)

info_faag

The date of applying YCAF:

info_ycaf <-
  crbirding_birds %>%
  filter(sovon_bird_shorthand == "YCAF") %>%
  mutate(
    sovon_bird_date_begin =
      obs_and_acts %>%
        filter(
          first_Nummer == "PLAB",
          !is.na(ziek)
        ) %>%
        ## there is just one "ziek" action (2013-07-22)
        pull(Datum)
  )

## filter: removed 11,558 rows (>99%), one row remaining

## filter: removed 150,842 rows (>99%), one row remaining

## mutate: changed one value (100%) of 'sovon_bird_date_begin' (1 fewer NA)

info_ycaf

The date of applying FHOV:

info_fhov <-
  crbirding_birds %>%
  filter(sovon_bird_shorthand == "FHOV") %>%
  mutate(
    sovon_bird_date_begin =
      obs_and_acts %>%
        filter(
          first_Nummer == "SUAV",
          !is.na(ziek)
        ) %>%
        ## there is just one "ziek" action (2018-04-26)
        pull(Datum)
  )

## filter: removed 11,558 rows (>99%), one row remaining

## filter: removed 150,842 rows (>99%), one row remaining

## mutate: changed one value (100%) of 'sovon_bird_date_begin' (1 fewer NA)

info_fhov

The date of applying HSOW:

info_hsow <-
  crbirding_birds %>%
  filter(sovon_bird_shorthand == "HSOW") %>%
  mutate(
    sovon_bird_date_begin =
      obs_and_acts %>%
        filter(
          first_Nummer == "CPAG",
          !is.na(ziek)
        ) %>%
        ## there is just one "ziek" action (2018-04-26)
        pull(Datum)
  )

## filter: removed 11,558 rows (>99%), one row remaining

## filter: removed 150,842 rows (>99%), one row remaining

## mutate: changed one value (100%) of 'sovon_bird_date_begin' (1 fewer NA)

info_hsow

Based on notes (column Opmerking in obs_and_acts) we understand that the color ring BUAH has been placed while applying the metal ring, so it is linked to action rngme.

The date of applying BUAH:

info_buah <-
  crbirding_birds %>%
  filter(sovon_bird_shorthand == "BUAH") %>%
  mutate(
    sovon_bird_date_begin =
      obs_and_acts %>%
        filter(
          first_Nummer == "ZBZZ",
          !is.na(rngme)
        ) %>%
        pull(Datum)
  )

## filter: removed 11,558 rows (>99%), one row remaining

## filter: removed 150,842 rows (>99%), one row remaining

## mutate: changed one value (100%) of 'sovon_bird_date_begin' (1 fewer NA)

info_buah

Add this dates to crbirding_birds:

crbirding_birds <-
  bind_rows(
    crbirding_birds %>%
      filter(!sovon_bird_shorthand %in% c("FAAG",
                                          "YCAF",
                                          "FHOV",
                                          "HSOW",
                                          "BUAH")),
    info_faag,
    info_ycaf,
    info_fhov,
    info_hsow,
    info_buah
  ) %>%
  arrange(sovon_bird_reference, sovon_bird_date_begin)

## filter: removed 5 rows (<1%), 11,554 rows remaining

All rings in crbirding_birds have a date:

crbirding_birds %>%
  filter(!is.na(sovon_bird_date_begin)) %>%
  nrow() == nrow(crbirding_birds)

## filter: no rows removed

## [1] TRUE

5.2.3.3 Add intermediate color rings

Based on spreadsheet of experts, we have to add new rings, as some birds have been ringed more than twice, so the information contained in first_Nummer and NummerNieuw is not complete, as they map the very first and the very last ring. The intermediate rings are the following:

intermediate_rings <- tibble(
  first_Nummer = c(
    "E633",
    "DJAB",
    "BWAD",
    "KLAT",
    "PR3",
    "TY2",
    "RTO",
    "E099",
    "MKAU",
    "ASAH",
    "ADAF",
    "KMAV",
    "KCAV",
    "BCAV"
  ),
  intermediate_ring = c(
    "BUAG",
    "TRAP",
    "GTAS",
    "UPAB",
    "DHAZ",
    "GMAJ",
    "DGAH",
    "GHAT",
    "ZVAU",
    "HWAX",
    "DJAU",
    "UMAR",
    "RTAK",
    "LMAA"
  ),
  sovon_bird_date_begin = as.POSIXct(c(
    "2000-05-08", ## BUAG
    "2012-05-25", ## TRAP
    "2007-06-01", ## GTAS
    "2012-05-29", ## UPAB
    "2006-05-26", ## DHAZ
    "2007-06-06", ## GMAJ
    "2006-05-17", ## DGAH
    "2007-06-18", ## GHAT
    "2014-05-23", ## ZVAU
    "2009-05-18", ## HWAX
    "2006-05-26", ## DJAU
    "2012-05-31", ## UMAR
    "2016-05-26", ## RTAK
    "2009-06-01" ## LMAA
  ), tz = "UTC")
)
intermediate_rings

Retrieve sovon_bird_reference:

intermediate_rings <-
  intermediate_rings %>%
  left_join(crbirding_birds %>%
    select(sovon_bird_reference, sovon_bird_shorthand, sovon_bird_notes),
  by = c("first_Nummer" = "sovon_bird_shorthand")
  ) %>%
  select(
    sovon_bird_reference, first_Nummer, intermediate_ring,
    sovon_bird_date_begin, sovon_bird_notes
  )

## select: dropped 2 variables (sovon_bird_shorthand_pt, sovon_bird_date_begin)

## left_join: added 2 columns (sovon_bird_reference, sovon_bird_notes)

##            > rows only in x        0

##            > rows only in y  (11,545)

##            > matched rows         14

##            >                 ========

##            > rows total           14

## select: columns reordered (sovon_bird_reference, first_Nummer, intermediate_ring, sovon_bird_date_begin, sovon_bird_notes)

intermediate_rings

Check whether all dates are linked to a valid observation and check whether they are linked to vang/vangl actions:

intermediate_rings %>%
  left_join(obs_and_acts %>%
    select(
      sovon_bird_reference,
      Datum,
      acts,
      first_Nummer
    ),
  by = c("sovon_bird_reference",
    "sovon_bird_date_begin" = "Datum",
    "first_Nummer"
  )
  ) %>%
  filter(!is.na(vang) | !is.na(vangl)) %>%
  select_if(function(x) any(!is.na(x)))

## select: dropped 26 variables (Nummer, EuringCode, LeeftijdCode, KleurringNummer, KleurringPlaats, …)

## left_join: added 12 columns (rngkl, rngme, klgev, br, vang, …)

##            > rows only in x         0

##            > rows only in y  (150,829)

##            > matched rows          14

##            >                 =========

##            > rows total            14

## filter: no rows removed

## select_if: dropped 10 variables (rngkl, klgev, br, dood, klweg, …)

We can then add the intermediate rings to crbirding_birds:

crbirding_birds <-
  crbirding_birds %>%
  bind_rows(intermediate_rings %>%
    select(-first_Nummer) %>%
    rename(sovon_bird_shorthand = intermediate_ring) %>%
    mutate(sovon_bird_shorthand_pt = sovon_bird_shorthand)) %>%
  arrange(sovon_bird_reference, sovon_bird_date_begin)

## select: dropped one variable (first_Nummer)

## rename: renamed one variable (sovon_bird_shorthand)

## mutate: new variable 'sovon_bird_shorthand_pt' (character) with 14 unique values and 0% NA

These are all mapped triplet ring sequences:

bird_reference_triplets <-
  crbirding_birds %>%
  filter(sovon_bird_shorthand %in% c(intermediate_rings$intermediate_ring)) %>%
  distinct(sovon_bird_reference) %>%
  pull()

## filter: removed 11,559 rows (>99%), 14 rows remaining

## distinct: no rows removed

crbirding_birds %>%
  filter(sovon_bird_reference %in% bird_reference_triplets)

## filter: removed 11,531 rows (>99%), 42 rows remaining

At this point all rings should have a sovon_bird_date_begin:

crbirding_birds %>%
  filter(!is.na(sovon_bird_date_begin)) %>%
  nrow() == nrow(crbirding_birds)

## filter: no rows removed

## [1] TRUE

5.2.4 Bird ringing end date

For birds ringed more than once, we can assign an end date for the changed rings. This information will be stored in field sovon_bird_date_end. The end date is equal to the date of applying the new ring

assign_end_date <- function(data) {
  if (nrow(data) > 1) {
    return(c(
      as_date(data$sovon_bird_date_begin[2:nrow(data)], tz = "UTC"),
      as_date(NA, tz = "UTC")
    ))
  } else {
    return(as_date(NA, tz = "UTC"))
  }
}

crbirding_birds <-
  crbirding_birds %>%
  arrange(sovon_bird_reference, sovon_bird_date_begin) %>%
  group_by(sovon_bird_reference) %>%
  nest() %>%
  mutate(sovon_bird_date_end = map(data, assign_end_date)) %>%
  unnest(cols = c(data, sovon_bird_date_end)) %>%
  mutate(sovon_bird_date_end = as.POSIXct(sovon_bird_date_end)) %>%
  select(
    sovon_bird_reference, sovon_bird_shorthand, sovon_bird_shorthand_pt,
    sovon_bird_date_begin, sovon_bird_date_end, sovon_bird_notes
  ) %>%
  ungroup()

## group_by: one grouping variable (sovon_bird_reference)

## mutate (grouped): new variable 'sovon_bird_date_end' (list) with 165 unique values and 97% NA

## mutate (grouped): converted 'sovon_bird_date_end' from Date to double (0 new NA)

## select: columns reordered (sovon_bird_reference, sovon_bird_shorthand, sovon_bird_shorthand_pt, sovon_bird_date_begin, sovon_bird_date_end, …)

## ungroup: no grouping variables

As example, we show the chronology of color rings for birds ringed thrice:

crbirding_birds %>%
  group_by(sovon_bird_reference) %>%
  add_tally() %>%
  ungroup() %>%
  filter(n == 3) %>%
  select(
    sovon_bird_reference,
    sovon_bird_shorthand,
    sovon_bird_date_begin,
    sovon_bird_date_end
  ) %>%
  arrange(sovon_bird_reference, sovon_bird_date_begin)

## group_by: one grouping variable (sovon_bird_reference)

## add_tally (grouped): new variable 'n' (integer) with 3 unique values and 0% NA

## ungroup: no grouping variables

## filter: removed 11,531 rows (>99%), 42 rows remaining

## select: dropped 3 variables (sovon_bird_shorthand_pt, sovon_bird_notes, n)

We add end date to the very last ring of dead birds by using the link to observations with action dood:

crbirding_birds <-
  obs_and_acts %>%
  filter(dood == "dood") %>%
  select(sovon_bird_reference, Datum) %>%
  rename(bird_dood_datum = Datum) %>%
  right_join(crbirding_birds,
    by = c("sovon_bird_reference")
  ) %>%
  group_by(sovon_bird_reference) %>%
  mutate(sovon_bird_date_end = case_when(
    is.na(sovon_bird_date_end) &
      sovon_bird_date_begin == max(sovon_bird_date_begin) &
      bird_dood_datum >= sovon_bird_date_begin ~ bird_dood_datum,
    TRUE ~ sovon_bird_date_end
  )) %>%
  select(-bird_dood_datum)

## filter: removed 150,113 rows (>99%), 730 rows remaining

## select: dropped 39 variables (Nummer, EuringCode, LeeftijdCode, KleurringNummer, KleurringPlaats, …)

## rename: renamed one variable (bird_dood_datum)

## right_join: added 5 columns (sovon_bird_shorthand, sovon_bird_shorthand_pt, sovon_bird_date_begin, sovon_bird_date_end, sovon_bird_notes)

##             > rows only in x  (     0)

##             > rows only in y   10,831

##             > matched rows        742

##             >                 ========

##             > rows total       11,573

## group_by: one grouping variable (sovon_bird_reference)

## mutate (grouped): changed 730 values (6%) of 'sovon_bird_date_end' (730 fewer NA)

## select: dropped one variable (bird_dood_datum)

Effects of mapping:

crbirding_birds %>%
  group_by(sovon_bird_reference) %>%
  filter(sovon_bird_date_begin == max(sovon_bird_date_begin) &
    !is.na(sovon_bird_date_end)) %>%
  select(sovon_bird_reference) %>%
  ungroup() %>%
  left_join(crbirding_birds, by = "sovon_bird_reference") %>%
  select(
    sovon_bird_reference,
    sovon_bird_shorthand,
    sovon_bird_date_begin,
    sovon_bird_date_end,
    everything()
  )

## group_by: one grouping variable (sovon_bird_reference)

## filter (grouped): removed 10,843 rows (94%), 730 rows remaining

## select: dropped 5 variables (sovon_bird_shorthand, sovon_bird_shorthand_pt, sovon_bird_date_begin, sovon_bird_date_end, sovon_bird_notes)

## ungroup: no grouping variables

## left_join: added 5 columns (sovon_bird_shorthand, sovon_bird_shorthand_pt, sovon_bird_date_begin, sovon_bird_date_end, sovon_bird_notes)

##            > rows only in x        0

##            > rows only in y  (10,831)

##            > matched rows        742    (includes duplicates)

##            >                 ========

##            > rows total          742

## select: columns reordered (sovon_bird_reference, sovon_bird_shorthand, sovon_bird_date_begin, sovon_bird_date_end, sovon_bird_shorthand_pt, …)

Number of rings still in use, i.e. no end date:

crbirding_birds %>%
  filter(is.na(sovon_bird_date_end)) %>%
  nrow()

## filter (grouped): removed 1,079 rows (9%), 10,494 rows remaining

## [1] 10494

5.2.5 Add rows for metal rings applied before color rings

Sometimes metal rings have been applied before color rings. These cases should be added to crbirding_birds as new rows. We can detect these situations by comparing the date of actions rngme and rngkl for each bird.

rngme_before_rngkl <-
  obs_and_acts %>%
  filter(!is.na(rngme) & is.na(rngkl)) %>%
  select(sovon_bird_reference, Datum) %>%
  rename(Datum_rngme = Datum) %>%
  left_join(obs_and_acts %>%
    filter(!is.na(rngkl)) %>%
    select(sovon_bird_reference, Datum) %>%
    rename(Datum_rngkl = Datum),
  by = "sovon_bird_reference"
  ) %>%
  filter(Datum_rngme < Datum_rngkl) %>%
  rename(
    sovon_bird_date_begin = Datum_rngme,
    sovon_bird_date_end = Datum_rngkl
  ) %>%
  mutate(
    sovon_bird_shorthand = NA_character_,
    sovon_bird_shorthand_pt = NA_character_,
    sovon_bird_notes = "sovon_bird_shorthand not available."
  ) %>%
  select(
    sovon_bird_reference,
    sovon_bird_shorthand,
    sovon_bird_shorthand_pt,
    everything()
  )

## filter: removed 150,075 rows (99%), 768 rows remaining

## select: dropped 39 variables (Nummer, EuringCode, LeeftijdCode, KleurringNummer, KleurringPlaats, …)

## rename: renamed one variable (Datum_rngme)

## filter: removed 139,619 rows (93%), 11,224 rows remaining

## select: dropped 39 variables (Nummer, EuringCode, LeeftijdCode, KleurringNummer, KleurringPlaats, …)

## rename: renamed one variable (Datum_rngkl)

## left_join: added one column (Datum_rngkl)

##            > rows only in x        0

##            > rows only in y  (10,456)

##            > matched rows        768

##            >                 ========

##            > rows total          768

## filter: removed 101 rows (13%), 667 rows remaining

## rename: renamed 2 variables (sovon_bird_date_begin, sovon_bird_date_end)

## mutate: new variable 'sovon_bird_shorthand' (character) with one unique value and 100% NA

##         new variable 'sovon_bird_shorthand_pt' (character) with one unique value and 100% NA

##         new variable 'sovon_bird_notes' (character) with one unique value and 0% NA

## select: columns reordered (sovon_bird_reference, sovon_bird_shorthand, sovon_bird_shorthand_pt, sovon_bird_date_begin, sovon_bird_date_end, …)

rngme_before_rngkl

We add these rows to crbirding_birds:

crbirding_birds <-
  crbirding_birds %>%
  bind_rows(rngme_before_rngkl) %>%
  arrange(sovon_bird_reference, sovon_bird_date_begin)

A preview:

crbirding_birds %>%
  filter(sovon_bird_reference %in%
    (rngme_before_rngkl %>%
      pull(sovon_bird_reference))) %>%
  head(n = 50)

## filter (grouped): removed 10,877 rows (89%), 1,363 rows remaining

5.2.6 Ring number

The ring number, or metal ring number, can be found in field MetaalringNummer, which contains the most recent metal ring number. Recoverying the complete chronology of metal rings for each bird is almost impossible as it is:

not complete
included in texutal description (field Opmerking of tblWaarneming)

However, this is not considered a real problem by INBO and SOVON experts as both INBO and SOVON databases focus on color rings. See issue 34 for more details. Just as example, we can show the textual notes of observations linked to action vang and containing 6 or more consecutive numbers in the notes:

obs_and_acts %>%
  filter(str_detect(Opmerking, pattern = "[0-9]{6,}")) %>%
  filter(!is.na(vang)) %>%
  select(Opmerking)

## filter: removed 150,254 rows (>99%), 589 rows remaining

## filter: removed 466 rows (79%), 123 rows remaining

## select: dropped 40 variables (sovon_bird_reference, Nummer, Datum, EuringCode, LeeftijdCode, …)

A ring number should consist of up to ten alphanumeric characters. At page 7 of the EURING Exchange Code 2000+ document we read the following instructions:

Where the ring number consist of fewer than ten numbers/letters, the number is padded with dots. These dots are always inserted to the left of the rightmost row of numbers.

Ring number anomalies:

birds %>%
  filter(!str_detect(MetaalringNummer, pattern = regex("\\d+"))) %>%
  group_by(MetaalringNummer) %>%
  count()

## filter: removed 11,174 rows (>99%), 50 rows remaining

## group_by: one grouping variable (MetaalringNummer)

## count: now 5 rows and 2 columns, one group variable remaining (MetaalringNummer)

Value none means not metal-ringed bird, while onbekend means that information is no more available. SOVON chooses to leave column sovon_bird_ring_number empty for both cases. However, we will add a note to sovon_bird_notes to still maintain a reference to this slight difference. Value ? is equivalent to onbekend while H???????? and Lxxxxxx are mapped as H-------- and L------ respectively.

birds <-
  birds %>%
  mutate(sovon_bird_ring_number = recode(
    MetaalringNummer,
    "?" = NA_character_,
    "onbekend" = NA_character_,
    "none" = NA_character_,
    "H????????" = "H--------",
    "Lxxxxxx" = "L------"
  ))

## mutate: new variable 'sovon_bird_ring_number' (character) with 11,111 unique values and 1% NA

We separate the birds with special mapping values by all the others:

special_values <- c("H--------", "L------")
birds_special_values <-
  birds %>%
  filter(sovon_bird_ring_number %in% special_values)

## filter: removed 11,222 rows (>99%), 2 rows remaining

birds_others <-
  birds %>%
  filter(!sovon_bird_ring_number %in% special_values)

## filter: removed 2 rows (<1%), 11,222 rows remaining

Some ring numbers contain asterisks:

birds_others %>%
  filter(str_detect(sovon_bird_ring_number, "\\*")) %>%
  select(sovon_bird_ring_number)

## filter: removed 11,161 rows (99%), 61 rows remaining

## select: dropped 15 variables (sovon_bird_reference, first_Nummer, NummerNieuw, NummerDesc, Nummer, …)

We remove the asterisks:

birds_others <-
  birds_others %>%
  mutate(sovon_bird_ring_number = str_remove_all(sovon_bird_ring_number, "\\*"))

## mutate: changed 61 values (1%) of 'sovon_bird_ring_number' (0 new NA)

Preview:

birds_others %>%
  select(MetaalringNummer, sovon_bird_ring_number) %>%
  filter(str_detect(MetaalringNummer, "\\*"))

## select: dropped 14 variables (sovon_bird_reference, first_Nummer, NummerNieuw, NummerDesc, Nummer, …)

## filter: removed 11,161 rows (99%), 61 rows remaining

Add points . where needed:

birds_others <-
  birds_others %>%
  # calculate the number of dots needed
  mutate(ndots = 10 - str_length(sovon_bird_ring_number)) %>%
  # created a string with the needed dots
  mutate(dots = str_dup(".", ndots)) %>%
  # concatenate the first uppercase letter, the dots and the digits together
  mutate(sovon_bird_ring_number = str_c(
    str_extract(sovon_bird_ring_number, "^[:upper:]+"),
    dots,
    str_extract(sovon_bird_ring_number, "[:digit:]+$"))) %>%
  # remove auxiliary columns after use
  select(-c(ndots, dots))

## mutate: new variable 'ndots' (double) with 5 unique values and 1% NA

## mutate: new variable 'dots' (character) with 5 unique values and 1% NA

## mutate: changed 11,143 values (99%) of 'sovon_bird_ring_number' (23 new NA)

## select: dropped 2 variables (ndots, dots)

Merge the two data frames together:

birds <- bind_rows(birds_others, birds_special_values)

Preivew of the effects the mapping:

birds %>%
  distinct(MetaalringNummer, sovon_bird_ring_number) %>%
  head(n = 200)

## distinct: removed 110 rows (1%), 11,114 rows remaining

We have to be sure that no multiple metal rings are assigned to the same bird (sovon_bird_reference) as this is not allowed by our database. Exceptions:

birds %>%
  group_by(sovon_bird_reference) %>%
  add_tally() %>%
  ungroup() %>%
  filter(n > 1)

## group_by: one grouping variable (sovon_bird_reference)

## add_tally (grouped): new variable 'n' (integer) with one unique value and 0% NA

## ungroup: no grouping variables

## filter: removed all rows (100%)

Later we will add value sovon_bird_ring_number to crbirding_birds where metal ring is present.

5.2.7 Initialize `sovon_bird_rings_changed` column for very first ring

In order to better follow the mapping of metal AND color rings, SOVON suggested to add a column called sovon_bird_rings_changed, as shown in this GitHub comment.

We initialize the column sovon_bird_rings_changed for the very first ringing by assigning:

sovon_bird_rings_changed = 0 if rngme action only
sovon_bird_rings_changed = 1 if rngkl action only
sovon_bird_rings_changed = 2 if rngkl and rngme

If very first bird_shorthand is empty, it means that the bird has been first ringed with a metal ring, sovon_bird_rings_changed = 0:

crbirding_birds <-
  crbirding_birds %>%
  group_by(sovon_bird_reference) %>%
  mutate(sovon_bird_rings_changed = if_else(
    sovon_bird_date_begin == min(sovon_bird_date_begin) &
      is.na(sovon_bird_shorthand),
    0, NA_real_
  )) %>%
  ungroup()

## group_by: one grouping variable (sovon_bird_reference)

## mutate (grouped): new variable 'sovon_bird_rings_changed' (double) with 2 unique values and 95% NA

## ungroup: no grouping variables

We proceed now by mapping values 1 (action rngkl only) and 2 (action rngkl and rngme together):

crbirding_birds <-
  crbirding_birds %>%
  left_join(obs_and_acts %>%
    filter(rngkl == "rngkl") %>%
    mutate(n_rings = if_else(is.na(rngme), 1, 2)) %>%
    select(sovon_bird_reference, n_rings, Datum),
  by = "sovon_bird_reference"
  ) %>%
  group_by(sovon_bird_reference) %>%
  mutate(sovon_bird_rings_changed = if_else(
    sovon_bird_date_begin == min(sovon_bird_date_begin) &
      !is.na(sovon_bird_shorthand),
    n_rings,
    sovon_bird_rings_changed
  )) %>%
  select(-c(n_rings, Datum)) %>%
  ungroup()

## filter: removed 139,619 rows (93%), 11,224 rows remaining

## mutate: new variable 'n_rings' (double) with 2 unique values and 0% NA

## select: dropped 39 variables (Nummer, EuringCode, LeeftijdCode, KleurringNummer, KleurringPlaats, …)

## left_join: added 2 columns (n_rings, Datum)

##            > rows only in x        0

##            > rows only in y  (     0)

##            > matched rows     12,240

##            >                 ========

##            > rows total       12,240

## group_by: one grouping variable (sovon_bird_reference)

## mutate (grouped): changed 10,557 values (86%) of 'sovon_bird_rings_changed' (10557 fewer NA)

## select: dropped 2 variables (n_rings, Datum)

## ungroup: no grouping variables

Preview sovon_bird_rings_changed = 1:

crbirding_birds %>%
  filter(sovon_bird_rings_changed == 1) %>%
  head(n = 10)

## filter: removed 12,139 rows (99%), 101 rows remaining

Preview sovon_bird_rings_changed = 2:

crbirding_birds %>%
  filter(sovon_bird_rings_changed == 2) %>%
  head(n = 10)

## filter: removed 1,784 rows (15%), 10,456 rows remaining

5.2.8 Add help field `metal_ring_missing`

We add also a help column, metal_ring_missing: it will help us later to fill the field sovon_ring_number only where metal ring is present.

We initialize it as FALSE except for very first metal rings only (sovon_bird_rings_changed = 1):

crbirding_birds <-
  crbirding_birds %>%
  mutate(metal_ring_missing = if_else(
    sovon_bird_rings_changed != 1 | is.na(sovon_bird_rings_changed),
    FALSE,
    TRUE
  ))

## mutate: new variable 'metal_ring_missing' (logical) with 2 unique values and 0% NA

Preview metal_ring_missing = FALSE:

crbirding_birds %>%
  filter(metal_ring_missing == FALSE) %>%
  head(n = 50)

## filter: removed 101 rows (1%), 12,139 rows remaining

Preview metal_ring_missing = TRUE:

crbirding_birds %>%
  filter(metal_ring_missing == TRUE) %>%
  head(n = 50)

## filter: removed 12,139 rows (99%), 101 rows remaining

5.2.9 Add rows for first metal ring applied after color rings

Sometimes metal rings have been applied after color rings. We can detect these situations by using sovon_bird_rings_changed value 1 (rngkl only) to identify the birds, observations with action rngme to get date of applying metal rings:

rngme_after_rngkl <-
  crbirding_birds %>%
  filter(sovon_bird_rings_changed == 1) %>%
  select(sovon_bird_reference) %>%
  left_join(obs_and_acts %>%
    filter(rngme == "rngme") %>%
    select(sovon_bird_reference, Datum),
  by = "sovon_bird_reference"
  ) %>%
  select(sovon_bird_reference, Datum) %>%
  rename(sovon_bird_date_begin = Datum)

## filter: removed 12,139 rows (99%), 101 rows remaining

## select: dropped 7 variables (sovon_bird_shorthand, sovon_bird_shorthand_pt, sovon_bird_date_begin, sovon_bird_date_end, sovon_bird_notes, …)

## filter: removed 139,619 rows (93%), 11,224 rows remaining

## select: dropped 39 variables (Nummer, EuringCode, LeeftijdCode, KleurringNummer, KleurringPlaats, …)

## left_join: added one column (Datum)

##            > rows only in x        0

##            > rows only in y  (11,123)

##            > matched rows        101

##            >                 ========

##            > rows total          101

## select: no changes

## rename: renamed one variable (sovon_bird_date_begin)

rngme_after_rngkl

If sovon_bird_reference and sovon_bird_date_begin are already present in crbirding_birds means that applying a metal ring occurred while changing color ring during a vang action: no rows should be added then, but sovon_bird_rings_changed = 2:

crbirding_birds <-
  crbirding_birds %>%
  left_join(rngme_after_rngkl %>%
    rename(rngme_date = sovon_bird_date_begin),
  by = "sovon_bird_reference"
  ) %>%
  mutate(sovon_bird_rings_changed = case_when(
    sovon_bird_date_begin == rngme_date ~ 2,
    TRUE ~ sovon_bird_rings_changed
  )) %>%
  select(-rngme_date)

## rename: renamed one variable (rngme_date)

## left_join: added one column (rngme_date)

##            > rows only in x   12,040

##            > rows only in y  (     0)

##            > matched rows        200

##            >                 ========

##            > rows total       12,240

## mutate: changed 94 values (1%) of 'sovon_bird_rings_changed' (94 fewer NA)

## select: dropped one variable (rngme_date)

Show changes:

rngme_after_rngkl %>%
  inner_join(crbirding_birds,
    by = c("sovon_bird_reference", "sovon_bird_date_begin")
  ) %>%
  select(
    sovon_bird_reference,
    sovon_bird_shorthand,
    sovon_bird_date_begin,
    sovon_bird_date_end,
    sovon_bird_rings_changed,
    metal_ring_missing,
    everything()
  )

## inner_join: added 6 columns (sovon_bird_shorthand, sovon_bird_shorthand_pt, sovon_bird_date_end, sovon_bird_notes, sovon_bird_rings_changed, …)

##             > rows only in x  (     7)

##             > rows only in y  (12,146)

##             > matched rows         94

##             >                 ========

##             > rows total           94

## select: columns reordered (sovon_bird_reference, sovon_bird_shorthand, sovon_bird_date_begin, sovon_bird_date_end, sovon_bird_rings_changed, …)

On the other side, if sovon_bird_reference and sovon_bird_date_begin are not present in crbirding_birds, we add them as new rows where sovon_bird_rings_changed = 0 and metal_ring_missing is FALSE.

Rows to add:

rngme_without_change_rngkl <-
  rngme_after_rngkl %>%
  anti_join(crbirding_birds, by = c("sovon_bird_reference", "sovon_bird_date_begin")) %>%
  rename(rngme_date = sovon_bird_date_begin) %>%
  right_join(crbirding_birds, by = "sovon_bird_reference") %>%
  group_by(sovon_bird_reference) %>%
  filter(sovon_bird_date_begin < rngme_date) %>%
  filter(sovon_bird_date_begin == max(sovon_bird_date_begin)) %>%
  mutate(
    sovon_bird_rings_changed = 0,
    metal_ring_missing = FALSE,
    sovon_bird_date_begin = rngme_date
  ) %>%
  select(names(crbirding_birds)) %>%
  ungroup()

## anti_join: added no columns

##            > rows only in x        7

##            > rows only in y  (12,146)

##            > matched rows    (    94)

##            >                 ========

##            > rows total            7

## rename: renamed one variable (rngme_date)

## right_join: added 7 columns (sovon_bird_shorthand, sovon_bird_shorthand_pt, sovon_bird_date_begin, sovon_bird_date_end, sovon_bird_notes, …)

##             > rows only in x  (     0)

##             > rows only in y   12,233

##             > matched rows          7

##             >                 ========

##             > rows total       12,240

## group_by: one grouping variable (sovon_bird_reference)

## filter (grouped): removed 12,233 rows (>99%), 7 rows remaining

## filter (grouped): no rows removed

## mutate (grouped): changed 7 values (100%) of 'sovon_bird_date_begin' (0 new NA)

##                   changed 7 values (100%) of 'sovon_bird_rings_changed' (0 new NA)

##                   changed 7 values (100%) of 'metal_ring_missing' (0 new NA)

## select: dropped one variable (rngme_date)

## ungroup: no grouping variables

rngme_without_change_rngkl

Add these new rows:

crbirding_birds <-
  crbirding_birds %>%
  bind_rows(rngme_without_change_rngkl) %>%
  arrange(
    sovon_bird_reference,
    sovon_bird_date_begin,
    sovon_bird_date_end
  ) %>%
  group_by(sovon_bird_reference, sovon_bird_date_end) %>%
  mutate(sovon_bird_date_end_updated = case_when(
    sovon_bird_date_begin == min(sovon_bird_date_begin) &
      sovon_bird_date_begin != max(sovon_bird_date_begin) ~ max(sovon_bird_date_begin),
    TRUE ~ sovon_bird_date_end
  )) %>%
  ungroup() %>%
  mutate(sovon_bird_date_end = sovon_bird_date_end_updated) %>%
  select(-sovon_bird_date_end_updated)

## group_by: 2 grouping variables (sovon_bird_reference, sovon_bird_date_end)

## mutate (grouped): new variable 'sovon_bird_date_end_updated' (double) with 637 unique values and 86% NA

## ungroup: no grouping variables

## mutate: changed 7 values (<1%) of 'sovon_bird_date_end' (6 fewer NA)

## select: dropped one variable (sovon_bird_date_end_updated)

Show changes:

crbirding_birds %>%
  filter(sovon_bird_reference %in% c(rngme_without_change_rngkl$sovon_bird_reference))

## filter: removed 12,233 rows (>99%), 14 rows remaining

For these birds, we can then assign value 1 to sovon_bird_rings_changed while applying color ring as rngkl occurs after rngme:

crbirding_birds <-
  crbirding_birds %>%
  mutate(sovon_bird_rings_changed = case_when(
    sovon_bird_reference %in% rngme_before_rngkl$sovon_bird_reference &
      !is.na(sovon_bird_shorthand) ~ 1,
    TRUE ~ sovon_bird_rings_changed
  ))

## mutate: changed 696 values (6%) of 'sovon_bird_rings_changed' (696 fewer NA)

Show changes in color/metal ring for these birds:

crbirding_birds %>%
  filter(sovon_bird_reference %in% rngme_before_rngkl$sovon_bird_reference)

## filter: removed 10,884 rows (89%), 1,363 rows remaining

5.2.10 Add rows for loosing color or metal rings: `klweg`, `meweg`

We have observations linked to actions klweg and meweg. These actions mean that the bird has been observed without the color ring or metal ring respectively.

Number of observations with action klweg:

obs_and_acts %>%
  filter(klweg == "klweg") %>%
  nrow()

## filter: removed 150,774 rows (>99%), 69 rows remaining

## [1] 69

Type of action combinations where klweg occurs:

obs_and_acts %>%
  filter(klweg == "klweg") %>%
  select(acts) %>%
  distinct() %>%
  select_if(~ sum(!is.na(.)) > 0)

## filter: removed 150,774 rows (>99%), 69 rows remaining

## select: dropped 29 variables (sovon_bird_reference, Nummer, Datum, EuringCode, LeeftijdCode, …)

## distinct: removed 62 rows (90%), 7 rows remaining

## select_if: dropped 5 variables (rngkl, rngme, klgev, meweg, vangl)

Number of observations with action meweg:

obs_and_acts %>%
  filter(meweg == "meweg") %>%
  nrow()

## filter: removed 150,718 rows (>99%), 125 rows remaining

## [1] 125

Type of action combinations where meweg occurs:

obs_and_acts %>%
  filter(meweg == "meweg") %>%
  select(acts) %>%
  distinct() %>%
  select_if(~ sum(!is.na(.)) > 0)

## filter: removed 150,718 rows (>99%), 125 rows remaining

## select: dropped 29 variables (sovon_bird_reference, Nummer, Datum, EuringCode, LeeftijdCode, …)

## distinct: removed 119 rows (95%), 6 rows remaining

## select_if: dropped 6 variables (rngkl, rngme, klgev, klweg, me, …)

Are there birds linked to both actions klweg and meweg?

bird_ref_meweg <-
  obs_and_acts %>%
  filter(meweg == "meweg") %>%
  pull(sovon_bird_reference)

## filter: removed 150,718 rows (>99%), 125 rows remaining

bird_ref_klweg <-
  (obs_and_acts %>%
    filter(klweg == "klweg") %>%
    pull(sovon_bird_reference))

## filter: removed 150,774 rows (>99%), 69 rows remaining

bird_ref_meweg[which(bird_ref_meweg %in% bird_ref_klweg)]

## integer(0)

Are there more than one meweg for bird?

bird_ref_multiple_meweg <-
  obs_and_acts %>%
  filter(meweg == "meweg") %>%
  group_by(sovon_bird_reference) %>%
  add_tally() %>%
  ungroup() %>%
  filter(n > 1)

## filter: removed 150,718 rows (>99%), 125 rows remaining

## group_by: one grouping variable (sovon_bird_reference)

## add_tally (grouped): new variable 'n' (integer) with one unique value and 0% NA

## ungroup: no grouping variables

## filter: removed all rows (100%)

bird_ref_multiple_meweg

Are there more than one klweg for bird?

bird_ref_multiple_klweg <-
  obs_and_acts %>%
  filter(klweg == "klweg") %>%
  group_by(sovon_bird_reference) %>%
  add_tally() %>%
  ungroup() %>%
  filter(n > 1)

## filter: removed 150,774 rows (>99%), 69 rows remaining

## group_by: one grouping variable (sovon_bird_reference)

## add_tally (grouped): new variable 'n' (integer) with 2 unique values and 0% NA

## ungroup: no grouping variables

## filter: removed 67 rows (97%), 2 rows remaining

bird_ref_multiple_klweg

If meweg/klweg occurs not in combination with dood or vang/ vangl, then a new row should be added to crbirding_birds as the ring situation changed.

We create first new rows based on action meweg. We set sovon_bird_rings_changed = 0 and metal_ring_missing = TRUE:

rings_to_add_meweg <-
  obs_and_acts %>%
  filter(meweg == "meweg" & is.na(dood) & is.na(vang) & is.na(vangl)) %>%
  select(sovon_bird_reference, Datum) %>%
  left_join(crbirding_birds, by = "sovon_bird_reference") %>%
  group_by(sovon_bird_reference) %>%
  filter(sovon_bird_date_begin < Datum) %>%
  filter(sovon_bird_date_begin == max(sovon_bird_date_begin)) %>%
  mutate(sovon_bird_date_begin = Datum) %>%
  select(-Datum) %>%
  mutate(
    sovon_bird_rings_changed = 0,
    metal_ring_missing = TRUE
  ) %>%
  ungroup() %>%
  arrange(sovon_bird_reference)

## filter: removed 150,721 rows (>99%), 122 rows remaining

## select: dropped 39 variables (Nummer, EuringCode, LeeftijdCode, KleurringNummer, KleurringPlaats, …)

## left_join: added 7 columns (sovon_bird_shorthand, sovon_bird_shorthand_pt, sovon_bird_date_begin, sovon_bird_date_end, sovon_bird_notes, …)

##            > rows only in x        0

##            > rows only in y  (12,081)

##            > matched rows        166    (includes duplicates)

##            >                 ========

##            > rows total          166

## group_by: one grouping variable (sovon_bird_reference)

## filter (grouped): removed 35 rows (21%), 131 rows remaining

## filter (grouped): removed 9 rows (7%), 122 rows remaining

## mutate (grouped): changed 122 values (100%) of 'sovon_bird_date_begin' (0 new NA)

## select: dropped one variable (Datum)

## mutate (grouped): changed 122 values (100%) of 'sovon_bird_rings_changed' (1 fewer NA)

##                   changed 122 values (100%) of 'metal_ring_missing' (0 new NA)

## ungroup: no grouping variables

rings_to_add_meweg

We add them, paying attention to change bird_date_end of previous rings:

crbirding_birds <-
  crbirding_birds %>%
  bind_rows(rings_to_add_meweg) %>%
  arrange(
    sovon_bird_reference,
    sovon_bird_date_begin,
    sovon_bird_date_end
  ) %>%
  group_by(sovon_bird_reference, sovon_bird_date_end) %>%
  mutate(sovon_bird_date_end_updated = case_when(
    sovon_bird_date_begin == min(sovon_bird_date_begin) &
      sovon_bird_date_begin != max(sovon_bird_date_begin) ~
    max(sovon_bird_date_begin),
    TRUE ~ sovon_bird_date_end
  )) %>%
  ungroup() %>%
  mutate(sovon_bird_date_end = sovon_bird_date_end_updated) %>%
  select(-sovon_bird_date_end_updated)

## group_by: 2 grouping variables (sovon_bird_reference, sovon_bird_date_end)

## mutate (grouped): new variable 'sovon_bird_date_end_updated' (double) with 741 unique values and 85% NA

## ungroup: no grouping variables

## mutate: changed 122 values (1%) of 'sovon_bird_date_end' (84 fewer NA)

## select: dropped one variable (sovon_bird_date_end_updated)

and setting sovon_bird_rings_changed = 2 for the next ring, if exists:

rings_to_update <-
  rings_to_add_meweg %>%
  filter(!is.na(sovon_bird_date_end)) %>%
  left_join(
    obs_and_acts %>%
      filter(dood == "dood") %>%
      select(sovon_bird_reference, Datum) %>%
      rename(bird_dood_datum = Datum),
    by = "sovon_bird_reference"
  ) %>%
  filter(is.na(bird_dood_datum)) %>%
  select(-bird_dood_datum) %>%
  select(sovon_bird_reference, sovon_bird_date_end) %>%
  left_join(crbirding_birds %>%
    select(-sovon_bird_date_end),
  by = c("sovon_bird_reference",
    "sovon_bird_date_end" = "sovon_bird_date_begin"
  )
  ) %>%
  rename(sovon_bird_date_begin = sovon_bird_date_end) %>%
  mutate(
    sovon_bird_rings_changed = 2,
    metal_ring_missing = FALSE
  ) %>%
  left_join(crbirding_birds %>%
    select(-c(
      sovon_bird_rings_changed,
      metal_ring_missing
    )),
  by = c(
    "sovon_bird_reference",
    "sovon_bird_shorthand",
    "sovon_bird_shorthand_pt",
    "sovon_bird_date_begin",
    "sovon_bird_notes"
  )
  ) %>%
  select(names(crbirding_birds))

## filter: removed 84 rows (69%), 38 rows remaining

## filter: removed 150,113 rows (>99%), 730 rows remaining

## select: dropped 39 variables (Nummer, EuringCode, LeeftijdCode, KleurringNummer, KleurringPlaats, …)

## rename: renamed one variable (bird_dood_datum)

## left_join: added one column (bird_dood_datum)

##            > rows only in x    30

##            > rows only in y  (722)

##            > matched rows       8

##            >                 =====

##            > rows total        38

## filter: removed 8 rows (21%), 30 rows remaining

## select: dropped one variable (bird_dood_datum)

## select: dropped 6 variables (sovon_bird_shorthand, sovon_bird_shorthand_pt, sovon_bird_date_begin, sovon_bird_notes, sovon_bird_rings_changed, …)

## select: dropped one variable (sovon_bird_date_end)

## left_join: added 5 columns (sovon_bird_shorthand, sovon_bird_shorthand_pt, sovon_bird_notes, sovon_bird_rings_changed, metal_ring_missing)

##            > rows only in x        0

##            > rows only in y  (12,339)

##            > matched rows         30

##            >                 ========

##            > rows total           30

## rename: renamed one variable (sovon_bird_date_begin)

## mutate: changed 30 values (100%) of 'sovon_bird_rings_changed' (26 fewer NA)

## select: dropped 2 variables (sovon_bird_rings_changed, metal_ring_missing)

## left_join: added one column (sovon_bird_date_end)

##            > rows only in x        0

##            > rows only in y  (12,339)

##            > matched rows         30

##            >                 ========

##            > rows total           30

## select: columns reordered (sovon_bird_reference, sovon_bird_shorthand, sovon_bird_shorthand_pt, sovon_bird_date_begin, sovon_bird_date_end, …)

crbirding_birds <-
  crbirding_birds %>%
  anti_join(rings_to_update,
    by = c(
      "sovon_bird_reference",
      "sovon_bird_shorthand",
      "sovon_bird_shorthand_pt"
    )
  ) %>%
  bind_rows(rings_to_update) %>%
  arrange(sovon_bird_reference, sovon_bird_date_begin)

## anti_join: added no columns

##            > rows only in x   12,339

##            > rows only in y  (     0)

##            > matched rows    (    30)

##            >                 ========

##            > rows total       12,339

Show changes:

crbirding_birds %>%
  filter(sovon_bird_reference %in%
    rings_to_add_meweg$sovon_bird_reference) %>%
  select(
    sovon_bird_reference,
    sovon_bird_shorthand,
    sovon_bird_date_begin,
    sovon_bird_date_end,
    sovon_bird_rings_changed,
    metal_ring_missing,
    everything()
  )

## filter: removed 12,081 rows (98%), 288 rows remaining

## select: columns reordered (sovon_bird_reference, sovon_bird_shorthand, sovon_bird_date_begin, sovon_bird_date_end, sovon_bird_rings_changed, …)

We create now new rows based on action klweg. We set sovon_bird_rings_changed = 1, metal_ring_missing = FALSE and we leave bird_shorthand empty:

rings_to_add_klweg <-
  obs_and_acts %>%
  filter(klweg == "klweg" & is.na(dood) & is.na(vang) & is.na(vangl)) %>%
  select(sovon_bird_reference, Datum) %>%
  left_join(crbirding_birds, by = "sovon_bird_reference") %>%
  group_by(sovon_bird_reference) %>%
  filter(sovon_bird_date_begin < Datum) %>%
  filter(sovon_bird_date_begin == max(sovon_bird_date_begin)) %>%
  mutate(sovon_bird_date_begin = Datum) %>%
  select(-Datum) %>%
  mutate(
    sovon_bird_rings_changed = 1,
    metal_ring_missing = FALSE,
    sovon_bird_shorthand = NA_character_,
    sovon_bird_shorthand_pt = NA_character_
  ) %>%
  ungroup() %>%
  arrange(sovon_bird_reference)

## filter: removed 150,785 rows (>99%), 58 rows remaining

## select: dropped 39 variables (Nummer, EuringCode, LeeftijdCode, KleurringNummer, KleurringPlaats, …)

## left_join: added 7 columns (sovon_bird_shorthand, sovon_bird_shorthand_pt, sovon_bird_date_begin, sovon_bird_date_end, sovon_bird_notes, …)

##            > rows only in x        0

##            > rows only in y  (12,292)

##            > matched rows         79    (includes duplicates)

##            >                 ========

##            > rows total           79

## group_by: one grouping variable (sovon_bird_reference)

## filter (grouped): removed 11 rows (14%), 68 rows remaining

## filter (grouped): removed 11 rows (16%), 57 rows remaining

## mutate (grouped): changed 57 values (100%) of 'sovon_bird_date_begin' (0 new NA)

## select: dropped one variable (Datum)

## mutate (grouped): changed 57 values (100%) of 'sovon_bird_shorthand' (57 new NA)

##                   changed 57 values (100%) of 'sovon_bird_shorthand_pt' (57 new NA)

##                   changed 50 values (88%) of 'sovon_bird_rings_changed' (1 fewer NA)

## ungroup: no grouping variables

rings_to_add_klweg

We add then these new rows, paying attention to change bird_date_end of previous rings:

crbirding_birds <-
  crbirding_birds %>%
  bind_rows(rings_to_add_klweg) %>%
  arrange(
    sovon_bird_reference,
    sovon_bird_date_begin,
    sovon_bird_date_end
  ) %>%
  group_by(sovon_bird_reference, sovon_bird_date_end) %>%
  mutate(sovon_bird_date_end_updated = case_when(
    sovon_bird_date_begin == min(sovon_bird_date_begin) &
      sovon_bird_date_begin != max(sovon_bird_date_begin)
    ~ max(sovon_bird_date_begin),
    TRUE ~ sovon_bird_date_end
  )) %>%
  ungroup() %>%
  mutate(sovon_bird_date_end = sovon_bird_date_end_updated) %>%
  select(-sovon_bird_date_end_updated)

## group_by: 2 grouping variables (sovon_bird_reference, sovon_bird_date_end)

## mutate (grouped): new variable 'sovon_bird_date_end_updated' (double) with 781 unique values and 84% NA

## ungroup: no grouping variables

## mutate: changed 56 values (<1%) of 'sovon_bird_date_end' (46 fewer NA)

## select: dropped one variable (sovon_bird_date_end_updated)

Show changes:

crbirding_birds %>%
  filter(sovon_bird_reference %in%
    rings_to_add_klweg$sovon_bird_reference) %>%
  select(
    sovon_bird_reference,
    sovon_bird_shorthand,
    sovon_bird_date_begin,
    sovon_bird_date_end,
    sovon_bird_rings_changed,
    metal_ring_missing,
    everything()
  )

## filter: removed 12,292 rows (99%), 134 rows remaining

## select: columns reordered (sovon_bird_reference, sovon_bird_shorthand, sovon_bird_date_begin, sovon_bird_date_end, sovon_bird_rings_changed, …)

5.2.11 Add rows for found color or metal rings: `klgev`, `megev`

We have observations linked to actions klgev and megev. These actions mean that a color/metal ring has been found. This means the bird is not wearing it anymore: we proceed as in previous section by adding a new row in crbirding_birds.

Number of observations with action klgev:

obs_and_acts %>%
  filter(klgev == "klgev") %>%
  nrow()

## filter: removed 150,805 rows (>99%), 38 rows remaining

## [1] 38

Type of action combinations where klgev occurs:

obs_and_acts %>%
  filter(klgev == "klgev") %>%
  select(acts) %>%
  distinct() %>%
  select_if(~ sum(!is.na(.)) > 0)

## filter: removed 150,805 rows (>99%), 38 rows remaining

## select: dropped 29 variables (sovon_bird_reference, Nummer, Datum, EuringCode, LeeftijdCode, …)

## distinct: removed 37 rows (97%), one row remaining

## select_if: dropped 11 variables (rngkl, rngme, br, vang, dood, …)

Number of observations with action megev:

if ("megev" %in% acts) {
  obs_and_acts %>%
    filter(megev == "megev") %>%
    nrow()
} else {
  message("0")
}

## 0

Type of action combinations where megev occurs:

if ("megev" %in% acts) {
  obs_and_acts %>%
    filter(megev == "megev") %>%
    select(acts) %>%
    distinct() %>%
    select_if(~ sum(!is.na(.)) > 0)
} else {
  message("'megev' is not present.")
}

## 'megev' is not present.

Are there observations of birds linked to both actions klgev and megev?

bird_ref_klgev <-
  (obs_and_acts %>%
    filter(klgev == "klgev") %>%
    pull(sovon_bird_reference))

## filter: removed 150,805 rows (>99%), 38 rows remaining

if ("megev" %in% acts) {
  bird_ref_megev <-
    obs_and_acts %>%
    filter(megev == "megev") %>%
    pull(sovon_bird_reference)
  bird_ref_meweg[which(bird_ref_megev %in% bird_ref_klgev)]
} else {
  message("'megev' is not present.")
}

## 'megev' is not present.

Are there observations of birds linked to action klgev and klweg?

bird_ref_klgev[which(bird_ref_klgev %in% bird_ref_klweg)]

## integer(0)

Are there observations of birds linked to action klgev and meweg?

bird_ref_klgev[which(bird_ref_klgev %in% bird_ref_meweg)]

## integer(0)

Are there more than one megev for bird?

if ("megev" %in% acts) {
  bird_ref_multiple_megev <-
    obs_and_acts %>%
    filter(megev == "megev") %>%
    group_by(sovon_bird_reference) %>%
    add_tally() %>%
    ungroup() %>%
    filter(n > 1)
  bird_ref_multiple_megev
} else {
  message("'megev' is not present.")
}

## 'megev' is not present.

Are there more than one klgev for bird?

bird_ref_multiple_klgev <-
  obs_and_acts %>%
  filter(klgev == "klgev") %>%
  group_by(sovon_bird_reference) %>%
  add_tally() %>%
  ungroup() %>%
  filter(n > 1)

## filter: removed 150,805 rows (>99%), 38 rows remaining

## group_by: one grouping variable (sovon_bird_reference)

## add_tally (grouped): new variable 'n' (integer) with one unique value and 0% NA

## ungroup: no grouping variables

## filter: removed all rows (100%)

bird_ref_multiple_klgev

We add new rows to crbirding_birds as the ring situation changed at each of these observations/actions.

We create first new rows based on action megev. We set sovon_bird_rings_changed = 0 and metal_ring_missing = TRUE:

if ("megev" %in% acts) {
  rings_to_add_megev <-
    obs_and_acts %>%
    filter(megev == "megev") %>%
    select(sovon_bird_reference, Datum) %>%
    left_join(crbirding_birds, by = "sovon_bird_reference") %>%
    group_by(sovon_bird_reference) %>%
    filter(sovon_bird_date_begin < Datum) %>%
    filter(sovon_bird_date_begin == max(sovon_bird_date_begin)) %>%
    mutate(sovon_bird_date_begin = Datum) %>%
    select(-Datum) %>%
    mutate(
      sovon_bird_rings_changed = 0,
      metal_ring_missing = TRUE
    ) %>%
    ungroup() %>%
    arrange(sovon_bird_reference)
  rings_to_add_megev
} else {
  message("'megev' is not present.")
}

## 'megev' is not present.

We add them, paying attention to change bird_date_end of previous rings:

if ("megev" %in% acts) {
  crbirding_birds <-
    crbirding_birds %>%
    bind_rows(rings_to_add_megev) %>%
    arrange(
      sovon_bird_reference,
      sovon_bird_date_begin,
      sovon_bird_date_end
    ) %>%
    group_by(sovon_bird_reference, sovon_bird_date_end) %>%
    mutate(sovon_bird_date_end_updated = case_when(
      sovon_bird_date_begin == min(sovon_bird_date_begin) &
        sovon_bird_date_begin != max(sovon_bird_date_begin) ~
      max(sovon_bird_date_begin),
      TRUE ~ sovon_bird_date_end
    )) %>%
    ungroup() %>%
    mutate(sovon_bird_date_end = sovon_bird_date_end_updated) %>%
    select(-sovon_bird_date_end_updated)
} else {
  message("'megev' is not present.")
}

## 'megev' is not present.

Show changes:

if ("megev" %in% acts) {
  crbirding_birds %>%
    filter(sovon_bird_reference %in%
      rings_to_add_megev$sovon_bird_reference) %>%
    select(
      sovon_bird_reference,
      sovon_bird_shorthand,
      metal_ring_missing,
      sovon_bird_date_begin,
      sovon_bird_date_end,
      everything()
    )
} else {
  message("'megev' is not present.")
}

## 'megev' is not present.

We create now new rows based on action klgev. We set sovon_bird_rings_changed = 1, metal_ring_missing = FALSE and we leave bird_shorthand empty:

rings_to_add_klgev <-
  obs_and_acts %>%
  filter(klgev == "klgev") %>%
  select(sovon_bird_reference, Datum) %>%
  left_join(crbirding_birds, by = "sovon_bird_reference") %>%
  group_by(sovon_bird_reference) %>%
  filter(sovon_bird_date_begin < Datum) %>%
  filter(sovon_bird_date_begin == max(sovon_bird_date_begin)) %>%
  mutate(
    sovon_bird_date_begin = Datum,
    sovon_bird_date_end = case_when(
      sovon_bird_date_end == sovon_bird_date_begin ~ as.POSIXct.Date(NA),
      TRUE ~ sovon_bird_date_end
    )
  ) %>%
  select(-Datum) %>%
  mutate(
    sovon_bird_rings_changed = 1,
    metal_ring_missing = FALSE,
    sovon_bird_shorthand = NA_character_,
    sovon_bird_shorthand_pt = NA_character_
  ) %>%
  ungroup() %>%
  arrange(sovon_bird_reference)

## filter: removed 150,805 rows (>99%), 38 rows remaining

## select: dropped 39 variables (Nummer, EuringCode, LeeftijdCode, KleurringNummer, KleurringPlaats, …)

## left_join: added 7 columns (sovon_bird_shorthand, sovon_bird_shorthand_pt, sovon_bird_date_begin, sovon_bird_date_end, sovon_bird_notes, …)

##            > rows only in x        0

##            > rows only in y  (12,384)

##            > matched rows         42    (includes duplicates)

##            >                 ========

##            > rows total           42

## group_by: one grouping variable (sovon_bird_reference)

## filter (grouped): removed 2 rows (5%), 40 rows remaining

## filter (grouped): removed 2 rows (5%), 38 rows remaining

## mutate (grouped): changed 38 values (100%) of 'sovon_bird_date_begin' (0 new NA)

##                   changed 0 values (0%) of 'sovon_bird_date_end' (0 new NA)

## select: dropped one variable (Datum)

## mutate (grouped): changed 38 values (100%) of 'sovon_bird_shorthand' (38 new NA)

##                   changed 38 values (100%) of 'sovon_bird_shorthand_pt' (38 new NA)

##                   changed 36 values (95%) of 'sovon_bird_rings_changed' (0 new NA)

## ungroup: no grouping variables

rings_to_add_klgev

We add then these new rows, paying attention to change bird_date_end of previous rings:

crbirding_birds <-
  crbirding_birds %>%
  bind_rows(rings_to_add_klgev) %>%
  arrange(
    sovon_bird_reference,
    sovon_bird_date_begin,
    sovon_bird_date_end
  ) %>%
  group_by(sovon_bird_reference, sovon_bird_date_end) %>%
  mutate(sovon_bird_date_end_updated = case_when(
    sovon_bird_date_begin == min(sovon_bird_date_begin) &
      sovon_bird_date_begin != max(sovon_bird_date_begin)
    ~ max(sovon_bird_date_begin),
    TRUE ~ sovon_bird_date_end
  )) %>%
  ungroup() %>%
  mutate(sovon_bird_date_end = sovon_bird_date_end_updated) %>%
  select(-sovon_bird_date_end_updated)

## group_by: 2 grouping variables (sovon_bird_reference, sovon_bird_date_end)

## mutate (grouped): new variable 'sovon_bird_date_end_updated' (double) with 795 unique values and 84% NA

## ungroup: no grouping variables

## mutate: changed 38 values (<1%) of 'sovon_bird_date_end' (36 fewer NA)

## select: dropped one variable (sovon_bird_date_end_updated)

Show changes:

crbirding_birds %>%
  filter(sovon_bird_reference %in%
    rings_to_add_klgev$sovon_bird_reference) %>%
  select(
    sovon_bird_reference,
    sovon_bird_shorthand,
    sovon_bird_date_begin,
    sovon_bird_date_end,
    sovon_bird_rings_changed,
    metal_ring_missing,
    everything()
  )

## filter: removed 12,384 rows (99%), 80 rows remaining

## select: columns reordered (sovon_bird_reference, sovon_bird_shorthand, sovon_bird_date_begin, sovon_bird_date_end, sovon_bird_rings_changed, …)

5.2.12 Finalize `sovon_bird_rings_changed`

There are still rings where sovon_bird_rings_changed is empty:

crbirding_birds %>%
  filter(is.na(sovon_bird_rings_changed))

## filter: removed 12,264 rows (98%), 200 rows remaining

Show more details, in particular the actions of observations related to the birds the rings come from and at the same date as sovon_bird_date_begin:

crbirding_birds %>%
  filter(is.na(sovon_bird_rings_changed)) %>%
  select(sovon_bird_reference, sovon_bird_date_begin) %>%
  left_join(obs_and_acts %>%
    select(Nummer, sovon_bird_reference, Datum, acts),
  by = c("sovon_bird_reference",
    "sovon_bird_date_begin" = "Datum"
  )
  ) %>%
  select_if(function(x) any(!is.na(x)))

## filter: removed 12,264 rows (98%), 200 rows remaining

## select: dropped 6 variables (sovon_bird_shorthand, sovon_bird_shorthand_pt, sovon_bird_date_end, sovon_bird_notes, sovon_bird_rings_changed, …)

## select: dropped 26 variables (EuringCode, LeeftijdCode, KleurringNummer, KleurringPlaats, MetaalringNummer_obs, …)

## left_join: added 13 columns (Nummer, rngkl, rngme, klgev, br, …)

##            > rows only in x         0

##            > rows only in y  (150,640)

##            > matched rows         203    (includes duplicates)

##            >                 =========

##            > rows total           203

## select_if: dropped 6 variables (rngkl, rngme, klgev, br, dood, …)

As expected most of them are vang only actions linked to applying new color rings.

The veld actions only are just field observations occurring the very same date of vang action and will be never used for mapping.

There are some ziek only actions:

crbirding_birds %>%
  filter(is.na(sovon_bird_rings_changed)) %>%
  select(sovon_bird_reference, sovon_bird_shorthand, sovon_bird_date_begin) %>%
  left_join(obs_and_acts %>%
    select(Nummer, sovon_bird_reference, Datum, acts, Opmerking),
  by = c("sovon_bird_reference",
    "sovon_bird_date_begin" = "Datum"
  )
  ) %>%
  filter(ziek == "ziek" & is.na(vangl)) %>%
  select_if(function(x) any(!is.na(x)))

## filter: removed 12,264 rows (98%), 200 rows remaining

## select: dropped 5 variables (sovon_bird_shorthand_pt, sovon_bird_date_end, sovon_bird_notes, sovon_bird_rings_changed, metal_ring_missing)

## select: dropped 25 variables (EuringCode, LeeftijdCode, KleurringNummer, KleurringPlaats, MetaalringNummer_obs, …)

## left_join: added 14 columns (Nummer, rngkl, rngme, klgev, br, …)

##            > rows only in x         0

##            > rows only in y  (150,640)

##            > matched rows         203    (includes duplicates)

##            >                 =========

##            > rows total           203

## filter: removed 199 rows (98%), 4 rows remaining

## select_if: dropped 10 variables (rngkl, rngme, klgev, br, vang, …)

These three rings have been added before as particular cases of ringing while being sick. Based on notes and previous observations, we can see that FAAG has been applied together with a new metal ring, i.e. sovon_bird_rings_changed = 2, while the other two don’t mention any change of metal ring: sovon_bird_rings_changed = 1:

crbirding_birds <-
  crbirding_birds %>%
  mutate(sovon_bird_rings_changed = case_when(
    sovon_bird_shorthand == "FAAG" ~ 2,
    sovon_bird_shorthand %in% c("YCAF", "FHOV") ~ 1,
    TRUE ~ sovon_bird_rings_changed
  ))

## mutate: changed 3 values (<1%) of 'sovon_bird_rings_changed' (3 fewer NA)

The combination of vang + klweg doesn’t change anything in the mapping, as noticing the absence of color ring happens at the same time of applying a new one. We can assess whether the metal ring is still present by checking the value of metal_ring_missing for the very previous ring. We make now two important assumptions:

the ringer applies always a new metal ring if missing
the ringer doesn’t change a metal ring if present

So, vang after a meweg or vang together with meweg are interpreted as applying a new metal ring, therefore sovon_bird_rings_changed = 2. Again, this is a consequence of the fact that the change of a metal ring is not coded by any action, but only described in informative notes.

Effects of this mapping:

rings_without_sovon_bird_rings_changed <-
  crbirding_birds %>%
  filter(is.na(sovon_bird_rings_changed)) %>%
  select(sovon_bird_reference, sovon_bird_date_begin) %>%
  rename(date_ringing = sovon_bird_date_begin) %>%
  left_join(crbirding_birds, by = "sovon_bird_reference") %>%
  group_by(sovon_bird_reference) %>%
  filter(sovon_bird_date_begin < date_ringing) %>%
  filter(sovon_bird_date_begin == max(sovon_bird_date_begin)) %>%
  mutate(
    sovon_bird_rings_changed = case_when(
      is.na(sovon_bird_shorthand) ~ 1,
      !is.na(sovon_bird_shorthand) & isTRUE(metal_ring_missing) ~ 2,
      !is.na(sovon_bird_shorthand) & isFALSE(metal_ring_missing) ~ 1
    ),
    metal_ring_missing = FALSE
  ) %>%
  ungroup() %>%
  select(
    sovon_bird_reference,
    sovon_bird_rings_changed,
    date_ringing,
    metal_ring_missing
  ) %>%
  rename(sovon_bird_date_begin = date_ringing) %>%
  left_join(crbirding_birds %>%
    select(-c(
      sovon_bird_rings_changed,
      metal_ring_missing
    )),
  by = c(
    "sovon_bird_reference",
    "sovon_bird_date_begin"
  )
  ) %>%
  select(names(crbirding_birds)) %>%
  left_join(obs_and_acts %>%
    filter((vang == "vang" | vangl == "vangl") & meweg == "meweg") %>%
    select(sovon_bird_reference, Datum, meweg),
  by = c("sovon_bird_reference",
    "sovon_bird_date_begin" = "Datum"
  )
  ) %>%
  mutate(sovon_bird_rings_changed = case_when(
    sovon_bird_rings_changed == 1 & meweg == "meweg" ~ 2,
    TRUE ~ sovon_bird_rings_changed
  )) %>%
  select(names(crbirding_birds))

## filter: removed 12,267 rows (98%), 197 rows remaining

## select: dropped 6 variables (sovon_bird_shorthand, sovon_bird_shorthand_pt, sovon_bird_date_end, sovon_bird_notes, sovon_bird_rings_changed, …)

## rename: renamed one variable (date_ringing)

## left_join: added 7 columns (sovon_bird_shorthand, sovon_bird_shorthand_pt, sovon_bird_date_begin, sovon_bird_date_end, sovon_bird_notes, …)

##            > rows only in x        0

##            > rows only in y  (12,051)

##            > matched rows        428    (includes duplicates)

##            >                 ========

##            > rows total          428

## group_by: one grouping variable (sovon_bird_reference)

## filter (grouped): removed 205 rows (48%), 223 rows remaining

## filter (grouped): removed 31 rows (14%), 192 rows remaining

## mutate (grouped): changed 183 values (95%) of 'sovon_bird_rings_changed' (5 fewer NA)

##                   changed 3 values (2%) of 'metal_ring_missing' (0 new NA)

## ungroup: no grouping variables

## select: dropped 5 variables (sovon_bird_shorthand, sovon_bird_shorthand_pt, sovon_bird_date_begin, sovon_bird_date_end, sovon_bird_notes)

## rename: renamed one variable (sovon_bird_date_begin)

## select: dropped 2 variables (sovon_bird_rings_changed, metal_ring_missing)

## left_join: added 4 columns (sovon_bird_shorthand, sovon_bird_shorthand_pt, sovon_bird_date_end, sovon_bird_notes)

##            > rows only in x        0

##            > rows only in y  (12,271)

##            > matched rows        193    (includes duplicates)

##            >                 ========

##            > rows total          193

## select: columns reordered (sovon_bird_reference, sovon_bird_shorthand, sovon_bird_shorthand_pt, sovon_bird_date_begin, sovon_bird_date_end, …)

## filter: removed 150,842 rows (>99%), one row remaining

## select: dropped 38 variables (Nummer, EuringCode, LeeftijdCode, KleurringNummer, KleurringPlaats, …)

## left_join: added one column (meweg)

##            > rows only in x   192

##            > rows only in y  (  0)

##            > matched rows       1

##            >                 =====

##            > rows total       193

## mutate: changed one value (1%) of 'sovon_bird_rings_changed' (0 new NA)

## select: dropped one variable (meweg)

rings_without_sovon_bird_rings_changed

Update crbirding_birds based on the mapping above:

crbirding_birds <-
  crbirding_birds %>%
  anti_join(rings_without_sovon_bird_rings_changed,
    by = c(
      "sovon_bird_reference",
      "sovon_bird_shorthand",
      "sovon_bird_shorthand_pt",
      "sovon_bird_date_begin",
      "sovon_bird_date_end"
    )
  ) %>%
  bind_rows(rings_without_sovon_bird_rings_changed) %>%
  arrange(sovon_bird_reference, sovon_bird_date_begin)

## anti_join: added no columns

##            > rows only in x   12,271

##            > rows only in y  (     0)

##            > matched rows    (   193)

##            >                 ========

##            > rows total       12,271

Rings still without sovon_bird_rings_changed:

crbirding_birds %>%
  filter(is.na(sovon_bird_rings_changed))

## filter: removed 12,459 rows (>99%), 5 rows remaining

These are intermediate rings of birds which got three color rings:

crbirding_birds %>%
  filter(sovon_bird_reference %in%
    (crbirding_birds %>%
      filter(is.na(sovon_bird_rings_changed)) %>%
      pull(sovon_bird_reference)))

## filter: removed 12,459 rows (>99%), 5 rows remaining

## filter: removed 12,449 rows (>99%), 15 rows remaining

All of them will get sovon_bird_rings_changed = 1:

crbirding_birds <-
  crbirding_birds %>%
  mutate(sovon_bird_rings_changed = case_when(
    is.na(sovon_bird_rings_changed) ~ 1,
    TRUE ~ sovon_bird_rings_changed
  ))

## mutate: changed 5 values (<1%) of 'sovon_bird_rings_changed' (5 fewer NA)

Check that all rings have a valid value (0, 1 or 2) for sovon_bird_rings_changed:

crbirding_birds %>%
  filter(is.na(sovon_bird_rings_changed)) %>%
  nrow() == 0 &
  all(unique(crbirding_birds$sovon_bird_rings_changed) %in%
    c(0, 1, 2))

## filter: removed all rows (100%)

## [1] TRUE

We show a final overview.

Birds getting color and metal ring at the same time and never ringed twice (only the first thousand are shown as this category includes more than 10 thousands rings):

crbirding_birds %>%
  group_by(sovon_bird_reference) %>%
  add_tally() %>%
  ungroup() %>%
  filter(sovon_bird_rings_changed == 2) %>%
  filter(n == 1) %>%
  select(-n)

## group_by: one grouping variable (sovon_bird_reference)

## add_tally (grouped): new variable 'n' (integer) with 4 unique values and 0% NA

## ungroup: no grouping variables

## filter: removed 1,879 rows (15%), 10,585 rows remaining

## filter: removed 501 rows (5%), 10,084 rows remaining

## select: dropped one variable (n)

Birds ringed in two different moments (only the first thousand are shown as this category includes more than two thousands rings):

crbirding_birds %>%
  group_by(sovon_bird_reference) %>%
  add_tally() %>%
  ungroup() %>%
  filter(n == 2) %>%
  select(-n)

## group_by: one grouping variable (sovon_bird_reference)

## add_tally (grouped): new variable 'n' (integer) with 4 unique values and 0% NA

## ungroup: no grouping variables

## filter: removed 10,362 rows (83%), 2,102 rows remaining

## select: dropped one variable (n)

Birds ringed at three different moments:

crbirding_birds %>%
  group_by(sovon_bird_reference) %>%
  add_tally() %>%
  ungroup() %>%
  filter(n == 3) %>%
  select(-n)

## group_by: one grouping variable (sovon_bird_reference)

## add_tally (grouped): new variable 'n' (integer) with 4 unique values and 0% NA

## ungroup: no grouping variables

## filter: removed 12,230 rows (98%), 234 rows remaining

## select: dropped one variable (n)

Birds ringed at four different moments:

crbirding_birds %>%
  group_by(sovon_bird_reference) %>%
  add_tally() %>%
  filter(n == 4) %>%
  select(-n)

## group_by: one grouping variable (sovon_bird_reference)

## add_tally (grouped): new variable 'n' (integer) with 4 unique values and 0% NA

## filter (grouped): removed 12,420 rows (>99%), 44 rows remaining

## select: dropped one variable (n)

At Sept, 25 no birds are ringed more than four times:

crbirding_birds %>%
  group_by(sovon_bird_reference) %>%
  add_tally() %>%
  filter(n >= 5) %>%
  select(-n)

## group_by: one grouping variable (sovon_bird_reference)

## add_tally (grouped): new variable 'n' (integer) with 4 unique values and 0% NA

## filter (grouped): removed all rows (100%)

## select: dropped one variable (n)

5.2.13 Map color of rings and inscriptions

The color of the ring should be added, if available, to bird_shorthand. It’s important to highlight the fact that we have this information only for the most recent color ring of each bird. Following combinations are present, although the color of the inscription InscriptieKleurCode will be not mapped:

birds %>%
  group_by(RingKleurCode, InscriptieKleurCode) %>%
  count()

## group_by: 2 grouping variables (RingKleurCode, InscriptieKleurCode)

## count: now 5 rows and 3 columns, 2 group variables remaining (RingKleurCode, InscriptieKleurCode)

We first map the colors based on the official cr-birding values ( cr-birding.org):

color_table <-
  color_table %>%
  mutate(crbirding_color = case_when(
    Code == "X" ~ "P",
    Code == "Z" ~ "N",
    TRUE ~ Code
  ))

## mutate: new variable 'crbirding_color' (character) with 8 unique values and 0% NA

color_table

We map the colors in birds:

birds <-
  birds %>%
  left_join(color_table %>%
    select(Code, crbirding_color),
  by = c("RingKleurCode" = "Code")
  ) %>%
  rename(ring_color = crbirding_color) %>%
  left_join(color_table %>%
    select(Code, crbirding_color),
  by = c("InscriptieKleurCode" = "Code")
  ) %>%
  rename(inscription_color = crbirding_color)

## select: dropped 3 variables (Beschrijving, BeschrijvingUK, Aktief)

## left_join: added one column (crbirding_color)

##            > rows only in x       88

##            > rows only in y  (     4)

##            > matched rows     11,136

##            >                 ========

##            > rows total       11,224

## rename: renamed one variable (ring_color)

## select: dropped 3 variables (Beschrijving, BeschrijvingUK, Aktief)

## left_join: added one column (crbirding_color)

##            > rows only in x       88

##            > rows only in y  (     5)

##            > matched rows     11,136

##            >                 ========

##            > rows total       11,224

## rename: renamed one variable (inscription_color)

Effects of the mapping:

birds %>%
  distinct(ring_color, RingKleurCode, inscription_color, InscriptieKleurCode)

## distinct: removed 11,219 rows (>99%), 5 rows remaining

The bird_shorthand should be composed of: 1. color of the ring 3. inscription

For example, B-BBAP is a dark blue ring (see issue #67).

We add ring color to bird_shorthand:

crbirding_birds <-
  crbirding_birds %>%
  left_join(birds %>%
              select(sovon_bird_reference, ring_color),
            by = "sovon_bird_reference") %>%
  group_by(sovon_bird_reference) %>%
  filter(!is.na(sovon_bird_shorthand)) %>%
  mutate(ring_color = if_else(
    sovon_bird_date_begin == max(sovon_bird_date_begin),
    ring_color,
    NA_character_
  )) %>%
  bind_rows(crbirding_birds %>%
              filter(is.na(sovon_bird_shorthand))) %>%
  arrange(sovon_bird_reference, sovon_bird_date_begin) %>%
  mutate(
    sovon_bird_shorthand_color = case_when(
      !is.na(sovon_bird_shorthand) &
        !is.na(ring_color) ~ paste0(
          ring_color,
          "-",
          sovon_bird_shorthand
        ),
      TRUE ~ sovon_bird_shorthand
    ),
    sovon_bird_shorthand_pt_color = case_when(
      !is.na(sovon_bird_shorthand_pt) &
        !is.na(ring_color) ~ paste0(
          ring_color,
          "-",
          sovon_bird_shorthand_pt
        ),
      TRUE ~ sovon_bird_shorthand_pt
    )
  ) %>%
  ungroup()

## select: dropped 16 variables (first_Nummer, NummerNieuw, NummerDesc, Nummer, Plaats, …)

## left_join: added one column (ring_color)

##            > rows only in x        0

##            > rows only in y  (     0)

##            > matched rows     12,464

##            >                 ========

##            > rows total       12,464

## group_by: one grouping variable (sovon_bird_reference)

## filter (grouped): removed 762 rows (6%), 11,702 rows remaining

## mutate (grouped): changed 478 values (4%) of 'ring_color' (478 new NA)

## filter: removed 11,702 rows (94%), 762 rows remaining

## mutate (grouped): new variable 'sovon_bird_shorthand_color' (character) with 11,670 unique values and 6% NA

##                   new variable 'sovon_bird_shorthand_pt_color' (character) with 11,670 unique values and 6% NA

## ungroup: no grouping variables

As inscription color would be lost in cr-birding database, we add it as a note: inscription color: followed by the EURING Exchange Code 2000+ standard color code:

crbirding_birds <- 
  crbirding_birds %>%
  # filter(str_sub(sovon_bird_shorthand_color, start = 2, end = 2) == "-") %>%
  left_join(birds %>%
              select(sovon_bird_reference, inscription_color),
            by = "sovon_bird_reference") %>%
  mutate(sovon_bird_notes = if_else(
    str_sub(sovon_bird_shorthand_color, start = 2, end = 2) == "-",
    if_else(is.na(sovon_bird_notes),
            str_c("inscription color: ", inscription_color, "."),
            str_c(sovon_bird_notes,
                  str_c("inscription color: ", inscription_color, "."),
                  sep = " ")),
    sovon_bird_notes))

## select: dropped 16 variables (first_Nummer, NummerNieuw, NummerDesc, Nummer, Plaats, …)

## left_join: added one column (inscription_color)

##            > rows only in x        0

##            > rows only in y  (     0)

##            > matched rows     12,464

##            >                 ========

##            > rows total       12,464

## mutate: changed 11,803 values (95%) of 'sovon_bird_notes' (10329 fewer NA)

Some examples from birds ringed thrice or more:

crbirding_birds %>%
  group_by(sovon_bird_reference) %>%
  add_tally() %>%
  ungroup() %>%
  filter(n > 2) %>%
  select(
    sovon_bird_reference,
    ring_color,
    inscription_color,
    sovon_bird_shorthand_color,
    sovon_bird_shorthand_pt_color,
    sovon_bird_shorthand,
    sovon_bird_shorthand_pt,
    sovon_bird_notes,
    sovon_bird_date_begin,
    sovon_bird_date_end,
    everything()
  )

## group_by: one grouping variable (sovon_bird_reference)

## add_tally (grouped): new variable 'n' (integer) with 4 unique values and 0% NA

## ungroup: no grouping variables

## filter: removed 12,186 rows (98%), 278 rows remaining

## select: columns reordered (sovon_bird_reference, ring_color, inscription_color, sovon_bird_shorthand_color, sovon_bird_shorthand_pt_color, …)

Based on INBO experts knowledge, we can assign color of rings and inscriptions for a significant number of old, changed rings as well. All rings with a 4-letter long inscription where the third letter is an A are blue rings with white inscription (see https://github.com/inbo/cr-birding/issues/84#issuecomment-478938321).

Rings still not mapped satisfying this condition:

old_rings_with_A <-
  crbirding_birds %>%
  filter(
    !str_detect(sovon_bird_shorthand_color, "\\-") &
      str_detect(sovon_bird_shorthand, "[A-Z]") &
      str_length(sovon_bird_shorthand) == 4 &
      str_sub(sovon_bird_shorthand, 3, 3) == "A"
  )

## filter: removed 12,092 rows (97%), 372 rows remaining

old_rings_with_A

Assign colors:

old_rings_with_A <-
  old_rings_with_A %>%
  mutate(
    sovon_bird_shorthand_color = paste0("B-",
                                        sovon_bird_shorthand_color),
    sovon_bird_shorthand_pt_color = paste0("B-",
                                           sovon_bird_shorthand_pt_color),
    sovon_bird_notes = if_else(is.na(sovon_bird_notes),
                               "inscription color: W.",
                               str_c(sovon_bird_notes,
                                     "inscription color: W.",
                                     sep = " "))
    ) %>%
  select(
    sovon_bird_reference,
    ring_color,
    sovon_bird_shorthand_color,
    sovon_bird_shorthand_pt_color,
    sovon_bird_shorthand,
    sovon_bird_shorthand_pt,
    sovon_bird_notes,
    sovon_bird_date_begin,
    sovon_bird_date_end,
    everything()
  )

## mutate: changed 372 values (100%) of 'sovon_bird_notes' (302 fewer NA)

##         changed 372 values (100%) of 'sovon_bird_shorthand_color' (0 new NA)

##         changed 372 values (100%) of 'sovon_bird_shorthand_pt_color' (0 new NA)

## select: columns reordered (sovon_bird_reference, ring_color, sovon_bird_shorthand_color, sovon_bird_shorthand_pt_color, sovon_bird_shorthand, …)

old_rings_with_A

Apply changes to crbirding_birds:

crbirding_birds <-
  crbirding_birds %>%
  anti_join(old_rings_with_A,
    by = c(
      "sovon_bird_shorthand",
      "sovon_bird_date_begin",
      "sovon_bird_date_end"
    )
  ) %>% 
  bind_rows(old_rings_with_A) %>%
  select(names(crbirding_birds)) %>%
  arrange(sovon_bird_reference, sovon_bird_date_begin)

## anti_join: added no columns

##            > rows only in x   12,092

##            > rows only in y  (     0)

##            > matched rows    (   372)

##            >                 ========

##            > rows total       12,092

## select: no changes

Some examples from birds ringed thrice or more:

crbirding_birds %>%
  group_by(sovon_bird_reference) %>%
  add_tally() %>%
  ungroup() %>%
  filter(n > 2) %>%
  select(
    sovon_bird_reference,
    ring_color,
    sovon_bird_shorthand_color,
    sovon_bird_shorthand_pt_color,
    sovon_bird_shorthand,
    sovon_bird_shorthand_pt,
    sovon_bird_notes,
    sovon_bird_date_begin,
    sovon_bird_date_end,
    everything()
  )

## group_by: one grouping variable (sovon_bird_reference)

## add_tally (grouped): new variable 'n' (integer) with 4 unique values and 0% NA

## ungroup: no grouping variables

## filter: removed 12,186 rows (98%), 278 rows remaining

## select: columns reordered (sovon_bird_reference, ring_color, sovon_bird_shorthand_color, sovon_bird_shorthand_pt_color, sovon_bird_shorthand, …)

Rings still without color:

rings_color_still_unknown <-
  crbirding_birds %>%
  filter(!str_detect(sovon_bird_shorthand_color, "\\-"))

## filter: removed 12,270 rows (98%), 194 rows remaining

rings_color_still_unknown %>%
  select(
    sovon_bird_reference,
    ring_color,
    sovon_bird_shorthand_color,
    sovon_bird_shorthand_pt_color,
    sovon_bird_shorthand,
    sovon_bird_shorthand_pt,
    sovon_bird_date_begin,
    sovon_bird_date_end,
    everything()
  )

## select: columns reordered (sovon_bird_reference, ring_color, sovon_bird_shorthand_color, sovon_bird_shorthand_pt_color, sovon_bird_shorthand, …)

Some ring inscriptions contain a B at third position:

rings_color_still_unknown_with_B_third_pos <-
  rings_color_still_unknown %>%
  filter(str_sub(sovon_bird_shorthand, 3, 3) == "B")

## filter: removed 106 rows (55%), 88 rows remaining

rings_color_still_unknown_with_B_third_pos

INBO experts explained us that the rings containing a B at third position are virtual rings (see issue #81#issuecomment-478954317). It has been suggested to remove them and not exporting them (see issues #81#issuecomment-698964036). We remove them:

crbirding_birds <- 
  crbirding_birds %>%
  filter(!
    sovon_bird_reference %in% rings_color_still_unknown_with_B_third_pos$sovon_bird_reference
  )

## filter: removed 88 rows (1%), 12,376 rows remaining

And we remove related observations as well:

obs_and_acts <-
  obs_and_acts %>%
  filter(!
    sovon_bird_reference %in% rings_color_still_unknown_with_B_third_pos$sovon_bird_reference)

## filter: removed 181 rows (<1%), 150,662 rows remaining

The rings left are foreign rings.

rings_color_still_unknown_foreign <-
  crbirding_birds %>%
  filter(!str_detect(sovon_bird_shorthand_pt_color, "\\-"))

## filter: removed 12,270 rows (99%), 106 rows remaining

rings_color_still_unknown_foreign

We assign fictive color to them to ease the submission to cr-birding database. We assign them blue as ring color (see issue #84):

rings_color_still_unknown_foreign <-
  rings_color_still_unknown_foreign %>%
  mutate(
    sovon_bird_notes = ifelse(is.na(sovon_bird_notes),
      "foreign_color_ring.",
      str_c(sovon_bird_notes,
        "foreign_color_ring.",
        sep = " "
      )
    ),
    sovon_bird_shorthand_color = paste0(
      "B-",
      sovon_bird_shorthand_color
    ),
    sovon_bird_shorthand_pt_color = paste0(
      "B-",
      sovon_bird_shorthand_pt_color
    )
  )

## mutate: changed 106 values (100%) of 'sovon_bird_notes' (101 fewer NA)

##         changed 106 values (100%) of 'sovon_bird_shorthand_color' (0 new NA)

##         changed 106 values (100%) of 'sovon_bird_shorthand_pt_color' (0 new NA)

crbirding_birds <-
  crbirding_birds %>%
  anti_join(rings_color_still_unknown_foreign,
    by = c(
      "sovon_bird_reference",
      "sovon_bird_shorthand",
      "sovon_bird_shorthand_pt",
      "sovon_bird_date_begin",
      "sovon_bird_date_end"
    )
  ) %>%
  bind_rows(rings_color_still_unknown_foreign) %>%
  arrange(
    sovon_bird_reference,
    sovon_bird_date_begin
  )

## anti_join: added no columns

##            > rows only in x   12,270

##            > rows only in y  (     0)

##            > matched rows    (   106)

##            >                 ========

##            > rows total       12,270

After mapping:

crbirding_birds %>%
  filter(sovon_bird_reference %in%
    rings_color_still_unknown_foreign$sovon_bird_reference) %>%
  select(
    sovon_bird_reference,
    sovon_bird_shorthand,
    sovon_bird_shorthand_color,
    sovon_bird_shorthand_pt_color,
    sovon_bird_date_begin,
    sovon_bird_date_end,
    sovon_bird_notes,
    everything()
  )

## filter: removed 12,156 rows (98%), 220 rows remaining

## select: columns reordered (sovon_bird_reference, sovon_bird_shorthand, sovon_bird_shorthand_color, sovon_bird_shorthand_pt_color, sovon_bird_date_begin, …)

Did we assigned a color to all rings?

crbirding_birds %>%
  filter(is.na(sovon_bird_shorthand_color) |
           str_detect(sovon_bird_shorthand_pt_color, "\\-")) %>%
  nrow() == nrow(crbirding_birds)

## filter: no rows removed

## [1] TRUE

We will overwrite the columns sovon_bird_shorthand and sovon_bird_shorthand_pt and remove the help columns sovon_bird_shorthand_color, sovon_bird_shorthand_pt_color and ring_color at the end of the processing.

5.2.14 Position of the color ring and inscription orientation

SOVON allows us to add two columns called position_color_ring and direction_color_ring in order to save: 1. the position of the color ring, left or right leg 2. the direction of the color ring’s inscription, upwards or downwards

In case of birds with one color ring only, SOVON doesn’t save these fields. However, INBO experts find them important as

it can help a lot when identifying mistakes in reading.

For more details, see issue #61.

As for colors, these informations are only available for the very last ring of each bird.

Overview:

birds %>%
  group_by(Plaats) %>%
  count()

## group_by: one grouping variable (Plaats)

## count: now 7 rows and 2 columns, one group variable remaining (Plaats)

We map all values of ring position and inscription reading direction:

ring_position_table <-
  ring_position_table %>%
  mutate(
    sovon_bird_ring_position = case_when(
      str_sub(Code, start = 1, end = 1) == "L" ~ "LB",
      str_sub(Code, start = 1, end = 1) == "R" ~ "RB",
      TRUE ~ NA_character_
    ),
    sovon_bird_ring_direction = case_when(
      str_sub(Code, start = -1, end = -1) == "D" ~ "D",
      str_sub(Code, start = -1, end = -1) == "U" ~ "U",
      TRUE ~ NA_character_
    )
  ) %>%
  select(
    Code,
    sovon_bird_ring_position,
    sovon_bird_ring_direction,
    everything()
  )

## mutate: new variable 'sovon_bird_ring_position' (character) with 3 unique values and 25% NA

##         new variable 'sovon_bird_ring_direction' (character) with 3 unique values and 25% NA

## select: columns reordered (Code, sovon_bird_ring_position, sovon_bird_ring_direction, Beschrijving, BeschrijvingUK, …)

ring_position_table

where LB and RB stay for left tarsus and right tarsus respectively.

We map the ring position and direction of ring inscription in birds:

birds <-
  birds %>%
  left_join(ring_position_table %>%
    select(Code, sovon_bird_ring_position),
  by = c("Plaats" = "Code")
  ) %>%
  left_join(ring_position_table %>%
    select(Code, sovon_bird_ring_direction),
  by = c("Plaats" = "Code")
  )

## select: dropped 4 variables (sovon_bird_ring_direction, Beschrijving, BeschrijvingUK, Aktief)

## left_join: added one column (sovon_bird_ring_position)

##            > rows only in x      977

##            > rows only in y  (     2)

##            > matched rows     10,247

##            >                 ========

##            > rows total       11,224

## select: dropped 4 variables (sovon_bird_ring_position, Beschrijving, BeschrijvingUK, Aktief)

## left_join: added one column (sovon_bird_ring_direction)

##            > rows only in x      977

##            > rows only in y  (     2)

##            > matched rows     10,247

##            >                 ========

##            > rows total       11,224

Effects of the mapping:

birds %>%
  distinct(Plaats, sovon_bird_ring_position, sovon_bird_ring_direction)

## distinct: removed 11,217 rows (>99%), 7 rows remaining

Map these values from birds to crbirding_birds, taking into account that the fields sovon_bird_ring_position and sovon_bird_ring_direction are available only for the very last color ring of each bird:

crbirding_birds <-
  crbirding_birds %>%
  filter(!is.na(sovon_bird_shorthand)) %>%
  left_join(birds %>%
    select(
      sovon_bird_reference,
      sovon_bird_ring_position,
      sovon_bird_ring_direction
    ),
  by = "sovon_bird_reference"
  ) %>%
  group_by(sovon_bird_reference) %>%
  mutate(
    sovon_bird_ring_position = if_else(
      sovon_bird_date_begin == max(sovon_bird_date_begin),
      sovon_bird_ring_position,
      NA_character_
    ),
    sovon_bird_ring_direction = if_else(
      sovon_bird_date_begin == max(sovon_bird_date_begin),
      sovon_bird_ring_direction,
      NA_character_
    )
  ) %>%
  ungroup() %>%
  bind_rows(crbirding_birds %>%
    filter(is.na(sovon_bird_shorthand))) %>%
  arrange(sovon_bird_reference, sovon_bird_date_begin)

## filter: removed 762 rows (6%), 11,614 rows remaining

## select: dropped 17 variables (first_Nummer, NummerNieuw, NummerDesc, Nummer, Plaats, …)

## left_join: added 2 columns (sovon_bird_ring_position, sovon_bird_ring_direction)

##            > rows only in x        0

##            > rows only in y  (    88)

##            > matched rows     11,614

##            >                 ========

##            > rows total       11,614

## group_by: one grouping variable (sovon_bird_reference)

## mutate (grouped): changed 469 values (4%) of 'sovon_bird_ring_position' (469 new NA)

##                   changed 446 values (4%) of 'sovon_bird_ring_direction' (446 new NA)

## ungroup: no grouping variables

## filter: removed 11,614 rows (94%), 762 rows remaining

Some examples from birds ringed more than twice:

crbirding_birds %>%
  group_by(sovon_bird_reference) %>%
  add_tally() %>%
  filter(n > 2) %>%
  select(
    sovon_bird_reference,
    sovon_bird_ring_position,
    sovon_bird_ring_direction,
    sovon_bird_shorthand,
    sovon_bird_date_begin,
    sovon_bird_date_end,
    everything()
  ) %>%
  head(n = 100)

## group_by: one grouping variable (sovon_bird_reference)

## add_tally (grouped): new variable 'n' (integer) with 4 unique values and 0% NA

## filter (grouped): removed 12,098 rows (98%), 278 rows remaining

## select: columns reordered (sovon_bird_reference, sovon_bird_ring_position, sovon_bird_ring_direction, sovon_bird_shorthand, sovon_bird_date_begin, …)

5.2.15 Mapping of `sovon_bird_ring_number`

We can now use metal_ring_missing in order to add the metal ring number as sovon_bird_ring_number. Still, note that only the very last metal ring number is saved in our color-oriented database. We will use it in place of older metal rings. Experts could improve it in crbirding database later.

crbirding_birds <-
  crbirding_birds %>%
  left_join(birds %>%
    select(sovon_bird_reference, sovon_bird_ring_number) %>%
    rename(metal_ring_number = sovon_bird_ring_number),
  by = c("sovon_bird_reference")
  ) %>%
  group_by(sovon_bird_reference) %>%
  mutate(sovon_bird_ring_number = case_when(
    metal_ring_missing == FALSE ~ metal_ring_number,
    metal_ring_missing == TRUE ~ NA_character_
  )) %>%
  select(-metal_ring_number) %>%
  ungroup()

## select: dropped 18 variables (first_Nummer, NummerNieuw, NummerDesc, Nummer, Plaats, …)

## rename: renamed one variable (metal_ring_number)

## left_join: added one column (metal_ring_number)

##            > rows only in x        0

##            > rows only in y  (    88)

##            > matched rows     12,376

##            >                 ========

##            > rows total       12,376

## group_by: one grouping variable (sovon_bird_reference)

## mutate (grouped): new variable 'sovon_bird_ring_number' (character) with 11,061 unique values and 3% NA

## select: dropped one variable (metal_ring_number)

## ungroup: no grouping variables

Show an example by selecting birds wich lost their own metal rings:

crbirding_birds %>%
  filter(metal_ring_missing == TRUE) %>%
  select(sovon_bird_reference) %>%
  left_join(crbirding_birds, by = "sovon_bird_reference") %>%
  select(
    sovon_bird_reference,
    sovon_bird_date_begin,
    sovon_bird_date_end,
    sovon_bird_ring_number,
    metal_ring_missing,
    sovon_bird_rings_changed,
    everything()
  )

## filter: removed 12,153 rows (98%), 223 rows remaining

## select: dropped 14 variables (sovon_bird_shorthand, sovon_bird_shorthand_pt, sovon_bird_date_begin, sovon_bird_date_end, sovon_bird_notes, …)

## left_join: added 14 columns (sovon_bird_shorthand, sovon_bird_shorthand_pt, sovon_bird_date_begin, sovon_bird_date_end, sovon_bird_notes, …)

##            > rows only in x        0

##            > rows only in y  (11,879)

##            > matched rows        497    (includes duplicates)

##            >                 ========

##            > rows total          497

## select: columns reordered (sovon_bird_reference, sovon_bird_date_begin, sovon_bird_date_end, sovon_bird_ring_number, metal_ring_missing, …)

Add note about absence of metal ring based on original values in column MetaaalringNummer and the fields sovon_bird_reference, sovon_bird_ring_number:

crbirding_birds <-
  crbirding_birds %>%
  left_join(birds %>%
    select(
      sovon_bird_reference,
      MetaalringNummer
    ),
  by = c("sovon_bird_reference")
  ) %>%
  mutate(sovon_bird_notes = case_when(
    is.na(sovon_bird_ring_number) &
      metal_ring_missing == FALSE &
      (MetaalringNummer %in% c("?", "onbekend") |
        is.na(MetaalringNummer)) ~
    ifelse(is.na(sovon_bird_notes),
      "bird_ring_number not available.",
      str_c(sovon_bird_notes, "bird_ring_number not available.", sep = " ")
    ),
    is.na(sovon_bird_ring_number) &
      metal_ring_missing == FALSE &
      MetaalringNummer == "none" ~
    ifelse(is.na(sovon_bird_notes),
      "bird_ring_number not present.",
      str_c(sovon_bird_notes, "bird_ring_number not present.", sep = " ")
    ),
    TRUE ~ sovon_bird_notes
  )) %>%
  select(-MetaalringNummer)

## select: dropped 18 variables (first_Nummer, NummerNieuw, NummerDesc, Nummer, Plaats, …)

## left_join: added one column (MetaalringNummer)

##            > rows only in x        0

##            > rows only in y  (    88)

##            > matched rows     12,376

##            >                 ========

##            > rows total       12,376

## mutate: changed 51 values (<1%) of 'sovon_bird_notes' (0 new NA)

## select: dropped one variable (MetaalringNummer)

Notice that in these cases the ring number is unknown although we are sure it exists. We left sovon_bird_ring_number empty as suggested by SOVON experts (see comment on issue #100) without modifying the value of bird_rings_changed.

This is how sovon_bird_notes has been updated, limited to birds where changes could happen:

crbirding_birds %>%
  filter(is.na(sovon_bird_ring_number)) %>%
  filter(metal_ring_missing == FALSE) %>%
  select(sovon_bird_reference) %>%
  left_join(crbirding_birds,
    by = "sovon_bird_reference"
  ) %>%
  select(-sovon_bird_shorthand) %>%
  arrange(sovon_bird_reference, sovon_bird_date_begin)

## filter: removed 12,057 rows (97%), 319 rows remaining

## filter: removed 223 rows (70%), 96 rows remaining

## select: dropped 14 variables (sovon_bird_shorthand, sovon_bird_shorthand_pt, sovon_bird_date_begin, sovon_bird_date_end, sovon_bird_notes, …)

## left_join: added 14 columns (sovon_bird_shorthand, sovon_bird_shorthand_pt, sovon_bird_date_begin, sovon_bird_date_end, sovon_bird_notes, …)

##            > rows only in x        0

##            > rows only in y  (12,276)

##            > matched rows        148    (includes duplicates)

##            >                 ========

##            > rows total          148

## select: dropped one variable (sovon_bird_shorthand)

5.2.16 Euring

Present values:

birds %>% distinct(EuringCode)

## distinct: removed 11,213 rows (>99%), 11 rows remaining

We assign the euring codes by applying the following mapping:

crbirding_birds <-
  crbirding_birds %>%
  left_join(birds %>%
    distinct(sovon_bird_reference, EuringCode),
  by = "sovon_bird_reference"
  ) %>%
  mutate(sovon_bird_euring = recode(EuringCode,
    "5920" = "05920",
    "5910" = "05910",
    "5926" = "05926",
    "5922" = "06009", # 5922 used for hybrid gulls
    "05922" = "06009", # 05922 used for hybrid gulls
    "zz" = "04560", # pied avocets
    "zzz" = "00720" # great cormorants
  )) %>%
  ungroup()

## distinct: no rows removed

## left_join: added one column (EuringCode)

##            > rows only in x        0

##            > rows only in y  (    88)

##            > matched rows     12,376

##            >                 ========

##            > rows total       12,376

## mutate: new variable 'sovon_bird_euring' (character) with 6 unique values and 0% NA

## ungroup: no grouping variables

Effects of mapping:

crbirding_birds %>%
  distinct(EuringCode, sovon_bird_euring)

## distinct: removed 12,365 rows (>99%), 11 rows remaining

We remove the help column EuringCode from crbirding_birds:

crbirding_birds <-
  crbirding_birds %>%
  select(-EuringCode)

## select: dropped one variable (EuringCode)

5.2.17 Scheme

Actual values:

birds %>% distinct(MetaalringLandCode)

## distinct: removed 11,218 rows (>99%), 6 rows remaining

We apply the following mapping:

crbirding_birds <-
  crbirding_birds %>%
  left_join(birds %>%
    select(sovon_bird_reference, MetaalringLandCode),
  by = "sovon_bird_reference"
  ) %>%
  mutate(sovon_bird_scheme = recode(MetaalringLandCode,
    "BE" = "BLB",
    "FR" = "FRP",
    "NL" = "NLA",
    "PT" = "POL",
    "UK" = "GBT"
  )) %>%
  mutate(sovon_bird_scheme = case_when(
    is.na(sovon_bird_ring_number) ~ NA_character_,
    TRUE ~ sovon_bird_scheme
  ))

## select: dropped 18 variables (first_Nummer, NummerNieuw, NummerDesc, Nummer, Plaats, …)

## left_join: added one column (MetaalringLandCode)

##            > rows only in x        0

##            > rows only in y  (    88)

##            > matched rows     12,376

##            >                 ========

##            > rows total       12,376

## mutate: new variable 'sovon_bird_scheme' (character) with 6 unique values and 5% NA

## mutate: changed 276 values (2%) of 'sovon_bird_scheme' (276 new NA)

Effects of mapping:

crbirding_birds %>%
  filter(!is.na(sovon_bird_ring_number)) %>%
  distinct(MetaalringLandCode, sovon_bird_scheme)

## filter: removed 319 rows (3%), 12,057 rows remaining

## distinct: removed 12,052 rows (>99%), 5 rows remaining

We remove the help column MetaalringLandCode from crbirding_birds:

crbirding_birds <-
  crbirding_birds %>%
  select(-MetaalringLandCode)

## select: dropped one variable (MetaalringLandCode)

5.2.18 Bird sex

Bird sex is translated to English. Letter M (Dutch word mannetje) will not change so no need to convert it:

crbirding_birds <-
  crbirding_birds %>%
  left_join(birds %>%
    select(sovon_bird_reference, GeslachtCode),
  by = "sovon_bird_reference"
  ) %>%
  mutate(sovon_bird_sex = recode(GeslachtCode,
    "V" = "F", ## V(rouwtje) ->F(emale)
    "O" = "U" ## O(nbekend) ->  U(nknown)
  ))

## select: dropped 18 variables (first_Nummer, NummerNieuw, NummerDesc, Nummer, Plaats, …)

## left_join: added one column (GeslachtCode)

##            > rows only in x        0

##            > rows only in y  (    88)

##            > matched rows     12,376

##            >                 ========

##            > rows total       12,376

## mutate: new variable 'sovon_bird_sex' (character) with 3 unique values and 0% NA

Effects of mapping:

crbirding_birds %>% distinct(GeslachtCode, sovon_bird_sex)

## distinct: removed 12,373 rows (>99%), 3 rows remaining

We remove the help column GeslachtCode from crbirding_birds:

crbirding_birds <-
  crbirding_birds %>%
  select(-GeslachtCode)

## select: dropped one variable (GeslachtCode)

5.2.19 Bird age ringing

For mapping the age while applying color rings, we have to follow the Euring standard: see online pdf document at page 14.

Bird age at the moment of any observation can be found in column LeeftijdCode of obs_and_acts. Values present:

obs_and_acts %>%
  distinct(LeeftijdCode)

## distinct: removed 150,654 rows (>99%), 8 rows remaining

We apply a recoding in order to standardize INBO’s vocabulary to the EURING standard:

obs_and_acts <-
  obs_and_acts %>%
  mutate(sovon_bird_age_obs = recode(LeeftijdCode,
    "PU" = "1",
    "AD" = "A",
    "J1" = "3",
    "I4" = "5",
    "I3" = "7",
    "I2" = "9",
    "I5" = "B",
    .missing = NA_character_
  ))

## mutate: new variable 'sovon_bird_age_obs' (character) with 8 unique values and 40% NA

The age can be added to crbirding_birds by matching sovon_bird_date_begin of crbirding_birds and Datum of obs_and_acts for each sovon_bird_reference. First we check that this strategy ends up with a one-to-one relation:

crbirding_birds %>%
  left_join(obs_and_acts %>%
    ## remove rows with Datum equal to NA or field observations
    filter(!is.na(sovon_bird_age_obs) &
      (!is.na(vang) | !is.na(vangl) |
        !is.na(rngkl) | !is.na(rngme) |
        !is.na(klgev) | !is.na(klweg) |
        !is.na(meweg) |
        !is.na(ziek) # for FHOV,YCAF,FAAG
      )),
  by = c("sovon_bird_reference",
    "sovon_bird_date_begin" = "Datum"
  )
  ) %>%
  nrow() == nrow(crbirding_birds)

## filter: removed 138,336 rows (92%), 12,326 rows remaining

## left_join: added 40 columns (Nummer, EuringCode, LeeftijdCode, KleurringNummer, KleurringPlaats, …)

##            > rows only in x      152

##            > rows only in y  (   103)

##            > matched rows     12,224

##            >                 ========

##            > rows total       12,376

## [1] TRUE

Apply mapping:

crbirding_birds <-
  crbirding_birds %>%
  left_join(obs_and_acts %>%
    ## remove rows with Datum equal to NA or field observations
    filter(!is.na(sovon_bird_age_obs) & 
      (!is.na(vang) | !is.na(vangl) |
        !is.na(rngkl) | !is.na(rngme) |
        !is.na(klgev) | !is.na(klweg) |
        !is.na(meweg) |
        !is.na(ziek) # for FHOV,YCAF,FAAG
      )) %>%
    select(sovon_bird_reference, Datum, sovon_bird_age_obs),
  by = c("sovon_bird_reference",
    "sovon_bird_date_begin" = "Datum"
  )
  )

## filter: removed 138,336 rows (92%), 12,326 rows remaining

## select: dropped 39 variables (Nummer, EuringCode, LeeftijdCode, KleurringNummer, KleurringPlaats, …)

## left_join: added one column (sovon_bird_age_obs)

##            > rows only in x      152

##            > rows only in y  (   103)

##            > matched rows     12,224

##            >                 ========

##            > rows total       12,376

It can happen that there are birds without age while ringing. This happens typically while changing a ring, i.e. birds with more than one ring:

crbirding_birds %>%
  group_by(sovon_bird_reference) %>%
  add_tally() %>%
  ungroup() %>%
  filter(sovon_bird_reference %in% 
           (crbirding_birds %>%
           filter(is.na(sovon_bird_age_obs)) %>%
           pull(sovon_bird_reference))) %>%
  rename(n_rings = n) %>%
  group_by(n_rings) %>%
  count()

## group_by: one grouping variable (sovon_bird_reference)

## add_tally (grouped): new variable 'n' (integer) with 4 unique values and 0% NA

## ungroup: no grouping variables

## filter: removed 12,224 rows (99%), 152 rows remaining

## filter: removed 12,043 rows (97%), 333 rows remaining

## rename: renamed one variable (n_rings)

## group_by: one grouping variable (n_rings)

## count: now 3 rows and 2 columns, one group variable remaining (n_rings)

This is considered not a problem by SOVON ITer (see 113#issuecomment-605295649).

Birds without sovon_bird_age_obs while ringing once should be checked:

crbirding_birds %>%
  group_by(sovon_bird_reference) %>%
  add_tally() %>%
  ungroup() %>%
  filter(sovon_bird_reference %in% 
           (crbirding_birds %>%
              filter(is.na(sovon_bird_age_obs)) %>%
              pull(sovon_bird_reference))) %>%
  rename(n_rings = n) %>%
  filter(n_rings == 1)

## group_by: one grouping variable (sovon_bird_reference)

## add_tally (grouped): new variable 'n' (integer) with 4 unique values and 0% NA

## ungroup: no grouping variables

## filter: removed 12,224 rows (99%), 152 rows remaining

## filter: removed 12,043 rows (97%), 333 rows remaining

## rename: renamed one variable (n_rings)

## filter: removed all rows (100%)

We rename sovon_bird_age_obs to sovon_bird_age_ringing in crbirding_birds:

crbirding_birds <-
  crbirding_birds %>%
  rename(sovon_bird_age_ringing = sovon_bird_age_obs)

## rename: renamed one variable (sovon_bird_age_ringing)

As examples, the bird age mapping of birds (color) ringed thrice or more:

bird_reference_triplet <-
  crbirding_birds %>%
  group_by(sovon_bird_reference) %>%
  count() %>%
  filter(n >= 3) %>%
  pull(sovon_bird_reference)

## group_by: one grouping variable (sovon_bird_reference)

## count: now 11,136 rows and 2 columns, one group variable remaining (sovon_bird_reference)

## filter (grouped): removed 11,047 rows (99%), 89 rows remaining

crbirding_birds %>%
  select(
    sovon_bird_reference,
    sovon_bird_shorthand,
    sovon_bird_date_begin,
    sovon_bird_age_ringing
  ) %>%
  filter(sovon_bird_reference %in% bird_reference_triplet)

## select: dropped 15 variables (sovon_bird_shorthand_pt, sovon_bird_date_end, sovon_bird_notes, sovon_bird_rings_changed, metal_ring_missing, …)

## filter: removed 12,098 rows (98%), 278 rows remaining

5.2.20 Bird ID

Bird identifiers will be provided by SOVON. NA is given:

crbirding_birds <-
  crbirding_birds %>%
  mutate(sovon_bird_id = NA)

## mutate: new variable 'sovon_bird_id' (logical) with one unique value and 100% NA

5.2.21 Bird BTO

Bird BTO will be provided by SOVON. NA is given:

crbirding_birds <-
  crbirding_birds %>%
  mutate(sovon_bird_bto = NA)

## mutate: new variable 'sovon_bird_bto' (logical) with one unique value and 100% NA

5.2.22 Bird name

Some birds, the ones with a GPS tracker, have a name saved in this file. The names are saved in column individual_remarks:

uvabits_file <- "https://raw.githubusercontent.com/inbo/bird-tracking/8a7a2c91d54b486d90a97f85cfaa30cede67315d/data/interim/individuals.csv"
uvabits_names <-
  read_csv(uvabits_file,
    col_types = cols(
      .default = col_character(),
      individual_id = col_double(),
      mass = col_double(),
      track_session_id = col_double(),
      device_info_serial = col_double(),
      tracker_id = col_double(),
      track_session_start_date = col_datetime(format = ""),
      track_session_end_date = col_datetime(format = ""),
      track_session_start_latitude = col_double(),
      track_session_start_longitude = col_double()
    )
  )
uvabits_names <- 
  uvabits_names %>%
  select(individual_id, ring_number, individual_remarks, everything())

## select: columns reordered (individual_id, ring_number, individual_remarks, key_name, station_name, …)

uvabits_names

We couple the birds to the correspondent names by color ring:

bird_ref_uvabits <-
  crbirding_birds %>%
  left_join(uvabits_names %>%
    select(colour_ring, individual_remarks) %>%
    filter(!is.na(colour_ring)),
  by = c("sovon_bird_shorthand" = "colour_ring")
  ) %>%
  rename(sovon_bird_name = individual_remarks) %>%
  filter(!is.na(sovon_bird_name)) %>%
  select(sovon_bird_reference, sovon_bird_name)

## select: dropped 16 variables (individual_id, ring_number, key_name, station_name, species_latin_name, …)

## filter: removed 4 rows (2%), 240 rows remaining

## left_join: added one column (individual_remarks)

##            > rows only in x   12,221

##            > rows only in y  (    85)

##            > matched rows        155

##            >                 ========

##            > rows total       12,376

## rename: renamed one variable (sovon_bird_name)

## filter: removed 12,228 rows (99%), 148 rows remaining

## select: dropped 20 variables (sovon_bird_shorthand, sovon_bird_shorthand_pt, sovon_bird_date_begin, sovon_bird_date_end, sovon_bird_notes, …)

And we assign the names by joining on sovon_bird_reference:

crbirding_birds <-
  crbirding_birds %>%
  left_join(bird_ref_uvabits, by = "sovon_bird_reference")

## left_join: added one column (sovon_bird_name)

##            > rows only in x   12,134

##            > rows only in y  (     0)

##            > matched rows        242

##            >                 ========

##            > rows total       12,376

The complete mapping of names:

crbirding_birds %>%
  filter(!is.na(sovon_bird_name)) %>%
  select(sovon_bird_reference, sovon_bird_name, sovon_bird_shorthand)

## filter: removed 12,134 rows (98%), 242 rows remaining

## select: dropped 19 variables (sovon_bird_shorthand_pt, sovon_bird_date_begin, sovon_bird_date_end, sovon_bird_notes, sovon_bird_rings_changed, …)

5.2.23 Bird birth year

This field will be filled by SOVON. NA is given:

crbirding_birds <-
  crbirding_birds %>%
  mutate(sovon_bird_birth_year = NA)

## mutate: new variable 'sovon_bird_birth_year' (logical) with one unique value and 100% NA

5.3 Finalize user data

We have now sufficient information to define the role of any user in crbirding_users.

5.3.1 Add user role to `crbirding_users`

Based on sovon_bird_date_begin we can retrieve the observations linked to applying rings. We retrieve the ringers by joining crbirding_users and obs_and_acts by WaarnemerNummer:

ringers_number <-
  crbirding_birds %>%
  select(sovon_bird_reference, sovon_bird_date_begin) %>%
  left_join(obs_and_acts %>%
    ## remove rows with Datum equal to NA or field observations
    filter(!is.na(sovon_bird_age_obs) &
      is.na(veld) & is.na(dood) & is.na(br) &
      (!is.na(vang) | !is.na(vangl) |
        !is.na(rngkl) | !is.na(rngme) |
        !is.na(klgev) | !is.na(klweg) |
        !is.na(meweg) |
        !is.na(ziek) # for FHOV,YCAF,FAAG
      )) %>%
    select(sovon_bird_reference, Datum, WaarnemerNummer),
  by = c("sovon_bird_reference", "sovon_bird_date_begin" = "Datum")
  ) %>%
  filter(!is.na(WaarnemerNummer)) %>%
  distinct(WaarnemerNummer) %>%
  pull(WaarnemerNummer)

## select: dropped 21 variables (sovon_bird_shorthand, sovon_bird_shorthand_pt, sovon_bird_date_end, sovon_bird_notes, sovon_bird_rings_changed, …)

## filter: removed 138,429 rows (92%), 12,233 rows remaining

## select: dropped 39 variables (Nummer, EuringCode, LeeftijdCode, KleurringNummer, KleurringPlaats, …)

## left_join: added one column (WaarnemerNummer)

##            > rows only in x      240

##            > rows only in y  (    98)

##            > matched rows     12,136

##            >                 ========

##            > rows total       12,376

## filter: removed 240 rows (2%), 12,136 rows remaining

## distinct: removed 12,100 rows (>99%), 36 rows remaining

message(paste(
  "Number of ringers:",
  length(ringers_number)
))

## Number of ringers: 36

We assign a R (ringer) to them, O (observer) otherwise:

crbirding_users <-
  crbirding_users %>%
  mutate(user_role = ifelse(user_reference %in% ringers_number,
    "R", "O"
  ))

## mutate: new variable 'user_role' (character) with 2 unique values and 0% NA

Number of ringers and observers:

crbirding_users %>%
  group_by(user_role) %>%
  count()

## group_by: one grouping variable (user_role)

## count: now 2 rows and 2 columns, one group variable remaining (user_role)

5.4 Save modified temporary observation data

We overwrite the temporary observation data based on the added columns:

write_tsv(
  obs_and_acts,
  path = here::here("data", "interim", "obs_and_actions.tsv"),
  na = "",
  append = FALSE
)

5.5 Save modified ring position and direction table

We save the updated table containing color ring position and inscription direction in data/interim:

write_tsv(
  ring_position_table,
  path = here::here("data", "interim", "ring_position_table.tsv"),
  na = "",
  append = FALSE
)

5.6 Save final user data

The desired order of columns in crbirding_users:

cr_users_cols <- c(
  "user_id", "user_reference", "user_email", "user_first_name",
  "user_last_name", "user_address", "user_postal_code", "user_place",
  "user_country", "user_language", "user_role"
)

Are all required columns present?

all(cr_users_cols %in% names(crbirding_users)) &
  length(cr_users_cols) == ncol(crbirding_users)

## [1] TRUE

We overwrite crbirding_users.csv with added information:

write_csv(crbirding_users,
  path = here::here("data", "processed", "crbirding_users.csv"),
  na = ""
)

5.7 Save final ring data

We overwrite the columns sovon_bird_shorthand and sovon_bird_shorthand_pt and remove the help columns metal_ring_missing, sovon_bird_shorthand_color, sovon_bird_shorthand_pt_color and color_combination:

crbirding_birds <-
  crbirding_birds %>%
  mutate(
    sovon_bird_shorthand = sovon_bird_shorthand_color,
    sovon_bird_shorthand_pt = sovon_bird_shorthand_pt_color
  ) %>%
  select(-c(
    ends_with("color"),
    starts_with("color"),
    metal_ring_missing
  ))

## mutate: changed 11,614 values (94%) of 'sovon_bird_shorthand' (0 new NA)

##         changed 11,614 values (94%) of 'sovon_bird_shorthand_pt' (0 new NA)

## select: dropped 5 variables (metal_ring_missing, ring_color, sovon_bird_shorthand_color, sovon_bird_shorthand_pt_color, inscription_color)

SOVON is interested in color ring versions with a dot if dots are present, even if their purpose is just improving readability. We can overwrite sovon_bird_shorthand with control column sovon_bird_shorthand_pt:

crbirding_birds <-
  crbirding_birds %>%
  select(-sovon_bird_shorthand) %>%
  rename(sovon_bird_shorthand = sovon_bird_shorthand_pt)

## select: dropped one variable (sovon_bird_shorthand)

## rename: renamed one variable (sovon_bird_shorthand)

Remove prefix sovon_:

names(crbirding_birds) <- str_remove_all(names(crbirding_birds),
  pattern = "sovon_"
)
names(crbirding_birds)

##  [1] "bird_reference"      "bird_shorthand"      "bird_date_begin"    
##  [4] "bird_date_end"       "bird_notes"          "bird_rings_changed" 
##  [7] "bird_ring_position"  "bird_ring_direction" "bird_ring_number"   
## [10] "bird_euring"         "bird_scheme"         "bird_sex"           
## [13] "bird_age_ringing"    "bird_id"             "bird_bto"           
## [16] "bird_name"           "bird_birth_year"

Remove time and timezone information from bird_date_begin and bird_date_end:

crbirding_birds <-
  crbirding_birds %>%
  mutate(bird_date_begin = as.Date(bird_date_begin),
         bird_date_end = as.Date(bird_date_end))

## mutate: converted 'bird_date_begin' from double to Date (0 new NA)

##         converted 'bird_date_end' from double to Date (0 new NA)

The desired order of columns in crbirding_birds:

cr_birds_cols <- c(
  "bird_id", "bird_reference", "bird_euring", "bird_bto",
  "bird_shorthand", "bird_scheme", "bird_ring_number", "bird_name",
  "bird_sex", "bird_birth_year", "bird_date_begin", "bird_date_end",
  "bird_rings_changed", "bird_age_ringing", "bird_ring_position",
  "bird_ring_direction", "bird_notes"
)

Are all required columns present?

all(cr_birds_cols %in% names(crbirding_birds)) &
  length(cr_birds_cols) == ncol(crbirding_birds)

## [1] TRUE

Set column order:

crbirding_birds <-
  crbirding_birds %>%
  select(all_of(cr_birds_cols))

## select: columns reordered (bird_id, bird_reference, bird_euring, bird_bto, bird_shorthand, …)

Preview data:

crbirding_birds %>% head(n = 100)

Save finale birds info as text file (comma separated value):

write_csv(
  crbirding_birds,
  path = here::here("data", "processed", "crbirding_birds.csv"),
  na = ""
)

5 Map ring data

5.1 Read temporary ring data

5.1.1 Read observation data

5.1.2 Read action data

5.1.3 Read ring position data

5.1.4 Read user data

5.1.5 Read color data

5.2 Map color ring data

5.2.1 Extract action codes

5.2.2 Bird reference & bird shorthand

5.2.3 Bird ringing date

5.2.3.1 Date of applying first ring

5.2.3.2 Date of applying last ring

5.2.3.3 Add intermediate color rings

5.2.4 Bird ringing end date

5.2.5 Add rows for metal rings applied before color rings

5.2.6 Ring number

5.2.7 Initialize sovon_bird_rings_changed column for very first ring

5.2.8 Add help field metal_ring_missing

5.2.9 Add rows for first metal ring applied after color rings

5.2.10 Add rows for loosing color or metal rings: klweg, meweg

5.2.11 Add rows for found color or metal rings: klgev, megev

5.2.12 Finalize sovon_bird_rings_changed

5.2.13 Map color of rings and inscriptions

5.2.14 Position of the color ring and inscription orientation

5.2.15 Mapping of sovon_bird_ring_number

5.2.16 Euring

5.2.17 Scheme

5.2.18 Bird sex

5.2.19 Bird age ringing

5.2.20 Bird ID

5.2.21 Bird BTO

5.2.22 Bird name

5.2.23 Bird birth year

5.3 Finalize user data

5.3.1 Add user role to crbirding_users

5.4 Save modified temporary observation data

5.5 Save modified ring position and direction table

5.6 Save final user data

5.7 Save final ring data

5.2.7 Initialize `sovon_bird_rings_changed` column for very first ring

5.2.8 Add help field `metal_ring_missing`

5.2.10 Add rows for loosing color or metal rings: `klweg`, `meweg`

5.2.11 Add rows for found color or metal rings: `klgev`, `megev`

5.2.12 Finalize `sovon_bird_rings_changed`

5.2.15 Mapping of `sovon_bird_ring_number`

5.3.1 Add user role to `crbirding_users`