##############################################################################
#
# Uporaba genetskih algoritmov
#
##############################################################################

# inicializiramo generator nakljucnih stevil
# (prakticno, ce zelimo ponovljive rezultate)
set.seed(0)



##############################################################################
#
# PRIMER 1
#
# Resevanje 0-1 nahrbtnika
#
# Podana je mnozica predmetov, ki so opisani z vrednostjo in velikostjo.
# Na voljo imamo nahrbtnik dolocene kapacitete. Naloga je izbrati
# podmnozico predmetov z najvecjo mozno skupno vrednostjo tako, da
# jih je mozno vstaviti v nahrbtnik (skupna velikost predmetov mora biti
# manjsa ali enaka kapaciteti nahrbtnika).
#
##############################################################################

#
# Vhodne podatke bomo nakljucno generirali
#

# stevilo predmetov
stPredmetov <- 10

# za nakljucno generiranje vrednosti predmetov uporabimo funkcijo
# runif (generator enakomerno porazdeljenih stevil)
# za pomoc in dokumentacijo vpisite ?runif
 
vrednost <- runif(stPredmetov, min = 1, max = 100)

# nakljucno generiramo tudi velikosti predmetov
velikost <- runif(stPredmetov, 1, 10)

# podatke organiziramo v podatkovni okvir
predmeti <- data.frame(vrednost, velikost)

# nakljucno izberemo tudi kapaciteto nahrbtnika
kapaciteta <- runif(1, min = 10, max = sum(velikost)*0.3)



# izpis podatkov
predmeti
kapaciteta

#
# Najprej bomo poiskali resitev z izcrpnim iskanjem
# (preverili bomo vse mozne kombinacije predmetov in 
# izbrali najbolj ustrezno) 
#

# posamezno izbiro bomo predstavili v obliki binarnega vektorja
# - vektor ima toliko elementov, kolikor je vseh predmetov
# - vrednost i-te komponente vektorja ustreza i-temu predmetu:
#     0 - predmeta nismo izbrali
#     1 - predmet je izbran

# na primer, ce je vseh predmetov 10 in izberemo prvi, drugi in osmi predmet
# izbiro zakodiramo kot:

izbira <- c(1,1,0,0,0,0,0,1,0,0)

# NALOGA:
# IMPLEMENTIRAJ FUNKCIJO ZA OCENO USTREZNOSTI IZBIRE
#

# Funkcija, ki izracuna ustreznost izbire
# - ustreznost je vsota vrednosti izbranih predmetov
# - izbira je ustrezna, ce vsota velikosti izbranih predmetov ne presega kapcitete nahrbtnika
#
ustreznostIzbire <- function(izbira, predmeti, kapaciteta)
{
	# vrednost izbranih predmetov
	v <- sum(predmeti$vrednost[izbira==1])
	
	# do istega rezultata lahko pridemo tudi na naslednji nacin:
	# v <- sum(predmeti$vrednost * izbira)

	# skupna velikost izbranih predmetov
	w <- sum(predmeti$velikost[izbira==1])

	# izbira je popolnoma neustrezna, ce presega kapaciteto nahrbtnika 
	if (w > kapaciteta)
		v <- 0
	v
}

# izracunajmo ustreznost nase izbire
ustreznostIzbire(izbira, predmeti, kapaciteta)

# NALOGA:
# IMPLEMENTIRAJ FUNKCIJO ZA GENERIRANJE NASLEDNJE IZBIRE
#

# Funkcija, ki generira naslednjo kombinacijo izbranih predmetov 
# - izbiro obravnavamo kot binarno zaporedje
# - naslednjo izbiro dobimo tako, da binarnemu zaporedju pristejemo 1
#
naslednjaIzbira <- function(izbira)
{
	for (i in 1:length(izbira))	
	{
		if (izbira[i] == 0)
		{
			izbira[i] <- 1
			break
		}
		else
			izbira[i] <- 0
	}

	izbira
}

# preverimo naso funkcijo
naslednjaIzbira(c(0,0,0,0,0,0,0,0,0,0))
naslednjaIzbira(c(1,0,0,0,0,0,0,0,0,0))
naslednjaIzbira(c(0,1,0,0,0,0,0,0,0,0))
naslednjaIzbira(c(1,1,0,0,0,0,0,0,0,0))
naslednjaIzbira(c(1,1,1,1,1,1,1,1,1,1))

# 
# FUNKCIJA ZA IZCRPNO ISKANJE NAJBOLJ USTREZNE IZBIRE
#

