Menu Close

Etiqueta: concatMap

Codificación de Fibonacci

La codificación de Fibonacci de un número n es una cadena d = d(0)d(1)…d(k-1)d(k) de ceros y unos tal que

   n = d(0)*F(2) + d(1)*F(3) +...+ d(k-1)*F(k+1) 
   d(k-1) = d(k) = 1

donde F(i) es el i-ésimo término de la sucesión de Fibonacci.

   0,1,1,2,3,5,8,13,21,34,...

Por ejemplo. La codificación de Fibonacci de 4 es “1011” ya que los dos últimos elementos son iguales a 1 y

   1*F(2) + 0*F(3) + 1*F(4) = 1*1 + 0*2 + 1*3 = 4

La codificación de Fibonacci de los primeros números se muestra en la siguiente tabla

    1  = 1     = F(2)           ≡       11
    2  = 2     = F(3)           ≡      011
    3  = 3     = F(4)           ≡     0011
    4  = 1+3   = F(2)+F(4)      ≡     1011
    5  = 5     = F(5)           ≡    00011
    6  = 1+5   = F(2)+F(5)      ≡    10011
    7  = 2+5   = F(3)+F(5)      ≡    01011
    8  = 8     = F(6)           ≡   000011
    9  = 1+8   = F(2)+F(6)      ≡   100011
   10  = 2+8   = F(3)+F(6)      ≡   010011
   11  = 3+8   = F(4)+F(6)      ≡   001011
   12  = 1+3+8 = F(2)+F(4)+F(6) ≡   101011
   13  = 13    = F(7)           ≡  0000011
   14  = 1+13  = F(2)+F(7)      ≡  1000011

Definir la función

   codigoFib :: Integer -> String

tal que (codigoFib n) es la codificación de Fibonacci del número n. Por ejemplo,

   λ> codigoFib 65
   "0100100011"
   λ> [codigoFib n | n <- [1..7]]
   ["11","011","0011","1011","00011","10011","01011"]

Soluciones

import Data.List
import Data.Array
import Test.QuickCheck
 
-- 1ª solución
-- ===========
 
codigoFib1 :: Integer -> String
codigoFib1 = (concatMap show) . codificaFibLista
 
-- (codificaFibLista n) es la lista correspondiente a la codificación de
-- Fibonacci del número n. Por ejemplo,
--    λ> codificaFibLista 65
--    [0,1,0,0,1,0,0,0,1,1]
--    λ> [codificaFibLista n | n <- [1..7]]
--    [[1,1],[0,1,1],[0,0,1,1],[1,0,1,1],[0,0,0,1,1],[1,0,0,1,1],[0,1,0,1,1]]
codificaFibLista :: Integer -> [Integer]
codificaFibLista n = map f [2..head xs] ++ [1]
  where xs = map fst (descomposicion n)
        f i | elem i xs = 1
            | otherwise = 0
 
-- (descomposicion n) es la lista de pares (i,f) tales que f es el
-- i-ésimo número de Fibonacci y las segundas componentes es una
-- sucesión decreciente de números de Fibonacci cuya suma es n. Por
-- ejemplo, 
--    descomposicion 65  ==  [(10,55),(6,8),(3,2)]
--    descomposicion 66  ==  [(10,55),(6,8),(4,3)]
descomposicion :: Integer -> [(Integer, Integer)]
descomposicion 0 = []
descomposicion 1 = [(2,1)]
descomposicion n = (i,x) : descomposicion (n-x)
  where (i,x) = fibAnterior n
 
-- (fibAnterior n) es el mayor número de Fibonacci menor o igual que
-- n. Por ejemplo,
--    fibAnterior 33  ==  (8,21)
--    fibAnterior 34  ==  (9,34)
fibAnterior :: Integer -> (Integer, Integer)
fibAnterior n = last (takeWhile p fibsConIndice)
  where p (i,x) = x <= n
 
-- fibsConIndice es la sucesión de los números de Fibonacci junto con
-- sus índices. Por ejemplo,
--    λ> take 10 fibsConIndice
--    [(0,0),(1,1),(2,1),(3,2),(4,3),(5,5),(6,8),(7,13),(8,21),(9,34)]
fibsConIndice :: [(Integer, Integer)]
fibsConIndice = zip [0..] fibs
 
-- fibs es la sucesión de Fibonacci. Por ejemplo, 
--    take 10 fibs  ==  [0,1,1,2,3,5,8,13,21,34]
fibs :: [Integer]
fibs = 0 : 1 : zipWith (+) fibs (tail fibs)
 
--- 2ª solución
-- ============
 
codigoFib2 :: Integer -> String
codigoFib2 = (concatMap show) . elems . codificaFibVec
 
