中断的时间序列,三个级别的ggplot2

我想在R中使用ggplot2创建中断的时间序列图,并使用三种不同的时间和2种干预措施。

我仅用1次干预和2次就完成了该图,并且此方法有效。

fas1 <- as.Date("2020-03-09")
fas2 <- as.Date("2020-04-04")
df$post1pre2 <- (df$data>= fas1 & df$data < fas2)
df$post2 <- (df$data >= fas2)
df$DateNum <- as.numeric(df$data)
df$DateNumCtr <- df$DateNum - as.numeric(fas1)
df$DateNumCtr1 <- df$DateNum - as.numeric(fas2)

我的资料:

> df
   id    N       data fase Nri Nti Ncg         PCT        VPG NDg post1pre2
1   1    7 2020-02-24    0   0   0   0   0.0000000         NA   0     FALSE
2   2   28 2020-02-25    0   0   0   0   0.0000000  0.0000000   0     FALSE
3   3   49 2020-02-26    0   0   0   0   0.0000000  0.0000000   0     FALSE
4   4   70 2020-02-27    0   0   0   0   0.0000000  0.0000000   0     FALSE
5   5   91 2020-02-28    0   0   0   0   0.0000000  0.0000000   0     FALSE
6   6  112 2020-02-29    0   0   0   0   0.0000000  0.0000000   0     FALSE
7   7  133 2020-03-01    0   0   0   6  11.1111111  0.0000000   0     FALSE
8   8  154 2020-03-02    0   0   0   3  11.5384615 50.0000000   0     FALSE
9   9  175 2020-03-03    0   1   0   4   4.7058824 44.4444444   0     FALSE
10 10  196 2020-03-04    0   3   0   5  22.7272727 38.4615385   0     FALSE
11 11  217 2020-03-05    0   4   0   3  14.2857143 16.6666667   0     FALSE
12 12  238 2020-03-06    0   4   0  10   5.5555556 47.6190476   0     FALSE
13 13  259 2020-03-07    0   7   1  11   0.0000000 35.4838710   0     FALSE
14 14  280 2020-03-08    0   7   1  15   3.5714286 35.7142857   1     FALSE
15 15  301 2020-03-09    1  18   1  36  10.3746398 63.1578947   0      TRUE
16 16  322 2020-03-10    1  27   6  23   8.9147287 24.7311828   2      TRUE
17 17  343 2020-03-11    1  16   5  10   2.1231423  8.6206897   3      TRUE
18 18  364 2020-03-12    1  23  10  41   7.7212806 32.5396825   2      TRUE
19 19  385 2020-03-13    1  59   8  90  16.5137615 53.8922156   2      TRUE
20 20  406 2020-03-14    1  67  11  44  19.3832599 17.1206226   3      TRUE
21 21  427 2020-03-15    1  98  12  46 148.3870968 15.2823920   1      TRUE
22 22  448 2020-03-16    1  96  19  39   2.7008310 11.2391931   8      TRUE
23 23  469 2020-03-17    1 104  21   8   7.4766355  2.0725389   8      TRUE
24 24  490 2020-03-18    1 128  27  68   0.0000000 17.2588833   1      TRUE
25 25  511 2020-03-19    1 134  29 137 -15.1214128 29.6536797   5      TRUE
26 26  532 2020-03-20    1 143  32  57   6.2500000  9.5158598   2      TRUE
27 27  553 2020-03-21    1 152  37 134  13.5216953 20.4268293   4      TRUE
28 28  574 2020-03-22    1 163  47  84  10.4218362 10.6329114   5      TRUE
29 29  595 2020-03-23    1 185  41  56   8.4464555  6.4073227   7      TRUE
30 30  616 2020-03-24    1 195  49  62   5.6261343  6.6666667  10      TRUE
31 31  637 2020-03-25    1 200  52 147  15.1859504 14.8185484   6      TRUE
32 32  658 2020-03-26    1 212  54  84   6.8459658  7.3748903   2      TRUE
33 33  679 2020-03-27    1 222  57  94   8.3928571  7.6860180   4      TRUE
34 34  700 2020-03-28    1 223  59 119  13.4920635  9.0356872  11      TRUE
35 35  721 2020-03-29    1 236  60  44   6.5281899  3.0640669  11      TRUE
36 36  742 2020-03-30    1 229  60  21   3.4653465  1.4189189   9      TRUE
37 37  763 2020-03-31    1 215  60  92  10.2678571  6.1292472   6      TRUE
38 38  784 2020-04-01    1 206  60  92   8.4558824  5.7752668   9      TRUE
39 39  805 2020-04-02    1 199  60 114  10.0529100  6.7655786   7      TRUE
40 40  826 2020-04-03    1 201  61  80   2.7932961  4.4469150   7      TRUE
41 41  847 2020-04-04    1 183  50 107   9.3777388  5.6945184   9     FALSE
42 42  868 2020-04-05    1 185  50  62  11.7870722  3.1218530   9     FALSE
43 43  889 2020-04-06    1 189  46  55   8.8709677  2.6855469   4     FALSE
44 44  910 2020-04-07    1 185  44  50   3.9556962  2.3775559   6     FALSE
45 45  931 2020-04-08    1 162  41  65   5.1505547  3.0190432   5     FALSE
46 46  952 2020-04-09    1 167  37  81   5.7569296  3.6519387   2     FALSE
47 47  973 2020-04-10    1 167  33  50   2.6427061  2.1748586   8     FALSE
48 48  994 2020-04-11    1 172  28  44   2.7707809  1.8731375   6     FALSE
49 49 1015 2020-04-12    1 160  28  38  12.5412541  1.5879649  10     FALSE
50 50 1036 2020-04-13    1 159  30  51   5.3515215  2.0979021   7     FALSE
51 51 1057 2020-04-14    1 166  28  38   4.6172539  1.5310234   4     FALSE
52 52 1078 2020-04-15    1 163  24  24   1.1787819  0.9523810   6     FALSE
53 53 1099 2020-04-16    1 159  26  72   3.6622584  2.8301887   5     FALSE
54 54 1120 2020-04-17    1 148  23  59   1.3836773  2.2553517   3     FALSE
55 55 1141 2020-04-18    1 141  27  56   1.7162121  2.0934579   2     FALSE
56 56 1162 2020-04-19    1 140  25  14   1.0534236  0.5126327   3     FALSE
57 57 1183 2020-04-20    1 140  22  30   5.5658627  1.0928962  14     FALSE
58 58 1204 2020-04-21    1 139  21  17   0.5091345  0.6126126   2     FALSE
59 59 1225 2020-04-22    1 134  20  25   1.0552976  0.8954155   5     FALSE
60 60 1246 2020-04-23    1 138  18  41   2.0009761  1.4554491  10     FALSE
61 61 1267 2020-04-24    1 136  16  24   0.9287926  0.8397481   2     FALSE
62 62 1288 2020-04-25    1 122  15  21   0.7309433  0.7286607   5     FALSE
63 63 1309 2020-04-26    1 129  13  14   1.0719755  0.4822597   1     FALSE
64 64 1330 2020-04-27    1 130  13  60   4.7656871  2.0569078   7     FALSE
65 65 1351 2020-04-28    1 136  13  18   0.5605730  0.6046355   7     FALSE
66 66 1372 2020-04-29    1 134  12  15   0.5729565  0.5008347   7     FALSE
   post2 DateNum DateNumCtr DateNumCtr1
