改進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，這可以提高子版本的性能。