loop to paste columns together if condition is met

Question

I would like to create a loop that will create a new column, then paste together two columns if a condition is met in a separate column. If the condition is not met, then the column would equal whatever value is in the existing column. Finally, I would like to delete the old columns and rename the new columns to match the old columns. In my example below, I create columns called a1_t, a2_t, a3_t. Then, if a1 == A, paste a1 and a1_c together and place the value in a1_t, otherwise copy the value from a1 into a1_t. Repeat this procedure for a2_t and a3_t.

Here is the data:

set.seed(1)
dat <- data.frame(a1 = sample(LETTERS[1:9],15,replace=T),
                  a1_c = sample (1:100,15),
                  a2 = sample(LETTERS[1:9],15,replace=T),
                  a2_c = sample (1:100,15),
                  a3 = sample(LETTERS[1:9],15,replace=T),
                  a3_c = sample (1:100,15))

Here is the long hand way of creating my end goal:

dat$a1_t <- 'none'
dat$a1_t[dat$a1=="A"] <- paste((dat$a1[dat$a1=="A"]),(dat$a1_c[dat$a1=="A"]),sep="_")
dat$a1_t[dat$a1=="B"] <- 'B'
dat$a1_t[dat$a1=="C"] <- 'C'
dat$a1_t[dat$a1=="D"] <- 'D'
dat$a1_t[dat$a1=="E"] <- 'E'
dat$a1_t[dat$a1=="F"] <- 'F'
dat$a1_t[dat$a1=="G"] <- 'G'
dat$a1_t[dat$a1=="H"] <- 'H'
dat$a1_t[dat$a1=="I"] <- 'I'

dat$a2_t <- 'none'
dat$a2_t[dat$a2=="A"] <- paste((dat$a2[dat$a2=="A"]),(dat$a2_c[dat$a2=="A"]),sep="_")
dat$a2_t[dat$a2=="B"] <- 'B'
dat$a2_t[dat$a2=="C"] <- 'C'
dat$a2_t[dat$a2=="D"] <- 'D'
dat$a2_t[dat$a2=="E"] <- 'E'
dat$a2_t[dat$a2=="F"] <- 'F'
dat$a2_t[dat$a2=="G"] <- 'G'
dat$a2_t[dat$a2=="H"] <- 'H'
dat$a2_t[dat$a2=="I"] <- 'I'

dat$a3_t <- 'none'
dat$a3_t[dat$a3=="A"] <- paste((dat$a3[dat$a3=="A"]),(dat$a3_c[dat$a3=="A"]),sep="_")
dat$a3_t[dat$a3=="B"] <- 'B'
dat$a3_t[dat$a3=="C"] <- 'C'
dat$a3_t[dat$a3=="D"] <- 'D'
dat$a3_t[dat$a3=="E"] <- 'E'
dat$a3_t[dat$a3=="F"] <- 'F'
dat$a3_t[dat$a3=="G"] <- 'G'
dat$a3_t[dat$a3=="H"] <- 'H'
dat$a3_t[dat$a3=="I"] <- 'I'

-al

Answer 1

If you are dealing with a small number of columns, you might just want to use within and ifelse, like this:

within(dat, {
  a1_t <- ifelse(a1 == "A", paste(a1, a1_c, sep = "_"), 
                 as.character(a1))
  a2_t <- ifelse(a2 == "A", paste(a2, a2_c, sep = "_"), 
                 as.character(a2))
  a3_t <- ifelse(a3 == "A", paste(a3, a3_c, sep = "_"), 
                 as.character(a3))
})

You can, however, extend the idea programatically, if necessary.

Ive added comments throughout the code below so you can see what it's doing.

## What variables are we checking?
checkMe <- c("a1", "a2", "a3")

## Let's convert those to character first
dat[checkMe] <- lapply(dat[checkMe], as.character)
cbind(dat,                  ## We'll combine the original data using cbind
      setNames(             ## setNames is for the resulting column names
        lapply(checkMe, function(x) {    ## lapply is an optimized loop
          Get <- c(x, paste0(x, "_c"))   ## We need this for the "if" part
          ifelse(dat[, x] == "A",        ## logical comparison
                 ## if matched, paste together the value from
                 ## the relevant column
                 paste(dat[, Get[1]], dat[, Get[2]], sep = "_"),
                 dat[, x])               ## else return the original value
        }), 
        paste0(checkMe, "_t")))          ## the column names we want
#    a1 a1_c a2 a2_c a3 a3_c a1_t a2_t a3_t
# 1   C   50  E   79  I   90    C    E    I
# 2   D   72  F    3  C   86    D    F    C
# 3   F   98  E   47  E   39    F    E    E
# 4   I   37  B   72  C   76    I    B    C
# 5   B   75  H   67  F   93    B    H    F
# 6   I   89  G   46  C   42    I    G    C
# 7   I   20  H   81  E   67    I    H    E
# 8   F   61  A   41  G   38    F A_41    G
# 9   F   12  G   23  A   30    F    G A_30
# 10  A   25  D    7  H   69 A_25    D    H
# 11  B   35  H    9  D   19    B    H    D
# 12  B    2  F   29  H   64    B    F    H
# 13  G   34  H   95  D   11    G    H    D
# 14  D   76  E   58  D   22    D    E    D
# 15  G   30  E   35  E   13    G    E    E