File: UPsampford.R

package info (click to toggle)
r-cran-sampling 2.10-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 1,336 kB
  • sloc: ansic: 21; makefile: 2
file content (26 lines) | stat: -rw-r--r-- 632 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
UPsampford<-function(pik,eps=1e-6,max_iter=500)
{
if(any(is.na(pik))) stop("there are missing values in the pik vector")
n=sum(pik)
n=.as_int(n)
list= pik>eps & pik < 1-eps
pikb=pik[list]
n=sum(pikb)
N=length(pikb)
s=pik
if(N<1) stop("the pik vector has all elements outside of the range [eps,1-eps]")
else 
{
sb=rep(2,N)
y=pikb/(1-pikb)/sum(pikb/(1-pikb))
step=0
while(sum(sb<=1)!=N & step<=max_iter)
      {
	sb=as.vector(rmultinom(1,1,pikb/sum(pikb))+rmultinom(1,.as_int(n-1),y))
      step=step+1
       }
if(sum(sb<=1)==N) s[list]=sb
else stop("Too many iterations. The algorithm was stopped.")
}
s
}