Inicial – Página 5

Representación reducida de matrices dispersas

PorJosé A. Alonso 20-febrero-201827-febrero-2018

Una representación reducida de una matriz dispersa es una lista de listas donde cada una de las listas representa una fila de la matriz mediante listas de pares correspondientes a las snúmeros de columnas con valores no nulos de la matriz. Por ejemplo, la representacioń reducida de la matriz

   ( 0 0 4 )
   ( 0 5 0 )
   ( 0 0 0 )

( 0 0 4 )

( 0 5 0 )

( 0 0 0 )

es [[(3,4)],[(2,5)],[]].

Definir la función

   reducida :: (Num a, Eq a) => Matrix a -> [[(Int,a)]]

1	reducida :: (Num a, Eq a) => Matrix a -> [[(Int,a)]]

tal que (reducida p) es la representación reducida de la matriz p. Por ejemplo,

   reducida (fromList 3 3 [0,0,4,0,5,0,0,0,0])  ==  [[(3,4)],[(2,5)],[]]
   reducida (identity 3)  ==  [[(1,1)],[(2,1)],[(3,1)]]
   reducida (zero 9 3)    ==  [[],[],[],[],[],[],[],[],[]]
   reducida (zero 9 4)    ==  [[],[],[],[],[],[],[],[],[]]

reducida (fromList 3 3 [0,0,4,0,5,0,0,0,0]) == [[(3,4)],[(2,5)],[]]

reducida (identity 3) == [[(1,1)],[(2,1)],[(3,1)]]

reducida (zero 9 3) == [[],[],[],[],[],[],[],[],[]]

reducida (zero 9 4) == [[],[],[],[],[],[],[],[],[]]

Soluciones

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

reducida :: (Num a, Eq a) => Matrix a -> [[(Int,a)]]
reducida p =
  [[(j,x) | j <- [1..n], let x = p!(i,j), x /= 0] | i <- [1..m]] 
  where m = nrows p
        n = ncols p

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

reducida :: (Num a, Eq a) => Matrix a -> [[(Int,a)]]

reducida p =

[[(j,x) | j <- [1..n], let x = p!(i,j), x /= 0] | i <- [1..m]]

where m = nrows p

n = ncols p

Matrices dispersas

PorJosé A. Alonso 19-febrero-201826-febrero-2018

Una matriz es dispersa si la mayoriá de sus elementos son ceros. Por ejemplo, la primera de las siguientes matrices es dispersa y la segunda no lo es

   ( 0 0 4 )   ( 0 1 4 )
   ( 0 5 0 )   ( 0 5 1 )
   ( 0 0 0 )

( 0 0 4 ) ( 0 1 4 )

( 0 5 0 ) ( 0 5 1 )

( 0 0 0 )

Usando la librería Data.Matrix, las anteriores matrices se pueden definir por

   ej1, ej2 :: Matrix Int
   ej1 = fromList 3 3 [0,0,4,0,5,0,0,0,0]
   ej2 = fromList 2 3 [0,1,4,0,5,1]

ej1, ej2 :: Matrix Int

ej1 = fromList 3 3 [0,0,4,0,5,0,0,0,0]

ej2 = fromList 2 3 [0,1,4,0,5,1]

La dispersión de una matriz es el cociente entre el número de ceros de la matriz y el producto de sus números de filas y de columnas.

Definir las siguientes funciones

   dispersion :: (Num a, Eq a) => Matrix a -> Double
   esDispersa :: (Num a, Eq a) => Matrix a -> Bool

1 2	dispersion :: (Num a, Eq a) => Matrix a -> Double esDispersa :: (Num a, Eq a) => Matrix a -> Bool

tales que

(dispersion p) es la dispersión de la matriz p. Por ejemplo,

     dispersion ej1              ==  0.7777777777777778
     dispersion ej2              ==  0.3333333333333333
     dispersion (fmap (+1) ej1)  ==  0.0
     dispersion (identity 3)     ==  0.6666666666666666
     dispersion (zero 9 9)       ==  1.0

dispersion ej1 == 0.7777777777777778

dispersion ej2 == 0.3333333333333333

dispersion (fmap (+1) ej1) == 0.0

dispersion (identity 3) == 0.6666666666666666

dispersion (zero 9 9) == 1.0

(esDispersa p) se verifica si la matriz p es dispersa. Por ejemplo,

     esDispersa ej1              ==  True
     esDispersa ej2              ==  False
     esDispersa (fmap (+1) ej1)  ==  False
     esDispersa (identity 3)     ==  True
     esDispersa (zero 9 9)       ==  True

esDispersa ej1 == True

esDispersa ej2 == False

esDispersa (fmap (+1) ej1) == False

esDispersa (identity 3) == True

esDispersa (zero 9 9) == True

Soluciones

import Data.Matrix (Matrix, fromList, nrows, ncols, toList)

ej1, ej2 :: Matrix Int
ej1 = fromList 3 3 [0,0,4,0,5,0,0,0,0]
ej2 = fromList 2 3 [0,1,4,0,5,1]

dispersion :: (Num a, Eq a) => Matrix a -> Double
dispersion p =
  fi nCeros / (fi nrows * fi ncols)
  where fi f = (fromIntegral . f) p

-- (nCeros p) es el número de ceros de la matriz p. Por ejemplo,
--    nCeros ej1  ==  7
--    nCeros ej2  ==  2
nCeros :: (Num a, Eq a) => Matrix a -> Int
nCeros p = length (filter (== 0) (toList p))

-- La función anterior se puede definir sin argumentos:
nCeros2 :: (Num a, Eq a) => Matrix a -> Int
nCeros2 = length . filter (== 0) . toList

esDispersa :: (Num a, Eq a) => Matrix a -> Bool
esDispersa p = dispersion p > 0.5

-- La función anterior se puede definir sin argumentos:
esDispersa2 :: (Num a, Eq a) => Matrix a -> Bool
esDispersa2 = (> 0.5) . dispersion

import Data.Matrix (Matrix, fromList, nrows, ncols, toList)

ej1, ej2 :: Matrix Int

ej1 = fromList 3 3 [0,0,4,0,5,0,0,0,0]

ej2 = fromList 2 3 [0,1,4,0,5,1]

dispersion :: (Num a, Eq a) => Matrix a -> Double

dispersion p =

fi nCeros / (fi nrows * fi ncols)

where fi f = (fromIntegral . f) p

-- (nCeros p) es el número de ceros de la matriz p. Por ejemplo,

-- nCeros ej1 == 7

-- nCeros ej2 == 2

nCeros :: (Num a, Eq a) => Matrix a -> Int

nCeros p = length (filter (== 0) (toList p))

-- La función anterior se puede definir sin argumentos:

nCeros2 :: (Num a, Eq a) => Matrix a -> Int

nCeros2 = length . filter (== 0) . toList

esDispersa :: (Num a, Eq a) => Matrix a -> Bool

esDispersa p = dispersion p > 0.5

-- La función anterior se puede definir sin argumentos:

esDispersa2 :: (Num a, Eq a) => Matrix a -> Bool

esDispersa2 = (> 0.5) . dispersion

Números que no son cuadrados

PorJosé A. Alonso 15-febrero-201822-febrero-2018

Definir las funciones

   noCuadrados :: [Integer]
   graficaNoCuadrados :: Integer -> IO ()

1 2	noCuadrados :: [Integer] graficaNoCuadrados :: Integer -> IO ()

tales que

noCuadrados es la lista de los números naturales que no son cuadrados. Por ejemplo,

     λ> take 25 noCuadrados
     [2,3,5,6,7,8,10,11,12,13,14,15,17,18,19,20,21,22,23,24,26,27,28,29,30]

1 2	λ> take 25 noCuadrados [2,3,5,6,7,8,10,11,12,13,14,15,17,18,19,20,21,22,23,24,26,27,28,29,30]

(graficaNoCuadrados n) dibuja las diferencias entre los n primeros elementos de noCuadrados y sus posiciones. Por ejemplo, (graficaNoCuadrados 300) dibuja

(graficaNoCuadrados 3000) dibuja

(graficaNoCuadrados 30000) dibuja

Comprobar con QuickCheck que el término de noCuadrados en la posición n-1 es (n + floor(1/2 + sqrt(n))).

Soluciones

import Data.List (genericIndex)
import Graphics.Gnuplot.Simple
import Test.QuickCheck

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

noCuadrados :: [Integer]
noCuadrados = aux [0..] cuadrados
  where aux xs (y:ys) = as ++ aux bs ys
          where (as,_:bs) = span (<y) xs

cuadrados :: [Integer]
cuadrados = [x^2 | x <- [0..]]

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

