José A. Alonso

Cálculo del número de islas rectangulares en una matriz

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

En este problema se consideran matrices cuyos elementos son 0 y 1. Los valores 1 aparecen en forma de islas rectangulares separadas por 0 de forma que como máximo las islas son diagonalmente adyacentes. Por ejemplo,

   ej1, ej2 :: Array (Int,Int) Int
   ej1 = listArray ((1,1),(6,3))
                   [0,0,0,
                    1,1,0, 
                    1,1,0,
                    0,0,1,
                    0,0,1,
                    1,1,0]
   ej2 = listArray ((1,1),(6,6))
                   [1,0,0,0,0,0,
                    1,0,1,1,1,1,
                    0,0,0,0,0,0,
                    1,1,1,0,1,1,
                    1,1,1,0,1,1,
                    0,0,0,0,1,1]

ej1, ej2 :: Array (Int,Int) Int

ej1 = listArray ((1,1),(6,3))

[0,0,0,

1,1,0,

0,0,1,

1,1,0]

ej2 = listArray ((1,1),(6,6))

[1,0,0,0,0,0,

1,0,1,1,1,1,

0,0,0,0,0,0,

1,1,1,0,1,1,

0,0,0,0,1,1]

Definir la función

   numeroDeIslas :: Array (Int,Int) Int -> Int

1	numeroDeIslas :: Array (Int,Int) Int -> Int

tal que (numeroDeIslas p) es el número de islas de la matriz p. Por ejemplo,

   numeroDeIslas ej1  ==  3
   numeroDeIslas ej2  ==  4

1 2	numeroDeIslas ej1 == 3 numeroDeIslas ej2 == 4

Soluciones

import Data.Array

type Matriz = Array (Int,Int) Int

ej1, ej2 :: Array (Int,Int) Int
ej1 = listArray ((1,1),(6,3))
                [0,0,0,
                 1,1,0,
                 1,1,0,
                 0,0,1,
                 0,0,1,
                 1,1,0]
ej2 = listArray ((1,1),(6,6))
                [1,0,0,0,0,0,
                 1,0,1,1,1,1,
                 0,0,0,0,0,0,
                 1,1,1,0,1,1,
                 1,1,1,0,1,1,
                 0,0,0,0,1,1]

numeroDeIslas :: Array (Int,Int) Int -> Int
numeroDeIslas p = 
    length [(i,j) | (i,j) <- indices p, 
                     verticeSuperiorIzquierdo p (i,j)]

-- (verticeSuperiorIzquierdo p (i,j)) se verifica si (i,j) es el
-- vértice superior izquierdo de algunas de las islas de la matriz p,
-- Por ejemplo, 
--    ghci> [(i,j) | (i,j) <- indices ej1, verticeSuperiorIzquierdo ej1 (i,j)]
--    [(2,1),(4,3),(6,1)]
--    ghci> [(i,j) | (i,j) <- indices ej2, verticeSuperiorIzquierdo ej2 (i,j)]
--    [(1,1),(2,3),(4,1),(4,5)]
verticeSuperiorIzquierdo :: Matriz -> (Int,Int) -> Bool
verticeSuperiorIzquierdo p (i,j) =
    enLadoSuperior p (i,j) && enLadoIzquierdo p (i,j) 

-- (enLadoSuperior p (i,j)) se verifica si (i,j) está en el lado
-- superior de algunas de las islas de la matriz p, Por ejemplo,
--    ghci> [(i,j) | (i,j) <- indices ej1, enLadoSuperior ej1 (i,j)]
--    [(2,1),(2,2),(4,3),(6,1),(6,2)]
--    ghci> [(i,j) | (i,j) <- indices ej2, enLadoSuperior ej2 (i,j)]
--    [(1,1),(2,3),(2,4),(2,5),(2,6),(4,1),(4,2),(4,3),(4,5),(4,6)]
enLadoSuperior :: Matriz -> (Int,Int) -> Bool
enLadoSuperior p (1,j) = p!(1,j) == 1
enLadoSuperior p (i,j) = p!(i,j) == 1 && p!(i-1,j) == 0

-- (enLadoIzquierdo p (i,j)) se verifica si (i,j) está en el lado
-- izquierdo de algunas de las islas de la matriz p, Por ejemplo,
--    ghci> [(i,j) | (i,j) <- indices ej1, enLadoIzquierdo ej1 (i,j)]
--    [(2,1),(3,1),(4,3),(5,3),(6,1)]
--    ghci> [(i,j) | (i,j) <- indices ej2, enLadoIzquierdo ej2 (i,j)]
--    [(1,1),(2,1),(2,3),(4,1),(4,5),(5,1),(5,5),(6,5)]
enLadoIzquierdo :: Matriz -> (Int,Int) -> Bool
enLadoIzquierdo p (i,1) = p!(i,1) == 1
enLadoIzquierdo p (i,j) = p!(i,j) == 1 && p!(i,j-1) == 0

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

numeroDeIslas2 :: Array (Int,Int) Int -> Int
numeroDeIslas2 p = 
    length [(i,j) | (i,j) <- indices p, 
                    p!(i,j) == 1,
                    i == 1 || p!(i-1,j) == 0,
                    j == 1 || p!(i,j-1) == 0]

import Data.Array

type Matriz = Array (Int,Int) Int

ej1, ej2 :: Array (Int,Int) Int

ej1 = listArray ((1,1),(6,3))

[0,0,0,

1,1,0,

0,0,1,

1,1,0]

ej2 = listArray ((1,1),(6,6))

[1,0,0,0,0,0,

1,0,1,1,1,1,

0,0,0,0,0,0,

1,1,1,0,1,1,

0,0,0,0,1,1]

numeroDeIslas :: Array (Int,Int) Int -> Int

numeroDeIslas p =

length [(i,j) | (i,j) <- indices p,

verticeSuperiorIzquierdo p (i,j)]

-- (verticeSuperiorIzquierdo p (i,j)) se verifica si (i,j) es el

-- vértice superior izquierdo de algunas de las islas de la matriz p,

-- Por ejemplo,

-- ghci> [(i,j) | (i,j) <- indices ej1, verticeSuperiorIzquierdo ej1 (i,j)]

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

-- ghci> [(i,j) | (i,j) <- indices ej2, verticeSuperiorIzquierdo ej2 (i,j)]

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

verticeSuperiorIzquierdo :: Matriz -> (Int,Int) -> Bool

verticeSuperiorIzquierdo p (i,j) =

enLadoSuperior p (i,j) && enLadoIzquierdo p (i,j)

-- (enLadoSuperior p (i,j)) se verifica si (i,j) está en el lado

-- superior de algunas de las islas de la matriz p, Por ejemplo,

-- ghci> [(i,j) | (i,j) <- indices ej1, enLadoSuperior ej1 (i,j)]

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

-- ghci> [(i,j) | (i,j) <- indices ej2, enLadoSuperior ej2 (i,j)]

-- [(1,1),(2,3),(2,4),(2,5),(2,6),(4,1),(4,2),(4,3),(4,5),(4,6)]

enLadoSuperior :: Matriz -> (Int,Int) -> Bool

enLadoSuperior p (1,j) = p!(1,j) == 1

enLadoSuperior p (i,j) = p!(i,j) == 1 && p!(i-1,j) == 0

-- (enLadoIzquierdo p (i,j)) se verifica si (i,j) está en el lado

-- izquierdo de algunas de las islas de la matriz p, Por ejemplo,

-- ghci> [(i,j) | (i,j) <- indices ej1, enLadoIzquierdo ej1 (i,j)]

-- [(2,1),(3,1),(4,3),(5,3),(6,1)]

-- ghci> [(i,j) | (i,j) <- indices ej2, enLadoIzquierdo ej2 (i,j)]

-- [(1,1),(2,1),(2,3),(4,1),(4,5),(5,1),(5,5),(6,5)]

enLadoIzquierdo :: Matriz -> (Int,Int) -> Bool

enLadoIzquierdo p (i,1) = p!(i,1) == 1

enLadoIzquierdo p (i,j) = p!(i,j) == 1 && p!(i,j-1) == 0

-- 2ª solución

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

numeroDeIslas2 :: Array (Int,Int) Int -> Int

numeroDeIslas2 p =

length [(i,j) | (i,j) <- indices p,

p!(i,j) == 1,

i == 1 || p!(i-1,j) == 0,

j == 1 || p!(i,j-1) == 0]

Mayor diferencia progresiva

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

La diferencia progresiva entre dos elementos de una lista es la resta entre el que ocupa la mayor posición y la menor. Por ejemplo, en la lista [1,5,8,2,9] la diferencia entre los elementos 5 y 8 es 3 y entre 5 y 2 es -3.

Definir la función

   mayorDiferencia :: [Int] -> Int

1	mayorDiferencia :: [Int] -> Int

tal que (mayorDiferencia xs) es la mayor diferencia progresiva entre los elementos de xs. Por ejemplo,

   mayorDiferencia [1,5,8,2,9]  ==  8
   mayorDiferencia [9,5,8,2,1]  ==  3
   mayorDiferencia [7,2,6]      ==  4
   mayorDiferencia [3,2,1]      ==  0
   mayorDiferencia [1..10^7]    ==  9999999

mayorDiferencia [1,5,8,2,9] == 8

mayorDiferencia [9,5,8,2,1] == 3

mayorDiferencia [7,2,6] == 4

mayorDiferencia [3,2,1] == 0

mayorDiferencia [1..10^7] == 9999999

Soluciones

import Data.List (inits)

-- 1ª definición (por recursión):
mayorDiferencia :: [Int] -> Int
mayorDiferencia ([_])  = 0
mayorDiferencia (x:xs) = 
    max (maximum [y-x | y <- xs]) (mayorDiferencia xs) 

-- 2ª definición (por comprensión)
mayorDiferencia2 :: [Int] -> Int
mayorDiferencia2 xs = 
    maximum [x-y | (x,y) <- zip xs (map minimum (tail (inits xs)))]

-- 3ª definición:
mayorDiferencia3 :: [Int] -> Int
mayorDiferencia3 xs = maximum (zipWith (-) xs (scanl1 min xs))

-- 4ª definición:
mayorDiferencia4 :: [Int] -> Int
mayorDiferencia4 xs = maximum . zipWith (-) xs $ scanl1 min xs

-- Comparación de eficiencia
--    ghci> mayorDiferencia [1..3000]
--    2999
--    (3.43 secs, 943439560 bytes)
--    
--    ghci> mayorDiferencia2 [1..3000]
--    2999
--    (3.38 secs, 978359192 bytes)
--    
--    ghci> mayorDiferencia3 [1..3000]
--    2999
--    (0.01 secs, 2877960 bytes)
--    
--    ghci> mayorDiferencia4 [1..3000]
--    2999
--    (0.01 secs, 2062616 bytes)

import Data.List (inits)

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

mayorDiferencia :: [Int] -> Int

mayorDiferencia ([_]) = 0

mayorDiferencia (x:xs) =

max (maximum [y-x | y <- xs]) (mayorDiferencia xs)

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

mayorDiferencia2 :: [Int] -> Int

mayorDiferencia2 xs =

maximum [x-y | (x,y) <- zip xs (map minimum (tail (inits xs)))]

-- 3ª definición:

mayorDiferencia3 :: [Int] -> Int

mayorDiferencia3 xs = maximum (zipWith (-) xs (scanl1 min xs))

-- 4ª definición:

mayorDiferencia4 :: [Int] -> Int

mayorDiferencia4 xs = maximum . zipWith (-) xs $ scanl1 min xs

-- Comparación de eficiencia

-- ghci> mayorDiferencia [1..3000]

-- 2999

-- (3.43 secs, 943439560 bytes)

-- ghci> mayorDiferencia2 [1..3000]

-- 2999

-- (3.38 secs, 978359192 bytes)

-- ghci> mayorDiferencia3 [1..3000]

-- 2999

-- (0.01 secs, 2877960 bytes)

-- ghci> mayorDiferencia4 [1..3000]

-- 2999

-- (0.01 secs, 2062616 bytes)

Suma de conjuntos de polinomios

PorJosé A. Alonso 25-febrero-20151-mayo-2016

Los conjuntos de polinomios se pueden representar por listas de listas de la misma longitud. Por ejemplo, los polinomios 3x²+5x+9, 10x³+9 y 8x³+5x²+x-1 se pueden representar por las listas [0,3,5,9], [10,0,0,9] y [8,5,1,-1].

Definir la función

   sumaPolinomios :: Num a => [[a]] -> [a]

1	sumaPolinomios :: Num a => [[a]] -> [a]

