José A. Alonso

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

Casas con números equilibrados

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

Continuando con los problema propuestos por alumnos, el de hoy es el propuesto por Rafael Jiménez.

Se tiene una calle en la que las casas sólo están en un lado de ésta y las casas están numeradas de 1 hasta n, donde n es el número total de casas en la calle. Se dice que el número de una casa es equilibrado si y solamente si la suma de los números de las casas anteriores es igual a la suma de los números posteriores a la casa. Por ejemplo, el número de la 6ª casa, en una calle con 8 casas, es equilibrado ya que

   1 + 2 + 3 + 4 + 5 = 7 + 8

1	1 + 2 + 3 + 4 + 5 = 7 + 8

Definir la función

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

1	soluciones :: Integer -> Integer -> [(Integer,Integer)]

tal que (soluciones x y) es la lista de pares (a,n) tales que a es el número equilibrado de una casa en una calle con n casas y n está entre x e y. Por ejemplo,

   soluciones 1 500          ==  [(1,1),(6,8),(35,49),(204,288)]
   soluciones 1000 3000      ==  [(1189,1681)]
   soluciones (10^5) (10^6)  ==  [(235416,332928)]
   soluciones (10^6) (10^7)  ==  [(1372105,1940449)]
   (fst $ head $ soluciones (10^100) (10^101))  `mod` (10^9)  ==  763728460
   (fst $ head $ soluciones (10^800) (10^1000)) `mod` (10^9)  ==  311156546

soluciones 1 500 == [(1,1),(6,8),(35,49),(204,288)]

soluciones 1000 3000 == [(1189,1681)]

soluciones (10^5) (10^6) == [(235416,332928)]

soluciones (10^6) (10^7) == [(1372105,1940449)]

(fst $ head $ soluciones (10^100) (10^101)) `mod` (10^9) == 763728460

(fst $ head $ soluciones (10^800) (10^1000)) `mod` (10^9) == 311156546

Soluciones

import Test.QuickCheck

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

soluciones1 :: Integer -> Integer -> [(Integer,Integer)]
soluciones1 x y =
    [(n,n+m) | n <- [x..y], m <- [0..y-n], 
               sum [1..n-1] == sum [n+1..n+m]]
               
-- 2ª solución
-- ===========

soluciones2 :: Integer -> Integer -> [(Integer,Integer)]
soluciones2 x y =
    [(n,n+m) | n <- [x..y], m <- [0..y-n], 
               esSolucion (n,n+m)]

esSolucion :: (Integer,Integer) -> Bool
esSolucion (n,m) = suma (n-1) == suma m - suma n
    where suma n = n*(n+1) `div` 2
    
-- 3ª solución
-- ===========

-- Con las definiciones anteriores se pueden calcular los cuatro
-- primeros números de las casas equilibradas:
--    ghci> map fst (soluciones2 1 500)
--    [1,6,35,204]
-- Conjeturando que el n-ésimo número p(n) se calcula mediante una
-- recurrencia del tipo p(n) = x*p(n-1) + y*p(n-2) se tiene   
--    p(1) =   1
--    p(2) =   6
--    p(3) =  35 =  6x +  y
--    p(4) = 204 = 35x + 6y
-- al resolverlo se obtiene x = 6 e y = -1. Por tanto,
--    p(1) = 1
--    p(2) = 6
--    p(n) = 6*p(n-1) - p(n-2)
--
-- Haciendo lo mismo con las segundas componentes, 
--    ghci> map snd (soluciones2 1 2000)
--    [1,8,49,288,1681]
-- Conjeturando que el n-ésimo número s(n) se calcula mediante una
-- recurrencia del tipo s(n) = x*s(n-1) + y*s(n-2) + z se tiene   
--    s(1) =    1
--    s(2) =    8
--    s(3) =   49 =   8x +   y + z
--    s(4) =  288 =  49x +  8y + z
--    s(5) = 1681 = 288x + 49y + z 
-- al resolverlo se obtiene x = 6, y = -1, z = 2. Por tanto,
--    s(1) = 1
--    s(2) = 8
--    s(n) = 6*s(n-1) - s(n-2) + 2

-- El número de la n-ésimo casa equilibrada, p(n), se puede calcular por
-- recursión: 
casa :: Integer -> Integer
casa 1 = 1
casa 2 = 6
casa n = 6 * (casa (n-1)) - (casa (n-2))

-- La sucesión de los números de las casas equilibradas se puede
-- calcular por programación dinámica:
casas :: [Integer]
casas = 
    1 : 6 : zipWith (\x y -> 6*x-y) (tail casas) casas

