Orden superior – Página 11

Sumas parciales de Nicómaco

PorJosé A. Alonso 15-enero-201825-marzo-2022

Nicómaco de Gerasa vivió en Palestina entre los siglos I y II de nuestra era. Escribió Arithmetike eisagoge (Introducción a la aritmética) que es el primer trabajo en donde se trata la Aritmética de forma separada a la Geometría. En el tratado se encuentra la siguiente proposición: «si se escriben los números impares

   1, 3, 5, 7, 9, 11, 13, 15, 17, ...

1	1, 3, 5, 7, 9, 11, 13, 15, 17, ...

entonces el primero es el cubo de 1; la suma de los dos siguientes, el cubo de 2; la suma de los tres siguientes, el cubo de 3; y así sucesivamente.»

Definir las siguientes funciones

   listasParciales :: [a] -> [[a]]
   sumasParciales  :: [Int] -> [Int]

1 2	listasParciales :: [a] -> [[a]] sumasParciales :: [Int] -> [Int]

tales que

(listasParciales xs) es la lista obtenido agrupando los elementos de la lista infinita xs de forma que la primera tiene 0 elementos; la segunda, el primer elemento de xs; la tercera, los dos siguientes; y así sucesivamente. Por ejemplo,

     λ> take 7 (listasParciales [1..])
     [[],[1],[2,3],[4,5,6],[7,8,9,10],[11,12,13,14,15],[16,17,18,19,20,21]]
     λ> take 7 (listasParciales [1,3..])
     [[],[1],[3,5],[7,9,11],[13,15,17,19],[21,23,25,27,29],[31,33,35,37,39,41]]

λ> take 7 (listasParciales [1..])

[[],[1],[2,3],[4,5,6],[7,8,9,10],[11,12,13,14,15],[16,17,18,19,20,21]]

λ> take 7 (listasParciales [1,3..])

[[],[1],[3,5],[7,9,11],[13,15,17,19],[21,23,25,27,29],[31,33,35,37,39,41]]

(sumasParciales xs) es la lista de las sumas parciales de la lista infinita xs. Por ejemplo,

     λ> take 15 (sumasParciales [1..])
     [0,1,5,15,34,65,111,175,260,369,505,671,870,1105,1379]
     λ> take 15 (sumasParciales [1,3..])
     [0,1,8,27,64,125,216,343,512,729,1000,1331,1728,2197,2744]

λ> take 15 (sumasParciales [1..])

[0,1,5,15,34,65,111,175,260,369,505,671,870,1105,1379]

λ> take 15 (sumasParciales [1,3..])

[0,1,8,27,64,125,216,343,512,729,1000,1331,1728,2197,2744]

Comprobar con QuickChek la propiedad de Nicómaco; es decir, que para todo número natural n, el término n-ésimo de (sumasParciales [1,3..]) es el cubo de n.

Soluciones

import Test.QuickCheck

listasParciales :: [a] -> [[a]]
listasParciales = aux 0
  where aux n xs = ys : aux (n+1) zs  
          where (ys,zs) = splitAt n xs

sumasParciales :: [Int] -> [Int]
sumasParciales = map sum . listasParciales

prop_Nicomaco :: (Positive Int) -> Bool
prop_Nicomaco (Positive n) =
  sumasParciales [1,3..] !! n == n^3

import Test.QuickCheck

listasParciales :: [a] -> [[a]]

listasParciales = aux 0

where aux n xs = ys : aux (n+1) zs

where (ys,zs) = splitAt n xs

sumasParciales :: [Int] -> [Int]

sumasParciales = map sum . listasParciales

prop_Nicomaco :: (Positive Int) -> Bool

prop_Nicomaco (Positive n) =

sumasParciales [1,3..] !! n == n^3

Números malvados y odiosos

PorJosé A. Alonso 12-enero-201825-abril-2021

Un número malvado es un número natural cuya expresión en base 2 (binaria) contiene un número par de unos.

Un número odioso es un número natural cuya expresión en base 2 (binaria) contiene un número impar de unos.

Podemos representar los números malvados y odiosos mediante el siguiente tipo de dato

  data MalvadoOdioso = Malvado | Odioso deriving Show

1	data MalvadoOdioso = Malvado \| Odioso deriving Show

Definir la función

  malvadoOdioso :: Integer -> MalvadoOdioso

1	malvadoOdioso :: Integer -> MalvadoOdioso

tal que (malvadoOdioso n) devuelve el tipo de número que es n. Por ejemplo,

   λ> malvadoOdioso 11
   Odioso
   λ> malvadoOdioso 12
   Malvado
   λ> malvadoOdioso3 (10^20000000)
   Odioso
   λ> malvadoOdioso3 (1+10^20000000)
   Malvado

λ> malvadoOdioso 11

Odioso

λ> malvadoOdioso 12

Malvado

λ> malvadoOdioso3 (10^20000000)

Odioso

λ> malvadoOdioso3 (1+10^20000000)

Malvado

Nota: Este ejercicio ha sido propuesto por Ángel Ruiz Campos.

Soluciones

import Data.List (genericLength)
import Data.Bits (popCount)

data MalvadoOdioso = Malvado | Odioso
  deriving (Eq, Show)

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

malvadoOdioso :: Integer -> MalvadoOdioso
malvadoOdioso n | (even . numeroUnosBin) n = Malvado
                | otherwise                = Odioso

-- (numeroUnosBin n) es el número de unos de la representación binaria
-- del número decimal n. Por ejemplo,
--   numeroUnosBin 11  ==  3
--   numeroUnosBin 12  ==  2
numeroUnosBin :: Integer -> Integer
numeroUnosBin = genericLength . filter (/= 0) . intBin

-- (intBin n) es el número binario correspondiente al número decimal n.
-- Por ejemplo, 
--   intBin 11  ==  [1,1,0,1]
--   intBin 12  ==  [0,0,1,1]
intBin :: Integer -> [Integer]
intBin n | n < 2     = [n]
         | otherwise = n `mod` 2 : intBin (n `div` 2)

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

malvadoOdioso2 :: Integer -> MalvadoOdioso
malvadoOdioso2 n | (even . numeroIntBin) n = Malvado
                 | otherwise               = Odioso

-- (numeroIntBin n) es el número de unos que contiene la representación
-- binaria del número decimal n. Por ejemplo,
--   numeroIntBin 11  ==  3
--   numeroIntBin 12  ==  2
numeroIntBin :: Integer -> Integer
numeroIntBin n | n < 2     = n
               | otherwise = n `mod` 2 + numeroIntBin (n `div` 2)

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

malvadoOdioso3 :: Integer -> MalvadoOdioso
malvadoOdioso3 n | (even . popCount) n = Malvado
                 | otherwise           = Odioso

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

--   λ> malvadoOdioso (10^40000)
--   Odioso
--   (3.25 secs, 1,167,416,968 bytes)
--   λ> malvadoOdioso2 (10^40000)
--   Odioso
--   (4.03 secs, 1,164,863,744 bytes)
--   λ> malvadoOdioso3 (10^40000)
--   Odioso
--   (0.00 secs, 165,312 bytes)

import Data.List (genericLength)

import Data.Bits (popCount)

data MalvadoOdioso = Malvado | Odioso

deriving (Eq, Show)

-- 1ª solución

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

malvadoOdioso :: Integer -> MalvadoOdioso

malvadoOdioso n | (even . numeroUnosBin) n = Malvado

| otherwise = Odioso

-- (numeroUnosBin n) es el número de unos de la representación binaria

-- del número decimal n. Por ejemplo,

-- numeroUnosBin 11 == 3

-- numeroUnosBin 12 == 2

numeroUnosBin :: Integer -> Integer

numeroUnosBin = genericLength . filter (/= 0) . intBin

-- (intBin n) es el número binario correspondiente al número decimal n.

-- Por ejemplo,

-- intBin 11 == [1,1,0,1]

-- intBin 12 == [0,0,1,1]

intBin :: Integer -> [Integer]

intBin n | n < 2 = [n]

| otherwise = n `mod` 2 : intBin (n `div` 2)

-- 2ª solución

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

malvadoOdioso2 :: Integer -> MalvadoOdioso

malvadoOdioso2 n | (even . numeroIntBin) n = Malvado

| otherwise = Odioso

-- (numeroIntBin n) es el número de unos que contiene la representación

-- binaria del número decimal n. Por ejemplo,

-- numeroIntBin 11 == 3

-- numeroIntBin 12 == 2

numeroIntBin :: Integer -> Integer

numeroIntBin n | n < 2 = n

| otherwise = n `mod` 2 + numeroIntBin (n `div` 2)

-- 3ª solución

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

malvadoOdioso3 :: Integer -> MalvadoOdioso

malvadoOdioso3 n | (even . popCount) n = Malvado

| otherwise = Odioso

-- Comparación de eficiencia

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

-- λ> malvadoOdioso (10^40000)

-- Odioso

-- (3.25 secs, 1,167,416,968 bytes)

-- λ> malvadoOdioso2 (10^40000)

-- Odioso

-- (4.03 secs, 1,164,863,744 bytes)

-- λ> malvadoOdioso3 (10^40000)

-- Odioso

-- (0.00 secs, 165,312 bytes)

Ordenación por frecuencia

PorJosé A. Alonso 11-enero-201819-febrero-2018

Definir la función

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

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

tal que (ordPorFrecuencia xs) es la lista obtenidas ordenando los elementos de xs por su frecuencia, de los que aparecen más a los que aparecen menos, y los que aparecen el mismo número de veces se ordenan de manera creciente según su valor. Por ejemplo,

   ordPorFrecuencia "canalDePanama"      ==  "aaaaannmlecPD"
   ordPorFrecuencia "11012018"           ==  "11110082"
   ordPorFrecuencia [2,3,5,3,7,9,5,3,7]  ==  [3,3,3,7,7,5,5,9,2]

ordPorFrecuencia "canalDePanama" == "aaaaannmlecPD"

ordPorFrecuencia "11012018" == "11110082"

ordPorFrecuencia [2,3,5,3,7,9,5,3,7] == [3,3,3,7,7,5,5,9,2]

Soluciones

import Test.QuickCheck

import Data.List (group, sort, sortBy)
import Data.Function (on)

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

ordPorFrecuencia1 :: Ord a => [a] -> [a]
ordPorFrecuencia1 xs =
  concatMap snd (reverse (sort [(length xs,xs) | xs <- group (sort xs)]))

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

ordPorFrecuencia2 :: Ord a => [a] -> [a]
ordPorFrecuencia2 =
    concat . reverse . sortBy comparaPorLongitud . group . sort

comparaPorLongitud :: [a] -> [a] -> Ordering
comparaPorLongitud xs ys = compare (length xs) (length ys)

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

ordPorFrecuencia3 :: Ord a => [a] -> [a]
ordPorFrecuencia3 =
    concat . reverse . sortBy (compare `on` length). group . sort

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

--    λ> xs = show (2^2000000)
--    λ> last (ordPorFrecuencia1 xs)
--    '8'
--    (1.45 secs, 938,345,320 bytes)
--    λ> last (ordPorFrecuencia2 xs)
--    '8'
--    (1.33 secs, 900,239,200 bytes)
--    λ> last (ordPorFrecuencia3 xs)
--    '8'
--    (1.30 secs, 900,241,848 bytes)

import Test.QuickCheck

import Data.List (group, sort, sortBy)

import Data.Function (on)

-- 1ª solución

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

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

ordPorFrecuencia1 xs =

concatMap snd (reverse (sort [(length xs,xs) | xs <- group (sort xs)]))

-- 2ª solución

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

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

ordPorFrecuencia2 =

concat . reverse . sortBy comparaPorLongitud . group . sort

comparaPorLongitud :: [a] -> [a] -> Ordering

comparaPorLongitud xs ys = compare (length xs) (length ys)

-- 3ª solución

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

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

ordPorFrecuencia3 =

concat . reverse . sortBy (compare `on` length). group . sort

-- Comparación de eficiencia

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

-- λ> xs = show (2^2000000)

-- λ> last (ordPorFrecuencia1 xs)

-- '8'

-- (1.45 secs, 938,345,320 bytes)

-- λ> last (ordPorFrecuencia2 xs)

-- '8'

-- (1.33 secs, 900,239,200 bytes)

-- λ> last (ordPorFrecuencia3 xs)

-- '8'

-- (1.30 secs, 900,241,848 bytes)

Números somirp

PorJosé A. Alonso 10-enero-201819-febrero-2018

Un número omirp es un número primo que forma un primo distinto al invertir el orden de sus dígitos.

Definir las funciones

  esOmirp            :: Integer -> Bool
  omirps             :: [Integer]
  nOmirpsIntermedios :: Int -> Int

esOmirp :: Integer -> Bool

omirps :: [Integer]

nOmirpsIntermedios :: Int -> Int

tales que

(esOmirp n) se verifica si n es un número omirp. Por ejemplo,

     esOmirp 13      ==  True
     esOmirp 11      ==  False
     esOmirp 112207  ==  True

esOmirp 13 == True

esOmirp 11 == False

esOmirp 112207 == True

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

     take 15 omirps  ==  [13,17,31,37,71,73,79,97,107,113]
     omirps !! 2000  ==  112207

1 2	take 15 omirps == [13,17,31,37,71,73,79,97,107,113] omirps !! 2000 == 112207

(nOmirpsIntermedios n) es la cantidad de números omirps entre el n-ésimo número omirp y el obtenido al invertir el orden de sus dígitos. Por ejemplo,

     nOmirpsIntermedios 2000  ==  4750

1	nOmirpsIntermedios 2000 == 4750

Nota: Este ejercicio ha sido propuesto por Ángel Ruiz Campos.

Soluciones

import Data.Numbers.Primes (isPrime,primes)

esOmirp :: Integer -> Bool
esOmirp n = n /= rn && isPrime rn
  where rn = read . reverse . show $ n

omirps :: [Integer]
omirps = filter esOmirp primes

nOmirpsIntermedios :: Int -> Int
nOmirpsIntermedios n =
  length
  . filter esOmirp
  . takeWhile (< rx)
  . dropWhile (<= x) $ primes
  where x  = omirps !! n
        rx = read . reverse . show $ x

import Data.Numbers.Primes (isPrime,primes)

esOmirp :: Integer -> Bool

esOmirp n = n /= rn && isPrime rn

where rn = read . reverse . show $ n

omirps :: [Integer]

omirps = filter esOmirp primes

nOmirpsIntermedios :: Int -> Int

nOmirpsIntermedios n =

length

. filter esOmirp

. takeWhile (< rx)

. dropWhile (<= x) $ primes

where x = omirps !! n

rx = read . reverse . show $ x

Enumeración de los números enteros

