#turn off messages and warnings and make it so output isn't prefixed by anything, #default is to put "##" in front of all output for some reason #also set tidy to true so code is wrapped properly knitr :: opts_chunk $ set ( message= FALSE , warning= FALSE , comment = "" , cache = F , fig.align = "center" ) options ( width = 200 ) options ( readr.show_col_types = FALSE ) packagesUsed = c ( "GGally" , "DT" , "ggplot2" , "stringr" , "tidyverse" , "stringr" , 'bookdown' ,
'knitr' , 'rmarkdown' , "finalfit" ,
"heatmaply" , "cowplot" ,
"fastmatch" , "rwantshue" , "lubridate" ,
"plotly" , "ggnewscale" , "ggtree" , "ggtreeExtra" , "ComplexHeatmap" ,
"dendextend" , "magrittr" , "ggpmisc" ,
"ggthemes" , "ggridges" , "HaplotypeRainbows" , "ggdist" ,
"here" )
# oldw <- getOption("warn") # oldmessage <- getOption("message") # options(warn = -1, message = -1) suppressMessages ( lapply ( packagesUsed , require , character.only = TRUE ) ) #loaded = lapply(packagesUsed, require, character.only = TRUE) # options(warn = oldw, message = oldmessage) myFormula = x ~ y # commonly used functions `%!in%` <- Negate ( `%in%` ) is.notna <- function ( x ) { return ( ! is.na ( x ) )
} scheme <- iwanthue ( seed = 42 , force_init = TRUE ) palettes <- ggthemes_data [[ "tableau" ] ] [[ "color-palettes" ] ] [[ "regular" ] ] # ggplot themes transparentBackground = theme ( panel.background = element_rect ( fill= 'transparent' ) , #transparent panel bg
plot.background = element_rect ( fill= 'transparent' , color= NA ) , #transparent plot bg
panel.grid.major = element_blank ( ) , #remove major gridlines
panel.grid.minor = element_blank ( ) , #remove minor gridlines
legend.background = element_rect ( color = NA , fill= 'transparent' ) , #transparent legend bg
legend.box.background = element_rect ( color = NA , fill= 'transparent' ) #transparent legend panel
) sofonias_theme_noTransparentBackground = theme_bw ( ) + theme ( panel.grid.major = element_blank ( ) ,panel.grid.minor = element_blank ( ) ) +
theme ( axis.line.x = element_line ( color= "black" , linewidth = 0.3 ) ,axis.line.y =
element_line ( color= "black" , linewidth = 0.3 ) ) +
theme ( text= element_text ( size= 12 , family= "Helvetica" ) ) +
theme ( axis.text.y = element_text ( size= 12 ) ) +
theme ( axis.text.x = element_text ( size= 12 ) ) +
theme ( legend.position = "bottom" ) +
theme ( plot.title = element_text ( hjust = 0.5 ) )
sofonias_theme = sofonias_theme_noTransparentBackground + transparentBackground
sofonias_theme_backgroundTransparent = sofonias_theme sofonias_theme_xRotate_noBackgroundTransparent = theme_bw ( ) + theme ( panel.grid.major = element_blank ( ) ,panel.grid.minor = element_blank ( ) ) +
theme ( axis.line.x = element_line ( color= "black" , linewidth = 0.3 ) ,axis.line.y =
element_line ( color= "black" , linewidth = 0.3 ) ) +
theme ( text= element_text ( size= 12 , family= "Helvetica" ) ) +
theme ( axis.text.y = element_text ( size= 12 ) ) +
theme ( axis.text.x = element_text ( size= 12 ) ) +
theme ( legend.position = "bottom" ) +
theme ( plot.title = element_text ( hjust = 0.5 ) ) +
theme ( axis.text.x = element_text ( size= 12 , angle = - 90 , vjust = 0.5 , hjust = 0 ) )
sofonias_theme_xRotate = sofonias_theme_xRotate_noBackgroundTransparent + transparentBackground
sofonias_theme_xRotate_backgroundTransparent = sofonias_theme_xRotate colorPalette_08 = c ( "#2271B2" ,"#F748A5" ,"#359B73" ,"#F0E442" ,"#D55E00" ,"#3DB7E9" ,"#E69F00" ,"#000000" ) colorPalette_12 = c ( "#E20134" ,"#FF6E3A" ,"#008DF9" ,"#8400CD" ,"#FFC33B" ,"#9F0162" ,"#009F81" ,"#FF5AAF" ,"#00FCCF" ,"#00C2F9" ,"#FFB2FD" ,"#A40122" ) colorPalette_15 = c ( "#F60239" ,"#003C86" ,"#EF0096" ,"#9400E6" ,"#009FFA" ,"#008169" ,"#68023F" ,"#00DCB5" ,"#FFCFE2" ,"#FF71FD" ,"#7CFFFA" ,"#6A0213" ,"#008607" ,"#00E307" ,"#FFDC3D" ) # "#9E0242" # "#A40122" rowAnnoColorsMod_hrp3DeletionPattern = c ( "13-11++" = "#8400CD" ,
"11++/13-" = "#8400CD" ,
"11/13-TARE1" = "#003C86" ,
"13-TARE1" = "#003C86" ,
"11/13-" = "#008DF9" ,
"13-" = "#008DF9" ,
"11-/13" = "#9F0162" ,
"11-TARE1/13" = "#EF0096" ,
"11-TARE1" = "#EF0096" ,
"13++11-" = "#6A0213" ,
"5++/13-" = "#FF6E3A" ,
"13-5++" = "#FF6E3A" ,
"8-TARE1" = "#00DCB5"
#, "13++11-" = "#F60239"
) # 5, 3, 7, 6, 6, 2, 8, 7, 3 haplotypeRankColors = c ( "-1" = "black" ,
"1" = "#A40122" ,
"2" = "#FF6E3A" ,
"3" = "#008DF9" ,
"4" = "#8400CD" ,
"5" = "#FFC33B" ,
"6" = "#00FCCF" ,
"7" = "#009F81" ,
"8" = "#FF5AAF"
) continentColors = c ( "AFRICA" = "#E69F00" ,
"ASIA" = "#F0E442" ,
"OCEANIA" = "#F748A5" ,
"S_AMERICA" = "#0072B2"
) pfhrpsCallColors = c ( "pfhrp2-/pfhrp3+" = "#68023F" , "pfhrp2-/pfhrp3-" = "#F60239" , "pfhrp2+/pfhrp3-" = "#009FFA" , "pfhrp2+/pfhrp3+" = "#003C86" ) createColorListFromDf <- function ( df , colorPalette = colorPalette_12 , iwanthudSeed = rnorm ( 1 ) * 100 ) { colorList = list ( )
for ( dfColname in colnames ( df ) ) {
levels = sort ( unique ( df [[ dfColname ] ] ) )
scheme <- iwanthue ( seed = iwanthudSeed , force_init = TRUE )
if ( length ( levels ) <= length ( colorPalette_12 ) ) {
levelsCols = colorPalette_12 [ 1 : length ( levels ) ]
} else {
levelsCols = scheme $ hex ( length ( levels ) )
}
names ( levelsCols ) = levels
colorList [[ dfColname ] ] = levelsCols
}
return ( colorList )
} createDownloadLink <- function ( fnp , linkName = "" ) { relToHere = sub ( here ( ) ,"" ,normalizePath ( getwd ( ) ) , fixed = T )
depth = stringr :: str_count ( relToHere , "/" )
prefix = ""
if ( depth > 0 ) {
prefix = paste0 ( paste0 ( rep ( ".." ,depth ) , collapse = "/" ) , "/" )
}
if ( "" == linkName ) {
linkName = basename ( fnp )
}
return ( paste0 ( "[" , linkName , "]" , "(" , paste0 ( prefix , gsub ( paste0 ( here ( ) ,"/" ) ,"" ,normalizePath ( fnp ) , fixed = T ) ) , "){.downloadLink .btn .btn-info}" ) )
} createImgLink <- function ( fnp , linkName = "" ) { relToHere = sub ( here ( ) , "" , normalizePath ( getwd ( ) ) , fixed = T )
depth = stringr :: str_count ( relToHere , "/" )
prefix = ""
if ( depth > 0 ) {
prefix = paste0 ( paste0 ( rep ( ".." ,depth ) , collapse = "/" ) , "/" )
}
if ( "" == linkName ) {
linkName = basename ( fnp )
}
return ( paste0 ( "![" , linkName , "]" , "(" , paste0 ( prefix , gsub ( paste0 ( here ( ) ,"/" ) ,"" ,normalizePath ( fnp ) , fixed = T ) ) , ")" ) )
} create_dt <- function ( x ) { DT :: datatable ( x ,
extensions = 'Buttons' ,
options = list ( dom = 'Blfrtip' ,
buttons = c ( 'copy' , 'csv' , 'excel' , 'pdf' , 'print' ) ,
lengthMenu = list ( c ( 10 ,25 ,50 ,- 1 ) ,
c ( 10 ,25 ,50 ,"All" ) ) ) ,
filter = "top" )
} create_tabsetOfHtmlWidgets <- function ( htmlObjectsList ) { zz <- textConnection ( "foo" , "w" )
sink ( zz )
cat ( "::: {.panel-tabset}\n" )
iwalk ( htmlObjectsList , ~ {
cat ( '## ' , .y , '\n\n' )
tempList = list ( )
tempList [[ "item" ] ] = .x
print ( htmltools :: tagList ( tempList ) )
cat ( '\n\n' )
} )
cat ( ":::\n" )
sink ( )
close ( zz )
paste0 ( foo , collapse = "\n" )
} subRegionOrder = c ( "South America" , "West Africa" , "Central Africa" , "East Africa" , "Oceania-SEA" )