-- El número de casas en la n-ésima calle con casas equilibradas, s(n),
-- se puede calcular por recursión: 
calle :: Integer -> Integer
calle 1 = 1
calle 2 = 8
calle n = 6 * (calle (n-1)) - (calle (n-2)) + 2

-- La sucesión de los números de las casas equilibradas se puede
-- calcular por programación dinámica:
calles :: [Integer]
calles = 
    1 : 8 : zipWith (\x y -> 6*x-y+2) (tail calles) calles

-- Usando casas se obtiene la 3ª solución:
soluciones3 :: Integer -> Integer -> [(Integer,Integer)]
soluciones3 x y =
   takeWhile (<=(y,y)) (dropWhile (<(x,x)) (zip casas calles))

-- Comprobación de soluciones
-- ==========================

-- La propiedad es
prop_soluciones :: Integer -> Integer -> Property
prop_soluciones x y =
    0 < x && x <= y ==>
    all esSolucion (soluciones3 x y)

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

-- Comparación de eficiencia:
--    ghci> soluciones1 1 2000
--    [(1,1),(6,8),(35,49),(204,288),(1189,1681)]
--    (337.30 secs, 396493594456 bytes)
--    ghci> soluciones2 1 2000
--    [(1,1),(6,8),(35,49),(204,288),(1189,1681)]
--    (23.47 secs, 3859436176 bytes)
--    ghci> soluciones3 1 2000
--    [(1,1),(6,8),(35,49),(204,288),(1189,1681)]
--    (0.01 secs, 1029592 bytes)

100

101

102

103

104

105

106

107

108

109

import Test.QuickCheck

-- 1ª solución

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

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

soluciones1 x y =

[(n,n+m) | n <- [x..y], m <- [0..y-n],

sum [1..n-1] == sum [n+1..n+m]]

-- 2ª solución

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

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

soluciones2 x y =

[(n,n+m) | n <- [x..y], m <- [0..y-n],

esSolucion (n,n+m)]

esSolucion :: (Integer,Integer) -> Bool

esSolucion (n,m) = suma (n-1) == suma m - suma n

where suma n = n*(n+1) `div` 2

-- 3ª solución

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

-- Con las definiciones anteriores se pueden calcular los cuatro

-- primeros números de las casas equilibradas:

-- ghci> map fst (soluciones2 1 500)

-- [1,6,35,204]

-- Conjeturando que el n-ésimo número p(n) se calcula mediante una

-- recurrencia del tipo p(n) = x*p(n-1) + y*p(n-2) se tiene

-- p(1) = 1

-- p(2) = 6

-- p(3) = 35 = 6x + y

-- p(4) = 204 = 35x + 6y

-- al resolverlo se obtiene x = 6 e y = -1. Por tanto,

-- p(1) = 1

-- p(2) = 6

-- p(n) = 6*p(n-1) - p(n-2)

-- Haciendo lo mismo con las segundas componentes,

-- ghci> map snd (soluciones2 1 2000)

-- [1,8,49,288,1681]

-- Conjeturando que el n-ésimo número s(n) se calcula mediante una

-- recurrencia del tipo s(n) = x*s(n-1) + y*s(n-2) + z se tiene

-- s(1) = 1

-- s(2) = 8

-- s(3) = 49 = 8x + y + z

-- s(4) = 288 = 49x + 8y + z

-- s(5) = 1681 = 288x + 49y + z

-- al resolverlo se obtiene x = 6, y = -1, z = 2. Por tanto,

-- s(1) = 1

-- s(2) = 8

-- s(n) = 6*s(n-1) - s(n-2) + 2

-- El número de la n-ésimo casa equilibrada, p(n), se puede calcular por

-- recursión:

casa :: Integer -> Integer

casa 1 = 1

casa 2 = 6

casa n = 6 * (casa (n-1)) - (casa (n-2))

-- La sucesión de los números de las casas equilibradas se puede

-- calcular por programación dinámica:

casas :: [Integer]

casas =

1 : 6 : zipWith (\x y -> 6*x-y) (tail casas) casas

-- El número de casas en la n-ésima calle con casas equilibradas, s(n),

-- se puede calcular por recursión:

calle :: Integer -> Integer

calle 1 = 1

calle 2 = 8

calle n = 6 * (calle (n-1)) - (calle (n-2)) + 2

-- La sucesión de los números de las casas equilibradas se puede

-- calcular por programación dinámica:

calles :: [Integer]

calles =

1 : 8 : zipWith (\x y -> 6*x-y+2) (tail calles) calles

-- Usando casas se obtiene la 3ª solución:

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

soluciones3 x y =

takeWhile (<=(y,y)) (dropWhile (<(x,x)) (zip casas calles))

-- Comprobación de soluciones

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

-- La propiedad es

prop_soluciones :: Integer -> Integer -> Property

prop_soluciones x y =

0 < x && x <= y ==>

all esSolucion (soluciones3 x y)

-- La comprobación es

-- ghci> quickCheck prop_soluciones

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia:

-- ghci> soluciones1 1 2000

-- [(1,1),(6,8),(35,49),(204,288),(1189,1681)]

-- (337.30 secs, 396493594456 bytes)

-- ghci> soluciones2 1 2000

-- [(1,1),(6,8),(35,49),(204,288),(1189,1681)]

-- (23.47 secs, 3859436176 bytes)

-- ghci> soluciones3 1 2000

-- [(1,1),(6,8),(35,49),(204,288),(1189,1681)]

-- (0.01 secs, 1029592 bytes)

Las torres de Hanói

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

En la clase de la semana pasada comenté la posibilidad de que los alumnos me enviaran propuestas de ejercicios para publicarlos en Exercitium. La primera que he recibido es la de Javier Linares sobre el problema de las torres de Hanoi que constituye el ejercicio de hoy.

Las torres de Hanoi es un rompecabeza que consta de tres postes que llamaremos A, B y C. Hay N discos de distintos tamaños en el poste A, de forma que no hay un disco situado sobre otro de menor tamaño. Los postes B y C están vacíos. Sólo puede moverse un disco a la vez y todos los discos deben de estar ensartados en algún poste. Ningún disco puede situarse sobre otro de menor tamaño. El problema consiste en colocar los N discos en el poste C.

Definir la función

   hanoi :: Int -> [String]

1	hanoi :: Int -> [String]

tal que (hanoi n) es la lista de los movimientos para resolver el problema de las torres de hanoi con n discos. Por ejemplo,

   ghci> hanoi 1
   ["Mueve el disco 1 de A a C"]
   ghci> hanoi 2
   ["Mueve el disco 1 de A a B","Mueve el disco 2 de A a C","Mueve el disco 1 de B a C"]
   ghci> mapM_ putStrLn (hanoi 2)
   Mueve el disco 1 de A a B
   Mueve el disco 2 de A a C
   Mueve el disco 1 de B a C
   ghci> mapM_ putStrLn (hanoi 3)
   Mueve el disco 1 de A a C
   Mueve el disco 2 de A a B
   Mueve el disco 1 de C a B
   Mueve el disco 3 de A a C
   Mueve el disco 1 de B a A
   Mueve el disco 2 de B a C
   Mueve el disco 1 de A a C

ghci> hanoi 1

["Mueve el disco 1 de A a C"]

ghci> hanoi 2

["Mueve el disco 1 de A a B","Mueve el disco 2 de A a C","Mueve el disco 1 de B a C"]

ghci> mapM_ putStrLn (hanoi 2)

Mueve el disco 1 de A a B

Mueve el disco 2 de A a C

Mueve el disco 1 de B a C

ghci> mapM_ putStrLn (hanoi 3)

Mueve el disco 1 de A a C

Mueve el disco 2 de A a B

Mueve el disco 1 de C a B

Mueve el disco 3 de A a C

Mueve el disco 1 de B a A

Mueve el disco 2 de B a C

Mueve el disco 1 de A a C

Soluciones

hanoi :: Int -> [String]
hanoi n = aux n "A" "B" "C" where  
    aux n a b c
        | n == 1 = ["Mueve el disco 1 de " ++ a ++ " a " ++ c]
        | otherwise = 
            aux (n-1) a c b ++ 
            ["Mueve el disco "++ show n ++ " de " ++ a ++ " a " ++ c] ++
            aux (n-1) b a c

hanoi :: Int -> [String]

hanoi n = aux n "A" "B" "C" where

aux n a b c

| n == 1 = ["Mueve el disco 1 de " ++ a ++ " a " ++ c]

| otherwise =

aux (n-1) a c b ++

["Mueve el disco "++ show n ++ " de " ++ a ++ " a " ++ c] ++

aux (n-1) b a c

Autor: José A. Alonso

Con mínimo común denominador

Soluciones

Primos hereditarios

Soluciones

Constante de Champernowne

Soluciones

Casas con números equilibrados

Soluciones

Las torres de Hanói

Soluciones

Entradas recientes

Buscar

Correo electrónico