Προς το περιεχόμενο

Πρόβλημα σε σκριπτάκι R

akotsi

Από τον akotsi
στο Προγραμματισμός

 Share

Προτεινόμενες αναρτήσεις

akotsi Newbie

akotsi

Δημοσ.
Δημοσ.

Καλησπέρα, έχω το παρακάτω σκριπτάκι το οποίο τρέχω σε R:                                                                     

options(scipen=999)
AssignmentMatrix <- read.csv("AssignmentMatrix.csv" ,stringsAsFactors = FALSE)
Capac_FreeFlow   <- read.csv("Capac_FreeFlow.csv" ,stringsAsFactors = FALSE)
Demand           <- read.csv("Demand.csv" ,stringsAsFactors = FALSE)
Logit_Sue   <- -0.3
Alfa      <- 0.15 
Beta      <- 4
mu        <- 0.01
iterations<- 4000
Players <- names(Demand[,2:5 ])
LinkFlows                            <- numeric(nrow(Capac_FreeFlow))
RouteFlows                           <- numeric(nrow(AssignmentMatrix)) # This needs to change!!! TO have a table 
RouteFlowsPerPlayer                  <- matrix(0,nrow=length(Players),ncol = nrow(AssignmentMatrix))
LinkFlowsPerPlayer                   <- matrix(0,nrow=length(Players),ncol = (ncol(AssignmentMatrix)-2))
AssignmentMatrix_MatrixFormat        <- AssignmentMatrix
AssignmentMatrix_MatrixFormat$OD     <- NULL
AssignmentMatrix_MatrixFormat$Route  <- NULL
AssignmentMatrix_MatrixFormat <- data.matrix(AssignmentMatrix_MatrixFormat)
ODs <- unique(AssignmentMatrix$OD)
LinkCosts       <- Capac_FreeFlow$Free.Flow + Capac_FreeFlow$alpha*LinkFlows #*(1 + Alfa*(LinkFlows/Capac_FreeFlow$Capacity)^Beta)
RouteCostMatrix <- AssignmentMatrix_MatrixFormat%*%LinkCosts
RouteCosts      <- rowSums(RouteCostMatrix)
for(i in 1:iterations){
  for(j in 1:length(ODs)){
    ExaminedOD          <- ODs[j]
    DemandForExOD       <- Demand[Demand$OD == ExaminedOD, ]
    RoutesForExaminedOD <- which(AssignmentMatrix$OD==ExaminedOD)
    for(k in 1:length(Players)){
      ExaminedPlayer    <- Players[k]
      DemandforExPlayer <- as.numeric(DemandForExOD[names(DemandForExOD)==ExaminedPlayer])
      if(length(DemandForExOD)!=0){
        if(ExaminedPlayer=="SO"){
          LinkCosts       <- Capac_FreeFlow$Free.Flow + Capac_FreeFlow$alpha*LinkFlows + LinkFlows * Capac_FreeFlow$alpha         # The corresponding equation 
          RouteCostMatrix <- AssignmentMatrix_MatrixFormat%*%LinkCosts
          RouteCosts      <- rowSums(RouteCostMatrix)
          ExaminedRoutesCosts <- RouteCosts[RoutesForExaminedOD]
          InterExCost         <- ExaminedRoutesCosts
          ExaminedRoutesCosts[ExaminedRoutesCosts!=min(InterExCost)]<-0
          ExaminedRoutesCosts[ExaminedRoutesCosts==min(InterExCost)]<-1
          if(sum(ExaminedRoutesCosts)>1){
            debag<-paste("Iteration:", i, "OD:",ExaminedOD, "#Same:", sum(ExaminedRoutesCosts),"Player:",ExaminedPlayer)
            cat(debag,"\n")
          }
          ExaminedRouteFlows  <- (ExaminedRoutesCosts * DemandforExPlayer)/sum(ExaminedRoutesCosts)
          RouteFlowsPerPlayer[1, RoutesForExaminedOD] <- ExaminedRouteFlows
        }else if(ExaminedPlayer=="UE"){ 
          #' Here you find route flows of a particular player for a particular OD pair
          #' Which means that you need to store these flows in the `RouteFlowsPerPlayer` matrix
          #' Then these `RouteFlowsPerPlayer` are combined (summed) for the `RouteFlows` variable.
          LinkCosts       <- Capac_FreeFlow$Free.Flow + Capac_FreeFlow$alpha*LinkFlows #Capac_FreeFlow$Free.Flow*(1 + Alfa*(LinkFlows/Capac_FreeFlow$Capacity)^Beta)
          RouteCostMatrix <- AssignmentMatrix_MatrixFormat%*%LinkCosts
          RouteCosts      <- rowSums(RouteCostMatrix)
          ExaminedRoutesCosts <- RouteCosts[RoutesForExaminedOD]
          InterExCost         <- ExaminedRoutesCosts
          ExaminedRoutesCosts[ExaminedRoutesCosts!=min(InterExCost)]<-0
          ExaminedRoutesCosts[ExaminedRoutesCosts==min(InterExCost)]<-1
          if(sum(ExaminedRoutesCosts)>1){
            debag<-paste("Iteration:", i, "OD:",ExaminedOD, "#Same:", sum(ExaminedRoutesCosts),"Player:",ExaminedPlayer)
            cat(debag,"\n")
          }
          ExaminedRouteFlows  <- (ExaminedRoutesCosts * DemandforExPlayer)/sum(ExaminedRoutesCosts)
          RouteFlowsPerPlayer[2, RoutesForExaminedOD] <- ExaminedRouteFlows
        }else if(ExaminedPlayer=="CN1"){# change UE to corresponding player
          LinkCosts       <- Capac_FreeFlow$Free.Flow + Capac_FreeFlow$alpha*(LinkFlows+LinkFlowsPerPlayer[3, ])#Capac_FreeFlow$Free.Flow*(1 + Alfa*(LinkFlows/Capac_FreeFlow$Capacity)^Beta)
          RouteCostMatrix <- AssignmentMatrix_MatrixFormat%*%LinkCosts
          RouteCosts      <- rowSums(RouteCostMatrix)
          ExaminedRoutesCosts <- RouteCosts[RoutesForExaminedOD]
          InterExCost         <- ExaminedRoutesCosts
          ExaminedRoutesCosts[ExaminedRoutesCosts!=min(InterExCost)]<-0
          ExaminedRoutesCosts[ExaminedRoutesCosts==min(InterExCost)]<-1
          if(sum(ExaminedRoutesCosts)>1){
            debag<-paste("Iteration:", i, "OD:",ExaminedOD, "#Same:", sum(ExaminedRoutesCosts),"Player:",ExaminedPlayer)
            cat(debag,"\n")
          }
          ExaminedRouteFlows  <- (ExaminedRoutesCosts * DemandforExPlayer)/sum(ExaminedRoutesCosts)
          RouteFlowsPerPlayer[3, RoutesForExaminedOD] <- ExaminedRouteFlows
        }else if(ExaminedPlayer=="CN2"){# change UE to corresponding player
          LinkCosts       <- Capac_FreeFlow$Free.Flow + Capac_FreeFlow$alpha*(LinkFlows + LinkFlowsPerPlayer[4, ])
          RouteCostMatrix <- AssignmentMatrix_MatrixFormat%*%LinkCosts
          RouteCosts      <- rowSums(RouteCostMatrix)
          ExaminedRoutesCosts <- RouteCosts[RoutesForExaminedOD]
          InterExCost         <- ExaminedRoutesCosts
          ExaminedRoutesCosts[ExaminedRoutesCosts!=min(InterExCost)]<-0
          ExaminedRoutesCosts[ExaminedRoutesCosts==min(InterExCost)]<-1
          if(sum(ExaminedRoutesCosts)>1){
            debag<-paste("Iteration:", i, "OD:",ExaminedOD, "#Same:", sum(ExaminedRoutesCosts),"Player:",ExaminedPlayer)
            cat(debag,"\n")
          }
          ExaminedRouteFlows  <- (ExaminedRoutesCosts * DemandforExPlayer)/sum(ExaminedRoutesCosts)
          RouteFlowsPerPlayer[4, RoutesForExaminedOD] <- ExaminedRouteFlows
          
        }
      }
      
    }
    InterVar<- RouteFlowsPerPlayer[, RoutesForExaminedOD]
    if(is.null(nrow(InterVar))){
      RouteFlows[RoutesForExaminedOD]<-sum(RouteFlowsPerPlayer[, RoutesForExaminedOD])
    }else{
      RouteFlows[RoutesForExaminedOD] <- colSums(RouteFlowsPerPlayer[, RoutesForExaminedOD]) # TODO: THIS IS WRONG
    }
  }
  
  LinkFlowsPerPlayer[1, ] <- LinkFlowsPerPlayer[1, ]+ (colSums(AssignmentMatrix_MatrixFormat * RouteFlowsPerPlayer[1, ])-LinkFlowsPerPlayer[1, ])/i
  LinkFlowsPerPlayer[2, ] <- LinkFlowsPerPlayer[2, ]+ (colSums(AssignmentMatrix_MatrixFormat * RouteFlowsPerPlayer[2, ])-LinkFlowsPerPlayer[2, ])/i
  LinkFlowsPerPlayer[3, ] <- LinkFlowsPerPlayer[3, ]+ (colSums(AssignmentMatrix_MatrixFormat * RouteFlowsPerPlayer[3, ])-LinkFlowsPerPlayer[3, ])/i
  LinkFlowsPerPlayer[4, ] <- LinkFlowsPerPlayer[4, ]+ (colSums(AssignmentMatrix_MatrixFormat * RouteFlowsPerPlayer[4, ])-LinkFlowsPerPlayer[4, ])/i
  LinkFlows <-colSums(LinkFlowsPerPlayer)
  # LinkFlows               <- LinkFlows+ (colSums(AssignmentMatrix_MatrixFormat * RouteFlows)-LinkFlows)/i
  
}  
LinkFlowsPerPlayer
LinkFlows
LinkCosts                                                                                                                                                                                                 

