Medio – Página 12

Productos de N números consecutivos

PorJosé A. Alonso 17-noviembre-201526-marzo-2022

La semana pasada se planteó en Twitter el siguiente problema

Se observa que

      1x2x3x4 = 2x3x4 
      2x3x4x5 = 4x5x6

1 2	1x2x3x4 = 2x3x4 2x3x4x5 = 4x5x6

¿Existen ejemplos de otros productos de cuatro enteros consecutivos iguales a un producto de tres enteros consecutivos?

Definir la función

   esProductoDeNconsecutivos :: Integer -> Integer -> Maybe Integer

1	esProductoDeNconsecutivos :: Integer -> Integer -> Maybe Integer

tal que (esProductoDeNconsecutivos n x) es (Just m) si x es el producto de n enteros consecutivos a partir de m y es Nothing si x no es el producto de n enteros consecutivos. Por ejemplo,

   esProductoDeNconsecutivos 3   6  == Just 1
   esProductoDeNconsecutivos 4   6  == Nothing
   esProductoDeNconsecutivos 4  24  == Just 1
   esProductoDeNconsecutivos 3  24  == Just 2
   esProductoDeNconsecutivos 3 120  == Just 4
   esProductoDeNconsecutivos 4 120  == Just 2

esProductoDeNconsecutivos 3 6 == Just 1

esProductoDeNconsecutivos 4 6 == Nothing

esProductoDeNconsecutivos 4 24 == Just 1

esProductoDeNconsecutivos 3 24 == Just 2

esProductoDeNconsecutivos 3 120 == Just 4

esProductoDeNconsecutivos 4 120 == Just 2

Para ejemplos mayores,

   λ> esProductoDeNconsecutivos 3 (product [10^20..2+10^20])
   Just 100000000000000000000
   λ> esProductoDeNconsecutivos2 4 (product [10^20..2+10^20])
   Nothing
   λ> esProductoDeNconsecutivos2 4 (product [10^20..3+10^20])
   Just 100000000000000000000

λ> esProductoDeNconsecutivos 3 (product [10^20..2+10^20])

Just 100000000000000000000

λ> esProductoDeNconsecutivos2 4 (product [10^20..2+10^20])

Nothing

λ> esProductoDeNconsecutivos2 4 (product [10^20..3+10^20])

Just 100000000000000000000

Usando la función esProductoDeNconsecutivos resolver el problema.

Soluciones

import Data.Maybe

-- 1ª definición
esProductoDeNconsecutivos1 :: Integer -> Integer -> Maybe Integer
esProductoDeNconsecutivos1 n x 
    | null productos = Nothing
    | otherwise      = Just (head productos)
    where productos = [m | m <- [1..x-n], product [m..m+n-1] == x]

-- 2ª definición
esProductoDeNconsecutivos2 :: Integer -> Integer -> Maybe Integer
esProductoDeNconsecutivos2 n x = aux k
    where k = floor (fromIntegral x ** (1/(fromIntegral n))) - (n `div` 2)
          aux m | y == x    = Just m
                | y <  x    = aux (m+1)
                | otherwise = Nothing
                where y = product [m..m+n-1]

-- Comparación de eficiencia
--    λ> esProductoDeNconsecutivos1 3 (product [10^7..2+10^7])
--    Just 10000000
--    (12.37 secs, 5678433692 bytes)
--    λ> esProductoDeNconsecutivos2 3 (product [10^7..2+10^7])
--    Just 10000000
--    (0.00 secs, 1554932 bytes)

-- Solución del problema
-- =====================

soluciones :: [Integer]
soluciones = [x | x <- [121..]
                , isJust (esProductoDeNconsecutivos2 4 x)
                , isJust (esProductoDeNconsecutivos2 3 x)]

-- El cálculo es
--    λ> head soluciones
--    175560
--    λ> esProductoDeNconsecutivos2 4 175560
--    Just 19
--    λ> esProductoDeNconsecutivos2 3 175560
--    Just 55
--    λ> product [19,20,21,22] 
--    175560
--    λ> product [55,56,57]
--    175560
--    λ> product [19,20,21,22] == product [55,56,57]
--    True

-- Se puede definir una función para automatizar el proceso anterior:
soluciones2 :: [(Integer,[Integer],[Integer])]
soluciones2 = [(x,[a..a+3],[b..b+2]) 
               | x <- [121..]
               , let y = esProductoDeNconsecutivos2 4 x
               , isJust y
               , let z = esProductoDeNconsecutivos2 3 x
               , isJust z
               , let a = fromJust y
               , let b = fromJust z
               ]

-- El cálculo es 
--    λ> head soluciones2
--    (175560,[19,20,21,22],[55,56,57])

import Data.Maybe

-- 1ª definición

esProductoDeNconsecutivos1 :: Integer -> Integer -> Maybe Integer

esProductoDeNconsecutivos1 n x

| null productos = Nothing

| otherwise = Just (head productos)

where productos = [m | m <- [1..x-n], product [m..m+n-1] == x]

-- 2ª definición

esProductoDeNconsecutivos2 :: Integer -> Integer -> Maybe Integer

esProductoDeNconsecutivos2 n x = aux k

where k = floor (fromIntegral x ** (1/(fromIntegral n))) - (n `div` 2)

aux m | y == x = Just m

| y < x = aux (m+1)

| otherwise = Nothing

where y = product [m..m+n-1]

-- Comparación de eficiencia

-- λ> esProductoDeNconsecutivos1 3 (product [10^7..2+10^7])

-- Just 10000000

-- (12.37 secs, 5678433692 bytes)

-- λ> esProductoDeNconsecutivos2 3 (product [10^7..2+10^7])

-- Just 10000000

-- (0.00 secs, 1554932 bytes)

-- Solución del problema

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

soluciones :: [Integer]

soluciones = [x | x <- [121..]

, isJust (esProductoDeNconsecutivos2 4 x)

, isJust (esProductoDeNconsecutivos2 3 x)]

-- El cálculo es

-- λ> head soluciones

-- 175560

-- λ> esProductoDeNconsecutivos2 4 175560

-- Just 19

-- λ> esProductoDeNconsecutivos2 3 175560

-- Just 55

-- λ> product [19,20,21,22]

-- 175560

-- λ> product [55,56,57]

-- 175560

-- λ> product [19,20,21,22] == product [55,56,57]

-- True

-- Se puede definir una función para automatizar el proceso anterior:

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

soluciones2 = [(x,[a..a+3],[b..b+2])

| x <- [121..]

, let y = esProductoDeNconsecutivos2 4 x

, isJust y

, let z = esProductoDeNconsecutivos2 3 x

, isJust z

, let a = fromJust y

, let b = fromJust z

]

-- El cálculo es

-- λ> head soluciones2

-- (175560,[19,20,21,22],[55,56,57])

Dígitos visibles y ocultos

PorJosé A. Alonso 16-noviembre-201526-marzo-2022

Una cadena clave es una cadena que contiene dígitos visibles y ocultos. Los dígitos se ocultan mediante las primeras letras minúsculas: la ‘a’ oculta el ‘0’, la ‘b’ el ‘1’ y así sucesivamente hasta la ‘j’ que oculta el ‘9’. Los restantes símbolos de la cadena no tienen significado y se pueden ignorar.

Definir la función

   numeroOculto :: String -> Maybe Integer

1	numeroOculto :: String -> Maybe Integer

tal que (numeroOculto cs) es justo el número formado por los dígitos visibles u ocultos de la cadena clave cs, si cs tiene dígitos y Nothing en caso contrario. Por ejemplo,

   numeroOculto "jihgfedcba"            ==  Just 9876543210
   numeroOculto "JIHGFEDCBA"            ==  Nothing
   numeroOculto "el 23 de Enero"        ==  Just 423344
   numeroOculto "El 23 de Enero"        ==  Just 23344
   numeroOculto "El 23 de enero"        ==  Just 233444
   numeroOculto "Todo para nada"        ==  Just 300030
   numeroOculto (replicate (10^6) 'A')  ==  Nothing

numeroOculto "jihgfedcba" == Just 9876543210

numeroOculto "JIHGFEDCBA" == Nothing

numeroOculto "el 23 de Enero" == Just 423344

numeroOculto "El 23 de Enero" == Just 23344

numeroOculto "El 23 de enero" == Just 233444

numeroOculto "Todo para nada" == Just 300030

numeroOculto (replicate (10^6) 'A') == Nothing

Soluciones

import Data.Char (isDigit, ord, chr)

numeroOculto :: String -> Maybe Integer
numeroOculto cs | null aux  = Nothing
                | otherwise = Just (read aux)
    where aux = filter isDigit (map visible cs)

visible :: Char -> Char
visible c | c `elem` ['a'..'j'] = chr (ord c - n)
          | otherwise           = c
          where n = ord 'a' - ord '0'

import Data.Char (isDigit, ord, chr)

numeroOculto :: String -> Maybe Integer

numeroOculto cs | null aux = Nothing

| otherwise = Just (read aux)

where aux = filter isDigit (map visible cs)

visible :: Char -> Char

visible c | c `elem` ['a'..'j'] = chr (ord c - n)

| otherwise = c

where n = ord 'a' - ord '0'

Números muy pares

PorJosé A. Alonso 13-noviembre-201520-noviembre-2015

Un entero positivo x es muy par si tanto x como x² sólo contienen cifras pares. Por ejemplo, 200 es muy par porque todas las cifras de 200 y 200² = 40000 son pares; pero 26 no lo es porque 26² = 676 tiene cifras impares.

Definir la función

   siguienteMuyPar :: Integer -> Integer

1	siguienteMuyPar :: Integer -> Integer

tal que (siguienteMuyPar x) es menor número mayor que x que es muy par. Por ejemplo,

   siguienteMuyPar 300           ==  668
   siguienteMuyPar 668           ==  680
   siguienteMuyPar 828268400000  ==  828268460602

siguienteMuyPar 300 == 668

siguienteMuyPar 668 == 680

siguienteMuyPar 828268400000 == 828268460602

Soluciones

siguienteMuyPar :: Integer -> Integer
siguienteMuyPar x = 
    head [n | n <- [y,y+2..], muyPar n]
    where y = siguientePar x

-- (siguientePar x) es el primer número mayor que x que es par. Por
-- ejemplo, 
--    siguientePar 3  ==  4
--    siguientePar 4  ==  6
siguientePar :: Integer -> Integer
siguientePar x | odd x     = x+1
               | otherwise = x+2

-- (muyPar x) se verifica si x es muy par. Por ejemplo,
--    muyPar 200           == True
--    muyPar 26            == False
muyPar :: Integer -> Bool
muyPar n = all even (digitos n) && all even (digitos (n*n))

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

siguienteMuyPar :: Integer -> Integer

siguienteMuyPar x =

