Как написать функцию R для создания нового столбца в любом кадре данных из условных значений двух существующих столбцов?

Question

Проблема:

У меня довольно неприятная проблема. Я пытаюсь написать функцию, которая создала бы / заполняла новый столбец в любом данном кадре данных, основываясь на значениях в двух уже существующих столбцах этого кадра данных.

Контекст:

Я часто работаю с базой данных, которая ссылается на события с двумя измерениями (ID проекта (1-7) и localeID (de_DE, fr_FR, jp_JP и т. Д.).

projectId    localeId
1            jp_JP   
2            es_ES       
3            de_DE         
1            jp_JP       
2            es_ES          
3            de_DE

Мне нужно выполнить ETL из базы данных и создать новое «рыночное» измерение, основанное на projectId и localeID. Например, projectId, равный 1, и localeId, равный jp_JP, могут означать, что рынком является «JAPAN1».

 projectId localeId   market
         1    jp_JP   JAPAN1
         2    es_ES   SPAIN2
         3    au_AU     AUS3
         4    us_US      US4
         5    en_EN ENGLAND5
         6    de_DE GERMANY6

Текущий успешный код:

Напишите сейчас У меня есть длинный фрагмент кода R, использующий функции ifelse. I.E ....

df$market <- ifelse(df$localeId == "jp_JP" & df$projectId == '1', "JAPAN1")
df$market <- ifelse(df$localeId == "es_ES" & df$projectId == '10', "SPAIN10")

Это ... хорошо. Это делает работу. К сожалению, у меня есть много скриптов, которые имеют дело с этой функцией рынка, и я не хочу копировать и вставлять этот код ifelse снова и снова. Вместо этого я хочу написать функцию, которую можно использовать на любом фрейме данных для создания нового рыночного столбца на основе localeId и projectId.

Попытки / Неудачные решения:

market_names <- function(df, "market", "projectId", "localeId"){
             df$market <- NA 
             x <- ifelse(projectId == 1, "1",
                     ifelse(projectId == 2, "2", projectId)
             y <- ifelse(localeId == "jp_JP", "JAPAN",
                     ifelse(localeId == "es_ES", "SPAIN", localeId)
            for(i in 1:nrow(df)){
                 df[i,]$market <- paste(x,y, sep = "")
}

df <- market_names(df, "market", "projectId", "localeId")

К сожалению, код просто ломается и даже не запускается, когда я пытаюсь передать фрейм данных в функцию.

Запрос:

Я надеюсь, что кто-то здесь испытывал подобные проблемы и мог бы посоветовать, как исправить эту функцию, чтобы ее можно было использовать для любого фрейма данных в любое время. У меня всегда одни и те же размеры projectId и localeId, поэтому я подумал, что это сэкономит мне много времени в будущем.

Если вы думаете, что есть более простой способ сделать все это даже без функции, я бы тоже хотел услышать ваши мысли!

Заранее спасибо!

Answer 1

Я бы порекомендовал небольшое изменение в методологии вместо простого написания кода.Когда я создаю справочные таблицы, я предпочитаю сохранять их где-нибудь в виде таблицы в базе данных или в виде CSV-файла на жестком диске.Это потому, что я буду часто использовать / изменять их в будущем.Когда у вас есть таблица поиска, вы можете выполнить left_join или объединить данные.Я знаком с left_join, поэтому буду использовать его ниже.Если вам нужно использовать base-R, то кто-то другой может помочь с этой частью.

library(readr)
library(dplyr)

# The original data you input
df1 <- readr::read_csv(
  "projectId,    localeId
  1,            jp_JP   
  2,            es_ES       
  3,            de_DE         
  1,            jp_JP       
  2,            es_ES          
  3,            de_DE"
)

# A lookup table, often loaded from a file
# It is common to create a lookup table in excel and save it as a csv to import
df_lookup <- readr::read_csv(
  "projectId, localeId,   market
         1,    jp_JP,   JAPAN1
         2,    es_ES,   SPAIN2
         3,    au_AU,     AUS3
         4,    us_US,      US4
         5,    en_EN, ENGLAND5
         6,    de_DE, GERMANY6"
)

# A join (dplyr) or a merge (base)
df2 <- left_join(df1,df_lookup,by = c("projectId","localeId"))

df2
# A tibble: 6 x 3
# projectId localeId market
#       <dbl> <chr>    <chr> 
# 1         1 jp_JP    JAPAN1
# 2         2 es_ES    SPAIN2
# 3         3 de_DE    NA    
# 4         1 jp_JP    JAPAN1
# 5         2 es_ES    SPAIN2
# 6         3 de_DE    NA   

Обратите внимание, что 3, de_DE привел к NA, потому что у меня нет этого значения в моей таблице поиска.

Другим способом сделать это было бы потенциально иметь таблицу поиска для localeId для localeName, а затем paste0(localeName,projectId).

РЕДАКТИРОВАТЬ:

ItПохоже, вы упомянули, что склеили вещи вместе, поэтому вот эта методология, использующая dplyr left_join.

df_lookup2 <- readr::read_csv(
  "localeId, localeName
 jp_JP,  Japan
 es_ES,  Spain
 au_AU,  Australia
 us_US,  US
 en_EN, England
 de_DE, Germany"
)

# Using dplyr pipes
df3 <- left_join(df1,df_lookup2,by = c("localeId")) %>%
  mutate(market = paste0(localeName,projectId)) %>%
  select(-localeName)

df3
# # A tibble: 6 x 3
# projectId localeId market  
#       <dbl> <chr>    <chr>   
# 1         1 jp_JP    Japan1  
# 2         2 es_ES    Spain2  
# 3         3 de_DE    Germany3
# 4         1 jp_JP    Japan1  
# 5         2 es_ES    Spain2  
# 6         3 de_DE    Germany3

# Using dplyr join, but base remainder
df4 <- left_join(df1,df_lookup2,by = c("localeId"))
df4$market <- paste0(df4$localeName,df4$projectId)
df4 <- df4[,c("projectId","localeId","market")]

df4
# # A tibble: 6 x 3
# projectId localeId market  
#       <dbl> <chr>    <chr>   
# 1         1 jp_JP    Japan1  
# 2         2 es_ES    Spain2  
# 3         3 de_DE    Germany3
# 4         1 jp_JP    Japan1  
# 5         2 es_ES    Spain2  
# 6         3 de_DE    Germany3

Answer 2

Ваша функция не работает по ряду причин.Например, вам не хватает закрывающих скобок на ваших ifelse s.Закрывающая фигурная скобка в вашем определении функции также отсутствует.Переменные x и y в вашем цикле for являются векторами с длиной> 1, поэтому им также нужны индексы.Аргументы не должны быть только строками, они должны быть назначены переменным, на которые можно ссылаться в функции.Ваши вложенные ifelse имеют дело только с двумя случаями: 1 и 2, а также с Японией и Испанией.Наконец, ваша функция ничего не возвращает.После исправления этих вещей вы получите следующее:

market_names <- function(df){
    df$market <- NA
    x <- ifelse(df$projectId == 1, "1",
                ifelse(df$projectId == 2, "2", df$projectId))
    y <- ifelse(df$localeId == "jp_JP", "JAPAN",
                ifelse(df$localeId == "es_ES", "SPAIN", df$localeId))
    for(i in 1:nrow(df)){
        df[i,]$market <- paste(x[i],y[i], sep = "")
    }
    df
}

market_names(df)

#### OUTPUT ####

# A tibble: 6 x 3
  projectId localeId market
      <dbl> <chr>    <chr> 
1         1 jp_JP    1JAPAN
2         2 es_ES    2SPAIN
3         3 au_AU    3au_AU
4         4 us_US    4us_US
5         5 en_EN    5en_EN
6         6 de_DE    6de_DE

Очевидно, что x должно быть после того, почему y в paste.Ваши условия также должны лучше обрабатывать все случаи.

Вероятно, было бы проще всего использовать список кодов стран, сопоставленный с названиями стран.Столбец localeId может затем использоваться в качестве индекса.Ни петли, ни условия не нужны:

# Country proper names can be accessed using codes.
country_codes <- list("jp_JP" = "JAPAN",
                      "es_ES" = "SPAIN",
                      "de_DE" = "GERMANY",
                      "au_AU" = "AUS",
                      "us_US" = "US",
                      "en_EN" = "ENGLAND",
                      "de_DE" = "GERMANY"
                      )

# Pass in dataframe and country codes.
market_names <- function(df, country_codes){
    df$market <- paste0(unlist(country_codes[df$localeId], use.names = F),
                        df$projectId
                        )
    df
}

# Function call:
market_names(df, country_codes)

#### OUTPUT ####

# A tibble: 6 x 3
  projectId localeId market  
      <dbl> <chr>    <chr>   
1         1 jp_JP    JAPAN1  
2         2 es_ES    SPAIN2  
3         3 au_AU    AUS3    
4         4 us_US    US4     
5         5 en_EN    ENGLAND5
6         6 de_DE    GERMANY6