4

単一の条件ステートメントに基づいて複数の変数の割り当てを実行する方法を探しています。ifelse 関数は一度に 1 つの変数に対して必要なことを実行しますが、1 つの条件に基づいてステートメントのブロックを実行できるようにしたいと考えています。

以下は、簡単なコード例です。

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 は正しく割り当てられますが、if ステートメントが最初の行の値のみを返すため、test1 と test2 は正しく割り当てられません。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)
       }
     }
  )
})

何か案は？

4

2 に答える 2

2 
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
              }})
      })

これにより、データが性別ごとにブロックに再配置されることに注意してください（この例では何も変更されません）。これは望ましくない場合があります...

私の例には追加の変数を含めませんでしたが、それらは正しく実行されます。

于 2012-09-25T21:28:40.270 に答える
2

時間とメモリの効率とコーディングの優雅さのための data.table ソリューション

library(data.table)
DT <- as.data.table(d)

DT[,  `:=`(paste0('test',1:5), list((1:0)[gender],  
            (c(2,0))[gender], gender, (1:0)[gender], (1:0)[gender])), with = F]

:=LHS引数が (作成される) 名前の文字ベクトルであり、RHS が使用される値を含むリストである場合、参照によって割り当てられ、複数の列に対して機能します。

このソリューションでは、 が因子変数であるという事実も利用しておりgender、基になる整数値を使用して再コーディングを参照できます。

次のようなこともできます

setkey(|Dt, gender)
DT['f', test1 := 1]
DT['m', test1 := 0]
DT['f', test2 := 2]
DT['m', test2 := 0]
DT[,test3 := gender]
# etc

これは、性別がキャラクターではなく要因である場合に警告を発しますが、それでも機能します。

于 2012-09-25T23:03:46.347 に答える