nub

Máximo producto de pares en la lista

PorJosé A. Alonso 30-enero-201726-marzo-2022

Definir la función

  maximoProducto :: [Int] -> Maybe Int

1	maximoProducto :: [Int] -> Maybe Int

tal que (maximoProducto xs) es el mayor elemento de xs que se puede escribir
como producto de dos elementos distintos de xs o Nothing, en el caso de que
ningún elemento de xs se pueda escribir como producto de dos elementos
distintos de xs, donde xs es una lista de números mayores que 0. Por ejemplo,

   maximoProducto [10, 3, 5, 30, 35]       ==  Just 30
   maximoProducto [10, 2, 2, 4, 30, 35]    ==  Just 4
   maximoProducto [17, 2, 1, 35, 30]       ==  Just 35
   maximoProducto [2,4]                    ==  Nothing
   maximoProducto [2, 5, 7, 8]             ==  Nothing
   maximoProducto [10, 2, 4, 30, 35]       ==  Nothing
   maximoProducto [1+2^n | n <- [1..10^6]] ==  Just 4611686018427387905

maximoProducto [10, 3, 5, 30, 35] == Just 30

maximoProducto [10, 2, 2, 4, 30, 35] == Just 4

maximoProducto [17, 2, 1, 35, 30] == Just 35

maximoProducto [2,4] == Nothing

maximoProducto [2, 5, 7, 8] == Nothing

maximoProducto [10, 2, 4, 30, 35] == Nothing

maximoProducto [1+2^n | n <- [1..10^6]] == Just 4611686018427387905

En el primer ejemplo, 30 es el producto de 10 y 3; en el segundo, 4 es el producto de 2 y 2 y en el tercero, 35 es el producto de 1 y 35.

Soluciones

import Data.List (delete, nub, sort)

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

maximoProducto1 :: [Int] -> Maybe Int
maximoProducto1 xs
  | null zs   = Nothing
  | otherwise = Just (head zs)
  where
    ys = reverse (sort xs)
    zs = [y | y <- ys, y `elem` productos xs]

-- (productos xs) es la lista de los números que son productos de dos
-- elementos de xs. Por ejemplo, 
--   productos [4,3,5,2]  ==  [12,20,8,15,6,10]
productos :: [Int] -> [Int]
productos xs =
  nub [y * z | y <- xs, z <- delete y xs]

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

maximoProducto2 :: [Int] -> Maybe Int
maximoProducto2 xs = aux (reverse (sort xs))
  where aux []     = Nothing
        aux (y:ys) | esProducto y xs = Just y
                   | otherwise       = aux ys

esProducto :: Int -> [Int] -> Bool
esProducto y []     = False
esProducto y (x:xs) = 
  (m == 0 && d `elem` xs) || esProducto y xs
  where (d,m) = divMod y x  

-- Comparación de eficiencia
-- =========================

--    λ> maximoProducto1 [1..10^4]
--    Just 10000
--    (2.60 secs, 0 bytes)
--    λ> maximoProducto2 [1..10^4]
--    Just 10000
--    (0.01 secs, 0 bytes)

import Data.List (delete, nub, sort)

-- 1ª solución

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

maximoProducto1 :: [Int] -> Maybe Int

maximoProducto1 xs

| null zs = Nothing

| otherwise = Just (head zs)

where

ys = reverse (sort xs)

zs = [y | y <- ys, y `elem` productos xs]

-- (productos xs) es la lista de los números que son productos de dos

-- elementos de xs. Por ejemplo,

-- productos [4,3,5,2] == [12,20,8,15,6,10]

productos :: [Int] -> [Int]

productos xs =

nub [y * z | y <- xs, z <- delete y xs]

-- 2ª solución

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

maximoProducto2 :: [Int] -> Maybe Int

maximoProducto2 xs = aux (reverse (sort xs))

where aux [] = Nothing

aux (y:ys) | esProducto y xs = Just y

| otherwise = aux ys

