改进R中的QCC统计计算

Question

我需要对循环中的数据子集执行QCC测试。绘图并不重要，但计算LCL，UCL和标记超出限制并违反Shewhart规则的数据点是。

输入数据是在DF组织，如下所示：

 
    TS CATEGORY KEYWORD CHANNEL QTY 
    2013_Q1 ABC WIDGET1 RETAIL 55 
    2013_Q2 ABC WIDGET1 RETAIL 57 
    2013_Q3 ABC WIDGET1 RETAIL 18 
    2013_Q4 ABC WIDGET1 RETAIL 20 
    2014_Q1 ABC WIDGET1 RETAIL 7 
    2014_Q2 ABC WIDGET1 RETAIL 15 
    2014_Q3 ABC WIDGET1 RETAIL 24 
    2014_Q4 ABC WIDGET1 RETAIL 21 
    2015_Q1 ABC WIDGET1 RETAIL 43 
    2015_Q2 ABC WIDGET1 RETAIL 70 
    2015_Q3 ABC WIDGET1 RETAIL 51 
    2015_Q4 ABC WIDGET1 RETAIL 83 
    2013_Q1 ABC WIDGET1 ONLINE 31 
    2013_Q2 ABC WIDGET1 ONLINE 37 
    2013_Q3 ABC WIDGET1 ONLINE 31 
    2013_Q4 ABC WIDGET1 ONLINE 56 
    2014_Q1 ABC WIDGET1 ONLINE 56 
    2014_Q2 ABC WIDGET1 ONLINE 62 
    2014_Q3 ABC WIDGET1 ONLINE 55 
    2014_Q4 ABC WIDGET1 ONLINE 86 
    2015_Q1 ABC WIDGET1 ONLINE 79 
    2015_Q2 ABC WIDGET1 ONLINE 79 
    2015_Q3 ABC WIDGET1 ONLINE 62 
    2015_Q4 ABC WIDGET1 ONLINE 83 
    2013_Q1 ABC WIDGET1 AUCTION 2 
    2013_Q2 ABC WIDGET1 AUCTION 0 
    2013_Q3 ABC WIDGET1 AUCTION 2 
    2013_Q4 ABC WIDGET1 AUCTION 1 
    2014_Q1 ABC WIDGET1 AUCTION 3 
    2014_Q2 ABC WIDGET1 AUCTION 4 
    2014_Q3 ABC WIDGET1 AUCTION 3 
    2014_Q4 ABC WIDGET1 AUCTION 2 
    2015_Q1 ABC WIDGET1 AUCTION 6 
    2015_Q2 ABC WIDGET1 AUCTION 2 
    2015_Q3 ABC WIDGET1 AUCTION 1 
    2015_Q4 ABC WIDGET1 AUCTION 2 

我已经能够得到的代码工作使用循环如下：

• 确定唯一的组（键）在基于类别，关键字和频道的数据集中
• 通过增加TS来订购数据（用于控制图）
• 通过键循环
• 选择一个子集
• 执行QCC计算
• 更新DF与结果 - 即OOS（超出规格），VLT（违反分），拼箱和UCL

性能优良的小数据集但是数据集很大（> 100,000行）却很差。

任何想法来改变逻辑将不胜感激。

下面是R代码：

library(qcc) 

# read data into DF 
DF <- read.csv("SPCQty1.csv",header=TRUE,na.strings = "null") 

# create ID row to use for later updates 
DF$ID <- 1:nrow(DF) 

# Create additional columns for later use 
# these will be populated after calling qcc function for each group 
DF$oos <- NA 
DF$vlt <- NA 
DF$ucl <- NA 
DF$lcl <- NA 

# determine unique groups in data set 
keys <- unique(DF[,c('PL','KEYWORD','CHANNEL')]) 
len <- nrow(keys) 

