I am trying to code the Markov Chain approximation for some control problems.
But I have the following bug in R and I checked similar question in Stackoverflow and still have
no idea how to solve it. Any help will be greatly appreciated.
The bug comes from where I would like to find the minimum value among all of 'u' in a for loop.
To specific, in the uit-for-loop, for each next uit I could get a new single value (I thought) temp and would like to compare this with the temporary minimal stored by a single value variable vmin. That is the idea in the if-else sentence.
It is better to skip the parameter setting and initialization procedure.
#----- parameters ------
xleft=0; xright=10
yleft=0; yright=10
h=0.01
Nx=(xright-xleft)/h
Ns=2
Nu=11; hu=0.2
la=0.1
qMainDiag=c(-0.5,-0.5)
qSubDiag=c(0.5,0.5)
alpha=c(0.2,0.25)
beta=c(0.35,0.2)
a=c(0.6,0.8)
b=c(0.5,0.3)
c=c(0.45,0.5)
d=c(0.65,0.8)
tol=10^(-8)
maxitr=10000
#---- Initialization -----
Vold=array(0,dim=c(Nx+1,Nx+1,Ns))
Vnew=array(0,dim=c(Nx+1,Nx+1,Ns))
Uopt=array(0,dim=c(Nx+1,Nx+1,Ns))
for(r in 1:Ns){
for(i in 1:(Nx+1)){
for(j in 1:(Nx+1)){
Vold[i,j,r]=1
}
}
}
#---- iteration ----
for(n in 1:maxitr){
for(r in 1:Ns){
# inner of O
for(i in 2:Nx){
for(j in 2:Nx){
vInt=0
for(it in 1:(min(i,j)+1)){
vInt=vInt+Vold[i-it+1,j-it+1,r]*0.1*exp(-0.1*(it-1)*h)*h
}
# For each u, want to find the minimum temp value and its u.
for(uit in 1:Nu){
x=xleft+(i-1)*h; y=yleft+(j-1)*h
u=hu*(uit-1)
Xi11=(alpha[r]*x)^2; Xi22=(beta[r]*y)^2
f1=x*(a[r]-b[r]*y+u); f2=y*(-c[r]+d[r]*x+u)
g=1+r*(x+y)*(1+u^2)
Qh=(Xi11+Xi22)+h*(abs(f1)+abs(f2))+h-(h^2)*qMainDiag[r]
dlt=(h*h)/Qh
pforward=0.5*(Xi11+2*h*max(f1,0.0))/Qh
pback=0.5*(Xi11+2*h*max(-f1,0.0))/Qh
pup=0.5*(Xi22+2*h*max(f2,0.0))/Qh
pdown=0.5*(Xi22+2*h*max(-f2,0.0))/Qh
pswitch=(h*h*qSubDiag[r])/Qh
pstay=h/Qh
temp=(1-la*dlt)*(pforward*Vold[i+1,j,r]+pback*Vold[i-1,j,r]
+pup*Vold[i,j+1,r]+pdown*Vold[i,j-1,r]
+pswitch*Vold[i,j,3-r]
+pstay*Vold[i,j,r])+la*dlt*vInt+dlt*g
# find the minimal value (Here is the spot!!!)
if(uit==1){
vmin=temp; umin=u
}else if(temp<vmin){
vmin=temp; umin=u
}
}
Vnew[i,j,r]=vmin
Uopt[i,j,r]=umin
}
}
errormax=max(abs(Vold-Vnew))
print(n)
print(errormax)
Vold=Vnew
if(errormax<tol){
break
}
}
}
Related
I have tried the following but the output brings an argument stating,
Error in append("0") : argument "values" is miss
for (rowz in final_data$Ingridients) {
Cobalt_row<-lst()
if (sum(str_detect(rowz, 'Cobalt'))>0) {
Cobalt_row.append(1)
} else {
Cobalt_row<-append(0)
}
print(Cobalt_row)
}
I intended to loop through the list and generate a boolean of ones and twos depending on
whether or not I had the value.
Please help
Without the data, I can't test it, but this should work:
Cobalt_row<-lst()
k <- 1
for (rowz in final_data$Ingridients) {
Cobalt_row[[k]] <- ifelse(str_detect(rowz, 'Cobalt'), 1, 0)
k <- k+1
}
or even simpler if you need a list:
Cobalt_row <- as.list(as.numeric(str_detect(final_data$Ingredients, "Cobalt")))
I have been trying to find the observations associated with rank j in Ranked Set Sampling method. The problem is I don't know how to use the simulations to find the Xj values I'm supposed to work with further. Please help!
#The rankedsets function selects ranked sets from a target population. The selection of units in a set is without replacement, but the sets are selecting with replacement.
rankedsets<-function(X,m,s=m){
if(s==m){
x=sample(X,(m^2),replace=F)
n=matrix(x,ncol=m,nrow=m,byrow=T)
ms=matrix(0,ncol=m,nrow=m)
for (i in 1:m){
ms[i,]=sort(n[i,])
}
}else {
x=sample(X,(m*s),replace=F)
n=matrix(x,ncol=m,nrow=s,byrow=T)
ms=matrix(0,ncol=m,nrow=s)
for (i in 1:s){
ms[i,]=sort(n[i,])
}
}
return(ms)
}
#The rss function samples from a target population by using ranked set sampling method
rss<-function(X,m,r=1,sets=FALSE){
rss=numeric()
set=matrix(0,ncol=m,nrow=(m*r))
if (is.vector(X)){
a=0
for (j in 1:r){
ms=rankedsets(X,m)
for (i in 1:(m)){
set[i+a,]=ms[i,]
rss[i+a]=ms[i,i]
}
a=a+m
}
rss=matrix(rss,ncol=m,nrow=r,byrow=T)
cn=rn=numeric()
for (i in 1:r){
rn[i]=paste("r","=",i)
}
for (i in 1:m){
cn[i]=paste("m","=",i)
}
rownames(rss)=rn
colnames(rss)=cn
if (sets){
s=list(sets=set,sample=rss)
return(s)
} else {
return(rss)}
}else stop(" X must be a vector!",call.=F)
}
#RSS Data Generation
data=rnorm(10000,1,3)
rss(data,m=5,r=3,sets=TRUE)
I was trying using simulations but the code doesn't return Xj values:
sims = 1000
Xj = rep(NA, sims)
because I don't really know where I should put my for loop.
I have written a custom function that performs a mathematical transformation on a column of data with the inputs being the data and one other input (temperature). I would like to have 2 different logical checks. The first one is whether or not any values in the column exceed a certain threshold, because the transformation is different above and below the threshold. The second is a check if the temperature input is above a certain value and in that case, to deliver a warning that values above the threshold are unusual and to check the data.
Right now, I have the function written with a series of if/else statements. However, this a warning that it is only using the first element of the string of T/F statements. A simplified example of my function is as follows:
myfun = function(temp,data) {
if(temp > 34){
warning('Temperature higher than expected')
}
if (data > 50) {
result = temp*data
return(result)
} else if(data <= 50) {
result = temp/data
return(result)
}
}
myfun(temp = c(25,45,23,19,10), data = c(30,40,NA,50,10))
As you can see, because it is only using the first value for the if/else statements, it does not properly calculate the return values because it doesn't switch between the two versions of the transformation. Additionally, it's only checking if the first temp value is above the threshold. How can I get it to properly apply the logical check to every value and not just the first?
-edit-simplified the function per #The_Questioner's suggestion and changed < 50 to <= 50.
The main issue with your code is that you are passing all the values to the functions as vectors, but then are doing single element comparisons. You need to either pass the elements one by one to the function, or put some kind of vectorized comparison or for loop into your function. Below is the for loop approach, which is probably the least elegant way to do this, but at least it's easy to understand what's going on.
Another issue is that NA's apparently need to be handled in the data vector before passing to any of your conditional statements, or you'll get an error.
A final issue is what to do when data = 50. Right now you have conditional tests for greater or less than 50, but as you can see, the 4th point in data is 50, so right now you get an NA.
myfun = function(temp,data) {
result <- rep(NA,length(temp))
for (t in 1:length(temp)) {
if(temp[t] > 34) {
warning('Temperature higher than expected')
if (!is.na(data[t])) {
if (data [t] > 50) {
result[t] <- temp[t]*data[t]
} else if(data[t] < 50) {
result[t] <- temp[t]/data[t]
}
}
} else {
if (!is.na(data[t])) {
if (data[t] > 50) {
result[t] <- temp[t]*data[t]
} else if(data[t] < 50) {
result[t] <- temp[t]/data[t]
}
}
}
}
return(result)
}
Output:
> myfun(temp = c(25,45,23,19,10), data = c(30,40,NA,50,10))
[1] 0.8333333 1.1250000 NA NA 1.0000000
I did some programming work on R language to do the bubble sort. Sometimes it works perfectly without any error message, but sometimes, it shows "Error in if (x[i] > x[i + 1]) { : argument is of length zero". Can any one help me check whats wrong with it? I have attached my code below
example <- function(x) {
n <- length(x)
repeat {
hasChanged <- FALSE
n <- n - 1
for(i in 1:n) {
if ( x[i] > x[i+1] ) {
temp <- x[i]
x[i] <- x[i+1]
x[i+1] <- temp
hasChanged <- TRUE
cat("The current Vector is", x ,"\n")
}
}
if ( !hasChanged ) break;
}
}
x <-sample(1:10,5)
cat("The original Vector is", x ,"\n")
example(x)
The error occurs because you are iteratively decreasing n. Depending on the original vector's order (or lack thereof), n can reach the value of 1 after the last change. In that case, a further reduction of n in the next iteration step addresses the value x[0], which is undefined.
With a minimal correction your code will work properly, without giving error messages. Try to replace the line
if ( !hasChanged ) break;
with
if ( !hasChanged | n==1 ) break
Basically you have two termination criteria: Either nothing has been changed in the previous iteration or n is equal to one. In both cases, a further iteration won't change the vector since it is already ordered.
By the way, in R programming you don't need a semicolon at the end of a command. It is tolerated/ignored by the interpreter, but it clutters the code and is not considered good programming style.
Hope this helps.
In my previous question:How do I put arena limits on a random walk? the community helped create a random walk function in a set arena. This function is designed to simulate a fish moving through an area, but now I need to make it decide when to stop when a certain condition is satisfied.
I thought it would be as simple as
{{if(z>P)break}} put in just before the loop function. What I want it to understand is "if this condition is satisfied then stop, otherwise keep going until you reach the maximum number of steps.
Instead it caused my random walk to become deterministic (I always get the same path and it never stops before step.max).
Main question: How do I tell the random walk to stop if z>P?
For reference:
step.max<-125
step.prob<-function(n.times=step.max){
draw=sample(0:100,1,replace=T)
CS<-sample(draw,size=1,replace=TRUE)
CS.max<-100
step.num<-15
SP<-((CS/CS.max)*(1-(step.num/step.max))+(step.num/step.max))*100
if(SP>P){stop('Settled at step number',P)}else{SP
}
}
z<-step.prob(1) #renaming the above function to be easier to reference later
P<-80 #preset cutoff point for value z, ranges from 0-100
walkE <- function(n.times=125,
xlim=c(524058,542800),
ylim=c(2799758,2818500),
start=c(525000,2810000),
stepsize=c(4000,4000)) {
plot(c(0,0),type="n",xlim=xlim,ylim=ylim,
xlab="Easting",ylab="Northing")
x <- start[1]
y <- start[2]
steps <- 1/c(1,2,4,8,12,16)
steps.y <- c(steps,-steps,0)
steps.x <- c(steps,-steps[c(1,5,6)],0)
points(x,y,pch=16,col="red",cex=1)
for (i in 1:n.times) {
repeat {
xi <- stepsize[1]*sample(steps.x,1)
yi <- stepsize[2]*sample(steps.y,1)
newx <- x+xi
newy <- y+yi
if (newx>xlim[1] && newx<xlim[2] &&
newy>ylim[1] && newy<ylim[2]) break
}
lines(c(x,newx),c(y,newy),col="blue")
x <- newx
y <- newy
if(z>P){stop(points(newx,newy,col="green",cex=1))}
#this is where I want it to stop if z>P
else
if(z<P){points(newx,newy,pch=1,col="blue",cex=1)}
else
if(step.max){points(newx,newy,pch=16,col="green",cex=1)}
set.seed(101)}
}
walkE(step.max) #run above random walk function walkE looped for the step.max number
Thanks in advance!!!
This is pretty easy and can be accomplished by inserting a stop(...) function in your user defined step.prob function.
step.prob<-function(n.times=step.max, p){
draw=sample(0:100,1,replace=T)
CS<-sample(draw,size=1,replace=TRUE)
CS.max<-100
CS.max
step.num<-15
SP<-((CS/CS.max)*(1-(step.num/step.max))+(step.num/step.max))*100
if(SP > p) {
stop('Your random walk exceeded ', p)
} else {
SP
}
}
If this doesn't do it for you look into the break command.
So, when the random walk value is > p:
step.prob(p=300000)
# Error in step.prob(p = 3) : Your random walk exceeded 3
And if you want to set the value returned by the function to p you can just add in SP <- p before the stop command.