In convergEU: Monitoring Convergence of EU Countries

library(convergEU)
library(knitr)
library(tibble)
library(devtools)
library(tidyverse)
library(eurostat)
library(purrr)
library(ggplot2)
library(dplyr)
library(tidyr)
library(ggplot2)
library(kableExtra)
library(caTools)
library(broom)
library(gridExtra)

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  prompt= TRUE,
  fig.width = 7,
  fig.height = 5,
  echo=FALSE,
  message = FALSE,
  warning = FALSE,
  eval=TRUE
)

# input parameters
params <- list()
params$dataNow <- Sys.Date()
params$time_0 <- 2005
params$time_t <- 2010
params$timeName  <- 'time'
params$workingDF  <- 'emp_20_64_MS'
params$indicaT <- 'emp_20_64_MS'
params$indiType<- 'lowBest' # highBest
params$seleMeasure <- 'all'
params$seleAggre <- 'custom' ##'EU12'
params$x_angle<- 45
params$data_res_download <- TRUE
params$auth <- 'A.P.Student'
params$outFile <- "test_indica-fi-cust"
#params$outDir <-
params$outDir <-   "../tt-fish"
params$pdf_out <- TRUE
params$workTB <- iris

Indicator Fiche

This fiche shows the investigation of upward convergence of Member States in the selected indicator using the methodological framework of Eurofound (2018). Where upward convergence is the process in which Member States improve their performance in relation to a particular outcome or policy objective together with a decrease in disparities among them. From a methodological point of view, there is no single measure capable of capturing all the relevant aspects of the convergence, it is therefore essential to consider more than one measure in order to obtain a more comprehensive idea of the convergence dynamics.

Fiche info

Today: r params$dataNow
R Package: convergEU
Indicator: r params$indicaT
Indicator type: r params$indiType
Measures of convergence: r if(is.null(params$seleMeasure)){"none"}else{params$seleMeasure}
Aggregation: r params$seleAggre
Time window: r params$timeName from r as.numeric(params$time_0) to r as.numeric(params$time_t)
Author: r params$auth

# to save into a out-file
out_packed_list <- list()
out_packed_list$params <- params

timeName <- params$timeName
myx_angle <-  params$x_angle
ptime_0 <-  as.numeric(params$time_0)
ptime_t <-  as.numeric(params$time_t)
indiName <- indicaT <- params$indicaT
indiType <- params$indiType

#otherCountries
aggregation <- params$seleAggre 

out_packed_name <- file.path(params$outDir,
                             paste0(params$outFile,
                                    '-workspace.RData'))


wkDF <- params$workTB

# wkDF
# filtering
wkDF1 <- dplyr::filter(wkDF, .data[[timeName]]   <= ptime_t & .data[[timeName]] >= ptime_0)


## select variables-countries according to aggregation
if( !(params$seleAggre %in% 
      c(convergEU_glb()$labels_clusters ,"custom"))){
  stop("Error: wrong aggregation selected!!\nLook into convergEU_glb()");
}; 

if(params$seleAggre != "custom"){
    nomiSele <- c(params$timeName,
               convergEU_glb()[[params$seleAggre]]$memberStates$codeMS)
    wkDF2 <-  wkDF1[, nomiSele]
    # only countries
    sele_soli_ms <- convergEU_glb()[[params$seleAggre]]$memberStates$codeMS

}else{
   # this is for "custom" selection
   nomiSele <- names(wkDF1)
   wkDF2 <-  wkDF1
   # only countries
   sele_soli_ms <- setdiff(names(wkDF2),timeName)
}


tempo_val <- unlist(wkDF2[,sele_soli_ms])
tempo_val <- tempo_val[tempo_val > 0]
minim_not_null <- min(tempo_val)/100
if(all(wkDF2[,sele_soli_ms] >= 0)){
      for(auxvv in sele_soli_ms){
         estrattore_nulli <- wkDF2[[auxvv]] == 0
         wkDF2[[auxvv]][estrattore_nulli] <- minim_not_null
      }
}

