R语言：洛伦兹曲线绘图时部分线条未显示？求确认

Hey there! I took a close look at your code, and the issue of overlapping (or seemingly missing) lines almost certainly stems from a logical flaw in how you're calculating post-tax wealth. Let's break this down and fix it step by step.

Why Your Curves Are Overlapping #

The core problem is in the make_lorenz_2 function's wealth redistribution logic:

newtau = ((1 - i) * tau) + transfers

Here, transfers is i * sort(tau, decreasing = T) — meaning you're taking the tax from the highest earners and adding those exact values to the unsorted original tau vector. This creates a weird, arbitrary redistribution: high earners end up with their original income (since (1-i)*high_income + i*high_income = high_income), while lower earners get random chunks of high-earner taxes. The end result? Different tax rates barely change the overall wealth distribution, so your Lorenz curves look nearly identical.

Fixing the Redistribution Logic #

A proper flat-tax + equal transfer system works like this:

1. Everyone pays i * their_income in taxes
2. Total tax revenue is split evenly among all individuals
3. Post-tax income = (1-i)*individual_income + total_tax / number_of_people

Here's the corrected make_lorenz_2 function:

make_lorenz_2 <- function(i, tau) {
  # Calculate total tax revenue and equal per-person transfer
  total_tax <- i * sum(tau)
  transfer_per_person <- total_tax / length(tau)
  
  # Compute post-tax income for each individual
  newtau <- (1 - i) * tau + transfer_per_person
  
  # Generate Lorenz curve data
  newtau_sorted <- sort(newtau)
  CumWealth <- cumsum(newtau_sorted) / sum(newtau_sorted)
  PoorPopulation <- seq_along(newtau_sorted) / length(newtau_sorted)
  
  # Use more quantile points for smoother curves
  quantiles <- seq(0, 1, 0.01)
  index <- round(quantiles * length(newtau_sorted))
  index <- pmin(index, length(newtau_sorted)) # Avoid out-of-bounds errors
  
  QQth <- CumWealth[index]
  x <- PoorPopulation[index]
  
  data.frame(x, QQth, Gini = Gini(newtau))
}

Improving Plot Readability #

To make sure lines are distinct even if they get close, tweak your ggplot code to use both color and line type, plus add a reference line for perfect equality:

# Regenerate the data frame with the corrected function
Lorenzdf1 <- purrr::map(taxations, tau = tau, make_lorenz_2) %>% 
  setNames(taxations) %>% 
  bind_rows(.id = "taxations")

# Define distinct colors and line types
cols <- c("0" = "black", "0.1"="blue","0.2"="green","0.3"="red", 
          "0.4" = "grey", "0.5" = "pink", "0.6"="yellow","0.7"="brown",
          "0.8"="orange", "0.9" = "purple", "1" = "darkgreen")
linetypes <- c("0" = "solid", "0.1"="dashed","0.2"="dotted","0.3"="dotdash",
               "0.4" = "longdash", "0.5" = "solid", "0.6"="dashed","0.7"="dotted",
               "0.8"="dotdash", "0.9" = "longdash", "1" = "solid")

# Build the plot
g <- ggplot(data=Lorenzdf1, aes(x=x, y=QQth, colour = taxations, linetype = taxations)) + 
  geom_line(linewidth = 1) + # Thicker lines for better visibility
  geom_abline(slope=1, intercept=0, color="black", linetype="twodash", alpha=0.5) + # Perfect equality reference
  ggtitle("Lorenz Curves After Flat Taxation with Equal Transfers") + 
  xlab("Cumulative Share of People (Lowest to Highest Wealth)") + 
  ylab("Cumulative Share of Wealth") + 
  scale_color_manual(name="Tax Rate", values=cols) +
  scale_linetype_manual(name="Tax Rate", values=linetypes) +
  theme_minimal()

print(g)

What You'll See Now #

With this fix:

• The i=0 curve will match your original pre-tax Lorenz curve
• Curves will gradually shift toward the diagonal as tax rates increase
• The i=1 curve will be exactly the diagonal (perfect equality, since all income is pooled and split evenly)
• All lines will be clearly distinguishable thanks to color + line type combinations

内容的提问来源于stack exchange，提问作者43zombiegit