map – Página 7 – Exercitium

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

Caracteres en la misma posición que en el alfabeto

PorJosé A. Alonso 9-diciembre-201617-diciembre-2016

Un carácter c de una cadena cs está bien colocado si la posición de c en cs es la misma que en el abecedario (sin distinguir entre mayúsculas y minúsculas). Por ejemplo, los elementos bien colocados de la cadena «aBaCEria» son ‘a’, ‘B’ y ‘E’.

Definir la función

   nBienColocados :: String -> Int

1	nBienColocados :: String -> Int

tal que (nBienColocados cs) es el número de elementos bien colocados de la cadena cs. Por ejemplo,

   nBienColocados "aBaCEria"                    ==  3
   nBienColocados "xBxxExxxIxxxxNxxxxxTxxxXYZ"  ==  8

1 2	nBienColocados "aBaCEria" == 3 nBienColocados "xBxxExxxIxxxxNxxxxxTxxxXYZ" == 8

Soluciones

import Data.Char (toLower)

nBienColocados :: String -> Int
nBienColocados = length . bienColocados

bienColocados :: String -> [Char]
bienColocados cs =
  [c | (c,d) <- zip (map toLower cs) ['a'..'z']
     , c == d]

import Data.Char (toLower)

nBienColocados :: String -> Int

nBienColocados = length . bienColocados

bienColocados :: String -> [Char]

bienColocados cs =

[c | (c,d) <- zip (map toLower cs) ['a'..'z']

, c == d]

Referencias

Basado en el problema Count characters at same position as in English alphabets de Sahil Chhabra en GeeksforGeeks.

Problema de las particiones óptimas

PorJosé A. Alonso 30-noviembre-20167-diciembre-2016

El problema de la particiones óptimas consiste en dada una lista xs dividirla en dos sublistas ys y zs tales que el valor absoluto de la diferencia de la suma de los elementos de xs y la suma de los elemento de zs sea lo menor posible.Cada una de estas divisiones (ys,zs) es una partición óptima de xs. Por ejemplo, la partición óptima de [2,3,5] es ([2,3],[5]) ya que |(2+3) – 5| = 0. Una lista puede tener distintas particiones óptimas. Por ejemplo, [1,1,2,3] tiene dos particiones óptimas ([1,2],[1,3]) y ([1,1,2],[3]) ambas con diferencia 1 (es decir, 1 = |(1+2)-(1+3)| = |(1+1+2)-3|).

Definir la función

   particionesOptimas :: [Int] -> [([Int],[Int])]

1	particionesOptimas :: [Int] -> [([Int],[Int])]

tal que (particionesOptimas xs) es la lista de las particiones óptimas de xs. Por ejemplo,

   particionesOptimas [2,3,5]    ==  [([2,3],[5])]
   particionesOptimas [1,1,2,3]  ==  [([1,2],[1,3]),([1,1,2],[3])]

1 2	particionesOptimas [2,3,5] == [([2,3],[5])] particionesOptimas [1,1,2,3] == [([1,2],[1,3]),([1,1,2],[3])]

Soluciones

import Data.List ((\\), nub, sort, subsequences)

-- Una partición es un par de lista de enteros.
type Particion = ([Int],[Int])

-- (particiones xs) es la lista de las particiones de xs. Por ejemplo,
--    λ> particiones [2,3,5]
--    [([],[2,3,5]),([2],[3,5]),([2,3],[5]),([2,5],[3])]
particiones :: [Int] -> [Particion]
particiones xs =
  [(sort ys, sort zs) | ys <- subsequences xs
                      , let zs = xs \\ ys
                      , ys <= zs]

-- (diferencia p) es el valor absoluto de la diferencia de las sumas de
-- los elementos de la partición p. Por ejemplo,
--    diferencia ([2],[3,5])  ==  6
--    diferencia ([2,3],[5])  ==  0
diferencia :: Particion -> Int
diferencia (xs,ys) = abs (sum xs - sum ys)

-- (diferenciasParticiones xs) es la lista de las diferencias de las
-- particiones de xs. Por ejemplo,
--    diferenciasParticiones [2,3,5]  ==  [10,6,0,4]
diferenciasParticiones :: [Int] -> [Int]
diferenciasParticiones xs = map diferencia (particiones xs)

-- (minDiferenciaParticiones xs) es el mínimo de las diferencias de las
-- particiones de xs. Por ejemplo, 
--    minDiferenciaParticiones [2,3,5]    ==  0
--    minDiferenciaParticiones [1,1,2,3]  ==  1
minDiferenciaParticiones :: [Int] -> Int
minDiferenciaParticiones = minimum . diferenciasParticiones

particionesOptimas :: [Int] -> [Particion]
particionesOptimas xs =
  nub [(ys,zs) | (ys,zs) <- particiones xs
               , diferencia (ys,zs) == m]
  where m = minDiferenciaParticiones xs

import Data.List ((\\), nub, sort, subsequences)

-- Una partición es un par de lista de enteros.

type Particion = ([Int],[Int])

-- (particiones xs) es la lista de las particiones de xs. Por ejemplo,

-- λ> particiones [2,3,5]

-- [([],[2,3,5]),([2],[3,5]),([2,3],[5]),([2,5],[3])]

particiones :: [Int] -> [Particion]

particiones xs =

[(sort ys, sort zs) | ys <- subsequences xs

, let zs = xs \\ ys

, ys <= zs]

-- (diferencia p) es el valor absoluto de la diferencia de las sumas de

-- los elementos de la partición p. Por ejemplo,

-- diferencia ([2],[3,5]) == 6

-- diferencia ([2,3],[5]) == 0

diferencia :: Particion -> Int

diferencia (xs,ys) = abs (sum xs - sum ys)

-- (diferenciasParticiones xs) es la lista de las diferencias de las

-- particiones de xs. Por ejemplo,

-- diferenciasParticiones [2,3,5] == [10,6,0,4]

diferenciasParticiones :: [Int] -> [Int]

diferenciasParticiones xs = map diferencia (particiones xs)

-- (minDiferenciaParticiones xs) es el mínimo de las diferencias de las

-- particiones de xs. Por ejemplo,

-- minDiferenciaParticiones [2,3,5] == 0

-- minDiferenciaParticiones [1,1,2,3] == 1

minDiferenciaParticiones :: [Int] -> Int

minDiferenciaParticiones = minimum . diferenciasParticiones

particionesOptimas :: [Int] -> [Particion]

particionesOptimas xs =

nub [(ys,zs) | (ys,zs) <- particiones xs

, diferencia (ys,zs) == m]

where m = minDiferenciaParticiones xs

Máxima ramificación

PorJosé A. Alonso 23-noviembre-201630-noviembre-2016

Los árboles se pueden representar mediante el siguiente tipo de datos

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

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

Por ejemplo, los árboles

     1         1             1          
    / \       / \           / \   
   2   3     2   3         2   3  
       |        /|\       /|\  |   
       4       4 5 6     4 5 6 7

1 1 1

/ \ / \ / \

2 3 2 3 2 3

| /|\ /|\ |

4 4 5 6 4 5 6 7