noCuadrados2 :: [Integer]
noCuadrados2 = aux 2 [1..]
  where aux n (_:xs) = ys ++ aux (n+2) zs
          where (ys,zs) = splitAt n xs

-- Definición de graficaNoCuadrados
-- ================================

graficaNoCuadrados :: Integer -> IO ()
graficaNoCuadrados n =
  plotList [ Key Nothing
           , PNG ("Numeros_que_no_son_cuadrados_" ++ show n ++ ".png")
           ]
           (zipWith (-) noCuadrados [0..n-1])

-- La propiedad es
prop_noCuadrados :: Positive Integer -> Bool
prop_noCuadrados (Positive n) =
  noCuadrados `genericIndex` (n-1) ==
  n + floor (1/2 + sqrt (fromIntegral n))

-- La comprobación es
--    λ> quickCheck prop_noCuadrados
--    +++ OK, passed 100 tests.

import Data.List (genericIndex)

import Graphics.Gnuplot.Simple

import Test.QuickCheck

-- 1ª definición

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

noCuadrados :: [Integer]

noCuadrados = aux [0..] cuadrados

where aux xs (y:ys) = as ++ aux bs ys

where (as,_:bs) = span (<y) xs

cuadrados :: [Integer]

cuadrados = [x^2 | x <- [0..]]

-- 2ª definición

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

noCuadrados2 :: [Integer]

noCuadrados2 = aux 2 [1..]

where aux n (_:xs) = ys ++ aux (n+2) zs

where (ys,zs) = splitAt n xs

-- Definición de graficaNoCuadrados

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

graficaNoCuadrados :: Integer -> IO ()

graficaNoCuadrados n =

plotList [ Key Nothing

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

]

(zipWith (-) noCuadrados [0..n-1])

-- La propiedad es

prop_noCuadrados :: Positive Integer -> Bool

prop_noCuadrados (Positive n) =

noCuadrados `genericIndex` (n-1) ==

n + floor (1/2 + sqrt (fromIntegral n))

-- La comprobación es

-- λ> quickCheck prop_noCuadrados

-- +++ OK, passed 100 tests.

Árboles binarios completos

PorJosé A. Alonso 14-febrero-201821-febrero-2018

Un árbol binario completo es un árbol en el que cada nodo tiene cero o dos hijos. Por ejemplo, el primero de los siguientes árboles es un árbol binario completo pero los otros no lo son

           1              1            1    
         /   \          /   \        / | \ 
        2     3        2     3      2  7  3
       / \            /            / \      
      4   5          4            4   5

1 1 1

/ \ / \ / | \

2 3 2 3 2 7 3

/ \ / / \

4 5 4 4 5

Los árboles se pueden representar mediante el siguiente tipo de datos

   data Arbol a = N a [Arbol a]
     deriving Show

1 2	data Arbol a = N a [Arbol a] deriving Show

Por ejemplo, los árboles los árboles anteriores se puede representar por

   ej1, ej2, ej3 :: Arbol Int
   ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 []]
   ej2 = N 1 [N 2 [N 4 []], N 3 []]
   ej3 = N 1 [N 2 [N 4 [], N 5 []], N 7 [], N 3 []]

ej1, ej2, ej3 :: Arbol Int

ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 []]

ej2 = N 1 [N 2 [N 4 []], N 3 []]

ej3 = N 1 [N 2 [N 4 [], N 5 []], N 7 [], N 3 []]

Definir la función

   esBinarioCompleto :: Arbol t -> Bool

1	esBinarioCompleto :: Arbol t -> Bool

tal que (esBinarioCompleto a) se verifica si a es un árbol binario completo. Por ejemplo,

   esBinarioCompleto ej1  ==  True
   esBinarioCompleto ej2  ==  False
   esBinarioCompleto ej3  ==  False

esBinarioCompleto ej1 == True

esBinarioCompleto ej2 == False

esBinarioCompleto ej3 == False

Soluciones

data Arbol a = N a [Arbol a]
  deriving Show

ej1, ej2, ej3 :: Arbol Int
ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 []]
ej2 = N 1 [N 2 [N 4 []], N 3 []]
ej3 = N 1 [N 2 [N 4 [], N 5 []], N 7 [], N 3 []]
          
esBinarioCompleto :: Arbol t -> Bool
esBinarioCompleto (N _ []) = True
esBinarioCompleto (N x as) = length as `elem` [0,2] 
                             && all esBinarioCompleto as

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2, ej3 :: Arbol Int

ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 []]

ej2 = N 1 [N 2 [N 4 []], N 3 []]

ej3 = N 1 [N 2 [N 4 [], N 5 []], N 7 [], N 3 []]

esBinarioCompleto :: Arbol t -> Bool

esBinarioCompleto (N _ []) = True

esBinarioCompleto (N x as) = length as `elem` [0,2]

&& all esBinarioCompleto as

Números trimórficos

PorJosé A. Alonso 12-febrero-201819-febrero-2018

Un número trimórfico es un número cuyo cubo termina en dicho número. Por ejemplo, 24 es trimórfico ya que 24^3 = 13824 termina en 24.

Para cada entero positivo n, la densidad de trimórficos hasta n es el cociente entre la cantidad de números trimórficos menores o iguales que n y el número n. Por ejemplo, hasta 10 hay 6 números trimórficos (0, 1, 4, 5, 6 y 9); por tanto, la densidad hasta 10 es 6/10 = 0.6.

Definir las funciones

   trimorficos         :: [Integer]
   densidadTrimorficos :: Integer -> Double

1 2	trimorficos :: [Integer] densidadTrimorficos :: Integer -> Double

tal que

trimorficos es la lista de los números trimórficos. Por ejemplo,

     λ> take 20 trimorficos
     [0,1,4,5,6,9,24,25,49,51,75,76,99,125,249,251,375,376,499,501]

1 2	λ> take 20 trimorficos [0,1,4,5,6,9,24,25,49,51,75,76,99,125,249,251,375,376,499,501]

(densidadTrimorficos n) es la densidad de trimórficos hasta n. Por ejemplo,

     densidadTrimorficos 10      ==  0.6
     densidadTrimorficos 100     ==  0.13
     densidadTrimorficos 1000    ==  2.6e-2
     densidadTrimorficos 10000   ==  3.7e-3
     densidadTrimorficos 100000  ==  4.8e-4

densidadTrimorficos 10 == 0.6

densidadTrimorficos 100 == 0.13

densidadTrimorficos 1000 == 2.6e-2

densidadTrimorficos 10000 == 3.7e-3

densidadTrimorficos 100000 == 4.8e-4

Soluciones

import Data.List (genericLength, isPrefixOf)

trimorficos :: [Integer]
trimorficos = filter esTrimorfico [0..]

-- (esTrimorfico n) se verifica si n es trimórfico. Por ejemplo,
--    esTrimorfico 24  ==  True
esTrimorfico :: Integer -> Bool
esTrimorfico n =
  reverse (show n) `isPrefixOf` reverse (show (n^3)) 

densidadTrimorficos :: Integer -> Double
densidadTrimorficos n =
  genericLength [x | x <- [0..n-1], esTrimorfico x] / fromIntegral n

import Data.List (genericLength, isPrefixOf)

trimorficos :: [Integer]

trimorficos = filter esTrimorfico [0..]

-- (esTrimorfico n) se verifica si n es trimórfico. Por ejemplo,

-- esTrimorfico 24 == True

esTrimorfico :: Integer -> Bool

esTrimorfico n =

reverse (show n) `isPrefixOf` reverse (show (n^3))

densidadTrimorficos :: Integer -> Double

densidadTrimorficos n =

genericLength [x | x <- [0..n-1], esTrimorfico x] / fromIntegral n

Huecos binarios

PorJosé A. Alonso 7-febrero-201814-febrero-2018

Los huecos binarios de un número natural n son las listas de cer0 entre dos unos en la representación binaria de n. Por ejemplo, puesto que la representación binaria de 20 es 10100 tiene dos huecos binarios de longitudes 1 y 2. La longitud del mayor hueco binario de 529 es 4 ya que la representación binaria de 529 es 1000010001.

Definir las funciones

   longMayorHuecoBinario        :: Int -> Int
   graficaLongMayorHuecoBinario :: Int -> IO ()

1 2	longMayorHuecoBinario :: Int -> Int graficaLongMayorHuecoBinario :: Int -> IO ()

tales que

(longMayorHuecoBinario n) es la longitud del mayor hueco binario de n. Por ejemplo,

     longMayorHuecoBinario 20    ==  2
     longMayorHuecoBinario 529   ==  4
     longMayorHuecoBinario 2018  ==  3

