Avanzado – Página 6

Caminos en un grafo

PorJosé A. Alonso 2-junio-201526-marzo-2022

Definir las funciones

   grafo   :: [(Int,Int)] -> Grafo Int Int
   caminos :: Grafo Int Int -> Int -> Int -> [[Int]]

1 2	grafo :: [(Int,Int)] -> Grafo Int Int caminos :: Grafo Int Int -> Int -> Int -> [[Int]]

tales que

(grafo as) es el grafo no dirigido definido cuyas aristas son as. Por ejemplo,

     ghci> grafo [(2,4),(4,5)]
     G ND (array (2,5) [(2,[(4,0)]),(3,[]),(4,[(2,0),(5,0)]),(5,[(4,0)])])

1 2	ghci> grafo [(2,4),(4,5)] G ND (array (2,5) [(2,[(4,0)]),(3,[]),(4,[(2,0),(5,0)]),(5,[(4,0)])])

(caminos g a b) es la lista los caminos en el grafo g desde a hasta b sin pasar dos veces por el mismo nodo. Por ejemplo,

     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 7)
     [[1,3,5,7],[1,3,7]]
     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 2 7)
     [[2,5,3,7],[2,5,7]]
     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 2)
     [[1,3,5,2],[1,3,7,5,2]]
     ghci> caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 4
     []
     ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
     109601

ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 7)

[[1,3,5,7],[1,3,7]]

ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 2 7)

[[2,5,3,7],[2,5,7]]

ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 2)

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

ghci> caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 4

[]

ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)

109601

Nota: Este ejercicio debe realizarse usando únicamente las funciones de la librería de grafos (I1M.Grafo) que se describe aquí y se encuentra aquí.

Soluciones

import Data.List (sort)
import I1M.Grafo
import I1M.BusquedaEnEspaciosDeEstados

grafo :: [(Int,Int)] -> Grafo Int Int
grafo as = creaGrafo ND (m,n) [(x,y,0) | (x,y) <- as]
    where ns = map fst as ++ map snd as
          m  = minimum ns
          n  = maximum ns

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

caminos :: Grafo Int Int -> Int -> Int -> [[Int]]
caminos g a b = aux [[b]] where 
    aux [] = []
    aux ((x:xs):yss)
        | x == a    = (x:xs) : aux yss
        | otherwise = aux ([z:x:xs | z <- adyacentes g x
                                   , z `notElem` (x:xs)] 
                           ++ yss) 

-- 2ª solución (mediante espacio de estados)
-- =========================================

caminos2 :: Grafo Int Int -> Int -> Int -> [[Int]]
caminos2 g a b = buscaEE sucesores esFinal inicial
    where inicial          = [b]
          sucesores (x:xs) = [z:x:xs | z <- adyacentes g x
                                     , z `notElem` (x:xs)] 
          esFinal (x:xs)   = x == a

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

