Last updated: 2023-03-24

Checks: 7 0

Knit directory: Test/

This reproducible R Markdown analysis was created with workflowr (version 1.7.0). The Checks tab describes the reproducibility checks that were applied when the results were created. The Past versions tab lists the development history.


Great! Since the R Markdown file has been committed to the Git repository, you know the exact version of the code that produced these results.

Great job! The global environment was empty. Objects defined in the global environment can affect the analysis in your R Markdown file in unknown ways. For reproduciblity it’s best to always run the code in an empty environment.

The command set.seed(20210926) was run prior to running the code in the R Markdown file. Setting a seed ensures that any results that rely on randomness, e.g. subsampling or permutations, are reproducible.

Great job! Recording the operating system, R version, and package versions is critical for reproducibility.

Nice! There were no cached chunks for this analysis, so you can be confident that you successfully produced the results during this run.

Great job! Using relative paths to the files within your workflowr project makes it easier to run your code on other machines.

Great! You are using Git for version control. Tracking code development and connecting the code version to the results is critical for reproducibility.

The results in this page were generated with repository version a6c9b90. See the Past versions tab to see a history of the changes made to the R Markdown and HTML files.

Note that you need to be careful to ensure that all relevant files for the analysis have been committed to Git prior to generating the results (you can use wflow_publish or wflow_git_commit). workflowr only checks the R Markdown file, but you know if there are other scripts or data files that it depends on. Below is the status of the Git repository when the results were generated:


Ignored files:
    Ignored:    .DS_Store
    Ignored:    .Rhistory
    Ignored:    .Rproj.user/
    Ignored:    analysis/figure/
    Ignored:    data/.DS_Store
    Ignored:    data/Stabiliseur/
    Ignored:    data/json/
    Ignored:    data/plan/
    Ignored:    workflowr.R

Note that any generated files, e.g. HTML, png, CSS, etc., are not included in this status report because it is ok for generated content to have uncommitted changes.


These are the previous versions of the repository in which changes were made to the R Markdown (analysis/machine_learning.Rmd) and HTML (docs/machine_learning.html) files. If you’ve configured a remote Git repository (see ?wflow_git_remote), click on the hyperlinks in the table below to view the files as they were in that past version.

File Version Author Date Message
Rmd a6c9b90 cfcforever 2023-03-24 some changes
html 569dde1 cfcforever 2021-11-01 Build site.
Rmd 7167828 cfcforever 2021-11-01 add new content
html 86f8149 cfcforever 2021-11-01 Build site.
Rmd 6c245f9 cfcforever 2021-11-01 add new content
html ad8fef2 cfcforever 2021-11-01 Build site.
html 483ea7e cfcforever 2021-11-01 Build site.
Rmd 0fe3a66 cfcforever 2021-11-01 add new content
html 2c4b0ea cfcforever 2021-10-19 Build site.
html 521a8d5 cfcforever 2021-10-18 Build site.
html c298dbc cfcforever 2021-10-07 Build site.
html 81375a6 cfcforever 2021-10-04 Build site.
Rmd 8466631 cfcforever 2021-10-04 add new analysis
html 99b80c9 cfcforever 2021-10-04 Build site.
Rmd ed2c623 cfcforever 2021-10-04 some changes
html 5fe63f5 cfcforever 2021-10-04 Build site.
Rmd 497949e cfcforever 2021-10-04 some changes

We are using the machine learning method to stabilize the points.

Introduction

This is an example of 199 points with the frequency of 200ms. We want to use a machine learning model to recognize if any 5 consecutive points are moving or not.

# load json file
json_data <- fromJSON(file = "data/Stabiliseur/data/2021-02-12_Firminy/test1/t1_anchor1_3tags_200ms.json")

# choose tagId, x and y from json_data, and convert list to data.frame
data <- data.frame(tagId = unlist(lapply(json_data, function(x){x$tagId})),
                   x = unlist(lapply(json_data, function(x){as.numeric(x$posUnfiltered$x)})),
                   y = unlist(lapply(json_data, function(x){as.numeric(x$posUnfiltered$y)})))

# choose a tag
dd = data %>%
  filter(tagId == "82a5")

plot of data