tal que (sumaPolinomios ps) es la suma de los polinomios ps. Por ejemplo,

   ghci> sumaPolinomios1 [[0,3,5,9],[10,0,0,9],[8,5,1,-1]]
   [18,8,6,17]
   ghci> sumaPolinomios6 (replicate 1000000 (replicate 3 1))
   [1000000,1000000,1000000]

ghci> sumaPolinomios1 [[0,3,5,9],[10,0,0,9],[8,5,1,-1]]

[18,8,6,17]

ghci> sumaPolinomios6 (replicate 1000000 (replicate 3 1))

[1000000,1000000,1000000]

Soluciones

import Data.List (transpose)
import Data.Array ((!),accumArray,elems,listArray)

-- 1ª definición (por recursión):
sumaPolinomios1 :: Num a => [[a]] -> [a]
sumaPolinomios1 []          = []
sumaPolinomios1 [xs]        = xs
sumaPolinomios1 (xs:ys:zss) = suma xs (sumaPolinomios1 (ys:zss))

-- (suma xs ys) es la suma de los vectores xs e ys. Por ejemplo,
--    suma [4,7,3] [1,2,5]  == [5,9,8]
suma :: Num a => [a] -> [a] -> [a]
suma [] []         = []
suma (x:xs) (y:ys) = x+y : suma xs ys

-- 2ª definición (por recursión con zipWith): 
sumaPolinomios2 :: Num a => [[a]] -> [a]
sumaPolinomios2 []       = []
sumaPolinomios2 [xs]     = xs
sumaPolinomios2 (xs:xss) = zipWith (+) xs (sumaPolinomios2 xss)

-- 3ª definición (por plegado)
sumaPolinomios3 :: Num a => [[a]] -> [a]
sumaPolinomios3 = foldr1 (zipWith (+))

-- 4ª definición (por comprensión con transpose):
sumaPolinomios4 :: Num a => [[a]] -> [a]
sumaPolinomios4 xss = [sum xs | xs <- transpose xss]

-- 5ª definición (con map y transpose):
sumaPolinomios5 :: Num a => [[a]] -> [a]
sumaPolinomios5 = map sum . transpose 

-- 6ª definición (con array)
sumaPolinomios6 :: Num a => [[a]] -> [a]
sumaPolinomios6 xss = [sum [p!(i,j) | i <- [1..m]] | j <- [1..n]] 
    where m = length xss
          n = length (head xss)
          p = listArray ((1,1),(m,n)) (concat xss) 

-- 7ª definición (con accumArray)
sumaPolinomios7 :: Num a => [[a]] -> [a]
sumaPolinomios7 xss = 
    elems $ accumArray (+) 0 (1,n) (concat [zip [1..] xs | xs <- xss])
    where n = length (head xss)

-- Comparación de eficiencia
--    ghci> sumaPolinomios1 (replicate 300000 (replicate 5 1))
--    [300000,300000,300000,300000,300000]
--    (3.94 secs, 354713532 bytes)
--    
--    ghci> sumaPolinomios2 (replicate 300000 (replicate 5 1))
--    [300000,300000,300000,300000,300000]
--    (2.08 secs, 185506908 bytes)
--    
--    ghci> sumaPolinomios3 (replicate 300000 (replicate 5 1))
--    [300000,300000,300000,300000,300000]
--    (1.48 secs, 167026728 bytes)
--    
--    ghci> sumaPolinomios4 (replicate 300000 (replicate 5 1))
--    [300000,300000,300000,300000,300000]
--    (1.08 secs, 148564752 bytes)
--    
--    ghci> sumaPolinomios5 (replicate 300000 (replicate 5 1))
--    [300000,300000,300000,300000,300000]
--    (1.02 secs, 148062764 bytes)
--    
--    ghci> sumaPolinomios6 (replicate 300000 (replicate 5 1))
--    [300000,300000,300000,300000,300000]
--    (3.17 secs, 463756028 bytes)
--    
--    ghci> sumaPolinomios7 (replicate 300000 (replicate 5 1))
--    [300000,300000,300000,300000,300000]
--    (1.50 secs, 291699548 bytes)

import Data.List (transpose)

import Data.Array ((!),accumArray,elems,listArray)

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

sumaPolinomios1 :: Num a => [[a]] -> [a]

sumaPolinomios1 [] = []

sumaPolinomios1 [xs] = xs

sumaPolinomios1 (xs:ys:zss) = suma xs (sumaPolinomios1 (ys:zss))

-- (suma xs ys) es la suma de los vectores xs e ys. Por ejemplo,

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

suma :: Num a => [a] -> [a] -> [a]

suma [] [] = []

suma (x:xs) (y:ys) = x+y : suma xs ys

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

sumaPolinomios2 :: Num a => [[a]] -> [a]

sumaPolinomios2 [] = []

sumaPolinomios2 [xs] = xs

sumaPolinomios2 (xs:xss) = zipWith (+) xs (sumaPolinomios2 xss)

-- 3ª definición (por plegado)

sumaPolinomios3 :: Num a => [[a]] -> [a]

sumaPolinomios3 = foldr1 (zipWith (+))

-- 4ª definición (por comprensión con transpose):

sumaPolinomios4 :: Num a => [[a]] -> [a]

sumaPolinomios4 xss = [sum xs | xs <- transpose xss]

-- 5ª definición (con map y transpose):

sumaPolinomios5 :: Num a => [[a]] -> [a]

sumaPolinomios5 = map sum . transpose

-- 6ª definición (con array)

sumaPolinomios6 :: Num a => [[a]] -> [a]

sumaPolinomios6 xss = [sum [p!(i,j) | i <- [1..m]] | j <- [1..n]]

where m = length xss

n = length (head xss)

p = listArray ((1,1),(m,n)) (concat xss)

-- 7ª definición (con accumArray)

sumaPolinomios7 :: Num a => [[a]] -> [a]

sumaPolinomios7 xss =

elems $ accumArray (+) 0 (1,n) (concat [zip [1..] xs | xs <- xss])

where n = length (head xss)

-- Comparación de eficiencia

-- ghci> sumaPolinomios1 (replicate 300000 (replicate 5 1))

-- [300000,300000,300000,300000,300000]

-- (3.94 secs, 354713532 bytes)

-- ghci> sumaPolinomios2 (replicate 300000 (replicate 5 1))

-- [300000,300000,300000,300000,300000]

-- (2.08 secs, 185506908 bytes)

-- ghci> sumaPolinomios3 (replicate 300000 (replicate 5 1))

-- [300000,300000,300000,300000,300000]

-- (1.48 secs, 167026728 bytes)

-- ghci> sumaPolinomios4 (replicate 300000 (replicate 5 1))

-- [300000,300000,300000,300000,300000]

-- (1.08 secs, 148564752 bytes)

-- ghci> sumaPolinomios5 (replicate 300000 (replicate 5 1))

-- [300000,300000,300000,300000,300000]

-- (1.02 secs, 148062764 bytes)

-- ghci> sumaPolinomios6 (replicate 300000 (replicate 5 1))

-- [300000,300000,300000,300000,300000]

-- (3.17 secs, 463756028 bytes)

-- ghci> sumaPolinomios7 (replicate 300000 (replicate 5 1))

-- [300000,300000,300000,300000,300000]

-- (1.50 secs, 291699548 bytes)

Mínimo número de cambios para igualar una lista

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

Definir la función

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

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

tal que (nMinimoCambios xs) es el menor número de elementos de xs que hay que cambiar para que todos sean iguales. Por ejemplo,

   nMinimoCambios [3,5,3,7,9,6]      ==  4
   nMinimoCambios [3,5,3,7,3,3]      ==  2
   nMinimoCambios "Salamanca"        ==  5
   nMinimoCambios (4 : [1..500000])  ==  499999

nMinimoCambios [3,5,3,7,9,6] == 4

nMinimoCambios [3,5,3,7,3,3] == 2

nMinimoCambios "Salamanca" == 5

nMinimoCambios (4 : [1..500000]) == 499999

En el primer ejemplo, los elementos que hay que cambiar son 5, 7, 9 y 6.

Soluciones

import Data.List (group, nub, sort)

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

nMinimoCambios1 :: Ord a => [a] -> Int
nMinimoCambios1 xs = 
    length xs - fst (last (sort (frecuencias xs)))

-- (frecuencias xs) es la lista de los pares de los elementos de xs y el
-- número de veces que ocurren en xs. Por ejemplo,
--    frecuencias [3,5,3,7,9,6]  ==  [(2,3),(1,5),(1,7),(1,9),(1,6)]
--    frecuencias [3,5,3,7,5,5]  ==  [(2,3),(3,5),(1,7)]
frecuencias :: Ord a => [a] -> [(Int,a)]
frecuencias xs = [(cuenta x xs,x) | x <- nub xs]

-- (cuenta x ys) es el número de veces que ocurre x en ys. Por ejemplo,
--    cuenta 3 [3,5,3,7,9,6]  ==  2
cuenta :: Ord a => a -> [a] -> Int
cuenta x ys = length [y | y <- ys, y == x]

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

nMinimoCambios2 :: Ord a => [a] -> Int
nMinimoCambios2 xs = 
    length xs - fst (last (sort (frecuencias2 xs)))

-- (frecuencias2 xs) es la lista de los pares de los elementos de xs y el
-- número de veces que ocurren en xs. Por ejemplo,
--    frecuencias2 [3,5,3,7,9,6]  ==  [(2,3),(1,5),(1,7),(1,9),(1,6)]
--    frecuencias2 [3,5,3,7,5,5]  ==  [(2,3),(3,5),(1,7)]
frecuencias2 :: Ord a  => [a] -> [(Int,a)]
frecuencias2 xs = 
    [(1 + length ys, y) | (y:ys) <- group (sort xs)] 

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

nMinimoCambios3 :: Ord a => [a] -> Int
nMinimoCambios3 xs = sum ys - maximum ys
    where ys = [length ys | ys <- group (sort xs)]

import Data.List (group, nub, sort)

-- 1ª definición

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

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

nMinimoCambios1 xs =

length xs - fst (last (sort (frecuencias xs)))

-- (frecuencias xs) es la lista de los pares de los elementos de xs y el

-- número de veces que ocurren en xs. Por ejemplo,

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

-- frecuencias [3,5,3,7,5,5] == [(2,3),(3,5),(1,7)]

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

frecuencias xs = [(cuenta x xs,x) | x <- nub xs]

-- (cuenta x ys) es el número de veces que ocurre x en ys. Por ejemplo,

-- cuenta 3 [3,5,3,7,9,6] == 2

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

cuenta x ys = length [y | y <- ys, y == x]

-- 2ª definición

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

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

nMinimoCambios2 xs =

length xs - fst (last (sort (frecuencias2 xs)))

-- (frecuencias2 xs) es la lista de los pares de los elementos de xs y el

-- número de veces que ocurren en xs. Por ejemplo,

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

-- frecuencias2 [3,5,3,7,5,5] == [(2,3),(3,5),(1,7)]

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

frecuencias2 xs =

[(1 + length ys, y) | (y:ys) <- group (sort xs)]

-- 3ª definición

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

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

nMinimoCambios3 xs = sum ys - maximum ys

where ys = [length ys | ys <- group (sort xs)]

Diagonales secundarias de una matriz

PorJosé A. Alonso 20-febrero-201526-abril-2015

Definir la función

   diagonalesSecundarias :: Matriz a -> [[a]]

1	diagonalesSecundarias :: Matriz a -> [[a]]

tal que (diagonalesSecundarias p) es la lista de las diagonales secundarias de p. Por ejemplo, para la matriz

   1  2  3  4
   5  6  7  8
   9 10 11 12

1 2 3 4

5 6 7 8

9 10 11 12

la lista de sus diagonales secundarias es

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

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

En Haskell,

   ghci> diagonalesSecundarias (listArray ((1,1),(3,4)) [1..12])
   [[1],[2,5],[3,6,9],[4,7,10],[8,11],[12]]

1 2	ghci> diagonalesSecundarias (listArray ((1,1),(3,4)) [1..12]) [[1],[2,5],[3,6,9],[4,7,10],[8,11],[12]]

Soluciones

import Data.Array

type Matriz a = Array (Int,Int) a

diagonalesSecundarias :: Matriz a -> [[a]]
diagonalesSecundarias p = 
    [[p!ij1 | ij1 <- extension ij] | ij <- iniciales]
    where (_,(m,n)) = bounds p
          iniciales = [(1,j) | j <- [1..n]] ++ [(i,n) | i <- [2..m]] 
          extension (i,j) = [(i+k,j-k) | k <- [0..min (j-1) (m-i)]]

