fst

Precisión de aproximaciones de pi

PorJosé A. Alonso 27-febrero-20176-marzo-2017

La precisión de una aproximación x de pi es el número de dígitos comunes entre el inicio de x y de pi. Por ejemplo, puesto que 355/113 es 3.1415929203539825 y pi es 3.141592653589793, la precisión de 355/113 es 7.

Definir las siguientes funciones

   mayorPrefijoComun :: Eq a => [a] -> [a] -> [a]
   precisionPi       :: Double -> Int
   precisionPiCR     :: CReal -> Int

mayorPrefijoComun :: Eq a => [a] -> [a] -> [a]

precisionPi :: Double -> Int

precisionPiCR :: CReal -> Int

tales que

(mayorPrefijoComun xs ys) es el mayor prefijo común de xs e ys. Por ejemplo,

     mayorPrefijoComun []      [2,3,4,5]  ==  []
     mayorPrefijoComun [2,3,5] []         ==  []
     mayorPrefijoComun [2,3,5] [2,3,4,5]  ==  [2,3]
     mayorPrefijoComun [2,3,5] [2,5,3,4]  ==  [2]
     mayorPrefijoComun [2,3,5] [5,2,3,4]  ==  []

mayorPrefijoComun [] [2,3,4,5] == []

mayorPrefijoComun [2,3,5] [] == []

mayorPrefijoComun [2,3,5] [2,3,4,5] == [2,3]

mayorPrefijoComun [2,3,5] [2,5,3,4] == [2]

mayorPrefijoComun [2,3,5] [5,2,3,4] == []

(precisionPi x) es la precisión de la aproximación de pi x. Por ejemplo,

     precisionPi (25/8)              ==  2
     precisionPi (22/7)              ==  3
     precisionPi (sqrt 2 + sqrt 3)   ==  3
     precisionPi (377/120)           ==  4
     precisionPi (31**(1/3))         ==  4
     precisionPi (7^7/4^9)           ==  5
     precisionPi (355/113)           ==  7
     precisionPi ((2143/22)**(1/4))  ==  9

precisionPi (25/8) == 2

precisionPi (22/7) == 3

precisionPi (sqrt 2 + sqrt 3) == 3

precisionPi (377/120) == 4

precisionPi (31**(1/3)) == 4

precisionPi (7^7/4^9) == 5

precisionPi (355/113) == 7

precisionPi ((2143/22)**(1/4)) == 9

(precisionPiCR x) es la precisión de la aproximación de pi x, como números reales. Por ejemplo,

     precisionPiCR (log (640320^3+744)/(sqrt 163))                        == 31
     precisionPiCR (log (5280^3*(236674+30303*sqrt 61)^3+744)/(sqrt 427)) == 53

1 2	precisionPiCR (log (640320^3+744)/(sqrt 163)) == 31 precisionPiCR (log (5280^3(236674+30303sqrt 61)^3+744)/(sqrt 427)) == 53

Nota: Para la definición precisionPiCR se usa la librería Data.Number.CReal que se instala con

   cabal install numbers

1	cabal install numbers

Soluciones

import Data.Number.CReal

-- mayorPrefijoComún
-- =================

-- 1ª definición
mayorPrefijoComun :: Eq a => [a] -> [a] -> [a]
mayorPrefijoComun [] _ = []
mayorPrefijoComun _ [] = []
mayorPrefijoComun (x:xs) (y:ys)
  | x == y    = x : mayorPrefijoComun xs ys
  | otherwise = []

-- 2ª definición
mayorPrefijoComun2 :: Eq a => [a] -> [a] -> [a]
mayorPrefijoComun2 xs ys =
  [x | (x,y) <- takeWhile (\(x,y) -> x == y) (zip xs ys)] 

-- 3ª definición
mayorPrefijoComun3 :: Eq a => [a] -> [a] -> [a]
mayorPrefijoComun3 xs ys =
  [x | (x,y) <- takeWhile (uncurry (==)) (zip xs ys)] 

-- 4ª definición
mayorPrefijoComun4 :: Eq a => [a] -> [a] -> [a]
mayorPrefijoComun4 xs =
  map fst . takeWhile (uncurry (==)) . zip xs

-- 5ª definición
mayorPrefijoComun5 :: Eq a => [a] -> [a] -> [a]
mayorPrefijoComun5 =
  ((map fst . takeWhile (uncurry (==))) .) . zip

-- precisionPi
-- ===========

-- 1ª definición
precisionPi :: Double -> Int
precisionPi x =
  length (mayorPrefijoComun xs ys) - 1
  where xs = show x
        ys = show pi

