R Row Labeled Plot for MLB Teams and a Few Baseball Statistical Categories

Question

I am trying to make a graph similar to the picture provided. Rather than states, I would like the teams. Instead of "Basic or Above", "Proficient or Above", and "Advanced", I would like "BA", "OBP", "SLG", and "OPS", with the teams being listed based on "BA". Additionally, I would like alternating colors for the points, like in the picture. Here is what I have so far, but I am having difficulty with the parts in between ggplot and rowTheme. Note that you have to scroll to view more code.

Any help would be much appreciated.

df <- read.table(textConnection(
  'Team   BA    OBP     SLG     OPS
  ARI     0.261 0.32    0.432   0.752
  ATL     0.255 0.321   0.384   0.705
  BAL     0.256 0.317   0.443   0.76
  BOS     0.282 0.348   0.461   0.81
  CHC     0.256 0.343   0.429   0.772
  CHW     0.257 0.317   0.41    0.727
  CIN     0.256 0.316   0.408   0.724
  CLE     0.262 0.329   0.43    0.759
  COL     0.275 0.336   0.457   0.794
  DET     0.267 0.331   0.438   0.769
  HOU     0.247 0.319   0.417   0.735
  KCR     0.261 0.312   0.4     0.712
  LAA     0.26  0.322   0.405   0.726
  LAD     0.249 0.319   0.409   0.728
  MIA     0.263 0.322   0.394   0.716
  MIL     0.244 0.322   0.407   0.729
  MIN     0.251 0.316   0.421   0.738
  NYM     0.246 0.316   0.417   0.733
  NYY     0.252 0.315   0.405   0.72
  OAK     0.246 0.304   0.395   0.699
  PHI     0.24  0.301   0.384   0.685
  PIT     0.257 0.332   0.402   0.734
  SDP     0.235 0.299   0.39    0.689
  SEA     0.259 0.326   0.43    0.756
  SFG     0.258 0.329   0.398   0.728
  STL     0.255 0.325   0.442   0.767
  TBR     0.243 0.307   0.426   0.733
  TEX     0.262 0.322   0.433   0.755
  TOR     0.248 0.33    0.426   0.755
  WSN     0.256 0.326   0.426   0.751'), header = TRUE)

library(ggplot2)
library(tidyr)
library(dplyr)

rowTheme <- theme_gray()+ theme(
  plot.title=element_text(hjust=0.5),
  plot.subtitle=element_text(hjust=0.5),
  plot.caption=element_text(hjust=-.5),
  strip.text.y = element_blank(),
  strip.background=element_rect(fill=rgb(.9,.95,1),
                                colour=gray(.5), size=.2),
  panel.border=element_rect(fill=FALSE,colour=gray(.75)),
  panel.grid.minor.x = element_blank(),
  panel.grid.minor.y = element_blank(),
  panel.grid.major.y = element_blank(),
  panel.spacing.x = unit(0.07,"cm"),
  panel.spacing.y = unit(0.07,"cm"),
  axis.ticks=element_blank(),
  axis.text=element_text(colour="black"),
  axis.text.y=element_text(size=rel(.78),
                           margin=margin(0,0,0,3)),
  axis.text.x=element_text(margin=margin(-1,0,3,0))
)


colName <- function(x){
  ints= 1:length(x)
  names(ints)=x
  return(ints)
}


rowOrd <- with(df,
               order(BA, OBP,
                     OPS, SLG, decreasing=TRUE))
colOrd <- c(1,5,4,3,2)           
df2 <- df[rowOrd,colOrd]
head(df2[,c(1,2,3,4,5)])

windows(width=8, height=9)

df3 <-
  (ggplot(df,aes(x=Percent,y=Team,fill=Row,group=Grp))
   + labs(title= "Title",
          x="Percent", y="Teams")
   + geom_point(shape=21,size=3)
   + scale_fill_manual(values=rowColor, guide=FALSE)
   + facet_grid(Grp ~ Achievement, scale="free",space="free_y")
   + rowTheme
   + theme(axis.text.y=element_text(size=rel(.78),
                                    face='bold'))

  )
df3

jesstme · Answer 1 · 2017-04-04T22:52:44.520

1

Is this what you're looking for, more or less?

library(dplyr)
df$Team <- reorder(as.factor(df$Team), df$BA)
row.names(df) <- NULL
dfx <- gather(df, group, data, BA, OBP, SLG, OPS)
dfx$data <- dfx$data*100

plot <- ggplot(dfx, aes(x = data, y = Team, group = group, fill = Team)) + 
  labs(title = "Title", x = "Percent", y = "Teams") + 
  geom_point(shape = 21, size = 3) + 
  theme(plot.title = element_text(hjust = 0.5),
    plot.subtitle = element_text(hjust = 0.5),
    plot.caption = element_text(hjust = -0.5),
    legend.position = "",
    strip.text.y = element_blank(),
    strip.background = element_rect(fill = rgb(.9,.95,1),
                                  colour = gray(.5), size=.2),
    panel.border = element_rect(fill = FALSE, colour=gray(.75)),
    panel.grid.minor.x = element_blank(),
    panel.grid.minor.y = element_blank(),
    panel.grid.major.y = element_blank(),
    panel.spacing.x = unit(0.07,"cm"),
    panel.spacing.y = unit(0.07,"cm"),
    axis.ticks = element_blank(),
    axis.text = element_text(colour = "black"),
    axis.text.y = element_text(size = rel(.78), face = "bold",
                             margin = margin(0,0,0,3)),
    axis.text.x = element_text(margin = margin(-1,0,3,0))) +
  facet_grid(~group, scale = "free") 

plot

edited Apr 04 '17 at 22:52

answered Apr 04 '17 at 22:18

jesstme

604
2
10
25

1

That's pretty close to what I'm looking for. I would like the teams to be ordered from best BA to worst BA, that way the dots would be sorted nicely, and that would carry on to the other stats for the most part, because teams with better BA, tend to have better statistics in other categories. Would that be hard to implement? – Remy M Apr 04 '17 at 22:25
1

@John H Please, the above edit. To sort based on BA you could use: df$Team2 <- reorder(df$Team, df$BA) – Edgar Santos Apr 04 '17 at 22:48
Thanks. If I were to use jesstme's graph, would I implement it by using that same statement? If so, where would it go? – Remy M Apr 04 '17 at 22:52
Edited the original answer, using a modification of @ed_sans ' response. Should be in correct order now. – jesstme Apr 04 '17 at 22:53
Thanks, much appreciated! I got the graph I was hoping for. – Remy M Apr 04 '17 at 22:55

Edgar Santos · Accepted Answer · 2017-04-04T22:49:04.343

1

How about:

library(reshape)
library(ggplot2)
df$Team2 <- reorder(df$Team, df$BA)
dfmelt <- melt(df, id = c("Team", "Team2") )

p <- ggplot(dfmelt, aes(value, Team2))
p + geom_point(aes(colour=Team2)) + facet_wrap(~ variable, scales = "free", ncol = 4)+ geom_blank(data=dfmelt)

edited Apr 04 '17 at 22:49

answered Apr 04 '17 at 22:19

Edgar Santos

3,426
2
17
29

R Row Labeled Plot for MLB Teams and a Few Baseball Statistical Categories

2 Answers2