-- (codificaFibVec n) es el vector correspondiente a la codificación de
-- Fibonacci del número n. Por ejemplo,
--    λ> codificaFibVec 65
--    array (0,9) [(0,0),(1,1),(2,0),(3,0),(4,1),(5,0),(6,0),(7,0),(8,1),(9,1)]
--    λ> [elems (codificaFibVec n) | n <- [1..7]]
--    [[1,1],[0,1,1],[0,0,1,1],[1,0,1,1],[0,0,0,1,1],[1,0,0,1,1],[0,1,0,1,1]]
codificaFibVec :: Integer -> Array Integer Integer
codificaFibVec n = accumArray (+) 0 (0,a+1) ((a+1,1):is) 
  where is = [(i-2,1) | (i,x) <- descomposicion n]
        a  = fst (head is)
 
-- Comparación de eficiencia
-- =========================
--    λ> head [n | n <- [1..], length (codigoFib1 n) > 25]
--    121393
--    (14.37 secs, 3135674112 bytes)
--    λ> :r
--    Ok, modules loaded: Main.
--    λ> head [n | n <- [1..], length (codigoFib2 n) > 25]
--    121393
--    (12.04 secs, 2762190920 bytes)
 
-- Propiedades
-- ===========
 
-- Usaremos la 2ª definición
codigoFib :: Integer -> String
codigoFib = codigoFib2
 
-- Prop.: La función descomposicion es correcta:
propDescomposicionCorrecta :: Integer -> Property
propDescomposicionCorrecta n =
  n >= 0 ==> n == sum (map snd (descomposicion n))
 
-- La comprobación es
--    λ> quickCheck propDescomposicionCorrecta
--    +++ OK, passed 100 tests.
 
-- Prop.: Todo número natural se puede descomponer en suma de números de
-- la sucesión de Fibonacci.
propDescomposicion :: Integer -> Property
propDescomposicion n =
  n >= 0 ==> not (null (descomposicion n))
 
-- La comprobación es
--    λ> quickCheck propDescomposicion
--    +++ OK, passed 100 tests.
 
-- Prop.: Las codificaciones de Fibonacci tienen como mínimo 2 elementos.
prop1 :: Integer -> Property
prop1 n = n > 0 ==> length (codigoFib n) >= 2
 
-- La comprobación es
--    λ> quickCheck prop1
--    +++ OK, passed 100 tests.
 
-- Prop.: Los dos últimos elementos de las codificaciones de Fibonacci
-- son iguales a 1.
prop2 :: Integer -> Property
prop2 n = n > 0 ==> take 2 (reverse (codigoFib n)) == "11"
 
-- La comprobación es
--    λ> quickCheck prop2
--    +++ OK, passed 100 tests.
 
-- Prop.: En las codificaciones de Fibonacci, la cadena "11" sólo
-- aparece una vez y la única vez que aparece es al final.
prop3 :: Integer -> Property
prop3 n = 
  n > 0 ==> not (isInfixOf "11" (drop 2 (reverse (codigoFib n))))
 
-- La comprobación es
--    λ> quickCheck prop3
--    +++ OK, passed 100 tests.

Cadenas de divisores

Una cadena de divisores de un número n es una lista donde cada elemento es un divisor de su siguiente elemento en la lista. Por ejemplo, las cadenas de divisores de 12 son [2,4,12], [2,6,12], [2,12], [3,6,12], [3,12], [4,12], [6,12] y [12].

Definir la función

   cadenasDivisores :: Int -> [[Int]]

tal que (cadenasDivisores n) es la lista de las cadenas de divisores de n. Por ejemplo,

   λ> cadenasDivisores 12
   [[2,4,12],[2,6,12],[2,12],[3,6,12],[3,12],[4,12],[6,12],[12]]
   λ> length (cadenaDivisores 48)
   48
   λ> length (cadenaDivisores 120)
   132

Soluciones

import Data.List (sort)
import Data.Numbers.Primes (isPrime)
 
-- 1ª definición
-- =============
 
cadenasDivisores :: Int -> [[Int]]
cadenasDivisores n = sort (extiendeLista [[n]])
    where extiendeLista []           = []
          extiendeLista ((1:xs):yss) = xs : extiendeLista yss
          extiendeLista ((x:xs):yss) =
              extiendeLista ([y:x:xs | y <- divisores x] ++ yss)
 
-- (divisores x) es la lista decreciente de los divisores de x distintos
-- de x. Por ejemplo,
--    divisores 12  ==  [6,4,3,2,1]
divisores :: Int -> [Int]
divisores x = 
    [y | y <- [a,a-1..1], x `mod` y == 0]
    where a = x `div` 2
 
-- 2ª definición
-- =============
 
cadenasDivisores2 :: Int -> [[Int]]
cadenasDivisores2 = sort . aux
    where aux 1 = [[]]
          aux n = [xs ++ [n] | xs <- concatMap aux (divisores n)]
 
-- 3ª definición
-- =============
 
cadenasDivisores3 :: Int -> [[Int]]
cadenasDivisores3 = sort . map reverse . aux
    where aux 1 = [[]]
          aux n = map (n:) (concatMap aux (divisores3 n))
 
