Orden superior

Agrupamiento según valores

PorJosé A. Alonso 29-abril-201525-abril-2021

Definir la función

   agrupa :: Ord c => (a -> c) -> [a] -> Map c [a]

1	agrupa :: Ord c => (a -> c) -> [a] -> Map c [a]

tal que (agrupa f xs) es el diccionario obtenido agrupando los elementos de xs según sus valores mediante la función f. Por ejemplo,

   ghci> agrupa length ["hoy", "ayer", "ana", "cosa"]
   fromList [(3,["hoy","ana"]),(4,["ayer","cosa"])]
   ghci> agrupa head ["claro", "ayer", "ana", "cosa"]
   fromList [('a',["ayer","ana"]),('c',["claro","cosa"])]
   ghci> agrupa length (words "suerte en el examen")
   fromList [(2,["en","el"]),(6,["suerte","examen"])]

ghci> agrupa length ["hoy", "ayer", "ana", "cosa"]

fromList [(3,["hoy","ana"]),(4,["ayer","cosa"])]

ghci> agrupa head ["claro", "ayer", "ana", "cosa"]

fromList [('a',["ayer","ana"]),('c',["claro","cosa"])]

ghci> agrupa length (words "suerte en el examen")

fromList [(2,["en","el"]),(6,["suerte","examen"])]

Soluciones

import qualified Data.List as L
import Data.Map

-- 1ª definición (por recursión)
agrupa1 :: Ord c => (a -> c) -> [a] -> Map c [a]
agrupa1 _ []     = empty
agrupa1 f (x:xs) = insertWith (++) (f x) [x] (agrupa1 f xs)

-- 2ª definición (por plegado)
agrupa2 :: Ord c => (a -> c) -> [a] -> Map c [a]
agrupa2 f = L.foldr (\x -> insertWith (++) (f x) [x]) empty

import qualified Data.List as L

import Data.Map

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

agrupa1 :: Ord c => (a -> c) -> [a] -> Map c [a]

agrupa1 _ [] = empty

agrupa1 f (x:xs) = insertWith (++) (f x) [x] (agrupa1 f xs)

-- 2ª definición (por plegado)

agrupa2 :: Ord c => (a -> c) -> [a] -> Map c [a]

agrupa2 f = L.foldr (\x -> insertWith (++) (f x) [x]) empty

Colinealidad de una lista de puntos

PorJosé A. Alonso 28-abril-20155-mayo-2015

Una colección de puntos son colineales si existe una línea recta tal que todos están en dicha línea. Por ejemplo, los puntos (2,1), (5,7), (4,5) y (20,37) son colineales porque pertenecen a la línea y = 2*x-3.

Definir la función

   colineales :: [(Int,Int)] -> Bool

1	colineales :: [(Int,Int)] -> Bool

tal que (colineales ps) se verifica si los puntos de la lista ps son colineales. Por ejemplo,

   colineales [(2,1),(5,7),(4,5),(20,37)]  ==  True
   colineales [(2,1),(5,7),(4,5),(21,37)]  ==  False

1 2	colineales [(2,1),(5,7),(4,5),(20,37)] == True colineales [(2,1),(5,7),(4,5),(21,37)] == False

Soluciones

-- 1ª definición
colineales1 :: [(Int,Int)] -> Bool
colineales1 ((x1,y1):(x2,y2):xys) =
    all (\(x,y) -> (x-x1)*dy == (y-y1)*dx) xys
    where (dx,dy) = (x2-x1,y2-y1)
colineales1 _ = True

-- 2ª definición
colineales2 :: [(Int,Int)] -> Bool
colineales2 ((x,y):xys) = all (\(dx',dy')-> dx'*dy == dy'*dx) ds 
    where ((dx,dy):ds) = [(x'-x,y'-y) | (x',y') <- xys]

-- 3ª definición
colineales3 :: [(Int,Int)] -> Bool
colineales3 ((x1,y1):(x2,y2):xys) =
    all (\(x,y) -> x*dy-y*dx == k) xys
    where (dx,dy,k) = (x2-x1,y2-y1,x1*dy-y1*dx)
colineales3 _ = True

-- 1ª definición

colineales1 :: [(Int,Int)] -> Bool

colineales1 ((x1,y1):(x2,y2):xys) =

all (\(x,y) -> (x-x1)*dy == (y-y1)*dx) xys

where (dx,dy) = (x2-x1,y2-y1)

colineales1 _ = True

-- 2ª definición

colineales2 :: [(Int,Int)] -> Bool

colineales2 ((x,y):xys) = all (\(dx',dy')-> dx'*dy == dy'*dx) ds

where ((dx,dy):ds) = [(x'-x,y'-y) | (x',y') <- xys]

-- 3ª definición

colineales3 :: [(Int,Int)] -> Bool

colineales3 ((x1,y1):(x2,y2):xys) =

all (\(x,y) -> x*dy-y*dx == k) xys

