projects
/
epclust.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (from parent 1:
d03c062
)
avancée sur compréhension de epclust/R/stage2.R
author
Benjamin Auder
<benjamin.auder@somewhere>
Tue, 31 Jan 2017 15:17:55 +0000
(16:17 +0100)
committer
Benjamin Auder
<benjamin.auder@somewhere>
Tue, 31 Jan 2017 15:17:55 +0000
(16:17 +0100)
epclust/R/stage2.R
patch
|
blob
|
blame
|
history
diff --git
a/epclust/R/stage2.R
b/epclust/R/stage2.R
index
ebb44d9
..
254092c
100644
(file)
--- a/
epclust/R/stage2.R
+++ b/
epclust/R/stage2.R
@@
-13,8
+13,8
@@
library("Rwave")
#toCWT: (aux)
##NOTE: renvoie une matrice 3D
#toCWT: (aux)
##NOTE: renvoie une matrice 3D
-toCWT <- function(X, sw=
0, tw= 0, swabs= 0, nvoice= 12, noctave= 5, s0= 2, w0=
2*pi,
- lt=
24, dt= 0.5, spectra = FALSE, smooth = TRUE, scaled =
FALSE, scalevector)
+toCWT <- function(X, sw=
0, tw=0, swabs=0, nvoice=12, noctave=5, s0=2, w0=
2*pi,
+ lt=
24, dt=0.5, spectra=FALSE, smooth=TRUE, scaled=
FALSE, scalevector)
{
noctave <- adjust.noctave(lt, dt, s0, tw, noctave)
if(missing(scalevector))
{
noctave <- adjust.noctave(lt, dt, s0, tw, noctave)
if(missing(scalevector))
@@
-37,6
+37,21
@@
toCWT <- function(X, sw= 0, tw= 0, swabs= 0, nvoice= 12, noctave= 5, s0= 2,
resArray
}
resArray
}
+#from sowas
+adjust.noctave <- function(N,dt,s0,tw,noctave)
+{
+ if (tw>0)
+ {
+ dumno <- as.integer((log(N*dt)-log(2*tw*s0))/log(2))
+ if (dumno<noctave)
+ {
+ cat("# noctave adjusted to time smoothing window \n")
+ noctave <- dumno
+ }
+ }
+ noctave
+}
+
#from sowas
cwt.ts <- function(ts,s0,noctave=5,nvoice=10,w0=2*pi)
{
#from sowas
cwt.ts <- function(ts,s0,noctave=5,nvoice=10,w0=2*pi)
{
@@
-67,9
+82,16
@@
cwt.ts <- function(ts,s0,noctave=5,nvoice=10,w0=2*pi)
}
#NOTE: vect2mat = as.matrix ?! (dans aux.R)
}
#NOTE: vect2mat = as.matrix ?! (dans aux.R)
-vect2mat <- function(vect)
+vect2mat <- function(vect
, delta, lscvect
)
{
vect <- as.vector(vect)
{
vect <- as.vector(vect)
+
+print(delta)
+print(lscvect)
+print(delta * lscvect)
+browser()
+
+
matrix(vect[-(1:2)], delta, lscvect)
}
matrix(vect[-(1:2)], delta, lscvect)
}
@@
-77,8
+99,8
@@
vect2mat <- function(vect)
smCWT <- function(CWT, sw= 0, tw= 0, swabs= 0, nvoice= 12, noctave= 2, s0= 2, w0= 2*pi,
lt= 24, dt= 0.5, scalevector )
{
smCWT <- function(CWT, sw= 0, tw= 0, swabs= 0, nvoice= 12, noctave= 2, s0= 2, w0= 2*pi,
lt= 24, dt= 0.5, scalevector )
{
-#noctave <- adjust.noctave(lt, dt, s0, tw, noctave)
-#scalevector <- 2^(0:(noctave * nvoice) / nvoice) * s0
+
#noctave <- adjust.noctave(lt, dt, s0, tw, noctave)
+
#scalevector <- 2^(0:(noctave * nvoice) / nvoice) * s0
wsp <- Mod(CWT)
smwsp <- smooth.matrix(wsp, swabs)
smsmwsp <- smooth.time(smwsp, tw, dt, scalevector)
wsp <- Mod(CWT)
smwsp <- smooth.matrix(wsp, swabs)
smsmwsp <- smooth.time(smwsp, tw, dt, scalevector)
@@
-134,7
+156,7
@@
step2 = function(conso)
# observations node with CWT
Xcwt4 <- toCWT(conso, noctave = noctave4, dt = 1, scalevector = scalevector4, lt = delta,
smooth = FALSE, nvoice = nvoice)
# observations node with CWT
Xcwt4 <- toCWT(conso, noctave = noctave4, dt = 1, scalevector = scalevector4, lt = delta,
smooth = FALSE, nvoice = nvoice)
-
+browser()
#matrix:
############Xcwt2 <- matrix(0.0, nrow= n, ncol= 2 + delta * lscvect)
Xcwt2 <- matrix(NA_complex_, nrow= n, ncol= 2 + length((c(Xcwt4[,,1]))))
#matrix:
############Xcwt2 <- matrix(0.0, nrow= n, ncol= 2 + delta * lscvect)
Xcwt2 <- matrix(NA_complex_, nrow= n, ncol= 2 + length((c(Xcwt4[,,1]))))
@@
-148,11
+170,18
@@
step2 = function(conso)
Xwer_dist <- matrix(0.0, n, n)
for(i in 1:(n - 1))
{
Xwer_dist <- matrix(0.0, n, n)
for(i in 1:(n - 1))
{
- mat1 <- vect2mat(Xcwt2[i,])
- for(j in (i + 1):n)
+
+
+
+
+
+##ERROR là :: delta lscvect --> taille ??!
+ mat1 <- vect2mat(Xcwt2[i,], delta, lscvect)
+
+ for(j in (i + 1):n)
{
{
- mat2 <- vect2mat(Xcwt2[j,])
+ mat2 <- vect2mat(Xcwt2[j,]
, delta, lscvect
)
num <- Mod(mat1 * Conj(mat2))
WX <- Mod(mat1 * Conj(mat1))
WY <- Mod(mat2 * Conj(mat2))
num <- Mod(mat1 * Conj(mat2))
WX <- Mod(mat1 * Conj(mat1))
WY <- Mod(mat2 * Conj(mat2))
@@
-166,5
+195,5
@@
step2 = function(conso)
}
}
diag(Xwer_dist) <- numeric(n)
}
}
diag(Xwer_dist) <- numeric(n)
-
W
wer_dist
+
X
wer_dist
}
}