p <- ggplot(dd) + theme_bw() +
  geom_point(aes(x=x, y=y), col="red") + 
  coord_equal(ratio = 1)
print(p)

Version Author Date
569dde1 cfcforever 2021-11-01
483ea7e cfcforever 2021-11-01
2c4b0ea cfcforever 2021-10-19
521a8d5 cfcforever 2021-10-18
99b80c9 cfcforever 2021-10-04

Machine learning method with 10 consecutive points

load model and predict data

load("data/Stabiliseur/ML/ML_model_with_10_points.RData")

input = as.data.frame(matrix(NA, nrow = nrow(dd)-9, ncol = 45))
for (k in 1:nrow(input)){
  input[k,] = as.numeric(dist(dd[k:(k+9), c("x","y")]))
}

dd$pred = 0
prediction = round(predict(ir, input), 3)
dd$pred[1:nrow(input)] = prediction

datatable(dd, class = 'cell-border stripe')

result

nb = length(prediction)
num = sum(prediction<=0.7)
ratio = num/nb
message(paste0(unique(dd$tagId), " - with ", nb, " points and to be predicted ", ratio*100, "% corrected of resting positions (which ", nb-num, " points are false)."))
82a5 - with 190 points and to be predicted 97.8947368421053% corrected of resting positions (which 4 points are false).

Study cases

case 1

k = 57
dk = 9

dist = round(as.matrix(dist(dd[k:(k+dk),c("x","y")])), 3)
kable(dist) %>%
  kable_styling(bootstrap_options = "striped", full_width = F)
57 58 59 60 61 62 63 64 65 66
57 0.000 0.047 0.081 0.147 0.161 0.244 0.196 0.147 0.180 0.340
58 0.047 0.000 0.064 0.132 0.149 0.237 0.196 0.145 0.225 0.381
59 0.081 0.064 0.000 0.069 0.086 0.173 0.133 0.083 0.252 0.417
60 0.147 0.132 0.069 0.000 0.021 0.107 0.079 0.041 0.304 0.472
61 0.161 0.149 0.086 0.021 0.000 0.088 0.058 0.030 0.309 0.477
62 0.244 0.237 0.173 0.107 0.088 0.000 0.054 0.097 0.372 0.539
63 0.196 0.196 0.133 0.079 0.058 0.054 0.000 0.051 0.318 0.485
64 0.147 0.145 0.083 0.041 0.030 0.097 0.051 0.000 0.284 0.452
65 0.180 0.225 0.252 0.304 0.309 0.372 0.318 0.284 0.000 0.168
66 0.340 0.381 0.417 0.472 0.477 0.539 0.485 0.452 0.168 0.000
p <- ggplot() + theme_bw() +
  geom_point(data=dd[k:(k+dk),], aes(x=x, y=y), col="red") + 
  geom_text(data=dd[k:(k+dk),], aes(x=x, y=y, label=k:(k+dk), vjust=-0.5), size=3) + 
  geom_path(data=dd[k:(k+dk),], aes(x=x,y=y), col="red") + 
  coord_equal(ratio = 1, xlim = range(dd$x), ylim = range(dd$y))
p

Version Author Date
569dde1 cfcforever 2021-11-01
483ea7e cfcforever 2021-11-01
2c4b0ea cfcforever 2021-10-19
521a8d5 cfcforever 2021-10-18
81375a6 cfcforever 2021-10-04
99b80c9 cfcforever 2021-10-04

case 2

k = 88
dk = 9

dist = round(as.matrix(dist(dd[k:(k+dk),c("x","y")])), 3)
kable(dist) %>%
  kable_styling(bootstrap_options = "striped", full_width = F)