where (dx,dy,k) = (x2-x1,y2-y1,x1*dy-y1*dx)

colineales3 _ = True

Distancia invierte y suma hasta capicúa

PorJosé A. Alonso 27-abril-20151-mayo-2016

Un número es capicúa si es igual leído de izquierda a derecha que de derecha a izquierda; por ejemplo, el 4884.

El transformado «invierte y suma» de un número x es la suma de x y su número invertido; es decir, el número resultante de la inversión del orden en el que aparecen sus dígitos. Por ejemplo, el transformado de 124 es 124 + 421 = 545.

Se aplica la transformación «invierte y suma» hasta obtener un capicúa. Por ejemplo, partiendo del número 87, el proceso es

     87 +   78 =  165 
    165 +  561 =  726 
    726 +  627 = 1353 
   1353 + 3531 = 4884

87 + 78 = 165

165 + 561 = 726

726 + 627 = 1353

1353 + 3531 = 4884

El número de pasos de dicho proceso es la distancia capicúa del número; por ejemplo, la distancia capicúa de 87 es 4.

Definir la función

   distanciaIS :: Integer -> Integer

1	distanciaIS :: Integer -> Integer

tal que (distanciaIS x) es la distancia capicúa de x. Por ejemplo,

   distanciaIS 11                   ==    0
   distanciaIS 10                   ==    1
   distanciaIS 19                   ==    2
   distanciaIS 59                   ==    3
   distanciaIS 69                   ==    4
   distanciaIS 166                  ==    5
   distanciaIS 79                   ==    6
   distanciaIS 89                   ==   24
   distanciaIS 10911                ==   55
   distanciaIS 1000000079994144385  ==  259

distanciaIS 11 == 0

distanciaIS 10 == 1

distanciaIS 19 == 2

distanciaIS 59 == 3

distanciaIS 69 == 4

distanciaIS 166 == 5

distanciaIS 79 == 6

distanciaIS 89 == 24

distanciaIS 10911 == 55

distanciaIS 1000000079994144385 == 259

Soluciones

import Data.List (genericLength)

-- 1ª solución (por recursión)
-- ===========================

distanciaIS1 :: Integer -> Integer
distanciaIS1 = genericLength . cadena

-- (cadena x) es la lista de transformados de x que no son capicúas. Por
-- ejemplo, 
--    cadena 87  ==  [87,165,726,1353]
cadena :: Integer -> [Integer]
cadena x | esCapicua x = []
         | otherwise   = x : cadena (transformadoIS x)

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,
--    esCapicua 42524  ==  True
--    esCapicua 42542  ==  False
esCapicua :: Integer -> Bool
esCapicua x = show x == reverse (show x)

-- (transformadoIS x) es el número obtenido sumándole a x el número con los
-- mismos dígitos que x pero en orden inverso. Por ejemplo,
--    transformadoIS 1325  ==  6556
--    transformadoIS 1375  ==  7106
transformadoIS :: Integer -> Integer
transformadoIS x = x + read (reverse (show x))

-- 2ª solución (por recursión con contador)
distanciaIS2 :: Integer -> Integer
distanciaIS2 x = aux x 0
    where aux x n | esCapicua x = n
                  | otherwise   = aux (transformadoIS x) (n+1)

-- 3ª solución (con iterate)
distanciaIS3 :: Integer -> Integer
distanciaIS3 =
    genericLength . takeWhile (not . esCapicua) . iterate transformadoIS

import Data.List (genericLength)

-- 1ª solución (por recursión)

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

distanciaIS1 :: Integer -> Integer

distanciaIS1 = genericLength . cadena

-- (cadena x) es la lista de transformados de x que no son capicúas. Por

-- ejemplo,

-- cadena 87 == [87,165,726,1353]

cadena :: Integer -> [Integer]

cadena x | esCapicua x = []

| otherwise = x : cadena (transformadoIS x)

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

-- esCapicua 42524 == True

-- esCapicua 42542 == False

esCapicua :: Integer -> Bool

esCapicua x = show x == reverse (show x)

-- (transformadoIS x) es el número obtenido sumándole a x el número con los

-- mismos dígitos que x pero en orden inverso. Por ejemplo,

-- transformadoIS 1325 == 6556

-- transformadoIS 1375 == 7106

transformadoIS :: Integer -> Integer

transformadoIS x = x + read (reverse (show x))

-- 2ª solución (por recursión con contador)

distanciaIS2 :: Integer -> Integer

distanciaIS2 x = aux x 0

where aux x n | esCapicua x = n

| otherwise = aux (transformadoIS x) (n+1)

-- 3ª solución (con iterate)

distanciaIS3 :: Integer -> Integer

distanciaIS3 =

genericLength . takeWhile (not . esCapicua) . iterate transformadoIS

Caminos reducidos

PorJosé A. Alonso 21-abril-201525-abril-2021