import Data.Array

type Matriz a = Array (Int,Int) a

diagonalesSecundarias :: Matriz a -> [[a]]

diagonalesSecundarias p =

[[p!ij1 | ij1 <- extension ij] | ij <- iniciales]

where (_,(m,n)) = bounds p

iniciales = [(1,j) | j <- [1..n]] ++ [(i,n) | i <- [2..m]]

extension (i,j) = [(i+k,j-k) | k <- [0..min (j-1) (m-i)]]

Mayor producto de n dígitos consecutivos de un número

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

Definir la función

   mayorProducto :: Int -> Integer -> Integer

1	mayorProducto :: Int -> Integer -> Integer

tal que (mayorProducto n x) es el mayor producto de n dígitos consecutivos del número x (suponiendo que x tiene al menos n dígitos). Por ejemplo,

   mayorProducto 2 325                  ==  10
   mayorProducto 5 11111                ==  1
   mayorProducto 5 113111               ==  3
   mayorProducto 5 110111               ==  0
   mayorProducto 5 10151112             ==  10
   mayorProducto 5 101511124            ==  10
   mayorProducto 5 (product [1..1000])  ==  41472

mayorProducto 2 325 == 10

mayorProducto 5 11111 == 1

mayorProducto 5 113111 == 3

mayorProducto 5 110111 == 0

mayorProducto 5 10151112 == 10

mayorProducto 5 101511124 == 10

mayorProducto 5 (product [1..1000]) == 41472

Soluciones

import Data.List (inits, tails)
import Data.Char (digitToInt)

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

mayorProducto1 :: Int -> Integer -> Integer
mayorProducto1 n x = 
    maximum [product xs | xs <- segmentos n (cifras x)]

-- (cifras x) es la lista de las cifras del número x, de derecha a
-- izquierda. Por ejemplo, 
--    cifras 325  ==  [5,2,3]
cifras :: Integer -> [Integer]
cifras x 
    | x < 10    = [x]
    | otherwise = r : cifras q
    where (q,r) = quotRem x 10

-- (segmentos n xs) es la lista de los segmentos de longitud n de la
-- lista xs. Por ejemplo,
--    segmentos 2 [3,5,4,6]  ==  [[3,5],[5,4],[4,6]]
segmentos :: Int -> [Integer] -> [[Integer]]
segmentos n xs = take (length xs - n + 1) (map (take n) (tails xs))

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

mayorProducto2 :: Int -> Integer -> Integer
mayorProducto2 n x = maximum (aux ns)
    where ns     = [read [d] | d <- show x]
          aux xs | length xs < n = []
                 | otherwise     = product (take n xs) : aux (tail xs)

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

mayorProducto3 :: Int -> Integer -> Integer
mayorProducto3 n = maximum . 
                   map (product . take n) .
                   filter ((>=n) . length) .
                   tails . 
                   cifras

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

mayorProducto4 :: Int -> Integer -> Integer
mayorProducto4 n = maximum . 
                   map (product . map (fromIntegral . digitToInt)) . 
                   filter ((==n) . length) . 
                   concatMap inits . 
                   tails .
                   show

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

-- Tiempo (en segundos) del cálculo de (mayorProducto4 5 (product [1..]))
-- 
--    | Def | 10   | 100  | 1000 | 5000  |
--    |-----+------+------+------+-------|
--    | 1   | 0.01 | 0.01 | 0.04 |  0.34 |
--    | 2   | 0.01 | 0.01 | 0.07 |  2.86 |
--    | 3   | 0.01 | 0.01 | 0.06 | 12.48 |
--    | 4   | 0.00 | 0.12 |      |       |
...

import Data.List (inits, tails)

import Data.Char (digitToInt)

-- 1ª solución

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

mayorProducto1 :: Int -> Integer -> Integer

mayorProducto1 n x =

maximum [product xs | xs <- segmentos n (cifras x)]

-- (cifras x) es la lista de las cifras del número x, de derecha a

-- izquierda. Por ejemplo,

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

cifras :: Integer -> [Integer]

cifras x

| x < 10 = [x]

| otherwise = r : cifras q

where (q,r) = quotRem x 10

-- (segmentos n xs) es la lista de los segmentos de longitud n de la

-- lista xs. Por ejemplo,

-- segmentos 2 [3,5,4,6] == [[3,5],[5,4],[4,6]]

segmentos :: Int -> [Integer] -> [[Integer]]

segmentos n xs = take (length xs - n + 1) (map (take n) (tails xs))

-- 2ª solución

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

mayorProducto2 :: Int -> Integer -> Integer

mayorProducto2 n x = maximum (aux ns)

where ns = [read [d] | d <- show x]

aux xs | length xs < n = []

| otherwise = product (take n xs) : aux (tail xs)

-- 3ª solución

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

mayorProducto3 :: Int -> Integer -> Integer

mayorProducto3 n = maximum .

map (product . take n) .

filter ((>=n) . length) .

tails .

cifras

-- 4ª solución

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

mayorProducto4 :: Int -> Integer -> Integer

mayorProducto4 n = maximum .

map (product . map (fromIntegral . digitToInt)) .

filter ((==n) . length) .

concatMap inits .

tails .

show

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

-- Comparación de soluciones --

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

-- Tiempo (en segundos) del cálculo de (mayorProducto4 5 (product [1..]))

-- | Def | 10 | 100 | 1000 | 5000 |

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

-- | 1 | 0.01 | 0.01 | 0.04 | 0.34 |

-- | 2 | 0.01 | 0.01 | 0.07 | 2.86 |

-- | 3 | 0.01 | 0.01 | 0.06 | 12.48 |

-- | 4 | 0.00 | 0.12 | | |

...

Segmentos de longitud dada

PorJosé A. Alonso 10-febrero-20151-mayo-2016

Definir la función

   segmentos :: Int -> [a] -> [[a]]

1	segmentos :: Int -> [a] -> [[a]]

tal que (segmentos n xs) es la lista de los segmentos de longitud n de la lista xs. Por ejemplo,

   segmentos 3 [1..5]  ==  [[1,2,3],[2,3,4],[3,4,5]]

1	segmentos 3 [1..5] == [[1,2,3],[2,3,4],[3,4,5]]

Soluciones

import Data.List (tails)

-- 1ª definición (por recursión)
segmentos1 :: Int -> [a] -> [[a]]
segmentos1 n xs 
    | length xs < n = []
    | otherwise     = take n xs : segmentos1 n (tail xs)
                  
-- 2ª definición (con tails):
segmentos2 :: Int -> [a] -> [[a]]
segmentos2 n xs = 
    takeWhile (\ys -> length ys == n) (map (take n) (tails xs))

-- 3ª definición:
segmentos3 :: Int -> [a] -> [[a]]
segmentos3 n xs = 
    take (length xs - n + 1) (map (take n) (tails xs))

--    ghci> length (segmentos1 3 [1..30000])
--    29998
--    (2.99 secs, 13998816 bytes)
--    
--    ghci> length (segmentos2 3 [1..30000])
--    29998
--    (0.05 secs, 16941304 bytes)
--    
--    ghci> length (segmentos3 3 [1..30000])
--    29998
--    (0.04 secs, 10375520 bytes)
--    
--    ghci> length (segmentos2 3 [1..1000000])
--    999998
--    (0.70 secs, 498098336 bytes)
--    
--    ghci> length (segmentos3 3 [1..1000000])
--    999998
--    (0.24 secs, 273979304 bytes)

import Data.List (tails)

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

segmentos1 :: Int -> [a] -> [[a]]

segmentos1 n xs

| length xs < n = []

| otherwise = take n xs : segmentos1 n (tail xs)

-- 2ª definición (con tails):

segmentos2 :: Int -> [a] -> [[a]]

segmentos2 n xs =

takeWhile (\ys -> length ys == n) (map (take n) (tails xs))

-- 3ª definición:

segmentos3 :: Int -> [a] -> [[a]]

segmentos3 n xs =

take (length xs - n + 1) (map (take n) (tails xs))

-- ghci> length (segmentos1 3 [1..30000])

-- 29998

-- (2.99 secs, 13998816 bytes)

-- ghci> length (segmentos2 3 [1..30000])

-- 29998

-- (0.05 secs, 16941304 bytes)

-- ghci> length (segmentos3 3 [1..30000])

-- 29998

-- (0.04 secs, 10375520 bytes)

-- ghci> length (segmentos2 3 [1..1000000])

-- 999998

-- (0.70 secs, 498098336 bytes)

-- ghci> length (segmentos3 3 [1..1000000])

-- 999998

-- (0.24 secs, 273979304 bytes)

Menor número triangular con más de n divisores

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

La sucesión de los números triangulares se obtiene sumando los números naturales.

Así, el 7º número triangular es

   1 + 2 + 3 + 4 + 5 + 6 + 7 = 28.

1	1 + 2 + 3 + 4 + 5 + 6 + 7 = 28.

Los primeros 10 números triangulares son

   1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ...

1	1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ...

Los divisores de los primeros 7 números triangulares son:

    1: 1
    3: 1,3
    6: 1,2,3,6
   10: 1,2,5,10
   15: 1,3,5,15
   21: 1,3,7,21
   28: 1,2,4,7,14,28

1: 1

3: 1,3

6: 1,2,3,6

10: 1,2,5,10

15: 1,3,5,15

21: 1,3,7,21

28: 1,2,4,7,14,28

Como se puede observar, 28 es el menor número triangular con más de 5 divisores.

Definir la función

   menorTriangularConAlMenosNDivisores :: Int -> Integer

1	menorTriangularConAlMenosNDivisores :: Int -> Integer

tal que (menorTriangularConAlMenosNDivisores n) es el menor número triangular que tiene al menos n divisores. Por ejemplo,

   menorTriangularConAlMenosNDivisores 5    ==  28
   menorTriangularConAlMenosNDivisores 50   ==  25200
   menorTriangularConAlMenosNDivisores 500  ==  76576500

menorTriangularConAlMenosNDivisores 5 == 28

menorTriangularConAlMenosNDivisores 50 == 25200

menorTriangularConAlMenosNDivisores 500 == 76576500

Soluciones

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

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

menorTriangularConAlMenosNDivisores1 :: Int -> Integer
menorTriangularConAlMenosNDivisores1 n = 
    head [x | x <- triangulares, nDivisores x >= n]

-- triangulares es la sucesión de los números triangulares. Por ejemplo,
--    take 10 triangulares  ==  [1,3,6,10,15,21,28,36,45,55]
triangulares :: [Integer]
triangulares = scanl (+) 1 [2..]

-- (nDivisores x) es el número de divisores de x. Por ejemplo,
--    nDivisores 28  ==  6
nDivisores :: Integer -> Int
nDivisores x = 
    1 + length [y | y <- [1..x `div` 2], mod x y == 0]

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

menorTriangularConAlMenosNDivisores2 :: Int -> Integer
menorTriangularConAlMenosNDivisores2 n = 
    head [x | x <- triangulares, nDivisores2 x >= n]

-- (nDivisores2 x) es el número de divisores de x. Por ejemplo,
--    nDivisores2 28  ==  6
nDivisores2 :: Integer -> Int
nDivisores2 n = product [1 + length xs | xs <- group (factoresPrimos n)]    

-- (factoresPrimos n) es la lista de los factores primos de n. Por
-- ejemplo, 
--    factoresPrimos 28  ==  [2,2,7]
factoresPrimos :: Integer -> [Integer]
factoresPrimos n = aux n primos
    where aux n (p:ps) 
              | p*p > n        = [n]
              | n `mod` p == 0 = p : aux (n `div` p) (p:ps)
              | otherwise      = aux n ps

-- primos es la lista de los números primos. Por ejemplo,
--    take 10 primos  ==  [2,3,5,7,11,13,17,19,23,29]
primos :: [Integer]
primos = 2 : filter ((==1) . length . factoresPrimos) [3,5..]

-- 3ª solución (usando primes)
-- ===========================

menorTriangularConAlMenosNDivisores3 :: Int -> Integer
menorTriangularConAlMenosNDivisores3 n = 
    head [x | x <- triangulares, nDivisores3 x >= n]

-- (nDivisores3 x) es el número de divisores de x. Por ejemplo,
--    nDivisores3 28  ==  6
nDivisores3 :: Integer -> Int
nDivisores3 n = product [1 + length xs | xs <- group (factoresPrimos3 n)]    