esProducto :: Int -> [Int] -> Bool

esProducto y [] = False

esProducto y (x:xs) =

(m == 0 && d `elem` xs) || esProducto y xs

where (d,m) = divMod y x

-- Comparación de eficiencia

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

-- λ> maximoProducto1 [1..10^4]

-- Just 10000

-- (2.60 secs, 0 bytes)

-- λ> maximoProducto2 [1..10^4]

-- Just 10000

-- (0.01 secs, 0 bytes)

La conjetura de Rodolfo

PorJosé A. Alonso 19-enero-201726-enero-2017

El pasado 1 de enero, Claudio Meller publicó el artículo La conjetura de Rodolfo que afirma que

Todos los números naturales se pueden números pueden expresarse como la suma de un capicúa y un capicúa especial (siendo los capicúas especiales los números que al quitarles los ceros finales son capicúas; por ejemplo, 32300, 50500 y 78987).

Definir las funciones

   descomposiciones               :: Integer -> [(Integer, Integer)]
   contraejemplosConjeturaRodolfo :: [Integer]

1 2	descomposiciones :: Integer -> [(Integer, Integer)] contraejemplosConjeturaRodolfo :: [Integer]

tales que

(descomposiciones x) es la lista de las descomposiciones de x como la suma de un capicúa y un capicúa especial. Por ejemplo,

     descomposiciones 1980  ==  [(99,1881),(979,1001)]
     descomposiciones 2016  ==  [(575,1441),(606,1410)]
     descomposiciones 1971  ==  [(161,1810),(1771,200),(1881,90)]

descomposiciones 1980 == [(99,1881),(979,1001)]

descomposiciones 2016 == [(575,1441),(606,1410)]

descomposiciones 1971 == [(161,1810),(1771,200),(1881,90)]

contraejemplosConjeturaRodolfo es la lista de contraejemplos de la conjetura de Rodolfo; es decir, de los números que no pueden expresarse com la suma de un capicúa y un capicúa especial. Por ejemplo,

     λ> take 12 contraejemplosConjeturaRodolfo
     [1200,1220,1240,1250,1260,1270,1280,1290,1300,1330,1350,1360]
     λ> take 12 (dropWhile (< 2000) contraejemplosConjeturaRodolfo)
     [3020,3240,3350,3460,3570,3680,3920,4030,4250,4360,4470,4580]

λ> take 12 contraejemplosConjeturaRodolfo

[1200,1220,1240,1250,1260,1270,1280,1290,1300,1330,1350,1360]

λ> take 12 (dropWhile (< 2000) contraejemplosConjeturaRodolfo)

[3020,3240,3350,3460,3570,3680,3920,4030,4250,4360,4470,4580]

Soluciones

import Data.List (nub)

descomposiciones :: Integer -> [(Integer, Integer)]
descomposiciones x =
  reducida [(y,z) | y <- takeWhile (<= x) capicuas
                  , let z = x - y
                  , esCapicuaG z]

-- capicuas es la sucesión de los números capicúas. Por ejemplo,
--    λ> take 45 capicuas
--    [0,1,2,3,4,5,6,7,8,9,11,22,33,44,55,66,77,88,99,101,111,121,131,
--     141,151,161,171,181,191,202,212,222,232,242,252,262,272,282,292,
--     303,313,323,333,343,353]
-- Se usará la 2ª definición del ejercicio "Sucesión de capicúas".
capicuas :: [Integer]
capicuas = capicuasImpares `mezcla` capicuasPares

-- capicuasPares es la sucesión del cero y las capicúas con un número
-- par de dígitos. Por ejemplo,  
--    λ> take 17 capicuasPares
--    [0,11,22,33,44,55,66,77,88,99,1001,1111,1221,1331,1441,1551,1661]
capicuasPares :: [Integer]
capicuasPares =
  [read (ns ++ reverse ns) | n <- [0..]
                           , let ns = show n]   

