Analisi del fusto semplificata (con poche rotelle)

Podernovo, Consuma, 2017 (la Marca, Rinaldini, et al.)
Nel corso di una utilizzazione a raso di un impianto di douglasia di circa 50 anni, in un area di 2500 m², tra 87 fusti presenti, ne sono stati selezionati 47 come Alberi Modello.
Dagli AM abbattuti, alle estremità dei toppi individuati dall’operatore in funzione degli assortimenti da produrre, sono state prelevate sezioni (rotelle).
[Project repository: https://github.com/NuoroForestrySchool/TreeStemAnalysis/tree/master/2017Douglasia-Podernovo]

[Documentazione struttura base dati: https://docs.google.com/a/uniss.it/document/d/1XvKwF-WxBra7PZ-ooxAcUGMu0ZsKfqYpiE0zPzzQw08/edit?usp=sharing]

Analisi dendrocronologiche (time series)

Base dati

##  path:  2017Douglasia-Podernovo 
##  file:  2017PodernovoDouglasiaProfiliSemplificati_GSapp.sqlite

Testing DTW

ir <- dbReadTable(con, "CalcolaIncRaggio")

ir <- ir[with(ir, order(Id_fusto, Id_rotella, ripetizione, anno)),]

library(dtw)

## Warning: package 'dtw' was built under R version 3.3.3

## Loading required package: proxy

## Warning: package 'proxy' was built under R version 3.3.3

## 
## Attaching package: 'proxy'

## The following objects are masked from 'package:stats':
## 
##     as.dist, dist

## The following object is masked from 'package:base':
## 
##     as.matrix

## Loaded dtw v1.18-1. See ?dtw for help, citation("dtw") for use in publication.

## > is.dtw
## Error: object 'is.dtw' not found
my.is.dtw <- function(a) inherits(a, "dtw")
library(latticeExtra)

## Warning: package 'latticeExtra' was built under R version 3.3.3

## Loading required package: lattice

## Loading required package: RColorBrewer

for(idf in unique(ir$Id_fusto)[33]) {
  for(idr in unique(ir$Id_rotella[ir$Id_fusto==idf])[-4]) {
  ir1 <- ir[ir$Id_fusto==idf & ir$Id_rotella==idr,]
  templ <- ir1[ir1$ripetizione=='a', c("anno", "ir")]
  query <- ir1[ir1$ripetizione=='b', c("anno", "ir")]
  ir.ts <- merge(templ, query, by="anno", all=T, suffixes = c(".t", ".q"))
  ir.ts <- ts(ir.ts[,-1], start = ir.ts$anno[1], names=c("templ", "query"))

cat(nrow(templ), nrow(query))
stpps <- c("symmetric1"
,"symmetric2"
,"asymmetric"
,"rabinerJuangStepPattern(6, 'c')"
)
for(stpp in stpps[c(3,4)]) {
alg <- tryCatch(
  dtw(ir.ts[,"templ"], window(ir.ts[,"query"],end=2016),keep=TRUE
      , step.pattern=eval(parse(text=stpp))
) #      , open.begin=T, open.end=T)
  , error = function(e) cat(" -ERROR in dtw- ")
  , finally = NA)
cat(" test:",my.is.dtw(alg),"\n")
if(my.is.dtw(alg)) {
  plot(alg, type="twoway",offset=-2, xlab='2017-anno', ylab='inc_raggio') 
} else {
  ir1$ir[ir1$ripetizione=='b'] <-1.52+ir1$ir[ir1$ripetizione=='b']
  print(
    xyplot(ir.ts, col=c('red', 'blue'), superpose = T, grid=T
    , main=paste("Fusto:",idf,"- Rot:", idr
                 , "- lungh.a =", nrow(templ),"e .b =", nrow(query)))
  )
}
title(main=paste("Fusto:",idf,"- Rot:", idr
             , "- lungh.a =", nrow(templ),"e .b =", nrow(query))
      ,sub = stpp)
}
}
}

## 50 50 test: TRUE

##  test: TRUE

## 41 41 test: TRUE

##  test: TRUE

## 34 34 test: TRUE

##  test: TRUE

## 33 33 test: TRUE

##  test: TRUE

## 27 27 test: TRUE

##  test: TRUE

## 23 23 test: TRUE

##  test: TRUE