I do have the following code for a loop, which basically only updates the column "decay rate" based on whether or not the column "RPK_cap" is higher than a certain threshold which is exogenously given(in scenario 1 it is 1200, in Scenario 2 it is 1300 etc). If that is the case than I want to decrease the decay rate by multiplying it my 0.9. This is done for all countries (column: iso) and years(column: year) which are in the data.table. When I am using scenario 1 data the column "RPK_cap" will be filled with scenario 1 data and if I choose scenario 2 the column "RPK_cap" will be filled with scenario 2 data respectively.
And my problem is the following:
This loop works ONLY for scenario 1.
If I am using scenario 2 I get the error message:
"Error in if (price_el_int_aviation_RPK$RPK_Cap[price_el_int_aviation_RPK$iso == :
argument is of length zero"
I really tried a lot and I just don´t know what the problem is here. Does anyone know what the problem is?
This is the data.table
data.table_example
if (scenario == "1") {
for (j in unique(price_el_int_aviation_RPK$iso)) {
for (i in unique(price_el_int_aviation_RPK$year[price_el_int_aviation_RPK$iso == j])) {
if (price_el_int_aviation_RPK$RPK_cap[price_el_int_aviation_RPK$iso == j & price_el_int_aviation_RPK$year == i] > 1200) {
price_el_int_aviation_RPK$decay_rate[price_el_int_aviation_RPK$iso == j & price_el_int_aviation_RPK$year >= i] <- price_el_int_aviation_RPK$decay_rate[price_el_int_aviation_RPK$iso == j & price_el_int_aviation_RPK$year >= i] * 0.90
}
}
}
} else if (scenario == "2"){
for (j in unique(price_el_int_aviation_RPK$iso)) {
for (i in unique(price_el_int_aviation_RPK$year[price_el_int_aviation_RPK$iso == j])) {
if (price_el_int_aviation_RPK$RPK_Cap[price_el_int_aviation_RPK$iso == j & price_el_int_aviation_RPK$year == i] > 1300) {
price_el_int_aviation_RPK$decay_rate[price_el_int_aviation_RPK$iso == j & price_el_int_aviation_RPK$year >= i] <- price_el_int_aviation_RPK$decay_rate[price_el_int_aviation_RPK$iso == j & price_el_int_aviation_RPK$year >= i] * 0.95
}
}
}
} else if (scenario == "3"){
for (j in unique(price_el_int_aviation_RPK$iso)) {
for (i in unique(price_el_int_aviation_RPK$year[price_el_int_aviation_RPK$iso == j])) {
if (price_el_int_aviation_RPK$RPK_Cap[price_el_int_aviation_RPK$iso == j & price_el_int_aviation_RPK$year == i] > 1400) {
price_el_int_aviation_RPK$decay_rate[price_el_int_aviation_RPK$iso == j & price_el_int_aviation_RPK$year >= i] <- price_el_int_aviation_RPK$decay_rate[price_el_int_aviation_RPK$iso == j & price_el_int_aviation_RPK$year >= i] * 0.95
}
}
}
} else if (scenario == "4"){
for (j in unique(price_el_int_aviation_RPK$iso)) {
for (i in unique(price_el_int_aviation_RPK$year[price_el_int_aviation_RPK$iso == j])) {
if (price_el_int_aviation_RPK$RPK_Cap[price_el_int_aviation_RPK$iso == j & price_el_int_aviation_RPK$year == i] > 1500) {
price_el_int_aviation_RPK$decay_rate[price_el_int_aviation_RPK$iso == j & price_el_int_aviation_RPK$year >= i] <- price_el_int_aviation_RPK$decay_rate[price_el_int_aviation_RPK$iso == j & price_el_int_aviation_RPK$year >= i] * 0.95
}
}
}
} else if (scenario == "5"){
for (j in unique(price_el_int_aviation_RPK$iso)) {
for (i in unique(price_el_int_aviation_RPK$year[price_el_int_aviation_RPK$iso == j])) {
if (price_el_int_aviation_RPK$RPK_Cap[price_el_int_aviation_RPK$iso == j & price_el_int_aviation_RPK$year == i] > 1600) {
price_el_int_aviation_RPK$decay_rate[price_el_int_aviation_RPK$iso == j & price_el_int_aviation_RPK$year >= i] <- price_el_int_aviation_RPK$decay_rate[price_el_int_aviation_RPK$iso == j & price_el_int_aviation_RPK$year >= i] * 0.99
}
}
}
}else{}
It's hard to answer in specifics because we cannot see your data.
But the error you see
"Error in if (price_el_int_aviation_RPK$RPK_Cap[price_el_int_aviation_RPK$iso == : argument is of length zero"
is because price_el_int_aviation_RPK$iso is of length zero - it's a vector without anything in it!
Here's a minimal example of the problem
# Create a vector of length zero
a <- c()
# Prove it's length is zero
length(a)
# [1] 0
# This is a minimal example of what's going wrong with scenario 2 in your script
if(a == 2) { print("it works") }
Error in if (a == 2) if (a == 2) { : argument is of length zero
Related
i <- 2
j <- 0
for (i in 2:1000) {
if(return.prime(i)){j = j + 1}
i = i + 1
}
I want to check how many prime numbers there are in 1 to 1000 using my own function return.prime which returns TRUE when the number input is a prime and FALSE when the number input is not prime. The return.prime function is the function below and it is correct.
return.prime <- function(d){
if(d ==1 ){print(FALSE)}
if (d == 2){
print(TRUE)
}
if(d !=2 && d!=1){
if(any(d %% (2:(d-1)) == rep(0,d-2))==TRUE){
print(FALSE)}
else
print(TRUE)
}
}
The problem is when I run my program it says:
[1] TRUE
Error in if (return.prime(i)) { : argument is of length zero
I do not know what causes the length zero.
R doesn't work that way. You're just having the function print the word "TRUE" or "FALSE". Instead, you need to ?return TRUE or FALSE. Consider:
return.prime <- function(d){
if(d==1){ return(FALSE) }
if(d==2){ return(TRUE) }
if(d !=2 && d!=1){
if(any(d %% (2:(d-1)) == rep(0,d-2))==TRUE){
return(FALSE)
} else{
return(TRUE)
}
}
}
i <- 2
j <- 0
for (i in 2:1000) {
if(return.prime(i)){j = j + 1}
i = i + 1
}
j # [1] 168
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
simulate_queue<- function(open_time, rate, low, high){
i<-1
j<-1
a<-rexp(1,rate)
b<-runif(1,low,high)
c<-a+b
d<-a + rexp(1,rate)
e<-c()
while (d <= open_time) {
a[i+1]<- d
if (a[i+1] < c[i]){
c[i+1]<-c[i]+b
b<- runif(1,low,high)
}
else c[i+1]<-a[i+1]+b
e[i]<-( while(d <= open_time){
if (c[j] < a[i+1]) {sum(c[j]< a[i])
i <- i+1
}
else if (c[j] > a[i+1]) {0
j <- j+1
}
else 0
}
)
i<-i+1
d <- a[i] + rexp(1,rate)
}
L <- list(arrival_times=a,queue_lengths=e,departure_times=c)
L
}
I don't know why there is an error message
Error in if (c[j] < a[i + 1]) { : missing value where TRUE/FALSE needed
Please help me..
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
}
}
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)