# Funkcija, ki izcrpno preisce vse mozne izbire predmetov in izpise tisto najbolj ustrezno
# (izbiro, ki ima najvisjo vrednost izbranih predmetov, pri cemer skupna velikost le-teh ne presega 
#  kapacitete nahrbtnika)
#
izcrpnoIskanje <- function(predmeti, kapaciteta)
{
	izbira <- rep(0,nrow(predmeti))
	maxIzbira <- izbira
	maxV <- 0

	repeat
	{
		izbira <- naslednjaIzbira(izbira)
		if(sum(izbira)==0)
			break

		v <- ustreznostIzbire(izbira, predmeti, kapaciteta)
		if (v > maxV)
		{
			maxV <- v
			maxIzbira <- izbira
		}
	}
	
	maxIzbira
}

# poiscimo najboljso izbiro za nase predmete
izbira <- izcrpnoIskanje(predmeti, kapaciteta)
izbira
ustreznostIzbire(izbira, predmeti, kapaciteta)


#
# PROBLEM NASTANE, KO JE STEVILO PREDMETOV PREVELIKO ZA SISTEMATICNO ISKANJE
# NAJBOLJ USTREZNE IZBIRE
#

#
# NALOGO BOMO RESILI Z UPORABO GENETSKEGA ALGORITMA
# DOBLJENA RESITEV BO SUBOPTIMALNA, TODA JO BOMO VSAJ DOBILI V DOGLEDNEM CASU
#

#
# Za izvedbo genetskega algoritma potrebujemo:
# - nacin predstavitve osebkov
# - funkcijo uspesnosti za ocenjevanje osebkov
# - izvedbo krizanja
# - izvedbo mutacije
#

# NALOGA:
# IMPLEMENTIRAJ FUNKCIJO ZA GENERIRANJE ZACETNE POPULACIJE
#

# Funkcija, ki ustvari nakljucno populacijo
# - stOsebkov doloca stevilo osebkov v populaciji
# - posamezen osebek predstavlja nakljucno izbiro predmetov (binarno zaporedje dolzine stPredmetov)
#
pripraviZacetnoPopulacijo <- function(stPredmetov, stOsebkov)
{
	# populacijo bomo hranili v obliki matrike
	# osebek predstavlja vrstico matrike
	# matrika ima toliko stolpcev, kolikor je vseh predmetov

	populacija <- matrix(nrow=stOsebkov, ncol=stPredmetov)
	
	for (i in 1:stOsebkov)
	{
		# za generiranje nakljucne vsebine osebka uporabimo funkcijo sample
		# ki izbira stPredmetov vrednosti iz zaloge {0,1} z vracanjem.
		# generirani osebek shranimo kot i-to vrstico v matriki
		
		populacija[i,] <- sample(x=c(0,1), prob=c(0.8,0.2), size=stPredmetov, replace = T)
	}

	populacija
}

# preverimo naso funkcijo
populacija <- pripraviZacetnoPopulacijo(10, 5)
populacija


# NALOGA:
# IMPLEMENTIRAJ FUNKCIJO ZA IZVEDBO MUTACIJE OSEBKA 
#

#
# Funkcija, ki izvede nakljucno mutacijo genetskega zapisa osebka
# - pMutacije doloca verjetnost, da se mutacija izvede na posameznem bitu
#
mutacija <- function(osebek, pMutacije)
{
	# generiramo vektor nakljucnih vrednosti na intervalu [0,1] 
	v <- runif(length(osebek), min=0, max=1)
	
	# invertiramo vrednost tistih genov osebka, ki ustrezajo 
	# nakljucni vrednosti nizji od parametra pMutacije
 
	# namesto obicajne uporabe for zanke za sprehajanje po elementih vektorja
	#       for (i in 1:length(osebek))
	#         if (v[i] < pMutacije)
	#           osebek[i] <- 1 - osebek[i]
	#
	# uporabimo indeksiranje z logicnim vektorjem
	osebek[v < pMutacije] <- 1 - osebek[v < pMutacije]
	
	osebek
}

# preverimo naso funkcijo
mutacija(c(0,0,0,0), 0.5) # 50% moznosti za mutacijo
mutacija(c(0,0,0,0), 0.5)
mutacija(c(0,0,0,0), 0.0) # nobenega ne sme zamenjati
mutacija(c(0,0,0,0), 1.0) # vse bo zamenjal

