, соединяющий функцию lapply с несколькими файлами csv

Question

У меня есть несколько файлов, на которых я хочу использовать те же скрипты. Я борюсь с тем, как именно «связывать» вместе функцию lapply со сценариями, которые я хочу использовать.

Это расширение applying R script prepared for single file to multiple files in the directory

filenames<-list.files("NEWELKYR",pattern="*.csv",full.names=T) 

mycsv=dir(pattern=".csv") 
n<-length(mycsv) 
mylist<-vector("list",n) 
for(i in 1:n) mylist[[1]] <- read.csv(mycsv[i]) 

mylist<-lapply(mylist,function(x) #what do I put here?# 

GROUP[1] <- 1 
Xdist[1] <- XLOC[2] - XLOC[1] 
Ydist[1] <- YLOC[2] - YLOC[1] 
NSD[1] <- as.integer(sqrt(Xdist[1]^2+Ydist[1]^2)) 
for (j in 2:(nrow()-1)) { 
    if (NSD[j-1] > 1700) { 
    Xdist[j] <- XLOC[j+1] - XLOC[j] 
    Ydist[j] <- YLOC[j+1] - YLOC[j] 
    NSD[j] <- as.integer(sqrt(Xdist[j]^2+Ydist[j]^2)) 
    GROUP[j] <- (GROUP[j-1] + 1) 
    } else { 
    Xdist[j] <- XLOC[j+1] - XLOC[j] + Xdist[j-1] 
    Ydist[j] <- YLOC[j+1] - YLOC[j] + Ydist[j-1] 
    NSD[j] <- as.integer(sqrt(Xdist[j]^2+Ydist[j]^2)) 
    GROUP[j] <- (GROUP[j-1])  
    }} 
) 


for(i in 1:n) 
    write.csv(file=paste("file",i,".csv",sep="")), 
    mylist[i],row.names=F) 

информация Справочная информация о сценарии можно найти здесь: calculating Net Squared Displacement and repeating at 0 when target is reached

Answer 1

Хорошо. Во-первых у меня есть некоторые примеры данных:

data <- read.table(header=TRUE, text=" 
     X  Y AnimalID  DATE 
1 550466 4789843  10 1/25/2008 
2 550820 4790544  10 1/26/2008 
3 551071 4791230  10 1/26/2008 
4 550462 4789292  10 1/26/2008 
5 550390 4789934  10 1/27/2008 
6 550543 4790085  10 1/27/2008 
") 

Тогда я пишу его в файл CSV:

write.csv(data, file="data.csv", row.names=FALSE) 

Теперь у меня есть функция, которая поддерживает сброс координат, если мимо на расстоянии 800.

read_march <- function(x){ 
    require(data.table) 
    data <- fread(x) 

    #Perform some quick data prep before entering animal march function 
    data[, X.BEG := X[1L]] 
    data[, Y.BEG := Y[1L]] 
    data[, NOT.CHECKED := 1L] 

     animal_march <- function(data){ 
      data[, NSD := sqrt((X.BEG-X)^2+(Y.BEG-Y)^2)] 
      data[NOT.CHECKED==1L, CUM.VAL := cumsum(cumsum(NSD>800))] 
      data[, X.BEG := ifelse(CUM.VAL>1L, data[CUM.VAL==1L]$X, X.BEG)] 
      data[, Y.BEG := ifelse(CUM.VAL>1L, data[CUM.VAL==1L]$Y, Y.BEG)] 
      data[, NOT.CHECKED := 1*(CUM.VAL>1L)] 
      data[, CUM.VAL := 0L] 

     if (data[, sum(NOT.CHECKED)]==0L){ 
      data[, GRP := .GRP, by=.(X.BEG,Y.BEG)] #Here, GRP is created 
      return(data) 
     } else { 
      return(animal_march(data)) 
     } 
     } 

    result <- animal_march(data=data) 
    return(result) 
} 

Следующим шагом является просто перебрать все и применять томами CSV нашего чтения и функции марш (у нас есть только 1 CSV здесь).

#Apply function to each csv file 
library(data.table) 
files = list.files(pattern="*.csv") 
animal.csvs <- lapply(files, function(x) read_march(x)) 
big.animal.data <- rbindlist(animal.csvs) #Retrieve one big dataset 

Вот распечатка:

> big.animal.data 
     X  Y AnimalID  DATE X.BEG Y.BEG NOT.CHECKED  NSD CUM.VAL GRP 
1: 550466 4789843  10 1/25/2008 550466 4789843   0 0.0000  0 1 
2: 550820 4790544  10 1/26/2008 550466 4789843   0 785.3133  0 1 
3: 551071 4791230  10 1/26/2008 550466 4789843   0 1513.2065  0 1 
4: 550462 4789292  10 1/26/2008 551071 4791230   0 2031.4342  0 2 
5: 550390 4789934  10 1/27/2008 550462 4789292   0 646.0248  0 3 
6: 550543 4790085  10 1/27/2008 550462 4789292   0 797.1261  0 3 

Обратите внимание, как X.BEG и Y.BEG постоянно меняется после того, как расстояние 800 превышена.

Answer 2

apply В функции не являются по существу не более чем фантазии for петель. В вашем примере у вас есть список матриц из ваших файлов csv.

lapply(mylist, function(x) ...) 

Это означает, что для каждого элемента в списке (то есть матрица/data.frame) представляется в виде x. Поэтому вы можете поместить свои функции в скобки после функции (x). В качестве простого примера:

mat <- matrix(seq(9), ncol= 3) 
mat1 <- matrix(seq(12), ncol=4) 
mylist <- list(mat, mat1) 
lapply(mylist, function(x) { 
    nr <- nrow(x) 
    nc <- ncol(x) 
    return(c(nr, nc)) 
}) 

Очевидно, что с этим примером я мог бы использовать dim, но это свидетельствует о том, как вы можете иметь несколько строк в ваших lapply. Однако я не могу дать вам больше дополнительной информации о вашем фактическом коде. Из вашего примера скрипта не ясно, какой объект является вашей матрицей/data.frame, но это должно заставить вас начать в общем направлении.