88 89 90 91 92 93 94 95 96 97
88 0.000 0.142 0.231 0.303 0.343 0.385 0.402 0.289 0.061 0.156
89 0.142 0.000 0.090 0.162 0.201 0.243 0.260 0.149 0.081 0.014
90 0.231 0.090 0.000 0.072 0.113 0.154 0.172 0.059 0.170 0.076
91 0.303 0.162 0.072 0.000 0.044 0.084 0.102 0.019 0.242 0.147
92 0.343 0.201 0.113 0.044 0.000 0.041 0.059 0.063 0.282 0.187
93 0.385 0.243 0.154 0.084 0.041 0.000 0.019 0.102 0.324 0.228
94 0.402 0.260 0.172 0.102 0.059 0.019 0.000 0.120 0.341 0.246
95 0.289 0.149 0.059 0.019 0.063 0.102 0.120 0.000 0.227 0.135
96 0.061 0.081 0.170 0.242 0.282 0.324 0.341 0.227 0.000 0.096
97 0.156 0.014 0.076 0.147 0.187 0.228 0.246 0.135 0.096 0.000
p <- ggplot() + theme_bw() +
  geom_point(data=dd[k:(k+dk),], aes(x=x, y=y), col="red") + 
  geom_text(data=dd[k:(k+dk),], aes(x=x, y=y, label=k:(k+dk), vjust=-0.5), size=3) + 
  geom_path(data=dd[k:(k+dk),], aes(x=x,y=y), col="red") + 
  coord_equal(ratio = 1, xlim = range(dd$x), ylim = range(dd$y))
p

Version Author Date
569dde1 cfcforever 2021-11-01
86f8149 cfcforever 2021-11-01
483ea7e cfcforever 2021-11-01
2c4b0ea cfcforever 2021-10-19
521a8d5 cfcforever 2021-10-18
81375a6 cfcforever 2021-10-04
99b80c9 cfcforever 2021-10-04

Machine learning method with 5 consecutive points

load model and predict data

load("data/Stabiliseur/ML/ML_model.RData")

input = as.data.frame(matrix(NA, nrow = nrow(dd)-4, ncol = 10))
for (k in 1:nrow(input)){
  input[k,] = as.numeric(dist(dd[k:(k+4), c("x","y")]))
}

dd$pred = 0
prediction = round(predict(ir, input), 3)
dd$pred[1:nrow(input)] = prediction

datatable(dd, class = 'cell-border stripe')

result

nb = length(prediction)
num = sum(prediction<=0.5)
ratio = num/nb
message(paste0(unique(dd$tagId), " - with ", nb, " points and to be predicted ", ratio*100, "% corrected of resting positions (which ", nb-num, " points are false)."))
82a5 - with 195 points and to be predicted 93.3333333333333% corrected of resting positions (which 13 points are false).

Study cases

case 1

k = 42
dk = 4

dist = round(as.matrix(dist(dd[k:(k+dk),c("x","y")])), 3)
kable(dist) %>%
  kable_styling(bootstrap_options = "striped", full_width = F)
42 43 44 45 46
42 0.000 0.218 0.258 0.210 0.372
43 0.218 0.000 0.041 0.015 0.154
44 0.258 0.041 0.000 0.048 0.115
45 0.210 0.015 0.048 0.000 0.163
46 0.372 0.154 0.115 0.163 0.000
p <- ggplot() + theme_bw() +
  geom_point(data=dd[k:(k+dk),], aes(x=x, y=y), col="red") + 
  geom_text(data=dd[k:(k+dk),], aes(x=x, y=y, label=k:(k+dk), vjust=-0.5), size=3) + 
  geom_path(data=dd[k:(k+dk),], aes(x=x,y=y), col="red") + 
  coord_equal(ratio = 1, xlim = range(dd$x), ylim = range(dd$y))
p

Version Author Date
569dde1 cfcforever 2021-11-01
86f8149 cfcforever 2021-11-01
483ea7e cfcforever 2021-11-01
2c4b0ea cfcforever 2021-10-19
521a8d5 cfcforever 2021-10-18
81375a6 cfcforever 2021-10-04
99b80c9 cfcforever 2021-10-04

case 2

k = 61
dk = 7

dist = round(as.matrix(dist(dd[k:(k+dk),c("x","y")])), 3)
kable(dist) %>%
  kable_styling(bootstrap_options = "striped", full_width = F)
