options(scipen = 9999)
library(readxl)
library(dplyr)

#Se cargan las funciones vistas en clase
#Matriz de coeficientes tecnicos
mip_coeficientes_tecnicos<-function(matriz_consumo_intermedio,
                                    vector_demanda_final){
  filas_ci<-nrow(matriz_consumo_intermedio)
  columnas_ci<-ncol(matriz_consumo_intermedio)
  filas_x<-nrow(vector_demanda_final)
  if(filas_ci!=columnas_ci){
    stop("Ingrese una matriz de Consumo Intermedio, Cuadrada",call. = FALSE)
  }
  if(filas_ci!=filas_x){
    stop("Vector de demanda final incompatible (diferente dimensión)",call. = FALSE)
  }
  v<-solve(diag(as.vector(vector_demanda_final)))
  A<-matriz_consumo_intermedio%*%v
  list(A=A,V=v)
}
#matriz tecnológica

mip_matriz_tecnologica<-function(matriz_coeficientes_tecnicos){
  filas_A<-nrow(matriz_coeficientes_tecnicos)
  columnas_A<-ncol(matriz_coeficientes_tecnicos)
  if(filas_A!=columnas_A){
    stop("Ingrese una matriz de coef. técnicos cuadrada",call. = FALSE)
  }
  tipo_matriz<-typeof(matriz_coeficientes_tecnicos)
  if(tipo_matriz!="double"){
    stop("La matriz ingresada no es numerica",call. = FALSE)
  }
  T<-diag(1,filas_A)-matriz_coeficientes_tecnicos
  T
}
mip_matriz_leontief<-function(matriz_tecnologica){
  L<-solve(matriz_tecnologica)
  L
}
mip_multiplicadores_produccion_mp<-function(matriz_leontief){
  mp<-rowSums(matriz_leontief)
  mp
}
mip_multiplicadores_expansion_demanda_me<-function(matriz_leontief){
  me<-colSums(matriz_leontief)
  me
}
mip_encadenamiento_pd<-function(matriz_leontief){
  mp<-mip_multiplicadores_produccion_mp(matriz_leontief)
  mp/mean(mp)
}
mip_encadenamiento_sd<-function(matriz_leontief){
  me<-mip_multiplicadores_expansion_demanda_me(matriz_leontief)
  me/mean(me)
}
mip_tabla_rasmussen<-function(matriz_leontief){
library(dplyr)
pd<-mip_encadenamiento_pd(matriz_leontief)
sd<-mip_encadenamiento_sd(matriz_leontief)
rasmussen<-data.frame(pd=pd,sd=sd)
rasmussen_clasificado<-rasmussen %>% 
  mutate(clasificacion=case_when(pd>1 & sd>1 ~ "Sector Clave",
                                           pd<1 & sd>1 ~"Sector Estrategico",
                                           pd>1 & sd<1 ~"Sector Impulsor",
                                           pd<1 & sd<1 ~"Sector Isla",
                                           TRUE ~ "No clasificado")) %>% mutate(sector=row_number()) %>% select(sector,pd,sd,clasificacion)
rasmussen_clasificado
}

#Cargando las mip 1990  y mip 2006

#mip 1990
#Consumo Intermedio
mip1990_ci <- read_excel("C:\\Users\\ileom\\OneDrive\\Escritorio\\tareas R\\Anexo_Resolución_32_MATRIZ_INSUMO_PRODUCTO_A_PRECIOS_CORRIENTES_EN_DOLARES_1990-2006.xlsx",
    sheet = "MIP 1990", range = "i14:bb59", 
    col_names = FALSE)
names(mip1990_ci)<-as.character(1:46)

#Demanda Final
mip1990_h <- read_excel("C:\\Users\\ileom\\OneDrive\\Escritorio\\tareas R\\Anexo_Resolución_32_MATRIZ_INSUMO_PRODUCTO_A_PRECIOS_CORRIENTES_EN_DOLARES_1990-2006.xlsx",
    sheet = "MIP 1990", range = "bd14:be59", 
    col_names = FALSE)
