Orden superior – Página 14

Mínima suma de las ramas de un árbol

PorJosé A. Alonso 28-diciembre-201625-marzo-2022

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          
    / \       / \           / \   
   8   3     5   3         5   3  
       |        /|\       /|\  |   
       4       4 7 6     4 7 6 7

1 1 1

/ \ / \ / \

8 3 5 3 5 3

| /|\ /|\ |

4 4 7 6 4 7 6 7

se representan por

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

ej1, ej2, ej3 :: Arbol Int

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

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

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

Definir la función

   minimaSuma :: Arbol Int -> Int

1	minimaSuma :: Arbol Int -> Int

tal que (minimaSuma a) es el mínimo de las sumas de las ramas del árbol a. Por ejemplo,

   minimaSuma ej1  ==  8
   minimaSuma ej2  ==  6
   minimaSuma ej3  ==  10

minimaSuma ej1 == 8

minimaSuma ej2 == 6

minimaSuma ej3 == 10

Soluciones

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

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


-- 1ª definición
-- =============
minimaSuma :: (Ord a, Num a) => Arbol a -> a
minimaSuma a = minimum [sum xs | xs <- ramas a]

-- (ramas a) es la lista de las ramas del árbol a. Por ejemplo,
--    ghci> ramas (N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]])
--    [[3,5,6],[3,4],[3,7,2],[3,7,1]]
ramas :: Arbol b -> [[b]]
ramas (N x []) = [[x]]
ramas (N x as) = [x : xs | a <- as, xs <- ramas a]

-- 2ª definición
-- =============
  
minimaSuma2 :: Arbol Int -> Int
minimaSuma2 (N x []) = x
minimaSuma2 (N x as) = x + minimum (map minimaSuma2 as)

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2, ej3 :: Arbol Int

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

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

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

-- 1ª definición

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

minimaSuma :: (Ord a, Num a) => Arbol a -> a

minimaSuma a = minimum [sum xs | xs <- ramas a]

-- (ramas a) es la lista de las ramas del árbol a. Por ejemplo,

-- ghci> ramas (N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]])

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

ramas :: Arbol b -> [[b]]

ramas (N x []) = [[x]]

ramas (N x as) = [x : xs | a <- as, xs <- ramas a]

-- 2ª definición

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

minimaSuma2 :: Arbol Int -> Int

minimaSuma2 (N x []) = x

minimaSuma2 (N x as) = x + minimum (map minimaSuma2 as)

Números super pandigitales

PorJosé A. Alonso 27-diciembre-20163-enero-2017

Un entero positivo n es pandigital en base b si su expresión en base b contiene todos los dígitos de 0 a b-1 al menos una vez. Por ejemplo,

el 2 es pandigital en base 2 porque 2 en base 2 es 10,
el 11 es pandigital en base 3 porque 11 en base 3 es 102 y
el 75 es pandigital en base 4 porque 75 en base 4 es 1023.

Un número n es super pandigital de orden m si es pandigital en todas las bases
desde 2 hasta m. Por ejemplo, 978 es super pandigital de orden 5 pues

en base 2 es: 1111010010
en base 3 es: 1100020
en base 4 es: 33102
en base 5 es: 12403

Definir la función

   superPandigitales :: Integer -> [Integer]

1	superPandigitales :: Integer -> [Integer]

tal que (superPandigitales m) es la lista de los números super pandigitales de orden m. Por ejemplo,

   take 3 (superPandigitales 3) == [11,19,21]
   take 3 (superPandigitales 4) == [75,99,114]
   take 3 (superPandigitales 5) == [978,1070,1138]

take 3 (superPandigitales 3) == [11,19,21]

take 3 (superPandigitales 4) == [75,99,114]

take 3 (superPandigitales 5) == [978,1070,1138]

Soluciones

superPandigitales :: Integer -> [Integer]
superPandigitales m =
  [n | n <- [1..]
     , and [pandigitalBase b n | b <- [2..m]]]

-- (pandigitalBase b n) se verifica si n es pandigital en base la base
-- b. Por ejemplo,
--    pandigitalBase 4 75  ==  True
--    pandigitalBase 4 76  ==  False
pandigitalBase :: Integer -> Integer -> Bool
pandigitalBase b n = [0..b-1] `esSubconjunto` enBase b n

-- (enBase b n) es la lista de los dígitos de n en base b. Por ejemplo,
--    enBase 4 75  ==  [3,2,0,1]
--    enBase 4 76  ==  [0,3,0,1]
enBase :: Integer -> Integer -> [Integer]
enBase b n | n < b     = [n]
           | otherwise = n `mod` b : enBase b (n `div` b)

-- (esSubconjunto xs ys) se verifica si xs es un subconjunto de ys. Por
-- ejemplo,
--    esSubconjunto [1,5] [5,2,1]  ==  True
--    esSubconjunto [1,5] [5,2,3]  ==  False
esSubconjunto :: Eq a => [a] -> [a] -> Bool
esSubconjunto xs ys = all (`elem` ys) xs

superPandigitales :: Integer -> [Integer]

superPandigitales m =

[n | n <- [1..]

, and [pandigitalBase b n | b <- [2..m]]]

-- (pandigitalBase b n) se verifica si n es pandigital en base la base

-- b. Por ejemplo,

-- pandigitalBase 4 75 == True

-- pandigitalBase 4 76 == False

pandigitalBase :: Integer -> Integer -> Bool

pandigitalBase b n = [0..b-1] `esSubconjunto` enBase b n

-- (enBase b n) es la lista de los dígitos de n en base b. Por ejemplo,

-- enBase 4 75 == [3,2,0,1]

-- enBase 4 76 == [0,3,0,1]

enBase :: Integer -> Integer -> [Integer]

enBase b n | n < b = [n]

| otherwise = n `mod` b : enBase b (n `div` b)

-- (esSubconjunto xs ys) se verifica si xs es un subconjunto de ys. Por

-- ejemplo,

-- esSubconjunto [1,5] [5,2,1] == True

-- esSubconjunto [1,5] [5,2,3] == False

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

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

Ordenación por una fila

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

Las matrices se pueden representar por listas de lista. Por ejemplo, la matriz

|1 2 5|

|3 0 7|

|9 1 6|

|6 4 2|

se puede representar por

   ej :: [[Int]]
   ej = [[1,2,5],
         [3,0,7],
         [9,1,6],
         [6,4,2]]

ej :: [[Int]]

ej = [[1,2,5],

[3,0,7],

[9,1,6],

[6,4,2]]

Definir la función

   ordenaPorFila :: Ord a => [[a]] -> Int -> [[a]]

1	ordenaPorFila :: Ord a => [[a]] -> Int -> [[a]]

tal que (ordenaPorFila xss k) es la matriz obtenida ordenando xs por los elementos de la fila k. Por ejemplo,

   ordenaPorFila ej 1  ==  [[2,1,5],[0,3,7],[1,9,6],[4,6,2]]
   ordenaPorFila ej 2  ==  [[2,5,1],[0,7,3],[1,6,9],[4,2,6]]
   ordenaPorFila ej 3  ==  [[5,2,1],[7,0,3],[6,1,9],[2,4,6]]

ordenaPorFila ej 1 == [[2,1,5],[0,3,7],[1,9,6],[4,6,2]]

ordenaPorFila ej 2 == [[2,5,1],[0,7,3],[1,6,9],[4,2,6]]

ordenaPorFila ej 3 == [[5,2,1],[7,0,3],[6,1,9],[2,4,6]]

Soluciones

import Data.List (sort, transpose)

ej :: [[Int]]
ej = [[1,2,5],
      [3,0,7],
      [9,1,6],
      [6,4,2]]

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

ordenaPorFila :: Ord a => [[a]] -> Int -> [[a]]
ordenaPorFila xss k =
  transpose (ordenaPorColumna (transpose xss) k)

ordenaPorColumna :: Ord a => [[a]] -> Int -> [[a]]
ordenaPorColumna xss k =
  map snd (sort [(xs!!k,xs) | xs <- xss])

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

ordenaPorFila2 :: Ord a => [[a]] -> Int -> [[a]]
ordenaPorFila2 xss k =
  [[x | (_,x) <- sort $ zip (xss!!k) xs ] | xs <- xss]

import Data.List (sort, transpose)

ej :: [[Int]]

ej = [[1,2,5],

[3,0,7],

[9,1,6],

[6,4,2]]

-- 1ª solución

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

ordenaPorFila :: Ord a => [[a]] -> Int -> [[a]]

ordenaPorFila xss k =

transpose (ordenaPorColumna (transpose xss) k)

ordenaPorColumna :: Ord a => [[a]] -> Int -> [[a]]

