मेरे पास नीचे जैसा डेटा फ्रेम है:

## Please copy following text in your clipboard (do not copy this line)
hid  ,mid    ,aprps,astart             ,aend               ,ax      ,ay     ,exph
10001,1000101,3    ,2012-01-01 00:00:00,2012-01-01 00:00:00,475465.6,1272272,41.55607
10001,1000101,3    ,2012-01-01 00:00:00,2012-01-01 08:00:00,475465.6,1272272,41.55607
10001,1000101,4    ,2012-01-01 08:00:00,2012-01-01 08:15:00,475465.6,1272272,41.55607
10001,1000101,3    ,2012-01-01 08:15:00,2012-01-01 09:15:00,475465.6,1272272,41.55607
10001,1000101,4    ,2012-01-01 09:15:00,2012-01-01 09:30:00,475465.6,1272272,41.55607
10001,1000101,3    ,2012-01-01 09:30:00,2012-01-02 00:00:00,475465.6,1272272,41.55607
10001,1000102,3    ,2012-01-01 00:00:00,2012-01-01 00:00:00,475465.6,1272272,41.55607
10001,1000102,3    ,2012-01-01 00:00:00,2012-01-01 07:30:00,475465.6,1272272,41.55607
10001,1000102,4    ,2012-01-01 07:30:00,2012-01-01 07:50:00,475465.6,1272272,41.55607
10001,1000102,1    ,2012-01-01 07:50:00,2012-01-01 11:00:00,475465.6,1272272,41.55607
10001,1000102,4    ,2012-01-01 11:00:00,2012-01-01 11:20:00,475465.6,1272272,41.55607
10001,1000102,3    ,2012-01-01 11:20:00,2012-01-01 14:00:00,475465.6,1272272,41.55607
10001,1000102,4    ,2012-01-01 14:00:00,2012-01-01 14:20:00,475465.6,1272272,41.55607
10001,1000102,1    ,2012-01-01 14:20:00,2012-01-01 17:00:00,475465.6,1272272,41.55607
10001,1000102,4    ,2012-01-01 17:00:00,2012-01-01 17:20:00,475465.6,1272272,41.55607
10001,1000102,3    ,2012-01-01 17:20:00,2012-01-02 00:00:00,475465.6,1272272,41.55607
10001,1000103,3    ,2012-01-01 00:00:00,2012-01-01 00:00:00,475465.6,1272272,41.55607
10001,1000103,3    ,2012-01-01 00:00:00,2012-01-01 08:00:00,475465.6,1272272,41.55607
10001,1000103,4    ,2012-01-01 08:00:00,2012-01-01 12:00:00,475465.6,1272272,41.55607
10001,1000103,3    ,2012-01-01 12:00:00,2012-01-01 13:00:00,475465.6,1272272,41.55607
10001,1000103,4    ,2012-01-01 13:00:00,2012-01-01 19:00:00,475465.6,1272272,41.55607
10001,1000103,3    ,2012-01-01 19:00:00,2012-01-01 20:00:00,475465.6,1272272,41.55607
10001,1000103,4    ,2012-01-01 20:00:00,2012-01-01 23:00:00,475465.6,1272272,41.55607
10001,1000103,3    ,2012-01-01 23:00:00,2012-01-02 00:00:00,475465.6,1272272,41.55607
10001,1000104,3    ,2012-01-01 00:00:00,2012-01-01 00:00:00,475465.6,1272272,41.55607
10001,1000104,3    ,2012-01-01 00:00:00,2012-01-01 07:00:00,475465.6,1272272,41.55607
10001,1000104,4    ,2012-01-01 07:00:00,2012-01-01 07:30:00,473548.0,1279171,41.55607
10001,1000104,2    ,2012-01-01 07:30:00,2012-01-01 10:00:00,473548.0,1279171,41.55607
10001,1000104,4    ,2012-01-01 10:00:00,2012-01-01 10:30:00,475465.6,1272272,41.55607
10001,1000104,3    ,2012-01-01 10:30:00,2012-01-01 17:30:00,475465.6,1272272,41.55607
10001,1000104,4    ,2012-01-01 17:30:00,2012-01-01 17:45:00,484869.7,1270558,41.55607
10001,1000104,2    ,2012-01-01 17:45:00,2012-01-01 21:30:00,484869.7,1270558,41.55607
10001,1000104,4    ,2012-01-01 21:30:00,2012-01-01 21:45:00,475465.6,1272272,41.55607
10001,1000104,3    ,2012-01-01 21:45:00,2012-01-02 00:00:00,475465.6,1272272,41.55607
## Do not copy this line

आप उपरोक्त पाठ को कॉपी कर सकते हैं और {psych} पैकेज का उपयोग करके df के रूप में आयात कर सकते हैं:

install.packages("psych")
library(psych)
# Please copy above text and run following
df <- read.clipboard(header=TRUE, sep=",")

मुझे df से जो प्राप्त करने की आवश्यकता है वे हैं:

  • दो जोड़ी पंक्तियों में exph का योग निकालें, जो aprps==4 और पिछली पंक्ति पर निकाले गए हैं
  • यदि aprps==4 के साथ कई पंक्तियाँ हैं, तो इसे mid के समूह द्वारा दोहराएं
  • सूची या डेटा फ़्रेम में exph और संबंधित hid का योग संग्रहीत करें