-- (divisores3 x) es la lista creciente de los divisores de x distintos
-- de x. Por ejemplo,
--    divisores3 12  ==  [1,2,3,4,6]
divisores3 :: Int -> [Int]
divisores3 x = 
    [y | y <- [1..a], x `mod` y == 0]
    where a = x `div` 2
 
-- 1ª definición de nCadenasDivisores
-- ==================================
 
nCadenasDivisores1 :: Int -> Int
nCadenasDivisores1 = length . cadenasDivisores
 
-- 2ª definición de nCadenasDivisores
-- ==================================
 
nCadenasDivisores2 :: Int -> Int
nCadenasDivisores2 1 = 1
nCadenasDivisores2 n = 
    sum [nCadenasDivisores2 x | x <- divisores n]

Pandigitales primos

Un número con n dígitos es pandigital si contiene todos los dígitos del 1 a n exactamente una vez. Por ejemplo, 2143 es un pandigital con 4 dígitos y, además, es primo.

Definir la constante

   pandigitalesPrimos :: [Int]

tal que sus elementos son los números pandigitales, ordenados de mayor a menor. Por ejemplo,

   take 3 pandigitalesPrimos       ==  [7652413,7642513,7641253]
   2143 `elem` pandigitalesPrimos  ==  True
   length pandigitalesPrimos       ==  538

Soluciones

import Data.List (permutations, sort)
import Data.Char (intToDigit)
import Data.Numbers.Primes (isPrime, primes)
 
-- 1ª solución
-- ===========
 
pandigitalesPrimos :: [Int]
pandigitalesPrimos =
  concatMap nPandigitalesPrimos [9,8..1]
 
-- (nPandigitalesPrimos n) es la lista de los números pandigitales con n
-- dígitos, ordenada de mayor a menor. Por ejemplo,
--    nPandigitalesPrimos 4  ==  [4231,2341,2143,1423]
--    nPandigitalesPrimos 5  ==  []
nPandigitalesPrimos1 :: Int -> [Int]
nPandigitalesPrimos1 n = filter isPrime (pandigitales n)
 
-- Nota. La definición anterior se puede simplificar, ya que la suma de
-- los números de 1 a n es divisible por 3, entonces los números
-- pandigitales con n dígitos también lo son y, por tanto, no son primos.
nPandigitalesPrimos2 :: Int -> [Int]
nPandigitalesPrimos2 n 
  | sum [1..n] `mod` 3 == 0 = []
  | otherwise               = filter isPrime (pandigitales n)
 
-- Nota. La definición anterior se puede simplificar, ya que
--    ghci> [n | n <- [1..9], sum [1..n] `mod` 3 /= 0]
--    [1,4,7]
nPandigitalesPrimos :: Int -> [Int]
nPandigitalesPrimos n 
  | n `elem` [4,7] = filter isPrime (pandigitales n)
  | otherwise      = []
 
-- (pandigitales n) es la lista de los números pandigitales de n dígitos
-- ordenada de mayor a menor. Por ejemplo,
--    pandigitales 3  ==  [321,312,231,213,132,123]
pandigitales :: Int -> [Int]
pandigitales n = 
  reverse $ sort $ map digitosAentero (permutations [1..n])
 
-- (digitosAentero ns) es el número cuyos dígitos son ns. Por ejemplo,
--    digitosAentero [3,2,5]  ==  325
digitosAentero :: [Int] -> Int
digitosAentero = read . map intToDigit

Reparto de escaños por la ley d’Hont

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

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

Definir la función

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

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

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

es decir, en el primer ejemplo,

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

Soluciones

import Data.List (sort, group)
 
-- Para los ejemplos que siguen, se usará la siguiente ditribución de
-- votos entre 5 partidos.
ejVotos :: [Int]
ejVotos = [340000,280000,160000,60000,15000]
 
-- 1ª solución
-- ===========
 
reparto :: Int -> [Int] -> [(Int,Int)]
reparto n vs = 
  [(x,1 + length xs) | (x:xs) <- group (sort (repartoAux n vs))] 
 
