使用R/SAS缩减数据集至1k条，匹配多变量目标均值

Got it, let's break down how to solve this problem. You need to shrink a 100k-row, 30-variable dataset to 1k rows while keeping all variable means as close as possible to your target values. Exact matches are tough, but we can get really close with optimization-based sampling methods. Here are practical, actionable solutions for both R and SAS:

R Implementation #

Method 1: Genetic Algorithm Optimization #

Genetic algorithms are perfect here because they efficiently explore potential samples to minimize the gap between sample means and target means. We'll use the genalg package for this:

1. First, install and load required packages:

install.packages(c("genalg", "dplyr"))
library(genalg)
library(dplyr)

2. Define your target means (replace with your actual values) and prepare the dataset:

# Example target means (adjust to your 30 variables)
target_means <- c(var1 = 5.2, var2 = 10.1, ..., var30 = 0.7)
data <- your_dataset # Replace with your actual dataset

3. Create a fitness function that calculates the sum of squared differences between sample means and target means (lower = better):

fitness_function <- function(chromosome) {
  # Chromosome is a binary vector: 1 = include row, 0 = exclude
  sample_rows <- which(chromosome == 1)
  if(length(sample_rows) != 1000) return(Inf) # Enforce sample size
  
  sample_means <- colMeans(data[sample_rows, names(target_means)])
  sum((sample_means - target_means)^2)
}

4. Run the genetic algorithm:

# Set parameters: population size, number of generations, etc.
ga_model <- rbga(
  stringMin = rep(0, nrow(data)),
  stringMax = rep(1, nrow(data)),
  popSize = 50,
  iters = 100,
  mutationChance = 0.01,
  fitnessFunc = fitness_function,
  verbose = TRUE
)

5. Extract the best sample:

best_chromosome <- ga_model$population[which.min(ga_model$fitnessValues), ]
final_sample <- data[which(best_chromosome == 1), ]

# Check how close we got
colMeans(final_sample[names(target_means)]) - target_means

Method 2: Iterative Adjustment (Simpler Alternative) #

If genetic algorithms feel too heavy, you can start with a random sample and iteratively replace rows to improve mean alignment:

# Start with a random sample
current_sample <- sample_n(data, 1000)
current_means <- colMeans(current_sample[names(target_means)])

# Iterate to adjust
for(i in 1:500) {
  # Pick a row from the sample to replace
  row_to_replace <- sample(1:nrow(current_sample), 1)
  # Pick a row from the full dataset not in the sample
  candidate_row <- sample(setdiff(1:nrow(data), rownames(current_sample)), 1)
  
  # Calculate new means if we swap
  temp_sample <- current_sample
  temp_sample[row_to_replace, ] <- data[candidate_row, ]
  temp_means <- colMeans(temp_sample[names(target_means)])
  
  # Keep the swap if it reduces the error
  if(sum((temp_means - target_means)^2) < sum((current_means - target_means)^2)) {
    current_sample <- temp_sample
    current_means <- temp_means
  }
}

SAS Implementation #

Method: Integer Linear Programming with PROC OPTMODEL #

SAS's PROC OPTMODEL lets you set up an optimization problem where we minimize the mean error while enforcing a 1k sample size:

/* Load your dataset */
data work.full_data;
  set your_input_dataset;
run;

/* Define target means (adjust to your 30 variables) */
%let target_means = 5.2 10.1 ... 0.7; /* List all 30 target values in order */

proc optmodel;
  /* Declare variables */
  num n = numobs(work.full_data);
  num p = 30; /* Number of variables */
  var x{1..n} binary; /* x[i] = 1 if row i is selected, 0 otherwise */
  
  /* Load data and target means */
  num y{1..n, 1..p};
  read data work.full_data into [_N_] y[1..p] = (var1 var2 ... var30); /* Replace with your variable names */
  num target{1..p} = &target_means;
  
  /* Objective: Minimize sum of squared differences between sample means and targets */
  min error = sum{j in 1..p} ( (sum{i in 1..n} x[i]*y[i,j])/1000 - target[j] )^2;
  
  /* Constraint: Select exactly 1000 rows */
  con sample_size: sum{i in 1..n} x[i] = 1000;
  
  /* Solve the problem */
  solve with milp / solver=cplex; /* or use the default solver if you don't have CPLEX */
  
  /* Extract the selected rows */
  create data work.final_sample from [_N_] x where x=1;
  merge work.final_sample work.full_data;
  by _N_;
  keep var1 var2 ... var30; /* Keep your variables */
run;

Notes for SAS #

• If you don't have CPLEX, the default MILP solver will work but might take longer for 100k rows.
• For a faster alternative, start with a stratified sample using PROC SURVEYSELECT and then use an iterative adjustment approach similar to the R example above.

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