Un camino es una sucesión de pasos en una de las cuatros direcciones Norte, Sur, Este, Oeste. Ir en una dirección y a continuación en la opuesta es un esfuerzo que se puede reducir, Por ejemplo, el camino [Norte,Sur,Este,Sur] se puede reducir a [Este,Sur].

Un camino se dice que es reducido si no tiene dos pasos consecutivos en direcciones opuesta. Por ejemplo, [Este,Sur] es reducido y [Norte,Sur,Este,Sur] no lo es.

En Haskell, las direcciones y los caminos se pueden definir por

   data Direccion = N | S | E | O deriving (Show, Eq)
   type Camino = [Direccion]

1 2	data Direccion = N \| S \| E \| O deriving (Show, Eq) type Camino = [Direccion]

Definir la función

   reducido :: Camino -> Camino

1	reducido :: Camino -> Camino

tal que (reducido ds) es el camino reducido equivalente al camino ds. Por ejemplo,

   reducido []                              ==  []
   reducido [N]                             ==  [N]
   reducido [N,O]                           ==  [N,O]
   reducido [N,O,E]                         ==  [N]
   reducido [N,O,E,S]                       ==  [] 
   reducido [N,O,S,E]                       ==  [N,O,S,E]
   reducido [N,S,S,E,O,N]                   ==  []
   reducido [N,S,S,E,O,N,O]                 ==  [O]
   reducido (take (10^7) (cycle [N,E,O,S])) ==  []

reducido [] == []

reducido [N] == [N]

reducido [N,O] == [N,O]

reducido [N,O,E] == [N]

reducido [N,O,E,S] == []

reducido [N,O,S,E] == [N,O,S,E]

reducido [N,S,S,E,O,N] == []

reducido [N,S,S,E,O,N,O] == [O]

reducido (take (10^7) (cycle [N,E,O,S])) == []

Nótese que en el penúltimo ejemplo las reducciones son

       [N,S,S,E,O,N,O]  
   --> [S,E,O,N,O]  
   --> [S,N,O]  
   --> [O]

[N,S,S,E,O,N,O]

--> [S,E,O,N,O]

--> [S,N,O]

--> [O]

Soluciones

data Direccion = N | S | E | O deriving (Show, Eq)

type Camino = [Direccion]

-- 1ª solución (por recursión):
reducido1 :: Camino -> Camino
reducido1 [] = []
reducido1 (d:ds) | null ds'                = [d]
                 | d == opuesta (head ds') = tail ds'
                 | otherwise               = d:ds'
    where ds' = reducido1 ds

opuesta :: Direccion -> Direccion
opuesta N = S
opuesta S = N
opuesta E = O
opuesta O = E

-- 2ª solución (por plegado)
reducido2 :: Camino -> Camino
reducido2 = foldr aux []
    where aux N (S:xs) = xs
          aux S (N:xs) = xs
          aux E (O:xs) = xs
          aux O (E:xs) = xs
          aux x xs     = x:xs

-- 3ª solución 
reducido3 :: Camino -> Camino
reducido3 []       = []
reducido3 (N:S:ds) = reducido3 ds
reducido3 (S:N:ds) = reducido3 ds
reducido3 (E:O:ds) = reducido3 ds
reducido3 (O:E:ds) = reducido3 ds
reducido3 (d:ds) | null ds'                = [d]
                 | d == opuesta (head ds') = tail ds'
                 | otherwise               = d:ds'
    where ds' = reducido3 ds

-- 4ª solución
reducido4 :: Camino -> Camino
reducido4 ds = reverse (aux ([],ds)) where 
    aux (N:xs, S:ys) = aux (xs,ys)
    aux (S:xs, N:ys) = aux (xs,ys)
    aux (E:xs, O:ys) = aux (xs,ys)
    aux (O:xs, E:ys) = aux (xs,ys)
    aux (  xs, y:ys) = aux (y:xs,ys)
    aux (  xs,   []) = xs

-- Comparación de eficiencia
--    ghci> reducido1 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (3.87 secs, 460160736 bytes)
--    ghci> reducido2 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (1.16 secs, 216582880 bytes)
--    ghci> reducido3 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (0.58 secs, 98561872 bytes)
--    ghci> reducido4 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (0.64 secs, 176154640 bytes)
--    
--    ghci> reducido3 (take (10^7) (cycle [N,E,O,S]))
--    []
--    (5.43 secs, 962694784 bytes)
--    ghci> reducido4 (take (10^7) (cycle [N,E,O,S]))
--    []
--    (9.29 secs, 1722601528 bytes)
-- 
--    ghci> length $ reducido3 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S])
--    400002
--    (4.52 secs, 547004960 bytes)
--    ghci> length $ reducido4 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S])
--    400002
--    (2.17 secs, 379049224 bytes)
--    
--    ghci> let n=10^6 in reducido1 (replicate n N ++ replicate n S)
--    []
--    (7.35 secs, 537797096 bytes)
--    ghci> let n=10^6 in reducido2 (replicate n N ++ replicate n S)
--    []
--    (2.30 secs, 244553404 bytes)
--    ghci> let n=10^6 in reducido3 (replicate n N ++ replicate n S)
--    []
--    (8.08 secs, 545043608 bytes)
--    ghci> let n=10^6 in reducido4 (replicate n N ++ replicate n S)
--    []
--    (1.96 secs, 205552240 bytes)

