用户定义的R函数中的while循环不会中断

时间:2017-11-29 14:34:32

标签: r while-loop

我创建了一个用户定义的函数,如下所示:

HAC.sim(K = 1, N, Hstar, m = 0, probs, perms, p = 0.95)

并且在这个函数的主体内,我想把下面的'while'循环(因为我想最终创建一个易于使用的包)。

while(R < p){
    HAC.sim(K = 1, N = Nstar, Hstar, m = 0, probs, perms, p = 0.95)
    }

R是在主函数体中定义的变量。

问题是当满足条件时(即,当R

当'while'循环放在函数外部时,我的例程工作(即,它成功中断),但是当我将它放在主函数体中时失败。

我也试过用break来实现一个重复循环,但同样的问题就出现了。

关于如何解决问题的任何想法?

这是完整的功能(很长)

HAC.sim <- function(K = 1, N, Hstar, probs, m = 0, perms = 10000, p = 0.95){

### Set up a container to hold the identity of each individual from each permutation

pop <- array(dim = c(c(perms, ceiling((1 - m) * N / K)), K))

### Create an ID for each haplotype

haps <- as.character(1:Hstar)

### Generate permutations, we assume each permutation has Npop individuals, and we sample those individuals' haplotypes from the probabilities

specs <- 1:ceiling((1 - m) * N / K) 

for(j in 1:perms){
    for(i in 1:K){
        pop[j, specs, i] <- sample(haps, size = ceiling((1 - m) * N / K), replace = TRUE, prob = probs)
    }
}

### Make a matrix to hold the 1:N individuals from each permutation

HAC.mat <- array(dim = c(c(perms, ceiling((1 - m) * N / K)), K))

for(k in specs){
    for(j in 1:perms){
        for(i in 1:K){
            ind.index <- sample(specs, size = k, replace = FALSE) ## which individuals will we sample
            hap.plot <- pop[sample(1:nrow(pop), size = 1, replace = TRUE), ind.index, sample(i, size = 1, replace = TRUE)] ## pull those individuals from a permutation
            HAC.mat[j, k, i] <- length(unique(hap.plot))  ## how many haplotypes did we get for a given sampling intensity (j) from each permutation (i)
        }
    }
}

### Calculate the mean and CI for number of haplotypes at each sampling intensity (k)

means <- apply(HAC.mat, MARGIN = 2, mean)
lower <- apply(HAC.mat, MARGIN = 2, function(x) quantile(x, 0.025))
upper <- apply(HAC.mat, MARGIN = 2, function(x) quantile(x, 0.975))

assign("d", data.frame(specs, means), envir = .GlobalEnv)

### Compute Measures of Sampling Closeness

P <- max(means)
Q <- Hstar - max(means)
R <- assign("R", max(means) / Hstar, envir = .GlobalEnv)
S <- (Hstar - max(means)) / Hstar
Nstar <- assign("Nstar", (N * Hstar) / max(means), envir = .GlobalEnv)
X <- ((N * Hstar) / max(means)) - N

cat("\n Input parameters \n \n Number of (sub)populations: ", K, "\n Number of individuals: ", N, "\n Number of haplotypes: ", Hstar, "\n Haplotype distribution: ", probs, "\n Migration rate: ", m, "\n Number of permutations: ", perms, "\n Proportion of haplotypes to recover: ", p, "\n \n \n Measures of Sampling Closeness \n \n Mean number of haplotypes sampled: " , P, "\n Mean number of haplotypes not sampled: " , Q, "\n Proportion of haplotypes sampled: " , R, "\n Proportion of haplotypes not sampled:  " , S, "\n \n Calculated mean value of N*: ", Nstar, "\n Mean number of individuals not sampled: ", X, "\n \n")

if(R < p){
    cat("Desired level of H* has not yet been reached")
        } else{
            cat("Desired level of H* has been reached")
}

### Plot the curve and frequency barplot

par(mfrow = c(1, 2))

plot(specs, means, type = "n", xlab = "Specimens sampled", ylab = "Unique haplotypes",  ylim = c(1, Hstar))
polygon(x = c(specs, rev(specs)), y = c(lower, rev(upper)), col = "gray")
lines(specs, means, lwd = 2)
HAC.bar <- barplot(ceiling((1 - m) * N / K)*probs, xlab = "Unique haplotypes", ylab = "Specimens sampled", names.arg = 1:Hstar)

while(R < p){
    HAC.sim(K = K, N = ceiling(Nstar), Hstar = Hstar, probs = probs, m = m,   perms = perms, p = p)
}

}

### Run simulation

HAC.sim(K = K,  N = N, Hstar = Hstar, probs = probs, m = m, perms = perms, p = p)

0 个答案:

没有答案