head [n | n <- [y,y+2..], muyPar n]

where y = siguientePar x

-- (siguientePar x) es el primer número mayor que x que es par. Por

-- ejemplo,

-- siguientePar 3 == 4

-- siguientePar 4 == 6

siguientePar :: Integer -> Integer

siguientePar x | odd x = x+1

| otherwise = x+2

-- (muyPar x) se verifica si x es muy par. Por ejemplo,

-- muyPar 200 == True

-- muyPar 26 == False

muyPar :: Integer -> Bool

muyPar n = all even (digitos n) && all even (digitos (n*n))

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

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

digitos :: Integer -> [Int]

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

Primos gemelos próximos a múltiplos de 6

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

Un par de números primos (p,q) es un par de números primos gemelos si su distancia de 2; es decir, si q = p+2. Por ejemplo, (17,19) es una par de números primos gemelos.

Se dice que un par de números (x,y) está próximo a un múltiplo de 6 si es de la forma (6*n-1,6*n+1). Por ejemplo, (17,19) está cerca de un múltiplo de 6 porque (17,19) = (6*3-1,6*3+1).

Definir las funciones

   primosGemelos :: Integer -> [(Integer,Integer)]
   primosGemelosNoProximosAmultiplosDe6 :: Integer -> [(Integer,Integer)]

1 2	primosGemelos :: Integer -> [(Integer,Integer)] primosGemelosNoProximosAmultiplosDe6 :: Integer -> [(Integer,Integer)]

tales que

(primosGemelos n) es la lista de los primos gemelos menores que n. Por ejemplo,

     primosGemelos 50  == [(3,5),(5,7),(11,13),(17,19),(29,31),(41,43)]
     primosGemelos 43  == [(3,5),(5,7),(11,13),(17,19),(29,31)]

1 2	primosGemelos 50 == [(3,5),(5,7),(11,13),(17,19),(29,31),(41,43)] primosGemelos 43 == [(3,5),(5,7),(11,13),(17,19),(29,31)]

(primosGemelosNoProximosAmultiplosDe6 n) es la lista de los primos gemelos menores que n que no están próximos a un múltiplo de 6. Por ejemplo,

     primosGemelosNoProximosAmultiplosDe6 50              == [(3,5)]
     length (primosGemelosNoProximosAmultiplosDe6 (10^9)) == 1

1 2	primosGemelosNoProximosAmultiplosDe6 50 == [(3,5)] length (primosGemelosNoProximosAmultiplosDe6 (10^9)) == 1

Soluciones

primosGemelos :: Integer -> [(Integer,Integer)]
primosGemelos n = [(x,x+2) | x <- [3,5..n-3], 
                             primo x,
                             primo (x+2)]

primo :: Integer -> Bool
primo n = divisores n == [1,n]

divisores :: Integer -> [Integer]
divisores n = [x | x <- [1..n], n `mod` x == 0]

proximosAmultiplosDe6 :: (Integer,Integer) -> Bool
proximosAmultiplosDe6 (x,y) =
    (x+1) `mod` 6 == 0 && y == 6*n+1
    where n = (x+1) `div` 6

primosGemelosNoProximosAmultiplosDe6 :: Integer -> [(Integer,Integer)]
primosGemelosNoProximosAmultiplosDe6 n =
    [p | p <- primosGemelos n,
         not (proximosAmultiplosDe6 p)]


-- Experimentado con primosGemelosNProximosAmultiplosDe6
--    primosGemelosNoProximosAmultiplosDe6 50    == [(3,5)]
--    primosGemelosNoProximosAmultiplosDe6 500   == [(3,5)]
--    primosGemelosNoProximosAmultiplosDe6 5000  == [(3,5)]
-- se observa que el único par de primos gemelos no próximos a múltiplos
-- de 6 es el (3,5). Su demostración es la siguiente:
--
-- Para cualquier n > 3, se tiene que de los tres números n-1, n. n+1
-- uno es divisible por 2 y alguno es divisible por 3. Si n-1 y n+1 son
-- primos, entonces el que es divisible por 2 y por 3 es n y, por tanto,
-- n es divisible por 6 y (n-1,n+1) están próximos a un múltiplo de 6.

-- Usando la propiedad tenemos una definición más eficiente
primosGemelosNoProximosAmultiplosDe6' :: Integer -> [(Integer,Integer)]
primosGemelosNoProximosAmultiplosDe6' n = [(3,5)]

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

primosGemelos n = [(x,x+2) | x <- [3,5..n-3],

primo x,

primo (x+2)]

primo :: Integer -> Bool

primo n = divisores n == [1,n]

divisores :: Integer -> [Integer]

divisores n = [x | x <- [1..n], n `mod` x == 0]

proximosAmultiplosDe6 :: (Integer,Integer) -> Bool

proximosAmultiplosDe6 (x,y) =

(x+1) `mod` 6 == 0 && y == 6*n+1

where n = (x+1) `div` 6

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

primosGemelosNoProximosAmultiplosDe6 n =

[p | p <- primosGemelos n,

not (proximosAmultiplosDe6 p)]

-- Experimentado con primosGemelosNProximosAmultiplosDe6

-- primosGemelosNoProximosAmultiplosDe6 50 == [(3,5)]

-- primosGemelosNoProximosAmultiplosDe6 500 == [(3,5)]

-- primosGemelosNoProximosAmultiplosDe6 5000 == [(3,5)]

-- se observa que el único par de primos gemelos no próximos a múltiplos

-- de 6 es el (3,5). Su demostración es la siguiente:

-- Para cualquier n > 3, se tiene que de los tres números n-1, n. n+1

-- uno es divisible por 2 y alguno es divisible por 3. Si n-1 y n+1 son

-- primos, entonces el que es divisible por 2 y por 3 es n y, por tanto,

-- n es divisible por 6 y (n-1,n+1) están próximos a un múltiplo de 6.

-- Usando la propiedad tenemos una definición más eficiente

primosGemelosNoProximosAmultiplosDe6' :: Integer -> [(Integer,Integer)]

primosGemelosNoProximosAmultiplosDe6' n = [(3,5)]

Capicúas productos de dos números de dos dígitos

PorJosé A. Alonso 5-noviembre-201525-abril-2021

El número 9009 es capicúa y es producto de dos números de dos dígitos, pues 9009 = 91*99.

Definir la lista

   capicuasP2N2D :: [Int]

1	capicuasP2N2D :: [Int]

cuyos elementos son los números capicúas que son producto de 2 números de dos dígitos. Por ejemplo,

   take 5  capicuasP2N2D  ==  [121,242,252,272,323]
   length  capicuasP2N2D  ==  74
   drop 70 capicuasP2N2D  ==  [8008,8118,8448,9009]

take 5 capicuasP2N2D == [121,242,252,272,323]

length capicuasP2N2D == 74

drop 70 capicuasP2N2D == [8008,8118,8448,9009]

Soluciones

import Data.List

capicuasP2N2D :: [Int]
capicuasP2N2D = [x | x <- productos, esCapicua x]

-- productos es la lista de números menores que son productos de 2
-- números de dos dígitos.  
productos :: [Int]
productos = sort (nub [x*y | x <- [10..99], y <- [x..99]])

-- (esCapicua x) se verifica si x es capicúa.
esCapicua :: Int -> Bool
esCapicua x = xs == reverse xs
    where xs = show x

import Data.List

capicuasP2N2D :: [Int]

capicuasP2N2D = [x | x <- productos, esCapicua x]

-- productos es la lista de números menores que son productos de 2

-- números de dos dígitos.

productos :: [Int]

productos = sort (nub [x*y | x <- [10..99], y <- [x..99]])

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

esCapicua :: Int -> Bool

esCapicua x = xs == reverse xs

where xs = show x

Números muy divisibles por 3

PorJosé A. Alonso 4-noviembre-201511-noviembre-2015

Se dice que un número n es muy divisible por 3 si es divisible por 3 y sigue siendo divisible por 3 si vamos quitando dígitos por la derecha. Por ejemplo, 96060 es muy divisible por 3 porque 96060, 9606, 960, 96 y 9 son todos divisibles por 3.

Definir las funciones

   muyDivPor3             :: Integer -> Bool
   numeroMuyDivPor3Cifras :: Integer -> Integer

1 2	muyDivPor3 :: Integer -> Bool numeroMuyDivPor3Cifras :: Integer -> Integer

tales que

(muyDivPor3 n) se verifica si n es muy divisible por 3. Por ejemplo,

     muyDivPor3 96060 == True
     muyDivPor3 90616 == False

1 2	muyDivPor3 96060 == True muyDivPor3 90616 == False

(numeroMuyDivPor3CifrasC k) es la cantidad de números de k cifras muy divisibles por 3. Por ejemplo,

     numeroMuyDivPor3Cifras 5                    == 768
     numeroMuyDivPor3Cifras 7                    == 12288
     numeroMuyDivPor3Cifras (10^6) `rem` (10^6)  == 332032

numeroMuyDivPor3Cifras 5 == 768

numeroMuyDivPor3Cifras 7 == 12288

numeroMuyDivPor3Cifras (10^6) `rem` (10^6) == 332032

Soluciones

import Data.List (genericLength)

muyDivPor3 :: Integer -> Bool
muyDivPor3 n 
    | n < 10    = n `rem` 3 == 0
    | otherwise = n `rem` 3 == 0 && muyDivPor3 (n `div` 10)

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

numeroMuyDivPor3Cifras :: Integer -> Integer
numeroMuyDivPor3Cifras k = 
    genericLength [x | x <- [10^(k-1)..10^k-1], muyDivPor3 x]

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

numeroMuyDivPor3Cifras2 :: Integer -> Integer
numeroMuyDivPor3Cifras2 k = 
    genericLength [x | x <- [n,n+3..10^k-1], muyDivPor3 x]
    where n = k*10^(k-1)

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

numeroMuyDivPor3Cifras3 :: Integer -> Integer
numeroMuyDivPor3Cifras3 k = genericLength (numeroMuyDivPor3Cifras3a k)

numeroMuyDivPor3Cifras3a :: Integer -> [Integer]
numeroMuyDivPor3Cifras3a 1 = [3,6,9] 
numeroMuyDivPor3Cifras3a k = 
    [10*x+y | x <- numeroMuyDivPor3Cifras3a (k-1),
              y <- [0,3..9]]

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

numeroMuyDivPor3Cifras4 :: Integer -> Integer
numeroMuyDivPor3Cifras4 1 = 3
numeroMuyDivPor3Cifras4 k = 4 * numeroMuyDivPor3Cifras4 (k-1)

-- 5ª definición
-- =============

numeroMuyDivPor3Cifras5 :: Integer -> Integer
numeroMuyDivPor3Cifras5 k = 3 * 4^(k-1)

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