--    ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
--    109601
--    (3.57 secs, 500533816 bytes)
--    ghci> length (caminos2 (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
--    109601
--    (3.53 secs, 470814096 bytes)

import Data.List (sort)

import I1M.Grafo

import I1M.BusquedaEnEspaciosDeEstados

grafo :: [(Int,Int)] -> Grafo Int Int

grafo as = creaGrafo ND (m,n) [(x,y,0) | (x,y) <- as]

where ns = map fst as ++ map snd as

m = minimum ns

n = maximum ns

-- 1ª solución

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

caminos :: Grafo Int Int -> Int -> Int -> [[Int]]

caminos g a b = aux [[b]] where

aux [] = []

aux ((x:xs):yss)

| x == a = (x:xs) : aux yss

| otherwise = aux ([z:x:xs | z <- adyacentes g x

, z `notElem` (x:xs)]

++ yss)

-- 2ª solución (mediante espacio de estados)

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

caminos2 :: Grafo Int Int -> Int -> Int -> [[Int]]

caminos2 g a b = buscaEE sucesores esFinal inicial

where inicial = [b]

sucesores (x:xs) = [z:x:xs | z <- adyacentes g x

, z `notElem` (x:xs)]

esFinal (x:xs) = x == a

-- Comparación de eficiencia

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

-- ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)

-- 109601

-- (3.57 secs, 500533816 bytes)

-- ghci> length (caminos2 (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)

-- 109601

-- (3.53 secs, 470814096 bytes)

Problema de las bolas de Dijkstra

PorJosé A. Alonso 1-junio-201513-junio-2015

En el juego de las bolas de Dijkstra se dispone de una bolsa con bolas blancas y negras. El juego consiste en elegir al azar dos bolas de la bolsa y añadir una bola negra si las dos bolas elegidas son del mismo color o una bola blanca en caso contrario. El juego termina cuando queda sólo una bola en la bolsa.

Vamos a representar las bolas blancas por 0, las negras por 1 y la bolsa la representaremos por una lista cuyos elementos son 0 ó 1.

Definir las funciones

   juego  :: [Int] -> [[Int]]
   ultima :: [Int] -> Int

1 2	juego :: [Int] -> [[Int]] ultima :: [Int] -> Int

tales que

(juego xs) es la lista de los pasos aleatorios de un juego de Dijkstra a partir de la lista xs. Por ejemplo,

     juego [1,1,0,0,1]  ==  [[1,1,0,0,1],[1,1,0,0],[1,1,1],[1,1],[1]]
     juego [1,1,0,0,1]  ==  [[1,1,0,0,1],[0,1,1,0],[0,0,1],[1,1],[1]]
     juego [1,0,0,0,1]  ==  [[1,0,0,0,1],[0,0,0,1],[0,1,1],[1,0],[0]]
     juego [1,0,1,1,1]  ==  [[1,0,1,1,1],[1,1,0,1],[1,0,1],[0,1],[0]]

juego [1,1,0,0,1] == [[1,1,0,0,1],[1,1,0,0],[1,1,1],[1,1],[1]]

juego [1,1,0,0,1] == [[1,1,0,0,1],[0,1,1,0],[0,0,1],[1,1],[1]]

juego [1,0,0,0,1] == [[1,0,0,0,1],[0,0,0,1],[0,1,1],[1,0],[0]]

juego [1,0,1,1,1] == [[1,0,1,1,1],[1,1,0,1],[1,0,1],[0,1],[0]]

(ultima xs) es la bola que queda en la bolsa al final del juego de Dijkstra a partir de xs. Por ejemplo,

     ultima [1,1,0,0,1]  ==  1
     ultima [1,0,0,0,1]  ==  0
     ultima [1,0,1,1,1]  ==  0

ultima [1,1,0,0,1] == 1

ultima [1,0,0,0,1] == 0

ultima [1,0,1,1,1] == 0

Comprobar con QuickCheck que la bola que queda en la bolsa al final del juego de Dijkstra es blanca si, y sólo si, el número de bolas blancas en la bolsa inicial es impar.

Soluciones

import System.IO.Unsafe
import System.Random
import Test.QuickCheck

-- (aleatorio a b) es un número aleatorio entre a y b. Por ejemplo, 
--    ghci> aleatorio 0 1000
--    681
--    ghci> aleatorio 0 1000
--    66
aleatorio :: Random t => t -> t -> t
aleatorio a b = unsafePerformIO $ 
                getStdRandom (randomR (a,b))

-- (aleatorios m n) es una lista infinita de números aleatorios entre m y
-- n. Por ejemplo, 
--    ghci> take 20 (aleatorios 2 9)
--    [6,5,3,9,6,3,6,6,2,7,9,6,8,6,2,4,2,6,9,4]
--    ghci> take 20 (aleatorios 2 9)
--    [3,7,7,5,7,7,5,8,6,4,7,2,8,8,2,8,7,6,5,5]
aleatorios :: Random t => t -> t -> [t]
aleatorios m n = aleatorio m n : aleatorios m n

-- (selecciona n x) es el par formado por el n-ésimo elemento de xs y
-- los restantes elementos. Por ejemplo,
--    selecciona 0 "abc"  ==  ('a',"bc")
--    selecciona 1 "abc"  ==  ('b',"ac")
--    selecciona 2 "abc"  ==  ('c',"ab")
selecciona :: Int -> [a] -> (a,[a])
selecciona n xs = (z,ys++zs)
    where (ys,z:zs) = splitAt n xs

-- (extraeAleatorio xs) es el par formado aleatoriamente por un elemento
-- de xs y las restantes. Por ejemplo, 
--    extraeAleatorio [1,0,0,1,1]  ==  (0,[1,0,1,1])
--    extraeAleatorio [1,0,0,1,1]  ==  (1,[0,0,1,1])
--    extraeAleatorio [1,0,0,1,1]  ==  (0,[1,0,1,1])
--    extraeAleatorio [1,0,0,1,1]  ==  (1,[1,0,0,1])
extraeAleatorio :: [a] -> (a,[a])
extraeAleatorio xs = selecciona n xs
    where n = aleatorio 0 (length xs - 1)

-- (inserta n x xs) inserta, en la posición n, el elemento x en la lista
-- xs. Por ejemplo,  
--    inserta 0 'a' "bcd"  ==  "abcd"
--    inserta 1 'a' "bcd"  ==  "bacd"
--    inserta 2 'a' "bcd"  ==  "bcad"
--    inserta 3 'a' "bcd"  ==  "bcda"
inserta :: Int -> a -> [a] -> [a]
inserta n x xs = us ++ (x:vs)
    where (us,vs) = splitAt n xs

-- (insertaAleatorio x xs) inserta aleatoriamente el elemento x en la
-- lista xs. Por ejemplo,
--    insertaAleatorio 9 [0..8]  ==  [0,1,2,3,4,9,5,6,7,8]
--    insertaAleatorio 9 [0..8]  ==  [0,1,9,2,3,4,5,6,7,8]
--    insertaAleatorio 9 [0..8]  ==  [0,1,2,3,4,5,6,9,7,8]
insertaAleatorio :: a -> [a] -> [a]
insertaAleatorio x xs = inserta n x xs
    where n = aleatorio 0 (length xs - 1)

-- (paso xs) elige aleatoriamente dos bolas de xs e inserta
-- aleatoriamente una bola negra si las dos extraídas son del mismo
-- color o una blanca, en caso contrario. Por ejemplo, 
--    paso [1,0,1,1,0,0,1,1,1,0,0,0]  ==  [0,1,1,0,0,1,1,0,1,0,0]
--    paso [1,0,1,1,0,0,1,1,1,0,0,0]  ==  [1,0,0,0,1,1,1,0,0,1,0]
paso :: [Int] -> [Int]
paso [x] = []
paso xs | x == y    = insertaAleatorio 1 zs
        | otherwise = insertaAleatorio 0 zs 
    where (x,ys) = extraeAleatorio xs
          (y,zs) = extraeAleatorio ys

-- (juego xs) es la lista de los pasos aleatorios de un juego a partir
-- de la lista xs. Por ejemplo,
--    juego [1,1,0,0,1]  ==  [[1,1,0,0,1],[1,1,0,0],[1,1,1],[1,1],[1]]
--    juego [1,1,0,0,1]  ==  [[1,1,0,0,1],[0,1,1,0],[0,0,1],[1,1],[1]]
--    juego [1,1,0,0,0]  ==  [[1,1,0,0,0],[0,1,0,0],[1,1,0],[0,1],[0]]
juego :: [Int] -> [[Int]]
juego xs = takeWhile (not . null) (iterate paso xs)

-- (ultima xs) es la bola que queda en la bolsa al final del juego de
-- Dijkstra. Por ejemplo, 
--    ultima [1,0,0,1]  ==  1
ultima :: [Int] -> Int
ultima = head . last . juego

-- (numeroDeCeros xs) es el número de ceros en xs. Por ejemplo,
--    numeroDeCeros [1,0,0,1,0]  ==  3
numeroDeCeros :: [Int] -> Int
numeroDeCeros xs = length (filter (==0) xs)

-- Propiedad. La bola que queda en la bolsa al final del juego de
-- Dijkstra es blanca si, y sólo si, el número de bolas blancas en la
-- bolsa inicial es impar. 
prop_Dijkstra :: [Int] -> Property
prop_Dijkstra xs = 
    not (null xs) ==> (ultima ys == 0) == odd (numeroDeCeros ys)
    where ys = [x `mod` 2 | x <- xs]

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

100

101

102

import System.IO.Unsafe

import System.Random

import Test.QuickCheck

-- (aleatorio a b) es un número aleatorio entre a y b. Por ejemplo,

-- ghci> aleatorio 0 1000

-- 681

-- ghci> aleatorio 0 1000

-- 66

aleatorio :: Random t => t -> t -> t

aleatorio a b = unsafePerformIO $

getStdRandom (randomR (a,b))

-- (aleatorios m n) es una lista infinita de números aleatorios entre m y

-- n. Por ejemplo,

-- ghci> take 20 (aleatorios 2 9)

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

-- ghci> take 20 (aleatorios 2 9)

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

aleatorios :: Random t => t -> t -> [t]

aleatorios m n = aleatorio m n : aleatorios m n

-- (selecciona n x) es el par formado por el n-ésimo elemento de xs y

-- los restantes elementos. Por ejemplo,

-- selecciona 0 "abc" == ('a',"bc")

-- selecciona 1 "abc" == ('b',"ac")

-- selecciona 2 "abc" == ('c',"ab")

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

selecciona n xs = (z,ys++zs)

where (ys,z:zs) = splitAt n xs

-- (extraeAleatorio xs) es el par formado aleatoriamente por un elemento

-- de xs y las restantes. Por ejemplo,

-- extraeAleatorio [1,0,0,1,1] == (0,[1,0,1,1])

-- extraeAleatorio [1,0,0,1,1] == (1,[0,0,1,1])

-- extraeAleatorio [1,0,0,1,1] == (0,[1,0,1,1])

-- extraeAleatorio [1,0,0,1,1] == (1,[1,0,0,1])

extraeAleatorio :: [a] -> (a,[a])

extraeAleatorio xs = selecciona n xs

where n = aleatorio 0 (length xs - 1)

-- (inserta n x xs) inserta, en la posición n, el elemento x en la lista

-- xs. Por ejemplo,

-- inserta 0 'a' "bcd" == "abcd"

-- inserta 1 'a' "bcd" == "bacd"

-- inserta 2 'a' "bcd" == "bcad"

-- inserta 3 'a' "bcd" == "bcda"

inserta :: Int -> a -> [a] -> [a]

inserta n x xs = us ++ (x:vs)

where (us,vs) = splitAt n xs

-- (insertaAleatorio x xs) inserta aleatoriamente el elemento x en la

-- lista xs. Por ejemplo,

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

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

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

insertaAleatorio :: a -> [a] -> [a]

insertaAleatorio x xs = inserta n x xs

where n = aleatorio 0 (length xs - 1)

-- (paso xs) elige aleatoriamente dos bolas de xs e inserta

-- aleatoriamente una bola negra si las dos extraídas son del mismo

-- color o una blanca, en caso contrario. Por ejemplo,

-- paso [1,0,1,1,0,0,1,1,1,0,0,0] == [0,1,1,0,0,1,1,0,1,0,0]

-- paso [1,0,1,1,0,0,1,1,1,0,0,0] == [1,0,0,0,1,1,1,0,0,1,0]

paso :: [Int] -> [Int]

paso [x] = []

paso xs | x == y = insertaAleatorio 1 zs

| otherwise = insertaAleatorio 0 zs

where (x,ys) = extraeAleatorio xs

(y,zs) = extraeAleatorio ys

-- (juego xs) es la lista de los pasos aleatorios de un juego a partir

-- de la lista xs. Por ejemplo,

-- juego [1,1,0,0,1] == [[1,1,0,0,1],[1,1,0,0],[1,1,1],[1,1],[1]]

-- juego [1,1,0,0,1] == [[1,1,0,0,1],[0,1,1,0],[0,0,1],[1,1],[1]]

-- juego [1,1,0,0,0] == [[1,1,0,0,0],[0,1,0,0],[1,1,0],[0,1],[0]]

juego :: [Int] -> [[Int]]

juego xs = takeWhile (not . null) (iterate paso xs)

-- (ultima xs) es la bola que queda en la bolsa al final del juego de

-- Dijkstra. Por ejemplo,

-- ultima [1,0,0,1] == 1

ultima :: [Int] -> Int

ultima = head . last . juego

-- (numeroDeCeros xs) es el número de ceros en xs. Por ejemplo,

-- numeroDeCeros [1,0,0,1,0] == 3

numeroDeCeros :: [Int] -> Int

numeroDeCeros xs = length (filter (==0) xs)

-- Propiedad. La bola que queda en la bolsa al final del juego de

-- Dijkstra es blanca si, y sólo si, el número de bolas blancas en la

-- bolsa inicial es impar.

prop_Dijkstra :: [Int] -> Property

prop_Dijkstra xs =

not (null xs) ==> (ultima ys == 0) == odd (numeroDeCeros ys)

where ys = [x `mod` 2 | x <- xs]

-- La comprobación es

-- ghci> quickCheck prop_Dijkstra

-- +++ OK, passed 100 tests.

Reparto de escaños por la ley d’Hont

PorJosé A. Alonso 26-mayo-201525-abril-2021

El sistema D’Hondt es una fórmula electoral, creada por Victor d’Hondt, que permite obtener el número de cargos electos asignados a las candidaturas, en proporción a los votos conseguidos.

Tras el recuento de los votos, se calcula una serie de divisores para cada partido. La fórmula de los divisores es V/N, donde V representa el número total de votos recibidos por el partido, y N representa cada uno de los números enteros desde 1 hasta el número de cargos electos de la circunscripción objeto de escrutinio. Una vez realizadas las divisiones de los votos de cada partido por cada uno de los divisores desde 1 hasta N, la asignación de cargos electos se hace ordenando los cocientes de las divisiones de mayor a menor y asignando a cada uno un escaño hasta que éstos se agoten

Definir la función

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

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

tal que (reparto n vs) es la lista de los pares formados por los números de los partidos y el número de escaño que les corresponden al repartir n escaños en función de la lista de sus votos. Por ejemplo,

   ghci> reparto 7 [340000,280000,160000,60000,15000]
   [(1,3),(2,3),(3,1)]
   ghci> reparto 21 [391000,311000,184000,73000,27000,12000,2000]
   [(1,9),(2,7),(3,4),(4,1)]

ghci> reparto 7 [340000,280000,160000,60000,15000]

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

ghci> reparto 21 [391000,311000,184000,73000,27000,12000,2000]

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

es decir, en el primer ejemplo,

al 1º partido (que obtuvo 340000 votos) le corresponden 3 escaños,
al 2º partido (que obtuvo 280000 votos) le corresponden 3 escaños,
al 3º partido (que obtuvo 160000 votos) le corresponden 1 escaño.

Soluciones

import Data.List (sort, group)

-- Para los ejemplos que siguen, se usará la siguiente ditribución de
-- votos entre 5 partidos.
ejVotos :: [Int]
ejVotos = [340000,280000,160000,60000,15000]

ejVotos2 :: [Int]
ejVotos2 = [391000,311000,184000,73000,27000,12000,2000]

-- ghci> reparto 21 ejVotos2
-- [(1,9),(2,7),(3,4),(4,1)]

ejVotos3 :: [Int]
ejVotos3 = [221,195,40,6,4]

-- (votosPartidos vs) es la lista con los pares formados por los votos y
-- el número de cada partido. Por ejemplo, 
--    ghci> votosPartidos ejVotos
--    [(340000,1),(280000,2),(160000,3),(60000,4),(15000,5)]
votosPartidos :: [Int] -> [(Int,Int)]
votosPartidos vs = zip vs [1..]

-- (restos n (x,i)) es la lista obtenidas dividiendo n entre 1, 2,..., n.
-- Por ejemplo, 
--    ghci> restos 5 (340000,1)
--    [(340000,1),(170000,1),(113333,1),(85000,1),(68000,1)]
restos :: Int -> (Int,Int) -> [(Int,Int)]
restos n (x,i) = [(x `div` k,i) | k <- [1..n]]

-- (reparto1 n vs) es la lista formada por los n restos mayores
-- correspondientes a la lista de votos vs. Por ejemplo,
--    ghci> reparto1 7 ejVotos
--    [(340000,1),(280000,2),(170000,1),(160000,3),(140000,2),(113333,1),
--     (93333,2)]
reparto1 :: Int -> [Int] -> [(Int,Int)]
reparto1 n vs = 
    take n $ reverse $ sort (concatMap (restos n) (votosPartidos vs))

-- (reparto2 n vs) es el número de los partidos, cuyos votos son vs, que
-- obtienen los n escaños. Por ejemplo,
--    ghci> reparto2 7 ejVotos
--    [1,2,1,3,2,1,2]
reparto2 :: Int -> [Int] -> [Int]
reparto2 n vs = map snd (reparto1 n vs)

-- (reparto n vs) es la lista de los pares formados por los números de
-- los partidos y el número de escaño que les corresponden al repartir n
-- escaños en función de la lista de sus votos. Por ejemplo, 
--    ghci> reparto 7 ejVotos
--    [(1,3),(2,3),(3,1)]
reparto :: Int -> [Int] -> [(Int,Int)]
reparto n vs = 
    [(x,1 + length xs) | (x:xs) <- group (sort (reparto2 n vs))]

import Data.List (sort, group)

-- Para los ejemplos que siguen, se usará la siguiente ditribución de

-- votos entre 5 partidos.

ejVotos :: [Int]

ejVotos = [340000,280000,160000,60000,15000]

ejVotos2 :: [Int]

ejVotos2 = [391000,311000,184000,73000,27000,12000,2000]

-- ghci> reparto 21 ejVotos2

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

ejVotos3 :: [Int]

ejVotos3 = [221,195,40,6,4]

-- (votosPartidos vs) es la lista con los pares formados por los votos y

-- el número de cada partido. Por ejemplo,

-- ghci> votosPartidos ejVotos

-- [(340000,1),(280000,2),(160000,3),(60000,4),(15000,5)]

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

votosPartidos vs = zip vs [1..]

-- (restos n (x,i)) es la lista obtenidas dividiendo n entre 1, 2,..., n.

-- Por ejemplo,

-- ghci> restos 5 (340000,1)

-- [(340000,1),(170000,1),(113333,1),(85000,1),(68000,1)]

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

restos n (x,i) = [(x `div` k,i) | k <- [1..n]]

-- (reparto1 n vs) es la lista formada por los n restos mayores

-- correspondientes a la lista de votos vs. Por ejemplo,

-- ghci> reparto1 7 ejVotos

-- [(340000,1),(280000,2),(170000,1),(160000,3),(140000,2),(113333,1),

-- (93333,2)]

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

reparto1 n vs =

take n $ reverse $ sort (concatMap (restos n) (votosPartidos vs))

-- (reparto2 n vs) es el número de los partidos, cuyos votos son vs, que

-- obtienen los n escaños. Por ejemplo,

-- ghci> reparto2 7 ejVotos

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

reparto2 :: Int -> [Int] -> [Int]

reparto2 n vs = map snd (reparto1 n vs)

-- (reparto n vs) es la lista de los pares formados por los números de

-- los partidos y el número de escaño que les corresponden al repartir n

-- escaños en función de la lista de sus votos. Por ejemplo,

-- ghci> reparto 7 ejVotos

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

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

reparto n vs =

[(x,1 + length xs) | (x:xs) <- group (sort (reparto2 n vs))]

Ciclos de un grafo

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

Un ciclo en un grafo G es una secuencia [v(1),v(2),v(3),…,v(n)] de nodos de G tal que:

(v(1),v(2)), (v(2),v(3)), (v(3),v(4)), …, (v(n-1),v(n)) son aristas de G,
v(1) = v(n), y
salvo v(1) = v(n), todos los v(i) son distintos entre sí.

Definir la función

   ciclos :: Grafo Int Int -> [[Int]]

1	ciclos :: Grafo Int Int -> [[Int]]

tal que (ciclos g) es la lista de ciclos de g. Por ejemplo, si g1 y g2 son los grafos definidos por

   g1, g2 :: Grafo Int Int
   g1 = creaGrafo D (1,4) [(1,2,0),(2,3,0),(2,4,0),(4,1,0)]
   g2 = creaGrafo D (1,4) [(1,2,0),(2,1,0),(2,4,0),(4,1,0)]

g1, g2 :: Grafo Int Int

g1 = creaGrafo D (1,4) [(1,2,0),(2,3,0),(2,4,0),(4,1,0)]

g2 = creaGrafo D (1,4) [(1,2,0),(2,1,0),(2,4,0),(4,1,0)]

entonces

   ciclos g1  ==  [[1,2,4,1],[2,4,1,2],[4,1,2,4]]
   ciclos g2  ==  [[1,2,1],[1,2,4,1],[2,1,2],[2,4,1,2],[4,1,2,4]]

1 2	ciclos g1 == [[1,2,4,1],[2,4,1,2],[4,1,2,4]] ciclos g2 == [[1,2,1],[1,2,4,1],[2,1,2],[2,4,1,2],[4,1,2,4]]

Nota: Este ejercicio debe realizarse usando únicamente las funciones de la librería de grafos (I1M.Grafo) que se describe aquí y se encuentra aquí.

Soluciones

import Data.List (nub, subsequences, permutations, sort)
import I1M.Grafo

-- 1ª definición (por fuerza bruta)
-- ================================

ciclos1 :: Grafo Int Int -> [[Int]]
ciclos1 g = 
    sort [ys | (x:xs) <- concatMap permutations (subsequences (nodos g)) 
             , let ys = (x:xs) ++ [x]
             , esCiclo ys g]

-- (esCiclo vs g) se verifica si vs es un ciclo en el grafo g. Por
-- ejemplo, 
esCiclo :: [Int] -> Grafo Int Int -> Bool
esCiclo vs g = 
    all (aristaEn g) (zip vs (tail vs)) &&
    head vs == last vs &&
    length (nub vs) == length vs - 1    

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

ciclos2 :: Grafo Int Int -> [[Int]]
ciclos2 g = sort [ys | (x:xs) <- caminos g
                     , let ys = (x:xs) ++ [x]
                     , esCiclo ys g]

-- (caminos g) es la lista de los caminos en el grafo g. Por ejemplo,
--    caminos g1  ==  [[1,2,3],[1,2,4],[2,3],[2,4,1],[3],[4,1,2,3]]
caminos :: Grafo Int Int -> [[Int]]
caminos g = concatMap (caminosDesde g) (nodos g)

-- (caminosDesde g v) es la lista de los caminos en el grafo g a partir
-- del vértice v. Por ejemplo,
--    caminosDesde g1 1  ==  [[1],[1,2],[1,2,3],[1,2,4]]
--    caminosDesde g1 2  ==  [[2],[2,3],[2,4],[2,4,1]]
--    caminosDesde g1 3  ==  [[3]]
--    caminosDesde g1 4  ==  [[4],[4,1],[4,1,2],[4,1,2,3]]
caminosDesde :: Grafo Int Int -> Int -> [[Int]]
caminosDesde g v = 
    map (reverse . fst) $
    concat $ 
    takeWhile (not.null) (iterate (concatMap sucesores) [([v],[v])])
    where sucesores (x:xs,ys) = [(z:x:xs,z:ys) | z <- adyacentes g x
                                               , z `notElem` ys]

-- 3ª solución (Pedro Martín)
-- ==========================

ciclos3 :: Grafo Int Int -> [[Int]]
ciclos3 g = concat [aux [n] (adyacentes g n) | n <- nodos g] where 
    aux _ [] = []
    aux xs (y:ys)
        | notElem y xs = aux (xs ++ [y]) (adyacentes g y) ++ aux xs ys
        | y == head xs = (xs ++ [y]) : aux xs ys
        | otherwise    = aux xs ys

-- 4ª solución (Chema Cortés)
-- ==========================

ciclos4 :: Grafo Int Int -> [[Int]]
ciclos4 g = concat [ caminos a a [] | a <- nodos g ] where
    -- caminos posibles de b hasta a, sin pasar dos veces por un mismo nodo
    caminos a b vs
        | a == b && (not.null) vs = [[b]]
        | otherwise = [ b:xs | c <- adyacentes g b
                             , c `notElem` vs
                             , xs <- caminos a c (c:vs)]

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

-- ghci> let ejemplo n = creaGrafo D (1,n) ((n,1,0) : [(i,i+1,0) | i <- [1..n-1]])
-- 
-- ghci> length (ciclos1 (ejemplo 9))
-- 9
-- (4.92 secs, 1371229152 bytes)
--
-- ghci> length (ciclos2 (ejemplo 9))
-- 9
-- (0.01 secs, 2577736 bytes)
-- 
-- ghci> length (ciclos3 (ejemplo 9))
-- 9
-- (0.01 secs, 1038932 bytes)
-- 
-- ghci> length (ciclos4 (ejemplo 9))
-- 9
-- (0.01 secs, 2589288 bytes)
-- 
-- ghci> length (ciclos2 (ejemplo 400))
-- 400
-- (11.74 secs, 5148997000 bytes)
-- 
-- ghci> length (ciclos3 (ejemplo 400))
-- 400
-- (4.99 secs, 936520100 bytes)
-- 
-- ghci> length (ciclos4 (ejemplo 400))
-- 400
-- (1.56 secs, 66701772 bytes)

100

101

102

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

import I1M.Grafo

-- 1ª definición (por fuerza bruta)

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

ciclos1 :: Grafo Int Int -> [[Int]]

ciclos1 g =

sort [ys | (x:xs) <- concatMap permutations (subsequences (nodos g))

, let ys = (x:xs) ++ [x]

, esCiclo ys g]

-- (esCiclo vs g) se verifica si vs es un ciclo en el grafo g. Por

-- ejemplo,

esCiclo :: [Int] -> Grafo Int Int -> Bool

esCiclo vs g =

all (aristaEn g) (zip vs (tail vs)) &&

head vs == last vs &&

length (nub vs) == length vs - 1

-- 2ª definición

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

ciclos2 :: Grafo Int Int -> [[Int]]

ciclos2 g = sort [ys | (x:xs) <- caminos g

, let ys = (x:xs) ++ [x]

, esCiclo ys g]

-- (caminos g) es la lista de los caminos en el grafo g. Por ejemplo,

-- caminos g1 == [[1,2,3],[1,2,4],[2,3],[2,4,1],[3],[4,1,2,3]]

caminos :: Grafo Int Int -> [[Int]]

caminos g = concatMap (caminosDesde g) (nodos g)

-- (caminosDesde g v) es la lista de los caminos en el grafo g a partir

-- del vértice v. Por ejemplo,

-- caminosDesde g1 1 == [[1],[1,2],[1,2,3],[1,2,4]]

-- caminosDesde g1 2 == [[2],[2,3],[2,4],[2,4,1]]

-- caminosDesde g1 3 == [[3]]

-- caminosDesde g1 4 == [[4],[4,1],[4,1,2],[4,1,2,3]]

caminosDesde :: Grafo Int Int -> Int -> [[Int]]

caminosDesde g v =

map (reverse . fst) $

concat $

takeWhile (not.null) (iterate (concatMap sucesores) [([v],[v])])

where sucesores (x:xs,ys) = [(z:x:xs,z:ys) | z <- adyacentes g x

, z `notElem` ys]

-- 3ª solución (Pedro Martín)

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

ciclos3 :: Grafo Int Int -> [[Int]]

ciclos3 g = concat [aux [n] (adyacentes g n) | n <- nodos g] where

aux _ [] = []

aux xs (y:ys)

| notElem y xs = aux (xs ++ [y]) (adyacentes g y) ++ aux xs ys

| y == head xs = (xs ++ [y]) : aux xs ys

| otherwise = aux xs ys

-- 4ª solución (Chema Cortés)

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

ciclos4 :: Grafo Int Int -> [[Int]]

ciclos4 g = concat [ caminos a a [] | a <- nodos g ] where

-- caminos posibles de b hasta a, sin pasar dos veces por un mismo nodo

caminos a b vs

| a == b && (not.null) vs = [[b]]

| otherwise = [ b:xs | c <- adyacentes g b

, c `notElem` vs

, xs <- caminos a c (c:vs)]

-- Comparación de eficiencia

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

-- ghci> let ejemplo n = creaGrafo D (1,n) ((n,1,0) : [(i,i+1,0) | i <- [1..n-1]])

-- ghci> length (ciclos1 (ejemplo 9))

-- 9

-- (4.92 secs, 1371229152 bytes)

-- ghci> length (ciclos2 (ejemplo 9))

-- 9

-- (0.01 secs, 2577736 bytes)

-- ghci> length (ciclos3 (ejemplo 9))

-- 9

-- (0.01 secs, 1038932 bytes)

-- ghci> length (ciclos4 (ejemplo 9))

-- 9

-- (0.01 secs, 2589288 bytes)

-- ghci> length (ciclos2 (ejemplo 400))

-- 400

-- (11.74 secs, 5148997000 bytes)

-- ghci> length (ciclos3 (ejemplo 400))

-- 400

-- (4.99 secs, 936520100 bytes)

-- ghci> length (ciclos4 (ejemplo 400))

-- 400

-- (1.56 secs, 66701772 bytes)

El teorema de Midy

PorJosé A. Alonso 12-mayo-201513-junio-2015

El ejercicio de hoy, propuesto por Antonio García Blázquez, tiene como objetivo comprobar la veracidad del Teorema de Midy, este teorema dice:

Sea a/p una fracción, donde a < p y p > 5 es un número primo. Si esta fracción tiene una expansión decimal periódica, donde la cantidad de dígitos en el período es par, entonces podemos partir el período en dos mitades, cuya suma es un número formado únicamente por nueves.

Por ejemplo, 2/7 = 0’285714285714… El período es 285714, cuya longitud es par (6). Lo partimos por la mitad y las sumamos: 285+714 = 999.

Definir la función

   teoremaMidy :: Integer -> Bool

1	teoremaMidy :: Integer -> Bool

tal que (teoremaMidy n) se verifica si para todo todo número primo p menor que n y mayor que 5 y todo número natural a menor que p tales que la cantidad de dígitos en el período de a/p es par, entonces podemos partir el período de a/p en dos mitades, cuya suma es un número formado únicamente por nueves. Por ejemplo,

   teoremaMidy 200  ==  True

1	teoremaMidy 200 == True

Además, comprobar el teorema de Midy usando QuickCheck.

Soluciones

import Data.List (genericTake)
import Data.Numbers.Primes (primes, isPrime)
import Test.QuickCheck

teoremaMidy :: Integer -> Bool
teoremaMidy n = 
    all conclusionMidy [(a,p) | p <- takeWhile (<n) (drop 3 primes),
                                a <- [1..p-1],
                                tienePeriodoDeLongitudPar (a,p)]

-- (tienePeriodoDeLongitudPar (a,p)) se verifica si el período de a/p
-- (con p un primo mayor que 5 y que a) es de longitud par. Por ejemplo,  
--    tienePeriodoDeLongitudPar (1,7)   ==  True
--    tienePeriodoDeLongitudPar (1,37)  ==  False
tienePeriodoDeLongitudPar :: (Integer,Integer) -> Bool
tienePeriodoDeLongitudPar (a,p) =
    even (longitudPeriodo p)

-- (expansionDec (a,p)) es la expansión decimal de a/p. Por ejemplo, 
--    take 10 (expansionDec (1,4))    ==  [0,2,5]
--    take 10 (expansionDec (1,7))    ==  [0,1,4,2,8,5,7,1,4,2]
--    take 12 (expansionDec (90,7))   ==  [12,8,5,7,1,4,2,8,5,7,1,4]
--    take 12 (expansionDec (23,14))  ==  [1,6,4,2,8,5,7,1,4,2,8,5]
expansionDec :: (Integer,Integer) -> [Integer]
expansionDec (x,y) 
    | r == 0    = [q] 
    | otherwise = q : expansionDec (r*10,y)
    where (q,r) = quotRem x y

-- (longitudPeriodo p) es la longitud del período de 1/p (y de
-- cualquier fracción irreducible de denominador p), donde p es un
-- número primo mayor que 5. Por ejemplo, 
--    longitudPeriodo 7   ==  6
--    longitudPeriodo 37  ==  3
--    longitudPeriodo 83  ==  41
longitudPeriodo :: Integer -> Integer
longitudPeriodo p = head [k | k <- [1..], 10^k `mod` p == 1]

-- (periodo (a,p)) es el período de a/b (para a < p y p > 5 es primo). 
-- Por ejemplo, 
--    periodo (1,7)   ==  [1,4,2,8,5,7]
--    periodo (2,7)   ==  [2,8,5,7,1,4]
--    periodo (6,7)   ==  [8,5,7,1,4,2]
--    periodo (1,73)  ==  [0,1,3,6,9,8,6,3]
periodo :: (Integer,Integer) -> [Integer]
periodo (a,p) = genericTake t xs
    where (_:xs) = expansionDec (a,p)
          t      = longitudPeriodo p

-- (conclusionMidy (a,p)) se verifica si a/p verifica la conclusión del
-- teorema de Midy; es decir, podemos partir el período de a/p en dos
-- mitades, cuya suma es un número formado únicamente por nueves. Por
-- ejemplo,  
--    conclusionMidy (1,7)   ==  True
--    conclusionMidy (1,37)  ==  False
conclusionMidy :: (Integer,Integer) -> Bool
conclusionMidy (a,p) = 
    all (==9) (zipWith (+) ys zs)
    where xs      = periodo (a,p)
          (ys,zs) = splitAt (length xs `div` 2) xs

-- ---------------------------------------------------------------------
-- § Comprobación con QuickCheck                                      --
-- ---------------------------------------------------------------------

-- (condicionMidy (a,p)) se verifica si a/p cumple las condiciones del
-- teorema de Midy. Por ejemplo,
--    condicionMidy (1,7)   ==  True
--    condicionMidy (1,37)  ==  False
condicionMidy :: (Integer,Integer) -> Bool
condicionMidy (a,p) = 
    a > 0 && 
    a < p && 
    isPrime p && 
    p > 5 && 
    tienePeriodoDeLongitudPar (a,p)

-- La propiedad es 
prop_teoremaMidy :: (Integer,Integer) -> Property
prop_teoremaMidy (a,p) = 
    condicionMidy (a,p) ==> conclusionMidy (a,p)

-- La comprobación es 
--    ghci> quickCheck prop_teoremaMidy
--    *** Gave up! Passed only 24 tests.

-- En la comprobación se observa que la mayoría de los ejemplos
-- generados no cumplen la condición del teorema de Midy y sólo 24 de
-- ellos la cumplen y también la conclusión. 

-- Para aumentar el número de casos en lo que se cumpla la condición, se
-- puede aumentar el valor de maxSuccess; por ejemplo,   
--    ghci> quickCheckWith (stdArgs {maxSuccess=700}) prop_teoremaMidy
--    *** Gave up! Passed only 137 tests.

-- Otra forma de conseguirlo es definir un generador de números de Midy
-- (es decir, de pares (a,p) que cumplan la condición del teorema de
-- Midy). Por ejemplo, 
--    ghci> sample numeroMidy
--    (15,19)
--    (5,7)
--    (1,23)
--    (7,11)
numeroMidy :: Gen (Integer,Integer)
numeroMidy = suchThat arbitrary condicionMidy

-- La propiedad es
prop_teoremaMidy2 :: Property
prop_teoremaMidy2 = forAll numeroMidy conclusionMidy

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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

import Data.List (genericTake)

import Data.Numbers.Primes (primes, isPrime)

import Test.QuickCheck

teoremaMidy :: Integer -> Bool

teoremaMidy n =

all conclusionMidy [(a,p) | p <- takeWhile (<n) (drop 3 primes),

a <- [1..p-1],

tienePeriodoDeLongitudPar (a,p)]

-- (tienePeriodoDeLongitudPar (a,p)) se verifica si el período de a/p

-- (con p un primo mayor que 5 y que a) es de longitud par. Por ejemplo,

-- tienePeriodoDeLongitudPar (1,7) == True

-- tienePeriodoDeLongitudPar (1,37) == False

tienePeriodoDeLongitudPar :: (Integer,Integer) -> Bool

tienePeriodoDeLongitudPar (a,p) =

even (longitudPeriodo p)

-- (expansionDec (a,p)) es la expansión decimal de a/p. Por ejemplo,

-- take 10 (expansionDec (1,4)) == [0,2,5]

-- take 10 (expansionDec (1,7)) == [0,1,4,2,8,5,7,1,4,2]

-- take 12 (expansionDec (90,7)) == [12,8,5,7,1,4,2,8,5,7,1,4]

-- take 12 (expansionDec (23,14)) == [1,6,4,2,8,5,7,1,4,2,8,5]

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

expansionDec (x,y)

| r == 0 = [q]

| otherwise = q : expansionDec (r*10,y)

where (q,r) = quotRem x y

-- (longitudPeriodo p) es la longitud del período de 1/p (y de

-- cualquier fracción irreducible de denominador p), donde p es un

-- número primo mayor que 5. Por ejemplo,

-- longitudPeriodo 7 == 6

-- longitudPeriodo 37 == 3

-- longitudPeriodo 83 == 41

longitudPeriodo :: Integer -> Integer

longitudPeriodo p = head [k | k <- [1..], 10^k `mod` p == 1]

-- (periodo (a,p)) es el período de a/b (para a < p y p > 5 es primo).

-- Por ejemplo,

-- periodo (1,7) == [1,4,2,8,5,7]

-- periodo (2,7) == [2,8,5,7,1,4]

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

-- periodo (1,73) == [0,1,3,6,9,8,6,3]

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

periodo (a,p) = genericTake t xs

where (_:xs) = expansionDec (a,p)

t = longitudPeriodo p

-- (conclusionMidy (a,p)) se verifica si a/p verifica la conclusión del

-- teorema de Midy; es decir, podemos partir el período de a/p en dos

-- mitades, cuya suma es un número formado únicamente por nueves. Por

-- ejemplo,

-- conclusionMidy (1,7) == True

-- conclusionMidy (1,37) == False

conclusionMidy :: (Integer,Integer) -> Bool

conclusionMidy (a,p) =

all (==9) (zipWith (+) ys zs)

where xs = periodo (a,p)

(ys,zs) = splitAt (length xs `div` 2) xs

-- ---------------------------------------------------------------------

-- § Comprobación con QuickCheck --

-- ---------------------------------------------------------------------

-- (condicionMidy (a,p)) se verifica si a/p cumple las condiciones del

-- teorema de Midy. Por ejemplo,

-- condicionMidy (1,7) == True

-- condicionMidy (1,37) == False

condicionMidy :: (Integer,Integer) -> Bool

condicionMidy (a,p) =

a > 0 &&

a < p &&

isPrime p &&

p > 5 &&

tienePeriodoDeLongitudPar (a,p)

-- La propiedad es

prop_teoremaMidy :: (Integer,Integer) -> Property

prop_teoremaMidy (a,p) =

condicionMidy (a,p) ==> conclusionMidy (a,p)

-- La comprobación es

-- ghci> quickCheck prop_teoremaMidy

-- *** Gave up! Passed only 24 tests.

-- En la comprobación se observa que la mayoría de los ejemplos

-- generados no cumplen la condición del teorema de Midy y sólo 24 de

-- ellos la cumplen y también la conclusión.

-- Para aumentar el número de casos en lo que se cumpla la condición, se

-- puede aumentar el valor de maxSuccess; por ejemplo,

-- ghci> quickCheckWith (stdArgs {maxSuccess=700}) prop_teoremaMidy

-- *** Gave up! Passed only 137 tests.

-- Otra forma de conseguirlo es definir un generador de números de Midy

-- (es decir, de pares (a,p) que cumplan la condición del teorema de

-- Midy). Por ejemplo,

-- ghci> sample numeroMidy

-- (15,19)

-- (5,7)

-- (1,23)

-- (7,11)

numeroMidy :: Gen (Integer,Integer)

numeroMidy = suchThat arbitrary condicionMidy

-- La propiedad es

prop_teoremaMidy2 :: Property

prop_teoremaMidy2 = forAll numeroMidy conclusionMidy

-- La comprobación es

-- ghci> quickCheck prop_teoremaMidy2

-- +++ OK, passed 100 tests.

Representación decimal de números racionales

PorJosé A. Alonso 11-mayo-201525-abril-2021

Continuando con los ejercicios propuestos por los alumnos, Antonio García Blázquez ha propuesto un ejercicio que usa el período de los números decimales. El ejercicio de hoy, basado en su propuesta, trata de la representación decimal de los números racionales.

Los números decimales se representan por ternas, donde el primer elemento es la parte entera, el segundo es el anteperíodo y el tercero es el período. Por ejemplo,

    6/2  = 3                  se representa por (3,[],[])
    1/2  = 0.5                se representa por (0,[5],[])
    1/3  = 0.333333...        se representa por (0,[],[3])  
   23/14 = 1.6428571428571... se representa por (1,[6],[4,2,8,5,7,1])

6/2 = 3 se representa por (3,[],[])

1/2 = 0.5 se representa por (0,[5],[])

1/3 = 0.333333... se representa por (0,[],[3])

23/14 = 1.6428571428571... se representa por (1,[6],[4,2,8,5,7,1])

Su tipo es

   type Decimal = (Integer,[Integer],[Integer])

1	type Decimal = (Integer,[Integer],[Integer])

Los números racionales se representan por un par de enteros, donde el primer elemento es el numerador y el segundo el denominador. Por ejemplo, el número 2/3 se representa por (2,3). Su tipo es

   type Racional = (Integer,Integer)

1	type Racional = (Integer,Integer)

Definir las funciones

   decimal  :: Racional -> Decimal
   racional :: Decimal -> Racional

1 2	decimal :: Racional -> Decimal racional :: Decimal -> Racional

tales que

(decimal r) es la representación decimal del número racional r. Por ejemplo,

        decimal (1,4)    ==  (0,[2,5],[])
        decimal (1,3)    ==  (0,[],[3])
        decimal (23,14)  ==  (1,[6],[4,2,8,5,7,1])

decimal (1,4) == (0,[2,5],[])

decimal (1,3) == (0,[],[3])

decimal (23,14) == (1,[6],[4,2,8,5,7,1])

(racional d) es el número racional cuya representación decimal es d. Por ejemplo,

        racional (0,[2,5],[])           ==  (1,4)
        racional (0,[],[3])             ==  (1,3)
        racional (1,[6],[4,2,8,5,7,1])  ==  (23,14)

racional (0,[2,5],[]) == (1,4)

racional (0,[],[3]) == (1,3)

racional (1,[6],[4,2,8,5,7,1]) == (23,14)

Con la función decimal se puede calcular los períodos de los números racionales. Por ejemplo,

   ghci> let (_,_,p) = decimal (23,14) in concatMap show p
   "428571"
   ghci> let (_,_,p) = decimal (1,47) in concatMap show p
   "0212765957446808510638297872340425531914893617"
   ghci> let (_,_,p) = decimal (1,541) in length (concatMap show p)
   540

ghci> let (_,_,p) = decimal (23,14) in concatMap show p

"428571"

ghci> let (_,_,p) = decimal (1,47) in concatMap show p

"0212765957446808510638297872340425531914893617"

ghci> let (_,_,p) = decimal (1,541) in length (concatMap show p)

540

Comprobar con QuickCheck si las funciones decimal y racional son inversas.

Soluciones

-- ---------------------------------------------------------------------
-- § Librerías auxiliares                                             --
-- ---------------------------------------------------------------------

import Data.List
import Test.QuickCheck

-- ---------------------------------------------------------------------
-- § Tipos                                                            --
-- ---------------------------------------------------------------------

-- Un número racional se representa por un par de enteros, donde el
-- primer elemento es el numerador y el segundo el denominador.
type Racional = (Integer,Integer)

-- Un número decimal es una terna donde el primer elemento es la parte
-- entera, el segundo es el anteperíodo y el tercero es el período.
type Decimal = (Integer,[Integer],[Integer])

-- ---------------------------------------------------------------------
-- § De racional a decimal                                            --
-- ---------------------------------------------------------------------

-- (mayorExponente a x) es el mayor n tal que a^n divide a x. Por ejemplo,
--    mayorExponente 2 40  ==  3
--    mayorExponente 5 40  ==  1
--    mayorExponente 5 41  ==  0
mayorExponente :: Integer -> Integer -> Integer
mayorExponente a x = head [n | n <- [1..], mod x (a^n) /= 0] - 1

-- (longitudAnteperiodo n) es la longitud del anteperíodo de 1/n (y de
-- cualquier fracción irreducible de denominador n). Por ejemplo, 
--    longitudAnteperiodo 2   ==  1
--    longitudAnteperiodo 3   ==  0
--    longitudAnteperiodo 14  ==  1
longitudAnteperiodo :: Integer -> Integer
longitudAnteperiodo n = max (mayorExponente 2 n) (mayorExponente 5 n)

-- (longitudPeriodo n) es la longitud del período de 1/n (y de
-- cualquier fracción irreducible de denominador n). Por ejemplo, 
--    longitudPeriodo 2  ==  0
--    longitudPeriodo 3  ==  1
--    longitudPeriodo 7  ==  6
longitudPeriodo :: Integer -> Integer
longitudPeriodo n
    | m == 1    = 0 
    | otherwise = head [k | k <- [1..], (10^k) `mod` m == 1]
    where m = n `div` (2^(mayorExponente 2 n) * 5^(mayorExponente 5 n))

-- (expansionDec (x,y)) es la expansión decimal de x/y. Por ejemplo, 
--    take 10 (expansionDec (1,4))    ==  [0,2,5]
--    take 10 (expansionDec (1,7))    ==  [0,1,4,2,8,5,7,1,4,2]
--    take 12 (expansionDec (90,7))   ==  [12,8,5,7,1,4,2,8,5,7,1,4]
--    take 12 (expansionDec (23,14))  ==  [1,6,4,2,8,5,7,1,4,2,8,5]
expansionDec :: Racional -> [Integer]
expansionDec (x,y) 
    | r == 0    = [q] 
    | otherwise = q : expansionDec (r*10,y)
    where (q,r) = quotRem x y

-- (parteEntera (a,b)) es la parte entera de a/b. Por ejemplo,
--    parteEntera (125,3)  ==  41
parteEntera :: Racional -> Integer
parteEntera (a,b) = a `div` b

-- (antePeriodo (a,b)) es el anteperíodo de a/b; es decir, la lista de
-- cifras que se encuentran entre la parte entera y el primer período de
-- a/b. Por ejemplo,
--    antePeriodo (23,14)  ==  [6]
--    antePeriodo (1,5)    ==  [2]
antePeriodo :: Racional -> [Integer]
antePeriodo (a,b) = genericTake s (tail xs)
    where xs = expansionDec (a,b)
          s  = longitudAnteperiodo b

-- (periodo (a,b)) es el período de a/b. Por ejemplo, 
--    periodo (1,3)                   ==  [3]
--    periodo (1,5)                   ==  []
--    periodo (1,7)                   ==  [1,4,2,8,5,7]
--    periodo (23,14)                 ==  [4,2,8,5,7,1]
--    concatMap show $ periodo (1,29) == "0344827586206896551724137931"
periodo :: Racional -> [Integer]
periodo (a,b) = genericTake t (genericDrop (1+s) xs)
    where xs = expansionDec (a,b)
          s  = longitudAnteperiodo b
          t  = longitudPeriodo b

-- (reducido (a,b)) es la forma reducida del número racional a/b. Por
-- ejemplo, 
--    reducido (40,80)  ==  (1,2)
reducido :: Racional -> Racional
reducido (a,b) = (a `div` m, b `div` m) 
    where m = gcd a b

-- (decimal (x,y)) es la forma decimal de x/y; es decir, la terna
-- formada por la parte entera, la parte decimal pura y la parte decimal
-- periódica. Por ejemplo, 
--    decimal (1,4)    ==  (0,[2,5],[])
--    decimal (1,3)    ==  (0,[],[3])
--    decimal (23,14)  ==  (1,[6],[4,2,8,5,7,1])
decimal :: Racional -> Decimal
decimal (a,b) = (parteEntera r, antePeriodo r, periodo r)
    where r = reducido (a,b)

-- ---------------------------------------------------------------------
-- § De decimal a racional                                            --
-- ---------------------------------------------------------------------

-- (digitosAnumero xs) es el número correspondiente a la lista de
-- dígitos xs. Por ejemplo,
--    digitosAnumero [3,2,5]  ==  325
digitosAnumero :: [Integer] -> Integer
digitosAnumero = foldl (\a y -> 10*a+y) 0

-- 2ª definición de digitosAnumero (por comprensión)
digitosAnumero2 :: [Integer] -> Integer
digitosAnumero2 xs = sum [x*(10^i) | (x,i) <- zip xs [n-1,n-2..0]]
    where n = length xs

-- (racional (x,ys,zs)) es el número racional cuya representación
-- decimal es (x,ys,zs). Por ejemplo,
--    racional (0,[2,5],[])           ==  (1,4)
--    racional (0,[],[3])             ==  (1,3)
--    racional (1,[6],[4,2,8,5,7,1])  ==  (23,14)
racional :: Decimal -> Racional
racional (x,ys,[]) = reducido (a,b) where
    a = digitosAnumero (x:ys)
    b = 10^(length ys)
racional (x,ys,zs) = reducido (a,b) where 
    a = digitosAnumero (x:ys++zs) - digitosAnumero (x:ys)
    b = digitosAnumero (replicate (length zs) 9 ++ replicate (length ys) 0)

-- ---------------------------------------------------------------------
-- § Propiedades                                                      --
-- ---------------------------------------------------------------------

-- La 1ª propiedad es
prop_RacionalDecimal :: Racional -> Property
prop_RacionalDecimal (a,b) =
    a >= 0 && b > 0  ==>
    racional (decimal (a,b)) == reducido (a,b)

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

-- En lugar de reducido se puede usar un generador de números racionales
numeroRacional :: Gen Racional
numeroRacional = do a <- arbitrary
                    b <- arbitrary
                    return (reducido (abs a, 1+ abs b))

-- La propiedad es
prop_RacionalDecimal2 :: Property
prop_RacionalDecimal2 =
    forAll numeroRacional
           (\(a,b) -> racional (decimal (a,b)) == (a,b))

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

-- Para la 2ª propiedad se define un generador de números decimales
numeroDecimal :: Gen Decimal
numeroDecimal = do a <- arbitrary
                   b <- arbitrary
                   return (decimal (abs a, 1+ abs b))

-- La 2ª propiedad es
prop_DecimalRacional :: Property
prop_DecimalRacional =
    forAll numeroDecimal 
           (\(x,ys,zs) -> decimal (racional (x,ys,zs)) == (x,ys,zs))

-- La comprobación es
--   ghci> quickCheck prop_DecimalRacional
--   +++ 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

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

-- ---------------------------------------------------------------------

-- § Librerías auxiliares --

-- ---------------------------------------------------------------------

import Data.List

import Test.QuickCheck

-- ---------------------------------------------------------------------

-- § Tipos --

-- ---------------------------------------------------------------------

-- Un número racional se representa por un par de enteros, donde el

-- primer elemento es el numerador y el segundo el denominador.

type Racional = (Integer,Integer)

-- Un número decimal es una terna donde el primer elemento es la parte

-- entera, el segundo es el anteperíodo y el tercero es el período.

type Decimal = (Integer,[Integer],[Integer])

-- ---------------------------------------------------------------------

-- § De racional a decimal --

-- ---------------------------------------------------------------------

-- (mayorExponente a x) es el mayor n tal que a^n divide a x. Por ejemplo,

-- mayorExponente 2 40 == 3

-- mayorExponente 5 40 == 1

-- mayorExponente 5 41 == 0

mayorExponente :: Integer -> Integer -> Integer

mayorExponente a x = head [n | n <- [1..], mod x (a^n) /= 0] - 1

-- (longitudAnteperiodo n) es la longitud del anteperíodo de 1/n (y de

-- cualquier fracción irreducible de denominador n). Por ejemplo,

-- longitudAnteperiodo 2 == 1

-- longitudAnteperiodo 3 == 0

-- longitudAnteperiodo 14 == 1

longitudAnteperiodo :: Integer -> Integer

longitudAnteperiodo n = max (mayorExponente 2 n) (mayorExponente 5 n)

-- (longitudPeriodo n) es la longitud del período de 1/n (y de

-- cualquier fracción irreducible de denominador n). Por ejemplo,

-- longitudPeriodo 2 == 0

-- longitudPeriodo 3 == 1

-- longitudPeriodo 7 == 6

longitudPeriodo :: Integer -> Integer

longitudPeriodo n

| m == 1 = 0

| otherwise = head [k | k <- [1..], (10^k) `mod` m == 1]

where m = n `div` (2^(mayorExponente 2 n) * 5^(mayorExponente 5 n))

-- (expansionDec (x,y)) es la expansión decimal de x/y. Por ejemplo,

-- take 10 (expansionDec (1,4)) == [0,2,5]

-- take 10 (expansionDec (1,7)) == [0,1,4,2,8,5,7,1,4,2]

-- take 12 (expansionDec (90,7)) == [12,8,5,7,1,4,2,8,5,7,1,4]

-- take 12 (expansionDec (23,14)) == [1,6,4,2,8,5,7,1,4,2,8,5]

expansionDec :: Racional -> [Integer]

expansionDec (x,y)

| r == 0 = [q]

| otherwise = q : expansionDec (r*10,y)

where (q,r) = quotRem x y

-- (parteEntera (a,b)) es la parte entera de a/b. Por ejemplo,

-- parteEntera (125,3) == 41

parteEntera :: Racional -> Integer

parteEntera (a,b) = a `div` b

-- (antePeriodo (a,b)) es el anteperíodo de a/b; es decir, la lista de

-- cifras que se encuentran entre la parte entera y el primer período de

-- a/b. Por ejemplo,

-- antePeriodo (23,14) == [6]

-- antePeriodo (1,5) == [2]

antePeriodo :: Racional -> [Integer]

antePeriodo (a,b) = genericTake s (tail xs)

where xs = expansionDec (a,b)

s = longitudAnteperiodo b

-- (periodo (a,b)) es el período de a/b. Por ejemplo,

-- periodo (1,3) == [3]

-- periodo (1,5) == []

-- periodo (1,7) == [1,4,2,8,5,7]

-- periodo (23,14) == [4,2,8,5,7,1]

-- concatMap show $ periodo (1,29) == "0344827586206896551724137931"

periodo :: Racional -> [Integer]

periodo (a,b) = genericTake t (genericDrop (1+s) xs)

where xs = expansionDec (a,b)

s = longitudAnteperiodo b

t = longitudPeriodo b

-- (reducido (a,b)) es la forma reducida del número racional a/b. Por

-- ejemplo,

-- reducido (40,80) == (1,2)

reducido :: Racional -> Racional

reducido (a,b) = (a `div` m, b `div` m)

where m = gcd a b

-- (decimal (x,y)) es la forma decimal de x/y; es decir, la terna

-- formada por la parte entera, la parte decimal pura y la parte decimal

-- periódica. Por ejemplo,

-- decimal (1,4) == (0,[2,5],[])

-- decimal (1,3) == (0,[],[3])

-- decimal (23,14) == (1,[6],[4,2,8,5,7,1])

decimal :: Racional -> Decimal

decimal (a,b) = (parteEntera r, antePeriodo r, periodo r)

where r = reducido (a,b)

-- ---------------------------------------------------------------------

-- § De decimal a racional --

-- ---------------------------------------------------------------------

-- (digitosAnumero xs) es el número correspondiente a la lista de

-- dígitos xs. Por ejemplo,

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

digitosAnumero :: [Integer] -> Integer

digitosAnumero = foldl (\a y -> 10*a+y) 0

-- 2ª definición de digitosAnumero (por comprensión)

digitosAnumero2 :: [Integer] -> Integer

digitosAnumero2 xs = sum [x*(10^i) | (x,i) <- zip xs [n-1,n-2..0]]

where n = length xs

-- (racional (x,ys,zs)) es el número racional cuya representación

-- decimal es (x,ys,zs). Por ejemplo,

-- racional (0,[2,5],[]) == (1,4)

-- racional (0,[],[3]) == (1,3)

-- racional (1,[6],[4,2,8,5,7,1]) == (23,14)

racional :: Decimal -> Racional

racional (x,ys,[]) = reducido (a,b) where

a = digitosAnumero (x:ys)

b = 10^(length ys)

racional (x,ys,zs) = reducido (a,b) where

a = digitosAnumero (x:ys++zs) - digitosAnumero (x:ys)

b = digitosAnumero (replicate (length zs) 9 ++ replicate (length ys) 0)

-- ---------------------------------------------------------------------

-- § Propiedades --

-- ---------------------------------------------------------------------

-- La 1ª propiedad es

prop_RacionalDecimal :: Racional -> Property

prop_RacionalDecimal (a,b) =

a >= 0 && b > 0 ==>

racional (decimal (a,b)) == reducido (a,b)

-- La comprobación es

-- ghci> quickCheck prop_RacionalDecimal

-- +++ OK, passed 100 tests.

-- En lugar de reducido se puede usar un generador de números racionales

numeroRacional :: Gen Racional

numeroRacional = do a <- arbitrary

b <- arbitrary

return (reducido (abs a, 1+ abs b))

-- La propiedad es

prop_RacionalDecimal2 :: Property

prop_RacionalDecimal2 =

forAll numeroRacional

(\(a,b) -> racional (decimal (a,b)) == (a,b))

-- La comprobación es

-- ghci> quickCheck prop_RacionalDecimal2

-- +++ OK, passed 100 tests.

-- Para la 2ª propiedad se define un generador de números decimales

numeroDecimal :: Gen Decimal

numeroDecimal = do a <- arbitrary

b <- arbitrary

return (decimal (abs a, 1+ abs b))

-- La 2ª propiedad es

prop_DecimalRacional :: Property

prop_DecimalRacional =

forAll numeroDecimal

(\(x,ys,zs) -> decimal (racional (x,ys,zs)) == (x,ys,zs))

-- La comprobación es

-- ghci> quickCheck prop_DecimalRacional

-- +++ OK, passed 100 tests.

Potencias de primos con exponentes potencias de dos

PorJosé A. Alonso 8-mayo-201513-junio-2015

Se llaman potencias de Fermi-Dirac a los números de la forma p^(2^k), donde p es un número primo y k es un número natural.

Definir la sucesión

   potencias :: [Integer]

1	potencias :: [Integer]

cuyos términos sean las potencias de Fermi-Dirac ordenadas de menor a mayor. Por ejemplo,

   take 14 potencias    ==  [2,3,4,5,7,9,11,13,16,17,19,23,25,29]
   potencias !! 60      ==  241
   potencias !! (10^6)  ==  15476303

take 14 potencias == [2,3,4,5,7,9,11,13,16,17,19,23,25,29]

potencias !! 60 == 241

potencias !! (10^6) == 15476303

Soluciones

import Data.Numbers.Primes (primes)

potencias :: [Integer]
potencias = 2 : mezcla (tail primes) (map (^2) potencias)

-- (mezcla xs ys) es la lista obtenida mezclando las dos listas xs e ys,
-- que se suponen ordenadas y disjuntas. Por ejemplo,
--    ghci> take 15 (mezcla [2^n | n <- [1..]] [3^n | n <- [1..]])
--    [2,3,4,8,9,16,27,32,64,81,128,243,256,512,729]
mezcla :: Ord a => [a] -> [a] -> [a]
mezcla (x:xs) (y:ys) | x < y = x : mezcla xs (y:ys)
                     | x > y = y : mezcla (x:xs) ys

import Data.Numbers.Primes (primes)

potencias :: [Integer]

potencias = 2 : mezcla (tail primes) (map (^2) potencias)

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

-- que se suponen ordenadas y disjuntas. Por ejemplo,

-- ghci> take 15 (mezcla [2^n | n <- [1..]] [3^n | n <- [1..]])

-- [2,3,4,8,9,16,27,32,64,81,128,243,256,512,729]

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

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

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

Fracciones cancelativas

PorJosé A. Alonso 22-abril-201529-abril-2015

Una fracción x/y es cancelativa si se cumplen las siguientes condiciones:

x/y es propia (es decir, x < y),
ninguno de los números x e y son múltiplos de 10 y
existe un dígito d tal que al borrar una ocurrencia de d en x y otra en y se obtiene una fracción cuyo valor coincide con x/y.

Por ejemplo, 16/64 es cancelativa ya que borrando el 6 en el numerador y el denominador se obtiene 1/4 que es igual a la original: 16/64 = 1/4.

Definir la función

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

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

tal que (cancelativas m n) es la lista de las fracciones cancelativas con su denominador entre m y n. Por ejemplo,

   ghci> cancelativas 1 100
   [((16,64),(1,4)),((26,65),(2,5)),((19,95),(1,5)),((49,98),(4,8))]
   ghci> cancelativas 101 150
   [((22,121),(2,11)),((33,132),(3,12)),((34,136),(4,16)),((44,143),(4,13))]
   ghci> length (cancelativas 1 200)
   18

ghci> cancelativas 1 100

[((16,64),(1,4)),((26,65),(2,5)),((19,95),(1,5)),((49,98),(4,8))]

ghci> cancelativas 101 150

[((22,121),(2,11)),((33,132),(3,12)),((34,136),(4,16)),((44,143),(4,13))]

ghci> length (cancelativas 1 200)

Soluciones

import Data.List (intersect, nub)

cancelativas :: Int -> Int -> [((Int, Int), (Int, Int))]
cancelativas m n = 
    nub [((x,y),(a,b))
         | y <- [m..n], 
           y `mod` 10 /= 0,
           x <- [1..y-1],
           x `mod` 10 /= 0,
           (as,bs) <- reducciones (show x) (show y),
           not (null as),
           not (null bs),
           let (a,b) = (read as, read bs),
           b /= 0,
           a*y == b*x]

-- (reducciones xs ys) es la lista de los pares obtenidos eliminando una
-- ocurrencia de un elemento de xs tanto en xs como en ys. Por ejemplo,
--    ghci> reducciones "abac" "bcba"
--    [("bac","bcb"),("abc","bcb"),
--     ("aac","cba"),("aac","bca"),
--     ("aba","bba")]
reducciones :: Eq a => [a] -> [a] -> [([a],[a])]
reducciones xs ys =
    concat [[(us,vs) | us <- eliminaciones xs x, vs <- eliminaciones ys x]
            | x <- nub (intersect xs ys)]

-- (eliminaciones xs y) es la lista de las listas obtenidas eliminando
-- una ocurrencia del elemento y en la lista xs. Por ejemplo,  
--    eliminaciones "abacda" 'a'  ==  ["bacda","abcda","abacd"]
--    eliminaciones "abacd"  'a'  ==  ["bacd","abcd"]
--    eliminaciones "abacd"  'b'  ==  ["aacd"]
--    eliminaciones "abacd"  'e'  ==  []
eliminaciones :: Eq a => [a] -> a -> [[a]]
eliminaciones [] _ = []
eliminaciones (x:xs) y
    | x == y    = xs : [x:zs | zs <- zss]
    | otherwise = [x:zs | zs <- zss]
    where zss = eliminaciones xs y

import Data.List (intersect, nub)

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

cancelativas m n =

nub [((x,y),(a,b))

| y <- [m..n],

y `mod` 10 /= 0,

x <- [1..y-1],

x `mod` 10 /= 0,

(as,bs) <- reducciones (show x) (show y),

not (null as),

not (null bs),

let (a,b) = (read as, read bs),

b /= 0,

a*y == b*x]

-- (reducciones xs ys) es la lista de los pares obtenidos eliminando una

-- ocurrencia de un elemento de xs tanto en xs como en ys. Por ejemplo,

-- ghci> reducciones "abac" "bcba"

-- [("bac","bcb"),("abc","bcb"),

-- ("aac","cba"),("aac","bca"),

-- ("aba","bba")]

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

reducciones xs ys =

concat [[(us,vs) | us <- eliminaciones xs x, vs <- eliminaciones ys x]

| x <- nub (intersect xs ys)]

-- (eliminaciones xs y) es la lista de las listas obtenidas eliminando

-- una ocurrencia del elemento y en la lista xs. Por ejemplo,

-- eliminaciones "abacda" 'a' == ["bacda","abcda","abacd"]

-- eliminaciones "abacd" 'a' == ["bacd","abcd"]

-- eliminaciones "abacd" 'b' == ["aacd"]

-- eliminaciones "abacd" 'e' == []

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

eliminaciones [] _ = []

eliminaciones (x:xs) y

| x == y = xs : [x:zs | zs <- zss]

| otherwise = [x:zs | zs <- zss]

where zss = eliminaciones xs y

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)

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)

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]

