Prognoos

Selgitavad tunnused

Eesti ettevõtjate detailsed hinnangud

Teiste riikide kindlustunde indikaatorid

Tarbijahinnaindeks

#Mudeli tegemine library(shiny) library(ggplot2) library(plotly) library(dplyr) library(reshape2) library(tidyr) library(lubridate) library(lettercase) library(readxl) library(XML) library(tibble) library(glmnet) #setwd("C:/Users/avork/Documents/CITIS/EMTA/Makroandmed/KIindikaatorid/kibaromeetrid/") # download.external.variables <- function() { # ######################################## # # 1. Konjunktuuriinstituudi lehelt Exceli failid, NB! Exceli ridade nimed erinevad eri failides # ######################################## # # #leht kus failidele lingid # url <- "http://www.ki.ee/baromeetrid/baromeetrid.htm" # doc <- htmlParse(url) # #otsime lehelt kõik lingid # links <- xpathSApply(doc, "//a/@href") # free(doc) # rm(doc) # # # Otsime linkidest kõik xls lõpuga failid # wanted <- links[grepl("*.xls", links)] # # # Jätame alles ainult need, mis meile huvi pakuvad # failialgused <- c("industry","ehitus","kaubandus","teenind", "majandus") # wanted <- wanted[sapply(failialgused, function(x) grep(x, wanted))] # # # Vaatame, mis xls failid juba kaustas olemas on. Neid, mis olemas, enam uuesti ei tõmba # failid_kaustas <- list.files(pattern = "xls") # files_to_download = wanted[!(wanted %in% failid_kaustas)] # GetMe = "" # # Laeme alla need failid, mida veel ei ole # if (length(files_to_download) > 0) { # GetMe <- paste("http://www.ki.ee/baromeetrid/", files_to_download, sep = "") # #Laeme alla # lapply(seq_along(GetMe), # function(x) download.file(GetMe[x], files_to_download[x], mode = "wb")) # } # # #Tarbijaküsitluse jaoks peab veel vaeva nägema # # failialgused <- c("industry","ehitus","kaubandus","teenind","majandus","tarbija") # # # #Loeme sisse soovitud Exceli failid # nimetused = data.frame(str_split_fixed(wanted, "_", n = 2), stringsAsFactors = F) # nimetused$end_date = as.Date(paste0(readr::parse_number(wanted),"01"), format = "%y%m%d") # # for (x in seq(1:length(wanted))) { # failinimi <- wanted[x] # nimetus = nimetused[x,1] # if (!(nimetus %in% failialgused)) {stop("Viga andmete sisselugemisel")} # temp_df <- read_excel(failinimi) # assign(nimetus, temp_df) # } # rm(temp_df) # # #Ükshaaval failide puhastamine # #jäta alles vajalikud read ja veerud alates 2003. aastast. # #NB! seda peab käsitsi kontrollima aeg-ajalt, et Konjunktuuriinstituut ei oleks muutnud veerge ega ridu # # #Ehituse fail # ehitus <- ehitus[c(2,4:15), c(1,44:ncol(ehitus))] # # #Tööstuse fail # industry <- industry[c(2:8,10:24), c(1,56:ncol(industry))] # # #Kaubanduse fail # kaubandus <- kaubandus[c(2:8), c(1,44:ncol(kaubandus))] # # #Teenindus # teenind <- teenind[c(2:7, 9:15), c(1,11:ncol(teenind))] # # #Majandus # majandus <- majandus[c(2:7), c(1,48:ncol(majandus))] # # #Tarbija - seda pole praegu vast vaja, nõuab palju käsitööd # # tarbija <- tarbija[c(2:7), c(1,48:ncol(tarbija))] # # # Tsükliga teisendame # #Veergudele õigete kuude nimede panemine # start = as.Date("2003-01-01") # # for (x in 1:nrow(nimetused)) { # data = get(nimetused[x,1]) # end = nimetused$end_date[x] # #paneme kuud veerunimedeks # colnames(data) <- c("indicator", seq.Date(start,end,"month")[1:(ncol(data) - 1)]) # #Keerame teistpidi # data = melt(data, id.vars = c("indicator")) # #Teeme kuupäeva # data$kpv <- as.Date(as.numeric(as.character(data$variable))) # data$value <- as.numeric(data$value) # data$variable <- NULL # #sektori nimi, kui on soov pärast kokku panna # data$sektor <- nimetused[x,1] # #Puhastame ja täpsutame näitajate nimesid # data$indicator <- gsub("[\n]","", data$indicator) # data$indicator <- gsub("[*]","", data$indicator) # data$indicator[is_lowercase(substr(data$indicator, 1,1))] <- paste0("Piirab praegu: ", data$indicator[is_lowercase(substr(data$indicator, 1,1))] ) # #Salvestame sama nime alla, mis on Konjunktuuriinstituudi failid # assign(nimetused[x,1],data) # } # # # save(industry, file = "industry.Rda") # # save(ehitus, file = "ehitus.Rda") # # save(kaubandus, file = "kaubandus.Rda") # # save(teenind, file = "teenind.Rda") # # save(majandus, file = "majandus.Rda") # #save(tarbija, file="tarbija.Rda") # # #kustutame üleliigsed asjad # rm(data, wanted, url, links, GetMe, failinimi, failid_kaustas) # # # # Osade tunnuste kohta koondfailide tegemine # # ehitus$indicator[ehitus$indicator =="Töötajate arv järgneva 3 kuu jooksul"]<-"emp3" # # industry$indicator[industry$indicator =="Töötajate arv järgneva 3 kuu jooksul"]<-"emp3" # # teenind$indicator[teenind$indicator =="Töötajate arv järgneva 3 kuu jooksul"]<-"emp3" # # kaubandus$indicator[kaubandus$indicator=="Töötajate arv 3 kuu pärast"]<-"emp3" # # # # ehitus$indicator[ehitus$indicator =="Ehitustööde hinnad järgneva 3 kuu jooksul"]<-"prices3" # # industry$indicator[industry$indicator =="Toodangu müügihinnad järgneva 3 kuu jooksul"]<-"prices3" # # teenind$indicator[teenind$indicator =="Teenuste hinnad järgneva 3 kuu jooksul"]<-"prices3" # # kaubandus$indicator[kaubandus$indicator=="Kaupade hinnad järgneva 3 kuu jooksul"]<-"prices3" # # # # ki <- rbind(ehitus, industry, kaubandus, teenind) # ki$indicator[ki$sektor=="ehitus"] <- paste0("Ehitus - ", ki$indicator[ki$sektor=="ehitus"]) # ki$indicator[ki$sektor=="teenind"] <- paste0("Teenindus - ", ki$indicator[ki$sektor=="teenind"]) # #ki$indicator[ki$sektor=="majandus"] <- paste0("Kogu majandus - ", ki$indicator[ki$sektor=="majandus"]) # ki$indicator[ki$sektor=="kaubandus"] <- paste0("Kaubandus - ", ki$indicator[ki$sektor=="kaubandus"]) # ki$indicator[ki$sektor=="industry"] <- paste0("Tööstus - ", ki$indicator[ki$sektor=="industry"]) # # save(ki,file = "ki.Rda") # # ######################################################## # # 2. Eurostatist Eesti ja EU majanduse usaldusindikaatorite toomine; # # Praegu olemas EU28 ja EA19 # ######################################################## # # euconfind <- get_eurostat("ei_bssi_m_r2", filters = list(geo = c("EE", "EU28", "SE", "FI", "LT", "LV")), stringsAsFactors = FALSE) # #Year and month for merge # euconfind$kpv <- euconfind$time # #kustuta puuduvad väärtused # euconfind <- euconfind[!is.na(euconfind$values),] # #Sobivamad nimed # euconfind$indica <- NA # euconfind$indica[euconfind$indic == "BS-CCI-BAL"] <- "Construction" # euconfind$indica[euconfind$indic == "BS-CSMCI-BAL"] <- "Consumer" # euconfind$indica[euconfind$indic == "BS-ICI-BAL"] <- "Industry" # euconfind$indica[euconfind$indic == "BS-RCI-BAL"] <- "Retail" # euconfind$indica[euconfind$indic == "BS-SCI-BAL"] <- "Service" # euconfind$indica[euconfind$indic == "BS-ESI-I"] <- "Economy" # #euconfind$indicator <- paste0(euconfind$indica,"_", euconfind$s_adj) # # #Jätame alles vaatlused alates 2003 # euconfind <- euconfind %>% dplyr::filter(year(kpv)>=2003) # # #Final table for merge # #euconfind <- dcast(euconfind, kpv ~ indicator+geo , value.var = "values") # save(euconfind, file = "euconfind.Rda") # # # #Võib kaaluda veel teiste riikide - Soome, Rootsi, Läti ja Leedu indikaatorite sissetoomist # # # ######################################################## # # 3. Eurostatist Eesti ja EU harmoniseeritud hinnaindeks # # # ######################################################## # # Indeces for Estonia and EU28, 2005=100, COICOP=CP00 or all-items HICP # euprices <- get_eurostat("prc_hicp_midx", filters = list(geo = c("EE", "EU28", "SE", "FI", "LT", "LV"), coicop=c("CP00"), unit=c("I05")), stringsAsFactors = FALSE) # #Year and month for merge # euprices$kpv <- euprices$time # #kustuta puuduvad väärtused # euprices <- euprices[!is.na(euprices$values),] # #Sobivamad nimed # #Jätame alles vaatlused alates 2003 # euprices$hicp <- euprices$values # euprices <- euprices %>% dplyr::filter(year(kpv)>=2003) %>% dplyr::select(geo, hicp, kpv) # # euprices <- euprices %>% group_by(geo) %>% # dplyr::mutate(d1hicp=(hicp/lag(hicp,1)-1)*100, d12hicp=(hicp/lag(hicp,12)-1)*100) %>% # ungroup() # # #Final table for merge # # euprices <- dcast(euprices, kpv ~ geo , value.var = "hicp") # # colnames(euprices) <- c("kpv", "hicp_EE", "hicp_EU") # save(euprices, file = "euprices.Rda") # # # # # # ################################# # # #Tulevikus võib kaaluda Google trendsi andmete sisse toomist # # ################################# # # # # # # # Andmete ühendamine ------------------------------------------------------ # # external_data <- merge(ki, euconfind, by="kpv", all=TRUE) # # external_data <- merge(external_data, euprices, by="kpv", all=TRUE) # # save(external_data, file = "external_data.Rda") # # return(external_data) # } #start=as.Date("2003-01-01", origin) #end=as.Date("2017-12-31", origin) load("data/ki.Rda") ki <- ki %>% select(indicator, value, kpv) load("data/euconfind.Rda") euconfind <- euconfind %>% select(s_adj, geo, kpv, values, indica) load("data/euprices.Rda") euprices <- euprices %>% select(geo, kpv, d1hicp, d12hicp) load("data/KMD.Rda") KMD$kpv <- as.Date(paste0(KMD$aasta, "-", KMD$kuu, "-01")) ui <- fluidPage( #h2("CITISe prognoosimudel"), h2("Testversioon"), sidebarLayout( sidebarPanel( h3("Prognoositav"), selectInput("sektor", label="Vali sektor", unique(KMD$tekst), selected = "Hoonete ehitus",multiple = F), selectInput("target", label="Vali prognoositav tunnus", colnames(KMD), selected = "Maksustatavkaive",multiple = F), sliderInput("h_int","Prognoosi pikkus kuudes", min = 1,max = 12, value = 6, step = 1), #selectInput("kifail", label=h3("Vali Eesti ettevõtjate detailsed hinnangud"), unique(ki$indicator), selected ="",multiple = T), h3("Valitud selgitavad tegurid"), h4("Eesti ettevõtjate detailsed hinnangud"), selectInput("kifail", label="Vali indikaator", unique(ki$indicator), selected = c(unique(ki$indicator)[1]),multiple = T), #actionButton("puhasta", "Puhasta joonis"), #actionButton("valised_tunnused", "Uuenda KI andmed kodulehelt") h4("Teiste riikide kindlustunde indikaatorid"), checkboxGroupInput("riigid", "Vali riigid", #choices = list(unique(euconfind$geo)), choices = unique(euconfind$geo), selected = c("EE", "EU28")), checkboxGroupInput("sector", "Vali sektorid", choices = unique(euconfind$indica), selected = "Construction"), radioButtons("sa", "Vali sesoonsus", choices = list("Sesoonselt kohandatud" = "SA", "Sesoonselt kohandamata" = "NSA"), selected = "SA"), h4("Tarbijahinnaindeks"), checkboxGroupInput("riigidhcpi", "Vali riigid", choices = unique(euprices$geo), selected = c("EE", "EU28")) #end sidebarPanel ), mainPanel( #plotlyOutput("joonis1") h3("Prognoos"), plotOutput("joonislasso"), plotOutput("joonisarima"), h3("Selgitavad tunnused"), h4("Eesti ettevõtjate detailsed hinnangud"), plotOutput("joonis1"), #plotOutput("kijoonis",height = "400px"), #plotOutput("targetjoonis",height = "400px"), #DT::dataTableOutput('mudeliandmetetabel') hr(), h4("Teiste riikide kindlustunde indikaatorid"), plotOutput("joonis2"), hr(), h4("Tarbijahinnaindeks"), plotOutput("joonis3"), plotOutput("joonis4") #h3("Prognoositav suurus"), #plotOutput("joonis5"), #h3("Andmetabel mudelisse"), #dataTableOutput("mudeliandmedtabel") ) #end sidebarLayout ) #end ui ) # Define server server <- function(input, output, session) { # observeEvent(input$valised_tunnused, { # downloadX <- download.external.variables() # }) kidf = reactive({ df <- ki %>% filter(indicator %in% input$kifail) %>% select(kpv, indicator, value) return(df) }) output$joonis1 = renderPlot({ ggplot(kidf(), aes(x=kpv, y=value, color=indicator)) + geom_line(data=kidf()[!is.na(kidf()$value),]) + #geom_point() + scale_x_date(date_breaks = "1 year" ,date_labels = "%Y") + labs(y="Indikaatori väärtused", x="", color="Indikaator", title="Eesti ettevõtete hinnangud", subtitle="Kojunktuuriinstituudi andmed", caption=paste0("http://www.ki.ee/baromeetrid/baromeetrid.htm, ",Sys.Date())) }) #Riikide võrdlev joonis euconf = reactive({ dfeu <- euconfind %>% filter((geo %in% input$riigid) & (s_adj %in% input$sa) & (indica %in% input$sector)) %>% select(kpv, indica, values, geo, s_adj) return(dfeu) }) output$joonis2 = renderPlot({ ggplot(euconf(), aes(x=kpv, y=values, color=geo)) + geom_line() + #geom_point() + scale_x_date(date_breaks = "1 year" ,date_labels = "%Y") + facet_wrap(~ indica, scales = "free")+ labs(y="Indikaatori väärtused", x="", color="Riik", title="Ettevõtete kindlustunde indikaatorid sektorite ja majanduste lõikes", subtitle="", caption=paste0("Allikas: Eurostat, ", Sys.Date())) }) euprice = reactive({ dfeu2 <- euprices %>% filter(geo %in% input$riigidhcpi) %>% select(geo, kpv, d1hicp, d12hicp) return(dfeu2) }) output$joonis3 = renderPlot({ ggplot(euprice(), aes(x=kpv, y=d1hicp, color=geo)) + geom_line() + #geom_point() + scale_x_date(date_breaks = "1 year" ,date_labels = "%Y") + labs(y="Harmoniseeritud hinnaindeks", x="", color="Riik", title="Hindade muutus võrreldes eelmise kuuga", subtitle="", caption=paste0("Allikas: Eurostat, ", Sys.Date())) }) output$joonis4 = renderPlot({ ggplot(euprice(), aes(x=kpv, y=d12hicp, color=geo)) + geom_line() + #geom_point() + scale_x_date(date_breaks = "1 year" ,date_labels = "%Y") + labs(y="Harmoniseeritud hinnaindeks", x="", color="Riik", title="Hindade muutus võrreldes eelmise aasta sama kuuga", subtitle="", caption=paste0("Allikas: Eurostat, ", Sys.Date())) }) targetandmed = reactive({ dftarget <- KMD %>% filter(tekst %in% input$sektor) %>% mutate(y=get(input$target)) %>% select(kpv, y) return(dftarget) }) output$joonis5 = renderPlot({ ggplot(targetandmed(), aes(x=kpv, y=y)) + geom_line() + #geom_point() + scale_x_date(date_breaks = "1 year" ,date_labels = "%Y") + labs(y="Eur", x="", title=input$sektor, subtitle=input$target, caption=paste0("Allikas: EMTA agregeeritud andmed")) }) h_int = reactive({ input$h_int }) mudeliandmed = reactive({ kidf <- dcast(kidf(), kpv~ indicator, value.var="value") #selgitavatele teguritele KI failis lühen nimi colnames(kidf)=c("kpv", LETTERS[1:(ncol(kidf)-1)]) euconf <- dcast(euconf(), kpv~ geo+indica, value.var="values") euprice <- melt(euprice(), id.vars=c("geo", "kpv")) euprice <- dcast(euprice, kpv ~ geo + variable, value.var="value") dfmudel <- merge(targetandmed(), kidf, by="kpv", all=TRUE) dfmudel <- merge(dfmudel, euconf , by="kpv", all=TRUE) dfmudel <- merge(dfmudel, euprice , by="kpv", all=TRUE) #colnames(dfmudel)[colnames(dfmudel) == "y"] =input$target dfmudel <- dfmudel[year(dfmudel$kpv)>2005,] start = as.Date(max(dfmudel$kpv+months(1))) end=as.Date(max(dfmudel$kpv+months(h_int()))) #library(tibble) dfmudel <- add_row(as_tibble(dfmudel), kpv=seq.Date(start,end,"month")[1:h_int()]) dfmudel <- as.data.frame(dfmudel) dfmudel$y_hint <- lead(dfmudel$y, h_int()) indeksid <- which(complete.cases(dfmudel)) LASSO_0 <- cv.glmnet(x = as.matrix(dfmudel[indeksid,!(colnames(dfmudel) %in% c("kpv","y","y_hint"))]), y = dfmudel$y_hint[indeksid], standardize = TRUE, grouped = FALSE, parallel = FALSE,alpha = 1) LASSO <- glmnet(x = as.matrix(dfmudel[indeksid,!(colnames(dfmudel) %in% c("kpv","y","y_hint"))]), y = dfmudel$y_hint[indeksid], standardize = TRUE, lambda = LASSO_0$lambda.1se,alpha = 1) dfmudel$lassohat_hint <- predict(LASSO,newx = as.matrix(dfmudel[,!(colnames(dfmudel) %in% c("kpv","y","y_hint"))])) dfmudel$kpvhint <-lead(dfmudel$kpv, h_int()) return(dfmudel) }) myarima = reactive({ y_hint.ts <- ts(mudeliandmed()$y_hint, start = c(year(min(mudeliandmed()$kpv)), month(min(mudeliandmed()$kpv))), frequency = 12) library(stats) myarima <- arima(y_hint.ts,order = c(1,0,1),seasonal = list(order = c(1,1,0),period = 12),method = "ML") #ARIMA <- auto.arima(y_hint.ts, max.p = 6, max.q = 0, max.P = 1, max.Q = 0) library(forecast) #dfmudel$arima_hint=forecast(myarima,h = h_int)$mean #arima_hint=forecast(myarima,h = h_int)$mean #arima_hint=forecast(myarima,h = h_int()) arima_hint=predict(myarima,h = h_int()) return(arima_hint) #dfmudel$arima_hint <-arima_hint }) output$joonislasso = renderPlot({ ggplot(mudeliandmed(), aes(x=kpvhint, y=y_hint)) + geom_line(aes(colour="Tegelik")) + geom_line(aes(y=lassohat_hint, colour="Prognoos")) + scale_x_date(date_breaks = "1 year" ,date_labels = "%Y") + labs(colour="Näitaja", x="", y="EUR", title=paste0("Sektor: ", input$sektor, " Näitaja: ", input$target), subtitle="Prognoos LASSO meetodil") }) output$joonisarima = renderPlot({ # ggplot(mudeliandmed(), aes(x=kpvhint, y=y_hint)) + # geom_line(aes(colour="Tegelik")) + # geom_line(aes(y=myarima(), colour="Prognoos, ARIMA")) + # scale_x_date(date_breaks = "1 year" ,date_labels = "%Y") + # labs(colour="Näitaja", x="", y="EUR", title=paste0("Sektor: ", input$sektor, " Näitaja: ", input$target), subtitle="Prognoos LASSO meetodil") plot(myarima()) }) # output$mudeliandmedtabel <- renderDataTable({ # mudeliandmed() # }) # mudel = reactive({ # # # }) #end of server } # Run the application shinyApp(ui = ui, server = server)