# perform stats on each set 
for (i in 1:len) 
{ 
    g1 <- as.data.frame.array(keys[i,]["PL"])[,"PL"] 
    g2 <- as.data.frame.array(keys[i,]["KEYWORD"])[,"KEYWORD"] 
    g3 <- as.data.frame.array(keys[i,]["CHANNEL"])[,"CHANNEL"] 

    # select the subset 
    tmp <- subset(DF, PL == g1 & KEYWORD == g2 & CHANNEL == g3) 
    # sort by TS for control chart 
    spcdata <- tmp[order(tmp$TS),] 

    # generate control chart stats 

    spc <- qcc(spcdata$QTY, type="xbar.one", plot = FALSE) 

    # get statistics object generated by qcc 
    stats <- spc$statistics 
    indices <- 1:length(stats) 

    # get UCL and LCL 
    limits <- spc$limits 
    lcl <- limits[,1] 
    ucl <- limits[,2] 

    # violating runs 
    violations <- spc$violations 

    # create a data frame of the qcc stats 
    qc.data <- data.frame(df.indices <- indices, df.statistics <- as.vector(stats), ID = spcdata$ID) 

    # detect violating runs 
    index.r <- rep(NA, length(violations$violating.runs)) 
    if(length(violations$violating.runs > 0)) { 
    index.r <- violations$violating.runs 
    # Create a data frame for violating run points. 
    df.runs <- data.frame(x.r = qc.data$ID[index.r], vlt = "Y") 
    idx <- df.runs$x.r 
    DF$vlt[DF$ID %in% idx]<- "Y" 
    } 

    # detect beyond limits points 
    index.b <- rep(NA, length(violations$beyond.limits)) 
    if(length(violations$beyond.limits > 0)) { 
    index.b <- violations$beyond.limits 
    # Create a data frame to tag beyond limit points. 
    df.beyond <- data.frame(x.b = qc.data$ID[index.b], oos = "Y") 
    idx <- df.beyond$x.b 
    DF$oos[DF$ID %in% idx]<- "Y" 
    } 

    idx <- qc.data$ID 
    DF$ucl[DF$ID %in% idx] <- ucl 
    DF$lcl[DF$ID %in% idx] <- lcl 
} 

DF[is.na(DF)] <- "" 
# DF will now have 5 additional columns - ID, oos, vlt, ucl and lcl 

Answer 1

我注意到你的代码创建大量的临时变量（EQ index.r，index.b等）如果数组长度是相同的有无需跟踪索引。

library(qcc) 
# read data into DF 
DF <- read.csv("sample.csv",header=TRUE,na.strings = "null") 

# Create additional columns for later use 
# these will be populated after calling qcc function for each group 
DF$oos <- NA 
DF$vlt <- NA 
DF$ucl <- NA 
DF$lcl <- NA 

# determine unique groups in data set 
keys <- unique(DF[,c('PL','KEYWORD','CHANNEL')]) 
len <- nrow(keys) 
dfnew<-data.frame() 

# perform stats on each set 
for (i in 1:len) 
{ 
    # select the subset 
    tmp <- subset(DF, PL == keys$PL[i] & KEYWORD == keys$KEYWORD[i] & CHANNEL == keys$CHANNEL[i]) 
    # generate control chart stats 
    spc <- qcc(tmp$QTY, type="xbar.one", plot = FALSE) 

    # get UCL and LCL 
    tmp$lcl <- spc$limits[,1] 
    tmp$ucl <- spc$limits[,2] 
    #get violations 
    tmp$vlt[spc$violations$violating.runs]<- "Y" 
    tmp$oos[spc$violations$beyond.limits]<- "Y" 
    #add onto data frame 
    dfnew<-rbind(dfnew,tmp) 
} 
dfnew[is.na(dfnew)] <- "" 
#Sort as needed 
print(dfnew) 

新的数据帧“dfnew”包含最终结果。这个简化的版本更易于阅读，应该有一些性能改进，不能用有限的数据对其进行量化。该版本还假定数据在循环之前预分类。下一步的改进是一起消除循环，并用_apply命令替换。同时查看Data.Table，这可以提高子版本的性能。