系统降低R的发现点

Question

我有以下数据框：

df <- structure(list(x = c(1059.6, 1061.4, 1063.4, 1064.9, 1066.3, 
1068, 1069.8, 1071.4, 1072.9, 1074.4, 1075.9, 1077.5, 1079.1, 
1080.5, 1082.1, 1083.8, 1085.1, 1086.7, 1088.1, 1089.5, 1091.6, 
1093.1, 1094.5, 1095.8, 1097.1, 1098.4, 1099.8, 1101.1, 1102.5, 
1103.9, 1105.3, 1106.6, 1108, 1109.4, 1110.8, 1112.2, 1113.7, 
1115.2, 1116.5, 1117.9, 1119.1, 1120.4, 1121.8, 1123.1, 1124.8, 
1126.2, 1127.4, 1128.8, 1130.2, 1131.8, 1133.3, 1134.6, 1138.5, 
1141.2, 1142.4, 1143.6, 1144.8, 1146.8, 1148.2, 1149.6, 1150.9, 
1152.2, 1153.4, 1154.7, 1155.9, 1157.1, 1158.3, 1159.5, 1161.9, 
1163.4, 1164.7, 1166, 1167.2, 1169, 1170.3, 1171.5, 1172.8, 1173.9, 
1175.1, 1176.8, 1178, 1179.2, 1180.3, 1181.6, 1182.8, 1184.1, 
1185.8, 1187, 1188.2, 1189.4, 1190.5, 1191.8, 1193, 1194.3, 1195.5, 
1205.8, 1206.9, 1208, 1209, 1210.2, 1211.3, 1212.4, 1213.6, 1214.7, 
1217.2, 1218.6, 1222.3, 1223.6, 1224.7, 1225.9, 1227.1, 1228.2, 
1229.3, 1230.4, 1231.6, 1232.7, 1233.6, 1234.6, 1235.7, 1236.9, 
1238.4, 1239.5, 1240.6, 1241.6, 1242.7, 1243.7, 1244.8, 1245.9, 
1247, 1248.1, 1249.2, 1250.3, 1251.3, 1252.6, 1253.7, 1254.8, 
1255.8, 1256.8, 1257.8, 1258.8, 1261.4, 1262.5, 1263.5, 1264.5, 
1265.6, 1266.6, 1267.8, 1268.8, 1270.1, 1271.1, 1272.1, 1273.2, 
1274.1, 1275.2, 1276.3, 1279, 1280, 1281, 1282.1, 1283.1, 1284.1, 
1285, 1286, 1287, 1288, 1289, 1290, 1291.1, 1292.3, 1293.3, 1294.4, 
1298.6, 1299.6, 1300.5, 1301.5, 1302.5, 1303.5, 1304.6, 1305.5, 
1306.4, 1307.6, 1308.6, 1309.7, 1310.7, 1311.7, 1312.7, 1315.2, 
1316.3, 1317.3, 1318.3, 1319.3, 1320.3, 1321.3, 1322.3, 1323.2, 
1326.8, 1327.8, 1329, 1330, 1331, 1332, 1333, 1333.9, 1335, 1336, 
1337.3, 1338.3, 1339.3, 1340.5, 1341.6, 1342.7, 1343.8, 1344.9, 
1345.9, 1346.8, 1347.8, 1348.8, 1350, 1351.1, 1352, 1353.3, 1354.3, 
1355.3, 1356.2, 1357.1, 1358, 1359.2, 1360.2, 1364.4, 1365.5, 
1366.6, 1367.6, 1368.7, 1369.8, 1371, 1372, 1373, 1374.1, 1375, 
1376, 1376.9, 1377.8, 1378.7, 1379.6, 1380.5, 1381.4, 1382.3, 
1383.3, 1384.2, 1385.2, 1387.6, 1388.5, 1389.5, 1390.4, 1391.4, 
1392.5, 1393.6, 1394.6, 1395.6, 1397, 1397.9, 1398.8, 1399.8, 
1400.6, 1401.6, 1402.5, 1403.4, 1404.2, 1405.1, 1407.4, 1408.3, 
1409.2, 1410.1, 1411.2, 1412.2, 1413.2, 1414.2, 1415.6, 1416.7, 
1417.8, 1418.9, 1420.2, 1421.5, 1424.6, 1425.7, 1427, 1428.1, 
1429.3, 1430.7, 1431.9, 1433.1, 1434.5, 1435.7, 1436.8, 1438, 
1439.4, 1440.6, 1441.9, 1443, 1444.4, 1445.6, 1447.3, 1448.5, 
1449.7, 1450.9, 1452.1, 1453.2, 1454.5, 1455.6, 1456.8, 1458.1, 
1459.3, 1460.3, 1461.4, 1462.4, 1463.9, 1465.1, 1466.3, 1469.8, 
1471.1, 1472.6, 1473.8, 1475, 1476.2, 1477.5, 1479.1, 1480.7, 
1482, 1483.2, 1484.9, 1486.2, 1487.5, 1488.8, 1490, 1491.3, 1492.4, 
1503, 1504.3, 1506.3, 1507.5, 1508.8, 1510.2, 1511.4, 1512.5, 
1513.8, 1515.6, 1517.1, 1520.1, 1523.9, 1526.5, 1527.9, 1529.8, 
1531.2, 1532.4, 1533.7, 1536, 1537.4, 1538.8, 1540.2, 1541.5, 
1542.9, 1544.2, 1545.6, 1546.9, 1548.3, 1549.7, 1551.1, 1552.7, 
1554.1, 1556.4, 1557.8, 1559.2, 1560.6, 1562, 1563.4, 1564.7, 
1566.2, 1567.5, 1568.9, 1570.2, 1571.4, 1573.9, 1576.7, 1581.5, 
1582.8, 1584.7, 1586.2, 1587.7, 1589.3, 1591, 1592.8, 1594.7, 
1596.4, 1598.5, 1600.6, 1602.4, 1604.6, 1606.9, 1609, 1611, 1612.6, 
1614.4, 1616.3, 1618.6, 1620.6, 1622.4, 1624.5, 1627.2, 1629.3, 
1631.4, 1635, 1636.9, 1638.6, 1640.5, 1642.1, 1643.7, 1645.5, 
1647.1, 1648.7, 1650.9, 1653, 1655.2, 1657.1, 1659.1, 1661.5, 
1663.6, 1665.9, 1668.1, 1671.7, 1674, 1676.2, 1678.1, 1679.7, 
1681.6, 1683.6, 1685.7, 1688, 1693.7, 1695.7, 1697.6, 1699.7, 
1701.7, 1704.1), y = c(1.876, 2.027, 2.087, 2.231, 2.18, 1.922, 
1.921, 1.851, 1.961, 2.035, 2.043, 2.043, 1.838, 2.032, 2.112, 
1.976, 2.046, 2.117, 2.062, 2.07, 1.748, 1.917, 2.092, 2.283, 
2.158, 2.119, 2.023, 1.971, 1.882, 2.058, 2.141, 2.241, 2.079, 
1.946, 1.959, 2.117, 1.923, 2.015, 2.066, 1.98, 2.091, 1.929, 
1.987, 1.852, 1.935, 2.127, 1.982, 2.182, 2.099, 2.03, 1.912, 
1.998, 2.491, 2.359, 2.188, 1.965, 1.906, 1.772, 1.927, 2.077, 
2.381, 2.191, 2.089, 2.086, 2.017, 2.028, 1.832, 1.88, 2.053, 
2.177, 1.995, 2.045, 2.116, 1.961, 1.99, 2.227, 2.235, 2.208, 
2.249, 1.992, 2.045, 2.152, 2.237, 2.239, 2.247, 2.114, 1.956, 
2.042, 1.926, 2.396, 2.184, 2.208, 2.016, 2.177, 2.29, 2.469, 
2.502, 2.115, 2.081, 2.091, 2.188, 2.118, 2.179, 2.067, 1.962, 
2.181, 2.246, 2.526, 2.145, 1.961, 2.299, 2.306, 2.34, 2.133, 
1.974, 1.997, 2.47, 2.24, 2.247, 2.137, 1.965, 2.232, 2.225, 
2.417, 2.362, 2.155, 2.034, 2.151, 2.176, 2.183, 2.372, 2.145, 
2.284, 1.967, 2.299, 2.299, 2.183, 2.292, 2.193, 2.249, 2.32, 
2.333, 2.286, 2.216, 2.233, 2.453, 2.373, 2.284, 2.074, 2.014, 
2.153, 2.353, 2.465, 2.373, 2.181, 2.424, 2.334, 2.349, 2.39, 
2.513, 2.526, 2.268, 2.098, 2.326, 2.385, 2.306, 2.378, 2.126, 
2.191, 2.363, 2.222, 2.723, 2.686, 2.4, 2.251, 2.121, 2.104, 
2.16, 2.333, 2.151, 2.116, 2.136, 2.293, 2.281, 2.313, 2.374, 
2.585, 2.521, 2.656, 2.66, 2.399, 2.442, 2.413, 2.528, 2.212, 
2.58, 2.667, 2.153, 2.736, 2.486, 2.406, 2.39, 2.403, 2.504, 
2.502, 2.158, 2.617, 2.434, 2.364, 2.497, 2.456, 2.263, 2.432, 
2.562, 2.453, 2.249, 2.18, 2.141, 2.324, 2.176, 2.184, 2.153, 
2.332, 2.202, 2.332, 2.125, 2.156, 2.189, 2.71, 2.458, 2.502, 
2.285, 2.527, 2.437, 2.418, 2.507, 2.087, 2.321, 2.701, 2.486, 
2.389, 2.335, 2.26, 2.108, 2.164, 2.286, 2.103, 2.257, 2.137, 
2.076, 2.378, 2.637, 2.446, 2.448, 2.539, 2.253, 2.099, 2.59, 
2.405, 2.219, 2.542, 2.532, 2.507, 2.439, 2.463, 2.342, 2.329, 
2.436, 2.511, 2.557, 2.603, 2.5, 2.428, 2.204, 2.307, 2.174, 
2.193, 1.793, 2.116, 2.107, 2.209, 1.967, 1.834, 2.713, 2.647, 
2.379, 2.229, 2.11, 1.964, 1.985, 2.162, 1.996, 2.074, 1.994, 
1.839, 1.838, 1.743, 1.668, 1.91, 1.735, 1.714, 1.421, 1.767, 
1.816, 1.755, 1.755, 1.698, 1.608, 1.556, 1.511, 1.394, 1.425, 
1.579, 1.495, 1.627, 1.305, 1.471, 1.469, 1.67, 1.697, 1.42, 
1.483, 1.274, 1.341, 1.235, 1.295, 1.401, 1.463, 1.313, 1.176, 
1.333, 1.373, 1.299, 1.086, 1.139, 1.237, 1.303, 1.143, 1.13, 
1.114, 1.096, 1.248, 1.302, 1.19, 1.069, 1.1, 1.027, 0.897, 1.09, 
0.922, 1.116, 0.963, 1.011, 1.053, 1.025, 0.985, 0.981, 1.025, 
1.117, 1.141, 1.135, 1.068, 0.982, 1.028, 1.06, 1.004, 1.112, 
1.108, 1.04, 0.857, 0.91, 0.98, 1.081, 1.025, 0.996, 0.931, 1, 
1.074, 0.987, 0.996, 1.125, 0.9, 0.607, 1.17, 1.08, 1, 0.909, 
0.841, 0.924, 0.818, 0.846, 0.732, 1.006, 0.717, 0.594, 0.786, 
0.685, 0.619, 0.684, 0.69, 0.633, 0.564, 0.689, 0.555, 0.445, 
0.696, 0.677, 0.729, 0.541, 0.362, 0.312, 0.568, 0.711, 0.515, 
0.622, 0.583, 0.631, 0.645, 0.696, 0.535, 0.424, 0.469, 0.519, 
0.511, 0.485, 0.436, 0.412, 0.351, 0.556, 0.255, 0.519, 0.399, 
0.497, 0.477, 0.564, 0.462, 0.433, 0.616, 0.547, 0.42, 0.499, 
0.415, 0.368)), row.names = c(NA, -443L), class = c("tbl_df", 
"tbl", "data.frame"), .Names = c("x", "y"))

