Re: [問題] 依特定欄位的內容對data.table資料作分群

看板R_Language作者celestialgod (天)時間8年前 (2017/03/05 23:28)推噓4(4推 0噓 11→)

留言15則, 1人參與討論串2/2 (看更多)

※ 引述《joson4921 (特務)》之銘言： : : - 問題: : : [問題類型]: : : 程式諮詢(我想用R 做某件事情，但是我不知道要怎麼用R 寫出來) : : [軟體熟悉度]: : : 入門(寫過其他程式，只是對語法不熟悉) : : [問題敘述]: : : 手邊有一份資料 dt1 ,裡面有幾個欄位,以下節錄部分內容： : Stop.No TravelTime Weekend : 1 1 　　↘ : 2 1 　 → 當Stop.No==1, TravelTime介於[0,120],Weekend可能為True/False : 3 1　　 ↗ : ... : 666 2 　 ↘ : 667 2　　 → 當Stop.No==2, TravelTime介於[60,180],Weekend可能為True/False : 668 2 ↗ : ... : 1315 3 　 ↘ : 1316 3 　→ 當Stop.No==3,TravelTime介於[120,240],Weekend可能為True/False : 1317 3 　↗ : ... : 2017 : ========================================================================= : ※1　共2017筆資料 : ※2 Stop.No的資料為隨機1~3, 上面表列僅為示意用 : 並非正好[ 第1~665筆的Stop.No==1, 第666~1314筆==2, 第1315~2017筆==3] : ========================================================================= : 我想做的事情是依照 Stop.No/Weekend 欄位進行分群, : 例： : 這2017筆資料中有322筆資料 Stop.No==1 且 Weekend=T , : 則將這322筆視為同一群,其餘依此類推,故應可得到6群 : 這邊參照之前板上前輩教導的方法將相同的 Stop.No 和 Weekend 取出作 group_by : 程式碼架構如下(by dplyr)： : dt1 %>% : group_by( Stop.No, Weekend ) %>% : summarise( 對 group_by 出來的6群,作集群分析,詳如下述 ) : ========================================================================= : summarise() 的內容： : 想把「上面 group_by 出來的結果(6群),每一群都再分成兩群(gr1/gr2)並找出中心」, : 因此上網查了分群的方法,根據google,假設上述六群中的某群叫作 gr8, : 則可透過以下程式碼將 gr8 分成兩群,並求出 gr8 的群集中心 : kmeans.result = kmeans( gr8, 2) : gr8_result <- gr8[, centers := kmeans.result$centers[kmeans.result$cluster] ] : ========================================================================= : 我想做的事情: : 以本資料 dt1 為例, group_by 出來的 6群應可透過kmeans求出 12個集群中心 : ( gr8 裡面的 centers欄位 ) : 最後將 gr8 的 centers 欄位內容加回 dt1 對應的2017筆資料列後面 : 以上敘述滿複雜的,若有敘述不清的地方歡迎提問,小弟將盡速補充 : 請求各位前輩們協助,先謝謝各位大大了 : : [程式範例]: : : [環境敘述]: : : : [關鍵字]: : : 上一篇發現做錯，先刪掉了好讀版：http://pastebin.com/MguuwYAi 建議直接看好讀版簡單simulation一組資料，有五個變數，兩個變數是group by的變數另外三個是拿來分群的變數最終的結果是把原始資料併上每個資料的cluster以及對應的center 計算時間的話，dplyr + tidyr 或是 data.table 都可以在0.1秒以內可以算完 20000個觀察值 library(dplyr) library(tidyr) library(pipeR) # dplyr + tidyr ngrp <- 2L numSamples <- 200L DF <- data.frame(V1 = sample(1L:3L, numSamples, TRUE), V2 = sample(1L:2L, numSamples, TRUE), V3 = rnorm(numSamples), V4 = rnorm(numSamples), V5 = rnorm(numSamples)) DF %>>% group_by(V1, V2) %>>% summarise( oriData = list(data.frame(V3 = V3, V4 = V4, V5 = V5)), kmeansRes = list(kmeans(data.frame(V3_center = V3, V4_center = V4, V5_center = V5), ngrp))) %>% rowwise %>>% do(V1 = .$V1, V2 = .$V2, oriData = .$oriData, grps = .$kmeansRes$cluster, centers = as.data.frame(.$kmeansRes$centers[.$kmeansRes$cluster, ])) %>>% mutate(V1 = unlist(V1), V2 = unlist(V2)) %>>% unnest(grps, oriData, centers) # # A tibble: 200 × 9 # V1 V2 grps V3 V4 V5 V3_center V4_center V5_center # <int> <int> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> # 1 1 1 1 1.11016253 0.02722608 0.3027893 -0.35019463 0.1903187 0.9848824 # 2 1 1 1 0.70820726 -2.19334026 0.3242983 -0.35019463 0.1903187 0.9848824 # 3 1 1 2 -0.33493165 -0.07425543 -0.6383053 -0.02633612 0.3241840 -1.0112687 # 4 1 1 2 -2.03926090 0.24728959 0.1302806 -0.02633612 0.3241840 -1.0112687 # 5 1 1 2 -0.04744358 0.20338375 -1.3591982 -0.02633612 0.3241840 -1.0112687 # 6 1 1 2 0.12768265 1.34077790 -1.4590170 -0.02633612 0.3241840 -1.0112687 # 7 1 1 2 1.08012650 1.95067610 1.3336783 -0.02633612 0.3241840 -1.0112687 # 8 1 1 2 0.85677265 0.46973309 -0.6577587 -0.02633612 0.3241840 -1.0112687 # 9 1 1 1 0.90455630 2.44301533 -1.0511750 -0.35019463 0.1903187 0.9848824 # 10 1 1 2 1.07202152 -0.05310248 -1.4048170 -0.02633612 0.3241840 -1.0112687 # # ... with 190 more rows # data.table library(data.table) ngrp <- 2L numSamples <- 200L DT <- data.table(V1 = sample(1L:3L, numSamples, TRUE), V2 = sample(1L:2L, numSamples, TRUE), V3 = rnorm(numSamples), V4 = rnorm(numSamples), V5 = rnorm(numSamples)) DT_kmeans <- DT[ , .( oriData = list(data.table(V3, V4, V5)), kmeansRes = list(kmeans(data.table(V3, V4, V5) %>>% setnames(paste0(names(.), "_center")), ngrp) %>>% {data.table(grp = .$cluster, .$centers[.$cluster, ])})), by = .(V1, V2)] cbind(DT_kmeans[ , .(V1, V2)][rep(1L:nrow(DT_kmeans), sapply(DT_kmeans$oriData, nrow)), ], rbindlist(DT_kmeans$oriData), rbindlist(DT_kmeans$kmeansRes)) # V1 V2 V3 V4 V5 grp V3_center V4_center V5_center # 1: 1 1 -1.5910524 2.1274208 -1.3464532 1 0.1155321 0.9482175 0.290026606 # 2: 1 1 0.3280774 -0.1150860 -1.2363502 2 -0.1138527 -1.1174780 -0.603929772 # 3: 1 1 -0.2026653 -0.9188654 0.4275579 2 -0.1138527 -1.1174780 -0.603929772 # 4: 1 1 -0.3258952 0.3159080 1.3667256 1 0.1155321 0.9482175 0.290026606 # 5: 1 1 -0.2819986 -1.2371227 0.6597289 2 -0.1138527 -1.1174780 -0.603929772 # --- # 196: 2 2 0.6875229 -1.4182973 -0.1774791 1 0.5244143 -0.4805122 0.084895890 # 197: 2 2 1.1732799 -0.7428654 -0.1777401 1 0.5244143 -0.4805122 0.084895890 # 198: 2 2 -1.1992074 -0.6165810 0.0421549 2 -0.8536335 0.6373769 -0.007181771 # 199: 2 2 -0.4136762 1.1002398 0.4306150 2 -0.8536335 0.6373769 -0.007181771 # 200: 2 2 -0.1929361 -0.7346460 -0.4713694 1 0.5244143 -0.4805122 0.084895890 -- R資料整理套件系列文： magrittr #1LhSWhpH (R_Language) https://goo.gl/72l1m9 data.table #1LhW7Tvj (R_Language) https://goo.gl/PZa6Ue dplyr(上.下) #1LhpJCfB,#1Lhw8b-s (R_Language) https://goo.gl/I5xX9b tidyr #1Liqls1R (R_Language) https://goo.gl/i7yzAz pipeR #1NXESRm5 (R_Language) https://goo.gl/zRUISx -- ※ 發信站: 批踢踢實業坊(ptt.cc), 來自: 36.232.184.141 ※ 文章網址: https://www.ptt.cc/bbs/R_Language/M.1488727704.A.05E.html

推