-- (repartoAux n vs) es el número de los partidos, cuyos votos son vs, que
-- obtienen los n escaños. Por ejemplo,
--    ghci> repartoAux 7 ejVotos
--    [1,2,1,3,2,1,2]
repartoAux :: Int -> [Int] -> [Int]
repartoAux n vs = map snd (repartoAux' n vs)
 
-- (repartoAux' n vs) es la lista formada por los n restos mayores
-- correspondientes a la lista de votos vs. Por ejemplo,
--    ghci> repartoAux' 7 ejVotos
--    [(340000,1),(280000,2),(170000,1),(160000,3),(140000,2),(113333,1),
--     (93333,2)]
repartoAux' :: Int -> [Int] -> [(Int,Int)]
repartoAux' n vs = 
  take n (reverse (sort (concatMap (restos n) (votosPartidos vs))))
 
-- (votosPartidos vs) es la lista con los pares formados por los votos y
-- el número de cada partido. Por ejemplo, 
--    ghci> votosPartidos ejVotos
--    [(340000,1),(280000,2),(160000,3),(60000,4),(15000,5)]
votosPartidos :: [Int] -> [(Int,Int)]
votosPartidos vs = zip vs [1..]
 
-- (restos n (x,i)) es la lista obtenidas dividiendo n entre 1, 2,..., n.
-- Por ejemplo, 
--    ghci> restos 5 (340000,1)
--    [(340000,1),(170000,1),(113333,1),(85000,1),(68000,1)]
restos :: Int -> (Int,Int) -> [(Int,Int)]
restos n (x,i) = [(x `div` k,i) | k <- [1..n]]
 
-- 2ª solución
-- ===========
 
reparto2 :: Int -> [Int] -> [(Int,Int)]
reparto2 n xs = 
  ( map (\x -> (head x, length x))  
  . group  
  . sort  
  . map snd  
  . take n  
  . reverse  
  . sort
  ) [(x `div` i, p) | (x,p) <- zip xs [1..], i <- [1..n]]

Otras soluciones

  • Se pueden escribir otras soluciones en los comentarios.
  • El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Suma de los elementos de las diagonales matrices espirales

Empezando con el número 1 y moviéndose en el sentido de las agujas del reloj se obtienen las matrices espirales

   |1 2|   |7 8 9|   | 7  8  9 10|   |21 22 23 24 25|
   |4 3|   |6 1 2|   | 6  1  2 11|   |20  7  8  9 10|
           |5 4 3|   | 5  4  3 12|   |19  6  1  2 11|
                     |16 15 14 13|   |18  5  4  3 12|
                                     |17 16 15 14 13|

La suma los elementos de sus diagonales es

+ en la 2x2: 1+3+2+4               =  10
+ en la 3x3: 1+3+5+7+9             =  25
+ en la 4x4: 1+2+3+4+7+10+13+16    =  56
+ en la 5x5: 1+3+5+7+9+13+17+21+25 = 101

Definir la función

   sumaDiagonales :: Integer -> Integer

tal que (sumaDiagonales n) es la suma de los elementos en las diagonales de la matriz espiral de orden nxn. Por ejemplo.

   sumaDiagonales 1         ==  1
   sumaDiagonales 2         ==  10
   sumaDiagonales 3         ==  25
   sumaDiagonales 4         ==  56
   sumaDiagonales 5         ==  101
   sumaDiagonales (10^6)    ==  666667166668000000
   sumaDiagonales (1+10^6)  ==  666669166671000001
 
   sumaDiagonales (10^2)  ==         671800
   sumaDiagonales (10^3)  ==        667168000
   sumaDiagonales (10^4)  ==       666716680000
   sumaDiagonales (10^5)  ==      666671666800000
   sumaDiagonales (10^6)  ==     666667166668000000
   sumaDiagonales (10^7)  ==    666666716666680000000
   sumaDiagonales (10^8)  ==   666666671666666800000000
   sumaDiagonales (10^9)  ==  666666667166666668000000000

Comprobar con QuickCheck que el último dígito de (sumaDiagonales n) es 0, 4 ó 6 si n es par y es 1, 5 ó 7 en caso contrario.

Soluciones

import Test.QuickCheck
 
-- 1ª solución
-- ===========
 
sumaDiagonales :: Integer -> Integer
sumaDiagonales = sum . elementosEnDiagonales
 
-- (elementosEnDiagonales n) es la lista de los elementos en las
-- diagonales de la matriz espiral de orden nxn. Por ejemplo,
--    elementosEnDiagonales 1  ==  [1]
--    elementosEnDiagonales 2  ==  [1,2,3,4]
--    elementosEnDiagonales 3  ==  [1,3,5,7,9]
--    elementosEnDiagonales 4  ==  [1,2,3,4,7,10,13,16]
--    elementosEnDiagonales 5  ==  [1,3,5,7,9,13,17,21,25]
elementosEnDiagonales :: Integer -> [Integer]
elementosEnDiagonales n 
  | even n    = tail (scanl (+) 0 (concatMap (replicate 4) [1,3..n-1]))
  | otherwise = scanl (+) 1 (concatMap (replicate 4) [2,4..n-1])
 
-- 2ª solución
-- ===========
 
sumaDiagonales2 :: Integer -> Integer
sumaDiagonales2 n
  | even n    = (-1) + n `div` 2 + sum [2*k^2-k+1 | k <- [0..n]]
  | otherwise = 1 + sum [4*k^2-6*k+6 | k <- [3,5..n]]
 
-- 3ª solución
-- ===========
 
sumaDiagonales3 :: Integer -> Integer
sumaDiagonales3 n
  | even n    = n * (4*n^2 + 3*n + 8) `div` 6
  | otherwise = (4*n^3 + 3*n^2 + 8*n - 9) `div` 6
 
-- Equivalencia de las definiciones
-- ================================
 
-- La propiedad es
prop_sumaDiagonales_equiv :: (Positive Integer) -> Bool
prop_sumaDiagonales_equiv (Positive n) =
  all (== sumaDiagonales n) [ sumaDiagonales2 n 
                            , sumaDiagonales3 n]
 
-- La comprobación es
--    λ> quickCheck prop_sumaDiagonales_equiv
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> sumaDiagonales (2*10^6)
--    5333335333336000000
--    (2.30 secs, 1,521,955,848 bytes)
--    λ> sumaDiagonales2 (2*10^6)
--    5333335333336000000
--    (2.77 secs, 1,971,411,440 bytes)
--    λ> sumaDiagonales3 (2*10^6)
--    5333335333336000000
--    (0.01 secs, 139,520 bytes)
 
-- Propiedad
-- =========
 
-- La propiedad es
prop_sumaDiagonales :: (Positive Integer) -> Bool
prop_sumaDiagonales (Positive n) 
  | even n    = x `elem` [0,4,6] 
  | otherwise = x `elem` [1,5,7] 
  where x = sumaDiagonales n `mod` 10
 
-- La comprobación es
--    λ> quickCheck prop_sumaDiagonales
--    +++ OK, passed 100 tests.

Otras soluciones

  • Se pueden escribir otras soluciones en los comentarios.
  • El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Pensamiento

“Un matemático que no sea también algo de poeta nunca será un matemático perfecto.”

Karl Weierstrass.

Suma de intervalos

Los intervalos se pueden representar por pares de enteros (a,b) con a < b. Los elementos del intervalo (2,5) son 2, 3, 4 y 5; por tanto, su longitud es 4. Para calcular la suma de los longitudes de una lista de intervalos hay que tener en cuenta que si hay intervalos superpuestos sus elementos deben de contarse sólo una vez. Por ejemplo, la suma de los intervalos de [(1,4),(7,10),(3,5)] es 7 ya que, como los intervalos (1,4) y (3,5) se solapan, los podemos ver como el intervalo (1,5) que tiene una longitud de 4.

Definir la función

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

tal que (sumaIntervalos xs) es la suma de las longitudes de los intervalos de xs contando los superpuestos sólo una vez. Por ejemplo,

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

Soluciones

import Data.List (nub, sort)
 
-- 1ª solución
sumaIntervalos :: [(Int, Int)] -> Int
sumaIntervalos = aux . sort
  where aux [] = 0
        aux [(a,b)] = b - a
        aux ((a,b):(c,d):xs) | b < c     = b - a + aux ((c,d):xs)
                             | otherwise = aux ((a,max b d):xs)
 
-- 2ª solución
sumaIntervalos2 :: [(Int, Int)] -> Int
sumaIntervalos2 = length . nub . concatMap f
  where f (a, b) = [a..b - 1]

Otras soluciones

  • Se pueden escribir otras soluciones en los comentarios.
  • El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Pensamiento

“Si la gente no cree que las matemáticas son simples, es sólo porque no se dan cuenta de lo complicada que es la vida.”

John von Neumann.

Átomos de FNC (fórmulas en forma normal conjuntiva)

Nota: En este ejercicio usaremos las mismas notaciones que en el anterior importando el módulo Evaluacion_de_FNC.

Definir las siguientes funciones

    atomosClausula :: Clausula -> [Atomo]
    atomosFNC      :: FNC -> [Atomo]

tales que

  • (atomosClausula c) es el conjunto de los átomos de la cláusula c. Por ejemplo,
     atomosClausula [3,1,-3] == [1,3]
  • (atomosFNC f) es el conjunto de los átomos de la FNC f. Por ejemplo,
   atomosFNC [[4,5],[1,-2],[-4,-1,-5]]  ==  [1,2,4,5]

Nota: Escribir la solución en el módulo Atomos_de_FNC para poderlo usar en los siguientes ejercicios.

Soluciones

module Atomos_de_FNC where
 
import Evaluacion_de_FNC
import Data.List (sort, nub)
 
-- 1ª definición de atomosClausula
atomosClausula :: Clausula -> [Atomo]
atomosClausula c = sort (nub (map abs c))
 
-- 2ª definición de atomosClausula
atomosClausula2 :: Clausula -> [Atomo]
atomosClausula2 = sort . nub . map abs
 
-- 1ª definición de atomosFNC
atomosFNC :: FNC -> [Atomo]
atomosFNC f = sort (nub (concat [atomosClausula c | c <- f]))
 
-- 2ª definición
atomosFNC2 :: FNC -> [Atomo]
atomosFNC2 f = sort (nub (concatMap atomosClausula f))
 
-- 3ª definición
atomosFNC3 :: FNC -> [Atomo]
atomosFNC3 = sort . nub . concatMap atomosClausula

Otras soluciones

  • Se pueden escribir otras soluciones en los comentarios.
  • El código se debe escribir entre una línea con <pre lang=”haskell”> y otra con </pre>

Pensamiento

“La esencia de las matemáticas es su libertad.”

Georg Cantor.

Números sin 2 en base 3

Definir la sucesión

   numerosSin2EnBase3 :: [Integer]

cuyos términos son los números cuya representación en base 3 no contiene el dígito 2. Por ejemplo,

   λ> take 20 numerosSin2EnBase3
   [0,1,3,4,9,10,12,13,27,28,30,31,36,37,39,40,81,82,84,85]

Se observa que

  • 12 está en la sucesión ya que su representación en base 3 es 110 (porque 1·3² + 1·3¹ + 0.3⁰ = 12) y no contiene a 2.
  • 14 no está en la sucesión ya que su representación en base 3 es 112 (porque 1·3² + 1·3¹ + 2.3⁰ = 14) y contiene a 2.

Comprobar con QuickCheck que las sucesiones numerosSin2EnBase3 y sucesionSin3enPA (del ejercicio anterior) son iguales; es decir, para todo número natural n, el n-ésimo término de numerosSin2EnBase3 es igual al n-ésimo término de sucesionSin3enPA.

Soluciones

import Data.List ((\\))
import Test.QuickCheck
 
-- 1ª solución
-- ===========
 
numerosSin2EnBase3a :: [Integer]
numerosSin2EnBase3a =
  [n | n <- [0..]
     , 2 `notElem` (enBase3 n)]
 
-- (enBase3 n) es la representación de n en base 3. Por ejemplo,
--    enBase3 7   ==  [1,2]
--    enBase3 9   ==  [0,0,1]
--    enBase3 10  ==  [1,0,1]
--    enBase3 11  ==  [2,0,1]
enBase3 :: Integer -> [Integer]
enBase3 n | n < 3     = [n]
          | otherwise = r : enBase3 q
  where (q,r) = quotRem n 3
 
-- 2ª definición
-- =============
 
-- Se puede construir como un triángulo:
--    0
--    1
--    3 4
--    9 10 12 13
--    27 28 30 31 36 37 39 40
--    ....
 
numerosSin2EnBase3b :: [Integer]
numerosSin2EnBase3b = 0 : concat (iterate siguientes [1])
  where siguientes xs = concatMap (\x -> [3*x,3*x+1]) xs
 
-- Comparación de eficiencia
-- =========================
 
-- La compración es
--    λ> numerosSin2EnBase3a !! (10^4)
--    1679697
--    (4.06 secs, 2,245,415,808 bytes)
--    λ> numerosSin2EnBase3b !! (10^4)
--    1679697
--    (0.03 secs, 2,109,912 bytes)
 
-- Definición
-- ==========
 
-- En lo que sigue usaremos la 2ª definición.
numerosSin2EnBase3 :: [Integer]
numerosSin2EnBase3 = numerosSin2EnBase3b
 
-- Propiedad
-- =========
 
-- La propiedad es
prop_equivalencia :: Int -> Property
prop_equivalencia n =
  n > 0 ==> sucesionSin3enPA !! n == numerosSin2EnBase3 !! n
 
-- sucesionSin3enPA donde cada uno de sus términos es el menor número
-- natural tal que no está en PA con cualesquiera dos términos
-- anteriores de la sucesión. 
sucesionSin3enPA :: [Integer]
sucesionSin3enPA = aux [] [0..] 
  where
    aux xs (y:ys) = y : aux (y:xs) (ys \\ [2 * y - x | x <- xs])
 
-- La comprobación es
--    λ> quickCheck prop_equivalencia
--    +++ OK, passed 100 tests.

Otras soluciones

  • Se pueden escribir otras soluciones en los comentarios.
  • El código se debe escribir entre una línea con <pre lang=”haskell”> y otra con </pre>

Pensamiento

O que yo pueda asesinar un día
en mi alma, al despertar, esa persona
que me hizo el mundo mientras yo dormía.

Antonio Machado

Posiciones de conjuntos finitos de naturales

En un ejercicio anterior se mostró que los conjuntos finitos de números naturales se pueden enumerar como sigue

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

en la que los elementos están ordenados de manera decreciente.

Además, se definió la constante

   enumeracionCFN :: [[Integer]]

tal que sus elementos son los conjuntos de los números naturales con la ordenación descrita anteriormente. Por ejemplo,

   λ> take 20 enumeracionCFN
   [[],
    [0],
    [1],[1,0],
    [2],[2,0],[2,1],[2,1,0],
    [3],[3,0],[3,1],[3,1,0],[3,2],[3,2,0],[3,2,1],[3,2,1,0],
    [4],[4,0],[4,1],[4,1,0]]

Definir la función

   posicion :: [Integer] -> Integer

tal que (posicion xs) es la posición del conjunto finito de números naturales xs, representado por una lista decreciente, en enumeracionCFN. Por ejemplo,

   posicion [2,0]          ==  5
   posicion [2,1]          ==  6
   posicion [2,1,0]        ==  7
   posicion [0]            ==  1
   posicion [1,0]          ==  3
   posicion [2,1,0]        ==  7
   posicion [3,2,1,0]      ==  15
   posicion [4,3,2,1,0]    ==  31
   posicion [5,4,3,2,1,0]  ==  63
   length (show (posicion [3*10^7])) == 9030900

Comprobar con QuickCheck que para todo número natural n,

   posicion [n,n-1..0] == 2^(n+1) - 1.

Soluciones

import Data.List (genericLength, nub, sort)
import Test.QuickCheck
 
-- 1ª solución
-- ===========
 
posicion :: [Integer] -> Integer
posicion xs =
  genericLength (takeWhile (< xs) enumeracionCFN)
 
enumeracionCFN :: [[Integer]]
enumeracionCFN = concatMap enumeracionCFNHasta [0..]
 
-- (enumeracionCFNHasta n) es la lista de conjuntos con la enumeración
-- anterior cuyo primer elemento es n. Por ejemplo,
--    λ> enumeracionCFNHasta 1
--    [[1],[1,0]]
--    λ> enumeracionCFNHasta 2
--    [[2],[2,0],[2,1],[2,1,0]]
--    λ> enumeracionCFNHasta 3
--    [[3],[3,0],[3,1],[3,1,0],[3,2],[3,2,0],[3,2,1],[3,2,1,0]]
enumeracionCFNHasta :: Integer -> [[Integer]]
enumeracionCFNHasta 0 = [[],[0]]
enumeracionCFNHasta n =
  [n:xs | k <- [0..n-1], xs <- enumeracionCFNHasta k]
 
-- 2ª solución
-- ===========
 
posicion2 :: [Integer] -> Integer
posicion2 []     = 0
posicion2 (x:xs) = 2^x + posicion2 xs
 
-- 3ª solución
-- ===========
 
posicion3 :: [Integer] -> Integer
posicion3 = foldr (\x -> (+) (2^x)) 0 
 
-- 4ª solución
-- ===========
 
posicion4 :: [Integer] -> Integer
posicion4 xs = sum [2^x | x <- xs ]
 
-- Equivalencia de las definiciones
-- ================================
 
-- La propiedad es
prop_equiv :: [Integer] -> Bool
prop_equiv xs =
  all (== posicion xs') [f xs' | f <- [ posicion2
                                      , posicion3
                                      , posicion4]]
  where xs' = reverse (sort (nub (map abs xs)))
 
-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=15}) prop_equiv
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> posicion [19,18,17,16,14,9,6]
--    1000000
--    (2.61 secs, 1,754,265,776 bytes)
--    λ> posicion2 [19,18,17,16,14,9,6]
--    1000000
--    (0.01 secs, 111,808 bytes)
--    λ> posicion3 [19,18,17,16,14,9,6]
--    1000000
--    λ> posicion4 [19,18,17,16,14,9,6]
--    1000000
--    (0.01 secs, 111,704 bytes)
 