-- capicuasImpares es la sucesión de las capicúas con un número
-- impar de dígitos a partir de 1. Por ejemplo,  
--    λ> take 20 capicuasImpares
--    [1,2,3,4,5,6,7,8,9,101,111,121,131,141,151,161,171,181,191,202]
capicuasImpares :: [Integer]
capicuasImpares =
  [1..9] ++ [read (ns ++ [z] ++ reverse ns)
            | n <- [1..]
            , let ns = show n
            , z <- "0123456789"]   

-- (mezcla xs ys) es la lista ordenada obtenida mezclando las dos listas
-- ordenadas xs e ys, suponiendo que ambas son infinitas y con elementos
-- distintos. Por ejemplo,
--    take 10 (mezcla [2,12..] [5,15..])  ==  [2,5,12,15,22,25,32,35,42,45]
--    take 10 (mezcla [2,22..] [5,15..])  ==  [2,5,15,22,25,35,42,45,55,62]
mezcla :: Ord a => [a] -> [a] -> [a]
mezcla us@(x:xs) vs@(y:ys)
  | x < y     = x : mezcla xs vs
  | otherwise = y : mezcla us ys

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,
--    esCapicua 353   ==  True
--    esCapicua 3553  ==  True
--    esCapicua 3535  ==  False
esCapicua :: Integer -> Bool
esCapicua x =
  xs == reverse xs
  where xs = show x

esCapicuaG :: Integer -> Bool
esCapicuaG x =
  x == 0 || esCapicua (sinCerosFinales x)

--    sinCerosFinales 3405000  ==  3405
sinCerosFinales :: Integer -> Integer
sinCerosFinales x =
  read (reverse (dropWhile (== '0') (reverse (show x))))

reducida :: [(Integer, Integer)] -> [(Integer, Integer)]
reducida ps =
  nub [(x,y) | (x,y) <- ps
             , x <= y]

--    λ> take 12 contraejemplosConjeturaRodolfo
--    [1200,1220,1240,1250,1260,1270,1280,1290,1300,1330,1350,1360]
--    λ> take 12 (dropWhile (< 2000) contraejemplosConjeturaRodolfo)
--    [3020,3240,3350,3460,3570,3680,3920,4030,4250,4360,4470,4580]
contraejemplosConjeturaRodolfo :: [Integer]
contraejemplosConjeturaRodolfo =
  [x | x <- [0..]
  , null (descomposiciones x)]

import Data.List (nub)

descomposiciones :: Integer -> [(Integer, Integer)]

descomposiciones x =

reducida [(y,z) | y <- takeWhile (<= x) capicuas

, let z = x - y

, esCapicuaG z]

-- capicuas es la sucesión de los números capicúas. Por ejemplo,

-- λ> take 45 capicuas

-- [0,1,2,3,4,5,6,7,8,9,11,22,33,44,55,66,77,88,99,101,111,121,131,

-- 141,151,161,171,181,191,202,212,222,232,242,252,262,272,282,292,

-- 303,313,323,333,343,353]

-- Se usará la 2ª definición del ejercicio "Sucesión de capicúas".

capicuas :: [Integer]

capicuas = capicuasImpares `mezcla` capicuasPares

-- capicuasPares es la sucesión del cero y las capicúas con un número

-- par de dígitos. Por ejemplo,

-- λ> take 17 capicuasPares

-- [0,11,22,33,44,55,66,77,88,99,1001,1111,1221,1331,1441,1551,1661]

capicuasPares :: [Integer]

capicuasPares =

[read (ns ++ reverse ns) | n <- [0..]

, let ns = show n]

-- capicuasImpares es la sucesión de las capicúas con un número

-- impar de dígitos a partir de 1. Por ejemplo,

-- λ> take 20 capicuasImpares

-- [1,2,3,4,5,6,7,8,9,101,111,121,131,141,151,161,171,181,191,202]

capicuasImpares :: [Integer]

capicuasImpares =

