r - R での QCC 統計計算の改善

Question

ループ内のデータのサブセットに対して QCC テストを実行する必要があります。プロットは重要ではありませんが、LCL、UCL の計算、および制限を超えてシューハートルールに違反しているデータポイントのタグ付けは重要です。

入力データは、以下に示すように DF で編成されます。

    TS カテゴリ キーワード チャネル数
    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 小売 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ウィジェット1 オークション2
    2013_Q2 ABC WIDGET1 オークション 0
    2013_Q3 ABCウィジェット1 オークション2
    2013_Q4 ABC WIDGET1 オークション 1
    2014_Q1 ABC WIDGET1 オークション 3
    2014_Q2 ABC WIDGET1 オークション 4
    2014_Q3 ABC WIDGET1 オークション 3
    2014_Q4 ABCウィジェット1 オークション2
    2015_Q1 ABC WIDGET1 オークション 6
    2015_Q2 ABCウィジェット1 オークション2
    2015_Q3 ABC WIDGET1 オークション 1
    2015_Q4 ABCウィジェット1 オークション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

r - R での QCC 統計計算の改善

1 に答える 1

Related

Reference