Perímetro más frecuente de triángulos rectángulos

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

El grado perimetral de un número p es la cantidad de tres triángulos rectángulos de lados enteros cuyo perímetro es p. Por ejemplo, el grado perimetral de 120 es 3 ya que sólo hay 3 triángulos rectángulos de lados enteros cuyo perímetro es 120: {20,48,52}, {24,45,51} y {30,40,50}.

Definir la función

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

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

tal que (maxGradoPerimetral n) es el par (m,ps) tal que m es el máximo grado perimetral de los números menores o iguales que n y ps son los perímetros, menores o iguales que n, cuyo grado perimetral es m. Por ejemplo,

   maxGradoPerimetral   50  ==  (1,[12,24,30,36,40,48])
   maxGradoPerimetral  100  ==  (2,[60,84,90])
   maxGradoPerimetral  200  ==  (3,[120,168,180])
   maxGradoPerimetral  400  ==  (4,[240,360])
   maxGradoPerimetral  500  ==  (5,[420])
   maxGradoPerimetral  750  ==  (6,[720])
   maxGradoPerimetral  839  ==  (6,[720])
   maxGradoPerimetral  840  ==  (8,[840])
   maxGradoPerimetral 1500  ==  (8,[840,1260])
   maxGradoPerimetral 2000  ==  (10,[1680])
   maxGradoPerimetral 3000  ==  (12,[2520])