# NALOGA:
# IMPLEMENTIRAJ FUNKCIJO ZA IZVEDBO KRIZANJA OSEBKOV 
#

#
# Funkcija, ki izvede krizanje dveh osebkov
# - krizanje izvedemo tako, da nakljucno razdelimo genetski zapis osebkov na dva dela
# - potomca dobimo tako, da kombiniramo razlicne dele starsev
# - rezultat funkcije je matrika, ki vsebuje genetski zapis obeh potomcev
#
krizanje <- function(osebek1, osebek2)
{
	# potomca shranimo v obliki matrike z dvema vrsticama
      
	n <- length(osebek1)

	potomca <- matrix(nrow=2,ncol=n)

	#nakljucno izberemo mesto krizanja
	i <- sample(1:(n-1), 1)

	#ustvarimo potomca s kombiniranjem genetskega zapisa starsev
	potomca[1,] <- c(osebek1[1:i],osebek2[(i+1):n])
	potomca[2,] <- c(osebek2[1:i],osebek1[(i+1):n])

	potomca
}

#preverimo naso funkcijo
krizanje(c(0,0,0,0,0,0,0,0),c(1,1,1,1,1,1,1,1))

# NALOGA:
# IMPLEMENTIRAJ FUNKCIJO ZA IZVEDBO TURNIRSKE IZBIRE 
#

#
# Funkcija, ki izvede enoturnirsko izbiro med izbranimi osebki
# - krizanje se izvede nad najboljse ocenjenima osebkoma
# - dobljena potomca zamenjata najslabse ocenjena osebka
#
turnir <- function(osebki, predmeti, kapaciteta)
{
	# funkcija predvideva vsaj dva osebka!
	
	# namesto spodnje zanke "for", raje uporabimo funkcijo "apply"
	#
	# 	v <- vector()
	# 	for (i in 1:nrow(osebki))
	#		v[i] <- ustreznostIzbire(osebki[i,], predmeti, kapaciteta)
	
	v <- apply(osebki, 1, ustreznostIzbire, predmeti, kapaciteta)
	ord <- order(v, decreasing = T)

	potomca <- krizanje(osebki[ord[1],],osebki[ord[2],])
	osebki[ord[length(ord)],] <- potomca[1,]
	osebki[ord[length(ord)-1],] <- potomca[2,]

	osebki
}

# preverimo naso funkcijo
populacija <- pripraviZacetnoPopulacijo(10, 5)
populacija

apply(populacija, 1, ustreznostIzbire, predmeti, kapaciteta)

populacija <- turnir(populacija, predmeti, kapaciteta)
populacija
apply(populacija, 1, ustreznostIzbire, predmeti, kapaciteta)



# NALOGA:
# IMPLEMENTIRAJ FUNKCIJO ZA IZVEDBO NADOMESCANJA OSEBKOV 
#

#
# Funkcija, ki izvede nadomescanje ene generacije osebkov z drugo
# - osebke nakljucno razdelimo na skupine, ki vsebuje velSkupine osebkov
# - za vsako skupino izvedemo turnir, ki kriza najboljsa osebka v skupini in nadomesti najslabsa
#
nadomescanje <- function(osebki, predmeti, kapaciteta, velSkupine)
{
	stOsebkov <- nrow(osebki)

	v <- sample(1:stOsebkov, stOsebkov, replace = F)
	
	od <- 1
	do <- velSkupine

	while(od < stOsebkov)
	{
		osebki[v[od:do],] <- turnir(osebki[v[od:do],], predmeti, kapaciteta)
		od <- do + 1
		do <- do + velSkupine
		if (do > stOsebkov)
			do <- stOsebkov
	}

	osebki
}

# preverimo naso funkcijo
populacija <- pripraviZacetnoPopulacijo(10, 50)
apply(populacija, 1, ustreznostIzbire, predmeti, kapaciteta)

populacija <- nadomescanje(populacija, predmeti, kapaciteta, 5)
apply(populacija, 1, ustreznostIzbire, predmeti, kapaciteta)

populacija <- nadomescanje(populacija, predmeti, kapaciteta, 5)
apply(populacija, 1, ustreznostIzbire, predmeti, kapaciteta)


# SEDAJ LAHKO SESTAVIMO GENETSKI ALGORITEM ZA RESEVANJE 0-1 NAHRBTNIKA
#