longMayorHuecoBinario 20 == 2

longMayorHuecoBinario 529 == 4

longMayorHuecoBinario 2018 == 3

(graficaLongMayorHuecoBinario n) dibuja la gráfica de las longitudes de los mayores huecos binarios de los n primeros números naturales. Por ejemplo, (graficaLongMayorHuecoBinario 200) dibuja

Soluciones

import Data.List (group)
import Graphics.Gnuplot.Simple

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

longMayorHuecoBinario :: Int -> Int
longMayorHuecoBinario n =
  maximum (0 : map length (huecosBinarios (decimalAbinario n)))

-- (decimalAbinario x) es la representación binaria del número c. Por
-- ejemplo, 
--    decimalAbinario 20   ==  [0,0,1,0,1]
--    decimalAbinario 529  ==  [1,0,0,0,1,0,0,0,0,1] 
decimalAbinario :: Int -> [Int]
decimalAbinario x
  | x < 2     = [x]
  | otherwise = x `mod` 2 : decimalAbinario (x `div` 2)

-- (huecosBinarios xs) es la lista de los ceros consecutivos de xs entre
-- dos elementos distintos de cero. Por ejemplo,
--    huecosBinarios [0,0,1,0,1]            ==  [[0,0],[0]]
--    huecosBinarios [1,0,0,0,1,0,0,0,0,1]  ==  [[0,0,0],[0,0,0,0]]
huecosBinarios :: [Int] -> [[Int]]
huecosBinarios xs =
  [ys | ys <- group xs, 0 `elem` ys]

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

longMayorHuecoBinario2 :: Int -> Int
longMayorHuecoBinario2 =
  maximum . (0 :) . map length . huecosBinarios . decimalAbinario

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

longMayorHuecoBinario3 :: Int -> Int
longMayorHuecoBinario3 = maximum . longHuecosBinarios

-- (longHuecosBinarios n) es la lista de las longitudes de los huecos
-- binarios de n. Por ejemplo,
--    longHuecosBinarios 20  ==  [2,1,0]
--    longHuecosBinarios 529  ==  [3,4,0]
longHuecosBinarios :: Int -> [Int]
longHuecosBinarios 1 = [0]
longHuecosBinarios n | mod n 2 == 1 = longHuecosBinarios (div n 2)
                     | mod n 4 == 2 = 1 : h : t
                     | otherwise = 1 + h : t
  where (h : t) = longHuecosBinarios (div n 2)

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

--    λ> maximum [longMayorHuecoBinario x | x <- [1..100000]]
--    16
--    (5.51 secs, 941,090,272 bytes)
--    λ> maximum [longMayorHuecoBinario2 x | x <- [1..100000]]
--    16
--    (5.54 secs, 933,093,168 bytes)
--    λ> maximum [longMayorHuecoBinario3 x | x <- [1..100000]]
--    16
--    (6.00 secs, 966,584,848 bytes)

graficaLongMayorHuecoBinario :: Int -> IO ()
graficaLongMayorHuecoBinario n =
  plotList [ Key Nothing
           , Title ("graficaLongMayorHuecoBinario " ++ show n)
           , PNG ("Huecos_binarios_" ++ show n ++ ".png")
           ]
           [longMayorHuecoBinario k | k <- [0..n-1]]

import Data.List (group)

import Graphics.Gnuplot.Simple

-- 1ª solución

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

longMayorHuecoBinario :: Int -> Int

longMayorHuecoBinario n =

maximum (0 : map length (huecosBinarios (decimalAbinario n)))

-- (decimalAbinario x) es la representación binaria del número c. Por

-- ejemplo,

-- decimalAbinario 20 == [0,0,1,0,1]

-- decimalAbinario 529 == [1,0,0,0,1,0,0,0,0,1]

decimalAbinario :: Int -> [Int]

decimalAbinario x

| x < 2 = [x]

| otherwise = x `mod` 2 : decimalAbinario (x `div` 2)

-- (huecosBinarios xs) es la lista de los ceros consecutivos de xs entre

-- dos elementos distintos de cero. Por ejemplo,

-- huecosBinarios [0,0,1,0,1] == [[0,0],[0]]

-- huecosBinarios [1,0,0,0,1,0,0,0,0,1] == [[0,0,0],[0,0,0,0]]

huecosBinarios :: [Int] -> [[Int]]

huecosBinarios xs =

[ys | ys <- group xs, 0 `elem` ys]

-- 2ª solución

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

longMayorHuecoBinario2 :: Int -> Int

longMayorHuecoBinario2 =

maximum . (0 :) . map length . huecosBinarios . decimalAbinario

-- 3ª solución

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

longMayorHuecoBinario3 :: Int -> Int

longMayorHuecoBinario3 = maximum . longHuecosBinarios

-- (longHuecosBinarios n) es la lista de las longitudes de los huecos

-- binarios de n. Por ejemplo,

-- longHuecosBinarios 20 == [2,1,0]

-- longHuecosBinarios 529 == [3,4,0]

longHuecosBinarios :: Int -> [Int]

longHuecosBinarios 1 = [0]

longHuecosBinarios n | mod n 2 == 1 = longHuecosBinarios (div n 2)

| mod n 4 == 2 = 1 : h : t

| otherwise = 1 + h : t

where (h : t) = longHuecosBinarios (div n 2)

-- Comparación de eficiencia

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

-- λ> maximum [longMayorHuecoBinario x | x <- [1..100000]]

-- 16

-- (5.51 secs, 941,090,272 bytes)

-- λ> maximum [longMayorHuecoBinario2 x | x <- [1..100000]]

-- 16

-- (5.54 secs, 933,093,168 bytes)

-- λ> maximum [longMayorHuecoBinario3 x | x <- [1..100000]]

-- 16

-- (6.00 secs, 966,584,848 bytes)

graficaLongMayorHuecoBinario :: Int -> IO ()

graficaLongMayorHuecoBinario n =

plotList [ Key Nothing

, Title ("graficaLongMayorHuecoBinario " ++ show n)

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

]

[longMayorHuecoBinario k | k <- [0..n-1]]

Celdas interiores de una retícula

PorJosé A. Alonso 5-febrero-201812-febrero-2018

Las celdas de una retícula cuadrada se numeran consecutivamente. Por ejemplo, la numeración de la retícula cuadrada de lado 4 es

   1, 2, 3, 4
   5, 6, 7, 8
   9,10,11,12
  13,14,15,16

1, 2, 3, 4

5, 6, 7, 8

9,10,11,12

13,14,15,16

Los números de sus celdas interiores son 6,7,10,11.

Definir la función

   interiores :: Int -> [Int]

1	interiores :: Int -> [Int]

tal que (interiores n) es la lista de los números de las celdas interiores de la retícula cuadrada de lado n. Por ejemplo,

   interiores 4  == [6,7,10,11]
   interiores 5  == [7,8,9,12,13,14,17,18,19]
   interiores 6  == [8,9,10,11,14,15,16,17,20,21,22,23,26,27,28,29]
   interiores 2  == []
   length (interiores 2018)  == 4064256

interiores 4 == [6,7,10,11]

interiores 5 == [7,8,9,12,13,14,17,18,19]

interiores 6 == [8,9,10,11,14,15,16,17,20,21,22,23,26,27,28,29]

interiores 2 == []

length (interiores 2018) == 4064256

Comprobar con QuickCheck que el número de celdas interiores de la retícula cuadrada de lado n, con n > 1, es (n-2)^2.

Soluciones

import Test.QuickCheck
import Data.List.Split (divvy)

-- 1ª solución
interiores :: Int -> [Int]
interiores n = [i | i <- [n..n*n-n], i `mod` n > 1]

-- 2ª solución
interiores2 :: Int -> [Int]
interiores2 n = aux [n+1..n^2-n]
  where aux xss@(x:xs) = take (n-2) xs ++ aux (drop n xss)
        aux []         = []

-- 3ª solución 
interiores3 :: Int -> [Int]
interiores3 n = concat (divvy (n-2) n [n+2..n*(n-1)-1])

-- 4ª solución
interiores4 :: Int -> [Int]
interiores4 n = concat [map (+(n*k)) [2..n-1] | k <- [1..n-2]]

-- 5ª solución
interiores5 :: Int -> [Int]
interiores5 n = concat (take (n-2) (iterate (map (+n)) [n+2..2*n-1]))

-- La propiedad es
prop_interiores :: Int -> Property
prop_interiores n =
  n > 1 ==> length (interiores n) == (n-2)^2

-- La comprobación es
--    λ> quickCheck prop_interiores
--    +++ OK, passed 100 tests.