maxGradoPerimetral 50 == (1,[12,24,30,36,40,48])

maxGradoPerimetral 100 == (2,[60,84,90])

maxGradoPerimetral 200 == (3,[120,168,180])

maxGradoPerimetral 400 == (4,[240,360])

maxGradoPerimetral 500 == (5,[420])

maxGradoPerimetral 750 == (6,[720])

maxGradoPerimetral 839 == (6,[720])

maxGradoPerimetral 840 == (8,[840])

maxGradoPerimetral 1500 == (8,[840,1260])

maxGradoPerimetral 2000 == (10,[1680])

maxGradoPerimetral 3000 == (12,[2520])

Soluciones

import Data.List
import Data.Array (accumArray, assocs)

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

maxGradoPerimetral1 :: Int -> (Int,[Int])
maxGradoPerimetral1 p = (m,[x | (n,x) <- ts, n == m])
    where ts    = [(length (triangulos x),x) | x <- [1..p]] 
          (m,_) = maximum ts 

-- (triangulos p) es el conjunto de triángulos rectángulos de perímetro
-- p. Por ejemplo,
--    triangulos 120  ==  [(20,48,52),(24,45,51),(30,40,50)]
triangulos :: Int -> [(Int,Int,Int)]
triangulos p = 
    [(a,b,c) | a <- [1..q],
               b <- [a..q],
               let c = p-a-b,
               a*a+b*b == c*c]
    where q = p `div` 2

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

maxGradoPerimetral2 :: Int -> (Int,[Int])
maxGradoPerimetral2 p = (m,[x | (n,x) <- ts, n == m])
    where ts    = [(n,x) | (x,n) <- numeroPerimetrosTriangulos p, n > 0]
          (m,_) = maximum ts 

-- (numeroPerimetrosTriangulos p) es la lista formado por los números de
-- 1 a p y la cantidad de triángulos rectángulos enteros cuyo perímetro
-- es dicho número. Por ejemplo,
--    ghci>  [(p,n) | (p,n) <- numeroPerimetrosTriangulos 70, n > 0]
--    [(12,1),(24,1),(30,1),(36,1),(40,1),(48,1),(56,1),(60,2),(70,1)]
numeroPerimetrosTriangulos :: Int -> [(Int,Int)] 
numeroPerimetrosTriangulos p = 
    assocs (accumArray (\x _ -> 1+x) 0 (1,p) (perimetrosTriangulos p))

-- (perimetrosTriangulos p) es la lista formada por los perímetros y los
-- lados de los triángulos rectángulos enteros cuyo perímetro es menor o
-- igual que p. Por ejemplo,
--    ghci> perimetrosTriangulos 70
--    [(12,(3,4,5)),   (30,(5,12,13)),(24,(6,8,10)),  (56,(7,24,25)),
--     (40,(8,15,17)), (36,(9,12,15)),(60,(10,24,26)),(48,(12,16,20)),
--     (60,(15,20,25)),(70,(20,21,29))]
perimetrosTriangulos :: Int -> [(Int,(Int,Int,Int))]
perimetrosTriangulos p =
    [(q,(a,b,c)) | a <- [1..p1],
                   b <- [a..p1],
                   esCuadrado (a*a+b*b), 
                   let c = raizCuadradaE (a*a+b*b), 
                   let q = a+b+c,
                   q <= p]
    where p1 = p `div` 2

-- (esCuadrado n) se verifica si n es un cuadrado. Por ejemplo,
--    esCuadrado 25  ==  True
--    esCuadrado 27  ==  False
esCuadrado :: Int -> Bool
esCuadrado n = a*a == n
    where a = raizCuadradaE n

-- (raizCuadradaE n) es la raíz cuadrada entera de n. Por ejemplo,
--    raizCuadradaE 25  ==  5
--    raizCuadradaE 27  ==  5
--    raizCuadradaE 35  ==  5
--    raizCuadradaE 36  ==  6
raizCuadradaE :: Int -> Int
raizCuadradaE = floor . sqrt . fromIntegral

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

maxGradoPerimetral3 :: Int -> (Int,[Int])
maxGradoPerimetral3 p = (m,[x | (n,x) <- ts, n == m])
    where ts    = [(n,x) | (x,n) <- numeroPerimetrosTriangulos2 p, n > 0]
          (m,_) = maximum ts 

-- (numeroPerimetrosTriangulos2 p) es la lista formado por los números de
-- 1 a p y la cantidad de triángulos rectángulos enteros cuyo perímetro
-- es dicho número. Por ejemplo,
--    ghci>  [(p,n) | (p,n) <- numeroPerimetrosTriangulos2 70, n > 0]
--    [(12,1),(24,1),(30,1),(36,1),(40,1),(48,1),(56,1),(60,2),(70,1)]
numeroPerimetrosTriangulos2 :: Int -> [(Int,Int)] 
numeroPerimetrosTriangulos2 p = 
    [(head xs, length xs) | xs <- group (sort (perimetrosTriangulos2 p))]

-- (perimetrosTriangulos2 p) es la lista formada por los perímetros de
-- los triángulos rectángulos enteros cuyo perímetro es menor o igual
-- que p. Por ejemplo, 
--    perimetrosTriangulos2 70  ==  [12,30,24,56,40,36,60,48,60,70]
perimetrosTriangulos2 :: Int -> [Int]
perimetrosTriangulos2 p =
    [q | a <- [1..p1],
         b <- [a..p1],
         esCuadrado (a*a+b*b), 
         let c = raizCuadradaE (a*a+b*b), 
         let q = a+b+c,
         q <= p]
    where p1 = p `div` 2

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