# Funkcija, ki izvede genetsko iskanje najustreznejse izbire predmetov
#
genIskanje <- function(predmeti, kapaciteta, velPopulacije=100, stGeneracij=150, velSkupine=5, pMutacije=0.01)
{
	populacija <- pripraviZacetnoPopulacijo(nrow(predmeti), velPopulacije)
	for (i in 1:stGeneracij)
	{
		cat(paste("generacija", i, "\n"))
		flush.console()

		populacija <- t(apply(populacija,1,mutacija,pMutacije))
		populacija <- nadomescanje(populacija, predmeti, kapaciteta, velSkupine)
	}

	v <- apply(populacija, 1, ustreznostIzbire, predmeti, kapaciteta)
	populacija[which.max(v),]
}

izbira <- genIskanje(predmeti, kapaciteta, 100, 50)
izbira
ustreznostIzbire(izbira, predmeti, kapaciteta)


# UPORABIMO GENETSKI ALGORITEM ZA RESEVANJE VECJEGA PROBLEMA
set.seed(0)
stPredmetov <- 100 
vrednost <- runif(stPredmetov, min = 1, max = 100)
velikost <- runif(stPredmetov, 1, 10)
predmeti <- data.frame(vrednost, velikost)
predmeti

kapaciteta <- runif(min = sum(velikost)*0.1, max = sum(velikost)*0.3, n = 1)
kapaciteta


# izracunajmo suboptimalno resitev nasega problema
izbira <- genIskanje(predmeti, kapaciteta, 1000, 150)
izbira
ustreznostIzbire(izbira, predmeti, kapaciteta)




##############################################################################
#
# PRIMER 2
#
# Obhod trgovskega potnika
#
# Podan je seznam mest in razdalj med njimi (za vsak par mesto - mesto). 
# Kaksna je najkrajsa pot, ki obisce vsa mesta v seznamu natanko enkrat in se 
# zakljuci v izhodiscnem mestu?
#
##############################################################################

# nalozimo vhodne podatke
data(UScitiesD)
UScitiesD

razdalje <- as.matrix(UScitiesD)
razdalje
stMest <- nrow(razdalje)
stMest


# Mesta ostevilcimo (dolocimo jim identifikacijske stevilke). 
# Posamezen obhod predstavlja permutacijo identifikacijskih stevilk mest.

obhod <-  sample(1:stMest, stMest, replace=F)
obhod

# NALOGA:
# IMPLEMENTIRAJ FUNKCIJO ZA IZRACUN DOLZINE OBHODA
# 

# Funkcija za izracun dolzine obhoda
# - obhod je permutacija identifikacijskih oznak mest
# - razdalja je kvadratna matrika razdalj med pari mest
dolzinaObhoda <- function(obhod, razdalje) 
{
	n <- length(obhod)

	dist <- 0
	for (i in 2:n) 
		dist <- dist + razdalje[obhod[i-1], obhod[i]]
	
	dist <- dist + razdalje[obhod[n], obhod[1]]
	dist
}

# preverimo naso funkcijo
dolzinaObhoda(obhod, razdalje)


# NALOGA:
# IMPLEMENTIRAJ FUNKCIJO ZA GENERIRANJE ZACETNE POPULACIJE OBHODOV
#

# Funkcija, ki ustvari nakljucno populacijo
# - stMest doloca dolzino permutacije
# - stOsebkov doloca stevilo osebkov v populaciji
# - posamezen osebek predstavlja nakljucen obhod
#
pripraviZacetnoPopulacijo <- function(stMest, stOsebkov)
{
	populacija <- matrix(nrow=stOsebkov,ncol=stMest)
	
	for (i in 1:stOsebkov)
	{
		populacija[i,] <- sample(1:stMest, size=stMest, replace=F)
	}

	populacija
}

# preverimo naso funkcijo
pripraviZacetnoPopulacijo(stMest, 5)


# NALOGA:
# IMPLEMENTIRAJ FUNKCIJO ZA IZVEDBO NAKLJUCNE MUTACIJE OBHODA
#

#
# Funkcija, ki izvede nakljucno mutacijo genetskega zapisa osebka
# - pMutacije doloca verjetnost, da se mutacija izvede na posameznem bitu
#
mutacija <- function(obhod, pMutacije)
{
	n <- length(obhod)
	if(runif(1, min=0, max=1) < pMutacije)
	{
		pos <- sample(1:n, 2, replace=F)
		
		# namesto obracanja pozicij eno po eno:
		#
		# tmp <- obhod[pos[1]]
		# obhod[pos[1]] <- obhod[pos[2]]
		# obhod[pos[2]] <- tmp
		#
		# lahko naredimo hitreje z enim samim ukazom:
		#
		obhod[pos[c(2,1)]] <- obhod[pos]
	}
	
	obhod
}