## selection of measures
allMeasures <- c( "beta","delta","gamma","sigma", "all")
semaforo <- list()
if(length(setdiff(params$seleMeasure, allMeasures)) > 0 ){
  stop("Errore: wrong measures selected!!")
}else{
    for(auxSemaforo in allMeasures[-5]){semaforo[[auxSemaforo]]<- FALSE};
    if("all" %in% params$seleMeasure){
       for(auxSemaforo in allMeasures[-5])semaforo[[auxSemaforo]]<- TRUE;
    }else{  
       for(auxSemaforo in params$seleMeasure)semaforo[[auxSemaforo]]<- TRUE;
    }  
}

# averaging conditional to aggregation
if(params$seleAggre != "custom"){
outMed <- average_clust(wkDF2, timeName = params$timeName, 
                        cluster = aggregation)$res[,c(timeName,aggregation)]
}else{
  outMed <- average_clust(wkDF2, timeName = params$timeName, 
                          cluster = "all")$res[,c(timeName,"all")]

  vars2rename <- c(custom="all")
  outMed <- dplyr::rename(outMed, custom = all)
}





## 2019-12-12 moved here
lastRowAverages <- nrow(outMed)

print(out_packed_name)

##
##
## Sigma convergence calculated always whether printed or not
## 2019-12-12
##


sigCores <- sigma_conv(wkDF2, timeName = timeName, time_0 = ptime_0, time_t=ptime_t)
#sigCores
lastRowAveragesSig <- nrow(sigCores$res)

sd_enne <<- function(vec_obs){
   enne <-  length(vec_obs)
   esse_n <- sd(vec_obs)*sqrt((enne-1)/enne)
   esse_n
}
CV_enne <<- function(vec_obs){
   enne <-  length(vec_obs)
   std_dev <- sd_enne(vec_obs) 
   val_CV_n <- 100*std_dev /mean(vec_obs)
   val_CV_n
}
dichia_con_stddev <- upDo_CoDi(wkDF2,
          timeName = timeName,
          indiType = params$indiType,
          time_0 = ptime_0,
          time_t = ptime_t,
          heter_fun = "sd_enne"
          )

dichia_con_CV <- upDo_CoDi(wkDF2,
          timeName = timeName,
          indiType = params$indiType,
          time_0 = ptime_0,
          time_t = ptime_t,
          heter_fun = "CV_enne"
          )


# here stddev
if(dichia_con_stddev$res$declaration_strict != "none"){
  label_dichia_con_stddev <- paste(
       dichia_con_stddev$res$declaration_strict,
       dichia_con_stddev$res$declaration_type
       )
}else{
  label_dichia_con_stddev <- paste(
               dichia_con_stddev$res$declaration_weak,
               dichia_con_stddev$res$declaration_type
               )
}
# now CV
if(dichia_con_CV$res$declaration_strict != "none"){
  label_dichia_con_CV <- paste(
       dichia_con_CV$res$declaration_strict,
       dichia_con_CV$res$declaration_type
       )
}else{
  label_dichia_con_CV <- paste(
               dichia_con_CV$res$declaration_weak,
               dichia_con_CV$res$declaration_type
               )
}

# overall sigma convergence
diffeSTDdev <- as.numeric(sigCores$res[lastRowAverages,'stdDev'])-as.numeric(sigCores$res[1,'stdDev'])
diffeCV <- 100*(as.numeric(sigCores$res[lastRowAveragesSig,'CV'])-as.numeric(sigCores$res[1,'CV']))
if(diffeSTDdev < 0){
   label_sigmaSTDdev <- "convergence"
}else if(diffeSTDdev == 0) {
  label_sigmaSTDdev <- "unchanged"
}else{
  label_sigmaSTDdev <- "divergence"
}
if(diffeCV < 0){
   label_sigmaCV <- "convergence"
}else if(diffeCV == 0){
  label_sigmaCV <- "unchanged"
}else{
  label_sigmaCV <- "divergence"
}

label_sigma_joint<- paste("Standard Deviation: ",label_sigmaSTDdev,"; CV: ",label_sigmaCV)

Time series overview of EU countries

The graph shows the times series trend of each Member State giving an idea of the development of the countries across time.

colMS <- setdiff(names(wkDF2),timeName)

wkDF3 <-  wkDF2  %>% tidyr::gather_( gather_cols = colMS, 
                            key_col = "Country",value_col="Indicator" )