--    λ> length (show (posicion2 [3*10^7]))
--    9030900
--    (2.06 secs, 571,911,304 bytes)
--    λ> length (show (posicion3 [3*10^7]))
--    9030900
--    (2.06 secs, 571,911,544 bytes)
--    λ> length (show (posicion4 [3*10^7]))
--    9030900
--    (2.05 secs, 571,911,464 bytes)
 
-- Propiedad
-- =========
 
-- La propiedad es
prop_posicion :: Integer -> Property
prop_posicion n =
  n >= 0 ==> posicion3 [n,n-1..0] == 2^(n+1) - 1
 
-- La comprobación es
--    λ> quickCheck prop_posicion
--    +++ OK, passed 100 tests.

Pensamiento

¡Volar sin alas donde todo es cielo!

Antonio Machado

Conjuntos con más sumas que restas

Dado un conjunto de números naturales, por ejemplo A = {0, 2, 3, 4}, calculamos las sumas de todos los pares de elementos de A. Como A tiene 4 elementos hay 16 pares, pero no todas sus sumas son distintas. En este caso solo hay 8 sumas distintas: {0, 2, 3, 4, 5, 6, 7, 8}. Procediendo análogamente hay 9 diferencias distinatas entre los pares de A: {-4, -3, -2, -1, 0, 1, 2, 3, 4}.