obhod
mutacija(obhod, 0.8)
mutacija(obhod, 0.0)
mutacija(obhod, 1.0)


# NALOGA:
# IMPLEMENTIRAJ FUNKCIJO ZA IZVEDBO KRIZANJA DVEH OBHODOV
#

#
# Funkcija, ki izvede krizanje dveh osebkov
# - implementirano je urejeno krizanje
# - potomca dobimo tako, da ohranimo cele sekvence v zapisu starsev
# - rezultat funkcije je matrika, ki vsebuje genetski zapis obeh potomcev
#
krizanje <- function(osebek1, osebek2)
{
	# potomca shranimo v obliki matrike z dvema vrsticama
      
	n <- length(osebek1)

	potomca <- matrix(nrow=2,ncol=n)

	#nakljucno izberemo dva indeksa med obhodom
	s <- sample(2:(n-1), 2)
	i <- min(s)
	j <- max(s)

	# pozicije, ki jih zelimo ohraniti
	ohrani <- i:j

	# pozicije, ki jih zelimo zamenjati
	zamenjaj <- c(1:(i-1),(j+1):n)

	# rotirana permutacija od drugega reza naprej
	rotacija <- c((j+1):n, 1:j)

	# sestavimo prvega potomca	
	potomca[1, ohrani] <- osebek1[ohrani]
	kandidati <- osebek2[rotacija]
	sel <- !(kandidati %in% osebek1[ohrani])
	potomca[1, zamenjaj] <- kandidati[sel]

	# sestavimo drugega potomca
	potomca[2, ohrani] <- osebek2[ohrani]
	kandidati <- osebek1[rotacija]
	sel <- !(kandidati %in% osebek2[ohrani])
	potomca[2, zamenjaj] <- kandidati[sel]
	

	potomca
}

# preverimo naso funkcijo

krizanje(c(3,6,2,1,10,8,4,7,9,5), c(4,5,2,6,7,8,10,9,3,1))


# NALOGA:
# IMPLEMENTIRAJ FUNKCIJO ZA IZVEDBO IZBIRE OSEBKA 
#

#
# Funkcija izbere osebek za razmnozevanje, pri cemer je 
# verjetnost izbire proporcionalna uspesnosti osebka 
# - pIzbire je vektor z verjetnostmi izbire posameznega osebka
#
propIzbira <- function(pIzbire)
{
	# privzamemo, da je sum(pIzbire) = 1
	
	val <- runif(1, min=0, max=1)

	for (i in 1:length(pIzbire))
	{
		val <- val - pIzbire[i]
		if (val < 0)
			return(i)
	}

	length(pIzbire)
}


# NALOGA:
# IMPLEMENTIRAJ FUNKCIJO ZA GENERIRANJE NASLEDNJE GENERACIJE OSEBKOV
#

#
# Funkcija, ki izvede selekcijo, reprodukcijo in mutacijo osebkov
# - populacija vsebuje prejsnjo generacijo osebkov
# - razdalja je kvadratna matrika razdalj med mesti
# - pMutacije je verjetnost mutacije osebka
# - elitizem je stevilo najbolje ocenjenih osebkov, ki neposredno pridejo v naslednjo generacijo
#
pripraviNaslednjoGeneracijo <- function(populacija, razdalje, pMutacije, elitizem)
{
	naslGeneracija <- matrix(nrow=nrow(populacija),ncol=ncol(populacija))
	nOsebkov <- nrow(naslGeneracija)

	kvaliteta <- apply(populacija, 1, dolzinaObhoda, razdalje)
	kvaliteta <- 1/kvaliteta
	pIzbire <- kvaliteta/sum(kvaliteta)

	if (elitizem > 0)
	{
		elitizem <- min(elitizem, nOsebkov)
		sel <- order(pIzbire, decreasing=T)[1:elitizem]
		naslGeneracija[1:elitizem,] <- populacija[sel,]
	}
	
	i <- 1 + elitizem
	while (i <= nOsebkov)
	{
		stars1 <- propIzbira(pIzbire)
		stars2 <- propIzbira(pIzbire)

		potomca <- krizanje(populacija[stars1,], populacija[stars2,])

		naslGeneracija[i,] <- mutacija(potomca[1,], pMutacije)
		i <- i + 1

		if (i <= nOsebkov)
		{
			naslGeneracija[i,] <- mutacija(potomca[2,], pMutacije)
			i <- i + 1
		}
	}

	naslGeneracija	
}

