I have been trying to implement a random walk on the n-cycle algorithm in R.
By n-cycle I mean the set of integers Zn, or modulo n. Basically, it’s example 5.3.1 from the book “Markov chains and mixing time”, by Levin, Peres and Wilmer. The intention is as follows: consider two chains modeling the movement of two particles X and Y on Zn with starting points X1 and Y1. By the flip of a fair coin we decide which particle will move (the particles cannot move simultaneously unless they have coupled); the direction is decided by another flip of fair coin.
Once the two particle collide, they move together hereafter. It is part of a study project to implement a CFTP algorithm, so the length of the chains should have a pre-defined value, say T.
The code does not run and an error message appears. The error is “object ‘res’ not found”. However, I had previously defined “res” as a list to store the output of the function. Why does this happen and how could it be fixed?
I have two scripts: in the first one the code is split in smaller helper functions; the second one may be messier, as I tried to put all the helper functions within one single function.
Any help will be much appreciated.
This one is script 2.
# X1 - initial state of chain X
# Y1 - initial state of chain Y
# T - "length" of a chain, number of steps the chains will run for.
# n - length of the n-cycle, i.e., Zn.
Main_Function <- function (X1 = 8, Y1 = 4 , T = 20, n = 6){
X <- rep( X1, T) %% n # X, Y and res will store the results
Y <- rep( Y1, T) %% n
res <- list(X,Y) # Here I defined the object res. Later on R encounters an error "object 'res' not found".
ps <- TakeOneStep() # TakeOneStep is a function defined below
return(ps)
}
TakeOneStep <- function(){
incr_same <- sample(c(-1, 0, 1), size = 1, prob = c(1/4, 1/2, 1/4)) #direction of the particles after they have coupled
incr_dif <- sample(c(-1,1), size = 1, prob = c(1/2, 1/2)) # direction of the particles before coupling occurred.
choice <- runif(T) # determines which chain moves, before coupling occurred.
for(t in 2:T){
if(res[[1]][t-1]%%n == res[[2]][t-1]%%n){
res[[1]][t] <- (res[[1]][t-1] + incr_same) %% n
res[[2]][t] <- (res[[2]][t-1] + incr_same) %% n
}else{ if(choice[t] < 0.5) {
res[[1]][t] <- (res[[1]][t-1] + incr_dif) %% n
}else{res[[2]][t] <- (res[[2]][t-1] + incr_dif)%%n}
}
}
return(res)
}
Related
I am trying to exercise a simulation of Sierpinski triangle in R with affine transformation and Iterated Function System (IFS). And hopefully, I can further exercise how the simulation of Barnsley's fern can also be done. For those who know Chinese, this video is my starting point of this exercise.
Here is a short introduction of the simulation process:
Create an equilateral triangle, name the vertices A, B, C
Create a random initial point lying inside the triangle ABC
Sample A, B, C with equal chances
If the outcome is A, then move the initial point to the midpoint of A and itself
Repeat step 3, and move the last point to the midpoint of the outcome point and itself.
By doing this repeatedly, we should see the path of the points looks like a Sierpinski triangle.
I wonder how the assignment of variable works inside a self-defined function. I would like to create an object (a matrix or a dataframe) to store the path of simulated points and keep updating the object to keep track of how the points move.
the following is my current codes:
# create the triangle
triangle <- matrix(c(A = c(-1,0),
B = c(1, 0),
C = c(0, sqrt(3))),
byrow = TRUE, nrow = 3, ncol = 2)
colnames(triangle) <- c("X", "Y") # axis name
rownames(triangle) <- c("A", "B", "C")
# sample an initial point inside the triangle ABC
sampleInit <- function(){
X <- runif(1, min = -1, max = 1)
Y <- runif(1, min = 0, max = sqrt(3))
if( (Y >= 0) && (Y <= (sqrt(3)*X + sqrt(3))) && (Y <= -sqrt(3)*X+sqrt(3)) ){
return(cbind(X, Y))
} else {
sampleInit()
}
}
### graph: plot the triangle and the initial point together
graphics.off()
plot(triangle, xlim = c(-1, 1), ylim = c(0, sqrt(3)))
par(new = TRUE)
plot(sampleInit(), xlim = c(-1, 1), ylim = c(0, sqrt(3)), col = "red")
### a three-sided dice: determine the direction to move along
diceRoll <- function(){
return(sample(c("A", "B", "C"), size = 1, prob = c(1/3, 1/3, 1/3)))
}
## path
stepTrace <- as.data.frame(sampleInit())
move <- function(diceOutCome, stepTrace){
lastStep <- tail(stepTrace, 1)
if(diceOutCome == "A"){
X <- (-1 + lastStep[,1])/2
Y <- (0 + lastStep[,2])/2
} else if(diceOutCome == "B"){
X <- (1 + lastStep[,1])/2
Y <- (0 + lastStep[,2])/2
} else if(diceOutCome == "C"){
X <- (0 + lastStep[,1])/2
Y <- (sqrt(3) + lastStep[,2])/2
}
lastStep <- cbind(X, Y)
stepTrace <- rbind(stepTrace, lastStep)
}
move(diceRoll(), stepTrace)
View(stepTrace)
Sorry for the long story and not jumping to the key question directly. My question is that stepTrace (the object I would like to store the path) didn't get updated as I execute the last two lines.
What I imagined was the assignment process in move() updates the dataframe stepTrace, however it turns out it doesn't. I check my code in the debugger, and found out that stepTrace did get updated inside the function call, but it didn't pass the new assigned value outside the function call. That's why I would like to ask how does the assignment process works in R. What is the difference between the this kind of process and other general purpose languages such as Java? (What I imagined to do this exercise in Java would not encounter this kind of assignment issue. Correct me if I am wrong since I am still new to Java)
Similar problems bother me when I tried to assign variables inside a loop. I know there is a base function assign that helps to resolve is issue, but I just don't know what is the mechanism behind it.
I tried to google my question, but I am not sure which keyword I should use, and I didn't find direct answers to my question. Any comment, keyword or external resource to the documentation is appreciated!
In short, your move function does what you want, but it is not advisable to write it like that. In its current form, stepTrace is updated in the function's local environment, but not in the global environment, where your stepTrace lives. They are not the same stepTrace. To fix it, you can run stepTrace <- move(diceRoll(), stepTrace), but beware of the second circle. For a cleaner approach, remove the last stepTrace assignment from move.
From ?return: If the end of a function is reached without calling return, the value of the last evaluated expression is returned.
Consider the following examples:
x <- 5
a <- b <- c <- d <- 1
f1 <- function(x) x + 1
f2 <- function(x) return(x + 1)
f3 <- function(x) x <- x + 1
f4 <- function(x) x <<- x + 1
f1(1)
f2(1)
f3(1) # your problem
f4(1) # x gets replaced with x in f4, 2 in global environment.
a <- b <- c <- d <- 1
a <- f1(1)
b <- f2(1)
c <- f3(1)
d <- f4(1)
f3 and f4 are generally considered bad practice because of side effects, i.e. they (can) modify a non-local variable, f2 might trigger a discussion. For f3, see the result of
c(f3(1))
#> [1] 2
Given our experiment of calling f3(1) by itself, we'd expect a vector of length 0 (?). Consider removing any assignment as the last operation within your functions, and avoid naming your function arguments the same as the objects you intend to change.
#DonaldSeinen explained how to fix your code in his answer. I'll try to point you to documentation for more details.
First, you don't need to go to external documentation. An Introduction to R and The R Language Definition manuals are included in R distributions. The Introduction describes what's going on in lots of detail in section 10.7, "Scope". There's a different description in the Language Definition in section 3.5, "Scope of Variables".
Some people find the language in those manuals to be too technical. An easier to read external reference that gets it right is Wickham's Advanced R, readable online at https://adv-r.hadley.nz/. Scoping is discussed in chapters 6 and 7, especially sections 6.4 and 7.2.
I am trying to set up a process using a while loop in order to have my code consistently sample among certain xd[i] before one particular xd[i] becomes equal to x.
I know it would be more efficient to put everything under one for loop (except for the while loop) but I am trying to create this step by step. Right now, I am stuck on the while loop part. I cannot run that part of the code without R crashing, or if it does not crash, it seems to continue sampling nonstop until I manually stop it. How can I change my while loop such that it samples over the xd vector until one of the elements of xd matches with x?
Thank you
reset1 = {
a = 0.3 #lower legal threshold
b = 0.9 #upper legal threshold
x = 0
theta = runif(1,min = a, max = b)
theta
A = 5 ## monetary value of harm from
maxw = 2*A
minw = 0
wbar = (maxw+minw)/2 ##average cost
wbar
xd = c(1,2,3)
w = c(1,2,3)
}
for (i in 1:length(xd)){w[i] = runif(1, min = 0, max = 2)} #trying to make it create a w for each person
##Drivers problem: pick the x that will minimize your cost
for(i in 1:length(xd)){xd[i] = min(c(1-(w[i]/(2*A)),((2+b)-sqrt(b^2-2*b+1+3*(w[i]/A)*(b-a)))/3,b))}
xd
for(i in 1:length(xd)){proba = function(xd){(xd-1)^2}}
proba(xd) #ith individual probability of getting in an accident given their xd[i]
proba(xd[c(1:3)])
probn = 1 - proba(xd) #probability of not getting in an accident given driveri's effort level
probn
while (any(x!=xd)) {x = sample(c(xd[c(1,2,3)],0,0,0),size = 1, replace = TRUE, prob = c(proba(xd), probn)) ###the x is selected based on which ever x resulted in an accident
}
show(x)
Perhaps
while(sum(xd!=x)==3){}
This loops runs as long as no element of xd equals x
I am working on Spike Trains and my code to get a spike train like this:
for 20 trials is written below. The image is representational for 5 trials.
fr = 100
dt = 1/1000 #dt in milisecond
duration = 2 #no of duration in s
nBins = 2000 #10msSpikeTrain
nTrials = 20 #NumberOfSimulations
MyPoissonSpikeTrain = function(p, fr= 100) {
p = runif(nBins)
q = ifelse(p < fr*dt, 1, 0)
return(q)
}
set.seed(1)
SpikeMat <- t(replicate(nTrials, MyPoissonSpikeTrain()))
plot(x=-1,y=-1, xlab="time (s)", ylab="Trial",
main="Spike trains",
ylim=c(0.5, nTrials+1), xlim=c(0, duration))
for (i in 1: nTrials)
{
clip(x1 = 0, x2= duration, y1= (i-0.2), y2= (i+0.4))
abline(h=i, lwd= 1/4)
abline(v= dt*which( SpikeMat[i,]== 1))
}
Each trial has spikes occuring at random time points. Now what I am trying to work towards, is getting a random sample time point that works for all 20 trials and I want to get the vector consisting of length of the intervals this point falls into, for each trial. The code to get the time vector for the points where the spikes occur is,
A <- numeric()
for (i in 1: nTrials)
{
ISI <- function(i){
spike_times <- c(dt*which( SpikeMat[i, ]==1))
ISI1vec <- c(diff(spike_times))
A <- c(A, ISI1vec)
return(A)}
}
Then you call ISI(i) for whichever trial you wish to see the Interspike interval vector for. A visual representation of what I want is:
I want to get a vector that has the lengths of the interval where this points fall into, for each trial. I want to figure out it's distribution as well, but that's for later. Can anybody help me figure out how to code my way to this? Any help is appreciated, even if it's just about how to start/where to look.
Your data
set.seed(1)
SpikeMat <- t(replicate(nTrials, MyPoissonSpikeTrain()))
I suggest transforming your sparse matrix data into a list of indices where spikes occur
L <- lapply(seq_len(nrow(SpikeMat)), function(i) setNames(which(SpikeMat[i, ] == 1), seq_along(which(SpikeMat[i, ] == 1))))
Grab random timepoint
set.seed(1)
RT <- round(runif(1) * ncol(SpikeMat))
# 531
Result
distances contains the distances to the 2 nearest spikes - each element of the list is a named vector where the values are the distances (to RT) and their names are their positions in the vector. nearest_columns shows the original timepoint (column number) of each spike in SpikeMat.
bookend_values <- function(vec) {
lower_val <- head(sort(vec[sign(vec) == 1]), 1)
upper_val <- head(sort(abs(vec[sign(vec) == -1])), 1)
return(c(lower_val, upper_val))
}
distances <- lapply(L, function(i) bookend_values(RT-i))
nearest_columns <- lapply(seq_along(distances), function(i) L[[i]][names(distances[[i]])])
Note that the inter-spike interval of the two nearest spikes that bookend RT can be obtained with
sapply(distances, sum)
I want to skip an error (if there is any) in a loop and continue the next iteration. I want to compute 100 inverse matrices of a 2 by 2 matrix with elements randomly sampled from {0, 1, 2}. It is possible to have a singular matrix (for example,
1 0
2 0
Here is my code
set.seed(1)
count <- 1
inverses <- vector(mode = "list", 100)
repeat {
x <- matrix(sample(0:2, 4, replace = T), 2, 2)
inverses[[count]] <- solve(x)
count <- count + 1
if (count > 100) break
}
At the third iteration, the matrix is singular and the code stops running with an error message. In practice, I would like to bypass this error and continue to the next loop. I know I need to use a try or tryCatch function but I don't know how to use them. Similar questions have been asked here, but they are all really complicated and the answers are far beyond my understanding. If someone can give me a complete code specifically for this question, I really appreciate it.
This would put NULLs into inverses for the singular matrices:
inverses[[count]] <- tryCatch(solve(x), error=function(e) NULL)
If the first expression in a call to tryCatch raises an error, it executes and returns the value of the function supplied to its error argument. The function supplied to the error arg has to take the error itself as an argument (here I call it e), but you don't have to do anything with it.
You could then drop the NULL entries with inverses[! is.null(inverses)].
Alternatively, you could use the lower level try. The choice is really a matter of taste.
count <- 0
repeat {
if (count == 100) break
count <- count + 1
x <- matrix(sample(0:2, 4, replace = T), 2, 2)
x.inv <- try(solve(x), silent=TRUE)
if ('try-error' %in% class(x.inv)) next
else inverses[[count]] <- x.inv
}
If your expression generates an error, try returns an object with class try-error. It will print the message to screen if silent=FALSE. In this case, if x.inv has class try-error, we call next to stop the execution of the current iteration and move to the next one, otherwise we add x.inv to inverses.
Edit:
You could avoid using the repeat loop with replicate and lapply.
matrices <- replicate(100, matrix(sample(0:2, 4, replace=T), 2, 2), simplify=FALSE)
inverses <- lapply(matrices, function(mat) if (det(mat) != 0) solve(mat))
It's interesting to note that the second argument to replicate is treated as an expression, meaning it gets executed afresh for each replicate. This means you can use replicate to make a list of any number of random objects that are generated from the same expression.
Instead of using tryCatch you could simply calculate the determinant of the matrix with the function det. A matrix is singular if and only if the determinant is zero.
Hence, you could test whether the determinant is different from zero and calculate the inverse only if the test is positive:
set.seed(1)
count <- 1
inverses <- vector(mode = "list", 100)
repeat {
x <- matrix(sample(0:2, 4, replace = T), 2, 2)
# if (det(x)) inverses[[count]] <- solve(x)
# a more robust replacement for the above line (see comment):
if (is.finite(determinant(x)$modulus)) inverses[[count]] <- solve(x)
count <- count + 1
if (count > 100) break
}
Update:
It is, however, possible to avoid generating singular matrices. The determinant of a 2-by-2 matrix mat is definded as mat[1] * mat[4] - mat[3] * mat[2]. You could use this knowledge for sampling random numbers. Just do not sample numbers which will produce a singular matrix. This, of course, depends on the numbers sampled before.
set.seed(1)
count <- 1
inverses <- vector(mode = "list", 100)
set <- 0:2 # the set of numbers to sample from
repeat {
# sample the first value
x <- sample(set, 1)
# if the first value is zero, the second and third one are not allowed to be zero.
new_set <- ifelse(x == 0, setdiff(set, 0), set)
# sample the second and third value
x <- c(x, sample(new_set, 2, replace = T))
# calculate which 4th number would result in a singular matrix
not_allowed <- abs(-x[3] * x[2] / x[1])
# remove this number from the set
new_set <- setdiff(0:2, not_allowed)
# sample the fourth value and build the matrix
x <- matrix(c(x, sample(new_set, 1)), 2, 2)
inverses[[count]] <- solve(x)
count <- count + 1
if (count > 100) break
}
This procedure is a guarantee that all generated matrices will have an inverse.
try is just a way of telling R: "If you commit an error inside the following parentheses, then skip it and move on."
So if you're worried that x <- matrix(sample(0:2, 4, replace = T), 2, 2) might give you an error, then all you have to do is:
try(x <- matrix(sample(0:2, 4, replace = T), 2, 2))
However, keep in mind then that x will be undefined if you do this and it ends up not being able to compute the answer. That could cause a problem when you get to solve(x) - so you can either define x before try or just "try" the whole thing:
try(
{
x <- matrix(sample(0:2, 4, replace = T), 2, 2)
inverses[[count]] <- solve(x)
}
)
The documentation for try explains your problem pretty well. I suggest you go through it completely.
Edit: The documentation example looked pretty straightforward and very similar to the op's question. Thanks for the suggestion though. Here goes the answer following the example in the documentation page:
# `idx` is used as a dummy variable here just to illustrate that
# all 100 entries are indeed calculated. You can remove it.
set.seed(1)
mat_inv <- function(idx) {
print(idx)
x <- matrix(sample(0:2, 4, replace = T), nrow = 2)
solve(x)
}
inverses <- lapply(1:100, function(idx) try(mat_inv(idx), TRUE))
I have two vectors x and y. x is a larger vector compared to y. For example (x is set to all zeros here, but that need not be the case)
x = rep(0,20)
y = c(2,3,-1,-1)
What I want to accomplish is overlay some y's in x but at random. So in the above example, x would look like
0,0,2,3,-1,-1,0,0,0,0,2,3,-1,-1,...
Basically, I'll step through each value in x, pull a random number, and if that random number is less than some threshold, I want to overlay y for the next 4 places in x unless I've reached the end of x. Would any of the apply functions help? Thanks much in advance.
A simple way of doing it would be to choose points at random (the same length as x) from the two vectors combined:
sample(c(x, y), length(x), replace = TRUE)
If you want to introduce some probability into it, you could do something like:
p <- c(rep(2, each = length(x)), rep(1, each = length(y)))
sample(c(x, y), length(x), prob = p, replace = TRUE)
This is saying that an x point is twice as likely to be chosen over a y point (change the 2 and 1 in p accordingly for different probabilities).
Short answer: yes :-) . Write some function like
ranx <- runif(length(x)-length(y)+1)
# some loop or apply func...
if (ranx[j] < threshold) x[j:j+length(y)] <- y
# and make sure to stop the loop at length(y)-length(x)
Something like the following worked for me.
i = 1
while(i <= length(x)){
p.rand = runif(1,0,1)
if(p.rand < prob[i]){
p[i:(i+length(y))] = y
i = i+length(y)
}
i = i + 1
}
where prob[i] is some probability vector.