Nothing
inst/doc/measuring-convergence.R
In convergEU: Monitoring Convergence of EU Countries
## ----setup, include = FALSE---------------------------------------------------
library(ggplot2)
library(dplyr)
library(tidyverse)
library(eurostat)
library(purrr)
library(tibble)
library(tidyr)
library(formattable)
library(kableExtra)
library(caTools)
library(convergEU)
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
fig.width = 7,
fig.height = 5
)
## ----eval=FALSE---------------------------------------------------------------
# data("emp_20_64_MS",package = "convergEU")
# head(emp_20_64_MS)
## ----eval=FALSE---------------------------------------------------------------
# data(package = "convergEU")
## ----eval=FALSE---------------------------------------------------------------
# help(emp_20_64_MS)
#
## -----------------------------------------------------------------------------
data(dbEurofound)
head(dbEurofound)
## -----------------------------------------------------------------------------
names(dbEurofound)
## -----------------------------------------------------------------------------
c(min(dbEurofound$time), max(dbEurofound$time))
## -----------------------------------------------------------------------------
data(dbEUF2018meta)
print(dbEUF2018meta,n=20,width=100)
## -----------------------------------------------------------------------------
convergEU_glb()$EU12$memberStates$codeMS
## -----------------------------------------------------------------------------
myTB <- extract_indicator_EUF(
indicator_code = "lifesatisf", #Code_in_database
fromTime=2003,
toTime=2016,
gender= c("Total","Females","Males")[2],
countries= convergEU_glb()$EU12$memberStates$codeMS
)
myTB
## -----------------------------------------------------------------------------
print(dbEUF2018meta,n=20,width=100)
names(convergEU_glb())
myTB <- extract_indicator_EUF(
indicator_code = "JQIintensity_i", #Code_in_database
fromTime= 1965,
toTime=2016,
gender= c("Total","Females","Males")[1],
countries= convergEU_glb()$EU27_2020$memberStates$codeMS
)
print(myTB$res,n=35,width=250)
## ----out.width="100%"---------------------------------------------------------
myTBinp <- impute_dataset(myTB$res, timeName = "time",
countries=convergEU_glb()$EU27_2020$memberStates$codeMS,
tailMiss = c("cut", "constant")[2],
headMiss = c("cut", "constant")[2])
print(myTBinp$res,n=35,width=250)
## -----------------------------------------------------------------------------
check_data(emp_20_64_MS)
## -----------------------------------------------------------------------------
tmp <- emp_20_64_MS
tmp <- mutate(tmp, time=factor(emp_20_64_MS$time))
check_data(tmp)
## -----------------------------------------------------------------------------
tmp <- emp_20_64_MS
tmp[3:6,1]<- NA
check_data(tmp)
## -----------------------------------------------------------------------------
myTB <- extract_indicator_EUF(
indicator_code = "exposdiscr_p", #Code_in_database
fromTime=1966,
toTime=2016,
gender= c("Total","Females","Males")[1],
countries= convergEU_glb()$EU12$memberStates$codeMS
)
## -----------------------------------------------------------------------------
sapply(myTB$res,function(vx)sum(is.na(vx)))
## -----------------------------------------------------------------------------
set.seed(1999)
myTB2 <- dplyr::bind_rows(myTB$res,myTB$res,myTB$res)
myTB2 <- dplyr::mutate(myTB2, time= seq(1975,2015,5))
for(aux in 3:14){
myTB2[[aux]] <- myTB2[[aux]] + c(runif(6,-2.5,2.5),0,0,0)
}
## -----------------------------------------------------------------------------
myTB2[["BE"]][1:2] <- NA
myTB2[["DE"]][8:9] <- NA
myTB2[["IT"]][c(3,4, 6,7,8)] <- NA
myTB2[["DK"]][6] <- NA
myTB2
## -----------------------------------------------------------------------------
toBeProcessed <- c( "IT","BE", "DE", "DK","UK")
# debug(impute_dataset)
impute_dataset(myTB2, countries=toBeProcessed,
timeName = "time",
tailMiss = c("cut", "constant")[1],
headMiss = c("cut", "constant")[1])
impute_dataset(myTB2, countries=toBeProcessed,
timeName = "time",
tailMiss = c("cut", "constant")[2],
headMiss = c("cut", "constant")[1])
## -----------------------------------------------------------------------------
#library(ggplot2)
#library(dplyr)
#library(tibble)
testTB <- tribble(
~time, ~countryA , ~countryB, ~countryC,
2000, 0.8, 2.7, 3.9,
2001, 1.2, 3.2, 4.2,
2002, 0.9, 2.9, 4.1,
2003, 1.3, 2.9, 4.0,
2004, 1.2, 3.1, 4.1,
2005, 1.2, 3.0, 4.0
)
res <- beta_conv(tavDes = testTB, time_0 = 2002, time_t = 2004,
all_within = TRUE,
timeName = "time")
res
## -----------------------------------------------------------------------------
res <- beta_conv(tavDes = testTB, time_0 = 2002, time_t = 2004,
all_within = FALSE,
timeName = "time")
res
## -----------------------------------------------------------------------------
testTB <- tribble(
~time, ~countryA , ~countryB, ~countryC,
2000, 0.8, 2.7, 3.9,
2001, 1.2, 3.2, 4.2,
2002, 0.9, 2.9, 4.1,
2003, 1.3, 2.9, 4.0,
2004, 1.2, 3.1, 4.1,
2005, 1.2, 3.0, 4.0
)
sigma_conv(testTB,timeName="time")
## -----------------------------------------------------------------------------
sigma_conv(testTB,timeName="time",time_0 = 2002,time_t = 2004)
sigma_conv(testTB,time_0 = 2002,time_t = 2004)
## -----------------------------------------------------------------------------
data(emp_20_64_MS)
mySTB <- sigma_conv(emp_20_64_MS)
mySTB
## -----------------------------------------------------------------------------
res <- departure_mean(oriTB = emp_20_64_MS, sigmaTB = mySTB$res)
names(res$res)
res$res$departures
## -----------------------------------------------------------------------------
res$res$squaredContrib
## -----------------------------------------------------------------------------
## sigma_conv(testTB,timeName="time",time_0 = 2002,time_t = 2004)
res$res$devianceContrib
## ----eval=T,fig.width=7,fig.height=9------------------------------------------
myGG <- graph_departure(res$res$departures,
timeName = "time",
displace = 0.25,
displaceh = 0.45,
dimeFontNum = 4,
myfont_scale = 1.35,
x_angle = 45,
color_rect = c("-1"='red1', "0"='gray80',"1"='lightskyblue1'),
axis_name_y = "Countries",
axis_name_x = "Time",
alpha_color = 0.9
)
myGG
## ----eval=T-------------------------------------------------------------------
#myWW1<- warnings()
myGG <- graph_departure(res$res$departures[1:10],
timeName = "time",
displace = 0.25,
displaceh = 0.45,
dimeFontNum = 4,
myfont_scale = 1.35,
x_angle = 45,
color_rect = c("-1"='red1', "0"='gray80',"1"='lightskyblue1'),
axis_name_y = "Countries",
axis_name_x = "Time",
alpha_color = 0.29
)
myGG
## -----------------------------------------------------------------------------
gamma_conv(emp_20_64_MS,2002,2016)
## -----------------------------------------------------------------------------
(timeCounTB <- testTB)
## -----------------------------------------------------------------------------
tmp <- c( 3, 6, 9, 1, 12)
rank(tmp)
## -----------------------------------------------------------------------------
# debug(gamma_conv)
(gamma_conv(timeCounTB,ref=2000,last=2005,timeName = "time"))
(gamma_conv(timeCounTB,ref=2000,last=2004,timeName = "time"))
(gamma_conv(timeCounTB,ref=2000,last=2003,timeName = "time"))
(gamma_conv(timeCounTB,ref=2000,last=2002,timeName = "time"))
(gamma_conv(timeCounTB,ref=2000,last=2001,timeName = "time"))
## -----------------------------------------------------------------------------
(gamma_conv(timeCounTB,ref=2001,last=2005,timeName = "time"))
(gamma_conv(timeCounTB,ref=2002,last=2004,timeName = "time"))
## -----------------------------------------------------------------------------
timeCounTB2 <- timeCounTB
timeCounTB2[2,2:4] <- timeCounTB[2,4:2]
timeCounTB2[4,2:4] <- timeCounTB[4,c(4,2,3)]
timeCounTB2
gamma_conv(timeCounTB2,last=2005,ref=2000, timeName = "time",printRanks = T)
## -----------------------------------------------------------------------------
timeCounTB3 <- cbind(timeCounTB[1],t(apply(timeCounTB,1,
function(vet)vet[sample(2:4,3)])))
timeCounTB3
(gamma_conv(timeCounTB3,last=2005,ref=2000, timeName = "time",printRanks = T))
## ----echo=FALSE,eval=FALSE----------------------------------------------------
#
# timeCounTB <- tribble(
# ~time, ~countryA , ~countryB, ~countryC,
# 0, 0.8, 2.7, 3.9,
# 1, 1.2, 3.2, 4.2,
# 2, 0.9, 2.9, 4.1,
# 3, 1.3, 2.9, 4.0,
# 4, 1.2, 3.1, 4.1,
# 5, 1.2, 3.0, 4.0
# )
# timeCounTB
## -----------------------------------------------------------------------------
delta_conv(timeCounTB)
## -----------------------------------------------------------------------------
data(emp_20_64_MS)
mySTB <- abso_change(emp_20_64_MS,
time_0 = 2005,
time_t = 2010,
all_within=TRUE,
timeName = "time")
names(mySTB$res)
## -----------------------------------------------------------------------------
mySTB$res$abso_change
## -----------------------------------------------------------------------------
round(mySTB$res$sum_abs_change,4)
## -----------------------------------------------------------------------------
round(mySTB$res$average_abs_change,4)
## -----------------------------------------------------------------------------
workDF <- extract_indicator_EUF(
indicator_code ="lifesatisf", #Code_in_database
fromTime=2000,
toTime =2018,
gender= c("Total","Females","Males")[1],
countries = convergEU_glb()$EU27_2020$memberStates$codeMS)
workDF
wDF <- workDF$res
## -----------------------------------------------------------------------------
check_data(select(wDF,-sex),timeName="time")
## -----------------------------------------------------------------------------
wDFI <- impute_dataset(select(wDF,-sex),
countries= names(select(wDF,-sex,-time)),
timeName = "time",
tailMiss = c("cut", "constant")[2],
headMiss = c("cut", "constant")[1])
## -----------------------------------------------------------------------------
check_data(wDFI$res,timeName="time")
## -----------------------------------------------------------------------------
wwTB <- (wDFI$res %>%
average_clust(timeName="time",cluster="EU27"))$res
wwTB$EU27
## -----------------------------------------------------------------------------
mini_EU <- min(wwTB$EU27)
maxi_EU <- max(wwTB$EU27)
qplot(time, EU27, data=wwTB,
ylim=c(mini_EU,maxi_EU))+geom_line(colour="navy blue")+
ylab("lifesatisf")
## -----------------------------------------------------------------------------
betaRes <- beta_conv(wDFI$res,time_0=2007, time_t=2011, all_within=FALSE)
betaRes
## ----out.width="100%"---------------------------------------------------------
mybetaplot<-beta_conv_graph(betaRes,
indiName = 'Mean Life Satisfaction',
time_0 = 2007,
time_t = 2011)
mybetaplot
## -----------------------------------------------------------------------------
mysigmares<-sigma_conv(wwTB)
#mysigmares
## ----fig.width=5,fig.height=4,out.width="65%"---------------------------------
mysigmaplot<-sigma_conv_graph(sigmaconvOut=mysigmares,
time_0 = 2007,
time_t = 2011,
aggregation='EU27_2020')
mysigmaplot
## -----------------------------------------------------------------------------
workDF <- extract_indicator_EUF(
indicator_code ="lifesatisf", #Code_in_database
fromTime=2000,
toTime =2018,
gender= c("Total","Females","Males")[1],
countries = convergEU_glb()$EU27_2020$memberStates$codeMS)
wDFI <- impute_dataset(select(workDF$res,-sex),
countries= names(select(wDF,-sex,-time)),
timeName = "time",
tailMiss = c("cut", "constant")[2],
headMiss = c("cut", "constant")[1])
check_data(wDFI$res,timeName="time")
## -----------------------------------------------------------------------------
gamma_conv(wDFI$res,ref=2003,last=2016,timeName = "time")
## -----------------------------------------------------------------------------
tmpRes <- gamma_conv(wDFI$res,ref=2007,last=2011,timeName = "time")
## -----------------------------------------------------------------------------
wDFI$res
## -----------------------------------------------------------------------------
gamma_conv_msteps(wDFI$res,
startTime=2003,
endTime=2016,
timeName = "time")
## -----------------------------------------------------------------------------
delta_conv(wwTB)
## -----------------------------------------------------------------------------
delta_conv(wwTB,"time", extended=TRUE)
## -----------------------------------------------------------------------------
res1<-demea_change(wwTB,
timeName="time",
time_0 = 2003,
time_t = 2016,
sele_countries= NA,
doplot=TRUE)
res1
## ----fig.width = 6,out.width="100%"-------------------------------------------
plot(res1$res$res_graph)
## -----------------------------------------------------------------------------
convergEU_glb()$Eurozone
## -----------------------------------------------------------------------------
convergEU_glb()$EU27_2020
## -----------------------------------------------------------------------------
testTB <- emp_20_64_MS
average_clust(testTB,timeName = "time",cluster = "EU27")$res[,c(1,30)]
## -----------------------------------------------------------------------------
average_clust(testTB,timeName = "time",cluster = "EU12")$res[,c(1,30)]
## -----------------------------------------------------------------------------
average_clust(testTB,timeName = "TTime",cluster = "EUspirit")
## ----out.width="65%"----------------------------------------------------------
intervalTime <- c(1999,2000,2001)
intervalMeasure <- c( 66.5, NA,87.2)
currentData <- tibble(time= intervalTime, veval= intervalMeasure)
currentData
resImputed <- impute_dataset(currentData,
countries = "veval",
timeName = "time",
tailMiss = c("cut", "constant")[2],
headMiss = c("cut", "constant")[2])
resImputed
## ----echo=FALSE,out.width="65%"-----------------------------------------------
tmp <- as.data.frame(currentData[ c(1,3),] )
tmp2 <- as.data.frame(resImputed$res[2,] )
myg <- ggplot(as.data.frame(resImputed$res), mapping=aes(x=time,y=veval)) +
geom_point() +
geom_line(data=resImputed$res,col="red") +
geom_point(data=tmp,mapping=aes(x=time,y=veval),
size=4,
colour="blue") +
geom_point(data= tmp2,
aes(x=time,y=veval),size=4,alpha=1/3,col="black") +
xlab("Time") + ylab("Measure / Index") +
ggtitle( "Blue points are observed values (grey ones are missing) \n")
myg
## -----------------------------------------------------------------------------
intervalTime <- c(1999,2000,2001,2002,2003)
intervalMeasure <- c( 66.5, NA,NA,NA,87.2)
currentData <- tibble(time= intervalTime, veval= intervalMeasure)
currentData
resImputed <- impute_dataset(currentData,
countries = "veval",
timeName = "time",
tailMiss = c("cut", "constant")[2],
headMiss = c("cut", "constant")[2])
tmp <- as.data.frame(currentData[ c(1,5),] )
tmp2 <- as.data.frame(resImputed$res[2:4,] )
resImputed
## ----echo=FALSE,out.width="65%"-----------------------------------------------
myg <- ggplot(as.data.frame(resImputed$res), mapping=aes(x=time,y=veval)) +
geom_point() +
geom_line(data=resImputed$res,col="red") +
geom_point(data=tmp,mapping=aes(x=time,y=veval),
size=4,
colour="blue") +
geom_point(data= tmp2,
aes(x=time,y=veval),size=4,alpha=1/3,col="black") +
xlab("Time") + ylab("Measure / Index") +
ggtitle( "Blue points are observed values (grey ones are missing) \n")
myg
## -----------------------------------------------------------------------------
workTB <- dplyr::select(emp_20_64_MS, time, IT,DE)
check_data(workTB)
## -----------------------------------------------------------------------------
resSM <- smoo_dataset(select(workTB,-time), leadW = 0.149, timeTB= select(workTB,time))
resSM
## -----------------------------------------------------------------------------
tmpSM <- dplyr::rename(dplyr::select(resSM,-time),IT1=IT,DE1=DE)
compaTB <- dplyr::select(bind_cols(workTB, tmpSM), time,IT,IT1,DE,DE1)
compaTB
## ----out.width="70%"----------------------------------------------------------
qplot(time,IT,data=compaTB) +
geom_line(colour="navyblue") +
geom_line(aes(x=time,y=IT1),colour="red") +
geom_point(aes(x=time,y=IT1),colour="red",shape=8)
## ----out.width="70%"----------------------------------------------------------
qplot(time,DE,data=compaTB) +
geom_line(colour="navyblue") +
geom_line(aes(x=time,y=DE1),colour="red") +
geom_point(aes(x=time,y=DE1),colour="red",shape=8)
## ----out.width="70%"----------------------------------------------------------
resSM <- smoo_dataset(dplyr::select(workTB,-time), leadW = 1,
timeTB= dplyr::select(workTB,time))
resSM <- dplyr::rename(resSM,IT1=IT, DE1=DE)
compaTB <- dplyr::select(dplyr::bind_cols(workTB,
dplyr::select(resSM,-time)), time,IT,IT1,DE,DE1)
qplot(time,IT,data=compaTB) +
geom_line(colour="navyblue") +
geom_line(aes(x=time,y=IT1),colour="red") +
geom_point(aes(x=time,y=IT1),colour="red",shape=8)
## -----------------------------------------------------------------------------
data(emp_20_64_MS)
cuTB <- dplyr::tibble(ITori =emp_20_64_MS$IT)
cuTB <- dplyr::mutate(cuTB,time =emp_20_64_MS$time)
## -----------------------------------------------------------------------------
cuTB <- dplyr:: mutate(cuTB, IT_k_3= caTools::runmean(emp_20_64_MS$IT, k=3,
alg=c("C", "R", "fast", "exact")[4],
endrule=c("mean", "NA", "trim", "keep", "constant", "func")[4],
align = c("center", "left", "right")[1]))
cuTB <- dplyr:: mutate(cuTB, IT_k_5= caTools::runmean(emp_20_64_MS$IT, k=5,
alg=c("C", "R", "fast", "exact")[4],
endrule=c("mean", "NA", "trim", "keep", "constant", "func")[4],
align = c("center", "left", "right")[1]))
cuTB <- dplyr:: mutate(cuTB, IT_k_7= caTools::runmean(emp_20_64_MS$IT, k=7,
alg=c("C", "R", "fast", "exact")[4],
endrule=c("mean", "NA", "trim", "keep", "constant", "func")[4],
align = c("center", "left", "right")[1]))
## -----------------------------------------------------------------------------
myG <- ggplot(cuTB,aes(x=time,y=ITori))+geom_line()+geom_point()+
geom_line(aes(x=time,y=IT_k_3),colour="red")+
geom_point(aes(x=time,y=IT_k_3),colour="red")+
#
geom_line(aes(x=time,y=IT_k_5),colour="blue")+
geom_point(aes(x=time,y=IT_k_5),colour="blue")+
#
geom_line(aes(x=time,y=IT_k_7),colour="orange")+
geom_point(aes(x=time,y=IT_k_7),colour="orange")+
theme(legend.position = c(.5, .5),
legend.title = element_text(face = "bold"))
myG
## -----------------------------------------------------------------------------
cuTB <- dplyr::mutate(cuTB, DEori =emp_20_64_MS$DE)
cuTB <- dplyr:: mutate(cuTB, DE_k_3= runmean(emp_20_64_MS$DE, k=3,
alg=c("C", "R", "fast", "exact")[4],
endrule=c("mean", "NA", "trim", "keep", "constant", "func")[4],
align = c("center", "left", "right")[1]))
cuTB <- dplyr:: mutate(cuTB, DE_k_5= runmean(emp_20_64_MS$DE, k=5,
alg=c("C", "R", "fast", "exact")[4],
endrule=c("mean", "NA", "trim", "keep", "constant", "func")[4],
align = c("center", "left", "right")[1]))
cuTB <- dplyr:: mutate(cuTB, DE_k_7= runmean(emp_20_64_MS$DE, k=7,
alg=c("C", "R", "fast", "exact")[4],
endrule=c("mean", "NA", "trim", "keep", "constant", "func")[4],
align = c("center", "left", "right")[1]))
## -----------------------------------------------------------------------------
myG <- ggplot(cuTB,aes(x=time,y=DEori))+geom_line()+geom_point()+
geom_line(aes(x=time,y=DE_k_3),colour="red")+
geom_point(aes(x=time,y=DE_k_3),colour="red")+
#
geom_line(aes(x=time,y=DE_k_5),colour="blue")+
geom_point(aes(x=time,y=DE_k_5),colour="blue")+
#
geom_line(aes(x=time,y=DE_k_7),colour="orange")+
geom_point(aes(x=time,y=DE_k_7),colour="orange")+
theme(legend.position = c(.5, .5),
legend.title = element_text(face = "bold"))
myG
## -----------------------------------------------------------------------------
cuTB <- emp_20_64_MS[,c("time","IT","DE")]
ma_dataset(cuTB, kappa=3, timeName= "time")
## -----------------------------------------------------------------------------
data(emp_20_64_MS)
resTB <- scoreb_yrs(emp_20_64_MS,timeName = "time")
resTB
## -----------------------------------------------------------------------------
# library(ggplot2)
data(emp_20_64_MS)
selectedCountry <- "IT"
timeName <- "time"
myx_angle <- 45
outSig <- sigma_conv(emp_20_64_MS, timeName = timeName,
time_0=2002,time_t=2016)
miniY <- min(emp_20_64_MS[,- which(names(emp_20_64_MS) == timeName )])
maxiY <- max(emp_20_64_MS[,- which(names(emp_20_64_MS) == timeName )])
estrattore<- emp_20_64_MS[[timeName]] >= 2002 & emp_20_64_MS[[timeName]] <= 2016
ttmp <- cbind(outSig$res, dplyr::select(emp_20_64_MS[estrattore,], -contains(timeName)))
myG2 <-
ggplot(ttmp) + ggtitle(
paste("EU average (black, solid) and country",selectedCountry ," (red, dotted)") )+
geom_line(aes(x=ttmp[,timeName], y =ttmp[,"mean"]),colour="black") +
geom_point(aes(x=ttmp[,timeName],y =ttmp[,"mean"]),colour="black") +
# geom_line()+geom_point()+
ylim(c(miniY,maxiY)) + xlab("Year") +ylab("Indicator") +
theme(legend.position = "none")+
# add countries
geom_line( aes(x=ttmp[,timeName], y = ttmp[,"IT"],colour="red"),linetype="dotted") +
geom_point( aes(x=ttmp[,timeName], y = ttmp[,"IT"],colour="red")) +
ggplot2::scale_x_continuous(breaks = ttmp[,timeName],
labels = ttmp[,timeName]) +
ggplot2::theme(
axis.text.x=ggplot2::element_text(
#size = ggplot2::rel(myfont_scale ),
angle = myx_angle
#vjust = 1,
#hjust=1
))
myG2
## ----fig.height=11------------------------------------------------------------
obe_lvl <- scoreb_yrs(emp_20_64_MS,timeName = timeName)$res$sco_level_num
# select subset of time
estrattore <- obe_lvl[[timeName]] >= 2009 & obe_lvl[[timeName]] <= 2016
scobelvl <- obe_lvl[estrattore,]
my_MSstd <- ms_dynam( scobelvl,
timeName = "time",
displace = 0.25,
displaceh = 0.45,
dimeFontNum = 3,
myfont_scale = 1.35,
x_angle = 45,
axis_name_y = "Countries",
axis_name_x = "Time",
alpha_color = 0.9
)
my_MSstd
## -----------------------------------------------------------------------------
setupConvergEU <- convergEU_glb()
names(setupConvergEU)
## -----------------------------------------------------------------------------
print(setupConvergEU$EUcodes,n=30)
print(setupConvergEU$Eurozone)
setupConvergEU$EU12
setupConvergEU$EU15
## -----------------------------------------------------------------------------
print(setupConvergEU$EU25$dates)
print(setupConvergEU$EU25$memberStates,n=30)
print(setupConvergEU$EU27$dates)
print(setupConvergEU$EU27$memberStates,n=30)
print(setupConvergEU$EU27_2020$dates)
print(setupConvergEU$EU27_2020$memberStates,n=30)
Try the convergEU package in your browser
Any scripts or data that you put into this service are public.
convergEU documentation built on May 29, 2024, 11:15 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
## ----setup, include = FALSE---------------------------------------------------
library(ggplot2)
library(dplyr)
library(tidyverse)
library(eurostat)
library(purrr)
library(tibble)
library(tidyr)
library(formattable)
library(kableExtra)
library(caTools)
library(convergEU)
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
fig.width = 7,
fig.height = 5
)
## ----eval=FALSE---------------------------------------------------------------
# data("emp_20_64_MS",package = "convergEU")
# head(emp_20_64_MS)
## ----eval=FALSE---------------------------------------------------------------
# data(package = "convergEU")
## ----eval=FALSE---------------------------------------------------------------
# help(emp_20_64_MS)
#
## -----------------------------------------------------------------------------
data(dbEurofound)
head(dbEurofound)
## -----------------------------------------------------------------------------
names(dbEurofound)
## -----------------------------------------------------------------------------
c(min(dbEurofound$time), max(dbEurofound$time))
## -----------------------------------------------------------------------------
data(dbEUF2018meta)
print(dbEUF2018meta,n=20,width=100)
## -----------------------------------------------------------------------------
convergEU_glb()$EU12$memberStates$codeMS
## -----------------------------------------------------------------------------
myTB <- extract_indicator_EUF(
indicator_code = "lifesatisf", #Code_in_database
fromTime=2003,
toTime=2016,
gender= c("Total","Females","Males")[2],
countries= convergEU_glb()$EU12$memberStates$codeMS
)
myTB
## -----------------------------------------------------------------------------
print(dbEUF2018meta,n=20,width=100)
names(convergEU_glb())
myTB <- extract_indicator_EUF(
indicator_code = "JQIintensity_i", #Code_in_database
fromTime= 1965,
toTime=2016,
gender= c("Total","Females","Males")[1],
countries= convergEU_glb()$EU27_2020$memberStates$codeMS
)
print(myTB$res,n=35,width=250)
## ----out.width="100%"---------------------------------------------------------
myTBinp <- impute_dataset(myTB$res, timeName = "time",
countries=convergEU_glb()$EU27_2020$memberStates$codeMS,
tailMiss = c("cut", "constant")[2],
headMiss = c("cut", "constant")[2])
print(myTBinp$res,n=35,width=250)
## -----------------------------------------------------------------------------
check_data(emp_20_64_MS)
## -----------------------------------------------------------------------------
tmp <- emp_20_64_MS
tmp <- mutate(tmp, time=factor(emp_20_64_MS$time))
check_data(tmp)
## -----------------------------------------------------------------------------
tmp <- emp_20_64_MS
tmp[3:6,1]<- NA
check_data(tmp)
## -----------------------------------------------------------------------------
myTB <- extract_indicator_EUF(
indicator_code = "exposdiscr_p", #Code_in_database
fromTime=1966,
toTime=2016,
gender= c("Total","Females","Males")[1],
countries= convergEU_glb()$EU12$memberStates$codeMS
)
## -----------------------------------------------------------------------------
sapply(myTB$res,function(vx)sum(is.na(vx)))
## -----------------------------------------------------------------------------
set.seed(1999)
myTB2 <- dplyr::bind_rows(myTB$res,myTB$res,myTB$res)
myTB2 <- dplyr::mutate(myTB2, time= seq(1975,2015,5))
for(aux in 3:14){
myTB2[[aux]] <- myTB2[[aux]] + c(runif(6,-2.5,2.5),0,0,0)
}
## -----------------------------------------------------------------------------
myTB2[["BE"]][1:2] <- NA
myTB2[["DE"]][8:9] <- NA
myTB2[["IT"]][c(3,4, 6,7,8)] <- NA
myTB2[["DK"]][6] <- NA
myTB2
## -----------------------------------------------------------------------------
toBeProcessed <- c( "IT","BE", "DE", "DK","UK")
# debug(impute_dataset)
impute_dataset(myTB2, countries=toBeProcessed,
timeName = "time",
tailMiss = c("cut", "constant")[1],
headMiss = c("cut", "constant")[1])
impute_dataset(myTB2, countries=toBeProcessed,
timeName = "time",
tailMiss = c("cut", "constant")[2],
headMiss = c("cut", "constant")[1])
## -----------------------------------------------------------------------------
#library(ggplot2)
#library(dplyr)
#library(tibble)
testTB <- tribble(
~time, ~countryA , ~countryB, ~countryC,
2000, 0.8, 2.7, 3.9,
2001, 1.2, 3.2, 4.2,
2002, 0.9, 2.9, 4.1,
2003, 1.3, 2.9, 4.0,
2004, 1.2, 3.1, 4.1,
2005, 1.2, 3.0, 4.0
)
res <- beta_conv(tavDes = testTB, time_0 = 2002, time_t = 2004,
all_within = TRUE,
timeName = "time")
res
## -----------------------------------------------------------------------------
res <- beta_conv(tavDes = testTB, time_0 = 2002, time_t = 2004,
all_within = FALSE,
timeName = "time")
res
## -----------------------------------------------------------------------------
testTB <- tribble(
~time, ~countryA , ~countryB, ~countryC,
2000, 0.8, 2.7, 3.9,
2001, 1.2, 3.2, 4.2,
2002, 0.9, 2.9, 4.1,
2003, 1.3, 2.9, 4.0,
2004, 1.2, 3.1, 4.1,
2005, 1.2, 3.0, 4.0
)
sigma_conv(testTB,timeName="time")
## -----------------------------------------------------------------------------
sigma_conv(testTB,timeName="time",time_0 = 2002,time_t = 2004)
sigma_conv(testTB,time_0 = 2002,time_t = 2004)
## -----------------------------------------------------------------------------
data(emp_20_64_MS)
mySTB <- sigma_conv(emp_20_64_MS)
mySTB
## -----------------------------------------------------------------------------
res <- departure_mean(oriTB = emp_20_64_MS, sigmaTB = mySTB$res)
names(res$res)
res$res$departures
## -----------------------------------------------------------------------------
res$res$squaredContrib
## -----------------------------------------------------------------------------
## sigma_conv(testTB,timeName="time",time_0 = 2002,time_t = 2004)
res$res$devianceContrib
## ----eval=T,fig.width=7,fig.height=9------------------------------------------
myGG <- graph_departure(res$res$departures,
timeName = "time",
displace = 0.25,
displaceh = 0.45,
dimeFontNum = 4,
myfont_scale = 1.35,
x_angle = 45,
color_rect = c("-1"='red1', "0"='gray80',"1"='lightskyblue1'),
axis_name_y = "Countries",
axis_name_x = "Time",
alpha_color = 0.9
)
myGG
## ----eval=T-------------------------------------------------------------------
#myWW1<- warnings()
myGG <- graph_departure(res$res$departures[1:10],
timeName = "time",
displace = 0.25,
displaceh = 0.45,
dimeFontNum = 4,
myfont_scale = 1.35,
x_angle = 45,
color_rect = c("-1"='red1', "0"='gray80',"1"='lightskyblue1'),
axis_name_y = "Countries",
axis_name_x = "Time",
alpha_color = 0.29
)
myGG
## -----------------------------------------------------------------------------
gamma_conv(emp_20_64_MS,2002,2016)
## -----------------------------------------------------------------------------
(timeCounTB <- testTB)
## -----------------------------------------------------------------------------
tmp <- c( 3, 6, 9, 1, 12)
rank(tmp)
## -----------------------------------------------------------------------------
# debug(gamma_conv)
(gamma_conv(timeCounTB,ref=2000,last=2005,timeName = "time"))
(gamma_conv(timeCounTB,ref=2000,last=2004,timeName = "time"))
(gamma_conv(timeCounTB,ref=2000,last=2003,timeName = "time"))
(gamma_conv(timeCounTB,ref=2000,last=2002,timeName = "time"))
(gamma_conv(timeCounTB,ref=2000,last=2001,timeName = "time"))
## -----------------------------------------------------------------------------
(gamma_conv(timeCounTB,ref=2001,last=2005,timeName = "time"))
(gamma_conv(timeCounTB,ref=2002,last=2004,timeName = "time"))
## -----------------------------------------------------------------------------
timeCounTB2 <- timeCounTB
timeCounTB2[2,2:4] <- timeCounTB[2,4:2]
timeCounTB2[4,2:4] <- timeCounTB[4,c(4,2,3)]
timeCounTB2
gamma_conv(timeCounTB2,last=2005,ref=2000, timeName = "time",printRanks = T)
## -----------------------------------------------------------------------------
timeCounTB3 <- cbind(timeCounTB[1],t(apply(timeCounTB,1,
function(vet)vet[sample(2:4,3)])))
timeCounTB3
(gamma_conv(timeCounTB3,last=2005,ref=2000, timeName = "time",printRanks = T))
## ----echo=FALSE,eval=FALSE----------------------------------------------------
#
# timeCounTB <- tribble(
# ~time, ~countryA , ~countryB, ~countryC,
# 0, 0.8, 2.7, 3.9,
# 1, 1.2, 3.2, 4.2,
# 2, 0.9, 2.9, 4.1,
# 3, 1.3, 2.9, 4.0,
# 4, 1.2, 3.1, 4.1,
# 5, 1.2, 3.0, 4.0
# )
# timeCounTB
## -----------------------------------------------------------------------------
delta_conv(timeCounTB)
## -----------------------------------------------------------------------------
data(emp_20_64_MS)
mySTB <- abso_change(emp_20_64_MS,
time_0 = 2005,
time_t = 2010,
all_within=TRUE,
timeName = "time")
names(mySTB$res)
## -----------------------------------------------------------------------------
mySTB$res$abso_change
## -----------------------------------------------------------------------------
round(mySTB$res$sum_abs_change,4)
## -----------------------------------------------------------------------------
round(mySTB$res$average_abs_change,4)
## -----------------------------------------------------------------------------
workDF <- extract_indicator_EUF(
indicator_code ="lifesatisf", #Code_in_database
fromTime=2000,
toTime =2018,
gender= c("Total","Females","Males")[1],
countries = convergEU_glb()$EU27_2020$memberStates$codeMS)
workDF
wDF <- workDF$res
## -----------------------------------------------------------------------------
check_data(select(wDF,-sex),timeName="time")
## -----------------------------------------------------------------------------
wDFI <- impute_dataset(select(wDF,-sex),
countries= names(select(wDF,-sex,-time)),
timeName = "time",
tailMiss = c("cut", "constant")[2],
headMiss = c("cut", "constant")[1])
## -----------------------------------------------------------------------------
check_data(wDFI$res,timeName="time")
## -----------------------------------------------------------------------------
wwTB <- (wDFI$res %>%
average_clust(timeName="time",cluster="EU27"))$res
wwTB$EU27
## -----------------------------------------------------------------------------
mini_EU <- min(wwTB$EU27)
maxi_EU <- max(wwTB$EU27)
qplot(time, EU27, data=wwTB,
ylim=c(mini_EU,maxi_EU))+geom_line(colour="navy blue")+
ylab("lifesatisf")
## -----------------------------------------------------------------------------
betaRes <- beta_conv(wDFI$res,time_0=2007, time_t=2011, all_within=FALSE)
betaRes
## ----out.width="100%"---------------------------------------------------------
mybetaplot<-beta_conv_graph(betaRes,
indiName = 'Mean Life Satisfaction',
time_0 = 2007,
time_t = 2011)
mybetaplot
## -----------------------------------------------------------------------------
mysigmares<-sigma_conv(wwTB)
#mysigmares
## ----fig.width=5,fig.height=4,out.width="65%"---------------------------------
mysigmaplot<-sigma_conv_graph(sigmaconvOut=mysigmares,
time_0 = 2007,
time_t = 2011,
aggregation='EU27_2020')
mysigmaplot
## -----------------------------------------------------------------------------
workDF <- extract_indicator_EUF(
indicator_code ="lifesatisf", #Code_in_database
fromTime=2000,
toTime =2018,
gender= c("Total","Females","Males")[1],
countries = convergEU_glb()$EU27_2020$memberStates$codeMS)
wDFI <- impute_dataset(select(workDF$res,-sex),
countries= names(select(wDF,-sex,-time)),
timeName = "time",
tailMiss = c("cut", "constant")[2],
headMiss = c("cut", "constant")[1])
check_data(wDFI$res,timeName="time")
## -----------------------------------------------------------------------------
gamma_conv(wDFI$res,ref=2003,last=2016,timeName = "time")
## -----------------------------------------------------------------------------
tmpRes <- gamma_conv(wDFI$res,ref=2007,last=2011,timeName = "time")
## -----------------------------------------------------------------------------
wDFI$res
## -----------------------------------------------------------------------------
gamma_conv_msteps(wDFI$res,
startTime=2003,
endTime=2016,
timeName = "time")
## -----------------------------------------------------------------------------
delta_conv(wwTB)
## -----------------------------------------------------------------------------
delta_conv(wwTB,"time", extended=TRUE)
## -----------------------------------------------------------------------------
res1<-demea_change(wwTB,
timeName="time",
time_0 = 2003,
time_t = 2016,
sele_countries= NA,
doplot=TRUE)
res1
## ----fig.width = 6,out.width="100%"-------------------------------------------
plot(res1$res$res_graph)
## -----------------------------------------------------------------------------
convergEU_glb()$Eurozone
## -----------------------------------------------------------------------------
convergEU_glb()$EU27_2020
## -----------------------------------------------------------------------------
testTB <- emp_20_64_MS
average_clust(testTB,timeName = "time",cluster = "EU27")$res[,c(1,30)]
## -----------------------------------------------------------------------------
average_clust(testTB,timeName = "time",cluster = "EU12")$res[,c(1,30)]
## -----------------------------------------------------------------------------
average_clust(testTB,timeName = "TTime",cluster = "EUspirit")
## ----out.width="65%"----------------------------------------------------------
intervalTime <- c(1999,2000,2001)
intervalMeasure <- c( 66.5, NA,87.2)
currentData <- tibble(time= intervalTime, veval= intervalMeasure)
currentData
resImputed <- impute_dataset(currentData,
countries = "veval",
timeName = "time",
tailMiss = c("cut", "constant")[2],
headMiss = c("cut", "constant")[2])
resImputed
## ----echo=FALSE,out.width="65%"-----------------------------------------------
tmp <- as.data.frame(currentData[ c(1,3),] )
tmp2 <- as.data.frame(resImputed$res[2,] )
myg <- ggplot(as.data.frame(resImputed$res), mapping=aes(x=time,y=veval)) +
geom_point() +
geom_line(data=resImputed$res,col="red") +
geom_point(data=tmp,mapping=aes(x=time,y=veval),
size=4,
colour="blue") +
geom_point(data= tmp2,
aes(x=time,y=veval),size=4,alpha=1/3,col="black") +
xlab("Time") + ylab("Measure / Index") +
ggtitle( "Blue points are observed values (grey ones are missing) \n")
myg
## -----------------------------------------------------------------------------
intervalTime <- c(1999,2000,2001,2002,2003)
intervalMeasure <- c( 66.5, NA,NA,NA,87.2)
currentData <- tibble(time= intervalTime, veval= intervalMeasure)
currentData
resImputed <- impute_dataset(currentData,
countries = "veval",
timeName = "time",
tailMiss = c("cut", "constant")[2],
headMiss = c("cut", "constant")[2])
tmp <- as.data.frame(currentData[ c(1,5),] )
tmp2 <- as.data.frame(resImputed$res[2:4,] )
resImputed
## ----echo=FALSE,out.width="65%"-----------------------------------------------
myg <- ggplot(as.data.frame(resImputed$res), mapping=aes(x=time,y=veval)) +
geom_point() +
geom_line(data=resImputed$res,col="red") +
geom_point(data=tmp,mapping=aes(x=time,y=veval),
size=4,
colour="blue") +
geom_point(data= tmp2,
aes(x=time,y=veval),size=4,alpha=1/3,col="black") +
xlab("Time") + ylab("Measure / Index") +
ggtitle( "Blue points are observed values (grey ones are missing) \n")
myg
## -----------------------------------------------------------------------------
workTB <- dplyr::select(emp_20_64_MS, time, IT,DE)
check_data(workTB)
## -----------------------------------------------------------------------------
resSM <- smoo_dataset(select(workTB,-time), leadW = 0.149, timeTB= select(workTB,time))
resSM
## -----------------------------------------------------------------------------
tmpSM <- dplyr::rename(dplyr::select(resSM,-time),IT1=IT,DE1=DE)
compaTB <- dplyr::select(bind_cols(workTB, tmpSM), time,IT,IT1,DE,DE1)
compaTB
## ----out.width="70%"----------------------------------------------------------
qplot(time,IT,data=compaTB) +
geom_line(colour="navyblue") +
geom_line(aes(x=time,y=IT1),colour="red") +
geom_point(aes(x=time,y=IT1),colour="red",shape=8)
## ----out.width="70%"----------------------------------------------------------
qplot(time,DE,data=compaTB) +
geom_line(colour="navyblue") +
geom_line(aes(x=time,y=DE1),colour="red") +
geom_point(aes(x=time,y=DE1),colour="red",shape=8)
## ----out.width="70%"----------------------------------------------------------
resSM <- smoo_dataset(dplyr::select(workTB,-time), leadW = 1,
timeTB= dplyr::select(workTB,time))
resSM <- dplyr::rename(resSM,IT1=IT, DE1=DE)
compaTB <- dplyr::select(dplyr::bind_cols(workTB,
dplyr::select(resSM,-time)), time,IT,IT1,DE,DE1)
qplot(time,IT,data=compaTB) +
geom_line(colour="navyblue") +
geom_line(aes(x=time,y=IT1),colour="red") +
geom_point(aes(x=time,y=IT1),colour="red",shape=8)
## -----------------------------------------------------------------------------
data(emp_20_64_MS)
cuTB <- dplyr::tibble(ITori =emp_20_64_MS$IT)
cuTB <- dplyr::mutate(cuTB,time =emp_20_64_MS$time)
## -----------------------------------------------------------------------------
cuTB <- dplyr:: mutate(cuTB, IT_k_3= caTools::runmean(emp_20_64_MS$IT, k=3,
alg=c("C", "R", "fast", "exact")[4],
endrule=c("mean", "NA", "trim", "keep", "constant", "func")[4],
align = c("center", "left", "right")[1]))
cuTB <- dplyr:: mutate(cuTB, IT_k_5= caTools::runmean(emp_20_64_MS$IT, k=5,
alg=c("C", "R", "fast", "exact")[4],
endrule=c("mean", "NA", "trim", "keep", "constant", "func")[4],
align = c("center", "left", "right")[1]))
cuTB <- dplyr:: mutate(cuTB, IT_k_7= caTools::runmean(emp_20_64_MS$IT, k=7,
alg=c("C", "R", "fast", "exact")[4],
endrule=c("mean", "NA", "trim", "keep", "constant", "func")[4],
align = c("center", "left", "right")[1]))
## -----------------------------------------------------------------------------
myG <- ggplot(cuTB,aes(x=time,y=ITori))+geom_line()+geom_point()+
geom_line(aes(x=time,y=IT_k_3),colour="red")+
geom_point(aes(x=time,y=IT_k_3),colour="red")+
#
geom_line(aes(x=time,y=IT_k_5),colour="blue")+
geom_point(aes(x=time,y=IT_k_5),colour="blue")+
#
geom_line(aes(x=time,y=IT_k_7),colour="orange")+
geom_point(aes(x=time,y=IT_k_7),colour="orange")+
theme(legend.position = c(.5, .5),
legend.title = element_text(face = "bold"))
myG
## -----------------------------------------------------------------------------
cuTB <- dplyr::mutate(cuTB, DEori =emp_20_64_MS$DE)
cuTB <- dplyr:: mutate(cuTB, DE_k_3= runmean(emp_20_64_MS$DE, k=3,
alg=c("C", "R", "fast", "exact")[4],
endrule=c("mean", "NA", "trim", "keep", "constant", "func")[4],
align = c("center", "left", "right")[1]))
cuTB <- dplyr:: mutate(cuTB, DE_k_5= runmean(emp_20_64_MS$DE, k=5,
alg=c("C", "R", "fast", "exact")[4],
endrule=c("mean", "NA", "trim", "keep", "constant", "func")[4],
align = c("center", "left", "right")[1]))
cuTB <- dplyr:: mutate(cuTB, DE_k_7= runmean(emp_20_64_MS$DE, k=7,
alg=c("C", "R", "fast", "exact")[4],
endrule=c("mean", "NA", "trim", "keep", "constant", "func")[4],
align = c("center", "left", "right")[1]))
## -----------------------------------------------------------------------------
myG <- ggplot(cuTB,aes(x=time,y=DEori))+geom_line()+geom_point()+
geom_line(aes(x=time,y=DE_k_3),colour="red")+
geom_point(aes(x=time,y=DE_k_3),colour="red")+
#
geom_line(aes(x=time,y=DE_k_5),colour="blue")+
geom_point(aes(x=time,y=DE_k_5),colour="blue")+
#
geom_line(aes(x=time,y=DE_k_7),colour="orange")+
geom_point(aes(x=time,y=DE_k_7),colour="orange")+
theme(legend.position = c(.5, .5),
legend.title = element_text(face = "bold"))
myG
## -----------------------------------------------------------------------------
cuTB <- emp_20_64_MS[,c("time","IT","DE")]
ma_dataset(cuTB, kappa=3, timeName= "time")
## -----------------------------------------------------------------------------
data(emp_20_64_MS)
resTB <- scoreb_yrs(emp_20_64_MS,timeName = "time")
resTB
## -----------------------------------------------------------------------------
# library(ggplot2)
data(emp_20_64_MS)
selectedCountry <- "IT"
timeName <- "time"
myx_angle <- 45
outSig <- sigma_conv(emp_20_64_MS, timeName = timeName,
time_0=2002,time_t=2016)
miniY <- min(emp_20_64_MS[,- which(names(emp_20_64_MS) == timeName )])
maxiY <- max(emp_20_64_MS[,- which(names(emp_20_64_MS) == timeName )])
estrattore<- emp_20_64_MS[[timeName]] >= 2002 & emp_20_64_MS[[timeName]] <= 2016
ttmp <- cbind(outSig$res, dplyr::select(emp_20_64_MS[estrattore,], -contains(timeName)))
myG2 <-
ggplot(ttmp) + ggtitle(
paste("EU average (black, solid) and country",selectedCountry ," (red, dotted)") )+
geom_line(aes(x=ttmp[,timeName], y =ttmp[,"mean"]),colour="black") +
geom_point(aes(x=ttmp[,timeName],y =ttmp[,"mean"]),colour="black") +
# geom_line()+geom_point()+
ylim(c(miniY,maxiY)) + xlab("Year") +ylab("Indicator") +
theme(legend.position = "none")+
# add countries
geom_line( aes(x=ttmp[,timeName], y = ttmp[,"IT"],colour="red"),linetype="dotted") +
geom_point( aes(x=ttmp[,timeName], y = ttmp[,"IT"],colour="red")) +
ggplot2::scale_x_continuous(breaks = ttmp[,timeName],
labels = ttmp[,timeName]) +
ggplot2::theme(
axis.text.x=ggplot2::element_text(
#size = ggplot2::rel(myfont_scale ),
angle = myx_angle
#vjust = 1,
#hjust=1
))
myG2
## ----fig.height=11------------------------------------------------------------
obe_lvl <- scoreb_yrs(emp_20_64_MS,timeName = timeName)$res$sco_level_num
# select subset of time
estrattore <- obe_lvl[[timeName]] >= 2009 & obe_lvl[[timeName]] <= 2016
scobelvl <- obe_lvl[estrattore,]
my_MSstd <- ms_dynam( scobelvl,
timeName = "time",
displace = 0.25,
displaceh = 0.45,
dimeFontNum = 3,
myfont_scale = 1.35,
x_angle = 45,
axis_name_y = "Countries",
axis_name_x = "Time",
alpha_color = 0.9
)
my_MSstd
## -----------------------------------------------------------------------------
setupConvergEU <- convergEU_glb()
names(setupConvergEU)
## -----------------------------------------------------------------------------
print(setupConvergEU$EUcodes,n=30)
print(setupConvergEU$Eurozone)
setupConvergEU$EU12
setupConvergEU$EU15
## -----------------------------------------------------------------------------
print(setupConvergEU$EU25$dates)
print(setupConvergEU$EU25$memberStates,n=30)
print(setupConvergEU$EU27$dates)
print(setupConvergEU$EU27$memberStates,n=30)
print(setupConvergEU$EU27_2020$dates)
print(setupConvergEU$EU27_2020$memberStates,n=30)
Try the convergEU package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.