Projeto RMarkdown

Centro Universitário Celso Lisboa

Aula de Algoritmos e Estrutura de Dados - Engenharia Civil 4° Período

Professor Adriano

Maria Eduarda Barbosa, Fernanda Asevedo e Yuri Monteiro

Rio de Janeiro, em 31 de outubro de 2024

1° Passo: Carregar as bibliotecas

library(dplyr) 
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(readr) 
library(readxl) 
library(writexl)
library(openxlsx) 
library(lubridate)
## 
## Attaching package: 'lubridate'
## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union
library(ggplot2) 
library(zoo) 
## 
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
library(data.table) 
## 
## Attaching package: 'data.table'
## The following objects are masked from 'package:zoo':
## 
##     yearmon, yearqtr
## The following objects are masked from 'package:lubridate':
## 
##     hour, isoweek, mday, minute, month, quarter, second, wday, week,
##     yday, year
## The following objects are masked from 'package:dplyr':
## 
##     between, first, last
library(dplyr)
library(neuralnet) 
## 
## Attaching package: 'neuralnet'
## The following object is masked from 'package:dplyr':
## 
##     compute
library(quantmod)
## Loading required package: xts
## 
## ######################### Warning from 'xts' package ##########################
## #                                                                             #
## # The dplyr lag() function breaks how base R's lag() function is supposed to  #
## # work, which breaks lag(my_xts). Calls to lag(my_xts) that you type or       #
## # source() into this session won't work correctly.                            #
## #                                                                             #
## # Use stats::lag() to make sure you're not using dplyr::lag(), or you can add #
## # conflictRules('dplyr', exclude = 'lag') to your .Rprofile to stop           #
## # dplyr from breaking base R's lag() function.                                #
## #                                                                             #
## # Code in packages is not affected. It's protected by R's namespace mechanism #
## # Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning.  #
## #                                                                             #
## ###############################################################################
## 
## Attaching package: 'xts'
## The following objects are masked from 'package:data.table':
## 
##     first, last
## The following objects are masked from 'package:dplyr':
## 
##     first, last
## Loading required package: TTR
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo
library(fpp) 
## Loading required package: forecast
## Loading required package: fma
## Loading required package: expsmooth
## Loading required package: lmtest
## Loading required package: tseries
library(fpp3) 
## Registered S3 method overwritten by 'tsibble':
##   method               from 
##   as_tibble.grouped_df dplyr
## ── Attaching packages ──────────────────────────────────────────── fpp3 1.0.1 ──
## ✔ tibble      3.2.1     ✔ tsibbledata 0.4.1
## ✔ tidyr       1.3.1     ✔ feasts      0.4.1
## ✔ tsibble     1.1.5     ✔ fable       0.4.1
## ── Conflicts ───────────────────────────────────────────────── fpp3_conflicts ──
## ✖ data.table::between() masks dplyr::between()
## ✖ neuralnet::compute()  masks dplyr::compute()
## ✖ lubridate::date()     masks base::date()
## ✖ dplyr::filter()       masks stats::filter()
## ✖ xts::first()          masks data.table::first(), dplyr::first()
## ✖ data.table::hour()    masks lubridate::hour()
## ✖ tsibble::index()      masks zoo::index()
## ✖ tsibble::intersect()  masks base::intersect()
## ✖ tsibble::interval()   masks lubridate::interval()
## ✖ data.table::isoweek() masks lubridate::isoweek()
## ✖ tsibble::key()        masks data.table::key()
## ✖ dplyr::lag()          masks stats::lag()
## ✖ xts::last()           masks data.table::last(), dplyr::last()
## ✖ data.table::mday()    masks lubridate::mday()
## ✖ data.table::minute()  masks lubridate::minute()
## ✖ data.table::month()   masks lubridate::month()
## ✖ data.table::quarter() masks lubridate::quarter()
## ✖ data.table::second()  masks lubridate::second()
## ✖ tsibble::setdiff()    masks base::setdiff()
## ✖ tsibble::union()      masks base::union()
## ✖ data.table::wday()    masks lubridate::wday()
## ✖ data.table::week()    masks lubridate::week()
## ✖ data.table::yday()    masks lubridate::yday()
## ✖ data.table::year()    masks lubridate::year()
## 
## Attaching package: 'fpp3'
## The following object is masked from 'package:fpp':
## 
##     insurance
library(forecast)
library(DMwR2)
## 
## Attaching package: 'DMwR2'
## The following object is masked from 'package:fma':
## 
##     sales
library(stats)
library(plogr)
library(psych) 
## 
## Attaching package: 'psych'
## The following objects are masked from 'package:ggplot2':
## 
##     %+%, alpha
library(forecast) 
library(fpp) 
library(fpp2)
## 
## Attaching package: 'fpp2'
## The following object is masked from 'package:fpp3':
## 
##     insurance
## The following objects are masked from 'package:fpp':
## 
##     ausair, ausbeer, austa, austourists, debitcards, departures,
##     elecequip, euretail, guinearice, oil, sunspotarea, usmelec
library(tseries) 
library(patchwork) 
library(mFilter) 
library(xts)
library(zoo)

Criando tabela de Vendas Mensais

vendas2024 <- read_excel("Vendas2024.xlsx")

vendas_mes <- vendas2024 %>%
  group_by(ano, mes)%>%
  summarise(venda_mensal = sum(venda_diaria)) %>%
  arrange(ano, mes)
## `summarise()` has grouped output by 'ano'. You can override using the `.groups`
## argument.

Criando o gráfico

plot(vendas_mes$venda_mensal)

vendas_mes_ts <- ts (vendas_mes$venda_mensal, start = c(2018,1),
frequency = 12) 
plot(vendas_mes_ts)

decomp_vendas_mes <- decompose(vendas_mes_ts, type = "additive")
plot(decomp_vendas_mes)

forecast(vendas_mes_ts, 6, 90) 
##          Point Forecast    Lo 90    Hi 90
## Apr 2024       592128.1 508364.8 675891.4
## May 2024       677756.0 563531.7 791980.3
## Jun 2024       626941.9 488818.4 765065.3
## Jul 2024       546903.3 388445.2 705361.4
## Aug 2024       546792.1 370327.1 723257.0
## Sep 2024       543842.9 351045.7 736640.1
forecast(vendas_mes_ts, 6, 95)
##          Point Forecast    Lo 95    Hi 95
## Apr 2024       592128.1 492318.0 691938.2
## May 2024       677756.0 541649.4 813862.6
## Jun 2024       626941.9 462357.7 791526.1
## Jul 2024       546903.3 358088.8 735717.8
## Aug 2024       546792.1 336521.1 757063.0
## Sep 2024       543842.9 314110.8 773575.0