index.Rmd

---
title: "Lemurs Data (Tidy Tuesday Week 35)"
author: "Nils Indreiten"
output: html_document
---

```{r setup, include=FALSE}
# Read in the tidy tuesday week 35 data
lemurs <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2021/2021-08-24/lemur_data.csv')
pacman::p_load(tidyverse, reactable,plotly,crosstalk,htmltools)
```

```{r, echo=FALSE}
set.seed(12345)

small_df <- lemurs %>% 
  select(weight_g,age_at_wt_y, birth_type,sex) %>% 
  na.omit() %>% 
  filter(birth_type %in% sample(unique(birth_type)) & sex %in% sample(unique(sex))) %>% 
  sample_n(2000)

small_df <- small_df %>% mutate_if(is.character, as.factor)

pen_df <- SharedData$new(small_df)

x <- list(title="Age when weight taken (y)", range= c(0,40))
y <- list(title="Weight (g)", range=c(0,7000))

plotly_graphic <- plot_ly(pen_df,
                          x = ~age_at_wt_y,
                          y = ~weight_g,
                          color = ~birth_type,
                          text = ~birth_type) %>% 
  add_markers() %>% 
  layout(
    xaxis=~x,
    yaxis=~y
    ) %>% 
  highlight(
    on = "plotly_selected",
    off = "plotly_doubleclick",
    persistent = FALSE
      ) %>% 
  config(displaylogo=FALSE)

reactable_table <-  reactable(
  pen_df,
  columns = list(
    birth_type = colDef("Birth Type"),
    weight_g = colDef("Weight"),
    age_at_wt_y = colDef("Age"),
    sex = colDef("Sex"))
  )

```

```{r, echo=FALSE, warning=FALSE, message=FALSE}
div(
  h3("Filter by: Birth Type, Sex or Weight"),
  br(),
  bscols(
    widths = c(2, 10),
    list(
      filter_checkbox("birth_type", "Birth Type", pen_df, ~birth_type),
      filter_checkbox("sex", "Sex", pen_df, ~sex),
      filter_slider("weight_g", "Weight (g)", pen_df, ~weight_g)
    ),
    plotly_graphic,
  br(),
  reactable_table
  )
)  
```

> Birth type refers to whether the animal was captive-born (CB), wild-born (WB), and unknown birth (UNK). Data used for this widget is a random sample of 2000 Lemurs, [the full data can be accessed here.](https://github.com/rfordatascience/tidytuesday/blob/master/data/2021/2021-08-24/readme.md)