---
title: "Tweaking Coding Schemes: Bird Tagging Example"
author: "Andrew Burchill"
date: "`r Sys.Date()`"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{Tweaking Coding Schemes: Bird Tagging Example}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(comment = "#>")
```
#The Setup:
In this vignette, we will tweak a color coding scheme generated by the `rs_IDs()` function. (For a very first experience with what `rs_IDs()` does, I recommend checking out the Shiny-based GUI for the function by running `exampleGUI()`.)

In our particular hypothetical situation, we plan on putting color bands around the legs of some bird. We have eight different band colors, and we want to put five bands on each bird: two bands below each of the bird's "ankles" (around the tarsometatarsus) and one band above the bird's right "ankle" joint (around the right tibiotarsus). A horrible "graphical" representation can be seen below, where `{1}`, `{2}`, `{3}`, `{4}`, and `{5}` refer to the five unique banding positions.

```{r, echo=FALSE, collapse=TRUE,comment=""}
cat("     |   |            |  {5}\n     o   o            o   o\n     |   |     =>    {1} {3}\n     .   .           {2} {4}\n    /|\\ /|\\          /|\\ /|\\")

```

Let us say that these bands fall off somewhat frequently; we want our coding scheme to be robust to the loss of two bands. If these bands occupy unique positions and can't be moved around, we can use the `rs_IDs()` function without further modification.
```{r, results='hide', warning=FALSE}
alphabet <- 8      # the number of colors we have
total.length <- 5  # the number of positions we want band
redundancy <- 2    # how many bands we can lose but still ID perfectly
codes <- rabi::rs_IDs(total.length, redundancy, alphabet)
print(paste0("Our list contains ", length(codes), " unique IDs."))
head(codes, n = 10L)
```
```{r, results='hide',echo=FALSE, comment="!!"}
codes <- rabi::rs_IDs(total.length, redundancy, alphabet)
```
```{r, echo=FALSE}
print(paste0("Our list contains ", length(codes), " unique IDs."))
codes <- t(do.call("cbind",codes))
knitr::kable(head(codes, n = 10L), col.names = c("{1}","{2}","{3}","{4}","{5}"), align = "c", caption = "ID sequences in the unaltered list")
```

Congratulations! It's as simple as one line of code. **Note the error: this lets us know that we aren't getting as much out of `rs_IDs()` as we could.**

#The Problem:


Actually, things aren't so simple; things get a bit trickier. In reality, these bands may be relatively loose around the legs of the bird. The unique positions of bands `{1}` and `{3}` are probably only maintained due to the physical presence of bands `{2}` and `{4}`. If `{2}` or `{4}` were to somehow be removed, the band above them would succumb to gravity and descend into the newly vacated position. In the below "diagram," we see that a loss of both `{1}` and `{2}` will yield the same final configuration. In this case, it would be impossible to tell the original position of the remaining band. 
```{r, echo=FALSE, collapse=TRUE,comment=""}
cat("     |  {5}           |  {5}           |  {5}\n     o   o            o   o            o   o\n    {1} {3}   AND     x  {3}    =>     |  {3}\n     x  {4}          {2} {4}          {?} {4}\n    /|\\ /|\\          /|\\ /|\\          /|\\ /|\\")

```
It becomes clear that a loss in `{1}` would make the ID code **3,4**,2,4,0 indistinguishable from **4,3**,2,4,0 or **5,3**,2,4,0 or **3,0**,2,4,0 etc. (A similar dilemma is caused by losses in `{3}` or `{4}`.) The generated codes can still totally correct for a _single_ erasure anywhere, but accounting for both an erasure AND an uncertain position "costs" the same as a double erasure. So if one erasure happens between `{1}` and `{2}` and a second erasure happens between `{3}` and `{4}`, we would need the code to be robust to FOUR erasures, which would render it quite useless.

The best fix for this is not easily apparent. Let's first try to work around it just by manipulating our coding scheme.

#Some Solutions: 

##Pruning the coding list

One possible idea: prune the list of codes so that the top bands, `{1}` and  `{3}`, are only odd numbers and the bottom bands, `{2}` and  `{4}`, are only even numbers. That way, a lone even-numbered band indicates that the upper band has been lost, etc.
```{r, results='hide',echo=FALSE, messages=FALSE, warning=FALSE}
codes <- rabi::rs_IDs(total.length = 5, redundancy = 2, alphabet = 8)
```
```{r}
 #create a function for determining odd or even
odd <- function(x){ x %% 2 == 1 }
 #turn the code list into a matrix for easier manipulation
codes <- t(do.call("cbind",codes)) 
 #only select the codes where {1} and {3} are odd, and {2} and {4} are even
codes <- 
  codes[which(odd(codes[,1]) & odd(codes[,3]) & !odd(codes[,2]) & !odd(codes[,4])), ]
