KaryoPlot: 0.18% of total WiCell dataset

Column

Abnormalities

Whole Gains

Partial Gains

Whole Losses

Partial Losses

---
title: "`r params$set_title`" 
author: Dylan Stavish
output: 
  flexdashboard::flex_dashboard:
    theme: cerulean
    source_code: embed
params:
  data: NULL
  data2: NULL
  output_name: NULL
  percent: NULL
  set_title: NULL
---

```{r setup, include=FALSE}
library(flexdashboard)
library(chromoMap)
library(tidyr)
library(dplyr)
library(data.table)
library(htmlwidgets)
library(readr)
library(downloadthis)
library(ggplot2)
library(plotly)
library(shiny)


##Load data (csv file name added to line below) and reformat dataframe
stats <- read_csv(params$data2)
##Clean up table, remove incompatible characters
stats$Loss <- gsub("%", "", stats$Loss)
stats$Gain <- gsub("%", "", stats$Gain)
stats <- stats %>% rename(cytogenetic_band = 'G850-Bands')
stats <- filter(stats, !grepl("p10", stats$cytogenetic_band))
stats <- filter(stats, !grepl("q10", stats$cytogenetic_band))
##Load cytoband data
cytobands <- read_csv(file="G:/My Drive/Variants/KaryoWork/ChromoMap/cytobands2.csv")

##correlate losses with cytobands and calculate max
Loss <- subset(stats, select = -c(Gain, Fusion))
Loss <- cbind(Loss[, 1], cytobands[, c("Chromosome","loc.start", "loc.end")], Loss[, 2])
Loss["loc.start"][Loss["loc.start"] == 0] <- 1
Loss <- Loss %>% rename(N = Loss)
Loss <- Loss %>% mutate(N = as.numeric(N))
LossMax <- as.numeric(max(Loss$N, na.rm = TRUE))

##correlate gains with cytobands and calculate max
Gain <- subset(stats, select = -c(Loss, Fusion))
Gain <- cbind(Gain[, 1], cytobands[, c("Chromosome", "loc.start", "loc.end")], Gain[, 2])
Gain["loc.start"][Gain["loc.start"] == 0] <- 1
Gain <- Gain %>% rename(N = Gain)
Gain <- Gain %>% mutate(N = as.numeric(N))
GainMax <- as.numeric(max(Gain$N, na.rm = TRUE))
##creat a max of both
Max <- max(GainMax, LossMax)


##CHROMOMAP###
  
#Reading in file with chromosomal/centromere coordinates to create the background
  hg_38 <- read.csv(file="G:/My Drive/Variants/KaryoWork/ChromoMap/hg38.csv", fileEncoding="UTF-8-BOM", header = FALSE)
##Set colors for plot
gains <- c("#363636","#FDFD96", "#03AC13")
losses <- c("#363636","#FDFD96", "#B90E0A")
colorlist = list(gains, losses)

##Assign chromomap function
  chromoheat <- chromoMap(list(hg_38, hg_38), list(Gain, Loss),
                          title = (params$output_name),
                              title_font_size = 12,
                             ploidy = 2, segment_annotation = TRUE,
                             chr_color = c("#363636"),
                             data_based_color_map=TRUE,
                             data_type = "numeric",
                            numeric.domain = unlist(c(0,1,(Max))),
                             aggregate_func = "max",
                             data_colors = colorlist,
                             legend = TRUE, lg_x = 100,
                             lg_y = 1000,
                              export.options = TRUE
  )
  
  ##read data
data <- read_csv(params$data)
##rename columns
names(data) <- gsub("\\(|\\)", "_", names(data))
names(data) <- gsub("gender", "sex", names(data))
  

```
### `r params$percent`

``` {r}
chromoheat
```

Column {.tabset}
-----------------------------------------------------------------------

### Abnormalities