# preverimo naso funkcijo
populacija <- pripraviZacetnoPopulacijo(stMest, 10)
populacija
apply(populacija, 1, dolzinaObhoda, razdalje)
novaPopulacija <- pripraviNaslednjoGeneracijo(populacija, razdalje, pMutacije=0.1, elitizem=3)
apply(novaPopulacija, 1, dolzinaObhoda, razdalje)


# SEDAJ LAHKO SESTAVIMO GENETSKI ALGORITEM ZA RESEVANJE OBHODA TRGOVSKEGA POTNIKA
#

# Funkcija, ki izvede genetsko iskanje najkrajsega obhoda trgovskega potnika
#
genIskanje <- function(razdalje, velPopulacije=100, stGeneracij=100, pMutacije=0.01, elitizem=2)
{
	populacija <- pripraviZacetnoPopulacijo(nrow(razdalje), velPopulacije)
	for (i in 1:stGeneracij)
	{
		cat(paste("generacija", i, "\n"))
		flush.console()

		populacija <- pripraviNaslednjoGeneracijo(populacija, razdalje, pMutacije, elitizem)
	}

	dolzine <- apply(populacija, 1, dolzinaObhoda, razdalje)
	populacija[which.min(dolzine),]
}

# izracunajmo suboptimalno resitev nasega problema
obhod <- genIskanje(razdalje, 100, 100, 0.01, 2)
obhod
dolzinaObhoda(obhod, razdalje)

# genetski algoritem je odvisen od nakljucja.
# ce ponovimo izracun, lahko dobimo drugacen rezultat
obhod <- genIskanje(razdalje, 100, 100, 0.01, 2)
obhod
dolzinaObhoda(obhod, razdalje)


##############################################################################
#
# PRIMER 3
#
# Ucenje linearnega modela 
#
# y = a0 + a1x1 + a2x2 + .... + anxn
#
# Zelimo minimizirati kvadratno napako med dejanskimi in modeliranimi vrednostmi
#
# Prevelikem prileganju ucnim podatkom se izognemo tako, da hkrati minimiziramo 
# vsoto |a0| + |a1| + .... + |an| 
#
##############################################################################


pm10 <- read.table("pm10.txt", sep=",", header=T)
summary(pm10)

pm10$Glob_radiation_min <- NULL
pm10$Date <- NULL

train <- pm10[1:317,]
test <- pm10[318:651,]

lmodel <- lm(PM10 ~ ., train)
lmodel

predicted <- predict(lmodel, test)
observed <- test$PM10

mean(abs(predicted-observed)) 





# VEKTORSKA PREDSTAVITEV OSEBKOV
# (osebek je predstavljen kot vektor realnih stevil)
#


# NALOGA:
# IMPLEMENTIRAJ FUNKCIJO ZA GENERIRANJE ZACETNE POPULACIJE LINEARNIH MODELOV
#

# Funkcija, ki ustvari nakljucno populacijo
# - steviloOsebkov doloca stevilo osebkov v populaciji 
# - dolzinaOsebkov doloca stevilo clenov v linearnem modelu
# - spMeje je vektor minimalnih vrednosti parametrov linearnega modela
# - zgMeje je vektor maksimalnih vrednosti parametrov linearnega modela
#
pripraviZacetnoPopulacijo <- function(steviloOsebkov, dolzinaOsebkov, spMeje, zgMeje)
{
	# populacijo bomo hranili v obliki matrike

	populacija <- matrix(nrow=steviloOsebkov,ncol=dolzinaOsebkov)
	
	for (i in 1:dolzinaOsebkov)
		populacija[,i] <- runif(steviloOsebkov, min=spMeje[i], max=zgMeje[i])

	populacija
}

# preverimo naso funkcijo
pripraviZacetnoPopulacijo(10, 3, c(1,5,10), c(2,10,20))

nAttrs <- ncol(train)-1
populacija <- pripraviZacetnoPopulacijo(10, dolzinaOsebkov=nAttrs+1, spMeje=rep(-5, times=nAttrs+1), zgMeje=rep(5, times=nAttrs+1))
populacija




# NALOGA:
# IMPLEMENTIRAJ FUNKCIJO ZA OCENO KVALITETE LINEARNEGA MODELA
#

