1

データ

x <- c(1:10, 13:22)
y <- numeric(20)
## Create first segment
y[1:10] <- 20:11 + rnorm(10, 0, 1.5)
## Create second segment
y[11:20] <- seq(11, 15, len=10) + rnorm(10, 0, 1.5)

目的

segmented区分的線形回帰の関数を適用します。最初tidyr::nestにデータセットを ing してからpurrrpackage を使用した後にそれを行いました。最後に unnested、目的の出力を取得します。コードは次のとおりです。

df <- data.frame(o = "A", x = x, y= y)

library(tidyr)
library(dplyr)

by_o <- df %>% 
  group_by(o) %>% 
  nest()



segf <- function(df){
  require(segmented)
  segmented(lm(y~x, data=df), seg.Z = ~x, psi=14,
            control = seg.control(seed = 2))
}

library(purrr)

models <- by_o %>% 
  mutate(segs = data %>% map(segf))

m <- models %>% mutate(psi = segs %>% map(function(x) round(x$psi[2],0)),
                       slo = map(segs, function(x) slope(x)[[1]][,1]))


up <- unnest(m, psi)
us <- unnest(m, slo)
ud <- unnest(m, data)

望ましい出力:

基本的にpsiは、変更x後slopeです。したがって、次の出力が必要です。 

> dput(ud)
structure(list(o = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = "A", class = "factor"), 
    x = c(1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 13L, 14L, 
    15L, 16L, 17L, 18L, 19L, 20L, 21L, 22L), y = c(18.8337487576471, 
    19.7196093890392, 17.9379671924293, 14.7675434512467, 16.4457014421767, 
    15.2094056495268, 10.9797139781902, 14.9949617420451, 12.6078427839913, 
    8.96774220196406, 12.1399686562958, 11.4098925289, 12.0982423698874, 
    13.6885980881852, 13.0854885243419, 11.1517028034879, 13.2448581873284, 
    14.438512104517, 14.6206728457974, 14.0299957736482), slope = c(-0.9909, 
    -0.9909, -0.9909, -0.9909, -0.9909, -0.9909, -0.9909, -0.9909, 
    -0.9909, -0.9909, 0.3146, 0.3146, 0.3146, 0.3146, 0.3146, 
    0.3146, 0.3146, 0.3146, 0.3146, 0.3146)), .Names = c("o", 
"x", "y", "slope"), row.names = c(NA, -20L), class = c("tbl_df", 
"tbl", "data.frame"))

upこれら 3 つのデータセット ( 、usおよびud) を上記の方法で組み合わせるにはどうすればよいですか? dfおもちゃのデータセットであることに注意してください。オリジナルdfには何百ものoS、つまり A、B がありxます。ydf

4

1 に答える 1