```{r}
##abnormality type
total <- as.numeric(nrow(data))

gainyes <- data %>%
  filter(Gain == "Yes" & is.na(Loss)) %>%
  count() %>%
  as.numeric(sum())

gainonly <- round(((gainyes)/(total)*100), digits = 2)


lossyes <- data %>%
  filter(Loss == "Yes" & is.na(Gain)) %>%
  count() %>%
  as.numeric(sum())


lossonly <- round(((lossyes)/(total)*100), digits = 2)

bothyes <- data %>%
  filter(Gain == "Yes" & Loss == "Yes") %>%
  count() %>%
  as.numeric(sum())

Gain_loss <- round(((bothyes)/(total)*100), digits = 2)
iso <- round((as.numeric(length(grep("Yes", data$Isochromosome)))/(total)*100), digits = 2)
del <- round((as.numeric(length(grep("Yes", data$Deletion)))/(total)*100), digits = 2)
dup <- round((as.numeric(length(grep("Yes", data$Duplication)))/(total)*100), digits = 2)
baltran <- data %>%
  filter(Translocation == "Yes" & is.na(Gain) & is.na(Loss)) %>%
  count() %>%
  as.numeric(sum())

tran <- round(((baltran)/(total)*100), digits = 2)


##Plot 1 data
Type <- c("Gain Only", "Loss Only", "Gain+Loss", "Isochromosome", "Deletion", "Duplication", "Balanced Translocation")
Percentage <- c(gainonly, lossonly, Gain_loss, iso, del, dup, tran)
df <- data.frame(Type, Percentage)

plot1 <- plot_ly(df, x = ~Type, y = ~Percentage, type = 'bar',
                 marker = list(color = c("#008000",
                                        "#A00000",
                                        "#F2B77C",
                                        "#FF6000",
                                        "#AF69EE",
                                        "#1338BE",
                                        "#C0C0C0"),
                              opacity = rep(0.7, 7)))
config(plot1, toImageButtonOptions = list(format= 'png',
                                          scale= 3 ))%>%
                  layout(title = "Abnormalities",
                  xaxis = list(title = "", categoryarray = ~Type, categoryorder = "array"),
                  yaxis = list(title = "Percentage of Karyotypes"))
plot1
```
   
### Whole Gains

```{r}
## Calculate Whole Gains
{a1_G_ <- round((as.numeric(length(grep("x", data$`1_G_`)))/(total)*100), digits = 2)
a2_G_ <- round((as.numeric(length(grep("x", data$`2_G_`)))/(total)*100), digits = 2)
a3_G_ <- round((as.numeric(length(grep("x", data$`3_G_`)))/(total)*100), digits = 2)
a4_G_ <- round((as.numeric(length(grep("x", data$`4_G_`)))/(total)*100), digits = 2)
a5_G_ <- round((as.numeric(length(grep("x", data$`5_G_`)))/(total)*100), digits = 2)
a6_G_ <- round((as.numeric(length(grep("x", data$`6_G_`)))/(total)*100), digits = 2)
a7_G_ <- round((as.numeric(length(grep("x", data$`7_G_`)))/(total)*100), digits = 2)
a8_G_ <- round((as.numeric(length(grep("x", data$`8_G_`)))/(total)*100), digits = 2)
a9_G_ <- round((as.numeric(length(grep("x", data$`9_G_`)))/(total)*100), digits = 2)
a10_G_ <- round((as.numeric(length(grep("x", data$`10_G_`)))/(total)*100), digits = 2)
a11_G_ <- round((as.numeric(length(grep("x", data$`11_G_`)))/(total)*100), digits = 2)
a12_G_ <- round((as.numeric(length(grep("x", data$`12_G_`)))/(total)*100), digits = 2)
a13_G_ <- round((as.numeric(length(grep("x", data$`13_G_`)))/(total)*100), digits = 2)
a14_G_ <- round((as.numeric(length(grep("x", data$`14_G_`)))/(total)*100), digits = 2)
a15_G_ <- round((as.numeric(length(grep("x", data$`15_G_`)))/(total)*100), digits = 2)
a16_G_ <- round((as.numeric(length(grep("x", data$`16_G_`)))/(total)*100), digits = 2)
a17_G_ <- round((as.numeric(length(grep("x", data$`17_G_`)))/(total)*100), digits = 2)
a18_G_ <- round((as.numeric(length(grep("x", data$`18_G_`)))/(total)*100), digits = 2)
a19_G_ <- round((as.numeric(length(grep("x", data$`19_G_`)))/(total)*100), digits = 2)
a20_G_ <- round((as.numeric(length(grep("x", data$`20_G_`)))/(total)*100), digits = 2)
a21_G_ <- round((as.numeric(length(grep("x", data$`21_G_`)))/(total)*100), digits = 2)
a22_G_ <- round((as.numeric(length(grep("x", data$`22_G_`)))/(total)*100), digits = 2)
aX_G_ <- round((as.numeric(length(grep("x", data$`X_G_`)))/(total)*100), digits = 2)
aY_G_ <- round((as.numeric(length(grep("x", data$`Y_G_`)))/(total)*100), digits = 2)
}

##WHOLE GAINS TABLE
{Chromosome <- c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "X", "Y")
Percent <- c(a1_G_,
                a2_G_,
                a3_G_,
                a4_G_,
                a5_G_,
                a6_G_,
                a7_G_,
                a8_G_,
                a9_G_,
                a10_G_,
                a11_G_,
                a12_G_,
                a13_G_,
                a14_G_,
                a15_G_,
               a16_G_,
                a17_G_,
                a18_G_,
                a19_G_,
                a20_G_,
                a21_G_,
                a22_G_,
                aX_G_,
                aY_G_)}
df2 <- data.frame(Chromosome, Percent)

plot2 <- plot_ly(df2, x = ~Chromosome, y = ~Percent, type = 'bar', marker = list(color = '#03AC13'))
config(plot2, toImageButtonOptions = list(format= 'png',
                                          scale= 3 ))%>%
  layout(title = "Whole Chromosome Gains",
         xaxis = list(title = "Chromosome", categoryarray = ~Chromosome, categoryorder = "array"),
         yaxis = list(title = "Percentage of Karyotypes"))
plot2

```   
 