-- 2ª definición
precisionPi2 :: Double -> Int
precisionPi2 =
  pred . length . mayorPrefijoComun (show pi) . show

-- precisionPiCR
-- =============

precisionPiCR :: CReal -> Int
precisionPiCR = aux 50
  where aux n x | p < n-1   = p
                | otherwise = aux (n+50) x
          where p = precisionPiCRHasta n x

-- (precisionPiCRHasta n x) es la precisión de pi acotada por n. Por
-- ejemplo,
--    precisionPiCRHasta 1 3.14   ==  2
--    precisionPiCRHasta 5 3.14   ==  3
--    precisionPiCRHasta 5 3.142  ==  3
--    precisionPiCRHasta 5 3.141  ==  4
precisionPiCRHasta :: Int -> CReal -> Int
precisionPiCRHasta n x =
  length (mayorPrefijoComun xs ys) - 1
  where xs = showCReal n x
        ys = showCReal n pi

import Data.Number.CReal

-- mayorPrefijoComún

-- =================

-- 1ª definición

mayorPrefijoComun :: Eq a => [a] -> [a] -> [a]

mayorPrefijoComun [] _ = []

mayorPrefijoComun _ [] = []

mayorPrefijoComun (x:xs) (y:ys)

| x == y = x : mayorPrefijoComun xs ys

| otherwise = []

-- 2ª definición

mayorPrefijoComun2 :: Eq a => [a] -> [a] -> [a]

mayorPrefijoComun2 xs ys =

[x | (x,y) <- takeWhile (\(x,y) -> x == y) (zip xs ys)]

-- 3ª definición

mayorPrefijoComun3 :: Eq a => [a] -> [a] -> [a]

mayorPrefijoComun3 xs ys =

[x | (x,y) <- takeWhile (uncurry (==)) (zip xs ys)]

-- 4ª definición

mayorPrefijoComun4 :: Eq a => [a] -> [a] -> [a]

mayorPrefijoComun4 xs =

map fst . takeWhile (uncurry (==)) . zip xs

-- 5ª definición

mayorPrefijoComun5 :: Eq a => [a] -> [a] -> [a]

mayorPrefijoComun5 =

((map fst . takeWhile (uncurry (==))) .) . zip

-- precisionPi

-- ===========

-- 1ª definición

precisionPi :: Double -> Int

precisionPi x =

length (mayorPrefijoComun xs ys) - 1

where xs = show x

ys = show pi

-- 2ª definición

precisionPi2 :: Double -> Int

precisionPi2 =

pred . length . mayorPrefijoComun (show pi) . show

-- precisionPiCR

-- =============

precisionPiCR :: CReal -> Int

precisionPiCR = aux 50

where aux n x | p < n-1 = p

| otherwise = aux (n+50) x

where p = precisionPiCRHasta n x

-- (precisionPiCRHasta n x) es la precisión de pi acotada por n. Por

-- ejemplo,

-- precisionPiCRHasta 1 3.14 == 2

-- precisionPiCRHasta 5 3.14 == 3

-- precisionPiCRHasta 5 3.142 == 3

-- precisionPiCRHasta 5 3.141 == 4

precisionPiCRHasta :: Int -> CReal -> Int

precisionPiCRHasta n x =

length (mayorPrefijoComun xs ys) - 1

where xs = showCReal n x

ys = showCReal n pi

Prefijo con suma acotada

PorJosé A. Alonso 7-febrero-201714-febrero-2017

Definir la función

   prefijoAcotado :: (Num a, Ord a) => a -> [a] -> [a]

1	prefijoAcotado :: (Num a, Ord a) => a -> [a] -> [a]

tal que (prefijoAcotado x ys) es el mayor prefijo de ys cuya suma es menor que x. Por ejemplo,

   prefijoAcotado 10 [3,2,5,7]  ==  [3,2]
   prefijoAcotado 10 [1..]      ==  [1,2,3]

1 2	prefijoAcotado 10 [3,2,5,7] == [3,2] prefijoAcotado 10 [1..] == [1,2,3]

Soluciones

-- 1ª definición (por recursión):
prefijoAcotado :: (Num a, Ord a) => a -> [a] -> [a]
prefijoAcotado x [] = []
prefijoAcotado x (y:ys)
  | y < x     = y : prefijoAcotado (x-y) ys
  | otherwise = []

-- 2ª definición (con scanl1 y takeWhile):
prefijoAcotado2 :: (Num a, Ord a) => a -> [a] -> [a]
prefijoAcotado2 x ys = map fst conSumasAcotadas
  where 
    sumas            = scanl1 (+) ys 
    conSumas         = zip ys sumas
    conSumasAcotadas = takeWhile (\(a,b) -> b < x) conSumas

