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(diagsm<-[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/n|m<-[1..]]|n<-[2..]] -- diags' xss (ys :yss) -- diags' 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..]:diags' ([m/2|m<-[1..]]:m<-[2..]) [m/n|m<-[1..]]|n<-[3..]] -- .. :diags' ([m/2|m<-[1..]]:m<-[2..]) [m/n|m<-[1..]]|n<-[3..]] -- .. :diags' (m<-[1..,[m/1|m<-[2..]]]) [m/n|m<-[1..]]|n<-[3..]] -- diags' xss (ys :yss) -- diags' 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<-[1..,[m/1|m<-[2..]]] -- :diags' ([m/3|m<-[1..]] -- :map tailm<-[1..,[m/1|m<-[2..]]]) [m/n|m<-[1..]]|n<-[4..]] -- -- map head m<-[1..,[m/1|m<-[2..]]] -- :diags' ([m/3|m<-[1..]] -- :m<-[2..,[m/1|m<-[3..]]]) [m/n|m<-[1..]]|n<-[4..]] -- -- ---------------------------------------------------------------------

-- De manera equivalente, se pueden generar directamente las diagonales -- rats2 ::[Rational] rats2 = concatm<-[1..d-1|d<-[2..]] -- -- -- TRAZA -- rats2 = concatm<-[1..d-1|d<-[2..]] -- .. = .. m<-[1..2-1|d<-[3..]] -- m<-[1|d<-[3..]] -- 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

-- -- |100 000 = 10^5 |1 000 000 = 10^6 |10 000 000 = 10^7

Enumeración de los racionales

Menú de navegación

Herramientas personales

Espacios de nombres

Variantes

Vistas

Más

Buscar

the CLG Wiki

Herramientas