[1..9] ++ [read (ns ++ [z] ++ reverse ns)

| n <- [1..]

, let ns = show n

, z <- "0123456789"]

-- (mezcla xs ys) es la lista ordenada obtenida mezclando las dos listas

-- ordenadas xs e ys, suponiendo que ambas son infinitas y con elementos

-- distintos. Por ejemplo,

-- take 10 (mezcla [2,12..] [5,15..]) == [2,5,12,15,22,25,32,35,42,45]

-- take 10 (mezcla [2,22..] [5,15..]) == [2,5,15,22,25,35,42,45,55,62]

mezcla :: Ord a => [a] -> [a] -> [a]

mezcla us@(x:xs) vs@(y:ys)

| x < y = x : mezcla xs vs

| otherwise = y : mezcla us ys

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,

-- esCapicua 353 == True

-- esCapicua 3553 == True

-- esCapicua 3535 == False

esCapicua :: Integer -> Bool

esCapicua x =

xs == reverse xs

where xs = show x

esCapicuaG :: Integer -> Bool

esCapicuaG x =

x == 0 || esCapicua (sinCerosFinales x)

-- sinCerosFinales 3405000 == 3405

sinCerosFinales :: Integer -> Integer

sinCerosFinales x =

read (reverse (dropWhile (== '0') (reverse (show x))))

reducida :: [(Integer, Integer)] -> [(Integer, Integer)]

reducida ps =

nub [(x,y) | (x,y) <- ps

, x <= y]

-- λ> take 12 contraejemplosConjeturaRodolfo

-- [1200,1220,1240,1250,1260,1270,1280,1290,1300,1330,1350,1360]

-- λ> take 12 (dropWhile (< 2000) contraejemplosConjeturaRodolfo)

-- [3020,3240,3350,3460,3570,3680,3920,4030,4250,4360,4470,4580]

contraejemplosConjeturaRodolfo :: [Integer]

contraejemplosConjeturaRodolfo =

[x | x <- [0..]

, null (descomposiciones x)]

Segmentos comunes maximales

PorJosé A. Alonso 30-diciembre-20167-enero-2017

Los segmentos de «abcd» son

   ["","a","ab","abc","abcd","b","bc","bcd","c","cd","d"]

1	["","a","ab","abc","abcd","b","bc","bcd","c","cd","d"]

Los segmentos comunes de «abcd» y «axbce» son

   ["","a","b","bc","c"]

1	["","a","b","bc","c"]

Los segmentos comunes maximales (es decir, no contenidos en otros segmentos) de «abcd» y «axbce» son

   ["a","bc"]

1	["a","bc"]

Definir la función

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

1	segmentosComunesMaximales :: Eq a => [a] -> [a] -> [[a]]

tal que (segmentosComunesMaximales xs ys) es la lista de los segmentos comunes maximales de xs e ys. Por ejemplo,

   segmentosComunesMaximales "abcd" "axbce"  ==  ["a","bc"]
   segmentosComunesMaximales [8,8] [8]       ==  [[8]]

1 2	segmentosComunesMaximales "abcd" "axbce" == ["a","bc"] segmentosComunesMaximales [8,8] [8] == [[8]]

Soluciones

import Data.List (inits, tails, isInfixOf)

segmentosComunesMaximales :: Eq a => [a] -> [a] -> [[a]]
segmentosComunesMaximales xs ys =
  nub [zs | zs <- zss
          , null [us | us <- zss, zs `isInfixOf` us, us /= zs]]
  where zss = segmentosComunes xs ys

segmentosComunes :: Eq a => [a] -> [a] -> [[a]]
segmentosComunes xs ys =
  [zs | zs <- segmentos xs
      , zs `isInfixOf` ys]

-- (segmentos xs) es la lista de los segmentos de xs. Por ejemplo,
--    segmentos "abc"  ==  ["","a","ab","abc","b","bc","c"]
segmentos :: [a] -> [[a]]
segmentos xs =
  [] : concatMap (tail . inits) (init (tails xs))

