페이스북의 KRUG (Korean R User Group) 에서 2017.11.18일 주말 퀴즈로 아래의 시각화를 푸는 문제가 있어서 재미로 풀어보았습니다. 


처음엔 금방 코드 짤 것으로 예상했는데요, 출제자분께서 중간 중간 장애물을 심어놓으셔서 제 예상보다 좀 더 걸렸네요. 


문제 풀면 KRUG 운영자분께서 스타벅스 기프티콘 주신다고 하는데요, 기대되네요. ^___^



# KRUG's plot quiz, as of 18th NOV. 2017


library(ggplot2)

#install.packages("dplyr")

library(dplyr)

str(mtcars)


# making 'model' variable

mtcars$model <- rownames(mtcars)


# ordering by cyl, hp

mtcars_ord <- arrange(mtcars[,c('model', 'cyl', 'hp')], cyl, desc(hp))


# marking an inflection point within cluster : threshold >= 40

mtcars_cyl <- c(4, 6, 8)

mtcars_ord_2 <- data.frame()


for (i in 1:length(mtcars_cyl)) {

  

  mtcars_tmp <- subset(mtcars_ord, subset = (cyl == mtcars_cyl[i]))

  

  for (j in 1:nrow(mtcars_tmp)) {

    if (j != nrow(mtcars_tmp) & mtcars_tmp$hp[j] - mtcars_tmp$hp[j+1] >= 40) {

      mtcars_tmp$hp_outlier[j] = '1_outlier'

    } else {

      mtcars_tmp$hp_outlier[j] = '2_normal'

    }

  }

  

  mtcars_ord_2 <- rbind(mtcars_ord_2, mtcars_tmp)

  rm(mtcars_tmp)

}


# converting cyl variable type from numeric to factor

mtcars_ord_2$cyl_cd <- paste0("cyl :", mtcars_ord_2$cyl)


model_order <- mtcars_ord_2$model[order(mtcars_ord_2$cyl_cd, 

                                        mtcars_ord_2$hp, 

                                        decreasing = FALSE)]


mtcars_ord_2$model <- factor(mtcars_ord_2$model, levels = model_order)



# drawing cleveland dot plot

ggplot(mtcars_ord_2, aes(x = hp, y = model)) +

  geom_point(size = 2, aes(colour = hp_outlier)) +

  scale_colour_manual(values = c("red", "black")) + 

  theme_bw() +

  facet_grid(. ~ cyl_cd, scales = "free_y", space = "free_y") +

  xlim(0, max(mtcars_ord_2$hp)) +

  geom_hline(yintercept = nrow(mtcars_ord_2[mtcars_ord_2$cyl == 4,]) + 0.5, 

             colour = "black", linetype = "dashed", size = 0.5) +

  geom_hline(yintercept = nrow(mtcars_ord_2) - 

               nrow(mtcars_ord_2[mtcars_ord_2$cyl == 8,]) + 0.5, 

             colour = "black", linetype = "dashed", size = 0.5) +

  theme(legend.position = 'none')

 




R Korea - KRUG(Korean R User Group) 에 문제 출제해주신 정우준님께서 나중에 정답지 올려주신 코드도 아래에 같이 공유합니다. 제가 짠 코드보다 한결 간결하네요. 



library(data.table)
library(dplyr)
library(ggplot2)

mtcars %>%
mutate(car.name=rownames(.)) %>%
arrange(cyl, hp) %>%
mutate(order.key=1:n()) -> data

data %>%
ggplot(aes(x=hp, y=reorder(car.name, order.key))) +
geom_point(
colour=case_when(
data$car.name %in% c('Ferrari Dino','Maserati Bora') ~ 'red', 
TRUE ~ 'black')) +
geom_hline(yintercept = 11.5, linetype='dashed') +
geom_hline(yintercept = 18.5, linetype='dashed') +
facet_wrap(~ cyl, labeller = label_both) +
scale_x_continuous(limits=c(0,max(data$hp))) +
theme_bw() +
theme(axis.title.y=element_blank())

 






Posted by R Friend R_Friend