--    λ> numeroMuyDivPor3Cifras 6
--    3072
--    (3.47 secs, 534,789,608 bytes)
--    λ> numeroMuyDivPor3Cifras2 6
--    2048
--    (0.88 secs, 107,883,432 bytes)
--    λ> numeroMuyDivPor3Cifras3 6
--    3072
--    (0.01 secs, 0 bytes)
--    
--    λ> numeroMuyDivPor3Cifras2 7
--    0
--    (2.57 secs, 375,999,336 bytes)
--    λ> numeroMuyDivPor3Cifras3 7
--    12288
--    (0.02 secs, 0 bytes)
--    λ> numeroMuyDivPor3Cifras4 7
--    12288
--    (0.00 secs, 0 bytes)
--    λ> numeroMuyDivPor3Cifras5 7
--    12288
--    (0.01 secs, 0 bytes)
--
--    λ> numeroMuyDivPor3Cifras4 (10^5) `rem` 100000
--    32032
--    (5.74 secs, 1,408,600,592 bytes)
--    λ> numeroMuyDivPor3Cifras5 (10^5) `rem` 100000
--    32032
--    (0.02 secs, 0 bytes)

import Data.List (genericLength)

muyDivPor3 :: Integer -> Bool

muyDivPor3 n

| n < 10 = n `rem` 3 == 0

| otherwise = n `rem` 3 == 0 && muyDivPor3 (n `div` 10)

-- 1ª definición

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

numeroMuyDivPor3Cifras :: Integer -> Integer

numeroMuyDivPor3Cifras k =

genericLength [x | x <- [10^(k-1)..10^k-1], muyDivPor3 x]

-- 2ª definición

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

numeroMuyDivPor3Cifras2 :: Integer -> Integer

numeroMuyDivPor3Cifras2 k =

genericLength [x | x <- [n,n+3..10^k-1], muyDivPor3 x]

where n = k*10^(k-1)

-- 3ª definición

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

numeroMuyDivPor3Cifras3 :: Integer -> Integer

numeroMuyDivPor3Cifras3 k = genericLength (numeroMuyDivPor3Cifras3a k)

numeroMuyDivPor3Cifras3a :: Integer -> [Integer]

numeroMuyDivPor3Cifras3a 1 = [3,6,9]

numeroMuyDivPor3Cifras3a k =

[10*x+y | x <- numeroMuyDivPor3Cifras3a (k-1),

y <- [0,3..9]]

-- 4ª definición

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

numeroMuyDivPor3Cifras4 :: Integer -> Integer

numeroMuyDivPor3Cifras4 1 = 3

numeroMuyDivPor3Cifras4 k = 4 * numeroMuyDivPor3Cifras4 (k-1)

-- 5ª definición

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

numeroMuyDivPor3Cifras5 :: Integer -> Integer

numeroMuyDivPor3Cifras5 k = 3 * 4^(k-1)

-- Comparación de eficiencia

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

-- λ> numeroMuyDivPor3Cifras 6

-- 3072

-- (3.47 secs, 534,789,608 bytes)

-- λ> numeroMuyDivPor3Cifras2 6

-- 2048

-- (0.88 secs, 107,883,432 bytes)

-- λ> numeroMuyDivPor3Cifras3 6

-- 3072

-- (0.01 secs, 0 bytes)

-- λ> numeroMuyDivPor3Cifras2 7

-- 0

-- (2.57 secs, 375,999,336 bytes)

-- λ> numeroMuyDivPor3Cifras3 7

-- 12288

-- (0.02 secs, 0 bytes)

-- λ> numeroMuyDivPor3Cifras4 7

-- 12288

-- (0.00 secs, 0 bytes)

-- λ> numeroMuyDivPor3Cifras5 7

-- 12288

-- (0.01 secs, 0 bytes)

-- λ> numeroMuyDivPor3Cifras4 (10^5) `rem` 100000

-- 32032

-- (5.74 secs, 1,408,600,592 bytes)

-- λ> numeroMuyDivPor3Cifras5 (10^5) `rem` 100000

-- 32032

-- (0.02 secs, 0 bytes)

Números libres de cuadrados

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

Un número es libre de cuadrados si no es divisible el cuadrado de ningún entero mayor que 1. Por ejemplo, 70 es libre de cuadrado porque sólo es divisible por 1, 2, 5, 7 y 70; en cambio, 40 no es libre de cuadrados porque es divisible por 2².

Definir la función

   libreDeCuadrados :: Integer -> Bool

1	libreDeCuadrados :: Integer -> Bool

tal que (libreDeCuadrados x) se verifica si x es libre de cuadrados. Por ejemplo,

   libreDeCuadrados 70                 ==  True
   libreDeCuadrados 40                 ==  False
   libreDeCuadrados 510510             ==  True
   libreDeCuadrados (((10^10)^10)^10)  ==  False

libreDeCuadrados 70 == True

libreDeCuadrados 40 == False

libreDeCuadrados 510510 == True

libreDeCuadrados (((10^10)^10)^10) == False

Soluciones

-- 1ª definición:
libreDeCuadrados :: Integer -> Bool
libreDeCuadrados x = x == product (divisoresPrimos x)

-- (divisoresPrimos x) es la lista de los divisores primos de x. Por
-- ejemplo,  
--    divisoresPrimos 40  ==  [2,5]
--    divisoresPrimos 70  ==  [2,5,7]
divisoresPrimos :: Integer -> [Integer]
divisoresPrimos x = [n | n <- divisores x, primo n]

-- (divisores n) es la lista de los divisores del número n. Por ejemplo,
--    divisores 30  ==  [1,2,3,5,6,10,15,30]  
divisores :: Integer -> [Integer]
divisores n = [x | x <- [1..n], n `mod` x == 0]

-- (primo n) se verifica si n es primo. Por ejemplo,
--    primo 30  == False
--    primo 31  == True  
primo :: Integer -> Bool
primo n = divisores n == [1, n]

-- 2ª definición
libreDeCuadrados2 :: Integer -> Bool
libreDeCuadrados2 n = 
    null [x | x <- [2..n], rem n (x^2) == 0]

-- 3ª definición
libreDeCuadrados3 :: Integer -> Bool
libreDeCuadrados3 n = 
    null [x | x <- [2..floor (sqrt (fromIntegral n))], 
              rem n (x^2) == 0]

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

--    λ> libreDeCuadrados 510510
--    True
--    (0.76 secs, 89,522,360 bytes)
--    λ> libreDeCuadrados2 510510
--    True
--    (1.78 secs, 371,826,320 bytes)
--    λ> libreDeCuadrados3 510510
--    True
--    (0.01 secs, 0 bytes)

-- 1ª definición:

libreDeCuadrados :: Integer -> Bool

libreDeCuadrados x = x == product (divisoresPrimos x)

-- (divisoresPrimos x) es la lista de los divisores primos de x. Por

-- ejemplo,

-- divisoresPrimos 40 == [2,5]

-- divisoresPrimos 70 == [2,5,7]

divisoresPrimos :: Integer -> [Integer]

divisoresPrimos x = [n | n <- divisores x, primo n]

-- (divisores n) es la lista de los divisores del número n. Por ejemplo,

-- divisores 30 == [1,2,3,5,6,10,15,30]

divisores :: Integer -> [Integer]

divisores n = [x | x <- [1..n], n `mod` x == 0]

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

-- primo 30 == False

-- primo 31 == True

primo :: Integer -> Bool

primo n = divisores n == [1, n]

-- 2ª definición

libreDeCuadrados2 :: Integer -> Bool

libreDeCuadrados2 n =

null [x | x <- [2..n], rem n (x^2) == 0]

-- 3ª definición

libreDeCuadrados3 :: Integer -> Bool

libreDeCuadrados3 n =

null [x | x <- [2..floor (sqrt (fromIntegral n))],

rem n (x^2) == 0]

-- Comparación de eficiencia

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

-- λ> libreDeCuadrados 510510

-- True

-- (0.76 secs, 89,522,360 bytes)

-- λ> libreDeCuadrados2 510510

-- True

-- (1.78 secs, 371,826,320 bytes)

-- λ> libreDeCuadrados3 510510

-- True

-- (0.01 secs, 0 bytes)

Factoriales iguales a su número de dígitos

PorJosé A. Alonso 30-octubre-201520-noviembre-2015

Se dice que un número n tiene un factorial especial si el número de dígitos de n! es igual a n. Por ejemplo, 22 tiene factorial especial porque 22! es 1124000727777607680000 que tiene 22 dígitos.

Definir la función

   factorialesEspeciales :: [Integer]

1	factorialesEspeciales :: [Integer]

tal que su valor es la lista de los números que tienen factoriales especiales. Por ejemplo,

   take 2 factorialesEspeciales  ==  [1,22]

1	take 2 factorialesEspeciales == [1,22]

Nota: Si factorialesEspeciales es una lista finita, argumentar porqué no puede tener más elementos.

Soluciones

import Data.List (genericLength)

factorialesEspeciales :: [Integer]
factorialesEspeciales =
    [n | n <- [1..], tieneFactorialEspecial n]

tieneFactorialEspecial :: Integer -> Bool
tieneFactorialEspecial n = n == genericLength (show (factorial n))

factorial :: Integer -> Integer
factorial n = product [1..n]

