Question

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

输入数据在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（违规点），lcl和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)

新数据框＆＃34; dfnew＆＃34;持有最终结果。这个简化版本更易于阅读，并且应该有一些性能改进，无法用有限的数据量化这一点。此版本还假设数据在循环之前预先排序。下一个改进是将所有循环消除在一起并用_apply命令替换。另外，请查看Data.Table，这可以提高子设备的性能。

改进R中的QCC统计计算

1 个答案: