Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
ℹ Please use tidy evaluation idioms with `aes()`.
ℹ See also `vignette("ggplot2-in-packages")` for more information.
g_num <-grid.arrange(grobs = plot_list_num, ncol =3, top ="Distribuzione Variabili Numeriche")ggsave("plots_selection/01_Numerical_Variables.png", g_num, width =12, height =8)grid::grid.draw(g_num) # Mostra in console
# --- 2. Variabili Categoriche (Barplots 100% Stacked) ---plot_list_cat <-list()for(var in my_cat_vars) { p <-ggplot(df_train, aes_string(x=var, fill="Diagnosis")) +geom_bar(position="fill") +scale_y_continuous(labels = scales::percent) +scale_fill_manual(values=c("#66CC99", "#FF6666")) +labs(title = var, y ="%", x ="") +theme_minimal() +theme(legend.position ="none",axis.text.x =element_text(angle =45, hjust =1, size=8)) plot_list_cat[[var]] <- p}# Parte 1g_cat1 <-grid.arrange(grobs = plot_list_cat[1:5], ncol =3)ggsave("plots_selection/02_Categorical_Part1.png", g_cat1, width =12, height =8)grid::grid.draw(g_cat1) # Mostra in console
# Parte 2g_cat2 <-grid.arrange(grobs = plot_list_cat[6:length(plot_list_cat)], ncol =3)ggsave("plots_selection/03_Categorical_Part2.png", g_cat2, width =12, height =8)grid::grid.draw(g_cat2) # Mostra in console
# --- 3. Matrice di Correlazione ---vars_cor <-c(my_num_vars, "Diagnosis_Num")cor_matrix <-cor(df_train[, vars_cor], use ="complete.obs")melted_cor <-melt(cor_matrix)p_cor <-ggplot(data = melted_cor, aes(x=Var1, y=Var2, fill=value)) +geom_tile(color ="white") +geom_text(aes(label =round(value, 2)), size =3) +scale_fill_gradient2(low ="blue", high ="red", mid ="white", midpoint =0, limit =c(-1,1)) +labs(title="Matrice di Correlazione") +theme_minimal() +theme(axis.text.x =element_text(angle =45, vjust =1, hjust =1))ggsave("plots_selection/04_Correlation_Matrix.png", p_cor, width =8, height =7)print(p_cor) # Mostra in console
#densityplot_list <-list()df_plot <- df_trainfor(var in my_num_vars) { mu <- df_plot %>%group_by(Diagnosis) %>%summarise(grp.mean =mean(.data[[var]], na.rm =TRUE)) p <-ggplot(df_plot, aes_string(x = var, fill ="Diagnosis", color ="Diagnosis")) +geom_density(alpha =0.4) +geom_vline(data = mu, aes(xintercept = grp.mean, color = Diagnosis),linetype ="dashed", size =0.8) +scale_fill_manual(values =c("Benign"="#66CC99", "Malignant"="#FF6666")) +scale_color_manual(values =c("Benign"="#2E8B57", "Malignant"="#CD5C5C")) +labs(title =gsub("_", " ", var), x = var, y ="Densità") +theme_minimal() +theme(plot.title =element_text(size =12, face ="bold"),legend.position ="none") plot_list[[var]] <- p}
Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
ℹ Please use `linewidth` instead.
final_grid <-grid.arrange(grobs = plot_list, ncol =3, top ="Distribuzione Variabili Cliniche: Benigni vs Maligni")ggsave(filename ="Grafico_Densita_Numeriche.png", plot = final_grid, width =14, height =8)grid::grid.draw(final_grid) # Mostra in console
Warning: The `x` argument of `as_tibble.matrix()` must have unique column names if
`.name_repair` is omitted as of tibble 2.0.0.
ℹ Using compatibility `.name_repair`.
ℹ The deprecated feature was likely used in the clustrd package.
Please report the issue to the authors.
df_sample$C1_Kmeans <-factor(out_mca$cluster)# 2. Plot Interattivo 3D (Aggiornato per 4 colori)coords <-as.data.frame(out_mca$obscoord)colnames(coords) <-c("Dim1", "Dim2", "Dim3")coords$Cluster <- df_sample$C1_Kmeans# Ho aggiunto il colore VIOLA ("#984EA3") per il 4° clusterp <-plot_ly(coords, x =~Dim1, y =~Dim2, z =~Dim3, color =~Cluster, colors =c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3")) %>%add_markers(marker =list(size =3)) %>%layout(title ="Cluster 3D Interattivo (MCA - 4 Gruppi)",scene =list(xaxis =list(title ='Dim 1'),yaxis =list(title ='Dim 2'),zaxis =list(title ='Dim 3')))saveWidget(p, "Plots_Clustering_3D/Cluster_Interactive.html", selfcontained =TRUE)print(p) # Mostra nel Viewer# 3. Calcolo altri cluster (Coerenti a k=4)mca_coords_matrix <- out_mca$obscoord# GMM a 4 componentimod_gmm <-Mclust(mca_coords_matrix, G =4) df_sample$C3_GMM_MCA <-factor(mod_gmm$classification)# Gerarchico con taglio a 4dist_matrix <-dist(mca_coords_matrix)hc_fit <-hclust(dist_matrix, method ="ward.D2")df_sample$C2_Hierar <-factor(cutree(hc_fit, k =4))# Salvataggiosave(df_sample, out_mca, mod_gmm, file ="thyroid_clusters_ready.RData")write.csv(df_sample, "thyroid_clusters_ready.csv", row.names =FALSE)
# ==============================================================================# ANALISI DELLE CORRISPONDENZE MULTIPLE (MCA) - "CLASSICA"# ==============================================================================# 1. Caricamento Librerie dedicate# Se non le hai, installale con: install.packages(c("FactoMineR", "factoextra"))library(FactoMineR)
Warning: il pacchetto 'FactoMineR' è stato creato con R versione 4.5.2
library(factoextra)library(dplyr)# Creazione cartella per i grafici MCAdir.create("Plots_MCA_Analysis", showWarnings =FALSE)# 2. Preparazione del Dataset per MCA# Se df_sample non esiste, usa df_train (o ricarica i dati)if(!exists("df_sample")) {message("df_sample non trovato. Uso df_train o rigenero il campione...")# Assicurati di avere df_train caricato o scommenta la riga sotto se necessario:# df_sample <- df_train[sample(nrow(df_train), 5000), ] }# Selezioniamo solo le variabili categoriche di interesse + Diagnosivars_mca_target <-c("Gender", "Family_History", "Radiation_Exposure", "Iodine_Deficiency", "Smoking", "Obesity", "Diabetes", "Diagnosis") # Diagnosis messa per ultima# Creiamo un sotto-dataset pulito convertendo tutto in fattoridf_mca <- df_sample %>% dplyr::select(all_of(vars_mca_target)) %>%mutate_all(as.factor)# 3. Esecuzione MCA (FactoMineR)# 'quali.sup' indica l'indice della variabile supplementare (Diagnosis è l'ultima)# graph = FALSE evita di stampare i grafici di default grezziidx_diagnosis <-length(vars_mca_target)res_mca <-MCA(df_mca, quali.sup = idx_diagnosis, graph =FALSE)# ==============================================================================# 4. VISUALIZZAZIONE RISULTATI# ==============================================================================# A. Scree Plot (Percentuale di varianza spiegata dalle dimensioni)p_eig <-fviz_eig(res_mca, addlabels =TRUE, ylim =c(0, 15)) +labs(title ="Scree Plot - Varianza spiegata dalle Dimensioni MCA")
Warning in geom_bar(stat = "identity", fill = barfill, color = barcolor, :
Ignoring empty aesthetic: `width`.
print(p_eig)
ggsave("Plots_MCA_Analysis/00_Scree_Plot.png", p_eig, width =8, height =6)# B. Mappa delle Variabili (Categorie)# Mostra le associazioni tra i fattori di rischio.# Punti vicini = categorie che tendono a presentarsi insieme.p_vars <-fviz_mca_var(res_mca, choice ="var.cat", # Mostra le categorierepel =TRUE, # Evita sovrapposizione testocol.var ="contrib", # Colora per contributogradient.cols =c("#00AFBB", "#E7B800", "#FC4E07"),shape.var =15,ggtheme =theme_minimal()) +labs(title ="MCA - Mappa delle Categorie di Rischio",subtitle ="Le categorie vicine sono associate tra loro")print(p_vars)
ggsave("Plots_MCA_Analysis/01_Risk_Factors_Map.png", p_vars, width =10, height =8)# C. Biplot Individui colorati per Diagnosi# Proietta i pazienti sullo spazio MCA e colora in base alla diagnosi (variabile supplementare)# Le ellissi indicano l'area di confidenza del 95% per ciascun gruppo.p_ind <-fviz_mca_ind(res_mca, label ="none", # Nascondi etichette punti (troppo affollato)habillage ="Diagnosis", # Colora punti in base alla Diagnosipalette =c("#66CC99", "#FF6666"), # Verde (Benign), Rosso (Malignant)addEllipses =TRUE, # Aggiungi ellissiellipse.type ="confidence",alpha.ind =0.4, # Trasparenzaggtheme =theme_minimal()) +labs(title ="MCA - Separazione Pazienti Benigni vs Maligni",subtitle ="Sovrapposizione delle ellissi indica scarsa separabilità basata solo sui rischi")print(p_ind)
ggsave("Plots_MCA_Analysis/02_Patients_Separation.png", p_ind, width =10, height =8)# D. Descrizione delle Dimensioni# Ti dice quali variabili pesano di più sulla Dimensione 1 e 2desc <-dimdesc(res_mca, axes =c(1,2))# Puoi ispezionare 'desc$Dim.1' in console per vedere i dettagli numerici
# ==============================================================================# CONFRONTO: MCA CLASSICA (FactoMineR) vs CLUSTER-MCA (clusmca)# ==============================================================================# 1. Estrazione Coordinate MCA Classica (FactoMineR)# Prendiamo le prime 2 dimensionicoord_classic <-data.frame(res_mca$ind$coord[, 1:2])colnames(coord_classic) <-c("Dim1", "Dim2")coord_classic$Method <-"MCA Classica (Esplorativa)"# Aggiungiamo le info sui cluster trovati da clusmca per vedere come si dispongonocoord_classic$Cluster <-as.factor(out_mca$cluster) coord_classic$Diagnosis <- df_sample$Diagnosis# 2. Estrazione Coordinate Cluster-MCA (clusmca)coord_clus <-data.frame(out_mca$obscoord[, 1:2])colnames(coord_clus) <-c("Dim1", "Dim2")coord_clus$Method <-"MCA Clustering (Ottimizzata)"coord_clus$Cluster <-as.factor(out_mca$cluster)coord_clus$Diagnosis <- df_sample$Diagnosis# 3. Unione dei datidf_compare <-rbind(coord_classic, coord_clus)# --- GRAFICO 1: Come appaiono i Cluster nei due spazi? ---p1 <-ggplot(df_compare, aes(x = Dim1, y = Dim2, color = Cluster)) +geom_point(alpha =0.5, size =1.5) +facet_wrap(~Method, scales ="free") +# Scale libere perché le unità varianotheme_minimal() +scale_color_brewer(palette ="Set1") +labs(title ="Confronto Strutturale: Formazione dei Cluster",subtitle ="A SX: Come sono i dati naturalmente. A DX: Come l'algoritmo li forza per separarli.",caption ="Se a SX i colori sono mischiati ma a DX separati, i cluster sono 'forzati' dall'algoritmo.") +theme(legend.position ="bottom")ggsave("Plots_MCA_Analysis/03_Compare_Clusters.png", p1, width =12, height =6)print(p1)
# --- GRAFICO 2: Come si separa la DIAGNOSI nei due spazi? ---# Questo risponde alla domanda: quale metodo separa meglio Maligni e Benigni?p2 <-ggplot(df_compare, aes(x = Dim1, y = Dim2, color = Diagnosis)) +geom_point(alpha =0.5, size =1.5) +stat_ellipse(level =0.95, size =1) +# Ellissi al 95%facet_wrap(~Method, scales ="free") +scale_color_manual(values =c("Benign"="#66CC99", "Malignant"="#FF6666")) +theme_minimal() +labs(title ="Confronto Diagnostico: Separazione Benigni vs Maligni",subtitle ="Verifica se la manipolazione dello spazio aiuta a distinguere la diagnosi.",caption ="Ellissi sovrapposte = Scarsa capacità discriminante delle variabili categoriali.") +theme(legend.position ="bottom")ggsave("Plots_MCA_Analysis/04_Compare_Diagnosis.png", p2, width =12, height =6)print(p2)
#Inerziaoptions(scipen =999)dir.create("Plots_Model_Selection", showWarnings =FALSE)coords_mca <- out_mca$obscoordp_elbow <-fviz_nbclust(coords_mca, kmeans, method ="wss", k.max =10) +geom_vline(xintercept =3, linetype ="dashed", color ="red") +labs(title ="Metodo del Gomito (Inerzia)",x ="Numero di Cluster (k)",y ="Total Within Sum of Square") +theme_minimal()ggsave("Plots_Model_Selection/Inertia_Elbow_Method.png", p_elbow, width =8, height =6)print(p_elbow)
options(scipen =999)dir.create("Plots_Data_Quality", showWarnings =FALSE)vars_check <-c("C1_Kmeans", "C2_Hierar", "C3_GMM_MCA") df_miss <- df_sample[, vars_check]miss_stats <-data.frame(Var =names(df_miss),Pct =colMeans(is.na(df_miss)) *100)write.csv(miss_stats, "Plots_Data_Quality/Missing_Stats.csv", row.names =FALSE)# Heatmap Missingdf_long <- df_miss %>%mutate(ID =row_number()) %>%pivot_longer(cols =-ID, names_to ="Var", values_to ="Val") %>%mutate(Is_Missing =is.na(Val))p1 <-ggplot(df_long, aes(x = Var, y = ID, fill = Is_Missing)) +geom_tile() +scale_fill_manual(values =c("FALSE"="grey95", "TRUE"="red"), labels =c("Presente", "Mancante")) +theme_minimal() +labs(title ="Mappa Valori Mancanti", x ="", y ="Indice Paziente", fill ="Stato") +theme(axis.text.x =element_text(angle =45, hjust =1))ggsave("Plots_Data_Quality/01_Missing_Map.png", p1, width =10, height =8)print(p1) # Mostra in console
# Barplot Missingp2 <-ggplot(miss_stats, aes(x =reorder(Var, Pct), y = Pct)) +geom_bar(stat ="identity", fill ="steelblue") +coord_flip() +theme_minimal() +labs(title ="% Valori Mancanti per Variabile", x ="", y ="%") +geom_text(aes(label =round(Pct, 1)), hjust =-0.1, size =3)ggsave("Plots_Data_Quality/02_Missing_Bar.png", p2, width =8, height =6)print(p2) # Mostra in console
#analisi clusteroptions(scipen =999)dir.create("Plots_Target_Analysis", showWarnings =FALSE)# 1. Distribuzione Targetdf_targ <- df_sample %>% dplyr::count(Diagnosis) %>%mutate(Pct = n /sum(n))p1 <-ggplot(df_targ, aes(x = Diagnosis, y = n, fill = Diagnosis)) +geom_bar(stat ="identity", width =0.6, show.legend =FALSE) +geom_text(aes(label =paste0(n, "\n(", scales::percent(Pct), ")")), vjust =-0.2) +scale_fill_manual(values =c("Benign"="#66CC99", "Malignant"="#FF6666")) +theme_minimal() +labs(title ="Distribuzione Variabile Target (Diagnosi)", x ="", y ="Conteggio")ggsave("Plots_Target_Analysis/01_Target_Distribution.png", p1, width =6, height =6)print(p1) # Mostra in console
# 2. Relazione Target vs Clusterdf_clust_targ <- df_sample %>% dplyr::select(C1_Kmeans, C2_Hierar, C3_GMM_MCA, Diagnosis) %>%pivot_longer(cols =c("C1_Kmeans", "C2_Hierar", "C3_GMM_MCA"), names_to ="Cluster_Type", values_to ="Cluster_ID")p2 <-ggplot(df_clust_targ, aes(x = Cluster_ID, fill = Diagnosis)) +geom_bar(position ="fill") +facet_wrap(~Cluster_Type, scales ="free_x") +scale_y_continuous(labels = scales::percent) +scale_fill_manual(values =c("Benign"="#66CC99", "Malignant"="#FF6666")) +theme_minimal() +labs(title ="Capacità dei Cluster di separare la Diagnosi", x ="Cluster ID", y ="% Malignità")ggsave("Plots_Target_Analysis/02_Target_vs_Clusters.png", p2, width =12, height =6)print(p2) # Mostra in console
Warning: Using an external vector in selections was deprecated in tidyselect 1.1.0.
ℹ Please use `all_of()` or `any_of()` instead.
# Was:
data %>% select(vars_risk)
# Now:
data %>% select(all_of(vars_risk))
See <https://tidyselect.r-lib.org/reference/faq-external-vector.html>.
p3 <-ggplot(df_risk_targ, aes(x = Value, y = Risk_Factor, fill = Pct)) +geom_tile(color ="white") +scale_fill_gradient(low ="white", high ="red", labels = scales::percent) +geom_text(aes(label = scales::percent(Pct, accuracy =1)), size =3.5) +theme_minimal() +labs(title ="Probabilità di Malignità per Fattore di Rischio", fill ="Risk %")ggsave("Plots_Target_Analysis/03_Target_Risk_Heatmap.png", p3, width =8, height =8)print(p3) # Mostra in console
# 4. Feature Importance Random Forest (Target)set.seed(2025)rf_target <-randomForest(Diagnosis ~ ., data = df_sample[, c("Diagnosis", vars_risk, "C1_Kmeans", "C2_Hierar", "C3_GMM_MCA")], ntree =100, importance =TRUE)imp_df <-as.data.frame(importance(rf_target))imp_df$Variable <-rownames(imp_df)p4 <-ggplot(imp_df, aes(x =reorder(Variable, MeanDecreaseGini), y = MeanDecreaseGini)) +geom_bar(stat ="identity", fill ="#FF6666") +coord_flip() +theme_minimal() +labs(title ="Quali variabili predicono meglio la Diagnosi?", x ="", y ="Importanza")ggsave("Plots_Target_Analysis/04_Target_Feature_Importance.png", p4, width =8, height =6)print(p4) # Mostra in console
High Low Medium
1 121 962 681
2 178 911 576
3 270 404 286
4 189 257 166
t <-table(df_sample$C1_Kmeans, df_sample$Thyroid_Cancer_Risk)plot(ca(t))
# analisi clusteroptions(scipen =999)dir.create("Plots_Cluster_Analysis", showWarnings =FALSE)vars_cat <-c("Gender", "Smoking", "Obesity", "Family_History", "Radiation_Exposure", "Iodine_Deficiency", "Diabetes")clusters <-c("C1_Kmeans", "C2_Hierar", "C3_GMM_MCA")for(k in clusters) {# Heatmap Rischi df_risk <- df_sample %>% dplyr::select(all_of(c(k, vars_cat))) %>%pivot_longer(cols = vars_cat, names_to ="Var", values_to ="Val") %>% dplyr::count(.data[[k]], Var, Val) %>%group_by(.data[[k]], Var) %>%mutate(Pct = n /sum(n)) %>%filter(Val =="Yes"| Val =="Male") p4 <-ggplot(df_risk, aes_string(x = k, y ="Var", fill ="Pct")) +geom_tile(color ="white") +scale_fill_gradient(low ="white", high ="red", labels = scales::percent) +geom_text(aes(label = scales::percent(Pct, accuracy =1)), size =3.5) +theme_minimal() +labs(title =paste("Profilo Rischi -", k), x ="", y ="")ggsave(paste0("Plots_Cluster_Analysis/02_Heatmap_", k, ".png"), p4, width =8, height =6)print(p4) # Mostra in console (funziona anche nel loop)# Barplot Diagnosi p5 <-ggplot(df_sample, aes_string(x = k, fill ="Diagnosis")) +geom_bar(position ="fill") +scale_y_continuous(labels = scales::percent) +scale_fill_manual(values =c("Benign"="#66CC99", "Malignant"="#FF6666")) +theme_minimal() +labs(title =paste("Composizione Diagnosi -", k), x ="Cluster", y ="%")ggsave(paste0("Plots_Cluster_Analysis/03_Diagnosis_", k, ".png"), p5, width =8, height =6)print(p5) # Mostra in console}
Warning: Using an external vector in selections was deprecated in tidyselect 1.1.0.
ℹ Please use `all_of()` or `any_of()` instead.
# Was:
data %>% select(vars_cat)
# Now:
data %>% select(all_of(vars_cat))
See <https://tidyselect.r-lib.org/reference/faq-external-vector.html>.
#matrice cramer'soptions(scipen =999)dir.create("Plots_Data_Quality", showWarnings =FALSE)# 1. Selezione Variabili (Cluster + Diagnosi)vars_assoc <-c("C1_Kmeans", "C2_Hierar", "C3_GMM_MCA", "Diagnosis")df_assoc <-as.data.frame(df_sample[, vars_assoc]) # 2. Funzione V di Cramer (Robusta)calc_cramer <-function(x, y) {# Assicuriamoci che siano fattori o vettori tbl <-table(as.factor(x), as.factor(y)) chi2 <-chisq.test(tbl, correct =FALSE)$statistic n <-sum(tbl) k <-min(dim(tbl)) -1if(k ==0) return(0) # Gestione errori per variabili costantireturn(as.numeric(sqrt(chi2 / (n * k))))}# 3. Calcolo Matricen <-ncol(df_assoc)mat_cramer <-matrix(0, nrow = n, ncol = n)rownames(mat_cramer) <-colnames(df_assoc)colnames(mat_cramer) <-colnames(df_assoc)for (i in1:n) {for (j in1:n) {if (i == j) { mat_cramer[i, j] <-1 } else {# Usiamo [[ ]] che è più sicuro per estrarre vettori mat_cramer[i, j] <-calc_cramer(df_assoc[[i]], df_assoc[[j]]) } }}# 4. Plotdf_plot <-as.data.frame(as.table(mat_cramer))colnames(df_plot) <-c("Var1", "Var2", "Value")p <-ggplot(df_plot, aes(x = Var1, y = Var2, fill = Value)) +geom_tile(color ="white") +geom_text(aes(label =sprintf("%.2f", Value)), size =4, fontface ="bold") +scale_fill_gradient(low ="white", high ="#FF3333", limits =c(0, 1)) +theme_minimal() +labs(title ="Matrice di Associazione (Cramer's V)", subtitle ="1.00 = Ridondanza Totale (stessa informazione)",x ="", y ="", fill ="Cramer's V") +theme(axis.text.x =element_text(angle =45, hjust =1),plot.title =element_text(face ="bold"))ggsave("Plots_Data_Quality/04_Association_Matrix.png", p, width =8, height =7)print(p)
Warning in lda.default(x, grouping, ...): le variabili sono collineari
Warning in lda.default(x, grouping, ...): le variabili sono collineari
Warning in lda.default(x, grouping, ...): le variabili sono collineari
Warning in lda.default(x, grouping, ...): le variabili sono collineari
Warning in lda.default(x, grouping, ...): le variabili sono collineari
Warning in lda.default(x, grouping, ...): le variabili sono collineari