# Funkcija izracuna vsoto kvadratne napake modela in utezene vsote vrednosti clenov modela
# - osebek je vektor clenov linearnega modela
# - x je ucna mnozica (vsebuje samo atribute, brez ciljne spremenljivke)
# - y je ciljna spremenljivka v ucnih primerih
# - lambda je utez
#
funkcijaNapake <- function(osebek, x, y, lambda)
{
	predicted <- osebek[1]
	for (i in 1:ncol(x))
		predicted <- predicted + osebek[i+1] * x[,i]

	
	sum((y-predicted)^2) + sum(abs(osebek))*lambda
}

# preverimo naso funkcijo
funkcijaNapake(populacija[1,],train[1:nAttrs],train[,nAttrs+1], 100)


# NALOGA:
# IMPLEMENTIRAJ FUNKCIJO ZA IZVEDBO NAKLJUCNE MUTACIJE PARAMETROV LINEARNEGA MODELA
#

#
# Funkcija, ki izvede nakljucno mutacijo genetskega zapisa osebka
# - pMutacije doloca verjetnost, da se mutacija izvede na osebku
# - spMeje je vektor minimalnih vrednosti parametrov modela
# - zgMeje je vektor maksimalnih vrednosti parametrov modela
#
mutacija <- function(osebek, pMutacije, spMeje, zgMeje)
{
	if(runif(1, min=0, max=1) < pMutacije)
	{
		i <- sample(1:length(osebek), 1)
		osebek[i] <- runif(1, min=spMeje[i], max=zgMeje[i])
	}

	osebek
}

mutacija(5.0, 0.8, 1.0, 8.0)
mutacija(c(5.0,2.3), 0.5, c(1,1),c(10,10))



# NALOGA:
# IMPLEMENTIRAJ FUNKCIJO ZA IZVEDBO KRIZANJA DVEH OSEBKOV V VEKTORSKI PREDSTAVITVI
#

#
# Funkcija, ki izvede krizanje dveh osebkov
# - potomec predstavlja povprecne vrednosti clenov starsev 
#
krizanjeAvg <- function(osebek1, osebek2)
{     
	# potomec <- vector()
	#
	# for (i in 1:length(osebek1))
	#	potomec[i] <- mean(c(osebek1[i], osebek2[i]))
	#
	# potomec
	

	# bolj jedrnato:
	mat <- rbind(osebek1, osebek2)
	colMeans(mat)
}

krizanjeAvg(5.0, 3.0)
krizanjeAvg(c(5.0,2.3), c(1.4,3.2))


#
# Funkcija, ki izvede krizanje dveh osebkov
# - potomca predstavljata linearno kombinacijo posameznih clenov starsev 
#
krizanjeLin <- function(osebek1, osebek2)
{
	# potomca shranimo v obliki matrike z dvema vrsticama
      
	n <- length(osebek1)
	potomca <- matrix(nrow=2,ncol=n)
	a <- runif(1, min=0, max=1)

	for (i in 1:n)
	{
		x <- osebek1[i]
		y <- osebek2[i]
	
		potomca[1,i] <- a*x + (1-a)*y
		potomca[2,i] <- (1-a)*x + a*y
	}

	potomca
}

krizanjeLin(5.0, 3.0)
krizanjeLin(c(5.0,2.3), c(1.4,3.2))

#
# Funkcija, ki izvede krizanje dveh osebkov
# - potomca sta lahko zunaj intervala vrednosti, ki ga dolocata starsa 
# - spMeje je vektor minimalnih vrednosti parametrov generiranih potomcev
# - zgMeje je vektor maksimalnih vrednosti parametrov generiranih potomcev
# - a je parameter postopka
#
krizanjeBLX <- function(osebek1, osebek2, spMeje, zgMeje, a=0.5)
{
	# potomca shranimo v obliki matrike z dvema vrsticama
      
	n <- length(osebek1)
	potomca <- matrix(nrow=2,ncol=n)

	for (i in 1:n)
	{
		x <- osebek1[i]
		y <- osebek2[i]
		d <- abs(x-y)
		lower <- spMeje[i]
		upper <- zgMeje[i]
		
		if (x < y)
		{
			min_val <- max(x-a*d, lower)
			max_val <- min(y+a*d, upper)

			# 
			# u <- runif(1, min=min_val, max=max_val)
			# potomca[1,i] <- u
			#
			# u <- runif(1, min=min_val, max=max_val)
			# potomca[2,i] <- u
			#

			potomca[,i] <- runif(2, min=min_val, max=max_val)
		}
		else
		{
			min_val <- max(y-a*d, lower)
			max_val <- min(x+a*d, upper)

			potomca[,i] <- runif(2, min=min_val, max=max_val)
		}
	}

	potomca
}
 