mGallEU <- ggplot2::ggplot(wkDF3,aes(x = time, y= Indicator, 
                                      group=Country
                                     )) +
           ggplot2::geom_line( aes(color=Country)) +
           ggplot2::scale_x_continuous(
               breaks = seq(ptime_0,ptime_t),
               labels = seq(ptime_0,ptime_t)) +
          ggplot2::theme( 
                   axis.text.x=ggplot2::element_text(
                   angle = 45 ,
                   vjust = 1,
                   hjust=1)) +
         ggplot2::ylab(indicaT) 

out_packed_list$allEUms <-  list()
out_packed_list$allEUms$mGallEU <- mGallEU

mGallEU

Time series summary of EU countries

The graph gives an overview of the development in some basic descriptive statistics: unweighted average, median, the minimum and the maximum value in each year.

colMS <- setdiff(names(wkDF2),timeName)

enneC <- nrow(wkDF2)
riaSD <- apply(wkDF2[,colMS],1,function(vx)sqrt(var(vx)*(enneC-1)/enneC))
sintesiTB <- wkDF2[,timeName]
sintesiTB <- sintesiTB %>% 
    dplyr::mutate(min =apply(wkDF2[,colMS],1,min))%>%
    dplyr::mutate(max = apply(wkDF2[,colMS],1,max))%>%
    dplyr::mutate(mean = apply(wkDF2[,colMS],1,mean))%>%
    dplyr::mutate(median = apply(wkDF2[,colMS],1,median))%>%
    dplyr::mutate(mean_mSD =mean-riaSD)%>%
    dplyr::mutate(mean_pSD =mean+riaSD)


riaFlat<-  sintesiTB  %>% tidyr::gather_( 
                gather_cols = c("min", "mean_mSD", "mean", "median",
                                "mean_pSD","max"), 
                key_col = "Stat",
                value_col="Value" )
riaFlat$Stat <- factor(riaFlat$Stat,
                       levels= c("min", "mean_mSD", "mean", "median",
                                "mean_pSD","max"))
myStyle <-  c("solid", "dashed", "dotted", "dotdash", "longdash", "twodash")
myColors <- c("black","black","white","red","blue","blue")
riaFlat <- dplyr::mutate(riaFlat,LineType = 0)    
riaFlat$LineType[riaFlat$Stat == "median"] <- 3    
riaFlat$LineType[riaFlat$Stat == "mean"] <- 1
riaFlat$LineType[riaFlat$Stat == "median"] <- 2     
riaFlat$LineType[riaFlat$Stat == "mean_mSD"] <- 4     
riaFlat$LineType[riaFlat$Stat == "mean_pSD"] <- 4    
riaFlat$LineType[riaFlat$Stat == "min"] <- 5     
riaFlat$LineType[riaFlat$Stat == "max"] <- 5     
riaFlat<- mutate(riaFlat,Grp= as.numeric(factor(Stat)))
# for legend
riaFlat <- dplyr::mutate(riaFlat,mylty=myStyle[riaFlat$LineType])
riaFlat <- dplyr::mutate(riaFlat,Statistic=as.character(riaFlat$Stat))


myLabels <- c("max", "mean","mean_mSD","mean_pSD","median","min")
# build labels for minimum and maximum

sintesiTB$eticheMin <- sapply(seq(1,length(sintesiTB$min)),
      function(vx){
      estrattore <- sintesiTB$min[vx] == wkDF2[vx,colMS]
      #print(sum(estrattore))
      paste(colMS[estrattore],collapse="/")
})
sintesiTB$eticheMax <- sapply(seq(1,length(sintesiTB$max)),
      function(vx){
      estrattore <- sintesiTB$max[vx] == wkDF2[vx,colMS]
      #print(sum(estrattore))
      paste(colMS[estrattore],collapse="/")
}) 



mGallSummary <- ggplot2::ggplot(riaFlat,aes(x = time,y= Value)) +
  ggplot2::geom_line( aes( colour=Stat ),linetype=riaFlat$mylty) +
  ggplot2::geom_point( aes( colour=Stat)) +
  scale_colour_manual("Statistic",values=c(min="blue",
                               mean_mSD="red",
                               mean="black",
                               median="black",
                               mean_pSD = "red",
                               max="blue")
                      ,labels=c(min="min",
                               mean_mSD="mean-1*std.dev.",
                               mean="mean",
                               median="median",
                               mean_pSD = "mean+1*std.dev.",
                               max="max")
                      ) +
  guides(shape = FALSE, colour = guide_legend(
           override.aes = list(linetype =  c("min"="82",
                                        "mean_mSD"="3313",
                                        "mean"="F1",
                                        "median"="66",
                                        "mean_pSD" = "3313",
                                        "max"="82")
           ))) + theme(legend.key.size = unit(1.3, "cm"))  +
  ggplot2::scale_x_continuous(
    breaks = seq(ptime_0,ptime_t),
    labels = seq(ptime_0,ptime_t)) +
  ggplot2::theme(
    axis.text.x=ggplot2::element_text(
      angle = 45 ,
      vjust = 1,
      hjust=1)) +
  ggplot2::ylab(indicaT) +
  # labels on min and max
  ggplot2::annotate("text",
                    x =sintesiTB[[timeName]] ,
                    y=sintesiTB$max ,
                    label = paste(sintesiTB$eticheMax,"    "),
                    color ="navyblue",
                    angle=45) +
  ggplot2::annotate("text",
                    x =sintesiTB[[timeName]] ,
                    y=sintesiTB$min ,
                    label = paste("    ",sintesiTB$eticheMin),
                    color ="navyblue",
                    angle=45)



out_packed_list$allEUms$mGallSummary <-  mGallSummary

mGallSummary

Boxplots of EU countries over time

The graph gives an overall idea of the dispersion and some descriptive statistics of the Member States in each year.

wkDF3 <- tidyr::gather_(wkDF2,  gather_cols = colMS, 
                            key_col = "Country",value_col="Indicator" )

wkDF3$time <-  factor(wkDF3$time)
condiBP <-   qplot(time,Indicator,data=wkDF3,geom="boxplot",
                  group= time) +
          geom_point(position=position_jitter(width=0.1),
                     colour=alpha("red",0.25)) +
          ggplot2::theme( 
                   axis.text.x=ggplot2::element_text(
                   angle = 45 ,
                   vjust = 1,
                   hjust=1)) +
         ggplot2::ylab(indicaT)





out_packed_list$condiBP <-  condiBP

condiBP

Legend:

boxes height: first and third quartile (hinges)
bold black horizontal segment: median
upper whisker: $min(max(x), Q_3 + 1.5 * IQR)$
lower whisker: $max(min(x), Q_1 - 1.5 * IQR)$

where $IQR = Q_3 - Q_1$ is the box length, that is the third quartile minus the first quartile. Overlaid jittered points are shown in red.

Unweighted average by year over selected countries

The graph presents the unweighted average calculated on the aggregation of Member States selected. Below the graph there are initial and final year values and the overall change in the period. The overall change can be upward or downward depending on the objective direction of the indicator and its interpretation.

cluster_mean_gr2 <- qplot(
      unlist(outMed[,timeName]),
      unlist(outMed[,aggregation]),
      xlab= paste("Years "),
      ylab= paste("Average (",aggregation,")")) +
  geom_line()  +
  ggplot2::scale_x_continuous(
       breaks = seq(ptime_0,ptime_t),
       labels = seq(ptime_0,ptime_t)) +
  ggplot2::theme( 
         axis.text.x=ggplot2::element_text(
         angle = 45 ,
         vjust = 1,
         hjust=1))


# export
out_packed_list$cluster_mean_gr2 <-  cluster_mean_gr2
#plot
cluster_mean_gr2

diffeAve <- as.numeric(outMed[lastRowAverages,aggregation]) - 
            as.numeric(outMed[1,aggregation])
## highBest
if( (diffeAve > 0 )  &  (params$indiType =="highBest")){
  labelAveDelta <-  "upward change"
}else if((diffeAve == 0)  &  (params$indiType =="highBest")){
  labelAveDelta <- "unchanged"
}else if((diffeAve < 0)  &  (params$indiType =="highBest")) {
  labelAveDelta <- "downward change"
}
## lowBest
if( (diffeAve > 0 )  &  (params$indiType =="lowBest")){
  labelAveDelta <-  "downward change"
}else if((diffeAve == 0)  &  (params$indiType =="lowBest")){
  labelAveDelta <- "unchanged"
}else if((diffeAve < 0)  &  (params$indiType =="lowBest")) {
  labelAveDelta <- "upward change"
}

