R HELP! PSO Package - "Error during wrapup: incorrect number of dimensions


#1

Hi everyone,

I am pretty new in working with R but I need to optimize a model for my Bachelor Thesis so my question is pretty time sensitive..

I have installed the package PSO and psoptim bc I need to optimize a cost function with the Particle Swarm Optimization.

First, I uploaded my data into r ( a matrix with 13 columns and 10 rows, which defines my variables) and defined the different columnes.
e.g.:

h <- as.matrix(IFRC[1:10,5])

that worked well.
additionally I defined the cost function, which also worked out:

VMIcost <- function(x){
  cost=0
  for (i in 1:length(D)){
    temp=(D[i]/x[i,1])*AR[i]+(h[i]/(2*x[i,1]))*(x[i,1]-x[i,2])^2+(pidach*x[i,2]^2)/(2*x[i,1])+(pi*x[i,2]*D[i]/x[i,1])+T[i]
    cost = cost + temp
    temp=0
  }
  cost
}

Further I defined a fitness function, which also includes penalty functions (constraints) that need to be considered:

fitness <- function(x){
  temp= matrix(mapply(negativ,x), length(D))
  -VMIcost(temp)+penaltyOrder(temp)+penaltySpace(temp)+PenaltyProportion(temp)+penaltyUpper(temp)+penaltyLower(temp)+penaltyRelation(temp)
}

Penalty functions eg:
penaltyOrder <- function(x){
  if(sum(x[,1])>V) {penalty=(sum(x[,1]))-V}
  else {penalty=0}
  penalty
}

Everything is now saved as values, data and functions.

In a documentation about PSO I found the code for the algorithm:

psoptim(par, fn, gr=NULL, lower,=-1, upper=1, control=list())