-- (factoresPrimos3 n) es la lista de los factores primos de n. Por
-- ejemplo, 
--    factoresPrimos3 28  ==  [2,2,7]
factoresPrimos3 n = aux n primes
  where
    aux n (p:ps) 
        | p*p > n        = [n]
        | n `mod` p == 0 = p : aux (n `div` p) (p:ps)
        | otherwise      = aux n ps

-- 4ª solución (usando primeFactors)
-- =================================

menorTriangularConAlMenosNDivisores4 :: Int -> Integer
menorTriangularConAlMenosNDivisores4 n = 
    head [x | x <- triangulares, nDivisores4 x >= n]

-- (nDivisores4 x) es el número de divisores de x. Por ejemplo,
--    nDivisores4 28  ==  6
nDivisores4 :: Integer -> Int
nDivisores4 n = product [1 + length xs | xs <- group (primeFactors n)]    

-- ---------------------------------------------------------------------
-- § Comparación de eficiencia                                        --
-- ---------------------------------------------------------------------

-- La comparación es
--    ghci> menorTriangularConAlMenosNDivisores1 50
--    25200
--    (1.25 secs, 200236512 bytes)
--    
--    ghci> menorTriangularConAlMenosNDivisores2 50
--    25200
--    (0.02 secs, 4199904 bytes)
--    
--    ghci> menorTriangularConAlMenosNDivisores3 50
--    25200
--    (0.03 secs, 6265128 bytes)
--    
--    ghci> menorTriangularConAlMenosNDivisores4 50
--    25200
--    (0.01 secs, 5753048 bytes)

100

101

102

import Data.List (group)

import Data.Numbers.Primes (primes,primeFactors)

-- 1ª definición

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

menorTriangularConAlMenosNDivisores1 :: Int -> Integer

menorTriangularConAlMenosNDivisores1 n =

head [x | x <- triangulares, nDivisores x >= n]

-- triangulares es la sucesión de los números triangulares. Por ejemplo,

-- take 10 triangulares == [1,3,6,10,15,21,28,36,45,55]

triangulares :: [Integer]

triangulares = scanl (+) 1 [2..]

-- (nDivisores x) es el número de divisores de x. Por ejemplo,

-- nDivisores 28 == 6

nDivisores :: Integer -> Int

nDivisores x =

1 + length [y | y <- [1..x `div` 2], mod x y == 0]

-- 2ª solución

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

menorTriangularConAlMenosNDivisores2 :: Int -> Integer

menorTriangularConAlMenosNDivisores2 n =

head [x | x <- triangulares, nDivisores2 x >= n]

-- (nDivisores2 x) es el número de divisores de x. Por ejemplo,

-- nDivisores2 28 == 6

nDivisores2 :: Integer -> Int

nDivisores2 n = product [1 + length xs | xs <- group (factoresPrimos n)]

-- (factoresPrimos n) es la lista de los factores primos de n. Por

-- ejemplo,

-- factoresPrimos 28 == [2,2,7]

factoresPrimos :: Integer -> [Integer]

factoresPrimos n = aux n primos

where aux n (p:ps)

| p*p > n = [n]

| n `mod` p == 0 = p : aux (n `div` p) (p:ps)

| otherwise = aux n ps

-- primos es la lista de los números primos. Por ejemplo,

-- take 10 primos == [2,3,5,7,11,13,17,19,23,29]

primos :: [Integer]

primos = 2 : filter ((==1) . length . factoresPrimos) [3,5..]

-- 3ª solución (usando primes)

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

menorTriangularConAlMenosNDivisores3 :: Int -> Integer

menorTriangularConAlMenosNDivisores3 n =

head [x | x <- triangulares, nDivisores3 x >= n]

-- (nDivisores3 x) es el número de divisores de x. Por ejemplo,

-- nDivisores3 28 == 6

nDivisores3 :: Integer -> Int

nDivisores3 n = product [1 + length xs | xs <- group (factoresPrimos3 n)]

-- (factoresPrimos3 n) es la lista de los factores primos de n. Por

-- ejemplo,

-- factoresPrimos3 28 == [2,2,7]

factoresPrimos3 n = aux n primes

where

aux n (p:ps)

| p*p > n = [n]

| n `mod` p == 0 = p : aux (n `div` p) (p:ps)

| otherwise = aux n ps

-- 4ª solución (usando primeFactors)

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

menorTriangularConAlMenosNDivisores4 :: Int -> Integer

menorTriangularConAlMenosNDivisores4 n =

head [x | x <- triangulares, nDivisores4 x >= n]

-- (nDivisores4 x) es el número de divisores de x. Por ejemplo,

-- nDivisores4 28 == 6

nDivisores4 :: Integer -> Int

nDivisores4 n = product [1 + length xs | xs <- group (primeFactors n)]

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

-- § Comparación de eficiencia --

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

-- La comparación es

-- ghci> menorTriangularConAlMenosNDivisores1 50

-- 25200

-- (1.25 secs, 200236512 bytes)

-- ghci> menorTriangularConAlMenosNDivisores2 50

-- 25200

-- (0.02 secs, 4199904 bytes)

-- ghci> menorTriangularConAlMenosNDivisores3 50

-- 25200

-- (0.03 secs, 6265128 bytes)

-- ghci> menorTriangularConAlMenosNDivisores4 50

-- 25200

-- (0.01 secs, 5753048 bytes)

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 |

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

Siguiente elemento en una lista

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

Definir la función

   siguiente :: Eq a => a -> [a] -> Maybe a

1	siguiente :: Eq a => a -> [a] -> Maybe a

tal que (siguiente x ys) es justo el elemento siguiente a la primera ocurrencia de x en ys o Nothing si x no pertenece a ys. Por ejemplo,

   siguiente 5 [3,5,2,5,7]                       ==  Just 2
   siguiente 9 [3,5,2,5,7]                       ==  Nothing
   siguiente 'd' "afdegdb"                       ==  Just 'e'
   siguiente "todo" ["En","todo","la","medida"]  ==  Just "la"
   siguiente "nada" ["En","todo","la","medida"]  ==  Nothing
   siguiente 999999 [1..1000000]                 ==  Just 1000000
   siguiente 1000000 [1..1000000]                ==  Nothing

siguiente 5 [3,5,2,5,7] == Just 2

siguiente 9 [3,5,2,5,7] == Nothing

siguiente 'd' "afdegdb" == Just 'e'

siguiente "todo" ["En","todo","la","medida"] == Just "la"

siguiente "nada" ["En","todo","la","medida"] == Nothing

siguiente 999999 [1..1000000] == Just 1000000

siguiente 1000000 [1..1000000] == Nothing

Soluciones

import Data.Maybe (listToMaybe) -- Para la 4ª solución

-- 1ª solución (por recursión):
siguiente1 :: Eq a => a -> [a] -> Maybe a
siguiente1 x (y1:y2:ys) | x == y1   = Just y2
                        | otherwise = siguiente1 x (y2:ys)
siguiente1 x _ = Nothing

-- 2ª solución (por comprensión):
siguiente2 :: Eq a => a -> [a] -> Maybe a
siguiente2 x ys 
    | null zs   = Nothing
    | otherwise = Just (snd (head zs))
    where zs = [(u,v) | (u,v) <- zip ys (tail ys), u == x]  

-- 3ª solución (con dropWhile)
siguiente3 :: Eq a => a -> [a] -> Maybe a
siguiente3 x = aux . drop 1 . dropWhile (/=x)
    where aux []    = Nothing
          aux (y:_) = Just y

-- 4ª solución (con dropWhile y listToMaybe):
siguiente4 :: Eq a => a -> [a] -> Maybe a
siguiente4 x = listToMaybe . drop 1 . dropWhile (/=x)

-- Nota: En la librería Data.Maybe está definida la función 
--    listToMaybe :: [a] -> Maybe a 
-- tal que (listToMaybe xs) es Nothing si la lista xs está vacía y es
-- justo el primer elemento, en caso contrario, Por ejemplo,
--    listToMaybe []       ==  Nothing
--    listToMaybe [3,2,5]  ==  Just 3

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

-- La comparación es
--    ghci> let n=10^6 in siguiente1 (n-1) [1..n]
--    Just 1000000
--    (1.34 secs, 277352616 bytes)
--    
--    ghci> let n=10^6 in siguiente2 (n-1) [1..n]
--    Just 1000000
--    (1.45 secs, 340836576 bytes)
--    
--    ghci> let n=10^6 in siguiente3 (n-1) [1..n]
--    Just 1000000
--    (0.26 secs, 84987544 bytes)
--    
--    ghci> let n=10^6 in siguiente4 (n-1) [1..n]
--    Just 1000000
--    (0.26 secs, 84987440 bytes)

import Data.Maybe (listToMaybe) -- Para la 4ª solución

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

siguiente1 :: Eq a => a -> [a] -> Maybe a

siguiente1 x (y1:y2:ys) | x == y1 = Just y2

| otherwise = siguiente1 x (y2:ys)

siguiente1 x _ = Nothing

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

siguiente2 :: Eq a => a -> [a] -> Maybe a

siguiente2 x ys

| null zs = Nothing

| otherwise = Just (snd (head zs))

where zs = [(u,v) | (u,v) <- zip ys (tail ys), u == x]

-- 3ª solución (con dropWhile)

siguiente3 :: Eq a => a -> [a] -> Maybe a

siguiente3 x = aux . drop 1 . dropWhile (/=x)

where aux [] = Nothing

aux (y:_) = Just y

-- 4ª solución (con dropWhile y listToMaybe):

siguiente4 :: Eq a => a -> [a] -> Maybe a

siguiente4 x = listToMaybe . drop 1 . dropWhile (/=x)

-- Nota: En la librería Data.Maybe está definida la función

-- listToMaybe :: [a] -> Maybe a

-- tal que (listToMaybe xs) es Nothing si la lista xs está vacía y es

-- justo el primer elemento, en caso contrario, Por ejemplo,

-- listToMaybe [] == Nothing

-- listToMaybe [3,2,5] == Just 3

-- Comparación de eficiencia

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

-- La comparación es

-- ghci> let n=10^6 in siguiente1 (n-1) [1..n]

-- Just 1000000

-- (1.34 secs, 277352616 bytes)

-- ghci> let n=10^6 in siguiente2 (n-1) [1..n]

-- Just 1000000

-- (1.45 secs, 340836576 bytes)

-- ghci> let n=10^6 in siguiente3 (n-1) [1..n]

-- Just 1000000

-- (0.26 secs, 84987544 bytes)

-- ghci> let n=10^6 in siguiente4 (n-1) [1..n]

-- Just 1000000

-- (0.26 secs, 84987440 bytes)

Números polidivisibles

PorJosé A. Alonso 30-enero-20156-febrero-2015

Introducción

Un número natural es polidivisible si cumple las siguientes condiciones:

El número formado por sus dos primeros dígitos es divisible por 2.
El número formado por sus tres primeros dígitos es divisible por 3.
El número formado por sus cuatros primeros dígitos es divisible por 4.
etcétera.

Por ejemplo, el número 345654 es un número polidivisible ya que

34 es divisible por 2,
345 es divisible por 3,
3456 es divisible por 4,
34565 es divisible por 5 y
345654 es divisible por 6.

pero 123456 no lo es, porque 1234 no es divisible por 4.

Enunciado

Definir las funciones

  polidivisibles :: [Integer]
  polidivisiblesN :: Integer -> [Integer]

1 2	polidivisibles :: [Integer] polidivisiblesN :: Integer -> [Integer]

tales que

polidivisible es la sucesión cuyos elementos son los números polidivisibles. Por ejemplo,

     ghci> take 20 polidivisibles
     [1,2,3,4,5,6,7,8,9,10,12,14,16,18,20,22,24,26,28,30]
     ghci> take 10 (dropWhile (<=100) polidivisibles)
     [102,105,108,120,123,126,129,141,144,147]

ghci> take 20 polidivisibles

[1,2,3,4,5,6,7,8,9,10,12,14,16,18,20,22,24,26,28,30]

ghci> take 10 (dropWhile (<=100) polidivisibles)

[102,105,108,120,123,126,129,141,144,147]

(polidivisiblesN k) es la lista de los números polidivisibles con k dígitos. Por ejemplo,

     ghci> polidivisiblesN 2
     [10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48,
      50,52,54,56,58,60,62,64,66,68,70,72,74,76,78,80,82,84,86,88,
      90,92,94,96,98]

ghci> polidivisiblesN 2

[10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48,

50,52,54,56,58,60,62,64,66,68,70,72,74,76,78,80,82,84,86,88,

90,92,94,96,98]