61 62 63 64 65 66 67 68
61 0.000 0.088 0.058 0.030 0.309 0.477 0.380 0.297
62 0.088 0.000 0.054 0.097 0.372 0.539 0.445 0.367
63 0.058 0.054 0.000 0.051 0.318 0.485 0.391 0.314
64 0.030 0.097 0.051 0.000 0.284 0.452 0.356 0.275
65 0.309 0.372 0.318 0.284 0.000 0.168 0.074 0.044
66 0.477 0.539 0.485 0.452 0.168 0.000 0.101 0.187
67 0.380 0.445 0.391 0.356 0.074 0.101 0.000 0.086
68 0.297 0.367 0.314 0.275 0.044 0.187 0.086 0.000
p <- ggplot() + theme_bw() +
  geom_point(data=dd[k:(k+dk),], aes(x=x, y=y), col="red") + 
  geom_text(data=dd[k:(k+dk),], aes(x=x, y=y, label=k:(k+dk), vjust=-0.5), size=3) + 
  geom_path(data=dd[k:(k+dk),], aes(x=x,y=y), col="red") + 
  coord_equal(ratio = 1, xlim = range(dd$x), ylim = range(dd$y))
p

Version Author Date
569dde1 cfcforever 2021-11-01
86f8149 cfcforever 2021-11-01
483ea7e cfcforever 2021-11-01
2c4b0ea cfcforever 2021-10-19
521a8d5 cfcforever 2021-10-18
81375a6 cfcforever 2021-10-04
99b80c9 cfcforever 2021-10-04

case 3

k = 71
dk = 5

dist = round(as.matrix(dist(dd[k:(k+dk),c("x","y")])), 3)
kable(dist) %>%
  kable_styling(bootstrap_options = "striped", full_width = F)
71 72 73 74 75 76
71 0.000 0.043 0.164 0.186 0.333 0.197
72 0.043 0.000 0.207 0.228 0.376 0.239
73 0.164 0.207 0.000 0.034 0.169 0.032
74 0.186 0.228 0.034 0.000 0.152 0.029
75 0.333 0.376 0.169 0.152 0.000 0.137
76 0.197 0.239 0.032 0.029 0.137 0.000
p <- ggplot() + theme_bw() +
  geom_point(data=dd[k:(k+dk),], aes(x=x, y=y), col="red") + 
  geom_text(data=dd[k:(k+dk),], aes(x=x, y=y, label=k:(k+dk), vjust=-0.5), size=3) + 
  geom_path(data=dd[k:(k+dk),], aes(x=x,y=y), col="red") + 
  coord_equal(ratio = 1, xlim = range(dd$x), ylim = range(dd$y))
p

Version Author Date
569dde1 cfcforever 2021-11-01
86f8149 cfcforever 2021-11-01
483ea7e cfcforever 2021-11-01
2c4b0ea cfcforever 2021-10-19
521a8d5 cfcforever 2021-10-18
81375a6 cfcforever 2021-10-04
99b80c9 cfcforever 2021-10-04

case 4

k = 75
dk = 4

dist = round(as.matrix(dist(dd[k:(k+dk),c("x","y")])), 3)
kable(dist) %>%
  kable_styling(bootstrap_options = "striped", full_width = F)
75 76 77 78 79
75 0.000 0.137 0.239 0.317 0.379
76 0.137 0.000 0.102 0.181 0.243
77 0.239 0.102 0.000 0.080 0.141
78 0.317 0.181 0.080 0.000 0.062
79 0.379 0.243 0.141 0.062 0.000
p <- ggplot() + theme_bw() +
  geom_point(data=dd[k:(k+dk),], aes(x=x, y=y), col="red") + 
  geom_text(data=dd[k:(k+dk),], aes(x=x, y=y, label=k:(k+dk), vjust=-0.5), size=3) + 
  geom_path(data=dd[k:(k+dk),], aes(x=x,y=y), col="red") + 
  coord_equal(ratio = 1, xlim = range(dd$x), ylim = range(dd$y))
p

Version Author Date
569dde1 cfcforever 2021-11-01
86f8149 cfcforever 2021-11-01
483ea7e cfcforever 2021-11-01
2c4b0ea cfcforever 2021-10-19
521a8d5 cfcforever 2021-10-18
81375a6 cfcforever 2021-10-04

case 5

k = 79
dk = 4

dist = round(as.matrix(dist(dd[k:(k+dk),c("x","y")])), 3)
kable(dist) %>%
  kable_styling(bootstrap_options = "striped", full_width = F)
