Search code examples
rdplyrlag

How to format a number as a percentage and limit number of decimal places


The sample data, manipulations, and such are below. My issue concerns the 4th portion with the lag function into it. The desired result would be to have the empprevyearpct (yes, I know it is actually a qtr) value for area 001 and smb 1 show up as 4.35% instead of .04347826. I have been trying to do so using scales can't figure out how to get the number to the right of decimal and also make it into a percent.

library(readxl)
library(dplyr)
library(data.table)
library(odbc)
library(DBI)
library(stringr)

 employment <- c(1,45,125,130,165,260,600,2,46,127,132,167,265,601,50,61,110,121,170,305,55,603,66,112,123,172,310,604)
 small <- c(1,1,2,2,3,4,NA,1,1,2,2,3,4,NA,1,1,2,2,3,4,NA,1,1,2,2,3,4,NA)
 area <-c(001,001,001,001,001,001,001,001,001,001,001,001,001,001,003,003,003,003,003,003,003,003,003,003,003,003,003,003)
 year<-c(2020,2020,2020,2020,2020,2020,2020,2020,2020,2020,2020,2020,2020,2020,2020,2020,2020,2020,2020,2020,2020,2020,2020,2020,2020,2020,2020,2020)
 qtr <-c(1,1,1,1,1,1,1,2,2,2,2,2,2,2,1,1,1,1,1,1,1,2,2,2,2,2,2,2)

 smbtest <- data.frame(employment,small,area,year,qtr)

 smbtest$smb <-0

 smbtest <- smbtest %>% mutate(smb = case_when(employment >=0 & employment <100 ~ "1",employment >=0 
 & employment <150 ~ "2",employment >=0 & employment <250 ~ "3", employment >=0 & employment <500 ~ 
 "4"))


smbsummary2<-smbtest %>% 
mutate(period = paste0(year,"q",qtr)) %>%
select(area,period,employment,smb) %>%
group_by(area,period,smb) %>%
summarise(employment = sum(employment), worksites = n(), 
        .groups = 'drop_last') %>% 
mutate(employment = cumsum(employment),
     worksites = cumsum(worksites))

smbsummary2<- smbsummary2%>%
group_by(area,smb)%>%
mutate(empprevyear=lag(employment),
     empprevyearpp=employment-empprevyear,
     empprevyearpct=((employment/empprevyear)-1))


 smblonger2<-smbsummary2 %>%
 ungroup() %>%
 pivot_longer(cols = employment:worksites, names_to = "measure", values_to = "value") %>%
 group_by(area,measure) %>%
 pivot_wider(names_from = period, values_from = value) %>% gt()

Solution

  • You could use scales::percent()

    smbsummary2<- smbsummary2%>%
      group_by(area,smb)%>%
      mutate(empprevyear=lag(employment),
             empprevyearpp=employment-empprevyear,
             empprevyearpct=((employment/empprevyear)-1), empprevyearpct=scales::percent(empprevyearpct)
             )
    

    Output:

        area period smb   employment worksites empprevyear empprevyearpp empprevyearpct
       <dbl> <chr>  <chr>      <dbl>     <int>       <dbl>         <dbl> <chr>         
     1     1 2020q1 1             46         2          NA            NA NA            
     2     1 2020q1 2            301         4          NA            NA NA            
     3     1 2020q1 3            466         5          NA            NA NA            
     4     1 2020q1 4            726         6          NA            NA NA            
     5     1 2020q1 NA          1326         7          NA            NA NA            
     6     1 2020q2 1             48         2          46             2 4%            
     7     1 2020q2 2            307         4         301             6 2%            
     8     1 2020q2 3            474         5         466             8 2%            
     9     1 2020q2 4            739         6         726            13 2%            
    10     1 2020q2 NA          1340         7        1326            14 1%            
    11     3 2020q1 1            166         3          NA            NA NA            
    12     3 2020q1 2            397         5          NA            NA NA            
    13     3 2020q1 3            567         6          NA            NA NA            
    14     3 2020q1 4            872         7          NA            NA NA            
    15     3 2020q2 1             66         1         166          -100 -60%          
    16     3 2020q2 2            301         3         397           -96 -24%          
    17     3 2020q2 3            473         4         567           -94 -17%          
    18     3 2020q2 4            783         5         872           -89 -10%          
    19     3 2020q2 NA          1990         7          NA            NA NA