Show add_subquadrat()

Mauro Lepore

2017-10-06

Define function based on Anudeep’s SQL code.

add_subquadrat <- function(df, dim_x, dim_y, divide_x, divide_y) {
  # Simplify nested parentheses
  dim_x_mns.1 <- dim_x - 0.1
  dim_y_mns.1 <- dim_y - 0.1

  # Conditions
  is_odd_both <- df$QX >=  dim_x & df$QY >=  dim_y
  is_odd_x <- df$QX >=  dim_x
  is_odd_y <- df$QY >=  dim_y
  is_not_odd <- TRUE

  # Cases
  with_subquadrat <- dplyr::mutate(df,
    subquadrat = dplyr::case_when(
      is_odd_both ~ paste0(
        (1 + floor((dim_x_mns.1 - dim_x * floor(dim_x_mns.1 / dim_x)) / divide_x)),
        (1 + floor((dim_y_mns.1- dim_y * floor(dim_y_mns.1/ dim_y)) / divide_y))
      ),
      is_odd_x ~ paste0(
        (1 + floor((dim_x_mns.1 - dim_x * floor(dim_x_mns.1 / dim_x)) / divide_x)),
        (1 + floor((df$QY - dim_y * floor(df$QY/ dim_y)) / divide_y))
      ),
      is_odd_y ~ paste0(
        (1 + floor((df$QX - dim_x * floor(df$QX/ dim_x)) / divide_x)),
        (1 + floor((dim_y_mns.1- dim_y * floor(dim_y_mns.1 / dim_y)) / divide_y))
      ),
      is_not_odd ~ paste0(
        (1 + floor((df$QX - dim_x * floor(df$QX/ dim_x)) / divide_x)),
        (1 + floor((df$QY - dim_y * floor(df$QY/ dim_y)) / divide_y))
      )
    )
  )
  with_subquadrat
}

Explore resutls for quadtat 15.

library(tidyverse)
#> + ggplot2 2.2.1        Date: 2017-10-06
#> + tibble  1.3.4           R: 3.4.1
#> + tidyr   0.7.1          OS: Windows 10 x64
#> + readr   1.1.1         GUI: RTerm
#> + purrr   0.2.3      Locale: English_Australia.1252
#> + dplyr   0.7.2          TZ: America/New_York
#> + stringr 1.2.0      
#> + forcats 0.2.0
#> -- Conflicts ----------------------------------------------------
#> * filter(),  from dplyr, masks stats::filter()
#> * lag(),     from dplyr, masks stats::lag()

df <- sinharaja::sinh_vftbl_selected
with_subquadrat <- add_subquadrat(
  df, dim_x = 20, dim_y = 20, divide_x = 5, divide_y = 5
)

q15 <- with_subquadrat %>%
  filter(QuadratName == "0015")
odds <- q15 %>%
  filter(QX >= 20 | QY >= 20)

ggplot(data = q15, aes(QX, QY)) +
  geom_hline(yintercept = 20) +
  geom_vline(xintercept = 20) +
  geom_point(data = odds, colour = "red", size = 8) +
  geom_text(data = q15, aes(label = subquadrat))