print(paste0("Our new list contains ", dim(codes)[1], " unique IDs."))
```
Damn. That's almost nothing...

###Using the `tweaked_IDs()` function
However, we can possibly increase that number by using the `tweaked_IDs()` function. It's the same as `brute_IDs()`, but instead of pruning down a list of ALL possible ID sequences, we can specify our constraints first and then generate that list.

```{r}
 #create a matrix of all possible sequences
perms <- rep(list(seq_len(alphabet)),total.length)
combos <- as.matrix(expand.grid(perms)) - 1
 #only keep sequences that fit our constraints
combos1 <- 
  combos[which(odd(combos[,1]) & odd(combos[,3]) & !odd(combos[,2]) & !odd(combos[,4])), ]
codes <- rabi::tweaked_IDs(combos1, redundancy, num.tries = 1)  #we're only running it once for speed
print(paste0("The 'tweaked' list contains ", length(codes), " unique IDs."))

```

Okay, that's still not much better... 

##Using empty spaces

Still not good enough? Perhaps you find it annoying that the top bands can only be odd. Perhaps we could get more IDs if we weren't so constrained. To further add IDs, we could have the top and bottom bands merely be opposites in terms of oddness or evenness. For example, if `{3}` is even, `{4}` is odd; if `{3}` is odd, `{4}` is even. But how could we indicate to the observer which level is even and which is odd?

Well, although `{5}` is around the right tibiotarsus, there is an unused spot around the left tibiotarsus. If we allow `{5}` to occupy either position (see below), we can encode a bit more information in the ID sequence.

```{r, echo=FALSE, collapse=TRUE,comment=""}
cat("     |  {5}          {5}  |\n     o   o            o   o\n    {1} {3}    OR    {1} {3}\n    {2} {4}          {2} {4}\n    /|\\ /|\\          /|\\ /|\\")

```
We can arbitrarily say that when `{5}` is on the right leg, the top bands `{1}` and `{3}` are odd. When `{5}` is on the left side, the top bands `{1}` and `{3}` are even. However, if `{5}` fell off, we might think that this information is lost. Not so! Imagine that `{5}` and `{3}` fell off: we can reconstruct both `{5}`'s position and `{3}`'s "oddness"" by looking at `{1}`.

```{r, results='hide', warning=FALSE}
 #only select sequences where the top and bottom bands differ in "oddness"
combos2 <- combos[which((
      (odd(combos[,1]) & odd(combos[,3]) & !odd(combos[,2]) & !odd(combos[,4])) |
      (!odd(combos[,1]) & !odd(combos[,3]) & odd(combos[,2]) & odd(combos[,4]))
      )), ]
codes <- rabi::tweaked_IDs(combos2, redundancy, num.tries = 1)  #we're only running it once for speed
 #add either a "left" or "right" indicating which leg {5} is on
codes <- lapply(codes, function(x) if(odd(x[[1]])) {append(x,"R")} else {append(x,"L")})
print(paste0("The 'tweaked' list contains ", length(codes), " unique IDs."))
head(codes, n = 10L)

```
```{r, echo=FALSE}
print(paste0("The 'tweaked' list contains ", length(codes), " unique IDs."))
codes <- t(do.call("cbind",codes))
knitr::kable(head(codes, n = 10L), col.names = c("{1}","{2}","{3}","{4}","{5}","{5}'s Position"), align = "c", caption = "ID sequences in variable position list")
```

Although this is the best so far, to really make this work we'll probably need to further change the physical setup of the tagging system.

##Removing ambiguity

If we consider the option of physically altering the setup, we find a very simple solution: on the upper color bands `{1}` and `{3}`, add some sort of dark, high-contrast mark. Perhaps something as simple as darkening the upper half of these bands with a sharpie would work. Adding additional markings to the bands can give the banding positions uniqueness in the face of gravity and detachment. However, this class of solutions is very dependent on your situation.

Barring something this simplistic, we could move `{1}` up above the "ankle" and around the left tibiotarsus. Now only `{3}` and `{4}` share a confusable position. The new arrangement would look something like this:
```{r, echo=FALSE, collapse=TRUE,comment=""}
cat("     |  {5}          {1} {5}\n     o   o            o   o\n    {1} {3}    =>     |  {3}\n    {2} {4}          {2} {4}\n    /|\\ /|\\          /|\\ /|\\")

```
Our code:
```{r}
 #now, only {3} and {4} need to be constrained as odd and even, respectively
combos3 <- 
  combos[which(odd(combos[,3]) & !odd(combos[,4])), ]
codes <- rabi::tweaked_IDs(combos3, redundancy, num.tries = 1)  #we're only running it once for speed
print(paste0("This last list contains ", length(codes), " unique IDs."))

```

There are many, many other ways to tweak both the tagging setup and the code list. I'm sure many of them could generate even more unique IDs than the ways I've outlined above. However, it's important to keep in mind that the functions in `rabi` ASSUME there is no weird uncertainty and sliding around of banding positions. If you are going to use these functions to help create codes for your own weird situation, I would make sure you write up a function that properly tests your lists to verify they are appropriately robust.