import Test.QuickCheck

import Data.List.Split (divvy)

-- 1ª solución

interiores :: Int -> [Int]

interiores n = [i | i <- [n..n*n-n], i `mod` n > 1]

-- 2ª solución

interiores2 :: Int -> [Int]

interiores2 n = aux [n+1..n^2-n]

where aux xss@(x:xs) = take (n-2) xs ++ aux (drop n xss)

aux [] = []

-- 3ª solución

interiores3 :: Int -> [Int]

interiores3 n = concat (divvy (n-2) n [n+2..n*(n-1)-1])

-- 4ª solución

interiores4 :: Int -> [Int]

interiores4 n = concat [map (+(n*k)) [2..n-1] | k <- [1..n-2]]

-- 5ª solución

interiores5 :: Int -> [Int]

interiores5 n = concat (take (n-2) (iterate (map (+n)) [n+2..2*n-1]))

-- La propiedad es

prop_interiores :: Int -> Property

prop_interiores n =

n > 1 ==> length (interiores n) == (n-2)^2

-- La comprobación es

-- λ> quickCheck prop_interiores

-- +++ OK, passed 100 tests.

Dígitos iniciales

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

Definir las funciones

   digitosIniciales        :: [Int]
   graficaDigitosIniciales :: Int -> IO ()

1 2	digitosIniciales :: [Int] graficaDigitosIniciales :: Int -> IO ()

tales que

digitosIniciales es la lista de los dígitos iniciales de los números naturales. Por ejemplo,

     λ> take 100 digitosIniciales
     [0,1,2,3,4,5,6,7,8,9,1,1,1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,
      3,3,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,
      6,6,6,6,6,6,6,6,6,6,7,7,7,7,7,7,7,7,7,7,8,8,8,8,8,8,8,8,8,8,
      9,9,9,9,9,9,9,9,9,9]

λ> take 100 digitosIniciales

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

3,3,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,

6,6,6,6,6,6,6,6,6,6,7,7,7,7,7,7,7,7,7,7,8,8,8,8,8,8,8,8,8,8,

9,9,9,9,9,9,9,9,9,9]

(graficaDigitosIniciales n) dibuja la gráfica de los primeros n términos de la sucesión digitosIniciales. Por ejemplo, (graficaDigitosIniciales 100) dibuja

y (graficaDigitosIniciales 1000) dibuja

Soluciones

import Graphics.Gnuplot.Simple

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

digitosIniciales :: [Int]
digitosIniciales = map digitoInicial [0..]

digitoInicial :: Integer -> Int
digitoInicial n = read [head (show n)]

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

digitosIniciales2 :: [Int]
digitosIniciales2 = map (read . return . head . show) [0..]

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

digitosIniciales3 :: [Int]
digitosIniciales3 = map digitoInicial3 [0..]

digitoInicial3 :: Integer -> Int
digitoInicial3 = fromInteger . until (< 10) (`div` 10)

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

digitosIniciales4 :: [Int]
digitosIniciales4 = map (fromInteger . until (< 10) (`div` 10)) [0..]

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

digitosIniciales5 :: [Int]
digitosIniciales5 =
  0 : concat [replicate k x | k <- [10^n | n <- [0..]]
                            , x <- [1..9]]

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

--    λ> digitosIniciales !! (2*10^6)
--    2
--    (0.46 secs, 320,145,984 bytes)
--    λ> digitosIniciales2 !! (2*10^6)
--    2
--    (0.46 secs, 320,143,288 bytes)
--    λ> digitosIniciales3 !! (2*10^6)
--    2
--    (0.17 secs, 320,139,216 bytes)
--    λ> digitosIniciales4 !! (2*10^6)
--    2
--    (0.55 secs, 320,139,248 bytes)
--    λ> digitosIniciales5 !! (2*10^6)
--    2
--    (0.12 secs, 224,158,992 bytes)

graficaDigitosIniciales :: Int -> IO ()
graficaDigitosIniciales n =
  plotList [ Key Nothing
           , Title ("graficaDigitosIniciales " ++ show n)
           , PNG ("Digitos_iniciales_" ++ show n ++ ".png" )
           ]
           (take n digitosIniciales)

import Graphics.Gnuplot.Simple

-- 1ª definición

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

digitosIniciales :: [Int]

digitosIniciales = map digitoInicial [0..]

digitoInicial :: Integer -> Int

digitoInicial n = read [head (show n)]

-- 2ª definición

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

digitosIniciales2 :: [Int]

digitosIniciales2 = map (read . return . head . show) [0..]

-- 3ª definición

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

digitosIniciales3 :: [Int]

digitosIniciales3 = map digitoInicial3 [0..]

digitoInicial3 :: Integer -> Int

digitoInicial3 = fromInteger . until (< 10) (`div` 10)

-- 4ª definición

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

digitosIniciales4 :: [Int]

digitosIniciales4 = map (fromInteger . until (< 10) (`div` 10)) [0..]

-- 5ª definición

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

digitosIniciales5 :: [Int]

digitosIniciales5 =

0 : concat [replicate k x | k <- [10^n | n <- [0..]]

, x <- [1..9]]

-- Comparación de eficiencia

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

-- λ> digitosIniciales !! (2*10^6)

-- 2

-- (0.46 secs, 320,145,984 bytes)

-- λ> digitosIniciales2 !! (2*10^6)

-- 2

-- (0.46 secs, 320,143,288 bytes)

-- λ> digitosIniciales3 !! (2*10^6)

-- 2

-- (0.17 secs, 320,139,216 bytes)

-- λ> digitosIniciales4 !! (2*10^6)

-- 2

-- (0.55 secs, 320,139,248 bytes)

-- λ> digitosIniciales5 !! (2*10^6)

-- 2

-- (0.12 secs, 224,158,992 bytes)

graficaDigitosIniciales :: Int -> IO ()

graficaDigitosIniciales n =

plotList [ Key Nothing

, Title ("graficaDigitosIniciales " ++ show n)

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

]

(take n digitosIniciales)

Recorrido del robot

PorJosé A. Alonso 31-enero-20187-febrero-2018

Los puntos de una retícula se representan mediante pares de enteros

   type Punto = (Int,Int)

1	type Punto = (Int,Int)

y los movimientos de un robot mediante el tipo

   data Movimiento = N Int
                   | S Int
                   | E Int
                   | O Int

data Movimiento = N Int

| S Int

| E Int

| O Int

donde (N x) significa que se mueve x unidades en la dirección norte y análogamente para las restantes direcciones (S es sur, E es este y O es oeste).

Definir la función

   posicion :: [Movimiento] -> Punto

1	posicion :: [Movimiento] -> Punto

tal que (posicion ms) es la posición final de un robot que inicialmente está en el el punto (0,0) y realiza los movimientos ms. Por ejemplo,

   posicion [N 3]                           ==  (0,3)
   posicion [N 3, E 5]                      ==  (5,3)
   posicion [N 3, E 5, S 1]                 ==  (5,2)
   posicion [N 3, E 5, S 1, O 4]            ==  (1,2)
   posicion [N 3, E 5, S 1, O 4, N 3]       ==  (1,5)
   posicion [N 3, E 5, S 1, O 4, N 3, S 3]  ==  (1,2)

posicion [N 3] == (0,3)

posicion [N 3, E 5] == (5,3)

posicion [N 3, E 5, S 1] == (5,2)

posicion [N 3, E 5, S 1, O 4] == (1,2)

posicion [N 3, E 5, S 1, O 4, N 3] == (1,5)

posicion [N 3, E 5, S 1, O 4, N 3, S 3] == (1,2)

Soluciones

type Punto = (Int,Int)

data Movimiento = N Int
                | S Int
                | E Int
                | O Int

-- 1ª solución                
posicion :: [Movimiento] -> Punto
posicion ms = aux ms (0,0)
  where aux [] p = p
        aux (N x:ms) (a,b) = aux ms (a,b+x)
        aux (S x:ms) (a,b) = aux ms (a,b-x)
        aux (E x:ms) (a,b) = aux ms (a+x,b)
        aux (O x:ms) (a,b) = aux ms (a-x,b)

-- 2ª solución
posicion2 :: [Movimiento] -> Punto
posicion2 []       = (0,0)
posicion2 (N x:ms) = suma (0 ,x)  (posicion2 ms)
posicion2 (S x:ms) = suma (0 ,-x) (posicion2 ms)
posicion2 (E x:ms) = suma (x ,0)  (posicion2 ms)
posicion2 (O x:ms) = suma (-x,0)  (posicion2 ms)