data Direccion = N | S | E | O deriving (Show, Eq)

type Camino = [Direccion]

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

reducido1 :: Camino -> Camino

reducido1 [] = []

reducido1 (d:ds) | null ds' = [d]

| d == opuesta (head ds') = tail ds'

| otherwise = d:ds'

where ds' = reducido1 ds

opuesta :: Direccion -> Direccion

opuesta N = S

opuesta S = N

opuesta E = O

opuesta O = E

-- 2ª solución (por plegado)

reducido2 :: Camino -> Camino

reducido2 = foldr aux []

where aux N (S:xs) = xs

aux S (N:xs) = xs

aux E (O:xs) = xs

aux O (E:xs) = xs

aux x xs = x:xs

-- 3ª solución

reducido3 :: Camino -> Camino

reducido3 [] = []

reducido3 (N:S:ds) = reducido3 ds

reducido3 (S:N:ds) = reducido3 ds

reducido3 (E:O:ds) = reducido3 ds

reducido3 (O:E:ds) = reducido3 ds

reducido3 (d:ds) | null ds' = [d]

| d == opuesta (head ds') = tail ds'

| otherwise = d:ds'

where ds' = reducido3 ds

-- 4ª solución

reducido4 :: Camino -> Camino

reducido4 ds = reverse (aux ([],ds)) where

aux (N:xs, S:ys) = aux (xs,ys)

aux (S:xs, N:ys) = aux (xs,ys)

aux (E:xs, O:ys) = aux (xs,ys)

aux (O:xs, E:ys) = aux (xs,ys)

aux ( xs, y:ys) = aux (y:xs,ys)

aux ( xs, []) = xs

-- Comparación de eficiencia

-- ghci> reducido1 (take (10^6) (cycle [N,E,O,S]))

-- []

-- (3.87 secs, 460160736 bytes)

-- ghci> reducido2 (take (10^6) (cycle [N,E,O,S]))

-- []

-- (1.16 secs, 216582880 bytes)

-- ghci> reducido3 (take (10^6) (cycle [N,E,O,S]))

-- []

-- (0.58 secs, 98561872 bytes)

-- ghci> reducido4 (take (10^6) (cycle [N,E,O,S]))

-- []

-- (0.64 secs, 176154640 bytes)

-- ghci> reducido3 (take (10^7) (cycle [N,E,O,S]))

-- []

-- (5.43 secs, 962694784 bytes)

-- ghci> reducido4 (take (10^7) (cycle [N,E,O,S]))

-- []

-- (9.29 secs, 1722601528 bytes)

-- ghci> length $ reducido3 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S])

-- 400002

-- (4.52 secs, 547004960 bytes)

-- ghci> length $ reducido4 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S])

-- 400002

-- (2.17 secs, 379049224 bytes)

-- ghci> let n=10^6 in reducido1 (replicate n N ++ replicate n S)

-- []

-- (7.35 secs, 537797096 bytes)

-- ghci> let n=10^6 in reducido2 (replicate n N ++ replicate n S)

-- []

-- (2.30 secs, 244553404 bytes)

-- ghci> let n=10^6 in reducido3 (replicate n N ++ replicate n S)

-- []

-- (8.08 secs, 545043608 bytes)

-- ghci> let n=10^6 in reducido4 (replicate n N ++ replicate n S)

-- []

-- (1.96 secs, 205552240 bytes)

Con mínimo común denominador

PorJosé A. Alonso 20-abril-201527-abril-2015

Los números racionales se pueden representar como pares de enteros:

   type Racional a = (a,a)

1	type Racional a = (a,a)

Definir la función

   reducida :: Integral a => [Racional a] -> [Racional a]

1	reducida :: Integral a => [Racional a] -> [Racional a]

tal que (reducida xs) es la lista de los números racionales donde cada uno es igual al correspondiente elemento de xs y el denominador de todos los elementos de (reducida xs) es el menor número que cumple dicha condición; es decir, si xs es la lista

   [(x_1, y_1), ..., (x_n, y_n)]

1	[(x_1, y_1), ..., (x_n, y_n)]

entonces (reducida xs) es

   [(z_1, d), ..., (z_n, d)]

1	[(z_1, d), ..., (z_n, d)]

tales que

   z_1/d = x_1/y_1, ..., z_n/d = x_n/y_n

1	z_1/d = x_1/y_1, ..., z_n/d = x_n/y_n

