r - 多个 block 命令的矢量化 if-else

Question

我正在寻找一种基于单个条件语句执行多个变量赋值的方法。 ifelse 函数一次执行我想要的单个变量，但我希望能够基于单个条件执行一个语句 block 。

这是一些简化的示例代码:

within(mydata, {
  if (gender == "f") {
    test1 <- 1
    test2 <- 2
  } else {
    test1 <- 0
    test2 <- 0
  }
  test3 <- gender
  test4 <- ifelse(gender == "f", 1, 0)
  test5 <- ifelse(gender == "f", 2, 0)  
})

这给出了以下输出:

  workshop gender q1 q2 q3 q4 test5 test4 test3 test2 test1
1        1      f  1  1  5  1     2     1     f     2     1
2        2      f  2  1  4  1     2     1     f     2     1
3        1      f  2  2  4  3     2     1     f     2     1
4        2      f  3  1 NA  3     2     1     f     2     1
5        1      m  4  5  2  4     0     0     m     2     1
6        2      m  5  4  5  5     0     0     m     2     1
7        1      m  5  3  4  4     0     0     m     2     1
8        2      m  4  5  5  5     0     0     m     2     1
Warning message:
In if (gender == "f") { :
  the condition has length > 1 and only the first element will be used

当我运行这段代码时，test4 和 test5 被正确分配，但 test1 和 test2 被错误分配，因为 if 语句只返回第一行的值。有没有办法做我正在尝试对 test1 和 test2 做的事情 - 基于单个条件为数据帧的每一行运行多个语句？

我知道我可以用 ifelse 完成相同的结果，但我希望能够将这些语句组合在一起，以便在阅读我的代码时清晰。

例如，我希望能够按度量对我所做的储蓄计算进行分组，如下所示:

a.lighting.all.3 <- within(a.lighting.all.3, {
  if (measure.subcategory %in% c('HID to Linear Fluorescent Retrofit', 
                                 'Hardwired CFL', 'Induction Lighting', 
                                 'Screw-In CFL', 'Specialty Screw-In CFL',
                                'T12 to Premium T8/T5', 'T12 to Standard T8/T5',
                                 'T8 to Premium T8', 'T12/T8 Delamping')) {
    kw.nc.v <- (base.watts - ee.watts) / 1000 * (1 + dif) * df * quantity
    kwh.v <- (base.watts - ee.watts) / 1000 * (1 + eif) * op.hrs * quantity    
  } else if (measure.subcategory == 'Traffic Signals') {
    kw.nc.v <- (base.watts - ee.watts) / 1000 * quantity
    kwh.v <- (base.watts - ee.watts) / 1000 * op.hrs * quantity    
  } else if (measure.subcategory == 'Exit Sign Retrofit') {

  } else if (measure.subcategory %in% c('LED Channel Lights',
                                        'Cold Cathode FL')) {
  } else if (measure.subcategory %in% c('Daylighting Controls', 
                                        'Occupancy Sensors')) {

  } else if (measure.subcategory == 'Lighting Power Density') {

  } else if (measure.subcategory == 'LED Lighting') {

  }
}) 

或按度量分配参数集，例如:

a.lighting.all.3 <- within(a.lighting.all.3, {
  switch(as.character(measure.subcategory),
     "T8 to Premium T8" = {
       op.hrs <- 4481
       cf <- 0.93
     },
     "Cold Cathode FL" = {
       op.hrs <- 6400
       cf <- 1
     },
     "Exit Sign Retrofit" = {
       op.hrs <- 8760
       cf <- 1
     },
     "LED Channel Lights" = {
       op.hrs <- 5110
       cf <- 0.134
     },
     "Traffic Signals" = {
       op.hrs <- ifelse(grepl("Green", measure), 3679, 4818)
       df <- ifelse(grepl("Green", measure), 0.42, 0.55)
       cf <- 1
     },
     "Daylighting Controls" = {
       dsf <- esf <-  0.54  # daylight savings fraction
     },
     "Occupancy Sensors" = {
       dsf <- 0.16  # demand savings fraction
       esf <- 0.39  # energy savings fraction
     },
     "LED Lighting" = {
       if (measure %in% c("Pedestrian NO countdown", 
                          "Pedestrian W/ countdown")) {
         cf <- 1
         op.hrs <- ifelse(measure == "Pedestrian W/ countdown", 6483, 5432)
         op.hrs.base <- 5432
         df <- ifelse(measure == "Pedestrian W/ countdown", 0.74, 0.62)
         df.base <- 0.62
       } else if (measure %in% c("Refrigerated Case LED Lamps NO motion Sensors",
                                 "Refrigerated Case LED Lamps W/ motion Sensors")) {
         cf <- 1
         dif <- 0.25
         eif <- 0.25
         op.hrs.base <- 8634
         op.hrs <- ifelse(measure == "Refrigerated Case LED Lamps W/ motion Sensors",
                          6043, 8634)
       }
     }
  )
})

有任何想法吗？

Answer 1

d <- data.frame(workshop=rep(1:2,4),
                gender=rep(c("f","m"),each=4))

我不知道这个答案是否让你高兴，但是:如果你使用 plyr要对代码块进行操作，您可以使用 if 执行您想要的操作。陈述。

library(plyr)
ddply(d,"gender",
      function(x) {
          within(x, {
              test3 <- gender
              ## test FIRST value only, since by construction they
              ## are all the same within a piece
              if (gender[1]=="f") {
                  test1 <- 1
                  test2 <- 2
                  test4 <- 1
                  test5 <- 1
              } else {
                  test1 <- test2 <- test4 <- test5 <- 0
              }})
      })

请注意，这会按性别将您的数据重新排列成 block (在此示例中它不会改变任何内容)，这可能是不可取的......

我没有在示例中包含其他变量，但它们会正确进行。