-- El cálculo es
--    ghci> factorialesEspeciales
--    [1,22,23,24  C-c C-cInterrupted.

-- Para comprobar que no hay más definimos

crecimiento :: [(Integer,Integer)]
crecimiento = [(n,n - genericLength (show (factorial n))) | n <- [1..]]

-- Al evaluarla

--    ghci> take 30 crecimiento 
--    [(1,0),(2,1),(3,2),(4,2),(5,2),(6,3),(7,3),(8,3),(9,3),(10,3),(11,3),
--     (12,3),(13,3),(14,3),(15,2),(16,2),(17,2),(18,2),(19,1),(20,1),(21,1),
--     (22,0),(23,0),(24,0),(25,-1),(26,-1),(27,-2),(28,-2),(29,-2),(30,-3)]

-- se observa que, a partir de n = 25, el número de cifras del factorial
-- de n es mayor que n.

import Data.List (genericLength)

factorialesEspeciales :: [Integer]

factorialesEspeciales =

[n | n <- [1..], tieneFactorialEspecial n]

tieneFactorialEspecial :: Integer -> Bool

tieneFactorialEspecial n = n == genericLength (show (factorial n))

factorial :: Integer -> Integer

factorial n = product [1..n]

-- El cálculo es

-- ghci> factorialesEspeciales

-- [1,22,23,24 C-c C-cInterrupted.

-- Para comprobar que no hay más definimos

crecimiento :: [(Integer,Integer)]

crecimiento = [(n,n - genericLength (show (factorial n))) | n <- [1..]]

-- Al evaluarla

-- ghci> take 30 crecimiento

-- [(1,0),(2,1),(3,2),(4,2),(5,2),(6,3),(7,3),(8,3),(9,3),(10,3),(11,3),

-- (12,3),(13,3),(14,3),(15,2),(16,2),(17,2),(18,2),(19,1),(20,1),(21,1),

-- (22,0),(23,0),(24,0),(25,-1),(26,-1),(27,-2),(28,-2),(29,-2),(30,-3)]

-- se observa que, a partir de n = 25, el número de cifras del factorial

-- de n es mayor que n.

Próximos a múltiplos de 6

PorJosé A. Alonso 29-octubre-20155-noviembre-2015

Se dice que un par de números (x,y) está próximo a un múltiplo de 6 si es de la forma (6*n-1,6*n+1). Por ejemplo, (17,19) está cerca de un múltiplo de 6 porque (17,19) = (6*3-1,6*3+1).

Definir la función

   proximosAmultiplosDe6 :: (Integer,Integer) -> Bool

1	proximosAmultiplosDe6 :: (Integer,Integer) -> Bool

tal que (proximosAmultiplosDe6 (x,y)) se verifica si el par (x,y) está próximo a un múltiplo de 6. Por ejemplo,

   proximosAmultiplosDe6 (17,19)                          ==  True
   proximosAmultiplosDe6 (18,20)                          ==  False
   proximosAmultiplosDe6 (5,19)                           ==  False
   proximosAmultiplosDe6 (1,3)                            ==  False
   proximosAmultiplosDe6 (74074073407403,74074073407405)  ==  True
   proximosAmultiplosDe6 (86419752308637,86419752308639)  ==  False

proximosAmultiplosDe6 (17,19) == True

proximosAmultiplosDe6 (18,20) == False

proximosAmultiplosDe6 (5,19) == False

proximosAmultiplosDe6 (1,3) == False

proximosAmultiplosDe6 (74074073407403,74074073407405) == True

proximosAmultiplosDe6 (86419752308637,86419752308639) == False

Soluciones

-- 1ª solución
proximosAmultiplosDe6 :: (Integer,Integer) -> Bool
proximosAmultiplosDe6 (x,y) =
    (x+1) `mod` 6 == 0 && y == 6*n+1
    where n = (x+1) `div` 6

-- 2ª solución
proximosAmultiplosDe6' :: (Integer,Integer) -> Bool
proximosAmultiplosDe6' (a,b) = 
    a+1 == b-1 && mod (a+b) 6 == 0

-- 1ª solución

proximosAmultiplosDe6 :: (Integer,Integer) -> Bool

proximosAmultiplosDe6 (x,y) =

(x+1) `mod` 6 == 0 && y == 6*n+1

where n = (x+1) `div` 6

-- 2ª solución

proximosAmultiplosDe6' :: (Integer,Integer) -> Bool

proximosAmultiplosDe6' (a,b) =

a+1 == b-1 && mod (a+b) 6 == 0

Lista con repeticiones

PorJosé A. Alonso 27-octubre-20153-noviembre-2015

Definir la función

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

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

tal que (tieneRepeticiones xs) se verifica si xs tiene algún elemento repetido. Por ejemplo,

   tieneRepeticiones [3,2,5,2,7]          ==  True
   tieneRepeticiones [3,2,5,4,7]          ==  False
   tieneRepeticiones (5:[1..2000000000])  ==  True
   tieneRepeticiones [1..20000]           ==  False

tieneRepeticiones [3,2,5,2,7] == True

tieneRepeticiones [3,2,5,4,7] == False

tieneRepeticiones (5:[1..2000000000]) == True

tieneRepeticiones [1..20000] == False

Soluciones

tieneRepeticiones :: Eq a => [a] -> Bool
tieneRepeticiones []     = False
tieneRepeticiones (x:xs) = x `elem` xs || tieneRepeticiones xs

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

tieneRepeticiones [] = False

tieneRepeticiones (x:xs) = x `elem` xs || tieneRepeticiones xs

Mayor resto

PorJosé A. Alonso 26-octubre-20152-noviembre-2015

El resultado de dividir un número n por un divisor d es un cociente q y un resto r.

Definir la función

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

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

tal que (mayorResto n d) es el par (m,xs) tal que m es el mayor resto de dividir n entre x (con 1 ≤ x < d) y xs es la lista de números x menores que d tales que el resto de n entre x es m. Por ejemplo,

   mayorResto 20 10  ==  (6,[7])
   mayorResto 50 8   ==  (2,[3,4,6])

1 2	mayorResto 20 10 == (6,[7]) mayorResto 50 8 == (2,[3,4,6])

Nota: Se supone que d es mayor que 1.

Soluciones

mayorResto :: Int -> Int -> (Int,[Int])
mayorResto n d = (m, [x | x <- [1..d-1], n `rem` x == m])
    where m = maximum [n `rem` x | x <- [1..d-1]]

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

mayorResto n d = (m, [x | x <- [1..d-1], n `rem` x == m])

where m = maximum [n `rem` x | x <- [1..d-1]]

Referencia

El ejercio está basado en el problema Largest possible remainder publicado el 16 de octubre de 2015 en «Programming paraxis».

Entero positivo con ciertas propiedades

PorJosé A. Alonso 23-octubre-201530-octubre-2015

El 6 de octubre, se propuso en el blog Gaussianos el siguiente problema

Demostrar que para todo entero positivo n, existe otro entero positivo que tiene las siguientes propiedades:

Tiene exactamente n dígitos.

Ninguno de sus dígitos es 0.

Es divisible por la suma de sus dígitos.

Definir la función

   especiales :: Integer -> [Integer]

1	especiales :: Integer -> [Integer]

tal que (especiales n) es la lista de los números enteros que cumplen las 3 propiedades anteriores para n. Por ejemplo,

   take 3 (especiales 2)  ==  [12,18,21]
   take 3 (especiales 3)  ==  [111,112,114]
   head (especiales 30)   ==  111111111111111111111111111125
   length (especiales 3)  ==  108
   null (especiales 1000) ==  False

take 3 (especiales 2) == [12,18,21]

take 3 (especiales 3) == [111,112,114]

head (especiales 30) == 111111111111111111111111111125

length (especiales 3) == 108

null (especiales 1000) == False

En el primer ejemplo, 12 es un número especial para 2 ya que tiene exactamente 2 dígitos, ninguno de sus dígitos es 0 y 12 es divisible por la suma de sus dígitos.

Soluciones

especiales :: Integer -> [Integer]
especiales n = [x | x <- [(10^n-1) `div` 9..10^n-1]
                  , esEspecial x]

esEspecial :: Integer -> Bool
esEspecial x = 
    notElem 0 digitos &&
    x `mod` sum digitos == 0        
    where digitos = [read [d] | d <- show x]

especiales :: Integer -> [Integer]

especiales n = [x | x <- [(10^n-1) `div` 9..10^n-1]

, esEspecial x]

esEspecial :: Integer -> Bool

esEspecial x =

notElem 0 digitos &&

x `mod` sum digitos == 0

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

Centro de masas

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

El centro de masas de un sistema discreto es el punto geométrico que dinámicamente se comporta como si en él estuviera aplicada la resultante de las fuerzas externas al sistema.

Representamos un conjunto de n masas en el plano mediante una lista de n pares de la forma ((a(i),b(i)),m(i)) donde (a(i),b(i)) es la posición y m(i) la masa puntual. Las coordenadas del centro de masas (a,b) se calculan por

   a = (a(1)*m(1) + a(2)*m(2) + ... + a(n)*m(n)) / (m(1) + m(2) +...+ m(n))
   b = (b(1)*m(1) + b(2)*m(2) + ... + b(n)*m(n)) / (m(1) + m(2) +...+ m(n))

1 2	a = (a(1)m(1) + a(2)m(2) + ... + a(n)m(n)) / (m(1) + m(2) +...+ m(n)) b = (b(1)m(1) + b(2)m(2) + ... + b(n)m(n)) / (m(1) + m(2) +...+ m(n))

Definir la función

   centrodeMasas :: [((Float,Float),Float)] -> (Float,Float)

1	centrodeMasas :: [((Float,Float),Float)] -> (Float,Float)

tal que (centrodeMasas xs) es las coordenadas del centro
de masas del sistema discreto xs. Por ejemplo:

   centrodeMasas [((-1,3),2),((0,0),5),((1,3),3)] == (0.1,1.5)

1	centrodeMasas [((-1,3),2),((0,0),5),((1,3),3)] == (0.1,1.5)

Soluciones

-- 1ª definición (por comprensión):
centrodeMasas :: [((Float,Float),Float)] -> (Float,Float) 
centrodeMasas xs = 
    (sum [a*m | ((a,_),m) <- xs] / t,
     sum [b*m | ((_,b),m) <- xs] / t)
    where t = sum [m | (_,m) <- xs]

-- 2ª definición (por recursión):
centrodeMasas2 :: [((Float,Float),Float)] -> (Float,Float)
centrodeMasas2 xs = aux xs (0,0,0)
    where aux [] (as,bs,ms)             = (as/ms, bs/ms)
          aux (((a,b),m):ys) (as,bs,ms) = aux ys (as+a*m,bs+b*m,ms+m)

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

centrodeMasas :: [((Float,Float),Float)] -> (Float,Float)

centrodeMasas xs =

(sum [a*m | ((a,_),m) <- xs] / t,

sum [b*m | ((_,b),m) <- xs] / t)

where t = sum [m | (_,m) <- xs]

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

centrodeMasas2 :: [((Float,Float),Float)] -> (Float,Float)

centrodeMasas2 xs = aux xs (0,0,0)

where aux [] (as,bs,ms) = (as/ms, bs/ms)

aux (((a,b),m):ys) (as,bs,ms) = aux ys (as+a*m,bs+b*m,ms+m)

Refinamiento de listas

PorJosé A. Alonso 21-octubre-201528-octubre-2015

Definir la función

   refinada :: [Float] -> [Float]

1	refinada :: [Float] -> [Float]

tal que (refinada xs) es la lista obtenida intercalando entre cada dos elementos consecutivos de xs su media aritmética. Por ejemplo,

   refinada [2,7,1,8]  ==  [2.0,4.5,7.0,4.0,1.0,4.5,8.0]
   refinada [2]        ==  [2.0]
   refinada []         ==  []

refinada [2,7,1,8] == [2.0,4.5,7.0,4.0,1.0,4.5,8.0]

refinada [2] == [2.0]

refinada [] == []

Soluciones

-- 1ª definición (por recursión):
refinada :: [Float] -> [Float]
refinada (x:y:zs) = x : (x+y)/2 : refinada (y:zs)
refinada xs       = xs

-- 2ª definición (por comprensión);
refinada2 :: [Float] -> [Float]
refinada2 []     = []
refinada2 (x:xs) = x : concat [[(a+b)/2,b] | (a,b) <- zip (x:xs) xs]

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

refinada :: [Float] -> [Float]

refinada (x:y:zs) = x : (x+y)/2 : refinada (y:zs)

refinada xs = xs

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

refinada2 :: [Float] -> [Float]

refinada2 [] = []

refinada2 (x:xs) = x : concat [[(a+b)/2,b] | (a,b) <- zip (x:xs) xs]

Menor n tal que el primo n-ésimo cumple una propiedad

PorJosé A. Alonso 18-junio-201528-octubre-2015

Sea p(n) el n-ésimo primo y sea r el resto de dividir (p(n)-1)^n + (p(n)+1)^n por p(n)^2. Por ejemplo,

   si n = 3, entonces p(3) =  5 y r = ( 4^3 +  6^3) mod  (5^2) =   5
   si n = 7, entonces p(7) = 17 y r = (16^7 + 18^7) mod (17^2) = 238

1 2	si n = 3, entonces p(3) = 5 y r = ( 4^3 + 6^3) mod (5^2) = 5 si n = 7, entonces p(7) = 17 y r = (16^7 + 18^7) mod (17^2) = 238

Definir la función

   menorPR :: Integer -> Integer

1	menorPR :: Integer -> Integer

tal que (menorPR x) es el menor n tal que el resto de dividir (p(n)-1)^n + (p(n)+1)^n por p(n)^2 es mayor que x. Por ejemplo,

   menorPR 100     == 5
   menorPR 345     == 9
   menorPR 1000    == 13
   menorPR (10^9)  == 7037
   menorPR (10^10) == 21035
   menorPR (10^12) == 191041

menorPR 100 == 5

menorPR 345 == 9

menorPR 1000 == 13

menorPR (10^9) == 7037

menorPR (10^10) == 21035

menorPR (10^12) == 191041

Soluciones

import Data.Numbers.Primes (primes)

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

menorPR1 :: Integer -> Integer
menorPR1 x = head [n | (n,p) <- zip [1..] primes
                     , (((p-1)^n + (p+1)^n) `mod` (p^2)) > x]

-- Segunda solución (usando el binomio de Newton)
-- ==============================================

-- Desarrollando por el binomio de Newton
--    (p+1)^n = C(n,0)p^n + C(n,1)p^(n-1) +...+ C(n,n-1)p + 1
--    (p-1)^n = C(n,0)p^n - C(n,1)p^(n-1) +...+ C(n,n-1)p + (-1)^n
-- Sumando se obtiene (según n sea par o impar)
--    2*C(n,0)p^n + 2*C(n,n-2)p^(n-1) +...+ 2*C(n,2)p^2 + 2
--    2*C(n,0)p^n + 2*C(n,n-2)p^(n-1) +...+ 2*C(n,1)p^1
-- Al dividir por p^2, el resto es (según n sea par o impar) 2 ó 2*C(n,1)p

-- (restoM n p) es el resto de de dividir (p-1)^n + (p+1)^n por p^2.
restoM :: Integer -> Integer -> Integer
restoM n p | even n    = 2
           | otherwise = 2*n*p `mod`(p^2)

menorPR2 :: Integer -> Integer
menorPR2 x = head [n | (n,p) <- zip [1..] primes, restoM n p > x]

-- Comparación de eficiencia
--    ghci> menorPR1 (3*10^8)
--    3987
--    (2.44 secs, 120291676 bytes)
--    ghci> menorPR2 (3*10^8)
--    3987
--    (0.04 secs, 8073900 bytes)

import Data.Numbers.Primes (primes)

-- 1ª solución

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

menorPR1 :: Integer -> Integer

menorPR1 x = head [n | (n,p) <- zip [1..] primes

, (((p-1)^n + (p+1)^n) `mod` (p^2)) > x]

-- Segunda solución (usando el binomio de Newton)

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

-- Desarrollando por el binomio de Newton

-- (p+1)^n = C(n,0)p^n + C(n,1)p^(n-1) +...+ C(n,n-1)p + 1

-- (p-1)^n = C(n,0)p^n - C(n,1)p^(n-1) +...+ C(n,n-1)p + (-1)^n

-- Sumando se obtiene (según n sea par o impar)

-- 2*C(n,0)p^n + 2*C(n,n-2)p^(n-1) +...+ 2*C(n,2)p^2 + 2

-- 2*C(n,0)p^n + 2*C(n,n-2)p^(n-1) +...+ 2*C(n,1)p^1

-- Al dividir por p^2, el resto es (según n sea par o impar) 2 ó 2*C(n,1)p

-- (restoM n p) es el resto de de dividir (p-1)^n + (p+1)^n por p^2.

restoM :: Integer -> Integer -> Integer

restoM n p | even n = 2

| otherwise = 2*n*p `mod`(p^2)

menorPR2 :: Integer -> Integer

menorPR2 x = head [n | (n,p) <- zip [1..] primes, restoM n p > x]

-- Comparación de eficiencia

-- ghci> menorPR1 (3*10^8)

-- 3987

-- (2.44 secs, 120291676 bytes)

-- ghci> menorPR2 (3*10^8)

-- 3987

-- (0.04 secs, 8073900 bytes)

Método de bisección para encontrar raíces de funciones

PorJosé A. Alonso 11-junio-201528-octubre-2015

El método de bisección para calcular un cero de una función en el intervalo
[a,b] se basa en el teorema de Bolzano:

Si f(x) es una función continua en el intervalo [a, b], y si, además, en los extremos del intervalo la función f(x) toma valores de signo opuesto (f(a) * f(b) < 0), entonces existe al menos un valor c en (a, b) para el que f(c) = 0″.

El método para calcular un cero de la función f en el intervalo [a,b] con un error menor que e consiste en tomar el punto medio del intervalo c = (a+b)/2 y considerar los siguientes casos:

Si |f(c)| < e, hemos encontrado una aproximación del punto que anula f en el intervalo con un error aceptable.
Si f(c) tiene signo distinto de f(a), repetir el proceso en el intervalo [a,c].
Si no, repetir el proceso en el intervalo [c,b].

Definir la función

   biseccion :: (Double -> Double) -> Double -> Double -> Double -> Double

1	biseccion :: (Double -> Double) -> Double -> Double -> Double -> Double

tal que (biseccion f a b e) es una aproximación del punto del intervalo [a,b] en el que se anula la función f, con un error menor que e, calculada mediante el método de la bisección. Por ejemplo,

   biseccion (\x -> x^2 - 3) 0 5 0.01             ==  1.7333984375
   biseccion (\x -> x^3 - x - 2) 0 4 0.01         ==  1.521484375
   biseccion cos 0 2 0.01                         ==  1.5625
   biseccion (\x -> log (50-x) - 4) (-10) 3 0.01  ==  -5.125

biseccion (\x -> x^2 - 3) 0 5 0.01 == 1.7333984375

biseccion (\x -> x^3 - x - 2) 0 4 0.01 == 1.521484375

biseccion cos 0 2 0.01 == 1.5625

biseccion (\x -> log (50-x) - 4) (-10) 3 0.01 == -5.125

Soluciones

-- 1ª solución
biseccion :: (Double -> Double) -> Double -> Double -> Double -> Double
biseccion f a b e  
    | abs (f c) < e   = c
    | (f a)*(f c) < 0 = biseccion f a c e
    | otherwise       = biseccion f c b e
    where c = (a+b)/2

-- 2ª solución
biseccion2 :: (Double -> Double) -> Double -> Double -> Double -> Double
biseccion2 f a b e = aux a b
    where aux a b | abs (f c) < e   = c
                  | (f a)*(f c) < 0 = aux a c 
                  | otherwise       = aux c b
                  where c = (a+b)/2

-- 1ª solución

biseccion :: (Double -> Double) -> Double -> Double -> Double -> Double

biseccion f a b e

| abs (f c) < e = c

| (f a)*(f c) < 0 = biseccion f a c e

| otherwise = biseccion f c b e

where c = (a+b)/2

-- 2ª solución

biseccion2 :: (Double -> Double) -> Double -> Double -> Double -> Double

biseccion2 f a b e = aux a b

where aux a b | abs (f c) < e = c

| (f a)*(f c) < 0 = aux a c

| otherwise = aux c b

where c = (a+b)/2

Descomposiciones en sumas de primos

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

Definir la función

   sumaDePrimos :: Int -> [[Int]]

1	sumaDePrimos :: Int -> [[Int]]

tal que (sumaDePrimos x) es la lista de las listas no crecientes de números primos que suman x. Por ejemplo,

   sumaDePrimos 10  ==  [[7,3],[5,5],[5,3,2],[3,3,2,2],[2,2,2,2,2]]
   sumaDePrimos 0   ==  []
   sumaDePrimos 1   ==  []

sumaDePrimos 10 == [[7,3],[5,5],[5,3,2],[3,3,2,2],[2,2,2,2,2]]

sumaDePrimos 0 == []

sumaDePrimos 1 == []

Soluciones

import Data.Numbers.Primes (primes)

sumaDePrimos :: Integer -> [[Integer]]
sumaDePrimos n = aux n (reverse (takeWhile (<=n) primes))
    where aux _ [] = []
          aux n (x:xs) | x > n     = aux n xs
                       | x == n    = [n] : aux n xs
                       | otherwise = map (x:) (aux (n-x) (x:xs)) ++ aux n xs

import Data.Numbers.Primes (primes)

sumaDePrimos :: Integer -> [[Integer]]

sumaDePrimos n = aux n (reverse (takeWhile (<=n) primes))

where aux _ [] = []

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

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

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

Matrices latinas

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

Una matriz latina de orden n es una matriz cuadrada de orden n tal que todos sus elementos son cero salvo los de su fila y columna central, si n es impar; o los de sus dos filas y columnas centrales, si n es par.

Definir la función

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

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

tal que (latina n) es la siguiente matriz latina de orden n:

Para n impar:

     | 0  0... 0 1   0 ... 0   0|
     | 0  0... 0 2   0 ... 0   0|
     | 0  0... 0 3   0 ... 0   0|
     | .........................|
     | 1  2..............n-1   n|
     | .........................|
     | 0  0... 0 n-2 0 ... 0   0|
     | 0  0... 0 n-1 0 ... 0   0|
     | 0  0... 0 n   0 ... 0   0|

| 0 0... 0 1 0 ... 0 0|

| 0 0... 0 2 0 ... 0 0|

| 0 0... 0 3 0 ... 0 0|

| .........................|

| 1 2..............n-1 n|

| .........................|

| 0 0... 0 n-2 0 ... 0 0|

| 0 0... 0 n-1 0 ... 0 0|

| 0 0... 0 n 0 ... 0 0|

Para n par:

     | 0  0... 0 1   n    0 ...   0   0|
     | 0  0... 0 2   n-1  0 ...   0   0|
     | 0  0... 0 3   n-2  0 ...   0   0|
     | ................................|
     | 1  2.....................n-1   n|
     | n n-1 .................... 2   1|
     | ................................|
     | 0  0... 0 n-2  3   0 ...   0   0|
     | 0  0... 0 n-1  2   0 ...   0   0|
     | 0  0... 0 n    1   0 ...   0   0|

| 0 0... 0 1 n 0 ... 0 0|

| 0 0... 0 2 n-1 0 ... 0 0|

| 0 0... 0 3 n-2 0 ... 0 0|

| ................................|

| 1 2.....................n-1 n|

| n n-1 .................... 2 1|

| ................................|

| 0 0... 0 n-2 3 0 ... 0 0|

| 0 0... 0 n-1 2 0 ... 0 0|

| 0 0... 0 n 1 0 ... 0 0|

Por ejemplo,

   ghci> elems (latina 5)
   [0,0,1,0,0,
    0,0,2,0,0,
    1,2,3,4,5,
    0,0,4,0,0,
    0,0,5,0,0]
   ghci> elems (latina 6)
   [0,0,1,6,0,0,
    0,0,2,5,0,0,
    1,2,3,4,5,6,
    6,5,4,3,2,1,
    0,0,5,2,0,0,
    0,0,6,1,0,0]

ghci> elems (latina 5)

[0,0,1,0,0,

0,0,2,0,0,

1,2,3,4,5,

0,0,4,0,0,

0,0,5,0,0]

ghci> elems (latina 6)

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

0,0,2,5,0,0,

1,2,3,4,5,6,

6,5,4,3,2,1,

0,0,5,2,0,0,

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

Soluciones

latina :: Int -> Array (Int,Int) Int
latina n | even n    = latinaPar n
         | otherwise = latinaImpar n

-- (latinaImpar n) es la matriz latina de orden n, siendo n un número
-- impar. Por ejemplo,
--    ghci> elems (latinaImpar 5)
--    [0,0,1,0,0,
--     0,0,2,0,0,
--     1,2,3,4,5,
--     0,0,4,0,0,
--     0,0,5,0,0]
latinaImpar :: Int -> Array (Int,Int) Int
latinaImpar n = 
    array ((1,1),(n,n)) [((i,j),f i j) | i <- [1..n], j <- [1..n]]
    where c = 1 + (n `div` 2)
          f i j | i == c    = j
                | j == c    = i 
                | otherwise = 0 

-- (latinaPar n) es la matriz latina de orden n, siendo n un número
-- par. Por ejemplo,
--    ghci> elems (latinaPar 6)
--    [0,0,1,6,0,0,
--     0,0,2,5,0,0,
--     1,2,3,4,5,6,
--     6,5,4,3,2,1,
--     0,0,5,2,0,0,
--     0,0,6,1,0,0]
latinaPar :: Int -> Array (Int,Int) Int
latinaPar n = 
    array ((1,1),(n,n)) [((i,j),f i j) | i <- [1..n], j <- [1..n]]
    where c = n `div` 2
          f i j | i == c    = j
                | i == c+1  = n-j+1
                | j == c    = i
                | j == c+1  = n-i+1
                | otherwise = 0

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

latina n | even n = latinaPar n

| otherwise = latinaImpar n

-- (latinaImpar n) es la matriz latina de orden n, siendo n un número

-- impar. Por ejemplo,

-- ghci> elems (latinaImpar 5)

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

-- 0,0,2,0,0,

-- 1,2,3,4,5,

-- 0,0,4,0,0,

-- 0,0,5,0,0]

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

latinaImpar n =

array ((1,1),(n,n)) [((i,j),f i j) | i <- [1..n], j <- [1..n]]

where c = 1 + (n `div` 2)

f i j | i == c = j

| j == c = i

| otherwise = 0

-- (latinaPar n) es la matriz latina de orden n, siendo n un número

-- par. Por ejemplo,

-- ghci> elems (latinaPar 6)

-- [0,0,1,6,0,0,

-- 0,0,2,5,0,0,

-- 1,2,3,4,5,6,

-- 6,5,4,3,2,1,

-- 0,0,5,2,0,0,

-- 0,0,6,1,0,0]

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

latinaPar n =

array ((1,1),(n,n)) [((i,j),f i j) | i <- [1..n], j <- [1..n]]

where c = n `div` 2

f i j | i == c = j

| i == c+1 = n-j+1

| j == c = i

| j == c+1 = n-i+1

| otherwise = 0

Matrices marco y transiciones

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

Las posiciones frontera de una matriz de orden mxn son aquellas que están en la fila 1 o la fila m o la columna 1 o la columna n. El resto se dirán posiciones interiores. Observa que cada elemento en una posición interior tiene exactamente 8 vecinos en la matriz.

Dada una matriz, un paso de transición genera una nueva matriz de la misma dimensión pero en la que se ha sustituido cada elemento interior por la suma de sus 8 vecinos. Los elementos frontera no varían.

Definir las funciones

   marco      :: Int -> Int -> Integer -> Matrix Integer
   paso       :: Matrix Integer -> Matrix Integer
   itPasos    :: Int -> Matrix Integer -> Matrix Integer
   pasosHasta :: Integer -> Int

marco :: Int -> Int -> Integer -> Matrix Integer

paso :: Matrix Integer -> Matrix Integer

itPasos :: Int -> Matrix Integer -> Matrix Integer

pasosHasta :: Integer -> Int

tales que

(marco m n z) genera la matriz de dimensión mxn que contiene el entero z en las posiciones frontera y 0 en las posiciones interiores. Por ejemplo,

     ghci> marco 5 5 1
     ( 1 1 1 1 1 )
     ( 1 0 0 0 1 )
     ( 1 0 0 0 1 )
     ( 1 0 0 0 1 )
     ( 1 1 1 1 1 )

ghci> marco 5 5 1

( 1 1 1 1 1 )

( 1 0 0 0 1 )

( 1 1 1 1 1 )

(paso t) calcula la matriz generada tras aplicar un paso de transición a la matriz t. Por ejemplo,

     ghci> paso (marco 5 5 1)
     ( 1 1 1 1 1 )
     ( 1 5 3 5 1 )
     ( 1 3 0 3 1 )
     ( 1 5 3 5 1 )
     ( 1 1 1 1 1 )

ghci> paso (marco 5 5 1)

( 1 1 1 1 1 )

( 1 5 3 5 1 )

( 1 3 0 3 1 )

( 1 5 3 5 1 )

( 1 1 1 1 1 )

(itPasos k t) es la matriz obtenida tras aplicar k pasos de transición a partir de la matriz t. Por ejemplo,

     ghci> itPasos 10 (marco 5 5 1)
     (       1       1       1       1       1 )
     (       1 4156075 5878783 4156075       1 )
     (       1 5878783 8315560 5878783       1 )
     (       1 4156075 5878783 4156075       1 )
     (       1       1       1       1       1 )

ghci> itPasos 10 (marco 5 5 1)

( 1 1 1 1 1 )

( 1 4156075 5878783 4156075 1 )

( 1 5878783 8315560 5878783 1 )

( 1 4156075 5878783 4156075 1 )

( 1 1 1 1 1 )

(pasosHasta k) es el número de pasos de transición a partir de la matriz (marco 5 5 1) necesarios para que en la matriz resultante aparezca un elemento mayor que k. Por ejemplo,

     pasosHasta 4         ==  1
     pasosHasta 6         ==  2
     pasosHasta (2^2015)  ==  887

pasosHasta 4 == 1

pasosHasta 6 == 2

pasosHasta (2^2015) == 887

Soluciones

import Data.Matrix

marco :: Int -> Int -> Integer -> Matrix Integer
marco m n z  = matrix m n f
    where f (i,j) | frontera m n (i,j) = z
                  | otherwise          = 0 

-- (frontera m n (i,j)) se verifica si (i,j) es una posición de la
-- frontera de las matrices de dimensión mxn.
frontera :: Int -> Int -> (Int,Int) -> Bool
frontera m n (i,j) = or [i == 1, i == m, j == 1, j == n]

paso :: Matrix Integer -> Matrix Integer
paso p = matrix m n f where
    m = nrows p
    n = ncols p
    f (i,j) 
        | frontera m n (i,j) = p!(i,j)
        | otherwise          = sum [p!(u,v) | (u,v) <- vecinos m n (i,j)]
    
-- (vecinos m n (i,j)) es la lista de las posiciones de los vecinos del
-- punto interior (i,j) en las matrices de dimensión mxn.
vecinos :: Int -> Int -> (Int,Int) -> [(Int,Int)]
vecinos m n (i,j) = [(a,b) | a <- [i-1..i+1]
                           , b <- [j-1..j+1]
                           , (a,b) /= (i,j)]

itPasos :: Int -> Matrix Integer -> Matrix Integer 
itPasos k t = (iterate paso t) !! k 

pasosHasta :: Integer -> Int
pasosHasta k =
    length (takeWhile (\t -> menores t k) (iterate paso (marco 5 5 1)))

-- (menores p k) se verifica si los elementos de p son menores o
-- iguales que k. Por ejemplo, 
--    menores (itPasos 1 (marco 5 5 1)) 6  ==  True
--    menores (itPasos 1 (marco 5 5 1)) 4  ==  False
menores :: Matrix Integer -> Integer -> Bool
menores p k = all (<=k) (toList p)

import Data.Matrix

marco :: Int -> Int -> Integer -> Matrix Integer

marco m n z = matrix m n f

where f (i,j) | frontera m n (i,j) = z

| otherwise = 0

-- (frontera m n (i,j)) se verifica si (i,j) es una posición de la

-- frontera de las matrices de dimensión mxn.

frontera :: Int -> Int -> (Int,Int) -> Bool

frontera m n (i,j) = or [i == 1, i == m, j == 1, j == n]

paso :: Matrix Integer -> Matrix Integer

paso p = matrix m n f where

m = nrows p

n = ncols p

f (i,j)

| frontera m n (i,j) = p!(i,j)

| otherwise = sum [p!(u,v) | (u,v) <- vecinos m n (i,j)]

-- (vecinos m n (i,j)) es la lista de las posiciones de los vecinos del

-- punto interior (i,j) en las matrices de dimensión mxn.

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

vecinos m n (i,j) = [(a,b) | a <- [i-1..i+1]

, b <- [j-1..j+1]

, (a,b) /= (i,j)]

itPasos :: Int -> Matrix Integer -> Matrix Integer

itPasos k t = (iterate paso t) !! k

pasosHasta :: Integer -> Int

pasosHasta k =

length (takeWhile (\t -> menores t k) (iterate paso (marco 5 5 1)))

-- (menores p k) se verifica si los elementos de p son menores o

-- iguales que k. Por ejemplo,

-- menores (itPasos 1 (marco 5 5 1)) 6 == True

-- menores (itPasos 1 (marco 5 5 1)) 4 == False

menores :: Matrix Integer -> Integer -> Bool

menores p k = all (<=k) (toList p)

Números alternados

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

Decimos que un número es alternado si no tiene dos cifras consecutivas iguales ni tres cifras consecutivas en orden creciente no estricto o decreciente no estricto. Por ejemplo, los números 132425 y 92745 son alternados, pero los números 12325 y 29778 no. Las tres primeras cifras de 12325 están en orden creciente y 29778 tiene dos cifras iguales consecutivas.

Definir la constante

   alternados :: [Integer]

1	alternados :: [Integer]

cuyo valor es la lista infinita de los números alternados. Por ejemplo,

   take 10 alternados                      ==  [0,1,2,3,4,5,6,7,8,9]
   length (takeWhile (< 1000) alternados)  ==  616
   alternados !! 1234567                   ==  19390804

take 10 alternados == [0,1,2,3,4,5,6,7,8,9]

length (takeWhile (< 1000) alternados) == 616

alternados !! 1234567 == 19390804

Soluciones

import Data.Char (digitToInt)

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

-- (cifras n) es la lista de las cifras de n. Por ejemplo.
--    cifras 325  ==  [3,2,5]
cifras :: Integer -> [Int]
cifras n = map digitToInt (show n)

-- (cifrasAlternadas xs) se verifica si las lista de cifras xs es
-- alternada. Por ejemplo,
--    cifrasAlternadas [1,3,2,4,2,5]  ==  True
--    cifrasAlternadas [9,2,7,4,5]    ==  True
--    cifrasAlternadas [1,2,3,2,5]    ==  False
--    cifrasAlternadas [2,9,7,7,8]    ==  False
cifrasAlternadas :: [Int] -> Bool
cifrasAlternadas [x1,x2] = x1 /= x2
cifrasAlternadas (x1:x2:x3:xs) =
    not (((x1 <= x2) && (x2 <= x3)) || ((x1 >= x2) && (x2 >= x3))) &&
    cifrasAlternadas (x2:x3:xs)
cifrasAlternadas _ = True

-- (alternado n) se verifica si n es un número alternado. Por ejemplo,
--    alternado 132425  ==  True
--    alternado 92745   ==  True
--    alternado 12325   ==  False
--    alternado 29778   ==  False
alternado :: Integer -> Bool
alternado n = cifrasAlternadas (cifras n)

alternados1 :: [Integer]
alternados1 = filter alternado [0..]

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

-- (extiendeAlternado n) es la lista de números alternados que se pueden
-- obtener añadiendo una cifra al final del número alternado n. Por
-- ejemplo,
--    extiendeAlternado 7   ==  [70,71,72,73,74,75,76,78,79]
--    extiendeAlternado 24  ==  [240,241,242,243]
--    extiendeAlternado 42  ==  [423,424,425,426,427,428,429]
extiendeAlternado :: Integer -> [Integer]
extiendeAlternado n 
    | n < 10    = [n*10+h | h <- [0..n-1]++[n+1..9]]
    | d < c     = [n*10+h | h <- [0..c-1]]
    | otherwise = [n*10+h | h <- [c+1..9]]
    where c = n `mod` 10
          d = (n `mod` 100) `div` 10

alternados2 :: [Integer]
alternados2 = concat (iterate (concatMap extiendeAlternado) [0])

import Data.Char (digitToInt)

-- 1ª definición

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

-- (cifras n) es la lista de las cifras de n. Por ejemplo.

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

cifras :: Integer -> [Int]

cifras n = map digitToInt (show n)

-- (cifrasAlternadas xs) se verifica si las lista de cifras xs es

-- alternada. Por ejemplo,

-- cifrasAlternadas [1,3,2,4,2,5] == True

-- cifrasAlternadas [9,2,7,4,5] == True

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

-- cifrasAlternadas [2,9,7,7,8] == False

cifrasAlternadas :: [Int] -> Bool

cifrasAlternadas [x1,x2] = x1 /= x2

cifrasAlternadas (x1:x2:x3:xs) =

not (((x1 <= x2) && (x2 <= x3)) || ((x1 >= x2) && (x2 >= x3))) &&

cifrasAlternadas (x2:x3:xs)

cifrasAlternadas _ = True

-- (alternado n) se verifica si n es un número alternado. Por ejemplo,

-- alternado 132425 == True

-- alternado 92745 == True

-- alternado 12325 == False

-- alternado 29778 == False

alternado :: Integer -> Bool

alternado n = cifrasAlternadas (cifras n)

alternados1 :: [Integer]

alternados1 = filter alternado [0..]

-- 2ª definición

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

-- (extiendeAlternado n) es la lista de números alternados que se pueden

-- obtener añadiendo una cifra al final del número alternado n. Por

-- ejemplo,

-- extiendeAlternado 7 == [70,71,72,73,74,75,76,78,79]

-- extiendeAlternado 24 == [240,241,242,243]

-- extiendeAlternado 42 == [423,424,425,426,427,428,429]

extiendeAlternado :: Integer -> [Integer]

extiendeAlternado n

| n < 10 = [n*10+h | h <- [0..n-1]++[n+1..9]]

| d < c = [n*10+h | h <- [0..c-1]]

| otherwise = [n*10+h | h <- [c+1..9]]

where c = n `mod` 10

d = (n `mod` 100) `div` 10

alternados2 :: [Integer]

alternados2 = concat (iterate (concatMap extiendeAlternado) [0])

Visibilidad de listas y matrices

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

La visibilidad de una lista es el número de elementos que son estrictamente mayores que todos los anteriores. Por ejemplo, la visibilidad de la lista [1,2,5,2,3,6] es 4.

La visibilidad de una matriz P es el par formado por las visibilidades de las filas de P y las visibilidades de las columnas de P. Por ejemplo, dada la matriz

       ( 4 2 1 )
   Q = ( 3 2 5 )
       ( 6 1 8 )

( 4 2 1 )

Q = ( 3 2 5 )

( 6 1 8 )

la visibilidad de Q es ([1,2,2],[2,1,3]).

Definir las funciones

   visibilidadLista  :: [Int] -> Int
   visibilidadMatriz :: Matrix Int -> ([Int],[Int])

1 2	visibilidadLista :: [Int] -> Int visibilidadMatriz :: Matrix Int -> ([Int],[Int])

tales que

(visibilidadLista xs) es la visibilidad de la lista xs. Por ejemplo,

     visibilidadLista [1,2,5,2,3,6]   ==  4
     visibilidadLista [0,-2,5,1,6,6]  ==  3

1 2	visibilidadLista [1,2,5,2,3,6] == 4 visibilidadLista [0,-2,5,1,6,6] == 3

(visibilidadMatriz p) es la visibilidad de la matriz p. Por ejemplo,

     ghci> visibilidadMatriz (fromLists [[4,2,1],[3,2,5],[6,1,8]])
     ([1,2,2],[2,1,3])
     ghci> visibilidadMatriz (fromLists [[0,2,1],[0,2,5],[6,1,8]])
     ([2,3,2],[2,1,3])

ghci> visibilidadMatriz (fromLists [[4,2,1],[3,2,5],[6,1,8]])

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

ghci> visibilidadMatriz (fromLists [[0,2,1],[0,2,5],[6,1,8]])

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

Soluciones

import Data.List (inits)
import Data.Matrix (Matrix, (!), nrows, ncols, fromLists)

visibilidadLista :: [Int] -> Int
visibilidadLista xs =
    length [x | (ys,x) <- zip (inits xs) xs, all (<x) ys]

visibilidadMatriz :: Matrix Int -> ([Int],[Int])
visibilidadMatriz p =
    ([visibilidadLista [p ! (i,j) | j <- [1..n]] | i <- [1..m]],
     [visibilidadLista [p ! (i,j) | i <- [1..m]] | j <- [1..n]])
     where m = nrows p
           n = ncols p

import Data.List (inits)

import Data.Matrix (Matrix, (!), nrows, ncols, fromLists)

visibilidadLista :: [Int] -> Int

visibilidadLista xs =

length [x | (ys,x) <- zip (inits xs) xs, all (<x) ys]

visibilidadMatriz :: Matrix Int -> ([Int],[Int])

visibilidadMatriz p =

([visibilidadLista [p ! (i,j) | j <- [1..n]] | i <- [1..m]],

[visibilidadLista [p ! (i,j) | i <- [1..m]] | j <- [1..n]])

where m = nrows p

n = ncols p

Reconocimiento de camino en un grafo

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

Dado un grafo no dirigido G, un camino en G es una secuencia de nodos [v(1),v(2),v(3),…,v(n)] tal que para todo i entre 1 y n-1, (v(i),v(i+1)) es una arista de G. Por ejemplo, dados los grafos

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

g1, g2 :: Grafo Int Int

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

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

la lista [1,2,3] es un camino en g1, pero no es un camino en g2 puesto que la arista (2,3) no existe en g2.

Definir la función

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

1	camino :: Grafo Int Int -> [Int] -> Bool

tal que (camino g vs) se verifica si la lista de nodos vs es un camino en el grafo g. Por ejemplo,

   camino g1 [1,2,3]  ==  True
   camino g2 [1,2,3]  ==  False

1 2	camino g1 [1,2,3] == True camino g2 [1,2,3] == False

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

Soluciones

import I1M.Grafo 
camino :: Grafo Int Int -> [Int] -> Bool
camino g vs = all (aristaEn g) (zip vs (tail vs))

import I1M.Grafo

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

camino g vs = all (aristaEn g) (zip vs (tail vs))

Colinealidad de una lista de puntos

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

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

Definir la función

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

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

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

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

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

Soluciones

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

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

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

-- 1ª definición

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

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

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

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

colineales1 _ = True

-- 2ª definición

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

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

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

-- 3ª definición

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

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

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

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

colineales3 _ = True

Distancia invierte y suma hasta capicúa

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

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

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

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

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

87 + 78 = 165

165 + 561 = 726

726 + 627 = 1353

1353 + 3531 = 4884

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

Definir la función

   distanciaIS :: Integer -> Integer

1	distanciaIS :: Integer -> Integer

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

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

distanciaIS 11 == 0

distanciaIS 10 == 1

distanciaIS 19 == 2

distanciaIS 59 == 3

distanciaIS 69 == 4

distanciaIS 166 == 5

distanciaIS 79 == 6

distanciaIS 89 == 24

distanciaIS 10911 == 55

distanciaIS 1000000079994144385 == 259

Soluciones

import Data.List (genericLength)

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

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

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

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

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

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

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

import Data.List (genericLength)

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

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

distanciaIS1 :: Integer -> Integer

distanciaIS1 = genericLength . cadena

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

-- ejemplo,

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

cadena :: Integer -> [Integer]

cadena x | esCapicua x = []

| otherwise = x : cadena (transformadoIS x)

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

-- esCapicua 42524 == True

-- esCapicua 42542 == False

esCapicua :: Integer -> Bool

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

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

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

-- transformadoIS 1325 == 6556

-- transformadoIS 1375 == 7106

transformadoIS :: Integer -> Integer

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

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

distanciaIS2 :: Integer -> Integer

distanciaIS2 x = aux x 0

where aux x n | esCapicua x = n

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

-- 3ª solución (con iterate)

distanciaIS3 :: Integer -> Integer

distanciaIS3 =

genericLength . takeWhile (not . esCapicua) . iterate transformadoIS

Con mínimo común denominador

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

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

   type Racional a = (a,a)

1	type Racional a = (a,a)

Definir la función

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

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

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

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

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

entonces (reducida xs) es

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

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

tales que

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

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

y d es el menor posible. Por ejemplo,

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

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

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

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

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

Soluciones

type Racional a = (a,a) 

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

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

type Racional a = (a,a)

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

reducida xs =

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

where ys = map fraccionReducida xs

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

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

-- denominador positivo. Por ejemplo,

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

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

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

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

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

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

fraccionReducida (x,y) =

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

where s = signum x * signum y

x1 = abs x

y1 = abs y

m = gcd x1 y1

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

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

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

mcm = foldl lcm 1

Primos hereditarios

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

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

Definir la sucesión

   hereditarios :: [Integer]

1	hereditarios :: [Integer]

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

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

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

Soluciones

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

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

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

import Data.List (inits, tails)

import Data.Char (digitToInt)

import Data.Numbers.Primes (primes, isPrime)

hereditarios :: [Integer]

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

hereditario :: Integer -> Bool

hereditario n =

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

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

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

where ds = show n

Constante de Champernowne

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

La constante de Champernowne es el número irracional

   0.12345678910111213141516171819202122232425262728293031323334 ...

1	0.12345678910111213141516171819202122232425262728293031323334 ...

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

Definir la función

   productoChampernowne :: [Int] -> Int

1	productoChampernowne :: [Int] -> Int

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

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

productoChampernowne [0,1,2] == 6

productoChampernowne [8,20] == 45

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

Soluciones

import Data.Char (digitToInt)

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

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

import Data.Char (digitToInt)

productoChampernowne :: [Int] -> Int

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

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

-- ghci> take 20 champernowne

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

champernowne :: [Int]

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

Las torres de Hanói

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

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

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

Definir la función

   hanoi :: Int -> [String]

1	hanoi :: Int -> [String]

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

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

ghci> hanoi 1

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

ghci> hanoi 2

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

ghci> mapM_ putStrLn (hanoi 2)

Mueve el disco 1 de A a B

Mueve el disco 2 de A a C

Mueve el disco 1 de B a C

ghci> mapM_ putStrLn (hanoi 3)

Mueve el disco 1 de A a C

Mueve el disco 2 de A a B

Mueve el disco 1 de C a B

Mueve el disco 3 de A a C

Mueve el disco 1 de B a A

Mueve el disco 2 de B a C

Mueve el disco 1 de A a C

Soluciones

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

hanoi :: Int -> [String]

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

aux n a b c

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

| otherwise =

aux (n-1) a c b ++

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

aux (n-1) b a c

Agrupamiento de consecutivos iguales

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

Definir las funciones

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

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

tales que

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

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

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

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

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

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

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

Soluciones

import Data.List (group)
import Test.QuickCheck

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

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

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

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

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

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

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

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

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

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

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

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

import Data.List (group)

import Test.QuickCheck

-- Definiciones de agrupa

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

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

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

agrupa xs = aux xs 1

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

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

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

aux [] _ = []

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

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

agrupa2 [] = []

agrupa2 (x:xs) =

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

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

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

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

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

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

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

-- Definiciones de expande

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

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

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

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

-- 2ª definición (por concatMap)

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

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

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

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

expande3 [] = []

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

-- Comprobación

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

-- La propiedad es

prop_expande_agrupa :: [Int] -> Bool

prop_expande_agrupa xs = expande (agrupa xs) == xs

-- La comprobación es

-- ghci> quickCheck prop_expande_agrupa

-- +++ OK, passed 100 tests.

Matrices cruzadas

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

Consideramos las matrices representadas como tablas cuyos índices son pares de números naturales.

   type Matriz a = Array (Int,Int) a

1	type Matriz a = Array (Int,Int) a

Una matriz cruzada es una matriz cuadrada en la que sólo hay elementos distintos de 0 en las diagonales principal y secundaria. Por ejemplo,

   | 1 0 0 0 3 |     | 1 0 0 3 |
   | 0 2 0 1 0 |     | 0 2 3 0 |
   | 0 0 3 0 0 |     | 0 4 5 0 |
   | 0 2 0 1 0 |     | 2 0 0 3 |
   | 1 0 0 0 3 |

| 1 0 0 0 3 | | 1 0 0 3 |

| 0 2 0 1 0 | | 0 2 3 0 |

| 0 0 3 0 0 | | 0 4 5 0 |

| 0 2 0 1 0 | | 2 0 0 3 |

| 1 0 0 0 3 |

Definir la función

   creaCruzada :: Int -> Matriz Int

1	creaCruzada :: Int -> Matriz Int

tal que (creaCruzada n) es la siguiente matriz cruzada con n filas y n columnas:

   | 1  0   0  ...  0   0  1 |
   | 0  2   0  ...  0   2  0 |
   | 0  0   3  ...  3   0  0 |
   | ....................... |
   | 0  0  n-2 ... n-2  0  0 |
   | 0 n-1  0  ...  0  n-1 0 |
   | n  0   0  ...  0   0  n |

| 1 0 0 ... 0 0 1 |

| 0 2 0 ... 0 2 0 |

| 0 0 3 ... 3 0 0 |

| ....................... |

| 0 0 n-2 ... n-2 0 0 |

| 0 n-1 0 ... 0 n-1 0 |

| n 0 0 ... 0 0 n |

Es decir, los elementos de la diagonal principal son [1,…,n], en orden desde la primera fila hasta la última; y los elementos de la diagonal secundaria son [1,…,n], en orden desde la primera fila hasta la última. Por ejemplo,

   ghci> elems (creaCruzada 3)
   [1,0,1, 0,2,0, 3,0,3]
   ghci> elems (creaCruzada 4)
   [1,0,0,1, 0,2,2,0, 0,3,3,0, 4,0,0,4]
   ghci> elems (creaCruzada 5)
   [1,0,0,0,1, 0,2,0,2,0, 0,0,3,0,0, 0,4,0,4,0, 5,0,0,0,5]

ghci> elems (creaCruzada 3)

[1,0,1, 0,2,0, 3,0,3]

ghci> elems (creaCruzada 4)

[1,0,0,1, 0,2,2,0, 0,3,3,0, 4,0,0,4]

ghci> elems (creaCruzada 5)

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

Soluciones

import Data.Array

type Matriz a = Array (Int,Int) a

-- 1ª solución
creaCruzada1 :: Int -> Matriz Int
creaCruzada1 n =
    array ((1,1),(n,n))
          [((i,j),f i j) | i <- [1..n], j <- [1..n]]
    where f i j | i == j     = i
                | i+j == n+1 = i
                | otherwise  = 0

-- 2ª solución
creaCruzada2 :: Int -> Matriz Int
creaCruzada2 n = listArray t [f i j| (i,j) <- range t]
    where t = ((1,1),(n,n))
          f i j | i == j     = i
                | i+j == n+1 = i
                | otherwise  = 0

-- 3ª solución
creaCruzada3 :: Int -> Matriz Int
creaCruzada3 n = 
    listArray ((1,1),(n,n)) 
              (replicate (n^2) 0) // ([((i,i),i) | i <- [1..n]] ++ 
                                     [((i,n-i+1),i)| i <- [n,n-1..1]])

