LSHTM_analysis/scripts/functions/bp_subcolours.R
2022-08-10 11:06:13 +01:00

154 lines
6 KiB
R
Executable file

#########################################################
# 1b: Define function: coloured barplot by subgroup
# LINK: https://stackoverflow.com/questions/49818271/stacked-barplot-with-colour-gradients-for-each-bar
#########################################################
#source("~/git/LSHTM_analysis/scripts/functions/generate_distance_colour_map.R")
ColourPalleteMulti = function(df, group, subgroup){
# Find how many colour categories to create and the number of colours in each
categories <- aggregate(as.formula(paste(subgroup, group, sep="~" ))
, df
, function(x) length(unique(x)))
# return(categories) }
category.start <- (scales::hue_pal(l = 100)(nrow(categories))) # Set the top of the colour pallete
category.end <- (scales::hue_pal(l = 40)(nrow(categories))) # set the bottom
#return(category.start); return(category.end)}
# Build Colour pallette
colours <- unlist(lapply(1:nrow(categories),
function(i){
colorRampPalette(colors = c(category.start[i]
, category.end[i]))(categories[i,2])}))
return(colours)
}
#########################################################################
########################
# Generate bp with
# colour palette derived
# from the data using
# above function
#########################
bp_stability_hmap <- function(plot_df = merged_df3
, xvar_colname = "position"
, yvar_colname = 'duet_scaled' #FIXME: temp, remove
#, bar_col_colname = "group"
, stability_colname = "duet_scaled"
, stability_outcome_colname = "duet_outcome"
, p_title = "DUET" # "Protein stability (DUET)"
, my_xaxls = 12 # x-axis label size
, my_yaxls = 20 # y-axis label size
, my_xaxts = 18 # x-axis text size
, my_yaxts = 20 # y-axis text size
, my_pts = 20 # plot-title size
, my_xlab = "Position"
, my_ylab = "No. of nsSNPs"
# Custom 2: x-axis: geom tiles ~ lig distance
#, A_xvar_lig = T
, lig_dist_colname = LigDist_colname # from globals
, tpos0 = 0 # 0 is a magic number that does my sensible default
, tW0 = 1
, tH0 = 0.2
)
{
################################################
# Custom 2: x-axis geom tiles ~ lig distance
################################################
#=========================
# Build data with colours
# ~ ligand distance
#=========================
plot_df = generate_distance_colour_map(plot_df, debug=TRUE)
# order the df by position and ensure it is a factor
plot_df = plot_df[order(plot_df[[xvar_colname]]), ]
plot_df[[xvar_colname]] = factor(plot_df[[xvar_colname]])
#cat("\nSneak peak:\n")
head(data.frame( plot_df[[xvar_colname]], plot_df[[stability_colname]] ) )
# stability values isolated to help with generating column called: 'group'
my_grp = plot_df[[stability_colname]]
cat( "\nLength of nsSNPs:", length(my_grp)
, "\nLength of unique values for nsSNPs:", length(unique(my_grp)) )
# Add col: 'group'
plot_df$group = paste0(plot_df[[stability_outcome_colname]], "_", my_grp, sep = "")
# check unique values in normalised data
cat("\nNo. of unique values in", stability_colname, "no rounding:"
, length(unique(plot_df[[stability_colname]])))
# Call the function to create the palette based on the group defined above
#subcols_ps
subcols_bp_hmap = ColourPalleteMulti(plot_df, stability_outcome_colname, stability_colname)
cat("\nNo. of sub colours generated:", length(subcols_bp_hmap))
#-------------------------------
# Generate the subcols barplot
#-------------------------------
cowplot::plot_grid(
ggplot(plot_df, aes_string(x = xvar_colname
# , ordered = T)
)) +
geom_bar(aes(fill = group)
, colour = "grey") +
scale_fill_manual( values = subcols_bp_hmap
, guide = "none") +
# scale_x_discrete("Position", labels=factor(plot_df$position)) +
theme(
axis.text.x = element_text(size = my_xaxls
, angle = 90
, hjust = 1
, vjust = 0.4)
, axis.text.y = element_text(size = my_yaxls
, angle = 0
, hjust = 1
, vjust = 0)
, axis.title.x = element_blank()
#, axis.title.x = element_text(size = my_xaxts)
, axis.title.y = element_text(size = my_yaxts )
, plot.title = element_text(size = my_pts
, hjust = 0.5)
) +
labs(title = p_title
, x = my_xlab
, y = my_ylab),
NULL,
ggplot(plot_df,
aes(x=factor(position), # THIS STUPID FUCKING FACTOR THING
)
) +
geom_tile(aes(y=0),
fill=plot_df$ligD_colours) +
scale_x_discrete("Position", labels=factor(plot_df$position)) +
theme_nothing() +
theme(plot.background = element_rect(fill = "transparent", colour=NA),
plot.margin = margin(t=0,b=0)) +
labs(x = NULL, y = NULL), #end of distance-heat-bar
NULL,
position_annotation(plot_df),
#generate_distance_legend(plot_df),
ncol = 1,
align = "v",
rel_heights = c(10,-0.1,1,-0.1,1)
#rel_widths = c(9/10, 0.4/10)
)
}
#bp_stability_hmap(small_df3)