79 80 81 82 83
79 0.000 0.231 0.371 0.267 0.176
80 0.231 0.000 0.141 0.045 0.056
81 0.371 0.141 0.000 0.106 0.196
82 0.267 0.045 0.106 0.000 0.093
83 0.176 0.056 0.196 0.093 0.000
p <- ggplot() + theme_bw() +
  geom_point(data=dd[k:(k+dk),], aes(x=x, y=y), col="red") + 
  geom_text(data=dd[k:(k+dk),], aes(x=x, y=y, label=k:(k+dk), vjust=-0.5), size=3) + 
  geom_path(data=dd[k:(k+dk),], aes(x=x,y=y), col="red") + 
  coord_equal(ratio = 1, xlim = range(dd$x), ylim = range(dd$y))
p

Version Author Date
569dde1 cfcforever 2021-11-01
86f8149 cfcforever 2021-11-01
483ea7e cfcforever 2021-11-01

case 6

k = 81
dk = 4

dist = round(as.matrix(dist(dd[k:(k+dk),c("x","y")])), 3)
kable(dist) %>%
  kable_styling(bootstrap_options = "striped", full_width = F)
81 82 83 84 85
81 0.000 0.106 0.196 0.285 0.366
82 0.106 0.000 0.093 0.182 0.265
83 0.196 0.093 0.000 0.089 0.172
84 0.285 0.182 0.089 0.000 0.083
85 0.366 0.265 0.172 0.083 0.000
p <- ggplot() + theme_bw() +
  geom_point(data=dd[k:(k+dk),], aes(x=x, y=y), col="red") + 
  geom_text(data=dd[k:(k+dk),], aes(x=x, y=y, label=k:(k+dk), vjust=-0.5), size=3) + 
  geom_path(data=dd[k:(k+dk),], aes(x=x,y=y), col="red") + 
  coord_equal(ratio = 1, xlim = range(dd$x), ylim = range(dd$y))
p

Version Author Date
569dde1 cfcforever 2021-11-01
86f8149 cfcforever 2021-11-01
483ea7e cfcforever 2021-11-01

case 7

k = 88
dk = 4

dist = round(as.matrix(dist(dd[k:(k+dk),c("x","y")])), 3)
kable(dist) %>%
  kable_styling(bootstrap_options = "striped", full_width = F)
88 89 90 91 92
88 0.000 0.142 0.231 0.303 0.343
89 0.142 0.000 0.090 0.162 0.201
90 0.231 0.090 0.000 0.072 0.113
91 0.303 0.162 0.072 0.000 0.044
92 0.343 0.201 0.113 0.044 0.000
p <- ggplot() + theme_bw() +
  geom_point(data=dd[k:(k+dk),], aes(x=x, y=y), col="red") + 
  geom_text(data=dd[k:(k+dk),], aes(x=x, y=y, label=k:(k+dk), vjust=-0.5), size=3) + 
  geom_path(data=dd[k:(k+dk),], aes(x=x,y=y), col="red") + 
  coord_equal(ratio = 1, xlim = range(dd$x), ylim = range(dd$y))
p

Version Author Date
569dde1 cfcforever 2021-11-01
86f8149 cfcforever 2021-11-01
483ea7e cfcforever 2021-11-01

case 8

k = 94
dk = 6

dist = round(as.matrix(dist(dd[k:(k+dk),c("x","y")])), 3)
kable(dist) %>%
  kable_styling(bootstrap_options = "striped", full_width = F)
94 95 96 97 98 99 100
94 0.000 0.120 0.341 0.246 0.147 0.103 0.061
95 0.120 0.000 0.227 0.135 0.049 0.027 0.060
96 0.341 0.227 0.000 0.096 0.194 0.239 0.281
97 0.246 0.135 0.096 0.000 0.098 0.143 0.185
98 0.147 0.049 0.194 0.098 0.000 0.047 0.088
99 0.103 0.027 0.239 0.143 0.047 0.000 0.042
100 0.061 0.060 0.281 0.185 0.088 0.042 0.000
p <- ggplot() + theme_bw() +
  geom_point(data=dd[k:(k+dk),], aes(x=x, y=y), col="red") + 
  geom_text(data=dd[k:(k+dk),], aes(x=x, y=y, label=k:(k+dk), vjust=-0.5), size=3) + 
  geom_path(data=dd[k:(k+dk),], aes(x=x,y=y), col="red") + 
  coord_equal(ratio = 1, xlim = range(dd$x), ylim = range(dd$y))
