Dynamic Heatmap for regimens Arm 1,3,5

library(ggplot2)
library(plotly)

## Warning: package 'plotly' was built under R version 4.0.3

## 
## Attaching package: 'plotly'

## The following object is masked from 'package:ggplot2':
## 
##     last_plot

## The following object is masked from 'package:stats':
## 
##     filter

## The following object is masked from 'package:graphics':
## 
##     layout

library(shiny)

## Warning: package 'shiny' was built under R version 4.0.3

library(reshape2)
library(highcharter)

## Warning: package 'highcharter' was built under R version 4.0.3

## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo

## Highcharts (www.highcharts.com) is a Highsoft software product which is

## not free for commercial and Governmental use

library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(purrr)

For dynamic heatmap the variable name of the list MUST be “sequence” #mock up data contains 5 missing in arm1, 4 missing in arm3, 2 missing in arm5

regimen$misInarm5<-paste0("m",regimen$arm5 )

regimen$Max_Pval<-round(regimen$max_Pval,4)
regwide<-dcast(regimen, arm1+arm3~misInarm5, value.var="max_Pval" )

reg_start<-regwide[,c(1,2,3)]

reg_seqc <- regimen %>% group_by(arm1,arm3) %>% do(sequence = list_parse(select(., 
  value = Max_Pval)))
reg_seqc

regfinal<- left_join(reg_start,reg_seqc)

## Joining, by = c("arm1", "arm3")

regfinal

save(regfinal, file="regfinal.RData")

limits <- (unlist(regimen$max_Pval)) %>% {
  c(min(.), max(.))
}
limits

## [1] 0.000327746 0.085500000

# con_colr<-list( list(0, '#FF5733'),
#                     list(0.05, '#fcfafa'),
#                     list(0.1, '#2E86C1'))

  cor_colr <- list( list(0, '#F8F5F5'),
                    list(0.05, '#FF5733'),
                    list(0.1, '#2E86C1')
)

 # fntltp <- JS("function(){
 #                  return this.series.xAxis.categories[this.point.x] + ' ~ ' +
 #                         this.series.yAxis.categories[this.point.y] + ': <b>' +
 #                         Highcharts.numberFormat(this.point.value, 2)+'</b>';
 #               ; }")

hc2 <- hchart(regfinal, type = "heatmap", hcaes(x = arm1, y =arm3, value = m0)) %>%
  hc_motion(enabled = TRUE, series = 0, startIndex = 0, labels = c("arm5: missing 0 observation", "arm5: missing 1 observations","arm5: missing 2 observations")) %>% 
  #hc_colorAxis(min = limits[1], max = limits[2])%>%
  #hc_colorAxis(  stops= con_colr,min=limits[1],max=limits[2])%>%
  #hc_colorAxis(  stops=color_stops(3,c("red", "white","blue")))%>%
  #hc_colors(list('#FF5733', '#fcfafa', '#2E86C1') )%>%
  hc_colorAxis(dataClasses=color_classes(c(limits[1],0.01,0.05, limits[2]), c("#21b9eb","#F8F5F5","#eb7521", "#f54636")))%>%
  hc_plotOptions(
           series = list(
             borderColor = "#fcfbfa",
             borderWidth = 1,
             animation=(durtion=1000),
              dataLabels = list(enabled = TRUE)
    )) %>%
  # hc_tooltip(formatter = fntltp) %>% 
    hc_legend(align = "right", layout = "vertical",
              margin = 0, verticalAlign = "top",
              y = 25, symbolHeight = 10,
              #set symbole to square instead of circle
              symbolRadius=0)%>%

hc_xAxis(title=list(text="arm1"))%>%
  hc_yAxis(title=list(text="arm3") )
 

hc2

Technical reference: https://cran.r-project.org/web/packages/highcharter/highcharter.pdf https://www.rdocumentation.org/packages/highcharter/versions/0.8.2/topics/color_classes https://rstudio-pubs-static.s3.amazonaws.com/176226_3ccc102076e545eeb8f68a71ed35983d.html