1  FALSE   18316        -14         -40
2  FALSE   18317        -13         -39
3  FALSE   18318        -12         -38
4  FALSE   18319        -11         -37
5  FALSE   18320        -10         -36
6  FALSE   18321         -9         -35
7  FALSE   18322         -8         -34
8  FALSE   18323         -7         -33
9  FALSE   18324         -6         -32
10 FALSE   18325         -5         -31
11 FALSE   18326         -4         -30
12 FALSE   18327         -3         -29
13 FALSE   18328         -2         -28
14 FALSE   18329         -1         -27
15 FALSE   18330          0         -26
16 FALSE   18331          1         -25
17 FALSE   18332          2         -24
18 FALSE   18333          3         -23
19 FALSE   18334          4         -22
20 FALSE   18335          5         -21
21 FALSE   18336          6         -20
22 FALSE   18337          7         -19
23 FALSE   18338          8         -18
24 FALSE   18339          9         -17
25 FALSE   18340         10         -16
26 FALSE   18341         11         -15
27 FALSE   18342         12         -14
28 FALSE   18343         13         -13
29 FALSE   18344         14         -12
30 FALSE   18345         15         -11
31 FALSE   18346         16         -10
32 FALSE   18347         17          -9
33 FALSE   18348         18          -8
34 FALSE   18349         19          -7
35 FALSE   18350         20          -6
36 FALSE   18351         21          -5
37 FALSE   18352         22          -4
38 FALSE   18353         23          -3
39 FALSE   18354         24          -2
40 FALSE   18355         25          -1
41  TRUE   18356         26           0
42  TRUE   18357         27           1
43  TRUE   18358         28           2
44  TRUE   18359         29           3
45  TRUE   18360         30           4
46  TRUE   18361         31           5
47  TRUE   18362         32           6
48  TRUE   18363         33           7
49  TRUE   18364         34           8
50  TRUE   18365         35           9
51  TRUE   18366         36          10
52  TRUE   18367         37          11
53  TRUE   18368         38          12
54  TRUE   18369         39          13
55  TRUE   18370         40          14
56  TRUE   18371         41          15
57  TRUE   18372         42          16
58  TRUE   18373         43          17
59  TRUE   18374         44          18
60  TRUE   18375         45          19
61  TRUE   18376         46          20
62  TRUE   18377         47          21
63  TRUE   18378         48          22
64  TRUE   18379         49          23
65  TRUE   18380         50          24
66  TRUE   18381         51          25
glsFit1 <- gls(model       = Ncg ~ DateNumCtr + post1pre2 + DateNumCtr:post1pre2,
               data        = df,
               correlation = corAR1(0.25))
