Ver el código de «Enumeración de los racionales»

<source lang="haskell">
-- ---------------------------------------------------------------------
--        ENUMERACION DE LOS RACIONALES                               --
--        por David Argullo                                           --
-- ---------------------------------------------------------------------

-- Mediante programacion funcional perezosa se pueden enumerar los
-- racionales positivos, generando una matriz de dos dimensiones
-- (una lista infinita de listas infinitas), a continuación,
-- recorrer sus diagonales finitas (una lista infinita de listas 
-- finitas). Cada fila de la matriz tiene los racionales positivos con un
-- denominador dado, y cada columna aquellos con un numerado  dado:
--
-- 1/1 2/1 3/1 ··· m/1 ···
-- 1/2 2/2 3/2 ··· m/2 ···
-- .
-- .
-- .
-- 1/n 2/n 3/n ··· m/n ···
-- .
-- .
-- .
--
-- Dado que cada fila es infinita, las filas no pueden simplemente ser
-- concatenadas. Sin embargo, cada una de las diagonales  desde la parte
-- superior de derecha hacia abajo a  izquierda, que contiene  números 
-- racionales con numerador y denominador de una suma determinada, 
-- es finito, por lo que estos pueden ser concatenados:
--
rats1::[Rational]
rats1 = concat(diags[[m/n|m<-[1..]]|n<-[1..]])
--
--ANALISIS
-- por cada elemento de la lista de la derecha añade todos los elementos
-- de la de la izquierda con lo que permite generar una lista de
-- listas, con cada estructura,[lista anterior |n<-[1..]],
-- que se añade, se anida la lista en otra lista
--
diags = diags'[] 
    where diags' xss (ys:yss) = 
              map head xss:diags' (ys:map tail xss) yss