### Partial Gains
    
```{r}
##Calculate partial Gains
{a1p_G_ <- round((as.numeric(length(grep("x", data$`1p_G_`)))/(total)*100), digits = 2)
a1q_G_ <- round((as.numeric(length(grep("x", data$`1q_G_`)))/(total)*100), digits = 2)
a2p_G_ <- round((as.numeric(length(grep("x", data$`2p_G_`)))/(total)*100), digits = 2)
a2q_G_ <- round((as.numeric(length(grep("x", data$`2q_G_`)))/(total)*100), digits = 2)
a3p_G_ <- round((as.numeric(length(grep("x", data$`3p_G_`)))/(total)*100), digits = 2)
a3q_G_ <- round((as.numeric(length(grep("x", data$`3q_G_`)))/(total)*100), digits = 2)
a4p_G_ <- round((as.numeric(length(grep("x", data$`4p_G_`)))/(total)*100), digits = 2)
a4q_G_ <- round((as.numeric(length(grep("x", data$`4q_G_`)))/(total)*100), digits = 2)
a5p_G_ <- round((as.numeric(length(grep("x", data$`5p_G_`)))/(total)*100), digits = 2)
a5q_G_ <- round((as.numeric(length(grep("x", data$`5q_G_`)))/(total)*100), digits = 2)
a6p_G_ <- round((as.numeric(length(grep("x", data$`6p_G_`)))/(total)*100), digits = 2)
a6q_G_ <- round((as.numeric(length(grep("x", data$`6q_G_`)))/(total)*100), digits = 2)
a7p_G_ <- round((as.numeric(length(grep("x", data$`7p_G_`)))/(total)*100), digits = 2)
a7q_G_ <- round((as.numeric(length(grep("x", data$`7q_G_`)))/(total)*100), digits = 2)
a8p_G_ <- round((as.numeric(length(grep("x", data$`8p_G_`)))/(total)*100), digits = 2)
a8q_G_ <- round((as.numeric(length(grep("x", data$`8q_G_`)))/(total)*100), digits = 2)
a9p_G_ <- round((as.numeric(length(grep("x", data$`9p_G_`)))/(total)*100), digits = 2)
a9q_G_ <- round((as.numeric(length(grep("x", data$`9q_G_`)))/(total)*100), digits = 2)
a10p_G_ <- round((as.numeric(length(grep("x", data$`10p_G_`)))/(total)*100), digits = 2)
a10q_G_ <- round((as.numeric(length(grep("x", data$`10q_G_`)))/(total)*100), digits = 2)
a11p_G_ <- round((as.numeric(length(grep("x", data$`11p_G_`)))/(total)*100), digits = 2)
a11q_G_ <- round((as.numeric(length(grep("x", data$`11q_G_`)))/(total)*100), digits = 2)
a12p_G_ <- round((as.numeric(length(grep("x", data$`12p_G_`)))/(total)*100), digits = 2)
a12q_G_ <- round((as.numeric(length(grep("x", data$`12q_G_`)))/(total)*100), digits = 2)
a13p_G_ <- round((as.numeric(length(grep("x", data$`13p_G_`)))/(total)*100), digits = 2)
a13q_G_ <- round((as.numeric(length(grep("x", data$`13q_G_`)))/(total)*100), digits = 2)
a14p_G_ <- round((as.numeric(length(grep("x", data$`14p_G_`)))/(total)*100), digits = 2)
a14q_G_ <- round((as.numeric(length(grep("x", data$`14q_G_`)))/(total)*100), digits = 2)
a15p_G_ <- round((as.numeric(length(grep("x", data$`15p_G_`)))/(total)*100), digits = 2)
a15q_G_ <- round((as.numeric(length(grep("x", data$`15q_G_`)))/(total)*100), digits = 2)
a16p_G_ <- round((as.numeric(length(grep("x", data$`16p_G_`)))/(total)*100), digits = 2)
a16q_G_ <- round((as.numeric(length(grep("x", data$`16q_G_`)))/(total)*100), digits = 2)
a17p_G_ <- round((as.numeric(length(grep("x", data$`17p_G_`)))/(total)*100), digits = 2)
a17q_G_ <- round((as.numeric(length(grep("x", data$`17q_G_`)))/(total)*100), digits = 2)
a18p_G_ <- round((as.numeric(length(grep("x", data$`18p_G_`)))/(total)*100), digits = 2)
a18q_G_ <- round((as.numeric(length(grep("x", data$`18q_G_`)))/(total)*100), digits = 2)
a19p_G_ <- round((as.numeric(length(grep("x", data$`19p_G_`)))/(total)*100), digits = 2)
a19q_G_ <- round((as.numeric(length(grep("x", data$`19q_G_`)))/(total)*100), digits = 2)
a20p_G_ <- round((as.numeric(length(grep("x", data$`20p_G_`)))/(total)*100), digits = 2)
a20q_G_ <- round((as.numeric(length(grep("x", data$`20q_G_`)))/(total)*100), digits = 2)
a21p_G_ <- round((as.numeric(length(grep("x", data$`21p_G_`)))/(total)*100), digits = 2)
a21q_G_ <- round((as.numeric(length(grep("x", data$`21q_G_`)))/(total)*100), digits = 2)
a22p_G_ <- round((as.numeric(length(grep("x", data$`22p_G_`)))/(total)*100), digits = 2)
a22q_G_ <- round((as.numeric(length(grep("x", data$`22q_G_`)))/(total)*100), digits = 2)
aXp_G_ <- round((as.numeric(length(grep("x", data$`Xp_G_`)))/(total)*100), digits = 2)
aXq_G_ <- round((as.numeric(length(grep("x", data$`Xq_G_`)))/(total)*100), digits = 2)
aYp_G_ <- round((as.numeric(length(grep("x", data$`Yp_G_`)))/(total)*100), digits = 2)
aYq_G_ <- round((as.numeric(length(grep("x", data$`Yq_G_`)))/(total)*100), digits = 2)}
{p <- c(a1p_G_,
             a2p_G_,
             a3p_G_,
             a4p_G_,
             a5p_G_,
             a6p_G_,
             a7p_G_,
             a8p_G_,
             a9p_G_,
             a10p_G_,
             a11p_G_,
             a12p_G_,
             a13p_G_,
             a14p_G_,
             a15p_G_,
             a16p_G_,
             a17p_G_,
             a18p_G_,
             a19p_G_,
             a20p_G_,
             a21p_G_,
             a22p_G_,
             aXp_G_,
             aYp_G_)
q <- c(a1q_G_,
       a2q_G_,
       a3q_G_,
       a4q_G_,
       a5q_G_,
       a6q_G_,
       a7q_G_,
       a8q_G_,
       a9q_G_,
       a10q_G_,
       a11q_G_,
       a12q_G_,
       a13q_G_,
       a14q_G_,
       a15q_G_,
       a16q_G_,
       a17q_G_,
       a18q_G_,
       a19q_G_,
       a20q_G_,
       a21q_G_,
       a22q_G_,
       aXq_G_,
       aYq_G_)
}

df3 <- data.frame(Chromosome, p, q)

plot3 <- plot_ly(df3, x = ~Chromosome, y = ~p, type = 'bar', name = 'p', marker = list(color = '#3DED97')) %>%
  add_trace(y = ~q, name = 'q', marker = list(color = '#028A0F'))
config(plot3, toImageButtonOptions = list(format= 'png',
                                          scale= 3 ))%>%
  layout(title = "Partial Gains",
         xaxis = list(title = "Chromosome", categoryarray = ~Chromosome, categoryorder = "array"),
         yaxis = list(title = "Percentage of Karyotypes"), barmode = 'group')
plot3
```

