3

I am trying to draw a plot in R. The resultant chart should be something like this:

enter image description here

So far, I have written some codes and the main components of the chart has been created as shown below: enter image description here

But as you may noticed, the ideal plot (the upper plot) has two red dotted lines. I want to draw a horizontal line at 80% values of the secondary y axis (the right vertocal axis). This horizontal line should intercept with the green curve, and then, from that point comes down (become vertical) and makes an intercept with x axis (As shown in the upper image).

My codes are shown below.

defect <- c( 80, 27, 66, 94, 33, 354, 32, 77, 567) 
defect 
names(defect ) <- c( "Jafar", "Ali", "Mamal", "Mosi", "Hamed", "Haney", "Munny", "Funny" , "Foony")


d <- data.frame(defect ) 

d <- arrange(d, desc(defect)) %>%
        mutate(
                cumsum = cumsum(defect),
                freq = round(defect / sum(defect), 3),
                cum_freq = cumsum(freq)
               )
d
## Saving Parameters 
def_par <- par() 

# New margins
par(mar=c(5,5,4,5)) 


## plot bars, pc will hold x values for bars
pc = barplot(d$freq,
             width = 1, space = 0.2, border = NA, axes = F,
             ylim = c(0, 1.05 * max(d$freq, na.rm = T)), 
             ylab = "Relative Frequency" , cex.names = 0.7, 
             names.arg = d$category,
             main = "Pareto Chart")

## anotate left axis
axis(side = 2, at = c(0, d$freq), las = 1, col.axis = "grey62", col = "grey62", tick = T, cex.axis = 0.8)

## frame plot
box( col = "grey62")

## Cumulative Frequency Lines 
px <- d$cum_freq * max(d$freq, na.rm = T)
lines(pc, px, type = "b", cex = 0.7, pch = 19, col="cyan4")
par(new=TRUE)

## Annotate Right Axis
axis(side = 4, at = c(0, px), labels = paste(c(0, round(d$cum_freq * 100)) ,"%",sep=""), 
     las = 1, col.axis = "grey62", col = "cyan4", cex.axis = 0.8, col.axis = "cyan4", abline(h=0.8) )

I would appreciate if the solution does not require any complex coding.

jay.sf
  • 60,139
  • 8
  • 53
  • 110
Oscar
  • 79
  • 5

2 Answers2

2

Add these lines. You need to convert the 80% the same way as you did with the px. Then you can use axis and segments.

y1 <- .8*max(d$freq, na.rm = T)
segments(pc[3, ], y1, par()$usr[2], y1, col='red', lty=2)
axis(4, y1, '80%', las=2, col.ticks='red', col.axis='red', cex.axis=.8)
abline(v=pc[3, ], col='red', lty=2)

enter image description here

jay.sf
  • 60,139
  • 8
  • 53
  • 110
1

You can use approx to interpolate between categories and find the exact point:

xy.80 <- approx(d$cum_freq, pc, xout=.8)
xy.80 <- list(x=xy.80$y, 
              y=xy.80$x * max(px))
lines(c(rep(xy.80$x, 2), par('usr')[2]), 
      c(0, rep(xy.80$y, 2)), 
      lty=2, col='red')
points(xy.80, pch=21, bg='red', col='white', lwd=3, cex=1.2)
axis(side=4, at=xy.80$y, labels='80%', las=2, col.axis='red', col='red', 
     cex.axis=.8)

I only drew the lower part of the vertical line and also added a small red point at the intersection. barplot

Robert Hacken
  • 3,878
  • 1
  • 13
  • 15