My code is as follows:
data("USArrests")
AssignLevel <- function(p,quartiles)
{
if (p < quartiles[1])
rlevel <-"LOW"
else if (p < quartiles[2])
rlevel <-"MODERATE"
else if (p < quartiles[3])
rlevel <-"HIGH"
else level <-"VERY HIGH"
return (rlevel)
}
k<-USArrests$UrbanPop
k
q<- quantile(USArrests$UrbanPop, c(.25,.5,.75))
newCol <- sapply(USArrests$UrbanPop,AssignLevel(k,q))
I'm trying to change the value of every state's urban pop value into one of the corresponding quartiles. It works when I run AssignLevel(k,q) but not when I run in in sapply.
I agree that the cut solution is better. For fun, here is how to resolve your current issue:
data("USArrests")
AssignLevel <- function(p,quartiles) {
if (p < quartiles[[1]]){
rlevel <- "LOW"
} else if(p < quartiles[[2]]) {
rlevel <- "MODERATE"
} else if(p < quartiles[[3]]) {
rlevel <- "HIGH"
} else {
rlevel <- "VERY HIGH"
}
return (rlevel)
}
k <- USArrests$UrbanPop
q <- quantile(k, c(.25,.5,.75))
newCol <- sapply(k,AssignLevel,q)
Related
Let's suppose the next function:
demo_function <- function(x){
if(is.na(x)){
return(NA)
} else if(1 < x < 2){
return("something")
} else {
return("Nothing")
}
}
The idea is that when the argument x is between 1 and 2, say x=0.001, then the function returns something.
However when trying to run the above function, the next error arises:
Error: no function to go from, jumping to a higher level
How could I adjust the function in order to get "something" for the specified argument?
The issue is in the else if i.e. the syntax in R is different than the mathematical notation - multiple expressions are connected by logical operators
else if(1 < x && x < 2)
i.e.
demo_function <- function(x){
if(is.na(x)){
return(NA)
} else if(1 < x && x < 2){
return("something")
} else {
return("Nothing")
}
}
> demo_function(0.01)
[1] "Nothing"
> demo_function(1.5)
[1] "something"
> demo_function(NA)
[1] NA
I am learning how to use while and for loops, and am having difficulty executing a for loop within a while loop. I am trying to recurse a simple procedure over a vector, and have the while loop set the conditionals for which parts of the vector are operated upon. This is really just meant as an exercise to understand how to use for and while loops in conjunction.
data <- c(1:200)
n=0
while(n < 100){
for(x in data){
n=x+1
if(x >= 10 & x < 100){
print("double digit")
} else {
print("single digit")
}}}
I want to stop the while loop when the procedure hits x=100 of the vector that runs from 1:200. But instead, the for loop runs through every element within the vector, from 1:200, failing to stop executing when n hits 100.
Would appreciate any advice to help out a new coder, thanks.
I have also tried
for(x in data){
n=x+1
while(n < 100){
if(x >= 10 & x < 100){
print("double digit")
} else {
print("single digit")
}}}
But the code does not stop executing.
First let's try a for loop. Each time through it n will be set to the loop counter plus 1. If this result is between 10 and 100, print a message, if not print something else. Note that no loop depends on n .
data <- c(1:200)
n = 0
for (x in data) {
n = x + 1
if (n < 100) {
if (x >= 10 && x < 100) {
print("double digit")
} else {
print("single digit")
}
}
}
x
#[1] 200
n
#[1] 201
Now for a while loop. I believe it is much simpler, it only envolves one variable, n.
n <- 0
while (n < 100) {
n = n + 1
if (n < 100) {
if (n >= 10) {
print("double digit")
} else {
print("single digit")
}
}
}
n
#[1] 100
I was asked to implement function that calculates n-dimensional matrix determinant using Laplace expansion. This involves recursion. I developed this:
minor<-function(A,i,j) {
return(A[c(1:(i-1),(i+1):dim(A)[1]),c(1:(j-1),(j+1):dim(A)[2])])
}
determinantRec<-function(X,k) {
if (dim(X)[1] == 1 && dim(X)[2] == 1) return(X[1][1])
else {
s = 0
for (i in 1:dim(X)[2]) {
s = s + X[k][i]*(-1)^(k+i)*determinantRec(minor(X,k,i),k)
}
return(s)
}
}
where k in determinantRec(X,k) function indicates which row I want to use Laplace expansion along of.
My problem is when I run determinantRec(matrix(c(1,2,3,4),nrow = 2,ncol = 2),1) this error appears:
C stack usage 7970628 is too close to the limit
What is wrong with my code?
#julia, there is one simple type in your code. Just remove the '*' at the end of the definition of 's'. And don't indent the recursion.
determinantRek<-function(X,k) {
if (dim(X)[1] == 1 && dim(X)[2] == 1)
return(X[1,1])
if (dim(X)[1] == 2 && dim(X)[2] == 2)
return(X[1,1]*X[2,2]-X[1,2]*X[2,1])
else
s = 0
for (i in 1:dim(X)[2]) {
s = s + X[k,i]*(-1)^(k+i)
determinantRek(X[-k,-i],k)
}
return(s)
}
I did this way and works just fine, although it is super slow, compared to the det function in base R
laplace_expansion <- function(mat){
det1 <- function(mat){
mat[1]*mat[4]-mat[2]*mat[3]
}
determinant <- 0
for(j in 1:ncol(mat)){
mat1 <- mat[-1,-j]
if(nrow(mat1) == 2){
determinant <- determinant+mat[1,j]*(-1)^(1+j)*det1(mat1)
}else{
val <- mat[1,j]*(-1)^(1+j)
if(val != 0){
determinant <- determinant+val*laplace_expansion(mat1)
}
}
}
return(determinant)
}
This is my approach, I think it's cleaner.
deter <- function(X) {
stopifnot(is.matrix(X))
stopifnot(identical(ncol(X), nrow(X)))
if (all(dim(X) == c(1, 1))) return(as.numeric(X))
i <- 1:nrow(X)
out <- purrr::map_dbl(i, function(i){
X[i, 1] * (-1)^(i + 1) * deter(X[-i, -1, drop = FALSE])
})
return(sum(out))
}
Thank you #ArtemSokolov and #MrFlick for pointing the problem cause, it was it. I also discovered that this code does not calculate properly the determinant of 2x2 matrix. After all it looks like that:
determinantRek<-function(X,k) {
if (dim(X)[1] == 1 && dim(X)[2] == 1)
return(X[1,1])
if (dim(X)[1] == 2 && dim(X)[2] == 2)
return(X[1,1]*X[2,2]-X[1,2]*X[2,1])
else
s = 0
for (i in 1:dim(X)[2]) {
s = s + X[k,i]*(-1)^(k+i)*
determinantRek(X[-k,-i],k)
}
return(s)
}
Debuging with browser() was also helpful :)
I have a Dataframe with columns containing different time series of data. I need to insert these columns into the function below automatically to find the best combination (highest return):
returns <- as.data.frame(rep(0, 4261)) #4261 because that's the length of n1.lc
returns$n2_5_10 <- rep(0, nrow(returns))
MSVrule <- function(n1, n2, hold){
for(i in 13:nrow(n1.lc)){
if (n1[i] > n2[i] & n1[i-1] < n2[i-1]) {
returns$n2_5_10[i] <- dt.lc$Settle[i - hold] - dt.lc$Settle[i]
} else {
if (n1[i] < n2[i] & n1[i-1] > n2[i-1])
{returns$n2_5_10[i] <- dt.lc$Settle[i] - dt.lc$Settle[i - hold]
}
else{
NULL
}
}
}
}
MSVrule(n1.lc$N1_2_5, n2.lc$n2_2_10, 5)
This function doesn't work, leaving returns$n2_5_10[i] 0 However, when I specifiy the vectors in the function it works:
hold <- 5
for(i in 13:nrow(n1.lc)){
if (n1.lc$N1_2_5[i] > n2.lc$n2_2_10[i] & n1.lc$N1_2_5[i-1] < n2.lc$n2_2_10[i-1]) {
returns$n2_5_10[i] <- (dt.lc$Settle[i - hold] - dt.lc$Settle[i]) / dt.lc$Settle[i]
} else {
if (n1.lc$N1_2_5[i] < n2.lc$n2_2_10[i] & n1.lc$N1_2_5[i-1] > n2.lc$n2_2_10[i-1])
{returns$n2_5_10[i] <- (dt.lc$Settle[i] - dt.lc$Settle[i - hold]) / dt.lc$Settle[i - hold]
}
else{
NULL
}
}
}
The next step would be to automatically apply the function to other combinations of vectors from the n1.lc Dataframe. But I need the function to work first.
Because you use a function with no return() attempting to modify objects outside its scope, nothing external will be changed. However, you can use <<- operator to modify external objects to the function, namely the n2_5_10 column in returns:
Below demonstrates with random generated data and assigns the column in returns with 500 or 5 as you do not post other needed, used objects (i.e., dt.lc). Adjust to actual data objects:
n1.lc <- data.frame(
N1_2_5 = runif(50),
n2_2_10 = runif(50)
)
returns <- data.frame(n2_5_10 = rep(0, nrow(n1.lc)))
MSVrule <- function(n1, n2, hold){
for(i in 13:nrow(n1.lc)){
if (n1[i] > n2[i] & n1[i-1] < n2[i-1]) {
returns$n2_5_10[i] <<- 500
} else {
if (n1[i] < n2[i] & n1[i-1] > n2[i-1])
{returns$n2_5_10[i] <<- 5
}
else{
NULL
}
}
}
}
MSVrule(n1.lc$N1_2_5, n1.lc$n2_2_10, 5)
However, consider using return where you create/update/output returns inside function. Then on outside, assign a new dataframe as the function's output (no need for else { NULL } clause):
MSVrule <- function(n1, n2, hold){
returns <- data.frame(n2_5_10 = rep(0, nrow(n1.lc)))
for(i in 13:nrow(n1.lc)){
if (n1[i] > n2[i] & n1[i-1] < n2[i-1]) {
returns$n2_5_10[i] <- 500
} else {
if (n1[i] < n2[i] & n1[i-1] > n2[i-1])
returns$n2_5_10[i] <- 5
}
}
return(returns)
}
newdf <- MSVrule(n1.lc$N1_2_5, n1.lc$n2_2_10, 5)
# BOTH ABOVE RESULT IN EQUIVALENT OUTCOMES
all.equal(returns, newdf)
# TRUE
identical(returns, newdf)
# TRUE
I am trying to build a matrix model which ends if certain conditions are invoked - however for some reason the break() command isn't working, although stop() does. Unfortunately stop() is not what I need as I need to run the model a number of times.
The first break command in the model works, but I have left it in with dth>100 so that you can see for yourselves
n.steps <- 200
ns <- array(0,c(14,n.steps))
ns[13,1]<-rpois(1,3)
ns[14,1] <- 1
k<-0
for (i in 1:n.steps){
k<-k+1
ns[13,1]<-rpois(1,2)
death<-sample(c(replicate(1000,
sample(c(1,0), prob=c(surv.age.a, 1-surv.age.a), size = 1))),1)
ns[14,k] <- death
if (death == 0) {
dth <- sample(1:100, 1)
if (dth > 100) {
ns[14,k]<-0
print("stop.1")
break()
} else {
while (death == 0) {
if (ns[13, k] > 0) {
rep.vec[i]<-ns[13,k]
ns[13, k] <- ns[13, k] - 1
ns[14,k+1]<-1
print("replace")
} else {
if (ns[13, k] == 0) {
print("stop.2")
ns[14,k+1]<-0
break()
}
}
}
}
}
}
Try this (only showing the relevant portions):
for (i in 1:n.steps){
# ...
break.out.of.for <- FALSE
while (death == 0) {
if (ns[13, k-1] > 0) {
# ...
} else {
if (ns[13, k] == 0) {
# ...
break.out.of.for = TRUE
break
}
}
if (break.out.of.for) {
break
}
}