-- La comparación es
--    ghci> maxGradoPerimetral1 1000
--    (8,[840])
--    (120.08 secs, 21116625136 bytes)
--    ghci> maxGradoPerimetral2 1000
--    (8,[840])
--    (0.66 secs, 132959056 bytes)
--    ghci> maxGradoPerimetral3 1000
--    (1000,[1])
--    (0.66 secs, 133443816 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

import Data.List

import Data.Array (accumArray, assocs)

-- 1ª solución --

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

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

maxGradoPerimetral1 p = (m,[x | (n,x) <- ts, n == m])

where ts = [(length (triangulos x),x) | x <- [1..p]]

(m,_) = maximum ts

-- (triangulos p) es el conjunto de triángulos rectángulos de perímetro

-- p. Por ejemplo,

-- triangulos 120 == [(20,48,52),(24,45,51),(30,40,50)]

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

triangulos p =

[(a,b,c) | a <- [1..q],

b <- [a..q],

let c = p-a-b,

a*a+b*b == c*c]

where q = p `div` 2

-- 2ª solución --

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

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

maxGradoPerimetral2 p = (m,[x | (n,x) <- ts, n == m])

where ts = [(n,x) | (x,n) <- numeroPerimetrosTriangulos p, n > 0]

(m,_) = maximum ts

-- (numeroPerimetrosTriangulos p) es la lista formado por los números de

-- 1 a p y la cantidad de triángulos rectángulos enteros cuyo perímetro

-- es dicho número. Por ejemplo,

-- ghci> [(p,n) | (p,n) <- numeroPerimetrosTriangulos 70, n > 0]

-- [(12,1),(24,1),(30,1),(36,1),(40,1),(48,1),(56,1),(60,2),(70,1)]

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

numeroPerimetrosTriangulos p =

assocs (accumArray (\x _ -> 1+x) 0 (1,p) (perimetrosTriangulos p))

-- (perimetrosTriangulos p) es la lista formada por los perímetros y los

-- lados de los triángulos rectángulos enteros cuyo perímetro es menor o

-- igual que p. Por ejemplo,

-- ghci> perimetrosTriangulos 70

-- [(12,(3,4,5)), (30,(5,12,13)),(24,(6,8,10)), (56,(7,24,25)),

-- (40,(8,15,17)), (36,(9,12,15)),(60,(10,24,26)),(48,(12,16,20)),

-- (60,(15,20,25)),(70,(20,21,29))]

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

perimetrosTriangulos p =

[(q,(a,b,c)) | a <- [1..p1],

b <- [a..p1],

esCuadrado (a*a+b*b),

let c = raizCuadradaE (a*a+b*b),

let q = a+b+c,

q <= p]

where p1 = p `div` 2

-- (esCuadrado n) se verifica si n es un cuadrado. Por ejemplo,

-- esCuadrado 25 == True

-- esCuadrado 27 == False

esCuadrado :: Int -> Bool

esCuadrado n = a*a == n

where a = raizCuadradaE n

-- (raizCuadradaE n) es la raíz cuadrada entera de n. Por ejemplo,

-- raizCuadradaE 25 == 5

-- raizCuadradaE 27 == 5

-- raizCuadradaE 35 == 5

-- raizCuadradaE 36 == 6

raizCuadradaE :: Int -> Int

raizCuadradaE = floor . sqrt . fromIntegral

-- 3ª solución --

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

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

maxGradoPerimetral3 p = (m,[x | (n,x) <- ts, n == m])

where ts = [(n,x) | (x,n) <- numeroPerimetrosTriangulos2 p, n > 0]

(m,_) = maximum ts

-- (numeroPerimetrosTriangulos2 p) es la lista formado por los números de

-- 1 a p y la cantidad de triángulos rectángulos enteros cuyo perímetro

-- es dicho número. Por ejemplo,

-- ghci> [(p,n) | (p,n) <- numeroPerimetrosTriangulos2 70, n > 0]

-- [(12,1),(24,1),(30,1),(36,1),(40,1),(48,1),(56,1),(60,2),(70,1)]

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

numeroPerimetrosTriangulos2 p =

[(head xs, length xs) | xs <- group (sort (perimetrosTriangulos2 p))]

-- (perimetrosTriangulos2 p) es la lista formada por los perímetros de

-- los triángulos rectángulos enteros cuyo perímetro es menor o igual

-- que p. Por ejemplo,

-- perimetrosTriangulos2 70 == [12,30,24,56,40,36,60,48,60,70]

perimetrosTriangulos2 :: Int -> [Int]

perimetrosTriangulos2 p =

[q | a <- [1..p1],

b <- [a..p1],

esCuadrado (a*a+b*b),

let c = raizCuadradaE (a*a+b*b),

let q = a+b+c,

q <= p]

where p1 = p `div` 2

-- Comparación de eficiencia

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

-- La comparación es

-- ghci> maxGradoPerimetral1 1000

-- (8,[840])

-- (120.08 secs, 21116625136 bytes)

-- ghci> maxGradoPerimetral2 1000

-- (8,[840])

-- (0.66 secs, 132959056 bytes)

-- ghci> maxGradoPerimetral3 1000

-- (1000,[1])

-- (0.66 secs, 133443816 bytes)

Números de suma prima hereditarios por la derecha

PorJosé A. Alonso 27-marzo-20151-mayo-2015

Decimos que un número es de suma prima si la suma de todos sus dígitos es un número primo. Por ejemplo el número 562 es de suma prima pues la suma de sus dígitos es el número primo 13; sin embargo, el número 514 no es de suma prima pues la suma de sus dígitos es 10, que no es primo.

Decimos que un número es de suma prima hereditario por la derecha si es de suma prima y los números que se obtienen eliminando sus últimas cifras también son de suma prima. Por ejemplo 7426 es de suma prima hereditario por la derecha pues 7426, 742, 74 y 7 son todos números de suma prima.

Definir la constante

   listaSumaPrimaHD :: [Integer]

1	listaSumaPrimaHD :: [Integer]

cuyo valor es la lista infinita de los números de suma prima hereditarios por la derecha. Por ejemplo,

   take 10 listaSumaPrimaHD     ==  [2,3,5,7,20,21,23,25,29,30]
   listaSumaPrimaHD !! 2000000  ==  3800024668046

1 2	take 10 listaSumaPrimaHD == [2,3,5,7,20,21,23,25,29,30] listaSumaPrimaHD !! 2000000 == 3800024668046

Soluciones

import Data.Char (digitToInt)
import Data.Array
import Data.Numbers.Primes (isPrime)

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

listaSumaPrimaHD1 :: [Integer]
listaSumaPrimaHD1 = filter sumaPrimaHD [1..]

-- (sumaPrimaHD n) se verifica si n es de suma prima hereditario por la
-- derecha. Por ejemplo,
--    sumaPrimaHD 7426  ==  True
--    sumaPrimaHD 7427  ==  False
sumaPrimaHD n
    | n < 10    = isPrime n
    | otherwise = sumaPrima n && sumaPrimaHD (n `div` 10)

-- (sumaPrima n) se verifica si n es un número de suma prima. Por
-- ejemplo, 
--    sumaPrima 562  ==  True
--    sumaPrima 514  ==  False
sumaPrima :: Integer -> Bool
sumaPrima = isPrime . sum . digitos

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


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

listaSumaPrimaHD2 :: [Integer]
listaSumaPrimaHD2 = map fst paresSumaPrimaHDDigitos

paresSumaPrimaHDDigitos :: [(Integer, Integer)]
paresSumaPrimaHDDigitos =
    paresSumaPrimaHDDigitosAux 1 [(2,2),(3,3),(5,5),(7,7)]

paresSumaPrimaHDDigitosAux :: Integer -> [(Integer,Integer)] -> 
                              [(Integer,Integer)]
paresSumaPrimaHDDigitosAux n ac =
    ac ++ paresSumaPrimaHDDigitosAux (n+1) 
                                     (concatMap extiendeSumaPrimaHD ac)

extiendeSumaPrimaHD :: (Integer,Integer) -> [(Integer,Integer)]
extiendeSumaPrimaHD (n,s) = [(n*10+k,s+k) | k <- [0..9], isPrime (s+k)]

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

listaSumaPrimaHD3 :: [Integer]
listaSumaPrimaHD3 = 
    map fst (concat (iterate (concatMap extiendeSumaPrimaHD3) 
                             [(2,2),(3,3),(5,5),(7,7)]))

extiendeSumaPrimaHD3 :: (Integer,Integer) -> [(Integer,Integer)]
extiendeSumaPrimaHD3 (n,s) = [(n*10+k,s+k) | k <- extensiones ! s]

extensiones :: Array Integer [Integer]
extensiones = array (1,1000) 
              [(n,[k | k <- [0..9], isPrime (n+k)]) | n <- [1..1000]]

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

--    ghci> listaSumaPrimaHD1 !! 600
--    34004
--    (2.47 secs, 1565301720 bytes)
--    ghci> listaSumaPrimaHD2 !! 600
--    34004
--    (0.02 secs, 7209000 bytes)
--    ghci> listaSumaPrimaHD3 !! 600
--    34004
--    (0.01 secs, 1579920 bytes)
-- 
--    ghci> listaSumaPrimaHD2 !! 2000000
--    3800024668046
--    (45.41 secs, 29056613824 bytes)
--    ghci> listaSumaPrimaHD3 !! 2000000
--    3800024668046
--    (4.29 secs, 973265400 bytes)

import Data.Char (digitToInt)

import Data.Array

import Data.Numbers.Primes (isPrime)

-- 1ª definición

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

listaSumaPrimaHD1 :: [Integer]

listaSumaPrimaHD1 = filter sumaPrimaHD [1..]

-- (sumaPrimaHD n) se verifica si n es de suma prima hereditario por la

-- derecha. Por ejemplo,

-- sumaPrimaHD 7426 == True

-- sumaPrimaHD 7427 == False

sumaPrimaHD n

| n < 10 = isPrime n

| otherwise = sumaPrima n && sumaPrimaHD (n `div` 10)

-- (sumaPrima n) se verifica si n es un número de suma prima. Por

-- ejemplo,

-- sumaPrima 562 == True

-- sumaPrima 514 == False

sumaPrima :: Integer -> Bool

sumaPrima = isPrime . sum . digitos

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

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

digitos :: Integer -> [Integer]

digitos = map (fromIntegral . digitToInt) . show

-- 2ª definición

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

listaSumaPrimaHD2 :: [Integer]

listaSumaPrimaHD2 = map fst paresSumaPrimaHDDigitos

paresSumaPrimaHDDigitos :: [(Integer, Integer)]

paresSumaPrimaHDDigitos =

paresSumaPrimaHDDigitosAux 1 [(2,2),(3,3),(5,5),(7,7)]

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

[(Integer,Integer)]

paresSumaPrimaHDDigitosAux n ac =

ac ++ paresSumaPrimaHDDigitosAux (n+1)

(concatMap extiendeSumaPrimaHD ac)

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

extiendeSumaPrimaHD (n,s) = [(n*10+k,s+k) | k <- [0..9], isPrime (s+k)]

-- 3ª definición

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

listaSumaPrimaHD3 :: [Integer]

listaSumaPrimaHD3 =

map fst (concat (iterate (concatMap extiendeSumaPrimaHD3)

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

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

extiendeSumaPrimaHD3 (n,s) = [(n*10+k,s+k) | k <- extensiones ! s]

extensiones :: Array Integer [Integer]

extensiones = array (1,1000)

[(n,[k | k <- [0..9], isPrime (n+k)]) | n <- [1..1000]]

-- Comparación de eficiencia

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

-- ghci> listaSumaPrimaHD1 !! 600

-- 34004

-- (2.47 secs, 1565301720 bytes)

-- ghci> listaSumaPrimaHD2 !! 600

-- 34004

-- (0.02 secs, 7209000 bytes)

-- ghci> listaSumaPrimaHD3 !! 600

-- 34004

-- (0.01 secs, 1579920 bytes)

-- ghci> listaSumaPrimaHD2 !! 2000000

-- 3800024668046

-- (45.41 secs, 29056613824 bytes)

-- ghci> listaSumaPrimaHD3 !! 2000000

-- 3800024668046

-- (4.29 secs, 973265400 bytes)

Pares como sumas de pares

PorJosé A. Alonso 26-marzo-20151-mayo-2015

Todo número par se puede escribir como suma de números pares de varias formas. Por ejemplo,

   8 = 8 
     = 6 + 2
     = 4 + 4
     = 4 + 2 + 2
     = 2 + 2 + 2 + 2

8 = 8

= 6 + 2

= 4 + 4

= 4 + 2 + 2

= 2 + 2 + 2 + 2

Definir la función

   descomposicionesDecrecientes:: Integer -> [[Integer]]

1	descomposicionesDecrecientes:: Integer -> [[Integer]]

tal que (descomposicionesDecrecientes n) es la lista con las descomposiciones de n como suma de pares, en forma decreciente. Por ejemplo,

   ghci> descomposicionesDecrecientes 8
   [[8],[6,2],[4,4],[4,2,2],[2,2,2,2]]
   ghci> descomposicionesDecrecientes 10
   [[10],[8,2],[6,4],[6,2,2],[4,4,2],[4,2,2,2],[2,2,2,2,2]]
   ghci> length (descomposicionesDecrecientes 100)
   204226

ghci> descomposicionesDecrecientes 8

[[8],[6,2],[4,4],[4,2,2],[2,2,2,2]]

ghci> descomposicionesDecrecientes 10

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

ghci> length (descomposicionesDecrecientes 100)

204226

Soluciones

descomposicionesDecrecientes:: Integer -> [[Integer]]
descomposicionesDecrecientes 0 = [[0]]
descomposicionesDecrecientes n = aux n [n,n-2..2]
    where aux _ [] = []
          aux n (x:xs) | x > n     = aux n xs
                       | x == n    = [n] : aux n xs
                       | otherwise = map (x:) (aux (n-x) (x:xs)) ++ aux n xs

descomposicionesDecrecientes:: Integer -> [[Integer]]

descomposicionesDecrecientes 0 = [[0]]

descomposicionesDecrecientes n = aux n [n,n-2..2]

where aux _ [] = []

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

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

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

Mayor capicúa producto de dos números de n cifras

PorJosé A. Alonso 3-febrero-201525-abril-2021

Un capicúa es un número que es igual leído de izquierda a derecha que de derecha a izquierda.

Definir la función

   mayorCapicuaP :: Integer -> Integer

1	mayorCapicuaP :: Integer -> Integer

tal que (mayorCapicuaP n) es el mayor capicúa que es el producto de dos números de n cifras. Por ejemplo,

   mayorCapicuaP 2  ==  9009
   mayorCapicuaP 3  ==  906609
   mayorCapicuaP 4  ==  99000099
   mayorCapicuaP 5  ==  9966006699

mayorCapicuaP 2 == 9009

mayorCapicuaP 3 == 906609

mayorCapicuaP 4 == 99000099

mayorCapicuaP 5 == 9966006699

Soluciones

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

mayorCapicuaP1 :: Integer -> Integer
mayorCapicuaP1 n = head (capicuasP n)

-- (capicuasP n) es la lista de las capicúas de 2*n cifras que
-- pueden escribirse como productos de dos números de n cifras. Por
-- ejemplo, Por ejemplo,
--    ghci> capicuasP 2
--    [9009,8448,8118,8008,7227,7007,6776,6336,6006,5775,5445,5335,
--     5225,5115,5005,4884,4774,4664,4554,4224,4004,3773,3663,3003,
--     2992,2772,2552,2442,2332,2112,2002,1881,1771,1551,1221,1001]
capicuasP n = [x | x <- capicuas n,
                        not (null (productosDosNumerosCifras n x))]

-- (capicuas n) es la lista de las capicúas de 2*n cifras de mayor a
-- menor. Por ejemplo, 
--    capicuas 1           ==  [99,88,77,66,55,44,33,22,11]
--    take 7 (capicuas 2)  ==  [9999,9889,9779,9669,9559,9449,9339]
capicuas :: Integer -> [Integer]
capicuas n = [capicua x | x <- numerosCifras n]

-- (numerosCifras n) es la lista de los números de n cifras de mayor a
-- menor. Por ejemplo,
--    numerosCifras 1           ==  [9,8,7,6,5,4,3,2,1]
--    take 7 (numerosCifras 2)  ==  [99,98,97,96,95,94,93]
--    take 7 (numerosCifras 3)  ==  [999,998,997,996,995,994,993]
numerosCifras :: Integer -> [Integer]
numerosCifras n = [a,a-1..b]
    where a = 10^n-1
          b = 10^(n-1) 

-- (capicua n) es la capicúa formada añadiendo el inverso de n a
--  continuación de n. Por ejemplo,
--    capicua 93  ==  9339
capicua :: Integer -> Integer
capicua n = read (xs ++ (reverse xs))
    where xs = show n

-- (productosDosNumerosCifras n x) es la lista de los números y de n
-- cifras tales que existe un z de n cifras y x es el producto de y por
-- z. Por ejemplo, 
--    productosDosNumerosCifras 2 9009  ==  [99,91]
productosDosNumerosCifras n x = [y | y <- numeros,
                                     mod x y == 0,
                                     div x y `elem` numeros]
    where numeros = numerosCifras n

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

mayorCapicuaP2 :: Integer -> Integer
mayorCapicuaP2 n = maximum [x*y | x <- [a,a-1..b],
                                  y <- [a,a-1..b],
                                  esCapicua (x*y)] 
    where a = 10^n-1
          b = 10^(n-1)

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

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

mayorCapicuaP3 :: Integer -> Integer
mayorCapicuaP3 n = maximum [x*y | (x,y) <- pares a b, 
                                  esCapicua (x*y)] 
     where a = 10^n-1
           b = 10^(n-1)

-- (pares a b) es la lista de los pares de números entre a y b de forma
-- que su suma es decreciente. Por ejemplo,
--    pares 9 7  ==  [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)]
pares a b = [(x,z-x) | z <- [a1,a1-1..b1],
                       x <- [a,a-1..b],
                       x <= z-x, z-x <= a]
            where a1 = 2*a
                  b1 = 2*b

-- 4ª solución
-- ===========

mayorCapicuaP4 :: Integer -> Integer
mayorCapicuaP4 n = maximum [x | y <- [a..b],
                                z <- [y..b],
                                let x = y * z,
                                let s = show x,
                                s == reverse s]
     where a = 10^(n-1)
           b = 10^n-1
     
-- 5ª solución
-- ===========

mayorCapicuaP5 :: Integer -> Integer
mayorCapicuaP5 n = maximum [x*y | (x,y) <- pares2 b a, esCapicua (x*y)]
     where a = 10^(n-1)
           b = 10^n-1
                       
-- (pares2 a b) es la lista de los pares de números entre a y b de forma
-- que su suma es decreciente. Por ejemplo,
--    pares2 9 7  ==  [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)]
pares2 a b = [(x,y) | x <- [a,a-1..b], y <- [a,a-1..x]]

-- 6ª solución
-- ===========

mayorCapicuaP6 :: Integer -> Integer
mayorCapicuaP6 n = maximum [x*y | x <- [a..b], 
                                  y <- [x..b] , 
                                  esCapicua (x*y)]
     where a = 10^(n-1)
           b = 10^n-1
 
-- (cifras n) es la lista de las cifras de n en orden inverso. Por
-- ejemplo,  
--    cifras 325  == [5,2,3]
cifras :: Integer -> [Integer]
cifras n 
    | n < 10    = [n]
    | otherwise = (ultima n) : (cifras (quitarUltima n))

-- (ultima n) es la última cifra de n. Por ejemplo,
--    ultima 325  ==  5
ultima  :: Integer -> Integer
ultima n =  n - (n `div` 10)*10

-- (quitarUltima n) es el número obtenido al quitarle a n su última
-- cifra. Por ejemplo,
--    quitarUltima 325  =>  32 
quitarUltima :: Integer -> Integer
quitarUltima n = (n - (ultima n)) `div` 10

-- 7ª solución
-- ===========

mayorCapicuaP7 :: Integer -> Integer
mayorCapicuaP7 n = head [x | x <- capicuas n, esFactorizable x n]

-- (esFactorizable x n) se verifica si x se puede escribir como producto
-- de dos números de n dígitos. Por ejemplo,
--    esFactorizable 1219 2  ==  True
--    esFactorizable 1217 2  ==  False
esFactorizable x n = aux i x
    where b = 10^n-1
          i = floor (sqrt (fromIntegral x))
          aux i x | i > b          = False
                  | x `mod` i == 0 = x `div` i < b 
                  | otherwise      = aux (i+1) x

-- ---------------------------------------------------------------------
-- Comparación de soluciones                                          --
-- ---------------------------------------------------------------------

-- Tiempo (en segundos) de cálculo de (mayorCapicuaP n) con las 7
-- definiciones
--    +------+------+------+------+
--    | Def. | 2    | 3    | 4    |
--    |------+------+------+------|
--    |    1 | 0.01 | 0.13 | 1.39 |
--    |    2 | 0.03 | 2.07 |      |
--    |    3 | 0.05 | 3.86 |      |
--    |    4 | 0.01 | 0.89 |      |
--    |    5 | 0.03 | 1.23 |      |
--    |    6 | 0.02 | 1.03 |      |
--    |    7 | 0.01 | 0.02 | 0.02 |
--    +------+------+------+------+

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

-- 1ª solución

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

mayorCapicuaP1 :: Integer -> Integer

mayorCapicuaP1 n = head (capicuasP n)

-- (capicuasP n) es la lista de las capicúas de 2*n cifras que

-- pueden escribirse como productos de dos números de n cifras. Por

-- ejemplo, Por ejemplo,

-- ghci> capicuasP 2

-- [9009,8448,8118,8008,7227,7007,6776,6336,6006,5775,5445,5335,

-- 5225,5115,5005,4884,4774,4664,4554,4224,4004,3773,3663,3003,

-- 2992,2772,2552,2442,2332,2112,2002,1881,1771,1551,1221,1001]

capicuasP n = [x | x <- capicuas n,

not (null (productosDosNumerosCifras n x))]

-- (capicuas n) es la lista de las capicúas de 2*n cifras de mayor a

-- menor. Por ejemplo,

-- capicuas 1 == [99,88,77,66,55,44,33,22,11]

-- take 7 (capicuas 2) == [9999,9889,9779,9669,9559,9449,9339]

capicuas :: Integer -> [Integer]

capicuas n = [capicua x | x <- numerosCifras n]

-- (numerosCifras n) es la lista de los números de n cifras de mayor a

-- menor. Por ejemplo,

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

-- take 7 (numerosCifras 2) == [99,98,97,96,95,94,93]

-- take 7 (numerosCifras 3) == [999,998,997,996,995,994,993]

numerosCifras :: Integer -> [Integer]

numerosCifras n = [a,a-1..b]

where a = 10^n-1

b = 10^(n-1)

-- (capicua n) es la capicúa formada añadiendo el inverso de n a

-- continuación de n. Por ejemplo,

-- capicua 93 == 9339

capicua :: Integer -> Integer

capicua n = read (xs ++ (reverse xs))

where xs = show n

-- (productosDosNumerosCifras n x) es la lista de los números y de n

-- cifras tales que existe un z de n cifras y x es el producto de y por

-- z. Por ejemplo,

-- productosDosNumerosCifras 2 9009 == [99,91]

productosDosNumerosCifras n x = [y | y <- numeros,

mod x y == 0,

div x y `elem` numeros]

where numeros = numerosCifras n

-- 2ª solución

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

mayorCapicuaP2 :: Integer -> Integer

mayorCapicuaP2 n = maximum [x*y | x <- [a,a-1..b],

y <- [a,a-1..b],

esCapicua (x*y)]

where a = 10^n-1

b = 10^(n-1)

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

-- esCapicua 353 == True

-- esCapicua 357 == False

esCapicua :: Integer -> Bool

esCapicua n = xs == reverse xs

where xs = show n

-- 3ª solución

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

mayorCapicuaP3 :: Integer -> Integer

mayorCapicuaP3 n = maximum [x*y | (x,y) <- pares a b,

esCapicua (x*y)]

where a = 10^n-1

b = 10^(n-1)

-- (pares a b) es la lista de los pares de números entre a y b de forma

-- que su suma es decreciente. Por ejemplo,

-- pares 9 7 == [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)]

pares a b = [(x,z-x) | z <- [a1,a1-1..b1],

x <- [a,a-1..b],

x <= z-x, z-x <= a]

where a1 = 2*a

b1 = 2*b

-- 4ª solución

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

mayorCapicuaP4 :: Integer -> Integer

mayorCapicuaP4 n = maximum [x | y <- [a..b],

z <- [y..b],

let x = y * z,

let s = show x,

s == reverse s]

where a = 10^(n-1)

b = 10^n-1

-- 5ª solución

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

mayorCapicuaP5 :: Integer -> Integer

mayorCapicuaP5 n = maximum [x*y | (x,y) <- pares2 b a, esCapicua (x*y)]

where a = 10^(n-1)

b = 10^n-1

-- (pares2 a b) es la lista de los pares de números entre a y b de forma

-- que su suma es decreciente. Por ejemplo,

-- pares2 9 7 == [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)]

pares2 a b = [(x,y) | x <- [a,a-1..b], y <- [a,a-1..x]]

-- 6ª solución

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

mayorCapicuaP6 :: Integer -> Integer

mayorCapicuaP6 n = maximum [x*y | x <- [a..b],

y <- [x..b] ,

esCapicua (x*y)]

where a = 10^(n-1)

b = 10^n-1

-- (cifras n) es la lista de las cifras de n en orden inverso. Por

-- ejemplo,

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

cifras :: Integer -> [Integer]

cifras n

| n < 10 = [n]

| otherwise = (ultima n) : (cifras (quitarUltima n))

-- (ultima n) es la última cifra de n. Por ejemplo,

-- ultima 325 == 5

ultima :: Integer -> Integer

ultima n = n - (n `div` 10)*10

-- (quitarUltima n) es el número obtenido al quitarle a n su última

-- cifra. Por ejemplo,

-- quitarUltima 325 => 32

quitarUltima :: Integer -> Integer

quitarUltima n = (n - (ultima n)) `div` 10

-- 7ª solución

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

mayorCapicuaP7 :: Integer -> Integer

mayorCapicuaP7 n = head [x | x <- capicuas n, esFactorizable x n]

-- (esFactorizable x n) se verifica si x se puede escribir como producto

-- de dos números de n dígitos. Por ejemplo,

-- esFactorizable 1219 2 == True

-- esFactorizable 1217 2 == False

esFactorizable x n = aux i x

where b = 10^n-1

i = floor (sqrt (fromIntegral x))

aux i x | i > b = False

| x `mod` i == 0 = x `div` i < b

| otherwise = aux (i+1) x

-- ---------------------------------------------------------------------

-- Comparación de soluciones --

-- ---------------------------------------------------------------------

-- Tiempo (en segundos) de cálculo de (mayorCapicuaP n) con las 7

-- definiciones

-- +------+------+------+------+

-- | Def. | 2 | 3 | 4 |

-- |------+------+------+------|

-- | 1 | 0.01 | 0.13 | 1.39 |

-- | 2 | 0.03 | 2.07 | |

-- | 3 | 0.05 | 3.86 | |

-- | 4 | 0.01 | 0.89 | |

-- | 5 | 0.03 | 1.23 | |

-- | 6 | 0.02 | 1.03 | |

-- | 7 | 0.01 | 0.02 | 0.02 |

-- +------+------+------+------+

Mezcla de infinitas listas infinitas

PorJosé A. Alonso 15-enero-201525-abril-2021

Definir la función

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

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

tal que (mezclaTodas xss) es la mezcla ordenada de xss, donde tanto xss como sus elementos son listas infinitas ordenadas. Por ejemplo,

   ghci> take 10 (mezclaTodas [[n,2*n..] | n <- [2..]])
   [2,3,4,5,6,7,8,9,10,11]
   ghci> take 10 (mezclaTodas [[n,2*n..] | n <- [2,9..]])
   [2,4,6,8,9,10,12,14,16,18]

ghci> take 10 (mezclaTodas [[n,2*n..] | n <- [2..]])

[2,3,4,5,6,7,8,9,10,11]

ghci> take 10 (mezclaTodas [[n,2*n..] | n <- [2,9..]])

[2,4,6,8,9,10,12,14,16,18]

Soluciones

mezclaTodas :: Ord a => [[a]] -> [a]
mezclaTodas = foldr1 xmezcla
    where xmezcla (x:xs) ys = x : mezcla xs ys

mezcla :: Ord a => [a] -> [a] -> [a]
mezcla (x:xs) (y:ys) | x < y  = x : mezcla xs (y:ys)
                     | x == y = x : mezcla xs ys
                     | x > y  = y : mezcla (x:xs) ys

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

mezclaTodas = foldr1 xmezcla

where xmezcla (x:xs) ys = x : mezcla xs ys

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

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

| x == y = x : mezcla xs ys

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

Triángulos de Herón

PorJosé A. Alonso 9-enero-201530-noviembre-2015

Un triángulo de Herón es un triángulo tal que sus lados y su área son números enteros. Su nombre se debe al matemático griego Herón de Alejandría que descubrió la fórmula para calcular el área de un triángulo a partir de sus lados.

La fórmula de Herón dice que el área de un triángulo cuyos lados miden a, b y c es
$\sqrt{s(s-a)(s-b)(s-c)}$
donde s es el semiperímetro del triángulo; es decir,
$s = \displaystyle \frac{a+b+c}{2}$

