MIP 2021
# Limpandoo ambiente
rm(list = ls())
# =========== Área de bibliotecas =================
# Pacotes necessários
if (!require("httr")) install.packages("httr")## Carregando pacotes exigidos: httrif (!require("readxl")) install.packages("readxl")## Carregando pacotes exigidos: readxlif (!require("writexl")) install.packages("writexl")## Carregando pacotes exigidos: writexlif (!require("fs")) install.packages("fs")## Carregando pacotes exigidos: fsif (!require("openxlsx")) install.packages("openxlsx")## Carregando pacotes exigidos: openxlsxlibrary(httr)
library(readxl)
library(writexl)
library(openxlsx)
library(fs)
# =========== Área do código principal ============
#
# Download das Tabela sde REcursos e Usos
#
# URL do ZIP com as Tabelas de Recursos e Usos (ajuste conforme o ano desejado)
url <- "https://ftp.ibge.gov.br/Contas_Nacionais/Sistema_de_Contas_Nacionais/2021/tabelas_xls/tabelas_de_recursos_e_usos/nivel_68_2010_2021_xls.zip"
#
# Nome do arquivo para salvar localmente
ArquivoDestino <- "Recursos_Usos_2021.zip"
# Diretório de destino
PastaDestino <- "./TRU_2021"
dir_create(PastaDestino)
# Download do arquivo ZIP
GET(url, write_disk(file.path(PastaDestino,ArquivoDestino), overwrite = TRUE))## Response [https://ftp.ibge.gov.br/Contas_Nacionais/Sistema_de_Contas_Nacionais/2021/tabelas_xls/tabelas_de_recursos_e_usos/nivel_68_2010_2021_xls.zip]
## Date: 2025-07-25 11:40
## Status: 200
## Content-Type: application/zip
## Size: 1.84 MB
## <ON DISK> C:\Users\katha\OneDrive\Documentos\FACULDADE\email\fl e bl 2021\TRU_2021\Recursos_Usos_2021.zip# Extração do ZIP
unzip(file.path(PastaDestino,ArquivoDestino),
files = NULL,
overwrite = TRUE,
exdir = PastaDestino)
#
# Lendo as Tabelas
nAnoMIP = 2021
nSetores = 68
nProdutos = 128
# Lendo Oferta
dSheet <- read_excel(file.path(PastaDestino,paste0("68_tab1_", nAnoMIP, ".xls")),
sheet = "oferta")## New names:
## • `` -> `...2`
## • `` -> `...3`
## • `` -> `...4`
## • `` -> `...5`
## • `` -> `...6`
## • `` -> `...7`
## • `` -> `...8`
## • `` -> `...9`
## • `` -> `...10`
## • `` -> `...11`mMatriz = dSheet[5:132, 3:9]
mOferta= apply(as.matrix.noquote(mMatriz),2,as.numeric)
# lendo Producao
dSheet <- read_excel(file.path(PastaDestino,paste0("68_tab1_", nAnoMIP, ".xls")),
sheet = "producao")## New names:
## • `` -> `...2`
## • `` -> `...3`
## • `` -> `...4`
## • `` -> `...5`
## • `` -> `...6`
## • `` -> `...7`
## • `` -> `...8`
## • `` -> `...9`
## • `` -> `...10`
## • `` -> `...11`
## • `` -> `...12`
## • `` -> `...13`
## • `` -> `...14`
## • `` -> `...15`
## • `` -> `...16`
## • `` -> `...17`
## • `` -> `...18`
## • `` -> `...19`
## • `` -> `...20`
## • `` -> `...21`
## • `` -> `...22`
## • `` -> `...23`
## • `` -> `...24`
## • `` -> `...25`
## • `` -> `...26`
## • `` -> `...27`
## • `` -> `...28`
## • `` -> `...29`
## • `` -> `...30`
## • `` -> `...31`
## • `` -> `...32`
## • `` -> `...33`
## • `` -> `...34`
## • `` -> `...35`
## • `` -> `...36`
## • `` -> `...37`
## • `` -> `...38`
## • `` -> `...39`
## • `` -> `...40`
## • `` -> `...41`
## • `` -> `...42`
## • `` -> `...43`
## • `` -> `...44`
## • `` -> `...45`
## • `` -> `...46`
## • `` -> `...47`
## • `` -> `...48`
## • `` -> `...49`
## • `` -> `...50`
## • `` -> `...51`
## • `` -> `...52`
## • `` -> `...53`
## • `` -> `...54`
## • `` -> `...55`
## • `` -> `...56`
## • `` -> `...57`
## • `` -> `...58`
## • `` -> `...59`
## • `` -> `...60`
## • `` -> `...61`
## • `` -> `...62`
## • `` -> `...63`
## • `` -> `...64`
## • `` -> `...65`
## • `` -> `...66`
## • `` -> `...67`
## • `` -> `...68`
## • `` -> `...69`
## • `` -> `...70`
## • `` -> `...71`mMatriz = dSheet[5:132, 3:70]
mProducao= apply(as.matrix.noquote(mMatriz),2,as.numeric)
# Lendo Importação
dSheet <- read_excel(file.path(PastaDestino,paste0("68_tab1_", nAnoMIP, ".xls")),
sheet = "importacao")## New names:
## • `` -> `...2`
## • `` -> `...3`mMatriz = dSheet[5:132, 3]
vImportacao= apply(as.matrix(mMatriz),2,as.numeric)
#lendo Consumo Intermediário
dSheet <- read_excel(file.path(PastaDestino,paste0("68_tab2_", nAnoMIP, ".xls")),
sheet = "CI")## New names:
## • `` -> `...2`
## • `` -> `...3`
## • `` -> `...4`
## • `` -> `...5`
## • `` -> `...6`
## • `` -> `...7`
## • `` -> `...8`
## • `` -> `...9`
## • `` -> `...10`
## • `` -> `...11`
## • `` -> `...12`
## • `` -> `...13`
## • `` -> `...14`
## • `` -> `...15`
## • `` -> `...16`
## • `` -> `...17`
## • `` -> `...18`
## • `` -> `...19`
## • `` -> `...20`
## • `` -> `...21`
## • `` -> `...22`
## • `` -> `...23`
## • `` -> `...24`
## • `` -> `...25`
## • `` -> `...26`
## • `` -> `...27`
## • `` -> `...28`
## • `` -> `...29`
## • `` -> `...30`
## • `` -> `...31`
## • `` -> `...32`
## • `` -> `...33`
## • `` -> `...34`
## • `` -> `...35`
## • `` -> `...36`
## • `` -> `...37`
## • `` -> `...38`
## • `` -> `...39`
## • `` -> `...40`
## • `` -> `...41`
## • `` -> `...42`
## • `` -> `...43`
## • `` -> `...44`
## • `` -> `...45`
## • `` -> `...46`
## • `` -> `...47`
## • `` -> `...48`
## • `` -> `...49`
## • `` -> `...50`
## • `` -> `...51`
## • `` -> `...52`
## • `` -> `...53`
## • `` -> `...54`
## • `` -> `...55`
## • `` -> `...56`
## • `` -> `...57`
## • `` -> `...58`
## • `` -> `...59`
## • `` -> `...60`
## • `` -> `...61`
## • `` -> `...62`
## • `` -> `...63`
## • `` -> `...64`
## • `` -> `...65`
## • `` -> `...66`
## • `` -> `...67`
## • `` -> `...68`
## • `` -> `...69`
## • `` -> `...70`
## • `` -> `...71`mMatriz = dSheet[5:132, 3:70]
mCI= apply(as.matrix.noquote(mMatriz),2,as.numeric)
#lendo demanda
dSheet <- read_excel(file.path(PastaDestino,paste0("68_tab2_", nAnoMIP, ".xls")),
sheet = "demanda")## New names:
## • `` -> `...2`
## • `` -> `...3`
## • `` -> `...4`
## • `` -> `...5`
## • `` -> `...6`
## • `` -> `...7`
## • `` -> `...8`
## • `` -> `...9`
## • `` -> `...10`mMatriz = dSheet[5:132, 3:8]
mDemanda= apply(as.matrix.noquote(mMatriz),2,as.numeric)
#lendo VA
dSheet <- read_excel(file.path(PastaDestino,paste0("68_tab2_", nAnoMIP, ".xls")),
sheet = "VA")## New names:
## • `` -> `...2`
## • `` -> `...3`
## • `` -> `...4`
## • `` -> `...5`
## • `` -> `...6`
## • `` -> `...7`
## • `` -> `...8`
## • `` -> `...9`
## • `` -> `...10`
## • `` -> `...11`
## • `` -> `...12`
## • `` -> `...13`
## • `` -> `...14`
## • `` -> `...15`
## • `` -> `...16`
## • `` -> `...17`
## • `` -> `...18`
## • `` -> `...19`
## • `` -> `...20`
## • `` -> `...21`
## • `` -> `...22`
## • `` -> `...23`
## • `` -> `...24`
## • `` -> `...25`
## • `` -> `...26`
## • `` -> `...27`
## • `` -> `...28`
## • `` -> `...29`
## • `` -> `...30`
## • `` -> `...31`
## • `` -> `...32`
## • `` -> `...33`
## • `` -> `...34`
## • `` -> `...35`
## • `` -> `...36`
## • `` -> `...37`
## • `` -> `...38`
## • `` -> `...39`
## • `` -> `...40`
## • `` -> `...41`
## • `` -> `...42`
## • `` -> `...43`
## • `` -> `...44`
## • `` -> `...45`
## • `` -> `...46`
## • `` -> `...47`
## • `` -> `...48`
## • `` -> `...49`
## • `` -> `...50`
## • `` -> `...51`
## • `` -> `...52`
## • `` -> `...53`
## • `` -> `...54`
## • `` -> `...55`
## • `` -> `...56`
## • `` -> `...57`
## • `` -> `...58`
## • `` -> `...59`
## • `` -> `...60`
## • `` -> `...61`
## • `` -> `...62`
## • `` -> `...63`
## • `` -> `...64`
## • `` -> `...65`
## • `` -> `...66`
## • `` -> `...67`
## • `` -> `...68`
## • `` -> `...69`
## • `` -> `...70`mMatriz = dSheet[5:18, 2:69]
mVA= apply(as.matrix.noquote(mMatriz),2,as.numeric)
# Calculando Matriz e distribuição sem Variação de estoque
nColunaEstoque = 6
mDemandaFinalSemEstoque <- mDemanda
mDemandaFinalSemEstoque[, nColunaEstoque] <- 0.0
mConsumoTotalSemEstoque <- cbind(mCI, mDemandaFinalSemEstoque)
vTotalProduto = rowSums(mConsumoTotalSemEstoque)
mDistribuicao = mConsumoTotalSemEstoque / vTotalProduto
mDistribuicao[is.na(mDistribuicao)] <- 0
# Distribuir IPI, ICMS e OILL
nColunaIPI = 5
mValorIPI = mOferta[,nColunaIPI] * mDistribuicao
nColunaICMS = 6
mValorICMS = mOferta[,nColunaICMS] * mDistribuicao
nColunaOILL = 7
mValorOILL = mOferta[,nColunaOILL] * mDistribuicao
# Distribui a margem do comércio
nColunaMargemComercio = 2
nColunaMargemTransporte = 3
vVetorEntrada <-mOferta[, nColunaMargemComercio]
vMargem <- c(93, 94)
vPropMargem <- vVetorEntrada[vMargem[1]:vMargem[2]] / sum(vVetorEntrada[vMargem[1]:vMargem[2]])
mMargemComercio <- vVetorEntrada * mDistribuicao
mMargemDistribuida <- colSums(mMargemComercio[1:(vMargem[1]-1), ]) + colSums(mMargemComercio[(vMargem[2]+1):nrow(mMargemComercio), ])
mMargemComercio[vMargem[1]:vMargem[2], ] <- t(t(vPropMargem)) %*% mMargemDistribuida * (-1)
options(scipen = 0)
colSums(mMargemComercio)## ...3 ...4 ...5 ...6 ...7
## -5.627408e-13 4.677682e-14 -1.715096e-13 4.692676e-14 -8.880952e-13
## ...8 ...9 ...10 ...11 ...12
## -1.247114e-12 -7.759765e-14 1.586953e-12 4.887063e-14 -7.725154e-12
## ...13 ...14 ...15 ...16 ...17
## -1.011691e-13 -2.427364e-13 1.928457e-13 -6.211698e-13 -8.859059e-14
## ...18 ...19 ...20 ...21 ...22
## 1.927451e-13 -9.909296e-13 -1.426240e-13 3.263917e-13 1.690553e-13
## ...23 ...24 ...25 ...26 ...27
## -1.645906e-12 4.104495e-13 7.843379e-14 -7.884804e-13 -2.322031e-13
## ...28 ...29 ...30 ...31 ...32
## -6.735446e-13 1.107447e-13 -1.153244e-12 -1.956491e-13 6.054046e-13
## ...33 ...34 ...35 ...36 ...37
## -1.526557e-14 -3.948175e-12 -2.520428e-12 2.564893e-13 -6.147860e-15
## ...38 ...39 ...40 ...41 ...42
## -9.953149e-14 -9.674483e-13 -3.781420e-13 -1.447731e-13 3.896883e-13
## ...43 ...44 ...45 ...46 ...47
## -1.110223e-12 1.204370e-12 -1.971978e-12 -2.715287e-14 3.497203e-15
## ...48 ...49 ...50 ...51 ...52
## -8.704149e-14 -9.435508e-14 -1.570688e-12 -6.805667e-14 -6.933343e-14
## ...53 ...54 ...55 ...56 ...57
## -4.796163e-14 -1.434963e-13 6.927792e-14 1.637579e-14 1.043610e-14
## ...58 ...59 ...60 ...61 ...62
## -1.135481e-13 -3.304024e-13 1.444400e-13 -5.200285e-13 -4.218847e-14
## ...63 ...64 ...65 ...66 ...67
## -1.088019e-13 -1.687539e-14 -1.709743e-13 -1.890932e-12 5.577760e-13
## ...68 ...69 ...70 ...3 ...4
## -6.586398e-14 -5.253575e-13 0.000000e+00 -1.743850e-11 -2.642331e-14
## ...5 ...6 ...7 ...8
## 0.000000e+00 -2.328182e-11 -6.821210e-12 0.000000e+00# Distribui a margem do transporte
vVetorEntrada <-mOferta[, nColunaMargemTransporte]
vMargem <- c(95, 98)
vPropMargem <- vVetorEntrada[vMargem[1]:vMargem[2]] / sum(vVetorEntrada[vMargem[1]:vMargem[2]])
mMargemTransporte <- vVetorEntrada * mDistribuicao
mMargemDistribuida <- colSums(mMargemTransporte[1:(vMargem[1]-1), ]) + colSums(mMargemTransporte[(vMargem[2]+1):nrow(mMargemTransporte), ])
mMargemTransporte[vMargem[1]:vMargem[2], ] <- t(t(vPropMargem)) %*% mMargemDistribuida * (-1)
# Calcula matriz de distribuição sem exportação
nColunaExportacao <- 1
mDemandaFinalSemExportacao <- mDemandaFinalSemEstoque
mDemandaFinalSemExportacao[, nColunaExportacao] <- 0.0
mConsumoTotalSemExportacao <- cbind(mCI, mDemandaFinalSemExportacao)
vTotalProduto <- rowSums(mConsumoTotalSemExportacao)
mDistribuicaoImportacao <- mConsumoTotalSemExportacao / vTotalProduto
mDistribuicaoImportacao[is.na(mDistribuicaoImportacao)] <- 0
# Distribuir II e importação
nColunaII <- 4
mValorII <- mOferta[, nColunaII] * mDistribuicaoImportacao
mImportacao <- vImportacao[,] * mDistribuicaoImportacao
# Calcula o consumo total a preço basicos
mConsumoTotalPrecoMercado <- cbind(mCI, mDemanda)
mConsumoTotalPrecoBase <- mConsumoTotalPrecoMercado - mMargemComercio - mMargemTransporte - mValorIPI - mValorICMS - mValorOILL - mImportacao - mValorII
# Estimação da MIP setor x setor utilizando a tecnologia baseada na indústria
nLinhasVA <- 14
nLinhaVBP <- 13
nLinhaOcupacoes <- 14
vVBP <- mVA[nLinhaVBP,]
vOcupacoes <- mVA[nLinhaOcupacoes,]
mU =mConsumoTotalPrecoBase[,1:nSetores]
mE =mConsumoTotalPrecoBase[,(nSetores+1):ncol(mConsumoTotalPrecoBase)]
options(scipen = 2)
vX = mVA[nLinhaVBP,]
mXChapeu = diag(1/vX)
mB = mU %*% mXChapeu
mV = t(mProducao)
vQ = colSums(mV)
mQChapeu = diag(1/vQ)
mD = mV %*% mQChapeu
mA = mD %*% mB
mY = mD %*% mE
mZ = mD %*% mU
mI = diag(nSetores)
mLeontief = (mI - mA)
vDemandaTotal = rowSums(mZ) + rowSums(mY)
nDemandaTotal = sum(vDemandaTotal)
mTConsumoItermediario = rbind(colSums(mValorII[,1:nSetores]),
colSums(mValorIPI[,1:nSetores]),
colSums(mValorICMS[,1:nSetores]),
colSums(mValorOILL[,1:nSetores]) )
nLinhaVA=1
vOfertaTotal = colSums(mZ) + colSums(mImportacao[,1:nSetores]) +
colSums(mTConsumoItermediario) + mVA[nLinhaVA,]
nOfertaTotal = sum(vOfertaTotal)
vDiferencas = vDemandaTotal - vOfertaTotal
vDiferencaTotal = sum(vDiferencas)
vDiferencas## ...3 ...4 ...5 ...6 ...7
## 0.000000e+00 5.820766e-11 7.275958e-12 0.000000e+00 1.164153e-10
## ...8 ...9 ...10 ...11 ...12
## 0.000000e+00 -3.637979e-12 -5.820766e-11 1.455192e-11 -5.820766e-11
## ...13 ...14 ...15 ...16 ...17
## 0.000000e+00 -7.275958e-12 1.455192e-11 -1.455192e-11 1.455192e-11
## ...18 ...19 ...20 ...21 ...22
## 7.275958e-12 0.000000e+00 -3.637979e-12 0.000000e+00 2.910383e-11
## ...23 ...24 ...25 ...26 ...27
## 5.820766e-11 0.000000e+00 -1.455192e-11 0.000000e+00 0.000000e+00
## ...28 ...29 ...30 ...31 ...32
## 2.910383e-11 0.000000e+00 1.455192e-11 0.000000e+00 -2.910383e-11
## ...33 ...34 ...35 ...36 ...37
## 0.000000e+00 -5.820766e-11 0.000000e+00 0.000000e+00 0.000000e+00
## ...38 ...39 ...40 ...41 ...42
## 0.000000e+00 0.000000e+00 0.000000e+00 1.455192e-11 0.000000e+00
## ...43 ...44 ...45 ...46 ...47
## 0.000000e+00 0.000000e+00 -5.820766e-11 0.000000e+00 0.000000e+00
## ...48 ...49 ...50 ...51 ...52
## -2.910383e-11 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00
## ...53 ...54 ...55 ...56 ...57
## 0.000000e+00 0.000000e+00 -1.164153e-10 0.000000e+00 0.000000e+00
## ...58 ...59 ...60 ...61 ...62
## 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00
## ...63 ...64 ...65 ...66 ...67
## -2.328306e-10 0.000000e+00 0.000000e+00 0.000000e+00 5.820766e-11
## ...68 ...69 ...70
## 0.000000e+00 2.910383e-11 0.000000e+00# Montagem da Matriz - Preparação dos totais
vMConsumoIntermdiario = colSums(mImportacao[,1:nSetores])
vMDemandaFinal = colSums(mImportacao[,nSetores+1:6])
vValorIIConsumoIntermdiario = colSums(mValorII[,1:nSetores])
vValorIIDemandaFinal = colSums(mValorII[,nSetores+1:6])
vValorIPIConsumoIntermdiario = colSums(mValorIPI[,1:nSetores])
vValorIPIDemandaFinal = colSums(mValorIPI[,nSetores+1:6])
vValorICMSConsumoIntermdiario = colSums(mValorICMS[,1:nSetores])
vValorICMSDemandaFinal = colSums(mValorICMS[,nSetores+1:6])
vValorOIConsumoIntermdiario = colSums(mValorOILL[,1:nSetores])
vValorOIDemandaFinal = colSums(mValorOILL[,nSetores+1:6])
mTConsumoIntermediario = rbind(vValorIIConsumoIntermdiario, vValorIPIConsumoIntermdiario,
vValorICMSConsumoIntermdiario, vValorOIConsumoIntermdiario)
mTDemandaFinal = rbind(vValorIIDemandaFinal, vValorIPIDemandaFinal,
vValorICMSDemandaFinal, vValorOIDemandaFinal)
# Montagem da Oferta
vOfertaNacional <- colSums(mZ)
vOfertaTributos <- colSums(mTConsumoIntermediario)
vOfertaConsumoIntermediario <- vOfertaNacional + vMConsumoIntermdiario + vOfertaTributos
mOfertaConsumoIntermediario <- rbind(mZ, vOfertaNacional, vMConsumoIntermdiario, mTConsumoIntermediario,
vOfertaConsumoIntermediario, mVA)
# Calculando Demanda Intermediaria Total
mTotalDemandaConsumoIntermediario <- rowSums(mOfertaConsumoIntermediario)
# Montagem da Demanda Final
mTDemandaFinal <- rbind(vValorIIDemandaFinal, vValorIPIDemandaFinal, vValorICMSDemandaFinal, vValorOIDemandaFinal)
vTotalLinhaDemandaNacional <- colSums(mY)
mDemanda <- rbind(mY, vTotalLinhaDemandaNacional, vMDemandaFinal, mTDemandaFinal)
vTotalLinhaDemandaFinal <- colSums(mDemanda)
mDemandaFinal <- rbind(mDemanda, vTotalLinhaDemandaFinal, matrix(0, nrow = 14, ncol = 6))
vTotalDemandaFinal <- rowSums(mDemandaFinal)
vDemandaTotal <- mTotalDemandaConsumoIntermediario + vTotalDemandaFinal
mMIP <- cbind(mOfertaConsumoIntermediario, mTotalDemandaConsumoIntermediario, mDemandaFinal,
vTotalDemandaFinal, vDemandaTotal)
# lendo Nome de Setores
lNomeSetores <- c()
for (i in 1:nSetores) {
lNomeSetores[[i]] <- dSheet[3, 1 + i]
lNomeSetores[[i]] <- substr(lNomeSetores[[i]],6,50)
}
lNomeVA = c()
for (i in 1:14) {
lNomeVA[[i]] <- dSheet[4+i, 1]
lNomeVA[[i]] <- substr(lNomeVA[[i]],1,60)
}
sColsLabel <- c()
sRowsLabel <- c()
sRowsLabel <- c(lNomeSetores, "Oferta Nacional", "Importação", "II", "IPI", "ICMS", "OI", "Oferta Intermediária Total", lNomeVA)
sColsLabel <- c(lNomeSetores, "Consumo Intermediário", "Exportação", "Consumo do Governo", "Consumo das ISFLSF", "Consumo das Famílias", "FBCF", "Variação do estoque", "Demanda Final", "Demanda Total")
# Definindo o caminho de saída
PastaDestino <- "./TRU_2021"
sCaminhoOutput <- "./Outputs/"
dir_create(sCaminhoOutput)
nome_arquivo <- paste0("MIP_", as.character(nAnoMIP), "_", as.character(nSetores), "x", as.character(nSetores), "MetodoGuilhoto.xlsx")
# Converter a matriz 'mMIP' em um data frame
df <- as.data.frame(mMIP)
rownames(df) <- sRowsLabel
colnames(df) <- sColsLabel
# Criar um novo arquivo Excel
# e adicionar a planilha com os dados
wb <- createWorkbook()
# Definindo o caminho de saída
addWorksheet(wb, "MIP")
# Adicionando os dados à planilha
writeData(wb, "MIP", df, rowNames = TRUE)
decimal2 <- createStyle(numFmt = "0.00")
# Adicionando o estilo de formatação
addStyle(wb, sheet = "MIP", style = decimal2,
cols = 1:77, rows = 1:89, gridExpand = TRUE)
# Salvando o arquivo Excel
saveWorkbook(wb, paste0(sCaminhoOutput, nome_arquivo), overwrite = TRUE)
print("Acabou")## [1] "Acabou"PCVA
# =========== Área de bibliotecas =================
# Pacotes necessários
if (!require("openxlsx")) install.packages("openxlsx")
if (!require("fs")) install.packages("fs")
if (!require("dplyr")) install.packages("dplyr")## Carregando pacotes exigidos: dplyr##
## Anexando pacote: 'dplyr'## Os seguintes objetos são mascarados por 'package:stats':
##
## filter, lag## Os seguintes objetos são mascarados por 'package:base':
##
## intersect, setdiff, setequal, unionif (!require("kableExtra")) install.packages("kableExtra")## Carregando pacotes exigidos: kableExtra##
## Anexando pacote: 'kableExtra'## O seguinte objeto é mascarado por 'package:dplyr':
##
## group_rowslibrary(openxlsx)
library(fs)
library(dplyr)
library(kableExtra)
# =========== Área do código principal ============
# 1. Leitura da Matriz e preparação dos dados
nSetores = 68
PastaMipEstimada <- "./Outputs"
PastaMipEstimada <- fs::path_expand(PastaMipEstimada)
dSheet <- read.xlsx(file.path(PastaMipEstimada,"MIP_2021_68x68MetodoGuilhoto.xlsx"),
sheet = "MIP",
rowNames = TRUE)
mMatriz <- as.matrix(dSheet)
lNomeSetores <- rownames(dSheet)[1:nSetores]
dimnames(mMatriz) <- NULL
mZ <- mMatriz[1:nSetores, 1:nSetores]
mVA <- mMatriz[76:89, 1:nSetores]
nLinhaVBP <- 13
vX <- mVA[nLinhaVBP,]
# 2. Cálculo do Modelo de Leontief
#---------------------------------------------------------------------------
mA <- t(t(mZ) / vX)
mI <- diag(nSetores)
mLeontief <- solve(mI - mA)
# 3. Cálculo dos Índices de Ligação (Hirschman-Rasmussen)
#---------------------------------------------------------------------------
mB = mLeontief
# Médias dos elementos da matriz de Leontief
vMediaLinhasB <- apply(mB, 1, mean)
vMediaColunasB <- apply(mB, 2, mean)
vMediaTodosElementosB <- sum(mB) / nSetores^2
# Cálculo dos índices
vIndiceLigacaoParaTras <- vMediaColunasB / vMediaTodosElementosB
vIndiceLigacaoParaFrente <- vMediaLinhasB / vMediaTodosElementosB
# 4. Criação da Tabela Analítica
#---------------------------------------------------------------------------
# Unindo os resultados em um único data frame
df_indices <- data.frame(
Setor = lNomeSetores,
Indice_Tras = vIndiceLigacaoParaTras,
Indice_Frente = vIndiceLigacaoParaFrente
)
# Classificando cada setor nos 4 quadrantes estratégicos
df_indices <- df_indices %>%
mutate(
Classificacao = case_when(
Indice_Tras > 1 & Indice_Frente > 1 ~ "Setor-Chave",
Indice_Tras > 1 & Indice_Frente <= 1 ~ "Efeito para Trás",
Indice_Tras <= 1 & Indice_Frente > 1 ~ "Efeito para Frente",
TRUE ~ "Independente"
),
# Criando uma coluna para ordenação (soma dos índices)
Ordem = Indice_Tras + Indice_Frente
) %>%
arrange(desc(Ordem)) %>% # Ordena do mais conectado para o menos
select(-Ordem) # Remove a coluna de ordem que não precisa aparecer na tabela
# 5. Geração do Relatório em HTML
#---------------------------------------------------------------------------
tabela_html <- df_indices %>%
kbl(
caption = "Análise de Encademaneto: Índices de Ligação para Trás e para Frente (2021)",
col.names = c("Setor", "Índice para Trás", "Índice para Frente", "Classificação Estratégica"),
digits = 3,
format = "html",
align = "lcrr"
) %>%
kable_styling(
bootstrap_options = c("striped", "hover", "condensed", "responsive"),
full_width = FALSE
) %>%
# Adicionando cores para facilitar a identificação
column_spec(4, bold = TRUE, color = "white",
background = case_when(
df_indices$Classificacao == "Setor-Chave" ~ "#d9534f", # Vermelho para destaque máximo
df_indices$Classificacao == "Efeito para Trás" ~ "#5bc0de", # Azul
df_indices$Classificacao == "Efeito para Frente" ~ "#f0ad4e", # Laranja
df_indices$Classificacao == "Independente" ~ "#777777" # Cinza
))
# Salva a tabela em um arquivo HTML
save_kable(tabela_html, file = "analise_indices_ligacao.html")
# Abre o arquivo HTML gerado no seu visualizador
rstudioapi::viewer("analise_indices_ligacao.html")## NULLprint("Análise concluída. Verifique o arquivo 'analise_indices_ligacao.html' no seu diretório.")## [1] "Análise concluída. Verifique o arquivo 'analise_indices_ligacao.html' no seu diretório."