推 wmj10054039: 感謝C大和Wush大 ～～收益良多！ 06/07 20:54
※ 引述《wmj10054039 (MJ)》之銘言：
: ※ 引述《celestialgod (天)》之銘言：
: : 程式：
: : library(data.table)
: : library(pipeR)
: : library(stringr)
: : dataStr <- "流水號 課程名稱 時間 地點 人數
: : 102 A 二3,4四5,7 甲 10
: : 248 B 一1,2,3 乙 20
: : 314 C 三4五7,8,a 丙 5"
: : removeEmptyFunc <- function(x) x[nchar(x) > 0]
: : fread(dataStr) %>>%
: : `[`(j = `:=`(星期 = str_split(時間, "[a-zA-Z0-9,]+") %>>%
: : lapply(removeEmptyFunc),
: : 節次 = str_split(時間, "[^a-zA-Z0-9,]+") %>>%
: : lapply(removeEmptyFunc))) %>>%
: : `[`(j = .(星期 = unlist(星期), 節次 = unlist(節次)),
: : by = .(流水號, 課程名稱, 地點, 人數)) %>>%
: : `[`(j = `:=`(節次 = str_split(節次, ","))) %>>%
: : `[`(j = .(節次 = unlist(節次)), by = .(流水號, 課程名稱, 地點, 人數, 星期))
: : ## no pipe 程式碼
: : dataDT <- fread(dataStr)
: : dataDT[ , `:=`(星期 = lapply(str_split(時間, "[a-zA-Z0-9,]+"),
: : removeEmptyFunc),
: : 節次 = lapply(str_split(時間, "[^a-zA-Z0-9,]+"),
: : removeEmptyFunc))]
: : tmpDT <- dataDT[ , .(星期 = unlist(星期), 節次 = unlist(節次)),
: : by = .(流水號, 課程名稱, 地點, 人數)]
: : tmpDT[ , `:=`(節次 = str_split(節次, ","))]
: : tmpDT[ , .(節次 = unlist(節次)), by = .(流水號, 課程名稱, 地點, 人數, 星期)]
: : 結果：
: : # 流水號 課程名稱 地點 人數 星期 節次
: : # 1: 102 A 甲 10 二 3
: : # 2: 102 A 甲 10 二 4
: : # 3: 102 A 甲 10 四 5
: : # 4: 102 A 甲 10 四 7
: : # 5: 248 B 乙 20 一 1
: : # 6: 248 B 乙 20 一 2
: : # 7: 248 B 乙 20 一 3
: : # 8: 314 C 丙 5 三 4
: : # 9: 314 C 丙 5 五 7
: : # 10: 314 C 丙 5 五 8
: : # 11: 314 C 丙 5 五 a
: 我在回應區的問題是想要把如果節次包含3節以上的課程，只取出頭跟尾的節次，並且只有
: 一節課的課程重複兩次，也就是說每個課程重複在dataframe的次數都會是偶數倍(主要
: 目的是想知道每個時段下不同地點會產生的進出人數)，舉例來說:
: 流水號 課程名稱 時間 人數 地點
: 102 A 二3,4四5,7 10 甲
: 248 B 一1,2,3 20 乙
: 314 C 三4五7,8,a 5 丙
: 整理成
: 流水號 課程名稱 地點 人數 星期 節次
: 102 A 甲 10 二 3
: 102 A 甲 10 二 4
: . .
: . .
: . .
: 248 B 乙 20 一 1
: 248 B 乙 20 一 3
: 314 C 丙 5 三 4
: 314 C 丙 5 三 4
: 314 C 丙 5 五 7
: 314 C 丙 5 五 a
: 我目前的想法是利用c大處理我之前問題的方法，將已經把時間拆開成星期跟節次但
: 還沒unlist的節次取出，用迴圈搭配條件判斷存成新的list再放回data.frame，但發現
: 這個方法存成的list只會有最後一個元素有值，其他都是NULL。想請教是哪邊有錯誤，
: 或是有更好的解決方法，謝謝。
: [程式範例]
: oldlist = df$節次
: newlist = list()
: for (i in length(oldlist)) {
: if (length(oldlist[[i]]) == 1){
: newlist[[i]] = rep(oldlist[[i]][1], 2)
: }else if (length(oldlist[[i]]) == 2){
: newlist[[i]] = c(oldlist[[i]][1], oldlist[[i]][2])
: }else if (length(oldlist[[i]]) == 3){
: newlist[[i]] = c(oldlist[[i]][1], olslist[[i]][3])
: }
: }
直接用原本整理好的data.table在整理一下就好了
(outDT是前次的輸出)
# 先轉成factor (節次為1~8 然後接A~E，如果不對再自行調整)
# 這樣會轉成整數比較好做
outDT[ , 節次 := factor(節次, c(1:8, letters[1:5]))]
# 用diff找出前後都相差1的節次還把它們移除掉
outDT[ , filter := diff(c(-2, 節次)) == 1 & diff(c(節次, 20)) == 1,
by = .(流水號, 課程名稱, 地點, 人數, 星期)]
# 過濾掉前後都相差1的節次
finalDT <- outDT[filter == FALSE]
# 把filter這個欄位移除掉
finalDT[ , filter := NULL]
# 最後：
# 流水號 課程名稱 地點 人數 星期 節次
# 1: 102 A 甲 10 二 3
# 2: 102 A 甲 10 二 4
# 3: 102 A 甲 10 四 5
# 4: 102 A 甲 10 四 7
# 5: 248 B 乙 20 一 1
# 6: 248 B 乙 20 一 3
# 7: 314 C 丙 5 三 4
# 8: 314 C 丙 5 五 7
# 9: 314 C 丙 5 五 a
--
※ 發信站: 批踢踢實業坊(ptt.cc), 來自: 36.233.83.41
※ 文章網址: https://www.ptt.cc/bbs/R_Language/M.1528288066.A.8F0.html
※ 編輯: celestialgod (36.233.83.41), 06/06/2018 20:29:25