p

Version Author Date
569dde1 cfcforever 2021-11-01
86f8149 cfcforever 2021-11-01

Validation with data of Firminy

load("data/Stabiliseur/ML/ML_model_with_10_points.RData")

fixed tag

We are using the FIX (19ab) tag to valide the machine learning model when it’s still.

load("data/Stabiliseur/output/19ab_20211031.RData")

nb_all = sum(data_tag$consec, na.rm = T)
nb_fix = sum(data_tag$stab<=0.5, na.rm = T)
nb_mov = nb_all - nb_fix

cat("number of points to validate:", nb_all, "\n")
number of points to validate: 375620 
cat("number of points to consider as fixed:", nb_fix, "which presents", 
    nb_fix, "/", nb_all, "=", round(nb_fix/nb_all*100, 2), "% of all points", "\n")
number of points to consider as fixed: 375135 which presents 375135 / 375620 = 99.87 % of all points 
cat("number of points to consider as moving:", nb_fix, "which presents", 
    nb_mov, "/", nb_all, "=", round(nb_mov/nb_all*100, 2), "% of all points", "\n")
number of points to consider as moving: 375135 which presents 485 / 375620 = 0.13 % of all points 

study cases

case 1

k = order(data_tag$stab, decreasing = T)[1]
dk = 9

cat("the point", k, "is moving with confidence", data_tag$stab[k], "\n")
the point 53430 is moving with confidence 0.9999984 
dist = round(as.matrix(dist(data_tag[k:(k+dk),c("x","y")])), 3)
kable(dist) %>%
  kable_styling(bootstrap_options = "striped", full_width = F)
53430 53431 53432 53433 53434 53435 53436 53437 53438 53439
53430 0.000 0.539 0.888 1.179 1.407 1.590 1.687 1.817 1.903 1.900
53431 0.539 0.000 0.350 0.641 0.868 1.052 1.148 1.279 1.365 1.362
53432 0.888 0.350 0.000 0.292 0.520 0.703 0.799 0.930 1.015 1.012
53433 1.179 0.641 0.292 0.000 0.228 0.412 0.508 0.638 0.724 0.721
53434 1.407 0.868 0.520 0.228 0.000 0.184 0.280 0.410 0.496 0.494
53435 1.590 1.052 0.703 0.412 0.184 0.000 0.099 0.228 0.314 0.312
53436 1.687 1.148 0.799 0.508 0.280 0.099 0.000 0.130 0.216 0.214
53437 1.817 1.279 0.930 0.638 0.410 0.228 0.130 0.000 0.086 0.085
53438 1.903 1.365 1.015 0.724 0.496 0.314 0.216 0.086 0.000 0.014
53439 1.900 1.362 1.012 0.721 0.494 0.312 0.214 0.085 0.014 0.000
p <- ggplot() + theme_bw() +
  geom_point(data=data_tag[k:(k+dk),], aes(x=x, y=y), col="red") + 
  geom_text(data=data_tag[k:(k+dk),], aes(x=x, y=y, label=k:(k+dk), vjust=-0.5), size=3) + 
  geom_path(data=data_tag[k:(k+dk),], aes(x=x,y=y), col="red") + 
  coord_equal(ratio = 1, xlim = range(data_tag$x), ylim = range(data_tag$y))
p

Version Author Date
569dde1 cfcforever 2021-11-01

case 2

k = order(data_tag$stab, decreasing = T)[2]
dk = 9

cat("the point", k, "is moving with confidence", data_tag$stab[k], "\n")
the point 301529 is moving with confidence 0.9999983 
dist = round(as.matrix(dist(data_tag[k:(k+dk),c("x","y")])), 3)
kable(dist) %>%
  kable_styling(bootstrap_options = "striped", full_width = F)
