Advertisement
edo99_

Untitled

Apr 24th, 2023
98
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
R 3.66 KB | None | 0 0
  1.  
  2.  
  3. #--- Motecarlo ---#
  4. library(glmnet)
  5. library(mvtnorm)
  6. library(Matrix)
  7. # Functions
  8.  
  9. correlation_matrix <- function(p) {
  10.   a = runif(1,0.1,0.9)
  11.   b = runif(1,0.1,0.9)
  12.   corr_min = min(a,b)
  13.   corr_max = max(a,b)
  14.  
  15.   Sigma <- diag(1, p)
  16.   Sigma[lower.tri(Sigma)] <- runif((p^2-p)/2, corr_min, corr_max)
  17.   Sigma[upper.tri(Sigma)] <- t(Sigma)[upper.tri(Sigma)]
  18.   Sigma
  19.   Sigma <- nearPD(Sigma, corr = TRUE, keepDiag = TRUE) # trova la matrice definita positiva più vicina alla matrice di input utilizzando l’algoritmo di Higham
  20.   Sigma$mat
  21.   return(list(matrix = Sigma$mat, mean_correlation = mean(Sigma$mat[upper.tri(Sigma$mat)]))) # restituisce matrice e correlazione media delle variabili
  22. }
  23.  
  24.  
  25. # Data generating process
  26. nsim <- 100 # numero simulazioni
  27. n <- 50 # numero osservazioni
  28. p <- 20 # numero varaibili indipendenti
  29. significative <- 20 # numero variabili indipendenti significative
  30. beta_vector <- runif(p,-5,5)
  31. # beta_value <- 8 # valore del coeff beta
  32. # beta_vector <- c(rep(beta_value, significative), rep(0,p-significative)) # vettore dei beta
  33. sigma_X <- (1/n)^.5 # deviazione standard della distribuzione normale utilizzata per generare le variabili indipendenti
  34. sigma_epsilon <- 1 # deviazione standard della distribuzione normale utilizzata per generare l'errore
  35.  
  36. # mse_ols_list <- list()
  37. # mse_ridge_list <- list()
  38. # lambda_list <- list()
  39. # correlation_list <- list()
  40. df <- data.frame(correlation = numeric(0), mse_ols = numeric(0), mse_ridge = numeric(0), optimal_lambda = numeric(0))
  41.  
  42. for (i in 1:nsim){
  43.   set.seed(i+1)
  44.  
  45.   # Sigma1 <- clusterGeneration::rcorrmatrix(p, alphad=1) # matrice di varianza e covarianza che rappresenta appunto la correlazione tra le p variabili indipendenti
  46.   return <- correlation_matrix(p)
  47.   Sigma <- as.matrix(return[1]$matrix)
  48.   mean_corr <- return[2]
  49.   Sigma
  50.   mean_corr
  51.  
  52.   epsilon <- rnorm(n,0,sigma_epsilon) # genero l'errore da una normale N(0,1)
  53.   X <- mvtnorm::rmvnorm(n,sigma = Sigma) # genero la matrice di dati nxp, ogni riga rappresenta un'osservazione, ogni colonna una variabile indipendente
  54.   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
  55.  
  56.   # OLS Estimator
  57.   fit.ols <- lm(Y ~ X)
  58.   summary(fit.ols)
  59.   stime_ols <- fit.ols$coefficients
  60.   stime_ols
  61.  
  62.   # Scelgo il lambda ottimale mediante CV
  63.   cv.ridge <- cv.glmnet(x=X,y=Y,family="gaussian", alpha=0)
  64.   # cv.ridge <- cv.glmnet(x[train,],y[train], nfolds = 10, type.measure = "mse",alpha=0)
  65.   # plot(cv.ridge)
  66.   optimal_lambda <- cv.ridge$lambda.min
  67.   optimal_lambda
  68.  
  69.   # Ridge Estimator
  70.   fit.ridge <- glmnet(x=X,y=Y,family="gaussian", alpha=0, lambda = optimal_lambda)
  71.   stime_ridge <- fit.ridge$beta
  72.  
  73.   # MSE
  74.   mse_ols <- mean((stime_ols[-1] - beta_vector)^2) # il primo valore in stime_ols è l'intercetta (?)
  75.  
  76.   mse_ridge <- mean((stime_ridge - beta_vector)^2)
  77.  
  78.   new_row <- data.frame(correlation=mean_corr, mse_ols = mse_ols, mse_ridge = mse_ridge, optimal_lambda=optimal_lambda)
  79.   df <- rbind(df, new_row)
  80. }
  81.  
  82. library(ggplot2)
  83. plot(df$mean_correlation, df$mse_ols)
  84. plot(df$mean_correlation, df$mse_ridge)
  85.  
  86. ggplot(df, aes(x = df$mean_correlation)) +
  87.   geom_point(aes(y = df$mse_ols), color = "red", alpha=0.7) +
  88.   geom_point(aes(y = df$mse_ridge), color = "blue",alpha=0.3) +
  89.   geom_smooth(aes(y = df$mse_ols), color = "red", alpha=0.7) +
  90.   geom_smooth(aes(y = df$mse_ridge), color = "blue",alpha=0.3) +
  91.   scale_y_log10()
  92.  
  93.  
  94. ggplot(df, aes(x = df$mean_correlation)) +
  95.   geom_point(aes(y = df$optimal_lambda), color = "red", alpha=0.7) +
  96.   geom_smooth(aes(y = df$optimal_lambda), color = "red",alpha=0.3) +
  97.   scale_y_log10()
  98.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement