R - 模擬乙型相關協變量

Question

我試圖模擬兒童人口的兩個體重和年齡值。這些數據應該是S形相關的，以便在低齡時體重緩慢變化，然後在經過約30周後月經體重增加加速，其開始平穩過去約50周。

我已經能夠使用下面的代碼來獲得體重和年齡之間的線性相關性，以相當好地工作。我遇到麻煩的部分是調整此代碼以獲得更多的S形數據。任何建議將不勝感激。

---

# Load required packages 
library(MASS) 
library(ggplot2) 

# Set the number of simulated data points 
n <- 100 

# Set the mean and standard deviations for 
# the two variables 
mean_age <- 50 
sd_age <- 20 

mean_wt <- 10 
sd_wt <- 4 

# Set the desired level of correlation 
# between the two variables 
cor_agewt <- 0.9 

# Build the covariance matrix 
covmat <- matrix(c(sd_age^2, cor_agewt * sd_age * sd_wt, 
        cor_agewt * sd_age * sd_wt, sd_wt^2), 
       nrow = 2, ncol = 2, byrow = TRUE) 

# Simulate the correlated results 
res <- mvrnorm(n, c(mean_age, mean_wt), covmat) 

# Reorganize the simulate data into a data frame 
df <- data.frame(age = res[,1], 
       wt = res[,2]) 

# Plot the results and fit a loess spline 
# to the data 
ggplot(df, aes(x = age, y = wt)) + 
    geom_point() + 
    stat_smooth(method = 'loess') 

電流輸出：

理想輸出（雖然在較小的年齡範圍和權重）：

Answer 1

一種方法是指定重量之間的函數形式年齡比單一相關更具體。在指定權重〜年齡+ e的函數形式後，您只需繪製（年齡，e），然後計算權重。一個簡單的例子如下：

set.seed(1234) 
mean_age <- 50; sd_age <- 20 
mean_wt <- 3.5; sd_wt <- 2.2 
n<-400 

age.seq<-rnorm(n,mean_age,sd_age) 
age.seq<-age.seq[order(age.seq)] 
#functional form: (here a "logistic" with a a location and scale) 
f<-function(x,loc,sca) 1/(1+exp(-(x-loc)/sca)) 
wt<-f(age.seq,65,20) #wt 
m<-mean_wt/mean(wt) #simple adjustment of the mean 
sdfit<-sqrt(sd_wt^2-var(m*wt)) 
sim_wt<-m*wt+rnorm(n,0,sdfit) #simulated wt 
plot(age.seq,sim_wt) 
lines(age.seq,m*wt) 

均值& SD：

>sd(age.seq); sd(sim_wt); mean(sim_wt); mean(age.seq) #check 
[1] 20.29432 
[1] 2.20271 
[1] 3.437339 
[1] 50.1549 

:::::: EDIT部分WRT。評論::::::

對採樣空間的限制，例如。非零權重標準會使問題變得更加困難。但是，如果您放棄對權重的平均值+ sd限制，則可以很容易地將該示例擴展到功能表單的靈活規範。下面是使用截短的正常DIST：

set.seed(1234) 

mean_age<-30 
sd_age<-10 
n<-500 

#ex. of control of functional-form 
loc<-40 #location 
scale<-10 #scaling 
sd_wt <- 0.8 #in the truncated normal 
ey_min<-c(0,0.2) #in the truncated normal 
ey_max<-c(55,6) #in the truncated normal 

age.seq<-rnorm(n,mean_age,sd_age) 
#age.seq<-0:55 
n<-length(age.seq) 

age.seq<-age.seq[order(age.seq)] 
#functional form: (here a "logistic" with a a location and scale) 
f<-function(x,loc,sca) 1/(1+exp(-(x-loc)/sca)) 

wt<-f(age.seq,loc,scale) #wt 
#correct lower: 
corr_lower<-ey_min[2]-f(ey_min[1],loc,scale) #add. correction lower 
wt<-wt+corr_lower 

#correct upper 
mult<-(ey_max[2]-ey_min[2])/(f(ey_max[1],loc,scale)+corr_lower) #mult. correction 
wt<-ey_min[2]+wt*mult*(age.seq/ey_max[1]) 

plot(age.seq,wt,type="l",ylim=c(0,8)) #plot mean used as par in the truncated normal 
sim_wt<-truncnorm::rtruncnorm(n,0,,mean=wt,sd=sd_wt) 
points(age.seq,sim_wt) 

abline(h=0.2,col=2);abline(v=0,col=2) 
abline(h=6,col=2);abline(v=55,col=2) 

這給（紅線說明控制）一個簡單的例子：

當然，你也可以嘗試控制方差WRT。年齡，簡化：

plot(age.seq,wt,type="l",ylim=c(0,8)) #plot mean used as par in the truncated normal 
sim_wt<-truncnorm::rtruncnorm(n,0,,mean=wt,sd=sd_wt*seq(0.3,1.3,len=n)) 
points(age.seq,sim_wt) 

點這裏，你需要更多的結構來模擬這樣的具體數據，例如（未進入前引導方法）。沒有內部R功能來救援。當然，在引入更多限制時，從分配中抽取樣本更加困難。你可以隨時諮詢交叉驗證的不同方法，分銷的選擇等。