In sbalci/histopathology-template: Template of R Codes Used in Histopathology Research.

Plots

Codes for generating Plots.^[See childRmd/_13plots.Rmd file for other codes]

Categorical Variables

dependent <- c("dependent1",
               "dependent2"
                 )

explanatory <- c("explanatory1",
                 "explanatory2"
                 )

mydataCategorical <- mydata %>% 
    select(-var1,
           -var2
    )

mydataCategorical_variable <- explanatory[1]
dependent2 <- dependent[!dependent %in% mydataCategorical_variable]
source(here::here("R", "gc_plot_cat.R"))

mydataCategorical_variable <- NA
dependent2 <- NA
mydataCategorical_variable <- explanatory[2]
dependent2 <- dependent[!dependent %in% mydataCategorical_variable]
source(here::here("R", "gc_plot_cat.R"))

mydataCategorical_variable <- NA
dependent2 <- NA
mydataCategorical_variable <- explanatory[3]
dependent2 <- dependent[!dependent %in% mydataCategorical_variable]
source(here::here("R", "gc_plot_cat.R"))

mydataCategorical_variable <- NA
dependent2 <- NA
mydataCategorical_variable <- explanatory[4]
dependent2 <- dependent[!dependent %in% mydataCategorical_variable]
source(here::here("R", "gc_plot_cat.R"))

mydataCategorical_variable <- NA
dependent2 <- NA
mydataCategorical_variable <- explanatory[5]
dependent2 <- dependent[!dependent %in% mydataCategorical_variable]
source(here::here("R", "gc_plot_cat.R"))

mydataCategorical_variable <- NA
dependent2 <- NA
mydataCategorical_variable <- explanatory[6]
dependent2 <- dependent[!dependent %in% mydataCategorical_variable]
source(here::here("R", "gc_plot_cat.R"))

mydataCategorical_variable <- NA
dependent2 <- NA
mydataCategorical_variable <- explanatory[7]
dependent2 <- dependent[!dependent %in% mydataCategorical_variable]
source(here::here("R", "gc_plot_cat.R"))

mydataCategorical_variable <- NA
dependent2 <- NA
mydataCategorical_variable <- explanatory[8]
dependent2 <- dependent[!dependent %in% mydataCategorical_variable]
source(here::here("R", "gc_plot_cat.R"))

mydataCategorical_variable <- NA
dependent2 <- NA
mydataCategorical_variable <- explanatory[9]
dependent2 <- dependent[!dependent %in% mydataCategorical_variable]
source(here::here("R", "gc_plot_cat.R"))

mydataCategorical_variable <- NA
dependent2 <- NA
mydataCategorical_variable <- explanatory[10]
dependent2 <- dependent[!dependent %in% mydataCategorical_variable]
source(here::here("R", "gc_plot_cat.R"))

mydataCategorical_variable <- NA
dependent2 <- NA
mydataCategorical_variable <- explanatory[11]
dependent2 <- dependent[!dependent %in% mydataCategorical_variable]
source(here::here("R", "gc_plot_cat.R"))

mydataCategorical_variable <- NA
dependent2 <- NA
mydataCategorical_variable <- explanatory[12]
dependent2 <- dependent[!dependent %in% mydataCategorical_variable]
source(here::here("R", "gc_plot_cat.R"))

mydataCategorical_variable <- NA
dependent2 <- NA
mydataCategorical_variable <- explanatory[13]
dependent2 <- dependent[!dependent %in% mydataCategorical_variable]
source(here::here("R", "gc_plot_cat.R"))

mydataCategorical_variable <- NA
dependent2 <- NA
mydataCategorical_variable <- explanatory[14]
dependent2 <- dependent[!dependent %in% mydataCategorical_variable]
source(here::here("R", "gc_plot_cat.R"))

mydataCategorical_variable <- NA
dependent2 <- NA
mydataCategorical_variable <- explanatory[15]
dependent2 <- dependent[!dependent %in% mydataCategorical_variable]
source(here::here("R", "gc_plot_cat.R"))