--
--TRAZA
--rats1=concat(diags[m/n|m<-[1..]]|n<-[1..]])
-- ..  =..    (diags' xss (ys:yss))
-- ..  =..    (diags' [] ([m/1|m<-[1..]]:[m/n|m<-[1..]]|n<-[2..]])
-- .. (map head xss:diags' (ys:map tail xss) yss)
-- (map head []:diags' ([m/1|m<-[1..]]:map tail []) [m/n|m<-[1..]]|n<-[2..]])  
-- (.. :diags' ([m/1|m<-[1..]]:map tail []) [m/n|m<-[1..]]|n<-[2..]])
-- diags' [[m/1|m<-[1..]]] [m/n|m<-[1..]]|n<-[2..]]
-- diags' xss              (ys            :yss)
-- diags' [[m/1|m<-[1..]]] ([m/2|m<-[1..]]:[m/n|m<-[1..]]|n<-[3..]])
-- map head xss:diags' (ys:map tail xss) yss
--
-- map head [[m/1|m<-[1..]]]:diags' ([m/2|m<-[1..]]:[[m/1|m<-[2..]]]) [m/n|m<-[1..]]|n<-[3..]]
-- .. :diags' ([m/2|m<-[1..]]:[[m/1|m<-[2..]]]) [m/n|m<-[1..]]|n<-[3..]]
-- .. :diags' ([[m/2|m<-[1..]],[m/1|m<-[2..]]]) [m/n|m<-[1..]]|n<-[3..]]
--     diags'  xss                              (ys            :yss)
--     diags'  [[m/2|m<-[1..]],[m/1|m<-[2..]]]  ([m/3|m<-[1..]]:[m/n|m<-[1..]]|n<-[4..]])
-- map head xss:diags' (ys:map tail xss) yss
-- map head [[m/2|m<-[1..]],[m/1|m<-[2..]]]
--                    :diags' ([m/3|m<-[1..]]
--                      :map tail[[m/2|m<-[1..]],[m/1|m<-[2..]]]) [m/n|m<-[1..]]|n<-[4..]]
--
-- map head [[m/2|m<-[1..]],[m/1|m<-[2..]]]
--                    :diags' ([m/3|m<-[1..]]
--                      :[[m/2|m<-[2..]],[m/1|m<-[3..]]]) [m/n|m<-[1..]]|n<-[4..]]
--
-- ---------------------------------------------------------------------

-- De manera equivalente, se pueden generar directamente las diagonales
--
rats2 ::[Rational]
rats2 = concat[[m/(d-m)|m<-[1..d-1]]|d<-[2..]]
--
--
-- TRAZA
-- rats2 = concat[[m/(d-m)|m<-[1..d-1]]|d<-[2..]]
-- ..   = .. [[m/(d-m)|m<-[1..2-1]]|d<-[3..]]
-- [[m/(2-m)|m<-[1]]|d<-[3..]]
-- [[1/(1)|m<-[1]]|d<-[3..]]
-- [[1/1],[m/(d-m)|m<-[1..d-1]]|d<-[3..]]
-- [[1/1],[m/(3-m)|m<-[1..3-1]]|d<-[4..]]
-- [[1/1],[m/(3-m)|m<-[1..2]]|d<-[4..]]
-- [[1/1],[1/(3-1),2/(3-2)],[m/(d-m)|m<-[1..d-1]]|d<-[4..]]
-- [[1/1],[1/2,2/1],[m/(d-m)|m<-[1..d-1]]|d<-[4..]]
-- [[1/1],[1/2,2/1],[m/(4-m)|m<-[1..4-1]]|d<-[5..]]
-- [[1/1],[1/2,2/1],[(1/(4-1),(2/(4-2),(1/(4-3)],[m/(d-m)|m<-[1..d-1]]|d<-[5..]]
-- [[1/1],[1/2,2/1],[1/3,2/2,3/1],[m/(d-m)|m<-[1..d-1]]|d<-[5..]]
--
-- Estas definiciones tienen un número infinito de duplicados de todo racional.
-- Se podrían enumerar los racionales sin duplicados mediante el filtrado
-- de los pares que no son coprimos.
--
-- Máximo común divisor
-- ====================

-- El enfoque diagonalización de enumerar los racionales se basa en la 
-- generación de los pares enteros de positivos. La esencia del problema
-- con este enfoque es que la correspondencia natural, a través de la
-- división  entre los pares de números enteros y racionales no es una
-- biyección:
-- aunque todo  racional se representa, muchos pares de enteros representan 
-- el mismo racional por lo tanto, la enumeración de los racionales
-- mediante la generación de los pares de enteros produce duplicados.
-- Los naturales son fáciles de enumerar, y existe una clara
-- biyección entre los naturales y los racionales; pero esta biyección
-- no es fácil de calcular.
-- La idea fundamental es la relación entre números racionales y divisores comunes.
-- Para ello el algoritmo de sustracción de Euclides para calcular el
-- máximo común divisor:
--
gcdi::(Integer,Integer)->Integer 
gcdi(m,n) = if m < n then gcdi(m,n-m) else 
            if m > n then gcdi(m-n,n) else m -- cuando m==n
--
--La siguiente 'versión instrumentada',  devuelve no sólo el máximo
--común divisor, sino también un rastro de la ejecución por la que se calcula.
--
igcd ::(Integer,Integer)->(Integer,[Bool])
igcd(m,n) = if m < n then step False (igcd(m,n-m)) else
            if m > n then step True  (igcd(m-n,n)) else(m,[])
                where step b(d,bs) = (d,b:bs) 

-- ANALISIS
-- en cada paso de igcd deja una traza de step b(d,bs) en el ultimo paso
-- igcd coloca (m,[]) el caso base de la recursion de step b(d,bs)
-- ---------------------------------------------------------------------
--
-- Dado un par (m, n), la función devuelve un par IGCD (d, bs),
-- donde d es mcd (m, n) y bs es la lista de booleanos grabación de la
-- ruta de ejecución, es decir, una lista de las ramas tomada 
-- en la evaluación de mcd (m, n). 
-- Vamos a representar la función PGCD, por  bs = PGCD (m,n).
-- Estas dos piezas de datos en conjunto son suficientes para invertir la
-- computación y reconstruir m y n.
--
ungcd ::(Integer,[Bool])->(Integer,Integer)
ungcd (d,bs) = foldr undo (d,d) bs
    where undo False (m,n) = (m,n+m)
          undo True  (m,n) = (m+n,n)
--
--ANALISIS
-- foldr undo (d,d) bs
-- foldr undo (d,d) [b1,b2,...,bn]
-- undo b1 (foldr undo (d,d) [b2,...,bn])
-- undo b1 (undo b2 ( .. undo bn (d,d)))--esta es la traza de igcd
-- al alcanzar el caso base de la recursion aplica las sustituciones
-- de undo  obteniendo la tupla inicial
--
--
-- Entonces ungcd y IGCD son inversas con lo que hay una biyección entre
-- los pares de enteros (m, n) y sus imágenes (d,bs) bajo IGCD.
-- Ahora, mcd (m, n) es exactamente lo que es superfluo desde (m,n) al 
-- racional m/n, y PGCD (m, n) es exactamente lo que es relevante  ya
-- que dos pares (m, n) y (m', n') representan el mismo racional si
-- tienen el mismo PGCD m/n = m'/n' <==> pgcd(m,n) = pgcd(m0,n0)
-- Por otra parte, PGCD es sobreyectiva: cada secuencia booleana finita es la
-- PGCD de algún par. La función ungcd  da una demostración constructiva
-- de esta, mediante la reconstrucción de tales pares.  Por lo tanto,
-- puede enumerar los racionales enumerando las secuencias booleas finitas
-- la enumeración es bastante fácil, y la biyección de los racionales
-- es fácil de calcular, a través ungcd
--
-- FUNCION ORIGINAL
--
-- rats3::[Rational]
-- rats3 = map (mkRat.curry ungcd 1) boolseqs 
-- boolseqs = []:[b:bs|bs<-boolseqs,b<-[False,True]]
-- mkRat (m,n) = m/n
--
--
rats3::[Rational]
rats3 = map (mkRat.f.curry ungcd 1) boolseqs 
       where f (m,n) =(fromIntegral m, fromIntegral n)
boolseqs = []:[b:bs|bs<-boolseqs,b<- [False,True]]
mkRat (m,n) = m/n
--
-- ANALISIS
--
-- curry :: ((a, b) -> c) -> a -> b -> c
-- curry f x y    =  f (x, y)
--
-- boolseqs genera una lista infinita de listas de booleanos,las cuales
-- son todas las variaciones con repeticion posibles
--
-- TRAZA
-- rats3 = map (mkRat.f.curry ungcd 1) boolseqs 
-- map (mkRat.f.curry ungcd 1) boolseqs 
-- map (mkRat.f.curry ungcd 1) []:[b:bs|bs<-boolseqs,b<-[False,True]]
-- map (mkRat.f.curry ungcd 1) []:[False]:[True]:[b:bs|bs<-boolseqs,b<-[False,True]] 
-- ((mkRat.f.curry ungcd 1) []): ..
-- (mkRat.f.(curry ungcd 1 []): ..
-- (mkRat.f.(ungcd (1 [])): ..
-- (mkRat.f.(foldr undo (1,1) [])): ..
-- (mkRat.f.((1,1) ): .. -- caso base foldr
-- (mkRat(1,1)): ..
-- [1/1]: ..
-- .. map (mkRat.f.curry ungcd 1) [False]:[True]:[False,False]:[b:bs|bs<-boolseqs,b<-[False,True]]
-- .. (mkRat.f.curry ungcd 1) [False]:..
-- .. (mkRat.f.(curry ungcd 1 [False]):..
-- .. (mkRat.f.(ungcd (1 [False])):..
-- .. (mkRat.f.(foldr undo (1,1) [False])): ..
-- .. foldr undo (1,1) [False]:..
-- .. undo False (foldr undo (1,1) []):..
-- .. undo False ((1,1)):..
-- .. undo False (1,1):..
-- .. undo False (1,1):.. 
-- .. mkRat.f.(1,2):..
-- ..(1/2):..
-- [1/1]:[1/2]:..
-- ..map (mkRat.f.curry ungcd 1) [True]:[False,False]:[b:bs|bs<-boolseqs,b<-[False,True]]
-- .. (mkRat.f.curry ungcd 1) [True]:..
-- .. (mkRat.f.(curry ungcd 1 [True]):..
-- .. (mkRat.f.(ungcd (1 [True])):..
-- .. (mkRat.f.(foldr undo (1,1) [True])): ..
-- .. foldr undo (1,1) [True]:..
-- .. undo True (foldr undo (1,1) []):..
-- .. undo True ((1,1)):..
-- .. undo True (1,1):..
-- .. undo True (1,1):.. 
-- .. mkRat.f.(2,1):..
-- .. (2,1)
-- [1/1]:[1/2]:[2/1]:..
--
--En esta definicion se generan los racionales en los cuales numerador y
--denominador son primos entre si
--
--3 The Stern-Brocot tree
-- Propiedades
--
-- 1)Es un árbol de búsqueda binaria infinita, por lo que cualquier poda
-- finita,es decir, aplanamiento de una profundidad finita tiene un recorrido en 
-- orden creciente.
-- Por ejemplo, la poda para incluir el nivel con 1/3 y 3/1, produce 
-- un árbol con recorrido en orden
-- 1 / 3, 1 / 2, 2 / 3, 1 / 1, 3 / 2, 2 / 1, 3 / 1, que está aumentando.
--
-- 2)Cada nodo está marcado con un racional m + m '/ n + n'donde,tras 
-- aplanar el arbol,  m / n es elemento  más a la derecha a su izquierda 
-- y m' / n' es el elemento más a la izquierda a su derecha.
--
-- Por ejemplo, el nodo 3/4 tiene antecesores a 2/3, 1/2, 1/1, 0/1, 1/0
-- de las cuales 1/1 y 1/0 son a la derecha y los otros a la izquierda.
-- El antecesor más a la derecha a su izquierda es 2/3, y el antecesor
-- más a la izquierda a su derecha es 1/1, y de hecho 3/4 = 2 + 1/3 + 1.
-- Es  por eso hacen que falta  los dos pseudo-nodos 0/1 y 1/0 para
-- hacer que esta relación funcione para los nodos, por ejemplo como 1/3 y 3/1
-- en el límite del árbol.
--
-- Esta última propiedad explica cómo generar el árbol directamente,
-- prescindiendo de las secuencias de los booleanos.
--
data Tree a = Node(a,Tree a,Tree a) deriving (Eq,Show)
--
foldt f (Node(a,x,y)) = f (a,foldt f x,foldt f y)
unfoldt f x = let (a,y,z) = f x in Node(a,unfoldt f y,unfoldt f z)
-- 
rats4 :: [Rational]
rats4 = bf (unfoldt step((0,1),(1,0)))
    where step(l,r) = let m = adj l r in (mkRat m,(l,m),(m,r))
adj (m,n) (m',n') = (m+m',n+n')
bf = concat.foldt glue
    where glue (a,xs,ys) = [a]:zipWith (++) xs ys 
--
--ANALISIS
--data Tree a = Node(a,Tree a,Tree a) deriving (Eq,Show)
-- data Tree a, es el tipo de dato de un arbol formado por un nodo,con
-- un tipo asignado a la variable, y dos ramas que a su vez terminan en otro
-- arbol del mismo tipo, luego es un arbol de infinitos nodos en el que
-- nunca se llegan a alcanzar las hojas.
--
--foldt f (Node(a,x,y)) = f (a,foldt f x,foldt f y)-- permite acceder a
---- los elementos del arbol y aplicarle una funcion
--unfoldt f x = let (a,y,z) = f x in Node(a,unfoldt f y,unfoldt f z)-- genera
--   -- un arbol que en lugar de hojas tiene todo el aplanado del arbol a
--   -- partir del cual va gerando los nodos del siguiente nivel del mismo.
--
--rats4 :: [Rational]
--rats4 = bf (unfoldt step((0,1),(1,0)))
--    where step(l,r) = let m = adj l r in (mkRat m,(l,m),(m,r))--genera
--       --el nodo y lo dispone en la posicion que ocuparia de ser
--       --aplanado el arbol para generar los siguientes nodos
--
--adj (m,n) (m',n') = (m+m',n+n') -- genera el valor de un nodo a apartir
--                                -- de los dos que lo rodean de ser
--                                aplanado el arbol
--
--bf = concat.foldt glue --recorre el arbol recogiendo los valores de los
--    where glue (a,xs,ys) = [a]:zipWith (++) xs ys --nodos y genera una
--                                                  --lista con ellos
--
--TRAZA //uso distinto de los puntos suspensivos
--
--rats4 = bf (unfoldt step ((0,1),(1,0)))
-- . bf (unfoldt step ((0,1),(1,0)))
-- . concat.foldt glue (unfoldt step ((0,1),(1,0)))
-- .. foldt glue (unfoldt step ((0,1),(1,0)))
-- ... unfoldt step ((0,1),(1,0))
--     unfoldt f    x = let (a,y,z) = f x in Node(a,unfoldt f y,unfoldt f z)
-- ... let (a,y,z) = step ((0,1),(1,0)) in Node(a,unfoldt step y,unfoldt step z))
-- .... step ((0,1),(1,0)) .
--      step(l,r) = let m = adj l r in (mkRat m,(l,m),(m,r)) 
-- .... step ((0,1),(1,0)) = let m = adj (0,1) (1,0) in (mkRat m,((0,1),m),(m,(1,0))) .                   
-- ..... let m = adj (0,1)(1,0)  in (mkRat m,((0,1),m),(m,(1,0))) . 
--                adj(m,n) (m',n') = (m+m',n+n') 
-- ..... let m = (1,1) in (mkRat m,((0,1),m),(m,(1,0))) .
-- ..... let m = (1,1) in (mkRat (1,1),((0,1),(1,1)),((1,1),(1,0))) .
--          mkRat (m,n) = m/n
-- ..... let m = (1,1) in (1%1,((0,1),(1,1)),((1,1),(1,0))) .
-- .... step ((0,1),(1,0)) = (1%1,((0,1),(1,1)),((1,1),(1,0))) .
-- ... let (a,y,z) = (1%1,((0,1),(1,1)),((1,1),(1,0))) in Node(a,unfoldt step y,unfoldt step z))
-- ...  Node(1%1,unfoldt  step ((0,1),(1,1)),unfoldt  step ((1,1),(1,0)) )
-- .. foldt glue (Node(1%1,unfoldt step ((0,1),(1,1)),unfoldt step ((1,1),(1,0)))) )
--    foldt f    (Node(a,x,y)) = f (a,foldt f x,foldt f y)
-- .. glue (1%1,foldt glue (unfoldt step ((0,1),(1,1))),foldt glue (unfoldt step ((1,1),(1,0))))) )
--     glue (a,xs,ys) = [a]:zipWith (++) xs ys 
-- .. [1%1]:zipWith (++) (foldt glue (unfoldt step ((0,1),(1,1)))) (foldt glue (unfoldt step ((1,1),(1,0)))))) 
-- . concat [1%1]:zipWith (++) (foldt glue (unfoldt step ((0,1),(1,1)))) (foldt glue (unfoldt step ((1,1),(1,0))))))
-- como cada uno de los argumentos de zipWith es una lista de listas
-- emplea (++) para concatenarlas, cada una de estas listas contiene un
-- nodo.
--
-- Alternativamente, se pueden generar directamente los niveles,
-- comenzando con el primer nivel,  que consiste en los dos 
-- pseudo-nodos, y en ir insertando los nuevos nodos m + m '/ n + n'
-- entre cada par adyacente existente, m / n, m '/ n'.
rats5::[Rational]
rats5 = concat (unfolds infill [(0,1),(1,0)])
unfolds f a = let(b,a') = f a in b:unfolds f a'
infill xs = (map mkRat ys,interleave xs ys) -- convierte a racionales y
                                            -- genera el siguiente nivel
    where ys = zipWith adj xs (tail xs)     -- genera las tuplas para nodos
interleave (x:xs) ys = x:interleave ys xs   -- va añadiendo los nodos
interleave [] [] = []                       -- generados entre los que ya habia.

--
-- ANALISIS 
--
-- TRAZA
-- rats5 = concat (unfolds infill [(0,1),(1,0)])
-- . concat (unfolds infill [(0,1),(1,0)])
-- .. unfolds infill [(0,1),(1,0)]
--    unfolds f      a = let(b,a') = f a in b:unfolds f a'
-- .. let(b,a') = infill [(0,1),(1,0)] in b:unfolds infill a'
-- ... infill [(0,1),(1,0)] .
--     infill xs = (map mkRat ys,interleave xs ys) .
--        where ys = zipWith adj xs (tail xs)
-- ... infill [(0,1),(1,0)] = (map mkRat ys,interleave [(0,1),(1,0)] ys) .
-- ...    where ys = zipWith adj [(0,1),(1,0)] (tail [(0,1),(1,0)])
-- ... infill [(0,1),(1,0)] = (map mkRat ys,interleave [(0,1),(1,0)] ys) .
-- ...    where ys = zipWith adj [(0,1),(1,0)]  [(1,0)]
--                           adj(m,n) (m',n') = (m+m',n+n')
-- ... infill [(0,1),(1,0)] = (map mkRat ys,interleave [(0,1),(1,0)] ys) .
-- ...   where ys = [(1,1)]
-- ... infill [(0,1),(1,0)] = (map mkRat [(1,1)],interleave [(0,1),(1,0)] [(1,1)]) .
-- .... ([1%1],interleave [(0,1),(1,0)] [(1,1)]) .
--               interleave (x:xs)        ys = x:interleave ys xs
--               interleave []            [] = []
-- ..... interleave ((0,1):[(1,0)]) [(1,1)] = (0,1):interleave [(1,1)] [(1,0)] ..
-- ......  (0,1):(1,1):interleave [(1,0)] []  ..
-- ......  (0,1):(1,1):(1,0):interleave [] []  ..
-- ......  (0,1):(1,1):(1,0):[]  ..
-- ......  [(0,1),(1,1),(1,0)]  ..
-- ..... interleave ((0,1):[(1,0)]) [(1,1)]= [(0,1),(1,1),(1,0)]. 
-- .... ([1%1],[(0,1),(1,1),(1,0)]) .
-- ... infill [(0,1),(1,0)] = ([(1%1)],[(0,1),(1,1),(1,0)])  .
-- .. let(b,a') = ([1%1],[(0,1),(1,1),(1,0)]) in b:unfolds infill a'
-- .. [1%1]:unfolds infill [(0,1),(1,1),(1,0)]
-- . concat ([1%1]:unfolds infill [(0,1),(1,1),(1,0)])

-- 4 The Calkin-Wilf tree
-- ======================

-- El árbol Calkin-Wilf no es un árbol de búsqueda binario cada nivel
-- del árbol de Calkin-Wilf es la permutación de bits reversión
-- (Hinze., 2000; Bird et al, 1999) del nivel correspondiente del árbol
-- de Stern-Brocot.
-- Por ejemplo, 1/4, 2/5, 3/5, 3/4, 4/3, 5/3,5/2,4/1  elementos de un
-- nivel del arbol Stern-Brocot se numeran en binario de 000 a 111 de
-- izquierda a derecha, aparecen en el arbol Calkin-Wilf en el orden 
-- 000.100.010.110.001.101.011.111, que son las inversiones de los
-- números binarios 000 a 111. Los niveles surge naturalmente por
-- reversión de los caminos del calculo del gcd.
-- Los ancestros en el árbol Calkin-Wilf de un racional dado, m/n, son todos
-- los pares quese generan al realizar el algoritmo de Euclides cuando
-- se inicia en el par (m, n). 
-- Por ejemplo, una ruta de ejecución del algoritmo de Euclides es la
-- secuencia de pares 
-- (3,4), (3,1), (2,1), (1,1), y de hecho los antepasados 
-- en el árbol Calkin-Wilfde 3/4 son 3/1, 2/1, 1/1.

-- ---------------------------------------------------------------------
-- *Main> igcd (3,4)
-- (1,[False,True,True])
-- *Main> igcd (3,1)
-- (1,[True,True])
-- *Main> igcd (2,1)
-- (1,[True])
-- *Main> igcd (1,1)
-- (1,[])
-- ---------------------------------------------------------------------

-- (Compárese esto con el árbol de Stern-Brocot,
-- en la que no existe una relación evidente entre nodos y ramas.)
-- Por lo tanto, un racional m/n con m<n es el hijo izquierdo de un racional
-- m/n-m, mientras que si m>n es el hijo  derecho  m-n/n. 
-- De manera equivalente, un racional m/n ha dejado un hijo izquierdo m/m+n y
-- un hijo derecho n+m/n. Esto muestra cómo generar el árbol
-- Calkin-Wilf:
--
rats6::[Rational]
rats6 = bf (unfoldt step (1,1))
    where step (m,n) = (m/n,(m,m+n),(n+m,n))
--
--
--TRAZA
-- rats6 = bf (unfoldt step (1,1))
-- . bf (unfoldt step (1,1))
--   bf = concat.foldt glue 
-- . concat.foldt glue (unfoldt step (1,1))
-- .. foldt glue (unfoldt step (1,1))
-- ... unfoldt step (1,1)
--      unfoldt f     x = let (a,y,z) = f x in Node(a,unfoldt f y,unfoldt f z)
-- .... let (a,y,z) =  step (1,1) in Node(a,unfoldt step y,unfoldt step z)
-- ..... step (1,1) in Node(a,unfoldt step y,unfoldt step z)
--        step (m,n) = (m/n,(m,m+n),(n+m,n))
-- ..... (1%1,(1,2),(2,1)) in Node(a,unfoldt step y,unfoldt step z)
-- .... let (a,y,z) = (1%1,(1,2),(2,1)) in Node(a,unfoldt step y,unfoldt step z)
-- .... Node(1%1,unfoldt step (1,2),unfoldt step (2,1))
-- ... unfoldt step (1,1) = Node(1%1,unfoldt step (1,2),unfoldt step (2,1))
-- .. foldt glue (Node(1%1,unfoldt step (1,2),unfoldt step (2,1)) )
--     foldt f    (Node(a,x,y)) = f (a,foldt f x,foldt f y)
-- .. glue (1%1,foldt glue (unfoldt step (1,2)),foldt glue (unfoldt step (2,1)))
--     glue (a,xs,ys) = [a]:zipWith (++) xs ys
-- .. [1%1]:zipWith (++) (foldt glue (unfoldt step (1,2))) (foldt glue (unfoldt step (2,1)))
-- . concat [1%1]:zipWith (++) (foldt glue (unfoldt step (1,2))) (foldt glue (unfoldt step (2,1)))
--
--
-- 5 Iterating through the rationals
-- Hay una compensación por la pérdida de la propiedad de ordenación en
-- el cambio del arbol Stern-Brocot al árbol Calkin-Wilf y es generar los 
-- racionales de cada nivel de izquierda a derecha  utilizando el
-- operador iteración.
--
-- iterate::(a->a)->a->[a]
-- iterate f x = x:iterate f (f x)
--
-- Se basa en como recorrer el arbol para ir de un elemento del arbol al
-- contiguo en el mismo nivel, exepto el ultimo que salta al primero del
-- siguiente nivel.
--
-- Caso en el que los elementos estan unidos por un nodo
--
-- Tomando x = m/n tenemos
--  Si rama izquierda -> x+1 = (m/n)+1 = (m/n)+(n+n) = (m+n)/n
--
--  Si rama derecha   -> 1/((1/x)+1) = 1/((1/(m/n)+1) = 1/((n/m)+1) = 
--
--                       = 1/((n+m)/m) = m/(n+m)
--
--         x-1                                 1/((1/x)-1)
--           \                                  /
--            x                                x
--           / \                              / \
--          /   \                            /   \
--         /     \                          /     \
--        /       \                        /       \
--       /         \                      /         \
--      /           \                    /           \
--     /             \                  /             \
--    /               \                /               \
-- 1/((1/x)+1)        x+1           1/((1/x)+1)        x+1
--
-- Como toda rama izquierda contiene un nodo x = m/n , m/n <1, el nodo que
-- lo genera es 1/((1/x)-1) y la rama derecha de este contiene un nodo
-- que es (1/((1/x)-1))+1 = 1/(1-x). Asi esta formula permite conseguir el
-- sucesor de un racional en el mismo nivel cuando estan unidos por solo
-- un nodo.
--
--
-- Caso en el que X y su sucesor en el mismo nivel, X', distan mas de un
-- nodo entonces hay un nodo en comun a partir del cual han sido
-- generados
--
--                     1/((1/X-K)-1)
--                       / \
--                      /   \
--                     /     \
--                    /       \
--                   /         \
--                  /           \
--                 /             \
--                /               \
--               /                 \
--              /                   \
--             /                     \
--        X-K = Xk                X'k = 1/(K+1-X)
--             .                     .
--              .                   .
--               .                 .
--            X-1 = X1        X'1 =  1/(2*K -X)
--                 \             /
--               X = X0     X'0 =  1/(2*K +1-X) = X'
--          
--
-- Aquí X0 = X es nodo de la rama derecha del nodo X1 = X-1, que a su vez
-- es nodo de la rama derecha X2 = X1-1 = X-2, y así sucesivamente hasta
-- Xk = X-k, que es nodo de la rama izquierda del nodo que es comun a X
-- y X' que es 1/((1/X-K)-1).
-- Por lo tanto como Xk<1,  así K = [X], la parte entera de X. Elemento Xk
-- es el nodo de la rama izquierda del nodo comun  1/(1/(X-K)-1), cuya
-- rama derecha tiene un nodo que es X'k= (1/(1/(X-K)-1))+1 =
-- = ((X-K)/(1-X+K))+1 = (X-K+1-X+K)/(1-X+K) = 1/(1-X+K) = 1/(K+1-X).
-- El nodo X'k tiene en la rama izquierda un nodo X'k-1 =1/(1/(x'k)1) =
-- = 1/(K+2-X), que a su vez tiene en la rama izquierda un nodo x'k-2 = 
-- = 1/(k+3-X), y así sucesivamente hasta X'0 = X' = 1/(2*K +1-X) =
-- = 1/(K+K+1-X) = 1/(K+K+1-[X]-{X}) = 1/(K+1-{X}) = 1/([X]1-{X})
--     Como X = [X]+{X}, donde {x} es la parte fraccionaria de X y K=[X] es
--     la parte entera.
-- La fórmula x' = 1 / ([x] + 1- {x}) para el sucesor de x funciona
-- incluso en el último caso restante, cuando x está en el límite derecho
-- y x' a la izquierda en frontera de un nivel inferior entonces x es un
-- entero, por lo que [x] = x y {x} = 0, y de hecho  x' = 1 / ([x] + 1- {x}).
-- Con esto se obtiene la siguiente enumeración de los racionales:
--
rats7::[Rational]
rats7 = iterate (next) 1
next x = recip (fromInteger n + 1 -  y)
    where (n,y) = properFraction x
--
-- ANALISIS
--
-- Cada término se genera a partir de su precursor con un número
-- constante de operaciones aritméticas racionales.
-- (En Haskell las funciones de la biblioteca estándar properFraction y recip
-- toma un x devolviendo ([x], {x}) y 1 / x, respectivamente.)
--
-- TRAZA
-- rats7 = iterate (next) 1
-- 1:next 1 :iterate (next) (next 1)
-- . next 1 = recip (fromInteger 1 + 1 -  0)
-- . next 1 = 1%2
-- 1:1%2:iterate (next) (1%2)
-- 1:1%2:next 1%2:iterate (next) (next 1%2)
-- . next 1%2 = recip (fromInteger 0 + 1 -  1%2)
-- . next 1%2 = 1/(1%2)
-- . next 1%2 = 2%1
-- 1:1%2:2%1:iterate (next) (2%1)
-- 1:1%2:2%1:next 2%1:iterate (next) (next 2%1)
-- . next 2%1 = recip (fromInteger 2 + 1 -  0)
-- . next 2%1 = 1%3
-- 1:1%2:2%1:1%3:iterate (next) (1%3)
-- 1:1%2:2%1:1%3:next 1%3:iterate (next) (next 1%3)
-- . next 1%3 = recip (fromInteger 0 + 1 - 1%3 )
-- . next 1%3 = 1/(2%3)
-- . next 1%3 = 3%2  
-- 1:1%2:2%1:1%3:3%2:iterate (next) (3%2)
-- 1:1%2:2%1:1%3:3%2:next 3%2:iterate (next) (next 3%2)
-- . next 3%2 =  recip (fromInteger 1 + 1 - 1%2)
-- . next 3%2 =  1/(3%2)
-- . next 3%2 =  2%3
-- 1:1%2:2%1:1%3:3%2:2%3:iterate (next) (2%3)
-- 1:1%2:2%1:1%3:3%2:2%3:next 2%3:iterate (next) (next 2%3)
-- . next 2%3 = recip (fromInteger 0 + 1 - 2%3)
-- . next 2%3 = 1/(1%3)
-- . next 2%3 = 3%1
-- 1:1%2:2%1:1%3:3%2:2%3:3%1:iterate (next) (3%1)
--

--
--
rats8::[Rational]
rats8 = iterate next' 0
    where next' 0 = 1
          next' x | x>0 = negate x
                  | otherwise = next (negate x)
--
--6 The continued fraction connection
--
-- Escribimos la fracción continua finita:
-- como la secuencia de coeficientes enteros [a0, a1, ..., an].
-- Por ejemplo, 3/4 es 0 + 1/(1+(1/3)), por lo
-- está representado por [0,1,3]. 
-------------------------------------------
-- Ejemplo de calculo mediante algotitmo de Euclides
-- a/b
-- a  = b  * q1 + r1
-- b  = r1 * q2 + r2
-- r1 = r2 * q3 + r3
-- .
-- .
-- .
-- r(n-1) = r(n-2) * qn + 0
-- [q1,q2,..,qn]
--
-- 23/5
-- 23 = 5*4 + 3
--  5 = 3*1 + 2
--  3 = 2*1 + 1
--  2 = 1*2 + 0
-- [4,1,1,2]
-------------------------------------------
-- Cada racional tiene una forma normal única como
-- fracción continua periódica; es decir, como una secuencia finita
-- [a0, a1, ..., an] bajo las restricciones que
-- ai > 0 para i > 0 y que an > 1 si n> 0. 
--
-- Hemos demostrado que los racionales positivos son las iteraciones
-- de la función de tomar x a 1 / ([x]+1-{x}), cuyo
-- cálculo requiere un número constante de operaciones aritméticas 
-- sobre los racionales.
-- Se requiere división con el fin de calcular [x](parte entera).
-- Sin embargo, si representamos racionales por fracciones continuas
-- entonces esta división se puede evitar:
-- Sea,un racional cuaquiera, 
--  q = n0 +(1/(n1+(1/(n2+(1/n3))))) -> 1/q = 0 +(1/(n0 +(1/(n1+(1/(n2+(1/n3))))))
--  donde n0 es la parte entera de q lo cual justifica recipcf para
--  invertir los racionales en forma de fraccion continua quitando un
--  cero si no tiene parte entera o añadiendo lo si la tiene.
--
-- Para el calculo de [x]+1-{x} del sucesor de q
--  Si q=[q] parte entera de q ->  [q]+1-0
--  que se formaliza nextcf [n0] = [n0+1] 
--
--  Si q=n0+(1/(2=n1)) -> n0 +1-(1/2) = 
--   = n0 +1-(1/2) = n0 +(1/2)
--  que se formaliza nextcf [n0,2] = [n0,2]
--
--  Si q = n0 +(1/(n1+(1/(n2+(1/n3))))) -> 
--   n0 + 1 -(1/(n1+(1/(n2+(1/n3))))) = 
--    = n0 + ((n1+(1/(n2+(1/n3)))-1)/(n1+(1/(n2+(1/n3)))))         =
--    = n0 + (1/((n1+(1/(n2+(1/n3))))/(n1+(1/(n2+(1/n3)))-1)))     =
--    = n0 + (1/((n1+1-1+(1/(n2+(1/n3))))/(n1-1+(1/(n2+(1/n3)))))) =
--    = n0 + (1/('1' + (1/(n1-1+(1/(n2+(1/n3))))))) 
--  tras los calculos se comprueba que si n1 /= 1 se genera un uno = '1' 
--  en la posicion que ocupaba n1 en la fraccion continua y aparecen
--  todos los terminos desplazados,excepto n0, una posicion hacia la derecha ademas 
--  a n1 se le resta una unidad, esto se formaliza
--   nextcf (n0:n1:ns) = n0: 1 :(n1-1):ns
--  en el caso de n1=1 entonces el calculo quedaria
--  n0 + (1/('1' + (1/(1-1+(1/(n2+(1/n3)))))))   =
--  = n0 + (1/('1' + (1/(1/(n2+(1/n3))))))       =
--  = n0 + (1/('1'+n2 +(1/n3)))
--  con lo que desaparece el uno en la posicion de n1 y el termino n1
--  el resto de los terminos, excepto n0, aparecen desplazado una
--  posicion a la izquierda ademas a n2 se le suma una unidad, esto se
--  formaliza
--   nextcf (n0: 1 :n2:ns) = n0:(n2+1):ns
--
type CF = [Integer]
rats9 :: [CF]
rats9 = iterate(recipcf.nextcf) [1]
    where nextcf [n0]           = [n0+1]
          nextcf [n0,2]         = [n0,2]
          nextcf (n0: 1 :n2:ns) = n0:(n2+1):ns
          nextcf (n0:n1:ns)     = n0: 1 :(n1-1):ns
          recipcf (0 :ns)       = ns
          recipcf ns            = 0 :ns
--
--TRAZA
-- rats9 = iterate(recipcf.nextcf) [1]
-- iterate(recipcf.nextcf) [1]
-- [1]:recipcf.nextcf [1]:iterate(recipcf.nextcf) (recipcf.nextcf [1])
-- . recipcf.nextcf [1]
-- .. nextcf [1] = [1+1]
-- . recipcf [2] = 0:[2]
-- [1]:[0,2]:iterate(recipcf.nextcf) [0,2]
-- [1]:[0,2]:recipcf.nextcf [0,2]:iterate(recipcf.nextcf) (recipcf.nextcf [0,2])
-- . recipcf.nextcf [0,2]
-- .. nextcf [0,2] = [0,2]
-- . recipcf [0,2] = [2]
-- [1]:[0,2]:[2]:iterate(recipcf.nextcf) [2]
--

-- No hay divisiones o multiplicaciones. Por supuesto, el resultado
-- será una lista de las fracciones continuas. Estas se pueden convertir 
-- a los racionales con la siguiente función:
--
cf2rat::CF->Rational
cf2rat = mkRat.foldr op (1,0)
    where op m (n,d) = (fromInteger m*n+d,n)
--
-- Utiliza adiciones y multiplicaciones pero  no hay divisiones 
--TRAZA ejemplo
-- cf2rat [0,1,1,2] = mkRat.foldr op (1,0) [0,1,1,2]
-- mkRat.foldr op (1,0) [0,1,1,2]
-- . foldr op (1,0) [1,1,2]
-- . op 0 (foldr op (1,0) [1,1,2])
-- . op 0 (op 1 (foldr op (1,0) [1,2]))
-- . op 0 (op 1 (op 1 (foldr op (1,0) [2])))
-- . op 0 (op 1 (op 1 (op 2 (foldr op (1,0) []))))
-- . op 0 (op 1 (op 1 (op 2 (1,0))))
--                     op m (n,d) = (fromInteger m*n+d,n)
-- . op 0 (op 1 (op 1 (fromInteger 2*1+0,1)))
-- . op 0 (op 1 (op 1 (fromInteger 2,1)))
-- . op 0 (op 1 (fromInteger 3,2))
-- . op 0 (fromInteger 5,3)
-- . (3,5)
-- mkRat (3,5)
-- 3%5
--
--
----------------------------------------------- 
rats9a = map cf2rat rats9
-----------------------------------------------
--
--
---------------------------------------------------------------------
--EXTRA
--
rats10::[Rational]
rats10 = bf (unfoldt step (1,1))
    where step (m,n) = (m/n,(n+m,n),(n,n+m))
--
-- Los elementos en cada nivel son los mismos que en el Stern-Brocot
-- y árboles Calkin-Wilf, pero un orden diferente de nuevo; como el
-- árbol de Stern-Brocot, este árbol también no da lugar a una
-- enumeración iterativo de los racionales.
--
--
--
--TRAZA
-- rats10 = bf (unfoldt step (1,1))
-- . bf (unfoldt step (1,1))
--   bf = concat.foldt glue 
-- . concat.foldt glue (unfoldt step (1,1))
-- .. foldt glue (unfoldt step (1,1))
-- ... unfoldt step (1,1)
--      unfoldt f     x = let (a,y,z) = f x in Node(a,unfoldt f y,unfoldt f z)
-- .... let (a,y,z) =  step (1,1) in Node(a,unfoldt step y,unfoldt step z)
-- ..... step (1,1) in Node(a,unfoldt step y,unfoldt step z)
--        step (m,n) =   (m/n,(n+m,n),(n,n+m))
-- ..... (1%1,(2,1),(1,2)) in Node(a,unfoldt step y,unfoldt step z)
-- .... let (a,y,z) = (1%1,(2,1),(1,2)) in Node(a,unfoldt step y,unfoldt step z)
-- .... Node(1%1,unfoldt step (2,1)(1,2),unfoldt step (1,2)(2,1))
-- ... unfoldt step (1,1) = Node(1%1,unfoldt step (2,1),unfoldt step (1,2))
-- .. foldt glue (Node(1%1,unfoldt step (2,1),unfoldt step (1,2)) )
--     foldt f    (Node(a,x,y)) = f (a,foldt f x,foldt f y)
-- .. glue (1%1,foldt glue (unfoldt step (2,1)),foldt glue (unfoldt step (1,2)))
--     glue (a,xs,ys) = [a]:zipWith (++) xs ys
-- .. [1%1]:zipWith (++) (foldt glue (unfoldt step (2,1))) (foldt glue (unfoldt step (1,2)))
-- . concat [1%1]:zipWith (++) (foldt glue (unfoldt step (2,1))) (foldt glue (unfoldt step (1,2)))

-- Eficiencia
-- Con la siguiente funcion 
h = length (take (10^8) rats10)
-- como length y take son las mismas para todos los argumentos entonces
-- la variacion del los valores de tiempo de ejecucion y consumo de
-- memoria dependeran de la evakuacion de los argumentos, es decir, de
-- como se generan los numeros racionales. Hay que tener
-- en cuenta que las dos primeras definiciones generan duplicadoscon lo
-- que su eficiencia es menor.  
--
--
--        |100 = 10^2                |1 000 = 10^3              |10 000 = 10^4  
---------------------------------------------------------------------------------------------------------------------------
-- rats1  |(0.00 secs, 2098856 bytes)|(0.14 secs, 3227372 bytes)|(0.02 secs, 3145960 bytes)|
-- rats2  |(0.00 secs, 2123392 bytes)|(0.00 secs, 2616724 bytes)|(0.03 secs, 7323280 bytes)|
-- rats3  |(0.00 secs, 2104648 bytes)|(0.02 secs, 2115448 bytes)|(0.02 secs, 3696572 bytes)|
-- rats4  |(0.00 secs, 2117156 bytes)|(0.02 secs, 2665632 bytes)|(0.06 secs, 11989724 bytes)|
-- rats5  |(0.00 secs, 2118316 bytes)|(0.02 secs, 2119288 bytes)|(0.02 secs, 4176880 bytes)|
-- rats6  |(0.02 secs, 2117888 bytes)|(0.02 secs, 2620132 bytes)|(0.08 secs, 12508356 bytes)|
-- rats7  |(0.02 secs, 2118732 bytes)|(0.00 secs, 2117604 bytes)|(0.02 secs, 3188408 bytes)|
-- rats8  |(0.00 secs, 2117332 bytes)|(0.00 secs, 2118444 bytes)|(0.02 secs, 2624480 bytes)|
-- rats9  |(0.00 secs, 2069792 bytes)|(0.00 secs, 2116352 bytes)|(0.02 secs, 3195336 bytes)|
-- rats9a |(0.00 secs, 1549436 bytes)|(0.02 secs, 2670772 bytes)|(0.02 secs, 3710164 bytes)|
-- rats10 |(0.00 secs, 2672300 bytes)|(0.00 secs, 3189840 bytes)|(0.08 secs, 11938204 bytes)|
---------------------------------------------------------------------------------------------------------------------------
--
--        |100 000 = 10^5             |1 000 000 = 10^6            |10 000 000 = 10^7    
---------------------------------------------------------------------------------------------------------------------------
-- rats1  |(0.03 secs, 16715988 bytes)|(0.28 secs, 146384432 bytes)|(4.88 secs, 1444329124 bytes)|
-- rats2  |(0.19 secs, 54879948 bytes)|(2.02 secs, 524377168 bytes)|(20.67 secs, 5208911740 bytes)|
-- rats3  |(0.09 secs, 18658508 bytes)|(1.16 secs, 167762516 bytes)|(11.08 secs, 1661841420 bytes)|
-- rats4  |(0.80 secs, 92414808 bytes)|(6.66 secs, 823758332 bytes)| out of memory|
-- rats5  |(0.17 secs, 23726992 bytes)|(1.28 secs, 218124796 bytes)|(11.64 secs, 2161602888 bytes)|
-- rats6  |(0.81 secs, 92937068 bytes)|(6.66 secs, 823778588 bytes)| out of memory|
-- rats7  |(0.02 secs, 9461692 bytes) |(0.19 secs, 74215288 bytes) |(1.94 secs, 722310896 bytes)|
-- rats8  |(0.00 secs, 8891312 bytes) |(0.17 secs, 74216932 bytes) |(2.00 secs, 722316560 bytes)|
-- rats9  |(0.02 secs, 9460112 bytes) |(0.17 secs, 74215196 bytes) |(2.00 secs, 722316784 bytes)|
-- rats9a |(0.02 secs, 14105252 bytes)|(0.42 secs, 118556424 bytes)|(3.58 secs, 1162073672 bytes)|
-- rats10 |(0.81 secs, 92933524 bytes)|(6.67 secs, 823772748 bytes)|out of memory|
-- ---------------------------------------------------------------------

--
--        |100 000 000 = 10^8             
-- -------+------------------
-- rats1  | out of memory
-- rats2  | out of memory
-- rats3  | out of memory
-- rats4  | out of memory
-- rats5  | out of memory
-- rats6  | out of memory
-- rats7  | out of memory
-- rats8  | out of memory
-- rats9  | out of memory
-- rats9a | out of memory
-- rats10 | out of memory
</source>