Το τρέχω με τα 3 αρχεία που επισυνάπτω και παίρνω τα παρακάτω αποτελέσματα τα οποία έχουν errors: 

> setwd("C:/Users/Areti Kotsi/Desktop/PHD Material/Thesis MODEL_July2023/FinalModels_Jul2023/paper Kinezou/Example 2 network")
> options(scipen=999)
> AssignmentMatrix <- read.csv("AssignmentMatrix.csv" ,stringsAsFactors = FALSE)
> Capac_FreeFlow   <- read.csv("Capac_FreeFlow.csv" ,stringsAsFactors = FALSE)
> Demand           <- read.csv("Demand.csv" ,stringsAsFactors = FALSE)
> Logit_Sue   <- -0.3
> Alfa      <- 0.15 
> Beta      <- 4
> mu        <- 0.01
> iterations<- 4000
> Players <- names(Demand[,2:5 ])
> LinkFlows                            <- numeric(nrow(Capac_FreeFlow))
> RouteFlows                           <- numeric(nrow(AssignmentMatrix)) # This needs to change!!! TO have a table 
> RouteFlowsPerPlayer                  <- matrix(0,nrow=length(Players),ncol = nrow(AssignmentMatrix))
> LinkFlowsPerPlayer                   <- matrix(0,nrow=length(Players),ncol = (ncol(AssignmentMatrix)-2))
> AssignmentMatrix_MatrixFormat        <- AssignmentMatrix
> AssignmentMatrix_MatrixFormat$OD     <- NULL
> AssignmentMatrix_MatrixFormat$Route  <- NULL
> AssignmentMatrix_MatrixFormat <- data.matrix(AssignmentMatrix_MatrixFormat)
> ODs <- unique(AssignmentMatrix$OD)
> LinkCosts       <- Capac_FreeFlow$Free.Flow + Capac_FreeFlow$alpha*LinkFlows #*(1 + Alfa*(LinkFlows/Capac_FreeFlow$Capacity)^Beta)
> RouteCostMatrix <- AssignmentMatrix_MatrixFormat%*%LinkCosts
Error in AssignmentMatrix_MatrixFormat %*% LinkCosts : 
  non-conformable arguments