(see page 6 ff. https://cran.r-project.org/web/packages/pso/pso.pdf)

I set par =NA, fn=, gr=NULL, lower=0, upper= 14000 (bc I need those bounds. Actually, I need the bounds to be defined by columns of the origin matrix, but both doesn't work)

as fn I first tried to define as VMIcost (my cost function)
also I tried fn=fintness

In both cases the Error:

Error during wrapup: incorrect number of dimensions 

occured.

Can anyone give me suggestions what the mistake might be?
What does it mean that the number of dimensions is incorrect?

THANKS

View(IFRC)
require(pso)
require(psoptim)

#Speichern des Bedarfes in D
D <- as.matrix(IFRC[1:10,2])
#Speichern der Bestellkosten des Lieferanten in AS
AS <- as.matrix(IFRC[1:10,3])
#Speichern der BEstellkosten des Käufers in AR
AR <- as.matrix(IFRC[1:10,4])
#Speichern der Haltungskosten in h
h <- as.matrix(IFRC[1:10,5])
#Einspeichern der Kapazität eines Produktes i auf Palette in K
K <- as.matrix(IFRC[1:10,6])
#Einspeichern der Anzahl Paletten je Bestellung von i in N
N <- as.matrix(IFRC[1:10,7])
#Einlesen der Transportkosten in T
T <- as.matrix(IFRC[1:10,8])
#Einlesen der Kapazität eines Produktes i in f
f <- as.matrix(IFRC[1:10,9])
#Lieferrückstandskosten je Einheit
pi <- 350
#Lieferrückstandskosten je Einheit je Zeiteinheit
pidach <- 350
#Maximale Anzahl von Bestellungen
V <- 144
#Maximale Lieferkapazität 
F <- 8920
#Einspeichern der Untergrenze der Bestellmenge in L
L <- as.matrix(IFRC[1:10,10])
#Einspeichern der Obergrenze der Bestellmenge in U
U <- as.matrix(IFRC[1:10,12])

#Zielfunktion
#x muss eine Matrix mit zwei Spalten und der gleichen Zeilenanzahl wie IFRC sein
VMIcost <- function(x){
  cost=0
  for (i in 1:length(D)){
    temp=(D[i]/x[i,1])*AR[i]+(h[i]/(2*x[i,1]))*(x[i,1]-x[i,2])^2+(pidach*x[i,2]^2)/(2*x[i,1])+(pi*x[i,2]*D[i]/x[i,1])+T[i]
    cost = cost + temp
    temp=0
  }
  cost
}

#Strafffunktion zur Einhaltung der maximalen Lagerkapazität
#(wird diese überschritten, erhält der Wert eine Strafe, sodass er nicht mehr "gut" ist)
penaltySpace <- function(x){
  if(sum(f*(x[,1]-x[,2]))>F) {penalty= (sum(f*(x[,1]-x[,2])))-F}
  else {penalty=0}
  penalty 
}

#Straffunktion zur Einhaltung der maximalen Anzahl an Bestellungen
#(wird diese überschritten, erhält der Wert eine Strafe, sodass er nicht mehr "gut" ist)
penaltyOrder <- function(x){
  if(sum(x[,1])>V) {penalty=(sum(x[,1]))-V}
  else {penalty=0}
  penalty
}

#Überprüft, ob x negativ ist. Wenn ja, wird sein Wert auf 0 gesetzt, ansonsten auf eine ganze Zahl gerundet
negativ <- function(x){
  if(x<0) {result=0}
  else {result=as.integer(x)}
  result
}
#Strafffunktion zur Einhaltung der Untergrenze des Bedarfes
penaltyLower <-function(x){
  if ((x[,1])<L) {penalty=(x[,1])-L}
  else {penalty=0}
  penalty
}

#Strafffunktion zur Einhaltung der Obergrenze des Bedarfes
penaltyUpper <- function(x){
  if ((x[,1])>U) {penalty=(x[,1])-U}
  else {penalty=0}
  penalty
}

#Straffunktion zur Einhaltung des Verhältnisses
penaltyRelation <- function(x){
  if (x[,1]!=K*N) {result=0}
  else {result=as.integer(x)}
  result
}

#Strafffunktion zur Einhaltung des Verhältnisses zwischen Liefermenge und Lieferrückstand
PenaltyProportion <- function(x){
  if (x[,2]>x[,1]) {penalty=(x[,2])=x[,1]}
  else {penalty=0}
  penalty
}

fitness <- function(x){
  temp= matrix(mapply(negativ,x), length(D))
  -VMIcost(temp)+penaltyOrder(temp)+penaltySpace(temp)+PenaltyProportion(temp)+penaltyUpper(temp)+penaltyLower(temp)+penaltyRelation(temp)
}

#Minimal- Maximalwerte
lower= as.matrix(IFRC[1:10,10:11])
upper= as.matrix(IFRC[1:10,12:13])


#PSO Algorithmus
Pso <- psoptim(par=NA, fn=fitness, gr=NULL, lower=lower, upper=upper)
Error during wrapup: subscript out of bounds
Pso <- psoptim(par=NA, fn=VMIcost, gr=NULL, lower=lower, upper=upper)
Error during wrapup: incorrect number of dimensions
Pso <- psoptim(par=10, fn=VMIcost, gr=NULL, lower=lower, upper=upper)
Error during wrapup: incorrect number of dimensions
Pso <- psoptim(par=NA, fn=VMIcost, gr=NULL, lower=0, upper=14000)
Error during wrapup: incorrect number of dimensions

#2

Hi @johannas,

I'm going to move this into #general, since AFAICT, it's not directly related to the IDE (you can change it back, if I'm wrong, but, if not, this will help ensure you get the right eyeballs on your question!)

I also think it will be :+1: if you can turn this into a self-contained reprex (short for minimal reproducible example). It improves legibility, and will help us help you if we can be sure we're all working with/looking at the same stuff.

Right now the best way to install reprex is:

# install.packages("devtools")
devtools::install_github("tidyverse/reprex")

If you've never heard of a reprex before, you might want to start by reading the tidyverse.org help page. The reprex dos and don'ts are also useful.

If you run into problems with access to your clipboard, you can specify an outfile for the reprex, and then copy and paste the contents into the forum.

reprex::reprex(input = "fruits_stringdist.R", outfile = "fruits_stringdist.md")

For pointers specific to the community site, check out the reprex FAQ, linked to below.