summary(glsFit1)

glsFit2 <- gls(model       = Ncg ~ DateNumCtr1 + post2 + DateNumCtr1:post2,
               data        = df,
               correlation = corAR1(0.25))
summary(glsFit2)

newdata <- data.frame(DateNumCtr = seq(min(df$DateNumCtr), max(df$DateNumCtr), by  = 1))
newdata$post1pre2 <- (newdata$DateNumCtr >= 0)

newdata <- data.frame(DateNumCtr1 = seq(min(df$DateNumCtr1), max(df$DateNumCtr1), by  = 1))
newdata$post2 <- (newdata$DateNumCtr1 >= 0)

newdata$Ncg <- predict(glsFit1, newdata = newdata)
newdata$Ncg1 <- predict(glsFit2, newdata = newdata)

ggplot(data = df, mapping = aes(x = DateNumCtr, y = Ncg)) +
  geom_line(stat = "identity", position = "identity",size=1) +
  geom_line(mapping = NULL, data = subset(newdata, DateNumCtr < 0),
            stat = "identity", position = "identity",
            color="red", size=1.5)+
  geom_line(mapping = NULL, data = subset(newdata, DateNumCtr >= 0),
            stat = "identity", position = "identity",
            color="blue", size=1.5)+
  geom_line(mapping = NULL, data = subset(newdata, DateNumCtr >= 0),
            stat = "identity", position = "identity",
            color="green", size=1.5)+
  theme_bw() + theme(legend.key = element_blank())+ labs(y= "Ncg %", x = "Giorno")

我也以这种方式尝试过(即使我没有这种方式的统计信息)

  geom_line() +
  geom_smooth(method="lm", se=FALSE, aes(colour=post1pre2)) +
  theme_bw() +
  labs(colour="")

在此:

  geom_line() +
  geom_smooth(method="lm", se=FALSE, aes(colour=fase)) +
  theme_bw() +
  labs(colour="")

但是没有结果...

With only 1 intervention and 2 times I obtain this: enter image description here

使用此代码:

df$data<- as.Date(df$data,format="%d/%m/%y")
fas1 <- as.Date("2020-03-09")
df$postfase1 <- (df$data >= fas1)
df$DateNum <- as.numeric(df$data)
df$DateNumCtr <- df$DateNum - as.numeric(fas1)

ggplot(data = df, mapping = aes(x = data, y = Ncg)) + layer(geom = "line", stat = "identity", position = "identity") + theme_bw() + theme(legend.key = element_blank())

glsFit1 <- gls(model       = Ncg ~ DateNumCtr + postfase1 + DateNumCtr:postfase1,
               data        = df,
               correlation = corAR1(0.25))
summary(glsFit1)

newdata <- data.frame(DateNumCtr = seq(min(df$DateNumCtr), max(df$DateNumCtr), by  = 1))
newdata$postfase1 <- (newdata$DateNumCtr >= 0)

newdata$Ncg <- predict(glsFit1, newdata = newdata)


ggplot(data = df, mapping = aes(x = DateNumCtr, y = Ncg)) +
  geom_line(stat = "identity", position = "identity",size=1) +
  geom_line(mapping = NULL, data = subset(newdata, DateNumCtr < 0),
           stat = "identity", position = "identity",
           color="red", size=1.5)+
  geom_line(mapping = NULL, data = subset(newdata, DateNumCtr >= 0),
            stat = "identity", position = "identity",
            color="blue", size=1.5)+
  theme_bw() + theme(legend.key = element_blank())+ labs(y= "Ncg %", x = "Giorno")

我想要这样的东西:

enter image description here

谢谢!

评论