इसे बनाने के लिए, मैं वर्तमान में दो लूपों के आधार पर निम्नलिखित स्क्रिप्ट का उपयोग कर रहा हूं:

library(tidyverse)

calc <- function(i) {

  ## Extract records by "mid" excluding the first records
    temp <<- df %>% filter(mid==i) %>% filter(row_number()>1)
  ## Extract row number of "aprps==4"
    r.aprps <- which(temp$aprps==4)

      ## Repeat operation by two pairs of rows based on "r.aprps"
      for (j in 1:length(r.aprps)) {

        ## Extract movement
        temp2 <<- temp[c((r.aprps[j]-1):r.aprps[j]),]

        ## Other operations in actual data set (jsut put example)
        exp <- data.frame(mid=unique(temp2$mid),expsum=sum(temp2$exph))

        ## Store PPA in list
        if (lp==1 & j==1) {
            df.exp <<- exp
            } else {
            df.exp <<- rbind(df.exp,exp)
          }
      }
    }

## Set loop conditions
list.mid <- unique(df$mid)
nloop <- length(list.mid)

## Initialize df.exp
df.exp <- data.frame(matrix(vector(),0,2,
                       dimnames=list(c(),c("mid","expsum"))),
                       stringsAsFactors=F)

## Loop to store PPA in list
for (lp in 1:nloop) {
    calc(list.mid[lp])
  }

हालाँकि, वास्तविक डेटा फ़्रेम df में लगभग 40,000 रिकॉर्ड होते हैं और वास्तविक संचालन में अधिक जटिल गणनाएँ होती हैं, इसमें 30 घंटे से अधिक समय लगता है। मैं ऑपरेशन को छोटा करने का तरीका खोजने की कोशिश कर रहा था और अब प्रत्येक ऑपरेशन को नेस्टेड डेटा फ्रेम में स्टोर करने के लिए map से purrr फ़ंक्शन को लागू करने का प्रयास कर रहा था, न कि लूप ऑपरेशन में हर बार वेरिएबल को बदलने के लिए।

निम्नलिखित स्क्रिप्ट वे हैं जिन्हें मैं बनाने की कोशिश कर रहा हूं, हालांकि यह वांछित आउटपुट तक नहीं पहुंच सकता है।

    ## Store df by mid into list
    nest <- df %>% group_by(mid) %>% nest()
    ## Extract row number with "aprps==4"
    nest2 <- nest %>% mutate(row.aprps4=map(data,~which(.$aprps==4)))
    ## Obtain row numbers to extract by movement
    nest3 <- nest2 %>% mutate(row.aprps4_1=map(data,~data.frame(rm1=which(.$aprps==4)-1)),
                              row.aprps4_2=map(data,~data.frame(rm1=which(.$aprps==4))))
    ## How to extract two pairs of records based on row.aprps4_1 and row.aprps4_1 and store sum of exph?

Some trials:
# It works but cannot extract records using two variables (row.aprps4_1 and .._2)
nest3 %>% mutate(move=map2(data,row.aprps4_1,~filter(.x,seq_len(nrow(.x))%in%.y)))
# Using pmap to specify range of filtering by two variables but does not work
nest4 %>% pmap(data,row.move1,row.move2,~filter(..1,seq_len(nrow(..1))%in%..2))
# Using double map function instead of double loop but does not work
pmap(nest4$data,nest4$row.move1,nest4$row.move2,~filter(..1,seq_len(nrow(..1))%in%c(..2:..3)))

क्या आपके पास ऑपरेशन को तेज करने के लिए कोई सुझाव है? मैं इसके बारे में जानने के लिए map फ़ंक्शन का उपयोग करना पसंद करता हूं, हालांकि अन्य विकल्पों का भी स्वागत है।

मुझे इस मुद्दे के समान यह पोस्ट भी मिली, लेकिन इसका समाधान नहीं हो सका गतिशील चर r.aprpr4_1 और _2 के आधार पर दो पंक्तियों को निकालने का तरीका जारी करें।

===== अद्यतन: समस्या हल हो गई =====

मैं निम्नलिखित लिपियों द्वारा इस मुद्दे को हल कर सकता था:

## Convert df into nested data frame by `mid`
nest <- df %>% group_by(mid) %>% nest()

## Obtain row numbers to extract aprps==4
nest2 <- nest %>% mutate(r=map(data,~which(.$aprps==4)))

## Split r and expand record
nest3 <- nest2 %>% unnest(r,.drop=FALSE)

## Extract pairs of movement
nest4 <- nest3 %>% mutate(pair=map2(data,r,~filter(.x,seq_len(nrow(.x))%in%c((.y-1):.y)))) %>% dplyr::select(mid,pair)

