Slide Inventory

Report generated on 2022-04-27.

path = list()
path$movat <- "Z:/Histology/Movat/SVS"
path$ab <- "Z:/Histology/Alcian Blue/SVS"

fn <- function(path){
  dta <- data.frame(files = list.files(path=path, pattern="svs$")) %>%
    mutate(files = str_remove(files, "\\.svs"))
  dta <- dta %>% 
    separate(files, 
           into=c("stain", "id", "info", "extra"),
           sep = " ") %>%
  separate(info, into=c("rgn", "slidenum", "sliceid")) %>%
  mutate(slidenum = as.integer(slidenum))
  # pull out slides with multiple regions and separate rows
  t <- dta %>% 
  filter(str_detect(rgn, pattern="[A-z]{2}")) %>%
  filter(rgn != c("IL", "GCP"))
  rgn_compound <- t %>% pull(rgn) %>% unique()
  t <- t %>% 
  mutate(
    R = ifelse(str_detect(rgn, "R"), 1, NA),
    P = ifelse(str_detect(rgn, "P"), 1, NA),
    M = ifelse(str_detect(rgn, "M"), 1, NA),
    D = ifelse(str_detect(rgn, "D"), 1, NA)
  ) %>%
  pivot_longer(
    cols=c("R","P","M", "D"),
    names_to = c("rgn_stdrd"),
    values_drop_na = T
  ) %>%
  select(-value)
  # create standard region variable
  rgn_stdrd <- c("R", "P", "M", "D", "O")
  t2 <- dta %>%
  filter(!rgn %in% rgn_compound) %>%
  mutate(rgn_stdrd =
           case_when(rgn %in% rgn_stdrd ~ rgn,
                     rgn %in% c("IL") ~ "O",
                     str_detect(rgn, pattern="[0-9]+") ~ 
                       str_extract(rgn, pattern="[A-z]+"),
                     TRUE ~ "O"
         )) 
  dta <- rbind(t2, t)
  # extract mat-#, fill out dataframe with all possible values
  controls <- dta %>% filter(str_detect(id, "^D")) %>% pull(id)
  subjects <- dta %>% filter(str_detect(id, "^MAT-")) %>% mutate(matnum = as.numeric(str_remove(id, "MAT-"))) %>% pull(matnum)
  dta <- dta %>% 
    mutate(matnum = as.numeric(case_when(
    id %in% controls ~ paste0(9, str_extract(id, "[0-9]+")),
    !id %in% controls ~ str_extract(id, "[0-9]+"),
    TRUE ~ NA_character_
  )))
  dta <- full_join(dta, expand_grid(matnum=seq(1, max(subjects)), rgn_stdrd=rgn_stdrd)) %>%
    mutate(have_slide = ifelse(is.na(id), 0, 1))
  return(dta)
}

fn_label <- function(data){
  if(data[1,"stain"]=="MOV"){
    stain <- "Movat"
  } else if(data[1,"stain"]=="AB"){
    stain <- "Alcian Blue"
  } else if(data[1,"stain"=="MAS"]){
    stain <- "Masson Trichrome"
  }
  
  dta <- data %>%
    labelled::set_variable_labels(
      rgn_stdrd = "Region",
      have_slide = paste(stain, "Scanned?"),
      matnum = "MAT-#"
  ) %>%
    labelled::set_value_labels(
      rgn_stdrd = c(Root="R", Prox="P", Mid="M", Dist="D", Other="O"),
      have_slide = c(Yes=1, No=0),
      .strict=F
    )
  return(dta)
}

fn_tile <- function(data){
  plot <- labelled::unlabelled(data, ordered=T) %>%
    filter(!str_detect(id, "^D") | is.na(id)) %>% 
    ggplot(aes(y=matnum, x=rgn_stdrd))+
    geom_tile(aes(fill=have_slide), col="black")+
    scale_fill_manual(values=c("green", "grey50"))+
    theme_classic()+ggeasy::easy_labs()+
    theme(legend.position="top")
  return(plot)
}

dta_mvt <- fn(path$movat)

dta_mvt <- fn_label(dta_mvt)

fn_tile(dta_mvt)

dta_ab <- fn(path$ab)

dta_ab <- fn_label(dta_ab)

fn_tile(dta_ab)

dta <- full_join(
  subset(dta_ab, have_slide==1, select = -c(slidenum:extra,stain))%>%rename(have_ab=have_slide),
  subset(dta_mvt, have_slide==1, select = -c(slidenum:extra,stain))%>%rename(have_mvt=have_slide)
)
dta <- dta %>%
  mutate(have_which = case_when(
    have_ab==1 & have_mvt==1 ~ 2,
    have_ab==1 & is.na(have_mvt) ~ 1,
    is.na(have_ab) & have_mvt==1 ~ 0,
    TRUE ~ NA_real_
  )) %>%
  set_variable_labels(
    have_which = "Slides Scanned",
    matnum = "MAT-#") %>%
  add_value_labels(
    have_which = c("Both"=2, "Alcian Blue"=1, "Movat"=0)
  )

labelled::unlabelled(dta, ordered=T) %>% 
  filter(str_detect(id, "MAT")) %>%
  ggplot(aes(x=rgn_stdrd, y=matnum))+
  geom_tile(aes(fill=have_which), col="black")+
  scale_fill_manual(values=c("yellow","blue", "orchid"))+
  theme_classic()+
  ggeasy::easy_labs()+
  theme(legend.position="top")+
  facet_wrap(~have_which)