> RouteCosts      <- rowSums(RouteCostMatrix)
Error in is.data.frame(x) : object 'RouteCostMatrix' not found
> for(i in 1:iterations){
+   for(j in 1:length(ODs)){
+     ExaminedOD          <- ODs[j]
+     DemandForExOD       <- Demand[Demand$OD == ExaminedOD, ]
+     RoutesForExaminedOD <- which(AssignmentMatrix$OD==ExaminedOD)
+     for(k in 1:length(Players)){
+       ExaminedPlayer    <- Players[k]
+       DemandforExPlayer <- as.numeric(DemandForExOD[names(DemandForExOD)==ExaminedPlayer])
+       if(length(DemandForExOD)!=0){
+         if(ExaminedPlayer=="SO"){
+           LinkCosts       <- Capac_FreeFlow$Free.Flow + Capac_FreeFlow$alpha*LinkFlows + LinkFlows * Capac_FreeFlow$alpha         # The corresponding equation 
+           RouteCostMatrix <- AssignmentMatrix_MatrixFormat%*%LinkCosts
+           RouteCosts      <- rowSums(RouteCostMatrix)
+           ExaminedRoutesCosts <- RouteCosts[RoutesForExaminedOD]
+           InterExCost         <- ExaminedRoutesCosts
+           ExaminedRoutesCosts[ExaminedRoutesCosts!=min(InterExCost)]<-0
+           ExaminedRoutesCosts[ExaminedRoutesCosts==min(InterExCost)]<-1
+           if(sum(ExaminedRoutesCosts)>1){
+             debag<-paste("Iteration:", i, "OD:",ExaminedOD, "#Same:", sum(ExaminedRoutesCosts),"Player:",ExaminedPlayer)
+             cat(debag,"\n")
+           }
+           ExaminedRouteFlows  <- (ExaminedRoutesCosts * DemandforExPlayer)/sum(ExaminedRoutesCosts)
+           RouteFlowsPerPlayer[1, RoutesForExaminedOD] <- ExaminedRouteFlows
+         }else if(ExaminedPlayer=="UE"){ 
+           #' Here you find route flows of a particular player for a particular OD pair
+           #' Which means that you need to store these flows in the `RouteFlowsPerPlayer` matrix
+           #' Then these `RouteFlowsPerPlayer` are combined (summed) for the `RouteFlows` variable.
+           LinkCosts       <- Capac_FreeFlow$Free.Flow + Capac_FreeFlow$alpha*LinkFlows #Capac_FreeFlow$Free.Flow*(1 + Alfa*(LinkFlows/Capac_FreeFlow$Capacity)^Beta)
+           RouteCostMatrix <- AssignmentMatrix_MatrixFormat%*%LinkCosts
+           RouteCosts      <- rowSums(RouteCostMatrix)
+           ExaminedRoutesCosts <- RouteCosts[RoutesForExaminedOD]
+           InterExCost         <- ExaminedRoutesCosts
+           ExaminedRoutesCosts[ExaminedRoutesCosts!=min(InterExCost)]<-0
+           ExaminedRoutesCosts[ExaminedRoutesCosts==min(InterExCost)]<-1
+           if(sum(ExaminedRoutesCosts)>1){
+             debag<-paste("Iteration:", i, "OD:",ExaminedOD, "#Same:", sum(ExaminedRoutesCosts),"Player:",ExaminedPlayer)
+             cat(debag,"\n")
+           }
+           ExaminedRouteFlows  <- (ExaminedRoutesCosts * DemandforExPlayer)/sum(ExaminedRoutesCosts)
+           RouteFlowsPerPlayer[2, RoutesForExaminedOD] <- ExaminedRouteFlows
+         }else if(ExaminedPlayer=="CN1"){# change UE to corresponding player
+           LinkCosts       <- Capac_FreeFlow$Free.Flow + Capac_FreeFlow$alpha*(LinkFlows+LinkFlowsPerPlayer[3, ])#Capac_FreeFlow$Free.Flow*(1 + Alfa*(LinkFlows/Capac_FreeFlow$Capacity)^Beta)
+           RouteCostMatrix <- AssignmentMatrix_MatrixFormat%*%LinkCosts
+           RouteCosts      <- rowSums(RouteCostMatrix)
+           ExaminedRoutesCosts <- RouteCosts[RoutesForExaminedOD]
+           InterExCost         <- ExaminedRoutesCosts
+           ExaminedRoutesCosts[ExaminedRoutesCosts!=min(InterExCost)]<-0
+           ExaminedRoutesCosts[ExaminedRoutesCosts==min(InterExCost)]<-1
+           if(sum(ExaminedRoutesCosts)>1){
+             debag<-paste("Iteration:", i, "OD:",ExaminedOD, "#Same:", sum(ExaminedRoutesCosts),"Player:",ExaminedPlayer)
+             cat(debag,"\n")
+           }
+           ExaminedRouteFlows  <- (ExaminedRoutesCosts * DemandforExPlayer)/sum(ExaminedRoutesCosts)
+           RouteFlowsPerPlayer[3, RoutesForExaminedOD] <- ExaminedRouteFlows
+         }else if(ExaminedPlayer=="CN2"){# change UE to corresponding player
+           LinkCosts       <- Capac_FreeFlow$Free.Flow + Capac_FreeFlow$alpha*(LinkFlows + LinkFlowsPerPlayer[4, ])
+           RouteCostMatrix <- AssignmentMatrix_MatrixFormat%*%LinkCosts
+           RouteCosts      <- rowSums(RouteCostMatrix)
+           ExaminedRoutesCosts <- RouteCosts[RoutesForExaminedOD]
+           InterExCost         <- ExaminedRoutesCosts
+           ExaminedRoutesCosts[ExaminedRoutesCosts!=min(InterExCost)]<-0
+           ExaminedRoutesCosts[ExaminedRoutesCosts==min(InterExCost)]<-1
+           if(sum(ExaminedRoutesCosts)>1){
+             debag<-paste("Iteration:", i, "OD:",ExaminedOD, "#Same:", sum(ExaminedRoutesCosts),"Player:",ExaminedPlayer)
+             cat(debag,"\n")
+           }
+           ExaminedRouteFlows  <- (ExaminedRoutesCosts * DemandforExPlayer)/sum(ExaminedRoutesCosts)
+           RouteFlowsPerPlayer[4, RoutesForExaminedOD] <- ExaminedRouteFlows
+           
+         }
+       }
+       
+     }
+     InterVar<- RouteFlowsPerPlayer[, RoutesForExaminedOD]
+     if(is.null(nrow(InterVar))){
+       RouteFlows[RoutesForExaminedOD]<-sum(RouteFlowsPerPlayer[, RoutesForExaminedOD])
+     }else{
+       RouteFlows[RoutesForExaminedOD] <- colSums(RouteFlowsPerPlayer[, RoutesForExaminedOD]) # TODO: THIS IS WRONG
+     }
+   }
+   
+   LinkFlowsPerPlayer[1, ] <- LinkFlowsPerPlayer[1, ]+ (colSums(AssignmentMatrix_MatrixFormat * RouteFlowsPerPlayer[1, ])-LinkFlowsPerPlayer[1, ])/i
+   LinkFlowsPerPlayer[2, ] <- LinkFlowsPerPlayer[2, ]+ (colSums(AssignmentMatrix_MatrixFormat * RouteFlowsPerPlayer[2, ])-LinkFlowsPerPlayer[2, ])/i
+   LinkFlowsPerPlayer[3, ] <- LinkFlowsPerPlayer[3, ]+ (colSums(AssignmentMatrix_MatrixFormat * RouteFlowsPerPlayer[3, ])-LinkFlowsPerPlayer[3, ])/i
+   LinkFlowsPerPlayer[4, ] <- LinkFlowsPerPlayer[4, ]+ (colSums(AssignmentMatrix_MatrixFormat * RouteFlowsPerPlayer[4, ])-LinkFlowsPerPlayer[4, ])/i
+   LinkFlows <-colSums(LinkFlowsPerPlayer)
+   # LinkFlows               <- LinkFlows+ (colSums(AssignmentMatrix_MatrixFormat * RouteFlows)-LinkFlows)/i
+   
+ }
Error in AssignmentMatrix_MatrixFormat %*% LinkCosts : 
  non-conformable arguments