301529 301530 301531 301532 301533 301534 301535 301536 301537 301538
301529 0.000 0.450 0.711 0.984 1.198 1.342 1.458 1.530 1.596 1.731
301530 0.450 0.000 0.262 0.534 0.748 0.892 1.008 1.080 1.146 1.281
301531 0.711 0.262 0.000 0.275 0.488 0.632 0.749 0.821 0.888 1.024
301532 0.984 0.534 0.275 0.000 0.214 0.358 0.474 0.546 0.613 0.749
301533 1.198 0.748 0.488 0.214 0.000 0.144 0.261 0.333 0.400 0.537
301534 1.342 0.892 0.632 0.358 0.144 0.000 0.117 0.189 0.256 0.394
301535 1.458 1.008 0.749 0.474 0.261 0.117 0.000 0.072 0.139 0.277
301536 1.530 1.080 0.821 0.546 0.333 0.189 0.072 0.000 0.067 0.206
301537 1.596 1.146 0.888 0.613 0.400 0.256 0.139 0.067 0.000 0.139
301538 1.731 1.281 1.024 0.749 0.537 0.394 0.277 0.206 0.139 0.000
p <- ggplot() + theme_bw() +
  geom_point(data=data_tag[k:(k+dk),], aes(x=x, y=y), col="red") + 
  geom_text(data=data_tag[k:(k+dk),], aes(x=x, y=y, label=k:(k+dk), vjust=-0.5), size=3) + 
  geom_path(data=data_tag[k:(k+dk),], aes(x=x,y=y), col="red") + 
  coord_equal(ratio = 1, xlim = range(data_tag$x), ylim = range(data_tag$y))
p

Version Author Date
569dde1 cfcforever 2021-11-01

case 3

k = order(data_tag$stab, decreasing = T)[3]
dk = 9

cat("the point", k, "is moving with confidence", data_tag$stab[k], "\n")
the point 299782 is moving with confidence 0.999998 
dist = round(as.matrix(dist(data_tag[k:(k+dk),c("x","y")])), 3)
kable(dist) %>%
  kable_styling(bootstrap_options = "striped", full_width = F)
299782 299783 299784 299785 299786 299787 299788 299789 299790 299791
299782 0.000 0.416 0.730 0.960 1.140 1.276 1.385 1.440 1.424 1.524
299783 0.416 0.000 0.314 0.544 0.724 0.860 0.968 1.024 1.009 1.108
299784 0.730 0.314 0.000 0.230 0.410 0.546 0.655 0.710 0.695 0.794
299785 0.960 0.544 0.230 0.000 0.180 0.316 0.424 0.480 0.467 0.564
299786 1.140 0.724 0.410 0.180 0.000 0.136 0.244 0.300 0.291 0.384
299787 1.276 0.860 0.546 0.316 0.136 0.000 0.108 0.164 0.161 0.248
299788 1.385 0.968 0.655 0.424 0.244 0.108 0.000 0.057 0.081 0.141
299789 1.440 1.024 0.710 0.480 0.300 0.164 0.057 0.000 0.064 0.085
299790 1.424 1.009 0.695 0.467 0.291 0.161 0.081 0.064 0.000 0.112
299791 1.524 1.108 0.794 0.564 0.384 0.248 0.141 0.085 0.112 0.000
p <- ggplot() + theme_bw() +
  geom_point(data=data_tag[k:(k+dk),], aes(x=x, y=y), col="red") + 
  geom_text(data=data_tag[k:(k+dk),], aes(x=x, y=y, label=k:(k+dk), vjust=-0.5), size=3) + 
  geom_path(data=data_tag[k:(k+dk),], aes(x=x,y=y), col="red") + 
  coord_equal(ratio = 1, xlim = range(data_tag$x), ylim = range(data_tag$y))
p

Version Author Date
569dde1 cfcforever 2021-11-01

case 4

k = order(data_tag$stab, decreasing = T)[8]
dk = 9

cat("the point", k, "is moving with confidence", data_tag$stab[k], "\n")
the point 93101 is moving with confidence 0.9999556 
dist = round(as.matrix(dist(data_tag[k:(k+dk),c("x","y")])), 3)
kable(dist) %>%
  kable_styling(bootstrap_options = "striped", full_width = F)