情节：

我需要找到y开始系统地减少的点。

我知道真正的重点是x == 1405。但是，有没有一种方法可以自动检测到它？

我不希望找到确切的x点。一个非常好的近似值可以完成这项工作。

我已经尝试使用分段的程序包执行断点分析，但是收效不大。我能得到的最好数字是x == 1363，但我正在寻找一个更接近的近似值。

Answer 1

以下是使用loess获得拟合的数据平滑度的方法。当您说“开始系统地下降”时，我想您的意思是“当斜率变为负值且超过某个阈值时”，因为在我看来，它在1350年代出现了峰值并开始下降。我可以通过使用span = 0.4平滑多于默认值来手动获得稍后出现的峰值。

library(broom)
fit <- loess(y ~ x, df, span = 0.4)
df_aug <- augment(fit)

使用该模型，峰值看起来在1370左右。

library(dplyr); library(ggplot2)
df_aug %>% filter(.fitted == max(.fitted))
# # A tibble: 1 x 5
# y     x .fitted .se.fit .resid
# <dbl> <dbl>   <dbl>   <dbl>  <dbl>
#   1  2.09  1373    2.39  0.0181 -0.307

我认为，如果您可以更明确地描述应使用哪种模型来定义“系统地减少”，您会得到更好的结果。

您可能会交替从黄土曲线中提取斜率和加速度，但是尚不清楚这是否会使您更接近您的预期结果：

# Extract slope & acceleration
df_aug_slope <- df_aug %>%
  mutate(slope = (.fitted - lag(.fitted)) / 
                 (x - lag(x)),
         curve = (slope - lag(slope)) / 
                (x - lag(x)))


ggplot(df_aug_slope, aes(x)) + 
  geom_point(aes(y=y)) + 
  geom_line(aes(y=.fitted), color ="red") +
  geom_line(aes(y= slope * 100), color = "blue") +
  geom_line(aes(y= curve * 1000), color = "green") +
  geom_vline(xintercept = 1405, lty = "dashed") +
  theme_minimal()