r函數或循環以創建新列並根據限制計算值

Question

如果滿足某些條件，我目前使用40行代碼來創建和計算新列。 我試圖提出一種將所有這些代碼轉換成循環或函數的方法，以簡化我的腳本。

以下是一些示例數據：

set.seed(1)
dat <- data.frame(sc1 = sample(LETTERS[1:6],15,replace=T),
                  sc1_n = sample (1:100,15),
                  sc2 = sample(LETTERS[1:6],15,replace=T),
                  sc2_n = sample (1:100,15),
                  sc3 = sample(LETTERS[1:6],15,replace=T),
                  sc3_n = sample (1:100,15),
                  ec1 = sample(LETTERS[1:6],15,replace=T),
                  ec1_n = sample (1:100,15),
                  ec2 = sample(LETTERS[1:6],15,replace=T),
                  ec2_n = sample (1:100,15),
                  ec3 = sample(LETTERS[1:6],15,replace=T),
                  ec3_n = sample (1:100,15),
                  area = sample (1:100,15))

我遍歷sc1（AF，n = 6），sc2（AF，n = 6）和sc3（AF，n = 6）的每個唯一值以計算一個值，然后將這些唯一值加在一起以創建另一列，稱為A，B，C，D，E或F，並在其后附加“ s”以表示它是s的值，而不是e的值，在我用sc1，sc2和sc3完成之后我也要對其進行迭代。

這是我當前用於生成所需列和值的40行代碼：

dat <- transform(dat,A1s = (sc1_n * 0.01) * (area) * (sc1 == "A")) #create new column A1s, and calculates a number if sc1=='A'
dat <- transform(dat,A2s = (sc2_n * 0.01) * (area) * (sc2 == "A")) #create new column A2s, and calculates a number if sc2=='A'
dat <- transform(dat,A3s = (sc3_n * 0.01) * (area) * (sc3 == "A")) #same as above, except A3s and where sc3='A'
dat <- transform(dat,As = A1s + A2s + A3s) #I really don't need A1s, A2s, or A3s, except to calculate this column, As
dat <- transform(dat,B1s = (sc1_n * 0.01) * (area) * (sc1 == "B"))
dat <- transform(dat,B2s = (sc2_n * 0.01) * (area) * (sc2 == "B"))
dat <- transform(dat,B3s = (sc3_n * 0.01) * (area) * (sc3 == "B"))
dat <- transform(dat,Bs = B1s + B2s + B3s)
dat <- transform(dat,C1s = (sc1_n * 0.01) * (area) * (sc1 == "C"))
dat <- transform(dat,C2s = (sc2_n * 0.01) * (area) * (sc2 == "C"))
dat <- transform(dat,C3s = (sc3_n * 0.01) * (area) * (sc3 == "C"))
dat <- transform(dat,Cs = C1s + C2s + C3s)
dat <- transform(dat,D1s = (sc1_n * 0.01) * (area) * (sc1 == "D"))
dat <- transform(dat,D2s = (sc2_n * 0.01) * (area) * (sc2 == "D"))
dat <- transform(dat,D3s = (sc3_n * 0.01) * (area) * (sc3 == "D"))
dat <- transform(dat,Ds = D1s + D2s + D3s)
dat <- transform(dat,E1s = (sc1_n * 0.01) * (area) * (sc1 == "E"))
dat <- transform(dat,E2s = (sc2_n * 0.01) * (area) * (sc2 == "E"))
dat <- transform(dat,E3s = (sc3_n * 0.01) * (area) * (sc3 == "E"))
dat <- transform(dat,Es = E1s + E2s + E3s)
dat <- transform(dat,F1s = (sc1_n * 0.01) * (area) * (sc1 == "F"))
dat <- transform(dat,F2s = (sc2_n * 0.01) * (area) * (sc2 == "F"))
dat <- transform(dat,F3s = (sc3_n * 0.01) * (area) * (sc3 == "F"))
dat <- transform(dat,Fs = F1s + F2s + F3s)

dat <- transform(dat,A1e = (ec1_n * 0.01) * (area) * (ec1 == "A"))
dat <- transform(dat,A2e = (ec2_n * 0.01) * (area) * (ec2 == "A"))
dat <- transform(dat,A3e = (ec3_n * 0.01) * (area) * (ec3 == "A"))
dat <- transform(dat,Ae = A1e + A2e + A3e)
dat <- transform(dat,B1e = (ec1_n * 0.01) * (area) * (ec1 == "B"))
dat <- transform(dat,B2e = (ec2_n * 0.01) * (area) * (ec2 == "B"))
dat <- transform(dat,B3e = (ec3_n * 0.01) * (area) * (ec3 == "B"))
dat <- transform(dat,Be = B1e + B2e + B3e)
dat <- transform(dat,C1e = (ec1_n * 0.01) * (area) * (ec1 == "C"))
dat <- transform(dat,C2e = (ec2_n * 0.01) * (area) * (ec2 == "C"))
dat <- transform(dat,C3e = (ec3_n * 0.01) * (area) * (ec3 == "C"))
dat <- transform(dat,Ce = C1e + C2e + C3e)
dat <- transform(dat,D1e = (ec1_n * 0.01) * (area) * (ec1 == "D"))
dat <- transform(dat,D2e = (ec2_n * 0.01) * (area) * (ec2 == "D"))
dat <- transform(dat,D3e = (ec3_n * 0.01) * (area) * (ec3 == "D"))
dat <- transform(dat,De = D1e + D2e + D3e)
dat <- transform(dat,E1e = (ec1_n * 0.01) * (area) * (ec1 == "E"))
dat <- transform(dat,E2e = (ec2_n * 0.01) * (area) * (ec2 == "E"))
dat <- transform(dat,E3e = (ec3_n * 0.01) * (area) * (ec3 == "E"))
dat <- transform(dat,Ee = E1e + E2e + E3e)
dat <- transform(dat,F1e = (ec1_n * 0.01) * (area) * (ec1 == "F"))
dat <- transform(dat,F2e = (ec2_n * 0.01) * (area) * (ec2 == "F"))
dat <- transform(dat,F3e = (ec3_n * 0.01) * (area) * (ec3 == "F"))
dat <- transform(dat,Fe = F1e + F2e + F3e)

我確信必須有一種方法，可以通過創建列表和循環或至少一個函數來巧妙而有效地做到這一點，但是我一直在尋找並且沒有找到一種方法。

-al

Answer 1

這樣的轉變怎么樣

for(p in c("s","e")) {
   g <- dat[, paste0(p, "c",1:3)]
   n <- dat[, paste0(p, "c",1:3,"_n")]
   for(x in LETTERS[1:5]) {
       dat[, paste0(x,p) ] <- rowSums(n * 0.01 * (g==x) * dat$area)
   }
}

在這里，我們遍歷“ s”和“ e”前綴的不同集合，並提取與該前綴相關的列的子集。 接下來，我們遍歷所有組並計算該組的行總和。 在這里，我們試圖利用存儲在列名稱中的盡可能多的信息。 這不會創建您不需要的臨時列（A1，A2等）