mydataCategorical_variable <- NA
dependent2 <- NA
mydataCategorical_variable <- explanatory[16]
dependent2 <- dependent[!dependent %in% mydataCategorical_variable]
source(here::here("R", "gc_plot_cat.R"))

## column chart
SmartEDA::ExpCatViz(
  Carseats,
  target = "Urban",
  fname = NULL,
  clim = 10,
  col = NULL,
  margin = 2,
  Page = c(2, 1),
  sample = 2
)

## Stacked bar graph
SmartEDA::ExpCatViz(
  Carseats,
  target = "Urban",
  fname = NULL,
  clim = 10,
  col = NULL,
  margin = 2,
  Page = c(2, 1),
  sample = 2
)

## Variable importance graph using information values
SmartEDA::ExpCatStat(
  Carseats,
  Target = "Urban",
  result = "Stat",
  Pclass = "Yes",
  plot = TRUE,
  top = 20,
  Round = 2
)

inspectdf::inspect_cat(starwars) %>% inspectdf::show_plot()

inspectdf::inspect_cat(starwars) %>% 
  inspectdf::show_plot(high_cardinality = 1)

inspectdf::inspect_cat(star_1, star_2) %>% inspectdf::show_plot()

Plots

Continious Variables

# mydataContinious

mydata %>%
    select(institution, starts_with("Slide")) %>%
    pivot_longer(cols = starts_with("Slide")) %>%
    ggplot(., aes(name, value)) -> p
p + geom_jitter() 
p + geom_jitter(aes(colour = institution)) 

dxchanges <- mydata %>%
    select(bx_no, starts_with("Slide")) %>% 
    filter(complete.cases(.)) %>%
    group_by(Slide1_infiltrative, Slide2_Medium, Slide3_Demarcated) %>% 
    tally()

library(ggalluvial)

ggplot(data = dxchanges,
       aes(axis1 = Slide1_infiltrative, axis2 = Slide2_Medium, axis3 = Slide3_Demarcated,
           y = n)) +
  scale_x_discrete(limits = c("Slide1", "Slide2", "Slide3"),
                   expand = c(.1, .05)
                   ) +
  xlab("Slide") +
  geom_alluvium(aes(fill = Slide1_infiltrative,
                    colour = Slide1_infiltrative
                    )) +
  geom_stratum() +
  geom_text(stat = "stratum", label.strata = TRUE) +
  theme_minimal() +
  ggtitle("PanNET")

## Generate Boxplot by category
SmartEDA::ExpNumViz(
  mtcars,
  target = "gear",
  type = 2,
  nlim = 25,
  fname = file.path(here::here(), "Mtcars2"),
  Page = c(2, 2)
)

## Generate Density plot
SmartEDA::ExpNumViz(
  mtcars,
  target = NULL,
  type = 3,
  nlim = 25,
  fname = file.path(here::here(), "Mtcars3"),
  Page = c(2, 2)
)

## Generate Scatter plot
SmartEDA::ExpNumViz(
  mtcars,
  target = "carb",
  type = 3,
  nlim = 25,
  fname = file.path(here::here(), "Mtcars4"),
  Page = c(2, 2)
)

SmartEDA::ExpNumViz(mtcars, target = "am", scatter = TRUE)