names(mip1990_h)<-as.character(1:2)

#Vector de producción
mip1990_X <- read_excel("C:\\Users\\ileom\\OneDrive\\Escritorio\\tareas R\\Anexo_Resolución_32_MATRIZ_INSUMO_PRODUCTO_A_PRECIOS_CORRIENTES_EN_DOLARES_1990-2006.xlsx",
    sheet = "MIP 1990", range = "bi14:bi59", 
    col_names = FALSE)
names(mip1990_X)<-c("X")


#mip 2006
#Consumo Intermedio
mip2006_ci <- read_excel("C:\\Users\\ileom\\OneDrive\\Escritorio\\tareas R\\Anexo_Resolución_32_MATRIZ_INSUMO_PRODUCTO_A_PRECIOS_CORRIENTES_EN_DOLARES_1990-2006.xlsx",
    sheet = "MIP 2006", range = "i15:bb60", 
    col_names = FALSE)
names(mip2006_ci)<-as.character(1:46)

#Demanda Final
mip2006_h <- read_excel("C:\\Users\\ileom\\OneDrive\\Escritorio\\tareas R\\Anexo_Resolución_32_MATRIZ_INSUMO_PRODUCTO_A_PRECIOS_CORRIENTES_EN_DOLARES_1990-2006.xlsx", 
    sheet = "MIP 2006", range = "bd15:be60", 
    col_names = FALSE)
names(mip2006_h)<-as.character(1:2)

#Vector de producción
mip2006_X <- read_excel("C:\\Users\\ileom\\OneDrive\\Escritorio\\tareas R\\Anexo_Resolución_32_MATRIZ_INSUMO_PRODUCTO_A_PRECIOS_CORRIENTES_EN_DOLARES_1990-2006.xlsx",
    sheet = "MIP 2006", range = "bi15:bi60", 
    col_names = FALSE)
names(mip2006_X)<-c("X")

Realice el cálculo de lo siguiente (de ser necesario haga las agregaciones de servicios propuestas en clase)

#Agregando los servicios

#Para 1990
servicios_row<-colSums(mip1990_ci[41:46,])
temporal<-rbind(mip1990_ci[1:40,],servicios_row)
servicios_col<-rowSums(temporal[,41:46])
mip1990_ci_corregida<-cbind(temporal[,1:40],servicios_col)
names(mip1990_ci_corregida)<-as.character(1:41)
X_1990<-rbind(mip1990_X[1:40,],colSums(mip1990_X[41:46,]))


#Para 2006
servicios_row<-colSums(mip2006_ci[41:46,])
temporal<-rbind(mip2006_ci[1:40,],servicios_row)
servicios_col<-rowSums(temporal[,41:46])
mip2006_ci_corregida<-cbind(temporal[,1:40],servicios_col)
names(mip2006_ci_corregida)<-as.character(1:41)
X_2006<-rbind(mip2006_X[1:40,],colSums(mip2006_X[41:46,]))

#Conversion a matrices para los calculos
#1990
matriz_X_1990<- as.matrix(X_1990)
matriz_CI_1990<-as.matrix(mip1990_ci_corregida)

#2006
matriz_X_2006<-as.matrix(X_2006)
matriz_CI_2006<-as.matrix(mip2006_ci_corregida)

#Calculando la funcion leontief para los calculos
#1990
matriz_A_1990<-mip_coeficientes_tecnicos(matriz_CI_1990,matriz_X_1990)[[1]]
matriz_T_1990<-mip_matriz_tecnologica(matriz_A_1990)
matriz_L_1990 <- mip_matriz_leontief(matriz_T_1990)

#2006
matriz_A_2006<-mip_coeficientes_tecnicos(matriz_CI_2006,matriz_X_2006)[[1]]
matriz_T_2006<-mip_matriz_tecnologica(matriz_A_2006)
matriz_L_2006 <- mip_matriz_leontief(matriz_T_2006)