y d es el menor posible. Por ejemplo,

   reducida [(1,2),(1,3),(1,4)]  ==  [(6,12),(4,12),(3,12)]
   reducida [(1,2),(1,3),(6,4)]  ==  [(3,6),(2,6),(9,6)]
   reducida [(-7,6),(-10,-8)]    ==  [(-14,12),(15,12)]
   reducida [(8,12)]             ==  [(2,3)]

reducida [(1,2),(1,3),(1,4)] == [(6,12),(4,12),(3,12)]

reducida [(1,2),(1,3),(6,4)] == [(3,6),(2,6),(9,6)]

reducida [(-7,6),(-10,-8)] == [(-14,12),(15,12)]

reducida [(8,12)] == [(2,3)]

Soluciones

type Racional a = (a,a) 

reducida :: Integral a => [Racional a] -> [Racional a]
reducida xs = 
    [(x * (m `div` y), m) | (x,y) <- ys]
    where ys = map fraccionReducida xs
          m  = mcm [y | (_,y) <- ys]

-- (fraccionReducida r) es el número racional igual a r con menor
-- denominador positivo. Por ejemplo,
--    fraccionReducida ( 6, 10)  ==  ( 3,5)
--    fraccionReducida (-6, 10)  ==  (-3,5)
--    fraccionReducida ( 6,-10)  ==  (-3,5)
--    fraccionReducida (-6,-10)  ==  ( 3,5)
--    fraccionReducida ( 3,  5)  ==  ( 3,5)
fraccionReducida :: Integral a => (a,a) -> (a,a)
fraccionReducida (x,y) =
    (s * x1 `div` m, y1 `div` m)
    where s  = signum x * signum y      
          x1 = abs x
          y1 = abs y
          m  = gcd x1 y1
          
-- (mcm xs) es el mínimo común múltiplo de xs. Por ejemplo,
--    mcm [2,6,10]  ==  30
mcm :: Integral a => [a] -> a
mcm = foldl lcm 1

type Racional a = (a,a)

reducida :: Integral a => [Racional a] -> [Racional a]

reducida xs =

[(x * (m `div` y), m) | (x,y) <- ys]

where ys = map fraccionReducida xs

m = mcm [y | (_,y) <- ys]

-- (fraccionReducida r) es el número racional igual a r con menor

-- denominador positivo. Por ejemplo,

-- fraccionReducida ( 6, 10) == ( 3,5)

-- fraccionReducida (-6, 10) == (-3,5)

-- fraccionReducida ( 6,-10) == (-3,5)

-- fraccionReducida (-6,-10) == ( 3,5)

-- fraccionReducida ( 3, 5) == ( 3,5)

fraccionReducida :: Integral a => (a,a) -> (a,a)

fraccionReducida (x,y) =

(s * x1 `div` m, y1 `div` m)

where s = signum x * signum y

x1 = abs x

y1 = abs y

m = gcd x1 y1

-- (mcm xs) es el mínimo común múltiplo de xs. Por ejemplo,

-- mcm [2,6,10] == 30

mcm :: Integral a => [a] -> a

mcm = foldl lcm 1

Primos hereditarios

PorJosé A. Alonso 16-abril-20151-mayo-2016

Un número primo es hereditario si todos los números obtenidos eliminando dígitos por la derecha o por la izquierda son primos. Por ejemplo, 3797 es hereditario ya que los números obtenidos eliminando dígitos por la derecha son 3797, 379, 37 y 3 y los obtenidos eliminando dígitos por la izquierda son 3797, 797, 97 y 7 y todos ellos son primos.

Definir la sucesión

   hereditarios :: [Integer]

1	hereditarios :: [Integer]

cuyos elementos son los números hereditarios. Por ejemplo,

   ghci> take 15 hereditarios
   [2,3,5,7,23,37,53,73,313,317,373,797,3137,3797,739397]

1 2	ghci> take 15 hereditarios [2,3,5,7,23,37,53,73,313,317,373,797,3137,3797,739397]

Soluciones

import Data.List (inits, tails)
import Data.Char (digitToInt)
import Data.Numbers.Primes (primes, isPrime)

hereditarios :: [Integer]
hereditarios = [n | n <- primes, hereditario n]

hereditario :: Integer -> Bool
hereditario n = 
    all odd (map digitToInt (tail ds)) &&
    all isPrime (map read (tail (inits ds))) &&
    all isPrime (map read (init (tails ds)))
    where ds = show n

import Data.List (inits, tails)

import Data.Char (digitToInt)

import Data.Numbers.Primes (primes, isPrime)

hereditarios :: [Integer]

hereditarios = [n | n <- primes, hereditario n]

hereditario :: Integer -> Bool

hereditario n =

all odd (map digitToInt (tail ds)) &&

all isPrime (map read (tail (inits ds))) &&

all isPrime (map read (init (tails ds)))

where ds = show n

Constante de Champernowne

PorJosé A. Alonso 15-abril-201525-marzo-2022

La constante de Champernowne es el número irracional

   0.12345678910111213141516171819202122232425262728293031323334 ...

