Net Promoter Score

library(ggplot2)
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(magrittr)
library(tidyr)

## 
## Attaching package: 'tidyr'

## The following object is masked from 'package:magrittr':
## 
##     extract

set.seed(123)
NpsData <- sample(x=6:10, size=1000, replace=TRUE, prob=c(0.06, 0.05, 0.05, 0.42, 0.42))
NpsData %>% head(20) %>% print()

##  [1]  9 10  9  6  8  9 10  6 10 10  7 10 10 10  9  6  9  9  9  7

NpsData %>%
  data.frame() %>% 
  summarise_all(list(Min=min, Max=max, Mean=mean, `Standard Deviation`=sd, Count=NROW)) %>%
  gather("Statistic", "Value") %>% 
  mutate_at("Value", round, 2)

##            Statistic   Value
## 1                Min    6.00
## 2                Max   10.00
## 3               Mean    9.09
## 4 Standard Deviation    1.10
## 5              Count 1000.00

NpsScore <- NpsData %>% 
  data.frame(Score=.) %>% 
  mutate(Category="Promoters"
         ,Category=ifelse(Score<=8, "Passives", Category)
         ,Category=ifelse(Score<=6, "Detractors", Category)
         ,Category=factor(Category, levels=c("Promoters", "Passives", "Detractors"))
  ) %>% 
  count(Category, name="Count") %>% 
  mutate(Percentage=Count/sum(Count)) %>% 
  (function(x){
    Pro <- x %>% filter(Category=="Promoters") %>% select(Percentage) %>% pull()
    Det <- x %>% filter(Category=="Detractors") %>% select(Percentage) %>% pull()
    return((Pro-Det)*10)
  }) %>% 
  data.frame(Score=.) %>% 
  mutate(Name="NPS")

NpsFrame <- seq(from=0, to=10, by=1) %>% 
    data.frame(NPS=.) %>% 
    mutate(Name="NPS"
          ,Category="Promoters"
          ,Category=ifelse(NPS<9,"Passives",Category)
          ,Category=ifelse(NPS<7,"Detractors",Category)
          ,Category=factor(Category, levels=c("Promoters", "Passives", "Detractors"))
          ,NPS=factor(NPS, levels=0:10)
          )

FinalData <- left_join(x=NpsFrame
                      ,y=NpsScore
                      ,by="Name"
                      )

FinalFrame <- NpsData %>% 
  data.frame(Score=.) %>% 
  mutate(Category="Promoters"
         ,Category=ifelse(Score<=8, "Passives", Category)
         ,Category=ifelse(Score<=6, "Detractors", Category)
         ,Category=factor(Category, levels=c("Promoters", "Passives", "Detractors"))
  )

FinalData %>% 
    ggplot(aes(Name)) +
    geom_bar(aes(fill=Category), colour="darkgrey", width=0.5, alpha=0.5) +
    geom_point(data=function(x) {x <- x %>% select(Name, Score) %>% mutate(Score=round(Score,2)) %>% distinct()}
              ,stat="identity"
              ,aes(y=Score)
              ,shape="plus"
              ,size=25
              ) +
    geom_label(data=function(x) {x %>% select(Name, Score) %>% mutate(Score=round(Score,2)) %>% distinct}
              ,stat="identity"
              ,aes(y=Score, label=Score)
              ,size=5
              ) +
    scale_y_continuous(breaks=seq(0,10,1), limits=c(0,10)) +
    scale_fill_manual(values=c("#66bd63", "#fdae61", "#d73027")) +
    theme(axis.text.y.left=element_blank()) +
    coord_flip() +
    labs(title="NPS Score"
        ,fill="Category"
        ,y="NPS Score"
        ,x="NPS"
        )

## Warning: Removed 1 rows containing missing values (geom_bar).

FinalFrame %>% 
  ggplot(aes(Score)) +
  geom_bar(aes(fill=Category), colour="darkgrey", alpha=0.3) +
  geom_density(aes(y=..count..), colour="blue", adjust=3, size=1) +
  scale_fill_manual(values=c("#66bd63", "#fdae61", "#d73027")) +
  scale_x_continuous(breaks=seq(0,10,1), limits=c(-0.5,10.5)) +
  theme(legend.position="none") +
  labs(title="Density Plot of NPS"
       ,x="Score"
       ,y="Count"
  )