Interactive graphics {#interactive}

---

R allows to build any type of interactive graphic. My favourite library is plotly that will turn any of your ggplot2 graphic interactive in one supplementary line of code. Try to hover points, to select a zone, to click on the legend.

library(ggplot2)
library(plotly)
library(gapminder)

p <- gapminder %>%
  filter(year==1977) %>%
  ggplot( aes(gdpPercap, lifeExp, size = pop, color=continent)) +
  geom_point() +
  scale_x_log10() +
  theme_bw()

ggplotly(p)

---

scales::show_col(colours(), cex_label = .35)

gistr::gist("https://gist.github.com/sbalci/834ebc154c0ffcb7d5899c42dd3ab75e") %>% 
  gistr::embed() -> embedgist

r embedgist

---

Alluvial

# https://stackoverflow.com/questions/43053375/weighted-sankey-alluvial-diagram-for-visualizing-discrete-and-continuous-panel/48133004

library(tidyr)
library(dplyr)
library(alluvial)
library(ggplot2)
library(forcats)

set.seed(42)
individual <- rep(LETTERS[1:10],each=2)
timeperiod <- paste0("time_",rep(1:2,10))
discretechoice <- factor(paste0("choice_",sample(letters[1:3],20, replace=T)))
continuouschoice <- ceiling(runif(20, 0, 100))
d <- data.frame(individual, timeperiod, discretechoice, continuouschoice)

# stacked bar diagram of discrete choice by individual
g <- ggplot(data=d,aes(timeperiod,fill=fct_rev(discretechoice)))
g + geom_bar(position="stack") + guides(fill=guide_legend(title=NULL))

# alluvial diagram of discrete choice by individual
d_alluvial <- d %>%
  select(individual,timeperiod,discretechoice) %>%
  spread(timeperiod,discretechoice) %>%
  group_by(time_1,time_2) %>%
  summarize(count=n()) %>%
  ungroup()
alluvial(select(d_alluvial,-count),freq=d_alluvial$count)

# stacked bar diagram of discrete choice, weighting by continuous choice
g + geom_bar(position="stack",aes(weight=continuouschoice))

library(ggalluvial)
ggplot(
  data = d,
  aes(
    x = timeperiod,
    stratum = discretechoice,
    alluvium = individual,
    y = continuouschoice
  )
) +
  geom_stratum(aes(fill = discretechoice)) +
  geom_flow()

 # use of strata and labels
ggplot(as.data.frame(Titanic),
       aes(y = Freq,axis1 = Class, axis2 = Sex, axis3 = Age)) +
  geom_flow() +
  scale_x_discrete(limits = c("Class", "Sex", "Age")) +
  geom_stratum() + 
  geom_text(stat = "stratum", infer.label = TRUE) +
  ggtitle("Alluvial plot of Titanic passenger demographic data")

# use of facets
ggplot(as.data.frame(Titanic),aes(y = Freq,axis1 = Class, axis2 = Sex)) +geom_flow(aes(fill = Age), width = .4) +geom_stratum(width = .4) +geom_text(stat = "stratum", infer.label = TRUE, size = 3) +scale_x_discrete(limits = c("Class", "Sex")) +facet_wrap(~ Survived, scales = "fixed")
# time series alluvia of WorldPhones 
wph <- as.data.frame(as.table(WorldPhones))
names(wph) <- c("Year", "Region", "Telephones")
ggplot(wph,aes(x = Year, alluvium = Region, y = Telephones)) +geom_flow(aes(fill = Region, colour = Region), width = 0)
# rightward flow aesthetics for vaccine survey datad
data(vaccinations)
levels(vaccinations$response) <- rev(levels(vaccinations$response))

ggplot(vaccinations,
       aes(x = survey, 
           stratum = response, 
           alluvium = subject,
           y = freq, 
           fill = response 
           label = round(a, 3)
           )
       ) +
  geom_lode() + 
  geom_flow() +
  geom_stratum(alpha = 0) +
  geom_text(stat = "stratum")

CD44changes <- mydata %>%
    dplyr::select(TumorCD44, TomurcukCD44, PeritumoralTomurcukGr4) %>% 
    dplyr::filter(complete.cases(.)) %>%
    dplyr::group_by(TumorCD44, TomurcukCD44, PeritumoralTomurcukGr4) %>% 
    dplyr::tally()

library(ggalluvial)

ggplot(data = CD44changes,
       aes(axis1 = TumorCD44, axis2 = TomurcukCD44,
           y = n)) +
  scale_x_discrete(limits = c("TumorCD44", "TomurcukCD44"),
                   expand = c(.1, .05)
                   ) +
  xlab("Tumor Tomurcuk") +
  geom_alluvium(aes(fill = PeritumoralTomurcukGr4,
                    colour = PeritumoralTomurcukGr4                    )) +
  geom_stratum(alpha = .5) +
  geom_text(stat = "stratum", infer.label = TRUE) +
  # geom_text(stat = 'alluvium', infer.label = TRUE) +
  theme_minimal() +
  ggtitle("Changes in CD44")

sbalci/histopathology-template documentation built on June 29, 2023, 5:52 a.m.