rapids/src/features/location_barnett/SimulateMobilityGaps.R

42 lines
2.0 KiB
R
Raw Normal View History

2019-11-05 21:17:20 +01:00
SimulateMobilityGaps <-
function(suboutmat,obj,wtype="TL",spread_pars=c(1,10)){
ind11=obj$ind11;ind12=obj$ind12;fd=obj$fd;ft=obj$ft;fts=obj$fts;fa=obj$fa;pt=obj$pt;pts=obj$pts;allts=obj$allts;phatall=obj$phatall;fxs=obj$fxs;fys=obj$fys;pxs=obj$pxs;pys=obj$pys;allxs=obj$allxs;allys=obj$allys
if(nrow(suboutmat)==0){
return(suboutmat)
}
foutmat=c()
for(i in 1:nrow(suboutmat)){
if(suboutmat[i,1]==1){
curx=suboutmat[i,5]
cury=suboutmat[i,6]
foutmat=rbind(foutmat,suboutmat[i,])
}else if(suboutmat[i,1]<=3){
curx=suboutmat[i,2]
cury=suboutmat[i,3]
foutmat=rbind(foutmat,suboutmat[i,])
}
if(suboutmat[i,1]==4 && i>1 && i<nrow(suboutmat)){
varmult=1
while(TRUE){
fw=dnorm((fts-mean(c(suboutmat[i,4],suboutmat[i,7])))/(varmult*(suboutmat[i,7]-suboutmat[i,4])))
pw=dnorm((pts-mean(c(suboutmat[i,4],suboutmat[i,7])))/(varmult*(suboutmat[i,7]-suboutmat[i,4])))
allw=dnorm((allts-mean(c(suboutmat[i,4],suboutmat[i,7])))/(varmult*(suboutmat[i,7]-suboutmat[i,4])))
if(length(pts)>0 && length(fts)>0 && sum(fw)>0 && sum(pw)>0){break}
if(length(pts)==0 && length(fts)>0 && sum(fw)>0){break}
if(length(fts)==0 && length(pts)>0 && sum(pw)>0){break}
varmult=varmult*2
}
s11=sum(allw[ind11],na.rm=T)
s12=sum(allw[ind12],na.rm=T)
if(s11+s12==0){phatcur=phatall}else{phatcur=s12/(s11+s12)}
if(wtype=="LI"){
foutmat=rbind(foutmat,c(1,curx,cury,suboutmat[i,4],suboutmat[i+1,2],suboutmat[i+1,3],suboutmat[i,7]))
}else{
rbout=matrix(RandomBridge(x0=curx,y0=cury,x1=suboutmat[i+1,2],y1=suboutmat[i+1,3],t0=suboutmat[i,4],t1=suboutmat[i,7],fd=fd,ft=ft,fts=fts,fa=fa,fw=fw,probp=phatcur,pt=pt,pts=pts,pw=pw,allts=allts,allw=allw,ind11=ind11,ind12=ind12,i_ind=i,pxs=pxs,pys=pys,fxs=fxs,fys=fys,allxs=allxs,allys=allys,wtype=wtype,canpause=suboutmat[i-1,1]==1,niter=100,spread_pars=spread_pars),ncol=7)
foutmat=rbind(foutmat,rbout)
}
}
}
return(foutmat)
}