This code is mostly the same as the preceding one.
> import Debug.Trace (trace)
> import Data.List
> data BinTree a = Empty
> | Node a (BinTree a) (BinTree a)
> deriving (Eq,Ord)
> -- declare BinTree a to be an instance of Show
> instance (Show a) => Show (BinTree a) where
> -- will start by a '<' before the root
> -- and put a : a begining of line
> show t = "< " ++ replace '\n' "\n: " (treeshow "" t)
> where
> treeshow pref Empty = ""
> treeshow pref (Node x Empty Empty) =
> (pshow pref x)
>
> treeshow pref (Node x left Empty) =
> (pshow pref x) ++ "\n" ++
> (showSon pref "`--" " " left)
>
> treeshow pref (Node x Empty right) =
> (pshow pref x) ++ "\n" ++
> (showSon pref "`--" " " right)
>
> treeshow pref (Node x left right) =
> (pshow pref x) ++ "\n" ++
> (showSon pref "|--" "| " left) ++ "\n" ++
> (showSon pref "`--" " " right)
>
> -- show a tree using some prefixes to make it nice
> showSon pref before next t =
> pref ++ before ++ treeshow (pref ++ next) t
>
> -- pshow replace "\n" by "\n"++pref
> pshow pref x = replace '\n' ("\n"++pref) (" " ++ show x)
>
> -- replace on char by another string
> replace c new string =
> concatMap (change c new) string
> where
> change c new x
> | x == c = new
> | otherwise = x:[] -- "x"
>
> treeTakeDepth _ Empty = Empty
> treeTakeDepth 0 _ = Empty
> treeTakeDepth n (Node x left right) = let
> nl = treeTakeDepth (n-1) left
> nr = treeTakeDepth (n-1) right
> in
> Node x nl nr
fr: Pour résoudre ces problèmes nous allons modifier légèrement nos
en: In order to resolve these problem we will modify slightly our
fr: fonctions `treeFromList` et `shuffle`.
en: `treeFromList` and `shuffle` function.
fr: Un premier problème est le manque de nombres différents dans notre immlémentation de `shuffle`.
en: A first problem, is the lack of infinite different number in our implementation of `shuffle`.
fr: Nous avons généré seulement `4331` nombres différents.
en: We generated only `4331` different numbers.
fr: Pour résoudre cela nous allons faire un meilleure fonction `shuffle`.
en: To resolve this we make a slightly better `shuffle` function.
> shuffle = map rand [1..]
> where
> rand x = ((p x) `mod` (x+c)) - ((x+c) `div` 2)
> p x = m*x^2 + n*x + o -- some polynome
> m = 3123
> n = 31
> o = 7641
> c = 1237
fr: Cette fonction à la propriété de ne pas avoir de bornes supérieure ou inférieure.
en: This shuffle function has the property (hopefully) not to have an upper nor lower bound.
fr: Mais avoir une meilleure list `shuffle` n'est pas assez pour entrer dans une boucle infinie.
en: But having a better shuffle list isn't enough not to enter an infinite loop.
fr: Généralement, nous ne pouvons pas décider que `filter ( Tous les élements de la branche de gauche doit être strictement inférieur au la valeur racine.
en: > Any element of the left (resp. right) branch must all be strictly inferior (resp. superior) to the label of the root.
fr: Remarquez que cela donnera _souvent_ un arbre ordonné.
en: Remark it will remains _mostly_ an ordered binary tree.
fr: En outre, avec cette construction, chaque noeud est unique dans l'arbre.
en: Furthermore, by construction, each node value is unique in the tree.
fr: Voici notre nouvelle version de `treeFromList`. Nous avons simplement remplacé `filter` par `safefilter`.
en: Here is our new version of `treeFromList`. We simply have replaced `filter` by `safefilter`.
> treeFromList :: (Ord a, Show a) => [a] -> BinTree a
> treeFromList [] = Empty
> treeFromList (x:xs) = Node x left right
> where
> left = treeFromList $ safefilter ( right = treeFromList $ safefilter (>x) xs
fr: Cette nouvelle fonction `safefilter` est presque équivalente à `filter` mais n'entre pas dans des boucles infinies si le résultat est une liste finie.
en: This new function `safefilter` is almost equivalent to `filter` but don't enter infinite loop if the result is a finite list.
fr: Si elle ne peut pas trouver un élément pour lequel le test est vrai après 10000 étapes consécutives, alors elle considère que la recherche est finie.
en: If it cannot find an element for which the test is true after 10000 consecutive steps, then it considers to be the end of the search.
> safefilter :: (a -> Bool) -> [a] -> [a]
> safefilter f l = safefilter' f l nbTry
> where
> nbTry = 10000
> safefilter' _ _ 0 = []
> safefilter' _ [] _ = []
> safefilter' f (x:xs) n =
> if f x
> then x : safefilter' f xs nbTry
> else safefilter' f xs (n-1)
fr: Maintenant faites tourner le programme et soyez heureux:
en: Now run the program and be happy:
> main = do
> putStrLn "take 10 shuffle"
> print $ take 10 shuffle
> putStrLn "\ntreeTakeDepth 8 (treeFromList shuffle)"
> print $ treeTakeDepth 8 (treeFromList $ shuffle)
fr: Vous devriez réaliser que le temps nécessaire pour afficher chaque valeur est différent.
en: You should realize the time to print each value is different.
fr: C'est parce que Haskell calcule chaque valeur lorsqu'il en a besoin.
en: This is because Haskell compute each value when it needs it.
fr: Et dans ce cas, il est demandé de l'afficher à l'écran.
en: And in this case, this is when asked to print it on the screen.
fr: Vous pouvez même essayer de remplacer la profondeur de `8` par `100`.
en: Impressively enough, try to replace the depth from `8` to `100`.
fr: Cela marchera sans tuer votre RAM!
en: It will work without killing your RAM!
fr: La gestion de la mémoire est faite naturellement par Haskell.
en: The flow and the memory management is done naturally by Haskell.
fr: Laissé comme exercices au lecteur:
en: Left as an exercise to the reader:
fr: - Même avec une grande valeur constante pour `deep` et `nbTry`, cela semble marcher correctement. Mais dans le pire des cas, cela peut devenir exponentiel.
en: - Even with large constant value for `deep` and `nbTry`, it seems to work nicely. But in the worst case, it can be exponential.
fr: Créez la pire liste à donner comme paramètre à `treeFromList`.
en: Create a worst case list to give as parameter to `treeFromList`.
fr: _indice_: pensez à (`[0,-1,-1,....,-1,1,-1,...,-1,1,...]`).
en: _hint_: think about (`[0,-1,-1,....,-1,1,-1,...,-1,1,...]`).
fr: - J'ai commencé à implémenter `safefilter` comme ceci:
en: - I first tried to implement `safefilter` as follow:
safefilter' f l = if filter f (take 10000 l) == []
then []
else filter f l
fr: Expliquer pourquoi cela ne fonctionne pas et peut entrer dans une boucle infinie.
en: Explain why it doesn't work and can enter into an infinite loop.
fr: - Supposez que `shuffle` est une liste de nombre réellement aléatoires avec de plus en plus de bornes.
en: - Suppose that `shuffle` is real random list with growing bounds.
fr: Si vous étudiez un peu cette structure, vous découvrirez qu'elle a toutes les chances
en: If you study a bit this structure, you'll discover that with probability 1,
fr: d'être finie.
en: this structure is finite.
fr: En utilisant le code suivant
en: Using the following code
fr: (supposez que nous pouvons utliser `safefilter'` directement comme si cela n'était pas dans le `where` de `safefilter`.
en: (suppose we could use `safefilter'` directly as if was not in the where of safefilter)
fr: trouvez une définition de `f` telle que, avec une probabilité de `1`,
en: find a definition of `f` such that with probability `1`,
fr: `treeFromList' shuffle` est infinie?. Et prouvez-le.
en: `treeFromList' shuffle` is infinite. And prove it.
fr: Avertissement, ce n'est qu'une conjecture.
en: Disclaimer, this is only a conjecture.
treeFromList' [] n = Empty
treeFromList' (x:xs) n = Node x left right
where
left = treeFromList' (safefilter' (x) xs (f n)
f = ???