### Whole Losses
```{r}
## Calculate Whole Losses
{a1_L_ <- round((as.numeric(length(grep("x", data$`1_L_`)))/(total)*100), digits = 2)
  a2_L_ <- round((as.numeric(length(grep("x", data$`2_L_`)))/(total)*100), digits = 2)
  a3_L_ <- round((as.numeric(length(grep("x", data$`3_L_`)))/(total)*100), digits = 2)
  a4_L_ <- round((as.numeric(length(grep("x", data$`4_L_`)))/(total)*100), digits = 2)
  a5_L_ <- round((as.numeric(length(grep("x", data$`5_L_`)))/(total)*100), digits = 2)
  a6_L_ <- round((as.numeric(length(grep("x", data$`6_L_`)))/(total)*100), digits = 2)
  a7_L_ <- round((as.numeric(length(grep("x", data$`7_L_`)))/(total)*100), digits = 2)
  a8_L_ <- round((as.numeric(length(grep("x", data$`8_L_`)))/(total)*100), digits = 2)
  a9_L_ <- round((as.numeric(length(grep("x", data$`9_L_`)))/(total)*100), digits = 2)
  a10_L_ <- round((as.numeric(length(grep("x", data$`10_L_`)))/(total)*100), digits = 2)
  a11_L_ <- round((as.numeric(length(grep("x", data$`11_L_`)))/(total)*100), digits = 2)
  a12_L_ <- round((as.numeric(length(grep("x", data$`12_L_`)))/(total)*100), digits = 2)
  a13_L_ <- round((as.numeric(length(grep("x", data$`13_L_`)))/(total)*100), digits = 2)
  a14_L_ <- round((as.numeric(length(grep("x", data$`14_L_`)))/(total)*100), digits = 2)
  a15_L_ <- round((as.numeric(length(grep("x", data$`15_L_`)))/(total)*100), digits = 2)
  a16_L_ <- round((as.numeric(length(grep("x", data$`16_L_`)))/(total)*100), digits = 2)
  a17_L_ <- round((as.numeric(length(grep("x", data$`17_L_`)))/(total)*100), digits = 2)
  a18_L_ <- round((as.numeric(length(grep("x", data$`18_L_`)))/(total)*100), digits = 2)
  a19_L_ <- round((as.numeric(length(grep("x", data$`19_L_`)))/(total)*100), digits = 2)
  a20_L_ <- round((as.numeric(length(grep("x", data$`20_L_`)))/(total)*100), digits = 2)
  a21_L_ <- round((as.numeric(length(grep("x", data$`21_L_`)))/(total)*100), digits = 2)
  a22_L_ <- round((as.numeric(length(grep("x", data$`22_L_`)))/(total)*100), digits = 2)
  aX_L_ <- round((as.numeric(length(grep("x", data$`X_L_`)))/(total)*100), digits = 2)
  aY_L_ <- round((as.numeric(length(grep("x", data$`Y_L_`)))/(total)*100), digits = 2)
}

##WHOLE Losses TABLE
{Chromosome <- c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "X", "Y")
  Percent <- c(a1_L_,
               a2_L_,
               a3_L_,
               a4_L_,
               a5_L_,
               a6_L_,
               a7_L_,
               a8_L_,
               a9_L_,
               a10_L_,
               a11_L_,
               a12_L_,
               a13_L_,
               a14_L_,
               a15_L_,
               a16_L_,
               a17_L_,
               a18_L_,
               a19_L_,
               a20_L_,
               a21_L_,
               a22_L_,
               aX_L_,
               aY_L_)}
df4 <- data.frame(Chromosome, Percent)

plot4 <- plot_ly(df4, x = ~Chromosome, y = ~Percent, type = 'bar', marker = list(color = '#e93e3a'))
config(plot4, toImageButtonOptions = list(format= 'png',
                                          scale= 3 ))%>%
  layout(title = "Whole Chromosome Losses",
         xaxis = list(title = "Chromosome", categoryarray = ~Chromosome, categoryorder = "array"),
         yaxis = list(title = "Percentage of Karyotypes"))
plot4
```