Un ejemplo de triángulo de Herón es el triángulo de lados 3, 4 y 5 cuya área es 6. Se puede observar que cualquier triángulo cuyos lados sean múltiplos de 3, 4 y 5 también es de Herón; por ejemplo, el de lados 6, 8 y 10 también lo es.

Se dice que un triángulo de Herón es primitivo si el máximo común divisor de sus lados es 1. Por ejemplo, el de lados 3, 4 y 5 es primitivo; pero el de lados 6, 8 y 10 no lo es.

Definir la sucesión

   triangulosHeronPrimitivos :: [(Int,Int,Int)]

1	triangulosHeronPrimitivos :: [(Int,Int,Int)]

tal que sus elementos son los triángulos de Herón primitivos ordenados por su perímetro. Por ejemplo,

   ghci> take 7 triangulosHeronPrimitivos
   [(3,4,5),(5,5,6),(5,5,8),(5,12,13),(4,13,15),(10,13,13),(9,10,17)]

1 2	ghci> take 7 triangulosHeronPrimitivos [(3,4,5),(5,5,6),(5,5,8),(5,12,13),(4,13,15),(10,13,13),(9,10,17)]

Soluciones

triangulosHeronPrimitivos :: [(Int,Int,Int)]
triangulosHeronPrimitivos =
    [(a,b,c) | n <- [3..], 
               c <- [1..n], 
               b <- [1..c], 
               let a = n-b-c, 
               0 < a, a <= b,
               esTrianguloHeronPrimitivo a b c]

-- (esTrianguloHeronPrimitivo a b c) se verifica si a, b y c 
-- (con a <= b <= c) son los lados de un triángulo de Herón
-- primitivo. Por ejemplo,  
--    esTrianguloHeronPrimitivo 3 4  5  ==  True
--    esTrianguloHeronPrimitivo 1 1  2  ==  False
--    esTrianguloHeronPrimitivo 6 8 10  ==  False
esTrianguloHeronPrimitivo :: Int -> Int -> Int -> Bool
esTrianguloHeronPrimitivo a b c =
    esTriangulo a b c && 
    mcd a b c == 1 &&
    p `mod` 2 == 0 && 
    esCuadrado (s*(s-a)*(s-b)*(s-c))
    where p = a+b+c
          s = p `div` 2

-- (esTriangulo a b c) se verifica si los números a, b y c (con a <= b <= c)
-- pueden ser los lados de un triángulo (es decir, cada uno es menor que
-- la suma de los otros dos). Por ejemplo,
--    esTriangulo 3 4 5  ==  True
--    esTriangulo 1 1 2  ==  False
esTriangulo :: Int -> Int -> Int -> Bool
esTriangulo a b c = c < a+b

-- (esCuadrado n) se verifica si n es un cuadrado perfecto. Por ejemplo, 
--    esCuadrado 25  ==  True
--    esCuadrado 26  ==  False
esCuadrado :: Int -> Bool
esCuadrado n = x*x == n
    where x = round (sqrt (fromIntegral n))

-- (mcd a b c) es el máximo común divisor de a, b y c. Por ejemplo, 
--    mcd 3 4 5   ==  1
--    mcd 6 8 10  ==  2
mcd :: Int -> Int -> Int -> Int
mcd a b c = gcd a (gcd b c)

triangulosHeronPrimitivos :: [(Int,Int,Int)]

triangulosHeronPrimitivos =

[(a,b,c) | n <- [3..],

c <- [1..n],

b <- [1..c],

let a = n-b-c,

0 < a, a <= b,

esTrianguloHeronPrimitivo a b c]

-- (esTrianguloHeronPrimitivo a b c) se verifica si a, b y c

-- (con a <= b <= c) son los lados de un triángulo de Herón

-- primitivo. Por ejemplo,

-- esTrianguloHeronPrimitivo 3 4 5 == True

-- esTrianguloHeronPrimitivo 1 1 2 == False

-- esTrianguloHeronPrimitivo 6 8 10 == False

esTrianguloHeronPrimitivo :: Int -> Int -> Int -> Bool

esTrianguloHeronPrimitivo a b c =

esTriangulo a b c &&

mcd a b c == 1 &&

p `mod` 2 == 0 &&

esCuadrado (s*(s-a)*(s-b)*(s-c))

where p = a+b+c

s = p `div` 2

-- (esTriangulo a b c) se verifica si los números a, b y c (con a <= b <= c)

-- pueden ser los lados de un triángulo (es decir, cada uno es menor que

-- la suma de los otros dos). Por ejemplo,

-- esTriangulo 3 4 5 == True

-- esTriangulo 1 1 2 == False

esTriangulo :: Int -> Int -> Int -> Bool

esTriangulo a b c = c < a+b

-- (esCuadrado n) se verifica si n es un cuadrado perfecto. Por ejemplo,

-- esCuadrado 25 == True

-- esCuadrado 26 == False

esCuadrado :: Int -> Bool

esCuadrado n = x*x == n

where x = round (sqrt (fromIntegral n))

-- (mcd a b c) es el máximo común divisor de a, b y c. Por ejemplo,

-- mcd 3 4 5 == 1

-- mcd 6 8 10 == 2

mcd :: Int -> Int -> Int -> Int

mcd a b c = gcd a (gcd b c)

Varios cuadrados encajados rotando

PorJosé A. Alonso 7-enero-20151-mayo-2016

Enunciado

Definir la función

   cuadrados :: Int -> Float -> Picture

1	cuadrados :: Int -> Float -> Picture

de forma que (cuadrados n) sea la animación obtenida rotando n cuadrados encajados como se muestra a continuación.

Nota: Escribir las soluciones usando la siguiente plantilla

import Graphics.Gloss
import System.IO
    
main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  putStr "Introduce el numero de cuadrados [1..10]: "
  n <- readLn
  animate (InWindow (show n ++ " cuadrados encajados rotando" ) 
                    (600,600) (20,20)) white (cuadrados n)

cuadrados :: Int -> Float -> Picture
cuadrados n t = undefined

import Graphics.Gloss

import System.IO

main :: IO ()

main = do

hSetBuffering stdout NoBuffering

putStr "Introduce el numero de cuadrados [1..10]: "

n <- readLn

animate (InWindow (show n ++ " cuadrados encajados rotando" )

(600,600) (20,20)) white (cuadrados n)

cuadrados :: Int -> Float -> Picture

cuadrados n t = undefined

Soluciones

import Graphics.Gloss
import System.IO
    
main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  putStr "Introduce el numero de cuadrados [1..10]: "
  n <- readLn
  animate (InWindow (show n ++ " cuadrados encajados rotando" ) 
                    (600,600) (20,20)) white (cuadrados n)

-- 1ª solución (por comprensión):
cuadrados :: Int -> Float -> Picture
cuadrados n t = 
    pictures [rotate (6*(fromIntegral n)*t) $ 
              scale (r^n) (r^n) $ rotate (g n) $ cuadrado | n <- [0..n-1]]
    where cuadrado        = rectangleWire 400 400
          g n | even n    = 0
              | otherwise = 45
          r               = 1 / sqrt 2

-- 2ª solución (por recursión):
cuadrados2 :: Int -> Float -> Picture
cuadrados2 1 _ = rectangleWire 500 500
cuadrados2 n t = 
    pictures [rectangleWire 500 500,
              rotate (45+10*t) $ 
              scale (1/sqrt 2) (1/sqrt 2) (cuadrados2 (n-1) t)]

import Graphics.Gloss

import System.IO

main :: IO ()

main = do

hSetBuffering stdout NoBuffering

putStr "Introduce el numero de cuadrados [1..10]: "

n <- readLn

animate (InWindow (show n ++ " cuadrados encajados rotando" )

(600,600) (20,20)) white (cuadrados n)

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

cuadrados :: Int -> Float -> Picture

cuadrados n t =

pictures [rotate (6*(fromIntegral n)*t) $

scale (r^n) (r^n) $ rotate (g n) $ cuadrado | n <- [0..n-1]]

where cuadrado = rectangleWire 400 400

g n | even n = 0

| otherwise = 45

r = 1 / sqrt 2

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

cuadrados2 :: Int -> Float -> Picture

cuadrados2 1 _ = rectangleWire 500 500

cuadrados2 n t =

pictures [rectangleWire 500 500,

rotate (45+10*t) $

scale (1/sqrt 2) (1/sqrt 2) (cuadrados2 (n-1) t)]

Simplificación de expresiones booleanas

PorJosé A. Alonso 2-enero-201525-abril-2021

El siguiente tipo de dato algebraico representa las expresiones booleanas construidas con una variable (X), las constantes verdadera (V) y falsa (F), la negación (Neg) y la disyunción (Dis):

   data Expr = X
             | V
             | F
             | Neg Expr
             | Dis Expr Expr
             deriving (Eq, Ord, Show)

data Expr = X

| V

| F

| Neg Expr

| Dis Expr Expr

deriving (Eq, Ord, Show)

Por ejemplo, la expresión (¬X v V) se representa por (Dis (Neg X) V).

Definir las funciones

   valor      :: Expr -> Bool -> Bool 
   simplifica :: Expr -> Expr

1 2	valor :: Expr -> Bool -> Bool simplifica :: Expr -> Expr

tales que (valor p i) es el valor de la expresión p cuando se le asigna a X el valor i. Por ejemplo,

   valor (Neg X) True           ==  False
   valor (Neg F) True           ==  True
   valor (Dis X (Neg X)) True   ==  True
   valor (Dis X (Neg X)) False  ==  True

valor (Neg X) True == False

valor (Neg F) True == True

valor (Dis X (Neg X)) True == True

valor (Dis X (Neg X)) False == True

y (simplifica p) es la expresión obtenida aplicándole a p las siguientes reglas de simplificación:

   Neg V       = F
   Neg F       = V
   Neg (Neg q) = q
   Dis V q     = V
   Dis F q     = q
   Dis q V     = V
   Dis q F     = F
   Dis q q     = q

Neg V = F

Neg F = V

Neg (Neg q) = q

Dis V q = V

Dis F q = q

Dis q V = V

Dis q F = F

Dis q q = q

Por ejemplo,

   simplifica (Dis X (Neg (Neg X)))                      ==  X
   simplifica (Neg (Dis (Neg (Neg X)) F))                ==  Neg X
   simplifica (Dis (Neg F) F)                            ==  V
   simplifica (Dis (Neg V) (Neg (Dis (Neg X) F)))        ==  X
   simplifica (Dis (Neg V) (Neg (Dis (Neg (Neg X)) F)))  ==  Neg X

simplifica (Dis X (Neg (Neg X))) == X

simplifica (Neg (Dis (Neg (Neg X)) F)) == Neg X

simplifica (Dis (Neg F) F) == V

simplifica (Dis (Neg V) (Neg (Dis (Neg X) F))) == X

simplifica (Dis (Neg V) (Neg (Dis (Neg (Neg X)) F))) == Neg X

Comprobar con QuickCheck que para cualquier expresión p y cualquier booleano i se verifica que (valor (simplifica p) i) es igual a (valor p i).

Nota: Escribir las soluciones usando la siguiente plantilla que contiene un generador de expresiones booleanas

import Test.QuickCheck
import Control.Monad 

data Expr = X
          | V
          | F
          | Neg Expr
          | Dis Expr Expr
          deriving (Eq, Ord, Show)

valor :: Expr -> Bool -> Bool 
valor = undefined

simplifica :: Expr -> Expr
simplifica = undefined

-- La propiedad es
prop_simplifica :: Expr -> Bool -> Bool
prop_simplifica p i = undefined

-- La comprobación es

-- Generador de expresións
instance Arbitrary Expr where
    arbitrary = sized expr
        where expr n | n <= 0    = atom
                     | otherwise = oneof [ atom
                                         , liftM Neg subexpr
                                         , liftM2 Dis subexpr subexpr ]
                     where atom    = oneof [elements [X,V,F]]
                           subexpr = expr (n `div` 2)

import Test.QuickCheck

import Control.Monad

data Expr = X

| V

| F

| Neg Expr

| Dis Expr Expr

deriving (Eq, Ord, Show)

valor :: Expr -> Bool -> Bool

valor = undefined

simplifica :: Expr -> Expr

simplifica = undefined

-- La propiedad es

prop_simplifica :: Expr -> Bool -> Bool

prop_simplifica p i = undefined

-- La comprobación es

-- Generador de expresións

instance Arbitrary Expr where

arbitrary = sized expr

where expr n | n <= 0 = atom

| otherwise = oneof [ atom

, liftM Neg subexpr

, liftM2 Dis subexpr subexpr ]

where atom = oneof [elements [X,V,F]]

subexpr = expr (n `div` 2)

Soluciones

import Test.QuickCheck
import Control.Monad 

data Expr = X
          | V
          | F
          | Neg Expr
          | Dis Expr Expr
          deriving (Eq, Ord, Show)

valor :: Expr -> Bool -> Bool 
valor X i         = i
valor V _         = True
valor F _         = False
valor (Neg p) i   = not (valor p i)
valor (Dis p q) i = valor p i || valor q i

simplifica :: Expr -> Expr
simplifica X = X
simplifica V = V
simplifica F = F
simplifica (Neg p) = negacion (simplifica p)
    where negacion V       = F
          negacion F       = V
          negacion (Neg p) = p
          negacion p       = Neg p
simplifica (Dis p q) = disyuncion (simplifica p) (simplifica q)
    where disyuncion V q = V
          disyuncion F q = q
          disyuncion q V = V
          disyuncion q F = q
          disyuncion p q | p == q    = p
                         | otherwise = Dis p q

-- La propiedad es
prop_simplifica :: Expr -> Bool -> Bool
prop_simplifica p i =
    valor (simplifica p) i == valor p i

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

-- Generador de expresiones
instance Arbitrary Expr where
    arbitrary = sized expr
        where expr n | n <= 0    = atom
                     | otherwise = oneof [ atom
                                         , liftM Neg subexpr
                                         , liftM2 Dis subexpr subexpr ]
                     where atom    = oneof [elements [X,V,F]]
                           subexpr = expr (n `div` 2)

import Test.QuickCheck

import Control.Monad

data Expr = X

| V

| F

| Neg Expr

| Dis Expr Expr

deriving (Eq, Ord, Show)

valor :: Expr -> Bool -> Bool

valor X i = i

valor V _ = True

valor F _ = False

valor (Neg p) i = not (valor p i)

valor (Dis p q) i = valor p i || valor q i

simplifica :: Expr -> Expr

simplifica X = X

simplifica V = V

simplifica F = F

simplifica (Neg p) = negacion (simplifica p)

where negacion V = F

negacion F = V

negacion (Neg p) = p

negacion p = Neg p

simplifica (Dis p q) = disyuncion (simplifica p) (simplifica q)

where disyuncion V q = V

disyuncion F q = q

disyuncion q V = V

disyuncion q F = q

disyuncion p q | p == q = p

| otherwise = Dis p q

-- La propiedad es

prop_simplifica :: Expr -> Bool -> Bool

prop_simplifica p i =

valor (simplifica p) i == valor p i

-- La comprobación es

-- ghci> quickCheck prop_simplifica

-- +++ OK, passed 100 tests.

-- Generador de expresiones

instance Arbitrary Expr where

arbitrary = sized expr

where expr n | n <= 0 = atom

| otherwise = oneof [ atom

, liftM Neg subexpr

, liftM2 Dis subexpr subexpr ]

where atom = oneof [elements [X,V,F]]

subexpr = expr (n `div` 2)

2015 como raíz cuadrada de la suma de tres cubos

PorJosé A. Alonso 19-diciembre-20141-mayo-2016

Todos los años, en las proximidades del final de año suelen aparecer cuestiones con propiedades del número del nuevo año. Una sobre el 2015 es la publicada el martes en la entrada 2015 como raíz de la suma de tres cubos del blog Números y algo más en la que se pide calcular tres números tales que 2015 sea igual a la raíz cuadrada de la suma de dichos tres números.

A partir de dicha entrada, se propone el siguiente problema: Definir la sucesión

   raicesCuadradasDeSumasDe3Cubos :: [Integer]

1	raicesCuadradasDeSumasDe3Cubos :: [Integer]

cuyos elementos son los números que se pueden escribir como raíces cuadradas de sumas de tres cubos. Por ejemplo,

   take 9 raicesCuadradasDeSumasDe3Cubos = [6,9,15,27,48,72,53,59,78]

1	take 9 raicesCuadradasDeSumasDe3Cubos = [6,9,15,27,48,72,53,59,78]

El 6 está en la sucesión porque 1³+2³+3³ = 36 y la raíz cuadrada de36 es 6 y el 9 está porque 3³+3³+3³ = 81 y la raíz cuadrada de 81 es 9. Algunos números tienen varias descomposiones como raíz cuadrada de suma de tres cubos; por ejemplo, el 71 se puede escribir como la raíz cuadrada de la suma de los cubos de 6, 9 y 16 y también como la de 4, 4, y 17.

A partir de la sucesión se plantean las siguientes cuestiones:

¿Qué lugar ocupa el 2015 en la sucesión?
¿Cuál será el próximo año que se podrá escribir como la raíz cuadrada de suma de tres cubos?
¿Cuáles son las descomposiciones de 2015 como raíz cuadrada de suma de tres cubos?
¿Cuáles son los años hasta el 2015 que se pueden escribir como raíz cuadrada de suma de tres cubos de más formas distintas?

Soluciones

import Data.List (sort)

raicesCuadradasDeSumasDe3Cubos :: [Integer]
raicesCuadradasDeSumasDe3Cubos =
    [n | n <- [1..], not (null (descomposiciones n))]

-- (descomposiciones n) es la lista de ternas de números tales que n es la
-- raíz cuadrada de la suma de los cubos de los tres números de la
-- terna. Por ejemplo,
--    descomposiciones  6  ==  [(1,2,3)]
--    descomposiciones  9  ==  [(3,3,3)]
--    descomposiciones 71  ==  [(6,9,16),(4,4,17)]
descomposiciones :: Integer -> [(Integer,Integer,Integer)]
descomposiciones n = 
    [(a,b,c) | c <- [1..floor ((fromIntegral (n*n))**(1/3))],
               b <- [1..c],
               let d = n^2 - c^3 - b^3,
               d > 0,
               let a = round ((fromIntegral d)**(1/3)),
               a <= b,
               a^3 == d]    

-- El cálculo de la posición de 2015 es
--    ghci> length (takeWhile (<=2015) raicesCuadradasDeSumasDe3Cubos)
--    343

-- El cálculo del próximo año expresable como la raízcuadrada de la suma
-- de tres cubos es
--    ghci> head (dropWhile (<=2015) raicesCuadradasDeSumasDe3Cubos)
--    2022

-- (masDescomponibles xs) es la lista de elementos de xs que se pueden
-- escribir de más formas como raíz cuadrada de suma de tres cubos.
masDescomponibles :: [Integer] -> [Integer]
masDescomponibles xs =
    [y | (x,y) <- takeWhile (\p -> fst p == u) zs]
    where zs = reverse (sort [(length (descomposiciones x),x) | x <- xs])
          u  = fst (head zs)

-- El cálculo de los años hasta el 2015 con mayor número de
-- descomposiciones es
--    ghci> masDescomponibles (takeWhile (<=2015) raicesCuadradasDeSumasDe3Cubos)
--    [1728]

import Data.List (sort)

raicesCuadradasDeSumasDe3Cubos :: [Integer]

raicesCuadradasDeSumasDe3Cubos =

[n | n <- [1..], not (null (descomposiciones n))]

-- (descomposiciones n) es la lista de ternas de números tales que n es la

-- raíz cuadrada de la suma de los cubos de los tres números de la

-- terna. Por ejemplo,

-- descomposiciones 6 == [(1,2,3)]

-- descomposiciones 9 == [(3,3,3)]

-- descomposiciones 71 == [(6,9,16),(4,4,17)]

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

descomposiciones n =

[(a,b,c) | c <- [1..floor ((fromIntegral (n*n))**(1/3))],

b <- [1..c],

let d = n^2 - c^3 - b^3,

d > 0,

let a = round ((fromIntegral d)**(1/3)),

a <= b,

a^3 == d]

-- El cálculo de la posición de 2015 es

-- ghci> length (takeWhile (<=2015) raicesCuadradasDeSumasDe3Cubos)

-- 343

-- El cálculo del próximo año expresable como la raízcuadrada de la suma

-- de tres cubos es

-- ghci> head (dropWhile (<=2015) raicesCuadradasDeSumasDe3Cubos)

-- 2022

-- (masDescomponibles xs) es la lista de elementos de xs que se pueden

-- escribir de más formas como raíz cuadrada de suma de tres cubos.

masDescomponibles :: [Integer] -> [Integer]

masDescomponibles xs =

[y | (x,y) <- takeWhile (\p -> fst p == u) zs]

where zs = reverse (sort [(length (descomposiciones x),x) | x <- xs])

u = fst (head zs)

-- El cálculo de los años hasta el 2015 con mayor número de

