我有车辆运动的数据集。因此,每个车辆ID重复多次。我使用segmented::segmented()
函数分别为每辆车拟合purrr::map()
回归模型。由于该模型可能不适合每辆车(可能由于给定车辆的数据点非常少),因此可能会产生错误。所以,我将segmented()
函数包装在try()
中。
以下是我的data
:
data = my_df %>% split(., .$per.Vehicle.ID2)
> str(data, max.level = 1)
List of 2
$ 3.544.534:Classes ‘tbl_df’, ‘tbl’ and 'data.frame': 30 obs. of 4 variables:
$ 3.553.545:Classes ‘tbl_df’, ‘tbl’ and 'data.frame': 72 obs. of 4 variables:
这里是data
重复性列表:
> dput(data)
structure(list(`3.544.534` = structure(list(per.Vehicle.ID2 = c("3.544.534",
"3.544.534", "3.544.534", "3.544.534", "3.544.534", "3.544.534",
"3.544.534", "3.544.534", "3.544.534", "3.544.534", "3.544.534",
"3.544.534", "3.544.534", "3.544.534", "3.544.534", "3.544.534",
"3.544.534", "3.544.534", "3.544.534", "3.544.534", "3.544.534",
"3.544.534", "3.544.534", "3.544.534", "3.544.534", "3.544.534",
"3.544.534", "3.544.534", "3.544.534", "3.544.534"), Time = c(307.1,
307.7, 308.3, 308.9, 309.5, 310.1, 310.7, 311.3, 311.9, 312.5,
313.1, 313.7, 314.3, 314.9, 315.5, 316.1, 316.7, 317.3, 317.9,
318.5, 319.1, 319.7, 320.3, 320.9, 321.5, 322.1, 322.7, 323.3,
323.9, 324.5), svel.mps_mean = c(NA, NA, NA, NA, NA, NA, NA,
12.7755159281222, 12.5036616661267, 12.2395719427147, 11.9923745340627,
11.7738694424139, 11.558525429244, 11.3191973673818, 11.0522994308264,
10.7788324802049, 10.5051145516082, 10.2349319889114, 9.97501528086885,
9.73263129457631, 9.49870470544252, 9.26388495185967, 9.03860711857004,
NA, NA, NA, NA, NA, NA, NA), dssvel = c(NA, NA, NA, NA, NA, NA,
NA, NA, NA, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, NA, NA,
NA, NA, NA, NA, NA)), .Names = c("per.Vehicle.ID2", "Time", "svel.mps_mean",
"dssvel"), row.names = c(NA, -30L), class = c("tbl_df", "tbl",
"data.frame")), `3.553.545` = structure(list(per.Vehicle.ID2 = c("3.553.545",
"3.553.545", "3.553.545", "3.553.545", "3.553.545", "3.553.545",
"3.553.545", "3.553.545", "3.553.545", "3.553.545", "3.553.545",
"3.553.545", "3.553.545", "3.553.545", "3.553.545", "3.553.545",
"3.553.545", "3.553.545", "3.553.545", "3.553.545", "3.553.545",
"3.553.545", "3.553.545", "3.553.545", "3.553.545", "3.553.545",
"3.553.545", "3.553.545", "3.553.545", "3.553.545", "3.553.545",
"3.553.545", "3.553.545", "3.553.545", "3.553.545", "3.553.545",
"3.553.545", "3.553.545", "3.553.545", "3.553.545", "3.553.545",
"3.553.545", "3.553.545", "3.553.545", "3.553.545", "3.553.545",
"3.553.545", "3.553.545", "3.553.545", "3.553.545", "3.553.545",
"3.553.545", "3.553.545", "3.553.545", "3.553.545", "3.553.545",
"3.553.545", "3.553.545", "3.553.545", "3.553.545", "3.553.545",
"3.553.545", "3.553.545", "3.553.545", "3.553.545", "3.553.545",
"3.553.545", "3.553.545", "3.553.545", "3.553.545", "3.553.545",
"3.553.545"), Time = c(262, 262.6, 263.2, 263.8, 264.4, 265,
265.6, 266.2, 266.8, 267.4, 268, 268.6, 269.2, 269.8, 270.4,
271, 271.6, 272.2, 272.8, 273.4, 274, 274.6, 275.2, 275.8, 276.4,
277, 277.6, 278.2, 278.8, 279.4, 280, 280.6, 281.2, 281.8, 282.4,
283, 283.6, 284.2, 284.8, 285.4, 286, 286.6, 287.2, 287.8, 288.4,
289, 289.6, 290.2, 290.8, 291.4, 292, 292.6, 293.2, 293.8, 294.4,
295, 295.6, 296.2, 296.8, 297.4, 298, 298.6, 299.2, 299.8, 300.4,
301, 301.6, 302.2, 302.8, 303.4, 304, 304.6), svel.mps_mean = c(NA,
NA, NA, NA, NA, NA, NA, 5.41298285821819, 5.48497881688925, 5.55898102091842,
5.63821570373546, 5.73023228642822, 5.84505407541773, 5.98954476445736,
6.1455976413909, 6.29775534569644, 6.4475118875263, 6.59939228553705,
6.75929997962276, 6.92825864041472, 7.10600376881863, 7.29418216320438,
7.48845217271764, 7.68381738580354, 7.87513283133227, 8.05995699864641,
8.21465371209303, 8.31097200556874, 8.3417386030748, 8.32304537754036,
8.26198297864187, 8.15886518084024, 8.02894718462323, 7.87911840872659,
7.71538338260088, 7.54358017038221, 7.36910128510413, 7.1920560779047,
7.00992171675244, 6.81783765068062, 6.61630770462671, 6.42117981828069,
6.24687579703188, 6.09559517163776, 5.96909261287346, 5.87826537515735,
5.83640038089119, 5.84922602270984, 5.9161965850754, 6.02778813388058,
6.18611611187481, 6.38709031522456, 6.61991746112876, 6.88184116355984,
7.1817199521547, 7.51057503223919, 7.8581088613562, 8.22211301486075,
8.60478211935657, 9.01154624501708, 9.42860178480699, 9.83720909606077,
10.2152191362441, 10.5568662978488, 10.8733070569773, NA, NA,
NA, NA, NA, NA, NA), dssvel = c(NA, NA, NA, NA, NA, NA, NA, NA,
NA, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, -2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, NA, NA, NA,
NA, NA, NA, NA)), .Names = c("per.Vehicle.ID2", "Time", "svel.mps_mean",
"dssvel"), row.names = c(NA, -72L), class = c("tbl_df", "tbl",
"data.frame"))), .Names = c("3.544.534", "3.553.545"))
library(segmented)
segf2_1 <- function(df){
try(segmented(lm(svel.mps_mean ~ Time, data=df), seg.Z = ~Time,
psi = list(Time = df$Time[which(df$dssvel != 0)]),
control = seg.control(seed=1, n.boot = 50)
),
silent=TRUE)
}
data
:library(purrr)
model_subject = data %>% map(segf2_1)
它产生以下内容:
> str(model_subject, max.level = 1)
List of 2
$ 3.544.534:Class 'try-error' atomic [1:1] Error in Z <= PSI : non-conformable arrays
.. ..- attr(*, "condition")=List of 2
.. .. ..- attr(*, "class")= chr [1:3] "simpleError" "error" "condition"
$ 3.553.545:List of 23
..- attr(*, "class")= chr [1:2] "segmented" "lm"
您可以看到该模型不适合
data
列表的第一个元素。 我想从model_subject
和data
列表中删除它。
我可以从model_subject
中删除错误产生元素,如下所示:
# Removing the vehicles which have error:
model_subject[grep("Error", model_subject)] <- NULL
问题:如何从data
列表中删除model_subject
之后从data
删除相应的元素? Error
列表不包含data
,但由于该模型不适合data[c(1)] <- NULL
的第一个元素,我想将其删除
手动,我可以做Error
。但我希望自动化(特别是如果有多个{{1}}元素)。请帮忙。
答案 0 :(得分:2)
考虑使用 possibly()
包中的 purrr
。
在拟合分段回归时,很多事情都可能出错。如果您要执行以下操作,则不必使用 try()
并最终得到 try-error 类。我还没有测试你的功能,但我正在对我自己的一些代码做同样的事情。
library(segmented)
# your function but without try(), and better formatted for readibility
segf2_1 <- function(df){
segmented(lm(svel.mps_mean ~ Time, data = df),
seg.Z = ~ Time,
psi = list(Time = df$Time[which(df$dssvel != 0)]),
control = seg.control(seed=1, n.boot = 50),
silent=TRUE)
}
library(purrr)
model_subject = map(data, possibly(segf2_1, otherwise = NULL))
答案 1 :(得分:1)
我们可以使用Filter
Filter(function(x) length(x) > 1, model_subject)
keep
来自purrr
library(purrr)
keep(model_subject, ~ length(.x) > 1)
或另一种选择是使用class
model_subject[sapply(model_subject, function(x) !"try-error" %in% class(x))]
或者
model_subject[sapply(model_subject, function(x) !inherits(x, "try-error"))]
如果OP已将这些错误元素分配给NULL
model_subject[grep("Error", model_subject)] <- list(NULL)
然后,我们可以在Filter
上使用Negate
is.null
Filter(Negate(is.null), model_subject)
或者
keep(model_subject, Negate(is.null))
如果我们需要获得逻辑索引
i1 <- !sapply(model_subject, is.null)
这可以用来对'数据'
进行子集化data[i1]
使用OP的可重复示例
data[i1]
#$`3.553.545`
# A tibble: 72 x 4
# per.Vehicle.ID2 Time svel.mps_mean dssvel
# <chr> <dbl> <dbl> <dbl>
# 1 3.553.545 262 NA NA
# 2 3.553.545 263 NA NA
# 3 3.553.545 263 NA NA
# 4 3.553.545 264 NA NA
# 5 3.553.545 264 NA NA
# 6 3.553.545 265 NA NA
# 7 3.553.545 266 NA NA
# 8 3.553.545 266 5.41 NA
# 9 3.553.545 267 5.48 NA
#10 3.553.545 267 5.56 0
# ... with 62 more rows