### Partial Losses

```{r}
##Calculate partial Loss
{a1p_L_ <- round((as.numeric(length(grep("x", data$`1p_L_`)))/(total)*100), digits = 2)
  a1q_L_ <- round((as.numeric(length(grep("x", data$`1q_L_`)))/(total)*100), digits = 2)
  a2p_L_ <- round((as.numeric(length(grep("x", data$`2p_L_`)))/(total)*100), digits = 2)
  a2q_L_ <- round((as.numeric(length(grep("x", data$`2q_L_`)))/(total)*100), digits = 2)
  a3p_L_ <- round((as.numeric(length(grep("x", data$`3p_L_`)))/(total)*100), digits = 2)
  a3q_L_ <- round((as.numeric(length(grep("x", data$`3q_L_`)))/(total)*100), digits = 2)
  a4p_L_ <- round((as.numeric(length(grep("x", data$`4p_L_`)))/(total)*100), digits = 2)
  a4q_L_ <- round((as.numeric(length(grep("x", data$`4q_L_`)))/(total)*100), digits = 2)
  a5p_L_ <- round((as.numeric(length(grep("x", data$`5p_L_`)))/(total)*100), digits = 2)
  a5q_L_ <- round((as.numeric(length(grep("x", data$`5q_L_`)))/(total)*100), digits = 2)
  a6p_L_ <- round((as.numeric(length(grep("x", data$`6p_L_`)))/(total)*100), digits = 2)
  a6q_L_ <- round((as.numeric(length(grep("x", data$`6q_L_`)))/(total)*100), digits = 2)
  a7p_L_ <- round((as.numeric(length(grep("x", data$`7p_L_`)))/(total)*100), digits = 2)
  a7q_L_ <- round((as.numeric(length(grep("x", data$`7q_L_`)))/(total)*100), digits = 2)
  a8p_L_ <- round((as.numeric(length(grep("x", data$`8p_L_`)))/(total)*100), digits = 2)
  a8q_L_ <- round((as.numeric(length(grep("x", data$`8q_L_`)))/(total)*100), digits = 2)
  a9p_L_ <- round((as.numeric(length(grep("x", data$`9p_L_`)))/(total)*100), digits = 2)
  a9q_L_ <- round((as.numeric(length(grep("x", data$`9q_L_`)))/(total)*100), digits = 2)
  a10p_L_ <- round((as.numeric(length(grep("x", data$`10p_L_`)))/(total)*100), digits = 2)
  a10q_L_ <- round((as.numeric(length(grep("x", data$`10q_L_`)))/(total)*100), digits = 2)
  a11p_L_ <- round((as.numeric(length(grep("x", data$`11p_L_`)))/(total)*100), digits = 2)
  a11q_L_ <- round((as.numeric(length(grep("x", data$`11q_L_`)))/(total)*100), digits = 2)
  a12p_L_ <- round((as.numeric(length(grep("x", data$`12p_L_`)))/(total)*100), digits = 2)
  a12q_L_ <- round((as.numeric(length(grep("x", data$`12q_L_`)))/(total)*100), digits = 2)
  a13p_L_ <- round((as.numeric(length(grep("x", data$`13p_L_`)))/(total)*100), digits = 2)
  a13q_L_ <- round((as.numeric(length(grep("x", data$`13q_L_`)))/(total)*100), digits = 2)
  a14p_L_ <- round((as.numeric(length(grep("x", data$`14p_L_`)))/(total)*100), digits = 2)
  a14q_L_ <- round((as.numeric(length(grep("x", data$`14q_L_`)))/(total)*100), digits = 2)
  a15p_L_ <- round((as.numeric(length(grep("x", data$`15p_L_`)))/(total)*100), digits = 2)
  a15q_L_ <- round((as.numeric(length(grep("x", data$`15q_L_`)))/(total)*100), digits = 2)
  a16p_L_ <- round((as.numeric(length(grep("x", data$`16p_L_`)))/(total)*100), digits = 2)
  a16q_L_ <- round((as.numeric(length(grep("x", data$`16q_L_`)))/(total)*100), digits = 2)
  a17p_L_ <- round((as.numeric(length(grep("x", data$`17p_L_`)))/(total)*100), digits = 2)
  a17q_L_ <- round((as.numeric(length(grep("x", data$`17q_L_`)))/(total)*100), digits = 2)
  a18p_L_ <- round((as.numeric(length(grep("x", data$`18p_L_`)))/(total)*100), digits = 2)
  a18q_L_ <- round((as.numeric(length(grep("x", data$`18q_L_`)))/(total)*100), digits = 2)
  a19p_L_ <- round((as.numeric(length(grep("x", data$`19p_L_`)))/(total)*100), digits = 2)
  a19q_L_ <- round((as.numeric(length(grep("x", data$`19q_L_`)))/(total)*100), digits = 2)
  a20p_L_ <- round((as.numeric(length(grep("x", data$`20p_L_`)))/(total)*100), digits = 2)
  a20q_L_ <- round((as.numeric(length(grep("x", data$`20q_L_`)))/(total)*100), digits = 2)
  a21p_L_ <- round((as.numeric(length(grep("x", data$`21p_L_`)))/(total)*100), digits = 2)
  a21q_L_ <- round((as.numeric(length(grep("x", data$`21q_L_`)))/(total)*100), digits = 2)
  a22p_L_ <- round((as.numeric(length(grep("x", data$`22p_L_`)))/(total)*100), digits = 2)
  a22q_L_ <- round((as.numeric(length(grep("x", data$`22q_L_`)))/(total)*100), digits = 2)
  aXp_L_ <- round((as.numeric(length(grep("x", data$`Xp_L_`)))/(total)*100), digits = 2)
  aXq_L_ <- round((as.numeric(length(grep("x", data$`Xq_L_`)))/(total)*100), digits = 2)
  aYp_L_ <- round((as.numeric(length(grep("x", data$`Yp_L_`)))/(total)*100), digits = 2)
  aYq_L_ <- round((as.numeric(length(grep("x", data$`Yq_L_`)))/(total)*100), digits = 2)}
{p <- c(a1p_L_,
        a2p_L_,
        a3p_L_,
        a4p_L_,
        a5p_L_,
        a6p_L_,
        a7p_L_,
        a8p_L_,
        a9p_L_,
        a10p_L_,
        a11p_L_,
        a12p_L_,
        a13p_L_,
        a14p_L_,
        a15p_L_,
        a16p_L_,
        a17p_L_,
        a18p_L_,
        a19p_L_,
        a20p_L_,
        a21p_L_,
        a22p_L_,
        aXp_L_,
        aYp_L_)
  q <- c(a1q_L_,
         a2q_L_,
         a3q_L_,
         a4q_L_,
         a5q_L_,
         a6q_L_,
         a7q_L_,
         a8q_L_,
         a9q_L_,
         a10q_L_,
         a11q_L_,
         a12q_L_,
         a13q_L_,
         a14q_L_,
         a15q_L_,
         a16q_L_,
         a17q_L_,
         a18q_L_,
         a19q_L_,
         a20q_L_,
         a21q_L_,
         a22q_L_,
         aXq_L_,
         aYq_L_)
}

df5 <- data.frame(Chromosome, p, q)

plot5 <- plot_ly(df4, x = ~Chromosome, y = ~p, type = 'bar', name = 'p', marker = list(color = '#F08072')) %>%
  add_trace(y = ~q, name = 'q', marker = list(color = '#800000'))
config(plot5, toImageButtonOptions = list(format= 'png',
                                          scale= 3 ))%>%
  layout(title = "Partial Losses",
         xaxis = list(title = "Chromosome", categoryarray = ~Chromosome, categoryorder = "array"),
         yaxis = list(title = "Percentage of Karyotypes"), barmode = 'group')
plot5
```


### Download

```{r}
stats %>% download_this(
    output_name = "G-Band Percentages",
    output_extension = ".xlsx",
    button_label = "Download G-Band Percentages as Excel",
    button_type = "default",
    has_icon = TRUE,
    icon = "fa fa-save"
  )

data %>% download_this(
    output_name = "Annotated Karyotypes",
    output_extension = ".xlsx",
    button_label = "Download Annotated Karyotypes as Excel",
    button_type = "default",
    has_icon = TRUE,
    icon = "fa fa-save"
  )
```