आर

2015-01-08 5 views
7

में एक अद्वितीय (एनवाईसी एमटीए टर्नस्टाइल) डेटासेट को पुनर्गठित करना मेरे पास एक अद्वितीय दिखने वाला डेटासेट (एनवाईसी एमटीए टर्नस्टाइल डेटा) है जिसे मुझे कुछ विश्लेषण करने के लिए एक निश्चित तरीके से फिर से व्यवस्थित करने की आवश्यकता है। मैंने कोड लिखा है जो काम करता है लेकिन बहुत प्रभावी नहीं है क्योंकि यह एक बहुत बड़ा डेटासेट है। मुझे उम्मीद है कि कोई बेहतर तरीका सुझा सकता है।आर

प्रश्न में डेटासेट में 43 कॉलम हैं। कॉलम 1-3 अद्वितीय पहचानकर्ता हैं (यानी एक विशिष्ट स्टेशन पर टर्नस्टाइल)। फिर स्तंभ 4-8 मीट्रिक समय, मीट्रिक प्रकार, प्रविष्टियों और फिर बाहर निकलने की पहचान करता है। 9-13 और फिर शेष स्तंभ 43 तक एक ही पैटर्न का पालन करते हैं। डेटासेट बदसूरत है इसलिए मैं इसे यहां पोस्ट नहीं करना चाहता हूं लेकिन आप इसे नीचे दिए गए लिंक में पा सकते हैं। आपको पूर्व 10/18/14 डेटा देखना होगा।

http://web.mta.info/developers/turnstile.html

#Vector of column numbers that identifies the break 
a <- c(4, 9, 14, 19, 24, 29, 34, 39) 
#The actual loop to re-sort the data 
for (i in 1:nrow(data)) { 
    for (j in 1:length(a)) { 
     if (j == 8){ all <- rbind(all, cbind(data[i, 1:3], data[i, a[j]:43])) } 
     else { all <- rbind(all, cbind(data[i, 1:3], data[i,a[j]:(a[j+1]-1)])) } } } 

इस सब के अंतिम परिणाम कुछ है कि इस तरह दिखता है है।

 1 2  3  1  2  3  4  5 
5083 H026 R137 00-00-00 10-04-14 00:00:00 REGULAR 4072851 10491832 
50831 H026 R137 00-00-00 10-04-14 04:00:00 REGULAR 4072918 10492356 
50832 H026 R137 00-00-00 10-04-14 08:00:00 REGULAR 4073125 10492613 
50833 H026 R137 00-00-00 10-04-14 12:00:00 REGULAR 4073511 10493116 
50834 H026 R137 00-00-00 10-04-14 16:00:00 REGULAR 4073820 10493877 
50835 H026 R137 00-00-00 10-04-14 20:00:00 REGULAR 4074140 10494817 

यह काम करता है, लेकिन मुझे पता है कि ऐसा करने के लिए वहां एक और अधिक प्रभावी तरीका है। किसी भी मदद को बहुत, बहुत सराहा जाएगा!

संपादित करें:

मैं के रूप में मैं कुछ महत्वपूर्ण टुकड़े है कि इस के लिए दृष्टिकोण बदल सकते हैं बाहर छोड़ दिया इस के लिए थोड़ा और जोड़ना चाहिए। Read.csv के साथ डेटा में पढ़ने के बाद मैं केवल कुछ मीटर (कॉलम 2) के साथ डेटा को सब्सक्राइब करता हूं। चूंकि मुझे सुझाव पसंद आया क्योंकि मैंने नीचे देखा गया सबसेट डेटा को एक स्ट्रिंग में रूपांतरित कर दिया है। यह वास्तव में काफी हद तक निष्पादित करता है लेकिन किसी और सुझाव की सराहना की जाएगी!

out1 <- function() { 
    data <- read.csv(name, header=FALSE) 

##Isolate data for stations included in network area 
    station <- subset(data, V2%in% station_names) 
    data <- apply(station, 1, paste, collapse=",") 
    starts <- seq(from=4, to=43, by=5) 
    new_data <- rbindlist(lapply(strsplit(data, ","), function(x) { 
    rbindlist(lapply(starts, function(y) { 
    as.list(x[c(1:3, y:(y+4))]) 
    })) 
})) 
setnames(new_data, colnames(new_data), c("C.A", "UNIT", "SCP", "DATE", "TIME","DESC", "ENTRIES", "EXIT")) 
new_data <- as.data.frame(new_data) 
} 

उत्तर

7

आप डेटा लोड पर प्रोसेसिंग करने से परहेज नहीं करते हैं:

# data via http://web.mta.info/developers/resources/nyct/turnstile/ts_Field_Description_pre-10-18-2014.txt 