Experimentando con más conjuntos, se puede conjeturar que el número de restas es mayor que el de sumas y argumentar que que mientras que con dos números distintos sólo se produce una suma distints sin embargo se producen dos restas distintas. Por ejemplo, con 5 y 7 sólo se produce una suma (ya que 5+7 y 7+5 ambos dan 12) pero dos restas (ya que 5-7 y 7-5 dan -2 y 2, respectivamente).

Sin embargo, la conjetura es falsa. Un contraejemplo en el conjunto {0, 2, 3, 4, 7, 11, 12, 14}, que tiene 26 sumas distintas con sus pares de elementos pero sólo 25 restas.

Los conjuntos con más sumas distintas con sus pares de elementos que restas se llaman conjuntos MSQR (por “más sumas que restas”).

El objetivo de este ejercicio es calcular los conjuntos MSQR.

Definir las funciones

   tieneMSQR :: [Integer] -> Bool
   conjuntosMSQR :: [[Integer]]

tales que

  • (tieneMSQR xs) se verifica si el conjunto xs tiene más sumas que restas. Por ejemplo,
     tieneMSQR [0, 2, 3, 4]                 ==  False
     tieneMSQR [0, 2, 3, 4, 7, 11, 12, 14]  ==  True
  • conjuntosMSQR es la lista de los conjuntos MSQR. Por ejemplo,
     λ> take 5 conjuntosMSQR
     [[14,12,11,7,4,3,2,0],
      [14,12,11,10,7,3,2,0],
      [14,13,12,9,5,4,2,1,0],
      [14,13,12,10,9,5,2,1,0],
      [15,13,12,8,5,4,3,1]]
 
      length (takeWhile (< [14]) conjuntosMSQR)   ==  0
      length (takeWhile (< [15]) conjuntosMSQR)   ==  4
      length (takeWhile (< [16]) conjuntosMSQR)   ==  10
      length (takeWhile (< [17]) conjuntosMSQR)   ==  30

