ugly 3D pyramid plot

ggpyramid.R

pyramid <- function(ymax=5,mcol="#CD3333",xoffset=0){
  f <- function(a,b,y){
    (y-b)/a
  }
  
  a1 <- ymax/0.65
  b1 <- 0
  c1 <- -ymax/(1-0.65)
  d1 <- -c1
  a2 <- -ymax/(1-0.65)
  b2 <- -a2
  c2 <- (sqrt(0.75)-ymax)/(1.5-0.65)
  d2 <- ymax-0.65*c2
  ys <- seq(0,ymax,length.out = 100)
  ys2 <- seq(sqrt(0.75),ymax,length.out = 100)
  xs1 <- cbind(f(a1,b1,ys),f(c1,d1,ys))
  xs2 <- cbind(f(a2,b2,ys),f(c2,d2,ys2))
  df <- tibble()
  for(i in 1:(nrow(xs1)-1)){
    tmp <- tibble(x=c(xs1[i,1:2],xs1[i+1,2:1]),y=c(ys[i],ys[i],ys[i+1],ys[i+1]),grp=i^3,grp2=i)
    df <- bind_rows(df,tmp)
    tmp <- tibble(x=c(xs2[i,1:2],xs2[i+1,2:1]),y=c(ys[i],ys2[i],ys2[i+1],ys[i+1]),grp=i^3+1,grp2=i)
    df <- bind_rows(df,tmp)
  }
  colfunc <- colorRampPalette(c("white","azure",mcol))
  pal <- colfunc(100)
  df$grp2 <- pal[df$grp2]
  df$x <- df$x+xoffset
  df
}
shad1 <- tibble(x=c(1,1.5,0.65),y=c(0,sqrt(0.75),5),grp=c(1,1,1))  
df <- pyramid()

shad2 <- tibble(x=c(1,1.5,0.65)+2,y=c(0,sqrt(0.75),3),grp=c(1,1,1))  
df1 <- pyramid(3,mcol="dodgerblue4",xoffset = 2)

shad3 <- tibble(x=c(1,1.5,0.65)+4,y=c(0,sqrt(0.75),4),grp=c(1,1,1))  
df2 <- pyramid(4,mcol="goldenrod3",xoffset = 4)

ggplot()+
  annotate("polygon",x=c(0,6,6+2*.5,2*0.5,0)-1,y=c(0,0,2*sqrt(0.75),2*sqrt(0.75),0)-0.5,fill="grey66")+
  annotate("line",x=c(-1,-1),y=c(-0.5,5),col="grey66")+
  annotate("text",x=-1.3,y=5,label="100.00%")+
  annotate("text",x=-1.3,y=2.5,label="50.00%")+
  annotate("text",x=-1.3,y=-0.5,label="0.00%")+
  geom_polygon(data=df,aes(x,y,group=grp),fill=df$grp2)+
  geom_polygon(data=shad1,aes(x,y,group=grp),fill="black",alpha=0.1)+
  geom_polygon(data=df1,aes(x,y,group=grp),fill=df1$grp2)+
  geom_polygon(data=shad2,aes(x,y,group=grp),fill="black",alpha=0.1)+
  geom_polygon(data=df2,aes(x,y,group=grp),fill=df2$grp2)+
  geom_polygon(data=shad3,aes(x,y,group=grp),fill="black",alpha=0.1)+
  theme_void()