creaCruzada4 :: Int -> Matriz Int
creaCruzada4 n = 
    accumArray (\x y -> y) 0 ((1,1),(n,n))
               (concat [[((i,i),i),((i,n+1-i),i)] | i <- [1..n]])

-- Comparación de eficiencia
--    ghci> let n = 2000 in creaCruzada1 n ! (n,n)
--    2000
--    (6.13 secs, 896997468 bytes)
--    
--    ghci> let n = 2000 in creaCruzada2 n ! (n,n)
--    2000
--    (3.83 secs, 433675668 bytes)
--    
--    ghci> let n = 2000 in creaCruzada3 n ! (n,n)
--    2000
--    (0.56 secs, 145741748 bytes)
--    
--    ghci> let n = 2000 in creaCruzada4 n ! (n,n)
--    2000
--    (0.27 secs, 37373392 bytes)

import Data.Array

type Matriz a = Array (Int,Int) a

-- 1ª solución

creaCruzada1 :: Int -> Matriz Int

creaCruzada1 n =

array ((1,1),(n,n))

[((i,j),f i j) | i <- [1..n], j <- [1..n]]

where f i j | i == j = i

| i+j == n+1 = i

| otherwise = 0

-- 2ª solución

creaCruzada2 :: Int -> Matriz Int