Multiplicadores Expansión de la demanda (me) para la MIP 1990 y para la MIP 2006.

#1990
me_1990 <- mip_multiplicadores_expansion_demanda_me(matriz_L_1990)
print(me_1990)

##  [1]  1.255178  1.267747  1.261599  1.568111  1.124569  1.445002  1.768326
##  [8]  1.029765  1.383834  1.047445  1.834384  1.788561  1.059243  1.799649
## [15]  1.840519  1.553178  1.365915  1.384794  1.505731  1.642505  1.578688
## [22]  1.361625  1.665210  1.447935  1.327641  1.408787  1.395278  1.459492
## [29]  2.366807  1.299373  1.109323  1.451591  1.392119  1.826914 37.440804
## [36]  1.636206  1.517817  1.258089  1.353294  1.170121  1.301949

#2006
me_2006<- mip_multiplicadores_expansion_demanda_me(matriz_L_2006)
print(me_2006)

##  [1]  1.297922  1.020215  1.234962  1.847889  1.083978  1.400624  1.685844
##  [8]  1.026941  1.499664  1.071302  1.401085  1.471804  1.040887  1.526300
## [15]  1.941532  1.344572  1.277062  1.000000  1.301245  1.371596  1.395160
## [22]  1.176944  1.433429  1.363739  1.212840  1.240559  1.276547  1.496298
## [29]  1.990601  1.109025  1.088510  1.588449  2.124461  1.674974 23.762309
## [36]  1.299292  1.397290  1.684696  1.236529  1.171619  1.360409

Multiplicadores de la producción (mp) para la MIP 1990 y para la MIP 2006

#1990
mp_1990<- mip_multiplicadores_produccion_mp(matriz_L_1990)
print(mp_1990)

##  [1]  1.105885  1.191285  1.750077  1.511243  1.389578  2.181171  1.119400
##  [8]  1.246299  1.083152  3.671425  1.223539  1.133089  1.006271  1.592563
## [15]  1.194635  2.224389  1.253500  1.015813  1.928648  1.030379  1.189543
## [22]  1.146679  2.696695  2.739024  3.150917  6.985378  2.603476  1.606020
## [29]  2.197902  1.495203  2.066329  2.185642  1.177725  1.239212  1.067583
## [36]  1.291981 13.816987  2.262777  3.717322  7.533336  3.673047

#2006
mp_2006<- mip_multiplicadores_produccion_mp(matriz_L_2006)
print(mp_2006)

##  [1]  1.013829  1.052815  1.474348  1.301361  1.244981  1.623459  1.060766
##  [8]  1.196731  1.359658  2.568025  1.150131  1.077882  1.002044  1.355794
## [15]  1.054278  1.918127  1.134142  1.000527  1.470996  1.018324  1.129994
## [22]  1.107301  2.018467  1.888203  2.150340  6.346229  1.563541  1.509519
## [29]  1.791534  1.250410  1.532295  2.797425  1.081905  1.187016  1.062057
## [36]  1.197085 10.302597  1.590620  1.766302  6.502581  3.075466

c.Tasa de cambio para ambos multiplicadores (por ejemplo, para me: me2006/me1990-1)

tabla <- data.frame(me_1990=me_1990, me_2006=me_2006, mp_1990=mp_1990, mp_2006=mp_2006) %>% 
  mutate(dif_me=round((me_2006/me_1990-1)*100,2),
         dif_mp=round((mp_2006/mp_1990-1)*100,2)) %>% 
  mutate(sector=row_number()) %>% 
  select(sector, everything()) 

tabla%>% select(sector, dif_me,dif_mp)

