为每个数据集分配一个值并使用 ggplot 绘制它

Assigning a value for each dataset and plot it with ggplot

这可能是个复杂的问题,但我会尽力解释它。

我有一个序列化的数据集,其中包含在绘图之前应该处理的观测值。

我想用一个函数来做。因为我在目录中还有另一个数据集(大约 20 个)

#reproducible dataset
numbers<-c(seq(1,-1,length.out = 601),seq(1,0.98,length.out = 601))
time <- c(rep(seq(90,54144,length.out = 601),times=1),rep(seq(90,49850,length.out = 601),times=1))
data = data.frame(time=rep(time,times=10), mag=rep(numbers, times=10))

myfun <- function(data){
library(dplyr)
data$lag <- data$time - lag(data$time)<0
data$lag[is.na(data$lag)] <- 1
data$set <- cumsum(data$lag)

dfchunk<- split(data, factor((rank(data$set))),drop=TRUE)   #split data

sw_t<-lapply(dfchunk,function(x)x[which(x$mag<0)[1],])
result <- data.frame(matrix(unlist(sw_t),nrow=max(data$set), byrow=TRUE))

all_states <- result[complete.cases(result),]
x_val <- c(rep(seq(3.2,8,0.2),each=max(data$set)))  # ????

final <- data.frame(all_states[1],x_val)         #????
}

data.list <- mixedsort(dir(pattern = "*.txt",full.names = FALSE)) # 

res<-lapply(data.list, myfun)

qplot(x_val, X1, data = data, colour = I("red"))

我在myfun里做的是;

  1. 重塑数据
  2. 用一个因子拆分它
  3. 应用一个函数得到第一个负值观测值
  4. 仅获取 complete.cases (na.omit)

我的目标

到目前为止,我的功能尚未完成任何指导。

处理 真实数据我使用下面的代码

library(gtools)
data.list <- mixedsort(dir(pattern = "*.txt",full.names = FALSE)) # creates the list of all the csv files in the directory
data  <-  lapply(data.list,function(x){
             tmp <- read.table(file = x, header = T)
             new.df <- select(tmp, V1,V10)
             return(new.df)
             })
swt <- function(data){
library(dplyr)
names(data) <-c("time","Mag")

data$lag <- data$time - lag(data$time) <0
data$lag[is.na(data$lag)] <- 1
data$set <- cumsum(data$lag)
set_nbr <- seq(3.2,8,0.2)
data$curr <- lapply(seq_along(set_nbr),data)
dfchunk<- split(data, factor((rank(data$set))),drop=TRUE)   #split data
sw_t<-lapply(dfchunk,function(x)x[which(x$Mag<0)[1],])
result <- data.frame(matrix(unlist(sw_t),nrow=max(data$set), byrow=TRUE))
#x_val <- rep(data$curr[1], each=nrow(all_states))

 resultt <- rename(result, c  ("X1"="time", "X2"="Mag","X3"="lag","X4"="set","X5"="curr"))

}

 res<-do.call(rbind, lapply(data.list, myfun))    

到目前为止,我在为数据分配当前值时遇到错误。 @while 答案很好,因为可以在创建数据期间添加 set_nbr 。但是在真实数据处理的情况下我不能赋值。

仍然不确定我是否完全理解了问题。如果我错过了一些要点,真的很抱歉。

我在名为 set_nbr 的 data.frame 中添加了 x_val 的设定号码。

我修改了测试数据创建以获得这样的完整列表:

data.list <- lapply(seq(3.2,8,0.2), function(x) {
  nrep <- sample(10:20, 1)

  numbers<-c(seq(1,-1,length.out = 601),seq(1,0.98,length.out = 601))
  time <- c(rep(seq(90,54144 + nrep,length.out = 601),times=1),rep(seq(90,49850 + nrep,length.out = 601),times=1))

  data.frame(time=rep(time,times=nrep), mag=rep(numbers, times=nrep), set_nbr=x)
})

然后我将您的代码修改为以下内容:

myfun <- function(data){
  require(dplyr)

  data$lag <- data$time - lag(data$time)<0
  data$lag[is.na(data$lag)] <- 1
  data$set <- cumsum(data$lag)

  dfchunk<- split(data, factor((rank(data$set))),drop=TRUE)   #split data

  sw_t<-lapply(dfchunk,function(x)x[which(x$mag<0)[1],])
  result <- data.frame(matrix(unlist(sw_t),nrow=max(data$set), byrow=TRUE))

  all_states <- result[complete.cases(result),]
  
  # repeat the set_nbr the same number of times as there are rows in all_states
  x_val <- rep(data$set_nbr[1], each=nrow(all_states))

  final <- data.frame(all_states[1],x_val) # Your example is fine here
}

# do.call rbind to combine the result to one data.frame
res<-do.call(rbind, lapply(data.list, myfun)) 

qplot(x_val, X1, data = res, colour = I("red"))

我希望这能回答您的问题,或者至少能为您提供足够的指导来解决您的问题。

编辑

您可以 lapply 代替 data.list 的行名。这样可以很容易地为每个数据集添加一个集合名称并在您的绘图中使用它。

# Create data set example
data.list <- lapply(1:25, function(x) {
  nrep <- sample(10:20, 1)

  numbers<-c(seq(1,-1,length.out = 601),seq(1,0.98,length.out = 601))
  time <- c(rep(seq(90,54144 + nrep,length.out = 601),times=1),rep(seq(90,49850 + nrep,length.out = 601),times=1))

  data.frame(time=rep(time,times=nrep), mag=rep(numbers, times=nrep))
})

# Name each row in the data.list according to the specified sequence
names(data.list) <- seq(3.2,8,0.2)

# Define function to transform the sets based on the list entry name
myfun <- function(data_name){
  require(dplyr)

  # Extract the dataset of interest from the data.list
  data <- data.list[[data_name]]

  data$lag <- data$time - lag(data$time)<0
  data$lag[is.na(data$lag)] <- 1
  data$set <- cumsum(data$lag)

  dfchunk <- split(data, factor((rank(data$set))),drop=TRUE)   #split data

  sw_t <-lapply(dfchunk,function(x)x[which(x$mag<0)[1],])
  result <- data.frame(matrix(unlist(sw_t),nrow=max(data$set), byrow=TRUE))

  all_states <- result[complete.cases(result),]
  x_val <- rep(data_name, each=nrow(all_states))

  final <- data.frame(all_states[1],x_val) 
}

# lapply over the list names instead of the list elements 
res <- do.call(rbind, lapply(names(data.list), myfun))

# plot result
qplot(x_val, X1, data = res, colour = I("red"))