-- 3ª definición (con (.)):
prefijoAcotado3 :: (Num a, Ord a) => a -> [a] -> [a]
prefijoAcotado3 x ys = map fst conSumasAcotadas
  where 
    sumas            = scanl1 (+) ys 
    conSumas         = zip ys sumas
    conSumasAcotadas = takeWhile ((<x) . snd) conSumas

-- 4ª definición:
prefijoAcotado4 :: (Num a, Ord a) => a -> [a] -> [a]
prefijoAcotado4 x ys = 
    map fst (takeWhile ((<x) . snd) (zip ys (scanl1 (+) ys)))

-- 1ª definición (por recursión):

prefijoAcotado :: (Num a, Ord a) => a -> [a] -> [a]

prefijoAcotado x [] = []

prefijoAcotado x (y:ys)

| y < x = y : prefijoAcotado (x-y) ys

| otherwise = []

-- 2ª definición (con scanl1 y takeWhile):

prefijoAcotado2 :: (Num a, Ord a) => a -> [a] -> [a]

prefijoAcotado2 x ys = map fst conSumasAcotadas

where

sumas = scanl1 (+) ys

conSumas = zip ys sumas

conSumasAcotadas = takeWhile (\(a,b) -> b < x) conSumas

-- 3ª definición (con (.)):

prefijoAcotado3 :: (Num a, Ord a) => a -> [a] -> [a]

prefijoAcotado3 x ys = map fst conSumasAcotadas

where

sumas = scanl1 (+) ys

conSumas = zip ys sumas

conSumasAcotadas = takeWhile ((<x) . snd) conSumas

-- 4ª definición:

prefijoAcotado4 :: (Num a, Ord a) => a -> [a] -> [a]

prefijoAcotado4 x ys =

map fst (takeWhile ((<x) . snd) (zip ys (scanl1 (+) ys)))

Sucesión de Cantor de números innombrables

PorJosé A. Alonso 3-febrero-201725-abril-2021

Un número es innombrable si es divisible por 7 o alguno de sus dígitos es un 7. Un juego infantil consiste en contar saltándose los números innombrables:

   1 2 3 4 5 6 ( ) 8 9 10 11 12 13 ( ) 15 16 ( ) 18 ...

1	1 2 3 4 5 6 ( ) 8 9 10 11 12 13 ( ) 15 16 ( ) 18 ...

La sucesión de Cantor se obtiene llenando los huecos de la sucesión anterior
como se indica a continuación:

  1 2 3 4 5 6 (1) 8 9 10 11 12 13 (2) 15 16 (3) 18 19 20 (4) 22 23
  24 25 26 (5) (6) 29 30 31 32 33 34 (1) 36 (8) 38 39 40 41  (9) 43
  44 45 46 (10) 48 (11) 50 51 52 53 54 55 (12) (13) 58 59 60 61 62
  (2) 64 65 66 (15) 68 69 (16) (3) (18) (19) (20) (4) (22) (23) (24)
  (25) 80 81 82 83 (26) 85 86 (5) 88 89 90 (6) 92 93 94 95 96 (29)
  (30) 99 100

1 2 3 4 5 6 (1) 8 9 10 11 12 13 (2) 15 16 (3) 18 19 20 (4) 22 23

24 25 26 (5) (6) 29 30 31 32 33 34 (1) 36 (8) 38 39 40 41 (9) 43

44 45 46 (10) 48 (11) 50 51 52 53 54 55 (12) (13) 58 59 60 61 62

(2) 64 65 66 (15) 68 69 (16) (3) (18) (19) (20) (4) (22) (23) (24)

(25) 80 81 82 83 (26) 85 86 (5) 88 89 90 (6) 92 93 94 95 96 (29)

(30) 99 100

Definir la sucesión

   sucCantor :: [Integer]

1	sucCantor :: [Integer]

cuyos elementos son los términos de la sucesión de Cantor. Por ejemplo,

   λ> take 100 sucCantor
   [1,2,3,4,5,6, 1 ,8,9,10,11,12,13, 2, 15,16, 3, 18,19,20, 4,
    22,23,24,25,26, 5 , 6 ,29,30,31,32,33,34, 1 ,36 , 8 ,38,39,
    40,41, 9 ,43,44,45,46, 10 ,48, 11 ,50,51,52,53,54,55 , 12 ,
    13, 58,59,60,61,62, 2 ,64,65,66, 15 ,68,69, 16 , 3 , 18, 19,
    20, 4, 22, 23, 24 ,25 ,80,81,82,83, 26 ,85,86, 5 ,88,89,90,
    6, 92,93,94,95,96, 29, 30 ,99,100]

   λ> sucCantor2 !! (5+10^6)
   544480

   λ> sucCantor2 !! (6+10^6)
   266086