suma :: Punto -> Punto -> Punto
suma (x,y) (a,b) = (x+a,y+b)

-- 3ª solución
posicion3 :: [Movimiento] -> Punto
posicion3 []     = (0,0)
posicion3 (m:ms) = case m of
                     N x -> (a,b+x)
                     S x -> (a,b-x)
                     E x -> (a+x,b)
                     O x -> (a-x,b)
  where (a,b) = posicion3 ms

-- 4ª solución
posicion4 :: [Movimiento] -> Punto
posicion4 = foldl aux (0,0)
  where
    aux (x,y) (N j) = (x,y+j)
    aux (x,y) (S j) = (x,y-j)
    aux (x,y) (E i) = (x+i,y)
    aux (x,y) (O i) = (x-i,y)

--- 5ª solución
posicion5 :: [Movimiento] -> Punto
posicion5 xs = (sum hs, sum vs)
  where
    (hs,vs)   = unzip (map aux xs)
    aux (N j) = (0,j)
    aux (S j) = (0,-j)
    aux (E i) = (i,0)
    aux (O i) = (-i,0)

type Punto = (Int,Int)

data Movimiento = N Int

| S Int

| E Int

| O Int

-- 1ª solución

posicion :: [Movimiento] -> Punto

posicion ms = aux ms (0,0)

where aux [] p = p

aux (N x:ms) (a,b) = aux ms (a,b+x)

aux (S x:ms) (a,b) = aux ms (a,b-x)

aux (E x:ms) (a,b) = aux ms (a+x,b)

aux (O x:ms) (a,b) = aux ms (a-x,b)

-- 2ª solución

posicion2 :: [Movimiento] -> Punto

posicion2 [] = (0,0)

posicion2 (N x:ms) = suma (0 ,x) (posicion2 ms)

posicion2 (S x:ms) = suma (0 ,-x) (posicion2 ms)

posicion2 (E x:ms) = suma (x ,0) (posicion2 ms)

posicion2 (O x:ms) = suma (-x,0) (posicion2 ms)

suma :: Punto -> Punto -> Punto

suma (x,y) (a,b) = (x+a,y+b)

-- 3ª solución

posicion3 :: [Movimiento] -> Punto

posicion3 [] = (0,0)

posicion3 (m:ms) = case m of

N x -> (a,b+x)

S x -> (a,b-x)

E x -> (a+x,b)

O x -> (a-x,b)

where (a,b) = posicion3 ms

-- 4ª solución

posicion4 :: [Movimiento] -> Punto

posicion4 = foldl aux (0,0)

where

aux (x,y) (N j) = (x,y+j)

aux (x,y) (S j) = (x,y-j)

aux (x,y) (E i) = (x+i,y)

aux (x,y) (O i) = (x-i,y)

--- 5ª solución

posicion5 :: [Movimiento] -> Punto

posicion5 xs = (sum hs, sum vs)

where

(hs,vs) = unzip (map aux xs)

aux (N j) = (0,j)

aux (S j) = (0,-j)

aux (E i) = (i,0)

aux (O i) = (-i,0)

Máxima distancia en árbol

PorJosé A. Alonso 29-enero-20185-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

         10
        /  \
       /    \
      8      1
     / \    / \
    3   9  2   6

/ \

8 1

/ \ / \

3 9 2 6

se puede representar por

   ejArbol :: Arbol Int
   ejArbol = N 10 (N 8 (H 3) (H 9))
                  (N 1 (H 2) (H 6))

ejArbol :: Arbol Int

ejArbol = N 10 (N 8 (H 3) (H 9))

(N 1 (H 2) (H 6))

La distancia entre un padre y un hijo en el árbol es el valor absoluto de la diferencia de sus valores. Por ejemplo, la distancia de 10 a 8 es 2 y de 1 a 6 es 5.

Definir la función

   maximaDistancia :: (Num a, Ord a) => Arbol a -> a

1	maximaDistancia :: (Num a, Ord a) => Arbol a -> a

tal que (maximaDistancia a) es la máxima distancia entre un padre y un hijo del árbol a. Por ejemplo,

   maximaDistancia ejArbol                                     ==  9
   maximaDistancia (N 1 (N 8 (H 3) (H 9)) (N 1  (H 2) (H 6)))  ==  7
   maximaDistancia (N 8 (N 8 (H 3) (H 9)) (N 10 (H 2) (H 6)))  ==  8

maximaDistancia ejArbol == 9

maximaDistancia (N 1 (N 8 (H 3) (H 9)) (N 1 (H 2) (H 6))) == 7

maximaDistancia (N 8 (N 8 (H 3) (H 9)) (N 10 (H 2) (H 6))) == 8

Soluciones

[schedule expon=’2018-02-05′ expat=»06:00″]

Las soluciones se pueden escribir en los comentarios hasta el 05 de febrero.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

[/schedule]

[schedule on=’2018-02-05′ at=»06:00″]

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

ejArbol :: Arbol Int
ejArbol = N 10 (N 8 (H 3) (H 9))
               (N 1 (H 2) (H 6))


maximaDistancia :: (Num a, Ord a) => Arbol a -> a
maximaDistancia (H _)     = 0
maximaDistancia (N x i d) = maximum [abs (x - raiz i)
                                    , maximaDistancia i
                                    , abs (x - raiz d)
                                    , maximaDistancia d]
                             
raiz :: Arbol a -> a
raiz (H x)     = x
raiz (N x _ _) = x

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving Show

ejArbol :: Arbol Int

ejArbol = N 10 (N 8 (H 3) (H 9))

(N 1 (H 2) (H 6))

maximaDistancia :: (Num a, Ord a) => Arbol a -> a

maximaDistancia (H _) = 0

maximaDistancia (N x i d) = maximum [abs (x - raiz i)

, maximaDistancia i

, abs (x - raiz d)

, maximaDistancia d]

raiz :: Arbol a -> a

raiz (H x) = x

raiz (N x _ _) = x

[/schedule]

Relación definida por un árbol

PorJosé A. Alonso 26-enero-20182-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

         10
        /  \
       /    \
      8      2
     / \    / \
    3   5  2   0

/ \

8 2

/ \ / \

3 5 2 0

se pueden representar por

   ejArbol :: Arbol Int
   ejArbol = N 10 (N 8 (H 3) (H 5))
                  (N 2 (H 2) (H 0))

ejArbol :: Arbol Int

ejArbol = N 10 (N 8 (H 3) (H 5))

(N 2 (H 2) (H 0))

Un árbol binario define una relación binaria donde un elemento x está relacionado con y si x es el padre de y. Por ejemplo, la relación definida por el árbol anterior es [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)].

Definir la función

   relacionDelArbol :: Arbol a -> [(a,a)]

1	relacionDelArbol :: Arbol a -> [(a,a)]

tal que (relacionDelArbol a) es la relación binaria definida por el árbol a. Por ejemplo,

   λ> relacionDelArbol ejArbol
   [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)]
   λ> relacionDelArbol (N 10 (H 8) (N 2 (H 2) (H 0)))
   [(10,8),(10,2),(2,2),(2,0)]
   λ> relacionDelArbol (N 10 (N 8 (H 3) (H 5)) (H 2))
   [(10,8),(8,3),(8,5),(10,2)]
   λ> relacionDelArbol (H 10)
   []

λ> relacionDelArbol ejArbol

[(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)]

λ> relacionDelArbol (N 10 (H 8) (N 2 (H 2) (H 0)))

[(10,8),(10,2),(2,2),(2,0)]

λ> relacionDelArbol (N 10 (N 8 (H 3) (H 5)) (H 2))

[(10,8),(8,3),(8,5),(10,2)]

λ> relacionDelArbol (H 10)

[]

Soluciones

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

ejArbol :: Arbol Int
ejArbol = N 10 (N 8 (H 3) (H 5))
               (N 2 (H 2) (H 0))

relacionDelArbol :: Arbol a -> [(a,a)]
relacionDelArbol (H _)     = []
relacionDelArbol (N x i d) = ((x,raiz i) : relacionDelArbol i) ++ 
                             ((x,raiz d) : relacionDelArbol d)
                             
raiz :: Arbol a -> a
raiz (H x)     = x
raiz (N x _ _) = x

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving Show

ejArbol :: Arbol Int

ejArbol = N 10 (N 8 (H 3) (H 5))

(N 2 (H 2) (H 0))

relacionDelArbol :: Arbol a -> [(a,a)]

relacionDelArbol (H _) = []

relacionDelArbol (N x i d) = ((x,raiz i) : relacionDelArbol i) ++

((x,raiz d) : relacionDelArbol d)

raiz :: Arbol a -> a

