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))
Related
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)
}
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.
I am trying to find the probability that the chain jumps from state k-1 to state 1 before it hits state k.
Can anyone spot my mistake?
I tried to simulate the markov chain, but i want to make a code that allows me to find probability of k ={1, 2, 3, ........17}. But I can really not get the code.
This is the error message I always get
Error in while (X[i] > 1 && X[i] < k) { :
missing value where TRUE/FALSE needed
Here is my code:
k <- 17
{ p <- 0.5
q <- 0.1
P <- matrix (0, nrow = k, ncol = k, byrow = TRUE)
for (i in 1:k)
{ for (j in 1:k)
{ if (i == 1 && i == j)
{ P[i,j] <- 1
}
else if (i == k && i == j)
{ P[i,j] <- 1
}
else if (i == j)
{ P[i,j] <- p*(1-q)
}
else if (j == k && i != 1)
{ P[i,j] <- q
}
else if (i == j+1 && i != k)
{ P[i,j] <- (1-p)*(1-q)
}
}
}
P
X <- (k-1)
trials <- 1000
hits <- 0 #counter for no. of hits
for (i in 1:trials)
{ i <- 1 #no. of steps
while(X[i] > 1 && X[i] < k)
{ Y <- runif(1) #uniform samples
p1 <- P[X[i],] #calculating the p-value
p1 <- cumsum(p1)
# changes in the chain
if(Y <= p1[1])
{ X[i+1] = 1}
else if(Y <= p1[2])
{ X[i+1] = 2}
else if(Y <= p1[3])
{ X[i+1] = 3}
else if(Y <= p1[4])
{ X[i+1] = 4}
else if(Y <= p1[5])
{ X[i+1] = 5}
else if(Y <= p1[6])
{ X[i+1] = 6}
else if(Y <= p1[7])
{ X[i+1] = 7}
else if(Y <= p1[8])
{ X[i+1] = 8}
else if(Y <= p1[9])
{ X[i+1] = 9}
else if(Y <= p1[10])
{ X[i+1] = 10}
else if(Y <= p1[11])
{ X[i+1] = 11}
else if(Y <= p1[12])
{ X[i+1] = 12}
else if(Y <= p1[13])
{ X[i+1] = 13}
else if(Y <= p1[14])
{ X[i+1] = 14}
else if(Y <= p1[15])
{ X[i+1] = 15}
else if(Y <= p1[16])
{ X[i+1] = 16}
else if(Y <= p1[17])
{ X[i+1] <= 17}
i <- i+1
}
if(X[i]==1)
{ hits <- hits+1}
else
{ hits <- hits+0}
}
Probability <- hits/trials
Probability
}
I think the line
i <- 1 #no. of steps
should not be there. Try this:
k <- 17
{ p <- 0.5
q <- 0.1
P <- matrix (0, nrow = k, ncol = k, byrow = TRUE)
for (i in 1:k)
{ for (j in 1:k)
{ if (i == 1 && i == j)
{ P[i,j] <- 1
}
else if (i == k && i == j)
{ P[i,j] <- 1
}
else if (i == j)
{ P[i,j] <- p*(1-q)
}
else if (j == k && i != 1)
{ P[i,j] <- q
}
else if (i == j+1 && i != k)
{ P[i,j] <- (1-p)*(1-q)
}
}
}
P
X <- (k-1)
trials <- 1000
hits <- 0 #counter for no. of hits
for (i in 1:trials)
{
while(X[i] > 1 && X[i] < k)
{ Y <- runif(1) #uniform samples
p1 <- P[X[i],] #calculating the p-value
p1 <- cumsum(p1)
# changes in the chain
if(Y <= p1[1])
{ X[i+1] = 1}
else if(Y <= p1[2])
{ X[i+1] = 2}
else if(Y <= p1[3])
{ X[i+1] = 3}
else if(Y <= p1[4])
{ X[i+1] = 4}
else if(Y <= p1[5])
{ X[i+1] = 5}
else if(Y <= p1[6])
{ X[i+1] = 6}
else if(Y <= p1[7])
{ X[i+1] = 7}
else if(Y <= p1[8])
{ X[i+1] = 8}
else if(Y <= p1[9])
{ X[i+1] = 9}
else if(Y <= p1[10])
{ X[i+1] = 10}
else if(Y <= p1[11])
{ X[i+1] = 11}
else if(Y <= p1[12])
{ X[i+1] = 12}
else if(Y <= p1[13])
{ X[i+1] = 13}
else if(Y <= p1[14])
{ X[i+1] = 14}
else if(Y <= p1[15])
{ X[i+1] = 15}
else if(Y <= p1[16])
{ X[i+1] = 16}
else if(Y <= p1[17])
{ X[i+1] <= 17}
i <- i+1
}
if(X[i]==1)
{ hits <- hits+1}
else
{ hits <- hits+0}
}
Probability <- hits/trials
Probability
}
You're setting X to k-1. In R, that's treated as a vector of length 1. As soon as i reaches 2, X[i] return an index error, because X does not have a second element.
Further notes: using the same index in two different nesting levels is very bad form. Also, when you start having a massive list of if-then-else statements, it's time to rethink your code. In this case, you could just subset 1:17 on p1[i] >=Y, take the minimum value, and then set X to that.
I am working on a data frame with x and y columns with values as rows.. I want to calculate the slope of x and y for every 2 rows and then using the calculated slope, record whether slope's "stability" is "high" or "low". You'll understand better after seeing the code. What is wrong with this code? When I input stability, R returns NULL.
slope <- (acc$y[i+1] - acc$y[i]) / (acc$x[i+1] - acc$x[i])
stability <- c()
for (i in 1:nrow(acc)) {
if (slope[i] > 0 & slope[i] < 0.8) {
stability[i] <- "low"
} else if (slope[i] >= 0.8 & slope[i] <= 1) {
stability[i] <- "high"
} else if (slope[i] > 1 & slope[i] < 1.2) {
stability[i] <- "high"
} else if (slope[i] >= 1.2) {
stability[i] <- "low"
} else if (slope[i] >= -1 & slope[i] <= -0.8) {
stability[i] <- "high"
} else if (slope[i] >= -0.8 & slope[i] <= 0) {
stability[i] <- "low"
} else if (slope[i] < -1 & slope[i] > -1.2) {
stability[i] <- "high"
} else
stability[i] <- "low"
}
Modify your code as following:
#slope <- (acc$y[i+1] - acc$y[i]) / (acc$x[i+1] - acc$x[i])
stability <- as.vector(nrow(acc))
n <- nrow(acc)-1
for (i in 1:n) {
slope <- (acc$y[i+1] - acc$y[i]) / (acc$x[i+1] - acc$x[i])
if (slope > 0 && slope < 0.8) {
stability[i] <- "low"
} else if (slope >= 0.8 && slope <= 1) {
stability[i] <- "high"
} else if (slope > 1 && slope < 1.2) {
stability[i] <- "high"
} else if (slope >= 1.2) {
stability[i] <- "low"
} else if (slope >= -1 && slope <= -0.8) {
stability[i] <- "high"
} else if (slope >= -0.8 && slope <= 0) {
stability[i] <- "low"
} else if (slope < -1 && slope > -1.2) {
stability[i] <- "high"
} else
stability[i] <- "low"
}
Try it Online
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.