PorJosé A. Alonso 9-enero-201825-marzo-2022

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-(2*n+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
import Control.Applicative ((<**>))

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

-- 2ª definición
enteros2 :: [Int]
enteros2 = 0 : [y | x <- [1..], y <- [x, -x]]

-- 3ª definición
enteros3 :: [Int]
enteros3 = iterate siguiente 0
  where siguiente i | i > 0     = -i
                    | otherwise = 1 - i

-- 4ª definición
enteros4 :: [Int]
enteros4 = iterate (\i -> if i > 0 then -i else 1-i) 0

-- 5ª definición
enteros5 :: [Int]
enteros5 = 0 : [f x | x <- [1..], f <- [id, negate]]

-- 6ª definición
enteros6 :: [Int]
enteros6 = 0 : ([1..] <**> [id, negate])

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

import Control.Applicative ((<**>))

-- 1ª definición

enteros :: [Int]

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

-- 2ª definición

enteros2 :: [Int]

enteros2 = 0 : [y | x <- [1..], y <- [x, -x]]

-- 3ª definición

enteros3 :: [Int]

enteros3 = iterate siguiente 0

where siguiente i | i > 0 = -i

| otherwise = 1 - i

-- 4ª definición

enteros4 :: [Int]

enteros4 = iterate (\i -> if i > 0 then -i else 1-i) 0

-- 5ª definición

enteros5 :: [Int]

enteros5 = 0 : [f x | x <- [1..], f <- [id, negate]]

-- 6ª definición

enteros6 :: [Int]

enteros6 = 0 : ([1..] <**> [id, negate])

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

Números apocalípticos

PorJosé A. Alonso 8-enero-201819-febrero-2018

Un número apocalíptico es aquel número natural n tal que 2^n contiene la secuencia 666.

Definir las funciones

   esApocaliptico           :: Integer -> Bool
   apocalipticos            :: [Integer]
   mayorNoApocalipticoMenor :: Integer -> Maybe Integer
   grafica                  :: Integer -> IO ()

esApocaliptico :: Integer -> Bool

apocalipticos :: [Integer]

mayorNoApocalipticoMenor :: Integer -> Maybe Integer

grafica :: Integer -> IO ()

tales que

(esApocaliptico n) se verifica si n es un número apocalíptico. Por ejemplo,

     esApocaliptico 666    ==  True
     esApocaliptico 29784  ==  False

1 2	esApocaliptico 666 == True esApocaliptico 29784 == False

apocalipticos es la lista de los números apocalípticos. Por ejemplo,

     take 9 apocalipticos  ==  [157,192,218,220,222,224,226,243,245]
     apocalipticos !! 55   ==  666

1 2	take 9 apocalipticos == [157,192,218,220,222,224,226,243,245] apocalipticos !! 55 == 666

(mayorNoApocalipticoMenor n) es justo el mayor número no apocalíptico menor que n. Por ejemplo,

     mayorNoApocalipticoMenor  40000  ==  Just 29784
     mayorNoApocalipticoMenor  29784  ==  Just 26667

1 2	mayorNoApocalipticoMenor 40000 == Just 29784 mayorNoApocalipticoMenor 29784 == Just 26667

(grafica n) dibuja las gráficas de los n primeros términos de la sucesión de los números apocalípticos junto con los de la sucesión a(n) = 3715+n. Por ejemplo, (grafica 3000) dibuja

y (grafica 30000) dibuja

Nota: Este ejercicio ha sido propuesto por Ángel Ruiz Campos.

Soluciones

import Data.List (isInfixOf, find, genericTake)
import Graphics.Gnuplot.Simple

esApocaliptico :: Integer -> Bool
esApocaliptico = isInfixOf "666" . show . (2^)

apocalipticos :: [Integer]
apocalipticos = filter esApocaliptico [1..]

mayorNoApocalipticoMenor :: Integer -> Maybe Integer
mayorNoApocalipticoMenor n = find (not . esApocaliptico) [n-1,n-2..1]

grafica :: Integer -> IO ()
grafica n = 
  plotLists [ Key Nothing
            , PNG ("Numeros_apocalipticos_" ++ show n ++ ".png")
            ]
            [ genericTake n apocalipticos
            , [3715..3715+n-1] ]

import Data.List (isInfixOf, find, genericTake)

import Graphics.Gnuplot.Simple

esApocaliptico :: Integer -> Bool

esApocaliptico = isInfixOf "666" . show . (2^)

apocalipticos :: [Integer]

apocalipticos = filter esApocaliptico [1..]

mayorNoApocalipticoMenor :: Integer -> Maybe Integer

mayorNoApocalipticoMenor n = find (not . esApocaliptico) [n-1,n-2..1]

grafica :: Integer -> IO ()

grafica n =

plotLists [ Key Nothing

, PNG ("Numeros_apocalipticos_" ++ show n ++ ".png")

]

[ genericTake n apocalipticos

, [3715..3715+n-1] ]

El problema 3SUM

PorJosé A. Alonso 2-enero-201819-febrero-2018

El problem 3SUM consiste en dado una lista xs, decidir si xs posee tres elementos cuya suma sea cero. Por ejemplo, en [7,5,-9,5,2] se pueden elegir los elementos 7, -9 y 2 que suman 0.

Definir las funciones

   sols3Sum :: [Int] -> [[Int]]
   pb3Sum :: [Int] -> Bool

1 2	sols3Sum :: [Int] -> [[Int]] pb3Sum :: [Int] -> Bool

tales que
+ (sols3Sum xs) son las listas de tres elementos de xs cuya suma sea cero. Por ejemplo,

      sols3Sum [8,10,-10,-7,2,-3]   ==  [[-10,2,8],[-7,-3,10]]
      sols3Sum [-2..3]              ==  [[-2,-1,3],[-2,0,2],[-1,0,1]]
      sols3Sum [1,-2]               ==  []
      sols3Sum [-2,1]               ==  []
      sols3Sum [1,-2,1]             ==  [[-2,1,1]]
      length (sols3Sum [-100..100]) ==  5000

sols3Sum [8,10,-10,-7,2,-3] == [[-10,2,8],[-7,-3,10]]

sols3Sum [-2..3] == [[-2,-1,3],[-2,0,2],[-1,0,1]]

sols3Sum [1,-2] == []

sols3Sum [-2,1] == []

sols3Sum [1,-2,1] == [[-2,1,1]]

length (sols3Sum [-100..100]) == 5000

(pb3Sum xs) se verifica si xs posee tres elementos cuya suma sea cero. Por ejemplo,

     pb3Sum [8,10,-10,-7,2,-3]  ==  True
     pb3Sum [1,-2]              ==  False
     pb3Sum [-2,1]              ==  False
     pb3Sum [1,-2,1]            ==  True
     pb3Sum [1..400]            ==  False

pb3Sum [8,10,-10,-7,2,-3] == True

pb3Sum [1,-2] == False

pb3Sum [-2,1] == False

pb3Sum [1,-2,1] == True

pb3Sum [1..400] == False

Soluciones

import Data.List

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

sols3Sum1 :: [Int] -> [[Int]]
sols3Sum1 = normaliza . sols3Sum1Aux 

sols3Sum1Aux :: [Int] -> [[Int]]
sols3Sum1Aux xs =
  [ys | ys <- subsequences xs
      , length ys == 3
      , sum ys == 0]

normaliza :: [[Int]] -> [[Int]]
normaliza = sort . nub . map sort

pb3Sum1 :: [Int] -> Bool
pb3Sum1 = not . null . sols3Sum1Aux


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

sols3Sum2 :: [Int] -> [[Int]]
sols3Sum2 = normaliza . sols3Sum2Aux 

sols3Sum2Aux :: [Int] -> [[Int]]
sols3Sum2Aux xs =
  [[a,b,c] | (a:bs) <- tails xs
           , (b:cs) <- tails bs
           , c <- cs
           , a + b + c == 0]
  
pb3Sum2 :: [Int] -> Bool
pb3Sum2 = not . null . sols3Sum2Aux

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

sols3Sum3 :: [Int] -> [[Int]]
sols3Sum3 = normaliza . sols3Sum3Aux 

sols3Sum3Aux :: [Int] -> [[Int]]
sols3Sum3Aux xs =
  [[a,b,-a-b] | (a:bs) <- tails xs
              , b <- bs
              , (-a-b) `elem` (delete a (delete b xs))]

pb3Sum3 :: [Int] -> Bool
pb3Sum3 = not . null . sols3Sum3Aux

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

--    λ> pb3Suma [1..23]
--    False
--    (2.61 secs, 1,812,734,176 bytes)
--    λ> pb3Sumb [1..23]
--    False
--    (0.01 secs, 554,496 bytes)
--    λ> pb3Sumc [1..23]
--    False
--    (0.01 secs, 584,344 bytes)
--    λ> pb3Suma ([1..23] ++ [-3]) 
--    True
--    (2.54 secs, 1,812,735,784 bytes)
--    λ> pb3Sumb ([1..23] ++ [-3]) 
--    True
--    (0.01 secs, 148,904 bytes)
--    λ> pb3Sumc ([1..23] ++ [-3]) 
--    True
--    (0.00 secs, 145,320 bytes)
--
--    λ> pb3Sumb [1..300]
--    False
--    (1.66 secs, 933,699,824 bytes)
--    λ> pb3Sumc [1..300]
--    False
--    (0.41 secs, 873,168,120 bytes)

import Data.List

-- 1ª solución

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

sols3Sum1 :: [Int] -> [[Int]]

sols3Sum1 = normaliza . sols3Sum1Aux

sols3Sum1Aux :: [Int] -> [[Int]]

sols3Sum1Aux xs =

[ys | ys <- subsequences xs

, length ys == 3

, sum ys == 0]

normaliza :: [[Int]] -> [[Int]]

normaliza = sort . nub . map sort

pb3Sum1 :: [Int] -> Bool

pb3Sum1 = not . null . sols3Sum1Aux

-- 2ª solución

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

sols3Sum2 :: [Int] -> [[Int]]

sols3Sum2 = normaliza . sols3Sum2Aux

sols3Sum2Aux :: [Int] -> [[Int]]

sols3Sum2Aux xs =

[[a,b,c] | (a:bs) <- tails xs

, (b:cs) <- tails bs

, c <- cs

, a + b + c == 0]

pb3Sum2 :: [Int] -> Bool

pb3Sum2 = not . null . sols3Sum2Aux

-- 3ª solución

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

sols3Sum3 :: [Int] -> [[Int]]

sols3Sum3 = normaliza . sols3Sum3Aux

sols3Sum3Aux :: [Int] -> [[Int]]

sols3Sum3Aux xs =

[[a,b,-a-b] | (a:bs) <- tails xs

, b <- bs

, (-a-b) `elem` (delete a (delete b xs))]

pb3Sum3 :: [Int] -> Bool

pb3Sum3 = not . null . sols3Sum3Aux

-- Comparación de eficiencia

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

-- λ> pb3Suma [1..23]

-- False

-- (2.61 secs, 1,812,734,176 bytes)

-- λ> pb3Sumb [1..23]

-- False

-- (0.01 secs, 554,496 bytes)

-- λ> pb3Sumc [1..23]

-- False

-- (0.01 secs, 584,344 bytes)

-- λ> pb3Suma ([1..23] ++ [-3])

-- True

-- (2.54 secs, 1,812,735,784 bytes)

-- λ> pb3Sumb ([1..23] ++ [-3])

-- True

-- (0.01 secs, 148,904 bytes)

-- λ> pb3Sumc ([1..23] ++ [-3])

-- True

-- (0.00 secs, 145,320 bytes)

-- λ> pb3Sumb [1..300]

-- False

-- (1.66 secs, 933,699,824 bytes)

-- λ> pb3Sumc [1..300]

-- False

-- (0.41 secs, 873,168,120 bytes)

De hexadecimal a decimal

PorJosé A. Alonso 1-enero-201819-febrero-2018

El sistema hexadecimal es el sistema de numeración posicional que tiene como base el 16.

En principio, dado que el sistema usual de numeración es de base decimal y, por ello, sólo se dispone de diez dígitos, se adoptó la convención de usar las seis primeras letras del alfabeto latino para suplir los dígitos que nos faltan. El conjunto de símbolos es el siguiente: {0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F}. En ocasiones se emplean letras minúsculas en lugar de mayúsculas. Se debe notar que A = 10, B = 11, C = 12, D = 13, E = 14 y F = 15.

Como en cualquier sistema de numeración posicional, el valor numérico de cada dígito es alterado dependiendo de su posición en la cadena de dígitos, quedando multiplicado por una cierta potencia de la base del sistema, que en este caso es 16. Por ejemplo, el valor decimal del número hexadecimal 3E0A es

     3×16^3 + E×16^2 + 0×16^1 + A×16^0
   = 3×4096 + 14×256 + 0×16   + 10×1
   = 15882

3×16^3 + E×16^2 + 0×16^1 + A×16^0

= 3×4096 + 14×256 + 0×16 + 10×1

= 15882

Definir la función

   hexAdec :: String -> Int

1	hexAdec :: String -> Int

tal que (hexAdec cs) es el valor decimal del número hexadecimal representado meiante la cadena cs. Por ejemplo,

   hexAdec "3E0A"   == 15882
   hexAdec "ABCDEF" == 11259375
   hexAdec "FEDCBA" == 16702650

hexAdec "3E0A" == 15882

hexAdec "ABCDEF" == 11259375

hexAdec "FEDCBA" == 16702650

Soluciones

import Data.Char (digitToInt)
import Numeric(readHex)
import Data.List (foldl')

-- 1ª solución
hexAdec1 :: String -> Int
hexAdec1 s =
  sum (zipWith (*) (map digitToInt (reverse s)) (iterate (*16) 1))

-- 2ª solución
hexAdec2 :: String -> Int
hexAdec2 = foldl' (\acc x -> acc * 16 + digitToInt x) 0

-- 3ª solución
hexAdec3 :: String -> Int
hexAdec3 = read . ("0x" ++)

-- 4ª solución
hexAdec4 :: String -> Int
hexAdec4 = fst . head . readHex

import Data.Char (digitToInt)

import Numeric(readHex)

import Data.List (foldl')

-- 1ª solución

hexAdec1 :: String -> Int

hexAdec1 s =

sum (zipWith (*) (map digitToInt (reverse s)) (iterate (*16) 1))

-- 2ª solución

hexAdec2 :: String -> Int

hexAdec2 = foldl' (\acc x -> acc * 16 + digitToInt x) 0

-- 3ª solución

hexAdec3 :: String -> Int

hexAdec3 = read . ("0x" ++)

-- 4ª solución

hexAdec4 :: String -> Int

hexAdec4 = fst . head . readHex

Factorial módulo

PorJosé A. Alonso 28-diciembre-201719-febrero-2018

Definir la función

   factorialMod :: Integer -> Integer -> Integer

1	factorialMod :: Integer -> Integer -> Integer

tal que (factorialMod n x) es el factorial de x módulo n. Por ejemplo,

   factorialMod (7+10^9) 100       ==  437918130
   factorialMod (7+10^9) (5*10^6)  ==  974067448

1 2	factorialMod (7+10^9) 100 == 437918130 factorialMod (7+10^9) (5*10^6) == 974067448

Soluciones

import Data.List (foldl')

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

factorialMod :: Integer -> Integer -> Integer
factorialMod n x =
  factorial x `mod` n

-- (factorial x) es el factorial de x. Por ejemplo,
--    factorial 3  ==  6
factorial :: Integer -> Integer
factorial x = product [1..x]

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

factorialMod2 :: Integer -> Integer -> Integer
factorialMod2 n x =
  foldl' (prodMod n) 1 [1..x]

-- (prodMod n x y) es el producto de x e y módulo n. Por ejemplo,
--    prodMod 3 4 7  ==  1
--    prodMod 5 4 7  ==  -- 3
prodMod :: Integer -> Integer -> Integer -> Integer
prodMod n x y =
  ((x `mod` n) * (y `mod` n)) `mod` n
  
-- Comparación de eficiencia
-- =========================

--    λ> factorialMod (7+10^9) (5*10^4)
--    737935835
--    (2.62 secs, 2,601,358,640 bytes)
--    λ> factorialMod2 (7+10^9) (5*10^4)
--    737935835
--    (0.07 secs, 23,471,880 bytes)

import Data.List (foldl')

-- 1ª definición

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

factorialMod :: Integer -> Integer -> Integer

factorialMod n x =

factorial x `mod` n

-- (factorial x) es el factorial de x. Por ejemplo,

-- factorial 3 == 6

factorial :: Integer -> Integer

factorial x = product [1..x]

-- 2ª definición

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

factorialMod2 :: Integer -> Integer -> Integer

factorialMod2 n x =

foldl' (prodMod n) 1 [1..x]

-- (prodMod n x y) es el producto de x e y módulo n. Por ejemplo,

-- prodMod 3 4 7 == 1

-- prodMod 5 4 7 == -- 3

prodMod :: Integer -> Integer -> Integer -> Integer

prodMod n x y =

((x `mod` n) * (y `mod` n)) `mod` n

-- Comparación de eficiencia

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

-- λ> factorialMod (7+10^9) (5*10^4)

-- 737935835

-- (2.62 secs, 2,601,358,640 bytes)

-- λ> factorialMod2 (7+10^9) (5*10^4)

-- 737935835

-- (0.07 secs, 23,471,880 bytes)

Recorrido por niveles de árboles binarios

PorJosé A. Alonso 27-diciembre-201719-febrero-2018

Los árboles binarios con valores en las hojas y en los nodos se definen por

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

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving (Eq, Show)

Por ejemplo, el árbol

         1 
       /   \
      2     3
     / \   / \
    4   5 6   7
       / \
      8   9

/ \

2 3

/ \ / \

4 5 6 7

/ \

8 9

se pueden representar por

   ejArbol :: Arbol Int
   ejArbol = N 1 (N 2 (H 4)
                      (N 5 (H 8) (H 9)))
                 (N 3 (H 6) (H 7))

ejArbol :: Arbol Int

ejArbol = N 1 (N 2 (H 4)

(N 5 (H 8) (H 9)))

(N 3 (H 6) (H 7))

Definir la función

   recorrido :: Arbol t -> [t]

1	recorrido :: Arbol t -> [t]

tal que (recorrido a) es el recorrido del árbol a por niveles desde la raíz a las hojas y de izquierda a derecha. Por ejemplo,

   λ> recorrido (N 1 (N 2 (H 4) (N 5 (H 8) (H 9))) (N 3 (H 6) (H 7)))
   [1,2,3,4,5,6,7,8,9]
   λ> recorrido (N 1 (N 3 (H 6) (H 7)) (N 2 (H 4) (N 5 (H 8) (H 9))))
   [1,3,2,6,7,4,5,8,9]
   λ> recorrido (N 1 (N 3 (H 6) (H 7)) (N 2 (H 4) (H 5)))
   [1,3,2,6,7,4,5]
   λ> recorrido (N 1 (N 2 (H 4) (H 5)) (N 3 (H 6) (H 7)))
   [1,2,3,4,5,6,7]
   λ> recorrido (N 1 (N 2 (H 4) (H 5)) (H 3))
   [1,2,3,4,5]
   λ> recorrido (N 1 (H 4) (H 3))
   [1,4,3]
   λ> recorrido (H 3)
   [3]

λ> recorrido (N 1 (N 2 (H 4) (N 5 (H 8) (H 9))) (N 3 (H 6) (H 7)))

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

λ> recorrido (N 1 (N 3 (H 6) (H 7)) (N 2 (H 4) (N 5 (H 8) (H 9))))

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

λ> recorrido (N 1 (N 3 (H 6) (H 7)) (N 2 (H 4) (H 5)))

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

λ> recorrido (N 1 (N 2 (H 4) (H 5)) (N 3 (H 6) (H 7)))

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

λ> recorrido (N 1 (N 2 (H 4) (H 5)) (H 3))

[1,2,3,4,5]

λ> recorrido (N 1 (H 4) (H 3))

[1,4,3]

λ> recorrido (H 3)

[3]

Soluciones

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

ejArbol :: Arbol Int
ejArbol = N 1 (N 2 (H 4)
                   (N 5 (H 8) (H 9)))
              (N 3 (H 6) (H 7))

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

recorrido :: Arbol t -> [t]
recorrido = concat . niveles

-- (niveles a) es la lista de los niveles del árbol a. Por ejemplo,
--    λ> niveles (N 1 (N 2 (H 4) (N 5 (H 8) (H 9))) (N 3 (H 6) (H 7)))
--    [[1],[2,3],[4,5,6,7],[8,9]]
niveles :: Arbol t -> [[t]]
niveles (H x)     = [[x]]
niveles (N x i d) = [x] : mezcla (niveles i) (niveles d)

-- (mezcla xss yss) es la lista obtenida concatenando los
-- correspondientes elementos de xss e yss. Por ejemplo,
--    λ> mezcla [[1,3],[2,5,7]] [[4],[1,9],[0,14]]
--    [[1,3,4],[2,5,7,1,9],[0,14]]
--    λ> mezcla [[1,3],[2,5,7]] [[4]]
--    [[1,3,4],[2,5,7]]
mezcla :: [[a]] -> [[a]] -> [[a]]
mezcla [] yss            = yss
mezcla xss []            = xss
mezcla (xs:xss) (ys:yss) = (xs ++ ys) : mezcla xss yss

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

recorrido2 :: Arbol t -> [t]
recorrido2 = concat . niveles2

-- (niveles2 a) es la lista de los niveles del árbol a. Por ejemplo,
--    λ> niveles2 (N 1 (N 2 (H 4) (N 5 (H 8) (H 9))) (N 3 (H 6) (H 7)))
--    [[1],[2,3],[4,5,6,7],[8,9]]
niveles2 :: Arbol t -> [[t]]
niveles2 a = takeWhile (not . null) [nivel n a | n <- [0..]]

-- (nivel n a) es el nivel iésimo del árbol a. Por ejemplo,
--    λ> nivel 2 (N 1 (N 2 (H 4) (N 5 (H 8) (H 9))) (N 3 (H 6) (H 7)))
--    [4,5,6,7]
--    λ> nivel 5 (N 1 (N 2 (H 4) (N 5 (H 8) (H 9))) (N 3 (H 6) (H 7)))
--    []
nivel :: Int -> Arbol t -> [t]
nivel 0 (H x)      = [x]
nivel n (H _)      = []
nivel 0 (N x _ _)  = [x]
nivel n (N x i d)  = nivel (n-1) i ++ nivel (n-1) d

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving (Eq, Show)

ejArbol :: Arbol Int

ejArbol = N 1 (N 2 (H 4)

(N 5 (H 8) (H 9)))

(N 3 (H 6) (H 7))

-- 1ª definición

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

recorrido :: Arbol t -> [t]

recorrido = concat . niveles

-- (niveles a) es la lista de los niveles del árbol a. Por ejemplo,

-- λ> niveles (N 1 (N 2 (H 4) (N 5 (H 8) (H 9))) (N 3 (H 6) (H 7)))

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

niveles :: Arbol t -> [[t]]

niveles (H x) = [[x]]

niveles (N x i d) = [x] : mezcla (niveles i) (niveles d)

-- (mezcla xss yss) es la lista obtenida concatenando los

-- correspondientes elementos de xss e yss. Por ejemplo,

-- λ> mezcla [[1,3],[2,5,7]] [[4],[1,9],[0,14]]

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

-- λ> mezcla [[1,3],[2,5,7]] [[4]]

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

mezcla :: [[a]] -> [[a]] -> [[a]]

mezcla [] yss = yss

mezcla xss [] = xss

mezcla (xs:xss) (ys:yss) = (xs ++ ys) : mezcla xss yss

-- 2ª definición

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

recorrido2 :: Arbol t -> [t]

recorrido2 = concat . niveles2

-- (niveles2 a) es la lista de los niveles del árbol a. Por ejemplo,

-- λ> niveles2 (N 1 (N 2 (H 4) (N 5 (H 8) (H 9))) (N 3 (H 6) (H 7)))

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

niveles2 :: Arbol t -> [[t]]

niveles2 a = takeWhile (not . null) [nivel n a | n <- [0..]]

-- (nivel n a) es el nivel iésimo del árbol a. Por ejemplo,

-- λ> nivel 2 (N 1 (N 2 (H 4) (N 5 (H 8) (H 9))) (N 3 (H 6) (H 7)))

-- [4,5,6,7]

-- λ> nivel 5 (N 1 (N 2 (H 4) (N 5 (H 8) (H 9))) (N 3 (H 6) (H 7)))

-- []

nivel :: Int -> Arbol t -> [t]

nivel 0 (H x) = [x]

nivel n (H _) = []

nivel 0 (N x _ _) = [x]

nivel n (N x i d) = nivel (n-1) i ++ nivel (n-1) d

Sucesión de raíces enteras de los números primos

PorJosé A. Alonso 26-diciembre-201719-febrero-2018

Definir las siguientes funciones

   raicesEnterasPrimos :: [Integer]
   posiciones :: Integer -> (Int,Int)
   frecuencia :: Integer -> Int
   grafica_raicesEnterasPrimos :: Int -> IO ()
   grafica_posicionesIniciales :: Integer -> IO ()
   grafica_frecuencias :: Integer -> IO ()

raicesEnterasPrimos :: [Integer]

posiciones :: Integer -> (Int,Int)

frecuencia :: Integer -> Int

grafica_raicesEnterasPrimos :: Int -> IO ()

grafica_posicionesIniciales :: Integer -> IO ()

grafica_frecuencias :: Integer -> IO ()

tales que

raicesEnterasPrimos es la sucesión de las raíces enteras (por defecto) de los números primos. Por ejemplo,

     λ> take 20 raicesEnterasPrimos
     [1,1,2,2,3,3,4,4,4,5,5,6,6,6,6,7,7,7,8,8]
     λ> raicesEnterasPrimos !! 2500000
     6415

λ> take 20 raicesEnterasPrimos

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

λ> raicesEnterasPrimos !! 2500000

6415

(posiciones x) es el par formado por la menor y la mayor posición de x en la sucesión de las raíces enteras de los números primos. Por ejemplo,

      posiciones 2     ==  (2,3)
      posiciones 4     ==  (6,8)
      posiciones 2017  ==  (287671,287931)
      posiciones 2018  ==  (287932,288208)

posiciones 2 == (2,3)

posiciones 4 == (6,8)

posiciones 2017 == (287671,287931)

posiciones 2018 == (287932,288208)

(frecuencia x) es el número de veces que aparece x en la sucesión de las raíces enteras de los números primos. Por ejemplo,

      frecuencia 2     ==  2
      frecuencia 4     ==  3
      frecuencia 2017  ==  261
      frecuencia 2018  ==  277

frecuencia 2 == 2

frecuencia 4 == 3

frecuencia 2017 == 261

frecuencia 2018 == 277

(grafica_raicesEnterasPrimos n) dibuja la gráfica de los n primeros términos de la sucesión de las raíces enteras de los números primos. Por ejemplo, (grafica_raicesEnterasPrimos 200) dibuja
(grafica_posicionesIniciales n) dibuja la gráfica de las menores posiciones de los n primeros números en la sucesión de las raíces enteras de los números primos. Por ejemplo, (grafica_posicionesIniciales 200) dibuja
(grafica_frecuencia n) dibuja la gráfica de las frecuencia de los n primeros números en la sucesión de las raíces enteras de los números primos. Por ejemplo, (grafica_frecuencia 200) dibuja

Soluciones

import Data.Numbers.Primes (primes)
import Graphics.Gnuplot.Simple

raicesEnterasPrimos :: [Integer]
raicesEnterasPrimos = map raizEntera primes                       

raizEntera :: Integer -> Integer
raizEntera = floor . sqrt . fromIntegral

posiciones :: Integer -> (Int,Int)
posiciones x = (n,n+m-1)
  where (as,bs) = span (<x) raicesEnterasPrimos
        cs      = takeWhile (==x) bs 
        n       = length as
        m       = length cs

frecuencia :: Integer -> Int
frecuencia x =
  ( length
  . takeWhile (==x)
  . dropWhile (<x)
  ) raicesEnterasPrimos

grafica_raicesEnterasPrimos :: Int -> IO ()
grafica_raicesEnterasPrimos n = 
  plotList [ Title "Raices enteras de primos"
           , XLabel "Posiciones de numeros primos"
           , YLabel "Raiz entera del n-esimo primo"
           , Key Nothing
           , PNG "Sucesion_de_raices_enteras_de_primos_1.png"
           ]
           (take n raicesEnterasPrimos)

grafica_posicionesIniciales :: Integer -> IO ()
grafica_posicionesIniciales n = 
  plotList [ Title "Posiciones iniciales en raices enteras de primos"
           , XLabel "Numeros enteros"
           , YLabel "Posicion del numero n en las raices enteras de primos"
           , Key Nothing
           , PNG "Sucesion_de_raices_enteras_de_primos_2.png"
           ]
           (map (fst . posiciones) [1..n])

grafica_frecuencias :: Integer -> IO ()
grafica_frecuencias n = 
  plotList [ Title "Frecuencias en raices enteras de primos"
           , XLabel "Numeros enteros n"
           , YLabel "Frecuencia del numero n en las raices enteras de primos"
           , Key Nothing
           , PNG "Sucesion_de_raices_enteras_de_primos_3.png"
           ]
           (map frecuencia [1..n])

import Data.Numbers.Primes (primes)

import Graphics.Gnuplot.Simple

raicesEnterasPrimos :: [Integer]

raicesEnterasPrimos = map raizEntera primes

raizEntera :: Integer -> Integer

raizEntera = floor . sqrt . fromIntegral

posiciones :: Integer -> (Int,Int)

posiciones x = (n,n+m-1)

where (as,bs) = span (<x) raicesEnterasPrimos

cs = takeWhile (==x) bs

n = length as

m = length cs

frecuencia :: Integer -> Int

frecuencia x =

( length

. takeWhile (==x)

. dropWhile (<x)

) raicesEnterasPrimos

grafica_raicesEnterasPrimos :: Int -> IO ()

grafica_raicesEnterasPrimos n =

plotList [ Title "Raices enteras de primos"

, XLabel "Posiciones de numeros primos"

, YLabel "Raiz entera del n-esimo primo"

, Key Nothing

, PNG "Sucesion_de_raices_enteras_de_primos_1.png"

]

(take n raicesEnterasPrimos)

grafica_posicionesIniciales :: Integer -> IO ()

grafica_posicionesIniciales n =

plotList [ Title "Posiciones iniciales en raices enteras de primos"

, XLabel "Numeros enteros"

, YLabel "Posicion del numero n en las raices enteras de primos"

, Key Nothing

, PNG "Sucesion_de_raices_enteras_de_primos_2.png"

]

(map (fst . posiciones) [1..n])

grafica_frecuencias :: Integer -> IO ()

grafica_frecuencias n =

plotList [ Title "Frecuencias en raices enteras de primos"

, XLabel "Numeros enteros n"

, YLabel "Frecuencia del numero n en las raices enteras de primos"

, Key Nothing

, PNG "Sucesion_de_raices_enteras_de_primos_3.png"

]

(map frecuencia [1..n])

Cadenas opuestas

PorJosé A. Alonso 18-diciembre-201725-diciembre-2017

La opuesta de una cadena de letras es la cadena obtenida cambiando las minúsculas por mayúsculas y las minúsculas por mayúsculas. Por ejemplo, la opuesta de «SeViLLa» es «sEvIllA».

Definir la función

   esOpuesta :: String -> String -> Bool

1	esOpuesta :: String -> String -> Bool

tal que (esOpuesta s1 s2) se verifica si las cadenas de letras s1 y s2 son opuestas. Por ejemplo,

   esOpuesta "ab" "AB"      `== True
   esOpuesta "aB" "Ab"      `== True
   esOpuesta "aBcd" "AbCD"  `== True
   esOpuesta "aBcde" "AbCD" `== False
   esOpuesta "AB" "Ab"      `== False
   esOpuesta "" ""          `== True

esOpuesta "ab" "AB" `== True

esOpuesta "aB" "Ab" `== True

esOpuesta "aBcd" "AbCD" `== True

esOpuesta "aBcde" "AbCD" `== False

esOpuesta "AB" "Ab" `== False

esOpuesta "" "" `== True

Soluciones

import Data.Char (isLower, isUpper, ord, toLower, toUpper)

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

esOpuesta1 :: String -> String -> Bool
esOpuesta1 s1 s2 = [opuesto c | c <- s1] == s2

opuesto :: Char -> Char
opuesto c
  | isLower c = toUpper c
  | otherwise = toLower c

-- 2ª solución (con map)
-- =====================

esOpuesta2 :: String -> String -> Bool
esOpuesta2 s1 s2 = map opuesto s1 == s2

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

esOpuesta3 :: String -> String -> Bool
esOpuesta3 "" ""           = True
esOpuesta3 (c1:s1) (c2:s2) = esOpuesto c1 c2 && esOpuesta3 s1 s2
esOpuesta3 _ _             = False

esOpuesto :: Char -> Char -> Bool
esOpuesto c1 c2 = abs (ord c1 - ord c2) == 32

import Data.Char (isLower, isUpper, ord, toLower, toUpper)

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

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

esOpuesta1 :: String -> String -> Bool

esOpuesta1 s1 s2 = [opuesto c | c <- s1] == s2

opuesto :: Char -> Char

opuesto c

| isLower c = toUpper c

| otherwise = toLower c

-- 2ª solución (con map)

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

esOpuesta2 :: String -> String -> Bool

esOpuesta2 s1 s2 = map opuesto s1 == s2

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

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

esOpuesta3 :: String -> String -> Bool

esOpuesta3 "" "" = True

esOpuesta3 (c1:s1) (c2:s2) = esOpuesto c1 c2 && esOpuesta3 s1 s2

esOpuesta3 _ _ = False

esOpuesto :: Char -> Char -> Bool

esOpuesto c1 c2 = abs (ord c1 - ord c2) == 32

Reconocimiento de recorridos correctos

PorJosé A. Alonso 12-diciembre-201719-diciembre-2017

Se usará la misma representación del ejercicio anterior para las subidas y bajadas en el autobús; es decir, una lista de pares donde los primeros elementos es el número de viajeros que suben y los segundo es el de los que bajan.

Un recorrido es correcto si en cada bajada tanto el número de viajeros que suben como los que bajan son positivos, el número de viajeros en el autobús no puede ser mayor que su capacidad y el número de viajeros que bajan no puede ser mayor que el número de viajeros en el autobús. Se supone que en la primera parada el autobús no tiene viajeros.

Definir la función

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

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

tal que (recorridoCorrecto n ps) se verifica si ps es un recorrido correcto en un autobús cuya capacidad es n. Por ejemplo,

  recorridoCorrecto 20 [(3,0),(9,1),(4,10),(12,2),(6,1)]  ==  True
  recorridoCorrecto 15 [(3,0),(9,1),(4,10),(12,2),(6,1)]  ==  False
  recorridoCorrecto 15 [(3,2),(9,1),(4,10),(12,2),(6,1)]  ==  False
  recorridoCorrecto 15 [(3,0),(2,7),(4,10),(12,2),(6,1)]  ==  False

recorridoCorrecto 20 [(3,0),(9,1),(4,10),(12,2),(6,1)] == True

recorridoCorrecto 15 [(3,0),(9,1),(4,10),(12,2),(6,1)] == False

recorridoCorrecto 15 [(3,2),(9,1),(4,10),(12,2),(6,1)] == False

recorridoCorrecto 15 [(3,0),(2,7),(4,10),(12,2),(6,1)] == False

el segundo ejemplo es incorrecto porque en la última para se supera la capacidad del autobús; el tercero, porque en la primera para no hay viajeros en el autobús que se puedan bajar y el cuarto, porque en la 2ª parada el autobús tiene 3 viajeros por lo que es imposible que se bajen 7.

Soluciones

-- 1ª definición
recorridoCorrecto1 :: Int -> [(Int,Int)] -> Bool
recorridoCorrecto1 _ [] = True
recorridoCorrecto1 n ps = aux 0 ps
  where aux _ []         = True
        aux k ((a,b):ps) = 0 <= a && a <= n - k + b &&
                           0 <= b && b <= k &&
                           aux (k + a - b) ps

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

recorridoCorrecto2 :: Int -> [(Int,Int)] -> Bool
recorridoCorrecto2 n ps =
  all (\(x,y) -> x >= 0 && y >= 0) ps &&
  all (\k -> 0 <= k && k <= n) (viajeros ps)

-- (viajeros ps) es el número de viajeros después de cada parada del
-- recorrido ps. Por ejemplo,
--   viajeros [(3,0),(9,1),(4,10),(12,2),(6,1)]  ==  [0,3,11,5,15,20]
--   viajeros [(3,0),(2,7),(4,10),(12,2),(6,1)]  ==  [0,3,-2,-8,2,7]
viajeros :: [(Int,Int)] -> [Int]
viajeros ps = aux [0] ps
  where aux ns     []         = reverse ns
        aux (n:ns) ((a,b):ps) = aux (n+a-b:n:ns) ps 

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

recorridoCorrecto3 :: Int -> [(Int,Int)] -> Bool
recorridoCorrecto3 n ps =
  all (\(x,y) -> x >= 0 && y >= 0) ps &&
  all (\k -> 0 <= k && k <= n) (viajeros3 ps)

-- (viajeros3 ps) es el número de viajeros después de cada parada del
-- recorrido ps. Por ejemplo,
--   viajeros3 [(3,0),(9,1),(4,10),(12,2),(6,1)]  ==  [0,3,11,5,15,20]
--   viajeros3 [(3,0),(2,7),(4,10),(12,2),(6,1)]  ==  [0,3,-2,-8,2,7]
viajeros3 :: [(Int,Int)] -> [Int]
viajeros3 = scanl (\k (a,b) -> k+a-b) 0

-- 1ª definición

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

recorridoCorrecto1 _ [] = True

recorridoCorrecto1 n ps = aux 0 ps

where aux _ [] = True

aux k ((a,b):ps) = 0 <= a && a <= n - k + b &&

0 <= b && b <= k &&

aux (k + a - b) ps

-- 2ª definición

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

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

recorridoCorrecto2 n ps =

all (\(x,y) -> x >= 0 && y >= 0) ps &&

all (\k -> 0 <= k && k <= n) (viajeros ps)

-- (viajeros ps) es el número de viajeros después de cada parada del

-- recorrido ps. Por ejemplo,

-- viajeros [(3,0),(9,1),(4,10),(12,2),(6,1)] == [0,3,11,5,15,20]

-- viajeros [(3,0),(2,7),(4,10),(12,2),(6,1)] == [0,3,-2,-8,2,7]

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

viajeros ps = aux [0] ps

where aux ns [] = reverse ns

aux (n:ns) ((a,b):ps) = aux (n+a-b:n:ns) ps

-- 3ª definición

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

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

recorridoCorrecto3 n ps =

all (\(x,y) -> x >= 0 && y >= 0) ps &&

all (\k -> 0 <= k && k <= n) (viajeros3 ps)

-- (viajeros3 ps) es el número de viajeros después de cada parada del

-- recorrido ps. Por ejemplo,

-- viajeros3 [(3,0),(9,1),(4,10),(12,2),(6,1)] == [0,3,11,5,15,20]

-- viajeros3 [(3,0),(2,7),(4,10),(12,2),(6,1)] == [0,3,-2,-8,2,7]

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

viajeros3 = scanl (\k (a,b) -> k+a-b) 0

Número de viajeros en el autobús

PorJosé A. Alonso 11-diciembre-201719-diciembre-2017

Un autobús inicia su recorrido con 0 viajeros. El número de viajeros que se suben y bajan en cada parada se representa por un par (x,y) donde x es el número de las que suben e y el de las que bajan. Un recorrido del autobús se representa por una lista de pares representando los números de viajeros que suben o bajan en cada parada.

Definir la función

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

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

tal que (nViajerosEnBus ps) es el número de viajeros en el autobús tras el recorrido ps. Por ejemplo,

  nViajerosEnBus []                                        ==  0
  nViajerosEnBus [(10,0),(3,5),(5,8)]                      ==  5
  nViajerosEnBus [(3,0),(9,1),(4,10),(12,2),(6,1),(7,10)]  ==  17
  nViajerosEnBus [(3,0),(9,1),(4,8),(12,2),(6,1),(7,8)]    ==  21

nViajerosEnBus [] == 0

nViajerosEnBus [(10,0),(3,5),(5,8)] == 5

nViajerosEnBus [(3,0),(9,1),(4,10),(12,2),(6,1),(7,10)] == 17

nViajerosEnBus [(3,0),(9,1),(4,8),(12,2),(6,1),(7,8)] == 21

Soluciones

import Data.List (foldl')

-- 1ª solución (por comprensión)
nViajerosEnBus1 :: [(Int, Int)] -> Int
nViajerosEnBus1 ps = sum [a - b | (a,b) <- ps]

-- 2ª solucioń (por recursión)
nViajerosEnBus2 :: [(Int, Int)] -> Int
nViajerosEnBus2 []         = 0
nViajerosEnBus2 ((a,b):ps) = a - b + nViajerosEnBus2 ps

-- 3ª solución (por recursión con acumulador)
nViajerosEnBus3 :: [(Int, Int)] -> Int
nViajerosEnBus3 = aux 0
  where aux n []         = n
        aux n ((a,b):xs) = aux (n+a-b) xs

-- 4ª solución (por plegado por la derecha):
nViajerosEnBus4 :: [(Int, Int)] -> Int
nViajerosEnBus4 = foldr (\(a,b) n -> a-b+n) 0

-- 5ª solución (por plegado por la derecha):
nViajerosEnBus5 :: [(Int, Int)] -> Int
nViajerosEnBus5 = foldl' (\n (a,b) -> a-b+n) 0

-- 6ª solución (con map)
nViajerosEnBus6 :: [(Int, Int)] -> Int
nViajerosEnBus6 xs = sum (map (\(x,y) -> x-y) xs)

-- 7ª solución (por composición y sin argumentos) 
nViajerosEnBus7 :: [(Int, Int)] -> Int
nViajerosEnBus7 = sum . map (uncurry (-))

import Data.List (foldl')

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

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

nViajerosEnBus1 ps = sum [a - b | (a,b) <- ps]

-- 2ª solucioń (por recursión)

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

nViajerosEnBus2 [] = 0

nViajerosEnBus2 ((a,b):ps) = a - b + nViajerosEnBus2 ps

-- 3ª solución (por recursión con acumulador)

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

nViajerosEnBus3 = aux 0

where aux n [] = n

aux n ((a,b):xs) = aux (n+a-b) xs

-- 4ª solución (por plegado por la derecha):

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

nViajerosEnBus4 = foldr (\(a,b) n -> a-b+n) 0

-- 5ª solución (por plegado por la derecha):

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

nViajerosEnBus5 = foldl' (\n (a,b) -> a-b+n) 0

-- 6ª solución (con map)

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

nViajerosEnBus6 xs = sum (map (\(x,y) -> x-y) xs)

-- 7ª solución (por composición y sin argumentos)

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

nViajerosEnBus7 = sum . map (uncurry (-))

Ordenación valle

PorJosé A. Alonso 8-diciembre-201715-diciembre-2017

La ordenación valle de la lista [79,35,54,19,35,25,12] es la lista [79,35,25,12,19,35,54] ya que es una permutación de la primera y cumple las siguientes condiciones

se compone de una parte decreciente ([79,35,25]), un elemento mínimo (12) y una parte creciente ([19,35,54]);
las dos partes tienen el mismo número de elementos;
cada elemento de la primera parte es mayor o igual que su correspondiente en la segunda parte; es decir. 79 ≥ 54, 35 ≥ 35 y 25 ≥ 19;
además, la diferencia entre dichos elementos es la menor posible.

En el caso, de que la longitud de la lista sea par, la división tiene sólo dos partes (sin diferenciar el menor elemento). Por ejemplo, el valle de [79,35,54,19,35,25] es [79,35,25,19,35,54].

Definir la función

   valle :: [Int] -> [Int]

1	valle :: [Int] -> [Int]

tal que (valle xs) es la ordenación valle de la lista xs. Por ejemplo,

   valle [79,35,54,19,35,25,12]       ==  [79,35,25,12,19,35,54]
   valle [79,35,54,19,35,25]          ==  [79,35,25,19,35,54]
   valle [67,93,100,-16,65,97,92]     ==  [100,93,67,-16,65,92,97]
   valle [14,14,14,14,7,14]           ==  [14,14,14,7,14,14]
   valle [14,14,14,14,14]             ==  [14,14,14,14,14]
   valle [17,17,15,14,8,7,7,5,4,4,1]  ==  [17,15,8,7,4,1,4,5,7,14,17]

valle [79,35,54,19,35,25,12] == [79,35,25,12,19,35,54]

valle [79,35,54,19,35,25] == [79,35,25,19,35,54]

valle [67,93,100,-16,65,97,92] == [100,93,67,-16,65,92,97]

valle [14,14,14,14,7,14] == [14,14,14,7,14,14]

valle [14,14,14,14,14] == [14,14,14,14,14]

valle [17,17,15,14,8,7,7,5,4,4,1] == [17,15,8,7,4,1,4,5,7,14,17]

En el último ejemplo se muestra cómo la última condición descarta la posibilidad de que la lista [17,17,15,14,8,1,4,4,5,7,7] también sea solución ya que aunque se cumplen se cumplen las tres primeras condiciones la diferencia entre los elementos correspondientes es mayor que en la solución; por ejemplo, 17 – 7 > 17 – 17.

Soluciones

import Data.List (sort, sortBy)

-- 1ª solución
valle1 :: [Int] -> [Int]
valle1 xs = ys ++ reverse zs
  where (ys,zs) = aux (reverse (sort xs))
        aux []       = ([],[])
        aux [x]      = ([x],[])
        aux [x,y]    = ([x,y],[])
        aux (x:y:zs) = (x:as,y:bs)
          where (as,bs) = aux zs

-- 2ª solución
valle2 :: [Int] -> [Int]
valle2 = aux . reverse . sort
  where aux []       = []
        aux [x]      = [x]
        aux (x:y:xs) = x : aux xs ++ [y]

-- 3ª solución
valle3 :: [Int] -> [Int]
valle3 = aux . sortBy (flip compare)
  where aux []       = []
        aux [x]      = [x]
        aux (x:y:xs) = x : aux xs ++ [y]
        
-- Comparación de eficiencia
-- =========================

-- λ> length (valle1 [1..2*10^4])
-- 20000
-- (0.02 secs, 8,621,240 bytes)
-- λ> length (valle2 [1..2*10^4])
-- 20000
-- (2.68 secs, 8,595,637,880 bytes)
-- λ> length (valle3 [1..2*10^4])
-- 20000
-- (2.67 secs, 8,594,678,104 bytes)

import Data.List (sort, sortBy)

-- 1ª solución

valle1 :: [Int] -> [Int]

valle1 xs = ys ++ reverse zs

where (ys,zs) = aux (reverse (sort xs))

aux [] = ([],[])

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

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

aux (x:y:zs) = (x:as,y:bs)

where (as,bs) = aux zs

-- 2ª solución

valle2 :: [Int] -> [Int]

valle2 = aux . reverse . sort

where aux [] = []

aux [x] = [x]

aux (x:y:xs) = x : aux xs ++ [y]

-- 3ª solución

valle3 :: [Int] -> [Int]

valle3 = aux . sortBy (flip compare)

where aux [] = []

aux [x] = [x]

aux (x:y:xs) = x : aux xs ++ [y]

-- Comparación de eficiencia

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

-- λ> length (valle1 [1..2*10^4])

-- 20000

-- (0.02 secs, 8,621,240 bytes)

-- λ> length (valle2 [1..2*10^4])

-- 20000

-- (2.68 secs, 8,595,637,880 bytes)

-- λ> length (valle3 [1..2*10^4])

-- 20000

-- (2.67 secs, 8,594,678,104 bytes)

Caminos minimales en un árbol numérico

PorJosé A. Alonso 7-diciembre-201725-abril-2021

En la librería Data.Tree se definen los árboles y los bosques como sigue

   data Tree a   = Node a (Forest a)
   type Forest a = [Tree a]

1 2	data Tree a = Node a (Forest a) type Forest a = [Tree a]

Se pueden definir árboles. Por ejemplo,

   ej = Node 3 [Node 5 [Node 9 []], Node 7 []]

1	ej = Node 3 [Node 5 [Node 9 []], Node 7 []]

Y se pueden dibujar con la función drawTree. Por ejemplo,

   λ> putStrLn (drawTree (fmap show ej))
   3
   |
   +- 5
   |  |
   |  `- 9
   |
   `- 7

λ> putStrLn (drawTree (fmap show ej))

+- 5

| |

| `- 9

`- 7

Los mayores divisores de un número x son los divisores u tales que u > 1 y existe un v tal que 1 < v < u y u*v = x. Por ejemplo, los mayores divisores de 24 son 12, 8 y 6.

El árbol de los predecesores y mayores divisores de un número x es el árbol cuya raíz es x y los sucesores de cada nodo y > 1 es el conjunto formado por y-1 junto con los mayores divisores de y. Los nodos con valor 1 no tienen sucesores. Por ejemplo, el árbol de los predecesores y mayores divisores del número 6 es

/ \

5 3

| |

4 2

/ \ |

3 2 1

| |

2 1

Definir las siguientes funciones

   mayoresDivisores :: Int -> [Int]
   arbol            :: Int -> Tree Int
   caminos          :: Int -> [[Int]]
   caminosMinimales :: Int -> [[Int]]

mayoresDivisores :: Int -> [Int]

arbol :: Int -> Tree Int

caminos :: Int -> [[Int]]

caminosMinimales :: Int -> [[Int]]

tales que

(mayoresDivisores x) es la lista de los mayores divisores de x. Por ejemplo,

     mayoresDivisores 24  ==  [12,8,6]
     mayoresDivisores 16  ==  [8,4]
     mayoresDivisores 10  ==  [5]
     mayoresDivisores 17  ==  []

mayoresDivisores 24 == [12,8,6]

mayoresDivisores 16 == [8,4]

mayoresDivisores 10 == [5]

mayoresDivisores 17 == []

(arbol x) es el árbol de los predecesores y mayores divisores del número x. Por ejemplo,

     λ> putStrLn (drawTree (fmap show (arbol 6)))
     6
     |
     +- 5
     |  |
     |  `- 4
     |     |
     |     +- 3
     |     |  |
     |     |  `- 2
     |     |     |
     |     |     `- 1
     |     |
     |     `- 2
     |        |
     |        `- 1
     |
     `- 3
        |
        `- 2
           |
           `- 1

λ> putStrLn (drawTree (fmap show (arbol 6)))

+- 5

| |

| `- 4

| |

| +- 3

| | |

| | `- 2

| | |

| | `- 1

| |

| `- 2

| |

| `- 1

`- 3

`- 2

`- 1

(caminos x) es la lista de los caminos en el árbol de los predecesores y mayores divisores del número x. Por ejemplo,

     λ> caminos 6
     [[6,5,4,3,2,1],[6,5,4,2,1],[6,3,2,1]]

1 2	λ> caminos 6 [[6,5,4,3,2,1],[6,5,4,2,1],[6,3,2,1]]

(caminosMinimales x) es la lista de los caminos en de menor longitud en el árbol de los predecesores y mayores divisores del número x. Por ejemplo,

     λ> caminosMinimales 6
     [[6,3,2,1]]
     λ> caminosMinimales 17
     [[17,16,4,2,1]]
     λ> caminosMinimales 50
     [[50,25,5,4,2,1],[50,10,9,3,2,1],[50,10,5,4,2,1]]

λ> caminosMinimales 6

[[6,3,2,1]]

λ> caminosMinimales 17

[[17,16,4,2,1]]

λ> caminosMinimales 50

[[50,25,5,4,2,1],[50,10,9,3,2,1],[50,10,5,4,2,1]]

Soluciones

import Data.Tree

mayoresDivisores :: Int -> [Int]
mayoresDivisores x =
  [max u v | u <- [2..floor (sqrt (fromIntegral x))]
           , x `mod` u == 0
           , let v = x `div` u]  

arbol :: Int -> Tree Int
arbol 1 = Node 1 []
arbol x = Node x (arbol (x-1) : [arbol y | y <- mayoresDivisores x])

caminos :: Int -> [[Int]]
caminos = caminosArbol . arbol

--    λ> caminosArbol (arbol 6)
--    [[6,5,4,3,2,1],[6,5,4,2,1],[6,3,2,1]]
caminosArbol :: Tree a -> [[a]]
caminosArbol (Node x []) = [[x]]
caminosArbol (Node x as) = [x:ys | ys <- caminosBosque as]

caminosBosque :: Forest a -> [[a]]
caminosBosque = concatMap caminosArbol

caminosMinimales :: Int -> [[Int]]
caminosMinimales x = [ys | ys <- yss, length ys == m]
  where yss = caminos x
        m   = minimum (map length yss)

import Data.Tree

mayoresDivisores :: Int -> [Int]

mayoresDivisores x =

[max u v | u <- [2..floor (sqrt (fromIntegral x))]

, x `mod` u == 0

, let v = x `div` u]

arbol :: Int -> Tree Int

arbol 1 = Node 1 []

arbol x = Node x (arbol (x-1) : [arbol y | y <- mayoresDivisores x])

caminos :: Int -> [[Int]]

caminos = caminosArbol . arbol

-- λ> caminosArbol (arbol 6)

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

caminosArbol :: Tree a -> [[a]]

caminosArbol (Node x []) = [[x]]

caminosArbol (Node x as) = [x:ys | ys <- caminosBosque as]

caminosBosque :: Forest a -> [[a]]

caminosBosque = concatMap caminosArbol

caminosMinimales :: Int -> [[Int]]

caminosMinimales x = [ys | ys <- yss, length ys == m]

where yss = caminos x

m = minimum (map length yss)

Máximo de las rotaciones restringidas

PorJosé A. Alonso 6-diciembre-201713-diciembre-2017

Rotar un número a la iquierda significa pasar su primer dígito al final. Por ejemplo, rotando a la izquierda el 56789 se obtiene 67895.

Las rotaciones restringidas del número 56789 se obtienen como se indica a continución:

Se inicia con el propio número: 56789
El anterior se rota a la izquierda y se obtiene el 67895.
Del anterior se fija el primer dígito y se rota a la iquierda los otros. Se obtiene 68957.
Del anterior se fijan los 2 primeros dígito y se rota a la iquierda los otros. Se obtiene 68579.
Del anterior se fijan los 3 primeros dígito y se rota a la iquierda los otros. Se obtiene 68597.

El proceso ha terminado ya que conservando los cuatro primeros queda sólo un dígito que al girar es él mismo. Por tanto, la sucesión de las rotaciones restringidas de 56789 es

   56789 -> 67895 -> 68957 -> 68579 -> 68597

1	56789 -> 67895 -> 68957 -> 68579 -> 68597

y su mayor elemento es 68957.

Definir la función

   maxRotaciones :: Integer -> Integer

1	maxRotaciones :: Integer -> Integer

tal que (maxRotaciones n) es el máximo de las rotaciones restringidas del número n. Por ejemplo,

   maxRotaciones 56789       ==  68957
   maxRotaciones 1347902468  ==  3790246814
   maxRotaciones 6           ==  6
   maxRotaciones 2017        ==  2017

maxRotaciones 56789 == 68957

maxRotaciones 1347902468 == 3790246814

maxRotaciones 6 == 6

maxRotaciones 2017 == 2017

Soluciones

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

maxRotaciones :: Integer -> Integer
maxRotaciones = read . aux . show
  where aux n@[_]        = n
        aux n@(x1:x2:xs) = max n (x2:aux (xs ++ [x1]))

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

maxRotaciones2 :: Integer -> Integer
maxRotaciones2 n
  | n < 10    = n
  | otherwise = maximum [ read (us ++ vs)
                        | (us,vs) <- take m (iterate siguiente ("",xs)) ]
  where xs = show n
        m  = length xs

-- siguiente ("","56789")  ==  ("6","7895")
-- siguiente ("6","7895")  ==  ("68","957")
-- siguiente ("68","957")  ==  ("685","79")
-- siguiente ("685","79")  ==  ("6859","7")
-- siguiente ("6859","7")  ==  ("6859","7")
siguiente :: (String,String) -> (String,String)
siguiente (xs,a:b:ys) = (xs ++ [b], ys ++ [a])
siguiente (xs,[a])    = (xs,[a])

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

maxRotaciones3 :: Integer -> Integer
maxRotaciones3 = read . aux . show
  where aux (x:y:xs) | x > y     = x : y : xs
                     | otherwise = y : (aux $ xs ++ [x])
        aux [x]                  = [x]
        aux _                    = []

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

--    λ> length (show (maxRotaciones (n (5*10^3))))
--    5001
--    (2.74 secs, 802,282,616 bytes)
--    λ> length (show (maxRotaciones2 (n (5*10^3))))
--    5001
--    (18.23 secs, 12,375,579,216 bytes)
--    λ> length (show (maxRotaciones3 (n (5*10^3))))
--    5001
--    (0.67 secs, 729,155,056 bytes)

-- 1ª solución

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

maxRotaciones :: Integer -> Integer

maxRotaciones = read . aux . show

where aux n@[_] = n

aux n@(x1:x2:xs) = max n (x2:aux (xs ++ [x1]))

-- 2ª solución

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

maxRotaciones2 :: Integer -> Integer

maxRotaciones2 n

| n < 10 = n

| otherwise = maximum [ read (us ++ vs)

| (us,vs) <- take m (iterate siguiente ("",xs)) ]

where xs = show n

m = length xs

-- siguiente ("","56789") == ("6","7895")

-- siguiente ("6","7895") == ("68","957")

-- siguiente ("68","957") == ("685","79")

-- siguiente ("685","79") == ("6859","7")

-- siguiente ("6859","7") == ("6859","7")

siguiente :: (String,String) -> (String,String)

siguiente (xs,a:b:ys) = (xs ++ [b], ys ++ [a])

siguiente (xs,[a]) = (xs,[a])

-- 3ª solución

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

maxRotaciones3 :: Integer -> Integer

maxRotaciones3 = read . aux . show

where aux (x:y:xs) | x > y = x : y : xs

| otherwise = y : (aux $ xs ++ [x])

aux [x] = [x]

aux _ = []

-- Comparación de eficiencia

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

-- λ> length (show (maxRotaciones (n (5*10^3))))

-- 5001

-- (2.74 secs, 802,282,616 bytes)

-- λ> length (show (maxRotaciones2 (n (5*10^3))))

-- 5001

-- (18.23 secs, 12,375,579,216 bytes)

-- λ> length (show (maxRotaciones3 (n (5*10^3))))

-- 5001

-- (0.67 secs, 729,155,056 bytes)

Aplicación de lista de funciones a lista de elementos

PorJosé A. Alonso 5-diciembre-201712-diciembre-2017

Definir la función

   aplicaLista :: [a -> b] -> [a] -> [b]

1	aplicaLista :: [a -> b] -> [a] -> [b]

tal que (aplicaLista fs xs) es la lista de los valores de las funciones de fs
aplicadas a los correspondientes elementos de xs. Por ejemplo,

   aplicaLista [(+2),(`div` 3),(*5)] [4,6,2]    ==  [6,2,10]
   aplicaLista [(+2),(`div` 3),(*5)] [4,6,2,8]  ==  [6,2,10]
   aplicaLista [(>2),(==3),(<5)]     [4,6,2,9]  ==  [True,False,True]

aplicaLista [(+2),(`div` 3),(*5)] [4,6,2] == [6,2,10]

aplicaLista [(+2),(`div` 3),(*5)] [4,6,2,8] == [6,2,10]

aplicaLista [(>2),(==3),(<5)] [4,6,2,9] == [True,False,True]

Soluciones

-- 1ª definición (por comprensión)
aplicaLista :: [a -> b] -> [a] -> [b]
aplicaLista fs xs =
  [f x | (f,x) <- zip fs xs]

-- 2ª definición (por recursión)
aplicaLista2 :: [a -> b] -> [a] -> [b]
aplicaLista2 (f:fs) (x:xs) = f x : aplicaLista2 fs xs
aplicaLista2 _      _     = []

-- 3ª definición (por orden superior)
aplicaLista3 :: [a -> b] -> [a] -> [b]
aplicaLista3 = zipWith ($)

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

aplicaLista :: [a -> b] -> [a] -> [b]

aplicaLista fs xs =

[f x | (f,x) <- zip fs xs]

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

aplicaLista2 :: [a -> b] -> [a] -> [b]

aplicaLista2 (f:fs) (x:xs) = f x : aplicaLista2 fs xs

aplicaLista2 _ _ = []

-- 3ª definición (por orden superior)

aplicaLista3 :: [a -> b] -> [a] -> [b]

aplicaLista3 = zipWith ($)

Mayúsculas y minúsculas alternadas

PorJosé A. Alonso 4-diciembre-201712-diciembre-2017

Definir la función

   alternadas :: String -> (String,String)

1	alternadas :: String -> (String,String)

tal que (alternadas cs) es el par de cadenas (xs,ys) donde xs es la cadena obtenida escribiendo alternativamente en mayúscula o minúscula las letras de la palabra cs (que se supone que es una cadena de letras minúsculas) e ys se obtiene análogamente pero empezando en minúscula. Por ejemplo,

   λ> alternadas "salamandra"
   ("SaLaMaNdRa","sAlAmAnDrA")
   λ> alternadas "solosequenosenada"
   ("SoLoSeQuEnOsEnAdA","sOlOsEqUeNoSeNaDa")
   λ> alternadas (replicate 30 'a')
   ("AaAaAaAaAaAaAaAaAaAaAaAaAaAaAa","aAaAaAaAaAaAaAaAaAaAaAaAaAaAaA")

λ> alternadas "salamandra"

("SaLaMaNdRa","sAlAmAnDrA")

λ> alternadas "solosequenosenada"

("SoLoSeQuEnOsEnAdA","sOlOsEqUeNoSeNaDa")

λ> alternadas (replicate 30 'a')

("AaAaAaAaAaAaAaAaAaAaAaAaAaAaAa","aAaAaAaAaAaAaAaAaAaAaAaAaAaAaA")

Soluciones

import Data.Char (toUpper)

-- 1ª solución
alternadas :: String -> (String,String)
alternadas []     = ([],[])
alternadas (x:xs) = (toUpper x : zs, x : ys)
  where (ys,zs) = alternadas xs

-- 2ª solución
alternadas2 :: String -> (String,String)
alternadas2 xs =
  ( [f x | (f,x) <- zip (cycle [toUpper,id]) xs]
  , [f x | (f,x) <- zip (cycle [id,toUpper]) xs]
  )

-- Comparación de eficiencia
--    λ> import Data.List
--    λ> let (xs,ys) = alternadas (replicate (10^6) 'a') in nub (xs ++ ys)
--    "Aa"
--    (4.81 secs, 616,143,320 bytes)
--    λ> let (xs,ys) = alternadas2 (replicate (10^6) 'a') in nub (xs ++ ys)
--    "Aa"
--    (3.23 secs, 528,144,752 bytes)

import Data.Char (toUpper)

-- 1ª solución

alternadas :: String -> (String,String)

alternadas [] = ([],[])

alternadas (x:xs) = (toUpper x : zs, x : ys)

where (ys,zs) = alternadas xs

-- 2ª solución

alternadas2 :: String -> (String,String)

alternadas2 xs =

( [f x | (f,x) <- zip (cycle [toUpper,id]) xs]

, [f x | (f,x) <- zip (cycle [id,toUpper]) xs]

)

-- Comparación de eficiencia

-- λ> import Data.List

-- λ> let (xs,ys) = alternadas (replicate (10^6) 'a') in nub (xs ++ ys)

-- "Aa"

-- (4.81 secs, 616,143,320 bytes)

-- λ> let (xs,ys) = alternadas2 (replicate (10^6) 'a') in nub (xs ++ ys)

-- "Aa"

-- (3.23 secs, 528,144,752 bytes)

Conjunto de funciones entre dos conjuntos

PorJosé A. Alonso 1-diciembre-20178-diciembre-2017

Una función f entre dos conjuntos A e B se puede representar mediante una lista de pares de AxB tales que para cada elemento a de A existe un único elemento b de B tal que (a,b) pertenece a f. Por ejemplo,

[(1,2),(3,6)] es una función de [1,3] en [2,4,6];
[(1,2)] no es una función de [1,3] en [2,4,6], porque no tiene ningún par cuyo primer elemento sea igual a 3;
[(1,2),(3,6),(1,4)] no es una función porque hay dos pares distintos cuya primera coordenada es 1.

Definir las funciones

   funciones  :: (Ord a, Ord b) => [a] -> [b] -> [[(a,b)]]
   nFunciones :: (Ord a, Ord b) => [a] -> [b] -> Integer

1 2	funciones :: (Ord a, Ord b) => [a] -> [b] -> [[(a,b)]] nFunciones :: (Ord a, Ord b) => [a] -> [b] -> Integer

tales que

(funciones xs ys) es el conjunto de las funciones del conjunto xs en el conjunto ys. Por ejemplo,

     λ> funciones [1] [2]
     [[(1,2)]]
     λ> funciones [1] [2,4]
     [[(1,2)],[(1,4)]]
     λ> funciones [1,3] [2]
     [[(1,2),(3,2)]]
     λ> funciones [1,3] [2,4]
     [[(1,2),(3,2)],[(1,2),(3,4)],[(1,4),(3,2)],[(1,4),(3,4)]]
     λ> funciones [1,3] [2,4,6]
     [[(1,2),(3,2)],[(1,2),(3,4)],[(1,2),(3,6)],
      [(1,4),(3,2)],[(1,4),(3,4)],[(1,4),(3,6)],
      [(1,6),(3,2)],[(1,6),(3,4)],[(1,6),(3,6)]]
     λ> funciones [1,3,5] [2,4]
     [[(1,2),(3,2),(5,2)],[(1,2),(3,2),(5,4)],[(1,2),(3,4),(5,2)],
      [(1,2),(3,4),(5,4)],[(1,4),(3,2),(5,2)],[(1,4),(3,2),(5,4)],
      [(1,4),(3,4),(5,2)],[(1,4),(3,4),(5,4)]]
     λ> funciones [] []
     [[]]
     λ> funciones [] [2]
     [[]]
     λ> funciones [1] []
     []

λ> funciones [1] [2]

[[(1,2)]]

λ> funciones [1] [2,4]

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

λ> funciones [1,3] [2]

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

λ> funciones [1,3] [2,4]

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

λ> funciones [1,3] [2,4,6]

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

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

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

λ> funciones [1,3,5] [2,4]

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

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

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

λ> funciones [] []

[[]]

λ> funciones [] [2]

[[]]

λ> funciones [1] []

[]

(nFunciones xs ys) es el número de funciones del conjunto xs en el conjunto ys. Por ejemplo,

     nFunciones [1,3] [2,4,6]  ==  9
     nFunciones [1,3,5] [2,4]  ==  8
     length (show (nFunciones2 [1..10^6] [1..10^3]))  ==  3000001

nFunciones [1,3] [2,4,6] == 9

nFunciones [1,3,5] [2,4] == 8

length (show (nFunciones2 [1..10^6] [1..10^3])) == 3000001

Soluciones

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

-- 1ª definición de funciones
-- ==========================

funciones :: (Ord a, Ord b) => [a] -> [b] -> [[(a,b)]]
funciones xs ys =
  conjunto [r | r <- relaciones xs ys
              , esFuncion r xs ys]

-- (relaciones xs ys) es el conjunto de las relaciones binarias entre xs
-- e ys. Por ejemplo,
--    λ> relaciones [1,3] [2,4]
--    [[],[(1,2)],[(1,4)],[(1,2),(1,4)],[(3,2)],[(1,2),(3,2)],
--     [(1,4),(3,2)],[(1,2),(1,4),(3,2)],[(3,4)],[(1,2),(3,4)],
--     [(1,4),(3,4)],[(1,2),(1,4),(3,4)],[(3,2),(3,4)],
--     [(1,2),(3,2),(3,4)],[(1,4),(3,2),(3,4)],
--     [(1,2),(1,4),(3,2),(3,4)]]
relaciones :: [a] -> [b] -> [[(a,b)]]
relaciones xs ys =
  subsequences (producto xs ys)

-- (producto xs ys) es el producto cartesiano de xs e ys. Por ejemplo,
--    producto [1,3] [2,4]  ==  [(1,2),(1,4),(3,2),(3,4)]
producto :: [a] -> [b] -> [(a,b)]
producto xs ys =
  [(x,y) | x <- xs, y <- ys]

-- (esFuncional r) r se verifica si la relación r es funcional. Por
-- ejemplo, 
--    esFuncional [(2,4),(1,5),(3,4)]        ==  True
--    esFuncional [(3,4),(1,4),(1,2),(3,4)]  ==  False
esFuncional :: (Ord a, Ord b) => [(a,b)] -> Bool
esFuncional r =
  and [esUnitario (imagen r x) | x <- dominio r] 

-- (dominio r) es el dominio de la relación r. Por ejemplo,
--    dominio [(5,4),(1,4),(1,2),(3,4)]  ==  [1,3,5]
dominio :: Ord a => [(a,b)] -> [a]
dominio = sort . nub . map fst

-- (imagen r x) es la imagen de x en la relación r. Por ejemplo,
--    imagen [(5,4),(1,4),(1,2),(3,4)] 1  ==  [2,4]
--    imagen [(5,4),(1,4),(1,2),(3,4)] 2  ==  []
imagen :: (Ord a, Ord b) => [(a,b)] -> a -> [b]
imagen r x =
  conjunto [y | (x1,y) <- r, x1 == x]

-- (conjunto xs) es el conjunto (es decir, lista ordenada de elementos
-- distintos) correspondiente a la lista xs. Por ejemplo, 
--    conjunto [7,2,3,2,7,3]  ==  [2,3,7]
conjunto :: Ord a => [a] -> [a]
conjunto = sort . nub

-- (esUnitario xs) se verifica si xs tiene sólo un elemento.
esUnitario :: [a] -> Bool
esUnitario xs =
  length xs == 1

-- (esFuncion r xs ys) se verifica si r es una función con dominio xs y
-- codominio ys. Por ejemplo,
--    esFuncion [(2,4),(1,5),(3,4)] [1,2,3] [4,5,7]   ==  True
--    esFuncion [(2,4),(1,5),(3,4)] [1,3] [4,5,7]     ==  False
--    esFuncion [(2,4),(1,5),(3,4)] [1,2,3] [4,7]     ==  False
--    esFuncion [(1,4),(1,5),(3,4)] [1,2,3] [4,5,7]   ==  False
esFuncion :: (Ord a, Ord b) => [(a,b)] -> [a] -> [b] -> Bool
esFuncion r xs ys =
     conjunto xs == dominio r 
  && rango r `contenido` conjunto ys
  && esFuncional r

-- (rango r) es el rango de la relación r. Por ejemplo,
--    rango [(5,4),(1,4),(1,2),(3,4)]  ==  [2,4]
rango :: Ord b => [(a,b)] -> [b]
rango = sort . nub . map snd

-- (contenido xs ys) se verifica si el conjunto xs está contenido en el
-- ys. Por ejemplo,
--    [1,3] `contenido` [1,2,3,5]  ==  True
--    [1,3] `contenido` [1,2,4,5]  ==  False
contenido :: Ord a => [a] -> [a] -> Bool 
contenido xs ys =
  all (`elem` ys) xs

-- 2ª definición de funciones
-- ==========================

funciones2 :: (Ord a, Ord b) => [a] -> [b] -> [[(a,b)]]
funciones2 xs ys =
  conjunto (aux xs ys)
  where aux [] _      = [[]]
        aux [x] ys    = [[(x,y)] | y <- ys]
        aux (x:xs) ys = [((x,y):f) | y <- ys, f <- fs]
          where fs = aux xs ys

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

--    λ> length (funciones [1..4] [1..4]) 
--    256
--    (2.69 secs, 754,663,072 bytes)
--    λ> length (funciones2 [1..4] [1..4]) 
--    256
--    (0.04 secs, 243,600 bytes)

-- 1ª definición de nFunciones
-- ===========================

nFunciones :: (Ord a, Ord b) => [a] -> [b] -> Integer
nFunciones xs ys =
  genericLength (funciones2 xs ys)

-- 2ª definición de nFunciones
-- ===========================

nFunciones2 :: (Ord a, Ord b) => [a] -> [b] -> Integer
nFunciones2 xs ys =
  (genericLength ys)^(genericLength xs)

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

--    λ> nFunciones [1..5] [1..5] 
--    3125
--    (1.35 secs, 1,602,872 bytes)
--    λ> nFunciones2 [1..5] [1..5] 
--    3125
--    (0.03 secs, 140,480 bytes)

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

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

-- 1ª definición de funciones

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

funciones :: (Ord a, Ord b) => [a] -> [b] -> [[(a,b)]]

funciones xs ys =

conjunto [r | r <- relaciones xs ys

, esFuncion r xs ys]

-- (relaciones xs ys) es el conjunto de las relaciones binarias entre xs

-- e ys. Por ejemplo,

-- λ> relaciones [1,3] [2,4]

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

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

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

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

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

relaciones :: [a] -> [b] -> [[(a,b)]]

relaciones xs ys =

subsequences (producto xs ys)

-- (producto xs ys) es el producto cartesiano de xs e ys. Por ejemplo,

-- producto [1,3] [2,4] == [(1,2),(1,4),(3,2),(3,4)]

producto :: [a] -> [b] -> [(a,b)]

producto xs ys =

[(x,y) | x <- xs, y <- ys]

-- (esFuncional r) r se verifica si la relación r es funcional. Por

-- ejemplo,

-- esFuncional [(2,4),(1,5),(3,4)] == True

-- esFuncional [(3,4),(1,4),(1,2),(3,4)] == False

esFuncional :: (Ord a, Ord b) => [(a,b)] -> Bool

esFuncional r =

and [esUnitario (imagen r x) | x <- dominio r]

-- (dominio r) es el dominio de la relación r. Por ejemplo,

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

dominio :: Ord a => [(a,b)] -> [a]

dominio = sort . nub . map fst

-- (imagen r x) es la imagen de x en la relación r. Por ejemplo,

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

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

imagen :: (Ord a, Ord b) => [(a,b)] -> a -> [b]

imagen r x =

conjunto [y | (x1,y) <- r, x1 == x]

-- (conjunto xs) es el conjunto (es decir, lista ordenada de elementos

-- distintos) correspondiente a la lista xs. Por ejemplo,

-- conjunto [7,2,3,2,7,3] == [2,3,7]

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

conjunto = sort . nub

-- (esUnitario xs) se verifica si xs tiene sólo un elemento.

esUnitario :: [a] -> Bool

esUnitario xs =

length xs == 1

-- (esFuncion r xs ys) se verifica si r es una función con dominio xs y

-- codominio ys. Por ejemplo,

-- esFuncion [(2,4),(1,5),(3,4)] [1,2,3] [4,5,7] == True

-- esFuncion [(2,4),(1,5),(3,4)] [1,3] [4,5,7] == False

-- esFuncion [(2,4),(1,5),(3,4)] [1,2,3] [4,7] == False

-- esFuncion [(1,4),(1,5),(3,4)] [1,2,3] [4,5,7] == False

esFuncion :: (Ord a, Ord b) => [(a,b)] -> [a] -> [b] -> Bool

esFuncion r xs ys =

conjunto xs == dominio r

&& rango r `contenido` conjunto ys

&& esFuncional r

-- (rango r) es el rango de la relación r. Por ejemplo,

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

rango :: Ord b => [(a,b)] -> [b]

rango = sort . nub . map snd

-- (contenido xs ys) se verifica si el conjunto xs está contenido en el

-- ys. Por ejemplo,

-- [1,3] `contenido` [1,2,3,5] == True

-- [1,3] `contenido` [1,2,4,5] == False

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

contenido xs ys =

all (`elem` ys) xs

-- 2ª definición de funciones

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

funciones2 :: (Ord a, Ord b) => [a] -> [b] -> [[(a,b)]]

funciones2 xs ys =

conjunto (aux xs ys)

where aux [] _ = [[]]

aux [x] ys = [[(x,y)] | y <- ys]

aux (x:xs) ys = [((x,y):f) | y <- ys, f <- fs]

where fs = aux xs ys

-- Comparación de eficiencia de funciones

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

-- λ> length (funciones [1..4] [1..4])

-- 256

-- (2.69 secs, 754,663,072 bytes)

-- λ> length (funciones2 [1..4] [1..4])

-- 256

-- (0.04 secs, 243,600 bytes)

-- 1ª definición de nFunciones

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

nFunciones :: (Ord a, Ord b) => [a] -> [b] -> Integer

nFunciones xs ys =

genericLength (funciones2 xs ys)

-- 2ª definición de nFunciones

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

nFunciones2 :: (Ord a, Ord b) => [a] -> [b] -> Integer

nFunciones2 xs ys =

(genericLength ys)^(genericLength xs)

-- Comparación de eficiencia de nFunciones

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

-- λ> nFunciones [1..5] [1..5]

-- 3125

-- (1.35 secs, 1,602,872 bytes)

-- λ> nFunciones2 [1..5] [1..5]

-- 3125

-- (0.03 secs, 140,480 bytes)

Expresiones equilibradas

PorJosé A. Alonso 30-noviembre-20178-diciembre-2017

Una cadena de paréntesis abiertos y cerrados está equilibrada si a cada paréntesis abierto le corresponde uno cerrado y los restantes están equilibrados. Por ejemplo, «(()())» está equilibrada, pero «())(()» no lo está.

Definir la función

   equilibrada :: String -> Bool

1	equilibrada :: String -> Bool

tal que (equilibrada cs) se verifica si la cadena cs está equilibrada. Por ejemplo,

   equilibrada "(()())"          ==  True
   equilibrada "())(()"          ==  False
   equilibrada "()"              ==  True
   equilibrada ")(()))"          ==  False
   equilibrada "("               ==  False
   equilibrada "(())((()())())"  == True

equilibrada "(()())" == True

equilibrada "())(()" == False

equilibrada "()" == True

equilibrada ")(()))" == False

equilibrada "(" == False

equilibrada "(())((()())())" == True

Soluciones

import Data.List (foldl')
import Test.Hspec

-- 1ª definición
equilibrada :: String -> Bool
equilibrada = aux 0 where
  aux 0 []       = True
  aux n ('(':cs) = aux (n + 1) cs 
  aux n (')':cs) = n > 0 && aux (n - 1) cs 
  aux _ _        = False

-- 2ª definición
equilibrada2 :: String -> Bool
equilibrada2 = aux 0 where
  aux n []       = n == 0
  aux n ('(':ps) = aux (n+1) ps
  aux n (')':ps) = n > 0 && aux (n-1) ps

-- 3ª definición
equilibrada3 :: String -> Bool
equilibrada3 xs = null $ foldl' op [] xs where
  op ('(':xs) ')' = xs
  op xs x = x:xs

import Data.List (foldl')

import Test.Hspec

-- 1ª definición

equilibrada :: String -> Bool

equilibrada = aux 0 where

aux 0 [] = True

aux n ('(':cs) = aux (n + 1) cs

aux n (')':cs) = n > 0 && aux (n - 1) cs

aux _ _ = False

-- 2ª definición

equilibrada2 :: String -> Bool

equilibrada2 = aux 0 where

aux n [] = n == 0

aux n ('(':ps) = aux (n+1) ps

aux n (')':ps) = n > 0 && aux (n-1) ps

-- 3ª definición

equilibrada3 :: String -> Bool

equilibrada3 xs = null $ foldl' op [] xs where

op ('(':xs) ')' = xs

op xs x = x:xs

Reconocimiento de relaciones funcionales entre dos conjuntos

PorJosé A. Alonso 29-noviembre-20178-diciembre-2017

Una relación binaria entre dos conjuntos A y B se puede representar mediante un conjunto de pares (a,b) tales que a ∈ A y b ∈ B. Por ejemplo, la relación < entre A = {1,5,3} y B = {0,2,4} se representa por {(1,2),(1,4),(3,4)}.

Una relación R entre A y B es funcional si cada elemento de A está relacionado mediante R como máximo con un elemento de B. Por ejemplo, [(2,4),(1,5),(3,4)] es funcional, pero [(3,4),(1,4),(1,2),(3,4)] no lo es.

Definir la función

   esFuncional :: (Ord a, Ord b) => [(a,b)] -> Bool

1	esFuncional :: (Ord a, Ord b) => [(a,b)] -> Bool

tal que (esFuncional r) se verifica si la relación r es funcional. Por ejemplo,

   esFuncional [(2,4),(1,5),(3,4)]        ==  True
   esFuncional [(3,4),(1,4),(1,2),(3,4)]  ==  False

1 2	esFuncional [(2,4),(1,5),(3,4)] == True esFuncional [(3,4),(1,4),(1,2),(3,4)] == False

Soluciones

import Data.List (nub, sort)

esFuncional :: (Ord a, Ord b) => [(a,b)] -> Bool
esFuncional r =
  and [esUnitario (imagen r x) | x <- dominio r] 

-- (dominio r) es el dominio de la relación r. Por ejemplo,
--    dominio [(5,4),(1,4),(1,2),(3,4)]  ==  [1,3,5]
dominio :: Ord a => [(a,b)] -> [a]
dominio = sort . nub . map fst

-- (imagen r x) es la imagen de x en la relación r. Por ejemplo,
--    imagen [(5,4),(1,4),(1,2),(3,4)] 1  ==  [2,4]
--    imagen [(5,4),(1,4),(1,2),(3,4)] 2  ==  []
imagen :: (Ord a, Ord b) => [(a,b)] -> a -> [b]
imagen r x =
  conjunto [y | (x1,y) <- r, x1 == x]

-- (conjunto xs) es el conjunto (es decir, lista ordenada de elementos
-- distintos) correspondiente a la lista xs. Por ejemplo, 
--    conjunto [7,2,3,2,7,3]  ==  [2,3,7]
conjunto :: Ord a => [a] -> [a]
conjunto = sort . nub

-- (esUnitario xs) se verifica si xs tiene sólo un elemento.
esUnitario :: [a] -> Bool
esUnitario xs =
  length xs == 1

import Data.List (nub, sort)

esFuncional :: (Ord a, Ord b) => [(a,b)] -> Bool

esFuncional r =

and [esUnitario (imagen r x) | x <- dominio r]

-- (dominio r) es el dominio de la relación r. Por ejemplo,

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

dominio :: Ord a => [(a,b)] -> [a]

dominio = sort . nub . map fst

-- (imagen r x) es la imagen de x en la relación r. Por ejemplo,

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

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

imagen :: (Ord a, Ord b) => [(a,b)] -> a -> [b]

imagen r x =

conjunto [y | (x1,y) <- r, x1 == x]

-- (conjunto xs) es el conjunto (es decir, lista ordenada de elementos

-- distintos) correspondiente a la lista xs. Por ejemplo,

-- conjunto [7,2,3,2,7,3] == [2,3,7]

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

conjunto = sort . nub

-- (esUnitario xs) se verifica si xs tiene sólo un elemento.

esUnitario :: [a] -> Bool

esUnitario xs =

length xs == 1

Menor x tal que los x múltiplos de n contienen todos los dígitos

PorJosé A. Alonso 28-noviembre-20178-diciembre-2017

Definir la función

   menorX :: Integer -> Integer

1	menorX :: Integer -> Integer

tal que (menorX n) es el menor x tal que entre los x primeros múltiplos de n (es decir, entre n, 2×n, 3×n, … y x×n) contienen todos los dígitos al menos una vez. Por ejemplo, (menorX 92) es 6 ya que

   92                                    contiene  [2,9]
   92 y 92×2                             contienen [1,2,4,8,9]
   92,  92×2 y 92×3                      contienen [1,2,4,6,7,8,9]
   92,  92×2,  92×3 y 92×4               contienen [1,2,3,4,6,7,8,9]
   92,  92×2,  92×3,  92×4 y 92×5        contienen [0,1,2,3,4,6,7,8,9]
   92,  92×2,  92×3,  92×4,  92×5 y 92×6 contienen [0,1,2,3,4,5,6,7,8,9]

92 contiene [2,9]

92 y 92×2 contienen [1,2,4,8,9]

92, 92×2 y 92×3 contienen [1,2,4,6,7,8,9]

92, 92×2, 92×3 y 92×4 contienen [1,2,3,4,6,7,8,9]

92, 92×2, 92×3, 92×4 y 92×5 contienen [0,1,2,3,4,6,7,8,9]

92, 92×2, 92×3, 92×4, 92×5 y 92×6 contienen [0,1,2,3,4,5,6,7,8,9]

Otros ejemplos

   menorX 92          ==  6
   menorX 2967        ==  3
   menorX 266         ==  4
   menorX 18          ==  5
   menorX 2           ==  45
   menorX 125         ==  72
   menorX 1234567890  ==  1
   maximum [menorX n | n <- [1..3000]]  ==  72
   minimum [menorX n | n <- [1..3000]]  ==  3

menorX 92 == 6

menorX 2967 == 3

menorX 266 == 4

menorX 18 == 5

menorX 2 == 45

menorX 125 == 72

menorX 1234567890 == 1

maximum [menorX n | n <- [1..3000]] == 72

minimum [menorX n | n <- [1..3000]] == 3

Soluciones

import Data.List ((\\))

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

menorX :: Integer -> Integer
menorX n =
  head [x | x <- [1..]
          , [0..9] `contenido` digitosMultiplos n x]

contenido :: Eq a => [a] -> [a] -> Bool
contenido xs ys =
  all (`elem` ys) xs

digitosMultiplos :: Integer -> Integer -> [Integer]
digitosMultiplos n x =
  concatMap digitos [n,2*n..x*n]

digitos :: Integer -> [Integer]
digitos n =
  [read [c] | c <- show n]

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

menorX2 :: Integer -> Integer
menorX2 n = aux [] 0
  where aux xs x
          | [0..9] `contenido` xs = x
          | otherwise             = aux (digitos (n*(x+1)) ++ xs) (x+1)

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

menorX3 :: Integer -> Integer
menorX3 n = aux ['0'..'9'] 0
  where aux xs x
          | null xs   = x
          | otherwise = aux (xs \\ show (n*(x+1))) (x+1)

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

menorX4 :: Integer -> Integer
menorX4 n = aux "0123456789" 1 n
  where aux xs x nx | null ys   = x
                    | otherwise = aux ys (1+x) (nx+n)
          where ys = xs \\ show nx

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

--    λ> maximum [menorX n | n <- [1..6000]]
--    72
--    (2.04 secs, 3,737,579,888 bytes)
--    λ> maximum [menorX2 n | n <- [1..6000]]
--    72
--    (0.52 secs, 818,602,736 bytes)
--    λ> maximum [menorX3 n | n <- [1..6000]]
--    72
--    (0.10 secs, 67,090,800 bytes)
--    λ> maximum [menorX3 n | n <- [1..6000]]
--    72
--    (0.08 secs, 67,090,800 bytes)
--    
--    λ> maximum [menorX3 n | n <- [1..10^5]]
--    72
--    (0.81 secs, 1,044,781,216 bytes)
--    λ> maximum [menorX4 n | n <- [1..10^5]]
--    72
--    (0.71 secs, 1,009,113,304 bytes)

import Data.List ((\\))

-- 1ª definición

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

menorX :: Integer -> Integer

menorX n =

head [x | x <- [1..]

, [0..9] `contenido` digitosMultiplos n x]

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

contenido xs ys =

all (`elem` ys) xs

digitosMultiplos :: Integer -> Integer -> [Integer]

digitosMultiplos n x =

concatMap digitos [n,2*n..x*n]

digitos :: Integer -> [Integer]

digitos n =

[read [c] | c <- show n]

-- 2ª definición

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

menorX2 :: Integer -> Integer

menorX2 n = aux [] 0

where aux xs x

| [0..9] `contenido` xs = x

| otherwise = aux (digitos (n*(x+1)) ++ xs) (x+1)

-- 3ª definición

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

menorX3 :: Integer -> Integer

menorX3 n = aux ['0'..'9'] 0

where aux xs x

| null xs = x

| otherwise = aux (xs \\ show (n*(x+1))) (x+1)

-- 4ª definición

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

menorX4 :: Integer -> Integer

menorX4 n = aux "0123456789" 1 n

where aux xs x nx | null ys = x

| otherwise = aux ys (1+x) (nx+n)

where ys = xs \\ show nx

-- Comparación de eficiencia

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

-- λ> maximum [menorX n | n <- [1..6000]]

-- 72

-- (2.04 secs, 3,737,579,888 bytes)

-- λ> maximum [menorX2 n | n <- [1..6000]]

-- 72

-- (0.52 secs, 818,602,736 bytes)

-- λ> maximum [menorX3 n | n <- [1..6000]]

-- 72

-- (0.10 secs, 67,090,800 bytes)

-- λ> maximum [menorX3 n | n <- [1..6000]]

-- 72

-- (0.08 secs, 67,090,800 bytes)

-- λ> maximum [menorX3 n | n <- [1..10^5]]

-- 72

-- (0.81 secs, 1,044,781,216 bytes)

-- λ> maximum [menorX4 n | n <- [1..10^5]]

-- 72

-- (0.71 secs, 1,009,113,304 bytes)

Sumas de dos cuadrados

PorJosé A. Alonso 24-noviembre-20174-diciembre-2017

Definir la función

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

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

tal que (sumasDe2Cuadrados n) es la lista de los pares de números tales que la suma de sus cuadrados es n y el primer elemento del par es mayor o igual que el segundo. Por ejemplo,

   sumasDe2Cuadrados 25                ==  [(5,0),(4,3)]
   sumasDe2Cuadrados 32                ==  [(4,4)]
   sumasDe2Cuadrados 55                ==  []
   sumasDe2Cuadrados 850               ==  [(29,3),(27,11),(25,15)]
   length (sumasDe2Cuadrados (10^12))  ==  7

sumasDe2Cuadrados 25 == [(5,0),(4,3)]

sumasDe2Cuadrados 32 == [(4,4)]

sumasDe2Cuadrados 55 == []

sumasDe2Cuadrados 850 == [(29,3),(27,11),(25,15)]

length (sumasDe2Cuadrados (10^12)) == 7

Soluciones

-- 1ª definición
sumasDe2Cuadrados1 :: Integer -> [(Integer, Integer)]
sumasDe2Cuadrados1 n = 
  [(x,y) | x <- [n,n-1..0]
         , y <- [0..x]
         , x*x+y*y == n]

-- 2ª definición:
sumasDe2Cuadrados2 :: Integer -> [(Integer, Integer)]
sumasDe2Cuadrados2 n = 
  [(x,y) | x <- [a,a-1..0]
         , y <- [0..x]
         , x*x+y*y == n]
  where a = (floor . sqrt . fromIntegral) n

-- 3ª definición
sumasDe2Cuadrados3 :: Integer -> [(Integer, Integer)]
sumasDe2Cuadrados3 n =
  [(raizEntera x, raizEntera y)
  | y <- takeWhile (<= n `div` 2) cuadrados
  , let x = n - y
  , esCuadrado x]

cuadrados :: [Integer]
cuadrados = map (^2) [0..]

esCuadrado :: Integer -> Bool
esCuadrado x =
  x == y * y
  where y = raizEntera x
  
raizEntera :: Integer -> Integer
raizEntera x =
  (floor . sqrt . fromIntegral) x

-- 4ª definición
sumasDe2Cuadrados4 :: Integer -> [(Integer, Integer)]
sumasDe2Cuadrados4 n = aux ((floor . sqrt . fromIntegral) n) 0 
  where aux x y | x < y          = [] 
                | x*x + y*y <  n = aux x (y+1)
                | x*x + y*y == n = (x,y) : aux (x-1) (y+1)
                | otherwise      = aux (x-1) y

-- Comparación de eficiencia
--    λ> sumasDe2Cuadrados1 2020
--    [(42,16),(38,24)]
--    (4.29 secs, 621,601,336 bytes)
--    λ> sumasDe2Cuadrados2 2020
--    [(42,16),(38,24)]
--    (0.01 secs, 488,496 bytes)
--    λ> sumasDe2Cuadrados3 2020
--    [(42,16),(38,24)]
--    (0.02 secs, 197,256 bytes)
--    λ> sumasDe2Cuadrados4 2020
--    [(42,16),(38,24)]
--    (0.01 secs, 175,088 bytes)
--
--    λ> length (sumasDe2Cuadrados2 48612265)
--    32
--    (51.25 secs, 7,395,035,904 bytes)
--    λ> length (sumasDe2Cuadrados3 48612265)
--    32
--    (0.06 secs, 8,368,296 bytes)
--    λ> length (sumasDe2Cuadrados4 48612265)
--    32
--    (0.04 secs, 3,483,168 bytes)
--    
--    λ> length (sumasDe2Cuadrados3 (10^12))
--    7
--    (7.32 secs, 1,137,167,688 bytes)
--    λ> length (sumasDe2Cuadrados4 (10^12))
--    7
--    (3.64 secs, 480,776,736 bytes)

-- 1ª definición

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

sumasDe2Cuadrados1 n =

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

, y <- [0..x]

, x*x+y*y == n]

-- 2ª definición:

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

sumasDe2Cuadrados2 n =

[(x,y) | x <- [a,a-1..0]

, y <- [0..x]

, x*x+y*y == n]

where a = (floor . sqrt . fromIntegral) n

-- 3ª definición

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

sumasDe2Cuadrados3 n =

[(raizEntera x, raizEntera y)

| y <- takeWhile (<= n `div` 2) cuadrados

, let x = n - y

, esCuadrado x]

cuadrados :: [Integer]

cuadrados = map (^2) [0..]

esCuadrado :: Integer -> Bool

esCuadrado x =

x == y * y

where y = raizEntera x

raizEntera :: Integer -> Integer

raizEntera x =

(floor . sqrt . fromIntegral) x

-- 4ª definición

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

sumasDe2Cuadrados4 n = aux ((floor . sqrt . fromIntegral) n) 0

where aux x y | x < y = []

| x*x + y*y < n = aux x (y+1)

| x*x + y*y == n = (x,y) : aux (x-1) (y+1)

| otherwise = aux (x-1) y

-- Comparación de eficiencia

-- λ> sumasDe2Cuadrados1 2020

-- [(42,16),(38,24)]

-- (4.29 secs, 621,601,336 bytes)

-- λ> sumasDe2Cuadrados2 2020

-- [(42,16),(38,24)]

-- (0.01 secs, 488,496 bytes)

-- λ> sumasDe2Cuadrados3 2020

-- [(42,16),(38,24)]

-- (0.02 secs, 197,256 bytes)

-- λ> sumasDe2Cuadrados4 2020

-- [(42,16),(38,24)]

-- (0.01 secs, 175,088 bytes)

-- λ> length (sumasDe2Cuadrados2 48612265)

-- 32

-- (51.25 secs, 7,395,035,904 bytes)

-- λ> length (sumasDe2Cuadrados3 48612265)

-- 32

-- (0.06 secs, 8,368,296 bytes)

-- λ> length (sumasDe2Cuadrados4 48612265)

-- 32

-- (0.04 secs, 3,483,168 bytes)

-- λ> length (sumasDe2Cuadrados3 (10^12))

-- 7

-- (7.32 secs, 1,137,167,688 bytes)

-- λ> length (sumasDe2Cuadrados4 (10^12))

-- 7

-- (3.64 secs, 480,776,736 bytes)

[/schedule]

Sucesión contadora

PorJosé A. Alonso 22-noviembre-201726-marzo-2022

Definir las siguientes funciones

   numeroContado           :: Integer -> Integer
   contadora               :: Integer -> [Integer]
   lugarPuntoFijoContadora :: Integer -> Integer -> Maybe Integer

numeroContado :: Integer -> Integer

contadora :: Integer -> [Integer]

lugarPuntoFijoContadora :: Integer -> Integer -> Maybe Integer

tales que

(numeroContado n) es el número obtenido al contar las repeticiones de cada una de las cifras de n. Por ejemplo,

     numeroContado 1                 == 11
     numeroContado 114213            == 31121314
     numeroContado 1111111111111111  == 161
     numeroContado 555555555500      == 20105

numeroContado 1 == 11

numeroContado 114213 == 31121314

numeroContado 1111111111111111 == 161

numeroContado 555555555500 == 20105

(contadora n) es la sucesión cuyo primer elemento es n y los restantes se obtienen contando el número anterior de la sucesión. Por ejemplo,

     λ> take 14 (contadora 1)
     [1,11,21,1112,3112,211213,312213,212223,114213,31121314,41122314,
      31221324,21322314,21322314]
     λ> take 14 (contadora 5)
     [5,15,1115,3115,211315,31121315,41122315,3122131415,4122231415,
      3132132415,3122331415,3122331415,3122331415,3122331415]

λ> take 14 (contadora 1)

[1,11,21,1112,3112,211213,312213,212223,114213,31121314,41122314,

31221324,21322314,21322314]

λ> take 14 (contadora 5)

[5,15,1115,3115,211315,31121315,41122315,3122131415,4122231415,

3132132415,3122331415,3122331415,3122331415,3122331415]

(lugarPuntoFijoContadora n k) es el menor i <= k tal que son iguales los elementos en las posiciones i e i+1 de la sucesión contadora que cominza con n. Por ejemplo,

      λ> lugarPuntoFijoContadora 1 100
      Just 12
      λ> contadora 1 !! 11
      31221324
      λ> contadora 1 !! 12
      21322314
      λ> contadora 1 !! 13
      21322314
      λ> lugarPuntoFijoContadora 1 10
      Nothing
      λ> lugarPuntoFijoContadora 5 20
      Just 10
      λ> lugarPuntoFijoContadora 40 200
      Nothing

λ> lugarPuntoFijoContadora 1 100

Just 12

λ> contadora 1 !! 11

31221324

λ> contadora 1 !! 12

21322314

λ> contadora 1 !! 13

21322314

λ> lugarPuntoFijoContadora 1 10

Nothing

λ> lugarPuntoFijoContadora 5 20

Just 10

λ> lugarPuntoFijoContadora 40 200

Nothing

Nota: Este ejercicio ha sido propuesto por Ángel Ruiz.

Soluciones

import Data.List ( genericLength
                 , genericTake
                 , group
                 , nub
                 , sort
                 )

-- Definición de numeroContado
numeroContado :: Integer -> Integer
numeroContado n =
  (read . concat . map concat) [[(show . length) m,nub m]
                               | m <- (group . sort . show) n]

-- 1ª definición de contadora
contadora :: Integer -> [Integer]
contadora n = n : map numeroContado (contadora n)

-- 2ª definición de contadora
contadora2 :: Integer ->  [Integer]
contadora2 = iterate numeroContado 

-- Definición de lugarPuntoFijoContadora
lugarPuntoFijoContadora :: Integer -> Integer -> Maybe Integer
lugarPuntoFijoContadora n k
  | m == k-1  = Nothing
  | otherwise = Just m
  where xs = genericTake k (contadora n)
        ds = zipWith (-) xs (tail xs)
        m  = genericLength (takeWhile (/=0) ds)

import Data.List ( genericLength

, genericTake

, group

, nub

, sort

)

-- Definición de numeroContado

numeroContado :: Integer -> Integer

numeroContado n =

(read . concat . map concat) [[(show . length) m,nub m]

| m <- (group . sort . show) n]

-- 1ª definición de contadora

contadora :: Integer -> [Integer]

contadora n = n : map numeroContado (contadora n)

-- 2ª definición de contadora

contadora2 :: Integer -> [Integer]

contadora2 = iterate numeroContado

-- Definición de lugarPuntoFijoContadora

lugarPuntoFijoContadora :: Integer -> Integer -> Maybe Integer

lugarPuntoFijoContadora n k

| m == k-1 = Nothing

| otherwise = Just m

where xs = genericTake k (contadora n)

ds = zipWith (-) xs (tail xs)

m = genericLength (takeWhile (/=0) ds)

Cadenas de sumas de factoriales de los dígitos

PorJosé A. Alonso 17-noviembre-201725-noviembre-2017

Dado un número n se considera la sucesión cuyo primer término es n y los restantes se obtienen sumando los factoriales de los dígitos del anterior. Por ejemplo, la sucesión que empieza en 69 es

         69
     363600  (porque 6! + 9! = 363600)  
       1454  (porque 3! + 6! + 3! + 6! + 0! + 0! = 1454)
        169  (porque 1! + 4! + 5! + 4! = 169)
     363601  (porque 1! + 6! + 9! = 363601)
       1454  (porque 3! + 6! + 3! + 6! + 0! + 1! = 1454)
     ......

363600 (porque 6! + 9! = 363600)

1454 (porque 3! + 6! + 3! + 6! + 0! + 0! = 1454)

169 (porque 1! + 4! + 5! + 4! = 169)

363601 (porque 1! + 6! + 9! = 363601)

1454 (porque 3! + 6! + 3! + 6! + 0! + 1! = 1454)

......

La cadena correspondiente a un número n son los términos de la sucesión que empieza en n hasta la primera repetición de un elemento en la sucesión. Por ejemplo, la cadena de 69 es

   [69,363600,1454,169,363601,1454]

1	[69,363600,1454,169,363601,1454]

Consta de una parte no periódica ([69,363600]) y de una periódica ([1454,169,363601]).

Definir las funciones

   cadena  :: Integer -> [Integer]
   periodo :: Integer -> [Integer]

1 2	cadena :: Integer -> [Integer] periodo :: Integer -> [Integer]

tales que

(cadena n es la cadena correspondiente al número n. Por ejemplo,

      cadena 69    ==  [69,363600,1454,169,363601,1454]
      cadena 145   ==  [145,145]
      cadena 78    ==  [78,45360,871,45361,871]
      cadena 569   ==  [569,363720,5775,10320,11,2,2]
      cadena 3888  ==  [3888,120966,364324,782,45362,872,45362]
      maximum [length (cadena n) | n <- [1..5000]]  ==  61
      length (cadena 1479)                          ==  61

cadena 69 == [69,363600,1454,169,363601,1454]

cadena 145 == [145,145]

cadena 78 == [78,45360,871,45361,871]

cadena 569 == [569,363720,5775,10320,11,2,2]

cadena 3888 == [3888,120966,364324,782,45362,872,45362]

maximum [length (cadena n) | n <- [1..5000]] == 61

length (cadena 1479) == 61

(periodo n) es la parte periódica de la cadena de n. Por ejemplo,

      periodo 69    ==  [169,363601,1454]
      periodo 145   ==  [145]
      periodo 78    ==  [45361,871]
      periodo 569   ==  [2]
      periodo 3888  ==  [872,45362]
      maximum [length (periodo n) | n <- [1..5000]]  ==  3
      length (periodo 1479)                          ==  3

periodo 69 == [169,363601,1454]

periodo 145 == [145]

periodo 78 == [45361,871]

periodo 569 == [2]

periodo 3888 == [872,45362]

maximum [length (periodo n) | n <- [1..5000]] == 3

length (periodo 1479) == 3

Soluciones

-- Definición de cadena
-- ====================

cadena :: Integer -> [Integer]
cadena n = reverse (extension [n])

extension :: [Integer] -> [Integer]
extension (n:ns)
  | m `elem` (n:ns) = m : n : ns
  | otherwise       = extension (m : n : ns)
  where m = siguiente n

siguiente :: Integer -> Integer
siguiente n =
  sum [factorial d | d <- digitos n]

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

digitos :: Integer -> [Integer]
digitos n =
  [read [c] | c <- show n]

-- Definición de periodo
-- =====================

periodo :: Integer -> [Integer]
periodo n =
  reverse (x : takeWhile (/= x) xs)
  where (x:xs) = reverse (cadena n)

-- Definición de cadena

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

cadena :: Integer -> [Integer]

cadena n = reverse (extension [n])

extension :: [Integer] -> [Integer]

extension (n:ns)

| m `elem` (n:ns) = m : n : ns

| otherwise = extension (m : n : ns)

where m = siguiente n

siguiente :: Integer -> Integer

siguiente n =

sum [factorial d | d <- digitos n]

factorial :: Integer -> Integer

factorial n =

product [1..n]

digitos :: Integer -> [Integer]

digitos n =

[read [c] | c <- show n]

-- Definición de periodo

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

periodo :: Integer -> [Integer]

periodo n =

reverse (x : takeWhile (/= x) xs)

where (x:xs) = reverse (cadena n)

Números dígito potenciales

PorJosé A. Alonso 15-noviembre-201725-noviembre-2017

Un número entero x es dígito potencial de orden n si x es la suma de los dígitos de x elevados a n. Por ejemplo,

153 es un dígito potencial de orden 3 ya que 153 = 1^3+5^3+3^3
4150 es un dígito potencial de orden 5 ya que 4150 = 4^5+1^5+5^5+0^5

Un número x es dígito auto potencial si es un dígito potencial de orden n, donde n es el número de dígitos de n. Por ejemplo, 153 es un número dígito auto potencial.

Definir las funciones

   digitosPotencialesOrden :: Integer -> [Integer]
   digitosAutoPotenciales  :: [Integer]

1 2	digitosPotencialesOrden :: Integer -> [Integer] digitosAutoPotenciales :: [Integer]

tales que

(digitosPotencialesOrden n) es la lista de los números dígito potenciales de orden n. Por ejemplo,

     take 6 (digitosPotencialesOrden 3)  ==  [0,1,153,370,371,407]
     take 5 (digitosPotencialesOrden 4)  ==  [0,1,1634,8208,9474]
     take 8 (digitosPotencialesOrden 5)  ==  [0,1,4150,4151,54748,92727,93084,194979]
     take 3 (digitosPotencialesOrden 6)  ==  [0,1,548834]

take 6 (digitosPotencialesOrden 3) == [0,1,153,370,371,407]

take 5 (digitosPotencialesOrden 4) == [0,1,1634,8208,9474]

take 8 (digitosPotencialesOrden 5) == [0,1,4150,4151,54748,92727,93084,194979]

take 3 (digitosPotencialesOrden 6) == [0,1,548834]

digitosAutoPotenciales es la lista de los números dígito auto potenciales. Por ejemplo,

     λ> take 20 digitosAutoPotenciales
     [0,1,2,3,4,5,6,7,8,9,153,370,371,407,1634,8208,9474,54748,92727,93084]

1 2	λ> take 20 digitosAutoPotenciales [0,1,2,3,4,5,6,7,8,9,153,370,371,407,1634,8208,9474,54748,92727,93084]

Soluciones

import Data.List (genericLength)
import Data.Char (digitToInt)

-- 1ª definición de digitosPotencialesOrden
-- ========================================

digitosPotencialesOrden :: Integer -> [Integer]
digitosPotencialesOrden n =
  [x | x <- [0..]
     , esDigitoPotencialOrden n x]

esDigitoPotencialOrden :: Integer -> Integer -> Bool
esDigitoPotencialOrden n x =
  x == sum [y^n | y <- digitos x]

digitos :: Integer -> [Integer]
digitos x = [read [d] | d <- show x] 

-- 2ª definición de digitosPotencialesOrden
-- ========================================

digitosPotencialesOrden2 :: Integer -> [Integer]
digitosPotencialesOrden2 n =
  filter (esDigitoPotencialOrden2 n) [0..]

esDigitoPotencialOrden2 :: Integer -> Integer -> Bool
esDigitoPotencialOrden2 n x =
  x == sum (map (^n) (digitos2 x))

digitos2 :: Integer -> [Integer]
digitos2 = map (toInteger . digitToInt) . show

-- 3ª definición de digitosPotencialesOrden
-- ========================================

--    digitosPotencialesOrden3 3  ==  [0,1,153,370,371,407]
--    digitosPotencialesOrden3 4  ==  [0,1,1634,8208,9474]
digitosPotencialesOrden3 :: Integer -> [Integer]
digitosPotencialesOrden3 n =
  filter (esDigitoPotencialOrden2 n) [0..10^d-1]
  where d = maximoNDigitosPotencialesOrden n 

-- (maximoNDigitosPotencialesOrden n) es el máximo número de dígitos de
-- los números dígitos potenciales de orden d. Por ejemplo,
--    maximoNDigitosPotencialesOrden 3  ==  5
--    maximoNDigitosPotencialesOrden 5  ==  7
maximoNDigitosPotencialesOrden :: Integer -> Integer
maximoNDigitosPotencialesOrden n =
  head (dropWhile (\d -> d*9^n >= 10^(d-1)) [1..])

-- 1ª definición de esDigitoAutoPotencial
-- ======================================

esDigitoAutoPotencial :: Integer -> Bool
esDigitoAutoPotencial x =
  esDigitoPotencialOrden (genericLength (show x)) x

digitosAutoPotenciales :: [Integer]
digitosAutoPotenciales =
  filter esDigitoAutoPotencial [0..]

-- 2ª definición de esDigitoAutoPotencial
-- ======================================

digitosAutoPotenciales2 :: [Integer]
digitosAutoPotenciales2 =
  0: concat [[x | x <- [10^k..10^(k+1)-1], esDigitoPotencialOrden (k+1) x]
            | k <- [0..]]

import Data.List (genericLength)

import Data.Char (digitToInt)

-- 1ª definición de digitosPotencialesOrden

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

digitosPotencialesOrden :: Integer -> [Integer]

digitosPotencialesOrden n =

[x | x <- [0..]

, esDigitoPotencialOrden n x]

esDigitoPotencialOrden :: Integer -> Integer -> Bool

esDigitoPotencialOrden n x =

x == sum [y^n | y <- digitos x]

digitos :: Integer -> [Integer]

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

-- 2ª definición de digitosPotencialesOrden

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

digitosPotencialesOrden2 :: Integer -> [Integer]

digitosPotencialesOrden2 n =

filter (esDigitoPotencialOrden2 n) [0..]

esDigitoPotencialOrden2 :: Integer -> Integer -> Bool

esDigitoPotencialOrden2 n x =

x == sum (map (^n) (digitos2 x))

digitos2 :: Integer -> [Integer]

digitos2 = map (toInteger . digitToInt) . show

-- 3ª definición de digitosPotencialesOrden

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

-- digitosPotencialesOrden3 3 == [0,1,153,370,371,407]

-- digitosPotencialesOrden3 4 == [0,1,1634,8208,9474]

digitosPotencialesOrden3 :: Integer -> [Integer]

digitosPotencialesOrden3 n =

filter (esDigitoPotencialOrden2 n) [0..10^d-1]

where d = maximoNDigitosPotencialesOrden n

-- (maximoNDigitosPotencialesOrden n) es el máximo número de dígitos de

-- los números dígitos potenciales de orden d. Por ejemplo,

-- maximoNDigitosPotencialesOrden 3 == 5

-- maximoNDigitosPotencialesOrden 5 == 7

maximoNDigitosPotencialesOrden :: Integer -> Integer

maximoNDigitosPotencialesOrden n =

head (dropWhile (\d -> d*9^n >= 10^(d-1)) [1..])

-- 1ª definición de esDigitoAutoPotencial

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

esDigitoAutoPotencial :: Integer -> Bool

esDigitoAutoPotencial x =

esDigitoPotencialOrden (genericLength (show x)) x

digitosAutoPotenciales :: [Integer]

digitosAutoPotenciales =

filter esDigitoAutoPotencial [0..]

-- 2ª definición de esDigitoAutoPotencial

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

digitosAutoPotenciales2 :: [Integer]

digitosAutoPotenciales2 =

0: concat [[x | x <- [10^k..10^(k+1)-1], esDigitoPotencialOrden (k+1) x]

| k <- [0..]]

Mayor número equidigital

PorJosé A. Alonso 14-noviembre-201721-noviembre-2017

Definir la función

   mayorEquidigital :: Integer -> Integer

1	mayorEquidigital :: Integer -> Integer

tal que (mayorEquidigital x) es el mayor número que se puede contruir con los dígitos de x. Por ejemplo,

   mayorEquidigital 13112017  ==  73211110
   mayorEquidigital2 (2^100)  ==  9987776666655443322222211000000

1 2	mayorEquidigital 13112017 == 73211110 mayorEquidigital2 (2^100) == 9987776666655443322222211000000

Soluciones

import Data.List (sort, permutations)

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

mayorEquidigital1 :: Integer -> Integer
mayorEquidigital1 =
  maximum . equidigitales

-- (equidigitales x) es la lista de los números que se pueden contruir
-- con los dígitos de x. Por ejemplo, 
--    equidigitales 325  ==  [325,235,523,253,532,352]
equidigitales :: Integer -> [Integer]
equidigitales x =
  [read ys | ys <- permutations ds]
  where ds = show x

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

mayorEquidigital2 :: Integer -> Integer
mayorEquidigital2 = read . reverse . sort . show 

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

--    λ> mayorEquidigital1 (2^30)
--    8774432110
--    (11.77 secs, 26,334,106,664 bytes)
--    λ> mayorEquidigital2 (2^30)
--    8774432110
--    (0.00 secs, 156,800 bytes)

import Data.List (sort, permutations)

-- 1ª solución

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

mayorEquidigital1 :: Integer -> Integer

mayorEquidigital1 =

maximum . equidigitales

-- (equidigitales x) es la lista de los números que se pueden contruir

-- con los dígitos de x. Por ejemplo,

-- equidigitales 325 == [325,235,523,253,532,352]

equidigitales :: Integer -> [Integer]

equidigitales x =

[read ys | ys <- permutations ds]

where ds = show x

-- 2ª solución

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

mayorEquidigital2 :: Integer -> Integer

mayorEquidigital2 = read . reverse . sort . show

-- Comparación de eficiencia

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

-- λ> mayorEquidigital1 (2^30)

-- 8774432110

-- (11.77 secs, 26,334,106,664 bytes)

-- λ> mayorEquidigital2 (2^30)

-- 8774432110

-- (0.00 secs, 156,800 bytes)

Números oblongos

PorJosé A. Alonso 13-noviembre-201725-marzo-2022

Un número oblongo es un número que es el producto de dos números naturales consecutivos; es decir, n es un número oblongo si existe un número natural x tal que n = x(x+1). Por ejemplo, 42 es un número oblongo porque 42 = 6 x 7.

Definir las funciones

   esOblongo :: Integer -> Bool
   oblongos  :: [Integer]

1 2	esOblongo :: Integer -> Bool oblongos :: [Integer]

tales que

(esOblongo n) se verifica si n es oblongo. Por ejemplo,

     esOblongo 42               ==  True
     esOblongo 40               ==  False
     esOblongo 100000010000000  ==  True

esOblongo 42 == True

esOblongo 40 == False

esOblongo 100000010000000 == True

oblongos es la suceción de los números oblongos. Por ejemplo,

     take 15 oblongos   == [0,2,6,12,20,30,42,56,72,90,110,132,156,182,210]
     oblongos !! 50     == 2550
     oblongos !! (10^7) == 100000010000000

take 15 oblongos == [0,2,6,12,20,30,42,56,72,90,110,132,156,182,210]

oblongos !! 50 == 2550

oblongos !! (10^7) == 100000010000000

Soluciones

-- 1ª definición de esOblongo
esOblongo1 :: Integer -> Bool
esOblongo1 n =
  n == x * (x+1)
  where x = round (sqrt (fromIntegral n))

-- 2ª definición de esOblongo
esOblongo2 :: Integer -> Bool
esOblongo2 n =
  n `pertenece` oblongos3

pertenece :: Integer -> [Integer] -> Bool
pertenece x ys =
  x == head (dropWhile (< x) ys)

-- 1ª definición de oblongos
oblongos1 :: [Integer]
oblongos1 = [n | n <- [0..]
               , esOblongo1 n]

-- 2ª definición de oblongos
oblongos2 :: [Integer]
oblongos2 = filter esOblongo1 [0..]

-- 3ª definición de oblongos
oblongos3 :: [Integer]
oblongos3 = zipWith (*) [0..] [1..]

-- 1ª definición de esOblongo

esOblongo1 :: Integer -> Bool

esOblongo1 n =

n == x * (x+1)

where x = round (sqrt (fromIntegral n))

-- 2ª definición de esOblongo

esOblongo2 :: Integer -> Bool

esOblongo2 n =

n `pertenece` oblongos3

pertenece :: Integer -> [Integer] -> Bool

pertenece x ys =

x == head (dropWhile (< x) ys)

-- 1ª definición de oblongos

oblongos1 :: [Integer]

oblongos1 = [n | n <- [0..]

, esOblongo1 n]

-- 2ª definición de oblongos

oblongos2 :: [Integer]

oblongos2 = filter esOblongo1 [0..]

-- 3ª definición de oblongos

oblongos3 :: [Integer]

oblongos3 = zipWith (*) [0..] [1..]

Pares definidos por su MCD y su MCM

PorJosé A. Alonso 10-noviembre-201725-abril-2021

Definir las siguientes funciones

   pares  :: Integer -> Integer -> [(Integer,Integer)]
   nPares :: Integer -> Integer -> Integer

1 2	pares :: Integer -> Integer -> [(Integer,Integer)] nPares :: Integer -> Integer -> Integer

tales que

(pares a b) es la lista de los pares de números enteros positivos tales que su máximo común divisor es a y su mínimo común múltiplo es b. Por ejemplo,

     pares 3 3  == [(3,3)]
     pares 4 12 == [(4,12),(12,4)]
     pares 2 12 == [(2,12),(4,6),(6,4),(12,2)]
     pares 2 60 == [(2,60),(4,30),(6,20),(10,12),(12,10),(20,6),(30,4),(60,2)]
     pares 2 7  == []
     pares 12 3 == []
     length (pares 3 (product [3,5..91]))  ==  8388608

pares 3 3 == [(3,3)]

pares 4 12 == [(4,12),(12,4)]

pares 2 12 == [(2,12),(4,6),(6,4),(12,2)]

pares 2 60 == [(2,60),(4,30),(6,20),(10,12),(12,10),(20,6),(30,4),(60,2)]

pares 2 7 == []

pares 12 3 == []

length (pares 3 (product [3,5..91])) == 8388608

(nPares a b) es el número de pares de enteros positivos tales que su máximo común divisor es a y su mínimo común múltiplo es b. Por ejemplo,

     nPares 3 3   ==  1
     nPares 4 12  ==  2
     nPares 2 12  ==  4
     nPares 2 60  ==  8
     nPares 2 7   ==  0
     nPares 12 3  ==  0
     nPares 3 (product [3..3*10^4]) `mod` (10^12)  ==  477999992832
     length (show (nPares 3 (product [3..3*10^4])))  ==  977

nPares 3 3 == 1

nPares 4 12 == 2

nPares 2 12 == 4

nPares 2 60 == 8

nPares 2 7 == 0

nPares 12 3 == 0

nPares 3 (product [3..3*10^4]) `mod` (10^12) == 477999992832

length (show (nPares 3 (product [3..3*10^4]))) == 977

Soluciones

import Data.Numbers.Primes (primeFactors)
import Data.List (genericLength, group, nub, sort, subsequences)
import Test.QuickCheck

-- 1ª definición de pares
-- ======================

pares1 :: Integer -> Integer -> [(Integer,Integer)]
pares1 a b = [(x,y) | x <- [1..b]
                    , y <- [1..b]
                    , gcd x y == a
                    , lcm x y == b]

-- 2ª definición de pares
-- ======================

pares2 :: Integer -> Integer -> [(Integer,Integer)]
pares2 a b = [(x,y) | x <- [a,a+a..b]
                    , y <- [a,a+a..b]
                    , gcd x y == a
                    , lcm x y == b]

-- Comparacioń de eficiencia
--    λ> length (pares1 3 (product [3,5..11]))
--    16
--    (95.12 secs, 86,534,165,528 bytes)
--    λ> length (pares2 3 (product [3,5..11]))
--    16
--    (15.80 secs, 14,808,762,128 bytes)

-- 3ª definición de pares
-- ======================

pares3 :: Integer -> Integer -> [(Integer,Integer)]
pares3 a b = [(x,y) | x <- [a,a+a..b]
                    , c `rem` x == 0
                    , let y = c `div` x
                    , gcd x y == a
                    ]
  where c = a * b

-- Comparacioń de eficiencia
--    λ> length (pares2 3 (product [3,5..11]))
--    16
--    (15.80 secs, 14,808,762,128 bytes)
--    λ> length (pares3 3 (product [3,5..11]))
--    16
--    (0.01 secs, 878,104 bytes)

-- 4ª definición de pares
-- ======================

-- Para la cuarta definición de pares se observa la relación con los
-- factores primos
--    λ> [(primeFactors x, primeFactors y) | (x,y) <- pares1 2 12]
--    [([2],[2,2,3]),([2,2],[2,3]),([2,3],[2,2]),([2,2,3],[2])]
--    λ> [primeFactors x | (x,y) <- pares1 2 12]
--    [[2],[2,2],[2,3],[2,2,3]]
--    λ> [primeFactors x | (x,y) <- pares1 2 60]
--    [[2],[2,2],[2,3],[2,5],[2,2,3],[2,2,5],[2,3,5],[2,2,3,5]]
--    λ> [primeFactors x | (x,y) <- pares1 6 60]
--    [[2,3],[2,2,3],[2,3,5],[2,2,3,5]]
--    λ> [primeFactors x | (x,y) <- pares1 2 24]
--    [[2],[2,3],[2,2,2],[2,2,2,3]]
-- Se observa que cada pare se obtiene de uno de los subconjuntos de los
-- divisores primos de b/a. Por ejemplo,
--    λ> (a,b) = (2,24)
--    λ> b `div` a
--    12
--    λ> primeFactors it
--    [2,2,3]
--    λ> group it
--    [[2,2],[3]]
--    λ> subsequences it
--    [[],[[2,2]],[[3]],[[2,2],[3]]]
--    λ> map concat it
--    [[],[2,2],[3],[2,2,3]]
--    λ> map product it
--    [1,4,3,12]
--    λ> [(a * x, b `div` x) | x <- it]
--    [(2,24),(8,6),(6,8),(24,2)]
-- A partir de la observación se construye la siguiente definición

pares4 :: Integer -> Integer -> [(Integer,Integer)]
pares4 a b
  | b `mod` a /= 0 = []
  | otherwise =
    [(a * x, b `div` x)
    | x <- map (product . concat)
               ((subsequences . group . primeFactors) (b `div` a))]

-- Nota. La función pares4 calcula el mismo conjunto que las anteriores,
-- pero no necesariamente en el mismo orde. Por ejemplo,
--    λ> pares3 2 60 
--    [(2,60),(4,30),(6,20),(10,12),(12,10),(20,6),(30,4),(60,2)]
--    λ> pares4 2 60 
--    [(2,60),(4,30),(6,20),(12,10),(10,12),(20,6),(30,4),(60,2)]
--    λ> pares3 2 60 == sort (pares4 2 60)
--    True

-- Comparacioń de eficiencia
--    λ> length (pares3 3 (product [3,5..17]))
--    64
--    (4.44 secs, 2,389,486,440 bytes)
--    λ> length (pares4 3 (product [3,5..17]))
--    64
--    (0.00 secs, 177,704 bytes)
  
-- Propiedades de equivalencia de pares
-- ====================================

prop_pares :: Integer -> Integer -> Property
prop_pares a b =
  a > 0 && b > 0 ==>
  all (== pares1 a b)
      [sort (f a b) | f <- [ pares2
                           , pares3
                           , pares4
                           ]]
  
prop_pares2 :: Integer -> Integer -> Property
prop_pares2 a b =
  a > 0 && b > 0 ==>
  all (== pares1 a (a * b))
      [sort (f a (a * b)) | f <- [ pares2
                                 , pares3
                                 , pares4
                                 ]]
  
-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=10}) prop_pares
--    +++ OK, passed 100 tests.
--    λ> quickCheckWith (stdArgs {maxSize=10}) prop_pares
--    +++ OK, passed 100 tests.
--    λ> quickCheckWith (stdArgs {maxSize=10}) prop_pares2
--    +++ OK, passed 100 tests.
             
-- 1ª definición de nPares
-- =======================

nPares1 :: Integer -> Integer -> Integer
nPares1 a b = genericLength (pares4 a b)

-- 2ª definición de nPares
-- =======================

nPares2 :: Integer -> Integer -> Integer
nPares2 a b = 2^(length (nub (primeFactors (b `div` a))))

-- Comparación de eficiencia
--    λ> nPares1 3 (product [3,5..91])
--    8388608
--    (4.68 secs, 4,178,295,920 bytes)
--    λ> nPares2 3 (product [3,5..91])
--    8388608
--    (0.00 secs, 234,688 bytes)

-- Propiedad de equivalencia de nPares
-- ===================================

prop_nPares :: Integer -> Integer -> Property
prop_nPares a b =
  a > 0 && b > 0 ==>
  nPares1 a (a * b) == nPares2 a (a * b)
  
-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=10}) prop_nPares
--    +++ OK, passed 100 tests.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

import Data.Numbers.Primes (primeFactors)

import Data.List (genericLength, group, nub, sort, subsequences)

import Test.QuickCheck

-- 1ª definición de pares

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

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

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

, y <- [1..b]

, gcd x y == a

, lcm x y == b]

-- 2ª definición de pares

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

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

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

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

, gcd x y == a

, lcm x y == b]

-- Comparacioń de eficiencia

-- λ> length (pares1 3 (product [3,5..11]))

-- 16

-- (95.12 secs, 86,534,165,528 bytes)

-- λ> length (pares2 3 (product [3,5..11]))

-- 16

-- (15.80 secs, 14,808,762,128 bytes)

-- 3ª definición de pares

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

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

pares3 a b = [(x,y) | x <- [a,a+a..b]

, c `rem` x == 0

, let y = c `div` x

, gcd x y == a

]

where c = a * b

-- Comparacioń de eficiencia

-- λ> length (pares2 3 (product [3,5..11]))

-- 16

-- (15.80 secs, 14,808,762,128 bytes)

-- λ> length (pares3 3 (product [3,5..11]))

-- 16

-- (0.01 secs, 878,104 bytes)

-- 4ª definición de pares

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

-- Para la cuarta definición de pares se observa la relación con los

-- factores primos

-- λ> [(primeFactors x, primeFactors y) | (x,y) <- pares1 2 12]

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

-- λ> [primeFactors x | (x,y) <- pares1 2 12]

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

-- λ> [primeFactors x | (x,y) <- pares1 2 60]

-- [[2],[2,2],[2,3],[2,5],[2,2,3],[2,2,5],[2,3,5],[2,2,3,5]]

-- λ> [primeFactors x | (x,y) <- pares1 6 60]

-- [[2,3],[2,2,3],[2,3,5],[2,2,3,5]]

-- λ> [primeFactors x | (x,y) <- pares1 2 24]

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

-- Se observa que cada pare se obtiene de uno de los subconjuntos de los

-- divisores primos de b/a. Por ejemplo,

-- λ> (a,b) = (2,24)

-- λ> b `div` a

-- 12

-- λ> primeFactors it

-- [2,2,3]

-- λ> group it

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

-- λ> subsequences it

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

-- λ> map concat it

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

-- λ> map product it

-- [1,4,3,12]

-- λ> [(a * x, b `div` x) | x <- it]

-- [(2,24),(8,6),(6,8),(24,2)]

-- A partir de la observación se construye la siguiente definición

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

pares4 a b

| b `mod` a /= 0 = []

| otherwise =

[(a * x, b `div` x)

| x <- map (product . concat)

((subsequences . group . primeFactors) (b `div` a))]

-- Nota. La función pares4 calcula el mismo conjunto que las anteriores,

-- pero no necesariamente en el mismo orde. Por ejemplo,

-- λ> pares3 2 60

-- [(2,60),(4,30),(6,20),(10,12),(12,10),(20,6),(30,4),(60,2)]

-- λ> pares4 2 60

-- [(2,60),(4,30),(6,20),(12,10),(10,12),(20,6),(30,4),(60,2)]

-- λ> pares3 2 60 == sort (pares4 2 60)

-- True

-- Comparacioń de eficiencia

-- λ> length (pares3 3 (product [3,5..17]))

-- 64

-- (4.44 secs, 2,389,486,440 bytes)

-- λ> length (pares4 3 (product [3,5..17]))

-- 64

-- (0.00 secs, 177,704 bytes)

-- Propiedades de equivalencia de pares

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

prop_pares :: Integer -> Integer -> Property

prop_pares a b =

a > 0 && b > 0 ==>

all (== pares1 a b)

[sort (f a b) | f <- [ pares2

, pares3

, pares4

]]

prop_pares2 :: Integer -> Integer -> Property

prop_pares2 a b =

a > 0 && b > 0 ==>

all (== pares1 a (a * b))

[sort (f a (a * b)) | f <- [ pares2

, pares3

, pares4

]]

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=10}) prop_pares

-- +++ OK, passed 100 tests.

-- λ> quickCheckWith (stdArgs {maxSize=10}) prop_pares

-- +++ OK, passed 100 tests.

-- λ> quickCheckWith (stdArgs {maxSize=10}) prop_pares2

-- +++ OK, passed 100 tests.

-- 1ª definición de nPares

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

nPares1 :: Integer -> Integer -> Integer

nPares1 a b = genericLength (pares4 a b)

-- 2ª definición de nPares

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

nPares2 :: Integer -> Integer -> Integer

nPares2 a b = 2^(length (nub (primeFactors (b `div` a))))

-- Comparación de eficiencia

-- λ> nPares1 3 (product [3,5..91])

-- 8388608

-- (4.68 secs, 4,178,295,920 bytes)

-- λ> nPares2 3 (product [3,5..91])

-- 8388608

-- (0.00 secs, 234,688 bytes)

-- Propiedad de equivalencia de nPares

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

prop_nPares :: Integer -> Integer -> Property

prop_nPares a b =

a > 0 && b > 0 ==>

nPares1 a (a * b) == nPares2 a (a * b)

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=10}) prop_nPares

-- +++ OK, passed 100 tests.

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

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