raiz (H x) = x

raiz (N x _ _) = x

Sucesión de Lichtenberg

PorJosé A. Alonso 25-enero-20181-febrero-2018

La sucesión de Lichtenberg esta formada por la representación decimal de los números binarios de la sucesión de dígitos 0 y 1 alternados Los primeros términos de ambas sucesiones son

   Alternada ..... Lichtenberg
   0 ....................... 0
   1 ....................... 1
   10 ...................... 2
   101 ..................... 5
   1010 ................... 10
   10101 .................. 21
   101010 ................. 42
   1010101 ................ 85
   10101010 .............. 170
   101010101 ............. 341
   1010101010 ............ 682
   10101010101 .......... 1365
   101010101010 ......... 2730

Alternada ..... Lichtenberg

0 ....................... 0

1 ....................... 1

10 ...................... 2

101 ..................... 5

1010 ................... 10

10101 .................. 21

101010 ................. 42

1010101 ................ 85

10101010 .............. 170

101010101 ............. 341

1010101010 ............ 682

10101010101 .......... 1365

101010101010 ......... 2730

Definir las funciones

   lichtenberg        :: [Integer]
   graficaLichtenberg :: Int -> IO ()

1 2	lichtenberg :: [Integer] graficaLichtenberg :: Int -> IO ()

tales que

lichtenberg es la lista cuyos elementos son los términos de la sucesión de Lichtenberg. Por ejemplo,

     λ> take 17 lichtenberg
     [0,1,2,5,10,21,42,85,170,341,682,1365,2730,5461,10922,21845,43690]

1 2	λ> take 17 lichtenberg [0,1,2,5,10,21,42,85,170,341,682,1365,2730,5461,10922,21845,43690]

(graficaLichtenberg n) dibuja la gráfica del número de dígitos de los n primeros términos de la sucesión de Lichtenberg. Por ejemlo, (graficaLichtenberg 100) dibuja

Comprobar con QuickCheck que todos los términos de la sucesión de Lichtenberg, a partir del 4º, son números compuestos.

Soluciones

import Data.Char (digitToInt)
import Graphics.Gnuplot.Simple
import Test.QuickCheck
import Data.Numbers.Primes (isPrime)

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

lichtenberg1 :: [Integer]
lichtenberg1 = map binarioAdecimal sucAlternada

-- sucAlternada es la lista cuyos elementos son los términos de la
-- sucesión de los dígitos 0 y 1 alternados. Por ejemplo,
--    λ> take 7 sucAlternada
--    ["0","1","10","101","1010","10101","101010"]
sucAlternada :: [String]
sucAlternada =
  ['0'] : [take n cadenaAlternada | n <- [1..]]

-- cadenaAltenada es la cadena formada alternando los caracteres 1 y
-- 0. Por ejemplo,
--    take 20 cadenaAlternada  ==  "10101010101010101010"
cadenaAlternada :: String
cadenaAlternada = cycle ['1','0']

-- (binarioAdecimal cs) es el número decimal correspondiente al número
-- binario cuya cadena de dígitos es cs. Por ejemplo,
--    binarioAdecimal "11101"  ==  29
binarioAdecimal :: String -> Integer
binarioAdecimal =
  foldl (\acc x -> acc * 2 + (toInteger . digitToInt) x) 0
  
-- 2ª solución
lichtenberg2 :: [Integer]
lichtenberg2 = map a [0..]
  where a 0 = 0
        a 1 = 1
        a n = a (n-1) + 2 * a (n-2) + 1

-- 3ª solución
lichtenberg3 :: [Integer]
lichtenberg3 =
  0 : 1 : map (+1) (zipWith (+) (tail lichtenberg3) (map (*2) lichtenberg3)) 

-- Comprobación de eficiencia
--    λ> length (show (lichtenberg1 !! 27))
--    8
--    (0.02 secs, 155,384 bytes)
--    λ> length (show (lichtenberg2 !! 27))
--    8
--    (2.22 secs, 311,157,760 bytes)
--    
--    λ> length (show (lichtenberg1 !! (8*10^4)))
--    24083
--    (1.28 secs, 664,207,040 bytes)
--    λ> length (show (lichtenberg3 !! (8*10^4)))
--    24083
--    (2.59 secs, 1,253,328,200 bytes)

-- La propiedad es
propLichtenberg :: Int -> Property
propLichtenberg n =
  n > 4 ==> not (isPrime (lichtenberg1 !! n))

-- La comprobación es
--    λ> quickCheck propLichtenberg
--    +++ OK, passed 100 tests.

graficaLichtenberg :: Int -> IO ()
graficaLichtenberg n =
  plotList [ Key Nothing
           , Title "Numero de digitos de la sucesion de Lichtenberg"
           , PNG "Sucesion_de_Lichtenberg.png"
           ]
           (take n (map (length . show) lichtenberg1))

import Data.Char (digitToInt)

import Graphics.Gnuplot.Simple

import Test.QuickCheck

import Data.Numbers.Primes (isPrime)

-- 1ª solución

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

lichtenberg1 :: [Integer]

lichtenberg1 = map binarioAdecimal sucAlternada

-- sucAlternada es la lista cuyos elementos son los términos de la

-- sucesión de los dígitos 0 y 1 alternados. Por ejemplo,

-- λ> take 7 sucAlternada

-- ["0","1","10","101","1010","10101","101010"]

sucAlternada :: [String]

sucAlternada =

['0'] : [take n cadenaAlternada | n <- [1..]]

-- cadenaAltenada es la cadena formada alternando los caracteres 1 y

-- 0. Por ejemplo,

-- take 20 cadenaAlternada == "10101010101010101010"

cadenaAlternada :: String

cadenaAlternada = cycle ['1','0']

-- (binarioAdecimal cs) es el número decimal correspondiente al número

-- binario cuya cadena de dígitos es cs. Por ejemplo,

-- binarioAdecimal "11101" == 29

binarioAdecimal :: String -> Integer

binarioAdecimal =

foldl (\acc x -> acc * 2 + (toInteger . digitToInt) x) 0

-- 2ª solución

lichtenberg2 :: [Integer]

lichtenberg2 = map a [0..]

where a 0 = 0

a 1 = 1

a n = a (n-1) + 2 * a (n-2) + 1

-- 3ª solución

lichtenberg3 :: [Integer]

lichtenberg3 =

0 : 1 : map (+1) (zipWith (+) (tail lichtenberg3) (map (*2) lichtenberg3))

-- Comprobación de eficiencia

-- λ> length (show (lichtenberg1 !! 27))

-- 8

-- (0.02 secs, 155,384 bytes)

-- λ> length (show (lichtenberg2 !! 27))

-- 8

-- (2.22 secs, 311,157,760 bytes)

-- λ> length (show (lichtenberg1 !! (8*10^4)))

-- 24083

-- (1.28 secs, 664,207,040 bytes)

-- λ> length (show (lichtenberg3 !! (8*10^4)))

-- 24083

-- (2.59 secs, 1,253,328,200 bytes)

-- La propiedad es

propLichtenberg :: Int -> Property

propLichtenberg n =

n > 4 ==> not (isPrime (lichtenberg1 !! n))

-- La comprobación es

-- λ> quickCheck propLichtenberg

-- +++ OK, passed 100 tests.

graficaLichtenberg :: Int -> IO ()

graficaLichtenberg n =

plotList [ Key Nothing

, Title "Numero de digitos de la sucesion de Lichtenberg"

, PNG "Sucesion_de_Lichtenberg.png"

]

(take n (map (length . show) lichtenberg1))

Sucesión de dígitos 0 y 1 alternados

PorJosé A. Alonso 24-enero-201831-enero-2018

Los primeros términos de la sucesión de los dígitos 0 y 1 alternados son

101

1010

10101

101010

1010101

10101010

101010101

Definir la lista

   sucAlternada :: [Integer]

1	sucAlternada :: [Integer]

tal que sus elementos son los términos de la sucesión de los dígitos 0 y 1 alternados. Por ejemplo,

   λ> take 10 sucAlternada
   [0,1,10,101,1010,10101,101010,1010101,10101010,101010101]
   λ> length (show (sucAlternada !! (2*10^6)))
   2000000

λ> take 10 sucAlternada

[0,1,10,101,1010,10101,101010,1010101,10101010,101010101]

λ> length (show (sucAlternada !! (2*10^6)))

2000000

Soluciones

import Data.List (inits, unfoldr)

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

sucAlternada :: [Integer]
sucAlternada = [read (take x aux) | x <- [1..]]
  where aux = '0' : '1' : aux

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