> LinkFlowsPerPlayer
     [,1] [,2] [,3]
[1,]    0    0    0
[2,]    0    0    0
[3,]    0    0    0
[4,]    0    0    0
> LinkFlows
[1] 0 0 0
> LinkCosts
[1]  10  50 100
>                                                                                                                                                                                                        

Μπορεί κάποιος να με βοηθήσει να διορθώσω το λάθος? Είμαι πολιτικός μηχανικός με ελάχιστες γνώσεις στον προγραμματισμό και χρησιμοποιώ αυτό το μοντέλο για το διδακτορικό μου.                                                                   

AssignmentMatrix.csv Capac_FreeFlow.csv Demand.csv

Xvipes Crazy Insomniac

Xvipes

Δημοσ.
Δημοσ.

image.png.967a21a382b1d5cdb45ace19352fadd2.png
Βάλε σε code tag τον κώδικα ώστε να μπορεί να διαβαστεί και πες μερικά πράγματα ακόμα στο τι κάνει το script, πως πας να το τρέξεις κλπ.

Spoiler

didnt read GIF

  • Like 1
akotsi Newbie

akotsi

Δημοσ.
  • Μέλος
Δημοσ. 
options(scipen=999)
AssignmentMatrix <- read.csv("AssignmentMatrix.csv" ,stringsAsFactors = FALSE)
Capac_FreeFlow   <- read.csv("Capac_FreeFlow.csv" ,stringsAsFactors = FALSE)
Demand           <- read.csv("Demand.csv" ,stringsAsFactors = FALSE)
Logit_Sue   <- -0.3
Alfa      <- 0.15 
Beta      <- 4
mu        <- 0.01
iterations<- 4000
Players <- names(Demand[,2:5 ])
LinkFlows                            <- numeric(nrow(Capac_FreeFlow))
RouteFlows                           <- numeric(nrow(AssignmentMatrix)) # This needs to change!!! TO have a table 
RouteFlowsPerPlayer                  <- matrix(0,nrow=length(Players),ncol = nrow(AssignmentMatrix))
LinkFlowsPerPlayer                   <- matrix(0,nrow=length(Players),ncol = (ncol(AssignmentMatrix)-2))
AssignmentMatrix_MatrixFormat        <- AssignmentMatrix
AssignmentMatrix_MatrixFormat$OD     <- NULL
AssignmentMatrix_MatrixFormat$Route  <- NULL
AssignmentMatrix_MatrixFormat <- data.matrix(AssignmentMatrix_MatrixFormat)
ODs <- unique(AssignmentMatrix$OD)
LinkCosts       <- Capac_FreeFlow$Free.Flow + Capac_FreeFlow$alpha*LinkFlows #*(1 + Alfa*(LinkFlows/Capac_FreeFlow$Capacity)^Beta)
RouteCostMatrix <- AssignmentMatrix_MatrixFormat%*%LinkCosts
RouteCosts      <- rowSums(RouteCostMatrix)
for(i in 1:iterations){
  for(j in 1:length(ODs)){
    ExaminedOD          <- ODs[j]
    DemandForExOD       <- Demand[Demand$OD == ExaminedOD, ]
    RoutesForExaminedOD <- which(AssignmentMatrix$OD==ExaminedOD)
    for(k in 1:length(Players)){
      ExaminedPlayer    <- Players[k]
      DemandforExPlayer <- as.numeric(DemandForExOD[names(DemandForExOD)==ExaminedPlayer])
      if(length(DemandForExOD)!=0){
        if(ExaminedPlayer=="SO"){
          LinkCosts       <- Capac_FreeFlow$Free.Flow + Capac_FreeFlow$alpha*LinkFlows + LinkFlows * Capac_FreeFlow$alpha         # The corresponding equation 
          RouteCostMatrix <- AssignmentMatrix_MatrixFormat%*%LinkCosts
          RouteCosts      <- rowSums(RouteCostMatrix)
          ExaminedRoutesCosts <- RouteCosts[RoutesForExaminedOD]
          InterExCost         <- ExaminedRoutesCosts
          ExaminedRoutesCosts[ExaminedRoutesCosts!=min(InterExCost)]<-0
          ExaminedRoutesCosts[ExaminedRoutesCosts==min(InterExCost)]<-1
          if(sum(ExaminedRoutesCosts)>1){
            debag<-paste("Iteration:", i, "OD:",ExaminedOD, "#Same:", sum(ExaminedRoutesCosts),"Player:",ExaminedPlayer)
            cat(debag,"\n")
          }
          ExaminedRouteFlows  <- (ExaminedRoutesCosts * DemandforExPlayer)/sum(ExaminedRoutesCosts)
          RouteFlowsPerPlayer[1, RoutesForExaminedOD] <- ExaminedRouteFlows
        }else if(ExaminedPlayer=="UE"){ 
          #' Here you find route flows of a particular player for a particular OD pair
          #' Which means that you need to store these flows in the `RouteFlowsPerPlayer` matrix
          #' Then these `RouteFlowsPerPlayer` are combined (summed) for the `RouteFlows` variable.
          LinkCosts       <- Capac_FreeFlow$Free.Flow + Capac_FreeFlow$alpha*LinkFlows #Capac_FreeFlow$Free.Flow*(1 + Alfa*(LinkFlows/Capac_FreeFlow$Capacity)^Beta)
          RouteCostMatrix <- AssignmentMatrix_MatrixFormat%*%LinkCosts
          RouteCosts      <- rowSums(RouteCostMatrix)
          ExaminedRoutesCosts <- RouteCosts[RoutesForExaminedOD]
          InterExCost         <- ExaminedRoutesCosts
          ExaminedRoutesCosts[ExaminedRoutesCosts!=min(InterExCost)]<-0
          ExaminedRoutesCosts[ExaminedRoutesCosts==min(InterExCost)]<-1
          if(sum(ExaminedRoutesCosts)>1){
            debag<-paste("Iteration:", i, "OD:",ExaminedOD, "#Same:", sum(ExaminedRoutesCosts),"Player:",ExaminedPlayer)
            cat(debag,"\n")
          }
          ExaminedRouteFlows  <- (ExaminedRoutesCosts * DemandforExPlayer)/sum(ExaminedRoutesCosts)
          RouteFlowsPerPlayer[2, RoutesForExaminedOD] <- ExaminedRouteFlows
        }else if(ExaminedPlayer=="CN1"){# change UE to corresponding player
          LinkCosts       <- Capac_FreeFlow$Free.Flow + Capac_FreeFlow$alpha*(LinkFlows+LinkFlowsPerPlayer[3, ])#Capac_FreeFlow$Free.Flow*(1 + Alfa*(LinkFlows/Capac_FreeFlow$Capacity)^Beta)
          RouteCostMatrix <- AssignmentMatrix_MatrixFormat%*%LinkCosts
          RouteCosts      <- rowSums(RouteCostMatrix)
          ExaminedRoutesCosts <- RouteCosts[RoutesForExaminedOD]
          InterExCost         <- ExaminedRoutesCosts
          ExaminedRoutesCosts[ExaminedRoutesCosts!=min(InterExCost)]<-0
          ExaminedRoutesCosts[ExaminedRoutesCosts==min(InterExCost)]<-1
          if(sum(ExaminedRoutesCosts)>1){
            debag<-paste("Iteration:", i, "OD:",ExaminedOD, "#Same:", sum(ExaminedRoutesCosts),"Player:",ExaminedPlayer)
            cat(debag,"\n")
          }
          ExaminedRouteFlows  <- (ExaminedRoutesCosts * DemandforExPlayer)/sum(ExaminedRoutesCosts)
          RouteFlowsPerPlayer[3, RoutesForExaminedOD] <- ExaminedRouteFlows
        }else if(ExaminedPlayer=="CN2"){# change UE to corresponding player
          LinkCosts       <- Capac_FreeFlow$Free.Flow + Capac_FreeFlow$alpha*(LinkFlows + LinkFlowsPerPlayer[4, ])
          RouteCostMatrix <- AssignmentMatrix_MatrixFormat%*%LinkCosts
          RouteCosts      <- rowSums(RouteCostMatrix)
          ExaminedRoutesCosts <- RouteCosts[RoutesForExaminedOD]
          InterExCost         <- ExaminedRoutesCosts
          ExaminedRoutesCosts[ExaminedRoutesCosts!=min(InterExCost)]<-0
          ExaminedRoutesCosts[ExaminedRoutesCosts==min(InterExCost)]<-1
          if(sum(ExaminedRoutesCosts)>1){
            debag<-paste("Iteration:", i, "OD:",ExaminedOD, "#Same:", sum(ExaminedRoutesCosts),"Player:",ExaminedPlayer)
            cat(debag,"\n")
          }
          ExaminedRouteFlows  <- (ExaminedRoutesCosts * DemandforExPlayer)/sum(ExaminedRoutesCosts)
          RouteFlowsPerPlayer[4, RoutesForExaminedOD] <- ExaminedRouteFlows
          
        }
      }
      
    }
    InterVar<- RouteFlowsPerPlayer[, RoutesForExaminedOD]
    if(is.null(nrow(InterVar))){
      RouteFlows[RoutesForExaminedOD]<-sum(RouteFlowsPerPlayer[, RoutesForExaminedOD])
    }else{
      RouteFlows[RoutesForExaminedOD] <- colSums(RouteFlowsPerPlayer[, RoutesForExaminedOD]) # TODO: THIS IS WRONG
    }
  }
  
  LinkFlowsPerPlayer[1, ] <- LinkFlowsPerPlayer[1, ]+ (colSums(AssignmentMatrix_MatrixFormat * RouteFlowsPerPlayer[1, ])-LinkFlowsPerPlayer[1, ])/i
  LinkFlowsPerPlayer[2, ] <- LinkFlowsPerPlayer[2, ]+ (colSums(AssignmentMatrix_MatrixFormat * RouteFlowsPerPlayer[2, ])-LinkFlowsPerPlayer[2, ])/i
  LinkFlowsPerPlayer[3, ] <- LinkFlowsPerPlayer[3, ]+ (colSums(AssignmentMatrix_MatrixFormat * RouteFlowsPerPlayer[3, ])-LinkFlowsPerPlayer[3, ])/i
  LinkFlowsPerPlayer[4, ] <- LinkFlowsPerPlayer[4, ]+ (colSums(AssignmentMatrix_MatrixFormat * RouteFlowsPerPlayer[4, ])-LinkFlowsPerPlayer[4, ])/i
  LinkFlows <-colSums(LinkFlowsPerPlayer)
  # LinkFlows               <- LinkFlows+ (colSums(AssignmentMatrix_MatrixFormat * RouteFlows)-LinkFlows)/i
  
}
LinkFlowsPerPlayer
LinkFlows
LinkCosts