λ> take 100 sucCantor

[1,2,3,4,5,6, 1 ,8,9,10,11,12,13, 2, 15,16, 3, 18,19,20, 4,

22,23,24,25,26, 5 , 6 ,29,30,31,32,33,34, 1 ,36 , 8 ,38,39,

40,41, 9 ,43,44,45,46, 10 ,48, 11 ,50,51,52,53,54,55 , 12 ,

13, 58,59,60,61,62, 2 ,64,65,66, 15 ,68,69, 16 , 3 , 18, 19,

20, 4, 22, 23, 24 ,25 ,80,81,82,83, 26 ,85,86, 5 ,88,89,90,

6, 92,93,94,95,96, 29, 30 ,99,100]

λ> sucCantor2 !! (5+10^6)

544480

λ> sucCantor2 !! (6+10^6)

266086

Soluciones

-- 1ª solución
-- ===========

sucCantor1 :: [Integer]
sucCantor1 = map fst $ scanl f (1,0) [2..]
  where f (a,i) x
          | esInnombrable x = (sucCantor1 !! i, i+1)
          | otherwise       = (x,i)


esInnombrable :: Integer -> Bool
esInnombrable x =
  rem x 7 == 0 || '7' `elem` show x

-- 2ª solución
-- ===========

sucCantor2 :: [Integer]
sucCantor2 = aux 0 1
  where aux i x
          | esInnombrable x = sucCantor2 !! i : aux (i+1) (x+1)
          | otherwise       = x : aux i (x+1)

-- 1ª solución

-- ===========

sucCantor1 :: [Integer]

sucCantor1 = map fst $ scanl f (1,0) [2..]

where f (a,i) x

| esInnombrable x = (sucCantor1 !! i, i+1)

| otherwise = (x,i)

esInnombrable :: Integer -> Bool

esInnombrable x =

rem x 7 == 0 || '7' `elem` show x

-- 2ª solución

-- ===========

sucCantor2 :: [Integer]

sucCantor2 = aux 0 1

where aux i x

| esInnombrable x = sucCantor2 !! i : aux (i+1) (x+1)

| otherwise = x : aux i (x+1)

Referencia

Basado en Cantor’s unspeakable numbers de
CodeGolf.

Día de la semana

PorJosé A. Alonso 21-diciembre-201628-diciembre-2016

Definir la función

   dia :: Int -> Int -> Int -> String

1	dia :: Int -> Int -> Int -> String

tal que (dia d m a) es el día de la semana correspondiente al día d del mes m del año a. Por ejemplo,

   dia 21 12 2016  ==  "Miercoles"
   dia 14  4 1936  ==  "Martes"

1 2	dia 21 12 2016 == "Miercoles" dia 14 4 1936 == "Martes"

Nota: Este ejercicio ha sido propuesto por Miguel Ibáñez.

Soluciones

-- 1ª solución
-- ===========

-- Comentario: usar que el 1-1-2007 cayó en lunes

dSem :: [(String,Int)]
dSem = [("Lunes",0),("Martes",1),("Miercoles",2),("Jueves",3),
        ("Viernes",4),("Sabado",5),("Domingo",6)]

dMes :: [(Int,Int)]
dMes = [(1,31),(2,28),(3,31),( 4,30),( 5,31),( 6,30),
        (7,31),(8,31),(9,30),(10,31),(11,30),(12,31)]

