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
if you can turn this into a self-contained