Reppo for internal functions.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

61 lines
2.2 KiB

  1. ggheatmap<-function(df, x=NULL, y=NULL, value=NULL, grouping="mean", exclude_group=NULL, scale="none",color="#FFFFFF00"){
  2. if (is.null(x)){x=colnames(df)[1]}
  3. if (is.null(y)){y=colnames(df)[2]}
  4. if (is.null(value)){value=colnames(df)[3]}
  5. df<-rename(df, "VarX"=all_of(x), "VarY"=all_of(y), "Value"=all_of(value))
  6. if (is.null(exclude_group)){
  7. df<-df %>% group_by(VarX,VarY)
  8. }else{
  9. df<-df %>% group_by_("VarX","VarY",exclude_group) #%>% rename(exclude_group="all_of(exclude_group)")
  10. }
  11. if (grouping == "mean"){
  12. df<-df %>% summarise(Value=mean(Value)) %>% ungroup
  13. }
  14. if (grouping == "median"){
  15. df<-df %>% summarise(Value=median(Value)) %>% ungroup
  16. }
  17. if (length(unique(df$VarX)) > 1 & length(unique(df$VarY)) > 1){
  18. order<-clustsort(df %>% spread(VarY,Value) %>% select(!all_of(exclude_group)) %>% as.data.frame)
  19. }else{
  20. order<-list()
  21. if (length(unique(df$VarX)) > 1){
  22. xhclust<-clustsort(df %>% spread(VarY,Value) %>% select(!all_of(exclude_group)) %>% as.data.frame)
  23. order[["x"]]<-pull(xhclust, 1)[hclust(dist(xhclust %>% select(-1)))$order]
  24. }else{order[["x"]]<-df %>% pull(VarX) %>% unique}
  25. if (length(unique(df$VarY)) > 1){
  26. yhclust<-clustsort(df %>% spread(VarY,Value) %>% select(!all_of(exclude_group)) %>% as.data.frame)
  27. order[["y"]]<-colnames(yhclust)[2:ncol(yhclust)][hclust(dist(t(yhclust %>% select(-1))))$order]
  28. }else{order[["y"]]<-df %>% pull(VarY) %>% unique}
  29. }
  30. if (scale != "none"){
  31. if (scale == "rows"){
  32. cols<-unique(df$VarY)
  33. sca.df<-spread(df, VarY, Value)
  34. for (i in cols){sca.df[,i]<-scale(sca.df[,i])}
  35. df<-gather(sca.df, VarY, Value, all_of(cols))
  36. }
  37. if (scale == "cols"){
  38. cols<-unique(df$VarX)
  39. sca.df<-spread(df, VarX, Value)
  40. for (i in cols){sca.df[,i]<-scale(sca.df[,i])}
  41. df<-gather(sca.df, VarX, Value, all_of(cols))
  42. }
  43. }
  44. df$VarX<-factor(df$VarX, levels=order$x)
  45. df$VarY<-factor(df$VarY, levels=order$y)
  46. df %>%
  47. ggplot(aes(VarX, VarY, fill=Value))+
  48. labs(x=x, y=y)+
  49. geom_tile(aes(fill=Value), color=color)+
  50. scale_fill_gradientn(colors=col2(200))+
  51. theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust=0.5),
  52. panel.background = element_blank(),
  53. axis.ticks = element_blank())
  54. }