Comprobar que, para n entre 1 y 5, la cantidad de números polidivisibles de n dígitos es 9*10^(n-1)/n!.

Soluciones

polidivisibles :: [Integer]
polidivisibles = [n | n <- [1..], esPolidivisible n]

-- (esPolidivisible n) se verifica si n es polidivisible. Por ejemplo, 
--    esPolidivisible 345654  ==  True
--    esPolidivisible 123456  ==  False
esPolidivisible :: Integer -> Bool
esPolidivisible n = 
    and [(n `div` 10^(m-k)) `mod` k == 0 | k <- [2..m]] 
    where m = fromIntegral (length (show n))

-- (polidivisiblesN n) es la lista de los números polidivisibles de n
-- dígitos. Por ejemplo, 
--    take 6 (polidivisiblesN 3)  ==  [102,105,108,120,123,126]
--    take 6 (polidivisiblesN 5)  ==  [10200,10205,10240,10245,10280,10285]
polidivisiblesN :: Integer -> [Integer]
polidivisiblesN n = 
    takeWhile (<=10^n-1) (dropWhile (<10^(n-1)) polidivisibles)

-- (conjetura k) se verifica si la cantidad de números polidivisibles de
-- k dígitos es 9*10^(k-1)/k!. 
conjetura :: Integer -> Bool
conjetura k = 
    fromIntegral (length (polidivisiblesN k)) == 9*10^(k-1) `div` factorial k
    where factorial n = product [1..n]

-- La comprobación de la conjetura para k entre 1 y 5 es
--    ghci> all conjetura [1..5]
--    True

polidivisibles :: [Integer]

polidivisibles = [n | n <- [1..], esPolidivisible n]

-- (esPolidivisible n) se verifica si n es polidivisible. Por ejemplo,

-- esPolidivisible 345654 == True

-- esPolidivisible 123456 == False

esPolidivisible :: Integer -> Bool

esPolidivisible n =

and [(n `div` 10^(m-k)) `mod` k == 0 | k <- [2..m]]

where m = fromIntegral (length (show n))

-- (polidivisiblesN n) es la lista de los números polidivisibles de n

-- dígitos. Por ejemplo,

-- take 6 (polidivisiblesN 3) == [102,105,108,120,123,126]

-- take 6 (polidivisiblesN 5) == [10200,10205,10240,10245,10280,10285]

polidivisiblesN :: Integer -> [Integer]

polidivisiblesN n =

takeWhile (<=10^n-1) (dropWhile (<10^(n-1)) polidivisibles)

-- (conjetura k) se verifica si la cantidad de números polidivisibles de

-- k dígitos es 9*10^(k-1)/k!.

conjetura :: Integer -> Bool

conjetura k =

fromIntegral (length (polidivisiblesN k)) == 9*10^(k-1) `div` factorial k

where factorial n = product [1..n]

-- La comprobación de la conjetura para k entre 1 y 5 es

-- ghci> all conjetura [1..5]

-- True

Posición del primer falso en un vector

PorJosé A. Alonso 29-enero-201526-marzo-2022

Excercitium

Definir la función

   posicion :: Array Int Bool -> Maybe Int

1	posicion :: Array Int Bool -> Maybe Int

tal que (posicion v) es la menor posición del vector de booleanos v cuyo valor es falso y es Nothing si todos los valores son verdaderos. Por ejemplo,

   posicion (listArray (0,4) [True,True,False,True,False]) == Just 2
   posicion (listArray (0,4) [i <= 2 | i <- [0..4]])       == Just 3
   posicion (listArray (0,4) [i <= 7 | i <- [0..4]])       == Nothing

posicion (listArray (0,4) [True,True,False,True,False]) == Just 2

posicion (listArray (0,4) [i <= 2 | i <- [0..4]]) == Just 3

posicion (listArray (0,4) [i <= 7 | i <- [0..4]]) == Nothing

Soluciones

import Data.Array 

-- 1ª definición:
posicion :: Array Int Bool -> Maybe Int
posicion v | p > n     = Nothing
           | otherwise = Just p
    where p = (length . takeWhile id . elems) v
          (_,n) = bounds v 

-- 2ª posición:
posicion2 :: Array Int Bool -> Maybe Int
posicion2 v | null xs   = Nothing
            | otherwise = Just (head xs)
    where xs = [i | i <- indices v, v!i]

import Data.Array

-- 1ª definición:

posicion :: Array Int Bool -> Maybe Int

posicion v | p > n = Nothing

| otherwise = Just p

where p = (length . takeWhile id . elems) v

(_,n) = bounds v

-- 2ª posición:

posicion2 :: Array Int Bool -> Maybe Int

posicion2 v | null xs = Nothing

| otherwise = Just (head xs)

where xs = [i | i <- indices v, v!i]

División según una propiedad

PorJosé A. Alonso 28-enero-20154-febrero-2015

Enunciado

Definir la función

   divideSegun :: (a -> Bool) -> [a] -> [[a]]

1	divideSegun :: (a -> Bool) -> [a] -> [[a]]

tal que (divideSegun p xs) es la lista de los segmentos de xs cuyos elementos no cumplen la propiedad p. Por ejemplo,

   divideSegun even [3,5,2,7,6,8,9,1]  ==  [[3,5],[7],[9,1]]
   divideSegun odd  [3,5,2,7,6,8,9,1]  ==  [[2],[6,8]]

1 2	divideSegun even [3,5,2,7,6,8,9,1] == [[3,5],[7],[9,1]] divideSegun odd [3,5,2,7,6,8,9,1] == [[2],[6,8]]

Comprobar con QuickCheck que, para cualquier lista xs de números enteros, la concatenación de los elementos de (divideSegun even xs) es la lista de los elementos de xs que no son pares.

Soluciones

import Test.QuickCheck

divideSegun :: (a -> Bool) -> [a] -> [[a]]
divideSegun p xs 
    | null ys   = []
    | otherwise = ys : divideSegun p zs
    where (ys,zs) = break p (dropWhile p xs)

-- La propiedad es
prop_divideSegun :: [Int] -> Bool
prop_divideSegun xs =
    concat (divideSegun even xs) == filter (not . even) xs

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

import Test.QuickCheck

divideSegun :: (a -> Bool) -> [a] -> [[a]]

divideSegun p xs

| null ys = []

| otherwise = ys : divideSegun p zs

where (ys,zs) = break p (dropWhile p xs)

-- La propiedad es

prop_divideSegun :: [Int] -> Bool

prop_divideSegun xs =

concat (divideSegun even xs) == filter (not . even) xs

-- La comprobación es

-- ghci> quickCheck prop_divideSegun

-- +++ OK, passed 100 tests.

Particiones en listas de segmentos

PorJosé A. Alonso 27-enero-20153-febrero-2015

Exercitium

Definir la función

   particiones :: Int -> [a] -> [[[a]]]

1	particiones :: Int -> [a] -> [[[a]]]

tal que (particiones n xs) es la lista de listas de n elementos cuya concatenación es xs. Por ejemplo,

   ghci> particiones 2 "abc"
   [["","abc"],["a","bc"],["ab","c"],["abc",""]]
   ghci> particiones 3 "abc"
   [["","","abc"],["","a","bc"],["","ab","c"],["","abc",""],
    ["a","","bc"],["a","b","c"],["a","bc",""],["ab","","c"],
    ["ab","c",""],["abc","",""]]
   ghci> length (particiones 4 "abc")
   20

ghci> particiones 2 "abc"

[["","abc"],["a","bc"],["ab","c"],["abc",""]]

ghci> particiones 3 "abc"

[["","","abc"],["","a","bc"],["","ab","c"],["","abc",""],

["a","","bc"],["a","b","c"],["a","bc",""],["ab","","c"],

["ab","c",""],["abc","",""]]

ghci> length (particiones 4 "abc")

Soluciones

particiones :: Int -> [a] -> [[[a]]]
particiones 0 [] = [[]]
particiones 0 xs = []
particiones n xs = [ys:yss | (ys,zs) <- biparticiones xs,
                             yss <- particiones (n-1) zs]

-- (biparticiones xs) es la lista de los pares (xs1,xs2) tales que su
-- concatenación es xs. Por ejemplo, 
--    ghci> biparticiones "abc"
--    [("","abc"),("a","bc"),("ab","c"),("abc","")]
biparticiones :: [a] -> [([a],[a])]
biparticiones []     = [([],[])]
biparticiones (x:xs) = ([],x:xs) :  
                       [(x:xs1,xs2) | (xs1,xs2) <- biparticiones xs]

particiones :: Int -> [a] -> [[[a]]]

particiones 0 [] = [[]]

particiones 0 xs = []

particiones n xs = [ys:yss | (ys,zs) <- biparticiones xs,

yss <- particiones (n-1) zs]

-- (biparticiones xs) es la lista de los pares (xs1,xs2) tales que su

-- concatenación es xs. Por ejemplo,

-- ghci> biparticiones "abc"

-- [("","abc"),("a","bc"),("ab","c"),("abc","")]

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

biparticiones [] = [([],[])]

biparticiones (x:xs) = ([],x:xs) :

[(x:xs1,xs2) | (xs1,xs2) <- biparticiones xs]

Números naturales separados por ceros

PorJosé A. Alonso 26-enero-201525-marzo-2022

Enunciado

Definir la sucesión

   naturales0 :: [Int]

1	naturales0 :: [Int]

cuyos elementos son los números naturales separados por 0. Por ejemplo,

   ghci> take 25 naturales0
   [0,0,1,0,2,0,3,0,4,0,5,0,6,0,7,0,8,0,9,0,10,0,11,0,12]

1 2	ghci> take 25 naturales0 [0,0,1,0,2,0,3,0,4,0,5,0,6,0,7,0,8,0,9,0,10,0,11,0,12]

Comprobar con QuickCheck que el n-ésimo término de la sucesión es n*(1+(-1)^n)/4.

Nota. En la comprobación usar

   quickCheckWith (stdArgs {maxSize=7}) prop_naturales0

1	quickCheckWith (stdArgs {maxSize=7}) prop_naturales0

Soluciones

import Test.QuickCheck

naturales0 :: [Int]
naturales0 = concat [[n,0] | n <- [0..]]

-- La propiedad es
prop_naturales0 :: Int -> Property
prop_naturales0 n = 
    n >= 0  ==>  naturales0 !! n == n*(1+(-1)^n) `div` 4

-- La comprobación es
--    ghci> quickCheckWith (stdArgs {maxSize=7}) prop_naturales0
--    +++ OK, passed 100 tests.

import Test.QuickCheck

naturales0 :: [Int]

naturales0 = concat [[n,0] | n <- [0..]]

-- La propiedad es

prop_naturales0 :: Int -> Property

prop_naturales0 n =

n >= 0 ==> naturales0 !! n == n*(1+(-1)^n) `div` 4

-- La comprobación es

-- ghci> quickCheckWith (stdArgs {maxSize=7}) prop_naturales0

-- +++ OK, passed 100 tests.

Enumeración de los números enteros

PorJosé A. Alonso 23-enero-201525-marzo-2022

Exercitium

Definir la sucesión

   enteros :: [Int]

1	enteros :: [Int]

tal que sus elementos son los números enteros comenzando en el 0 e intercalando los positivos y los negativos. Por ejemplo,

   ghci> take 23 enteros
   [0,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6,7,-7,8,-8,9,-9,10,-10,11,-11]

1 2	ghci> take 23 enteros [0,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6,7,-7,8,-8,9,-9,10,-10,11,-11]

Comprobar con QuickCheck que el n-ésimo término de la sucesión es (1-(2n+1)(-1)^n)/4.

Nota. En la comprobación usar

   quickCheckWith (stdArgs {maxSize=7}) prop_enteros

1	quickCheckWith (stdArgs {maxSize=7}) prop_enteros

Soluciones

import Test.QuickCheck

enteros :: [Int]
enteros = 0 : concat [[n,-n] | n <- [1..]]

-- La propiedad es
prop_enteros :: Int -> Property
prop_enteros n = 
    n >= 0 ==> enteros !! n == (1-(2*n+1)*(-1)^n) `div` 4

-- La comprobación es
--    ghci> quickCheckWith (stdArgs {maxSize=7}) prop_enteros
--    +++ OK, passed 100 tests.

import Test.QuickCheck

enteros :: [Int]

enteros = 0 : concat [[n,-n] | n <- [1..]]

-- La propiedad es

prop_enteros :: Int -> Property

prop_enteros n =

n >= 0 ==> enteros !! n == (1-(2*n+1)*(-1)^n) `div` 4

-- La comprobación es