बिंदु थे:

  • aprps==4 से निकाले गए वैक्टर द्वारा प्रत्येक रिकॉर्ड का विस्तार करने के लिए unnest() की आवश्यकता है (.x%in%.y लागू नहीं किया जा सकता जहां .y की लंबाई दो से अधिक है)
  • mutate लागू करने के लिए आवश्यक है map2 (कोड जैसे nest3 %>% map2(a,b,~f(.x,.y...)) स्वीकार नहीं किए जाते हैं)

इस समाधान को पाने के लिए निम्नलिखित पोस्ट के लिए बहुत-बहुत धन्यवाद:

एक कॉलम में सीमांकित स्ट्रिंग्स को विभाजित करें और नई पंक्तियों के रूप में डालें

map2 () पाइप में समारोह

1
Hideo.S 21 अक्टूबर 2018, 06:57

1 उत्तर

सबसे बढ़िया उत्तर

चूंकि आप अन्य विकल्पों का भी स्वागत करते हैं का उल्लेख करते हैं, आधार R पर विचार करें। आपके प्रारंभिक (गैर-purr) सेटअप से कई समस्याएं उत्पन्न होती हैं:

  1. मूल कोड के सबसे बड़े मुद्दों में से एक लूप के अंदर rbind का उपयोग कर रहा है जो स्मृति में अत्यधिक प्रतिलिपि की ओर जाता है जैसा कि इस SO थ्रेड में बताया गया है, rbind को for-loop में lapply से बदलें? (नरक का दूसरा चक्र) और पैट्रिक बर्न का R इंटरनल - सर्कल 2 : बढ़ती हुई वस्तुएँ। हल करने के लिए, लूप के बाहर संलग्न डेटा फ़्रेमों की एक सूची बनाएं।

  2. स्थानीय फ़ंक्शन के अंदर से वैश्विक वातावरण को प्रभावित करने के लिए स्कोपिंग असाइनमेंट, <<- का बार-बार उपयोग अनावश्यक प्रतीत होता है, खासकर जब से temp ऑब्जेक्ट्स को प्रत्येक लूप से बदल दिया जाता है, इसलिए केवल अंतिम पुनरावृत्ति ही बनाए रखेगी . अक्सर इस ऑपरेटर को हतोत्साहित किया जाता है क्योंकि वैश्विक चर समायोजित होने के बाद से इसे डीबग करना कठिन हो जाता है। जब एक वस्तु वापस आती है तो कार्यों को सबसे अच्छा संभाला जाता है।

  3. आप calc() को कॉल करने से पहले एक खाली डेटा फ्रेम, df.exp को इनिशियलाइज़ करते हैं, लेकिन इसे लूप के अंदर <<- से ओवरराइट कर देते हैं। आमतौर पर, एक खाली मैट्रिक्स या डेटा फ्रेम निर्दिष्ट करने के बाद, लूप के अंदर पंक्तियों द्वारा असाइन किया जाता है लेकिन ऐसा नहीं किया जाता है।

  4. unique() मानों के माध्यम से लूपिंग को by() या split() से बदला जा सकता है जो dplyr::filter() के अंदर फ़ंक्शन का उपयोग करने से भी बचता है। वैसे, लूप के अंदर %>% पाइप का उपयोग करने में प्रदर्शन चुनौतियां हैं।

  5. for लूप के बजाय, लागू करें परिवार का उपयोग पुनरावृत्ति के बाद वस्तुओं की एक सूची बनाने के लिए करें जैसे lapply जो for लूप की बहीखाता से बचा जाता है जिसे आरंभ करने की आवश्यकता होती है एक खाली सूची और इसे तत्वों को असाइन करें (हालांकि इस दृष्टिकोण को करने में कुछ भी गलत नहीं है)। साथ ही, इस तरह आप फ़ंक्शन के भीतर <<- के उपयोग से बचते हैं।

आधार आर (by, lapply, और do.call का उपयोग करके)

calc <- function(sub) {

    ## Extract records by "mid" excluding the first records
    temp <- sub[2:nrow(temp),]

    ## Extract row number of "aprps==4"
    r.aprps <- which(temp$aprps==4)

    ## Store exp dataframes in list
    subdf_list <- lapply(1:length(r.aprps), function(j) {

        ## Extract movement by two pairs of rows based on "r.aprps"
        temp2 <- temp[c((r.aprps[j]-1):r.aprps[j]),]

        ## Other operations in actual data set (just put example)
        exp <- data.frame(mid=unique(temp2$mid), expsum=sum(temp2$exph))

        return(exp)
    })

    df.exp <- do.call(rbind, subdf_list)  
    return(df.exp)
}

## subset by mid and pass subsets to calc()
df_list <- by(df, df$mid, calc)

## append all in final object
final_df <- do.call(rbind, df_list)

क्योंकि base::rbind.data.frame में कुछ नुकसान हैं, ऐसे में तीसरे पक्ष के पैकेज पर विचार करें do.call(rbind, ...) जैसे dplyr::bind_rows() और data.table::rbindlist() का प्रतिस्थापन।

df.exp  <- dplyr::bind_rows(subdf_list) 
...
final_df <-  dplyr::bind_rows(df_list)


df.exp  <- data.table::rbindlist(subdf_list)
...
final_df <-  data.table::rbindlist(df_list)
1
Parfait 23 अक्टूबर 2018, 15:54