SERIES

COMPONENTES PRINCIPALES

setwd("~/Dropbox/ESTADISTICA/SERIES")
datos=read.csv(file="datosst.csv",sep=",",header=TRUE,dec = ".")

h3=datos %>%
  select(ends_with("3"))
summary(pc.cr <- princomp(h3,cor=TRUE))

## Importance of components:
##                           Comp.1     Comp.2      Comp.3       Comp.4
## Standard deviation     1.9729199 0.29224287 0.147696343 1.915723e-02
## Proportion of Variance 0.9731032 0.02135147 0.005453552 9.174991e-05
## Cumulative Proportion  0.9731032 0.99445470 0.999908250 1.000000e+00

attributes(pc.cr)

## $names
## [1] "sdev"     "loadings" "center"   "scale"    "n.obs"    "scores"   "call"    
## 
## $class
## [1] "princomp"

loadings(pc.cr)

## 
## Loadings:
##        Comp.1 Comp.2 Comp.3 Comp.4
## RMSE3   0.505  0.131  0.496  0.694
## sMAPE3  0.498  0.533 -0.684       
## MASE3   0.505  0.146  0.454 -0.719
## OWA3    0.492 -0.824 -0.283       
## 
##                Comp.1 Comp.2 Comp.3 Comp.4
## SS loadings      1.00   1.00   1.00   1.00
## Proportion Var   0.25   0.25   0.25   0.25
## Cumulative Var   0.25   0.50   0.75   1.00

plot(pc.cr)

#biplot(pc.cr)
#pc.cr$scores


dd=cbind(method=datos$method,id=datos$id,h3,score=pc.cr$scores[,1])
# asignamos el orden para cada uno de los criterios de error (menor a mayor)
ddd=dd %>%
  arrange(RMSE3) %>%
  mutate(oRMSE=order(RMSE3))%>%
  arrange(sMAPE3) %>%
  mutate(osMAPE=order(sMAPE3))%>%
  arrange(MASE3) %>%
  mutate(oMASE=order(MASE3))%>%
  arrange(OWA3) %>%
  mutate(oOWA=order(OWA3))%>%
  arrange(score) %>%
  mutate(oscore=order(score)) 

ddo = ddd %>%
  pivot_longer(cols=8:12,names_to="error",values_to="order")

Ordenación versus error criteria

# Ordenación versus error
g1=ggplot(ddo[ddo$error=="oRMSE",],aes(x=order,y=RMSE3))+
  geom_point(size=0.5)+geom_line()
g2=ggplot(ddo[ddo$error=="osMAPE",],aes(x=order,y=sMAPE3))+
  geom_point(size=0.5)+geom_line()
g3=ggplot(ddo[ddo$error=="oMASE",],aes(x=order,y=MASE3))+
  geom_point(size=0.5)+geom_line()
g4=ggplot(ddo[ddo$error=="oOWA",],aes(x=order,y=OWA3))+
  geom_point(size=0.5)+geom_line()
g5=ggplot(ddo[ddo$error=="oscore",],aes(x=order,y=score))+
  geom_point(size=0.5)+geom_line()
grid.arrange(g1,g2,g3,g4,g5,ncol=3)

Representamos los métodos ordenados por el score(princomp)

ggplot(ddd,aes(x=fct_reorder(method,oscore),y=score))+
  geom_point()+
  geom_line()+
  geom_vline(aes(xintercept = method[ddd$oscore==10]))+
  labs(x="Ordered Method",y="Score")+
  coord_flip()

## Warning: Use of `ddd$oscore` is discouraged. Use `oscore` instead.

## geom_path: Each group consists of only one observation. Do you need to adjust
## the group aesthetic?

Score para los mejores 10 métodos (posicionados del 1 al 10)

ddd %>%
  filter(oscore<11)%>%
ggplot(aes(x=fct_reorder(method,oscore),y=score))+
  geom_point()+
  geom_line()+
  labs(x="Ordered Method",y="Score")+
  coord_flip()