ordenaPorColumna xss k =

map snd (sort [(xs!!k,xs) | xs <- xss])

-- 2ª solución

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

ordenaPorFila2 :: Ord a => [[a]] -> Int -> [[a]]

ordenaPorFila2 xss k =

[[x | (_,x) <- sort $ zip (xss!!k) xs ] | xs <- xss]

Ordenación por una columna

PorJosé A. Alonso 20-diciembre-201627-diciembre-2016

Las matrices se pueden representar por listas de lista. Por ejemplo, la matriz

|1 2 5|

|3 0 7|

|9 1 6|

|6 4 2|

se puede representar por

   ej :: [[Int]]
   ej = [[1,2,5],
         [3,0,7],
         [9,1,6],
         [6,4,2]]

ej :: [[Int]]

ej = [[1,2,5],

[3,0,7],

[9,1,6],

[6,4,2]]

Definir la función

   ordenaPor :: Ord a => [[a]] -> Int -> [[a]]

1	ordenaPor :: Ord a => [[a]] -> Int -> [[a]]

tal que (ordenaPor xss k) es la matriz obtenida ordenando xs por los elementos de la columna k. Por ejemplo,

   ordenaPor ej 0  ==  [[1,2,5],[3,0,7],[6,4,2],[9,1,6]]
   ordenaPor ej 1  ==  [[3,0,7],[9,1,6],[1,2,5],[6,4,2]]
   ordenaPor ej 2  ==  [[6,4,2],[1,2,5],[9,1,6],[3,0,7]]

ordenaPor ej 0 == [[1,2,5],[3,0,7],[6,4,2],[9,1,6]]

ordenaPor ej 1 == [[3,0,7],[9,1,6],[1,2,5],[6,4,2]]

ordenaPor ej 2 == [[6,4,2],[1,2,5],[9,1,6],[3,0,7]]

Soluciones

import Data.List (sort)

ej :: [[Int]]
ej = [[1,2,5],
      [3,0,7],
      [9,1,6],
      [6,4,2]]

-- 1ª definición
ordenaPor :: Ord a => [[a]] -> Int -> [[a]]
ordenaPor xss k =
  map snd (sort [(xs!!k,xs) | xs <- xss])

-- 2ª definición
ordenaPor2 :: Ord a => [[a]] -> Int -> [[a]]
ordenaPor2 xss k =
  map snd (sort (map (\xs -> (xs!!k, xs)) xss))

-- 3ª definición
ordenaPor3 :: Ord a => [[a]] -> Int -> [[a]]
ordenaPor3 xss k =
  map snd (sort [p | p <- zip (map (!!k) xss) xss])

import Data.List (sort)

ej :: [[Int]]

ej = [[1,2,5],

[3,0,7],

[9,1,6],

[6,4,2]]

-- 1ª definición

ordenaPor :: Ord a => [[a]] -> Int -> [[a]]

ordenaPor xss k =

map snd (sort [(xs!!k,xs) | xs <- xss])

-- 2ª definición

ordenaPor2 :: Ord a => [[a]] -> Int -> [[a]]

ordenaPor2 xss k =

map snd (sort (map (\xs -> (xs!!k, xs)) xss))

-- 3ª definición

ordenaPor3 :: Ord a => [[a]] -> Int -> [[a]]

ordenaPor3 xss k =

map snd (sort [p | p <- zip (map (!!k) xss) xss])

Selección por posición

PorJosé A. Alonso 19-diciembre-201627-diciembre-2016

Definir la función

   seleccion :: Ord a => [a] -> [Int] -> [a]

1	seleccion :: Ord a => [a] -> [Int] -> [a]

tal que (seleccion xs ps) es la lista ordenada de los elementos que ocupan las posiciones indicadas en la lista ps. Por ejemplo,

   seleccion [6,2,4,7] [2,0]      ==  [4,6]
   seleccion ['a'..'z'] [0,2..10] ==  "acegik"

1 2	seleccion [6,2,4,7] [2,0] == [4,6] seleccion ['a'..'z'] [0,2..10] == "acegik"

Soluciones

import Data.List (sort)

-- 1ª definición
seleccion :: Ord a => [a] -> [Int] -> [a]
seleccion xs ps =
  sort [x | (x,n) <- zip xs [0..]
          , n `elem` ps]

-- 2ª definición
seleccion2 :: Ord a => [a] -> [Int] -> [a]
seleccion2 xs = sort . map (xs!!)

import Data.List (sort)

-- 1ª definición

seleccion :: Ord a => [a] -> [Int] -> [a]

seleccion xs ps =

sort [x | (x,n) <- zip xs [0..]

, n `elem` ps]

-- 2ª definición

seleccion2 :: Ord a => [a] -> [Int] -> [a]

seleccion2 xs = sort . map (xs!!)

Posiciones de equilibrio

PorJosé A. Alonso 15-diciembre-201622-diciembre-2016

Se dice que k es una posición de equilibrio de una lista xs si la suma de los elementos de xs en las posiciones menores que k es igual a la suma de los elementos de xs en las posiciones mayores que k. Por ejemplo, en la lista [-7,1,5,2,-4,3,0] el 3 es una posición de equilibrio ya que -7+1+5 = -4+3+0; también lo es el 6 ya que -7+1+5+2+(-4)+3 = 0.

Definir la función,

   equilibrios :: (Num a, Eq a) => [a] -> [Int]

1	equilibrios :: (Num a, Eq a) => [a] -> [Int]

tal que (equilibrios xs) es la lista de las posiciones de equilibrio de xs. Por ejemplo,

   equilibrios [-7,1,5,2,-4,3,0]  ==  [3,6]
   equilibrios [1..10^6]          ==  []

1 2	equilibrios [-7,1,5,2,-4,3,0] == [3,6] equilibrios [1..10^6] == []

Soluciones

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

equilibrios1 :: (Num a, Eq a) => [a] -> [Int]
equilibrios1 xs =
  [n | n <- [0..length xs - 1]
     , sum (take n xs) == sum (drop (n+1) xs)]

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

equilibrios2 :: (Num a, Eq a) => [a] -> [Int]
equilibrios2 xs =
  [n | (n,x,y) <- zip3 [0..] (sumasI xs) (sumasD xs)
     , x == y]

sumasI :: (Num a, Eq a) => [a] -> [a]
sumasI xs = [sum (take n xs) | n <- [0..length xs - 1]] 

sumasD :: (Num a, Eq a) => [a] -> [a]
sumasD xs = [sum (drop (n+1) xs) | n <- [0..length xs - 1]] 

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

equilibrios3 :: (Num a, Eq a) => [a] -> [Int]
equilibrios3 xs =
  [n | (n,x,y) <- zip3 [0..] (sumasI' xs) (sumasD' xs)
     , x == y]

sumasI' :: (Num a, Eq a) => [a] -> [a]
sumasI'  = init . scanl (+) 0 

sumasD' :: (Num a, Eq a) => [a] -> [a]
sumasD' = tail . scanr (+) 0

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

equilibrios4 :: (Num a, Eq a) => [a] -> [Int]
equilibrios4 xs =
  [n | (n,x,y) <- zip3 [0..] (scanl1 (+) xs) (scanr1 (+) xs)
     , x == y]

-- Comparación de eficiencia
--    λ> let xs = [1..10^4] in equilibrios1 (xs ++ [5] ++ reverse xs)
--    [10000]
--    (20.92 secs, 46,240,541,256 bytes)
--    λ> let xs = [1..10^4] in equilibrios2 (xs ++ [5] ++ reverse xs)
--    [10000]
--    (21.12 secs, 46,249,562,520 bytes)
--    λ> let xs = [1..10^4] in equilibrios3 (xs ++ [5] ++ reverse xs)
--    [10000]
--    (0.02 secs, 11,858,768 bytes)
--    λ> let xs = [1..10^4] in equilibrios4 (xs ++ [5] ++ reverse xs)
--    [10000]
--    (0.02 secs, 13,963,952 bytes)

-- 1ª definición

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

equilibrios1 :: (Num a, Eq a) => [a] -> [Int]

equilibrios1 xs =

[n | n <- [0..length xs - 1]

, sum (take n xs) == sum (drop (n+1) xs)]

-- 2ª definición

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

equilibrios2 :: (Num a, Eq a) => [a] -> [Int]

equilibrios2 xs =

[n | (n,x,y) <- zip3 [0..] (sumasI xs) (sumasD xs)

, x == y]

sumasI :: (Num a, Eq a) => [a] -> [a]

sumasI xs = [sum (take n xs) | n <- [0..length xs - 1]]

sumasD :: (Num a, Eq a) => [a] -> [a]

sumasD xs = [sum (drop (n+1) xs) | n <- [0..length xs - 1]]