##    sector dif_me dif_mp
## 1       1   3.41  -8.32
## 2       2 -19.53 -11.62
## 3       3  -2.11 -15.76
## 4       4  17.84 -13.89
## 5       5  -3.61 -10.41
## 6       6  -3.07 -25.57
## 7       7  -4.66  -5.24
## 8       8  -0.27  -3.98
## 9       9   8.37  25.53
## 10     10   2.28 -30.05
## 11     11 -23.62  -6.00
## 12     12 -17.71  -4.87
## 13     13  -1.73  -0.42
## 14     14 -15.19 -14.87
## 15     15   5.49 -11.75
## 16     16 -13.43 -13.77
## 17     17  -6.51  -9.52
## 18     18 -27.79  -1.50
## 19     19 -13.58 -23.73
## 20     20 -16.49  -1.17
## 21     21 -11.63  -5.01
## 22     22 -13.56  -3.43
## 23     23 -13.92 -25.15
## 24     24  -5.81 -31.06
## 25     25  -8.65 -31.76
## 26     26 -11.94  -9.15
## 27     27  -8.51 -39.94
## 28     28   2.52  -6.01
## 29     29 -15.90 -18.49
## 30     30 -14.65 -16.37
## 31     31  -1.88 -25.84
## 32     32   9.43  27.99
## 33     33  52.61  -8.14
## 34     34  -8.32  -4.21
## 35     35 -36.53  -0.52
## 36     36 -20.59  -7.34
## 37     37  -7.94 -25.44
## 38     38  33.91 -29.70
## 39     39  -8.63 -52.48
## 40     40   0.13 -13.68
## 41     41   4.49 -16.27

Presente los resultados en una tabla que incluya los nombres para todos los sectores.

library(dplyr)
library(kableExtra)

## 
## Attaching package: 'kableExtra'

## The following object is masked from 'package:dplyr':
## 
##     group_rows

nombres_sectores<- data.frame(me_1990=me_1990,me_2006=me_2006, mp_1990=mp_1990, mp_2006=mp_2006) %>% 
  mutate(dif_me=round((me_2006/me_1990-1)*100,2),
         dif_mp=round((mp_2006/mp_1990-1)*100,2)) %>%
  mutate(sector=row_number()) %>% 
         select(sector, everything())

#Se une la tabla de los nombres de los sectores y la tabla de multiplicadores anterior
tabla_2<- left_join(nombres_sectores,tabla)

## Joining with `by = join_by(sector, me_1990, me_2006, mp_1990, mp_2006, dif_me,
## dif_mp)`

tabla_2 %>% 
  kable(aption="Tabla de los multiplicadores MIP 1990 y 2006",
        digits = 2)

sector	me_1990	me_2006	mp_1990	mp_2006	dif_me	dif_mp
1	1.26	1.30	1.11	1.01	3.41	-8.32
2	1.27	1.02	1.19	1.05	-19.53	-11.62
3	1.26	1.23	1.75	1.47	-2.11	-15.76
4	1.57	1.85	1.51	1.30	17.84	-13.89
5	1.12	1.08	1.39	1.24	-3.61	-10.41
6	1.45	1.40	2.18	1.62	-3.07	-25.57
7	1.77	1.69	1.12	1.06	-4.66	-5.24
8	1.03	1.03	1.25	1.20	-0.27	-3.98
9	1.38	1.50	1.08	1.36	8.37	25.53
10	1.05	1.07	3.67	2.57	2.28	-30.05
11	1.83	1.40	1.22	1.15	-23.62	-6.00
12	1.79	1.47	1.13	1.08	-17.71	-4.87
13	1.06	1.04	1.01	1.00	-1.73	-0.42
14	1.80	1.53	1.59	1.36	-15.19	-14.87
15	1.84	1.94	1.19	1.05	5.49	-11.75
16	1.55	1.34	2.22	1.92	-13.43	-13.77
17	1.37	1.28	1.25	1.13	-6.51	-9.52
18	1.38	1.00	1.02	1.00	-27.79	-1.50
19	1.51	1.30	1.93	1.47	-13.58	-23.73
20	1.64	1.37	1.03	1.02	-16.49	-1.17
21	1.58	1.40	1.19	1.13	-11.63	-5.01
22	1.36	1.18	1.15	1.11	-13.56	-3.43
23	1.67	1.43	2.70	2.02	-13.92	-25.15
24	1.45	1.36	2.74	1.89	-5.81	-31.06
25	1.33	1.21	3.15	2.15	-8.65	-31.76
26	1.41	1.24	6.99	6.35	-11.94	-9.15
27	1.40	1.28	2.60	1.56	-8.51	-39.94
28	1.46	1.50	1.61	1.51	2.52	-6.01
29	2.37	1.99	2.20	1.79	-15.90	-18.49
30	1.30	1.11	1.50	1.25	-14.65	-16.37
31	1.11	1.09	2.07	1.53	-1.88	-25.84
32	1.45	1.59	2.19	2.80	9.43	27.99
33	1.39	2.12	1.18	1.08	52.61	-8.14
34	1.83	1.67	1.24	1.19	-8.32	-4.21
35	37.44	23.76	1.07	1.06	-36.53	-0.52
36	1.64	1.30	1.29	1.20	-20.59	-7.34
37	1.52	1.40	13.82	10.30	-7.94	-25.44
38	1.26	1.68	2.26	1.59	33.91	-29.70
39	1.35	1.24	3.72	1.77	-8.63	-52.48
40	1.17	1.17	7.53	6.50	0.13	-13.68
41	1.30	1.36	3.67	3.08	4.49	-16.27