busca :: a -> [(a1,a2)] -> (a -> a1 -> Bool) -> [(a1,a2)]
busca x xs p  =  [(x',y) | (x',y) <- xs, p x x']

diaAno :: (Int,Int,Int) -> Int
diaAno (d,m,a)  =  d + sum [y | (x,y) <- busca m dMes (>)]

dia :: Int -> Int -> Int -> String
dia d m a = head [fst (x,y') | (x,y') <- dSem, n == y']
  where  n = mod ((diaAno (d,m,a) + (a - 2007)*365) + x) 7
         x | d <= 29 && m <= 2  =  div (a - 2007) 4 - 1
           | otherwise          =  div (a - 2007) 4


-- 2ª solución
-- ===========

-- Usando la congruencia de Zeller http://bit.ly/2gYxHym

dia2 :: Int -> Int -> Int -> String
dia2 d m a = diasSemana !! h
  where m1 = if   (m < 3)
             then m + 12
             else m

        a1 = if   (m1 > 12)
             then a - 1
             else a

        k  = a1 `mod` 100
        j  = a1 `div` 100

        h  = ( d
             + ((13 * (m1 + 1)) `div` 5)
             + k
             + (k `div` 4)
             + (j `div` 4)
             - (2 * j)
             ) `mod` 7

diasSemana :: [String]
diasSemana = [ "Sabado" 
             , "Domingo"
             , "Lunes" 
             , "Martes"
             , "Miercoles"
             , "Jueves"
             , "Viernes"]

-- 1ª solución

-- ===========

-- Comentario: usar que el 1-1-2007 cayó en lunes

dSem :: [(String,Int)]

dSem = [("Lunes",0),("Martes",1),("Miercoles",2),("Jueves",3),

("Viernes",4),("Sabado",5),("Domingo",6)]

dMes :: [(Int,Int)]

dMes = [(1,31),(2,28),(3,31),( 4,30),( 5,31),( 6,30),

(7,31),(8,31),(9,30),(10,31),(11,30),(12,31)]

busca :: a -> [(a1,a2)] -> (a -> a1 -> Bool) -> [(a1,a2)]

busca x xs p = [(x',y) | (x',y) <- xs, p x x']

diaAno :: (Int,Int,Int) -> Int

diaAno (d,m,a) = d + sum [y | (x,y) <- busca m dMes (>)]

dia :: Int -> Int -> Int -> String

dia d m a = head [fst (x,y') | (x,y') <- dSem, n == y']

where n = mod ((diaAno (d,m,a) + (a - 2007)*365) + x) 7

x | d <= 29 && m <= 2 = div (a - 2007) 4 - 1

| otherwise = div (a - 2007) 4

-- 2ª solución

-- ===========

-- Usando la congruencia de Zeller http://bit.ly/2gYxHym

dia2 :: Int -> Int -> Int -> String

dia2 d m a = diasSemana !! h

where m1 = if (m < 3)

then m + 12

else m

a1 = if (m1 > 12)

then a - 1

else a

k = a1 `mod` 100

j = a1 `div` 100

h = ( d

+ ((13 * (m1 + 1)) `div` 5)

+ k

+ (k `div` 4)

+ (j `div` 4)

- (2 * j)

) `mod` 7

diasSemana :: [String]

diasSemana = [ "Sabado"

, "Domingo"

, "Lunes"

, "Martes"

, "Miercoles"

, "Jueves"

, "Viernes"]

Distancia a Erdős

PorJosé A. Alonso 14-diciembre-201621-diciembre-2016

Una de las razones por la que el matemático húngaro Paul Erdős es conocido es por la multitud de colaboraciones que realizó durante toda su carrera, un total de 511. Tal es así que se establece la distancia a Erdős como la distancia que has estado de coautoría con Erdős. Por ejemplo, si eres Paul Erdős tu distancia a Erdős es 0, si has escrito un artículo con Erdős tu distancia es 1, si has escrito un artículo con alguien que ha escrito un artículo con Erdős tu distancia es 2, etc. El objetivo de este problema es definir una función que a partir de una lista de pares de coautores y un número natural n calcular la lista de los matemáticos a una distancia n de Erdős.

Para el problema se considerará la siguiente lista de coautores

   coautores :: [(String,String)]
   coautores =
     [("Paul Erdos","Ernst Straus"),("Paul Erdos","Pascual Jordan"),
      ("Paul Erdos","D. Kleitman"),("Albert Einstein","Ernst Straus"),
      ("John von Newmann","David Hilbert"),("S. Glashow","D. Kleitman"),
      ("John von Newmann","Pascual Jordan"), ("David Pines","D. Bohm"),
      ("Albert Einstein","Otto Stern"),("S. Glashow", "M. Gell-Mann"),
      ("Richar Feynman","M. Gell-Mann"),("M. Gell-Mann","David Pines"),
      ("David Pines","A. Bohr"),("Wolfgang Pauli","Albert Einstein"),
      ("D. Bohm","L. De Broglie"), ("Paul Erdos","J. Conway"),
      ("J. Conway", "P. Doyle"),("Paul Erdos","A. J. Granville"),
      ("A. J. Granville","B. Mazur"),("B. Mazur","Andrew Wiles")]

coautores :: [(String,String)]

coautores =

[("Paul Erdos","Ernst Straus"),("Paul Erdos","Pascual Jordan"),

("Paul Erdos","D. Kleitman"),("Albert Einstein","Ernst Straus"),

("John von Newmann","David Hilbert"),("S. Glashow","D. Kleitman"),

("John von Newmann","Pascual Jordan"), ("David Pines","D. Bohm"),

("Albert Einstein","Otto Stern"),("S. Glashow", "M. Gell-Mann"),

("Richar Feynman","M. Gell-Mann"),("M. Gell-Mann","David Pines"),

("David Pines","A. Bohr"),("Wolfgang Pauli","Albert Einstein"),

("D. Bohm","L. De Broglie"), ("Paul Erdos","J. Conway"),

("J. Conway", "P. Doyle"),("Paul Erdos","A. J. Granville"),

("A. J. Granville","B. Mazur"),("B. Mazur","Andrew Wiles")]

La lista anterior es real y se ha obtenido del artículo Famous trails to Paul Erdős.

Definir la función

   numeroDeErdos :: [(String, String)] -> Int -> [String]

1	numeroDeErdos :: [(String, String)] -> Int -> [String]

tal que (numeroDeErdos xs n) es la lista de lista de los matemáticos de la
lista de coautores xs que se encuentran a una distancia n de Erdős. Por ejemplo,

   λ> numeroDeErdos coautores 0
   ["Paul Erdos"]
   λ> numeroDeErdos coautores 1
   ["Ernst Straus","Pascual Jordan","D. Kleitman","J. Conway","A. J. Granville"]
   λ> numeroDeErdos coautores 2
   ["Albert Einstein","John von Newmann","S. Glashow","P. Doyle","B. Mazur"]

λ> numeroDeErdos coautores 0

["Paul Erdos"]

λ> numeroDeErdos coautores 1

["Ernst Straus","Pascual Jordan","D. Kleitman","J. Conway","A. J. Granville"]

λ> numeroDeErdos coautores 2

["Albert Einstein","John von Newmann","S. Glashow","P. Doyle","B. Mazur"]

Nota: Este ejercicio ha sido propuesto por Enrique Naranjo.

Soluciones

data Arbol a = N a [Arbol a]
             deriving Show 

coautores :: [(String,String)]
coautores =
  [("Paul Erdos","Ernst Straus"),("Paul Erdos","Pascual Jordan"),
   ("Paul Erdos","D. Kleitman"),("Albert Einstein","Ernst Straus"),
   ("John von Newmann","David Hilbert"),("S. Glashow","D. Kleitman"),
   ("John von Newmann","Pascual Jordan"), ("David Pines","D. Bohm"),
   ("Albert Einstein","Otto Stern"),("S. Glashow", "M. Gell-Mann"),
   ("Richar Feynman","M. Gell-Mann"),("M. Gell-Mann","David Pines"),
   ("David Pines","A. Bohr"),("Wolfgang Pauli","Albert Einstein"),
   ("D. Bohm","L. De Broglie"), ("Paul Erdos","J. Conway"),
   ("J. Conway", "P. Doyle"),("Paul Erdos","A. J. Granville"),
   ("A. J. Granville","B. Mazur"),("B. Mazur","Andrew Wiles")]

-- 1ª solución
-- ===========

numeroDeErdos :: [(String, String)] -> Int -> [String]
numeroDeErdos xs n = nivel n (arbolDeErdos xs "Paul Erdos")

-- (arbolDeErdos xs a) es el árbol de coautores de a según la lista de
-- coautores xs. Por ejemplo,
--    λ> arbolDeErdos coautores "Paul Erdos"
--    N "Paul Erdos"
--      [N "Ernst Straus"
--         [N "Albert Einstein"
--           [N "Wolfgang Pauli" [],
--            N "Otto Stern" []]],
--          N "Pascual Jordan"
--            [N "John von Newmann"
--               [N "David Hilbert" []]],
--          N "D. Kleitman"
--            [N "S. Glashow"
--               [N "M. Gell-Mann"
--                  [N "Richar Feynman" [],
--                   N "David Pines"
--                     [N "A. Bohr" [],
--                      N "D. Bohm"
--                        [N "L. De Broglie" []]]]]],
--          N "J. Conway"
--            [N "P. Doyle" []],
--             N "A. J. Granville"
--               [N "B. Mazur"
--                  [N "Andrew Wiles" []]]]
arbolDeErdos :: [(String, String)] -> String -> Arbol String
arbolDeErdos xs a =
  N a [arbolDeErdos noColaboradores n | n <- colaboradores]
  where
    colaboradores   = [filtra a (x,y) | (x,y) <- xs, x == a || y == a]
    filtra a (x,y) | a == x    = y
                   | otherwise = x
    noColaboradores = [(x,y) | (x,y) <- xs, x /= a, y /= a]

-- (nivel n a) es la lista de los elementos del árbol a en el nivel
-- n. Por ejemplo,      
--    nivel 0 (N 3 [N 5 [N 6 []], N 7 [N 9 []]])   ==  [3]
--    nivel 1 (N 3 [N 5 [N 6 []], N 7 [N 9 []]])   ==  [5,7]
--    nivel 2 (N 3 [N 5 [N 6 []], N 7 [N 9 []]])   ==  [6,9]
nivel :: Int -> Arbol a -> [a]
nivel 0 (N a xs) = [a]
nivel n (N a xs) = concatMap (nivel (n-1)) xs

-- 2ª solución
-- ===========

numeroDeErdos2 :: [(String, String)] -> Int -> [String]
numeroDeErdos2 = auxC ["Paul Erdos"] 
  where
    auxC v xs 0 = v
    auxC v xs x = auxC  (n v) (m v xs) (x-1)
      where n v =     [a | (a,b) <- xs, elem b v] ++
                      [b | (a,b) <- xs, elem a v]
            m ys xs = [(a,b) | (a,b) <- xs
                             , notElem a ys && notElem b ys]

-- 3ª solución
-- ===========

numeroDeErdos3 :: [(String, String)] -> Int -> [String]
numeroDeErdos3 ps n = (sucCoautores "Paul Erdos" ps) !! n

-- (sucCoautores a ps) es la sucesión de coautores de a en ps ordenados
-- por diatancia. Por ejemplo, 
--    λ> take 3 (sucCoautores "Paul Erdos" coautores)
--    [["Paul Erdos"],
--     ["Ernst Straus","Pascual Jordan","D. Kleitman","J. Conway",
--      "A. J. Granville"],
--     ["Albert Einstein","John von Newmann","S. Glashow","P. Doyle",
--      "B. Mazur"]]
--    λ> sucCoautores "Albert Einstein" coautores
--    [["Albert Einstein"],
--     ["Ernst Straus","Otto Stern","Wolfgang Pauli"],
--     ["Paul Erdos"],
--     ["Pascual Jordan","D. Kleitman","J. Conway", "A. J. Granville"],
--     ["John von Newmann","S. Glashow","P. Doyle","B. Mazur"],
--     ["David Hilbert","M. Gell-Mann","Andrew Wiles"],
--     ["David Pines","Richar Feynman"],
--     ["D. Bohm","A. Bohr"],
--     ["L. De Broglie"]]
sucCoautores :: String -> [(String, String)] -> [[String]]
sucCoautores a ps =
  takeWhile (not . null) (map fst (iterate sig ([a], as \\ [a])))
  where as = elementos ps
        sig (xs,ys) = (zs,ys \\ zs)
          where zs = [y | y <- ys
                        , or [elem (x,y) ps || elem (y,x) ps | x <- xs]]

-- (elementos ps) es la lista de los elementos de los pares ps. Por
-- ejemplo,
--    elementos [(1,3),(3,2),(1,5)]  ==  [1,3,2,5]
elementos :: Eq a => [(a, a)] -> [a]
elementos = nub . (concatMap (\(x,y) -> [x,y]))

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

data Arbol a = N a [Arbol a]

deriving Show

coautores :: [(String,String)]

coautores =

[("Paul Erdos","Ernst Straus"),("Paul Erdos","Pascual Jordan"),

("Paul Erdos","D. Kleitman"),("Albert Einstein","Ernst Straus"),

("John von Newmann","David Hilbert"),("S. Glashow","D. Kleitman"),

("John von Newmann","Pascual Jordan"), ("David Pines","D. Bohm"),

("Albert Einstein","Otto Stern"),("S. Glashow", "M. Gell-Mann"),

("Richar Feynman","M. Gell-Mann"),("M. Gell-Mann","David Pines"),

("David Pines","A. Bohr"),("Wolfgang Pauli","Albert Einstein"),

("D. Bohm","L. De Broglie"), ("Paul Erdos","J. Conway"),

("J. Conway", "P. Doyle"),("Paul Erdos","A. J. Granville"),

("A. J. Granville","B. Mazur"),("B. Mazur","Andrew Wiles")]

-- 1ª solución

-- ===========

numeroDeErdos :: [(String, String)] -> Int -> [String]

numeroDeErdos xs n = nivel n (arbolDeErdos xs "Paul Erdos")

-- (arbolDeErdos xs a) es el árbol de coautores de a según la lista de

-- coautores xs. Por ejemplo,

-- λ> arbolDeErdos coautores "Paul Erdos"

-- N "Paul Erdos"

-- [N "Ernst Straus"

-- [N "Albert Einstein"

-- [N "Wolfgang Pauli" [],

-- N "Otto Stern" []]],

-- N "Pascual Jordan"

-- [N "John von Newmann"

-- [N "David Hilbert" []]],

-- N "D. Kleitman"

-- [N "S. Glashow"

-- [N "M. Gell-Mann"

-- [N "Richar Feynman" [],

-- N "David Pines"

-- [N "A. Bohr" [],

-- N "D. Bohm"

-- [N "L. De Broglie" []]]]]],

-- N "J. Conway"

-- [N "P. Doyle" []],

-- N "A. J. Granville"

-- [N "B. Mazur"

-- [N "Andrew Wiles" []]]]

arbolDeErdos :: [(String, String)] -> String -> Arbol String

arbolDeErdos xs a =

N a [arbolDeErdos noColaboradores n | n <- colaboradores]

where

colaboradores = [filtra a (x,y) | (x,y) <- xs, x == a || y == a]

filtra a (x,y) | a == x = y

| otherwise = x

noColaboradores = [(x,y) | (x,y) <- xs, x /= a, y /= a]

-- (nivel n a) es la lista de los elementos del árbol a en el nivel

-- n. Por ejemplo,

-- nivel 0 (N 3 [N 5 [N 6 []], N 7 [N 9 []]]) == [3]

-- nivel 1 (N 3 [N 5 [N 6 []], N 7 [N 9 []]]) == [5,7]

-- nivel 2 (N 3 [N 5 [N 6 []], N 7 [N 9 []]]) == [6,9]

nivel :: Int -> Arbol a -> [a]

nivel 0 (N a xs) = [a]

nivel n (N a xs) = concatMap (nivel (n-1)) xs

-- 2ª solución

-- ===========

numeroDeErdos2 :: [(String, String)] -> Int -> [String]

numeroDeErdos2 = auxC ["Paul Erdos"]

where

auxC v xs 0 = v

auxC v xs x = auxC (n v) (m v xs) (x-1)

where n v = [a | (a,b) <- xs, elem b v] ++

[b | (a,b) <- xs, elem a v]

m ys xs = [(a,b) | (a,b) <- xs

, notElem a ys && notElem b ys]

-- 3ª solución

-- ===========

numeroDeErdos3 :: [(String, String)] -> Int -> [String]

numeroDeErdos3 ps n = (sucCoautores "Paul Erdos" ps) !! n

-- (sucCoautores a ps) es la sucesión de coautores de a en ps ordenados

-- por diatancia. Por ejemplo,

-- λ> take 3 (sucCoautores "Paul Erdos" coautores)

-- [["Paul Erdos"],

-- ["Ernst Straus","Pascual Jordan","D. Kleitman","J. Conway",

-- "A. J. Granville"],

-- ["Albert Einstein","John von Newmann","S. Glashow","P. Doyle",

-- "B. Mazur"]]

-- λ> sucCoautores "Albert Einstein" coautores

-- [["Albert Einstein"],

-- ["Ernst Straus","Otto Stern","Wolfgang Pauli"],

-- ["Paul Erdos"],

-- ["Pascual Jordan","D. Kleitman","J. Conway", "A. J. Granville"],

-- ["John von Newmann","S. Glashow","P. Doyle","B. Mazur"],

-- ["David Hilbert","M. Gell-Mann","Andrew Wiles"],

-- ["David Pines","Richar Feynman"],

-- ["D. Bohm","A. Bohr"],

-- ["L. De Broglie"]]

sucCoautores :: String -> [(String, String)] -> [[String]]

sucCoautores a ps =

takeWhile (not . null) (map fst (iterate sig ([a], as \\ [a])))

where as = elementos ps

sig (xs,ys) = (zs,ys \\ zs)

where zs = [y | y <- ys

, or [elem (x,y) ps || elem (y,x) ps | x <- xs]]

-- (elementos ps) es la lista de los elementos de los pares ps. Por

-- ejemplo,

-- elementos [(1,3),(3,2),(1,5)] == [1,3,2,5]

elementos :: Eq a => [(a, a)] -> [a]

elementos = nub . (concatMap (\(x,y) -> [x,y]))

Precisión de aproximaciones de pi

Soluciones

Prefijo con suma acotada

Soluciones

Sucesión de Cantor de números innombrables

Soluciones

Referencia

Día de la semana

Soluciones

Distancia a Erdős

Soluciones

Entradas recientes

Buscar

Correo electrónico