## geom_path: Each group consists of only one observation. Do you need to adjust
## the group aesthetic?

Diversas propuestas de pesos para utilizar en la ponderación de los métodos, usando los scores, donde \(x_1,..., x_n\) son los scores ordenados y \(m\) es el número de métodos a combinar.

\[w_i=\frac{x_i}{\sum_{j=1}^m{x_j}}\] \[wi_i=\frac{1/x_i}{\sum_{j=1}^m{1/x_j}}\] \[d1_i=x_i-x_1\] \[d2_i=\frac{1-(x_i-x_1)}{m-\sum_{j=1}^m{(x_j-x_1)}}\]

pesosi=function(x,m){
  v=rep(0,length(x))
  for(i in 1:m)
    v[i]=(1/x[i])/sum(1/x[1:m])
  return(v)
}

pesos=function(x,m){
  v=rep(0,length(x))
  for(i in 1:m)
    v[i]=(x[i])/sum(x[1:m])
  return(v)
}

pesosd=function(x,m){
  v=rep(0,length(x))
 for(i in 1:m)
    v[i]=(1-(x[i]-x[1]))/(m-sum(x[1:m]-x[1]))
  return(v)
 }

distancias=ddd %>%
  filter(oscore<11)%>%
  arrange(oscore)

m=2
cbind(score=distancias$score,oscore=distancias$oscore,w=pesos(distancias$score,m),
      wi=pesosi(distancias$score,m),d1=distancias$score-distancias$score[1],
      d2=pesosd(distancias$score,m))

##           score oscore        w       wi         d1        d2
##  [1,] -1.517523      1 0.503591 0.496409 0.00000000 0.5054697
##  [2,] -1.495881      2 0.496409 0.503591 0.02164205 0.4945303
##  [3,] -1.201618      3 0.000000 0.000000 0.31590460 0.0000000
##  [4,] -1.194922      4 0.000000 0.000000 0.32260130 0.0000000
##  [5,] -1.163026      5 0.000000 0.000000 0.35449708 0.0000000
##  [6,] -1.147547      6 0.000000 0.000000 0.36997566 0.0000000
##  [7,] -1.141259      7 0.000000 0.000000 0.37626400 0.0000000
##  [8,] -1.042830      8 0.000000 0.000000 0.47469293 0.0000000
##  [9,] -1.042777      9 0.000000 0.000000 0.47474614 0.0000000
## [10,] -1.042777     10 0.000000 0.000000 0.47474614 0.0000000

obs=c(39,60,43)
p1=c(42.89707,54.67645,46.19981)
p2=c(44.02194,56.71832,47.55288)

p=0.5033591*p1+0.496409*p2
mean(abs(p-obs)/obs*100)

## [1] 9.193894

mean(abs(p1-obs)/obs*100)

## [1] 8.76883

mean(abs(p2-obs)/obs*100)

## [1] 9.644776

Calculamos los rangos de las ordenaciones en los 5 criterios. Calculamos el rango=max(order)-min(order) utilizando como datos las ordenaciones en los 5 criterios de error considerados, y lo representamos para cada método.

#Cálculo de los rangos de las posiciones en los 5 criterios
rango=function(x){
  r=range(x)
  return(r[2]-r[1])
}
 
ddd$rango=apply(ddd[8:12],1,rango)

ggplot(ddd,aes(x=fct_reorder(method,rango),y=rango))+
  geom_point()+
  geom_line()+
  labs(x="Method",y="Range for orders")+
  coord_flip()

## geom_path: Each group consists of only one observation. Do you need to adjust
## the group aesthetic?

Seleccionamos los métodos con rango 0 en las ordenaciones y representamos sus ordenaciones en los 5 criterios.

ddd %>%
  filter(rango==0) %>%
  pivot_longer(cols=8:12,names_to="error",values_to="order") %>%
  ggplot(aes(x=method,y=error))

SERIES_ST

COMPONENTES PRINCIPALES