-- ghci> quickCheckWith (stdArgs {maxSize=7}) prop_enteros

-- +++ OK, passed 100 tests.

Sustitución de listas

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

Definir la función

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

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

tal que (sustituye xs ys zs) es la lista obtenida sustituyendo las ocurrencias de la lista no vacía xs en zs por ys. Por ejemplo,

   sustituye "as" "_" "las casaderas"   ==  "l_ c_ader_"
   sustituye "as" "es" "las casaderas"  ==  "les cesaderes"
   sustituye "asa" "a" "las casaderas"  ==  "las caderas"
   sustituye "asd" "a" "las casaderas"  ==  "las casaderas"

sustituye "as" "_" "las casaderas" == "l_ c_ader_"

sustituye "as" "es" "las casaderas" == "les cesaderes"

sustituye "asa" "a" "las casaderas" == "las caderas"

sustituye "asd" "a" "las casaderas" == "las casaderas"

Soluciones

import Data.List (isPrefixOf)

sustituye :: Eq a => [a] -> [a] -> [a] -> [a]
sustituye xs ys [] = []
sustituye xs ys (z:zs) 
    | isPrefixOf xs (z:zs) = ys ++ sustituye xs ys (drop n zs)
    | otherwise            = z : sustituye xs ys zs
    where n = length xs - 1

import Data.List (isPrefixOf)

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

sustituye xs ys [] = []

sustituye xs ys (z:zs)

| isPrefixOf xs (z:zs) = ys ++ sustituye xs ys (drop n zs)

| otherwise = z : sustituye xs ys zs

where n = length xs - 1

Triparticiones de una lista

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

Definir la función

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

1	triparticiones :: [a] -> [([a],[a],[a])]

tal que (triparticiones xs) es la lista de las ternas (xs1,xs2,xs3) tales que su concatenación es xs. Por ejemplo,

   ghci> triparticiones "abc"
   [("","","abc"),("","a","bc"),("","ab","c"),("","abc",""),
    ("a","","bc"),("a","b","c"),("a","bc",""),("ab","","c"),
    ("ab","c",""),("abc","","")]

ghci> triparticiones "abc"

[("","","abc"),("","a","bc"),("","ab","c"),("","abc",""),

("a","","bc"),("a","b","c"),("a","bc",""),("ab","","c"),

("ab","c",""),("abc","","")]

Comprobar con QuickCheck que, suponiendo que xs es una lista de elementos comparables por igualdad, entonces para cada terna de (triparticiones xs) se cumple que la concatenación de sus elementos es xs.

Soluciones

import Test.QuickCheck

triparticiones :: [a] -> [([a],[a],[a])]
triparticiones xs = [(xs1,xs2,xs3) | (xs1,ys)  <- biparticiones xs,
                                     (xs2,xs3) <- biparticiones ys]

-- (biparticiones xs) es la lista de los pares (xs1,xs2) tales que su
-- concatenación es xs. Por ejemplo, 
--    ghci> biparticiones "abc"
--    [("","abc"),("a","bc"),("ab","c"),("abc","")]
biparticiones :: [a] -> [([a],[a])]
biparticiones []     = [([],[])]
biparticiones (x:xs) = ([],x:xs) :
                       [(x:xs1,xs2) | (xs1,xs2) <- biparticiones xs]

-- La propiedad es
prop_triparticiones :: Eq a => [a] -> Bool
prop_triparticiones xs =
    all (\(xs1,xs2,xs3) -> xs1 ++ xs2 ++ xs3 == xs) (triparticiones xs)

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

import Test.QuickCheck

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

triparticiones xs = [(xs1,xs2,xs3) | (xs1,ys) <- biparticiones xs,

(xs2,xs3) <- biparticiones ys]

-- (biparticiones xs) es la lista de los pares (xs1,xs2) tales que su

-- concatenación es xs. Por ejemplo,

-- ghci> biparticiones "abc"

-- [("","abc"),("a","bc"),("ab","c"),("abc","")]

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

biparticiones [] = [([],[])]

biparticiones (x:xs) = ([],x:xs) :

[(x:xs1,xs2) | (xs1,xs2) <- biparticiones xs]

-- La propiedad es

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

prop_triparticiones xs =

all (\(xs1,xs2,xs3) -> xs1 ++ xs2 ++ xs3 == xs) (triparticiones xs)

-- La comprobación es

-- ghci> quickCheck prop_triparticiones

-- +++ OK, passed 100 tests.

Listas con suma dada

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

Definir la función

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

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

tal que (conSuma xs yss) es la lista de los vectores de xss cuya suma vectorial es xs. Por ejemplo,

   ghci> conSuma [9,10,12] [[4,7,3],[3,1,4],[5,3,9],[2,2,5]] 
   [[[4,7,3],[5,3,9]],[[4,7,3],[3,1,4],[2,2,5]]]
   ghci> conSuma [9,11,12] [[4,7,3],[3,1,4],[5,3,9],[2,2,5]] 
   []

ghci> conSuma [9,10,12] [[4,7,3],[3,1,4],[5,3,9],[2,2,5]]

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

ghci> conSuma [9,11,12] [[4,7,3],[3,1,4],[5,3,9],[2,2,5]]

[]

Soluciones

import Data.List (subsequences, transpose)

conSuma :: (Eq a, Num a) => [a] -> [[a]] -> [[[a]]]
conSuma xs yss = [zss | zss <- subsequences yss, suma zss == xs]

-- (suma xss) es la suma de las listas xs. Por ejemplo,
--    suma [[4,7,3],[3,1,4],[2,2,5]]  ==  [9,10,12]
suma :: Num a => [[a]] -> [a]
suma = map sum . transpose

import Data.List (subsequences, transpose)

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

conSuma xs yss = [zss | zss <- subsequences yss, suma zss == xs]

-- (suma xss) es la suma de las listas xs. Por ejemplo,

-- suma [[4,7,3],[3,1,4],[2,2,5]] == [9,10,12]

suma :: Num a => [[a]] -> [a]

suma = map sum . transpose

Suma de una lista de vectores

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

Definir la función

   sumaVec :: Num a => [[a]] -> [a]

1	sumaVec :: Num a => [[a]] -> [a]

tal que (sumaVec xss) es la suma de los vectores de xss. Por ejemplo,

   sumaVec [[4,7,3],[3,1,4],[2,2,5]]  ==  [9,10,12]
   sumaVec [[4,7],[3,3],[1,4],[2,5]]  ==  [10,19]

1 2	sumaVec [[4,7,3],[3,1,4],[2,2,5]] == [9,10,12] sumaVec [[4,7],[3,3],[1,4],[2,5]] == [10,19]

Soluciones

import Data.List (transpose)
import Data.Array (listArray,(!))

-- 1ª definición (por recursión):
sumaVec1 :: Num a => [[a]] -> [a]
sumaVec1 []          = []
sumaVec1 [xs]        = xs
sumaVec1 (xs:ys:zss) = suma xs (sumaVec1 (ys:zss))

-- (suma xs ys) es la suma de los vectores xs e ys. Por ejemplo,
--    suma [4,7,3] [1,2,5]  == [5,9,8]
suma :: Num a => [a] -> [a] -> [a]
suma [] []         = []
suma (x:xs) (y:ys) = x+y : suma xs ys

-- 2ª definición (por recursión con zipWith): 
sumaVec2 :: Num a => [[a]] -> [a]
sumaVec2 []       = []
sumaVec2 [xs]     = xs
sumaVec2 (xs:xss) = zipWith (+) xs (sumaVec2 xss)

-- 3ª definición (por plegado)
sumaVec3 :: Num a => [[a]] -> [a]
sumaVec3 = foldr1 (zipWith (+))

-- 4ª definición (con map y transpose):
sumaVec4 :: Num a => [[a]] -> [a]
sumaVec4 = map sum . transpose 

-- 5ª definición (con array)
-- =========================

sumaVec5 :: Num a => [[a]] -> [a]
sumaVec5 xss = [sum [p!(i,j) | i <- [1..m]] | j <- [1..n]] 
    where m = length xss
          n = length (head xss)
          p = listArray ((1,1),(m,n)) (concat xss)

import Data.List (transpose)

import Data.Array (listArray,(!))

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

sumaVec1 :: Num a => [[a]] -> [a]

sumaVec1 [] = []

sumaVec1 [xs] = xs

sumaVec1 (xs:ys:zss) = suma xs (sumaVec1 (ys:zss))

-- (suma xs ys) es la suma de los vectores xs e ys. Por ejemplo,

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

suma :: Num a => [a] -> [a] -> [a]

suma [] [] = []

suma (x:xs) (y:ys) = x+y : suma xs ys

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

sumaVec2 :: Num a => [[a]] -> [a]

sumaVec2 [] = []

sumaVec2 [xs] = xs

sumaVec2 (xs:xss) = zipWith (+) xs (sumaVec2 xss)

-- 3ª definición (por plegado)

sumaVec3 :: Num a => [[a]] -> [a]

sumaVec3 = foldr1 (zipWith (+))

-- 4ª definición (con map y transpose):

sumaVec4 :: Num a => [[a]] -> [a]

sumaVec4 = map sum . transpose

-- 5ª definición (con array)

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

sumaVec5 :: Num a => [[a]] -> [a]

sumaVec5 xss = [sum [p!(i,j) | i <- [1..m]] | j <- [1..n]]

where m = length xss

n = length (head xss)

p = listArray ((1,1),(m,n)) (concat xss)

Ordenación según una función

PorJosé A. Alonso 16-enero-201526-abril-2015

Definir la función

   ordenaSegun :: Ord b => (a -> b) -> [a] -> [a]

1	ordenaSegun :: Ord b => (a -> b) -> [a] -> [a]

tal que (ordenaSegun f xs) es la lista obtenida ordenando los elementos de xs según sus valores mediante la función f. Por ejemplo,

   ordenaSegun abs [-3,2,5,-2]                           ==  [2,-2,-3,5]
   ordenaSegun abs [-3,-2,5,2]                           ==  [-2,2,-3,5]
   ordenaSegun length ["pq","x","mn"]                    ==  ["x","pq","mn"]
   [g 0 | g <- ordenaSegun (\f -> f 4) [(+5),(+2),(+3)]] == [2,3,5]

ordenaSegun abs [-3,2,5,-2] == [2,-2,-3,5]

ordenaSegun abs [-3,-2,5,2] == [-2,2,-3,5]

ordenaSegun length ["pq","x","mn"] == ["x","pq","mn"]

[g 0 | g <- ordenaSegun (\f -> f 4) [(+5),(+2),(+3)]] == [2,3,5]

Comprobar con QuickCheck que (ordenaSegun id) es equivalente a sort.

Soluciones

import Data.List (sort, sortBy)
import Data.Ord (comparing)
import Test.QuickCheck

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

ordenaSegun :: Ord b => (a -> b) -> [a] -> [a]
ordenaSegun _ []  = []
ordenaSegun f (x:xs) = insertaSegun f x (ordenaSegun f xs)

insertaSegun :: Ord b => (a -> b) -> a -> [a] -> [a]
insertaSegun _ x [] = [x]
insertaSegun f x (y:ys) | f x <= f y = x : y : ys
                        | otherwise  = y : insertaSegun f x ys

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

ordenaSegun2 :: Ord b => (a -> b) -> [a] -> [a]
ordenaSegun2 f xs = [xs!!i | (_,i) <- sort (zip [f x | x <- xs] [0..])]

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

ordenaSegun3 :: Ord b => (a -> b) -> [a] -> [a]
ordenaSegun3 f xs = map ((xs!!) . snd) (sort (zip (map f xs) [0..]))

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

ordenaSegun4 :: Ord b => (a -> b) -> [a] -> [a]
ordenaSegun4 = sortBy . comparing

-- La propiedad es
prop_ordenaSegun :: Ord a => [a] -> Bool
prop_ordenaSegun xs =
    ordenaSegun id xs == sort xs

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

import Data.List (sort, sortBy)

import Data.Ord (comparing)

import Test.QuickCheck

-- 1ª definición

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

ordenaSegun :: Ord b => (a -> b) -> [a] -> [a]

ordenaSegun _ [] = []

ordenaSegun f (x:xs) = insertaSegun f x (ordenaSegun f xs)

insertaSegun :: Ord b => (a -> b) -> a -> [a] -> [a]

insertaSegun _ x [] = [x]

insertaSegun f x (y:ys) | f x <= f y = x : y : ys

| otherwise = y : insertaSegun f x ys

-- 2ª definición

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

ordenaSegun2 :: Ord b => (a -> b) -> [a] -> [a]