krizanjeBLX(5.0, 3.0, 2, 6)
krizanjeBLX(c(5.0,2.3), c(1.4,3.2), c(1,1), c(10,10))



# NALOGA:
# IMPLEMENTIRAJ FUNKCIJO ZA GENERIRANJE NASLEDNJE GENERACIJE OSEBKOV
#

#
# Funkcija, ki izvede selekcijo, reprodukcijo in mutacijo osebkov
# - populacija vsebuje prejsnjo generacijo osebkov
# - x je ucna mnozica (vsebuje samo atribute, brez ciljne spremenljivke)
# - y je ciljna spremenljivka v ucnih primerih
# - lambda je utez pri izracunu kvalitete osebkov
# - spMeje je vektor minimalnih vrednosti parametrov linearnega modela
# - zgMeje je vektor maksimalnih vrednosti parametrov linearnega modela
# - a je parameter krizanja
# - pMutacije je verjetnost mutacije osebka
# - elitizem je stevilo najbolje ocenjenih osebkov, ki neposredno pridejo v naslednjo generacijo
#
pripraviNaslednjoGeneracijo <- function(populacija, x, y, lambda, spMeje, zgMeje, a, pMutacije, elitizem)
{
	naslGeneracija <- matrix(nrow=nrow(populacija),ncol=ncol(populacija))
	nOsebkov <- nrow(naslGeneracija)

	kvaliteta <- apply(populacija, 1, funkcijaNapake, x, y, lambda)
	kvaliteta <- 1/kvaliteta
	pIzbire <- kvaliteta/sum(kvaliteta)

	if (elitizem > 0)
	{
		elitizem <- min(elitizem, nOsebkov)
		sel <- order(pIzbire, decreasing=T)[1:elitizem]
		naslGeneracija[1:elitizem,] <- populacija[sel,]
	}
	
	i <- 1 + elitizem
	while (i <= nOsebkov)
	{
		stars1 <- propIzbira(pIzbire)
		stars2 <- propIzbira(pIzbire)

		potomca <- krizanjeBLX(populacija[stars1,], populacija[stars2,], spMeje, zgMeje, a)

		naslGeneracija[i,] <- mutacija(potomca[1,], pMutacije, spMeje, zgMeje)
		i <- i + 1

		if (i <= nOsebkov)
		{
			naslGeneracija[i,] <- mutacija(potomca[2,], pMutacije, spMeje, zgMeje)
			i <- i + 1
		}
	}

	naslGeneracija	
}


# SEDAJ LAHKO SESTAVIMO GENETSKI ALGORITEM ZA DOLOCANJE PARAMETROV LINEARNEGA MODELA
#

# Funkcija, ki izvede genetsko iskanje parametrov linearnega modela
#

genIskanje <- function(x, y, spMeje, zgMeje, lambda = 0.1, a = 0.5, velPopulacije = 100, stGeneracij = 100, pMutacije = 0.01, elitizem = 2)
{
	populacija <- pripraviZacetnoPopulacijo(velPopulacije, ncol(x)+1, spMeje, zgMeje)
	for (i in 1:stGeneracij)
	{
		cat(paste("generacija", i, "\n"))
		flush.console()

		populacija <- pripraviNaslednjoGeneracijo(populacija, x, y, lambda, spMeje, zgMeje, a, pMutacije, elitizem)
	}

	napaka <- apply(populacija, 1, funkcijaNapake, x, y, lambda)
	populacija[which.min(napaka),]
}

# izracunajmo suboptimalno resitev nasega problema
parametri <- genIskanje(x=train[,1:22], y=train[,23], 
				spMeje=rep(-1, times=23), zgMeje=rep(1, times=23), 
				lambda=100, a=0.5, 
				velPopulacije=50, stGeneracij=1000, 0.01, 2)
parametri
funkcijaNapake(parametri,x=train[,1:22], y=train[,23],lambda=0.1)

# izracunajmo napako dobljenega modela na neodvisni testni mnozici

predicted <- parametri[1]
for (i in 1:22)
	predicted <- predicted + parametri[i+1] * test[,i]

mean(abs(predicted-observed))