Advertisement
edo99_

Untitled

Apr 25th, 2023
99
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
R 7.99 KB | None | 0 0
  1.  
  2.  
  3.  
  4.  
  5. #--- Motecarlo ---#
  6. library(glmnet)
  7. library(mvtnorm)
  8. library(Matrix)
  9. # Functions
  10.  
  11. correlation_matrix <- function(p) {
  12.   a = runif(1,0.1,0.9)
  13.   b = runif(1,0.1,0.9)
  14.   corr_min = min(a,b)
  15.   corr_max = max(a,b)
  16.  
  17.   Sigma <- diag(1, p)
  18.   Sigma[lower.tri(Sigma)] <- runif((p^2-p)/2, corr_min, corr_max)
  19.   Sigma[upper.tri(Sigma)] <- t(Sigma)[upper.tri(Sigma)]
  20.   Sigma
  21.   Sigma <- nearPD(Sigma, corr = TRUE, keepDiag = TRUE) # trova la matrice definita positiva più vicina alla matrice di input utilizzando l’algoritmo di Higham
  22.   Sigma$mat
  23.   return(list(matrix = Sigma$mat, mean_correlation = mean(Sigma$mat[upper.tri(Sigma$mat)]))) # restituisce matrice e correlazione media delle variabili
  24. }
  25.  
  26.  
  27. # Data generating process
  28. nsim <- 500 # numero simulazioni
  29. n <- 200 # numero osservazioni
  30. p <- 100 # numero varaibili indipendenti
  31. significative <- 20 # numero variabili indipendenti significative
  32. beta_vector <- runif(p,-5,5)
  33. # beta_value <- 8 # valore del coeff beta
  34. # beta_vector <- c(rep(beta_value, significative), rep(0,p-significative)) # vettore dei beta
  35. sigma_X <- (1/n)^.5 # deviazione standard della distribuzione normale utilizzata per generare le variabili indipendenti
  36. sigma_epsilon <- 1 # deviazione standard della distribuzione normale utilizzata per generare l'errore
  37.  
  38. df <- data.frame(mean_sigma_inv = numeric(0), mean_correlation = numeric(0), determinant = numeric(0), mse_ols = numeric(0), mse_ridge = numeric(0), optimal_lambda = numeric(0))
  39.  
  40. for (i in 1:nsim){
  41.   set.seed(i+1)
  42.  
  43.   # Sigma <- clusterGeneration::rcorrmatrix(p, alphad=1) # matrice di varianza e covarianza che rappresenta appunto la correlazione tra le p variabili indipendenti
  44.   res <- correlation_matrix(p)
  45.   Sigma <- as.matrix(res[1]$matrix)
  46.   mean_corr <- res[2]
  47.   Sigma
  48.   mean_corr
  49.  
  50.   # Multicollinearità
  51.   determinant <- det(Sigma) # http://www.stat.unipg.it/~bart/metodi/lezione14.pdf Quando c’è una forte correlazione tra due o più variabili esplicative in un modello di regressione, il determinante della matrice di varianza e covarianza può diventare molto piccolo
  52.  
  53.   Sigma_inv <- solve(Sigma) # Matrice inversa
  54.   mean_sigma_inv <- mean(Sigma_inv[upper.tri(Sigma_inv)])
  55.   mean_sigma_inv
  56.  
  57.   epsilon <- rnorm(n,0,sigma_epsilon) # genero l'errore da una normale N(0,1)
  58.   X <- mvtnorm::rmvnorm(n,sigma = Sigma) # genero la matrice di dati nxp, ogni riga rappresenta un'osservazione, ogni colonna una variabile indipendente
  59.   Y <- X%*%beta_vector + epsilon # genero la variabile dipendente come combinazione lineare delle X e del vettore dei beta con l'aggiunta di un errore
  60.  
  61.   # OLS Estimator
  62.   fit.ols <- lm(Y ~ X)
  63.   summary(fit.ols)
  64.   stime_ols <- fit.ols$coefficients
  65.   stime_ols
  66.  
  67.   # Scelgo il lambda ottimale mediante CV
  68.   cv.ridge <- cv.glmnet(x=X,y=Y,family="gaussian", alpha=0)
  69.   # cv.ridge <- cv.glmnet(x[train,],y[train], nfolds = 10, type.measure = "mse",alpha=0)
  70.   # plot(cv.ridge)
  71.   optimal_lambda <- cv.ridge$lambda.min
  72.   optimal_lambda
  73.  
  74.   # Ridge Estimator
  75.   # Prova senza family
  76.   fit.ridge <- glmnet(x=X,y=Y,family="gaussian", alpha=0, lambda = optimal_lambda)
  77.   stime_ridge <- fit.ridge$beta
  78.  
  79.   # MSE
  80.   mse_ols <- mean((stime_ols[-1] - beta_vector)^2) # il primo valore in stime_ols è l'intercetta (?)
  81.  
  82.   mse_ridge <- mean((stime_ridge - beta_vector)^2)
  83.  
  84.   new_row <- data.frame(mean_sigma_inv=mean_sigma_inv,mean_correlation=mean_corr, determinant = determinant, mse_ols = mse_ols, mse_ridge = mse_ridge, optimal_lambda=optimal_lambda)
  85.   df <- rbind(df, new_row)
  86. }
  87.  
  88.  
  89. library(ggplot2)
  90. plot(df$mean_correlation, df$mse_ols)
  91. plot(df$mean_correlation, df$mse_ridge)
  92.  
  93. ggplot(df, aes(x = df$determinant)) +
  94.   geom_point(aes(y = df$determinant), color = "red", alpha=0.7) +
  95.   scale_y_log10()
  96.  
  97. ggplot(df, aes(x = df$mean_correlation)) +
  98.   geom_point(aes(y = df$mse_ols), color = "red", alpha=0.7) +
  99.   geom_point(aes(y = df$mse_ridge), color = "blue",alpha=0.3) +
  100.   geom_smooth(aes(y = df$mse_ols), color = "red", alpha=0.7) +
  101.   geom_smooth(aes(y = df$mse_ridge), color = "blue",alpha=0.3) +
  102.   scale_y_log10()
  103.  
  104.  
  105. ggplot(df, aes(x = df$mean_sigma_inv)) +
  106.   geom_point(aes(y = df$mse_ols), color = "red", alpha=0.7) +
  107.   geom_point(aes(y = df$mse_ridge), color = "blue",alpha=0.3) +
  108.   geom_smooth(aes(y = df$mse_ols), color = "red", alpha=0.7) +
  109.   geom_smooth(aes(y = df$mse_ridge), color = "blue",alpha=0.3) +
  110.   scale_y_log10()
  111.  
  112. ggplot(df, aes(x = df$mean_sigma_inv)) +
  113.   geom_point(aes(y = df$mse_ols), color = "red", alpha=0.7) +
  114.   geom_point(aes(y = df$mse_ridge), color = "blue",alpha=0.3) +
  115.   geom_smooth(aes(y = df$mse_ols), color = "red", alpha=0.7) +
  116.   geom_smooth(aes(y = df$mse_ridge), color = "blue",alpha=0.3)
  117.  
  118. ggplot(df, aes(x = df$determinant)) +
  119.   geom_point(aes(y = df$mse_ols), color = "red", alpha=0.7) +
  120.   geom_point(aes(y = df$mse_ridge), color = "blue",alpha=0.3) +
  121.   geom_smooth(aes(y = df$mse_ols), color = "red", alpha=0.7) +
  122.   geom_smooth(aes(y = df$mse_ridge), color = "blue",alpha=0.3)
  123.  
  124. ggplot(df, aes(x = df$mean_correlation)) +
  125.   geom_point(aes(y = df$optimal_lambda), color = "red", alpha=0.7) +
  126.   geom_smooth(aes(y = df$optimal_lambda), color = "red",alpha=0.3) +
  127.   scale_y_log10()
  128.  
  129. ggplot(df, aes(x = df$mean_sigma_inv)) +
  130.   geom_point(aes(y = df$optimal_lambda), color = "red", alpha=0.7) +
  131.   geom_smooth(aes(y = df$optimal_lambda), color = "red",alpha=0.3) +
  132.   scale_y_log10()
  133.  
  134.  
  135. # La multicollinearità va guardata sull'inversa
  136. # Posso calcolare il determinante della matrie inversa per capire il livello di correlazione
  137.  
  138.  
  139.  
  140.  
  141. # --- Scenario 2 --- #
  142. library(glmnet)
  143. library(mvtnorm)
  144. library(Matrix) # Per trovare la semidefinita positiva piu vicina
  145. # Functions
  146.  
  147. correlation_matrix <- function(p) {
  148.   a = runif(1,0.1,0.9)
  149.   b = runif(1,0.1,0.9)
  150.   corr_min = min(a,b)
  151.   corr_max = max(a,b)
  152.  
  153.   Sigma <- diag(1, p)
  154.   Sigma[lower.tri(Sigma)] <- runif((p^2-p)/2, corr_min, corr_max)
  155.   Sigma[upper.tri(Sigma)] <- t(Sigma)[upper.tri(Sigma)]
  156.   Sigma
  157.   Sigma <- nearPD(Sigma, corr = TRUE, keepDiag = TRUE) # trova la matrice definita positiva più vicina alla matrice di input utilizzando l’algoritmo di Higham
  158.   Sigma$mat
  159.   return(Sigma$mat) # restituisce matrice e correlazione media delle variabili
  160. }
  161.  
  162. # Data generating process
  163. nsim <- 500 # numero simulazioni
  164. n <- 100 # numero osservazioni
  165. p <- 200 # numero varaibili indipendenti
  166. significative <- 20 # numero variabili indipendenti significative
  167. beta_vector <- runif(p,-5,5)
  168. # beta_value <- 8 # valore del coeff beta
  169. # beta_vector <- c(rep(beta_value, significative), rep(0,p-significative)) # vettore dei beta
  170. sigma_X <- (1/n)^.5 # deviazione standard della distribuzione normale utilizzata per generare le variabili indipendenti
  171. sigma_epsilon <- 1 # deviazione standard della distribuzione normale utilizzata per generare l'errore
  172.  
  173. df <- data.frame(mse_ridge=numeric(0),mse_lasso=numeric(0))
  174.  
  175. for (i in 1:nsim){
  176.   set.seed(i+1)
  177.  
  178.   # Sigma <- clusterGeneration::rcorrmatrix(p, alphad=1) # matrice di varianza e covarianza che rappresenta appunto la correlazione tra le p variabili indipendenti
  179.   Sigma <- correlation_matrix(p)
  180.   Sigma <- as.matrix(Sigma)
  181.   Sigma
  182.  
  183.   epsilon <- rnorm(n,0,sigma_epsilon) # genero l'errore da una normale N(0,1)
  184.   X <- mvtnorm::rmvnorm(n,sigma = Sigma) # genero la matrice di dati nxp, ogni riga rappresenta un'osservazione, ogni colonna una variabile indipendente
  185.   Y <- X%*%beta_vector + epsilon # genero la variabile dipendente come combinazione lineare delle X e del vettore dei beta con l'aggiunta di un errore
  186.  
  187.   # Ridge Estimator
  188.   fit.ridge <- glmnet(x=X,y=Y, alpha=0)
  189.   stime_ridge <- fit.ridge$beta
  190.  
  191.   # Lasso Estimator
  192.   fit.lasso <- glmnet(x=X,y=Y, alpha=1)
  193.   stime_lasso <- fit.lasso$beta
  194.   stime_lasso
  195.  
  196.  
  197.   # MSE
  198.   mse_ridge <- mean((stime_ridge - beta_vector)^2)
  199.   mse_lasso <- mean((stime_lasso - beta_vector)^2)
  200.   new_row <- data.frame(mse_ridge=mse_ridge,mse_lasso=mse_lasso)
  201.   df <- rbind(df, new_row)
  202. }
  203.  
  204. mean_mse_ridge <- mean(df$mse_ridge)
  205. mean_mse_lasso <- mean(df$mse_lasso)
  206. mean_mse_ridge
  207. mean_mse_lasso
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement