Creating a Table out of a While Loop in R - r

I am trying to make a table from a while loop. Basically, I want to make a while loop where the value of r increases by 1 and repeats this until the inequality is met. But in addition to that, I want to combine these values into a table with three columns: the value of r, the value of w, and the value of rhs (rounded to 3 decimal places).
```{r}
al = 0.10; n = 30; a = 3; b = 5; r = 2; int = 8; h = (int/2); msE = 19.19
table = function(MSE, V, H, alpha = al, r = 2){
rhs = h^2*r/((V-1)*MSE)
w = qf(alpha, V-1, V*(r-1), lower.tail = FALSE)
g = data.frame(r, round(w, 3), round(rhs, 3))
while(w > rhs){
r = r+1
rhs = h^2*r/((V-1)*MSE)
w = qf(alpha, V-1, V*(r-1), lower.tail = FALSE)
g = data.frame(r, round(w, 3), round(rhs, 3))
}
rbind(g)
}
table(MSE = msE, V = a*b, H = h)
```
I figured it would go something like this, but this only prints out the last value of r before the loop ends (it ends at 26), which results in a "table" that only has one row. I would like a table with 24 rows (since it starts at r = 2).
Any help would be appreciated!

Perhaps this might help:
al = 0.10; n = 30; a = 3; b = 5; r = 2; int = 8; h = (int/2); msE = 19.19
table = function(MSE, V, H, alpha = al, r = 2){
rhs = h^2*r/((V-1)*MSE)
w = qf(alpha, V-1, V*(r-1), lower.tail = FALSE)
g = data.frame(r, round(w, 3), round(rhs, 3))
gn = data.frame(r, round(w, 3), round(rhs, 3))
while(w > rhs){
r = r+1
rhs = h^2*r/((V-1)*MSE)
w = qf(alpha, V-1, V*(r-1), lower.tail = FALSE)
g = data.frame(r, round(w, 3), round(rhs, 3))
gn <- rbind(gn,g)
}
return(gn)
}
table(MSE = msE, V = a*b, H = h)

A slightly different approach, eliminating the need for an interim data frame and for rbind(). Commented in the code.
# your parameters
al <- 0.10; n <- 30; a <- 3; b <- 5; int <- 8; h <- (int/2); msE <- 19.19
# your function definition (name changed to avoid confusion / conflict with existing R function)
tabula <- function(MSE, V, H, alpha = al, r = 2)
{
g <- data.frame( N = 0, W = 1, RHS = 0 ) # initiate data frame, values set
# so that the while condition is met
# the while function populates the data frame cell by cell,
# eliminating the need for an interim data.frame and rbind()
while( g[ r - 1, "W" ] > g[ r - 1, "RHS" ] ) # check condition in the last data frame row
{ # write values in a new row
g[ r, "N" ] <- r
g[ r, "W" ] <- round( qf( alpha, V - 1, V * ( r - 1 ), lower.tail = FALSE ), 3 )
g[ r, "RHS" ] <- round( h^2 * r / ( ( V - 1 ) * MSE ), 3 )
r <- r + 1 # increment row counter
}
return( g[ -1, ] ) # return the data frame, removing the initial row
}
tabula( MSE = msE, V = a * b, H = h )

Related

How to store list values in to matrix

set.seed(650)
library(maxLik)
y = c(rnorm(15,1,1), rnorm(15,3,1))
dat = data.frame(y)
B = 3 # number bootstrap sample
n = length(dat$y)
n1 = 15
boot.samples = matrix(sample(dat$y, size = B * n, replace = TRUE), n, B)
ml = list()
boot.l = 0
va.l = NULL
for (j in 1:B) {
boot.l = boot.samples[, j]
for (i in 1:n) {
LLl <- function(param) {
mul <- param[1]
sigmal <- param[2]
sum(log(dnorm(dat[1:i, ], mul, sigmal)))
}
ml[[i]] = coef(maxLik(logLik = LLl, start = c(mul = 1, sigmal = 1)))
}
va.l = matrix(unlist(ml), n-1, B*2, byrow = TRUE)
}
va.l
The following are my output
However, when I print the list I have the following output.
My question is how can I have mul estimates for j=1 in the 1st column, sigmal estimates for j = 1 in the second column and mul estimates for j=2 in the 3rd column, sigmal estimates for j = 2 in the 4th column and so on?
Are there any other way do this? Thank you for your help.

R : Changing values of variables after certain time

the question I am trying to ask is how to I change one of the values of my variables (noted as LO$M in my list) after I pass a certain time.
The thing I am trying to achieve is that after 20,000 seconds passing I would like to change my value of Lac to the value of Lac at time 20,0000 +10,000
So at t = 20,000, Lac = Lac + 10,000
The issue I am having with my code is that within my if command I have if tt>= 20000, but this leads to the issue that every value of Lac after 20,000 being increased by 10,000 when what i want is that the FIRST value after 20,000 be increased by 10,000.
Basically, after 20,000 of my experiment passing I am trying to inject 10,000 more Lac into the experiment.
My code is given below:
LO = list()
LO$M = c(i = 1, ri = 0, I = 50, Lac = 20, ILac = 0, o = 1, Io = 0, RNAP = 100, RNAPo = 0, r = 0, z = 0)
LO$Pre = matrix(c(1,0,0,0,0,0,0,0,0,0,0,
0,1,0,0,0,0,0,0,0,0,0,
0,0,1,1,0,0,0,0,0,0,0,
0,0,0,0,1,0,0,0,0,0,0,
0,0,1,0,0,1,0,0,0,0,0,
0,0,0,0,0,0,1,0,0,0,0,
0,0,0,0,0,1,0,1,0,0,0,
0,0,0,0,0,0,0,0,1,0,0,
0,0,0,0,0,0,0,0,1,0,0,
0,0,0,0,0,0,0,0,0,1,0,
0,0,0,1,0,0,0,0,0,0,1,
0,1,0,0,0,0,0,0,0,0,0,
0,0,1,0,0,0,0,0,0,0,0,
0,0,0,0,1,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,1,0,
0,0,0,0,0,0,0,0,0,0,1), ncol=11, byrow=TRUE)
LO$Post = matrix(c(1,1,0,0,0,0,0,0,0,0,0,
0,1,1,0,0,0,0,0,0,0,0,
0,0,0,0,1,0,0,0,0,0,0,
0,0,1,1,0,0,0,0,0,0,0,
0,0,0,0,0,0,1,0,0,0,0,
0,0,1,0,0,1,0,0,0,0,0,
0,0,0,0,0,0,0,0,1,0,0,
0,0,0,0,0,1,0,1,0,0,0,
0,0,0,0,0,1,0,1,0,1,0,
0,0,0,0,0,0,0,0,0,1,1,
0,0,0,0,0,0,0,0,0,0,1,
0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,
0,0,0,1,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0), ncol=11, byrow=TRUE)
LO$h = function(x,t,th=c(0.02,0.1,0.005,0.1,1,0.01,0.1,0.01,0.03,0.1,1e-05,0.01,0.002,0.01,0.001))
{
with(as.list(c(x, th)), {
return(c(th[1]*i, th[2]*ri, th[3]*I*Lac, th[4]*ILac, th[5]*I*o, th[6]*Io, th[7]*o*RNAP,
th[8]*RNAPo, th[9]*RNAPo, th[10]*r, th[11]*Lac*z, th[12]*ri, th[13]*I,
th[13]*ILac, th[14]*r, th[15]*z))
})
}
gillespie1 = function (N, n, ...)
{
tt = 0
x = N$M
S = t(N$Post - N$Pre)
u = nrow(S)
v = ncol(S)
tvec = vector("numeric", n)
xmat = matrix(ncol = u, nrow = n + 1)
xmat[1, ] = x
for (i in 1:n) {
h = N$h(x, tt, ...)
tt = tt + rexp(1, sum(h))
j = sample(v, 1, prob = h)
x = x + S[, j]
tvec[i] = tt
xmat[i + 1, ] = x
if( tt >=20000){
x[4] = x[4] +10000
}
}
return(list(t = tvec, x = xmat))
}
newout = gillespie1(LO,200000)
matplot(newout$x[,4], type="l", lwd=0.25, col="grey")
I don't have a high enough reputation to attach images, but it should look something like this:
https://gyazo.com/0ffd940a22df23b2ccfdf4a17e85dca8
Sorry if this isn't clear. Thanks
In this example, you have the function myTask(). When you call execMyTask(), you will execute myTask()once, and after that, you will execute it at random intervals between 1 to max_wait milliseconds. When you get tired, you can kill the task with tclTaskDelete().
library(tcltk2)
myTask <- function() cat("some task!\n")
id = "execMyTask"
execMyTask <- function(max_wait = 3000) {
id <- toString(match.call()[[1]])
myTask()
wait = sample(1:max_wait, 1)
cat("Waiting", wait, "miliseconds\n") # replace with your function
if (is.null(tclTaskGet(id))) {
tclTaskSchedule(wait=wait, execMyTask(), id=id, redo = TRUE)
} else {
tclTaskChange(wait=wait, execMyTask(), id=id, redo = TRUE)
}
}
execMyTask()
tclTaskDelete(id)
So far, there is a little problem with this approach, because we can not supply arguments to the function fun in tclTaskChange().

Vectorized R function to produce sets of histograms

I have a vectorized R function (see below). At each run, the function plots two histograms. My goal is that when argument n is a vector (see example of use below), the function plots length of n separate sets of these histograms (ex: if n is a vector of length 2, I expected two sets of histograms i.e., 4 individual histograms)?
I have tried the following with no success. Is there a way to do this?
t.sim = Vectorize(function(n, es, n.sim){
d = numeric(n.sim)
p = numeric(n.sim)
for(i in 1:n.sim){
N = sqrt((n^2)/(2*n))
x = rnorm(n, es, 1)
y = rnorm(n, 0, 1)
a = t.test(x, y, var.equal = TRUE)
d[i] = a[[1]]/N
p[i] = a[[3]]
}
par(mfcol = c(2, length(n)))
hist(p) ; hist(d)
}, "n")
# Example of use:
t.sim(n = c(30, 300), es = .1, n.sim = 1e3) # `n` is a vector of `2` so I expect
# 4 histograms in my graphical device
Vectorize seems to be based on mapply, which would essentially call the function numerous times while cycle through your inputs vector. Hence, the easier way out probably just calls it outside the function
t.sim = Vectorize(function(n, es, n.sim){
d = numeric(n.sim)
p = numeric(n.sim)
for(i in 1:n.sim){
N = sqrt((n^2)/(2*n))
x = rnorm(n, es, 1)
y = rnorm(n, 0, 1)
a = t.test(x, y, var.equal = TRUE)
d[i] = a[[1]]/N
p[i] = a[[3]]
}
# par(mfcol = c(2, npar))
hist(p) ; hist(d)
}, "n")
#inputs
data <- c(30,300)
par(mfcol = c(2, length(data)))
t.sim(n = data, es = c(.1), n.sim = 1e3)

Efficient code to map genotype matrix in R

Hi I want to convert a matrix of genotypes, encoded as triples to a matrix encoded as 0, 1, 2, i.e.
c(0,0,1) <-> 0; c(0,1,0) <-> 1; c(0,0,1) <-> 2
First here is some code to generate the matrix that needs to be reduced.
# generate genotypes
expand.G = function(n,p){
probs = runif(n = p)
G012.rows = matrix(rbinom(2,prob = probs,n=n*p),nrow = p)
colnames(G012.rows) = paste('s',1:n,sep = '')
rownames(G012.rows) = paste('g',1:p, sep = '')
G012.cols = t(G012.rows)
expand.geno = function(g){
if(g == 0){return(c(1,0,0))}
if(g == 1){return(c(0,1,0))}
if(g == 2){return(c(0,0,1))}
}
gtype = c()
for(i in 1:length(c(G012.cols))){
gtype = c(
gtype,
expand.geno(c(G012.cols)[i])
)
}
length(gtype)
G = matrix(gtype,byrow = T, nrow = p)
colnames(G) = paste('s',rep(1:n,each = 3),c('1','2','3'),sep = '')
rownames(G) = paste('g',1:p, sep = '')
print(G[1:10,1:15])
print(G012.rows[1:10,1:5])
return(G)
}
The output has 3n columns and p rows, where n is sample size and p is number of genotypes. Now we can reduce the matrix back to 0,1,2 coding with the following functions
reduce012 = function(x){
if(identical(x, c(1,0,0))){
return(0)
} else if(identical(x, c(0,1,0))){
return(1)
} else if(identical(x, c(0,0,1))){
return(2)
} else {
return(NA)
}
}
reduce.G = function(G.gen){
G.vec =
mapply(function(i,j) reduce012(as.numeric(G.gen[i,(3*j-2):(3*j)])),
i=expand.grid(1:(ncol(G.gen)/3),1:nrow(G.gen))[,2],
j=expand.grid(1:(ncol(G.gen)/3),1:nrow(G.gen))[,1]
)
G = matrix(G.vec, nrow = ncol(G.gen)/3, ncol = nrow(G.gen))
colnames(G) = rownames(G.gen)
return(G)
}
reduce.G.loop = function(G.gen){
G = matrix(NA,nrow = ncol(G.gen)/3, ncol = nrow(G.gen))
for(i in 1:nrow(G.gen)){
for(j in 1:(ncol(G.gen)/3)){
G[j,i] = reduce012(as.numeric(G.gen[i,(3*j-2):(3*j)]))
}
}
colnames(G) = rownames(G.gen)
return(G)
}
The output is n rows by p columns. It is incidental, but intentional, that the matrix encoded as 0,1,2 is the transpose of the matrix encoded as triples.
The code is not particularly fast. What is bothering me is that the the timing goes with n^2. Can you explain or supply more efficient code?
G = expand.G(1000,20)
system.time(reduce.G(G))
system.time(reduce.G.loop(G))
G = expand.G(2000,20)
system.time(reduce.G(G))
system.time(reduce.G.loop(G))
G = expand.G(4000,20)
system.time(reduce.G(G))
system.time(reduce.G.loop(G))
You can simply make an accessor lookup table:
decode <- array(dim = c(3, 3, 3))
decode[cbind(1, 0, 0) + 1] <- 0
decode[cbind(0, 1, 0) + 1] <- 1
decode[cbind(0, 0, 1) + 1] <- 2
And then, just do:
matrix(decode[matrix(t(G + 1), ncol = 3, byrow = TRUE)], ncol = nrow(G))
This full vectorized R version will give you the same matrix, without dimnames and super fast.
Yet, if you have much larger matrices, you should really use Rcpp for both memory and timing issues.
This seems to be a about three times faster than your version (renamed reduce.G.orig):
reduce.G <- function(G) {
varmap = c("100"=0, "010"=1, "001"=2)
result <- do.call(rbind, lapply(1:(ncol(G)/3)-1, function(val)
varmap[paste(G[,3*val+1], G[,3*val+2], G[,3*val+3], sep="")]))
colnames(result) <- rownames(G)
result
}
system.time(reduce.G(G))
# user system elapsed
# 0.156 0.000 0.155
system.time(reduce.G.orig(G))
# user system elapsed
# 0.444 0.000 0.441
identical(reduce.G(G), reduce.G.orig(G))
# [1] TRUE

R code clinical trials

This is my code for running a clinical trial in order to show probability of a trial been successful. My problem is that I need to show that by introducing a second set of sample (n.2), how many samples are required to produce a value above the threshold of 90%. Any help please, I know I need to loop the code I have but am having trouble doing so.
calc.quant = function( n, X.1, a, b, n.2, nsim, thr, p1=0.025, p2=0.975 )
{
a.star = a + n
b.star = b + n - X.1
theta = rbeta( nsim, a.star, b.star
X.2 = rbinom( nsim, n.2, theta )
theta.p1p2 = matrix( 0, nrow=nsim, ncol=2 )
for( j in 1:nsim ) {
theta.p1p2[j,] = qbeta( c( p1, p2 ), a.star + X.2[j], b.star + n.2 - X.2[j] )
}
return( theta.p1p2 )
}
n = 117
X.1 = 110
a = 1
b = 1
n.2 = 50
nsim = 1000
thr = .90
res = calc.quant( n, X.1, a, b, n.2, nsim, thr )
sum( res[,1] > thr ) / nsim
[This is not a complete answer, but simply to get clarification on what the OP is going for.]
Basic strategy with a for-loop:
threshold <- somevalue
for(i in someseq){
output <- somefunction(...)
if(output > threshold)
break
}
output
Basic strategy with a while-loop:
threshold <- somevalue
below.threshold <- TRUE
while(below.threshold){
output <- somefunction(...)
if(output > threshold)
below.threshold <- FALSE
}

Resources