In GaryTruong/whiskR: Stable Isotope Analysis for Whisker Samples

#install.packages("devtools")
#install.packages("roxygen2")
#install.packages("usethis")
devtools::install_github("r-lib/pkgdown")
install.packages("Rtools")
# install.packages("installr")

#installr::install.Rtools(choose_version = TRUE, check = FALSE, GUI = TRUE,  page_with_download_url = "https://cran.r-project.org/bin/windows/Rtools/")

library(magrittr)
library(devtools)
library(roxygen2)
library(tidyverse)
library(pkgdown)

devtools::install_github("GaryTruong/whiskR")

library(whiskR)
# devtools::create("whiskR")

Add functions

x <- (92.6-(14*(0.0126*141.5)))/(1-(14*0.0126))

# LP1 calculates the cut section length that should be cut to obtain a defined time period.
LP1 <- function(L, Time, k, L.asym){
  section = format((L - (Time*(k*L.asym)))/(1-(Time*k)), digits = 4, nsmall = 1)
  paste(section, "mm", sep = "")
}
# k is estimated from seal whiskers and adapted for devils, assumption that whiskers fall out after 1 year
# L.asym is asymptotic length which is longest recorded length + 1% at the given position
# L is length of cut or plucked whisker
# Time is specified numnber of days represented by sample
# This function does not factor in intradermal length

LP1(156.2,75, 0.0126, 171.4)

LP1(129.5, 14, 0.0126, 150.3)
LP1(125.045, 14, 0.0126, 150.3)

#TP1 calculates the time period that is represented based on a cut section
TP1 <- function(Lp, Lp1, k, L.asym){
  time = format((Lp - Lp1)/(k*(L.asym-Lp1)), digits = 3, nsmall = 0)
  paste(time, "days", sep = " ")
}

 ## Simple Von Bertanlanffy equation for L and T
## L = L.asym * (1-exp(-KT))
## T = (-log(1-156.2/171.4))/(0.0126)


# MaxTime uses simple Von Bertanlanffy model (growth function) to caclulate maximum theoretically time that the sample whisker represents
MaxTime <- function(L , L.asym, k){
  Time = format((-log(1-L/L.asym))/(k), digits = 4, nsmall = 1)
  paste(Time, "days", sep = " ")
}


MaxTime(169.7, 171.4, 0.0126)  

# K - growth coefficient

k <- function(L, L.asym, Time){
   k = format((-log(1-L/L.asym))/(Time), digits = 4)
   k
}


k(1000, 1010, 365)


#Intra time calculates the days represented by the intradermal length
Intra.time <- function(L.int, L.asym, L, k){
  time = format((L.int)/(k*(L.asym - (L - L.int))), digits = 3, nsmall = 0)
  paste(time, "days", sep = " ")
}

Intra.time(5.3, 163.4, 127.8, 0.0126)

## Vindi tassie devil
MaxTime(127.8, 163.4, 0.0126)

#Vindi sampled on 1st August 2018 , 120.9 max days, should go back to april

Date

TP1(L=150 ,L.asym=170, LP1=140.5, k=0.0126)


MaxTime(150,170,0.0126)
library(dplyr)

sample <- function(L, L.asym, Time, k){
  a <- as.numeric(whiskR::LP1(L, L.asym, Time, k))
  b <- as.numeric(whiskR::LP1(L, L.asym, Time, k)) %>%
    whiskR::LP1(L.asym, Time, k)
  as.numeric(c(a,b,Time))
}
a <- c()
a <- c(1)
b <- c(a)
sample(150,170,14,0.0126)


section <- function(L, L.asym, k, Time = 1, date = "1900/01/01"){
  out <- list(0)
  name <- value <- L.start <- L.end <- NULL
  a <- as.numeric(whiskR::LP1(L, L.asym, Time, k))
  out[1] = a
  out[2] = Time
  out[3] = L
  out[4] = lubridate::as_date(date)
  out[[3]][2] = a
  for(i in 1:1000){
    if(a > 0 & a < L){
      a <- as.numeric(out[[1]][i]) %>%
        whiskR::LP1(L.asym, Time, k)
      out[[1]][i+1] = a
      out[[2]][i+1] = Time
      out[[3]][i+2] = a
      out[[4]][i+1] = lubridate::as_date(date) - Time*i
    }
    else if(a <0){
      out[[1]][i] = 0
      out[[2]][i] = 1 + whiskR::TP1(a, L.asym, 0, k)
      out[[4]][i] = lubridate::as_date(date) - Time*(i-1)
    }
    else{
      stop
    }
  }
  x <- tibble::enframe(as.numeric(out[[3]])) %>%
    dplyr::select(name, L.start = value)
  y <- tibble::enframe(as.numeric(out[[2]])) %>%
    dplyr::select(name, time = value)
  z <- tibble::enframe(as.numeric(out[[1]])) %>%
    dplyr::select(name,L.end = value)
  w <- tibble::enframe(lubridate::as_date(out[[4]])) %>%
    dplyr::select(name, date = value)
  x %>% dplyr::left_join(z, by = "name") %>%
    dplyr::left_join(y, by = "name") %>%
    dplyr::left_join(w, by = "name") %>%
    dplyr::filter(L.start > 0) %>%
    dplyr::mutate(SectionLength = L.start-L.end) %>%
    dplyr::mutate(CumulativeLength = cumsum(SectionLength))
}

c <- section(169.5,170, 0.0126, 1)

Generate documents for functions

devtools::document()

Create a vignette

library(usethis)
usethis::use_vignette("whiskR_vignette")

Creating Website

# not working for R 4.0.2
#install.packages("rpkgdown")

devtools::install_github("r-lib/pkgdown")
library(pkgdown)

# Run once to configure package to use pkgdown
usethis::use_pkgdown()
# Run to build the website
pkgdown::build_site()


## running R CMD check through devtools
devtools::check()

Testing

# usethis::use_testthat()
# use_test("TP1")
#
# devtools::test()
#
# #use_travis()

Test

GaryTruong/whiskR documentation built on Sept. 25, 2020, 1:41 p.m.