se representan por

   ej1, ej2, ej3 :: Arbol Int
   ej1 = N 1 [N 2 [],N 3 [N 4 []]]
   ej2 = N 1 [N 2 [], N 3 [N 4 [], N 5 [], N 6 []]
   ej3 = N 1 [N 2 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

ej1, ej2, ej3 :: Arbol Int

ej1 = N 1 [N 2 [],N 3 [N 4 []]]

ej2 = N 1 [N 2 [], N 3 [N 4 [], N 5 [], N 6 []]

ej3 = N 1 [N 2 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

En el primer ejemplo la máxima ramificación es 2 (en el nodo 1 que tiene 2 hijos), la del segundo es 3 (en el nodo 3 que tiene 3 hijos) y la del tercero es 3 (en el nodo 3 que tiene 3 hijos).

Definir la función

   maximaRamificacion :: Arbol a -> Int

1	maximaRamificacion :: Arbol a -> Int

tal que (maximaRamificacion a) es la máxima ramificación del árbol a. Por ejemplo,

   maximaRamificacion ej1  ==  2
   maximaRamificacion ej2  ==  3
   maximaRamificacion ej3  ==  3

maximaRamificacion ej1 == 2

maximaRamificacion ej2 == 3

maximaRamificacion ej3 == 3

Soluciones

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

ej1, ej2 :: Arbol Int
ej1 = N 1 [N 2 [],N 3 [N 4 []]]
ej2 = N 1 [N 2 [], N 3 [N 4 [], N 5 [], N 6 []]]
ej3 = N 1 [N 2 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]] 

maximaRamificacion :: Arbol a -> Int
maximaRamificacion (N _ []) = 0
maximaRamificacion (N x xs) =
  max (length xs) (maximum (map maximaRamificacion xs))

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2 :: Arbol Int

ej1 = N 1 [N 2 [],N 3 [N 4 []]]

ej2 = N 1 [N 2 [], N 3 [N 4 [], N 5 [], N 6 []]]

ej3 = N 1 [N 2 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

maximaRamificacion :: Arbol a -> Int

maximaRamificacion (N _ []) = 0

maximaRamificacion (N x xs) =

max (length xs) (maximum (map maximaRamificacion xs))

Números consecutivos compuestos

PorJosé A. Alonso 22-noviembre-201629-noviembre-2016

Una serie compuesta de longitud n es una lista de n números consecutivos que son todos compuestos. Por ejemplo, [8,9,10] y [24,25,26] son dos series compuestas de longitud 3.

Cada serie compuesta se puede representar por el par formado por su primer y último elemento. Por ejemplo, las dos series anteriores se pueden representar pos (8,10) y (24,26) respectivamente.

Definir la función

   menorSerieCompuesta :: Integer -> (Integer,Integer)

1	menorSerieCompuesta :: Integer -> (Integer,Integer)

tal que (menorSerieCompuesta n) es la menor serie compuesta (es decir, la que tiene menores elementos) de longitud 3. Por ejemplo,

   menorSerieCompuesta 3    ==  (8,10)
   menorSerieCompuesta 4    ==  (24,27)
   menorSerieCompuesta 5    ==  (24,28)
   menorSerieCompuesta 150  ==  (4652354,4652503)

menorSerieCompuesta 3 == (8,10)

menorSerieCompuesta 4 == (24,27)

menorSerieCompuesta 5 == (24,28)

menorSerieCompuesta 150 == (4652354,4652503)

Comprobar con QuickCheck que para n > 1, el primer elemento de (menorSerieCompuesta n) es igual al primero de (menorSerieCompuesta (n-1)) o al primero de (menorSerieCompuesta (n+1)).

Soluciones

import Data.Numbers.Primes
import Test.QuickCheck

-- 1ª definición
-- =============

menorSerieCompuesta1 :: Integer -> (Integer,Integer)
menorSerieCompuesta1 n = (x,x+n-1)
  where x = head [y | y <- [1..]
                    , esCompuesta [y..y+n-1]]

esCompuesta :: [Integer] -> Bool
esCompuesta xs =  all (not . isPrime) xs

-- 2ª definición
-- =============

menorSerieCompuesta2 :: Integer -> (Integer,Integer)
menorSerieCompuesta2 n = (x+1,x+n)
  where (x,y) = head [(p,q) | (p,q) <- zip primes (tail primes)
                            , q - p >= n + 1]

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

--    λ> menorSerieCompuesta1 75
--    (155922,155996)
--    (12.16 secs, 30,378,380,552 bytes)
--    λ> menorSerieCompuesta2 75
--    (155922,155996)
--    (0.07 secs, 89,813,752 bytes)


-- Comprobación de la propiedad
-- ============================

-- La propiedad es
prop_menorSerieCompuesta :: Integer -> Property
prop_menorSerieCompuesta n =
  n > 1 ==> x == y || y == z
  where [x,y,z] = map (fst . menorSerieCompuesta2) [n-1,n,n+1]

-- La comprobación es
--    λ> quickCheck prop_menorSerieCompuesta
--    +++ OK, passed 100 tests.

import Data.Numbers.Primes

import Test.QuickCheck

-- 1ª definición

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

menorSerieCompuesta1 :: Integer -> (Integer,Integer)

menorSerieCompuesta1 n = (x,x+n-1)

where x = head [y | y <- [1..]

, esCompuesta [y..y+n-1]]

esCompuesta :: [Integer] -> Bool

esCompuesta xs = all (not . isPrime) xs

-- 2ª definición

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

menorSerieCompuesta2 :: Integer -> (Integer,Integer)

menorSerieCompuesta2 n = (x+1,x+n)

where (x,y) = head [(p,q) | (p,q) <- zip primes (tail primes)

, q - p >= n + 1]

-- Comparación de eficiencia

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

-- λ> menorSerieCompuesta1 75

-- (155922,155996)

-- (12.16 secs, 30,378,380,552 bytes)

-- λ> menorSerieCompuesta2 75

-- (155922,155996)

-- (0.07 secs, 89,813,752 bytes)

-- Comprobación de la propiedad

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

-- La propiedad es

prop_menorSerieCompuesta :: Integer -> Property

prop_menorSerieCompuesta n =

n > 1 ==> x == y || y == z

where [x,y,z] = map (fst . menorSerieCompuesta2) [n-1,n,n+1]

-- La comprobación es

-- λ> quickCheck prop_menorSerieCompuesta

-- +++ OK, passed 100 tests.

Referencias

Sucesión A030296 de la OEIS.

Máximo producto en la partición de un número

PorJosé A. Alonso 16-noviembre-201623-noviembre-2016

El artículo de esta semana de Antonio Roldán en su blog Números y hoja de cálculo es Máximo producto en la partición de un número (1)

Una partición de un entero positivo n es una forma de descomponer n como suma de enteros positivos. Dos sumas se considerarán iguales si solo difieren en el orden de los sumandos. Por ejemplo, las 11 particiones de 6 (con sus correspondientes productos) son

   6 = 6                      |  6                     = 6
   6 = 5 + 1                  |  5 x 1                 = 5
   6 = 4 + 2                  |  4 x 2                 = 8
   6 = 4 + 1 + 1              |  4 x 1 x 1             = 4
   6 = 3 + 3                  |  3 x 3                 = 9
   6 = 3 + 2 + 1              |  3 x 2 x 1             = 6
   6 = 3 + 1 + 1 + 1          |  3 x 1 x 1 x 1         = 3
   6 = 2 + 2 + 2              |  2 x 2 x 2             = 8
   6 = 2 + 2 + 1 + 1          |  2 x 2 x 1 x 1         = 4
   6 = 2 + 1 + 1 + 1 + 1      |  2 x 1 x 1 x 1 x 1     = 2
   6 = 1 + 1 + 1 + 1 + 1 + 1  |  1 x 1 x 1 x 1 x 1 x 1 = 1

6 = 6 | 6 = 6

6 = 5 + 1 | 5 x 1 = 5

6 = 4 + 2 | 4 x 2 = 8

6 = 4 + 1 + 1 | 4 x 1 x 1 = 4

6 = 3 + 3 | 3 x 3 = 9

6 = 3 + 2 + 1 | 3 x 2 x 1 = 6

6 = 3 + 1 + 1 + 1 | 3 x 1 x 1 x 1 = 3

6 = 2 + 2 + 2 | 2 x 2 x 2 = 8

6 = 2 + 2 + 1 + 1 | 2 x 2 x 1 x 1 = 4

6 = 2 + 1 + 1 + 1 + 1 | 2 x 1 x 1 x 1 x 1 = 2

6 = 1 + 1 + 1 + 1 + 1 + 1 | 1 x 1 x 1 x 1 x 1 x 1 = 1

Se observa que el máximo producto de las particiones de 6 es 9.

Definir la función

   maximoProductoParticiones :: Int -> Int

1	maximoProductoParticiones :: Int -> Int

tal que (maximoProductoParticiones n) es el máximo de los productos de las particiones de n. Por ejemplo,

   maximoProductoParticiones 4     ==  4
   maximoProductoParticiones 5     ==  6
   maximoProductoParticiones 6     ==  9
   maximoProductoParticiones 7     ==  12
   maximoProductoParticiones 8     ==  18
   maximoProductoParticiones 9     ==  27
   maximoProductoParticiones 50    ==  86093442
   maximoProductoParticiones 100   ==  7412080755407364
   maximoProductoParticiones 200   ==  61806308765265224723841283607058
   length (show (maximoProductoParticiones (10^7)))  ==  1590405

maximoProductoParticiones 4 == 4

maximoProductoParticiones 5 == 6

maximoProductoParticiones 6 == 9

maximoProductoParticiones 7 == 12

maximoProductoParticiones 8 == 18

maximoProductoParticiones 9 == 27

maximoProductoParticiones 50 == 86093442

maximoProductoParticiones 100 == 7412080755407364

maximoProductoParticiones 200 == 61806308765265224723841283607058

length (show (maximoProductoParticiones (10^7))) == 1590405

Comprobar con QuickChek que los únicos posibles factores de (maximoProductoParticiones n) son 2 y 3.

Soluciones

import Data.List (genericIndex, sort)
import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck

-- 1ª definición
-- =============

maximoProductoParticiones1 :: Integer -> Integer
maximoProductoParticiones1 n =
  maximum [product xs | xs <- particiones1 n]

-- (particiones1 n) es la lista de las particiones de n. Por ejemplo,  
--    λ> particiones1 4
--    [[4],[3,1],[2,2],[2,1,1],[1,1,1,1]]
--    λ> particiones1 5
--    [[5],[4,1],[3,2],[3,1,1],[2,2,1],[2,1,1,1],[1,1,1,1,1]]
particiones1 :: Integer -> [[Integer]]
particiones1 0 = [[]]
particiones1 n = [x:y | x <- [n,n-1..1]
                      , y <- particiones1 (n-x) 
                      , [x] >= take 1 y]
 
-- 2ª definición
-- =============

maximoProductoParticiones2 :: Integer -> Integer
maximoProductoParticiones2 n =
  maximum [product xs | xs <- particiones2 n]

-- (particiones2 n) es la lista de las particiones de n. Por ejemplo,  
--    λ> particiones2 4
--    [[4],[3,1],[2,2],[2,1,1],[1,1,1,1]]
--    λ> particiones2 5
--    [[5],[4,1],[3,2],[3,1,1],[2,2,1],[2,1,1,1],[1,1,1,1,1]]
particiones2 :: Integer -> [[Integer]]
particiones2 n = aux `genericIndex` n
  where aux = [] : map particiones [1..]
          where particiones n = [n] : [x:p | x <- [n,n-1..1]
                                           , p <- aux `genericIndex` (n-x) 
                                           , x >= head p]

-- 3ª definición
-- =============

maximoProductoParticiones3 :: Integer -> Integer
maximoProductoParticiones3 0 = 1
maximoProductoParticiones3 n =
  maximum [(n-i) * maximoProductoParticiones3 i | i <- [0..n-1]]

-- 4ª definición
-- =============

maximoProductoParticiones4 :: Integer -> Integer
maximoProductoParticiones4 n =
  maximosProductosParticiones `genericIndex` n

maximosProductosParticiones :: [Integer]
maximosProductosParticiones = 1 : f [1]
  where f xs = y : f (y:xs)
          where y = maximum (zipWith (*) [1..] xs)

-- 5ª definición
-- =============

maximoProductoParticiones5 :: Integer -> Integer
maximoProductoParticiones5 1 = 1
maximoProductoParticiones5 n
  | r == 0 = 3^q
  | r == 1 = 4 * 3^(q-1)
  | r == 2 = 2 * 3 ^q
  where (q,r) = quotRem n 3
        
-- Comparación de eficiencia                                        
-- =========================

-- La comparación es
--    λ> maximoProductoParticiones1 20
--    1458
--    (5.42 secs, 832,283,184 bytes)
--    λ> maximoProductoParticiones2 20
--    1458
--    (0.02 secs, 0 bytes)
--    λ> maximoProductoParticiones3 20
--    1458
--    (3.18 secs, 524,500,000 bytes)
--    λ> maximoProductoParticiones4 20
--    1458
--    (0.00 secs, 0 bytes)
--    
--    λ> maximoProductoParticiones2 50
--    86093442
--    (9.18 secs, 980,524,320 bytes)
--    λ> maximoProductoParticiones4 50
--    86093442
--    (0.01 secs, 1,381,192 bytes)
--    λ> maximoProductoParticiones5 50
--    86093442
--    (0.00 secs, 0 bytes)
--    
--    λ> length (show (maximoProductoParticiones4 2000))
--    319
--    (2.93 secs, 638,270,872 bytes)
--    λ> length (show (maximoProductoParticiones5 2000))
--    319
--    (0.01 secs, 0 bytes)

-- Comprobación
-- ============

-- La propiedad es
prop_factores :: Integer -> Property
prop_factores n =
  n > 0 ==> primeFactors (maximoProductoParticiones5 n) `contenido` [2,3]

contenido :: Eq a => [a] -> [a] -> Bool
contenido xs ys = all (`elem` ys) xs

-- La comprobación es
--    λ> quickCheck prop_factores
--    +++ OK, passed 100 tests.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

import Data.List (genericIndex, sort)

import Data.Numbers.Primes (primeFactors)

import Test.QuickCheck

-- 1ª definición

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

maximoProductoParticiones1 :: Integer -> Integer

maximoProductoParticiones1 n =

maximum [product xs | xs <- particiones1 n]

-- (particiones1 n) es la lista de las particiones de n. Por ejemplo,

-- λ> particiones1 4

-- [[4],[3,1],[2,2],[2,1,1],[1,1,1,1]]

-- λ> particiones1 5

-- [[5],[4,1],[3,2],[3,1,1],[2,2,1],[2,1,1,1],[1,1,1,1,1]]

particiones1 :: Integer -> [[Integer]]

particiones1 0 = [[]]

particiones1 n = [x:y | x <- [n,n-1..1]

, y <- particiones1 (n-x)

, [x] >= take 1 y]

-- 2ª definición

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

maximoProductoParticiones2 :: Integer -> Integer

maximoProductoParticiones2 n =

maximum [product xs | xs <- particiones2 n]

-- (particiones2 n) es la lista de las particiones de n. Por ejemplo,

-- λ> particiones2 4

-- [[4],[3,1],[2,2],[2,1,1],[1,1,1,1]]

-- λ> particiones2 5

-- [[5],[4,1],[3,2],[3,1,1],[2,2,1],[2,1,1,1],[1,1,1,1,1]]

particiones2 :: Integer -> [[Integer]]

particiones2 n = aux `genericIndex` n

where aux = [] : map particiones [1..]

where particiones n = [n] : [x:p | x <- [n,n-1..1]

, p <- aux `genericIndex` (n-x)

, x >= head p]

-- 3ª definición

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

maximoProductoParticiones3 :: Integer -> Integer

maximoProductoParticiones3 0 = 1

maximoProductoParticiones3 n =

maximum [(n-i) * maximoProductoParticiones3 i | i <- [0..n-1]]

-- 4ª definición

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

maximoProductoParticiones4 :: Integer -> Integer

maximoProductoParticiones4 n =

maximosProductosParticiones `genericIndex` n

maximosProductosParticiones :: [Integer]

maximosProductosParticiones = 1 : f [1]

where f xs = y : f (y:xs)

where y = maximum (zipWith (*) [1..] xs)

-- 5ª definición

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

maximoProductoParticiones5 :: Integer -> Integer

maximoProductoParticiones5 1 = 1

maximoProductoParticiones5 n

| r == 0 = 3^q

| r == 1 = 4 * 3^(q-1)

| r == 2 = 2 * 3 ^q

where (q,r) = quotRem n 3

-- Comparación de eficiencia

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

-- La comparación es

-- λ> maximoProductoParticiones1 20

-- 1458

-- (5.42 secs, 832,283,184 bytes)

-- λ> maximoProductoParticiones2 20

-- 1458

-- (0.02 secs, 0 bytes)

-- λ> maximoProductoParticiones3 20

-- 1458

-- (3.18 secs, 524,500,000 bytes)

-- λ> maximoProductoParticiones4 20

-- 1458

-- (0.00 secs, 0 bytes)

-- λ> maximoProductoParticiones2 50

-- 86093442

-- (9.18 secs, 980,524,320 bytes)

-- λ> maximoProductoParticiones4 50

-- 86093442

-- (0.01 secs, 1,381,192 bytes)

-- λ> maximoProductoParticiones5 50

-- 86093442

-- (0.00 secs, 0 bytes)

-- λ> length (show (maximoProductoParticiones4 2000))

-- 319

-- (2.93 secs, 638,270,872 bytes)

-- λ> length (show (maximoProductoParticiones5 2000))

-- 319

-- (0.01 secs, 0 bytes)

-- Comprobación

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

-- La propiedad es

prop_factores :: Integer -> Property

prop_factores n =

n > 0 ==> primeFactors (maximoProductoParticiones5 n) `contenido` [2,3]

contenido :: Eq a => [a] -> [a] -> Bool

contenido xs ys = all (`elem` ys) xs

-- La comprobación es

-- λ> quickCheck prop_factores

-- +++ OK, passed 100 tests.

Referencia

Máximo producto en la partición de un número (1) de Antonio Roldán en el blog Números y hoja de cálculo.
Sucesión A000792 de la OEIS.

Sucesiones de listas de números

PorJosé A. Alonso 20-mayo-201626-marzo-2022

En la Olimpiada Internacional de Matemáticas del 2012 se propuso el siguiente problema:

Varios enteros positivos se escriben en una lista. Iterativamente, Alicia elige dos números adyacentes x e y tales que x > y y x está a la izquierda de y y reemplaza el par (x,y) por (y+1,x) o (x-1,x). Demostrar que sólo puede aplicar un número finito de dichas iteraciones.

Por ejemplo, las transformadas de la lista [1,3,2] son [1,2,3] y [1,3,3] y las dos obtenidas son finales (es decir, no se les puede aplicar ninguna transformación).

Definir las funciones

   soluciones       :: [Int] -> [Estado]
   finales          :: [Int] -> [[Int]]
   finalesMaximales :: [Int] -> (Int,[[Int]])

soluciones :: [Int] -> [Estado]

finales :: [Int] -> [[Int]]

finalesMaximales :: [Int] -> (Int,[[Int]])

tales que

(soluciones xs) es la lista de pares (n,ys) tales que ys es una lista obtenida aplicándole n transformaciones a xs. Por ejemplo,

     λ> soluciones [1,3,2]
     [(1,[1,3,3]),(1,[1,2,3])]
     λ> sort (nub (soluciones [3,3,2]))
     [(1,[3,3,3]),(2,[2,3,3]),(2,[3,3,3])]
     λ> sort (nub (soluciones [3,2,1]))
     [(2,[2,2,3]),(3,[2,2,3]),(3,[2,3,3]),(3,[3,3,3]),(4,[2,3,3]),(4,[3,3,3])]

λ> soluciones [1,3,2]

[(1,[1,3,3]),(1,[1,2,3])]

λ> sort (nub (soluciones [3,3,2]))

[(1,[3,3,3]),(2,[2,3,3]),(2,[3,3,3])]

λ> sort (nub (soluciones [3,2,1]))

[(2,[2,2,3]),(3,[2,2,3]),(3,[2,3,3]),(3,[3,3,3]),(4,[2,3,3]),(4,[3,3,3])]

(finales xs) son las listas obtenidas transformando xs y a las que no se les puede aplicar más transformaciones. Por ejemplo,

     finales [1,2,3]               ==  [[1,2,3]]
     finales [1,3,2]               ==  [[1,2,3],[1,3,3]]
     finales [3,2,1]               ==  [[2,2,3],[2,3,3],[3,3,3]]
     finales [1,3,2,4]             ==  [[1,2,3,4],[1,3,3,4]]
     finales [1,3,2,3]             ==  [[1,2,3,3],[1,3,3,3]]
     length (finales [9,6,0,7,2])  ==  19
     length (finales [80,60..0])   ==  420

finales [1,2,3] == [[1,2,3]]

finales [1,3,2] == [[1,2,3],[1,3,3]]

finales [3,2,1] == [[2,2,3],[2,3,3],[3,3,3]]

finales [1,3,2,4] == [[1,2,3,4],[1,3,3,4]]

finales [1,3,2,3] == [[1,2,3,3],[1,3,3,3]]

length (finales [9,6,0,7,2]) == 19

length (finales [80,60..0]) == 420

(finalesMaximales xs) es el par (n,yss) tal que la longitud de las cadenas más largas de transformaciones a partir de xs e yss es la lista de los estados finales a partir de xs con n transformaciones. Por ejemplo,

     finalesMaximales [9,5,7]   ==  (2,[[6,8,9],[8,8,9]])
     finalesMaximales [3,2,1]   ==  (4,[[2,3,3],[3,3,3]])
     finalesMaximales [3,2..0]  ==  (10,[[2,3,3,3],[3,3,3,3]])
     finalesMaximales [4,3..0]  ==  (20,[[3,4,4,4,4],[4,4,4,4,4]])

finalesMaximales [9,5,7] == (2,[[6,8,9],[8,8,9]])

finalesMaximales [3,2,1] == (4,[[2,3,3],[3,3,3]])

finalesMaximales [3,2..0] == (10,[[2,3,3,3],[3,3,3,3]])

finalesMaximales [4,3..0] == (20,[[3,4,4,4,4],[4,4,4,4,4]])

Soluciones

import Data.List (nub, sort)
import I1M.BusquedaEnEspaciosDeEstados (buscaEE)

type Estado = (Int,[Int])

inicial :: [Int] -> Estado
inicial xs = (0,xs)

esFinal :: Estado -> Bool
esFinal e = null (sucesores e)

--    λ> sucesores [9,6,0,7,2]
--    [[7,9,0,7,2],[8,9,0,7,2],[9,1,6,7,2],[9,5,6,7,2],[9,6,0,3,7],[9,6,0,6,7]]
sucesores :: Estado -> [Estado]
sucesores (_,[])  = []
sucesores (_,[_]) = []
sucesores (n,x:y:xs) | x > y     = [(n+1,y+1:x:xs), (n+1,x-1:x:xs)] ++ yss
                     | otherwise = yss
    where yss = [(m,x:ys) | (m,ys) <- sucesores (n,y:xs)]
                       

soluciones :: [Int] -> [Estado]
soluciones xs =
    buscaEE sucesores esFinal (inicial xs)

finales :: [Int] -> [[Int]]
finales xs =
    sort (nub (map snd (soluciones xs)))
            
finalesMaximales :: [Int] -> (Int,[[Int]])
finalesMaximales xs =
    (m, [xs | (n,xs) <- es, n == m])
    where es    = sort (nub (soluciones xs))
          (m,_) = maximum es

import Data.List (nub, sort)

import I1M.BusquedaEnEspaciosDeEstados (buscaEE)

type Estado = (Int,[Int])

inicial :: [Int] -> Estado

inicial xs = (0,xs)

esFinal :: Estado -> Bool

esFinal e = null (sucesores e)

-- λ> sucesores [9,6,0,7,2]

-- [[7,9,0,7,2],[8,9,0,7,2],[9,1,6,7,2],[9,5,6,7,2],[9,6,0,3,7],[9,6,0,6,7]]

sucesores :: Estado -> [Estado]

sucesores (_,[]) = []

sucesores (_,[_]) = []

sucesores (n,x:y:xs) | x > y = [(n+1,y+1:x:xs), (n+1,x-1:x:xs)] ++ yss

| otherwise = yss

where yss = [(m,x:ys) | (m,ys) <- sucesores (n,y:xs)]

soluciones :: [Int] -> [Estado]

soluciones xs =

buscaEE sucesores esFinal (inicial xs)

finales :: [Int] -> [[Int]]

finales xs =

sort (nub (map snd (soluciones xs)))

finalesMaximales :: [Int] -> (Int,[[Int]])

finalesMaximales xs =

(m, [xs | (n,xs) <- es, n == m])

where es = sort (nub (soluciones xs))

(m,_) = maximum es

Problema de las jarras

PorJosé A. Alonso 18-mayo-201626-marzo-2022

En el problema de las jarras (A,B,C) se tienen dos jarras sin marcas de medición, una de A litros de capacidad y otra de B. También se dispone de una bomba que permite llenar las jarras de agua.

El problema de las jarras (A,B,C) consiste en determinar cómo se puede lograr tener exactamente C litros de agua en la jarra de A litros de capacidad.

Definir, mediante búsqueda en espacio de estados, la función

   jarras :: (Int,Int,Int) -> [[(Int,Int)]]

1	jarras :: (Int,Int,Int) -> [[(Int,Int)]]

tal (jarras (a,b,c)) es la lista de las soluciones del problema de las
jarras (a,b,c). Por ejemplo,

   λ> take 2 (map snd (sort [(length xs,xs) | xs <- jarras (4,3,2)]))
   [[(0,0),(0,3),(3,0),(3,3),(4,2),(0,2),(2,0)],
    [(0,0),(4,0),(1,3),(1,0),(0,1),(4,1),(2,3)]]

λ> take 2 (map snd (sort [(length xs,xs) | xs <- jarras (4,3,2)]))

[[(0,0),(0,3),(3,0),(3,3),(4,2),(0,2),(2,0)],

[(0,0),(4,0),(1,3),(1,0),(0,1),(4,1),(2,3)]]

La interpretación [(0,0),(4,0),(1,3),(1,0),(0,1),(4,1),(2,3)] es:

(0,0) se inicia con las dos jarras vacías,
(4,0) se llena la jarra de 4 con el grifo,
(1,3) se llena la de 3 con la de 4,
(1,0) se vacía la de 3,
(0,1) se pasa el contenido de la primera a la segunda,
(4,1) se llena la primera con el grifo,
(2,3) se llena la segunda con la primera.

Otros ejemplos

   λ> (snd . head . sort) [(length xs,xs) | xs <- jarras (15,10,5)]
   [(0,0),(15,0),(5,10)]
   λ> jarras (15,10,4)
   []

λ> (snd . head . sort) [(length xs,xs) | xs <- jarras (15,10,5)]

[(0,0),(15,0),(5,10)]

λ> jarras (15,10,4)

[]

Nota: Las librerías necesarias se encuentran en la página de códigos.

Soluciones

import I1M.BusquedaEnEspaciosDeEstados

-- Un problema queda determinado por las capacidades de las dos jarras y
-- el contenido que se desea lograr 

-- Un estado es una lista de dos números. El primero es el contenido de
-- la jarra de 4 litros y el segundo el de la de 3 litros. 
type EstadoJarras = (Int,Int)

inicialJarras :: EstadoJarras
inicialJarras = (0,0)

esFinalJarras :: (Int,Int,Int) -> EstadoJarras -> Bool
esFinalJarras (_,_,c) (x,_) = x == c

sucesoresEjarras :: (Int,Int,Int) -> EstadoJarras -> [EstadoJarras]
sucesoresEjarras (a,b,_) (x,y) =
    [(a,y) | x < a] ++
    [(x,b) | y < b] ++
    [(0,y) | x > 0] ++
    [(x,0) | y > 0] ++
    [(a,y-(a-x)) | x < a, y > 0, x + y > a] ++
    [(x-(b-y),b) | x > 0, y < b, x + y > b] ++
    [(x+y,0) | y > 0, x + y <= a] ++ 
    [(0,x+y) | x > 0, x + y <= b]

-- Los nodos son las soluciones parciales
type NodoJarras = [EstadoJarras]

inicialNjarras :: NodoJarras
inicialNjarras = [inicialJarras]

esFinalNjarras :: (Int,Int,Int) -> NodoJarras -> Bool
esFinalNjarras p (e:_) = esFinalJarras p e

sucesoresNjarras :: (Int,Int,Int) -> NodoJarras -> [NodoJarras]
sucesoresNjarras p n@(e:es) =
    [e':n | e' <- sucesoresEjarras p e,
            e' `notElem` n]

solucionesJarras :: (Int,Int,Int) -> [NodoJarras]
solucionesJarras p = buscaEE (sucesoresNjarras p)
                             (esFinalNjarras p)
                             inicialNjarras

jarras :: (Int,Int,Int) -> [[(Int,Int)]]
jarras p = map reverse (solucionesJarras p)

import I1M.BusquedaEnEspaciosDeEstados

-- Un problema queda determinado por las capacidades de las dos jarras y

-- el contenido que se desea lograr

-- Un estado es una lista de dos números. El primero es el contenido de

-- la jarra de 4 litros y el segundo el de la de 3 litros.

type EstadoJarras = (Int,Int)

inicialJarras :: EstadoJarras

inicialJarras = (0,0)

esFinalJarras :: (Int,Int,Int) -> EstadoJarras -> Bool

esFinalJarras (_,_,c) (x,_) = x == c

sucesoresEjarras :: (Int,Int,Int) -> EstadoJarras -> [EstadoJarras]

sucesoresEjarras (a,b,_) (x,y) =

[(a,y) | x < a] ++

[(x,b) | y < b] ++

[(0,y) | x > 0] ++

[(x,0) | y > 0] ++

[(a,y-(a-x)) | x < a, y > 0, x + y > a] ++

[(x-(b-y),b) | x > 0, y < b, x + y > b] ++

[(x+y,0) | y > 0, x + y <= a] ++

[(0,x+y) | x > 0, x + y <= b]

-- Los nodos son las soluciones parciales

type NodoJarras = [EstadoJarras]

inicialNjarras :: NodoJarras

inicialNjarras = [inicialJarras]

esFinalNjarras :: (Int,Int,Int) -> NodoJarras -> Bool

esFinalNjarras p (e:_) = esFinalJarras p e

sucesoresNjarras :: (Int,Int,Int) -> NodoJarras -> [NodoJarras]

sucesoresNjarras p n@(e:es) =

[e':n | e' <- sucesoresEjarras p e,

e' `notElem` n]

solucionesJarras :: (Int,Int,Int) -> [NodoJarras]

solucionesJarras p = buscaEE (sucesoresNjarras p)

(esFinalNjarras p)

inicialNjarras

jarras :: (Int,Int,Int) -> [[(Int,Int)]]

jarras p = map reverse (solucionesJarras p)

Problema del dominó

PorJosé A. Alonso 17-mayo-201626-marzo-2022

Las fichas del dominó se pueden representar por pares de números enteros. El problema del dominó consiste en colocar todas las fichas de una lista dada de forma que el segundo número de cada ficha coincida con el primero de la siguiente.

Definir, mediante búsqueda en espacio de estados, la función

   domino :: [(Int,Int)] -> [[(Int,Int)]]

1	domino :: [(Int,Int)] -> [[(Int,Int)]]

tal que (domino fs) es la lista de las soluciones del problema del dominó correspondiente a las fichas fs. Por ejemplo,

   ghci> domino [(1,2),(2,3),(1,4)]
   [[(4,1),(1,2),(2,3)],[(3,2),(2,1),(1,4)]]
   ghci> domino [(1,2),(1,1),(1,4)]
   [[(4,1),(1,1),(1,2)],[(2,1),(1,1),(1,4)]]
   ghci> domino [(1,2),(3,4),(2,3)]
   [[(1,2),(2,3),(3,4)]]
   ghci> domino [(1,2),(2,3),(5,4)]
   []
   ghci> domino [(x,y) | x <- [1..2], y <- [x..2]]
   [[(2,2),(2,1),(1,1)],[(1,1),(1,2),(2,2)]]
   λ> [(x,y) | x <- [1..3], y <- [x..3]]
   [(1,1),(1,2),(1,3),(2,2),(2,3),(3,3)]
   λ> mapM_ print (domino [(x,y) | x <- [1..3], y <- [x..3]])
   [(1,3),(3,3),(3,2),(2,2),(2,1),(1,1)]
   [(1,2),(2,2),(2,3),(3,3),(3,1),(1,1)]
   [(2,2),(2,3),(3,3),(3,1),(1,1),(1,2)]
   [(3,3),(3,2),(2,2),(2,1),(1,1),(1,3)]
   [(2,3),(3,3),(3,1),(1,1),(1,2),(2,2)]
   [(2,1),(1,1),(1,3),(3,3),(3,2),(2,2)]
   [(3,3),(3,1),(1,1),(1,2),(2,2),(2,3)]
   [(3,2),(2,2),(2,1),(1,1),(1,3),(3,3)]
   [(3,1),(1,1),(1,2),(2,2),(2,3),(3,3)]
   ghci> length (domino [(x,y) | x <- [1..4], y <- [x..4]])
   0

ghci> domino [(1,2),(2,3),(1,4)]

[[(4,1),(1,2),(2,3)],[(3,2),(2,1),(1,4)]]

ghci> domino [(1,2),(1,1),(1,4)]

[[(4,1),(1,1),(1,2)],[(2,1),(1,1),(1,4)]]

ghci> domino [(1,2),(3,4),(2,3)]

[[(1,2),(2,3),(3,4)]]

ghci> domino [(1,2),(2,3),(5,4)]

[]

ghci> domino [(x,y) | x <- [1..2], y <- [x..2]]

[[(2,2),(2,1),(1,1)],[(1,1),(1,2),(2,2)]]

λ> [(x,y) | x <- [1..3], y <- [x..3]]

[(1,1),(1,2),(1,3),(2,2),(2,3),(3,3)]

λ> mapM_ print (domino [(x,y) | x <- [1..3], y <- [x..3]])

[(1,3),(3,3),(3,2),(2,2),(2,1),(1,1)]

[(1,2),(2,2),(2,3),(3,3),(3,1),(1,1)]

[(2,2),(2,3),(3,3),(3,1),(1,1),(1,2)]

[(3,3),(3,2),(2,2),(2,1),(1,1),(1,3)]

[(2,3),(3,3),(3,1),(1,1),(1,2),(2,2)]

[(2,1),(1,1),(1,3),(3,3),(3,2),(2,2)]

[(3,3),(3,1),(1,1),(1,2),(2,2),(2,3)]

[(3,2),(2,2),(2,1),(1,1),(1,3),(3,3)]

[(3,1),(1,1),(1,2),(2,2),(2,3),(3,3)]

ghci> length (domino [(x,y) | x <- [1..4], y <- [x..4]])

Nota: Las librerías necesarias se encuentran en la página de códigos.

Soluciones

import I1M.BusquedaEnEspaciosDeEstados (buscaEE)
import Data.List (delete)

type Ficha  = (Int,Int)

-- Los estados son los pares formados por la listas sin colocar y las
-- colocadas. 
type EstadoDomino = ([Ficha],[Ficha])

inicialDomino :: [Ficha] -> EstadoDomino
inicialDomino fs = (fs,[])

esFinalDomino :: EstadoDomino -> Bool
esFinalDomino (fs,_) = null fs 

sucesoresDomino :: EstadoDomino -> [EstadoDomino]
sucesoresDomino (fs,[]) = [(delete f fs, [f]) | f <- fs]
sucesoresDomino (fs,n@((x,y):qs)) =
    [(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u /= v, v == x] ++
    [(delete (u,v) fs,(v,u):n) | (u,v) <- fs, u /= v, u == x] ++
    [(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u == v, u == x] 

solucionesDomino :: [Ficha] -> [EstadoDomino]
solucionesDomino ps = buscaEE sucesoresDomino
                              esFinalDomino         
                              (inicialDomino ps)

domino :: [(Int,Int)] -> [[(Int,Int)]]
domino ps = map snd (solucionesDomino ps)

import I1M.BusquedaEnEspaciosDeEstados (buscaEE)

import Data.List (delete)

type Ficha = (Int,Int)

-- Los estados son los pares formados por la listas sin colocar y las

-- colocadas.

type EstadoDomino = ([Ficha],[Ficha])

inicialDomino :: [Ficha] -> EstadoDomino

inicialDomino fs = (fs,[])

esFinalDomino :: EstadoDomino -> Bool

esFinalDomino (fs,_) = null fs

sucesoresDomino :: EstadoDomino -> [EstadoDomino]

sucesoresDomino (fs,[]) = [(delete f fs, [f]) | f <- fs]

sucesoresDomino (fs,n@((x,y):qs)) =

[(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u /= v, v == x] ++

[(delete (u,v) fs,(v,u):n) | (u,v) <- fs, u /= v, u == x] ++

[(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u == v, u == x]

solucionesDomino :: [Ficha] -> [EstadoDomino]

solucionesDomino ps = buscaEE sucesoresDomino

esFinalDomino

(inicialDomino ps)

domino :: [(Int,Int)] -> [[(Int,Int)]]

domino ps = map snd (solucionesDomino ps)

Sucesión fractal

PorJosé A. Alonso 10-mayo-201625-abril-2021

La sucesión fractal

   0, 0, 1, 0, 2, 1, 3, 0, 4, 2, 5, 1, 6, 3, 7, 0, 8, 4, 9, 2, 
   10, 5, 11, 1, 12, 6, 13, 3, 14, 7, 15, ...

1 2	0, 0, 1, 0, 2, 1, 3, 0, 4, 2, 5, 1, 6, 3, 7, 0, 8, 4, 9, 2, 10, 5, 11, 1, 12, 6, 13, 3, 14, 7, 15, ...

está construida de la siguiente forma:

los términos pares forman la sucesión de los números naturales

     0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, ...

1	0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, ...

los términos impares forman la misma sucesión original

     0, 0, 1, 0, 2, 1, 3, 0, 4, 2, 5, 1, 6, 3, 7, ...

1	0, 0, 1, 0, 2, 1, 3, 0, 4, 2, 5, 1, 6, 3, 7, ...

Definir las funciones

   sucFractal     :: [Integer]
   sumaSucFractal :: Integer -> Integer

1 2	sucFractal :: [Integer] sumaSucFractal :: Integer -> Integer

tales que

sucFractal es la lista de los términos de la sucesión fractal. Por ejemplo,

     take 20 sucFractal   == [0,0,1,0,2,1,3,0,4,2,5,1,6,3,7,0,8,4,9,2]
     sucFractal !! 30     == 15
     sucFractal !! (10^7) == 5000000

take 20 sucFractal == [0,0,1,0,2,1,3,0,4,2,5,1,6,3,7,0,8,4,9,2]

sucFractal !! 30 == 15

sucFractal !! (10^7) == 5000000

(sumaSucFractal n) es la suma de los n primeros términos de la sucesión fractal. Por ejemplo,

     sumaSucFractal 10      ==  13
     sumaSucFractal (10^5)  == 1666617368
     sumaSucFractal (10^10) == 16666666661668691669
     sumaSucFractal (10^15) == 166666666666666166673722792954
     sumaSucFractal (10^20) == 1666666666666666666616666684103392376198
     length (show (sumaSucFractal (10^15000))) == 30000
     sumaSucFractal (10^15000) `mod` (10^9)    == 455972157

sumaSucFractal 10 == 13

sumaSucFractal (10^5) == 1666617368

sumaSucFractal (10^10) == 16666666661668691669

sumaSucFractal (10^15) == 166666666666666166673722792954

sumaSucFractal (10^20) == 1666666666666666666616666684103392376198

length (show (sumaSucFractal (10^15000))) == 30000

sumaSucFractal (10^15000) `mod` (10^9) == 455972157

Soluciones

-- 1ª definición de sucFractal
-- ===========================

sucFractal1 :: [Integer]
sucFractal1 = 
    map termino [0..]

-- (termino n) es el término n de la secuencia anterior. Por ejemplo,
--   termino 0            ==  0
--   termino 1            ==  0
--   map termino [0..10]  ==  [0,0,1,0,2,1,3,0,4,2,5]
termino :: Integer -> Integer
termino 0 = 0
termino n 
    | even n    = n `div` 2
    | otherwise = termino (n `div` 2)

-- 2ª definición de sucFractal
-- ===========================

sucFractal2 :: [Integer]
sucFractal2 =
    0 : 0 : mezcla [1..] (tail sucFractal2)

-- (mezcla xs ys) es la lista obtenida intercalando las listas infinitas
-- xs e ys. Por ejemplo,
--    take 10 (mezcla [0,2..] [0,-2..])  ==  [0,0,2,-2,4,-4,6,-6,8,-8]
mezcla :: [Integer] -> [Integer] -> [Integer]
mezcla (x:xs) (y:ys) =
    x:y:mezcla xs ys

-- Comparación de eficiencia de definiciones de sucFractal
-- =======================================================

--    λ> sum (take (10^6) sucFractal1)
--    166666169612
--    (5.56 secs, 842,863,264 bytes)
--    λ> sum (take (10^6) sucFractal2)
--    166666169612
--    (1.81 secs, 306,262,616 bytes)

-- En lo que sigue usaremos la 2ª definición
sucFractal :: [Integer]
sucFractal = sucFractal2

-- 1ª definición de sumaSucFractal
-- ===============================

sumaSucFractal1 :: Integer -> Integer
sumaSucFractal1 n =
    sum (map termino [0..n-1])

-- 2ª definición de sumaSucFractal
-- ===============================

sumaSucFractal2 :: Integer -> Integer
sumaSucFractal2 n =
    sum (take (fromIntegral n) sucFractal)

-- 3ª definición de sumaSucFractal
-- ===============================

sumaSucFractal3 :: Integer -> Integer
sumaSucFractal3 0 = 0
sumaSucFractal3 1 = 0
sumaSucFractal3 n
    | even n    = sumaN (n `div` 2) + sumaSucFractal3 (n `div` 2)
    | otherwise = sumaN ((n+1) `div` 2) + sumaSucFractal3 (n `div` 2)
    where sumaN n = (n*(n-1)) `div` 2

-- Comparación de eficiencia de definiciones de sumaSucFractal
-- ===========================================================

--    λ> sumaSucFractal1 (10^6)
--    166666169612
--    (5.25 secs, 810,622,504 bytes)
--    λ> sumaSucFractal2 (10^6)
--    166666169612
--    (1.72 secs, 286,444,048 bytes)
--    λ> sumaSucFractal3 (10^6)
--    166666169612
--    (0.01 secs, 0 bytes)
--    
--    λ> sumaSucFractal2 (10^7)
--    16666661685034
--    (17.49 secs, 3,021,580,920 bytes)
--    λ> sumaSucFractal3 (10^7)
--    16666661685034
--    (0.01 secs, 0 bytes)

-- 1ª definición de sucFractal

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

sucFractal1 :: [Integer]

sucFractal1 =

map termino [0..]

-- (termino n) es el término n de la secuencia anterior. Por ejemplo,

-- termino 0 == 0

-- termino 1 == 0

-- map termino [0..10] == [0,0,1,0,2,1,3,0,4,2,5]

termino :: Integer -> Integer

termino 0 = 0

termino n

| even n = n `div` 2

| otherwise = termino (n `div` 2)

-- 2ª definición de sucFractal

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

sucFractal2 :: [Integer]

sucFractal2 =

0 : 0 : mezcla [1..] (tail sucFractal2)

-- (mezcla xs ys) es la lista obtenida intercalando las listas infinitas

-- xs e ys. Por ejemplo,

-- take 10 (mezcla [0,2..] [0,-2..]) == [0,0,2,-2,4,-4,6,-6,8,-8]

mezcla :: [Integer] -> [Integer] -> [Integer]

mezcla (x:xs) (y:ys) =

x:y:mezcla xs ys

-- Comparación de eficiencia de definiciones de sucFractal

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

-- λ> sum (take (10^6) sucFractal1)

-- 166666169612

-- (5.56 secs, 842,863,264 bytes)

-- λ> sum (take (10^6) sucFractal2)

-- 166666169612

-- (1.81 secs, 306,262,616 bytes)

-- En lo que sigue usaremos la 2ª definición

sucFractal :: [Integer]

sucFractal = sucFractal2

-- 1ª definición de sumaSucFractal

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

sumaSucFractal1 :: Integer -> Integer

sumaSucFractal1 n =

sum (map termino [0..n-1])

-- 2ª definición de sumaSucFractal

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

sumaSucFractal2 :: Integer -> Integer

sumaSucFractal2 n =

sum (take (fromIntegral n) sucFractal)

-- 3ª definición de sumaSucFractal

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

sumaSucFractal3 :: Integer -> Integer

sumaSucFractal3 0 = 0

sumaSucFractal3 1 = 0

sumaSucFractal3 n

| even n = sumaN (n `div` 2) + sumaSucFractal3 (n `div` 2)

| otherwise = sumaN ((n+1) `div` 2) + sumaSucFractal3 (n `div` 2)

where sumaN n = (n*(n-1)) `div` 2

-- Comparación de eficiencia de definiciones de sumaSucFractal

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

-- λ> sumaSucFractal1 (10^6)

-- 166666169612

-- (5.25 secs, 810,622,504 bytes)

-- λ> sumaSucFractal2 (10^6)

-- 166666169612

-- (1.72 secs, 286,444,048 bytes)

-- λ> sumaSucFractal3 (10^6)

-- 166666169612

-- (0.01 secs, 0 bytes)

-- λ> sumaSucFractal2 (10^7)

-- 16666661685034

-- (17.49 secs, 3,021,580,920 bytes)

-- λ> sumaSucFractal3 (10^7)

-- 16666661685034

-- (0.01 secs, 0 bytes)

Referencia

Fractal sequences and restricted Nim por Lionel Levine.

Conjuntos de primos emparejables

PorJosé A. Alonso 9-mayo-201625-abril-2021

Un conjunto de primos emparejables es un conjunto S de números primos tales que al concatenar cualquier par de elementos de S se obtiene un número primo. Por ejemplo, {3, 7, 109, 673} es un conjunto de primos emparejables ya que sus elementos son primos y las concatenaciones de sus parejas son 37, 3109, 3673, 73, 7109, 7673, 1093, 1097, 109673, 6733, 6737 y 673109 son primos.

Definir la función

   emparejables :: Integer -> Integer -> [[Integer]]

1	emparejables :: Integer -> Integer -> [[Integer]]

tal que (emparejables n m) es el conjunto de los conjuntos emparejables de n elementos menores que n. Por ejemplo,

   take 5 (emparejables 2   10)  ==  [[3,7]]
   take 5 (emparejables 3   10)  ==  []
   take 5 (emparejables 2  100)  ==  [[3,7],[3,11],[3,17],[3,31],[3,37]]
   take 5 (emparejables 3  100)  ==  [[3,37,67],[7,19,97]]
   take 5 (emparejables 4  100)  ==  []
   take 5 (emparejables 4 1000)  ==  [[3,7,109,673],[23,311,677,827]]

take 5 (emparejables 2 10) == [[3,7]]

take 5 (emparejables 3 10) == []

take 5 (emparejables 2 100) == [[3,7],[3,11],[3,17],[3,31],[3,37]]

take 5 (emparejables 3 100) == [[3,37,67],[7,19,97]]

take 5 (emparejables 4 100) == []

take 5 (emparejables 4 1000) == [[3,7,109,673],[23,311,677,827]]

Soluciones

import Data.Numbers.Primes (primes, isPrime)
import Data.List (nub, sort)
import qualified Data.Set as S

-- 1ª definición
-- =============

emparejables :: Integer -> Integer -> [[Integer]]
emparejables 0 _ = [[]]
emparejables n m = 
    nub [sort (x:xs) | x <- takeWhile (<=m) primes,
                       xs <- xss,
                       all (x `emparejable`) xs]
    where xss = emparejables (n-1) m

emparejable :: Integer -> Integer -> Bool
emparejable x y =
    isPrime (concatenacion x y) &&
    isPrime (concatenacion y x)

concatenacion :: Integer -> Integer -> Integer
concatenacion x y =
    read (show x ++ show y)

-- 2ª definición
-- =============

emparejables2 :: Integer -> Integer -> [[Integer]]
emparejables2 n m = map reverse (aux n m)
    where aux 1 m = [[x] | x <- takeWhile (<=m) primes]
          aux n m = 
              [p:ys | ys@(x:xs) <- xss,
                      p <- dropWhile (<x) ps,
                      all (p `emparejable`) ys]
              where ps  = takeWhile (<=m) primes
                    xss = aux (n-1) m

-- 3ª definición
-- =============

emparejables3 :: Integer -> Integer -> [[Integer]]
emparejables3 n m = map S.toList (aux n m)
    where aux 1 m = [S.singleton x | x <- takeWhile (<=m) primes]
          aux n m = [S.insert x xs | x <- takeWhile (<=m) primes,
                                     xs <- xss,
                                     all (x `emparejable`) xs]
              where xss = aux (n-1) m

-- 2ª definición
-- =============

emparejables4 :: Integer -> Integer -> [[Integer]]
emparejables4 n m = map S.toList (aux n m)
    where aux 1 m = [S.singleton x | x <- takeWhile (<=m) primes]
          aux n m = 
              [S.insert p ys | ys <- xss,
                               let (x,xs) = S.deleteFindMax ys,
                               p <- dropWhile (<x) ps,
                               all (p `emparejable`) ys]
              where ps  = takeWhile (<=m) primes
                    xss = aux (n-1) m

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

--    λ> head (emparejables 4 1000)
--    [3,7,109,673]
--    (20.36 secs, 11,781,891,120 bytes)
--    
--    λ> head (emparejables2 4 1000)
--    [3,7,109,673]
--    (0.02 secs, 0 bytes)
--    
--    λ> head (emparejables3 4 1000)
--    [3,7,109,673]
--    (38.04 secs, 21,542,334,024 bytes)
--    
--    λ> head (emparejables4 4 1000)
--    [3,7,109,673]
--    (0.03 secs, 0 bytes)

import Data.Numbers.Primes (primes, isPrime)

import Data.List (nub, sort)

import qualified Data.Set as S

-- 1ª definición

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

emparejables :: Integer -> Integer -> [[Integer]]

emparejables 0 _ = [[]]

emparejables n m =

nub [sort (x:xs) | x <- takeWhile (<=m) primes,

xs <- xss,

all (x `emparejable`) xs]

where xss = emparejables (n-1) m

emparejable :: Integer -> Integer -> Bool

emparejable x y =

isPrime (concatenacion x y) &&

isPrime (concatenacion y x)

concatenacion :: Integer -> Integer -> Integer

concatenacion x y =

read (show x ++ show y)

-- 2ª definición

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

emparejables2 :: Integer -> Integer -> [[Integer]]

emparejables2 n m = map reverse (aux n m)

where aux 1 m = [[x] | x <- takeWhile (<=m) primes]

aux n m =

[p:ys | ys@(x:xs) <- xss,

p <- dropWhile (<x) ps,

all (p `emparejable`) ys]

where ps = takeWhile (<=m) primes

xss = aux (n-1) m

-- 3ª definición

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

emparejables3 :: Integer -> Integer -> [[Integer]]

emparejables3 n m = map S.toList (aux n m)

where aux 1 m = [S.singleton x | x <- takeWhile (<=m) primes]

aux n m = [S.insert x xs | x <- takeWhile (<=m) primes,

xs <- xss,

all (x `emparejable`) xs]

where xss = aux (n-1) m

-- 2ª definición

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

emparejables4 :: Integer -> Integer -> [[Integer]]

emparejables4 n m = map S.toList (aux n m)

where aux 1 m = [S.singleton x | x <- takeWhile (<=m) primes]

aux n m =

[S.insert p ys | ys <- xss,

let (x,xs) = S.deleteFindMax ys,

p <- dropWhile (<x) ps,

all (p `emparejable`) ys]

where ps = takeWhile (<=m) primes

xss = aux (n-1) m

-- Comparación de eficiencia

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

-- λ> head (emparejables 4 1000)

-- [3,7,109,673]

-- (20.36 secs, 11,781,891,120 bytes)

-- λ> head (emparejables2 4 1000)

-- [3,7,109,673]

-- (0.02 secs, 0 bytes)

-- λ> head (emparejables3 4 1000)

-- [3,7,109,673]

-- (38.04 secs, 21,542,334,024 bytes)

-- λ> head (emparejables4 4 1000)

-- [3,7,109,673]

-- (0.03 secs, 0 bytes)

Cadenas de divisores

PorJosé A. Alonso 6-mayo-201625-abril-2021

Una cadena de divisores de un número n es una lista donde cada elemento es un divisor de su siguiente elemento en la lista. Por ejemplo, las cadenas de divisores de 12 son [2,4,12], [2,6,12], [2,12], [3,6,12], [3,12], [4,12], [6,12] y [12].

Definir la función

   cadenasDivisores :: Int -> [[Int]]

1	cadenasDivisores :: Int -> [[Int]]

tal que (cadenasDivisores n) es la lista de las cadenas de divisores de n. Por ejemplo,

   λ> cadenasDivisores 12
   [[2,4,12],[2,6,12],[2,12],[3,6,12],[3,12],[4,12],[6,12],[12]]
   λ> length (cadenaDivisores 48)
   48
   λ> length (cadenaDivisores 120)
   132

λ> cadenasDivisores 12

[[2,4,12],[2,6,12],[2,12],[3,6,12],[3,12],[4,12],[6,12],[12]]

λ> length (cadenaDivisores 48)

λ> length (cadenaDivisores 120)

132

Soluciones

import Data.List (sort)
import Data.Numbers.Primes (isPrime)

-- 1ª definición
-- =============

cadenasDivisores :: Int -> [[Int]]
cadenasDivisores n = sort (extiendeLista [[n]])
    where extiendeLista []           = []
          extiendeLista ((1:xs):yss) = xs : extiendeLista yss
          extiendeLista ((x:xs):yss) =
              extiendeLista ([y:x:xs | y <- divisores x] ++ yss)

-- (divisores x) es la lista decreciente de los divisores de x distintos
-- de x. Por ejemplo,
--    divisores 12  ==  [6,4,3,2,1]
divisores :: Int -> [Int]
divisores x = 
    [y | y <- [a,a-1..1], x `mod` y == 0]
    where a = x `div` 2

-- 2ª definición
-- =============

cadenasDivisores2 :: Int -> [[Int]]
cadenasDivisores2 = sort . aux
    where aux 1 = [[]]
          aux n = [xs ++ [n] | xs <- concatMap aux (divisores n)]

-- 3ª definición
-- =============

cadenasDivisores3 :: Int -> [[Int]]
cadenasDivisores3 = sort . map reverse . aux
    where aux 1 = [[]]
          aux n = map (n:) (concatMap aux (divisores3 n))

-- (divisores3 x) es la lista creciente de los divisores de x distintos
-- de x. Por ejemplo,
--    divisores3 12  ==  [1,2,3,4,6]
divisores3 :: Int -> [Int]
divisores3 x = 
    [y | y <- [1..a], x `mod` y == 0]
    where a = x `div` 2

-- 1ª definición de nCadenasDivisores
-- ==================================

nCadenasDivisores1 :: Int -> Int
nCadenasDivisores1 = length . cadenasDivisores

-- 2ª definición de nCadenasDivisores
-- ==================================

nCadenasDivisores2 :: Int -> Int
nCadenasDivisores2 1 = 1
nCadenasDivisores2 n = 
    sum [nCadenasDivisores2 x | x <- divisores n]

import Data.List (sort)

import Data.Numbers.Primes (isPrime)

-- 1ª definición

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

cadenasDivisores :: Int -> [[Int]]

cadenasDivisores n = sort (extiendeLista [[n]])

where extiendeLista [] = []

extiendeLista ((1:xs):yss) = xs : extiendeLista yss

extiendeLista ((x:xs):yss) =

extiendeLista ([y:x:xs | y <- divisores x] ++ yss)

-- (divisores x) es la lista decreciente de los divisores de x distintos

-- de x. Por ejemplo,

-- divisores 12 == [6,4,3,2,1]

divisores :: Int -> [Int]

divisores x =

[y | y <- [a,a-1..1], x `mod` y == 0]

where a = x `div` 2

-- 2ª definición

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

cadenasDivisores2 :: Int -> [[Int]]

cadenasDivisores2 = sort . aux

where aux 1 = [[]]

aux n = [xs ++ [n] | xs <- concatMap aux (divisores n)]

-- 3ª definición

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

cadenasDivisores3 :: Int -> [[Int]]

cadenasDivisores3 = sort . map reverse . aux

where aux 1 = [[]]

aux n = map (n:) (concatMap aux (divisores3 n))

-- (divisores3 x) es la lista creciente de los divisores de x distintos

-- de x. Por ejemplo,

-- divisores3 12 == [1,2,3,4,6]

divisores3 :: Int -> [Int]

divisores3 x =

[y | y <- [1..a], x `mod` y == 0]

where a = x `div` 2

-- 1ª definición de nCadenasDivisores

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

nCadenasDivisores1 :: Int -> Int

nCadenasDivisores1 = length . cadenasDivisores

-- 2ª definición de nCadenasDivisores

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

nCadenasDivisores2 :: Int -> Int

nCadenasDivisores2 1 = 1

nCadenasDivisores2 n =

sum [nCadenasDivisores2 x | x <- divisores n]

Referencias

Sucesión A163272 de OEIS.
Ordered and unordered factorizations of integers por A. Knopfmacher y M. Mays

Operaciones con series de potencias

PorJosé A. Alonso 29-abril-201625-marzo-2022

Una serie de potencias es una serie de la forma

   a₀ + a₁x + a₂x² + a₃x³ + ...

1	a₀ + a₁x + a₂x² + a₃x³ + ...

Las series de potencias se pueden representar mediante listas
infinitas. Por ejemplo, la serie de la función exponencial es

   e^x = 1 + x + x²/2! + x³/3! + ...

1	e^x = 1 + x + x²/2! + x³/3! + ...

y se puede representar por [1, 1, 1/2, 1/6, 1/24, 1/120, …]

Las operaciones con series se pueden ver como una generalización de las de los polinomios.

En lo que sigue, usaremos el tipo (Serie a) para representar las series de potencias con coeficientes en a y su definición es

   type Serie a = [a]

1	type Serie a = [a]

Definir las siguientes funciones

   opuesta      :: Num a => Serie a -> Serie a
   suma         :: Num a => Serie a -> Serie a -> Serie a
   resta        :: Num a => Serie a -> Serie a -> Serie a
   producto     :: Num a => Serie a -> Serie a -> Serie a
   cociente     :: Fractional a => Serie a -> Serie a -> Serie a
   derivada     :: (Num a, Enum a) => Serie a -> Serie a
   integral     :: (Fractional a, Enum a) => Serie a -> Serie a
   expx         :: Serie Rational

opuesta :: Num a => Serie a -> Serie a

suma :: Num a => Serie a -> Serie a -> Serie a

resta :: Num a => Serie a -> Serie a -> Serie a

producto :: Num a => Serie a -> Serie a -> Serie a

cociente :: Fractional a => Serie a -> Serie a -> Serie a

derivada :: (Num a, Enum a) => Serie a -> Serie a

integral :: (Fractional a, Enum a) => Serie a -> Serie a

expx :: Serie Rational

tales que

(opuesta xs) es la opuesta de la serie xs. Por ejemplo,

     λ> take 7 (opuesta [-6,-4..])
     [6,4,2,0,-2,-4,-6]

1 2	λ> take 7 (opuesta [-6,-4..]) [6,4,2,0,-2,-4,-6]

(suma xs ys) es la suma de las series xs e ys. Por ejemplo,

     λ> take 7 (suma [1,3..] [2,4..])
     [3,7,11,15,19,23,27]

1 2	λ> take 7 (suma [1,3..] [2,4..]) [3,7,11,15,19,23,27]

(resta xs ys) es la resta de las series xs es ys. Por ejemplo,

     λ> take 7 (resta [3,5..] [2,4..])
     [1,1,1,1,1,1,1]
     λ> take 7 (resta ([3,7,11,15,19,23,27] ++ repeat 0) [1,3..])
     [2,4,6,8,10,12,14]

λ> take 7 (resta [3,5..] [2,4..])

[1,1,1,1,1,1,1]

λ> take 7 (resta ([3,7,11,15,19,23,27] ++ repeat 0) [1,3..])

[2,4,6,8,10,12,14]

(producto xs ys) es el producto de las series xs e ys. Por ejemplo,

     λ> take 7 (producto [3,5..] [2,4..])
     [6,22,52,100,170,266,392]

1 2	λ> take 7 (producto [3,5..] [2,4..]) [6,22,52,100,170,266,392]

(cociente xs ys) es el cociente de las series xs e ys. Por ejemplo,

     λ> take 7 (cociente ([6,22,52,100,170,266,392] ++ repeat 0) [3,5..])
     [2.0,4.0,6.0,8.0,10.0,12.0,14.0]

1 2	λ> take 7 (cociente ([6,22,52,100,170,266,392] ++ repeat 0) [3,5..]) [2.0,4.0,6.0,8.0,10.0,12.0,14.0]

(derivada xs) es la derivada de la serie xs. Por ejemplo,

     λ> take 7 (derivada [2,4..])
     [4,12,24,40,60,84,112]

1 2	λ> take 7 (derivada [2,4..]) [4,12,24,40,60,84,112]

(integral xs) es la integral de la serie xs. Por ejemplo,

     λ> take 7 (integral ([4,12,24,40,60,84,112] ++ repeat 0))
     [0.0,4.0,6.0,8.0,10.0,12.0,14.0]

1 2	λ> take 7 (integral ([4,12,24,40,60,84,112] ++ repeat 0)) [0.0,4.0,6.0,8.0,10.0,12.0,14.0]

expx es la serie de la función exponencial. Por ejemplo,

     λ> take 8 expx
     [1 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]
     λ> take 8 (derivada expx)
     [1 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]
     λ> take 8 (integral expx)
     [0 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]

λ> take 8 expx

[1 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]

λ> take 8 (derivada expx)

[1 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]

λ> take 8 (integral expx)

[0 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]

Soluciones

type Serie a = [a] 

opuesta :: Num a => Serie a -> Serie a
opuesta = map negate

suma :: Num a => Serie a -> Serie a -> Serie a
suma = zipWith (+)

resta :: Num a => Serie a -> Serie a -> Serie a
resta xs ys = suma xs (opuesta ys)

producto :: Num a => Serie a -> Serie a -> Serie a
producto (x:xs) zs@(y:ys) = 
    x*y : suma (producto xs zs) (map (x*) ys)

cociente :: Fractional a => Serie a -> Serie a -> Serie a
cociente (x:xs) (y:ys) = zs 
    where zs = x/y : map (/y) (resta xs (producto zs ys))  

derivada :: (Num a, Enum a) => Serie a -> Serie a
derivada (_:xs) = zipWith (*) xs [1..]

integral :: (Fractional a, Enum a) => Serie a -> Serie a
integral xs = 0 : zipWith (/) xs [1..]

expx :: Serie Rational
expx = map (1/) (map fromIntegral factoriales)

-- factoriales es la lista de los factoriales. Por ejemplo, 
--    take 7 factoriales  ==  [1,1,2,6,24,120,720]
factoriales :: [Integer]
factoriales = 1 : scanl1 (*) [1..]

type Serie a = [a]

opuesta :: Num a => Serie a -> Serie a

opuesta = map negate

suma :: Num a => Serie a -> Serie a -> Serie a

suma = zipWith (+)

resta :: Num a => Serie a -> Serie a -> Serie a

resta xs ys = suma xs (opuesta ys)

producto :: Num a => Serie a -> Serie a -> Serie a

producto (x:xs) zs@(y:ys) =

x*y : suma (producto xs zs) (map (x*) ys)

cociente :: Fractional a => Serie a -> Serie a -> Serie a

cociente (x:xs) (y:ys) = zs

where zs = x/y : map (/y) (resta xs (producto zs ys))

derivada :: (Num a, Enum a) => Serie a -> Serie a

derivada (_:xs) = zipWith (*) xs [1..]

integral :: (Fractional a, Enum a) => Serie a -> Serie a

integral xs = 0 : zipWith (/) xs [1..]

expx :: Serie Rational

expx = map (1/) (map fromIntegral factoriales)

-- factoriales es la lista de los factoriales. Por ejemplo,

-- take 7 factoriales == [1,1,2,6,24,120,720]

factoriales :: [Integer]

factoriales = 1 : scanl1 (*) [1..]

Comportamiento del último dígito en primos consecutivos

PorJosé A. Alonso 18-marzo-20162-mayo-2016

El pasado 11 de marzo se ha publicado el artículo Unexpected biases in the distribution of consecutive primes en el que muestra que los números primos repelen a otros primos que terminan en el mismo dígito.

La lista de los últimos dígitos de los 30 primeros números es

   [2,3,5,7,1,3,7,9,3,9,1,7,1,3,7,3,9,1,7,1,3,9,3,9,7,1,3,7,9,3]

1	[2,3,5,7,1,3,7,9,3,9,1,7,1,3,7,3,9,1,7,1,3,9,3,9,7,1,3,7,9,3]

Se observa que hay 6 números que su último dígito es un 1 y de sus consecutivos 4 terminan en 3 y 2 terminan en 7.

Definir la función

   distribucionUltimos :: Int -> M.Matrix Integer

1	distribucionUltimos :: Int -> M.Matrix Integer

tal que (distribucionUltimos n) es la matriz cuyo elemento (i,j) indica cuántos de los n primeros números primos terminan en i y su siguiente número primo termina en j. Por ejemplo,

   λ> distribucionUltimos 30
   ( 0 0 4 0 0 0 2 0 0 )
   ( 0 0 1 0 0 0 0 0 0 )
   ( 0 0 0 0 1 0 4 0 4 )
   ( 0 0 0 0 0 0 0 0 0 )
   ( 0 0 0 0 0 0 1 0 0 )
   ( 0 0 0 0 0 0 0 0 0 )
   ( 4 0 1 0 0 0 0 0 2 )
   ( 0 0 0 0 0 0 0 0 0 )
   ( 2 0 3 0 0 0 1 0 0 )
   
   λ> distribucionUltimos (10^5)
   ( 4104    0 7961    0    0    0 8297    0 4605 )
   (    0    0    1    0    0    0    0    0    0 )
   ( 5596    0 3604    0    1    0 7419    0 8387 )
   (    0    0    0    0    0    0    0    0    0 )
   (    0    0    0    0    0    0    1    0    0 )
   (    0    0    0    0    0    0    0    0    0 )
   ( 6438    0 6928    0    0    0 3627    0 8022 )
   (    0    0    0    0    0    0    0    0    0 )
   ( 8830    0 6513    0    0    0 5671    0 3995 )

λ> distribucionUltimos 30

( 0 0 4 0 0 0 2 0 0 )

( 0 0 1 0 0 0 0 0 0 )

( 0 0 0 0 1 0 4 0 4 )

( 0 0 0 0 0 0 0 0 0 )

( 0 0 0 0 0 0 1 0 0 )

( 0 0 0 0 0 0 0 0 0 )

( 4 0 1 0 0 0 0 0 2 )

( 0 0 0 0 0 0 0 0 0 )

( 2 0 3 0 0 0 1 0 0 )

λ> distribucionUltimos (10^5)

( 4104 0 7961 0 0 0 8297 0 4605 )

( 0 0 1 0 0 0 0 0 0 )

( 5596 0 3604 0 1 0 7419 0 8387 )

( 0 0 0 0 0 0 0 0 0 )

( 0 0 0 0 0 0 1 0 0 )

( 0 0 0 0 0 0 0 0 0 )

( 6438 0 6928 0 0 0 3627 0 8022 )

( 0 0 0 0 0 0 0 0 0 )

( 8830 0 6513 0 0 0 5671 0 3995 )

Nota: Se observa cómo se «repelen» ya que en las filas del 1, 3, 7 y 9 el menor elemento es el de la diagonal.

Soluciones

import Data.Numbers.Primes
import Data.Array
import qualified Data.Matrix as M

-- (ultimo n) es el último dígito de n.    
ultimo :: Integer -> Integer
ultimo n = n `mod` 10

-- ultimos es la lista de el último dígito de los primos.
--    λ> take 20 ultimos
--    [2,3,5,7,1,3,7,9,3,9,1,7,1,3,7,3,9,1,7,1]
ultimos :: [Integer]
ultimos = map ultimo primes

-- ultimosConsecutivos es la lista de los últimos dígitos de los primos
-- consecutivos. 
--    λ> take 10 ultimosConsecutivos
--    [(2,3),(3,5),(5,7),(7,1),(1,3),(3,7),(7,9),(9,3),(3,9),(9,1)]
ultimosConsecutivos :: [(Integer,Integer)]
ultimosConsecutivos = zip ultimos (tail ultimos)

-- (histograma r is) es el vector formado contando cuantas veces
-- aparecen los elementos del rango r en la lista de índices is. Por
-- ejemplo, 
--    ghci> histograma (0,5) [3,1,4,1,5,4,2,7]
--    array (0,5) [(0,0),(1,2),(2,1),(3,1),(4,2),(5,1)]
histograma :: (Ix a, Num b) => (a,a) -> [a] -> Array a b
histograma r is = 
    accumArray (+) 0 r [(i,1) | i <- is, inRange r i]

distribucionUltimos :: Int -> M.Matrix Integer
distribucionUltimos n =
    M.fromList 9 9 (elems (histograma ((1,1),(9,9)) (take n ultimosConsecutivos)))

import Data.Numbers.Primes

import Data.Array

import qualified Data.Matrix as M

-- (ultimo n) es el último dígito de n.

ultimo :: Integer -> Integer

ultimo n = n `mod` 10

-- ultimos es la lista de el último dígito de los primos.

-- λ> take 20 ultimos

-- [2,3,5,7,1,3,7,9,3,9,1,7,1,3,7,3,9,1,7,1]

ultimos :: [Integer]

ultimos = map ultimo primes

-- ultimosConsecutivos es la lista de los últimos dígitos de los primos

-- consecutivos.

-- λ> take 10 ultimosConsecutivos

-- [(2,3),(3,5),(5,7),(7,1),(1,3),(3,7),(7,9),(9,3),(3,9),(9,1)]

ultimosConsecutivos :: [(Integer,Integer)]

ultimosConsecutivos = zip ultimos (tail ultimos)

-- (histograma r is) es el vector formado contando cuantas veces

-- aparecen los elementos del rango r en la lista de índices is. Por

-- ejemplo,

-- ghci> histograma (0,5) [3,1,4,1,5,4,2,7]

-- array (0,5) [(0,0),(1,2),(2,1),(3,1),(4,2),(5,1)]

histograma :: (Ix a, Num b) => (a,a) -> [a] -> Array a b

histograma r is =

accumArray (+) 0 r [(i,1) | i <- is, inRange r i]

distribucionUltimos :: Int -> M.Matrix Integer

distribucionUltimos n =

M.fromList 9 9 (elems (histograma ((1,1),(9,9)) (take n ultimosConsecutivos)))

Solución en Maxima

distribucionUltimos (n) := block (
  [r : zeromatrix (9,9),
   xs : ultimos (n),
   i, j],
  unless length (xs) < 2 do
    ( i : first (xs),
      j : second (xs),
      r[i,j] : 1 + r[i,j],
      xs : rest (xs)),
  r)$

/* ultimos(n) es la lista del último dígito de los n primeros primos.
      (%i5) ultimos (30);
      (%o5) [2,3,5,7,1,3,7,9,3,9,1,7,1,3,7,3,9,1,7,1,3,9,3,9,7,1,3,7,9,3,7]
*/
ultimos (n) := block ([r:[], p:2],
  for k from 0 thru n do
    ( r : cons (mod (p,10), r),
      p : next_prime (p) ),
  reverse (r))$

distribucionUltimos (n) := block (

[r : zeromatrix (9,9),

xs : ultimos (n),

i, j],

unless length (xs) < 2 do

( i : first (xs),

j : second (xs),

r[i,j] : 1 + r[i,j],

xs : rest (xs)),

r)$

/* ultimos(n) es la lista del último dígito de los n primeros primos.

(%i5) ultimos (30);

(%o5) [2,3,5,7,1,3,7,9,3,9,1,7,1,3,7,3,9,1,7,1,3,9,3,9,7,1,3,7,9,3,7]

ultimos (n) := block ([r:[], p:2],

for k from 0 thru n do

( r : cons (mod (p,10), r),

p : next_prime (p) ),

reverse (r))$

Máxima suma de elementos consecutivos

PorJosé A. Alonso 17-marzo-20161-mayo-2016

Definir la función

   sumaMaxima :: [Integer] -> Integer

1	sumaMaxima :: [Integer] -> Integer

tal que (sumaMaxima xs) es el valor máximo de la suma de elementos consecutivos de la lista xs. Por ejemplo,

   sumaMaxima []             ==  0 
   sumaMaxima [2,-2,3,-3,4]  ==  4
   sumaMaxima [-1,-2,-3]     ==  0
   sumaMaxima [2,-1,3,-2,3]  ==  5
   sumaMaxima [1,-1,3,-2,4]  ==  5
   sumaMaxima [2,-1,3,-2,4]  ==  6
   sumaMaxima [1..10^6]      ==  500000500000

sumaMaxima [] == 0

sumaMaxima [2,-2,3,-3,4] == 4

sumaMaxima [-1,-2,-3] == 0

sumaMaxima [2,-1,3,-2,3] == 5

sumaMaxima [1,-1,3,-2,4] == 5

sumaMaxima [2,-1,3,-2,4] == 6

sumaMaxima [1..10^6] == 500000500000

Comprobar con QuickCheck que

   sumaMaxima xs == sumaMaxima (reverse xs)

1	sumaMaxima xs == sumaMaxima (reverse xs)

Soluciones

import Data.List (inits, tails)
import Test.QuickCheck

-- 1ª definición
-- =============

sumaMaxima1 :: [Integer] -> Integer
sumaMaxima1 [] = 0
sumaMaxima1 xs =
    maximum (0 : map sum [sublista xs i j | i <- [0..length xs - 1],
                                            j <- [i..length xs - 1]])

sublista :: [Integer] -> Int -> Int -> [Integer]
sublista xs i j =
    [xs!!k | k <- [i..j]]

-- 2ª definición
-- =============

sumaMaxima2 :: [Integer] -> Integer
sumaMaxima2 [] = 0
sumaMaxima2 xs = sumaMaximaAux 0 0 xs
    where m = maximum xs

sumaMaximaAux :: Integer -> Integer -> [Integer] -> Integer
sumaMaximaAux m v [] = max m v
sumaMaximaAux m v (x:xs)
    | x >= 0    = sumaMaximaAux m (v+x) xs
    | v+x > 0   = sumaMaximaAux (max m v) (v+x) xs
    | otherwise = sumaMaximaAux (max m v) 0 xs

-- 3ª definición
-- =============

sumaMaxima3 :: [Integer] -> Integer
sumaMaxima3 [] = 0
sumaMaxima3 xs = maximum (map sum (segmentos xs))

-- (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 =
    [] : concat [tail (inits ys) | ys <- init (tails xs)]

-- 4ª definición
-- =============

sumaMaxima4 :: [Integer] -> Integer
sumaMaxima4 [] = 0
sumaMaxima4 xs = 
    maximum (concat [scanl (+) 0 ys | ys <- tails xs])

-- Comprobación
-- ============

-- La propiedad es
prop_sumaMaxima :: [Integer] -> Bool
prop_sumaMaxima xs =
    sumaMaxima2 xs == n &&
    sumaMaxima3 xs == n &&
    sumaMaxima4 xs == n
    where n = sumaMaxima1 xs

-- La comprobación es
--    λ> quickCheck prop_sumaMaxima
--    +++ OK, passed 100 tests.

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

--    λ> let n = 10^2 in sumaMaxima1 [-n..n] 
--    5050
--    (2.10 secs, 390,399,104 bytes)
--    λ> let n = 10^2 in sumaMaxima2 [-n..n] 
--    5050
--    (0.02 secs, 0 bytes)
--    λ> let n = 10^2 in sumaMaxima3 [-n..n] 
--    5050
--    (0.27 secs, 147,705,184 bytes)
--    λ> let n = 10^2 in sumaMaxima4 [-n..n] 
--    5050
--    (0.04 secs, 11,582,520 bytes)

prop_inversa :: [Integer] -> Bool
prop_inversa xs =
    sumaMaxima2 xs == sumaMaxima2 (reverse xs)

import Data.List (inits, tails)

import Test.QuickCheck

-- 1ª definición

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

sumaMaxima1 :: [Integer] -> Integer

sumaMaxima1 [] = 0

sumaMaxima1 xs =

maximum (0 : map sum [sublista xs i j | i <- [0..length xs - 1],

j <- [i..length xs - 1]])

sublista :: [Integer] -> Int -> Int -> [Integer]

sublista xs i j =

[xs!!k | k <- [i..j]]

-- 2ª definición

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

sumaMaxima2 :: [Integer] -> Integer

sumaMaxima2 [] = 0

sumaMaxima2 xs = sumaMaximaAux 0 0 xs

where m = maximum xs

sumaMaximaAux :: Integer -> Integer -> [Integer] -> Integer

sumaMaximaAux m v [] = max m v

sumaMaximaAux m v (x:xs)

| x >= 0 = sumaMaximaAux m (v+x) xs

| v+x > 0 = sumaMaximaAux (max m v) (v+x) xs

| otherwise = sumaMaximaAux (max m v) 0 xs

-- 3ª definición

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

sumaMaxima3 :: [Integer] -> Integer

sumaMaxima3 [] = 0

sumaMaxima3 xs = maximum (map sum (segmentos xs))

-- (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 =

[] : concat [tail (inits ys) | ys <- init (tails xs)]

-- 4ª definición

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

sumaMaxima4 :: [Integer] -> Integer

sumaMaxima4 [] = 0

sumaMaxima4 xs =

maximum (concat [scanl (+) 0 ys | ys <- tails xs])

-- Comprobación

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

-- La propiedad es

prop_sumaMaxima :: [Integer] -> Bool

prop_sumaMaxima xs =

sumaMaxima2 xs == n &&

sumaMaxima3 xs == n &&

sumaMaxima4 xs == n

where n = sumaMaxima1 xs

-- La comprobación es

-- λ> quickCheck prop_sumaMaxima

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> let n = 10^2 in sumaMaxima1 [-n..n]

-- 5050

-- (2.10 secs, 390,399,104 bytes)

-- λ> let n = 10^2 in sumaMaxima2 [-n..n]

-- 5050

-- (0.02 secs, 0 bytes)

-- λ> let n = 10^2 in sumaMaxima3 [-n..n]

-- 5050

-- (0.27 secs, 147,705,184 bytes)

-- λ> let n = 10^2 in sumaMaxima4 [-n..n]

-- 5050

-- (0.04 secs, 11,582,520 bytes)

prop_inversa :: [Integer] -> Bool

prop_inversa xs =

sumaMaxima2 xs == sumaMaxima2 (reverse xs)

Paridad del número de divisores

PorJosé A. Alonso 10-marzo-201617-marzo-2016

Definir la función

   nDivisoresPar :: Integer -> Bool

1	nDivisoresPar :: Integer -> Bool

tal que (nDivisoresPar n) se verifica si n tiene un número par de divisores. Por ejemplo,

   nDivisoresPar 12                     ==  True
   nDivisoresPar 16                     ==  False
   nDivisoresPar (product [1..2*10^4])  ==  True

nDivisoresPar 12 == True

nDivisoresPar 16 == False

nDivisoresPar (product [1..2*10^4]) == True

Soluciones

import Data.List (group)
import Data.Numbers.Primes (primeFactors)

-- 1ª definición
-- =============

nDivisoresPar1 :: Integer -> Bool
nDivisoresPar1 = even . length . divisores

-- (divisores n) es la lista de los divisores de n. Por ejemplo,
--    divisores 12  ==  [1,2,3,4,6,12]
--    divisores 16  ==  [1,2,4,8,16]
divisores :: Integer -> [Integer]
divisores n =
    [x | x <- [1..n], n `mod` x == 0]

-- 2ª definición
-- =============

nDivisoresPar2 :: Integer -> Bool
nDivisoresPar2 n =
    any odd (map length (group (primeFactors n)))

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

--    λ> nDivisoresPar1 (10^7)
--    True
--    (14.18 secs, 2,078,736,992 bytes)
--    λ> nDivisoresPar2 (10^7)
--    True
--    (0.01 secs, 0 bytes)
--
--    λ> nDivisoresPar2 (product [1..2*10^4])
--    True
--    (2.30 secs, 1,003,013,112 bytes)

import Data.List (group)

import Data.Numbers.Primes (primeFactors)

-- 1ª definición

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

nDivisoresPar1 :: Integer -> Bool

nDivisoresPar1 = even . length . divisores

-- (divisores n) es la lista de los divisores de n. Por ejemplo,

-- divisores 12 == [1,2,3,4,6,12]

-- divisores 16 == [1,2,4,8,16]

divisores :: Integer -> [Integer]

divisores n =

[x | x <- [1..n], n `mod` x == 0]

-- 2ª definición

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

nDivisoresPar2 :: Integer -> Bool

nDivisoresPar2 n =

any odd (map length (group (primeFactors n)))

-- Comparación de eficiencia

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

-- λ> nDivisoresPar1 (10^7)

-- True

-- (14.18 secs, 2,078,736,992 bytes)

-- λ> nDivisoresPar2 (10^7)

-- True

-- (0.01 secs, 0 bytes)

-- λ> nDivisoresPar2 (product [1..2*10^4])

-- True

-- (2.30 secs, 1,003,013,112 bytes)

Solución en Maxima

/* concat(xs) es la lista obtenida concatenado los elementos de xss. Por
   ejemplo,
      concat([[1,3],[2,4],[5,7]])  ==  [1, 3, 2, 4, 5, 7]             */
concat (xs) := block ([r:[]],
  for x in reverse (xs) do r : append (x,r),
  r)$

nDivisoresPares (n) := block(
  [xs : concat (map (rest, ifactors (n))), p : false],
  for x in xs do p: oddp (x) or p,
  p)$

/* concat(xs) es la lista obtenida concatenado los elementos de xss. Por

ejemplo,

concat([[1,3],[2,4],[5,7]]) == [1, 3, 2, 4, 5, 7] */

concat (xs) := block ([r:[]],

for x in reverse (xs) do r : append (x,r),

r)$

nDivisoresPares (n) := block(

[xs : concat (map (rest, ifactors (n))), p : false],

for x in xs do p: oddp (x) or p,

p)$

Máxima longitud de las sublistas comunes

PorJosé A. Alonso 9-marzo-201616-marzo-2016

Las sublistas comunes de «1325» y «36572» son «», «3»,»32″, «35», «2» y «5». El máximo de sus longitudes es 2.

Definir la función

   maximo :: Eq a => [a] -> [a] -> Int

1	maximo :: Eq a => [a] -> [a] -> Int

tal que (maximo xs ys) es el máximo de las longitudes de las sublistas comunes de xs e ys. Por ejemplo,

   maximo "1325" "36572"       == 2
   maximo [1,4..33] [2,4..33]  == 5
   maximo [1..10^6] [1..10^6]  == 100000

maximo "1325" "36572" == 2

maximo [1,4..33] [2,4..33] == 5

maximo [1..10^6] [1..10^6] == 100000

Soluciones

import Data.List (subsequences, intersect)

-- 1ª definición
-- =============

maximo1 :: Eq a => [a] -> [a] -> Int
maximo1 xs ys = 
    maximum (map length (sublistasComunes xs ys))

-- (sublistasComunes xs ys) es la lista de las sublistas comunes de xs e
-- ys. Por ejemplo,
sublistasComunes :: Eq a => [a] -> [a] -> [[a]]
sublistasComunes xs ys =
    subsequences xs `intersect` subsequences ys

-- 2ª definición
-- =============

maximo2 :: Eq a => [a] -> [a] -> Int
maximo2 l1@(x:xs) l2@(y:ys) 
    | x == y    = 1 + maximo2 xs ys
    | otherwise = max (maximo2 xs l2) (maximo2 l1 ys)  
maximo2 _ _ = 0

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

--    λ> maximo1 [1,4..30] [2,4..30]
--    5
--    (3.60 secs, 0 bytes)
--    λ> maximo2 [1,4..30] [2,4..30]
--    5
--    (1.58 secs, 216,347,472 bytes)
--    
--    λ> maximo2 [1..10^6] [1..10^6]
--    1000000
--    (2.44 secs, 407,051,096 bytes)

import Data.List (subsequences, intersect)

-- 1ª definición

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

maximo1 :: Eq a => [a] -> [a] -> Int

maximo1 xs ys =

maximum (map length (sublistasComunes xs ys))

-- (sublistasComunes xs ys) es la lista de las sublistas comunes de xs e

-- ys. Por ejemplo,

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

sublistasComunes xs ys =

subsequences xs `intersect` subsequences ys

-- 2ª definición

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

maximo2 :: Eq a => [a] -> [a] -> Int

maximo2 l1@(x:xs) l2@(y:ys)

| x == y = 1 + maximo2 xs ys

| otherwise = max (maximo2 xs l2) (maximo2 l1 ys)

maximo2 _ _ = 0

-- Comparación de eficiencia

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

-- λ> maximo1 [1,4..30] [2,4..30]

-- 5

-- (3.60 secs, 0 bytes)

-- λ> maximo2 [1,4..30] [2,4..30]

-- 5

-- (1.58 secs, 216,347,472 bytes)

-- λ> maximo2 [1..10^6] [1..10^6]

-- 1000000

-- (2.44 secs, 407,051,096 bytes)

Particiones en sumas de cuadrados

PorJosé A. Alonso 26-febrero-20161-mayo-2016

Definir las funciones

   particionesCuadradas        :: Integer -> [[Integer]]
   nParticionesCuadradas       :: Integer -> Integer
   graficaParticionesCuadradas :: Integer -> IO ()

particionesCuadradas :: Integer -> [[Integer]]

nParticionesCuadradas :: Integer -> Integer

graficaParticionesCuadradas :: Integer -> IO ()

tales que

(particionesCuadradas n) es la listas de conjuntos de cuadrados cuya suma es n. Por ejemplo,

      particionesCuadradas 3  ==  [[1,1,1]]
      particionesCuadradas 4  ==  [[4],[1,1,1,1]]
      particionesCuadradas 9  ==  [[9],[4,4,1],[4,1,1,1,1,1],[1,1,1,1,1,1,1,1,1]]

particionesCuadradas 3 == [[1,1,1]]

particionesCuadradas 4 == [[4],[1,1,1,1]]

particionesCuadradas 9 == [[9],[4,4,1],[4,1,1,1,1,1],[1,1,1,1,1,1,1,1,1]]

(nParticionesCuadradas n) es el número de conjuntos de cuadrados cuya suma es n. Por ejemplo,

      nParticionesCuadradas 3    ==  1
      nParticionesCuadradas 4    ==  2
      nParticionesCuadradas 9    ==  4
      nParticionesCuadradas 50   ==  104
      nParticionesCuadradas 100  ==  1116
      nParticionesCuadradas 200  ==  27482

nParticionesCuadradas 3 == 1

nParticionesCuadradas 4 == 2

nParticionesCuadradas 9 == 4

nParticionesCuadradas 50 == 104

nParticionesCuadradas 100 == 1116

nParticionesCuadradas 200 == 27482

(graficaParticionesCuadradas n) dibuja la gráfica de la sucesión

      [nParticionesCuadradas k | k <- [0..n]]

1	[nParticionesCuadradas k \| k <- [0..n]]

Por ejemplo, con (graficaParticionesCuadradas 100) se obtiene

Soluciones

import Data.List (genericLength)
import Graphics.Gnuplot.Simple

-- Definición de particiones cuadradas
-- ===================================

particionesCuadradas :: Integer -> [[Integer]]
particionesCuadradas n = 
    particiones n (reverse $ takeWhile (<=n) cuadrados)

-- cuadrados es la lista de los cuadrados. Por ejemplo,
--    take 12 cuadrados  ==  [1,4,9,16,25,36,49,64,81,100,121,144]
cuadrados :: [Integer]
cuadrados = map (^2) [1..]

-- (particiones n xs) es la lista de las particiones de n como suma de
-- elementos de xs, donde xs es una lista no creciente. Por ejemplo,
--    particiones 10 [7,4,2]  ==  [[4,4,2],[4,2,2,2],[2,2,2,2,2]]
--    particiones 11 [7,4,2]  ==  [[7,4],[7,2,2]]
--    particiones  5 [7,4,2]  ==  []
particiones:: Integer -> [Integer] -> [[Integer]]
particiones _ [] = []
particiones n (x:xs)
    | x >  n    = particiones n xs
    | x == n    = [n] : particiones n xs
    | otherwise = map (x:) (particiones (n-x) (x:xs)) ++ particiones n xs

-- 1ª definición de nParticionesCuadradas       
nParticionesCuadradas1 :: Integer -> Integer
nParticionesCuadradas1 = genericLength . particionesCuadradas

-- 2ª definición nParticionesCuadradas   
nParticionesCuadradas2 :: Integer -> Integer
nParticionesCuadradas2 n = aux n (reverse $ takeWhile (<=n) cuadrados) where
    aux _ [] = 0
    aux n ys@(x:xs) | x >  n    = aux n xs
                    | x == n    = 1 + aux n xs
                    | otherwise = aux (n-x) ys + aux n xs

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

--    λ> nParticionesCuadradas1 250
--    94987
--    (4.21 secs, 3,256,031,528 bytes)
--    λ> nParticionesCuadradas2 250
--    94987
--    (2.93 secs, 1,714,701,504 bytes)

-- Definición de graficaParticionesCuadradas
-- =========================================
                                  
graficaParticionesCuadradas :: Integer  -> IO ()
graficaParticionesCuadradas n = 
    plotList [Key Nothing] [nParticionesCuadradas2 k | k <- [0..n]]

import Data.List (genericLength)

import Graphics.Gnuplot.Simple

-- Definición de particiones cuadradas

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

particionesCuadradas :: Integer -> [[Integer]]

particionesCuadradas n =

particiones n (reverse $ takeWhile (<=n) cuadrados)

-- cuadrados es la lista de los cuadrados. Por ejemplo,

-- take 12 cuadrados == [1,4,9,16,25,36,49,64,81,100,121,144]

cuadrados :: [Integer]

cuadrados = map (^2) [1..]

-- (particiones n xs) es la lista de las particiones de n como suma de

-- elementos de xs, donde xs es una lista no creciente. Por ejemplo,

-- particiones 10 [7,4,2] == [[4,4,2],[4,2,2,2],[2,2,2,2,2]]

-- particiones 11 [7,4,2] == [[7,4],[7,2,2]]

-- particiones 5 [7,4,2] == []

particiones:: Integer -> [Integer] -> [[Integer]]

particiones _ [] = []

particiones n (x:xs)

| x > n = particiones n xs

| x == n = [n] : particiones n xs

| otherwise = map (x:) (particiones (n-x) (x:xs)) ++ particiones n xs

-- 1ª definición de nParticionesCuadradas

nParticionesCuadradas1 :: Integer -> Integer

nParticionesCuadradas1 = genericLength . particionesCuadradas

-- 2ª definición nParticionesCuadradas

nParticionesCuadradas2 :: Integer -> Integer

nParticionesCuadradas2 n = aux n (reverse $ takeWhile (<=n) cuadrados) where

aux _ [] = 0

aux n ys@(x:xs) | x > n = aux n xs

| x == n = 1 + aux n xs

| otherwise = aux (n-x) ys + aux n xs

-- Comparación de eficiencia

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

-- λ> nParticionesCuadradas1 250

-- 94987

-- (4.21 secs, 3,256,031,528 bytes)

-- λ> nParticionesCuadradas2 250

-- 94987

-- (2.93 secs, 1,714,701,504 bytes)

-- Definición de graficaParticionesCuadradas

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

graficaParticionesCuadradas :: Integer -> IO ()

graficaParticionesCuadradas n =

plotList [Key Nothing] [nParticionesCuadradas2 k | k <- [0..n]]

Referencias

Sucesión A001156 de OEIS.

Sumas digitales de primos consecutivos

PorJosé A. Alonso 22-enero-20161-mayo-2016

Definir la función

   primosConsecutivosConSumasDigitalesPrimas :: Int -> [[Integer]]

1	primosConsecutivosConSumasDigitalesPrimas :: Int -> [[Integer]]

tal que (primosConsecutivosConSumasDigitalesPrimas k) es la sucesión de listas de k primos consecutivos tales que las sumas ordenadas de sus dígitos también son primos consecutivos. Por ejemplo,

   λ> take 5 (primosConsecutivosConSumasDigitalesPrimas 2)
   [[2,3],[3,5],[5,7],[41,43],[43,47]]
   λ> take 5 (primosConsecutivosConSumasDigitalesPrimas 3)
   [[2,3,5],[3,5,7],[41,43,47],[191,193,197],[193,197,199]]
   λ> take 4 (primosConsecutivosConSumasDigitalesPrimas 4)
   [[2,3,5,7],[3,5,7,11],[191,193,197,199],[821,823,827,829]]
   λ> primosConsecutivosConSumasDigitalesPrimas 4 !! 50
   [129197,129209,129221,129223]

λ> take 5 (primosConsecutivosConSumasDigitalesPrimas 2)

[[2,3],[3,5],[5,7],[41,43],[43,47]]

λ> take 5 (primosConsecutivosConSumasDigitalesPrimas 3)

[[2,3,5],[3,5,7],[41,43,47],[191,193,197],[193,197,199]]

λ> take 4 (primosConsecutivosConSumasDigitalesPrimas 4)

[[2,3,5,7],[3,5,7,11],[191,193,197,199],[821,823,827,829]]

λ> primosConsecutivosConSumasDigitalesPrimas 4 !! 50

[129197,129209,129221,129223]

Soluciones

import Data.Char (digitToInt)
import Data.List (isPrefixOf, sort, tails)
import Data.Numbers.Primes

primosConsecutivosConSumasDigitalesPrimas :: Int -> [[Integer]]
primosConsecutivosConSumasDigitalesPrimas k = 
    [xs | xs <- map (take k) (tails primes),
          primosConsecutivos (sort (map sumaDigital xs))]

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 325  ==  [3,2,5]
digitos :: Integer -> [Integer]
digitos n = [read [d] | d <- show n]

-- (sumaDigital n) es la suma de los dígitos de n. Por ejemplo, 
--    sumaDigital 325  ==  10
sumaDigital :: Integer -> Integer
sumaDigital = sum . digitos

-- (primosConsecutivos xs) se verifica si xs es una lista de primos
-- consecutivos. Por ejemplo,
--    primosConsecutivos [5,7,11]  ==  True
--    primosConsecutivos [5,7,17]  ==  False
primosConsecutivos :: [Integer] -> Bool
primosConsecutivos (x:xs) =
    isPrefixOf (x:xs) (dropWhile (<x) primes)

import Data.Char (digitToInt)

import Data.List (isPrefixOf, sort, tails)

import Data.Numbers.Primes

primosConsecutivosConSumasDigitalesPrimas :: Int -> [[Integer]]

primosConsecutivosConSumasDigitalesPrimas k =

[xs | xs <- map (take k) (tails primes),

primosConsecutivos (sort (map sumaDigital xs))]

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,

-- digitos 325 == [3,2,5]

digitos :: Integer -> [Integer]

digitos n = [read [d] | d <- show n]

-- (sumaDigital n) es la suma de los dígitos de n. Por ejemplo,

-- sumaDigital 325 == 10

sumaDigital :: Integer -> Integer

sumaDigital = sum . digitos

-- (primosConsecutivos xs) se verifica si xs es una lista de primos

-- consecutivos. Por ejemplo,

-- primosConsecutivos [5,7,11] == True

-- primosConsecutivos [5,7,17] == False

primosConsecutivos :: [Integer] -> Bool

primosConsecutivos (x:xs) =

isPrefixOf (x:xs) (dropWhile (<x) primes)

Referencias

Basado en el artículo DigitSums of some consecutive primes del blog Fun With Num3ers.

Antiimágenes en una función creciente

PorJosé A. Alonso 20-enero-201626-marzo-2022

Definir la función

   antiimagen :: (Int -> Int) -> Int -> Maybe Int

1	antiimagen :: (Int -> Int) -> Int -> Maybe Int

tal que (antiimagen f y) es justo el x tal que f(x) = y, si y pertenece a la imagen de la función creciente f, o nada, en caso contrario. Por ejemplo,

   antiimagen (^2) 25  ==  Just 5
   antiimagen (^3) 25  ==  Nothing

1 2	antiimagen (^2) 25 == Just 5 antiimagen (^3) 25 == Nothing

Nota. Se supone que f está definida sobre los números naturales.

Soluciones

-- 1ª definición
-- =============

antiimagen1 :: (Int -> Int) -> Int -> Maybe Int
antiimagen1 f y 
    | estaEnImagen f y = Just x
    | otherwise        = Nothing
    where x = head [x | x <- [0..], f x == y]

-- (estaEnImagen f y) se verifica si pertenece a la imagen de f. Por
-- ejemplo, 
--    estaEnImagen (^2) 25 == True
--    estaEnImagen (^2) 30 == False
estaEnImagen :: (Int -> Int) -> Int -> Bool
estaEnImagen f y = elem y (takeWhile (<=y) (imagen f)) 

-- (imagen f) es la imagen de f. Por ejemplo,
--    take 10 (imagen (^2))  ==  [0,1,4,9,16,25,36,49,64,81]
--    take 10 (imagen (*3))  ==  [0,3,6,9,12,15,18,21,24,27]
imagen :: (Int -> Int) -> [Int]
imagen f = map f [0..]

-- 2ª definición (con lookup y maxBound)
-- =====================================

antiimagen2 :: (Int -> Int) -> Int -> Maybe Int
antiimagen2 f y =
    lookup y (takeWhile (<= (y,maxBound)) [(f x, x) | x <- [0..]])

-- 1ª definición

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

antiimagen1 :: (Int -> Int) -> Int -> Maybe Int

antiimagen1 f y

| estaEnImagen f y = Just x

| otherwise = Nothing

where x = head [x | x <- [0..], f x == y]

-- (estaEnImagen f y) se verifica si pertenece a la imagen de f. Por

-- ejemplo,

-- estaEnImagen (^2) 25 == True

-- estaEnImagen (^2) 30 == False

estaEnImagen :: (Int -> Int) -> Int -> Bool

estaEnImagen f y = elem y (takeWhile (<=y) (imagen f))

-- (imagen f) es la imagen de f. Por ejemplo,

-- take 10 (imagen (^2)) == [0,1,4,9,16,25,36,49,64,81]

-- take 10 (imagen (*3)) == [0,3,6,9,12,15,18,21,24,27]

imagen :: (Int -> Int) -> [Int]

imagen f = map f [0..]

-- 2ª definición (con lookup y maxBound)

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

antiimagen2 :: (Int -> Int) -> Int -> Maybe Int

antiimagen2 f y =

lookup y (takeWhile (<= (y,maxBound)) [(f x, x) | x <- [0..]])

Cambios de signo

PorJosé A. Alonso 12-enero-201620-enero-2016

En una lista xs se produce un cambio de signo por cada elemento x de la lista junto el primero de los elementos de xs con signo opuesto al de x. Por ejemplo,en la lista [6,5,-4,0,-2,-7,0,-8,-1,4] hay 2 cambios de signo (entre (5,-4) y (-1,4)) y en la lista [6,5,-4,0, 2,-7,0,-8,-1,4] hay 4 cambios de signo (entre (5,-4), (-4,2), (2,-7) y(-1,4)).

Definir la función

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

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

tal que (nCambios xs) es el número de cambios de signos de la lista xs. Por ejemplo,

   nCambios []                          ==  0
   nCambios [6,5,-4,0,-2,-7,0,-8,-1,4]  ==  2
   nCambios [6,5,-4,0, 2,-7,0,-8,-1,4]  ==  4

nCambios [] == 0

nCambios [6,5,-4,0,-2,-7,0,-8,-1,4] == 2

nCambios [6,5,-4,0, 2,-7,0,-8,-1,4] == 4

Soluciones

import Data.List (group)

-- 1ª definición
nCambios1 :: (Num a, Ord a) => [a] -> Int
nCambios1 = length . cambios

-- (cambios xs) es la lista de los pares de elementos de xs entre los
-- que se producen cambios de signo. Por ejemplo,
--    cambios [6,5,-4,0,-2,-7,0,-8,-1,4]  ==  [(5,-4),(-1,4)]
--    cambios [6,5,-4,0, 2,-7,0,-8,-1,4]  ==  [(5,-4),(-4,2),(2,-7),(-1,4)]
cambios :: (Num a, Ord a) => [a] -> [(a,a)]
cambios xs =
    [(x,y) | (x,y) <- zip ys (tail ys), x*y < 0]
    where ys = filter (/=0) xs

-- 2ª definición
nCambios2 :: (Num a, Ord a) => [a] -> Int
nCambios2 [] = 0
nCambios2 xs = length (group (filter (/=0) (map signum xs))) - 1

-- 3ª definición
nCambios3 :: (Num a, Ord a) => [a] -> Int
nCambios3 = pred . length . group . filter (/=0) . map signum

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

--    λ> nCambios1 (take (2*10^6) (cycle [3,0,-3]))
--    1333332
--    (3.84 secs, 679,805,392 bytes)
--    λ> nCambios2 (take (2*10^6) (cycle [3,0,-3]))
--    1333332
--    (0.98 secs, 694,247,368 bytes)
--    λ> nCambios3 (take (2*10^6) (cycle [3,0,-3]))
--    1333332
--    (0.95 secs, 708,118,976 bytes)

import Data.List (group)

-- 1ª definición

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

nCambios1 = length . cambios

-- (cambios xs) es la lista de los pares de elementos de xs entre los

-- que se producen cambios de signo. Por ejemplo,

-- cambios [6,5,-4,0,-2,-7,0,-8,-1,4] == [(5,-4),(-1,4)]

-- cambios [6,5,-4,0, 2,-7,0,-8,-1,4] == [(5,-4),(-4,2),(2,-7),(-1,4)]

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

cambios xs =

[(x,y) | (x,y) <- zip ys (tail ys), x*y < 0]

where ys = filter (/=0) xs

-- 2ª definición

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

nCambios2 [] = 0

nCambios2 xs = length (group (filter (/=0) (map signum xs))) - 1

-- 3ª definición

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

nCambios3 = pred . length . group . filter (/=0) . map signum

-- Comparación de eficiencia

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

-- λ> nCambios1 (take (2*10^6) (cycle [3,0,-3]))

-- 1333332

-- (3.84 secs, 679,805,392 bytes)

-- λ> nCambios2 (take (2*10^6) (cycle [3,0,-3]))

-- 1333332

-- (0.98 secs, 694,247,368 bytes)

-- λ> nCambios3 (take (2*10^6) (cycle [3,0,-3]))

-- 1333332

-- (0.95 secs, 708,118,976 bytes)

2016 es un número práctico

PorJosé A. Alonso 4-enero-20161-mayo-2016

Un entero positivo n es un número práctico si todos los enteros positivos menores que él se pueden expresar como suma de distintos divisores de n. Por ejemplo, el 12 es un número práctico, ya que todos los enteros positivos menores que 12 se pueden expresar como suma de divisores de 12 (1, 2, 3, 4 y 6) sin usar ningún divisor más de una vez en cada suma:

    1 = 1
    2 = 2
    3 = 3
    4 = 4
    5 = 2 + 3
    6 = 6
    7 = 1 + 6
    8 = 2 + 6
    9 = 3 + 6
   10 = 4 + 6
   11 = 1 + 4 + 6

1 = 1

2 = 2

3 = 3

4 = 4

5 = 2 + 3

6 = 6

7 = 1 + 6

8 = 2 + 6

9 = 3 + 6

10 = 4 + 6

11 = 1 + 4 + 6

En cambio, 14 no es un número práctico ya que 6 no se puede escribir como suma, con sumandos distintos, de divisores de 14.

Definir la función

   esPractico :: Integer -> Bool

1	esPractico :: Integer -> Bool

tal que (esPractico n) se verifica si n es un número práctico. Por ejemplo,

   esPractico 12                                      ==  True
   esPractico 14                                      ==  False
   esPractico 2016                                    ==  True
   esPractico 42535295865117307932921825928971026432  ==  True

esPractico 12 == True

esPractico 14 == False

esPractico 2016 == True

esPractico 42535295865117307932921825928971026432 == True

Soluciones

import Data.List (genericLength, group, nub, sort, subsequences)
import Data.Numbers.Primes (primeFactors)
import Graphics.Gnuplot.Simple

-- 1ª definición
-- =============

esPractico1 :: Integer -> Bool
esPractico1 n =
    takeWhile (<n) (sumas (divisores n)) == [0..n-1]

-- (divisores n) es la lista de los divisores de n. Por ejemplo,
--    divisores 12  ==  [1,2,3,4,6]
--    divisores 14  ==  [1,2,7]
divisores :: Integer -> [Integer]
divisores n = [k | k <- [1..n-1], n `mod` k == 0]

-- (sumas xs) es la lista ordenada de números que se pueden obtener como
-- sumas de elementos de xs sin usar ningún elemento más de una vez en
-- cada suma. Por ejemplo,  
--    sumas [1,2,3]  ==  [0,1,2,3,4,5,6]
--    sumas [1,2,7]  ==  [0,1,2,3,7,8,9,10]
sumas :: [Integer] -> [Integer]
sumas xs = sort (nub (map sum (subsequences xs)))

-- 2ª definición
-- =============

esPractico2 :: Integer -> Bool
esPractico2 n = all (esSumable (divisores n)) [1..n-1]

-- (esSumable xs n) se verifica si n se puede escribir como una suma de
-- elementos distintos de la lista creciente xs. Por ejemplo,
--    esSumable [1,2,7] 8  ==  True
--    esSumable [1,2,7] 6  ==  False
--    esSumable [1,2,7] 4  ==  False
--    esSumable [1,2,7] 2  ==  True
--    esSumable [1,2,7] 0  ==  True
esSumable :: [Integer] -> Integer -> Bool
esSumable _ 0  = True
esSumable [] _ = False
esSumable (x:xs) n = x <= n && (esSumable xs (n-x) || esSumable xs n)

-- 3ª definición
-- =============

-- Usando la caracterización de Stewart y Sierpiński: un entero n >= 2
-- es práctico syss para su factorización prima
--    n = p(1)^e(1) * p(2)*e(2) *...* p(k)^e(k)
-- se cumple que p(1) = 2 y, para cada i de 2 a k se cumple que
--                         1+e(j) 
--                i-1  p(j)       - 1
--    p(i) <= 1 +  ∏  ----------------
--                j=1     p(j) - 1

esPractico3 :: Integer -> Bool
esPractico3 1 = True
esPractico3 n = 
    x == 2 &&
    and [p <= 1 + c | (p,c) <- zip bases cotas]
    where xss       = factorizacion n
          (x:bases) = map fst xss
          cotas     = scanl1 (*) [(p^(1+e)-1) `div` (p-1) | (p,e) <- xss]

-- (factorizacion n) es la factorización de n. Por ejemplo, 
--    factorizacion  600  ==  [(2,3),(3,1),(5,2)]
--    factorizacion 1400  ==  [(2,3),(5,2),(7,1)]
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion n =
    [(head xs,genericLength xs) | xs <- group (primeFactors n)]

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

--    λ> length [n | n <- [1..400], esPractico1 n]
--    92
--    (40.21 secs, 8,378,539,464 bytes)
--    λ> length [n | n <- [1..400], esPractico2 n]
--    92
--    (8.29 secs, 1,109,669,760 bytes)
--    λ> length [n | n <- [1..400], esPractico3 n]
--    92
--    (0.02 secs, 0 bytes)

import Data.List (genericLength, group, nub, sort, subsequences)

import Data.Numbers.Primes (primeFactors)

import Graphics.Gnuplot.Simple

-- 1ª definición

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

esPractico1 :: Integer -> Bool

esPractico1 n =

takeWhile (<n) (sumas (divisores n)) == [0..n-1]

-- (divisores n) es la lista de los divisores de n. Por ejemplo,

-- divisores 12 == [1,2,3,4,6]

-- divisores 14 == [1,2,7]

divisores :: Integer -> [Integer]

divisores n = [k | k <- [1..n-1], n `mod` k == 0]

-- (sumas xs) es la lista ordenada de números que se pueden obtener como

-- sumas de elementos de xs sin usar ningún elemento más de una vez en

-- cada suma. Por ejemplo,

-- sumas [1,2,3] == [0,1,2,3,4,5,6]

-- sumas [1,2,7] == [0,1,2,3,7,8,9,10]

sumas :: [Integer] -> [Integer]

sumas xs = sort (nub (map sum (subsequences xs)))

-- 2ª definición

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

esPractico2 :: Integer -> Bool

esPractico2 n = all (esSumable (divisores n)) [1..n-1]

-- (esSumable xs n) se verifica si n se puede escribir como una suma de

-- elementos distintos de la lista creciente xs. Por ejemplo,

-- esSumable [1,2,7] 8 == True

-- esSumable [1,2,7] 6 == False

-- esSumable [1,2,7] 4 == False

-- esSumable [1,2,7] 2 == True

-- esSumable [1,2,7] 0 == True

esSumable :: [Integer] -> Integer -> Bool

esSumable _ 0 = True

esSumable [] _ = False

esSumable (x:xs) n = x <= n && (esSumable xs (n-x) || esSumable xs n)

-- 3ª definición

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

-- Usando la caracterización de Stewart y Sierpiński: un entero n >= 2

-- es práctico syss para su factorización prima

-- n = p(1)^e(1) * p(2)*e(2) *...* p(k)^e(k)

-- se cumple que p(1) = 2 y, para cada i de 2 a k se cumple que

-- 1+e(j)

-- i-1 p(j) - 1

-- p(i) <= 1 + ∏ ----------------

-- j=1 p(j) - 1

esPractico3 :: Integer -> Bool

esPractico3 1 = True

esPractico3 n =

x == 2 &&

and [p <= 1 + c | (p,c) <- zip bases cotas]

where xss = factorizacion n

(x:bases) = map fst xss

cotas = scanl1 (*) [(p^(1+e)-1) `div` (p-1) | (p,e) <- xss]

-- (factorizacion n) es la factorización de n. Por ejemplo,

-- factorizacion 600 == [(2,3),(3,1),(5,2)]

-- factorizacion 1400 == [(2,3),(5,2),(7,1)]

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

factorizacion n =

[(head xs,genericLength xs) | xs <- group (primeFactors n)]

-- Comparación de eficiencia

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

-- λ> length [n | n <- [1..400], esPractico1 n]

-- 92

-- (40.21 secs, 8,378,539,464 bytes)

-- λ> length [n | n <- [1..400], esPractico2 n]

-- 92

-- (8.29 secs, 1,109,669,760 bytes)

-- λ> length [n | n <- [1..400], esPractico3 n]

-- 92

-- (0.02 secs, 0 bytes)

Referencias

Basado en el artículo de Gaussianos Feliz Navidad y Feliz Año (número práctico) 2016.

Otras referencias

M. Margenstern (1991), Les nombres pratiques: théorie, observations et conjectures.
G. Melfi, Practical numbers.
G. Melfi (2008), A survey on practical numbers.
OEIS, Sucesión A005153.
PlanetMath.org, Practical number.
E.W. Weisstein, Practical number.
A. Weingartner (2015), Practical numbers and the distribution of divisors.
Wikipedia, Practical number.

Suma con redondeos

PorJosé A. Alonso 1-enero-20167-enero-2016

Definir las funciones

   sumaRedondeos       :: Integer -> [Integer]
   limiteSumaRedondeos :: Integer -> Integer

1 2	sumaRedondeos :: Integer -> [Integer] limiteSumaRedondeos :: Integer -> Integer

tales que

(sumaRedondeos n) es la sucesión cuyo k-ésimo término es

     redondeo (n/2) + redondeo (n/4) + ... + redondeo (n/2^k)

1	redondeo (n/2) + redondeo (n/4) + ... + redondeo (n/2^k)

Por ejemplo,

     take 5 (sumaRedondeos 1000)  ==  [500,750,875,937,968]

1	take 5 (sumaRedondeos 1000) == [500,750,875,937,968]

(limiteSumaRedondeos n) es la suma de la serie

     redondeo (n/2) + redondeo (n/4) + redondeo (n/8) + ...

1	redondeo (n/2) + redondeo (n/4) + redondeo (n/8) + ...

Por ejemplo,

     limiteSumaRedondeos 2000                    ==  1999
     limiteSumaRedondeos 2016                    ==  2016
     limiteSumaRedondeos (10^308) `mod` (10^10)  ==  123839487

limiteSumaRedondeos 2000 == 1999

limiteSumaRedondeos 2016 == 2016

limiteSumaRedondeos (10^308) `mod` (10^10) == 123839487

Soluciones

-- 1ª definición
-- =============

sumaRedondeos1 :: Integer -> [Integer]
sumaRedondeos1 n =
    [sum [round (n'/(fromIntegral (2^k))) | k <- [1..m]] | m <- [1..]]
    where n' = fromIntegral n

limiteSumaRedondeos1 :: Integer -> Integer
limiteSumaRedondeos1 = limite . sumaRedondeos1

limite :: [Integer] -> Integer
limite xs = head [x | (x,y) <- zip xs (tail xs), x == y]

-- 2ª definición
sumaRedondeos2 :: Integer -> [Integer]
sumaRedondeos2 n =
    scanl1 (+) [round (n'/(fromIntegral (2^k))) | k <- [1..]]
    where n' = fromIntegral n

limiteSumaRedondeos2 :: Integer -> Integer
limiteSumaRedondeos2 = limite . sumaRedondeos2

-- 3ª definición
sumaRedondeos3 :: Integer -> [Integer]
sumaRedondeos3 n = map fst (iterate f (round (n'/2),4))
    where f (s,d) = (s + round (n'/(fromIntegral d)), 2*d)
          n'      = fromIntegral n

limiteSumaRedondeos3 :: Integer -> Integer
limiteSumaRedondeos3 = limite . sumaRedondeos3

-- 4ª definición
sumaRedondeos4 :: Integer -> [Integer]
sumaRedondeos4 n = xs ++ repeat x
    where n' = fromIntegral n
          m  = round (logBase 2 n')
          xs = scanl1 (+) [round (n'/(fromIntegral (2^k))) | k <- [1..m]]
          x  = last xs

limiteSumaRedondeos4 :: Integer -> Integer
limiteSumaRedondeos4 = limite . sumaRedondeos4

-- Comparación de eficiencia
--    λ> (sumaRedondeos1 4) !! 20000
--    3
--    (0.92 secs, 197,782,232 bytes)
--    λ> (sumaRedondeos1 4) !! 30000
--    3
--    (2.20 secs, 351,084,816 bytes)
--    λ> (sumaRedondeos3 4) !! 20000
--    3
--    (0.30 secs, 53,472,392 bytes)
--    λ> (sumaRedondeos4 4) !! 20000
--    3
--    (0.01 secs, 0 bytes)

-- En lo que sigue, usaremos la 3ª definición
sumaRedondeos :: Integer -> [Integer]
sumaRedondeos = sumaRedondeos3

-- 5ª definición
-- =============

limiteSumaRedondeos5 :: Integer -> Integer
limiteSumaRedondeos5 n = 
    sum [round (n'/(fromIntegral (2^k))) | k <- [1..m]]
    where n' = fromIntegral n
          m  = round (logBase 2 n')

-- 1ª definición

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

sumaRedondeos1 :: Integer -> [Integer]

sumaRedondeos1 n =

[sum [round (n'/(fromIntegral (2^k))) | k <- [1..m]] | m <- [1..]]

where n' = fromIntegral n

limiteSumaRedondeos1 :: Integer -> Integer

limiteSumaRedondeos1 = limite . sumaRedondeos1

limite :: [Integer] -> Integer

limite xs = head [x | (x,y) <- zip xs (tail xs), x == y]

-- 2ª definición

sumaRedondeos2 :: Integer -> [Integer]

sumaRedondeos2 n =

scanl1 (+) [round (n'/(fromIntegral (2^k))) | k <- [1..]]

where n' = fromIntegral n

limiteSumaRedondeos2 :: Integer -> Integer

limiteSumaRedondeos2 = limite . sumaRedondeos2

-- 3ª definición

sumaRedondeos3 :: Integer -> [Integer]

sumaRedondeos3 n = map fst (iterate f (round (n'/2),4))

where f (s,d) = (s + round (n'/(fromIntegral d)), 2*d)

n' = fromIntegral n

limiteSumaRedondeos3 :: Integer -> Integer

limiteSumaRedondeos3 = limite . sumaRedondeos3

-- 4ª definición

sumaRedondeos4 :: Integer -> [Integer]

sumaRedondeos4 n = xs ++ repeat x

where n' = fromIntegral n

m = round (logBase 2 n')

xs = scanl1 (+) [round (n'/(fromIntegral (2^k))) | k <- [1..m]]

x = last xs

limiteSumaRedondeos4 :: Integer -> Integer

limiteSumaRedondeos4 = limite . sumaRedondeos4

-- Comparación de eficiencia

-- λ> (sumaRedondeos1 4) !! 20000

-- 3

-- (0.92 secs, 197,782,232 bytes)

-- λ> (sumaRedondeos1 4) !! 30000

-- 3

-- (2.20 secs, 351,084,816 bytes)

-- λ> (sumaRedondeos3 4) !! 20000

-- 3

-- (0.30 secs, 53,472,392 bytes)

-- λ> (sumaRedondeos4 4) !! 20000

-- 3

-- (0.01 secs, 0 bytes)

-- En lo que sigue, usaremos la 3ª definición

sumaRedondeos :: Integer -> [Integer]

sumaRedondeos = sumaRedondeos3

-- 5ª definición

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

limiteSumaRedondeos5 :: Integer -> Integer

limiteSumaRedondeos5 n =

sum [round (n'/(fromIntegral (2^k))) | k <- [1..m]]

where n' = fromIntegral n

m = round (logBase 2 n')

Elementos óptimos

PorJosé A. Alonso 31-diciembre-20157-enero-2016

Definir la función

   optimos :: Eq b => (b -> b -> Bool) -> (a -> b) -> [a] -> [a]

1	optimos :: Eq b => (b -> b -> Bool) -> (a -> b) -> [a] -> [a]

tal que (optimos r f xs) es la lista de los elementos de xs donde la función f alcanza sus valores óptimos respecto de la relación r. Por ejemplo,

   optimos (<) length ["ab","c","de","f"]  ==  ["c","f"]
   optimos (>) length ["ab","c","de","f"]  ==  ["ab","de"]

1 2	optimos (<) length ["ab","c","de","f"] == ["c","f"] optimos (>) length ["ab","c","de","f"] == ["ab","de"]

Soluciones

-- 1ª definición
-- =============

optimos1 :: Eq a => (b -> b -> Bool) -> (a -> b) -> [a] -> [a]
optimos1 r f xs = 
    [x | x <- xs, null [y | y <- xs, x /= y, r (f y) (f x)]]

-- 2ª definición
-- =============

optimos2 :: Eq b => (b -> b -> Bool) -> (a -> b) -> [a] -> [a]
optimos2 r f xs = [x | x <- xs, f x `elem` ms]
    where ms = maximales r (map f xs) 

-- (maximales r xs) es la lista de los elementos de xs para los que no
-- hay ningún otro elemento de xs mayor según la relación r. Por
-- ejemplo, 
--    maximales (>) [2,3,4,6]                     ==  [6]
--    maximales (<) [2,3,4,6]                     ==  [2]
--    maximales (\x y -> mod x y == 0) [2,3,4,6]  ==  [4,6]
--    maximales (\x y -> mod y x == 0) [2,3,4,6]  ==  [2,3]
maximales :: Eq a => (a -> a -> Bool) -> [a] -> [a]
maximales r xs = [x | x <- xs, null [y | y <- xs, y /= x, r y x]]

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

--    λ> length $ optimos1 (>) length [replicate n 'a' | n <- [1..1000]]
--    1
--    (16.74 secs, 153,957,400 bytes)
--    λ> length $ optimos2 (>) length [replicate n 'a' | n <- [1..1000]]
--    1
--    (0.64 secs, 85,520,896 bytes)

-- 1ª definición

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

optimos1 :: Eq a => (b -> b -> Bool) -> (a -> b) -> [a] -> [a]

optimos1 r f xs =

[x | x <- xs, null [y | y <- xs, x /= y, r (f y) (f x)]]

-- 2ª definición

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

optimos2 :: Eq b => (b -> b -> Bool) -> (a -> b) -> [a] -> [a]

optimos2 r f xs = [x | x <- xs, f x `elem` ms]

where ms = maximales r (map f xs)

-- (maximales r xs) es la lista de los elementos de xs para los que no

-- hay ningún otro elemento de xs mayor según la relación r. Por

-- ejemplo,

-- maximales (>) [2,3,4,6] == [6]

-- maximales (<) [2,3,4,6] == [2]

-- maximales (\x y -> mod x y == 0) [2,3,4,6] == [4,6]

-- maximales (\x y -> mod y x == 0) [2,3,4,6] == [2,3]

maximales :: Eq a => (a -> a -> Bool) -> [a] -> [a]

maximales r xs = [x | x <- xs, null [y | y <- xs, y /= x, r y x]]

-- Comparación de eficiencia

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

-- λ> length $ optimos1 (>) length [replicate n 'a' | n <- [1..1000]]

-- 1

-- (16.74 secs, 153,957,400 bytes)

-- λ> length $ optimos2 (>) length [replicate n 'a' | n <- [1..1000]]

-- 1

-- (0.64 secs, 85,520,896 bytes)

Operación sobre todos los pares

PorJosé A. Alonso 28-diciembre-20154-enero-2016

Definir la función

   todosPares :: (a -> b -> c) -> [a] -> [b] -> [c]

1	todosPares :: (a -> b -> c) -> [a] -> [b] -> [c]

tal que (todosPares f xs ys) es el resultado de aplicar la operación f a todos los pares de xs e ys. Por ejemplo,

   todosPares (*) [2,3,5] [7,11]            == [14,22,21,33,35,55]
   todosPares (\x y -> x:show y) "ab" [7,5] == ["a7","a5","b7","b5"]

1 2	todosPares (*) [2,3,5] [7,11] == [14,22,21,33,35,55] todosPares (\x y -> x:show y) "ab" [7,5] == ["a7","a5","b7","b5"]

Soluciones

-- 1ª definición (por comprensión)
todosPares1 :: (a -> b -> c) -> [a] -> [b] -> [c]
todosPares1 f xs ys = [f x y | x <- xs, y <- ys] 

-- 2ª definición (por recursión)
todosPares2 :: (a -> b -> c) -> [a] -> [b] -> [c]
todosPares2 _ []     _  = []
todosPares2 f (x:xs) ys = map (f x) ys ++ todosPares2 f xs ys

-- 3ª definición (recursión con auxiliar)
todosPares3 :: (a -> b -> c) -> [a] -> [b] -> [c]
todosPares3 f xs ys = aux xs where
   aux []     = []
   aux (x:xs) = map (f x) ys ++ aux xs

-- 4ª definición (recursión con auxiliar)
todosPares4 :: (a -> b -> c) -> [a] -> [b] -> [c]
todosPares4 f xs ys = 
    (foldr (\x zs -> map (f x) ys ++ zs) []) xs

-- 1ª definición (por comprensión)

todosPares1 :: (a -> b -> c) -> [a] -> [b] -> [c]

todosPares1 f xs ys = [f x y | x <- xs, y <- ys]

-- 2ª definición (por recursión)

todosPares2 :: (a -> b -> c) -> [a] -> [b] -> [c]

todosPares2 _ [] _ = []

todosPares2 f (x:xs) ys = map (f x) ys ++ todosPares2 f xs ys

-- 3ª definición (recursión con auxiliar)

todosPares3 :: (a -> b -> c) -> [a] -> [b] -> [c]

todosPares3 f xs ys = aux xs where

aux [] = []

aux (x:xs) = map (f x) ys ++ aux xs

-- 4ª definición (recursión con auxiliar)

todosPares4 :: (a -> b -> c) -> [a] -> [b] -> [c]

todosPares4 f xs ys =

(foldr (\x zs -> map (f x) ys ++ zs) []) xs

Producto infinito

PorJosé A. Alonso 22-diciembre-201525-marzo-2022

Definir la función

   productoInfinito :: [Int] -> [Int]

1	productoInfinito :: [Int] -> [Int]

tal que (productoInfinito xs) es la lista infinita que en la posición N tiene el producto de los N primeros elementos de la lista infinita xs. Por ejemplo,

   take 5 (productoInfinito [1..])    ==  [1,2,6,24,120]
   take 5 (productoInfinito [2,4..])  ==  [2,8,48,384,3840]
   take 5 (productoInfinito [1,3..])  ==  [1,3,15,105,945]

take 5 (productoInfinito [1..]) == [1,2,6,24,120]

take 5 (productoInfinito [2,4..]) == [2,8,48,384,3840]

take 5 (productoInfinito [1,3..]) == [1,3,15,105,945]

Nota: Este ejercicio es parte del examen del grupo 3 del 2 de diciembre.

Soluciones

-- 1ª definición (por comprensión):
productoInfinito1 :: [Integer] -> [Integer]
productoInfinito1 xs = [product (take n xs) | n <- [1..]]

-- 2ª definición (por recursión)
productoInfinito2 :: [Integer] -> [Integer]
productoInfinito2 (x:y:zs) = x : productoInfinito2 (x*y:zs)

-- 2ª definición (por recursión y map)
productoInfinito3 :: [Integer] -> [Integer]
productoInfinito3 []     = [1]
productoInfinito3 (x:xs) = map (x*) (1 : productoInfinito3 xs)

-- 4ª definición (con scanl1)
productoInfinito4 :: [Integer] -> [Integer]
productoInfinito4 = scanl1 (*)

-- Comparación de eficiencia
--    λ> take 20 (show (productoInfinito1 [2,4..] !! 10000))
--    "11358071114466915693"
--    (0.35 secs, 98,287,328 bytes)
--    λ> take 20 (show (productoInfinito2 [2,4..] !! 10000))
--    "11358071114466915693"
--    (0.35 secs, 98,840,440 bytes)
--    λ> take 20 (show (productoInfinito3 [2,4..] !! 10000))
--    "11358071114466915693"
--    (7.36 secs, 6,006,360,472 bytes)
--    λ> take 20 (show (productoInfinito4 [2,4..] !! 10000))
--    "11358071114466915693"
--    (0.34 secs, 96,367,000 bytes)

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

productoInfinito1 :: [Integer] -> [Integer]

productoInfinito1 xs = [product (take n xs) | n <- [1..]]

-- 2ª definición (por recursión)

productoInfinito2 :: [Integer] -> [Integer]

productoInfinito2 (x:y:zs) = x : productoInfinito2 (x*y:zs)

-- 2ª definición (por recursión y map)

productoInfinito3 :: [Integer] -> [Integer]

productoInfinito3 [] = [1]

productoInfinito3 (x:xs) = map (x*) (1 : productoInfinito3 xs)

-- 4ª definición (con scanl1)

productoInfinito4 :: [Integer] -> [Integer]

productoInfinito4 = scanl1 (*)

-- Comparación de eficiencia

-- λ> take 20 (show (productoInfinito1 [2,4..] !! 10000))

-- "11358071114466915693"

-- (0.35 secs, 98,287,328 bytes)

-- λ> take 20 (show (productoInfinito2 [2,4..] !! 10000))

-- "11358071114466915693"

-- (0.35 secs, 98,840,440 bytes)

-- λ> take 20 (show (productoInfinito3 [2,4..] !! 10000))

-- "11358071114466915693"

-- (7.36 secs, 6,006,360,472 bytes)

-- λ> take 20 (show (productoInfinito4 [2,4..] !! 10000))

-- "11358071114466915693"

-- (0.34 secs, 96,367,000 bytes)

Los números de Smith

PorJosé A. Alonso 4-diciembre-201511-diciembre-2015

Un número de Smith es un número natural compuesto que cumple que la suma de sus dígitos es igual a la suma de los dígitos de todos sus factores primos (si tenemos algún factor primo repetido lo sumamos tantas veces como aparezca). Por ejemplo, el 22 es un número de Smith ya que

    22 = 2*11 y
   2+2 = 2+(1+1)

1 2	22 = 2*11 y 2+2 = 2+(1+1)

y el 4937775 también lo es ya que

   4937775       = 3*5*5*65837 y 
   4+9+3+7+7+7+5 = 3+5+5+(6+5+8+3+7)

1 2	4937775 = 355*65837 y 4+9+3+7+7+7+5 = 3+5+5+(6+5+8+3+7)

Definir las funciones

   esSmith :: Integer -> Bool
   smith :: [Integer]

1 2	esSmith :: Integer -> Bool smith :: [Integer]

tales que

(esSmith x) se verifica si x es un número de Smith. Por ejemplo,

     esSmith 22          ==  True
     esSmith 29          ==  False
     esSmith 2015        ==  False
     esSmith 4937775     ==  True
     esSmith 4567597056  ==  True

esSmith 22 == True

esSmith 29 == False

esSmith 2015 == False

esSmith 4937775 == True

esSmith 4567597056 == True

smith es la lista cuyos elementos son los números de Smith. Por ejemplo,

     λ> take 17 smith
     [4,22,27,58,85,94,121,166,202,265,274,319,346,355,378,382,391]
     λ> smith !! 2000
     62158

λ> take 17 smith

[4,22,27,58,85,94,121,166,202,265,274,319,346,355,378,382,391]

λ> smith !! 2000

62158

Soluciones

import Data.Numbers.Primes

esSmith :: Integer -> Bool
esSmith x = 
    not (isPrime x) && 
    sumaDigitos x == sum (map sumaDigitos (primeFactors x))

sumaDigitos :: Integer -> Integer
sumaDigitos x | x < 10 = x
              | otherwise = x `mod` 10 + sumaDigitos (x `div` 10)

smith :: [Integer]
smith = [x | x <- [1..], esSmith x]

import Data.Numbers.Primes

esSmith :: Integer -> Bool

esSmith x =

not (isPrime x) &&

sumaDigitos x == sum (map sumaDigitos (primeFactors x))

sumaDigitos :: Integer -> Integer

sumaDigitos x | x < 10 = x

| otherwise = x `mod` 10 + sumaDigitos (x `div` 10)

smith :: [Integer]

smith = [x | x <- [1..], esSmith x]

Raíces enteras de los números primos

PorJosé A. Alonso 2-diciembre-20151-mayo-2016

Definir la sucesión

   raicesEnterasDePrimos :: [Integer]

1	raicesEnterasDePrimos :: [Integer]

cuyos elementos son las partes enteras de las raíces cuadradas de los números primos. Por ejemplo,

   λ> take 30 raicesEnterasDePrimos
   [1,1,2,2,3,3,4,4,4,5,5,6,6,6,6,7,7,7,8,8,8,8,9,9,9,10,10,10,10,10]
   λ> raicesEnterasDePrimos !!  9963
   322
   λ> raicesEnterasDePrimos !!  9964
   323

λ> take 30 raicesEnterasDePrimos

[1,1,2,2,3,3,4,4,4,5,5,6,6,6,6,7,7,7,8,8,8,8,9,9,9,10,10,10,10,10]

λ> raicesEnterasDePrimos !! 9963

322

λ> raicesEnterasDePrimos !! 9964

323

Comprobar con QuickCheck que la diferencia entre dos términos consecutivos de la sucesión es como máximo igual a 1.

Soluciones

import Data.Numbers.Primes (primes)
import Test.QuickCheck

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

raicesEnterasDePrimos1 :: [Integer]
raicesEnterasDePrimos1 = map raizEntera primes

-- (raizEntera x) es la parte entera de la raíz cuadrada de x. Por
-- ejemplo,
--    raizEntera  8  ==  2
--    raizEntera  9  ==  3
--    raizEntera 10  ==  3
raizEntera :: Integer -> Integer
raizEntera = floor . sqrt . fromIntegral 

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

raicesEnterasDePrimos2 :: [Integer]
raicesEnterasDePrimos2 = map raizEntera2 primes

raizEntera2 :: Integer -> Integer
raizEntera2 n = aux 1
    where aux k | k*k > n   = k-1
                | otherwise = aux (k+1)

-- 3º solución
-- ===========

raicesEnterasDePrimos3 :: [Integer]
raicesEnterasDePrimos3 = aux primes [1..]
    where aux (p:ps) (x:xs) | p > x*x   = aux (p:ps) xs
                            | otherwise = (x-1) : aux ps (x:xs)


-- Comparación de eficiencia
--    ghci> raicesEnterasDePrimos1 !! 400000
--    2408
--    (2.86 secs, 1177922500 bytes)
--    ghci> raicesEnterasDePrimos2 !! 400000
--    2408
--    (3.08 secs, 1177432260 bytes)
--    ghci> raicesEnterasDePrimos3 !! 400000
--    2408
--    (3.88 secs, 1260772112 bytes)

-- En lo sucesivo usaremos la 1ª definición
raicesEnterasDePrimos :: [Integer]
raicesEnterasDePrimos = raicesEnterasDePrimos3

-- La propiedad es
prop_raicesEnterasDePrimos :: Int -> Property
prop_raicesEnterasDePrimos n =
    n >= 0 ==> 
    raicesEnterasDePrimos !! (n+1) - raicesEnterasDePrimos !! n <= 1

-- La comprobación es
--    λ> quickCheck prop_raicesEnterasDePrimos
--    +++ OK, passed 100 tests.

import Data.Numbers.Primes (primes)

import Test.QuickCheck

-- 1ª solución

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

raicesEnterasDePrimos1 :: [Integer]

raicesEnterasDePrimos1 = map raizEntera primes

-- (raizEntera x) es la parte entera de la raíz cuadrada de x. Por

-- ejemplo,

-- raizEntera 8 == 2

-- raizEntera 9 == 3

-- raizEntera 10 == 3

raizEntera :: Integer -> Integer

raizEntera = floor . sqrt . fromIntegral

-- 2ª solución

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

raicesEnterasDePrimos2 :: [Integer]

raicesEnterasDePrimos2 = map raizEntera2 primes

raizEntera2 :: Integer -> Integer

raizEntera2 n = aux 1

where aux k | k*k > n = k-1

| otherwise = aux (k+1)

-- 3º solución

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

raicesEnterasDePrimos3 :: [Integer]

raicesEnterasDePrimos3 = aux primes [1..]

where aux (p:ps) (x:xs) | p > x*x = aux (p:ps) xs

| otherwise = (x-1) : aux ps (x:xs)

-- Comparación de eficiencia

-- ghci> raicesEnterasDePrimos1 !! 400000

-- 2408

-- (2.86 secs, 1177922500 bytes)

-- ghci> raicesEnterasDePrimos2 !! 400000

-- 2408

-- (3.08 secs, 1177432260 bytes)

-- ghci> raicesEnterasDePrimos3 !! 400000

-- 2408

-- (3.88 secs, 1260772112 bytes)

-- En lo sucesivo usaremos la 1ª definición

raicesEnterasDePrimos :: [Integer]

raicesEnterasDePrimos = raicesEnterasDePrimos3

-- La propiedad es

prop_raicesEnterasDePrimos :: Int -> Property

prop_raicesEnterasDePrimos n =

n >= 0 ==>

raicesEnterasDePrimos !! (n+1) - raicesEnterasDePrimos !! n <= 1

-- La comprobación es

-- λ> quickCheck prop_raicesEnterasDePrimos

-- +++ OK, passed 100 tests.

Dígitos visibles y ocultos

PorJosé A. Alonso 16-noviembre-201526-marzo-2022

Una cadena clave es una cadena que contiene dígitos visibles y ocultos. Los dígitos se ocultan mediante las primeras letras minúsculas: la ‘a’ oculta el ‘0’, la ‘b’ el ‘1’ y así sucesivamente hasta la ‘j’ que oculta el ‘9’. Los restantes símbolos de la cadena no tienen significado y se pueden ignorar.

Definir la función

   numeroOculto :: String -> Maybe Integer

1	numeroOculto :: String -> Maybe Integer

tal que (numeroOculto cs) es justo el número formado por los dígitos visibles u ocultos de la cadena clave cs, si cs tiene dígitos y Nothing en caso contrario. Por ejemplo,

   numeroOculto "jihgfedcba"            ==  Just 9876543210
   numeroOculto "JIHGFEDCBA"            ==  Nothing
   numeroOculto "el 23 de Enero"        ==  Just 423344
   numeroOculto "El 23 de Enero"        ==  Just 23344
   numeroOculto "El 23 de enero"        ==  Just 233444
   numeroOculto "Todo para nada"        ==  Just 300030
   numeroOculto (replicate (10^6) 'A')  ==  Nothing

numeroOculto "jihgfedcba" == Just 9876543210

numeroOculto "JIHGFEDCBA" == Nothing

numeroOculto "el 23 de Enero" == Just 423344

numeroOculto "El 23 de Enero" == Just 23344

numeroOculto "El 23 de enero" == Just 233444

numeroOculto "Todo para nada" == Just 300030

numeroOculto (replicate (10^6) 'A') == Nothing

Soluciones

import Data.Char (isDigit, ord, chr)

numeroOculto :: String -> Maybe Integer
numeroOculto cs | null aux  = Nothing
                | otherwise = Just (read aux)
    where aux = filter isDigit (map visible cs)

visible :: Char -> Char
visible c | c `elem` ['a'..'j'] = chr (ord c - n)
          | otherwise           = c
          where n = ord 'a' - ord '0'

import Data.Char (isDigit, ord, chr)

numeroOculto :: String -> Maybe Integer

numeroOculto cs | null aux = Nothing

| otherwise = Just (read aux)

where aux = filter isDigit (map visible cs)

visible :: Char -> Char

visible c | c `elem` ['a'..'j'] = chr (ord c - n)

| otherwise = c

where n = ord 'a' - ord '0'

Con mínimo común denominador

PorJosé A. Alonso 20-abril-201527-abril-2015

Los números racionales se pueden representar como pares de enteros:

   type Racional a = (a,a)

1	type Racional a = (a,a)

Definir la función

   reducida :: Integral a => [Racional a] -> [Racional a]

1	reducida :: Integral a => [Racional a] -> [Racional a]

tal que (reducida xs) es la lista de los números racionales donde cada uno es igual al correspondiente elemento de xs y el denominador de todos los elementos de (reducida xs) es el menor número que cumple dicha condición; es decir, si xs es la lista

   [(x_1, y_1), ..., (x_n, y_n)]

1	[(x_1, y_1), ..., (x_n, y_n)]

entonces (reducida xs) es

   [(z_1, d), ..., (z_n, d)]

1	[(z_1, d), ..., (z_n, d)]

tales que

   z_1/d = x_1/y_1, ..., z_n/d = x_n/y_n

1	z_1/d = x_1/y_1, ..., z_n/d = x_n/y_n

y d es el menor posible. Por ejemplo,

   reducida [(1,2),(1,3),(1,4)]  ==  [(6,12),(4,12),(3,12)]
   reducida [(1,2),(1,3),(6,4)]  ==  [(3,6),(2,6),(9,6)]
   reducida [(-7,6),(-10,-8)]    ==  [(-14,12),(15,12)]
   reducida [(8,12)]             ==  [(2,3)]

reducida [(1,2),(1,3),(1,4)] == [(6,12),(4,12),(3,12)]

reducida [(1,2),(1,3),(6,4)] == [(3,6),(2,6),(9,6)]

reducida [(-7,6),(-10,-8)] == [(-14,12),(15,12)]

reducida [(8,12)] == [(2,3)]

Soluciones

type Racional a = (a,a) 

reducida :: Integral a => [Racional a] -> [Racional a]
reducida xs = 
    [(x * (m `div` y), m) | (x,y) <- ys]
    where ys = map fraccionReducida xs
          m  = mcm [y | (_,y) <- ys]

-- (fraccionReducida r) es el número racional igual a r con menor
-- denominador positivo. Por ejemplo,
--    fraccionReducida ( 6, 10)  ==  ( 3,5)
--    fraccionReducida (-6, 10)  ==  (-3,5)
--    fraccionReducida ( 6,-10)  ==  (-3,5)
--    fraccionReducida (-6,-10)  ==  ( 3,5)
--    fraccionReducida ( 3,  5)  ==  ( 3,5)
fraccionReducida :: Integral a => (a,a) -> (a,a)
fraccionReducida (x,y) =
    (s * x1 `div` m, y1 `div` m)
    where s  = signum x * signum y      
          x1 = abs x
          y1 = abs y
          m  = gcd x1 y1
          
-- (mcm xs) es el mínimo común múltiplo de xs. Por ejemplo,
--    mcm [2,6,10]  ==  30
mcm :: Integral a => [a] -> a
mcm = foldl lcm 1

type Racional a = (a,a)

reducida :: Integral a => [Racional a] -> [Racional a]

reducida xs =

[(x * (m `div` y), m) | (x,y) <- ys]

where ys = map fraccionReducida xs

m = mcm [y | (_,y) <- ys]

-- (fraccionReducida r) es el número racional igual a r con menor

-- denominador positivo. Por ejemplo,

-- fraccionReducida ( 6, 10) == ( 3,5)

-- fraccionReducida (-6, 10) == (-3,5)

-- fraccionReducida ( 6,-10) == (-3,5)

-- fraccionReducida (-6,-10) == ( 3,5)

-- fraccionReducida ( 3, 5) == ( 3,5)

fraccionReducida :: Integral a => (a,a) -> (a,a)

fraccionReducida (x,y) =

(s * x1 `div` m, y1 `div` m)

where s = signum x * signum y

x1 = abs x

y1 = abs y

m = gcd x1 y1

-- (mcm xs) es el mínimo común múltiplo de xs. Por ejemplo,

-- mcm [2,6,10] == 30

mcm :: Integral a => [a] -> a

mcm = foldl lcm 1

Soluciones

Soluciones

Referencias

Soluciones

Soluciones

Soluciones

Referencias

Soluciones

Referencia

Soluciones

Soluciones

Soluciones

Soluciones

Referencia

Soluciones

Soluciones

Referencias

Soluciones

Soluciones

Solución en Maxima

Soluciones

Soluciones

Solución en Maxima

Soluciones

Soluciones

Referencias

Soluciones

Referencias

Soluciones

Soluciones

Soluciones

Referencias

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Entradas recientes

Buscar

Correo electrónico