Change in average:
- Year r ptime_0, average: r as.numeric(outMed[1,aggregation])
- Year r ptime_t, average: r as.numeric(outMed[lastRowAverages,aggregation])
- Difference $\Delta$ between years: r diffeAve
- Overall result (interpretation): r labelAveDelta
- Member states with increment of mean in year r ptime_t with respect to year r ptime_0:
- r paste(sort(dichia_con_stddev$res$declaration_split$names_incre),collapse="; ")
Member states with decrement of means in year r ptime_t with respect to year r ptime_0:
- r paste(sort(dichia_con_stddev$res$declaration_split$names_decre),collapse="; ")

# Pre-processing for beta convergence when null or negative values 
#     are present 

wkDF2bis <- dplyr::filter(wkDF2, .data[[timeName]] == ptime_0 | 
                                 .data[[timeName]] == ptime_t)[sele_soli_ms];  


semaforo[["nega_val_indi"]] <- FALSE
#nega_val <- any(wkDF2[, sele_soli_ms] < 0)# check too many values instead of ptime_t & ptime_0
nega_val <- any(wkDF2bis < 0)

if(nega_val & semaforo[["beta"]] ){
  semaforo[["nega_val_indi"]] <- TRUE
  semaforo[["beta"]] <- FALSE
}

semaforo

if(semaforo[["nega_val_indi"]]){
  cat(knitr::asis_output(knitr::knit_child("indica_fi_2_nobeta.Rmd", 
                                           quiet=TRUE, envir=environment())))
}

if(semaforo[["beta"]]){
  cat(knitr::asis_output(knitr::knit_child("indica_fi_2_beta.Rmd", 
                                           quiet=TRUE, envir=environment())))
}

if(semaforo[["sigma"]]){
  cat(knitr::asis_output(knitr::knit_child("indica_fi_2_sigma.Rmd", 
                                           quiet=TRUE, envir=environment())))
}

if(semaforo[["delta"]]){
  cat(knitr::asis_output(knitr::knit_child("indica_fi_2_delta.Rmd", 
                                           quiet=TRUE, envir=environment())))
}

if(semaforo[["gamma"]]){
  cat(knitr::asis_output(knitr::knit_child("indica_fi_2_gamma.Rmd", 
                                           quiet=TRUE, envir=environment())))
}

Member States dynamics

The dynamics of Member States show the differences in the situation of single Member States which can be hidden under the use of a single indicator. Understanding the dynamics is also necessary to better identify possible drivers of convergence and divergence as well as structural deficiencies or sustainable recoveries.

Alert indicator

This graph is useful in order to assess if the Member State's performance deviates significantly from the average and it has been created building on the EMCO and SPC methodology. The performance of each country is standardised each year and then the scores are compared according to their standard deviation.

#altezzIG0 <- 3+7*(length(sele_soli_ms)/30)

obe_lvl <- scoreb_yrs(wkDF2,timeName = timeName)$res$sco_level_num
#curCountries <- names(obe_lvl)[-1]
curCountries <- setdiff(names(obe_lvl),timeName)
altezzIG00 <- 3+7*(length(curCountries)/30)

scobe_lvl <- scoreb_yrs(wkDF2,timeName = timeName)$res$sco_level
# select subset of time
estrattore <- scobe_lvl[[timeName]] >= ptime_0  & scobe_lvl[[timeName]] <= ptime_t  
scobelvl <- scobe_lvl[estrattore,]
# conversion
curCountries <- setdiff(names(scobelvl),timeName)

for(aux in curCountries){
  scobelvl[,aux] <- c(-1,-0.5,0,0.5,1)[unlist(scobelvl[,aux])]
}
final_TB <- tidyr::gather(scobelvl, key="Country",value="Level",all_of(curCountries))

numberofOutColumns <-  6
myG_JAF <- ggplot(final_TB,aes(x = unlist(final_TB[,timeName]),
                    y = Level)) +
  ggplot2::facet_wrap(~ Country,ncol=numberofOutColumns)+
  ggplot2::geom_line() + 
  ggplot2::geom_point() +
  ggplot2::theme(
         axis.text.x=ggplot2::element_text(
         angle = 90 
         )) +
   ggplot2::scale_x_continuous(
     breaks = unlist(final_TB[,timeName]),
     labels = unlist(final_TB[,timeName]))  +
   ggplot2::scale_y_continuous(
     breaks =  c(-1,-0.5,0,0.5,1),
     labels = c(-1,-0.5,0,0.5,1), 
     limits= c( -1.25,1.25) )  +
  xlab("Years") +ylab("Indicator") +
