Age,Female,Male 0~10,5,6 11~20,15,14 21~30,20,22 31~40,25,24 41~50,25,28 51~60,30,26 61~70,20,18 71~80,15,16 81~90,10,12
Select option:
# # Load libraries # # Load libraries library(ggplot2) library(dplyr) library(ggrepel) library(ggforce) library(scales) # Step 0: Create the dataframe nodes <- read.table(textConnection(' name value value2 carac Guangdong 1439 3.8850237 1 Beijing 1953 3.5303286 2 Zhejiang 875 1.965589 1 Shanghai 1150 1.9121914 1 Liaoning 564 0.9916418 1 Sichuan 622 0.9864629 1 Jiangsu 801 0.9787652 1 Hubei 580 0.9638502 2 Hong Kong 646 0.9606211 2 Taiwan 1620 0.6250277 2 '), header = TRUE, sep = "\t", stringsAsFactors = FALSE) # Step 1: Set column names # Step 1: Preprocess # Step 1: Set column names if (ncol(nodes) == 3) { colnames(nodes) <- c("name", "value", "value2") } else if (ncol(nodes) == 4) { colnames(nodes) <- c("name", "value", "value2", "carac") } else if (ncol(nodes) == 5) { colnames(nodes) <- c("name", "value", "value2", "carac", "value3") } if (ncol(nodes) > 3) { # Step 2: Assign colors nodes$carac <- as.factor(nodes$carac) specified_colors <- c( "#FF0000", "#0000FF", "#998000", "#008000", "#800080", "#FFC0CB", "#000000", "#ADD8E6", "#FF4500", "#A52A2A", "#8B4513", "#FF8C00", "#32CD32", "#4682B4", "#9400D3", "#FFD700", "#C0C0C0", "#DC143C", "#1E90FF" ) regular_clusters <- levels(nodes$carac)[levels(nodes$carac) != "100"] color_mapping <- setNames(specified_colors[1:length(regular_clusters)], regular_clusters) nodes$fill_color <- ifelse(nodes$carac == "100", NA, color_mapping[as.character(nodes$carac)]) nodes$border_color <- "black" } # Step 1: Preprocess mean_x <- mean(nodes$value2) mean_y <- mean(nodes$value) sd_x <- sd(nodes$value2) sd_y <- sd(nodes$value) # Step 2: Generate curves spread_x <- 4 * sd_x spread_y <- 5 * sd_y t <- seq(0, 1, length.out = 300) lower_curve <- data.frame( x = t * spread_x - spread_x / 2 + mean_x, y = mean_y - spread_y * (1 - t)^2 ) upper_curve <- data.frame( x = -t * spread_x + spread_x / 2 + mean_x, y = mean_y + spread_y * (1 - t)^2 ) # Step 3: Classification Functions ci_radius_x <- sd_x ci_radius_y <- sd_y ###############for column==3 if (ncol(nodes) == 3) { is_inside_ellipse <- function(x, y) { ((x - mean_x)^2 / ci_radius_x^2) + ((y - mean_y)^2 / ci_radius_y^2) <= 1 } is_outside_ellipse <- function(x, y) { ((x - mean_x)^2 / ci_radius_x^2) + ((y - mean_y)^2 / ci_radius_y^2) > 1 } is_above_upper <- function(x, y) { x_parabola <- -t * spread_x + spread_x / 2 + mean_x y_parabola <- mean_y + spread_y * (1 - t)^2 y_pred <- approx(x_parabola, y_parabola, xout = x, rule = 2)$y return(!is.na(y_pred) && y > y_pred) } is_below_lower <- function(x, y) { x_parabola <- t * spread_x - spread_x / 2 + mean_x y_parabola <- mean_y - spread_y * (1 - t)^2 y_pred <- approx(x_parabola, y_parabola, xout = x, rule = 2)$y return(!is.na(y_pred) && y < y_pred) } # Step 4: Classification Logic nodes$carac <- mapply(function(x, y) { above <- is_above_upper(x, y) below <- is_below_lower(x, y) inside <- is_inside_ellipse(x, y) outside <- is_outside_ellipse(x, y) if (x >= mean_x & y > mean_y & outside) return("1") else if (below) return("2") else if (inside) return("3") else if (x < mean_x & y > mean_y & above) return("4") else return("5") }, nodes$value2, nodes$value) # Step 5: Map labels and colors label_mapping <- c( "1" = "Leader", "2" = "Connector", "3" = "Normal", "4" = "Lone Wolves", "5" = "Follower" ) nodes$carac <- factor(nodes$carac, levels = names(label_mapping), labels = label_mapping) } ####column==3 specified_colors <- c( "Leader" = "#FF0000", "Connector" = "#0000FF", "Normal" = "#998000", "Lone Wolves" = "#008000", "Follower" = "#FFC0CB" ) nodes$color <- specified_colors[nodes$carac] # Step 6: Draw plot visual_ratio <- (max(nodes$value2) - min(nodes$value2)) / (max(nodes$value) - min(nodes$value)) theta <- seq(0, 2 * pi, length.out = 300) circle_data <- data.frame( x = mean_x + (spread_x * 0.19) * cos(theta), y = mean_y + (spread_y * 0.19) * sin(theta) ) ggplot(nodes, aes(x = value2, y = value)) + geom_point(aes(size = value, fill = color), color = "black", shape = 21, alpha = 0.9) + geom_text_repel(aes(label = name), size = 3.5) + scale_fill_identity() + scale_size(range = c(3, 12)) + geom_vline(xintercept = mean_x, linetype = "dashed", color = "red") + geom_hline(yintercept = mean_y, linetype = "dashed", color = "red") + geom_line(data = lower_curve, aes(x = x, y = y), color = "blue") + geom_line(data = upper_curve, aes(x = x, y = y), color = "blue") + geom_path(data = circle_data, aes(x = x, y = y), color = "purple", linewidth = 1.1) + coord_fixed(ratio = visual_ratio) + labs( x = "Edge(Influence)", y = "Density(Dominance)", size = "Dominance" ) + theme_minimal(base_family = "Helvetica") + theme( plot.title = element_text(size = 16, face = "bold", hjust = 0.5), legend.position = "none" ) # Compute Pearson correlation cor_test <- cor.test(nodes$value, nodes$value2, method = "pearson") # Extract results r_val <- round(cor_test$estimate, 3) t_val <- round(cor_test$statistic, 3) p_val <- signif(cor_test$p.value, 3) # Create a correlation label cor_label <- paste0("r = ", r_val, ", t = ", t_val, ", p = ", round(p_val,4)) # Step 1: Extract top 3 values in descending order top3_values <- sort(nodes$value, decreasing = TRUE)[1:3] top3_values # Assign for readability v1 <- top3_values[1] # top 1 v2 <- top3_values[2] # top 2 v3 <- top3_values[3] # top 3 # Step 2: Compute AAC as per your formula: # AAC = ((v1/v2)/(v2/v3)) / (1 + (v1/v2)/(v2/v3)) numerator <- (v1 / v2) / (v2 / v3) AAC <- numerator / (1 + numerator) # Step 1: Extract top 3 values in descending order top3_values <- sort(nodes$value2, decreasing = TRUE)[1:3] top3_values # Assign for readability v1 <- top3_values[1] # top 1 v2 <- top3_values[2] # top 2 v3 <- top3_values[3] # top 3 # Step 2: Compute AAC as per your formula: # AAC = ((v1/v2)/(v2/v3)) / (1 + (v1/v2)/(v2/v3)) numerator <- (v1 / v2) / (v2 / v3) AAC2 <- numerator / (1 + numerator) # Step 3: Output result cat("AAC2 =", round(AAC2, 4), "\n") # Step 3: Output result cat("AAC1 =", round(AAC, 4), "\n") cat(cor_label,sep="/t")