ordenaSegun2 f xs = [xs!!i | (_,i) <- sort (zip [f x | x <- xs] [0..])]

-- 3ª definición

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

ordenaSegun3 :: Ord b => (a -> b) -> [a] -> [a]

ordenaSegun3 f xs = map ((xs!!) . snd) (sort (zip (map f xs) [0..]))

-- 4ª definición

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

ordenaSegun4 :: Ord b => (a -> b) -> [a] -> [a]

ordenaSegun4 = sortBy . comparing

-- La propiedad es

prop_ordenaSegun :: Ord a => [a] -> Bool

prop_ordenaSegun xs =

ordenaSegun id xs == sort xs

-- La comprobación es

-- ghci> quickCheck prop_ordenaSegun

-- +++ OK, passed 100 tests.

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

Conjuntos de puntos enteros en regiones rectangulares

PorJosé A. Alonso 14-enero-201526-abril-2015

Los puntos de una cuadrícula se puede representar mediante pares de números enteros

   type Punto = (Int,Int)

1	type Punto = (Int,Int)

y las regiones rectangulares mediante el siguiente tipo de dato

   data Region = Rectangulo Punto  Punto 
               | Union      Region Region
               | Diferencia Region Region
               deriving (Eq, Show)

data Region = Rectangulo Punto Punto

| Union Region Region

| Diferencia Region Region

deriving (Eq, Show)

donde

(Rectangulo p1 p2) es la región formada por un rectángulo cuyo vértice superior izquierdo es p1 y su vértice inferior derecho es p2.
(Union r1 r2) es la región cuyos puntos pertenecen a alguna de las regiones r1 y r2.
(Diferencia r1 r2) es la región cuyos puntos pertenecen a la región r1 pero no pertenecen a la r2.

Definir la función

   puntos :: Region -> [Punto]

1	puntos :: Region -> [Punto]

tal que (puntos r) es la lista de puntos de la región r. Por ejemplo, usando las regiones definidas por

   r0021, r3051, r4162 :: Region
   r0021 = Rectangulo (0,0) (2,1)
   r3051 = Rectangulo (3,0) (5,1)
   r4162 = Rectangulo (4,1) (6,2)

r0021, r3051, r4162 :: Region

r0021 = Rectangulo (0,0) (2,1)

r3051 = Rectangulo (3,0) (5,1)

r4162 = Rectangulo (4,1) (6,2)

se tiene

   ghci> puntos r0021
   [(0,0),(0,1),(1,0),(1,1),(2,0),(2,1)]
   ghci> puntos r3051
   [(3,0),(3,1),(4,0),(4,1),(5,0),(5,1)]
   ghci> puntos r4162
   [(4,1),(4,2),(5,1),(5,2),(6,1),(6,2)]
   ghci> puntos (Union r0021 r3051)
   [(0,0),(0,1),(1,0),(1,1),(2,0),(2,1),(3,0),(3,1),(4,0),(4,1),(5,0),(5,1)]
   ghci> puntos (Diferencia r3051 r4162)
   [(3,0),(3,1),(4,0),(5,0)]
   ghci> puntos (Union (Diferencia r3051 r4162) r4162)
   [(3,0),(3,1),(4,0),(5,0),(4,1),(4,2),(5,1),(5,2),(6,1),(6,2)]

ghci> puntos r0021

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

ghci> puntos r3051

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

ghci> puntos r4162

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

ghci> puntos (Union r0021 r3051)

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

ghci> puntos (Diferencia r3051 r4162)

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

ghci> puntos (Union (Diferencia r3051 r4162) r4162)

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

Comprobar con QuickCheck, usando la función enRegion definida en el ejercicio [Puntos en regiones rectangulares](Puntos en regiones rectangulares) que (enRegion p r) es equivalente a (p elem puntos r).

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

import Test.QuickCheck
import Control.Monad

type Punto = (Int,Int)

data Region = Rectangulo Punto  Punto
            | Union      Region Region
            | Diferencia Region Region
            deriving (Eq, Show)

r0021, r3051, r4162 :: Region
r0021 = Rectangulo (0,0) (2,1)
r3051 = Rectangulo (3,0) (5,1)
r4162 = Rectangulo (4,1) (6,2)

puntos :: Region -> [Punto]
puntos = undefined

-- La propiedad es
prop_puntos :: Punto -> Region -> Bool
prop_puntos p r = undefined

-- La comprobación es
--    ghci> quickCheckWith (stdArgs {maxSize=7}) prop_puntos
--    +++ OK, passed 100 tests.

enRegion :: Punto -> Region -> Bool
enRegion (x,y) (Rectangulo (x1,y1) (x2,y2)) =
    x1 <= x && x <= x2 && y1 <= y && y <= y2
enRegion p (Union r1 r2)      = enRegion p r1 || enRegion p r2
enRegion p (Diferencia r1 r2) = enRegion p r1 && not (enRegion p r2)

-- Generador de regiones:
instance Arbitrary Region where
    arbitrary = sized arb where
        arb 0         = liftM2 Rectangulo arbitrary arbitrary
        arb n | n > 0 = oneof [liftM2 Rectangulo arbitrary arbitrary,
                               liftM2 Union sub sub, 
                               liftM2 Diferencia sub sub] 
              where sub = arb (n `div` 2)

import Test.QuickCheck

import Control.Monad

type Punto = (Int,Int)

data Region = Rectangulo Punto Punto

| Union Region Region

| Diferencia Region Region

deriving (Eq, Show)

r0021, r3051, r4162 :: Region

r0021 = Rectangulo (0,0) (2,1)

r3051 = Rectangulo (3,0) (5,1)

r4162 = Rectangulo (4,1) (6,2)

puntos :: Region -> [Punto]

puntos = undefined

-- La propiedad es

prop_puntos :: Punto -> Region -> Bool

prop_puntos p r = undefined

-- La comprobación es

-- ghci> quickCheckWith (stdArgs {maxSize=7}) prop_puntos

-- +++ OK, passed 100 tests.

enRegion :: Punto -> Region -> Bool

enRegion (x,y) (Rectangulo (x1,y1) (x2,y2)) =

x1 <= x && x <= x2 && y1 <= y && y <= y2

enRegion p (Union r1 r2) = enRegion p r1 || enRegion p r2

enRegion p (Diferencia r1 r2) = enRegion p r1 && not (enRegion p r2)

-- Generador de regiones:

instance Arbitrary Region where

arbitrary = sized arb where

arb 0 = liftM2 Rectangulo arbitrary arbitrary

arb n | n > 0 = oneof [liftM2 Rectangulo arbitrary arbitrary,

liftM2 Union sub sub,

liftM2 Diferencia sub sub]

where sub = arb (n `div` 2)

Soluciones

import Data.List 
import Test.QuickCheck
import Control.Monad

type Punto = (Int,Int)

data Region = Rectangulo Punto  Punto
            | Union      Region Region
            | Diferencia Region Region
            deriving (Eq, Show)

r0021, r3051, r4162 :: Region
r0021 = Rectangulo (0,0) (2,1)
r3051 = Rectangulo (3,0) (5,1)
r4162 = Rectangulo (4,1) (6,2)

puntos :: Region -> [Punto]
puntos (Rectangulo (x1,y1) (x2,y2)) = 
    [(x,y) | x <- [x1..x2], y <- [y1..y2]]
puntos (Union r1 r2)      = puntos r1 `union` puntos r2
puntos (Diferencia r1 r2) = puntos r1 \\ puntos r2

-- La propiedad es
prop_puntos :: Punto -> Region -> Bool
prop_puntos p r =
    enRegion p r == (p `elem` puntos r)

-- La comprobación es
--    ghci> quickCheckWith (stdArgs {maxSize=7}) prop_puntos
--    +++ OK, passed 100 tests.

enRegion :: Punto -> Region -> Bool
enRegion (x,y) (Rectangulo (x1,y1) (x2,y2)) =
    x1 <= x && x <= x2 && y1 <= y && y <= y2
enRegion p (Union r1 r2)      = enRegion p r1 || enRegion p r2
enRegion p (Diferencia r1 r2) = enRegion p r1 && not (enRegion p r2)

-- Generador de regiones:
instance Arbitrary Region where
    arbitrary = sized arb where
        arb 0         = liftM2 Rectangulo arbitrary arbitrary
        arb n | n > 0 = oneof [liftM2 Rectangulo arbitrary arbitrary,
                               liftM2 Union sub sub, 
                               liftM2 Diferencia sub sub] 
              where sub = arb (n `div` 2)

import Data.List

import Test.QuickCheck

import Control.Monad

type Punto = (Int,Int)

data Region = Rectangulo Punto Punto

| Union Region Region

| Diferencia Region Region

deriving (Eq, Show)

r0021, r3051, r4162 :: Region

r0021 = Rectangulo (0,0) (2,1)

r3051 = Rectangulo (3,0) (5,1)

r4162 = Rectangulo (4,1) (6,2)

puntos :: Region -> [Punto]

puntos (Rectangulo (x1,y1) (x2,y2)) =

[(x,y) | x <- [x1..x2], y <- [y1..y2]]

puntos (Union r1 r2) = puntos r1 `union` puntos r2

puntos (Diferencia r1 r2) = puntos r1 \\ puntos r2

-- La propiedad es

prop_puntos :: Punto -> Region -> Bool

prop_puntos p r =

enRegion p r == (p `elem` puntos r)

-- La comprobación es

-- ghci> quickCheckWith (stdArgs {maxSize=7}) prop_puntos

-- +++ OK, passed 100 tests.

enRegion :: Punto -> Region -> Bool

enRegion (x,y) (Rectangulo (x1,y1) (x2,y2)) =

x1 <= x && x <= x2 && y1 <= y && y <= y2

enRegion p (Union r1 r2) = enRegion p r1 || enRegion p r2

enRegion p (Diferencia r1 r2) = enRegion p r1 && not (enRegion p r2)

-- Generador de regiones:

instance Arbitrary Region where

arbitrary = sized arb where

arb 0 = liftM2 Rectangulo arbitrary arbitrary

arb n | n > 0 = oneof [liftM2 Rectangulo arbitrary arbitrary,

liftM2 Union sub sub,

liftM2 Diferencia sub sub]

where sub = arb (n `div` 2)

Máxima suma de los segmentos

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

Un segmento de una lista xs es una sublista de xs formada por elementos consecutivos en la lista. El problema de la máxima suma de segmentos consiste en dada una lista de números enteros calcular el máximo de las sumas de todos los segmentos de la lista. Por ejemplo, para la lista [-1,2,-3,5,-2,1,3,-2,-2,-3,6] la máxima suma de segmentos es 7 que es la suma del segmento [5,-2,1,3] y para la lista [-1,-2,-3] es 0 que es la suma de la lista vacía.

Definir la función

   mss :: [Integer] -> Integer

1	mss :: [Integer] -> Integer

tal que (mss xs) es la máxima suma de los segmentos de xs. Por ejemplo,

   mss [-1,2,-3,5,-2,1,3,-2,-2,-3,6]  ==  7
   mss [-1,-2,-3]                     ==  0
   mss [1..500]                       ==  125250
   mss [1..1000]                      ==  500500
   mss [-500..3]                      ==  6
   mss [-1000..3]                     ==  6

mss [-1,2,-3,5,-2,1,3,-2,-2,-3,6] == 7

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

mss [1..500] == 125250

mss [1..1000] == 500500

mss [-500..3] == 6

mss [-1000..3] == 6

Soluciones

import Data.List (inits,tails)

-- 1ª solución
mss :: [Integer] -> Integer
mss = maximum . map sum . segmentos

-- (segmentos xs) es la lista de los segmentos de xs. Por ejemplo,
--    ghci> segmentos "abc"
--    ["","a","ab","abc","","b","bc","","c",""]
segmentos :: [a] -> [[a]]
segmentos = concat . map inits . tails

-- 2ª definición:
mss2 :: [Integer] -> Integer
mss2 = maximum . map (maximum . scanl (+) 0) . tails

-- 3ª definición:
mss3 :: [Integer] -> Integer
mss3 = maximum . map sum . concatMap tails . inits 

-- 4ª definición
mss4 :: [Integer] -> Integer
mss4  = fst . foldr (\x (b,a) -> (max (a+x) b, max 0 (a+x))) (0,0) 

-- 5ª definición (con scanl):
mss5 :: [Integer] -> Integer
mss5 = maximum . scanl (\a x -> max 0 a + x) 0

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

