Trzy algorytmy ewolucyjne w RStudio

Question

Mam do zrobienia 3 proste projekty w RStudio. Temat dotyczy algorytmów ewolucyjnych. Wykładowca pokazał nam 3 przykładowe zastosowania jak to powinno wyglądać. Do implementacji mam real-valued, binary i permutation. Przedstawione przykłady wyglądają na proste jednak jak chciałem wykonać jeden z nich program zasypywał mnie błędami. Domyślam się, że zrobiłem coś źle jednak nie wiedziałem do końca co. Pomysł na zastosowanie "binary" jaki wpadł mi do głowy to "problem samochodu dostawczego i jego ładowności". Jakie produkty ma zapakować pracownik sklepu do samochodu dostawczego by wykorzystać jego maksymalną ładowność ale żeby ich wartość była jak najwieksza. Mam na myśli sklep z artykułami RTV AGD.

Comments

1) Napisz, z czym konkretnie masz problem: z programowaniem (zrozumienie koncepcji, a może jakiś konkretny błąd - pokaż kod, pokaż komunikat błędu), czy merytoryczny z problemem (problemami)?

Piszesz o wszystkim, ale brak w tym konkretów.

2) Odnośnie problemu optymalizacji, który opisujesz - jest to tzw. problem plecakowy (ang. knapsack problem).

Zagadnienie dość znane, więc powinno być sporo materiałów na ten temat w sieci. Poza specyficznymi przypadkami AE (właściwie to genetyczne) dobrze sobie z tym radzą, więc nie powinno być problemów z wynikami.

---

1) Koncepcja jest w miarę zrozumiała, ponieważ wzoruję się na dostępnych przykładach. błędy, które mi się pojawiają to "Błąd w poleceniu 'chr %*% dostawczakDb$cena':niezgodne argumenty" lub, że nie zdefiniowano jakiejś zmiennej.

2)Owszem jest to problem plecakowy, na nim się wzorowałem i chciałem zrobić coś podobnego podmieniając jedynie dane. 

#Pojazd ma ograniczona ladownosc do 150 kg
#Jakie produkty powinien zapakowac pracownik sklepu aby mialy najwieksza wartosc

#Instalacja i wlaczenie wymaganych pakietow
#install.packages("GA")
library(GA)

#Definiowanie zioru danych i limitu pojazdu
dostawczakDb = data.frame(
	produkt = c("TV", "komputer","monitor", "lodówka", "zmywarka", "pralka", 
                  "okap", "suszarka", "kuchenka", "mikrofala"),
	cena = c(4000, 5000, 1000, 3000, 800, 1400, 450, 200, 750, 230),
	waga = c(50, 20, 10, 60, 45, 40, 18, 1, 35, 12)
)
dostawczakLimit = 150
#dostawczakDb

#Definiowanie funkcji przystosowania
fitnessFunc=function(chr) {
	calacenaChr=chr%*%dostawczakDb$cena
	calawagaChr=chr%*%dostawczakDb$waga
	if(calawagaChr>dostawczakLimit)return(-calacenaChr)
	else return(calacenaChr)
}

#Uruchomienie algorytmu genetycznego
wyniki=ga(type="binary",nBits=11,fitness=fitnessFunc,popSize=100,
           pcrossover=0.85,pmutation=0.05,elitism=5,maxiter=30,seed=10)

#Wyniki dzialania algorytmu genetycznego
summary(wyniki)
plot(wyniki)

Na koniec chciałbym dodać, że moja wersja programu RStudio nie jest najnowszą wersją tylko jedną z poprzednich którą wykładowca kazał nam zainstalować

---

Widzę, że nikt nie odpowiedział, więc dopiszę kolejny komentarz.

Dla mnie wciąż nie jest jasne, z czym masz problem. Chodzi to ten błąd w poleceniu? (Wtedy jest to sprawa dla kogoś, kto zna R; ja nie znam.)

Nie używam R, natomiast można powiedzieć że "zęby zjadłem" na algorytmach genetycznych i ewolucyjnych (choć profesorem nie jestem). Rzuciłem okiem na Twój kod i widzę, że masz 10 przedmiotów, natomiast nBits masz ustawione na 11. Jeśli te nBits to długość genotypu (liczba genów, w tym przypadku - zer i jedynek), to o 1 za dużo. Powinien być jeden gen na przedmiot. (Ale ta uwaga ma sens tylko wówczas, gdy nBits jest długością/rozmiarem genotypu.)

Kolejna sprawa odnośnie funkcji przystosowania oraz frameworka do GA w R: jak rozumiem, algorytm maksymalizuje funkcję przystosowania? Wnioskuję stąd, że zwracasz wyliczoną cenę gdy waga nie jest przekroczona, albo ujemną cenę, gdy jest. Przy maksymalizacji dostaniesz rozwiązanie, o które chodzi.

Poza tym z parametrów widzę, że nie powinno być problemów z uzyskaniem rozwiązania. Można co najwyżej nieco podnieść liczbę pokoleń (domyślam się, że to maxiter?) - tak do 50, albo do 100. W gruncie rzeczy lepiej byłoby zastosować nieco inne kryterium stopu: jeśli brak poprawy od pewnej liczby pokoleń (od 20? od 50?), to przerywamy obliczenia.

---

Postaram się dziś tak zrobić i dam znać co mi wyszło

---

@edutomek, Udało się pokazać wykres, błąd był w "nBits" Dzięki bardzo

Także zostały mi jeszcze do zrobienia "real-valued' i "permutation"

---

Zakładam że chodzi o kodowanie?

Dla permutation może być dowolny problem z doborem kolejności elementów (szeregowanie zadań, problem komiwojażera itp.). Komiwojażer to dość klasyczny przypadek, materiałów na ten temat będzie pełno. Gdybyś chciał coś bardziej oryginalnego (dla studentów, bo nie dla badaczy), może być coś z szeregowania zadań (np. taki system przepływowy dla większej liczby maszyn; uwielbiałem pokazywać studentom, że algorytm Johnsona działa świetnie dla dwóch maszyn, a ewolucyjny też sobie z tym radzi, a dla większej liczby maszyn często daje lepsze wyniki).

To "real-valued" kojarzy mi się z poszukiwaniem wektora liczb rzeczywistych. Zresztą pewnie macierz też mogłaby być. Czyli można znowu klasycznie: choćby jakikolwiek wielomian (przynajmniej dwóch zmiennych) - bo wtedy wiadomo, jakie jest rozwiązanie i widać, czy algorytm działa.

---

Z "real-valued" poradziłem sobie sprawnie. Trudniej jest z implemetacją list. Nie wszystko wychodzi tak jak powinno. Domyślam się, że jest problem w kodzie. Moim pomysłem było skorzystanie z pakietu GA i użycie datasets WorldPhones. Nie wiem gdzie jest błąd ale wykres, summary i dekoduj(GA@solution[1,]) nie wyszło poprawnie. 

data("WorldPhones", package="datasets")
macierzilosci<-as.matrix(WorldPhones)
View(macierzilosci)

f.przystosowania <- function(miasta) {
   miasta  <- c(miasta, miasta[1])    
   telefony  <- embed(miasta, 2)               
   return (1/sum(macierzilosci[telefony]))    
                                                 
 }

GA <- ga(type = "permutation", fitness = f.przystosowania,
          lower = 1, upper = 7, popSize = 10, maxiter = 1000,
          run = 200, pmutation = 0.1)

summary(GA)
plot(GA)

dekoduj=function(miasta)
{
  miasta <- c(miasta, miasta[1])    
  telefony <- embed(miasta, 2)  
uzycie <- sum(macierzilosci[miasta])               
  cat( paste("Liczba lat badan:", attr(WorldPhones, "Size"),"\n") )
  cat(paste("Miasta:","\n"))
  etykiety<-colnames(macierzilosci)
  for(index in miasta) {
    cat(paste("->", etykiety[index]),"\n")
  }
}


rysuj=function(miasta)
{
  mds <- cmdscale(WorldPhones)
  x <- -mds[, 1]
  y <- -mds[, 2]
  plot(x, y, type = "n", asp = 1, xlab = "", ylab = "")
  abline(h = pretty(range(x), 10), v = pretty(range(y), 10),
         col = "red")
  miasta <- c(miasta, miasta[1])
  n <- length(miasta)
  arrows(x[miasta[-n]], y[miasta[-n]], x[miasta[-1]], y[miasta[-1]],
         length = 0.15, angle = 25, col = "green", lwd = 2)
  text(x, y, labels(WorldPhones), cex=0.8)
}