Soluciones

import Data.List (tails, nub, sort)
 
-- 1ª solución
-- ===========
 
-- (sumas xs) es el conjunto de las sumas de pares de elementos de
-- xs. Por ejemplo,
--    sumas2 [0,2,3,4]  ==  [0,2,3,4,5,6,7,8]
sumas :: [Integer] -> [Integer]
sumas xs = nub [x + y | x <- xs, y <- xs]
 
-- (restas xs) es el conjunto de las restas de pares de elementos de
-- xs. Por ejemplo,
--    restas [0,2,3,4]  ==  [0,-2,-3,-4,2,-1,3,1,4]
restas :: [Integer] -> [Integer]
restas xs = nub [x - y | x <- xs, y <- xs]
 
tieneMSQR :: [Integer] -> Bool
tieneMSQR xs = length (sumas xs) > length (restas xs)
 
conjuntosMSQR :: [[Integer]]
conjuntosMSQR = [xs | xs <- enumeracionCFN, tieneMSQR xs]
 
-- enumeracionCFN es la enumeración de los conjuntos finitos de números
-- naturales del ejercicio anterior.
enumeracionCFN :: [[Integer]]
enumeracionCFN = concatMap enumeracionCFNHasta [0..]
 
-- (enumeracionCFNHasta n) es la lista de conjuntos con la enumeración
-- anterior cuyo primer elemento es n. Por ejemplo,
--    λ> enumeracionCFNHasta 1
--    [[1],[1,0]]
--    λ> enumeracionCFNHasta 2
--    [[2],[2,0],[2,1],[2,1,0]]
--    λ> enumeracionCFNHasta 3
--    [[3],[3,0],[3,1],[3,1,0],[3,2],[3,2,0],[3,2,1],[3,2,1,0]]
enumeracionCFNHasta :: Integer -> [[Integer]]
enumeracionCFNHasta 0 = [[],[0]]
enumeracionCFNHasta n =
  [n:xs | k <- [0..n-1], xs <- enumeracionCFNHasta k]
 
