REGRESIÓN LINEAL MÚLTIPLE: Análisis inmobiliario
Maestría en Investigación Operativa y Estadística
Datos
Funciones: Análisis de parámetros
#Espectro de modelos
Bin_matrix1 <- function(pred_var,dt) {
matrix_data <- matrix(0, nrow = (2^pred_var), ncol = pred_var) #Matriz inicial de 0s
combinations <- do.call(expand.grid, replicate(pred_var, 0:1, simplify = FALSE)) #Cálculo combinaciones
matrix_data <- as.matrix(combinations)
dat_fr <- as.data.frame(matrix_data)
dat_frr <- dat_fr[-1, ] #Eliminación de primer modelo (Ninguna variable predictora)
colnames(dat_frr) <- names(dt)[1:pred_var]
return(dat_frr)
}Con_Sig2 <- function(dt,F0,sng){
value_list <- list(
NA_p = vector("logical"),
Sg = vector("logical")
)
for (i in 1:nrow(F0)){
indices <- which(F0[i, ] == 1)
column_name <- names(F0)[indices]
formula <- as.formula(paste("price ~", paste(column_name, collapse = " + ")))
model <- lm(formula, data = dt)
p_values <- data.frame(summary(model)$coefficients[, "Pr(>|t|)"])
colnames(p_values) <- c("P_values")
pn_r <- nrow(p_values)-1
LC <- any(p_values$P_values > sng)
value_list$NA_p <- c(value_list$NA_p, length(column_name) != nrow(p_values)-1) #Consistencia
value_list$Sg <- c(value_list$Sg,LC) #Significancia
}
my_matrix <- do.call(rbind, value_list)
my_matrix<- t(my_matrix)
NA_pSg <- data.frame(my_matrix)
matching_rows <- which((NA_pSg$Sg == "FALSE") & (NA_pSg$NA_p == "FALSE"))
matching_rows <- data.frame(matching_rows)
Filter_1 <- F0[matching_rows$matching_rows, ]
return(Filter_1)
}Ind <- function(F1,dt){
value_list <- list(
Indp = vector("logical")
)
for(i in 1:nrow(F1)){
indices <- which(F1[i, ] == 1)
column_name <- names(F1)[indices]
formula <- as.formula(paste("price ~", paste(column_name, collapse = " + ")))
model <- lm(formula, data = dt)
DW_t <- dwtest(model)$statistic #Independencia...
DW_c <- data.frame(DW_t)
value_list$Indp <- c(value_list$Indp, any(DW_c$DW_t > 1.5 && DW_t < 2.5)) #Independencia
}
Id <- data.frame(value_list)
matching_rows <- which(Id$Indp == "TRUE")
matching_rows <- data.frame(matching_rows)
Filter_2 <- F1[matching_rows$matching_rows, ]
return(Filter_2)
}Coli <- function(F2,dt){
value_list <- list(
Coln = vector("logical")
)
sum_r <- rowSums(F2[, 1:ncol(F2)])
sum_r <- data.frame(sum_r)
colnames(sum_r) <- c("sm")
matrix_of_zeros <- matrix(0, nrow = 1, ncol = 1)
for(i in 1:nrow(F2)){
indices <- which(F2[i, ] == 1)
column_name <- names(F2)[indices]
formula <- as.formula(paste("price ~", paste(column_name, collapse = " + ")))
model <- lm(formula, data = dt)
if (sum_r$sm[i] > 1) {
cold <- data.frame(vif(model)) #Colinealidad
} else {
cold <- data.frame(matrix_of_zeros)
}
colnames(cold) <- c("VIF")
value_list$Coln <- c(value_list$Coln, any(cold$VIF > 5.0)) #Colinealidad
}
Cl <- data.frame(value_list)
matching_rows <- which(Cl$Coln == "FALSE")
matching_rows <- data.frame(matching_rows)
Filter_3 <- F2[matching_rows$matching_rows, ]
return(Filter_3)
}MCDM_DM <- function(F3,dt){
value_list <- list(
CI = vector("integer"),
R_2 = vector("numeric"),
LF = vector("numeric"),
BP = vector("numeric")
)
for(i in 1:nrow(F3)){
indices <- which(F3[i, ] == 1)
column_name <- names(F3)[indices]
formula <- as.formula(paste("price ~", paste(column_name, collapse = " + ")))
model <- lm(formula, data = dt)
R_2 <- summary(model)$adj.r.square #Ajuste del modelo
R_2 <- data.frame(R_2)
LF_t <- lillie.test(model$residuals)$p.value #Normalidad
LF_t <- data.frame(LF_t)
BP_t <- bptest(model)$p.value #Homocedasticidad
BP_c <- data.frame(BP_t)
value_list$R_2 <- c(value_list$R_2, R_2$R_2)
value_list$LF_t <- c(value_list$LF_t, LF_t$LF_t)
value_list$BP <- c(value_list$BP, BP_c$BP_t)
}
row_sums <- data.frame(rowSums(F3[, 1:ncol(F3)])) #Número de variables predictoras
colnames(row_sums) <- c("CI")
value_list$CI <- c(value_list$CI, row_sums$CI)
my_matrix <- do.call(rbind, value_list)
my_matrix <- t(my_matrix)
MD <- data.frame(my_matrix)
return(MD)
}Evaluación de parámetros estadísticos
filtros <- function(num_col_dat,data){
F0 <- Bin_matrix1(num_col_dat,data) #Matriz de modelos
F1 <- Con_Sig2(data,F0,0.001) # Consistencia / Significancia
F2 <- Ind(F1,data) #Independencia
F3 <- Coli(F2,data) # Colinealidad
models <- rownames(F3)
models <- paste0("M", models) #Construcción alternativas = modelos
DM <- MCDM_DM(F3,data) #Matriz de decisión inicial
rownames(DM) <- models
DM <- DM[DM$LF_t > 0.05, ] #Normalidad
DM <- DM[DM$BP > 0.05, ] #Homocedasticidad
DM <- subset(DM, select = c("CI", "R_2")) # Matriz de decisión preliminar
DM <- DM[DM$CI > 2, ] #Matriz de decisión final
return(DM)
}Matriz de modelos
## p_est_1 p_est_2 p_est_3 p_est_4 p_est_5 p_est_6 ICI tc
## 2 1 0 0 0 0 0 0 0
## 3 0 1 0 0 0 0 0 0
## 4 1 1 0 0 0 0 0 0
## 5 0 0 1 0 0 0 0 0
## 6 1 0 1 0 0 0 0 0
## 7 0 1 1 0 0 0 0 0
## 8 1 1 1 0 0 0 0 0
## 9 0 0 0 1 0 0 0 0
## 10 1 0 0 1 0 0 0 0
## 11 0 1 0 1 0 0 0 0
## 12 1 1 0 1 0 0 0 0
## 13 0 0 1 1 0 0 0 0
## 14 1 0 1 1 0 0 0 0
## 15 0 1 1 1 0 0 0 0
## 16 1 1 1 1 0 0 0 0
## 17 0 0 0 0 1 0 0 0
## 18 1 0 0 0 1 0 0 0
## 19 0 1 0 0 1 0 0 0
## 20 1 1 0 0 1 0 0 0
## 21 0 0 1 0 1 0 0 0
## 22 1 0 1 0 1 0 0 0
## 23 0 1 1 0 1 0 0 0
## 24 1 1 1 0 1 0 0 0
## 25 0 0 0 1 1 0 0 0
## 26 1 0 0 1 1 0 0 0
## 27 0 1 0 1 1 0 0 0
## 28 1 1 0 1 1 0 0 0
## 29 0 0 1 1 1 0 0 0
## 30 1 0 1 1 1 0 0 0
## 31 0 1 1 1 1 0 0 0
## 32 1 1 1 1 1 0 0 0
## 33 0 0 0 0 0 1 0 0
## 34 1 0 0 0 0 1 0 0
## 35 0 1 0 0 0 1 0 0
## 36 1 1 0 0 0 1 0 0
## 37 0 0 1 0 0 1 0 0
## 38 1 0 1 0 0 1 0 0
## 39 0 1 1 0 0 1 0 0
## 40 1 1 1 0 0 1 0 0
## 41 0 0 0 1 0 1 0 0
## 42 1 0 0 1 0 1 0 0
## 43 0 1 0 1 0 1 0 0
## 44 1 1 0 1 0 1 0 0
## 45 0 0 1 1 0 1 0 0
## 46 1 0 1 1 0 1 0 0
## 47 0 1 1 1 0 1 0 0
## 48 1 1 1 1 0 1 0 0
## 49 0 0 0 0 1 1 0 0
## 50 1 0 0 0 1 1 0 0
## 51 0 1 0 0 1 1 0 0
## 52 1 1 0 0 1 1 0 0
## 53 0 0 1 0 1 1 0 0
## 54 1 0 1 0 1 1 0 0
## 55 0 1 1 0 1 1 0 0
## 56 1 1 1 0 1 1 0 0
## 57 0 0 0 1 1 1 0 0
## 58 1 0 0 1 1 1 0 0
## 59 0 1 0 1 1 1 0 0
## 60 1 1 0 1 1 1 0 0
## 61 0 0 1 1 1 1 0 0
## 62 1 0 1 1 1 1 0 0
## 63 0 1 1 1 1 1 0 0
## 64 1 1 1 1 1 1 0 0
## 65 0 0 0 0 0 0 1 0
## 66 1 0 0 0 0 0 1 0
## 67 0 1 0 0 0 0 1 0
## 68 1 1 0 0 0 0 1 0
## 69 0 0 1 0 0 0 1 0
## 70 1 0 1 0 0 0 1 0
## 71 0 1 1 0 0 0 1 0
## 72 1 1 1 0 0 0 1 0
## 73 0 0 0 1 0 0 1 0
## 74 1 0 0 1 0 0 1 0
## 75 0 1 0 1 0 0 1 0
## 76 1 1 0 1 0 0 1 0
## 77 0 0 1 1 0 0 1 0
## 78 1 0 1 1 0 0 1 0
## 79 0 1 1 1 0 0 1 0
## 80 1 1 1 1 0 0 1 0
## 81 0 0 0 0 1 0 1 0
## 82 1 0 0 0 1 0 1 0
## 83 0 1 0 0 1 0 1 0
## 84 1 1 0 0 1 0 1 0
## 85 0 0 1 0 1 0 1 0
## 86 1 0 1 0 1 0 1 0
## 87 0 1 1 0 1 0 1 0
## 88 1 1 1 0 1 0 1 0
## 89 0 0 0 1 1 0 1 0
## 90 1 0 0 1 1 0 1 0
## 91 0 1 0 1 1 0 1 0
## 92 1 1 0 1 1 0 1 0
## 93 0 0 1 1 1 0 1 0
## 94 1 0 1 1 1 0 1 0
## 95 0 1 1 1 1 0 1 0
## 96 1 1 1 1 1 0 1 0
## 97 0 0 0 0 0 1 1 0
## 98 1 0 0 0 0 1 1 0
## 99 0 1 0 0 0 1 1 0
## 100 1 1 0 0 0 1 1 0
## 101 0 0 1 0 0 1 1 0
## 102 1 0 1 0 0 1 1 0
## 103 0 1 1 0 0 1 1 0
## 104 1 1 1 0 0 1 1 0
## 105 0 0 0 1 0 1 1 0
## 106 1 0 0 1 0 1 1 0
## 107 0 1 0 1 0 1 1 0
## 108 1 1 0 1 0 1 1 0
## 109 0 0 1 1 0 1 1 0
## 110 1 0 1 1 0 1 1 0
## 111 0 1 1 1 0 1 1 0
## 112 1 1 1 1 0 1 1 0
## 113 0 0 0 0 1 1 1 0
## 114 1 0 0 0 1 1 1 0
## 115 0 1 0 0 1 1 1 0
## 116 1 1 0 0 1 1 1 0
## 117 0 0 1 0 1 1 1 0
## 118 1 0 1 0 1 1 1 0
## 119 0 1 1 0 1 1 1 0
## 120 1 1 1 0 1 1 1 0
## 121 0 0 0 1 1 1 1 0
## 122 1 0 0 1 1 1 1 0
## 123 0 1 0 1 1 1 1 0
## 124 1 1 0 1 1 1 1 0
## 125 0 0 1 1 1 1 1 0
## 126 1 0 1 1 1 1 1 0
## 127 0 1 1 1 1 1 1 0
## 128 1 1 1 1 1 1 1 0
## 129 0 0 0 0 0 0 0 1
## 130 1 0 0 0 0 0 0 1
## 131 0 1 0 0 0 0 0 1
## 132 1 1 0 0 0 0 0 1
## 133 0 0 1 0 0 0 0 1
## 134 1 0 1 0 0 0 0 1
## 135 0 1 1 0 0 0 0 1
## 136 1 1 1 0 0 0 0 1
## 137 0 0 0 1 0 0 0 1
## 138 1 0 0 1 0 0 0 1
## 139 0 1 0 1 0 0 0 1
## 140 1 1 0 1 0 0 0 1
## 141 0 0 1 1 0 0 0 1
## 142 1 0 1 1 0 0 0 1
## 143 0 1 1 1 0 0 0 1
## 144 1 1 1 1 0 0 0 1
## 145 0 0 0 0 1 0 0 1
## 146 1 0 0 0 1 0 0 1
## 147 0 1 0 0 1 0 0 1
## 148 1 1 0 0 1 0 0 1
## 149 0 0 1 0 1 0 0 1
## 150 1 0 1 0 1 0 0 1
## 151 0 1 1 0 1 0 0 1
## 152 1 1 1 0 1 0 0 1
## 153 0 0 0 1 1 0 0 1
## 154 1 0 0 1 1 0 0 1
## 155 0 1 0 1 1 0 0 1
## 156 1 1 0 1 1 0 0 1
## 157 0 0 1 1 1 0 0 1
## 158 1 0 1 1 1 0 0 1
## 159 0 1 1 1 1 0 0 1
## 160 1 1 1 1 1 0 0 1
## 161 0 0 0 0 0 1 0 1
## 162 1 0 0 0 0 1 0 1
## 163 0 1 0 0 0 1 0 1
## 164 1 1 0 0 0 1 0 1
## 165 0 0 1 0 0 1 0 1
## 166 1 0 1 0 0 1 0 1
## 167 0 1 1 0 0 1 0 1
## 168 1 1 1 0 0 1 0 1
## 169 0 0 0 1 0 1 0 1
## 170 1 0 0 1 0 1 0 1
## 171 0 1 0 1 0 1 0 1
## 172 1 1 0 1 0 1 0 1
## 173 0 0 1 1 0 1 0 1
## 174 1 0 1 1 0 1 0 1
## 175 0 1 1 1 0 1 0 1
## 176 1 1 1 1 0 1 0 1
## 177 0 0 0 0 1 1 0 1
## 178 1 0 0 0 1 1 0 1
## 179 0 1 0 0 1 1 0 1
## 180 1 1 0 0 1 1 0 1
## 181 0 0 1 0 1 1 0 1
## 182 1 0 1 0 1 1 0 1
## 183 0 1 1 0 1 1 0 1
## 184 1 1 1 0 1 1 0 1
## 185 0 0 0 1 1 1 0 1
## 186 1 0 0 1 1 1 0 1
## 187 0 1 0 1 1 1 0 1
## 188 1 1 0 1 1 1 0 1
## 189 0 0 1 1 1 1 0 1
## 190 1 0 1 1 1 1 0 1
## 191 0 1 1 1 1 1 0 1
## 192 1 1 1 1 1 1 0 1
## 193 0 0 0 0 0 0 1 1
## 194 1 0 0 0 0 0 1 1
## 195 0 1 0 0 0 0 1 1
## 196 1 1 0 0 0 0 1 1
## 197 0 0 1 0 0 0 1 1
## 198 1 0 1 0 0 0 1 1
## 199 0 1 1 0 0 0 1 1
## 200 1 1 1 0 0 0 1 1
## 201 0 0 0 1 0 0 1 1
## 202 1 0 0 1 0 0 1 1
## 203 0 1 0 1 0 0 1 1
## 204 1 1 0 1 0 0 1 1
## 205 0 0 1 1 0 0 1 1
## 206 1 0 1 1 0 0 1 1
## 207 0 1 1 1 0 0 1 1
## 208 1 1 1 1 0 0 1 1
## 209 0 0 0 0 1 0 1 1
## 210 1 0 0 0 1 0 1 1
## 211 0 1 0 0 1 0 1 1
## 212 1 1 0 0 1 0 1 1
## 213 0 0 1 0 1 0 1 1
## 214 1 0 1 0 1 0 1 1
## 215 0 1 1 0 1 0 1 1
## 216 1 1 1 0 1 0 1 1
## 217 0 0 0 1 1 0 1 1
## 218 1 0 0 1 1 0 1 1
## 219 0 1 0 1 1 0 1 1
## 220 1 1 0 1 1 0 1 1
## 221 0 0 1 1 1 0 1 1
## 222 1 0 1 1 1 0 1 1
## 223 0 1 1 1 1 0 1 1
## 224 1 1 1 1 1 0 1 1
## 225 0 0 0 0 0 1 1 1
## 226 1 0 0 0 0 1 1 1
## 227 0 1 0 0 0 1 1 1
## 228 1 1 0 0 0 1 1 1
## 229 0 0 1 0 0 1 1 1
## 230 1 0 1 0 0 1 1 1
## 231 0 1 1 0 0 1 1 1
## 232 1 1 1 0 0 1 1 1
## 233 0 0 0 1 0 1 1 1
## 234 1 0 0 1 0 1 1 1
## 235 0 1 0 1 0 1 1 1
## 236 1 1 0 1 0 1 1 1
## 237 0 0 1 1 0 1 1 1
## 238 1 0 1 1 0 1 1 1
## 239 0 1 1 1 0 1 1 1
## 240 1 1 1 1 0 1 1 1
## 241 0 0 0 0 1 1 1 1
## 242 1 0 0 0 1 1 1 1
## 243 0 1 0 0 1 1 1 1
## 244 1 1 0 0 1 1 1 1
## 245 0 0 1 0 1 1 1 1
## 246 1 0 1 0 1 1 1 1
## 247 0 1 1 0 1 1 1 1
## 248 1 1 1 0 1 1 1 1
## 249 0 0 0 1 1 1 1 1
## 250 1 0 0 1 1 1 1 1
## 251 0 1 0 1 1 1 1 1
## 252 1 1 0 1 1 1 1 1
## 253 0 0 1 1 1 1 1 1
## 254 1 0 1 1 1 1 1 1
## 255 0 1 1 1 1 1 1 1
## 256 1 1 1 1 1 1 1 1Matriz de decisión
## CI R_2
## M12 3 0.8164968
## M26 3 0.7904781
## M28 4 0.8184871
## M36 3 0.8134841
## M40 4 0.8183801
## M42 3 0.7871196
## M45 3 0.3919865
## M46 4 0.7981911
## M57 3 0.3236553
## M58 4 0.7991409
## M61 4 0.4956456
## M62 5 0.8185941
## M63 5 0.8185941
## M68 3 0.8179068
## M70 3 0.8084675
## M78 4 0.8119636
## M98 3 0.7986807
## M101 3 0.4874923
## M102 4 0.8175513
## M103 4 0.7930406
## M109 4 0.4916882
## M111 5 0.8089342
## M117 4 0.4935479
## M119 5 0.8141906
## M135 3 0.8083349
## M138 3 0.8151268
## M139 3 0.8008973
## M143 4 0.8130738
## M158 5 0.8184438
## M159 5 0.8154748
## M162 3 0.8174527
## M163 3 0.8121166
## M167 4 0.8142787
## M169 3 0.7084288
## M177 3 0.7096656
## M181 4 0.7153670
## M185 4 0.7202776
## M194 3 0.8151507
## M198 4 0.8186436
## M199 4 0.8158468
## M225 3 0.7171535
## M241 4 0.7196106Método de cálculo de pesos para MCDM
Norm <- function(A, n) {
num_A <- nrow(A)
num_C <- ncol(A)
A_norm <- matrix(0, nrow = num_A, ncol = num_C)
suma <- numeric(num_C)
for (j in 1:num_C) {
for (i in 1:num_A) {
suma[j] <- suma[j] + A[i, j]^n
}
}
for (j in 1:num_C) {
for (i in 1:num_A) {
A_norm[i, j] <- A[i, j] / suma[j]^(1/n)
}
}
return(A_norm)
}Entropía de Shannon
#Pesos de los criterios: Entropía de Shannon
Entropy <- function(A) {
num_A <- nrow(A)
num_C <- ncol(A)
A_norm <- Norm(A, 1)
E <- numeric(num_C)
D <- numeric(num_C)
for (j in 1:num_C) {
for (i in 1:num_A) {
E[j] <- E[j] + A_norm[i, j] * log(A_norm[i, j])/log(num_A)
}
D[j] <- 1 + E[j]
}
w <- numeric(num_C)
for (j in 1:num_C) {
w[j] <- D[j] / sum(D)
}
return(w)
}Multicriteria Decision Making Method (MCDM): TOPSIS
# Normalización (Matriz de decisión)
Norm_improved <- function(A, Atri) {
num_A <- nrow(A)
num_C <- ncol(A)
A_norm <- matrix(0, nrow = num_A, ncol = num_C)
L <- apply(A, ncol(A), min) # 2 indicates columns
U <- apply(A, ncol(A), max)
for (j in 1:num_C) {
for (i in 1:num_A) {
if (Atri[j] == 0) {
A_norm[i, j] <- (U[j] - A[i, j]) / (U[j] - L[j])
} else if (Atri[j] == 1) {
A_norm[i, j] <- (A[i, j] - L[j]) / (U[j] - L[j])
}
}
}
return(A_norm)
}#Ponderación (Matriz de decisión)
Pond <- function(A_norm, W) {
num_A <- nrow(A_norm)
num_C <- ncol(A_norm)
A_pond <- matrix(0, nrow = num_A, ncol = num_C)
for (i in 1:num_A) {
for (j in 1:num_C) {
A_pond[i, j] <- A_norm[i, j] * W[j]
}
}
return(A_pond)
}#Solución ideal y antideal (TOPSIS)
Ideal_solution_improved <- function(A, Atri, W) {
PIS <- W
NIS <- numeric(ncol(A))
return(list(PIS, NIS))
}#Índice de proximidad relativa (TOPSIS)
Similiraty_ratio <- function(A_pond, PIS, NIS) {
num_A <- nrow(A_pond)
num_C <- ncol(A_pond)
Sp <- numeric(num_A) #rep(0, num_A)
Sn <- numeric(num_A)
Sr <- numeric(num_A)
for (i in 1:num_A) {
for (j in 1:num_C) {
Sp[i] <- Sp[i] + (PIS[j] - A_pond[i, j])^2
Sn[i] <- Sn[i] + (NIS[j] - A_pond[i, j])^2
}
Sp[i] <- sqrt(Sp[i])
Sn[i] <- sqrt(Sn[i])
Sr[i] <- Sn[i] / (Sp[i] + Sn[i])
}
return(Sr)
}#Función auxiliar No.1
Ordenar <- function(Ranking, Alt) {
num_A <- length(Ranking)
Res <- cbind(data.frame(Modelos = Alt),data.frame(Ranking= seq(1,length(Ranking))), data.frame(Dominancia = Ranking))
Res <- Res[order(-Res$Dominancia, Res$Modelos), ]
Res$Ranking <- 1:num_A
print(Res)
return(Res)
}#Evaluación de pesos en el caso de tener múltiples escenarios
Pesos_Escenarios <- function(Escenario, A, dex) {
Escenarios <- unique(Escenario)
s <- length(Escenarios) + 2
num_C <- ncol(A)
W <- matrix(0, nrow = s, ncol = num_C)
W[1,] <- Entropy(A)
W[2,] <- rep(1 / num_C, num_C)
for (i in 1:(s - 2)) {
suma_pertenece <- 0
No_pertenece <- 0
for (j in 1:num_C) {
if (Escenarios[i] == Escenario[j]) {
suma_pertenece <- suma_pertenece + W[1, j]
} else {
No_pertenece <- No_pertenece + 1
}
}
for (j in 1:num_C) {
if (Escenarios[i] == Escenario[j]) {
W[i + 2, j] <- dex * (W[1, j] / suma_pertenece)
} else {
W[i + 2, j] <- (1 - dex) / No_pertenece
}
}
}
Escenarios <- c("Base", "Homogéneo", Escenarios)
return(list(Escenarios, W))
}#Evaluación de pesos en el caso de tener múltiples escenarios
pesos_casos_escenarios <- function(Criterios, Escenarios, Matriz_D, des_pesos, index) {
result <- Pesos_Escenarios(Escenarios, Matriz_D, des_pesos)
A <- result[[2]]
A <- A[match(index, result[[1]]), ]
return(A)
}# MCDM TOPSIS
TOPSIS_improved_No2 <- function(Alternativas, Criterios, A, Escenarios, Atri, des_pesos, index) {
W <- pesos_casos_escenarios(Criterios, Escenarios, A, des_pesos, index)
A_norm <- Norm_improved(A, Atri)
A_pond <- Pond(A_norm, W)
PIS_NIS <- Ideal_solution_improved(A, Atri, W)
PIS <- PIS_NIS[[1]]
NIS <- PIS_NIS[[2]]
Sr <- Similiraty_ratio(A_pond, PIS, NIS)
Ranking <- Ordenar(Sr, rownames(A))
Pesos_W <- data.frame(W)
colnames(Pesos_W) <- c("Pesos")
rownames(Pesos_W) <- Criterios
print(Pesos_W)
return(Ranking)
}Resultados: Selección del mejor modelo de regresión lineal múltiple
#Evaluación de la estrategia propuesta
Alternativas_E <- rownames(DM)
Criterios_E <- c("CI", "R_2") #Nombre de los criterios
Atributo_E <- c(0, 1) #Asignación de atributo (0: Negativo, 1: Positivo)
Escenario_E <- c("Estadístico", "Estadístico") #Nota: Definir cuando se tienen criterios de diferente naturaleza
D_Matrix <- as.matrix(DM) #Matriz de decisión (Numérica)
Rankeo <- TOPSIS_improved_No2(Alternativas_E, Criterios_E, D_Matrix, Escenario_E, Atributo_E, 0.8, 'Base')## Modelos Ranking Dominancia
## 14 M68 1 0.9989709
## 31 M162 2 0.9983370
## 1 M12 3 0.9970033
## 38 M194 4 0.9951270
## 26 M138 5 0.9950938
## 4 M36 6 0.9928072
## 32 M163 7 0.9909061
## 15 M70 8 0.9858445
## 25 M135 9 0.9856608
## 27 M139 10 0.9753965
## 17 M98 11 0.9723507
## 2 M26 12 0.9611341
## 6 M42 13 0.9565663
## 41 M225 14 0.8648864
## 35 M177 15 0.8554910
## 34 M169 16 0.8539474
## 39 M198 17 0.6835930
## 3 M28 18 0.6835393
## 5 M40 19 0.6835024
## 19 M102 20 0.6832157
## 40 M199 21 0.6826177
## 33 M167 22 0.6820577
## 28 M143 23 0.6816210
## 16 M78 24 0.6812136
## 10 M58 25 0.6761611
## 8 M46 26 0.6757614
## 20 M103 27 0.6735320
## 37 M185 28 0.6312462
## 42 M241 29 0.6307709
## 36 M181 30 0.6277140
## 18 M101 31 0.6208564
## 7 M45 32 0.5499774
## 9 M57 33 0.5108394
## 12 M62 34 0.4891356
## 13 M63 35 0.4891356
## 29 M158 36 0.4890597
## 30 M159 37 0.4875512
## 24 M119 38 0.4868934
## 22 M111 39 0.4841675
## 11 M61 40 0.4287273
## 23 M117 41 0.4268447
## 21 M109 42 0.4251824
## Pesos
## CI 0.5108394
## R_2 0.4891606Modelo seleccionado por el método propuesto: “M68”
sf <- Fm[sub("^M", "", Rankeo$Modelos[1]),]
mol <- which(sf == 1)
column_name <- names(sf)[mol]
form <- as.formula(paste("price ~", paste(column_name, collapse = " + ")))
modl <- lm(form, data = data)
summary(modl)##
## Call:
## lm(formula = form, data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -61427213 -14049016 414440 14118744 65227048
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 269735513 3333387 80.919 < 0.0000000000000002 ***
## p_est_1 -374225391 5621078 -66.575 < 0.0000000000000002 ***
## p_est_2 -74323834 5460861 -13.610 < 0.0000000000000002 ***
## ICI 201699342 25712768 7.844 0.00000000000000822 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 20860000 on 1496 degrees of freedom
## Multiple R-squared: 0.8183, Adjusted R-squared: 0.8179
## F-statistic: 2245 on 3 and 1496 DF, p-value: < 0.00000000000000022