sucAlternada2 :: [Integer]
sucAlternada2 =
  [read (take n (cycle "01")) | n <- [1..]]

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

sucAlternada3 :: [Integer]
sucAlternada3 = 0 : [siguiente n | n <- sucAlternada3]

siguiente :: Integer -> Integer
siguiente x | even x    = 10*x + 1
            | otherwise = 10*x

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

sucAlternada4 :: [Integer]
sucAlternada4 = 0 : map siguiente sucAlternada4

-- 5ª solución
-- ===========

sucAlternada5 :: [Integer]
sucAlternada5 = map read ((tail . inits . concat . repeat) "01")

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

sucAlternada6 :: [Integer]
sucAlternada6 = [(10 * 10^n - 1) `div` 99 | n <- [0..]]
 
-- 7ª solución
-- ===========

sucAlternada7 :: [Integer]
sucAlternada7 =
  unfoldr (\x -> if x `mod` 10 == 0
                 then Just (x,10 * x + 1)
                 else Just (x,10 * x))
          0

import Data.List (inits, unfoldr)

-- 1ª solución

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

sucAlternada :: [Integer]

sucAlternada = [read (take x aux) | x <- [1..]]

where aux = '0' : '1' : aux

-- 2ª solución

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

sucAlternada2 :: [Integer]

sucAlternada2 =

[read (take n (cycle "01")) | n <- [1..]]

-- 3ª solución

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

sucAlternada3 :: [Integer]

sucAlternada3 = 0 : [siguiente n | n <- sucAlternada3]

siguiente :: Integer -> Integer

siguiente x | even x = 10*x + 1

| otherwise = 10*x

-- 3ª solución

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

sucAlternada4 :: [Integer]

sucAlternada4 = 0 : map siguiente sucAlternada4

-- 5ª solución

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

sucAlternada5 :: [Integer]

sucAlternada5 = map read ((tail . inits . concat . repeat) "01")

-- 6ª solución

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

sucAlternada6 :: [Integer]

sucAlternada6 = [(10 * 10^n - 1) `div` 99 | n <- [0..]]

-- 7ª solución

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

sucAlternada7 :: [Integer]

sucAlternada7 =

unfoldr (\x -> if x `mod` 10 == 0

then Just (x,10 * x + 1)

else Just (x,10 * x))

Números como diferencias de potencias

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

El número 45 se puede escribir de tres formas como diferencia de los cuadrados de dos números naturales:

   45 =  7^2 -  2^2 
      =  9^2 -  6^2
      = 23^2 - 22^2

45 = 7^2 - 2^2

= 9^2 - 6^2

= 23^2 - 22^2

Definir la función

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

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

tal que (diferencias x n) es la lista de pares tales que la diferencia de sus potencias n-ésima es x. Por ejemplo,

   diferencias 45 2    ==  [(7,2),(9,6),(23,22)]
   diferencias 50 2    ==  []
   diferencias 19 3    ==  [(3,2)]
   diferencias 8 3     ==  [(2,0)]
   diferencias 15 4    ==  [(2,1)]
   diferencias 4035 2  ==  [(142,127),(406,401),(674,671),(2018,2017)]
   head (diferencias 1161480105172255454401 5)  ==  (123456,123455)

diferencias 45 2 == [(7,2),(9,6),(23,22)]

diferencias 50 2 == []

diferencias 19 3 == [(3,2)]

diferencias 8 3 == [(2,0)]

diferencias 15 4 == [(2,1)]

diferencias 4035 2 == [(142,127),(406,401),(674,671),(2018,2017)]

head (diferencias 1161480105172255454401 5) == (123456,123455)

Soluciones

-- 1ª definición
diferencias :: Integer -> Integer -> [(Integer,Integer)]
diferencias x n = [(a,b) | b <- [0..x]
                         , a <- [b..x]
                         , x == a^n - b^n]

-- 2ª definición
diferencias2 :: Integer -> Integer -> [(Integer,Integer)]
diferencias2 x n =
  [(a,b) | a <- [1..x]
         , a^n >= x
         , let b = round ((fromIntegral (a^n - x)) ** (1/fromIntegral n))
         , x == a^n - b^n]

-- 3ª definición
diferencias3 :: Integer -> Integer -> [(Integer,Integer)]
diferencias3 x n =
  [(a,b) | a <- [0..x]
         , a^n >= x
         , b <- raizEntera n (a^n - x)]

raizEntera :: Integer -> Integer -> [Integer]
raizEntera n x 
  | y^n == x  = [y]
  | otherwise = []
  where y = head [k | k <- [0..], k^n >= x] 

-- 4ª definición
diferencias4 :: Integer -> Integer -> [(Integer,Integer)]
diferencias4 x n =
  [(a,b) | a <- [0..x]
         , a^n >= x
         , b <- raizEntera n (a^n - x)]
  where potencias = [(k,k^n) | k <- [0..]]
        raizEntera n x 
          | yn == x   = [y]
          | otherwise = []
          where (y,yn) = head [(k,kn) | (k,kn) <- potencias, kn >= x]

-- Comparación de eficiencia
--    λ> head (diferencias 7351 3)
--    (50,49)
--    (2.16 secs, 533,868,368 bytes)
--    λ> head (diferencias2 7351 3)
--    (50,49)
--    (0.01 secs, 270,040 bytes)
--    λ> head (diferencias3 7351 3)
--    (50,49)
--    (0.01 secs, 1,021,720 bytes)
--    λ> head (diferencias4 7351 3)
--    (50,49)
--    (0.01 secs, 316,536 bytes)

-- 1ª definición

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

diferencias x n = [(a,b) | b <- [0..x]

, a <- [b..x]

, x == a^n - b^n]

-- 2ª definición

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

diferencias2 x n =

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

, a^n >= x

, let b = round ((fromIntegral (a^n - x)) ** (1/fromIntegral n))

, x == a^n - b^n]

-- 3ª definición

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

diferencias3 x n =

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

, a^n >= x

, b <- raizEntera n (a^n - x)]

raizEntera :: Integer -> Integer -> [Integer]

raizEntera n x

| y^n == x = [y]

| otherwise = []

where y = head [k | k <- [0..], k^n >= x]

-- 4ª definición

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

diferencias4 x n =

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

, a^n >= x

, b <- raizEntera n (a^n - x)]

where potencias = [(k,k^n) | k <- [0..]]

raizEntera n x

| yn == x = [y]

| otherwise = []

where (y,yn) = head [(k,kn) | (k,kn) <- potencias, kn >= x]

-- Comparación de eficiencia

-- λ> head (diferencias 7351 3)

-- (50,49)

-- (2.16 secs, 533,868,368 bytes)

-- λ> head (diferencias2 7351 3)

-- (50,49)

-- (0.01 secs, 270,040 bytes)

-- λ> head (diferencias3 7351 3)

-- (50,49)

-- (0.01 secs, 1,021,720 bytes)

-- λ> head (diferencias4 7351 3)

-- (50,49)

-- (0.01 secs, 316,536 bytes)

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

Ofertas 3 por 2

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

En una tienda tienen la «oferta 3 por 2» de forma que cada cliente que elige 3 artículos obtiene el más barato de forma gratuita. Por ejemplo, si los precios de los artículos elegidos por un cliente son 10, 2, 4, 5 euros pagará 19 euros si agrupa los artículos en (10,2,4) y (5) o pagará 17 si lo agupa en (5,10,4) y (2).

Definir la función

   minimoConOferta :: [Int] -> Int

1	minimoConOferta :: [Int] -> Int

tal que (minimoConOferta xs) es lo mínimo que pagará el cliente si los precios de la compra son xs; es decir, lo que pagará agrupando los artículos de forma óptima para aplicar la oferta 3 por 2. Por ejemplo,

   minimoConOferta [10,2,4,5]     ==  17
   minimoConOferta [3,2,3,2]      ==  8
   minimoConOferta [6,4,5,5,5,5]  ==  21

minimoConOferta [10,2,4,5] == 17

minimoConOferta [3,2,3,2] == 8

minimoConOferta [6,4,5,5,5,5] == 21

Soluciones

import Data.List (sort)

minimoConOferta :: [Int] -> Int
minimoConOferta xs = aux (reverse (sort xs)) 0
  where aux (a:b:_:ds) n = aux ds (a+b+n)
        aux as         n = n + sum as

import Data.List (sort)

minimoConOferta :: [Int] -> Int

minimoConOferta xs = aux (reverse (sort xs)) 0

where aux (a:b:_:ds) n = aux ds (a+b+n)

aux as n = n + sum as

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

Ordenación según una cadena

PorJosé A. Alonso 29-diciembre-201726-marzo-2022