-- 3ª definición

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

equilibrios3 :: (Num a, Eq a) => [a] -> [Int]

equilibrios3 xs =

[n | (n,x,y) <- zip3 [0..] (sumasI' xs) (sumasD' xs)

, x == y]

sumasI' :: (Num a, Eq a) => [a] -> [a]

sumasI' = init . scanl (+) 0

sumasD' :: (Num a, Eq a) => [a] -> [a]

sumasD' = tail . scanr (+) 0

-- 4ª definición

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

equilibrios4 :: (Num a, Eq a) => [a] -> [Int]

equilibrios4 xs =

[n | (n,x,y) <- zip3 [0..] (scanl1 (+) xs) (scanr1 (+) xs)

, x == y]

-- Comparación de eficiencia

-- λ> let xs = [1..10^4] in equilibrios1 (xs ++ [5] ++ reverse xs)

-- [10000]

-- (20.92 secs, 46,240,541,256 bytes)

-- λ> let xs = [1..10^4] in equilibrios2 (xs ++ [5] ++ reverse xs)

-- [10000]

-- (21.12 secs, 46,249,562,520 bytes)

-- λ> let xs = [1..10^4] in equilibrios3 (xs ++ [5] ++ reverse xs)

-- [10000]

-- (0.02 secs, 11,858,768 bytes)

-- λ> let xs = [1..10^4] in equilibrios4 (xs ++ [5] ++ reverse xs)

-- [10000]

-- (0.02 secs, 13,963,952 bytes)

Distancia a Erdős

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

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

Para el problema se considerará la siguiente lista de coautores

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

coautores :: [(String,String)]

coautores =

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

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

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

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

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

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

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

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

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

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

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

Definir la función

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

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

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

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

λ> numeroDeErdos coautores 0

["Paul Erdos"]

λ> numeroDeErdos coautores 1

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

λ> numeroDeErdos coautores 2

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

Nota: Este ejercicio ha sido propuesto por Enrique Naranjo.

Soluciones

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

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

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

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

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

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

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

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

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

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

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

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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

data Arbol a = N a [Arbol a]

deriving Show

coautores :: [(String,String)]

coautores =

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

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

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

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

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

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

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

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

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

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

-- 1ª solución

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

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

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

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

-- coautores xs. Por ejemplo,

-- λ> arbolDeErdos coautores "Paul Erdos"

-- N "Paul Erdos"