--    ghci> mss [1..500]
--    125250
--    (7.52 secs, 2022130824 bytes)
--    
--    ghci> mss2 [1..500]
--    125250
--    (0.01 secs, 10474956 bytes)
--    
--    ghci> mss3 [1..500]
--    125250
--    (0.98 secs, 841862016 bytes)
--    
--    ghci> mss4 [1..500]
--    125250
--    (0.01 secs, 552252 bytes)
--    
--    ghci> mss2 [1..1000]
--    500500
--    (0.06 secs, 54575712 bytes)
--    
--    ghci> mss3 [1..1000]
--    500500
--    (7.87 secs, 7061347900 bytes)
--
--    ghci> mss4 [1..1000]
--    500500
--    (0.01 secs, 549700 bytes)
--    
--    ghci> mss2 [1..2000]
--    2001000
--    (0.29 secs, 216424336 bytes)
--    
--    ghci> mss2 [1..5000]
--    12502500
--    (2.37 secs, 1356384840 bytes)
--    
--    ghci> mss4 [1..5000]
--    12502500
--    (0.02 secs, 1913548 bytes)
--
--    ghci> mss5 [1..5000]
--    12502500
--    (0.01 secs, 2886360 bytes)

import Data.List (inits,tails)

-- 1ª solución

mss :: [Integer] -> Integer

mss = maximum . map sum . segmentos

-- (segmentos xs) es la lista de los segmentos de xs. Por ejemplo,

-- ghci> segmentos "abc"

-- ["","a","ab","abc","","b","bc","","c",""]

segmentos :: [a] -> [[a]]

segmentos = concat . map inits . tails

-- 2ª definición:

mss2 :: [Integer] -> Integer

mss2 = maximum . map (maximum . scanl (+) 0) . tails

-- 3ª definición:

mss3 :: [Integer] -> Integer

mss3 = maximum . map sum . concatMap tails . inits

-- 4ª definición

mss4 :: [Integer] -> Integer

mss4 = fst . foldr (\x (b,a) -> (max (a+x) b, max 0 (a+x))) (0,0)

-- 5ª definición (con scanl):

mss5 :: [Integer] -> Integer

mss5 = maximum . scanl (\a x -> max 0 a + x) 0

-- Comparación de eficiencia

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

-- ghci> mss [1..500]

-- 125250

-- (7.52 secs, 2022130824 bytes)

-- ghci> mss2 [1..500]

-- 125250

-- (0.01 secs, 10474956 bytes)

-- ghci> mss3 [1..500]

-- 125250

-- (0.98 secs, 841862016 bytes)

-- ghci> mss4 [1..500]

-- 125250

-- (0.01 secs, 552252 bytes)

-- ghci> mss2 [1..1000]

-- 500500

-- (0.06 secs, 54575712 bytes)

-- ghci> mss3 [1..1000]

-- 500500

-- (7.87 secs, 7061347900 bytes)

-- ghci> mss4 [1..1000]

-- 500500

-- (0.01 secs, 549700 bytes)

-- ghci> mss2 [1..2000]

-- 2001000

-- (0.29 secs, 216424336 bytes)

-- ghci> mss2 [1..5000]

-- 12502500

-- (2.37 secs, 1356384840 bytes)

-- ghci> mss4 [1..5000]

-- 12502500

-- (0.02 secs, 1913548 bytes)

-- ghci> mss5 [1..5000]

-- 12502500

-- (0.01 secs, 2886360 bytes)

Referencias

El ejercicio está basado en la función mss del libro de Bird Thinking functionally with Haskell (página 127).
Las soluciones 3ª y 4ª las publicó josejuan aquí

Listas disjuntas

PorJosé A. Alonso 12-enero-201526-abril-2015

Definir la función

   disjuntas :: Ord a => [a] -> [a] -> Bool

1	disjuntas :: Ord a => [a] -> [a] -> Bool

tal que (disjuntas xs ys) se verifica si las listas ordenadas crecientemente xs e ys son disjuntas. Por ejemplo,

   disjuntas [2,5]   [1,4,7]                  ==  True
   disjuntas [2,5,7] [1,4,7]                  ==  False
   disjuntas [1..1000000] [3000000..4000000]  ==  True

disjuntas [2,5] [1,4,7] == True

disjuntas [2,5,7] [1,4,7] == False

disjuntas [1..1000000] [3000000..4000000] == True

Soluciones

disjuntas :: Ord a => [a] -> [a] -> Bool
disjuntas xs [] = True
disjuntas [] ys = True
disjuntas xs1@(x:xs) ys1@(y:ys)
    | x < y  = disjuntas xs ys1
    | x == y = False
    | x > y  = disjuntas xs1 ys

disjuntas :: Ord a => [a] -> [a] -> Bool

disjuntas xs [] = True

disjuntas [] ys = True

disjuntas xs1@(x:xs) ys1@(y:ys)

| x < y = disjuntas xs ys1

| x == y = False

| x > y = disjuntas xs1 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)

2015 y los números pitagóricos

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

Un número pitagórico es un número natural cuyo cuadrado se puede escribir como la suma de los cuadrados de dos números naturales no nulos; es decir, el número natural a es pitagórico si existen dos números naturales b y c distintos de cero tales que a² = b²+c². Por ejemplo, 5 es un número pitagórico ya que 5² = 3²+4² y también lo es 2015 ya que 2015² = 1612²+1209².

Definir la sucesión

    pitagoricos :: [Integer]

1	pitagoricos :: [Integer]

cuyos elementos son los números pitagóricos. Por ejemplo,

   ghci> take 20 pitagoricos
   [5,10,13,15,17,20,25,26,29,30,34,35,37,39,40,41,45,50,51,52]

1 2	ghci> take 20 pitagoricos [5,10,13,15,17,20,25,26,29,30,34,35,37,39,40,41,45,50,51,52]

Calcular la posición de 2015 en la sucesión.

Soluciones

import Test.QuickCheck

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

pitagoricos :: [Integer]
pitagoricos = [n | n <- [1..], esPitagorico n]

-- (esPitagorico n) se verifica si n es pitagórico. Por ejemplo,
--    esPitagorico 5  ==  True
--    esPitagorico 6  ==  False
esPitagorico :: Integer -> Bool
esPitagorico n = not (null (ternasPitagoricas n))

-- (ternasPitagoricas n) es la lista de las ternas (n,a,b) tales que 
-- n² = a²+b² con b < a < n. Por ejemplo,
--    ghci> ternasPitagoricas 5
--    [(5,4,3)]
--    ghci> ternasPitagoricas 2015
--    [(2015,1612,1209),(2015,1736,1023),(2015,1860,775),(2015,1953,496)]
ternasPitagoricas :: Integer -> [(Integer,Integer,Integer)]
ternasPitagoricas n = 
    [(n,a,b) | a <- [1..n-1],
               let b2 = n^2-a^2,
               let b = round (sqrt (fromIntegral b2)),
               b < a,     
               b^2 == b2]

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

pitagoricos2 :: [Integer]
pitagoricos2 = [round (sqrt (fromIntegral a)) | 
                a <- cuadrados,
                let xs = takeWhile (< a) cuadrados,
                any (\b -> a-b `elem` xs) xs]

-- cuadrados es la lista de los cuadrados de los números naturales. Por
-- ejemplo, 
--    take 10 cuadrados  ==  [1,4,9,16,25,36,49,64,81,100]
cuadrados :: [Integer]
cuadrados = [n*n | n <- [1..]]

-- El cálculo de la posición de 2015 es
--    ghci> length (takeWhile (< 2015) pitagoricos)
--    1195

import Test.QuickCheck

-- 1ª definición

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

pitagoricos :: [Integer]

pitagoricos = [n | n <- [1..], esPitagorico n]

-- (esPitagorico n) se verifica si n es pitagórico. Por ejemplo,

-- esPitagorico 5 == True

-- esPitagorico 6 == False

esPitagorico :: Integer -> Bool

esPitagorico n = not (null (ternasPitagoricas n))

-- (ternasPitagoricas n) es la lista de las ternas (n,a,b) tales que

-- n² = a²+b² con b < a < n. Por ejemplo,

-- ghci> ternasPitagoricas 5

-- [(5,4,3)]

-- ghci> ternasPitagoricas 2015

-- [(2015,1612,1209),(2015,1736,1023),(2015,1860,775),(2015,1953,496)]

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

ternasPitagoricas n =

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

let b2 = n^2-a^2,

let b = round (sqrt (fromIntegral b2)),

b < a,

b^2 == b2]

-- 2ª definición

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

pitagoricos2 :: [Integer]

pitagoricos2 = [round (sqrt (fromIntegral a)) |

a <- cuadrados,

let xs = takeWhile (< a) cuadrados,

any (\b -> a-b `elem` xs) xs]

-- cuadrados es la lista de los cuadrados de los números naturales. Por

-- ejemplo,

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

cuadrados :: [Integer]

cuadrados = [n*n | n <- [1..]]

-- El cálculo de la posición de 2015 es

-- ghci> length (takeWhile (< 2015) pitagoricos)

-- 1195

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

Varios cuadrados encajados

PorJosé A. Alonso 6-enero-201513-enero-2015

Enunciado

Definir la función

   cuadrados :: Int -> Picture

1	cuadrados :: Int -> Picture

tal que (cuadrados n) dibuje n cuadrados encajados como se muestra en las siguientes figuras:

para n=2
para n=4
para n=10

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
  display (InWindow (show n ++ " cuadrados encajados" ) 
                    (600,600) (20,20)) white (cuadrados n)
    
cuadrados :: Int -> Picture
cuadrados n = undefined

import Graphics.Gloss

import System.IO

main :: IO ()

main = do

hSetBuffering stdout NoBuffering

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

n <- readLn

display (InWindow (show n ++ " cuadrados encajados" )

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

cuadrados :: Int -> Picture

cuadrados n = 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
  display (InWindow (show n ++ " cuadrados encajados" ) 
                    (600,600) (20,20)) white (cuadrados n)
    
-- 1ª solución (por comprensión):    
cuadrados :: Int -> Picture
cuadrados n = 
    pictures [scale (r^n) (r^n) $ rotate (g n) $ cuadrado | n <- [0..n-1]]
    where cuadrado        = rectangleWire 500 500
          g n | even n    = 0
              | otherwise = 45
          r               = 1 / sqrt 2

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

import Graphics.Gloss

import System.IO

main :: IO ()

main = do

hSetBuffering stdout NoBuffering

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

n <- readLn

display (InWindow (show n ++ " cuadrados encajados" )

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

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

cuadrados :: Int -> Picture

cuadrados n =

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

where cuadrado = rectangleWire 500 500

g n | even n = 0

| otherwise = 45

r = 1 / sqrt 2

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

cuadrados2 :: Int -> Picture

cuadrados2 1 = rectangleWire 500 500

cuadrados2 n =

pictures [rectangleWire 500 500,

rotate 45 $ scale (1/sqrt 2) (1/sqrt 2) (cuadrados2 (n-1))]

Dos cuadrados encajados

PorJosé A. Alonso 5-enero-201512-enero-2015

Enunciado

Definir la función

   dosCuadrados :: Picture

1	dosCuadrados :: Picture

que dibuje dos cuadrados encajados como se muestra en la siguiente figura

Nota: Escribir las soluciones usando la siguiente plantilla

import Graphics.Gloss
    
main :: IO ()
main = display (InWindow "Dibujo" (500,300) (20,20)) white dosCuadrados
    
dosCuadrados :: Picture
dosCuadrados = undefined

import Graphics.Gloss

main :: IO ()

main = display (InWindow "Dibujo" (500,300) (20,20)) white dosCuadrados

dosCuadrados :: Picture

dosCuadrados = undefined

Soluciones

import Graphics.Gloss
    
main :: IO ()
main = display (InWindow "Dibujo" (500,300) (20,20)) white dosCuadrados
    
dosCuadrados :: Picture
dosCuadrados = pictures [cuadrado,
                         scale r r $ rotate 45 $ cuadrado]
    where cuadrado = rectangleWire 200 200
          r        = 1 / sqrt 2

import Graphics.Gloss

main :: IO ()

main = display (InWindow "Dibujo" (500,300) (20,20)) white dosCuadrados

dosCuadrados :: Picture

dosCuadrados = pictures [cuadrado,

scale r r $ rotate 45 $ cuadrado]

where cuadrado = rectangleWire 200 200

r = 1 / sqrt 2

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Introducción

Enunciado

Soluciones

Excercitium

Soluciones

Enunciado

Soluciones

Exercitium

Soluciones

Enunciado

Soluciones

Exercitium

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Referencias

Soluciones

Soluciones

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Entradas recientes

Buscar

Correo electrónico