W dniu 2012-09-25 14:15, M.M. pisze:
> W dniu wtorek, 25 września 2012 13:30:44 UTC+2 użytkownik bartekltg napisał:
>> Ten zapis jest bez sensu.
>> Rozumiem, że chodzi o max_{zi} (min(f1,f2,f3))
>
> Trzeba zmaksymalizowac funkcje ff zmieniajac wartosci x.
> http://pastebin.com/papzUzaL
> Wartosci w p[j] sa losowe z przedzialu od 1 do P. Wartosci w z[i][j]
> sa rowne albo zero, albo jeden, albo p[j]. Suma wartosci x[i]
> msui byc rowna 1, ponadto kazdy x[i] >= 0.
>

Po przeczytaniu, co napisali przedpiścy, spróbowałem napisać
proste rozwiązanie iteracyjne (w Common Lispie).

W założeniu zaczynam z wektorem x na wierzchołku hiperkostki
jednostkowej i poruszam się w jej wnętrzu po płaszczyźnie
wyznaczonej przez jej narożniki ruchami w kierunku tego wierzchołka
kostki, który daje aktualnie największy gradient funkcji celu.
Kiedy nie ma już możliwości ruchu zmniejszam krok o połowę
(a la szukanie binarne). To chyba powinno działać? - możecie
zweryfikować czy się gdzieś nie machnąłem?

Znaczące są funkcje ,,move" i ,,maxff" reszta jest analogiczna jak
w zadaniu w C++.

Szybkościowo mieści się w założonym 0,03 s nawet w nieoptymalizowanym
lispie chociaż robi dużo nadmiarowych obliczeń :) - pytanie tylko czy
jest poprawne?



(defconstant +N+ 3)
(defconstant +M+ 8)

;;;; pomocnicze działania na wektorach

(defun add (va vb) ; suma
(let ((vr (make-array +M+ :element-type 'float)))
(dotimes (i +M+)
(setf (aref vr i) (+ (aref va i) (aref vb i))))
vr))

(defun sub (va vb) ; różnica
(let ((vr (make-array +M+ :element-type 'float)))
(dotimes (i +M+)
(setf (aref vr i) (- (aref va i) (aref vb i))))
vr))

(defun smul (va s) ; mnożenie ze skalarem
(let ((vr (make-array +M+ :element-type 'float)))
(dotimes (i +M+)
(setf (aref vr i) (* (aref va i) s)))
vr))

(defun check-in-1-box (vx) ; sprawdzenie czy wektor mieści się kostce
(every (lambda (x) (and (<= x 1.0)
(>= x 0)))
vx))

;;;; inicjalizacje parametrów zadania

(defun frand ()
(random 1.0))


(defun initP ()
"Utwóż wektor losowych p takich, że p >=1 i p <= 5"
(let ((p (make-array +M+ :element-type 'float)))
(dotimes (i +M+)
(setf (aref p i) (+ 1.0 (* (frand) 5.0))))
p))

(defun initZ (vp)
"Utwóż losową tablicę współczynników dla funkcji f na podstawie vp"
(let ((mz (make-array +N+)))
(dotimes (i +N+)
(let ((mzi (make-array +M+ :element-type 'float)))
(dotimes (j +M+)
(setf (aref mzi j) (ecase (random 3)
(0 0)
(1 1)
(2 (aref vp j)))))
(setf (aref mz i) mzi)))
mz))

(defun initX (&optional (vx nil))
"Utwórz wektor losowych x takich, że x >= 0 i sum(x) = 1"
(when (null vx)
(setf vx (make-array +M+ :element-type 'float)))
(dotimes (i +M+)
(setf (aref vx i) (random 1.0)))
(let ((sum (reduce #'+ vx)))
(dotimes (i +M+)
(setf (aref vx i) (/ (aref vx i) sum))))
vx)


(defun initDir ()
"Utwórz zbiór narożników hiperkostki"
(let ((dir (make-array +M+)))
(dotimes (i +M+)
(let ((vdir (make-array +M+ :element-type 'float :initial-element
0.0)))
(setf (aref vdir i) 1.0)
(setf (aref dir i) vdir)))
dir))


(defun asert (vx)
"Sprawdz czy vx spełnia warunki x >= 0 i sum(x) = 1"
(when (some (lambda (x) (< x 0))
vx)
(error "x mniejsze od zera"))
(when (> (abs (- 1.0 (reduce #'+ vx)))
0.00001)
(error "błąd sumy x większy od 0.00001"))
t)

;;;; zadanie

(defun f (z x &aux (sum 0.0))
(dotimes (i +M+)
(setf sum (+ sum
(* (aref z i) (aref x i)))))
sum)


(defun ff (mz x)
(asert x)
(let ((min nil))
(dotimes (i +N+)
(let ((tmp (f (aref mz i) x)))
(when (or (null min)
(> min tmp))
(setf min tmp))))
min))

;;;; rozwiązanie

(defun move (mz vx step dir)
(let ((max (ff mz vx))
(max-vx vx))
(dolist (s (list step (- step))) ; sprawdz ruchy w obu kierunkach
(dotimes (i +M+) ; po wszystkich osiach układu
współrzędnych
(let ((v (add vx (smul (sub (aref dir i) vx) s)))) ; idziemy po linii
vx - dir o współczynnik s
(when (check-in-1-box v)
(let ((p-max (ff mz v)))
(when (> p-max max) ; zapisz najlepszy znaleziony ruch
(setf max p-max
max-vx v)))))))
(values max-vx max)))

(defun maxff (mz)
(let* ((vx (let ((v (make-array +M+ :element-type 'float
:initial-element 0.0)))
(setf (aref v 0) 1.0)
v)) ; początkowy x i aktualizowny na bieżąco najlepszy
(max 0.0) ; początkowe maksimum i aktualizowne na bieżąco najlepsze
(dir (initDir)) ; tablica wierzchołków kostki (wektory typu [1 0 0 ... 0])
(step 0.5) ; aktualny krok modyfikacji
(epsilon 0.00001)) ; żądana dokładność maksimum
(do () ((< step epsilon) ())
(multiple-value-bind (p-vx p-max) (move mz vx step dir)
(if (> (- p-max max) epsilon)
(setf max p-max
vx p-vx)
(setf step (/ step 2.0)))))
(values vx max)))



; // TODO: zmaksymalizować funkcję ff( z , x ) zmiejąc x (nie zmieniając z)

Można tego użyć np tak: (maxff (initZ (initP)))