geom_hline(yintercept=-1,colour="red",linetype="dotted")+
geom_hline(yintercept=-0.5,colour="red",linetype="dotted")+
geom_hline(yintercept=0,colour="red",linetype="dotted")+
geom_hline(yintercept=0.5,colour="red",linetype="dotted")+
geom_hline(yintercept= 1,colour="red",linetype="dotted")


out_packed_list$JAF <- myG_JAF 
myG_JAF

Dynamics

This table is useful in order to assess if the Member State's performance deviates significantly from the average.

#altezzIG0 <- 3+7*(length(sele_soli_ms)/30)


obe_lvl <- scoreb_yrs(wkDF2,timeName = timeName)$res$sco_level_num
#curCountries <- names(obe_lvl)[-1]
curCountries <- setdiff(names(obe_lvl),timeName)
altezzIG0 <- 3+7*(length(curCountries)/30)

# select subset of time
estrattore <- obe_lvl[[timeName]] >= ptime_0  & obe_lvl[[timeName]] <= ptime_t  
scobelvl <- obe_lvl[estrattore,c(timeName,curCountries)]

my_MS <- ms_dynam( scobelvl,
                timeName = "time",
                displace = 0.25,
                displaceh = 0.5,
                dimeFontNum = 4,
                myfont_scale = 1.35,
                x_angle = 90,
                axis_name_y = "Countries",
                axis_name_x = "Time",
                alpha_color = 0.9,
                indiType = params$indiType
                )

out_packed_list$MSdyn <- my_MS
my_MS

Convergence and divergence patterns

The table represents the 20 convergence patterns of the 'aggregation' countries in the chosen timeframe. The values in the table refer to the patterns shown in the graphical legend below.

