library(ggplot2)
library(tidyr)
## Warning: package 'tidyr' was built under R version 4.0.4
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(tibble)
mat = matrix(runif(200),10,20)
colnames(mat) = paste0("col",1:ncol(mat))
rownames(mat) = paste0("row",1:nrow(mat))
###########
df = data.frame(mat) %>%
rownames_to_column("row") %>%
pivot_longer(-row) %>%
mutate(name=factor(name,levels=colnames(mat)),
row=factor(row,levels=rownames(mat)))
################
row_num = length(levels(df$row))
dim(df)
## [1] 200 3
head(df)
## # A tibble: 6 x 3
## row name value
## <fct> <fct> <dbl>
## 1 row1 col1 0.0713
## 2 row1 col2 0.588
## 3 row1 col3 0.946
## 4 row1 col4 0.921
## 5 row1 col5 0.973
## 6 row1 col6 0.00139
df
## # A tibble: 200 x 3
## row name value
## <fct> <fct> <dbl>
## 1 row1 col1 0.0713
## 2 row1 col2 0.588
## 3 row1 col3 0.946
## 4 row1 col4 0.921
## 5 row1 col5 0.973
## 6 row1 col6 0.00139
## 7 row1 col7 0.505
## 8 row1 col8 0.120
## 9 row1 col9 0.0175
## 10 row1 col10 0.306
## # ... with 190 more rows
g = ggplot(df,aes(x=name,y=as.numeric(row),fill=value)) +
xlim(c("",colnames(mat))) + ylim(c(-row_num/1.5,row_num+1))+
geom_tile()+ ylab("")+
annotate(x="",y=1:row_num,label=levels(df$row),size=2.5,geom="text")
g
####################
g + coord_polar(start=-0.15) + theme_bw() +
theme(legend.position = c(0.5, 0.5),legend.key.size = unit(0.2, "cm"),
axis.text.x = element_text(angle = 0))
##################method_2
library(reshape)
##
## Attaching package: 'reshape'
## The following object is masked from 'package:dplyr':
##
## rename
## The following objects are masked from 'package:tidyr':
##
## expand, smiths
library(ggplot2)
library(plyr)
## ------------------------------------------------------------------------------
## You have loaded plyr after dplyr - this is likely to cause problems.
## If you need functions from both plyr and dplyr, please load plyr first, then dplyr:
## library(plyr); library(dplyr)
## ------------------------------------------------------------------------------
##
## Attaching package: 'plyr'
## The following objects are masked from 'package:reshape':
##
## rename, round_any
## The following objects are masked from 'package:dplyr':
##
## arrange, count, desc, failwith, id, mutate, rename, summarise,
## summarize
nba <- read.csv("http://datasets.flowingdata.com/ppg2008.csv")
nba$Name <- with(nba, reorder(Name, PTS))
nba.m <- melt(nba)
## Using Name as id variables
nba.m <- ddply(nba.m, .(variable), transform, value = scale(value))
# Convert the factor levels (variables) to numeric + quanity to determine size of hole.
nba.m$var2 = as.numeric(nba.m$variable) + 15
# Labels and breaks need to be added with scale_y_discrete.
y_labels = levels(nba.m$variable)
y_breaks = seq_along(y_labels) + 15
View(nba.m)
dim(nba.m)
## [1] 1000 4
nba.labs <- subset(nba.m, variable==levels(nba.m$variable) [nlevels(nba.m$variable)])
dim(nba.labs)
## [1] 50 4
#View(nba.labs)
nba.labs <- nba.labs[order(nba.labs$Name),]
head(nba.labs)
## Name variable value var2
## 1000 Nate Robinson PF 0.61147245 35
## 999 Allen Iverson PF -1.75434359 35
## 998 Chauncey Billups PF -0.84441434 35
## 997 Rashard Lewis PF 0.06551491 35
## 995 Maurice Williams PF 0.42948660 35
## 996 Shaquille O'neal PF 1.70338755 35
nba.labs$ang <- seq(from=(360/nrow(nba.labs))/1.5, to=(1.5* (360/nrow(nba.labs)))-360, length.out=nrow(nba.labs))+80
nba.labs$hjust <- 0
nba.labs$hjust[which(nba.labs$ang < -90)] <- 1
nba.labs$ang[which(nba.labs$ang < -90)] <- (180+nba.labs$ang)[which(nba.labs$ang < -90)]
str(nba.labs)
## 'data.frame': 50 obs. of 6 variables:
## $ Name : Factor w/ 50 levels "Nate Robinson ",..: 1 2 3 4 5 6 7 8 9 10 ...
## $ variable: Factor w/ 20 levels "G","MIN","PTS",..: 20 20 20 20 20 20 20 20 20 20 ...
## $ value : num [1:50, 1] 0.6115 -1.7543 -0.8444 0.0655 0.4295 ...
## $ var2 : num 35 35 35 35 35 35 35 35 35 35 ...
## $ ang : num 84.8 77.6 70.4 63.1 55.9 ...
## $ hjust : num 0 0 0 0 0 0 0 0 0 0 ...
class(nba.labs)
## [1] "data.frame"
#nba.labs$value <- NULL
ggplot(nba.m, aes(x=Name, y=var2, fill=value)) +
geom_tile(colour="white") +
geom_text(data=nba.labs, aes(x=Name, y=var2+1.5,
label=Name, angle=ang, hjust=hjust), size=3) +
scale_fill_gradient(low = "white", high = "steelblue") +
ylim(c(0, max(nba.m$var2) + 1.5)) +
#scale_y_discrete(breaks=y_breaks, labels=y_labels) +
coord_polar(theta="x") +
theme(panel.background=element_blank(),
axis.title=element_blank(),
panel.grid=element_blank(),
axis.text.x=element_blank(),
axis.ticks=element_blank(),
axis.text.y=element_text(size=5))
#print(p2)
####################
#ref:https://stackoverflow.com/questions/41500000/how-to-add-another-legend-to-circular-heat-map-in-r
#https://stackoverflow.com/questions/62556246/how-to-plot-the-variant-circular-bar-chart-in-r-with-ggplot