1	0.12345678910111213141516171819202122232425262728293031323334 ...

cuya parte entera es 0 y la parte decimal se obtiene concatenado los números naturales a partir de 1.

Definir la función

   productoChampernowne :: [Int] -> Int

1	productoChampernowne :: [Int] -> Int

tal que (productoChampernowne ns) es el producto de los dígitos de la constante de Champernowne que ocupan las posiciones ns. Por ejemplo,

   productoChampernowne [0,1,2]                 ==  6
   productoChampernowne [8,20]                  ==  45
   productoChampernowne [10^i-1 | i <- [0..7]]  ==  1470

productoChampernowne [0,1,2] == 6

productoChampernowne [8,20] == 45

productoChampernowne [10^i-1 | i <- [0..7]] == 1470

Soluciones

import Data.Char (digitToInt)

productoChampernowne :: [Int] -> Int
productoChampernowne ns = product [champernowne !! n | n <- ns] 

-- champernowne  es la sucesión de champernowne. Por ejemplo,
--    ghci> take 20 champernowne
--    [1,2,3,4,5,6,7,8,9,1,0,1,1,1,2,1,3,1,4,1]
champernowne :: [Int] 
champernowne = map digitToInt (concatMap show [1..])

import Data.Char (digitToInt)

productoChampernowne :: [Int] -> Int

productoChampernowne ns = product [champernowne !! n | n <- ns]

-- champernowne es la sucesión de champernowne. Por ejemplo,

-- ghci> take 20 champernowne

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

champernowne :: [Int]

champernowne = map digitToInt (concatMap show [1..])

Pandigitales múltiplos de un número por una lista de números

PorJosé A. Alonso 9-abril-20151-mayo-2015

Un número pandigital es un número que contiene todos los dígitos del 1 al 9 sólo una vez. Por ejemplo, 192384576 es un número pandigital.

El producto de un número natural x por una lista de números naturales ys es el número obtenido concatenando los productos de x por cada uno de los elementos de ys. Por ejemplo, el producto de 2 por [3,2,5] es 6410.

Un número pandigital x es un múltiplo si existe un y y un n > 1 tales que x es el producto de y por [1,2,3,…,n]. Por ejemplo, 192384576 es un pandigital múltiplo ya que

   192 × 1 = 192
   192 × 2 = 384
   192 × 3 = 576

192 × 1 = 192

192 × 2 = 384

192 × 3 = 576

por tanto, 192384576 es el producto de 192 por [1,2,3]. Otro pandgital múltiplo es el 918273645 ya que es el producto de 9 por [1,2,3,4,5].

Definir la sucesión

   pandigitalesMultiplos :: [Integer]

1	pandigitalesMultiplos :: [Integer]

tal que sus elementos son los números pandigitales múltiplos. Por ejemplo,

   ghci> take 5 pandigitalesMultiplos
   [123456789,192384576,219438657,273546819,327654981]

1 2	ghci> take 5 pandigitalesMultiplos [123456789,192384576,219438657,273546819,327654981]

Soluciones

import Data.List (sort)

pandigitalesMultiplos :: [Integer]
pandigitalesMultiplos =
    sort [y | x <- [1..a],
              y <- productosCon9Digitos x,
              esPandigital y]
    where a = head [x | x <- [1..], producto x [1,2] > 987654321]

-- (productosCon9Digitos x) es la lista de los productos de x por una
-- lista [1,2,...,n] (con n > 1) que tienen 9 dígitos, Por ejemplo, 
--    productosCon9Digitos 3  ==  [369121518]
--    productosCon9Digitos 2  ==  []
productosCon9Digitos :: Integer -> [Integer]
productosCon9Digitos x | numeroDeDigitos z == 9 = [z]
                       | otherwise              = []
    where z = head [y | n <- [2..], 
                        let y = producto x [1..n], 
                        numeroDeDigitos y >= 9]

-- (producto x ys) es el producto de x por ys. Por ejemplo,
--    producto 2 [3,2,5]  ==  6410
producto :: Integer -> [Integer] -> Integer
producto x = read . concatMap (show . (x*))

-- (numeroDeDigitos x) es el número de dígitos de x. Por ejemplo,
--    numeroDeDigitos 425  ==  3
numeroDeDigitos :: Integer -> Int
numeroDeDigitos = length . show

-- (esPandigital x) se verifica si x es pandigital. Por ejemplo,
--    esPandigital 192384576   ==  True
--    esPandigital 192314576   ==  False
--    esPandigital 1923145761  ==  False
esPandigital :: Integer -> Bool
esPandigital n = sort (show n) == "123456789"

-- La lista de los pandigitales múltiplos se calcula por
--    ghci> pandigitalesMultiplos
--    [123456789, 192384576, 219438657, 273546819, 327654981, 672913458,
--     679213584, 692713854, 726914538, 729314586, 732914658, 769215384,
--     792315846, 793215864, 918273645, 926718534, 927318546, 932718654]

import Data.List (sort)