Dada una lista xs y una cadena cs de la misma longitud, la ordenación de xs según cs consiste en emparejar los elementos de cs con los de xs (de forma que al menor elemento de cs le corresponde el menor de xs, al segundo de cs el segundo de xs, etc.) y ordenar los elementos de xs en el mismo orden que sus correspondientes elementos de cs. Por ejemplo, si xs es [6,4,2] y cs es «CAB» entonces a ‘A’ le corresponde el 2, a ‘B’ el 4 y a ‘C’ el 6; luego la ordenación es [6,2,4].

Definir la función

   ordenacion :: Ord a => [a] -> String -> [a]

1	ordenacion :: Ord a => [a] -> String -> [a]

tal que (ordenacion xs ys) es la ordenación de la lista xs según la cadena cs. Por ejemplo,

   ordenacion [6,4,2] "CAB"     ==  [6,2,4]
   ordenacion [1,5,3] "ABC"     ==  [1,3,5]
   ordenacion [1,5,3,7] "ABEC"  ==  [1,3,7,5]

ordenacion [6,4,2] "CAB" == [6,2,4]

ordenacion [1,5,3] "ABC" == [1,3,5]

ordenacion [1,5,3,7] "ABEC" == [1,3,7,5]

Soluciones

import Data.List (sort)
import Data.Maybe (fromJust)

ordenacion :: Ord a => [a] -> String -> [a]
ordenacion xs cs =
  [fromJust (lookup y diccionario) | y <- cs]
  where diccionario = zip (sort cs) (sort xs)

import Data.List (sort)

import Data.Maybe (fromJust)

ordenacion :: Ord a => [a] -> String -> [a]

ordenacion xs cs =

[fromJust (lookup y diccionario) | y <- cs]

where diccionario = zip (sort cs) (sort xs)

Posiciones de las mayúsculas

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

Definir la función

   posicionesMayusculas :: String -> [Int]

1	posicionesMayusculas :: String -> [Int]

tal que (posicionesMayusculas cs) es la lista de las posiciones de las mayúsculas de la cadena cs. Por ejemplo,

   posicionesMayusculas "SeViLLa"  == [0,2,4,5]
   posicionesMayusculas "aAbB"     == [1,3]
   posicionesMayusculas "ABCDEF"   == [0,1,2,3,4,5]
   posicionesMayusculas "4ysdf4"   == []
   posicionesMayusculas ""         == []

posicionesMayusculas "SeViLLa" == [0,2,4,5]

posicionesMayusculas "aAbB" == [1,3]

posicionesMayusculas "ABCDEF" == [0,1,2,3,4,5]

posicionesMayusculas "4ysdf4" == []

posicionesMayusculas "" == []

Soluciones

import Data.Char (isUpper)
import Data.List (findIndices)

-- 1ª solución
posicionesMayusculas :: String -> [Int]
posicionesMayusculas xs = [n | (n,x) <- zip [0..] xs, isUpper x] 

-- 2ª solución
posicionesMayusculas2 :: String -> [Int]
posicionesMayusculas2 = aux 0 []
  where aux n ns [] = reverse ns
        aux n ns (y:ys) | isUpper y = aux (n+1) (n:ns) ys
                        | otherwise = aux (n+1)    ns  ys

-- 3ª solución
posicionesMayusculas3 :: String -> [Int]
posicionesMayusculas3 = findIndices isUpper

import Data.Char (isUpper)

import Data.List (findIndices)

-- 1ª solución

posicionesMayusculas :: String -> [Int]

posicionesMayusculas xs = [n | (n,x) <- zip [0..] xs, isUpper x]

-- 2ª solución

posicionesMayusculas2 :: String -> [Int]

posicionesMayusculas2 = aux 0 []

where aux n ns [] = reverse ns

aux n ns (y:ys) | isUpper y = aux (n+1) (n:ns) ys

| otherwise = aux (n+1) ns ys

-- 3ª solución

posicionesMayusculas3 :: String -> [Int]

posicionesMayusculas3 = findIndices isUpper

Sumable sin vecinos

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

En la lista [3,2,5,7,4] el número 12 se puede escribir como una suma de elementos de la lista sin incluir sus vecinos (ya que es la suma de 3, 5 y 4); en cambio, 14 no lo es (porque es la suma de 3, 7 y 4, pero 7 y 4 son vecinos).

Definir la función

   esSumableSinVecinos :: [Int] -> Int -> Bool

1	esSumableSinVecinos :: [Int] -> Int -> Bool

tal que (esSumableSinVecinos xs n) se verifica si n se puede escribir como una suma de elementos de xs que no incluye a ninguno de sus vecinos. Por ejemplo,

   esSumableSinVecinos [3,2,5,7,4] 12  ==  True
   esSumableSinVecinos [3,2,5,7,4] 9   ==  True
   esSumableSinVecinos [3,2,5,7,4] 6   ==  True
   esSumableSinVecinos [3,2,5,7,4] 14  ==  False
   esSumableSinVecinos [3,2,5,7,4] 1   ==  False

esSumableSinVecinos [3,2,5,7,4] 12 == True

esSumableSinVecinos [3,2,5,7,4] 9 == True

esSumableSinVecinos [3,2,5,7,4] 6 == True

esSumableSinVecinos [3,2,5,7,4] 14 == False

esSumableSinVecinos [3,2,5,7,4] 1 == False

Soluciones

esSumableSinVecinos :: [Int] -> Int -> Bool
esSumableSinVecinos _  0       = True
esSumableSinVecinos []  _      = False
esSumableSinVecinos [x] n      = x == n
esSumableSinVecinos (x:y:zs) n = esSumableSinVecinos zs (n - x) ||
                                 esSumableSinVecinos (y:zs) n

esSumableSinVecinos :: [Int] -> Int -> Bool

esSumableSinVecinos _ 0 = True

esSumableSinVecinos [] _ = False

esSumableSinVecinos [x] n = x == n

esSumableSinVecinos (x:y:zs) n = esSumableSinVecinos zs (n - x) ||

esSumableSinVecinos (y:zs) 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

Aplicaciones biyectivas

PorJosé A. Alonso 14-diciembre-201721-diciembre-2017

Definir las funciones

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

1 2	biyectivas :: (Ord a, Ord b) => [a] -> [b] -> [[(a,b)]] nBiyectivas :: (Ord a, Ord b) => [a] -> [b] -> Integer

tales que

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

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

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

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

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

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

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

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

[]

(nBiyectivas xs ys) es el número de aplicaciones biyectivas del conjunto xs en el conjunto ys. Por ejemplo,

     nBiyectivas [1,3] [2,4]      ==  2
     nBiyectivas [1,3,5] [2,4,6]  ==  6
     λ> nBiyectivas [1,3] [2,4,6] ==  0
     length (show (nBiyectivas2 [1..2*10^4] [1..2*10^4]))  ==  77338

nBiyectivas [1,3] [2,4] == 2

nBiyectivas [1,3,5] [2,4,6] == 6

λ> nBiyectivas [1,3] [2,4,6] == 0

length (show (nBiyectivas2 [1..2*10^4] [1..2*10^4])) == 77338

Nota: En este ejercicio los conjuntos se representan mediante listas ordenadas de elementos distintos.

Soluciones

import Data.List (genericLength, permutations)

-- 1ª definición de biyectivas
biyectivas :: (Ord a, Ord b) => [a] -> [b] -> [[(a,b)]]
biyectivas xs ys
  | length xs == length ys = [zip xs zs | zs <- permutations ys]
  | otherwise              = []

-- 1ª definición de nBiyectivas
nBiyectivas :: (Ord a, Ord b) => [a] -> [b] -> Integer
nBiyectivas xs ys
  | length xs == length ys = genericLength (biyectivas xs ys)
  | otherwise              = 0

-- 2ª definición de nBiyectivas
nBiyectivas2 :: (Ord a, Ord b) => [a] -> [b] -> Integer
nBiyectivas2 xs ys 
  | n == m    = product [1..n]
  | otherwise = 0
  where n = genericLength xs
        m = genericLength ys

import Data.List (genericLength, permutations)

-- 1ª definición de biyectivas

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

biyectivas xs ys

| length xs == length ys = [zip xs zs | zs <- permutations ys]

| otherwise = []

-- 1ª definición de nBiyectivas

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

nBiyectivas xs ys

| length xs == length ys = genericLength (biyectivas xs ys)

| otherwise = 0

-- 2ª definición de nBiyectivas

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

nBiyectivas2 xs ys

| n == m = product [1..n]

| otherwise = 0

where n = genericLength xs

m = genericLength ys

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

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)

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

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

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