Το τρεχω σε περιβάλλον RStudio. Έχω τα 3 αρχεία excel σε ένα φάκελο, πάω στο RStudio στο tab Session->Set Working Directory->Choose Directory, επιλεγω το συγκεκριμενο φακελο και μετα παταω Run. H όλη λογικη του script ειναι οτι κανει κατανομη κυκλοφοριακού φορτου σε ενα δικτυο και μου υπολογιζει τους φορτους στο δικτυο και τα κοστη για 3 διαφορετικες κατηγοριες μετακινουμενων. Εψαξα τι ειναι τα λαθη που μου βγαινουν και ειδα οτι σχετιζονται με καποιο προβλημα στους πολλαπλασιασμους των πινακων, αλλα δεν ξερω πως να το διορθωσω.

andreoulios Contributor

andreoulios

Δημοσ.
Δημοσ. (επεξεργασμένο)

Στο assignment matrix έχεις κάποια null values και μάλλον για αυτό δε συνεχίζει το πολλαπλασιασμό πινάκων . Αλλιώς ψάχνεις το error στο Google.

Επεξ/σία από andreoulios
  • 3 εβδομάδες αργότερα...
masteripper Crazy Insomniac

masteripper

Δημοσ.
Δημοσ.

Βασικως πρέπει να σπάσεις τον κώδικα σε function τις οποίες θα μπορείς να ελέγχεις ατομικά τα δεδομένα που επιστρέφουν.

 

Δημιουργήστε ένα λογαριασμό ή συνδεθείτε για να σχολιάσετε

Πρέπει να είστε μέλος για να αφήσετε σχόλιο

Δημιουργία λογαριασμού

Εγγραφείτε με νέο λογαριασμό στην κοινότητα μας. Είναι πανεύκολο!

Δημιουργία νέου λογαριασμού

Σύνδεση

Έχετε ήδη λογαριασμό; Συνδεθείτε εδώ.

Συνδεθείτε τώρα
 Share
Προς την λίστα θεμάτων
  • Δημιουργία νέου...