########################################
# #
# REGIONES PUENTES DE CONFIANZA #
# #
########################################
######## Trayectorias
# Simulación puente browniano fraccionario
p1<-c(1,1)
p2<-c(2,2)
# Función que toma la trayectoria del punto inicial y el final
al <- function(p1,p2,N){
t<-seq(0,1,length=N)
alt<-matrix(0,N,2)
for(i in 1:N){
alt[i,1]<-p1[1]+(p2[1]-p1[1])*t[i]
alt[i,2]<-p1[2]+(p2[2]-p1[2])*t[i]
}
return(alt)
}
al(p1,p2,100)
## [,1] [,2]
## [1,] 1.000000 1.000000
## [2,] 1.010101 1.010101
## [3,] 1.020202 1.020202
## [4,] 1.030303 1.030303
## [5,] 1.040404 1.040404
## [6,] 1.050505 1.050505
## [7,] 1.060606 1.060606
## [8,] 1.070707 1.070707
## [9,] 1.080808 1.080808
## [10,] 1.090909 1.090909
## [11,] 1.101010 1.101010
## [12,] 1.111111 1.111111
## [13,] 1.121212 1.121212
## [14,] 1.131313 1.131313
## [15,] 1.141414 1.141414
## [16,] 1.151515 1.151515
## [17,] 1.161616 1.161616
## [18,] 1.171717 1.171717
## [19,] 1.181818 1.181818
## [20,] 1.191919 1.191919
## [21,] 1.202020 1.202020
## [22,] 1.212121 1.212121
## [23,] 1.222222 1.222222
## [24,] 1.232323 1.232323
## [25,] 1.242424 1.242424
## [26,] 1.252525 1.252525
## [27,] 1.262626 1.262626
## [28,] 1.272727 1.272727
## [29,] 1.282828 1.282828
## [30,] 1.292929 1.292929
## [31,] 1.303030 1.303030
## [32,] 1.313131 1.313131
## [33,] 1.323232 1.323232
## [34,] 1.333333 1.333333
## [35,] 1.343434 1.343434
## [36,] 1.353535 1.353535
## [37,] 1.363636 1.363636
## [38,] 1.373737 1.373737
## [39,] 1.383838 1.383838
## [40,] 1.393939 1.393939
## [41,] 1.404040 1.404040
## [42,] 1.414141 1.414141
## [43,] 1.424242 1.424242
## [44,] 1.434343 1.434343
## [45,] 1.444444 1.444444
## [46,] 1.454545 1.454545
## [47,] 1.464646 1.464646
## [48,] 1.474747 1.474747
## [49,] 1.484848 1.484848
## [50,] 1.494949 1.494949
## [51,] 1.505051 1.505051
## [52,] 1.515152 1.515152
## [53,] 1.525253 1.525253
## [54,] 1.535354 1.535354
## [55,] 1.545455 1.545455
## [56,] 1.555556 1.555556
## [57,] 1.565657 1.565657
## [58,] 1.575758 1.575758
## [59,] 1.585859 1.585859
## [60,] 1.595960 1.595960
## [61,] 1.606061 1.606061
## [62,] 1.616162 1.616162
## [63,] 1.626263 1.626263
## [64,] 1.636364 1.636364
## [65,] 1.646465 1.646465
## [66,] 1.656566 1.656566
## [67,] 1.666667 1.666667
## [68,] 1.676768 1.676768
## [69,] 1.686869 1.686869
## [70,] 1.696970 1.696970
## [71,] 1.707071 1.707071
## [72,] 1.717172 1.717172
## [73,] 1.727273 1.727273
## [74,] 1.737374 1.737374
## [75,] 1.747475 1.747475
## [76,] 1.757576 1.757576
## [77,] 1.767677 1.767677
## [78,] 1.777778 1.777778
## [79,] 1.787879 1.787879
## [80,] 1.797980 1.797980
## [81,] 1.808081 1.808081
## [82,] 1.818182 1.818182
## [83,] 1.828283 1.828283
## [84,] 1.838384 1.838384
## [85,] 1.848485 1.848485
## [86,] 1.858586 1.858586
## [87,] 1.868687 1.868687
## [88,] 1.878788 1.878788
## [89,] 1.888889 1.888889
## [90,] 1.898990 1.898990
## [91,] 1.909091 1.909091
## [92,] 1.919192 1.919192
## [93,] 1.929293 1.929293
## [94,] 1.939394 1.939394
## [95,] 1.949495 1.949495
## [96,] 1.959596 1.959596
## [97,] 1.969697 1.969697
## [98,] 1.979798 1.979798
## [99,] 1.989899 1.989899
## [100,] 2.000000 2.000000
# Función que ayuda a realizar un puente browniano
#con desviación y numero de iteraciones
fbbm<-function(sig,N){
t<-seq(0,1,length=N)
z<-c(0,cumsum(rnorm(N-1)))
bbm <- NULL
for( i in 1:N){
bbm[i]<-sig*(z[i]-t[i]*z[N])
}
return(bbm)
}
plot(fbbm(5,100),type="l")
# puente browniano en R2
N<-100
sig<-0.3
p1<-c(1,1);p2<-c(2,8)
n<-(p2-p1)/sqrt(sum((p2-p1)^2))*c(-1,1)
n
## [1] -0.1414214 0.9899495
t<-seq(0,1,length=N)
w<-matrix(0,N,2)
trend<-al(p1,p2,N)
f<-fbbm(sig,N)
length(f)
## [1] 100
for(i in 1:N){
w[i,1]<-trend[i,1]+n[1]*f[i]
w[i,2]<-trend[i,2]+n[2]*f[i]
}
plot(w[,1],w[,2],type="l")
# Función que simula un puente browniano en R2
fbbr<-function(p1,p2,sig,N){
n<-(p2-p1)/sqrt(sum((p2-p1)^2))*c(-1,1)
n
t<-seq(0,1,length=N)
alt<-matrix(0,N,2)
for(i in 1:N){
alt[i,1]<-p1[1]+(p2[1]-p1[1])*t[i]
alt[i,2]<-p1[2]+(p2[2]-p1[2])*t[i]
}
w<-matrix(0,N,2)
trend<-alt
#C<-matrix(0,N-1,N-1)
# for (i in 2:N) {
# for (j in 2:N) {
# C[i-1,j-1] <- (1/2)*((abs(t[i])^(2*H) + abs(t[j])^(2*H) - abs(t[i]-t[j])^(2*H)))
# }
# }
z<-cumsum(c(0,rnorm(N)))
bbm <- NULL
for( i in 1:N){
bbm[i]<-sig*(z[i]-t[i]*z[N])
}
f<-bbm
length(f)
for(i in 1:N){
w[i,1]<-trend[i,1]+n[1]*f[i]
w[i,2]<-trend[i,2]+n[2]*f[i]
}
return(w)
}
p1<-c(1,1)
p2<-c(5,8)
N<-100
sig<-0.5
fbbr(p1,p2,sig,N)
## [,1] [,2]
## [1,] 1.0000000 1.0000000
## [2,] 1.3258925 0.5711023
## [3,] 1.4724605 0.4560224
## [4,] 1.3041378 0.8920013
## [5,] 1.2774572 1.0801065
## [6,] 1.1381575 1.4652951
## [7,] 1.1781227 1.5367701
## [8,] 1.3154524 1.4378573
## [9,] 1.3461577 1.5255372
## [10,] 1.1592234 1.9940862
## [11,] 1.2341371 2.0044014
## [12,] 1.2337112 2.1465610
## [13,] 1.0148239 2.6710279
## [14,] 1.4314673 2.0833161
## [15,] 1.2725838 2.5027764
## [16,] 0.9945883 3.1306826
## [17,] 0.7916554 3.6272292
## [18,] 0.8612456 3.6468606
## [19,] 1.2943979 3.0302582
## [20,] 1.2594480 3.2328346
## [21,] 1.3648699 3.1897606
## [22,] 1.4976765 3.0987630
## [23,] 1.2834155 3.6151340
## [24,] 1.1604901 3.9716676
## [25,] 1.1195896 4.1846576
## [26,] 1.6842976 3.3378327
## [27,] 1.8465496 3.1953059
## [28,] 1.7126302 3.5710790
## [29,] 1.6347909 3.8487119
## [30,] 1.8270966 3.6535910
## [31,] 1.9008182 3.6659924
## [32,] 2.2363641 3.2202012
## [33,] 2.2011241 3.4232854
## [34,] 2.0688638 3.7961550
## [35,] 2.0860066 3.9075692
## [36,] 1.9637591 4.2629165
## [37,] 1.7304791 4.8125707
## [38,] 1.9236663 4.6159073
## [39,] 2.1309344 4.3946021
## [40,] 2.5551345 3.7936662
## [41,] 3.2775892 2.6707846
## [42,] 3.4251313 2.5539999
## [43,] 3.7177651 2.1833050
## [44,] 3.7106649 2.3371445
## [45,] 3.9398562 2.0774739
## [46,] 3.7794921 2.4995252
## [47,] 3.2054612 3.6454934
## [48,] 3.4096731 3.4295367
## [49,] 3.3750575 3.6315281
## [50,] 3.2567480 3.9799839
## [51,] 3.1876325 4.2423502
## [52,] 3.3660645 4.0715083
## [53,] 3.4347461 4.0927297
## [54,] 3.4993008 4.1211732
## [55,] 3.4407627 4.3650289
## [56,] 3.6618633 4.1195170
## [57,] 3.7389280 4.1260679
## [58,] 3.8978299 3.9894037
## [59,] 3.6356050 4.5897114
## [60,] 3.7467212 4.5366723
## [61,] 3.4458531 5.2046055
## [62,] 3.1851644 5.8022249
## [63,] 3.2911255 5.7582071
## [64,] 3.5960684 5.3659712
## [65,] 3.3428862 5.9504543
## [66,] 3.4482349 5.9075080
## [67,] 3.6155291 5.7561575
## [68,] 3.3126881 6.4275434
## [69,] 2.8624328 7.3569042
## [70,] 2.8175864 7.5767995
## [71,] 2.6088526 8.0834979
## [72,] 2.4381949 8.5235629
## [73,] 2.6461938 8.3009789
## [74,] 2.6005636 8.5222460
## [75,] 3.1479894 7.7056651
## [76,] 3.4486201 7.3209755
## [77,] 3.6751720 7.0659238
## [78,] 3.8393007 6.9201127
## [79,] 3.7739511 7.1758886
## [80,] 4.0160477 6.8936336
## [81,] 4.0766459 6.9290011
## [82,] 3.9468740 7.2975160
## [83,] 4.0857502 7.1958967
## [84,] 4.2092732 7.1211457
## [85,] 4.6215966 6.5409938
## [86,] 4.4011310 7.0682228
## [87,] 4.3328288 7.3291658
## [88,] 4.5034272 7.1720328
## [89,] 4.3075268 7.6562726
## [90,] 3.9414212 8.4383715
## [91,] 3.9838035 8.5056167
## [92,] 3.5598405 9.3889660
## [93,] 3.7329175 9.2274954
## [94,] 3.9786302 8.9389123
## [95,] 3.9440518 9.1408386
## [96,] 4.5633900 8.1984110
## [97,] 5.0946883 7.4100530
## [98,] 5.0853800 7.5677566
## [99,] 5.0284669 7.8087688
## [100,] 5.0000000 8.0000000
# FUNCIÓN
# Ejemplo
par(mfrow = c(1, 1))
p1<-c(1,1)
p2<-c(5,8)
N<-500
sig<-0.05
H<-1/2
n<-200
ww<- fbbr(p1,p2,sig,N)
plot(ww[, 1], ww[, 2], xlim = c(0, 8), ylim = c(0, 8), type = "l", main = "Migration in two trajectories",
ylab = "Latitude", xlab = "Longitude", col = "#0DF7B7")
# Superponer las curvas adicionales utilizando lines dentro del bucle
for (k in 1:n) {
ww <- fbbr(p1, p2, sig, N)
lines(ww[, 1], ww[, 2], type = "l", col = sample(c("#0DF7B7","#1CF4A7","#0AB7B7","#0BC7C1"),1))
}
ww1<-matrix(0,n,N)
for (k in 1:n) {
ww1[k,]<-fbbm(sig,N)
}
n<-(p2-p1)/sqrt(sum((p2-p1)^2))*c(-1,1)
n
## [1] -0.4961389 0.8682431
t<-seq(0,1,length=N)
a<-rep(0,N)
b<-rep(0,N)
for (i in 1:N) {
a[i]<-quantile(ww1[,i],0.025)
b[i]<-quantile(ww1[,i],0.975)
}
alt<-matrix(0,N,2)
for(i in 1:N){
alt[i,1]<-p1[1]+(p2[1]-p1[1])*t[i]
alt[i,2]<-p1[2]+(p2[2]-p1[2])*t[i]
}
lines(alt[,1]+a*n[1],alt[,2]+a*n[2],type="l",col="red",lwd=2)
lines(alt[,1]+b*n[1],alt[,2]+b*n[2],type="l",col="red",lwd=2)
p1<-c(5,8)
p2<-c(8,5)
N<-500
sig<-0.02
H<-1/2
n<-200
ww<- fbbr(p1,p2,sig,N)
# Superponer las curvas adicionales utilizando lines dentro del bucle
for (k in 1:n) {
ww <- fbbr(p1, p2, sig, N)
lines(ww[, 1], ww[, 2], type = "l", col = sample(c("#0DF7B7","#1CF4A7","#0AB7B7","#0BC7C1"),1))
}
ww1<-matrix(0,n,N)
for (k in 1:n) {
ww1[k,]<-fbbm(sig,N)
}
n<-(p2-p1)/sqrt(sum((p2-p1)^2))*c(-1,1)
n
## [1] -0.7071068 -0.7071068
t<-seq(0,1,length=N)
a<-rep(0,N)
b<-rep(0,N)
for (i in 1:N) {
a[i]<-quantile(ww1[,i],0.025)
b[i]<-quantile(ww1[,i],0.975)
}
alt<-matrix(0,N,2)
for(i in 1:N){
alt[i,1]<-p1[1]+(p2[1]-p1[1])*t[i]
alt[i,2]<-p1[2]+(p2[2]-p1[2])*t[i]
}
lines(alt[,1]+a*n[1],alt[,2]+a*n[2],type="l",col="red",lwd=2)
lines(alt[,1]+b*n[1],alt[,2]+b*n[2],type="l",col="red",lwd=2)
