--DEVOIR PROGRAMMATION FONCTIONNELLE
--TAILLE DE LA GRILLE
n= 5

newline = ['\n']

--Les états sont les cases de la grille
data Etat = Case Integer Integer
	    deriving (Show,Eq)

--l'état initial
etatInitial = Case 1 1

--l'état final
etatFinal = Case n n

--Emplacement des obstacles
obstacles = [Case 2 2, Case 3 3, Case 4 2, Case 3 5]

--Teste si un état est terminal (on le compare avec l'état terminal)
estTerminal ::Etat -> Bool
estTerminal e =  e == etatFinal

--Regarde si l'état est un obstacle (on regarde si cet état appartient à la liste des obstacles)
estObstacle :: Etat -> Bool
estObstacle e = elem e obstacles

--Regarde si un état n'est pas un obstacle et est dans la grille
--on teste si l'indice de la case en abscisse et en ordonné fait partie des indices de la grille
--et on teste si la case n'est pas un obstacle; dans ce cas on renvoie la case
succ_aux :: Etat -> [Etat]
succ_aux (Case x y)  |((not(elem (Case x y) obstacles))&& (x<=n) && (x>0) && (y>0) && (y<=n)) = [Case x y]
		     |otherwise = []
		     
--Renvoi les successeurs d'un état donné
--On appelle la fonction succ_aux pour les états à gauche, à droite, en haut et en bas de l'état courant
--On insére ces cases dans une liste d'états
successeurs :: Etat -> [Etat]
successeurs (Case x y)  = succ_aux (Case (x-1) y)++succ_aux (Case (x+1) y)++succ_aux (Case x (y-1))++succ_aux (Case x (y+1))


--affichage d'un état: permet d'afficher un état, les obstacles sont matérialisés par des X. 
--Les cases autres que départ, but et obstacles sont représentées par des *.
afficherEtat :: Etat -> String
afficherEtat (Case x y) |estObstacle (Case x y) = "  xxx  "
	       		|estTerminal (Case x y) = "  but  "
	       		|(Case x y) == etatInitial = " depart"
	     		|otherwise = "   *   "


--affichage de la grille en utilisant pour chaque état la fonction afficheEtat
--Quand on arrive en bout de grille (n = 5) on passe à la ligne
afficherAux :: Integer -> Integer -> String -> String
afficherAux a b s |((a==n)&&(b==n)) = s++afficherEtat (Case a b)++newline
		  |(a==n) = afficherAux 1 (b+1) (s++afficherEtat (Case a b)++newline)
		  |otherwise = afficherAux (a+1) (b) (s++afficherEtat (Case a b))

--permet de renvoyer la chaine de caractères représentant la grille à l'écran
afficher = putStr(afficherAux 1 1 "")
	   
	
--h1 la distance de Manathan
h1 :: Etat -> Integer
h1 (Case x y) = abs(x-n)+abs(y-n)


--h2 la distance euclidienne
h2 :: Etat -> Integer
h2 (Case x y) = floor(sqrt(fromInteger (sommeCarre)))
	where sommeCarre = ((x-n)*(x-n)) + ((y-n)*(y-n))



--TYPE QUEUE : FILE A PRIORITE
type Queue a =[a]

--constructeur
emptyQueue = []

--teste si une file est vide
isEmptyQueue :: Queue a -> Bool
isEmptyQueue [] = True
isEmptyQueue _ = False

--accesseurs
--permet de renvoyer le premier élément de la file
front :: Queue a -> a
front (e:_) = e

--renvoie la file sans son premier éléments
deQueue :: Queue a -> Queue a
deQueue (_:xs) = xs


-- File a priorité : les états sont rangés suivant h1
--permet d'insérer un élément a dans une queue: l'élément en tête de la queue est celui pour lequel la valeur de l'heuristique est la plus petite
--si la file est vide on insère l'état dans la file
--si le nouvel élément a une heuristique plus petite que la tête de la file on l'insére en tête de la file sinon on cherche à l'insérer après la tête de la liste

enQueue a q = insert a q
	where
	  insert e [] = [e]
	  insert e (x:xs)
		|h1 e <= h1 x = e : x :xs   
		|otherwise = x : (insert e xs)


--algo A*
--si l'état de tête de file est un état obstacle ou déjà visité on enlève cet élément de la file et on regarde la nouvelle tête
--sinon on insère les successeurs de l'état en tête de la file selon leur valeur heuristique croissante. On enlève aussi cet état (la tête) de la file et on le met dans les états déjà visités. On aura donc en tête de la file le meilleur état successeur de l'état que l'on vient de défiler. 
search :: Etat -> [Etat]
search e = bfs (enQueue e emptyQueue)[]
	where
	bfs q visit
		|isEmptyQueue q = []
		|elem (front q) visit || estObstacle (front q) = bfs (deQueue q) visit  
		|estTerminal (front q) = [front q]
		|otherwise = (front q) : (bfs (foldr enQueue (deQueue q) (successeurs (front q))) ((front q) : visit))


--Renvoi les successeurs d'un état donné sans tenir compte des obstacles
successeurs2 :: Etat -> [Etat]
successeurs2 (Case x y)  = succ_bis2 (Case (x-1) y)++succ_bis2 (Case (x+1) y)++succ_bis2 (Case x (y-1))++succ_bis2 (Case x (y+1))
	where succ_bis2 (Case x y)|((x<=n) && (x>0) && (y>0) && (y<=n)) = [Case x y]
			     	  |otherwise = []


--h3 qui tient compte des obstacles
--si on a un obstacle on renvoie un nombre qui tend vers l'infini
--ici on choisit la taille de la grille au carré
h3 :: Etat -> Integer
h3 (Case x y) 	|estObstacle (Case x y) = n * n
		|otherwise =  floor(sqrt(fromInteger (sommeCarre)))
			where sommeCarre = ((x-n)*(x-n)) + ((y-n)*(y-n))



--plusieurs états finaux
--permet de choisir le meilleur chemin pour aller d'un état initial à un état final que l'on choisit 
search2 :: Etat -> Etat -> [Etat]
search2 e fin = bfs (enQueue e emptyQueue)[]
	where
	bfs q visit
		|isEmptyQueue q = []
		|elem (front q) visit || estObstacle (front q) = bfs (deQueue q) visit
		|fin == (front q) = [front q]
		|otherwise = (front q) : (bfs (foldr enQueue (deQueue q) (successeurs (front q))) ((front q) : visit))


--permet de faire le chemin entre plusieurs état finaux. On parcours la liste des états finaux et pour chaque état on appelle la fonction search2.
--(z:zs) est la liste des états a atteindre
search3 :: Etat -> [Etat] -> [Etat] -> [Etat]
search3 (Case x y) []  listeEtat =  listeEtat
search3 (Case x y) (z:zs) listeEtat =  search3 z zs (listeEtat++(search2 (Case x y) z))



--PARTIE2

data Action = G | D | H | B
	deriving(Show,Eq)

--permet de passer d'un état à un autre par une action a
transition :: Etat -> Action -> Etat
transition (Case x y) a |((a == G) && (x==1)) = (Case x y) 
			|a == G = (Case (x-1) y)
 			|((a == D) && (x==n)) = (Case x y)
			|a == D = (Case (x+1) y)
			|((a == H) && (y==1)) = (Case x y)
			|a == H = (Case x (y-1))
			|((a == B) && (y==n)) = (Case x y)
			|a == B = (Case x (y+1))

--regarde si un etat a déjà été visité
deja_Visite :: Etat -> [Etat] -> Bool
deja_Visite (Case x y) liste = elem (Case x y) liste


--permet de tester si l'action est possible
estPossible :: Action -> Etat -> Bool
estPossible a (Case x y) |(not((transition (Case x y) a) == (Case x y))) && (not (elem (transition (Case x y) a) obstacles)) = True
			 |otherwise = False

--generation de plan
genPlanAux :: Etat -> [Etat] -> [Action] -> [Action]
genPlanAux (Case x y) visit listeAction 	
	|(x>n || y>n) = []
	|estObstacle (Case x y) = []
	|estTerminal (Case x y) = reverse listeAction	
	|((estPossible D (Case x y)) && (not (elem (Case x y) visit))) = (genPlanAux (Case (x+1) y) ((Case x y):visit) (D:listeAction))
	|((estPossible B (Case x y)) && (not (elem (Case x y) visit))) = (genPlanAux (Case x (y+1)) ((Case x y):visit) (B:listeAction))
	|((estPossible H (Case x y)) && (not (elem (Case x y) visit))) = (genPlanAux (Case x (y-1))  ((Case x y):visit) (H:listeAction))
	|((estPossible G (Case x y)) && (not (elem (Case x y) visit))) = (genPlanAux (Case (x-1) y) ((Case x y):visit) (G:listeAction))
		
genPlan :: Etat -> [Etat] -> [Action]
genPlan (Case x y) visit = genPlanAux (Case x y) visit []


 
--liste des actions
listeAction :: [Action]
listeAction = [G,D,B,H]

--A partir d'un état et une liste d'actions on renvoie les cases sur lesquelles on peut aboutir en appliquant les actions données. on tient compte des obstacles (fonction estPossible)
casePossible :: Etat -> [Action] -> [Etat] -> [Etat]
casePossible (Case x y) [] listeCases = listeCases
casePossible (Case x y) (z:zs) listeCases |estPossible z (Case x y)  = casePossible (Case x y) zs ((transition (Case x y) z):listeCases)
					  |not(estPossible z (Case x y)) = casePossible (Case x y) zs listeCases

--permet de retrouver l'action, qui après avoir été appliquée à un état initial,donne un état qui a pour heuristique une certaine valeur
chercheAction :: Etat -> (Etat -> Integer) -> Integer -> Action
chercheAction (Case x y) heuri valeurHeuristique
		|(heuri (transition (Case x y) D) == valeurHeuristique)&& (not (estObstacle (transition (Case x y) D))) = D
		|(heuri (transition (Case x y) B) == valeurHeuristique)&& (not (estObstacle (transition (Case x y) B))) = B
		|(heuri (transition (Case x y) H) == valeurHeuristique)&& (not (estObstacle (transition (Case x y) H))) = H
		|(heuri (transition (Case x y) G) == valeurHeuristique)&& (not (estObstacle (transition (Case x y) G))) = G


--fonction qui calcule le min d'une liste d'entier
minimum2 :: [Integer] -> Integer
minimum2 (x:xs) = minimumBis (x:xs) x
	where minimumBis (y:ys) k  |(y:ys)== [] = k
				   |y<=k = minimumBis ys y
				   |y>k = minimumBis ys k


--calcule l'heuristique minimum pour un état avec plusieurs transitions. On fait transiter l'état
--initial dans un autre via les action H,B,G,D on regarde son heuristique.
heuristiqueMinBis :: Etat -> (Etat -> Integer) -> [Etat] -> [Integer] -> Integer
heuristiqueMinBis (Case x y) heuri [] listeH = minimum listeH
heuristiqueMinBis (Case x y) heuri (z:zs) listeH = heuristiqueMinBis (Case x y) heuri zs ((heuri z):listeH) 

heuriMin :: Etat -> (Etat -> Integer) -> Integer
heuriMin (Case x y) heuri = heuristiqueMinBis (Case x y) heuri (casePossible (Case x y) listeAction []) []

--le meilleur chemin en utilisant une heuristique
meilleurAux :: Etat -> (Etat -> Integer) -> [Action] -> [Action]
meilleurAux (Case x y) heuri res
	|estTerminal (Case x y) = reverse res
	|otherwise = meilleurAux (transition (Case x y) (chercheAction (Case x y) heuri (heuriMin (Case x y) heuri))) heuri ((chercheAction (Case x y) heuri (heuriMin (Case x y) heuri)):res)		


meilleur :: Etat -> [Action]
meilleur (Case x y) = meilleurAux (Case x y) h1 []