93101 93102 93103 93104 93105 93106 93107 93108 93109 93110
93101 0.000 0.041 0.058 0.705 0.633 0.494 0.400 0.242 0.194 0.189
93102 0.041 0.000 0.022 0.666 0.594 0.455 0.361 0.205 0.156 0.150
93103 0.058 0.022 0.000 0.646 0.575 0.436 0.341 0.184 0.136 0.130
93104 0.705 0.666 0.646 0.000 0.081 0.213 0.306 0.463 0.510 0.516
93105 0.633 0.594 0.575 0.081 0.000 0.139 0.233 0.394 0.439 0.444
93106 0.494 0.455 0.436 0.213 0.139 0.000 0.094 0.255 0.300 0.305
93107 0.400 0.361 0.341 0.306 0.233 0.094 0.000 0.162 0.206 0.211
93108 0.242 0.205 0.184 0.463 0.394 0.255 0.162 0.000 0.050 0.058
93109 0.194 0.156 0.136 0.510 0.439 0.300 0.206 0.050 0.000 0.010
93110 0.189 0.150 0.130 0.516 0.444 0.305 0.211 0.058 0.010 0.000
p <- ggplot() + theme_bw() +
  geom_point(data=data_tag[k:(k+dk),], aes(x=x, y=y), col="red") + 
  geom_text(data=data_tag[k:(k+dk),], aes(x=x, y=y, label=k:(k+dk), vjust=-0.5), size=3) + 
  geom_path(data=data_tag[k:(k+dk),], aes(x=x,y=y), col="red") + 
  coord_equal(ratio = 1, xlim = range(data_tag$x), ylim = range(data_tag$y))
p

Version Author Date
569dde1 cfcforever 2021-11-01

sessionInfo()
R version 4.2.3 (2023-03-15)
Platform: x86_64-apple-darwin17.0 (64-bit)
Running under: macOS Catalina 10.15.7

Matrix products: default
BLAS:   /Library/Frameworks/R.framework/Versions/4.2/Resources/lib/libRblas.0.dylib
LAPACK: /Library/Frameworks/R.framework/Versions/4.2/Resources/lib/libRlapack.dylib

locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] htmltools_0.5.5  openxlsx_4.2.5.2 scales_1.2.1     DT_0.27         
 [5] readxl_1.4.2     lubridate_1.9.2  dplyr_1.1.1      nnet_7.3-18     
 [9] kableExtra_1.3.4 rjson_0.2.21     cowplot_1.1.1    gifski_1.6.6-1  
[13] gganimate_1.0.8  ggplot2_3.4.1    workflowr_1.7.0 

loaded via a namespace (and not attached):
 [1] Rcpp_1.0.10       svglite_2.1.1     prettyunits_1.1.1 getPass_0.2-2    
 [5] ps_1.7.3          rprojroot_2.0.3   digest_0.6.31     utf8_1.2.3       
 [9] cellranger_1.1.0  R6_2.5.1          evaluate_0.20     highr_0.10       
[13] httr_1.4.5        pillar_1.9.0      rlang_1.1.0       progress_1.2.2   
[17] rstudioapi_0.14   whisker_0.4.1     callr_3.7.3       jquerylib_0.1.4  
[21] rmarkdown_2.20    labeling_0.4.2    webshot_0.5.4     stringr_1.5.0    
[25] htmlwidgets_1.6.2 munsell_0.5.0     compiler_4.2.3    httpuv_1.6.9     
[29] xfun_0.37         pkgconfig_2.0.3   systemfonts_1.0.4 tidyselect_1.2.0 
[33] tibble_3.2.1      fansi_1.0.4       viridisLite_0.4.1 crayon_1.5.2     
[37] withr_2.5.0       later_1.3.0       grid_4.2.3        jsonlite_1.8.4   
[41] gtable_0.3.3      lifecycle_1.0.3   git2r_0.31.0      magrittr_2.0.3   
[45] zip_2.2.2         cli_3.6.1         stringi_1.7.12    cachem_1.0.7     
[49] farver_2.1.1      fs_1.6.1          promises_1.2.0.1  xml2_1.3.3       
[53] bslib_0.4.2       ellipsis_0.3.2    generics_0.1.3    vctrs_0.6.1      
[57] tools_4.2.3       glue_1.6.2        tweenr_2.0.2      crosstalk_1.2.0  
[61] hms_1.1.3         processx_3.8.0    fastmap_1.1.1     yaml_2.3.7       
[65] timechange_0.2.0  colorspace_2.1-0  rvest_1.0.3       knitr_1.42       
[69] sass_0.4.5