-- [N "Ernst Straus"

-- [N "Albert Einstein"

-- [N "Wolfgang Pauli" [],

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

-- N "Pascual Jordan"

-- [N "John von Newmann"

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

-- N "D. Kleitman"

-- [N "S. Glashow"

-- [N "M. Gell-Mann"

-- [N "Richar Feynman" [],

-- N "David Pines"

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

-- N "D. Bohm"

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

-- N "J. Conway"

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

-- N "A. J. Granville"

-- [N "B. Mazur"

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

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

arbolDeErdos xs a =

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

where

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

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

| otherwise = x

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

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

-- n. Por ejemplo,

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

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

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

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

nivel 0 (N a xs) = [a]

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

-- 2ª solución

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

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

numeroDeErdos2 = auxC ["Paul Erdos"]

where

auxC v xs 0 = v

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

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

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

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

, notElem a ys && notElem b ys]

-- 3ª solución

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

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

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

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

-- por diatancia. Por ejemplo,

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

-- [["Paul Erdos"],

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

-- "A. J. Granville"],

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

-- "B. Mazur"]]

-- λ> sucCoautores "Albert Einstein" coautores

-- [["Albert Einstein"],

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

-- ["Paul Erdos"],

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

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

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

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

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

-- ["L. De Broglie"]]

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

sucCoautores a ps =

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

where as = elementos ps

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

where zs = [y | y <- ys

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

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

-- ejemplo,

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

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

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

Agrupación por orden de aparición

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

Definir la función

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

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

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

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

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

Soluciones

import Data.List (nub, partition)

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

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

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

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

import Data.List (nub, partition)

-- 1ª definición

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

agrupacion [] = []

agrupacion (x:xs) =

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

-- 2ª definición

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

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

-- 3ª definición

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

agrupacion3 [] = []

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

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

-- Comparación de eficiencia

-- λ> import Data.List (cycle)

-- λ> :set +s

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

-- 15000000

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

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

-- 15000000

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

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

-- 15000000

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

Mayores que la mitad

PorJosé A. Alonso 12-diciembre-201619-diciembre-2016

Definir la función

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

1	mayoresMitad :: Ord a => [a] -> [a]

tal que (mayoresMitad xs) es la lista de los elementos de xs que son mayores que la mitad de los elementos de xs, suponiendo que los elementos de xs son distintos. Por ejemplo,

   sort (mayoresMitad [1,6,3,4])    ==  [4,6]
   sort (mayoresMitad [1,6,3,4,7])  ==  [4,6,7]
   sort (mayoresMitad [1,6,3,4,2])  ==  [3,4,6]
   length (mayoresMitad3 [1..10^6]) ==  500000

sort (mayoresMitad [1,6,3,4]) == [4,6]

sort (mayoresMitad [1,6,3,4,7]) == [4,6,7]

sort (mayoresMitad [1,6,3,4,2]) == [3,4,6]

length (mayoresMitad3 [1..10^6]) == 500000

Nota: Se considera que si la lista tiene 2n+1 elementos, su mitad tiene n elementos.

Soluciones

import Data.List (sort)

-- 1ª solución:
mayoresMitad1 :: Ord a => [a] -> [a]
mayoresMitad1 xs =
  [x | x <- xs
     , length (filter (<=x) xs) > k]
  where k = length xs `div` 2 

-- 2ª solución
mayoresMitad2 :: Ord a => [a] -> [a]
mayoresMitad2 xs = aux xs
  where aux [] = []
        aux (y:ys) | length [x | x <- xs, x <= y] > k = y : aux ys
                   | otherwise                        = aux ys
        k = length xs `div` 2 

-- 3ª solución
mayoresMitad3 :: Ord a => [a] -> [a]
mayoresMitad3 xs = drop k (sort xs)
  where k = length xs `div` 2 

-- Comprobación de eficiencia
--    λ> length (mayoresMitad1 [1..4*10^3])
--    2000
--    (3.79 secs, 442,631,712 bytes)
--    λ> length (mayoresMitad2 [1..4*10^3])
--    2000
--    (11.82 secs, 1,463,762,192 bytes)
--    λ> length (mayoresMitad3 [1..4*10^3])
--    2000
--    (0.02 secs, 0 bytes)

import Data.List (sort)

-- 1ª solución:

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

mayoresMitad1 xs =

[x | x <- xs

, length (filter (<=x) xs) > k]

where k = length xs `div` 2

-- 2ª solución

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

mayoresMitad2 xs = aux xs

where aux [] = []

aux (y:ys) | length [x | x <- xs, x <= y] > k = y : aux ys

| otherwise = aux ys

k = length xs `div` 2

-- 3ª solución

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

mayoresMitad3 xs = drop k (sort xs)

where k = length xs `div` 2

-- Comprobación de eficiencia

-- λ> length (mayoresMitad1 [1..4*10^3])

-- 2000

-- (3.79 secs, 442,631,712 bytes)

-- λ> length (mayoresMitad2 [1..4*10^3])

-- 2000

-- (11.82 secs, 1,463,762,192 bytes)

-- λ> length (mayoresMitad3 [1..4*10^3])

-- 2000

-- (0.02 secs, 0 bytes)

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.

Suma de los máximos de los subconjuntos

PorJosé A. Alonso 8-diciembre-201615-diciembre-2016

Los subconjuntos distinto del vacío del conjunto {3, 2, 5}, junto con sus máximos elementos, son

   {3}       su máximo es 3
   {2}       su máximo es 2
   {5}       su máximo es 5
   {3, 2}    su máximo es 3
   {3, 5}    su máximo es 5
   {2, 5}    su máximo es 5
   {3, 2, 5} su máximo es 5

{3} su máximo es 3

{2} su máximo es 2

{5} su máximo es 5

{3, 2} su máximo es 3

{3, 5} su máximo es 5

{2, 5} su máximo es 5

{3, 2, 5} su máximo es 5

Por tanto, la suma de los máximos elementos de los subconjuntos de {3, 2, 5} es 3 + 2 + 5 + 3 + 5 + 5 + 5 = 28.

Definir la función

   sumaMaximos :: [Integer] -> Integer

1	sumaMaximos :: [Integer] -> Integer

tal que (sumaMaximos xs) es la suma de los máximos elementos de los subconjuntos de xs. Por ejemplo,

   sumaMaximos [3,2,5]    ==  28
   sumaMaximos [4,1,6,3]  ==  71
   sumaMaximos [1..100]   ==  125497409422594710748173617332225
   length (show (sumaMaximos [1..10^5]))  ==  30108
   sumaMaximos [1..10^5] `mod` (10^7)     ==  4490625

sumaMaximos [3,2,5] == 28

sumaMaximos [4,1,6,3] == 71

sumaMaximos [1..100] == 125497409422594710748173617332225

length (show (sumaMaximos [1..10^5])) == 30108

sumaMaximos [1..10^5] `mod` (10^7) == 4490625

Soluciones

import Data.List (sort, subsequences)

-- 1ª definición
sumaMaximos :: [Integer] -> Integer
sumaMaximos xs =
  sum [maximum ys | ys <- tail (subsequences xs)]

-- 2ª definición
sumaMaximos2 :: [Integer] -> Integer
sumaMaximos2 =
  sum . map maximum . tail . subsequences

-- 3ª definición
sumaMaximos3 :: [Integer] -> Integer
sumaMaximos3 xs =
  sum (zipWith (*) (sort xs) potenciasDeDos)

potenciasDeDos :: [Integer]
potenciasDeDos = iterate (*2) 1

-- Comparación de eficiencia
--    λ> sumaMaximos [1..20]
--    19922945
--    (2.74 secs, 703,957,848 bytes)
--    λ> sumaMaximos2 [1..20]
--    19922945
--    (2.06 secs, 680,728,696 bytes)
--    λ> sumaMaximos3 [1..20]
--    19922945
--    (0.01 secs, 0 bytes)

import Data.List (sort, subsequences)

-- 1ª definición

sumaMaximos :: [Integer] -> Integer

sumaMaximos xs =

sum [maximum ys | ys <- tail (subsequences xs)]

-- 2ª definición

sumaMaximos2 :: [Integer] -> Integer

sumaMaximos2 =

sum . map maximum . tail . subsequences

-- 3ª definición

sumaMaximos3 :: [Integer] -> Integer

sumaMaximos3 xs =

sum (zipWith (*) (sort xs) potenciasDeDos)

potenciasDeDos :: [Integer]

potenciasDeDos = iterate (*2) 1

-- Comparación de eficiencia

-- λ> sumaMaximos [1..20]

-- 19922945

-- (2.74 secs, 703,957,848 bytes)

-- λ> sumaMaximos2 [1..20]

-- 19922945

-- (2.06 secs, 680,728,696 bytes)

-- λ> sumaMaximos3 [1..20]

-- 19922945

-- (0.01 secs, 0 bytes)

Basado en el artículo
Sum of maximum elements of all subsets
de Utkarsh Trivedi en GeeksforGeeks.

Elementos que respetan la ordenación

PorJosé A. Alonso 7-diciembre-201614-diciembre-2016

Se dice que un elemento x de una lista xs respeta la ordenación si x es mayor o igual que todos lo que tiene delante en xs y es menor o igual que todos lo que tiene detrás en xs. Por ejemplo, en la lista lista [3,2,1,4,6,5,7,9,8] el número 4 respeta la ordenación pero el número 5 no la respeta (porque es mayor que el 6 que está delante).

Definir la función

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

1	respetuosos :: Ord a => [a] -> [a]

tal que (respetuosos xs) es la lista de los elementos de xs que respetan la ordenación. Por ejemplo,

   respetuosos [3,2,1,4,6,4,7,9,8]  ==  [4,7]
   respetuosos [2,1,3,4,6,4,7,8,9]  ==  [3,4,7,8,9]
   respetuosos "abaco"              ==  "aco"
   respetuosos "amor"               ==  "amor"
   respetuosos "romanos"            ==  "s"
   respetuosos [1..9]               ==  [1,2,3,4,5,6,7,8,9]
   respetuosos [9,8..1]             ==  []

respetuosos [3,2,1,4,6,4,7,9,8] == [4,7]

respetuosos [2,1,3,4,6,4,7,8,9] == [3,4,7,8,9]

respetuosos "abaco" == "aco"

respetuosos "amor" == "amor"

respetuosos "romanos" == "s"

respetuosos [1..9] == [1,2,3,4,5,6,7,8,9]

respetuosos [9,8..1] == []

Comprobar con QuickCheck que para cualquier lista de enteros xs se verifican las siguientes propiedades:

todos los elementos de (sort xs) respetan la ordenación y
en la lista (nub (reverse (sort xs))) hay como máximo un elemento que respeta la ordenación.

Soluciones

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

-- 1ª definición (por comprensión):
respetuosos :: Ord a => [a] -> [a]
respetuosos xs =
  [z | k <- [0..n-1]
     , let (ys,z:zs) = splitAt k xs
     , all (<=z) ys
     , all (>=z) zs]
  where n = length xs

-- 2ª definición (por recursión):
respetuosos2 :: Ord a => [a] -> [a]
respetuosos2 xs = aux [] [] xs
  where aux zs _  []      = reverse zs
        aux zs ys (x:xs)
          | all (<=x) ys && all (>=x) xs = aux (x:zs) (x:ys) xs
          | otherwise                    = aux zs     (x:ys) xs

-- 3ª definición
respetuosos3 :: Ord a => [a] -> [a]
respetuosos3 xs = [ x | (ys,x,zs) <- zip3 (inits xs) xs (tails xs)
                      , all (<=x) ys
                      , all (x<=) zs ]

-- 4ª solución
respetuosos4 :: Ord a =>[a] ->[a]
respetuosos4 xs =
  [x | (a, x, b) <- zip3 (scanl1 max xs) xs (scanr1 min xs)
     , a <= x && x <= b]

-- Comparación de eficiencia
--    λ> length (respetuosos [1..3000])
--    3000
--    (3.31 secs, 1,140,407,224 bytes)
--    λ> length (respetuosos2 [1..3000])
--    3000
--    (2.85 secs, 587,082,160 bytes)
--    λ> length (respetuosos3 [1..3000])
--    3000
--    (2.12 secs, 785,446,880 bytes)
--    λ> length (respetuosos4 [1..3000])
--    3000
--    (0.02 secs, 0 bytes)

-- 1ª propiedad
prop_respetuosos1 :: [Int] -> Bool
prop_respetuosos1 xs =
  respetuosos (sort xs) == sort xs

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

-- La 2ª propiedad
prop_respetuosos2 :: [Int] -> Bool
prop_respetuosos2 xs =
  length (respetuosos (nub (reverse (sort xs)))) <= 1

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

import Data.List (inits, nub, sort, tails)

import Test.QuickCheck

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

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

respetuosos xs =

[z | k <- [0..n-1]

, let (ys,z:zs) = splitAt k xs

, all (<=z) ys

, all (>=z) zs]

where n = length xs

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

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

respetuosos2 xs = aux [] [] xs

where aux zs _ [] = reverse zs

aux zs ys (x:xs)

| all (<=x) ys && all (>=x) xs = aux (x:zs) (x:ys) xs

| otherwise = aux zs (x:ys) xs

-- 3ª definición

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

respetuosos3 xs = [ x | (ys,x,zs) <- zip3 (inits xs) xs (tails xs)

, all (<=x) ys

, all (x<=) zs ]

-- 4ª solución

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

respetuosos4 xs =

[x | (a, x, b) <- zip3 (scanl1 max xs) xs (scanr1 min xs)

, a <= x && x <= b]

-- Comparación de eficiencia

-- λ> length (respetuosos [1..3000])

-- 3000

-- (3.31 secs, 1,140,407,224 bytes)

-- λ> length (respetuosos2 [1..3000])

-- 3000

-- (2.85 secs, 587,082,160 bytes)

-- λ> length (respetuosos3 [1..3000])

-- 3000

-- (2.12 secs, 785,446,880 bytes)

-- λ> length (respetuosos4 [1..3000])

-- 3000

-- (0.02 secs, 0 bytes)

-- 1ª propiedad

prop_respetuosos1 :: [Int] -> Bool

prop_respetuosos1 xs =

respetuosos (sort xs) == sort xs

-- La comprobación es

-- λ> quickCheck prop_respetuosos1

-- +++ OK, passed 100 tests.

-- La 2ª propiedad

prop_respetuosos2 :: [Int] -> Bool

prop_respetuosos2 xs =

length (respetuosos (nub (reverse (sort xs)))) <= 1

-- La comprobación es

-- λ> quickCheck prop_respetuosos2

-- +++ OK, passed 100 tests.

Sin ceros finales

PorJosé A. Alonso 6-diciembre-201613-diciembre-2016

Definir la función

   sinCerosFinales :: Int -> Int

1	sinCerosFinales :: Int -> Int

tal que (sinCerosFinales n) es el número obtenido eliminando los ceros finales de n. Por ejemplo,

   sinCerosFinales 104050     == 10405
   sinCerosFinales 960000     == 96
   sinCerosFinales 100050     == 10005
   sinCerosFinales (-10050)   == -1005
   sinCerosFinales 12         == 12
   sinCerosFinales 0          == 0

sinCerosFinales 104050 == 10405

sinCerosFinales 960000 == 96

sinCerosFinales 100050 == 10005

sinCerosFinales (-10050) == -1005

sinCerosFinales 12 == 12

sinCerosFinales 0 == 0

Comprobar con QuickCheck que, para cualquier número entero n,

   sinCerosFinales (sinCerosFinales n) == sinCerosFinales n

1	sinCerosFinales (sinCerosFinales n) == sinCerosFinales n

Soluciones

import Test.QuickCheck

-- 1ª solución
sinCerosFinales :: Int -> Int
sinCerosFinales 0 = 0
sinCerosFinales n
  | r /= 0    = n
  | otherwise = sinCerosFinales q  
  where (q,r) = quotRem n 10

-- 2ª solución
sinCerosFinales2 :: Int -> Int
sinCerosFinales2 0 = 0
sinCerosFinales2 n =
  read (reverse (dropWhile (=='0') (reverse (show n))))

-- 3ª solución
sinCerosFinales3 :: Int -> Int
sinCerosFinales3 0 = 0
sinCerosFinales3 n =
  (read . reverse . dropWhile (== '0') . reverse . show) n

-- 4ª solución
sinCerosFinales4 :: Int -> Int
sinCerosFinales4 0 = 0
sinCerosFinales4 n =
  read . reverse . dropWhile (== '0') . reverse . show $ n

-- La propiedad es
prop_sinCerosFinales :: Int -> Bool
prop_sinCerosFinales n =
  sinCerosFinales (sinCerosFinales n) == sinCerosFinales n

-- 5ª solución
sinCerosFinales5 :: Int -> Int
sinCerosFinales5 0 = 0
sinCerosFinales5 n = until (\x -> mod x 10 /= 0) (`div` 10) n

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

import Test.QuickCheck

-- 1ª solución

sinCerosFinales :: Int -> Int

sinCerosFinales 0 = 0

sinCerosFinales n

| r /= 0 = n

| otherwise = sinCerosFinales q

where (q,r) = quotRem n 10

-- 2ª solución

sinCerosFinales2 :: Int -> Int

sinCerosFinales2 0 = 0

sinCerosFinales2 n =

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

-- 3ª solución

sinCerosFinales3 :: Int -> Int

sinCerosFinales3 0 = 0

sinCerosFinales3 n =

(read . reverse . dropWhile (== '0') . reverse . show) n

-- 4ª solución

sinCerosFinales4 :: Int -> Int

sinCerosFinales4 0 = 0

sinCerosFinales4 n =

read . reverse . dropWhile (== '0') . reverse . show $ n

-- La propiedad es

prop_sinCerosFinales :: Int -> Bool

prop_sinCerosFinales n =

sinCerosFinales (sinCerosFinales n) == sinCerosFinales n

-- 5ª solución

sinCerosFinales5 :: Int -> Int

sinCerosFinales5 0 = 0

sinCerosFinales5 n = until (\x -> mod x 10 /= 0) (`div` 10) n

-- La comprobación es

-- λ> quickCheck prop_sinCerosFinales

-- +++ OK, passed 100 tests.

Listas engarzadas

PorJosé A. Alonso 5-diciembre-201612-diciembre-2016

Una lista de listas es engarzada si el último elemento de cada lista coincide con el primero de la siguiente.

Definir la función

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

1	engarzada :: Eq a => [[a]] -> Bool

tal que (engarzada xss) se verifica si xss es una lista engarzada. Por ejemplo,

   engarzada [[1,2,3], [3,5], [5,9,0]] == True
   engarzada [[1,4,5], [5,0], [1,0]]   == False
   engarzada [[1,4,5], [], [1,0]]      == False
   engarzada [[2]]                     == True

engarzada [[1,2,3], [3,5], [5,9,0]] == True

engarzada [[1,4,5], [5,0], [1,0]] == False

engarzada [[1,4,5], [], [1,0]] == False

engarzada [[2]] == True

Soluciones

-- 1ª solución:
engarzada :: Eq a => [[a]] -> Bool
engarzada (xs:ys:xss) =
     not (null xs) && not (null ys) && last xs == head ys
  && engarzada (ys:xss)
engarzada _ = True

-- 2ª solución:
engarzada2 :: Eq a => [[a]] -> Bool
engarzada2 (xs:ys:xss) =
  and [ not (null xs)
      , not (null ys)
      , last xs == head ys
      , engarzada2 (ys:xss) ]
engarzada2 _ = True

-- 3ª solución:
engarzada3 :: Eq a => [[a]] -> Bool
engarzada3 xss =
  and [ not (null xs) && not (null ys) && last xs == head ys
      | (xs,ys) <- zip xss (tail xss)]

-- 4ª solución:
engarzada4 :: Eq a => [[a]] -> Bool
engarzada4 xss =
  all engarzados (zip xss (tail xss))
  where engarzados (xs,ys) =
          not (null xs) && not (null ys) && last xs == head ys

-- 5ª solución:
engarzada5 :: Eq a => [[a]] -> Bool
engarzada5 xss =
  all engarzados (zip xss (tail xss))
  where engarzados ([],_)   = False
        engarzados (_,[])   = False
        engarzados (xs,y:_) = last xs == y

-- 6ª solución:
engarzada6 :: Eq a => [[a]] -> Bool
engarzada6 xss =
  and (zipWith engarzados xss (tail xss))
  where engarzados [] _     = False
        engarzados _  []    = False
        engarzados xs (y:_) = last xs == y

-- 1ª solución:

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

engarzada (xs:ys:xss) =

not (null xs) && not (null ys) && last xs == head ys

&& engarzada (ys:xss)

engarzada _ = True

-- 2ª solución:

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

engarzada2 (xs:ys:xss) =

and [ not (null xs)

, not (null ys)

, last xs == head ys

, engarzada2 (ys:xss) ]

engarzada2 _ = True

-- 3ª solución:

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

engarzada3 xss =

and [ not (null xs) && not (null ys) && last xs == head ys

| (xs,ys) <- zip xss (tail xss)]

-- 4ª solución:

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

engarzada4 xss =

all engarzados (zip xss (tail xss))

where engarzados (xs,ys) =

not (null xs) && not (null ys) && last xs == head ys

-- 5ª solución:

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

engarzada5 xss =

all engarzados (zip xss (tail xss))

where engarzados ([],_) = False

engarzados (_,[]) = False

engarzados (xs,y:_) = last xs == y

-- 6ª solución:

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

engarzada6 xss =

and (zipWith engarzados xss (tail xss))

where engarzados [] _ = False

engarzados _ [] = False

engarzados xs (y:_) = last xs == y

Listas alternadas

PorJosé A. Alonso 2-diciembre-20169-diciembre-2016

Una lista de números enteros se llama alternada si sus elementos son alternativamente par/impar o impar/par.

Definir la función

   alternada :: [Int] -> Bool

1	alternada :: [Int] -> Bool

tal que (alternada xs) se verifica si xs es una lista alternada. Por ejemplo,

   alternada [1,2,3]     == True
   alternada [1,4,6,5]   == False
   alternada [1,4,3,5]   == False
   alternada [8,1,2,3,4] == True
   alternada [8,1,2,3]   == True
   alternada [8]         == True
   alternada [7]         == True

alternada [1,2,3] == True

alternada [1,4,6,5] == False

alternada [1,4,3,5] == False

alternada [8,1,2,3,4] == True

alternada [8,1,2,3] == True

alternada [8] == True

alternada [7] == True

Soluciones

-- 1ª solución:
alternada1 :: [Int] -> Bool
alternada1 (x:y:xs)
  | even x    = odd y  && alternada1 (y:xs)
  | otherwise = even y && alternada1 (y:xs)
alternada1 _ = True

-- 2ª solución
alternada2 :: [Int] -> Bool
alternada2 xs = all odd (zipWith (+) xs (tail xs))

-- 1ª solución:

alternada1 :: [Int] -> Bool

alternada1 (x:y:xs)

| even x = odd y && alternada1 (y:xs)

| otherwise = even y && alternada1 (y:xs)

alternada1 _ = True

-- 2ª solución

alternada2 :: [Int] -> Bool

alternada2 xs = all odd (zipWith (+) xs (tail xs))

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

Huecos de Euclides

PorJosé A. Alonso 29-noviembre-20166-diciembre-2016

El teorema de Euclides afirma que existen infinitos números primos. En palabras de Euclides,

«Hay más números primos que cualquier cantidad propuesta de números primos.» (Proposición 20 del Libro IX de «Los Elementos»)

Su demostración se basa en que si p₁,…,pₙ son los primeros n números primos, entonces entre 1+pₙ y 1+p₁·p₂·…·pₙ hay algún número primo. La cantidad de dichos números primos se llama el n-ésimo hueco de Euclides. Por ejemplo, para n = 3 se tiene que p₁ = 2, p₂ = 3 y p₃ = 5 entre 1+p₃ = 6 y 1+p₁·p₂·p₃ = 31 hay 8 números primos (7, 11, 13, 17, 19, 23, 29 y 31), por lo que el valor del tercer hueco de Euclides es 8.

Definir la función

   hueco :: Int -> Integer

1	hueco :: Int -> Integer

tal que (hueco n) es el n-ésimo hueco de Eulides. Por ejemplo,

   hueco 3                   ==  8
   [hueco n | n <- [1..8]]   ==  [1,2,8,43,339,3242,42324,646021]

1 2	hueco 3 == 8 [hueco n \| n <- [1..8]] == [1,2,8,43,339,3242,42324,646021]

Soluciones

import Data.List
import Data.Numbers.Primes

hueco :: Int -> Integer
hueco n = nPrimosEntre (primes !! (n-1)) (1 + product (take n primes))

-- (nPrimosEntre x y) es el número de primos entre x e y. Por ejemplo, 
--    nPrimosEntre 3 7  ==  2
nPrimosEntre :: Integer -> Integer -> Integer
nPrimosEntre x y = genericLength (primosEntre x y)

-- (primosEntre x y) es la lista de los números de primos entre x e
-- y. Por ejemplo,  
--    primosEntre 3 7  ==  [5,7]
primosEntre :: Integer -> Integer -> [Integer]
primosEntre x y =
  takeWhile (<=y) (dropWhile (<=x) primes)

import Data.List

import Data.Numbers.Primes

hueco :: Int -> Integer

hueco n = nPrimosEntre (primes !! (n-1)) (1 + product (take n primes))

-- (nPrimosEntre x y) es el número de primos entre x e y. Por ejemplo,

-- nPrimosEntre 3 7 == 2

nPrimosEntre :: Integer -> Integer -> Integer

nPrimosEntre x y = genericLength (primosEntre x y)

-- (primosEntre x y) es la lista de los números de primos entre x e

-- y. Por ejemplo,

-- primosEntre 3 7 == [5,7]

primosEntre :: Integer -> Integer -> [Integer]

primosEntre x y =

takeWhile (<=y) (dropWhile (<=x) primes)

Referencias

Euclid’s theorem en la ProofWiki.

Representación binaria de los números de Carol

PorJosé A. Alonso 28-noviembre-20165-diciembre-2016

Un número de Carol es un número entero de la forma $4^n-2^{n+1}-1$ o, equivalentemente, $(2^n-1)^2-2$ . Los primeros números de Carol son -1, 7, 47, 223, 959, 3967, 16127, 65023, 261119, 1046527.

Definir las funciones

   carol        :: Integer -> Integer
   carolBinario :: Integer -> Integer

1 2	carol :: Integer -> Integer carolBinario :: Integer -> Integer

tales que

(carol n) es el n-ésimo número de Carol. Por ejemplo,

     carol  3  ==  47
     carol  4  ==  223
     carol 25  ==  1125899839733759

carol 3 == 47

carol 4 == 223

carol 25 == 1125899839733759

(carolBinario n) es la representación binaria del n-ésimo número de Carol. Por ejemplo,

     carolBinario 3  ==  101111
     carolBinario 4  ==  11011111
     carolBinario 5  ==  1110111111

carolBinario 3 == 101111

carolBinario 4 == 11011111

carolBinario 5 == 1110111111

Comprobar con QuickCheck que, para n > 2, la representación binaria del n-ésimo número de Carol es el número formado por n-2 veces el dígito 1, seguido por un 0 y a continuación n+1 veces el dígito 1.

Soluciones

import Test.QuickCheck

carol :: Integer -> Integer
carol n = x^2 - 2
  where x = 2^n - 1

carolBinario :: Integer -> Integer
carolBinario = binario . carol

-- (binario x) es el número binario correspondiente al número decimal
-- x. Por ejemplo, 
--    binario 223  ==  11011111
binario :: Integer -> Integer 
binario = digitosAnumero . reverse . int2bin

-- (int2bin x) es el número binario (representado como la lista
-- invertida de sus dígitos) correspondiente al número decimal
-- x. Por ejemplo, 
--    int2bin 223  ==  [1,1,1,1,1,0,1,1]
int2bin :: Integer -> [Integer]
int2bin n | n < 2     = [n]
          | otherwise = n `mod` 2 : int2bin (n `div` 2)

-- (digitosAnumero xs) es el número cuya lista de dígitos es xs. Por
-- ejemplo,  
--    digitosAnumero [3,2,5]  ==  325
digitosAnumero :: [Integer] -> Integer
digitosAnumero xs =
  read (concatMap show xs)

-- En la definición anterior se pueden eliminar el argumento
digitosAnumero2 :: [Integer] -> Integer
digitosAnumero2 = read . (concatMap show)

-- La propiedad es
prop_carol :: Integer -> Property
prop_carol n =
  n > 2 ==> carolBinario n == carolBinario2 n
  where
    carolBinario2 n =
      digitosAnumero ((replicate (m-2) 1) ++ [0] ++ (replicate (m+1) 1))
      where m = fromIntegral n

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

import Test.QuickCheck

carol :: Integer -> Integer

carol n = x^2 - 2

where x = 2^n - 1

carolBinario :: Integer -> Integer

carolBinario = binario . carol

-- (binario x) es el número binario correspondiente al número decimal

-- x. Por ejemplo,

-- binario 223 == 11011111

binario :: Integer -> Integer

binario = digitosAnumero . reverse . int2bin

-- (int2bin x) es el número binario (representado como la lista

-- invertida de sus dígitos) correspondiente al número decimal

-- x. Por ejemplo,

-- int2bin 223 == [1,1,1,1,1,0,1,1]

int2bin :: Integer -> [Integer]

int2bin n | n < 2 = [n]

| otherwise = n `mod` 2 : int2bin (n `div` 2)

-- (digitosAnumero xs) es el número cuya lista de dígitos es xs. Por

-- ejemplo,

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

digitosAnumero :: [Integer] -> Integer

digitosAnumero xs =

read (concatMap show xs)

-- En la definición anterior se pueden eliminar el argumento

digitosAnumero2 :: [Integer] -> Integer

digitosAnumero2 = read . (concatMap show)

-- La propiedad es

prop_carol :: Integer -> Property

prop_carol n =

n > 2 ==> carolBinario n == carolBinario2 n

where

carolBinario2 n =

digitosAnumero ((replicate (m-2) 1) ++ [0] ++ (replicate (m+1) 1))

where m = fromIntegral n

-- La comprobación es

-- λ> quickCheck prop_carol

-- +++ OK, passed 100 tests.

Referencias

Carol number por Shashank Mishra en GeeksforGeeks.
Carol number en la Wikipedia.

Menor potencia de 2 comenzando un número dado

PorJosé A. Alonso 24-noviembre-20161-diciembre-2016

Definir las siguientes funciones

   potenciasDe2  :: Integer -> [Integer]
   menorPotenciaDe2 :: Integer -> Integer

1 2	potenciasDe2 :: Integer -> [Integer] menorPotenciaDe2 :: Integer -> Integer

tales que

(potenciasDe2 a) es la lista de las potencias de 2 que comienzan por a. Por ejemplo,

     λ> take 5 (potenciasDe2 3)
     [32,32768,33554432,34359738368,35184372088832]
     λ> take 2 (potenciasDe2 102)
     [1024,102844034832575377634685573909834406561420991602098741459288064]

λ> take 5 (potenciasDe2 3)

[32,32768,33554432,34359738368,35184372088832]

λ> take 2 (potenciasDe2 102)

[1024,102844034832575377634685573909834406561420991602098741459288064]

(menorPotenciaDe2 a) es la menor potencia de 2 que comienza con el número a. Por ejemplo,

     λ> menorPotenciaDe2 10
     1024
     λ> menorPotenciaDe2 25
     256
     λ> menorPotenciaDe2 62
     6277101735386680763835789423207666416102355444464034512896
     λ> menorPotenciaDe2 425
     42535295865117307932921825928971026432
     λ> menorPotenciaDe2 967140655691
     9671406556917033397649408
     λ> [menorPotenciaDe2 a | a <- [1..10]]
     [1,2,32,4,512,64,70368744177664,8,9007199254740992,1024]

λ> menorPotenciaDe2 10

1024

λ> menorPotenciaDe2 25

256

λ> menorPotenciaDe2 62

6277101735386680763835789423207666416102355444464034512896

λ> menorPotenciaDe2 425

42535295865117307932921825928971026432

λ> menorPotenciaDe2 967140655691

9671406556917033397649408

λ> [menorPotenciaDe2 a | a <- [1..10]]

[1,2,32,4,512,64,70368744177664,8,9007199254740992,1024]

Comprobar con QuickCheck que, para todo entero positivo a, existe una potencia de 2 que empieza por a.

Soluciones

import Data.List (isPrefixOf)
import Test.QuickCheck

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

potenciasDe2A :: Integer -> [Integer]
potenciasDe2A a =
  [x | x <- potenciasA
     , a `esPrefijo` x]

potenciasA :: [Integer]
potenciasA = [2^n | n <- [0..]]

esPrefijo :: Integer -> Integer -> Bool
esPrefijo x y = show x `isPrefixOf` show y

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

potenciasDe2B :: Integer -> [Integer]
potenciasDe2B a = filter (a `esPrefijo`) potenciasA

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

potenciasDe2C :: Integer -> [Integer]
potenciasDe2C a = filter (a `esPrefijo`) potenciasC

potenciasC :: [Integer]
potenciasC = iterate (*2) 1

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

-- λ> length (show (head (potenciasDe2A 123456)))
-- 19054
-- (7.17 secs, 1,591,992,792 bytes)
-- λ> length (show (head (potenciasDe2B 123456)))
-- 19054
-- (5.96 secs, 1,273,295,272 bytes)
-- λ> length (show (head (potenciasDe2C 123456)))
-- 19054
-- (6.24 secs, 1,542,698,392 bytes)

-- Definición de menorPotenciaDe2 
menorPotenciaDe2 :: Integer -> Integer
menorPotenciaDe2 = head . potenciasDe2B

-- Propiedad
prop_potenciasDe2 :: Integer -> Property
prop_potenciasDe2 a =
  a > 0 ==> not (null (potenciasDe2B a))

-- Comprobación
--    λ> quickCheck prop_potenciasDe2
--    +++ OK, passed 100 tests.

import Data.List (isPrefixOf)

import Test.QuickCheck

-- 1ª definición de potenciasDe2

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

potenciasDe2A :: Integer -> [Integer]

potenciasDe2A a =

[x | x <- potenciasA

, a `esPrefijo` x]

potenciasA :: [Integer]

potenciasA = [2^n | n <- [0..]]

esPrefijo :: Integer -> Integer -> Bool

esPrefijo x y = show x `isPrefixOf` show y

-- 2ª definición de potenciasDe2

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

potenciasDe2B :: Integer -> [Integer]

potenciasDe2B a = filter (a `esPrefijo`) potenciasA

-- 3ª definición de potenciasDe2

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

potenciasDe2C :: Integer -> [Integer]

potenciasDe2C a = filter (a `esPrefijo`) potenciasC

potenciasC :: [Integer]

potenciasC = iterate (*2) 1

-- Comparación de eficiencia

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

-- λ> length (show (head (potenciasDe2A 123456)))

-- 19054

-- (7.17 secs, 1,591,992,792 bytes)

-- λ> length (show (head (potenciasDe2B 123456)))

-- 19054

-- (5.96 secs, 1,273,295,272 bytes)

-- λ> length (show (head (potenciasDe2C 123456)))

-- 19054

-- (6.24 secs, 1,542,698,392 bytes)

-- Definición de menorPotenciaDe2

menorPotenciaDe2 :: Integer -> Integer

menorPotenciaDe2 = head . potenciasDe2B

-- Propiedad

prop_potenciasDe2 :: Integer -> Property

prop_potenciasDe2 a =

a > 0 ==> not (null (potenciasDe2B a))

-- Comprobación

-- λ> quickCheck prop_potenciasDe2

-- +++ OK, passed 100 tests.

Referencias

Potencias de 2 por Philippe Chevanne en «Mad Maths».
Sucesión A018802 de la OEIS

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.

Números poderosos

PorJosé A. Alonso 17-noviembre-201624-noviembre-2016

Un número es poderoso si es igual a la suma de sus dígitos elevados a sus respectivas posiciones. Por ejemplo, los números 89, 135 y 1306 son poderosos ya que

     89 = 8^1 + 9^2
    135 = 1^1 + 3^2 + 5^3.
   1306 = 1^1 + 3^2 + 0^3 + 6^4

89 = 8^1 + 9^2

135 = 1^1 + 3^2 + 5^3.

1306 = 1^1 + 3^2 + 0^3 + 6^4

Definir la función

   esPoderoso :: Integer -> Bool

1	esPoderoso :: Integer -> Bool

tal que (esPoderoso n) se verifica si n es poderoso. Por ejemplo,

   λ> esPoderoso 135
   True
   λ> esPoderoso 80
   False
   λ> esPoderoso 89
   True
   λ> esPoderoso 12157692622039623539
   True
   λ> [n | n <- [10..30000], esPoderoso n]
   [89,135,175,518,598,1306,1676,2427]

λ> esPoderoso 135

True

λ> esPoderoso 80

False

λ> esPoderoso 89

True

λ> esPoderoso 12157692622039623539

True

λ> [n | n <- [10..30000], esPoderoso n]

[89,135,175,518,598,1306,1676,2427]

Comprobar con QuickCheck que 12157692622039623539 es el mayor número poderoso.

Soluciones

import Test.QuickCheck

esPoderoso :: Integer -> Bool
esPoderoso n =
  sum (zipWith (^) (digitos n) [1..]) == n

digitos :: Integer -> [Integer]
digitos n =
  [read [d] | d <- show n]

-- La propiedad es
prop_poderosos :: Integer -> Property
prop_poderosos n =
  n > 0 ==> not (esPoderoso (12157692622039623539 + n))

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

import Test.QuickCheck

esPoderoso :: Integer -> Bool

esPoderoso n =

sum (zipWith (^) (digitos n) [1..]) == n

digitos :: Integer -> [Integer]

digitos n =

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

-- La propiedad es

prop_poderosos :: Integer -> Property

prop_poderosos n =

n > 0 ==> not (esPoderoso (12157692622039623539 + n))

-- La comprobación es

-- λ> quickCheck prop_poderosos

-- +++ OK, passed 100 tests.

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.

Variación de la conjetura de Goldbach

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

La conjetura de Goldbach afirma que

Todo número entero mayor que 5 se puede escribir como suma de tres números primos.

En este ejercicio consideraremos la variación consistente en exigir que los tres sumandos sean distintos.

Definir las funciones

   sumas3PrimosDistintos      :: Int -> [(Int,Int,Int)]
   conKsumas3PrimosDistintos  :: Int -> Int -> [Int]
   noSonSumas3PrimosDistintos :: Int -> [Int]

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

conKsumas3PrimosDistintos :: Int -> Int -> [Int]

noSonSumas3PrimosDistintos :: Int -> [Int]

tales que

(sumas3PrimosDistintos n) es la lista de las descomposiciones decrecientes de n como tres primos distintos. Por ejemplo,

   sumas3PrimosDistintos 26  ==  [(13,11,2),(17,7,2),(19,5,2)]
   sumas3PrimosDistintos 18  ==  [(11,5,2),(13,3,2)]
   sumas3PrimosDistintos 10  ==  [(5,3,2)]
   sumas3PrimosDistintos 11  ==  []

sumas3PrimosDistintos 26 == [(13,11,2),(17,7,2),(19,5,2)]

sumas3PrimosDistintos 18 == [(11,5,2),(13,3,2)]

sumas3PrimosDistintos 10 == [(5,3,2)]

sumas3PrimosDistintos 11 == []

(conKsumas3PrimosDistintos k n) es la lista de los números menores o iguales que n que se pueden escribir en k forma distintas como suma de tres primos distintos. Por ejemplo,

   conKsumas3PrimosDistintos 3 99  ==  [26,27,29,32,36,42,46,48,54,58,60]
   conKsumas3PrimosDistintos 2 99  ==  [18,20,21,22,23,24,25,28,30,34,64,70]
   conKsumas3PrimosDistintos 1 99  ==  [10,12,14,15,16,19,40]
   conKsumas3PrimosDistintos 0 99  ==  [11,13,17]

conKsumas3PrimosDistintos 3 99 == [26,27,29,32,36,42,46,48,54,58,60]

conKsumas3PrimosDistintos 2 99 == [18,20,21,22,23,24,25,28,30,34,64,70]

conKsumas3PrimosDistintos 1 99 == [10,12,14,15,16,19,40]

conKsumas3PrimosDistintos 0 99 == [11,13,17]

(noSonSumas3PrimosDistintos n) es la lista de los números menores o iguales que n que no se pueden escribir como suma de tres primos distintos. Por ejemplo,

   noSonSumas3PrimosDistintos 99   ==  [11,13,17]
   noSonSumas3PrimosDistintos 500  ==  [11,13,17]

1 2	noSonSumas3PrimosDistintos 99 == [11,13,17] noSonSumas3PrimosDistintos 500 == [11,13,17]

Soluciones

import Data.Numbers.Primes

sumas3PrimosDistintos :: Int -> [(Int,Int,Int)]
sumas3PrimosDistintos n =
  [(a,b,c) | a <- takeWhile (<=n-5) primes
           , b <- takeWhile (<a) primes
           , let c = n - a - b
           , c < b
           , isPrime c]

conKsumas3PrimosDistintos :: Int -> Int -> [Int]
conKsumas3PrimosDistintos k n =
  [x | x <- [10..n]
     , length (sumas3PrimosDistintos x) == k]

noSonSumas3PrimosDistintos :: Int -> [Int]
noSonSumas3PrimosDistintos = conKsumas3PrimosDistintos 0

import Data.Numbers.Primes

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

sumas3PrimosDistintos n =

[(a,b,c) | a <- takeWhile (<=n-5) primes

, b <- takeWhile (<a) primes

, let c = n - a - b

, c < b

, isPrime c]

conKsumas3PrimosDistintos :: Int -> Int -> [Int]

conKsumas3PrimosDistintos k n =

[x | x <- [10..n]

, length (sumas3PrimosDistintos x) == k]

noSonSumas3PrimosDistintos :: Int -> [Int]

noSonSumas3PrimosDistintos = conKsumas3PrimosDistintos 0

Referencias

Basado en el artículo Derivaciones de la conjetura de Goldbach de Claudio Meller en el blog Números y algo más.

Primo anterior

PorJosé A. Alonso 7-noviembre-201614-noviembre-2016

Definir la función

   primoAnterior :: Integer -> Integer

1	primoAnterior :: Integer -> Integer

tal que (primoAnterior n) es el mayor primo menor que n (donde n > 2). Por ejemplo,

   primoAnterior 10     ==  7
   primoAnterior 17     ==  13
   primoAnterior 30     ==  29
   primoAnterior 2016   ==  2011
   primoAnterior 15726  ==  15683

primoAnterior 10 == 7

primoAnterior 17 == 13

primoAnterior 30 == 29

primoAnterior 2016 == 2011

primoAnterior 15726 == 15683

Calcular el menor número cuya distancia a su primo anterior es mayor que 40.

Soluciones

import Data.Numbers.Primes ( isPrime
                           , primes
                           )

-- 1ª definición
primoAnterior1 :: Integer -> Integer
primoAnterior1 n =
  last (takeWhile (<n) primes)

-- 2ª definición
primoAnterior2 :: Integer -> Integer
primoAnterior2 3 = 2
primoAnterior2 n =
  head [x | x <- [a,a-2..]
          , isPrime x]
  where a | even n    = n-1
          | otherwise = n-2

-- Comparación de eficiencia  
--    λ> primoAnterior1 3000000
--    2999999
--    (1.80 secs, 1,148,572,848 bytes)
--    λ> primoAnterior2 3000000
--    2999999
--    (0.00 secs, 0 bytes)
--    
--    λ> head [n | n <- [3..], n - primoAnterior1 n > 34]
--    9586
--    (28.08 secs, 14,396,008,560 bytes)
--    λ> head [n | n <- [3..], n - primoAnterior2 n > 34]
--    9586
--    (1.10 secs, 625,247,632 bytes)

-- El cálculo es
--    λ> head [n | n <- [3..], n - primoAnterior2 n > 40]
--    15724

import Data.Numbers.Primes ( isPrime

, primes

)

-- 1ª definición

primoAnterior1 :: Integer -> Integer

primoAnterior1 n =

last (takeWhile (<n) primes)

-- 2ª definición

primoAnterior2 :: Integer -> Integer

primoAnterior2 3 = 2

primoAnterior2 n =

head [x | x <- [a,a-2..]

, isPrime x]

where a | even n = n-1

| otherwise = n-2

-- Comparación de eficiencia

-- λ> primoAnterior1 3000000

-- 2999999

-- (1.80 secs, 1,148,572,848 bytes)

-- λ> primoAnterior2 3000000

-- 2999999

-- (0.00 secs, 0 bytes)

-- λ> head [n | n <- [3..], n - primoAnterior1 n > 34]

-- 9586

-- (28.08 secs, 14,396,008,560 bytes)

-- λ> head [n | n <- [3..], n - primoAnterior2 n > 34]

-- 9586

-- (1.10 secs, 625,247,632 bytes)

-- El cálculo es

-- λ> head [n | n <- [3..], n - primoAnterior2 n > 40]

-- 15724

Primos de Kamenetsky

PorJosé A. Alonso 4-noviembre-201611-noviembre-2016

Un número primo se dice que es un primo de Kamenetsky si al anteponerlo cualquier dígito se obtiene un número compuesto. Por ejemplo, el 5 es un primo de Kamenetsky ya que 15, 25, 35, 45, 55, 65, 75, 85 y 95 son compuestos. También lo es 149 ya que 1149, 2149, 3149, 4149, 5149, 6149, 7149, 8149 y 9149 son compuestos.

Definir la sucesión

   primosKamenetsky :: [Integer]

1	primosKamenetsky :: [Integer]

tal que sus elementos son los números primos de Kamenetsky. Por ejemplo,

   take 5 primosKamenetsky  ==  [2,5,149,401,509]

1	take 5 primosKamenetsky == [2,5,149,401,509]

Soluciones

import Data.Numbers.Primes (isPrime, primes)

primosKamenetsky :: [Integer]
primosKamenetsky =
  [x | x <- primes
     , esKamenetsky x] 

esKamenetsky :: Integer -> Bool
esKamenetsky x =
  all (not . isPrime) [read (d:xs) | d <- "123456789"]
  where xs = show x

import Data.Numbers.Primes (isPrime, primes)

primosKamenetsky :: [Integer]

primosKamenetsky =

[x | x <- primes

, esKamenetsky x]

esKamenetsky :: Integer -> Bool

esKamenetsky x =

all (not . isPrime) [read (d:xs) | d <- "123456789"]

where xs = show x

Referencias

Sucesión A155762 de la OEIS.
Anteponer un dígito a un primo en «Números y algo más».

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 duplicadora

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

Para cada entero positivo n, existe una única sucesión que empieza en 1, termina en n y en la que cada uno de sus elementos es el doble de su anterior o el doble más uno. Dicha sucesión se llama la sucesión duplicadora de n. Por ejemplo, la sucesión duplicadora de 13 es [1, 3, 6, 13], ya que

    3 = 2*1 +1
    6 = 2*3
   13 = 2*6 +1

3 = 2*1 +1

6 = 2*3

13 = 2*6 +1

Definir la función

   duplicadora :: Integer -> [Integer]

1	duplicadora :: Integer -> [Integer]

tal que (duplicadora n) es la sucesión duplicadora de n. Por ejemplo,

   duplicadora 13                   ==  [1,3,6,13]
   duplicadora 17                   ==  [1,2,4,8,17]
   length (duplicadora (10^40000))  ==  132878

duplicadora 13 == [1,3,6,13]

duplicadora 17 == [1,2,4,8,17]

length (duplicadora (10^40000)) == 132878

Soluciones

-- 1ª solución
duplicadora :: Integer -> [Integer]
duplicadora x =
    reverse (takeWhile (>=1) (iterate (`div` 2) x))

-- 2ª definición
duplicadora2 :: Integer -> [Integer]
duplicadora2  =
    reverse . takeWhile (>=1) . iterate (`div` 2)

-- 1ª solución

duplicadora :: Integer -> [Integer]

duplicadora x =

reverse (takeWhile (>=1) (iterate (`div` 2) x))

-- 2ª definición

duplicadora2 :: Integer -> [Integer]

duplicadora2 =

reverse . takeWhile (>=1) . iterate (`div` 2)

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Referencias

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Referencias

Soluciones

Referencias

Soluciones

Referencias

Soluciones

Soluciones

Referencias

Soluciones

Soluciones

Referencia

Soluciones

Referencias

Soluciones

Soluciones

Referencias

Soluciones

Soluciones

Soluciones

Soluciones

Entradas recientes

Buscar

Correo electrónico