testa_1 <- function(colonne_tot){
paste(  
"<table class=\"table table-striped table-condensed table-bordered\" style=\"font-size: 12px; width: auto !important; margin-center: auto; margin-right: auto;\"><thead>
<tr>
<th style=\"border-bottom:hidden\" colspan=\"1\"></th><th style=\"border-bottom:hidden; padding-bottom:0; padding-center:3px;padding-right:3px;text-align: center; color: #2676ba;\" colspan=\"",
colonne_tot-4,
"\"><div style=\"border-bottom: 1px solid #ddd; padding-bottom: 5px; \"><span style=\"-webkit-transform: rotate(0deg); -moz-transform: rotate(0deg); -ms-transform: rotate(0deg); -o-transform: rotate(0deg); transform: rotate(0deg); display: inline-block;\">Yearly changes</span></div></th>
<th style=\"border-bottom:hidden; padding-bottom:0; padding-center:3px;padding-right:3px;text-align: center; color: #2676ba;\" colspan=\"3\"><div style=\"border-bottom: 1px solid #ddd; padding-bottom: 5px; \"><span style=\"-webkit-transform: rotate(0deg); -moz-transform: rotate(0deg); -ms-transform: rotate(0deg); -o-transform: rotate(0deg); transform: rotate(0deg); display: inline-block;\">Instances of convergence and divergence</span></div>
</th>
<th style=\"border-bottom:hidden\" colspan=\"1\"></th>
</tr>",  sep="")

}


testa_2bis <- function(etichetteH, etich_col_1r="First/Last"){

res <- "<tr><th style=\"text-align:left;\"> <div   style=\"color:#2676ba;\">Country</div> </th>";
for(aux in etichetteH){
  res <- paste(res,"<th style=\"text-align:center;\"><div class=\"vertical-text\">",
             "<div class=\"vertical-text__inner\" style=\"color:#2676ba;\">",
               aux,"</div></div> </th>", sep="",collapse="\n");
}  
res <- paste(res,  "<th style=\"text-align:center;\"> <div style=\"color:#2676ba;\">")  
res <- paste(res, "Catching up<br>(1) </div> </th> <th style=\"text-align:center;\"> ")
res <- paste(res,"<div style=\"color:#2676ba;\"> Falling away <br>(9) </div> </th>")
res <- paste(res, "<th style=\"text-align:center;\">  <div style=\"color:#2676ba;\">Diving  <br>(6)</div> </th>")
res <- paste(res,"<th style=\"text-align:center;\"><div class=\"vertical-text\">",
             "<div class=\"vertical-text__inner\" style=\"color:#2676ba;\">",
               etich_col_1r,"</div></div> </th>", 
         "</tr></thead>",sep=" ",collapse=" ") 
res  
}

corpo_1 <-  function(record){ # tutta la riga anche con colonna extra
  dime <- length(record)-1
  # filtro record for colouring the background
  templato <- list()
  templato[1:21] <- "<td style=\"text-align:center;\">";

  # end of changes
  templato[[1]] <- "<td style=\"text-align:center;background-color: #dbe7c2\">";
  templato[[6]] <- "<td style=\"text-align:center;background-color: #f9b9b9\">";
  templato[[9]] <- "<td style=\"text-align:center;background-color: #ee3557\">";

  elem_good <- as.numeric(record[-1*c(1,dime-2,dime-1,dime,dime+1)])
  res <- paste(
  "<tr>",
   "<td style=\"text-align:left;\">", record[1],"</td>",
  paste(templato[elem_good],
        elem_good,"</td>",sep="",collapse=""),
   "<td style=\"text-align:center;\">",
         "<span  >",record[dime-2],"</span></td>",
  "<td style=\"text-align:center;\">",
            "<span  >",record[dime-1],"</span></td>",
  "<td style=\"text-align:center;\">", 
             "<span  >",record[dime],"</span></td>",

  templato[[as.numeric(record[dime+1])]],
             "<span  >",record[dime+1],"</span></td>",
  "</tr>",sep="")

  res
}

corpo_full <-  function(myTB){

  dimeR <- nrow(myTB)
  res<-"<tbody>"
  for(aux in 1:dimeR){
    recordcorre <-  corpo_1( unlist(myTB[aux,]))
    res <- paste(res,recordcorre,
                 sep="")
  } 
  paste(res,
        "</tbody>","</table>",sep="")
}

tabe_tot <- function(mydata, first_last_years="First/Last"){
  totcol <- ncol(mydata)-1
  intesta <- names(mydata)[-c(1,totcol-2,totcol-1,totcol,totcol+1)]
  res <-  testa_1(totcol)
  res <- paste(res, testa_2bis(etichetteH = intesta, 
                               etich_col_1r = first_last_years ),
               sep="")
  res <- paste(res, corpo_full(mydata),sep="")
  res
}

estrattore <- as.logical((wkDF2[,timeName] >= ptime_0) &  (wkDF2[,timeName]<= ptime_t))

myMSPat <- ms_pattern_ori(wkDF2[estrattore,],
                          timeName = timeName,
                          typeIn= params$indiType)
estrattore_1_n <- as.logical((wkDF2[,timeName] == ptime_0) |   
                               (wkDF2[,timeName]== ptime_t))
myMSPat_first_last <- ms_pattern_ori(wkDF2[estrattore_1_n ,],
                          timeName = timeName,
                          typeIn= params$indiType)

workMatSco <- myMSPat$res$mat_num_tags
workMatSco2 <- dplyr::bind_cols(myMSPat$res$mat_num_tags,
                            myMSPat_first_last$res$mat_num_tags[,2] )
# test
if(any(myMSPat$res$mat_num_tags[,1] != myMSPat_first_last$res$mat_num_tags[,1])){
  stop("Error: line 1020 indica_fi.Rmd - countries do not match.")
}


curCountries <- setdiff(names(wkDF2),timeName)
posiMS <- posiMS2 <- vector()
for(auxCC in curCountries){
    posiMS <-  c(posiMS,which(workMatSco$Country == auxCC))
    posiMS2 <-  c(posiMS2,which(workMatSco2$Country == auxCC))

}  
workMatSco <- workMatSco[posiMS,]
workMatSco2 <- workMatSco2[posiMS2,]


if(aggregation != "custom"){
  map2str <- convergEU_glb()[[aggregation]]$memberStates
}else{ # it's custom 3 october 2019
  map2str <- dplyr::tibble(MS = curCountries,
                           codeMS = curCountries)
}



## below is fine
for(aux in 1:nrow(workMatSco)){ 
    puntaMS <- which(map2str$codeMS ==   workMatSco$Country[aux ])
    workMatSco$Country[aux ] <- map2str$MS[puntaMS]
    puntaMS2 <- which(map2str$codeMS ==   workMatSco2$Country[aux ])
    workMatSco2$Country[aux ] <- map2str$MS[puntaMS]

}


tabeHTMLfinal <- tabe_tot(workMatSco2, 
                          first_last_years = paste(ptime_0,"/", ptime_t,sep=""))# "First/Last")

out_packed_list$patterns <- list(css="<style>\n.vertical-text {\n\tdisplay: inline-block;\n\toverflow: hidden;\n\twidth: 1.3em;\n}\n.vertical-text__inner {\n\tdisplay: inline-block;\n\twhite-space: nowrap;\n\tline-height: 1.5;\n\ttransform: translate(0,100%) rotate(-90deg);\n\ttransform-origin: 0 0;\n}\n\n.vertical-text__inner:after {\n\tcontent: \"\";\n\tdisplay: block;\n\tmargin: -1.5em 0 100%;\n}\n\n\nbody {\n\tfont: 11px/1 Arial, sans-serif;\n}\n\ntable {\n\tmargin-top: 1em;\n}\nth,td {\n\tborder: 1px solid;\n\ttext-align:center;\n\tfont-weight: normal;\n\tpadding: 0.5em;\n}\nhead{\n   color: blue;\n}\n</style>",
     html=tabeHTMLfinal)

cat(tabeHTMLfinal)

if(params$indiType == "highBest"){
    refGGpat <- patt_legend(indiType = "highBest")
} else{  
    refGGpat <- patt_legend(indiType = "lowBest")
}

grid.arrange(  refGGpat,
               nrow = 1, ncol=1,
      top= paste0("Patterns legend"),
      bottom = "Time",
      left= "Indicator value")




out_packed_list$gridLegend <- refGGpat

Note: 21 is none of the previous patterns and requires visual inspection.

Legend:

dashed blue lines: Member States
solid lines: EU average
Indicator type: r params$indiType

Total decrease and increase in the gap with the `r params$aggregation` mean

The graph shows the sum of the yearly deviations from European average in each country.

altezzIG000 <- 3+6*(length(curCountries)/30)

# already set
# curCountries 
res_dev_pt <- dev_mean_plot(wkDF2,
                          timeName = timeName,
                          time_0 = ptime_0,
                          time_t = ptime_t,
                          indiType = params$indiType,
                          countries = curCountries,  
                          displace = 0.15,
                          axis_name_y = "Countries",
                          val_alpha  = 0.95,
                          debug=FALSE) 

out_packed_list$Tot_inc_dec <- res_dev_pt$res
res_dev_pt$res

res_dev_pt  <- demea_change(wkDF2,
                      timeName=timeName,
                      time_0 = ptime_0,
                      time_t = ptime_t,
                      sele_countries= curCountries,
                      doplot=TRUE)


out_packed_list$Tot_inc_dec <- res_dev_pt$res
plot(res_dev_pt$res$res_graph)

Last r date()

save(out_packed_list,file = out_packed_name)

Any scripts or data that you put into this service are public.

convergEU documentation built on March 7, 2023, 7:22 p.m.

rdrr.io home R language documentation Run R code online

CRAN packages Bioconductor packages R-Forge packages GitHub packages

Note that we can't provide technical support on individual packages. You should contact the package authors for that.

convergEU
Monitoring Convergence of EU Countries

In convergEU: Monitoring Convergence of EU Countries

Indicator Fiche

Fiche info

Time series overview of EU countries

Time series summary of EU countries

Boxplots of EU countries over time

Unweighted average by year over selected countries

Member States dynamics

Alert indicator

Dynamics

Convergence and divergence patterns

Total decrease and increase in the gap with the `r params$aggregation` mean

Try the convergEU package in your browser

R Package Documentation

Browse R Packages

We want your feedback!

convergEU Monitoring Convergence of EU Countries

In convergEU: Monitoring Convergence of EU Countries

Indicator Fiche

Fiche info

Time series overview of EU countries

Time series summary of EU countries

Boxplots of EU countries over time

Unweighted average by year over selected countries

Member States dynamics

Alert indicator

Dynamics

Convergence and divergence patterns

Total decrease and increase in the gap with the r params$aggregation mean

Try the convergEU package in your browser

R Package Documentation

Browse R Packages

We want your feedback!

convergEU
Monitoring Convergence of EU Countries

Total decrease and increase in the gap with the `r params$aggregation` mean