Automatic vlookup and multiply coefficients with R - r
I´m trying to code a function in R (stats programming language) that would allow me to automate the calculation of a linear regression (lm)
The problem:
The regression is calculated through the "step" function, so the coefficients selected cannot be known in advance.
Problem
Automate identifying the coefficients selected by the step function.
Vlookup and cross multiply the second column of the results Ex."View(OpenCoefs)" (estimates) with the last row(last day) of respective columns of the original data frame "sp"
The desirable solution would be a function that i would just type "run()" that would return the "y"s for each regression, namely, the forecast of the S&P500 index for the following day(Open, Low, High,Close).
The code retrieves data from the yahoo finance website, so it´s operational if you run it.
Here´s the code.
sp <- read.csv(paste("http://ichart.finance.yahoo.com/table.csv?s=%5EGSPC&a=03&b=1&c=1940&d=03&e=1&f=2014&g=d&ignore=.csv"))
sp$Adj.Close<-NULL
sp<-sp[nrow(sp):1,]
sp<-as.data.frame(sp)
for ( i in 2:nrow( sp ) ) {
sp[ i , "Gr_Open" ] <-
( sp[ i , "Open" ] / sp[ i - 1 , "Open" ] ) - 1
}
for ( i in 2:nrow( sp ) ) {
sp[ i , "Gr_High" ] <-
( sp[ i , "High" ] / sp[ i - 1 , "High" ] ) - 1
}
for ( i in 2:nrow( sp ) ) {
sp[ i , "Gr_Low" ] <-
( sp[ i , "Low" ] / sp[ i - 1 , "Low" ] ) - 1
}
for ( i in 2:nrow( sp ) ) {
sp[ i , "Gr_Close" ] <-
( sp[ i , "Close" ] / sp[ i - 1 , "Close" ] ) - 1
}
for ( i in 2:nrow( sp ) ) {
sp[ i , "Gr_Volume" ] <-
( sp[ i , "Volume" ] / sp[ i - 1 , "Volume" ] ) - 1
}
nRows_in_sp<-1:nrow(sp)
sp<-cbind(sp,nRows_in_sp)
Open_Rollin<-NA
sp<-cbind(sp,Open_Rollin)
for ( i in 2:nrow( sp ) ) {
if(sp[i,"nRows_in_sp"]<=1000)
{
sp[ i , "Open_Rollin" ]<-0
} else {
sp[ i , "Open_Rollin" ]<-(( mean(sp[,"Open"][(i-100):i])))
}
}
Close_Rollin<-NA
nRows_in_sp<-1:nrow(sp)
sp<-cbind(sp,Close_Rollin)
for ( i in 2:nrow( sp ) ) {
if(sp[i,"nRows_in_sp"]<=1000)
{
sp[ i , " Close_Rollin" ]<-0
} else {
sp[ i , "Close_Rollin" ]<-(( mean(sp[,"Close"][(i-100):i])))
}
}
Low_Rollin<-NA
sp<-cbind(sp,Low_Rollin)
for ( i in 2:nrow( sp ) ) {
if(sp[i,"nRows_in_sp"]<=1000)
{
sp[ i , "Low_Rollin" ]<-0
} else {
sp[ i , "Low_Rollin" ]<-(( mean(sp[,"Low"][(i-100):i])))
}
}
High_Rollin<-NA
sp<-cbind(sp,High_Rollin)
for ( i in 2:nrow( sp ) ) {
if(sp[i,"nRows_in_sp"]<=1000)
{
sp[ i , "High_Rollin" ]<-0
} else {
sp[ i , "High_Rollin" ]<-(( mean(sp[,"High"][(i-100):i])))
}
}
Open_GR_Rollin<-NA
sp<-cbind(sp,Open_GR_Rollin)
for ( i in 2:nrow( sp ) ) {
if(sp[i,"nRows_in_sp"]<=1000)
{
sp[ i , "Open_GR_Rollin" ]<-0
} else {
sp[ i , "Open_GR_Rollin" ]<-(( mean(sp[,"Gr_Open"][(i-100):i])))
}
}
Close_GR_Rollin<-NA
sp<-cbind(sp, Close_GR_Rollin)
for ( i in 2:nrow( sp ) ) {
if(sp[i,"nRows_in_sp"]<=1000)
{
sp[ i , "Close_GR_Rollin" ]<-0
} else {
sp[ i , "Close_GR_Rollin" ]<-(( mean(sp[,"Gr_Close"][(i-100):i])))
}
}
Low_GR_Rollin<-NA
sp<-cbind(sp, Low_GR_Rollin)
for ( i in 2:nrow( sp ) ) {
if(sp[i,"nRows_in_sp"]<=1000)
{
sp[ i , "Low_GR_Rollin" ]<-0
} else {
sp[ i , "Low_GR_Rollin" ]<-(( mean(sp[,"Gr_Low"][(i-100):i])))
}
}
High_GR_Rollin<-NA
sp<-cbind(sp, High_GR_Rollin)
for ( i in 2:nrow( sp ) ) {
if(sp[i,"nRows_in_sp"]<=1000)
{
sp[ i , "High_GR_Rollin" ]<-0
} else {
sp[ i , "High_GR_Rollin" ]<-(( mean(sp[,"Gr_High"][(i-100):i])))
}
}
Open_SD_Rollin<-NA
sp<-cbind(sp,Open_SD_Rollin)
for ( i in 2:nrow( sp ) ) {
if(sp[i,"nRows_in_sp"]>100)
{
sp[ i, "Open_SD_Rollin" ] <- sd(sp[,"Open"][(i-100):i])
}
}
Close_SD_Rollin<-NA
sp<-cbind(sp, Close_SD_Rollin)
for ( i in 2:nrow( sp ) ) {
if(sp[i,"nRows_in_sp"]>100)
{
sp[ i, "Close_SD_Rollin" ] <- sd(sp[,"Close"][(i-100):i])
}
}
Low_SD_Rollin<-NA
sp<-cbind(sp, Low_SD_Rollin)
for ( i in 2:nrow( sp ) ) {
if(sp[i,"nRows_in_sp"]>100)
{
sp[ i, "Low_SD_Rollin" ] <- sd(sp[,"Low"][(i-100):i])
}
}
High_SD_Rollin<-NA
sp<-cbind(sp, High_SD_Rollin)
for ( i in 2:nrow( sp ) ) {
if(sp[i,"nRows_in_sp"]>100)
{
sp[ i, "High_SD_Rollin" ] <- sd(sp[,"High"][(i-100):i])
}
}
N <- length(sp[,"Open"])
Openlag <- c(NA, sp[,"Open"][1:(N-1)])
sp<-cbind(sp,Openlag)
Highlag <- c(NA, sp[,"High"][1:(N-1)])
sp<-cbind(sp,Highlag)
Lowlag <- c(NA, sp[,"Low"][1:(N-1)])
sp<-cbind(sp,Lowlag)
Closelag <- c(NA, sp[,"Close"][1:(N-1)])
sp<-cbind(sp,Closelag)
Gr_Openlag <- c(NA, sp[,"Gr_Open"][1:(N-1)])
sp<-cbind(sp,Gr_Openlag)
Gr_Highlag <- c(NA, sp[,"Gr_High"][1:(N-1)])
sp<-cbind(sp,Gr_Highlag)
Gr_Lowlag <- c(NA, sp[,"Gr_Low"][1:(N-1)])
sp<-cbind(sp,Gr_Lowlag)
Gr_Closelag <- c(NA, sp[,"Gr_Close"][1:(N-1)])
sp<-cbind(sp,Gr_Closelag)
Gr_Volumelag <- c(NA, sp[,"Gr_Volume"][1:(N-1)])
sp<-cbind(sp,Gr_Volumelag)
Open_GR_Rollinlag <- c(NA, sp[,"Open_GR_Rollin"][1:(N-1)])
sp<-cbind(sp, Open_GR_Rollinlag)
Low_GR_Rollinlag <- c(NA, sp[,"Low_GR_Rollin"][1:(N-1)])
sp<-cbind(sp, Low_GR_Rollinlag)
High_GR_Rollinlag <- c(NA, sp[,"High_GR_Rollin"][1:(N-1)])
sp<-cbind(sp, High_GR_Rollinlag)
Close_GR_Rollinlag <- c(NA, sp[,"Close_GR_Rollin"][1:(N-1)])
sp<-cbind(sp, Close_GR_Rollinlag)
Open_SD_Rollinlag <- c(NA, sp[,"Open_SD_Rollin"][1:(N-1)])
sp<-cbind(sp, Open_SD_Rollinlag)
Low_SD_Rollinlag <- c(NA, sp[,"Low_SD_Rollin"][1:(N-1)])
sp<-cbind(sp, Low_SD_Rollinlag)
High_SD_Rollinlag <- c(NA, sp[,"High_SD_Rollin"][1:(N-1)])
sp<-cbind(sp, High_SD_Rollinlag)
Close_SD_Rollinlag <- c(NA, sp[,"Close_SD_Rollin"][1:(N-1)])
sp<-cbind(sp, Close_SD_Rollinlag)
OpenCoefs<-coefficients(summary(step(lm(sp[,"Open"] ~ Openlag + Lowlag + Highlag + Closelag + Gr_Openlag + Gr_Lowlag + Gr_Highlag + Gr_Closelag + Gr_Volumelag + Open_GR_Rollinlag + Low_GR_Rollinlag + High_GR_Rollinlag + Close_GR_Rollinlag + Open_SD_Rollinlag + Low_SD_Rollinlag + High_SD_Rollinlag + Close_SD_Rollinlag),direction="both",test="F")))
LowCoefs<-coefficients(summary(step(lm(sp[,"Low"] ~ Openlag + Lowlag + Highlag + Closelag + Gr_Openlag + Gr_Lowlag + Gr_Highlag + Gr_Closelag + Gr_Volumelag + Open_GR_Rollinlag + Low_GR_Rollinlag + High_GR_Rollinlag + Close_GR_Rollinlag + Open_SD_Rollinlag + Low_SD_Rollinlag + High_SD_Rollinlag + Close_SD_Rollinlag),direction="both",test="F")))
HighCoefs<-coefficients(summary(step(lm(sp[,"High"] ~ Openlag + Lowlag + Highlag + Closelag + Gr_Openlag + Gr_Lowlag + Gr_Highlag + Gr_Closelag + Gr_Volumelag + Open_GR_Rollinlag + Low_GR_Rollinlag + High_GR_Rollinlag + Close_GR_Rollinlag + Open_SD_Rollinlag + Low_SD_Rollinlag + High_SD_Rollinlag + Close_SD_Rollinlag),direction="both",test="F")))
CloseCoefs<-coefficients(summary(step(lm(sp[,"Close"] ~ Openlag + Lowlag + Highlag + Closelag + Gr_Openlag + Gr_Lowlag + Gr_Highlag + Gr_Closelag + Gr_Volumelag + Open_GR_Rollinlag + Low_GR_Rollinlag + High_GR_Rollinlag + Close_GR_Rollinlag + Open_SD_Rollinlag + Low_SD_Rollinlag + High_SD_Rollinlag + Close_SD_Rollinlag),direction="both",test="F")))
View(OpenCoefs)
View(LowCoefs)
View(HighCoefs)
View(CloseCoefs)
View(sp)
Your code is so bad, I had to take pity on you. :) Here's a refactored version of your code:
library(quantmod)
sp <- getSymbols("^GSPC", auto.assign=FALSE)
sp$GSPC.Adjusted <- NULL
colnames(sp) <- gsub("^GSPC\\.","",colnames(sp))
sp$Gr_Open <- ROC(Op(sp), type="discrete")
sp$Gr_High <- ROC(Hi(sp), type="discrete")
sp$Gr_Low <- ROC(Lo(sp), type="discrete")
sp$Gr_Close <- ROC(Cl(sp), type="discrete")
sp$Gr_Volume <- ROC(Vo(sp), type="discrete")
N <- 100
sp$Open_Rollin <- runMean(sp$Open, N)
sp$High_Rollin <- runMean(sp$High, N)
sp$Low_Rollin <- runMean(sp$Low, N)
sp$Close_Rollin <- runMean(sp$Close, N)
sp$Open_GR_Rollin <- runMean(sp$Gr_Open, N)
sp$High_GR_Rollin <- runMean(sp$Gr_High, N)
sp$Low_GR_Rollin <- runMean(sp$Gr_Low, N)
sp$Close_GR_Rollin <- runMean(sp$Gr_Close, N)
sp$Open_SD_Rollin <- runSD(sp$Open, N)
sp$High_SD_Rollin <- runSD(sp$High, N)
sp$Low_SD_Rollin <- runSD(sp$Low, N)
sp$Close_SD_Rollin <- runSD(sp$Close, N)
spLag <- lag(sp)
colnames(spLag) <- paste(colnames(sp),"lag",sep="")
sp <- na.omit(merge(sp, spLag))
There's no need to answer your first question in order to answer your second question. You don't have to cross-multiply coefficients with data by hand. You can simply access the fitted values from the model. That requires that you preserve the model though...
f <- Open ~ Openlag + Lowlag + Highlag + Closelag +
Gr_Openlag + Gr_Lowlag + Gr_Highlag + Gr_Closelag + Gr_Volumelag +
Open_GR_Rollinlag + Low_GR_Rollinlag + High_GR_Rollinlag + Close_GR_Rollinlag +
Open_SD_Rollinlag + Low_SD_Rollinlag + High_SD_Rollinlag + Close_SD_Rollinlag
OpenLM <- lm(f, data=sp)
HighLM <- update(OpenLM, High ~ .)
LowLM <- update(OpenLM, Low ~ .)
CloseLM <- update(OpenLM, Close ~ .)
OpenStep <- step(OpenLM,direction="both",test="F")
HighStep <- step(HighLM,direction="both",test="F")
LowStep <- step(LowLM,direction="both",test="F")
CloseStep <- step(CloseLM,direction="both",test="F")
tail(fitted(OpenStep),1)
# 2013-02-01
# 1497.91
tail(fitted(HighStep),1)
# 2013-02-01
# 1504.02
tail(fitted(LowStep),1)
# 2013-02-01
# 1491.934
tail(fitted(CloseStep),1)
# 2013-02-01
# 1499.851
Related
schelling segregation model in shiny
I tried to run the Schelling segregation model in shiny. I got 3 inputes: number of houses, number of neighbors and alike_preference and sorting should be done within 1000 seconds. The problem is I don't get the output. Also, I put my renderTable() function both in the eventreactive() and loop, and outside them , but still no output was shown. library(shiny) # UI ui <- fluidPage( titlePanel("Schelling’s model!"), sidebarLayout( sidebarPanel( sliderInput(inputId = "Ic1", label = "Number of Houses:", min = 1, max = 51, value =1), sliderInput(inputId = "Ic2", label = "Number of Neighbours", min=0, max=2000, step=50, value = 0), sliderInput(inputId = 'Ic3', label = 'alike_preference', min=0, max=1, value=0), br(), actionButton(inputId = 'Id8','go', style="color: #fff; background-color: #428fd6; border-color: #2e6da4") ), # Main panel for displaying outputs ---- mainPanel( tableOutput(outputId = "map"), ) ) ) #Now The cycle of changing places in 1000 seconds server <- function(input, output) { grid_activation1 <- reactiveVal() grid_activation1 <- eventReactive(input$Id8 ,{ input$Ic3 group<-c(rep(0,(input$Ic1*input$Ic1)-input$Ic2,rep(1,input$Ic2/2),rep(2,input$Ic2/2))) grid <- matrix(sample(group,input$Ic1*Input$Ic1,replace=F), ncol= input$Ic1) image(grid,col=c("black","red","green"),axes=F) get_neighbors<-function(coords) { n<-c() for (i in c(1:8)) { if (i == 1) { x<-coords[1] + 1 y<-coords[2] } if (i == 2) { x<-coords[1] + 1 y<-coords[2] + 1 } if (i == 3) { x<-coords[1] y<-coords[2] + 1 } if (i == 4) { x<-coords[1] - 1 y<-coords[2] + 1 } if (i == 5) { x<-coords[1] - 1 y<-coords[2] } if (i == 6) { x<-coords[1] - 1 y<-coords[2] - 1 } if (i == 7) { x<-coords[1] y<-coords[2] - 1 } if (i == 8) { x<-coords[1] + 1 y<-coords[2] - 1 } if (x < 1) { x<-51 } if (x > 51) { x<-1 } if (y < 1) { y<-51 } if (y > 51) { y<-1 } n<-rbind(n,c(x,y)) } n } for (t in c(1:1000)) { happy_cells<-c() unhappy_cells<-c() for (j in c(1:input$Ic1)) { for (k in c(1:input$Ic1)) { current<-c(j,k) value<-grid[j,k] if (value > 0) { like_neighbors<-0 all_neighbors<-0 neighbors<-get_neighbors(current) for (i in c(1:nrow(neighbors))){ x<-neighbors[i,1] y<-neighbors[i,2] if (grid[x,y] > 0) { all_neighbors<-all_neighbors + 1 } if (grid[x,y] == value) { like_neighbors<-like_neighbors + 1 } } if (is.nan(like_neighbors / all_neighbors)==FALSE) { if ((like_neighbors / all_neighbors) < input$Ic3) { unhappy_cells<-rbind(unhappy_cells,c(current[1],current[2])) } else { happy_cells<-rbind(happy_cells,c(current[1],current[2])) } } else { happy_cells<-rbind(happy_cells,c(current[1],current[2])) } } } } happiness_tracker<-append(happiness_tracker,length(happy_cells)/(length(happy_cells) + length(unhappy_cells))) rand<-sample(nrow(unhappy_cells)) for (i in rand) { mover<-unhappy_cells[i,] mover_val<-grid[mover[1],mover[2]] move_to<-c(sample(1:input$Ic1,1),sample(1:input$Ic1,1)) move_to_val<-grid[move_to[1],move_to[2]] while (move_to_val > 0 ){ move_to<-c(sample(1:input$Ic1,1),sample(1:input$Ic1,1)) move_to_val<-grid[move_to[1],move_to[2]] } grid[mover[1],mover[2]]<-0 grid[move_to[1],move_to[2]]<-mover_val } image(grid,col=c("black","red","green"),axes=F) # I put output plotting in for loop to see changes Continuously output$map <- renderTable({ grid_activation1 }) } }) } shinyApp(ui = ui, server = server)
R Incorrect Number of Dimensions Error from data.frame Assignment
When running the code below I get the error: Error in data[, 4] : incorrect number of dimensions Both data[,4] and goals have the same length (480) so I don't understand what the issue is. Data is a data.frame with 4 columns and goals is a length 480 vector. library(glmmTMB) simulate_games = function(data) { mod <- glmmTMB(goals ~ home + (1|attack) + (1|defence), poisson, data=data, REML=TRUE) goals = predict(mod,newdata = data, type = "response") data[,4] = goals #Error here res = comp_ranks(goals)[,2] #comp_ranks is a user defined function for (i in 1:1000) { data[,4] = rpois(480,goals) res = cbind(res,comp_ranks(data)[,2]) } return(res) } long <- read.csv("https://www.math.ntnu.no/emner/TMA4315/2020h/eliteserie.csv", colClasses = c("factor","factor","factor","numeric")) simulate_games(long) Here is also the comp_ranks function although I don't think its whats causing the error. comp_ranks = function(data) { goals = data[,4] goals = goals[!is.na(goals)] teams = unique(data[,1]) teams_points = cbind.data.frame(0,teams) goals_scored = cbind.data.frame(0,teams) goals_conceded = cbind.data.frame(0,teams) for (i in 1:length(teams)) { tfs = data[,1] == teams[i] tfc = data[,2] == teams[i] goals_scored[i,1] = sum(na.omit(goals[tfs])) goals_conceded[i,1] = sum(na.omit(goals[tfc])) } for (i in seq(1,length(goals)-1,2)) { idx_1 = match(data[,1][i],teams) idx_2 = match(data[,1][i+1],teams) if (goals[i] - goals[i+1] > 0) { teams_points[idx_1,1] = teams_points[idx_1,1] + 3 } else if (goals[i] - goals[i+1] < 0 ) { teams_points[idx_2,1] = teams_points[idx_2,1] + 3 } else { teams_points[idx_1,1] = teams_points[idx_1,1] + 1 teams_points[idx_2,1] = teams_points[idx_2,1] + 1 } } #Sort data.frame by ranks colnames(teams_points) = c("Points","Teams") teams_points = teams_points[with(teams_points, order(-Points)), ] diff = goals_scored[,1] - goals_conceded[,1] goals_diff = cbind.data.frame(diff,teams) teams_ranked = teams_points[,2] for (i in 1:length(teams_points)) { for (j in 1:length(teams_points)) { if(j != i) { if (teams_points[i,1] == teams_points[j,1]) { if (goals_diff[i,1] == goals_diff[j,1]) { if (goals_scored[i,1] < goals_scored[j,1] ) { teams_ranked = replace(teams_ranked,c(i,j), teams_ranked[c(j,i)]) teams_points[,2] = teams_ranked } else if(goals_diff[i,1] < goals_diff[j,1] ) { teams_ranked = replace(teams_ranked,c(i,j), teams_ranked[c(j,i)]) teams_points[,2] = teams_ranked } } } } } } ranks = data.frame("Ranks" = c(1:16), "Teams" = teams_points[,2], "Points" = teams_points[,1]) return(ranks) }
Attempting to call my function n times
My goal is to call my dice roll function n times where n is the amount of turns. This is a monopoly simulated turn and as such the doubles will roll again, and triples will go to jail. I cannot figure out how to set this up so my function will be Diceroll <- Function ( Turns, Sides) Diceroll <- function(Turn,sides){ Turn = as.integer(0) First_roll = as.integer(0) Second_roll = as.integer(0) Third_roll = as.integer(0) Fourth_roll = as.integer(0) Fifth_roll = as.integer(0) Sixth_roll = as.integer(0) Total = as.integer(0) i = as.integer(1) for (i in 1:Turn) { First_roll = sample(1:sides,size = 1) Second_roll = sample(1:sides,size = 1) if(First_roll[1] == Second_roll[1]) { Third_roll = sample(1:sides,size = 1) Fourth_roll = sample(1:sides,size = 1) } if(Third_roll[1] == Fourth_roll[1] & Third_roll[1] + Fourth_roll[1] > 0) { Fifth_roll= sample(1:sides,size = 1) Sixth_roll = sample(1:sides,size = 1) } if(Fifth_roll[1] == Sixth_roll[1] & Fifth_roll[1] + Sixth_roll[1] > 0) { Total = "Jail" } else { Total = (First_roll[1] + Second_roll[1] + Third_roll[1] + Fourth_roll[1] + Fifth_roll[1] + Sixth_roll[1]) } return(Total) } } Here is my attempt but it is only listed the value of one roll.
missing value where TRUE/FALSE needed in Markov-Chain
I have been trying to use Markov Chain to improve my model and get trouble when computing transition matrix. It appears missing values. Someone know why my code is wrong? Many thanks I already defined all the variables to be 0 at first. mresiduals is residuals of my model. len is the length of vector(residuals). Error message is: Error in if (mresiduals[ele + 1] < lim5) { : missing value where TRUE/FALSE needed for (ele in 1:len) { if (mresiduals[ele] < lim5) { p1 = p1 + 1 if (mresiduals[ele + 1] < lim5) { p1I = p1I + 1 } else if (mresiduals[ele + 1] > lim5 & mresiduals[ele + 1] < lim4) { p1II = p1II + 1 } else if (mresiduals[ele + 1] > lim4 & mresiduals[ele + 1] < lim3) { p1III = p1III + 1 } else if (mresiduals[ele + 1] > lim3 & mresiduals[ele + 1] < lim2) { p1IV = p1IV + 1 } else{ p1V = p1V + 1 } } else if (ele > lim5 & ele < lim4) { p2 = p2 + 1 if (mresiduals[ele + 1] < lim5) { p2I = p2I + 1 } else if (mresiduals[ele + 1] > lim5 & mresiduals[ele + 1] < lim4) { p2II = p2II + 1 } else if (mresiduals[ele + 1] > lim4 & mresiduals[ele + 1] < lim3) { p2III = p2III + 1 } else if (mresiduals[ele + 1] > lim3 & mresiduals[ele + 1] < lim2) { p2IV = p2IV + 1 } else { p2V = p2V + 1 } } else if (ele > lim4 & ele < lim3) { p3 = p3 + 1 if (mresiduals[ele + 1] < lim5) { p3I = p3I + 1 } else if (mresiduals[ele + 1] > lim5 & mresiduals[ele + 1] < lim4) { p3II = p3II + 1 } else if (mresiduals[ele + 1] > lim4 & mresiduals[ele + 1] < lim3) { p3III = p3III + 1 } else if (mresiduals[ele + 1] > lim3 & mresiduals[ele + 1] < lim2) { p3IV = p3IV + 1 } else{ p3V = p3V + 1 } } else if (ele > lim4 & ele < lim3) { p4 = p4 + 1 if (mresiduals[ele + 1] < lim5) { p4I = p4I + 1 } else if (mresiduals[ele + 1] > lim5 & mresiduals[ele + 1] < lim4) { p4II = p4II + 1 } else if (mresiduals[ele + 1] > lim4 & mresiduals[ele + 1] < lim3) { p4III = p4III + 1 } else if (mresiduals[ele + 1] > lim3 & mresiduals[ele + 1] < lim2) { p4IV = p4IV + 1 } else{ p4V = p4V + 1 } } else{ p5 = p5 + 1 if (mresiduals[ele + 1] < lim5) { p5I = p5I + 1 } else if (mresiduals[ele + 1] > lim5 & mresiduals[ele + 1] < lim4) { p5II = p5II + 1 } else if (mresiduals[ele + 1] > lim4 & mresiduals[ele + 1] < lim3) { p5III = p5III + 1 } else if (mresiduals[ele + 1] > lim3 & mresiduals[ele + 1] < lim2) { p5IV = p5IV + 1 } else{ p5V = p5V + 1 } } }
When R finds NA during its execution and try to compare that with some other element results in this error. In current case mresiduals is of length len so in line 5 mresiduals[ele + 1] when ele loop reaches len; ele+1 becomes len+1 outside the boundary of mresiduals and hence the error.
need help on output my own function result in ddply
I have a problem outputting my result correctly when I apply my own function in ddply. Basically, I wrote a function that will output 2 variables (aggressive_name, aggressive_node). But when I run this function in ddply, the function values are not output. option_1_aggressive <- function(first_date,Market) { if (Market =="Automotive" && first_date < yearqtr(2017 + 0)) { aggressive_name = "PC2E" aggressive_node="19nm"} else if (Market =="Automotive" && first_date >= yearqtr(2017 + 0)) {aggressive_name = "Osprey_BiCS_Auto" aggressive_node="BiCS2"} else if (Market !="Automotive" && first_date < yearqtr(2014 + 0.25)) { aggressive_name = "PC2E" aggressive_node="19nm"} else if (Market !="Automotive" && yearqtr(2014 + 0.25) <= first_date && first_date<= yearqtr(2014 + 0.75)) { aggressive_name = "Whale" aggressive_node="1Ynm"} else if (Market !="Automotive" && yearqtr(2015 + 0) <= first_date && first_date<= yearqtr(2015 + 0.25) ) {aggressive_name = "Robin/Seagull" aggressive_node="1Ynm"} else if (Market !="Automotive" && yearqtr(2015 + 0.5) <= first_date && first_date <= yearqtr(2016 + 0.5) ) {aggressive_name = "Z-hawk" aggressive_node="1Znm" } else if (Market !="Automotive" && yearqtr(2016 + 0.75) <= first_date && first_date<= yearqtr(2017 + 0.75) ) {aggressive_name = "Osprey_BiCS_Mobile" aggressive_node="BiCS2"} else if (Market !="Automotive" && yearqtr(2018 + 0) <= first_date ) {aggressive_name = "PCIe" aggressive_node="BiCS3"} result <-list(aggressive_name , aggressive_node) } option_1_aggressive <- ddply(combine, .(Market, Customer, Product_Line, Platform_Name, Die_Name, Controller, Capacity, first_date), summarise, option_1_aggressive(first_date,Market))