creaCruzada2 n = listArray t [f i j| (i,j) <- range t]

where t = ((1,1),(n,n))

f i j | i == j = i

| i+j == n+1 = i

| otherwise = 0

-- 3ª solución

creaCruzada3 :: Int -> Matriz Int

creaCruzada3 n =

listArray ((1,1),(n,n))

(replicate (n^2) 0) // ([((i,i),i) | i <- [1..n]] ++

[((i,n-i+1),i)| i <- [n,n-1..1]])

creaCruzada4 :: Int -> Matriz Int

creaCruzada4 n =

accumArray (\x y -> y) 0 ((1,1),(n,n))

(concat [[((i,i),i),((i,n+1-i),i)] | i <- [1..n]])

-- Comparación de eficiencia

-- ghci> let n = 2000 in creaCruzada1 n ! (n,n)

-- 2000

-- (6.13 secs, 896997468 bytes)

-- ghci> let n = 2000 in creaCruzada2 n ! (n,n)

-- 2000

-- (3.83 secs, 433675668 bytes)

-- ghci> let n = 2000 in creaCruzada3 n ! (n,n)

-- 2000

-- (0.56 secs, 145741748 bytes)

-- ghci> let n = 2000 in creaCruzada4 n ! (n,n)

-- 2000

-- (0.27 secs, 37373392 bytes)

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Referencia

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Entradas recientes

Buscar

Correo electrónico