data <- readLines(textConnection("A002,R051,02-00-00,03-21-10,00:00:00,REGULAR,002670738,000917107,03-21-10,04:00:00,REGULAR,002670738,000917107,03-21-10,08:00:00,REGULAR,002670746,000917117,03-21-10,12:00:00,REGULAR,002670790,000917166,03-21-10,16:00:00,REGULAR,002670932,000917204,03-21-10,20:00:00,REGULAR,002671164,000917230,03-22-10,00:00:00,REGULAR,002671181,000917231,03-22-10,04:00:00,REGULAR,002671181,000917231 
A002,R051,02-00-00,03-22-10,08:00:00,REGULAR,002671220,000917324,03-22-10,12:00:00,REGULAR,002671364,000917640,03-22-10,16:00:00,REGULAR,002671651,000917719,03-22-10,20:00:00,REGULAR,002672430,000917789,03-23-10,00:00:00,REGULAR,002672473,000917795,03-23-10,04:00:00,REGULAR,002672474,000917795,03-23-10,08:00:00,REGULAR,002672516,000917876,03-23-10,12:00:00,REGULAR,002672652,000917934 
A002,R051,02-00-00,03-23-10,16:00:00,REGULAR,002672879,000917996,03-23-10,20:00:00,REGULAR,002673636,000918073,03-24-10,00:00:00,REGULAR,002673683,000918079,03-24-10,04:00:00,REGULAR,002673683,000918079,03-24-10,08:00:00,REGULAR,002673722,000918171,03-24-10,12:00:00,REGULAR,002673876,000918514,03-24-10,16:00:00,REGULAR,002674221,000918594,03-24-10,20:00:00,REGULAR,002675082,000918671 
A002,R051,02-00-00,03-25-10,00:00:00,REGULAR,002675153,000918675,03-25-10,04:00:00,REGULAR,002675153,000918675,03-25-10,08:00:00,REGULAR,002675190,000918752,03-25-10,12:00:00,REGULAR,002675345,000919053,03-25-10,16:00:00,REGULAR,002675676,000919118,03-25-10,20:00:00,REGULAR,002676557,000919179,03-26-10,00:00:00,REGULAR,002676688,000919207,03-26-10,04:00:00,REGULAR,002676694,000919208 
A002,R051,02-00-00,03-26-10,08:00:00,REGULAR,002676735,000919287,03-26-10,12:00:00,REGULAR,002676887,000919607,03-26-10,16:00:00,REGULAR,002677213,000919680,03-26-10,20:00:00,REGULAR,002678039,000919743,03-27-10,00:00:00,REGULAR,002678144,000919756,03-27-10,04:00:00,REGULAR,002678145,000919756,03-27-10,08:00:00,REGULAR,002678155,000919777,03-27-10,12:00:00,REGULAR,002678247,000919859 
A002,R051,02-00-00,03-27-10,16:00:00,REGULAR,002678531,000919908,03-27-10,20:00:00,REGULAR,002678892,000919964,03-28-10,00:00:00,REGULAR,002678929,000919966,03-28-10,04:00:00,REGULAR,002678929,000919966,03-28-10,08:00:00,REGULAR,002678935,000919982,03-28-10,12:00:00,REGULAR,002679003,000920006,03-28-10,16:00:00,REGULAR,002679231,000920059,03-28-10,20:00:00,REGULAR,002679475,000920098")) 


library(data.table) 

starts <- seq(from=4, to=43, by=5) 

new_data <- rbindlist(lapply(strsplit(data, ","), function(x) { 

    rbindlist(lapply(starts, function(y) { 
    as.list(x[c(1:3, y:(y+4))]) 
    })) 

})) 

setnames(new_data, colnames(new_data), c("control_area", "unit", "scp", "date", "time", "description", "entries", "exits")) 

dplyr::glimpse(new_data) 

## Observations: 48 
## Variables: 
## $ control_area (fctr) A002, A002, A002, A002, A002, A002, A002, A002, A002, A002, A002, A002, A002, A0... 
## $ unit   (fctr) R051, R051, R051, R051, R051, R051, R051, R051, R051, R051, R051, R051, R051, R0... 
## $ scp   (fctr) 02-00-00, 02-00-00, 02-00-00, 02-00-00, 02-00-00, 02-00-00, 02-00-00, 02-00-00, ... 
## $ date   (fctr) 03-21-10, 03-21-10, 03-21-10, 03-21-10, 03-21-10, 03-21-10, 03-22-10, 03-22-10, ... 
## $ time   (fctr) 00:00:00, 04:00:00, 08:00:00, 12:00:00, 16:00:00, 20:00:00, 00:00:00, 04:00:00, ... 
## $ description (fctr) REGULAR, REGULAR, REGULAR, REGULAR, REGULAR, REGULAR, REGULAR, REGULAR, REGULAR,... 
## $ entries  (fctr) 002670738, 002670738, 002670746, 002670790, 002670932, 002671164, 002671181, 002... 
## $ exits  (fctr) 000917107, 000917107, 000917117, 000917166, 000917204, 000917230, 000917231, 000... 
+0

यह बहुत अच्छा है। आपके सहयोग के लिए धन्यवाद! –

5

यहाँ एक वैकल्पिक दृष्टिकोण पर विचार करने के लिए है। यह "स्ट्रिंग" पैकेज और मेरा "splitstackshape" पैकेज का उपयोग करता है।

library(splitstackshape) 
library(stringi) 

हम के रूप में the URL shared by @hrbmstr

Names <- scan(what = "character", sep = ",", 
       text = paste0(
       "C/A,UNIT,SCP,DATE1,TIME1,DESC1,ENTRIES1,EXITS1,", 
       "DATE2,TIME2,DESC2,ENTRIES2,EXITS2,DATE3,TIME3,DESC3,", 
       "ENTRIES3,EXITS3,DATE4,TIME4,DESC4,ENTRIES4,EXITS4,", 
       "DATE5,TIME5,DESC5,ENTRIES5,EXITS5,DATE6,TIME6,DESC6,", 
       "ENTRIES6,EXITS6,DATE7,TIME7,DESC7,ENTRIES7,EXITS7,", 
       "DATE8,TIME8,DESC8,ENTRIES8,EXITS8")) 

## What are the unique variable "stubs"? 
isRepeated <- unique(gsub("\\d", "", Names[4:length(Names)])) 

अगला में पहचान क्षेत्र विवरण से नामों का उपयोग करेगा, हम एक समारोह है कि इसके बाद के संस्करण स्थिरांक का उपयोग करता है लिखते हैं।

  1. का उपयोग करता है stri_split_fixed एक matrix में vector विभाजित करने के लिए: समारोह निम्नलिखित है।
  2. किसी भी अत्यधिक सफेद जगह trims।
  3. matrix को data.table में परिवर्तित करता है और प्रासंगिक नाम निर्दिष्ट करता है।
  4. "विस्तृत" फ़ॉर्म से "अर्द्ध-लंबे" रूप में जाने के लिए merged.stack का उपयोग करता है।

    funAM <- function(invec) { 
        temp <- stri_split_fixed(invec, ",", simplify = TRUE) 
        temp <- `dim<-`(stri_trim_both(temp), dim(temp)) 
        DT <- setnames(as.data.table(temp), Names) 
        merged.stack(getanID(DT, 1:3), var.stubs = isRepeated, 
           sep = "var.stubs") 
    } 
    

    के लिए इसे बाहर की कोशिश करते हैं:

    system.time(out <- funAM(data)) ## Reasonably fast 
    # user system elapsed 
    # 1.25 0.02 1.29 
    out 
    #  C/A UNIT  SCP .id .time_1  DATE  TIME DESC ENTRIES  EXITS 
    # 1: A002 R051 02-00-00 1  1 06-08-13 00:00:00 REGULAR 004153504 001427135 
    # 2: A002 R051 02-00-00 1  2 06-08-13 04:00:00 REGULAR 004153535 001427138 
    # 3: A002 R051 02-00-00 1  3 06-08-13 08:00:00 REGULAR 004153559 001427177 
    # 4: A002 R051 02-00-00 1  4 06-08-13 12:00:00 REGULAR 004153683 001427255 
    # 5: A002 R051 02-00-00 1  5 06-08-13 16:00:00 REGULAR 004153959 001427320 
    # ---                    
    # 241492: TRAM2 R469 00-05-01 6  4            
    # 241493: TRAM2 R469 00-05-01 6  5            
    # 241494: TRAM2 R469 00-05-01 6  6            
    # 241495: TRAM2 R469 00-05-01 6  7            
    # 241496: TRAM2 R469 00-05-01 6  8 
    
    :

    ## Try a dataset where we know there are unbalanced numbers of observations... 
    data <- readLines("http://web.mta.info/developers/data/nyct/turnstile/turnstile_130615.txt") 
    

    हम data उद्देश्य यह है कि सिर्फ बनाया गया था पर समारोह लागू कर देंगे

यहाँ समारोह है


@ hrbmstr के दृष्टिकोण की तुलना में, यहाँ समय है:

funHRB <- function() { 
    starts <- seq(from=4, to=43, by=5) 
    new_data <- rbindlist(lapply(strsplit(data, ","), function(x) { 
    rbindlist(lapply(starts, function(y) { 
     as.list(x[c(1:3, y:(y+4))]) 
    })) 
    })) 
    setnames(new_data, colnames(new_data), 
      c("control_area", "unit", "scp", "date", 
      "time", "description", "entries", "exits")) 
    new_data 
} 
system.time(out2 <- funHRB()) 
# user system elapsed 
# 23.59 0.03 23.77 

भी तुलनात्मक रूप से

, इन तरीकों के दोनों मैं क्या ओ पी का पहला कदम है, जो मुझे लगता है के लिए है होना करने के लिए मान की तुलना में बहुत तेजी से कर रहे हैं read.csv या आर में डेटा को पहले स्थान पर प्राप्त करने के समान कुछ उपयोग करें। मेरे लिए, इसमें एक ही डेटासेट के साथ लगभग एक मिनट लगते हैं:

system.time(DF <- read.csv(
    header = FALSE, col.names = Names, 
    strip.white = TRUE, 
    colClasses = rep("character", length(Names)), 
    text = data)) 
# user system elapsed 
# 66.01 0.07 66.91