-- 2ª solución
-- ===========
 
-- (sumas2 xs) es el conjunto de las sumas de pares de elementos de
-- xs. Por ejemplo,
--    sumas2 [0,2,3,4]  ==  [0,2,3,4,5,6,7,8]
--    sumas2 [0,2,3,4]  ==  [0,2,3,4,5,6,7,8]
sumas2 :: [Integer] -> [Integer]
sumas2 xs = nub [x + y | (x:ys) <- tails xs, y <- (x:ys)]
 
-- (restas2 xs) es el conjunto de las restas de pares de elementos de
-- xs. Por ejemplo,
--    sumas2 [0,2,3,4]  ==  [0,2,3,4,5,6,7,8]
--    restas2 [0,2,3,4]  ==  [0,-2,-3,-4,2,-1,3,1,4]
restas2 :: [Integer] -> [Integer]
restas2 xs = 0 : ys ++ map negate ys
  where ys = nub [x - y | (x:ys) <- tails (sort xs), y <- ys]
 
tieneMSQR2 :: [Integer] -> Bool
tieneMSQR2 xs = length (sumas2 xs) > length (restas2 xs)
 
conjuntosMSQR2 :: [[Integer]]
conjuntosMSQR2 = [xs | xs <- enumeracionCFN, tieneMSQR2 xs]
 
-- Comparación de eficiencia
-- =========================
 
--    λ> length (takeWhile (< [17,16..0]) conjuntosMSQR)
--    66
--    (21.36 secs, 10,301,222,168 bytes)
--    λ> length (takeWhile (< [17,16..0]) conjuntosMSQR2)
--    66
--    (10.13 secs, 7,088,969,752 bytes)

Pensamiento

¡Qué fácil es volar, qué fácil es!
Todo consiste en no dejar que el suelo
se acerque a nuestros pies.

Antonio Machado