pandigitalesMultiplos :: [Integer]

pandigitalesMultiplos =

sort [y | x <- [1..a],

y <- productosCon9Digitos x,

esPandigital y]

where a = head [x | x <- [1..], producto x [1,2] > 987654321]

-- (productosCon9Digitos x) es la lista de los productos de x por una

-- lista [1,2,...,n] (con n > 1) que tienen 9 dígitos, Por ejemplo,

-- productosCon9Digitos 3 == [369121518]

-- productosCon9Digitos 2 == []

productosCon9Digitos :: Integer -> [Integer]

productosCon9Digitos x | numeroDeDigitos z == 9 = [z]

| otherwise = []

where z = head [y | n <- [2..],

let y = producto x [1..n],

numeroDeDigitos y >= 9]

-- (producto x ys) es el producto de x por ys. Por ejemplo,

-- producto 2 [3,2,5] == 6410

producto :: Integer -> [Integer] -> Integer

producto x = read . concatMap (show . (x*))

-- (numeroDeDigitos x) es el número de dígitos de x. Por ejemplo,

-- numeroDeDigitos 425 == 3

numeroDeDigitos :: Integer -> Int

numeroDeDigitos = length . show

-- (esPandigital x) se verifica si x es pandigital. Por ejemplo,

-- esPandigital 192384576 == True

-- esPandigital 192314576 == False

-- esPandigital 1923145761 == False

esPandigital :: Integer -> Bool

esPandigital n = sort (show n) == "123456789"

-- La lista de los pandigitales múltiplos se calcula por

-- ghci> pandigitalesMultiplos

-- [123456789, 192384576, 219438657, 273546819, 327654981, 672913458,

-- 679213584, 692713854, 726914538, 729314586, 732914658, 769215384,

-- 792315846, 793215864, 918273645, 926718534, 927318546, 932718654]

Ramas a las que pertenece un elemento

PorJosé A. Alonso 1-abril-20151-mayo-2015

Representamos los árboles binarios con elementos en las hojas y en los nodos mediante el tipo de dato

   data Arbol a = H a | N a (Arbol a) (Arbol a) deriving Show

1	data Arbol a = H a \| N a (Arbol a) (Arbol a) deriving Show

Por ejemplo,

   ej1 :: Arbol Int
   ej1 = N 5 (N 2 (H 1) (H 2)) (N 3 (H 4) (H 2))

1 2	ej1 :: Arbol Int ej1 = N 5 (N 2 (H 1) (H 2)) (N 3 (H 4) (H 2))

Definir la función

   ramasCon :: Eq a => Arbol a -> a -> [[a]]

1	ramasCon :: Eq a => Arbol a -> a -> [[a]]

tal que (ramasCon a x) es la lista de las ramas del árbol a en las que aparece el elemento x. Por ejemplo,

  ramasCon ej1 2 ==  [[5,2,1],[5,2,2],[5,3,2]]

1	ramasCon ej1 2 == [[5,2,1],[5,2,2],[5,3,2]]

Soluciones

data Arbol a = H a | N a (Arbol a) (Arbol a) deriving Show

ej1 :: Arbol Int
ej1 = N 5 (N 2 (H 1) (H 2)) (N 3 (H 4) (H 2))

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

ramasCon :: Eq a => Arbol a -> a -> [[a]]
ramasCon a x = [ys | ys <- ramas a, x `elem` ys]

ramas :: Arbol a -> [[a]]
ramas (H x)     = [[x]]
ramas (N x i d) = [x:ys | ys <- ramas i ++ ramas d]

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

ramasCon2 :: Eq a => Arbol a -> a -> [[a]]
ramasCon2 a x = filter (x `elem`) (ramas2 a)

ramas2 :: Arbol a -> [[a]]
ramas2 (H x)     = [[x]]
ramas2 (N x i d) = map (x:) (ramas2 i ++ ramas2 d)

data Arbol a = H a | N a (Arbol a) (Arbol a) deriving Show

ej1 :: Arbol Int

ej1 = N 5 (N 2 (H 1) (H 2)) (N 3 (H 4) (H 2))

-- 1ª definición

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

ramasCon :: Eq a => Arbol a -> a -> [[a]]

ramasCon a x = [ys | ys <- ramas a, x `elem` ys]

ramas :: Arbol a -> [[a]]

ramas (H x) = [[x]]

ramas (N x i d) = [x:ys | ys <- ramas i ++ ramas d]

-- 2ª definición

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

ramasCon2 :: Eq a => Arbol a -> a -> [[a]]

ramasCon2 a x = filter (x `elem`) (ramas2 a)

ramas2 :: Arbol a -> [[a]]

ramas2 (H x) = [[x]]

ramas2 (N x i d) = map (x:) (ramas2 i ++ ramas2 d)

Agrupamiento de consecutivos iguales

PorJosé A. Alonso 30-marzo-20151-mayo-2016

