I was hoping to automate the following process but have been unable to find a solution. The aim is to use vectors height and area to update each if equation in the function. The function would then use depth (x) to convert to volume.
The equation for each if statement would use the following syntax:
for (i in 2:length(height) {
(x >= height[i - 1] &&
x <= height[i]) {
(((area[i] - area[i - 1]) * (x - height[i - 1]) /
(height[i] - height[i - 1]) + area[i - 1]) * x)
}
Manual method:
height <- c(0.01, seq(0.05, 0.5, by = 0.05))
area <- c(8, 210, 300, 350, 400, 440, 470, 500, 535, 570, 610)
# Height values
Hmin <- min(height)
Hmax <- max(height)
for(i in 2:(length(height) - 1)) {
assign(paste0("H", i-1), height[i])
}
# Area values
Amin <- min(area)
Amax <- max(area)
for(i in 2:(length(area) - 1)) {
assign(paste0("A", i-1), area[i])
}
volume.fn <- function(x) {
if (x < Hmin) { # if less than min height value
x <- 0 # x <- 0
} else if (x >= Hmin && # if between min height and next height value
x <= H1) {
(((A1 - Amin) * (x - Hmin) / (H1 - Hmin) + Amin) * x) # apply this linear interpolation equation to depth column (x)
} else if (x >= H1 && # if x between height1 and height 2
x <= H2) {
(((A2 - A1) * (x - H1) / (H2 - H1) + A1) * x) # apply this linear interpolation equation to depth column (x)
} else if (x >= H2 &&
x <= H3) {
(((A3 - A2) * (x - H2) / (H3 - H2) + A2) * x)
} else if (x >= H3 &&
x <= H4) {
(((A4 - A3) * (x - H3) / (H4 - H3) + A3) * x)
} else if (x >= H4 &&
x <= H5) {
(((A5 - A4) * (x - H4) / (H5 - H4) + A4) * x)
} else if (x >= H5 &&
x <= H6) {
(((A6 - A5) * (x - H5) / (H6 - H5) + A5) * x)
} else if (x >= H6 &&
x <= H7) {
(((A7 - A6) * (x - H6) / (H7 - H6) + A6) * x)
} else if (x >= H7 &&
x <= H8) {
(((A8 - A7) * (x - H7) / (H8 - H7) + A7) * x)
} else if (x >= H8 &&
x <= H9) {
(((A9 - A8) * (x - H8) / (H9 - H8) + A8) * x)
} else if (x >= H9 &&
x <= Hmax) {
(((Amax - A9) * (x - H9) / (Hmax - H9) + A9) * x)
} else {
NA
}
}
Using findInterval you could do:
volume.fn1 <- function(x, height, area) {
volume <- if (x < min(height)) {
0
} else if (x > max(height)) {
NA
} else {
i <- findInterval(x, height, rightmost.closed = TRUE) + 1
((area[i] - area[i - 1]) * (x - height[i - 1]) /
(height[i] - height[i - 1]) + area[i - 1]) * x
}
return(volume)
}
volume.fn(.32)
#> [1] 154.24
volume.fn1(.32, height, area)
#> [1] 154.24
volume.fn(.48)
#> [1] 285.12
volume.fn1(.48, height, area)
#> [1] 285.12
Related
together with you, I have recently made the following function (the content is not important right now). It seems to be correct but when I try to process it, the following error turns up: Error: unexpected '}' in " }". Do you know what I´ve made wrong?
Here´s the function, thank you in advance (btw I have checked every bracket):
Edit: Now it works:
CI <- function(x, s, z, Fall) {
if (Fall == "Fall1") {
result <- mean(x) + c(-1,1)* qnorm(1-z/2)*(s/sqrt(length(x)))
} else if (Fall == "Fall2") {
result <- mean(x) + c(-1,1)* qt(p=1-a/2, df=length(x)- 1)*(sd(x)/sqrt(length(x)))
} else if (Fall == "Fall3") {
result <-mean(x)+c(-1,1)qnorm(1-z/2(s/sqrt(length(x))))
} else if (Fall == "Fall4"){
result <- mean(x)+c(-1,1)qt(p=1-a/2, df=length(x)-1)(sd(x)/sqrt(length(x)))
} else {result<-NA}
return(result)
}
CI(x=x, s=15, z=0.05, Fall="Fall1")
There are couple of errors - 1) else would not have a condition check, instead use else if, 2), the values to compare should be quoted "Fall1"
CI <- function(x, mean, sd, z, Fall)
{
if (Fall == "Fall1") {
result <- mean(x) + c(-1, 1) * qnorm(1 - z / 2) * (sd / sqrt(length(x)))
} else if (Fall == "Fall2") {
result <-
mean(x) + c(-1, 1) * qt(p = 1 - a / 2, df = length(x) - 1) * (sd(x) / sqrt(length(x)))
} else if (Fall == "Fall3") {
result <- mean(x) + c(-1, 1) * qnorm(1 - z / 2 *
(sd / sqrt(length(x))))
} else if (Fall == "Fall4") {
result <-
mean(x) + c(-1, 1) * qt(p = 1 - a / 2, df = length(x) - 1) * (sd(x) / sqrt(length(x)))
}
else {
result <- NA_real_
}
return(result)
}
I am writing a ShaderToy to model De Broglie-Bohm theory to help me visualize quantum mechanics from a deterministic perspective. A key part is the Del(∇) operator for calculating gradients for diffusing a field.
Right now I appear to have something that looks like it's diffusing, but I believe it runs into an underflow error and a black splotch appears. How do I prevent it from forming? This is what it looks like:
Here is the Del operator code:
vec4 del(in vec4[9] points){
vec4 deltaX = ((points[2 * 3 + 0] + points[2 * 3 + 1] + points[2 * 3 + 2])/3.
- (points[0 * 3 + 0] + points[0 * 3 + 1] + points[0 * 3 + 2])/3.)/2.;
vec4 deltaY = ((points[0 * 3 + 2] + points[1 * 3 + 2] + points[2 * 3 + 2])/3.
- (points[0 * 3 + 0] + points[1 * 3 + 0] + points[2 * 3 + 0])/3.)/2.;
return vec4((deltaX + deltaY).rgb, 1.);
}
vec4 delTex(sampler2D tex, ivec2 coord){
vec4[9] surroundingPoints = vec4[9](vec4(1),vec4(1),vec4(1),vec4(1),vec4(1),vec4(1),vec4(1),vec4(1),vec4(1));
for(int x = 0; x < 3; x++){
for(int y = 0; y < 3; y++){
surroundingPoints[x * 3 + y] = texelFetch(tex,(ivec2(coord) + (ivec2(x,y) - ivec2(1))), 0);
}
}
return del(surroundingPoints);
}
void mainImage(out vec4 fragColor, in vec2 coord) {
if(iMouse.x > 0. && iMouse.y > 0. && abs(coord.x - iMouse.x) < 5. && abs(coord.y - iMouse.y) < 5.) {
fragColor = vec4(1.,0.,1.,1.); return;
}
if(coord.x == 0. || coord.y == 0.){
fragColor = vec4(1.,0.,1.,1.);return;
}
// texelFetch(iChannel0, ivec2(coord), 0) +
fragColor = texelFetch(iChannel0, ivec2(coord), 0) + delTex(iChannel0, ivec2(coord)); return;
//fragColor = texelFetch(iChannel0, ivec2(coord), 0);
}
So I figured it out, the numbers were overflowing because the gradient was being added to the original pixel. I used the min() function to clamp the number to below 1. and there is no black square anymore.
So I am trying to do a for loop over the upper triangle part of a matrix, so I only want the elements 1 <= i < j <= n. And I tried it out in R as follows:
for(i in 1:n-1) {
for(j in i+1:n) {
...
}
}
But instead of iterating over 1 <= i < j <= n these for loops go over the elements i + 1 <= j <= i + n, 1 <= i < n.
I'm new to R, so I don't understand what is happening. Could someone give me a hint how to do it correctly?
Thanks.
for(i in seq(1, n - 1)) {
for(j in seq(i + 1, n)) {
...
}
}
alternatively
for(i in 1:(n - 1)) {
for(j in (i + 1):n) {
...
}
}
The issue is that R understands i+1:n as i + (1:n)
enter code here
fn = function(a, b, c) {
if ((b^2 - 4ac) > 0) {
root1 = ((-b) + sqrt((b^2) - 4 a c)) / (2 * a)
root2 = ((-b) - sqrt((b^2) - 4 a c)) / (2 * a)
print(root1)
print(root2)
} else if (b*2 -4a*c == 0) {
root = -b / (2*a)
print(root)
} else {
print("There are no real roots.")
}
}
unexpected token 'ac' line 2
unexpected token 'a' line 3
unexpected token 'a' line 4
unexpected token 'a' '*' line 7
You need * for product, e.g.,
fn <- function(a, b, c) {
if ((b^2 - 4 * a * c) > 0) {
root1 <- ((-b) + sqrt((b^2) - 4 * a * c)) / (2 * a)
root2 <- ((-b) - sqrt((b^2) - 4 * a * c)) / (2 * a)
print(root1)
print(root2)
} else if (b * 2 - 4 * a * c == 0) {
root <- -b / (2 * a)
print(root)
} else {
print("There are no real roots.")
}
}
such that
> fn(1, -2, 1)
[1] "There are no real roots."
> fn(1,1,0)
[1] 0
[1] -1
I am trying to simulate a markov chain by using code that wasnt made for it. My for loop is not correct and I continue to get error messages but I kept track of the brackets and syntax but I cannot quite put my finger on the issue. The matrix for the markov chain is markov. I am trying to plot each point by appending to the vector a but I dont think my loops are doing exactly what I want.
I am using the random number generator in order to test which state to move to and from. I understand there are easier ways to go about writing this code but I would like to try to use this basic foundation in order to get the code right. If you could please help me straighten the code up and figure out which way to nest the loop properly I would be grateful.
x is my starting point
The markov chain probabilities are uniformly distributed
x1 <- runif(100, 1.0, 100)
markov <- matrix(c(.5,.3,.2,.4,.5,.1,.2,.4,.4),nrow=3)
m1 <- markov[1:3]
m2 <- markov[4:6]
m3 <- markov[7:9]
y <- 2
x <- 1
a <- c(1)
while (y <= 100)
{
if(x==1) {
if(x1[y] < m1[1] * 100) {
x <- 1
} else if (x1[y] <= m1[2]*100 + m1[1] * 100 && x1[y] > m1[1] * 100) {
x <- 2
} else {
x <- 3
}
a <- union(x,c(y))
} else if (x==2) {
if(x1[y] < m2[1] * 100) {
x <- 1
} else if (x1[y] <= m2[2]*100 + m2[1] * 100 && x1[y] > m2[1] * 100) {
x <- 2
} else {
x <- 3
}
a <- union(x,c(y))
} else {
if(x1[y] < m3[1] * 100) {
x <- 1
} else if (x1[y] <= m3[2]*100 + m3[1] * 100 && x1[y] > m3[1] * 100) {
x <- 2
} else {
x <- 3
}
a <- union(x,c(y))
y <- y + 1
}
}
plot(c(1:100),a)
Your y <- y+1 is in one too many curly brackets. It is not being called most of the time.
I think this is what you want:
x1 <- runif(100, 1.0, 100)
markov <- matrix(c(.5,.3,.2,.4,.5,.1,.2,.4,.4),nrow=3)
m1 <- markov[1:3]
m2 <- markov[4:6]
m3 <- markov[7:9]
y <- 2
x <- 1
a <- c(1)
aa <- c()
while (y <= 100)
{
if(x==1) {
if(x1[y] < m1[1] * 100) {
x <- 1
} else if (x1[y] <= m1[2]*100 + m1[1] * 100 && x1[y] > m1[1] * 100) {
x <- 2
} else {
x <- 3
}
a <- union(x,c(y))
} else if (x==2) {
if(x1[y] < m2[1] * 100) {
x <- 1
} else if (x1[y] <= m2[2]*100 + m2[1] * 100 && x1[y] > m2[1] * 100) {
x <- 2
} else {
x <- 3
}
a <- union(x,c(y))
} else {
if(x1[y] < m3[1] * 100) {
x <- 1
} else if (x1[y] <= m3[2]*100 + m3[1] * 100 && x1[y] > m3[1] * 100) {
x <- 2
} else {
x <- 3
}
a <- union(x,c(y))
}
aa <- c(aa,x)
y <- y + 1
}
plot(aa)