-- descomposiciones es

-- ghci> masDescomponibles (takeWhile (<=2015) raicesCuadradasDeSumasDe3Cubos)

-- [1728]

Fractal de la curva del dragón

PorJosé A. Alonso 18-diciembre-201427-diciembre-2014

La curva del dragón es un fractal que se construye siguiendo los siguientes pasos:

A partir de un segmento, se construye el triángulo rectángulo e isósceles, como lo muestra las dos primeras figuras. Luego se borra el segmento inicial.
Se repite varias veces el proceso de remplazar un segmento por otros dos para cada línea de la curva, alternando siempre la orientación de los triángulos.

La siguiente figura muestra los trece primeros pasos:

El ejercicio consiste en definir (en CodeWorld) la función

   dragon :: Number -> Picture

1	dragon :: Number -> Picture

tal que dragon(n) es el dibujo correspondiente al paso n de la construcción de la curva del dragón. Por ejemplo, el dibujo de dragon(20) es

Comentarios

La descripción de la curva dragón es la que se encuentra en el artículo de la Wikipedia.
Una definición análoga es la del fractal de la curva de Koch.

Soluciones

main = pictureOf(translate(dragon(20), 1, -2))

dragon :: Number -> Picture
dragon(0) = line[(-6, 0), (6, 0)]
dragon(n) = translate(rotate(sub, 45),  -3, 3) &
            translate(rotate(sub, 135), 3, 3)
  where sub = scale(dragon(n-1), 1 / sqrt(2), 1 / sqrt(2))

main = pictureOf(translate(dragon(20), 1, -2))

dragon :: Number -> Picture

dragon(0) = line[(-6, 0), (6, 0)]

dragon(n) = translate(rotate(sub, 45), -3, 3) &

translate(rotate(sub, 135), 3, 3)

where sub = scale(dragon(n-1), 1 / sqrt(2), 1 / sqrt(2))

Juego de bloques con letras

PorJosé A. Alonso 12-diciembre-201425-abril-2021

Introducción

Para el juego de los bloques se dispone de un conjunto de bloques con una letra en cada una de sus dos caras. El objetivo del juego consiste en formar palabras sin que se pueda usar un bloque más de una vez y sin diferenciar mayúsculas de minúsculas. Por ejemplo, si se tiene tres bloques de forma que el 1º tiene las letras A y B, el 2ª la N y la O y el 3º la O y la A entonces se puede obtener la palabra ANA de dos formas: una con los bloques 1, 2 y 3 y otra con los 3, 2 y 1.

Enunciado

-- Definir la función 
--    soluciones :: [String] -> String -> [[String]]
-- tal que (soluciones bs cs) es la lista de las soluciones del juego de
-- los bloque usando los bloques bs (cada bloque es una cadena de dos
-- letras mayúsculas) para formar la palabra cs. Por ejemplo,
--    ghci> soluciones ["AB","NO","OA"] "ANA"
--    [["AB","NO","OA"],["OA","NO","AB"]]
--    ghci> soluciones ["AB","NE","OA"] "Bea"
--    [["AB","NE","OA"]]
--    ghci> soluciones ["AB","NE","OA"] "EvA"
--    []
--    ghci> soluciones ["AB","NO","OA","NC"] "ANA"
--    [["AB","NO","OA"],["AB","NC","OA"],["OA","NO","AB"],["OA","NC","AB"]]
--    ghci> soluciones ["AB","NO","OA","NC"] "Anca"
--    [["AB","NO","NC","OA"],["OA","NO","NC","AB"]]

-- Definir la función

-- soluciones :: [String] -> String -> [[String]]

-- tal que (soluciones bs cs) es la lista de las soluciones del juego de

-- los bloque usando los bloques bs (cada bloque es una cadena de dos

-- letras mayúsculas) para formar la palabra cs. Por ejemplo,

-- ghci> soluciones ["AB","NO","OA"] "ANA"

-- [["AB","NO","OA"],["OA","NO","AB"]]

-- ghci> soluciones ["AB","NE","OA"] "Bea"

-- [["AB","NE","OA"]]

-- ghci> soluciones ["AB","NE","OA"] "EvA"

-- []

-- ghci> soluciones ["AB","NO","OA","NC"] "ANA"

-- [["AB","NO","OA"],["AB","NC","OA"],["OA","NO","AB"],["OA","NC","AB"]]

-- ghci> soluciones ["AB","NO","OA","NC"] "Anca"

-- [["AB","NO","NC","OA"],["OA","NO","NC","AB"]]

Soluciones

import Data.List (delete)
import Data.Char (toUpper)

soluciones :: [String] -> String -> [[String]]
soluciones _ []      = [[]]
soluciones bs (c:cs) = [b:rs | b <- bs, 
                               toUpper c `elem` b,
                               rs <- soluciones (delete b bs) cs]

import Data.List (delete)

import Data.Char (toUpper)

soluciones :: [String] -> String -> [[String]]

soluciones _ [] = [[]]

soluciones bs (c:cs) = [b:rs | b <- bs,

toUpper c `elem` b,

rs <- soluciones (delete b bs) cs]

Normalización de expresiones aritméticas

PorJosé A. Alonso 10-diciembre-201425-abril-2021

Enunciado

-- El siguiente tipo de dato representa expresiones construidas con
-- variables, sumas y productos
--    data Expr = V String
--              | S Expr Expr
--              | P Expr Expr
--              deriving (Eq, Show)
-- Por ejemplo, x*(y+z) se representa por (P (V "x") (S (V "y") (V "z"))) 
-- 
-- Una expresión es un término si es un producto de variables. Por
-- ejemplo, x*(y*z) es un término pero x+(y*z) ni x*(y+z) lo son.
--
-- Una expresión está en forma normal si es una suma de términos. Por
-- ejemplo, x*(y*z) y x+(y*z) está en forma normal; pero x*(y+z) y
-- (x+y)*(x+z) no lo están. 
-- 
-- Definir la función 
--    normal :: Expr -> Expr
-- tal que (normal e) es la forma normal de la expresión e obtenida
-- aplicando, mientras que sea posible, las propiedades distributivas:
--    (a+b)*c = a*c+b*c
--    c*(a+b) = c*a+c*b
-- Por ejemplo,
--    ghci> normal (P (S (V "x") (V "y")) (V "z"))
--    S (P (V "x") (V "z")) (P (V "y") (V "z"))
--    ghci> normal (P (V "z") (S (V "x") (V "y")))
--    S (P (V "z") (V "x")) (P (V "z") (V "y"))
--    ghci> normal (P (S (V "x") (V "y")) (S (V "u") (V "v")))
--    S (S (P (V "x") (V "u")) (P (V "x") (V "v"))) 
--      (S (P (V "y") (V "u")) (P (V "y") (V "v")))
--    ghci> normal (S (P (V "x") (V "y")) (V "z"))
--    S (P (V "x") (V "y")) (V "z")
--    ghci> normal (V "x")
--    V "x"
--
-- Comprobar con QuickCheck (usando la función esNormal del ejercicio
-- del 2 de diciembre) que para cualquier expresión e, (normal e) está en
-- forma normal y que (normal (normal e)) es igual a (normal e).
--
-- Nota. Para la comprobación se usará el siguiente generador de
-- expresiones aritméticas:
--    instance Arbitrary Expr where
--        arbitrary = sized arb 
--            where
--              arb 0          =  liftM V arbitrary
--              arb n | n > 0  =  oneof [liftM V arbitrary,
--                                       liftM2 S sub sub, 
--                                       liftM2 P sub sub] 
--                    where sub = arb (n `div` 2)

-- El siguiente tipo de dato representa expresiones construidas con

-- variables, sumas y productos

-- data Expr = V String

-- | S Expr Expr

-- | P Expr Expr

-- deriving (Eq, Show)

-- Por ejemplo, x*(y+z) se representa por (P (V "x") (S (V "y") (V "z")))

-- Una expresión es un término si es un producto de variables. Por

-- ejemplo, x*(y*z) es un término pero x+(y*z) ni x*(y+z) lo son.

-- Una expresión está en forma normal si es una suma de términos. Por

-- ejemplo, x*(y*z) y x+(y*z) está en forma normal; pero x*(y+z) y

-- (x+y)*(x+z) no lo están.

-- Definir la función

-- normal :: Expr -> Expr

-- tal que (normal e) es la forma normal de la expresión e obtenida

-- aplicando, mientras que sea posible, las propiedades distributivas:

-- (a+b)*c = a*c+b*c

-- c*(a+b) = c*a+c*b

-- Por ejemplo,

-- ghci> normal (P (S (V "x") (V "y")) (V "z"))

-- S (P (V "x") (V "z")) (P (V "y") (V "z"))

-- ghci> normal (P (V "z") (S (V "x") (V "y")))

-- S (P (V "z") (V "x")) (P (V "z") (V "y"))

-- ghci> normal (P (S (V "x") (V "y")) (S (V "u") (V "v")))

-- S (S (P (V "x") (V "u")) (P (V "x") (V "v")))

-- (S (P (V "y") (V "u")) (P (V "y") (V "v")))

-- ghci> normal (S (P (V "x") (V "y")) (V "z"))

-- S (P (V "x") (V "y")) (V "z")

-- ghci> normal (V "x")

-- V "x"

-- Comprobar con QuickCheck (usando la función esNormal del ejercicio

-- del 2 de diciembre) que para cualquier expresión e, (normal e) está en

-- forma normal y que (normal (normal e)) es igual a (normal e).

-- Nota. Para la comprobación se usará el siguiente generador de

-- expresiones aritméticas:

-- instance Arbitrary Expr where

-- arbitrary = sized arb

-- where

-- arb 0 = liftM V arbitrary

-- arb n | n > 0 = oneof [liftM V arbitrary,

-- liftM2 S sub sub,

-- liftM2 P sub sub]

-- where sub = arb (n `div` 2)

Soluciones

import Test.QuickCheck
import Control.Monad

data Expr = V String
          | S Expr Expr
          | P Expr Expr
          deriving (Eq, Show)

esTermino :: Expr -> Bool
esTermino (V _)   = True
esTermino (S _ _) = False
esTermino (P a b) = esTermino a && esTermino b

esNormal :: Expr -> Bool
esNormal (S a b) = esNormal a && esNormal b
esNormal a       = esTermino a

normal :: Expr -> Expr
normal (V v)   = V v
normal (S a b) = S (normal a) (normal b)
normal (P a b) = p (normal a) (normal b)
    where p (S a b) c = S (p a c) (p b c)
          p a (S b c) = S (p a b) (p a c)
          p a b       = P a b

prop_normal :: Expr -> Bool
prop_normal e = 
    esNormal (normal e) && normal (normal e) == normal e

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

instance Arbitrary Expr where
    arbitrary = sized arb 
        where
          arb 0          =  liftM V arbitrary
          arb n | n > 0  =  oneof [liftM V arbitrary,
                                   liftM2 S sub sub, 
                                   liftM2 P sub sub] 
                where sub = arb (n `div` 2)

import Test.QuickCheck

import Control.Monad

data Expr = V String

| S Expr Expr

| P Expr Expr

deriving (Eq, Show)

esTermino :: Expr -> Bool

esTermino (V _) = True

esTermino (S _ _) = False

esTermino (P a b) = esTermino a && esTermino b

esNormal :: Expr -> Bool

esNormal (S a b) = esNormal a && esNormal b

esNormal a = esTermino a

normal :: Expr -> Expr

normal (V v) = V v

normal (S a b) = S (normal a) (normal b)

normal (P a b) = p (normal a) (normal b)

where p (S a b) c = S (p a c) (p b c)

p a (S b c) = S (p a b) (p a c)

p a b = P a b

prop_normal :: Expr -> Bool

prop_normal e =

esNormal (normal e) && normal (normal e) == normal e

-- La comprobación es

-- ghci> quickCheck prop_normal

-- +++ OK, passed 100 tests.

instance Arbitrary Expr where

arbitrary = sized arb

where

arb 0 = liftM V arbitrary

arb n | n > 0 = oneof [liftM V arbitrary,

liftM2 S sub sub,

liftM2 P sub sub]

where sub = arb (n `div` 2)

Particiones de longitud fija

PorJosé A. Alonso 28-noviembre-201425-abril-2021

Enunciado

-- Definir la función 
--    particionesFijas :: Int -> Int -> [[Int]]
-- tal que (particionesFijas n k) es la lista de listas de k números
-- naturales no crecientes cuya suma es n. Por ejemplo,
--    ghci> particionesFijas 8 3
--    [[3,3,2],[4,2,2],[4,3,1],[5,2,1],[6,1,1]]

-- Definir la función

-- particionesFijas :: Int -> Int -> [[Int]]

-- tal que (particionesFijas n k) es la lista de listas de k números

-- naturales no crecientes cuya suma es n. Por ejemplo,

-- ghci> particionesFijas 8 3

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

Soluciones

-- 1ª definición
particionesFijas :: Int -> Int -> [[Int]]
particionesFijas n 1 = [[n]]
particionesFijas n k 
    | k < 1     = []
    | otherwise = [x:y:ys | x <- [1..n-1], 
                            (y:ys) <- particionesFijas (n-x) (k-1),
                            x >= y]

-- 2ª definición
particionesFijas2 :: Int -> Int -> [[Int]]
particionesFijas2 n k
    | k <= 0    = []
    | k == 1    = [[n]]
    | k == n    = [replicate k 1]
    | k > n     = []
    | otherwise = [xs ++ [1] | xs <- particionesFijas2 (n-1) (k-1)] ++
                  [[x+1 | x <- xs] | xs <- particionesFijas2 (n-k) k]

-- Comparación:
--    ghci> length (particionesFijas 800 3)
--    53333
--    (1.01 secs, 97696476 bytes)
--    
--    ghci> length (particionesFijas2 800 3)
--    53333
--    (4.52 secs, 693969028 bytes)

-- 1ª definición

particionesFijas :: Int -> Int -> [[Int]]

particionesFijas n 1 = [[n]]

particionesFijas n k

| k < 1 = []

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

(y:ys) <- particionesFijas (n-x) (k-1),

x >= y]

-- 2ª definición

particionesFijas2 :: Int -> Int -> [[Int]]

particionesFijas2 n k

| k <= 0 = []

| k == 1 = [[n]]

| k == n = [replicate k 1]

| k > n = []

| otherwise = [xs ++ [1] | xs <- particionesFijas2 (n-1) (k-1)] ++

[[x+1 | x <- xs] | xs <- particionesFijas2 (n-k) k]

-- Comparación:

-- ghci> length (particionesFijas 800 3)

-- 53333

-- (1.01 secs, 97696476 bytes)

-- ghci> length (particionesFijas2 800 3)

-- 53333

-- (4.52 secs, 693969028 bytes)

Máximo de una función

PorJosé A. Alonso 4-noviembre-201427-diciembre-2014

Enunciado

-- Se considera la siguiente función
--    g :: Integer -> Integer
--    g n = if n < 10 then n*n else n
-- 
-- Definir la función 
--    max_g :: Integer -> Integer
-- tal que (max_g n) es el punto i del intervalo [0,n] donde g alcanza
-- el máximo de sus valores, si n es positivo y 0 en caso contrario. Por
-- ejemplo,
--    max_g (-7)  ==  0
--    max_g 7     ==  7
--    max_g 14    ==  9
--    max_g 84    ==  84
-- 
-- Comprobar con QuickCheck que la función max_g es equivalente a la
-- función f definida por  
--    f :: Integer -> Integer
--    f n | n < 0             = 0
--        | n >= 10 && n < 81 = 9
--        | otherwise         = n
--
-- Nota: Se piden dos definiciones de max_g, una por comprensión y otra
-- por recursión.

-- Se considera la siguiente función

-- g :: Integer -> Integer

-- g n = if n < 10 then n*n else n

-- Definir la función

-- max_g :: Integer -> Integer

-- tal que (max_g n) es el punto i del intervalo [0,n] donde g alcanza

-- el máximo de sus valores, si n es positivo y 0 en caso contrario. Por

-- ejemplo,

-- max_g (-7) == 0

-- max_g 7 == 7

-- max_g 14 == 9

-- max_g 84 == 84

-- Comprobar con QuickCheck que la función max_g es equivalente a la

-- función f definida por

-- f :: Integer -> Integer

-- f n | n < 0 = 0

-- | n >= 10 && n < 81 = 9

-- | otherwise = n

-- Nota: Se piden dos definiciones de max_g, una por comprensión y otra

-- por recursión.

Soluciones

import Test.QuickCheck

g :: Integer -> Integer
g n = if n < 10 then n*n else n

-- 1ª definición (por comprensión):
max_gC :: Integer -> Integer
max_gC n | n < 0     = 0 
         | otherwise = snd (maximum [(g i,i) | i <- [0..n]])

-- 2ª definición (por recursión):
max_gR :: Integer -> Integer
max_gR n | n < 0      = 0
         | g m > g n  = m 
         | otherwise  = n
         where m = max_gR (n - 1)

f :: Integer -> Integer
f n | n < 0             = 0
    | n >= 10 && n < 81 = 9
    | otherwise         = n

-- La propiedad con max_gR es
prop_max_gR n = max_gR n == f n

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

-- La propiedad con max_gC es
prop_max_gC n = max_gC n == f n

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

import Test.QuickCheck

g :: Integer -> Integer

g n = if n < 10 then n*n else n

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

max_gC :: Integer -> Integer

max_gC n | n < 0 = 0

| otherwise = snd (maximum [(g i,i) | i <- [0..n]])

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

max_gR :: Integer -> Integer

max_gR n | n < 0 = 0

| g m > g n = m

| otherwise = n

where m = max_gR (n - 1)

f :: Integer -> Integer

f n | n < 0 = 0

| n >= 10 && n < 81 = 9

| otherwise = n

-- La propiedad con max_gR es

prop_max_gR n = max_gR n == f n

-- La comprobación es

-- ghci> quickCheck prop_max_gR

-- +++ OK, passed 100 tests.

-- La propiedad con max_gC es

prop_max_gC n = max_gC n == f n

-- La comprobación es

-- ghci> quickCheck prop_max_gC

-- +++ OK, passed 100 tests.

Laberinto numérico

PorJosé A. Alonso 25-julio-201425-marzo-2022

Enunciado

-- El problema del laberinto numérico consiste en, dados un par de
-- números, encontrar la longitud del camino más corto entre ellos
-- usando sólo las siguientes operaciones:  
--    * multiplicar por 2,
--    * dividir por 2 (sólo para los pares) y
--    * sumar 2.
-- Por ejemplo, un camino mínimo 
--    * de  3 a 12 es [3,6,12], 
--    * de 12 a  3 es [12,6,3], 
--    * de  9 a  2 es [9,18,20,10,12,6,8,4,2] y 
--    * de  2 a  9 es [2,4,8,16,18,9].
-- 
-- Definir la función
--    longitudCaminoMinimo :: Int -> Int -> Int
-- tal que (longitudCaminoMinimo x y) es la longitud del camino mínimo
-- desde x hasta y en el laberinto numérico. 
--    longitudCaminoMinimo 3 12  ==  2
--    longitudCaminoMinimo 12 3  ==  2
--    longitudCaminoMinimo 9 2   ==  8
--    longitudCaminoMinimo 2 9   ==  5

-- El problema del laberinto numérico consiste en, dados un par de

-- números, encontrar la longitud del camino más corto entre ellos

-- usando sólo las siguientes operaciones:

-- * multiplicar por 2,

-- * dividir por 2 (sólo para los pares) y

-- * sumar 2.

-- Por ejemplo, un camino mínimo

-- * de 3 a 12 es [3,6,12],

-- * de 12 a 3 es [12,6,3],

-- * de 9 a 2 es [9,18,20,10,12,6,8,4,2] y

-- * de 2 a 9 es [2,4,8,16,18,9].

-- Definir la función

-- longitudCaminoMinimo :: Int -> Int -> Int

-- tal que (longitudCaminoMinimo x y) es la longitud del camino mínimo

-- desde x hasta y en el laberinto numérico.

-- longitudCaminoMinimo 3 12 == 2

-- longitudCaminoMinimo 12 3 == 2

-- longitudCaminoMinimo 9 2 == 8

-- longitudCaminoMinimo 2 9 == 5

Soluciones

longitudCaminoMinimo :: Int -> Int -> Int
longitudCaminoMinimo x y = 
    head [n | n <- [1..], y `elem` orbita n [x]] 

-- (orbita n xs) es el conjunto de números que se pueden obtener aplicando 
-- como máximo n veces las operaciones a los elementos de xs. Por ejemplo, 
--    orbita 0 [12]  ==  [12]
--    orbita 1 [12]  ==  [6,12,14,24]
--    orbita 2 [12]  ==  [3,6,7,8,12,14,16,24,26,28,48]
orbita :: Int -> [Int] -> [Int]
orbita 0 xs = sort xs
orbita n xs = sort (nub (ys ++ concat [sucesores x | x <- ys]))
    where ys = orbita (n-1) xs
          sucesores x | odd x     = [2*x, x+2]
                      | otherwise = [2*x, x `div` 2, x+2]