Realice el análisis de Rasmussen para para las MIP 1990 y 2006. Analisis 1990

library(dplyr)
library(kableExtra)
## Análisis de Rasmussen para MIP 1990.

rasmussen_1990 <-mip_tabla_rasmussen(matriz_L_1990) 

summary_rasmussen_1990 <- rasmussen_1990 %>% 
  group_by(clasificacion) %>% summarise(total=n()) %>% mutate(porcentaje=round(prop.table(total)*100,2))

summary_rasmussen_1990 %>% 
  kable(aption="Análisis de Rasmussen para MIP 1990",
        align = "c",
        digits = 2) %>% 
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))

clasificacion	total	porcentaje
Sector Estrategico	2	4.88
Sector Impulsor	10	24.39
Sector Isla	29	70.73

Analisis 2006

library(dplyr)
library(kableExtra)
## Análisis de Rasmussen para MIP 2006.

rasmussen_2006<-mip_tabla_rasmussen(matriz_L_2006) 

summary_rasmussen_2006 <- rasmussen_2006 %>% 
  group_by(clasificacion) %>% summarise(total=n()) %>% mutate(porcentaje=round(prop.table(total)*100,2))
  
summary_rasmussen_2006 %>% 
  kable(aption="Análisis de Rasmussen para MIP 2006",
        align = "c",
        digits = 2) %>% 
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))

clasificacion	total	porcentaje
Sector Estrategico	4	9.76
Sector Impulsor	8	19.51
Sector Isla	29	70.73

Presente una tabla comparativa entre los resultados porcentuales por tipo de sector entre 1990 y 2006, incluya una columna que muestre la variación porcentual por tipo de sector.

library(dplyr)
library(kableExtra)

tabla_comparativa_1990_2006<-left_join(summary_rasmussen_1990, summary_rasmussen_2006, by="clasificacion", suffix=c("_1990","_2006"))

tabla_comparativa_1990_2006 %>% 
  mutate(dif_variacion_porcentual= round((porcentaje_2006/porcentaje_1990-1)*100,2)) %>% 
  kable(aption="Tabla comparativa",
        align = "c",
        digits = 2) %>% 
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))

clasificacion	total_1990	porcentaje_1990	total_2006	porcentaje_2006	dif_variacion_porcentual
Sector Estrategico	2	4.88	4	9.76	100.00
Sector Impulsor	10	24.39	8	19.51	-20.01
Sector Isla	29	70.73	29	70.73	0.00

Untitled

IRIS LEONOR MARQUEZ AREVALO MA15003

2024-09-26

Realice el cálculo de lo siguiente (de ser necesario haga las agregaciones de servicios propuestas en clase)