Как создать вычисляемый столбец в R

Ниже представлен примерный набор данных и желаемые манипуляции. Пока все работает нормально. Попытка создать новый вычисляемый столбец. В некотором контексте smb означает малый бизнес. 1,2,3,4 представляют разные пороги того, что можно было бы считать малым. В желаемом столбце будет, например, какой процент от общей занятости занимает smb = 1 для данной области. Например, для области 001 это будет 46/1927. Я могу понять, как сделать так, чтобы он появлялся один раз, но не как полный столбец. Как бы я это сделал? Желаемый результат внизу.

library(readxl)
library(dplyr)
library(data.table)
library(DBI)
library(stringr)
library(tidyverse)
library(gt)


 employment <- c(1,45,125,130,165,260,600,601,2,46,127,132,167,265,601,602,50,61,110,121,170,305,55,603,52,66,112,123,172,310,604,605)
 small <- c(1,1,2,2,3,4,NA,NA,1,1,2,2,3,4,NA,NA,1,1,2,2,3,4,NA,NA,1,1,2,2,3,4,NA,NA)
 area <-c(001,001,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,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,2020,2020,2020,2020)
 qtr <-c(1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,1,1,1,1,1,1,1,1,2,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)) %>%
 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), 
 empprevyearpct=scales::percent(empprevyearpct,accuracy = 0.01)
 )




smblonger2<-smbsummary2 %>%
dplyr::select(area,period,employment,worksites,smb) %>%
ungroup() %>%
pivot_longer(cols = employment:worksites, names_to = "measure", values_to = "value") %>%
group_by(area,measure) %>%
pivot_wider(names_from = period, values_from = value)%>%filter(smb %in% 
c("1","2","3","4"))%>%gt()%>%cols_label(
smb = md("**Category**"))


smblonger2

area    period   smb    employment    worksites    pcttotal
 1      2020q1    1         46           2          46/1927 (total employment)
 2      2020q2    2        301           4          301/1927
 3      2020q3    3        466           5          466/1927
 4      2020q4    4        726           6          726/1927

 schema
 smb      employment range
  1         0 to 100
  2         0 to 150
  3         0 to 250
  4         0 to 500

r summarize dplyr gt
person Tim Wilcox    schedule 14.04.2021    source источник
comment
Я не совсем понимаю, о чем вы спрашиваете. Но 1. Случай, когда - эти случаи перекрываются, если занятость = 125, это 1 или 2 ?. 2. Можете ли вы объяснить, чего вы пытаетесь достичь в результате?   -  person CALUM Polwart    schedule 15.04.2021
comment
@CALUMPolwart, вопрос отредактировал.   -  person Tim Wilcox    schedule 15.04.2021
comment
Что ты пробовал? % ›% Mutate (your_answer = занятость / сумма (занятость)). Я все еще не понимаю, о чем вы спрашиваете? Вы хотите получить результат 46/1927 или хотите, чтобы он был рассчитан?   -  person CALUM Polwart    schedule 15.04.2021
comment
@CALUMPolwart Мне нужен расчет. Ставлю 46/1927 просто для большей конкретности. Этот новый столбец pcttotal покажет вам, какой процент от общей занятости связан с кем-л. 1 (от 0 до 100) за определенный период и область.   -  person Tim Wilcox    schedule 15.04.2021

Ответы (1)


arrow_upward
1
arrow_downward

Хорошо, вот мое решение (теперь кто-то придет с функцией с одной строкой!)

library(dplyr)
library(tidyr)

employment <- c(1,45,125,130,165,260,600,601,2,46,127,132,167,265,601,602,50,61,110,121,170,305,55,603,52,66,112,123,172,310,604,605)
small <- c(1,1,2,2,3,4,NA,NA,1,1,2,2,3,4,NA,NA,1,1,2,2,3,4,NA,NA,1,1,2,2,3,4,NA,NA)
area <-c(001,001,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,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,2020,2020,2020,2020)
qtr <-c(1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2)

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

smbtest$smb <-0  # I think this line is redundent

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)) %>%
    group_by(area,period,smb) %>%
    summarise(employment = sum(employment), worksites = n(), 
              .groups = 'drop_last') %>% 
    mutate(employment = cumsum(employment),
           worksites = cumsum(worksites))



smbsummary2 %>%
    # Make the data wider (a column for each smb)
    pivot_wider(
        id_cols=c("area", "period"), 
        names_from = "smb", 
        values_from = c("employment", "worksites"),
        names_prefix = "SMB"
        ) %>%
    # calculate the %
    mutate(across(starts_with("employment_SMB"), 
                  ~(100*(.x/employment_SMBNA)),
                  .names = "pcttotal_{.col}")) %>%

    # Now make the data longer
    pivot_longer(
        cols = contains("SMB")
    ) %>%
    # rework the data names so the smb is a value
    separate(name, into=c("name", "smb"), sep="_SMB") %>%
    # Make the date wider again to match the shape requested
    pivot_wider(
        id_cols=c("area", "period", "smb"), 
        names_from = "name", 
        values_from = "value"
    ) -> smbsummary3
person CALUM Polwart    schedule 16.04.2021