longitudCaminoMinimo :: Int -> Int -> Int

longitudCaminoMinimo x y =

head [n | n <- [1..], y `elem` orbita n [x]]

-- (orbita n xs) es el conjunto de números que se pueden obtener aplicando

-- como máximo n veces las operaciones a los elementos de xs. Por ejemplo,

-- orbita 0 [12] == [12]

-- orbita 1 [12] == [6,12,14,24]

-- orbita 2 [12] == [3,6,7,8,12,14,16,24,26,28,48]

orbita :: Int -> [Int] -> [Int]

orbita 0 xs = sort xs

orbita n xs = sort (nub (ys ++ concat [sucesores x | x <- ys]))

where ys = orbita (n-1) xs

sucesores x | odd x = [2*x, x+2]

| otherwise = [2*x, x `div` 2, x+2]

Producto de matrices como listas de listas

PorJosé A. Alonso 16-julio-20141-mayo-2015

-- Las matrices pueden representarse mediante una lista de listas donde
-- cada una de las lista representa una fila  de la matriz. Por ejemplo,
-- la matriz
--    |1 0 -2|
--    |0 3 -1|
-- puede representarse por [[1,0,-2],[0,3,-1]]. 
-- 
-- Definir la función
--    producto :: Num a => [[a]] -> [[a]] -> [[a]]
-- tal que (producto p q) es el producto de las matrices p y q. Por
-- ejemplo, 
--    ghci> producto [[1,0,-2],[0,3,-1]] [[0,3],[-2,-1],[0,4]]
--    [[0,-5],[-6,-7]]

-- Las matrices pueden representarse mediante una lista de listas donde

-- cada una de las lista representa una fila de la matriz. Por ejemplo,

-- la matriz

-- |1 0 -2|

-- |0 3 -1|

-- puede representarse por [[1,0,-2],[0,3,-1]].

-- Definir la función

-- producto :: Num a => [[a]] -> [[a]] -> [[a]]

-- tal que (producto p q) es el producto de las matrices p y q. Por

-- ejemplo,

-- ghci> producto [[1,0,-2],[0,3,-1]] [[0,3],[-2,-1],[0,4]]

-- [[0,-5],[-6,-7]]

Soluciones

import Data.List (transpose)

producto :: Num a => [[a]] -> [[a]] -> [[a]]
producto p q = 
    [[sum [x*y | (x,y) <- zip fil col] | col <- transpose q] | fil <- p]

import Data.List (transpose)

producto :: Num a => [[a]] -> [[a]] -> [[a]]

producto p q =

[[sum [x*y | (x,y) <- zip fil col] | col <- transpose q] | fil <- p]

Código Morse

PorJosé A. Alonso 10-julio-201427-diciembre-2014

El código Morse es un sistema de representación de letras y números mediante señales emitidas de forma intermitente.

A los signos (letras mayúsculas o dígitos) se le asigna un código como se muestra a continuación

    +---+-------+---+-------+---+-------+---+-------+
    | A | .-    | J | .---  | S | ...   | 1 | ..--- |
    | B | -...  | K | -.-   | T | -     | 2 | ...-- |
    | C | -.-.  | L | .-..  | U | ..-   | 3 | ....- |
    | D | -..   | M | --    | V | ...-  | 4 | ..... |
    | E | .     | N | -.    | W | .--   | 5 | -.... |
    | F | ..-.  | O | ---   | X | -..-  | 6 | --... |
    | G | --.   | P | .--.  | Y | -.--  | 7 | ---.. |
    | H | ....  | Q | --.-  | Z | --..  | 8 | ----. |
    | I | ..    | R | .-.   | 0 | .---- | 9 | ----- |
    +---+-------+---+-------+---+-------+---+-------+

+---+-------+---+-------+---+-------+---+-------+

| A | .- | J | .--- | S | ... | 1 | ..--- |

| B | -... | K | -.- | T | - | 2 | ...-- |

| C | -.-. | L | .-.. | U | ..- | 3 | ....- |

| D | -.. | M | -- | V | ...- | 4 | ..... |

| E | . | N | -. | W | .-- | 5 | -.... |

| F | ..-. | O | --- | X | -..- | 6 | --... |

| G | --. | P | .--. | Y | -.-- | 7 | ---.. |

| H | .... | Q | --.- | Z | --.. | 8 | ----. |

| I | .. | R | .-. | 0 | .---- | 9 | ----- |

+---+-------+---+-------+---+-------+---+-------+

El código Morse de las palabras se obtiene a partir del de sus caracteres insertando un espacio entre cada uno. Por ejemplo, el código de "todo" es "- --- -.. ---"

El código Morse de las frases se obtiene a partir del de sus palabras insertando dos espacios entre cada uno. Por ejemplo, el código de "todo o nada" es "- --- -.. --- --- -. .- -.. .-"

Enunciado

-- Definir las funciones
--    fraseAmorse :: String -> String
--    morseAfrase :: String -> String
-- tales que
-- * (fraseAmorse cs) es la traducción de la frase cs a Morse. Por
--   ejemplo, 
--      ghci> fraseAmorse "En todo la medida"
--      ". -.  - --- -.. ---  .-.. .-  -- . -.. .. -.. .-"
-- * (morseAfrase cs) es la frase cuya traducción a Morse es cs. Por 
--   ejemplo, 
--      ghci> morseAfrase ". -.  - --- -.. ---  .-.. .-  -- . -.. .. -.. .-"
--      "EN TODO LA MEDIDA"
--
-- Nota: La lista de los códigos Morse de A, B, ..., Z, 0, 1, ..., 9 es
--    [".-","-...","-.-.","-..",".","..-.","--.","....","..",".---",
--     "-.-",".-..","--","-.","---",".--.","--.-",".-.","...","-",
--     "..-","...-",".--","-..-","-.--","--..",".----","..---","...--",
--     "....-",".....","-....","--...","---..","----.","-----"]

-- Definir las funciones

-- fraseAmorse :: String -> String

-- morseAfrase :: String -> String

-- tales que

-- * (fraseAmorse cs) es la traducción de la frase cs a Morse. Por

-- ejemplo,

-- ghci> fraseAmorse "En todo la medida"

-- ". -. - --- -.. --- .-.. .- -- . -.. .. -.. .-"

-- * (morseAfrase cs) es la frase cuya traducción a Morse es cs. Por

-- ejemplo,

-- ghci> morseAfrase ". -. - --- -.. --- .-.. .- -- . -.. .. -.. .-"

-- "EN TODO LA MEDIDA"

-- Nota: La lista de los códigos Morse de A, B, ..., Z, 0, 1, ..., 9 es

-- [".-","-...","-.-.","-..",".","..-.","--.","....","..",".---",

-- "-.-",".-..","--","-.","---",".--.","--.-",".-.","...","-",

-- "..-","...-",".--","-..-","-.--","--..",".----","..---","...--",

-- "....-",".....","-....","--...","---..","----.","-----"]

Ayuda: Se puede usar la función splitOn de la librería Data.List.Split.

Soluciones

import Data.Char (toUpper)
import Data.List (intercalate)
import Data.List.Split (splitOn)

-- caracteres es la lista ordenada de las caracteres (letras mayúsculas
-- y dígitos) que se usan en los mensajes Morse.
caracteres :: [Char]
caracteres = ['A'..'Z'] ++ ['0'..'9']

-- morse es la lista de los códigos Morse correspondientes a la lista
-- de caracteres.
morse :: [String]
morse = [".-","-...","-.-.","-..",".","..-.","--.","....","..",".---",
         "-.-",".-..","--","-.","---",".--.","--.-",".-.","...","-",
         "..-","...-",".--","-..-","-.--","--..",".----","..---","...--",
         "....-",".....","-....","--...","---..","----.","-----"]

-- (correspondiente xs ys x) es el elemento de ys en la misma posición
-- que x en xs. Por ejemplo,
--    correspondiente [1..10] [2,4..20] 3  ==  6
correspondiente :: Ord a => [a] -> [b] -> a -> b
correspondiente xs ys x = head [y | (z,y) <- zip xs ys, z == x]

-- (caracterAmorse x) es el código Morse correspondiente al carácter
-- x. Por ejemplo, 
--    caracterAmorse 'A'  ==  ".-"
--    caracterAmorse 'B'  ==  "-..."
--    caracterAmorse '1'  ==  "..---"
--    caracterAmorse 'a'  ==  ".-"
caracterAmorse :: Char -> String
caracterAmorse = correspondiente caracteres morse . toUpper

-- (morseAcaracter x) es el carácter cuyo código Morse es x. Por
-- ejemplo,  
--    morseAcaracter ".-"     ==  'A'
--    morseAcaracter "-..."   ==  'B'
--    morseAcaracter "..---"  ==  '1'
morseAcaracter :: String -> Char
morseAcaracter = correspondiente morse caracteres

-- (palabraAmorse cs) es el código Morse correspondiente a la palabra
-- cs. Por ejemplo,
--    palabraAmorse "En"  ==  ". -."
palabraAmorse :: [Char] -> String
palabraAmorse = unwords . map caracterAmorse

-- (morseApalabra cs) es la palabra cuyo traducción a Morse es cs. Por
-- ejemplo, 
--    morseApalabra ". -."  ==  "EN"
morseApalabra :: String -> [Char]
morseApalabra = map morseAcaracter . words

-- (fraseAmorse cs) es la traducción de la frase cs a Morse. Por ejemplo,
--    ghci> fraseAmorse "En todo la medida"
--    ". -.  - --- -.. ---  .-.. .-  -- . -.. .. -.. .-"
fraseAmorse :: String -> String
fraseAmorse = intercalate "  " . map palabraAmorse . words

-- Ejemplo de cálculo
--    fraseAmorse "En todo la medida"
--    = (intercalate "  " . map palabraAmorse . words)
--      "En todo la medida"
--    = (intercalate "  " . map palabraAmorse)
--      ["En","todo","la","medida"]
--    = intercalate "  " [". -.","- --- -.. ---",".-.. .-","-- . -.. .. -.. .-"]
--    = ". -.  - --- -.. ---  .-.. .-  -- . -.. .. -.. .-"
  
-- (morseAfrase cs) es la frase cuya traducción a Morse es cs. Por
-- ejemplo, 
--    ghci> morseAfrase ". -.  - --- -.. ---  .-.. .-  -- . -.. .. -.. .-"
--    "EN TODO LA MEDIDA"
morseAfrase :: String -> String
morseAfrase = unwords . map morseApalabra . splitOn "  "

-- Ejemplo de cálculo
--    morseAfrase ". -.  - --- -.. ---  .-.. .-  -- . -.. .. -.. .-"
--    = (unwords . map morseApalabra)
--      ". -.  - --- -.. ---  .-.. .-  -- . -.. .. -.. .-"
--    = (unwords . map morseApalabra)
--      [". -.","- --- -.. ---",".-.. .-","-- . -.. .. -.. .-"]
--    = unwords ["EN","TODO","LA","MEDIDA"]
--    = "EN TODO LA MEDIDA"

import Data.Char (toUpper)

import Data.List (intercalate)

import Data.List.Split (splitOn)

-- caracteres es la lista ordenada de las caracteres (letras mayúsculas

-- y dígitos) que se usan en los mensajes Morse.

caracteres :: [Char]

caracteres = ['A'..'Z'] ++ ['0'..'9']

-- morse es la lista de los códigos Morse correspondientes a la lista

-- de caracteres.

morse :: [String]

morse = [".-","-...","-.-.","-..",".","..-.","--.","....","..",".---",

"-.-",".-..","--","-.","---",".--.","--.-",".-.","...","-",

"..-","...-",".--","-..-","-.--","--..",".----","..---","...--",

"....-",".....","-....","--...","---..","----.","-----"]

-- (correspondiente xs ys x) es el elemento de ys en la misma posición

-- que x en xs. Por ejemplo,

-- correspondiente [1..10] [2,4..20] 3 == 6

correspondiente :: Ord a => [a] -> [b] -> a -> b

correspondiente xs ys x = head [y | (z,y) <- zip xs ys, z == x]

-- (caracterAmorse x) es el código Morse correspondiente al carácter

-- x. Por ejemplo,

-- caracterAmorse 'A' == ".-"

-- caracterAmorse 'B' == "-..."

-- caracterAmorse '1' == "..---"

-- caracterAmorse 'a' == ".-"

caracterAmorse :: Char -> String

caracterAmorse = correspondiente caracteres morse . toUpper

-- (morseAcaracter x) es el carácter cuyo código Morse es x. Por

-- ejemplo,

-- morseAcaracter ".-" == 'A'

-- morseAcaracter "-..." == 'B'

-- morseAcaracter "..---" == '1'

morseAcaracter :: String -> Char

morseAcaracter = correspondiente morse caracteres

-- (palabraAmorse cs) es el código Morse correspondiente a la palabra

-- cs. Por ejemplo,

-- palabraAmorse "En" == ". -."

palabraAmorse :: [Char] -> String

palabraAmorse = unwords . map caracterAmorse

-- (morseApalabra cs) es la palabra cuyo traducción a Morse es cs. Por

-- ejemplo,

-- morseApalabra ". -." == "EN"

morseApalabra :: String -> [Char]

morseApalabra = map morseAcaracter . words

-- (fraseAmorse cs) es la traducción de la frase cs a Morse. Por ejemplo,

-- ghci> fraseAmorse "En todo la medida"

-- ". -. - --- -.. --- .-.. .- -- . -.. .. -.. .-"

fraseAmorse :: String -> String

fraseAmorse = intercalate " " . map palabraAmorse . words

-- Ejemplo de cálculo

-- fraseAmorse "En todo la medida"

-- = (intercalate " " . map palabraAmorse . words)

-- "En todo la medida"

-- = (intercalate " " . map palabraAmorse)

-- ["En","todo","la","medida"]

-- = intercalate " " [". -.","- --- -.. ---",".-.. .-","-- . -.. .. -.. .-"]

-- = ". -. - --- -.. --- .-.. .- -- . -.. .. -.. .-"

-- (morseAfrase cs) es la frase cuya traducción a Morse es cs. Por

-- ejemplo,

-- ghci> morseAfrase ". -. - --- -.. --- .-.. .- -- . -.. .. -.. .-"

-- "EN TODO LA MEDIDA"

morseAfrase :: String -> String

morseAfrase = unwords . map morseApalabra . splitOn " "

-- Ejemplo de cálculo

-- morseAfrase ". -. - --- -.. --- .-.. .- -- . -.. .. -.. .-"

-- = (unwords . map morseApalabra)

-- ". -. - --- -.. --- .-.. .- -- . -.. .. -.. .-"

-- = (unwords . map morseApalabra)

-- [". -.","- --- -.. ---",".-.. .-","-- . -.. .. -.. .-"]

-- = unwords ["EN","TODO","LA","MEDIDA"]

-- = "EN TODO LA MEDIDA"

Renombramiento de un árbol

PorJosé A. Alonso 3-julio-201427-diciembre-2014

-- Los árboles binarios se pueden representar mediante el tipo Arbol definido
-- por
--    data Arbol a = H a 
--                 | N a (Arbol a) (Arbol a)
--                 deriving Show
-- Por ejemplo, el árbol
--         "C"
--         / \ 
--        /   \
--       /     \
--     "B"     "A"
--     / \     / \
--   "A" "B" "B" "C" 
-- se puede definir por 
--    ej1 :: Arbol String
--    ej1 = N "C" (N "B" (H "A") (H "B")) (N "A" (H "B") (H "C"))
--
-- Definir la función
--    renombraArbol :: Arbol t -> Arbol Int
-- tal que (renombraArbol a) es el árbol obtenido sustituyendo el valor
-- de los nodos y hojas por números tales que tengan el mismo valor si y
-- sólo si coincide su contenido. Por ejemplo,
--    ghci> renombraArbol ej1
--    N 2 (N 1 (H 0) (H 1)) (N 0 (H 1) (H 2))
-- Gráficamente, 
--          2 
--         / \ 
--        /   \
--       /     \
--      1       0 
--     / \     / \
--    0   1   1   2

-- Los árboles binarios se pueden representar mediante el tipo Arbol definido

-- por

-- data Arbol a = H a

-- | N a (Arbol a) (Arbol a)

-- deriving Show

-- Por ejemplo, el árbol

-- "C"

-- / \

-- "B" "A"

-- / \ / \

-- "A" "B" "B" "C"

-- se puede definir por

-- ej1 :: Arbol String

-- ej1 = N "C" (N "B" (H "A") (H "B")) (N "A" (H "B") (H "C"))

-- Definir la función

-- renombraArbol :: Arbol t -> Arbol Int

-- tal que (renombraArbol a) es el árbol obtenido sustituyendo el valor

-- de los nodos y hojas por números tales que tengan el mismo valor si y

-- sólo si coincide su contenido. Por ejemplo,

-- ghci> renombraArbol ej1

-- N 2 (N 1 (H 0) (H 1)) (N 0 (H 1) (H 2))

-- Gráficamente,

-- 2

-- / \

-- 1 0

-- / \ / \

-- 0 1 1 2

Soluciones

import Data.List 

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

ej1 :: Arbol String
ej1 = N "C" (N "B" (H "A") (H "B")) (N "A" (H "B") (H "C"))

renombraArbol :: Ord t => Arbol t -> Arbol Int
renombraArbol a = aux a
    where ys            = valores a
          aux (H x)     = H (posicion x ys)
          aux (N x i d) = N (posicion x ys) (aux i) (aux d) 

-- (valores a) es la lista de los valores en los nodos y las hojas del
-- árbol a. Por ejemplo,
--    valores ej1  ==  ["A","B","C"]
valores :: Ord a => Arbol a -> [a]
valores a = sort (nub (aux a))
    where aux (H x)     = [x]
          aux (N x i d) = x : (aux i ++ aux d)

-- (posicion x ys) es la posición de x en ys. Por ejemplo.
--    posicion 7 [5,3,7,8]  ==  2
posicion :: Eq a => a -> [a] -> Int
posicion x ys = head [n | (y,n) <- zip ys [0..], y == x]

import Data.List

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving (Show, Eq)

ej1 :: Arbol String

ej1 = N "C" (N "B" (H "A") (H "B")) (N "A" (H "B") (H "C"))

renombraArbol :: Ord t => Arbol t -> Arbol Int

renombraArbol a = aux a

where ys = valores a

aux (H x) = H (posicion x ys)

aux (N x i d) = N (posicion x ys) (aux i) (aux d)

-- (valores a) es la lista de los valores en los nodos y las hojas del

-- árbol a. Por ejemplo,

-- valores ej1 == ["A","B","C"]

valores :: Ord a => Arbol a -> [a]

valores a = sort (nub (aux a))

where aux (H x) = [x]

aux (N x i d) = x : (aux i ++ aux d)

-- (posicion x ys) es la posición de x en ys. Por ejemplo.

-- posicion 7 [5,3,7,8] == 2

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

posicion x ys = head [n | (y,n) <- zip ys [0..], y == x]

N gramas

PorJosé A. Alonso 25-junio-201429-noviembre-2014

Un n-grama de una sucesión es una subsucesión de n elementos.

Enunciado

-- Definir la función
--    nGramas :: Int -> [a] -> [[a]]
-- tal que (nGramas k xs) es la lista de los n-gramas de xs de longitud
-- k. Por ejemplo,
--    nGramas 0 "abcd"  ==  [""]
--    nGramas 1 "abcd"  ==  ["a","b","c","d"]
--    nGramas 2 "abcd"  ==  ["ab","ac","ad","bc","bd","cd"]
--    nGramas 3 "abcd"  ==  ["abc","abd","acd","bcd"]
--    nGramas 4 "abcd"  ==  ["abcd"]
--    nGramas 5 "abcd"  ==  []

-- Definir la función

-- nGramas :: Int -> [a] -> [[a]]

-- tal que (nGramas k xs) es la lista de los n-gramas de xs de longitud

-- k. Por ejemplo,

-- nGramas 0 "abcd" == [""]

-- nGramas 1 "abcd" == ["a","b","c","d"]

-- nGramas 2 "abcd" == ["ab","ac","ad","bc","bd","cd"]

-- nGramas 3 "abcd" == ["abc","abd","acd","bcd"]

-- nGramas 4 "abcd" == ["abcd"]

-- nGramas 5 "abcd" == []

Soluciones

nGramas :: Int -> [a] -> [[a]]
nGramas 0 xs     = [[]]
nGramas n []     = []
nGramas n (x:xs) = [x:ys | ys <- nGramas (n-1) xs] ++ nGramas n xs

nGramas :: Int -> [a] -> [[a]]

nGramas 0 xs = [[]]

nGramas n [] = []

nGramas n (x:xs) = [x:ys | ys <- nGramas (n-1) xs] ++ nGramas n xs

Referencia

El ejercicio está basado en el problema del 3 de junio de 1HaskellADay.

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Enunciado

Soluciones

Soluciones

Soluciones

Comentarios

Soluciones

Introducción

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Soluciones

Enunciado

Soluciones

Soluciones

Enunciado

Soluciones

Referencia

Entradas recientes

Buscar

Correo electrónico