Definir las funciones

   agrupa  :: Eq a => [a] -> [(a,Int)]
   expande :: [(a,Int)] -> [a]

1 2	agrupa :: Eq a => [a] -> [(a,Int)] expande :: [(a,Int)] -> [a]

tales que

(agrupa xs) es la lista obtenida agrupando las ocurrencias consecutivas de elementos de xs junto con el número de dichas ocurrencias. Por ejemplo:

     agrupa "aaabzzaa" == [('a',3),('b',1),('z',2),('a',2)]

1	agrupa "aaabzzaa" == [('a',3),('b',1),('z',2),('a',2)]

(expande xs) es la lista expandida correspondiente a ps (es decir, es la lista xs tal que la comprimida de xs es ps. Por ejemplo,

     expande [('a',2),('b',3),('a',1)] == "aabbba"

1	expande [('a',2),('b',3),('a',1)] == "aabbba"

Comprobar con QuickCheck que dada una lista de enteros, si se la agrupa y después se expande se obtiene la lista inicial.

Soluciones

import Data.List (group)
import Test.QuickCheck

-- Definiciones de agrupa
-- ======================

-- 1ª definición (por recursión)
agrupa :: Eq a => [a] -> [(a,Int)]
agrupa xs = aux xs 1
    where aux (x:y:zs) n | x == y    = aux (y:zs) (n+1)
                         | otherwise = (x,n) : aux (y:zs) 1
          aux [x]      n             = [(x,n)]
          aux []       _             = []

-- 2ª definición (por recursión usando takeWhile):
agrupa2 :: Eq a => [a] -> [(a,Int)]
agrupa2 [] = []
agrupa2 (x:xs) = 
    (x,1 + length (takeWhile (==x) xs)) : agrupa2 (dropWhile (==x) xs)

-- 3ª definición (por comprensión usando group):
agrupa3 :: Eq a => [a] -> [(a,Int)]
agrupa3 xs = [(head ys,length ys) | ys <- group xs]

-- 4ª definición (usando map y group):
agrupa4 :: Eq a => [a] -> [(a,Int)]
agrupa4 = map (\xs -> (head xs, length xs)) . group

-- Definiciones de expande
-- =======================

-- 1ª definición (por comprensión)
expande :: [(a,Int)] -> [a]
expande ps = concat [replicate k x | (x,k) <- ps]

-- 2ª definición (por concatMap)
expande2 :: [(a,Int)] -> [a]
expande2 = concatMap (\(x,k) -> replicate k x) 

-- 3ª definición (por recursión)
expande3 :: [(a,Int)] -> [a]
expande3 [] = []
expande3 ((x,n):ps) = replicate n x ++ expande3 ps

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

-- La propiedad es
prop_expande_agrupa :: [Int] -> Bool 
prop_expande_agrupa xs = expande (agrupa xs) == xs

-- La comprobación es
--    ghci> quickCheck prop_expande_agrupa
--    +++ OK, passed 100 tests.

import Data.List (group)

import Test.QuickCheck

-- Definiciones de agrupa

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

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

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

agrupa xs = aux xs 1

where aux (x:y:zs) n | x == y = aux (y:zs) (n+1)

| otherwise = (x,n) : aux (y:zs) 1

aux [x] n = [(x,n)]

aux [] _ = []

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

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

agrupa2 [] = []

agrupa2 (x:xs) =

(x,1 + length (takeWhile (==x) xs)) : agrupa2 (dropWhile (==x) xs)

-- 3ª definición (por comprensión usando group):

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

agrupa3 xs = [(head ys,length ys) | ys <- group xs]

-- 4ª definición (usando map y group):

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

agrupa4 = map (\xs -> (head xs, length xs)) . group

-- Definiciones de expande

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

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

expande :: [(a,Int)] -> [a]

expande ps = concat [replicate k x | (x,k) <- ps]

-- 2ª definición (por concatMap)

expande2 :: [(a,Int)] -> [a]

expande2 = concatMap (\(x,k) -> replicate k x)

-- 3ª definición (por recursión)

expande3 :: [(a,Int)] -> [a]

expande3 [] = []

expande3 ((x,n):ps) = replicate n x ++ expande3 ps

-- Comprobación

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

-- La propiedad es

prop_expande_agrupa :: [Int] -> Bool

prop_expande_agrupa xs = expande (agrupa xs) == xs

-- La comprobación es

-- ghci> quickCheck prop_expande_agrupa

-- +++ OK, passed 100 tests.

Agrupamiento según valores

Soluciones

Colinealidad de una lista de puntos

Soluciones

Distancia invierte y suma hasta capicúa

Soluciones

Caminos reducidos

Soluciones

Con mínimo común denominador

Soluciones

Primos hereditarios

Soluciones

Constante de Champernowne

Soluciones

Pandigitales múltiplos de un número por una lista de números

Soluciones

Ramas a las que pertenece un elemento

Soluciones

Entradas recientes

Buscar

Correo electrónico