import Data.List (inits, tails, isInfixOf)

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

segmentosComunesMaximales xs ys =

nub [zs | zs <- zss

, null [us | us <- zss, zs `isInfixOf` us, us /= zs]]

where zss = segmentosComunes xs ys

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

segmentosComunes xs ys =

[zs | zs <- segmentos xs

, zs `isInfixOf` ys]

-- (segmentos xs) es la lista de los segmentos de xs. Por ejemplo,

-- segmentos "abc" == ["","a","ab","abc","b","bc","c"]

segmentos :: [a] -> [[a]]

segmentos xs =

[] : concatMap (tail . inits) (init (tails xs))

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]))

Agrupación por orden de aparición

PorJosé A. Alonso 13-diciembre-201620-diciembre-2016

Definir la función

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

1	agrupacion :: Eq a => [a] -> [a]

tal que (agrupacion xs) es la lista obtenida agrupando los elementos de xs según su primera aparición. Por ejemplo,

   agrupacion [3,1,5,1,7,1,5,3]  ==  [3,3,1,1,1,5,5,7]
   agrupacion "babcacb"          ==  "bbbaacc"

1 2	agrupacion [3,1,5,1,7,1,5,3] == [3,3,1,1,1,5,5,7] agrupacion "babcacb" == "bbbaacc"

Soluciones

import Data.List (nub, partition)

-- 1ª definición
agrupacion :: Eq a => [a] -> [a]
agrupacion [] = []
agrupacion (x:xs) =
  x : filter (==x) xs ++ agrupacion (filter (/=x) xs)

-- 2ª definición
agrupacion2 :: Eq a => [a] -> [a]
agrupacion2 xs = concat [filter (x==) xs | x <- nub xs]

-- 3ª definición
agrupacion3 :: Eq a => [a] -> [a]
agrupacion3 []     = []
agrupacion3 (x:xs) = x : ys ++ agrupacion3 zs
  where (ys,zs) = partition (==x) xs

-- Comparación de eficiencia
--    λ> import Data.List (cycle)
--    λ> :set +s
--    λ> sum (agrupacion (take (10^7) (cycle [0,1,2,3])))
--    15000000
--    (24.40 secs, 3,173,123,368 bytes)
--    λ> sum (agrupacion2 (take (10^7) (cycle [0,1,2,3])))
--    15000000
--    (13.71 secs, 2,333,129,416 bytes)
--    λ> sum (agrupacion3 (take (10^7) (cycle [0,1,2,3])))
--    15000000
--    (22.33 secs, 5,080,127,944 bytes)

import Data.List (nub, partition)

-- 1ª definición

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

agrupacion [] = []

agrupacion (x:xs) =

x : filter (==x) xs ++ agrupacion (filter (/=x) xs)

-- 2ª definición

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

agrupacion2 xs = concat [filter (x==) xs | x <- nub xs]

-- 3ª definición

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

agrupacion3 [] = []

agrupacion3 (x:xs) = x : ys ++ agrupacion3 zs

where (ys,zs) = partition (==x) xs

-- Comparación de eficiencia

-- λ> import Data.List (cycle)

-- λ> :set +s

-- λ> sum (agrupacion (take (10^7) (cycle [0,1,2,3])))

-- 15000000

-- (24.40 secs, 3,173,123,368 bytes)

-- λ> sum (agrupacion2 (take (10^7) (cycle [0,1,2,3])))

-- 15000000

-- (13.71 secs, 2,333,129,416 bytes)

-- λ> sum (agrupacion3 (take (10^7) (cycle [0,1,2,3])))

-- 15000000

-- (22.33 secs, 5,080,127,944 bytes)

Máximo producto de pares en la lista

Soluciones

La conjetura de Rodolfo

Soluciones

Segmentos comunes maximales

Soluciones

Distancia a Erdős

Soluciones

Agrupación por orden de aparición

Soluciones

Entradas recientes

Buscar

Correo electrónico