在为 R 中的行分配概率时添加区域约束

如何解决在为 R 中的行分配概率时添加区域约束

我正在尝试根据一组作物概率（在单独的分析中生成）生成 1000 次田间作物分配模拟。我所做的是提取和聚合（使用平均值）栅格像素级概率到字段，以便每个字段都有与每种类型的作物相关联的概率。本质上，我拥有的数据集看起来像这样，其中 ID 对应于单个字段。

crp_data<-as.data.frame(matrix(data=runif(30,0.3),nrow=10,ncol=3))
colnames(crp_data)<-c('Almond','Corn','Soy')
ID<-1:10
mini_dat<-cbind(ID,crp_data)
   ID     Almond       Corn        Soy
1   1 0.06892399 0.06547728 0.13620222
2   2 0.26790834 0.29593780 0.05201943
3   3 0.21228911 0.13332820 0.28494349
4   4 0.19941160 0.17655127 0.18443079
5   5 0.26986918 0.23266005 0.03110367
6   6 0.01985116 0.15348043 0.06481676
7   7 0.24824107 0.16718490 0.04176194
8   8 0.09972657 0.04325504 0.28476090
9   9 0.14981208 0.15580469 0.27743882
10 10 0.28884774 0.16109794 0.04253892

我已经设法建立了一个 for 循环，我在 1000 次模拟中使用作物概率为田地分配作物值，没问题。我首先创建一个空的数据框，然后遍历行（按 ID）和列以分配新的作物：

mat_n<-as.data.frame(matrix(data=NA,nrow=nrow(mini_dat),ncol=1000)) 
colnames(mat_n)[1:1000]<-paste0("Sim",1:1000,"")
ID<-unique(mini_dat$ID) #field ID that corresponds with the fields in my mini_dat
mat_n<-cbind(ID,mat_n)

 for (j in 2:ncol(mat_n)){
  for (i in 1:nrow(mat_n)){
    out<-mini_dat[mini_dat$ID %in% mat_n[i,1],] #row of probabilities corresponding to each field
    probs<-as.numeric(out[,2:4])  
    r1<-sample(3,size = 1,replace = TRUE,prob = probs) #sample from the row,using probabilities 
    mat_n[i,j] <- colnames(out)[r1+1]#gives me the name of the crop in the simulation,i.e,'Almond'
  }
}

我希望能够做的是添加一个区域约束，以便在每次模拟中，当循环运行以考虑该作物的面积时，每个田地被分配某种作物的概率会发生变化。即，对于模拟中的每个字段，当分配作物时，到目前为止分配的作物面积会更新，一旦达到最大值，就会分配不同的概率。对于每个字段，每种作物的更新概率将计算如下： 1-（到目前为止作物 X 的面积/作物 X 的总面积）。

到目前为止我所做的是尝试使用一个空的数据框来更新从田地级区域中提取的逐行作物区域，并为每行的每个作物求和，然后它以上述比例循环使用那些更新的区域。我所拥有的不起作用，我认为这是因为我误解了 for 循环方面的内容。

#dataframe with total crop areas,crop names,and column to hold updated crop totals by row
area_c<-as.data.frame(matrix(data=runif(3,500,10000),nrow=3,ncol=1))
area_c$Crop<-c('Almond','Soy')
area_c$field_tot<-0
colnames(area_c)[1]<-'C'

#dataframe with individual field crop areas and IDs
area_f<-as.data.frame(matrix(data=runif(3,1000),ncol=1))
area_f$ID<-ID
colnames(area_f)[1]<-'fields'

#dataset for updating the areas that matches ncol and nrow of mat_n
area_up<-mini_dat
area_up[,2:4]<-0

for (j in 2:ncol(mat_n)){ #by simulation
    for (i in 1:nrow(mat_n)){ #by ID
      out<-mini_dat[mini_dat$ID %in% mat_n[i,] #this pulls out the row of crop probabilities by ID
      var<-out[,2:31] #only probs
      probs<-as.numeric(var) #numeric for sample function
      r1<-sample(30,prob = probs) #use IDs of each crop,and then the probs associated with crop
      mat_n[i,j] <-names(var[,r1]) #assign probs originally
      mat_n[i,j]<-ifelse(mat_n[i,j] == area_c$Crop,(1-(area_c$field_tot/area_c$C)),NA)
    }
    for (x in 2:ncol(area_up)){
      area_o<-area_f[area_f$ID %in% out[,] 
      area_o<-area_o[,1]
      area_up[i,x]<-ifelse(out[,1] == area_up$ID & mat_n[i,j] == names(area_up),area_o,0)
      area_c$field_tot<-colsums(area_up[,2:31])
  }
}

任何建议或替代建议都会很棒。

解决方法

您示例的第一部分不起作用，但我认为可以简化很多（很难知道，因为您的代码不起作用）

crp <-as.data.frame(matrix(data=runif(30,0.3),nrow=10,ncol=3))
colnames(crp) <- c('Almond','Corn','Soy')

对于示例来说，5 个实现应该足够了

nsample <- 5
ncrops <- ncol(crp)
set.seed(48)

a <- apply(crp,1,function(i) sample(ncrops,nsample,prob=i,replace=TRUE))
a <- t(a)
head(a)
#     [,1] [,2] [,3] [,4] [,5]
#[1,]    1    1    1    3    3
#[2,]    2    2    1    2    3
#[3,]    3    2    2    2    1
#[4,]    3    1    1    2    1
#[5,]    2    1    2    2    2
#[6,]    3    3    1    3    3

或者得到他们的名字

 a[] <- names(crp)[a]
 head(a)
 #     [,1]     [,2]     [,3]     [,4]   [,5]    
 #[1,] "Almond" "Almond" "Almond" "Soy"  "Soy"   
 #[2,] "Corn"   "Corn"   "Almond" "Corn" "Soy"   
 #[3,] "Soy"    "Corn"   "Corn"   "Corn" "Almond"
 #[4,] "Soy"    "Almond" "Almond" "Corn" "Almond"
 #[5,] "Corn"   "Almond" "Corn"   "Corn" "Corn"  
 #[6,] "Soy"    "Soy"    "Almond" "Soy"  "Soy"