用多个csv文件连接lapply函数

时间:2015-01-22 19:51:03

标签: r

我有多个文件要使用相同的脚本。我正在努力将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

2 个答案:

答案 0 :(得分:2)

确定。首先,我有一些示例数据:

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.BEGY.BEG在超出800距离后如何不断变化。

答案 1 :(得分:0)

apply函数基本上只是花哨的for循环。在您的示例中,您有一个csv文件中的矩阵列表。

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

这意味着列表中的每个元素(即matrix / 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,但这应该让您从一般方向开始。