junio 2022 – Página 3

Representación matricial de relaciones binarias

PorJosé A. Alonso 9-junio-20226-junio-2022

Dada una relación r sobre un conjunto de números enteros, la matriz asociada a r es una matriz booleana p (cuyos elementos son True o False), tal que p(i,j) = True si y sólo si i está relacionado con j mediante la relación r.

Las relaciones binarias homogéneas y las matrices booleanas se pueden representar por

   type Relacion = ([Int],[(Int,Int)])
   type Matriz = Array (Int,Int) Bool

1 2	type Relacion = ([Int],[(Int,Int)]) type Matriz = Array (Int,Int) Bool

Definir la función

   matrizRB:: Relacion -> Matriz

1	matrizRB:: Relacion -> Matriz

tal que (matrizRB r) es la matriz booleana asociada a r. Por ejemplo,

   λ> matrizRB ([1..3],[(1,1), (1,3), (3,1), (3,3)])
   array ((1,1),(3,3)) [((1,1),True) ,((1,2),False),((1,3),True),
                        ((2,1),False),((2,2),False),((2,3),False),
                        ((3,1),True) ,((3,2),False),((3,3),True)]
   λ> matrizRB ([1..3],[(1,3), (3,1)])
   array ((1,1),(3,3)) [((1,1),False),((1,2),False),((1,3),True),
                        ((2,1),False),((2,2),False),((2,3),False),
                        ((3,1),True) ,((3,2),False),((3,3),False)]
   λ> let n = 10^4 in matrizRB3 ([1..n],[(1,n),(n,1)]) ! (n,n)
   False

λ> matrizRB ([1..3],[(1,1), (1,3), (3,1), (3,3)])

array ((1,1),(3,3)) [((1,1),True) ,((1,2),False),((1,3),True),

((2,1),False),((2,2),False),((2,3),False),

((3,1),True) ,((3,2),False),((3,3),True)]

λ> matrizRB ([1..3],[(1,3), (3,1)])

array ((1,1),(3,3)) [((1,1),False),((1,2),False),((1,3),True),

((2,1),False),((2,2),False),((2,3),False),

((3,1),True) ,((3,2),False),((3,3),False)]

λ> let n = 10^4 in matrizRB3 ([1..n],[(1,n),(n,1)]) ! (n,n)

False

Soluciones

import Data.Array      (Array, accumArray, array, listArray)
import Test.QuickCheck (Arbitrary, Gen, arbitrary, sublistOf, suchThat,
                        quickCheck)

type Relacion = ([Int],[(Int,Int)])
type Matriz   = Array (Int,Int) Bool

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

matrizRB1 :: Relacion -> Matriz 
matrizRB1 r = 
    array ((1,1),(n,n)) 
          [((a,b), (a,b) `elem` grafo r) | a <- [1..n], b <- [1..n]]
    where n = maximum (universo r)
          universo (us,_) = us
          grafo (_,ps)    = ps

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

matrizRB2 :: Relacion -> Matriz
matrizRB2 r = 
    listArray ((1,1),(n,n)) 
              [(a,b) `elem` snd r | a <- [1..n], b <- [1..n]]
    where n = maximum (fst r)

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

matrizRB3 :: Relacion -> Matriz
matrizRB3 r = 
    accumArray (||) False ((1,1),(n,n)) (zip (snd r) (repeat True))
    where n = maximum (fst r)

-- Comprobación de equivalencia
-- ============================

-- Tipo de relaciones binarias
newtype RB = RB Relacion
  deriving Show

-- relacionArbitraria genera una relación arbitraria. Por ejemplo, 
--    λ> generate relacionArbitraria
--    RB ([1,2,3,4,5],[(1,4),(1,5),(2,3),(2,4),(4,2),(4,3),(4,4),(5,1),(5,2),(5,3),(5,4)])
relacionArbitraria :: Gen RB
relacionArbitraria = do
  n <- arbitrary `suchThat` (> 1)
  xs <- sublistOf [(x,y) | x <- [1..n], y <- [1..n]]
  return (RB ([1..n], xs))

-- RB es una subclase de Arbitrary
instance Arbitrary RB where
  arbitrary = relacionArbitraria

-- La propiedad es
prop_matrizRB :: RB -> Bool
prop_matrizRB (RB r) =
  all (== matrizRB1 r)
      [matrizRB2 r,
       matrizRB3 r]

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

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

-- La comparación es
--    λ> let n = 2000 in matrizRB1 ([1..n],[(1,n),(n,1)]) ! (n,n)
--    False
--    (2.02 secs, 1,505,248,912 bytes)
--    λ> let n = 2000 in matrizRB2 ([1..n],[(1,n),(n,1)]) ! (n,n)
--    False
--    (1.92 secs, 833,232,360 bytes)
--    λ> let n = 2000 in matrizRB3 ([1..n],[(1,n),(n,1)]) ! (n,n)
--    False
--    (0.05 secs, 32,848,696 bytes)

import Data.Array (Array, accumArray, array, listArray)

import Test.QuickCheck (Arbitrary, Gen, arbitrary, sublistOf, suchThat,

quickCheck)

type Relacion = ([Int],[(Int,Int)])

type Matriz = Array (Int,Int) Bool

-- 1ª solución

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

matrizRB1 :: Relacion -> Matriz

matrizRB1 r =

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

[((a,b), (a,b) `elem` grafo r) | a <- [1..n], b <- [1..n]]

where n = maximum (universo r)

universo (us,_) = us

grafo (_,ps) = ps

-- 2ª solución

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

matrizRB2 :: Relacion -> Matriz

matrizRB2 r =

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

[(a,b) `elem` snd r | a <- [1..n], b <- [1..n]]

where n = maximum (fst r)

-- 3ª solución

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

matrizRB3 :: Relacion -> Matriz

matrizRB3 r =

accumArray (||) False ((1,1),(n,n)) (zip (snd r) (repeat True))

where n = maximum (fst r)

-- Comprobación de equivalencia

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

-- Tipo de relaciones binarias

newtype RB = RB Relacion

deriving Show

-- relacionArbitraria genera una relación arbitraria. Por ejemplo,

-- λ> generate relacionArbitraria

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

relacionArbitraria :: Gen RB

relacionArbitraria = do

n <- arbitrary `suchThat` (> 1)

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

return (RB ([1..n], xs))

-- RB es una subclase de Arbitrary

instance Arbitrary RB where

arbitrary = relacionArbitraria

-- La propiedad es

prop_matrizRB :: RB -> Bool

prop_matrizRB (RB r) =

all (== matrizRB1 r)

[matrizRB2 r,

matrizRB3 r]

-- La comprobación es

-- λ> quickCheck prop_matrixzB

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> let n = 2000 in matrizRB1 ([1..n],[(1,n),(n,1)]) ! (n,n)

-- False

-- (2.02 secs, 1,505,248,912 bytes)

-- λ> let n = 2000 in matrizRB2 ([1..n],[(1,n),(n,1)]) ! (n,n)

-- False

-- (1.92 secs, 833,232,360 bytes)

-- λ> let n = 2000 in matrizRB3 ([1..n],[(1,n),(n,1)]) ! (n,n)

-- False

-- (0.05 secs, 32,848,696 bytes)

El código se encuentra en GitHub.

Codificación de Gödel

PorJosé A. Alonso 8-junio-20225-junio-2022

Dada una lista de números naturales xs, codificación de Gödel de xs se obtiene multiplicando las potencias de los primos sucesivos, siendo los exponentes los sucesores de los elementos de xs. Por ejemplo, si xs = [6,0,4], la codificación de xs es

   2^7 * 3^1 * 5^5 = 1200000

1	2^7 * 3^1 * 5^5 = 1200000

Definir las funciones

   codificaG   :: [Integer] -> Integer
   decodificaG :: Integer -> [Integer]

1 2	codificaG :: [Integer] -> Integer decodificaG :: Integer -> [Integer]

tales que

(codificaG xs) es la codificación de Gödel de xs. Por ejemplo,

     codificaG [6,0,4]            ==  1200000
     codificaG [3,1,1]            ==  3600
     codificaG [3,1,0,0,0,0,0,1]  ==  4423058640
     codificaG [1..6]             ==  126111168580452537982500

codificaG [6,0,4] == 1200000

codificaG [3,1,1] == 3600

codificaG [3,1,0,0,0,0,0,1] == 4423058640

codificaG [1..6] == 126111168580452537982500

(decodificaG n) es la lista xs cuya codificación es n. Por ejemplo,

     decodificaG 1200000                   ==  [6,0,4]
     decodificaG 3600                      ==  [3,1,1]
     decodificaG 4423058640                ==  [3,1,0,0,0,0,0,1]
     decodificaG 126111168580452537982500  ==  [1,2,3,4,5,6]

decodificaG 1200000 == [6,0,4]

decodificaG 3600 == [3,1,1]

decodificaG 4423058640 == [3,1,0,0,0,0,0,1]

decodificaG 126111168580452537982500 == [1,2,3,4,5,6]

Comprobar con QuickCheck que ambas funciones son inversas; es decir,

   decodificaG (codificaG xs) = xs
   codificaG (decodificaG n) = n

1 2	decodificaG (codificaG xs) = xs codificaG (decodificaG n) = n

Soluciones

import Data.List (genericLength, group)
import Data.Numbers.Primes (primes, primeFactors)
import Test.QuickCheck (NonNegative (getNonNegative),
                        NonEmptyList (NonEmpty),
                        Positive (Positive, getPositive), quickCheck)

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

codificaG1 :: [Integer] -> Integer
codificaG1 = codificaG1' . codificaAux

codificaAux :: [Integer] -> [Integer]
codificaAux = map succ

codificaG1' :: [Integer] -> Integer
codificaG1' = aux primes
  where aux _ []          = 1
        aux (p:ps) (x:xs) = p^x * aux ps xs

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

codificaG2 :: [Integer] -> Integer
codificaG2 = codificaG2' . codificaAux

codificaG2' :: [Integer] -> Integer
codificaG2' xs = product [p^x | (p, x) <- zip primes xs]

-- 3ª definición de codificaG
-- ==========================

codificaG3 :: [Integer] -> Integer
codificaG3 = codificaG3' . codificaAux

codificaG3' :: [Integer] -> Integer
codificaG3' xs = product (zipWith (^) primes xs)

-- 4ª definición de codificaG
-- ==========================

codificaG4 :: [Integer] -> Integer
codificaG4 = codificaG4' . codificaAux

codificaG4' :: [Integer] -> Integer
codificaG4' = product . zipWith (^) primes

-- Comprobación de equivalencia de codificaG
-- =========================================

-- La propiedad es
prop_codificaG :: [NonNegative Integer] -> Bool
prop_codificaG xs =
  all (== codificaG1 ys)
      [codificaG2 ys,
       codificaG3 ys,
       codificaG4 ys]
  where ys = map getNonNegative xs

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

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

-- La comparación es
--    λ> length (show (codificaG1 (replicate (4*10^4) 1)))
--    208100
--    (1.73 secs, 2,312,100,136 bytes)
--    λ> length (show (codificaG2 (replicate (4*10^4) 1)))
--    208100
--    (1.63 secs, 2,327,676,832 bytes)
--    λ> length (show (codificaG3 (replicate (4*10^4) 1)))
--    208100
--    (1.62 secs, 2,323,836,832 bytes)
--    λ> length (show (codificaG4 (replicate (4*10^4) 1)))
--    208100
--    (1.54 secs, 2,147,635,680 bytes)

-- Definición de codificaG
-- =======================

-- Usaremos la 4ª
codificaG :: [Integer] -> Integer
codificaG = codificaG4

-- Definición de decodificaG
-- =========================

decodificaG :: Integer -> [Integer]
decodificaG = decodificaAux . decodificaG'

decodificaAux :: [Integer] -> [Integer]
decodificaAux = map pred

decodificaG' :: Integer -> [Integer]
decodificaG' 1 = [0]
decodificaG' n = aux primes (group (primeFactors n))
  where aux _ [] = []
        aux (x:xs) ((y:ys):yss) | x == y    = 1 + genericLength ys : aux xs yss
                                | otherwise = 0 : aux xs ((y:ys):yss)

-- Comprobación de propiedades
-- ===========================

-- La primera propiedad es
prop_decodificaG_codificaG :: NonEmptyList (NonNegative Integer) -> Bool
prop_decodificaG_codificaG (NonEmpty xs) = 
  decodificaG (codificaG ys) == ys
  where ys = map getNonNegative xs

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

-- La 2ª propiedad es
prop_codificaG_decodificaG :: Positive Integer -> Bool
prop_codificaG_decodificaG (Positive n) = 
  codificaG (decodificaG n) == n

-- la comprobación es
--    λ> quickCheck prop_codificaG_decodificaG
--    +++ OK, passed 100 tests.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

import Data.List (genericLength, group)

import Data.Numbers.Primes (primes, primeFactors)

import Test.QuickCheck (NonNegative (getNonNegative),

NonEmptyList (NonEmpty),

Positive (Positive, getPositive), quickCheck)

-- 1ª definición de codificaG

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

codificaG1 :: [Integer] -> Integer

codificaG1 = codificaG1' . codificaAux

codificaAux :: [Integer] -> [Integer]

codificaAux = map succ

codificaG1' :: [Integer] -> Integer

codificaG1' = aux primes

where aux _ [] = 1

aux (p:ps) (x:xs) = p^x * aux ps xs

-- 2ª definición de codificaG

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

codificaG2 :: [Integer] -> Integer

codificaG2 = codificaG2' . codificaAux

codificaG2' :: [Integer] -> Integer

codificaG2' xs = product [p^x | (p, x) <- zip primes xs]

-- 3ª definición de codificaG

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

codificaG3 :: [Integer] -> Integer

codificaG3 = codificaG3' . codificaAux

codificaG3' :: [Integer] -> Integer

codificaG3' xs = product (zipWith (^) primes xs)

-- 4ª definición de codificaG

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

codificaG4 :: [Integer] -> Integer

codificaG4 = codificaG4' . codificaAux

codificaG4' :: [Integer] -> Integer

codificaG4' = product . zipWith (^) primes

-- Comprobación de equivalencia de codificaG

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

-- La propiedad es

prop_codificaG :: [NonNegative Integer] -> Bool

prop_codificaG xs =

all (== codificaG1 ys)

[codificaG2 ys,

codificaG3 ys,

codificaG4 ys]

where ys = map getNonNegative xs

-- La comprobación es

-- λ> quickCheck prop_codificaG

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia de codificaG

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

-- La comparación es

-- λ> length (show (codificaG1 (replicate (4*10^4) 1)))

-- 208100

-- (1.73 secs, 2,312,100,136 bytes)

-- λ> length (show (codificaG2 (replicate (4*10^4) 1)))

-- 208100

-- (1.63 secs, 2,327,676,832 bytes)

-- λ> length (show (codificaG3 (replicate (4*10^4) 1)))

-- 208100

-- (1.62 secs, 2,323,836,832 bytes)

-- λ> length (show (codificaG4 (replicate (4*10^4) 1)))

-- 208100

-- (1.54 secs, 2,147,635,680 bytes)

-- Definición de codificaG

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

-- Usaremos la 4ª

codificaG :: [Integer] -> Integer

codificaG = codificaG4

-- Definición de decodificaG

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

decodificaG :: Integer -> [Integer]

decodificaG = decodificaAux . decodificaG'

decodificaAux :: [Integer] -> [Integer]

decodificaAux = map pred

decodificaG' :: Integer -> [Integer]

decodificaG' 1 = [0]

decodificaG' n = aux primes (group (primeFactors n))

where aux _ [] = []

aux (x:xs) ((y:ys):yss) | x == y = 1 + genericLength ys : aux xs yss

| otherwise = 0 : aux xs ((y:ys):yss)

-- Comprobación de propiedades

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

-- La primera propiedad es

prop_decodificaG_codificaG :: NonEmptyList (NonNegative Integer) -> Bool

prop_decodificaG_codificaG (NonEmpty xs) =

decodificaG (codificaG ys) == ys

where ys = map getNonNegative xs

-- La comprobación es

-- λ> quickCheck prop_decodificaG_codificaG

-- +++ OK, passed 100 tests.

-- La 2ª propiedad es

prop_codificaG_decodificaG :: Positive Integer -> Bool

prop_codificaG_decodificaG (Positive n) =

codificaG (decodificaG n) == n

-- la comprobación es

-- λ> quickCheck prop_codificaG_decodificaG

-- +++ OK, passed 100 tests.

El código se encuentra en GitHub.

Primos circulares

PorJosé A. Alonso 7-junio-20223-junio-2022

Un primo circular es un número tal que todas las rotaciones de dígitos producen números primos. Por ejemplo, 195 es un primo circular ya que las rotaciones de sus dígitos son 197, 971 y 719 y los tres números son primos.

Definir la lista

   circulares :: [Integer]

1	circulares :: [Integer]

cuyo valor es la lista de los números primos circulares. Por ejemplo,

   take 16 circulares == [2,3,5,7,11,13,17,31,37,71,73,79,97,113,131,197]
   circulares !! 50   == 933199

1 2	take 16 circulares == [2,3,5,7,11,13,17,31,37,71,73,79,97,113,131,197] circulares !! 50 == 933199

Soluciones

import Data.Numbers.Primes (isPrime, primes)
import Test.QuickCheck (Positive (Positive), quickCheck)

-- 1ª solución
-- ===========
  
circulares1 :: [Integer]
circulares1 = filter esCircular1 primes

-- (esCircular1 n) se verifica si n es un número circular. Por ejemplo, 
--    esCircular1 197  ==  True
--    esCircular1 157  ==  False
esCircular1 :: Integer -> Bool
esCircular1 = all (isPrime . read) . rotaciones1 . show 

-- (rotaciones1 xs) es la lista de las rotaciones obtenidas desplazando
-- el primer elemento xs al final. Por ejemplo,
--    rotaciones1 [2,3,5]  ==  [[2,3,5],[3,5,2],[5,2,3]]
rotaciones1 :: [a] -> [[a]]
rotaciones1 xs = reverse (aux (length xs) [xs])
    where aux 1 yss      = yss
          aux n (ys:yss) = aux (n-1) (rota ys : ys :yss)

-- 2ª solución
-- ===========
  
circulares2 :: [Integer]
circulares2 = filter esCircular2 primes

esCircular2 :: Integer -> Bool
esCircular2 = all (isPrime . read) . rotaciones2 . show 

rotaciones2 :: [a] -> [[a]]
rotaciones2 xs = take (length xs) (iterate rota xs)

-- (rota xs) es la lista añadiendo el primer elemento de xs al
-- final. Por ejemplo, 
--    rota [3,2,5,7]  ==  [2,5,7,3]
rota :: [a] -> [a]
rota (x:xs) = xs ++ [x]

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

circulares3 :: [Integer]
circulares3 = filter (all isPrime . rotaciones3) primes 

rotaciones3 :: Integer -> [Integer]
rotaciones3 n = [read (take m (drop i (cycle s))) | i <- [1..m]]
    where s = show n
          m = length s

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

-- Nota. La 4ª definición es una mejora observando que para que n sea un
-- número primo circular es necesario que todos los dígitos de n sean
-- impares, salvo para n = 2. 

circulares4 :: [Integer]
circulares4 = 2 : filter esCircular4 primes

-- (esCircular4 n) se verifica si n es un número circular. Por ejemplo, 
--    esCircular4 197  ==  True
--    esCircular4 157  ==  False
esCircular4 :: Integer -> Bool
esCircular4 n = digitosImpares n && 
                all (isPrime . read) (rotaciones2 (show n))

-- (digitosImpares n) se verifica si todos los dígitos de n son
-- impares. Por ejemplo,
--    digitosImpares 7351  ==  True
--    digitosImpares 7341  ==  False
digitosImpares :: Integer -> Bool
digitosImpares = all (`elem` "135679") . show

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_circulares :: Positive Int -> Bool
prop_circulares (Positive n) =
  all (== circulares1 !! n)
      [circulares2 !! n,
       circulares3 !! n,
       circulares4 !! n]

-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=50}) prop_circulares
--    +++ OK, passed 100 tests.

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

-- La comparación es
--    λ> circulares1 !! 46
--    331999
--    (2.08 secs, 7,229,208,200 bytes)
--    λ> circulares2 !! 46
--    331999
--    (1.93 secs, 7,165,043,992 bytes)
--    λ> circulares3 !! 46
--    331999
--    (0.74 secs, 2,469,098,648 bytes)
--    λ> circulares4 !! 46
--    331999
--    (0.28 secs, 917,501,600 bytes)

100

101

102

103

104

105

106

107

import Data.Numbers.Primes (isPrime, primes)

import Test.QuickCheck (Positive (Positive), quickCheck)

-- 1ª solución

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

circulares1 :: [Integer]

circulares1 = filter esCircular1 primes

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

-- esCircular1 197 == True

-- esCircular1 157 == False

esCircular1 :: Integer -> Bool

esCircular1 = all (isPrime . read) . rotaciones1 . show

-- (rotaciones1 xs) es la lista de las rotaciones obtenidas desplazando

-- el primer elemento xs al final. Por ejemplo,

-- rotaciones1 [2,3,5] == [[2,3,5],[3,5,2],[5,2,3]]

rotaciones1 :: [a] -> [[a]]

rotaciones1 xs = reverse (aux (length xs) [xs])

where aux 1 yss = yss

aux n (ys:yss) = aux (n-1) (rota ys : ys :yss)

-- 2ª solución

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

circulares2 :: [Integer]

circulares2 = filter esCircular2 primes

esCircular2 :: Integer -> Bool

esCircular2 = all (isPrime . read) . rotaciones2 . show

rotaciones2 :: [a] -> [[a]]

rotaciones2 xs = take (length xs) (iterate rota xs)

-- (rota xs) es la lista añadiendo el primer elemento de xs al

-- final. Por ejemplo,

-- rota [3,2,5,7] == [2,5,7,3]

rota :: [a] -> [a]

rota (x:xs) = xs ++ [x]

-- 3ª solución

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

circulares3 :: [Integer]

circulares3 = filter (all isPrime . rotaciones3) primes

rotaciones3 :: Integer -> [Integer]

rotaciones3 n = [read (take m (drop i (cycle s))) | i <- [1..m]]

where s = show n

m = length s

-- 4ª definición

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

-- Nota. La 4ª definición es una mejora observando que para que n sea un

-- número primo circular es necesario que todos los dígitos de n sean

-- impares, salvo para n = 2.

circulares4 :: [Integer]

circulares4 = 2 : filter esCircular4 primes

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

-- esCircular4 197 == True

-- esCircular4 157 == False

esCircular4 :: Integer -> Bool

esCircular4 n = digitosImpares n &&

all (isPrime . read) (rotaciones2 (show n))

-- (digitosImpares n) se verifica si todos los dígitos de n son

-- impares. Por ejemplo,

-- digitosImpares 7351 == True

-- digitosImpares 7341 == False

digitosImpares :: Integer -> Bool

digitosImpares = all (`elem` "135679") . show

-- Comprobación de equivalencia

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

-- La propiedad es

prop_circulares :: Positive Int -> Bool

prop_circulares (Positive n) =

all (== circulares1 !! n)

[circulares2 !! n,

circulares3 !! n,

circulares4 !! n]

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=50}) prop_circulares

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> circulares1 !! 46

-- 331999

-- (2.08 secs, 7,229,208,200 bytes)

-- λ> circulares2 !! 46

-- 331999

-- (1.93 secs, 7,165,043,992 bytes)

-- λ> circulares3 !! 46

-- 331999

-- (0.74 secs, 2,469,098,648 bytes)

-- λ> circulares4 !! 46

-- 331999

-- (0.28 secs, 917,501,600 bytes)

El código se encuentra en GitHub.

Diccionario de frecuencias

PorJosé A. Alonso 6-junio-20222-junio-2022

Definir la función

   frecuencias :: Ord a => [a] -> Map a Int

1	frecuencias :: Ord a => [a] -> Map a Int

tal que (frecuencias xs) es el diccionario formado por los elementos de xs junto con el número de veces que aparecen en xs. Por ejemplo,

   λ> frecuencias "sosos"
   fromList [('o',2),('s',3)]
   λ> frecuencias (show (10^100))
   fromList [('0',100),('1',1)]
   λ> frecuencias (take (10^6) (cycle "abc"))
   fromList [('a',333334),('b',333333),('c',333333)]
   λ> size (frecuencias (take (10^6) (cycle [1..10^6])))
   1000000

λ> frecuencias "sosos"

fromList [('o',2),('s',3)]

λ> frecuencias (show (10^100))

fromList [('0',100),('1',1)]

λ> frecuencias (take (10^6) (cycle "abc"))

fromList [('a',333334),('b',333333),('c',333333)]

λ> size (frecuencias (take (10^6) (cycle [1..10^6])))

1000000

Soluciones

import Data.List (foldl')
import Data.Map (Map, empty, insertWith, fromList, fromListWith, size)
import Test.QuickCheck

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

frecuencias1 :: Ord a => [a] -> Map a Int
frecuencias1 []     = empty
frecuencias1 (x:xs) = insertWith (+) x 1 (frecuencias1 xs)

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

frecuencias2 :: Ord a => [a] -> Map a Int
frecuencias2 = foldl' (\d x-> insertWith (+) x 1 d) empty

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

frecuencias3 :: Ord a => [a] -> Map a Int
frecuencias3 xs = fromListWith (+) (zip xs (repeat 1))

-- Equivalencia de las definiciones
-- ================================

-- La propiedad es
prop_frecuencias :: [Int] -> Bool
prop_frecuencias xs =
  all (== frecuencias1 xs)
      [ frecuencias2 xs
      , frecuencias3 xs]

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

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

-- La comparación es
--    λ> frecuencias1 (take (10^6) (cycle "abc"))
--    fromList [('a',333334),('b',333333),('c',333333)]
--    (0.89 secs, 453,842,448 bytes)
--    λ> frecuencias2 (take (10^6) (cycle "abc"))
--    fromList [('a',333334),('b',333333),('c',333333)]
--    (0.54 secs, 274,181,128 bytes)
--    λ> frecuencias3 (take (10^6) (cycle "abc"))
--    fromList [('a',333334),('b',333333),('c',333333)]
--    (0.29 secs, 313,787,976 bytes)
     
--    λ> size (frecuencias1 (take (10^6) (cycle [1..10^6])))
--    1000000
--    (3.76 secs, 2,651,926,024 bytes)
--    λ> size (frecuencias2 (take (10^6) (cycle [1..10^6])))
--    1000000
--    (1.03 secs, 1,640,678,448 bytes)
--    λ> size (frecuencias3 (take (10^6) (cycle [1..10^6])))
--    1000000
--    (0.88 secs, 1,672,678,536 bytes)

import Data.List (foldl')

import Data.Map (Map, empty, insertWith, fromList, fromListWith, size)

import Test.QuickCheck

-- 1ª solución

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

frecuencias1 :: Ord a => [a] -> Map a Int

frecuencias1 [] = empty

frecuencias1 (x:xs) = insertWith (+) x 1 (frecuencias1 xs)

-- 2ª solución

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

frecuencias2 :: Ord a => [a] -> Map a Int

frecuencias2 = foldl' (\d x-> insertWith (+) x 1 d) empty

-- 3ª solución

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

frecuencias3 :: Ord a => [a] -> Map a Int

frecuencias3 xs = fromListWith (+) (zip xs (repeat 1))

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_frecuencias :: [Int] -> Bool

prop_frecuencias xs =

all (== frecuencias1 xs)

[ frecuencias2 xs

, frecuencias3 xs]

-- La comprobación es

-- λ> quickCheck prop_frecuencias

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> frecuencias1 (take (10^6) (cycle "abc"))

-- fromList [('a',333334),('b',333333),('c',333333)]

-- (0.89 secs, 453,842,448 bytes)

-- λ> frecuencias2 (take (10^6) (cycle "abc"))

-- fromList [('a',333334),('b',333333),('c',333333)]

-- (0.54 secs, 274,181,128 bytes)

-- λ> frecuencias3 (take (10^6) (cycle "abc"))

-- fromList [('a',333334),('b',333333),('c',333333)]

-- (0.29 secs, 313,787,976 bytes)

-- λ> size (frecuencias1 (take (10^6) (cycle [1..10^6])))

-- 1000000

-- (3.76 secs, 2,651,926,024 bytes)

-- λ> size (frecuencias2 (take (10^6) (cycle [1..10^6])))

-- 1000000

-- (1.03 secs, 1,640,678,448 bytes)

-- λ> size (frecuencias3 (take (10^6) (cycle [1..10^6])))

-- 1000000

-- (0.88 secs, 1,672,678,536 bytes)

El código se encuentra en GitHub.

Descomposiciones con sumandos 1 ó 2

PorJosé A. Alonso 3-junio-20225-junio-2022

Definir la funciones

   sumas  :: Int -> [[Int]]
   nSumas :: Int -> Integer

1 2	sumas :: Int -> [[Int]] nSumas :: Int -> Integer

tales que

(sumas n) es la lista de las descomposiciones de n como sumas cuyos sumandos son 1 ó 2. Por ejemplo,

      sumas 1            ==  [[1]]
      sumas 2            ==  [[1,1],[2]]
      sumas 3            ==  [[1,1,1],[1,2],[2,1]]
      sumas 4            ==  [[1,1,1,1],[1,1,2],[1,2,1],[2,1,1],[2,2]]
      length (sumas 26)  ==  196418
      length (sumas 33)  ==  5702887

sumas 1 == [[1]]

sumas 2 == [[1,1],[2]]

sumas 3 == [[1,1,1],[1,2],[2,1]]

sumas 4 == [[1,1,1,1],[1,1,2],[1,2,1],[2,1,1],[2,2]]

length (sumas 26) == 196418

length (sumas 33) == 5702887

(nSumas n) es el número de descomposiciones de n como sumas cuyos sumandos son 1 ó 2. Por ejemplo,

      nSumas 4                      ==  5
      nSumas 123                    ==  36726740705505779255899443
      length (show (nSumas 123456)) ==  25801

nSumas 4 == 5

nSumas 123 == 36726740705505779255899443

length (show (nSumas 123456)) == 25801

Soluciones

import Data.List  (genericIndex, genericLength)
import Data.Array ((!), array)
import Test.QuickCheck (Positive(Positive), quickCheckWith)

-- 1ª solución de sumas
-- ====================

sumas1 :: Int -> [[Int]]
sumas1 0 = [[]]
sumas1 1 = [[1]]
sumas1 n = [1:xs | xs <- sumas1 (n-1)] ++ [2:xs | xs <- sumas1 (n-2)]

-- 2ª solución de sumas
-- ====================

sumas2 :: Int -> [[Int]]
sumas2 0 = [[]]
sumas2 1 = [[1]]
sumas2 n = map (1:) (sumas2 (n-1)) ++ map (2:) (sumas2 (n-2))

-- 3ª solución de sumas
-- ====================

sumas3 :: Int -> [[Int]]
sumas3 n = v ! n
  where v = array (0,n) [(i, f i) | i <- [0..n]]
        f 0 = [[]]
        f 1 = [[1]]
        f k = map (1:) (v!(k-1)) ++ map (2:) (v!(k-2))
 
-- 4ª solución de sumas
-- ====================

sumas4 :: Int -> [[Int]]
sumas4 n = sucSumas !! n

-- sucSumas es la sucesión cuyo n-ésimo elemento es la lista de las
-- descomposiciones de n como sumas cuyos sumandos son 1 ó 2. Por
-- ejemplo,
--    λ> take 4 sucSumas
--    [[[]],[[1]],[[1,1],[2]],[[1,1,1],[1,2],[2,1]]]
--    λ> mapM_ print (take 5 sucSumas)
--    [[]]
--    [[1]]
--    [[1,1],[2]]
--    [[1,1,1],[1,2],[2,1]]
--    [[1,1,1,1],[1,1,2],[1,2,1],[2,1,1],[2,2]]
sucSumas :: [[[Int]]]
sucSumas = [[]] : [[1]] : zipWith f (tail sucSumas) sucSumas
  where f xs ys = map (1:) xs ++ map (2:) ys

-- Comprobación de equivalencia de sumas
-- =====================================

-- La propiedad es
prop_sumas :: Positive Int -> Bool
prop_sumas (Positive n) =
  all (== sumas1 n)
      [sumas2 n,
       sumas3 n,
       sumas4 n]

-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=20}) prop_sumas
--    +++ OK, passed 100 tests.

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

-- La comparación es
--    λ> length (sumas1 28)
--    514229
--    (2.79 secs, 1,739,784,512 bytes)
--    λ> length (sumas2 28)
--    514229
--    (1.33 secs, 1,512,291,248 bytes)
--    λ> length (sumas3 28)
--    514229
--    (0.20 secs, 165,215,800 bytes)
--    λ> length (sumas4 28)
--    514229
--    (0.17 secs, 165,201,592 bytes)
--
--    λ> length (sumas3 33)
--    5702887
--    (2.16 secs, 1,830,761,864 bytes)
--    λ> length (sumas4 33)
--    5702887
--    (1.44 secs, 1,830,749,832 bytes)

-- Definición de sumas
-- ===================

-- La cuarta solución es más eficiente y es la que usaremos en lo
-- sucesivo:
sumas :: Int -> [[Int]]
sumas = sumas4

-- 1ª solución de nSumas
-- =====================

nSumas1 :: Int -> Integer
nSumas1 = genericLength . sumas2

-- 2ª solución de nSumas
-- =====================

nSumas2 :: Int -> Integer
nSumas2 0 = 1
nSumas2 1 = 1
nSumas2 n = nSumas2 (n-1) + nSumas2 (n-2)

-- 3ª solución de nSumas
-- =====================

nSumas3 :: Int -> Integer
nSumas3 n = v ! n
  where v = array (0,n) [(i,f i) | i <- [0..n]]
        f 0 = 1
        f 1 = 1
        f k = v ! (k-1) + v ! (k-2)

-- 4ª solución de nSumas
-- =====================

nSumas4 :: Int -> Integer
nSumas4 n = aux `genericIndex` n
  where aux = 1 : 1 : zipWith (+) aux (tail aux) 

-- Comprobación de equivalencia de nSumas
-- ======================================

-- La propiedad es
prop_nSumas :: Positive Int -> Bool
prop_nSumas (Positive n) =
  all (== nSumas1 n)
      [nSumas2 n,
       nSumas3 n,
       nSumas4 n]

-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=20}) prop_nSumas
--    +++ OK, passed 100 tests.

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

-- La comparación es
--    λ> nSumas1 33
--    5702887
--    (17.32 secs, 23,140,562,600 bytes)
--    λ> nSumas2 33
--    5702887
--    (3.48 secs, 1,870,676,904 bytes)
--    λ> nSumas3 33
--    5702887
--    (0.00 secs, 152,960 bytes)
--    λ> nSumas4 33
--    5702887
--    (0.00 secs, 139,456 bytes)
--    
--    λ> length (show (nSumas3 (2*10^5)))
--    41798
--    (1.41 secs, 1,895,295,528 bytes)
--    λ> length (show (nSumas4 (2*10^5)))
--    41798
--    (2.39 secs, 1,834,998,800 bytes)

-- Nota. El valor de (nSumas n) es el n-ésimo término de la sucesión de
-- Fibonacci 1, 1, 2, 3, 5, 8, ...

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

import Data.List (genericIndex, genericLength)

import Data.Array ((!), array)

import Test.QuickCheck (Positive(Positive), quickCheckWith)

-- 1ª solución de sumas

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

sumas1 :: Int -> [[Int]]

sumas1 0 = [[]]

sumas1 1 = [[1]]

sumas1 n = [1:xs | xs <- sumas1 (n-1)] ++ [2:xs | xs <- sumas1 (n-2)]

-- 2ª solución de sumas

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

sumas2 :: Int -> [[Int]]

sumas2 0 = [[]]

sumas2 1 = [[1]]

sumas2 n = map (1:) (sumas2 (n-1)) ++ map (2:) (sumas2 (n-2))

-- 3ª solución de sumas

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

sumas3 :: Int -> [[Int]]

sumas3 n = v ! n

where v = array (0,n) [(i, f i) | i <- [0..n]]

f 0 = [[]]

f 1 = [[1]]

f k = map (1:) (v!(k-1)) ++ map (2:) (v!(k-2))

-- 4ª solución de sumas

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

sumas4 :: Int -> [[Int]]

sumas4 n = sucSumas !! n

-- sucSumas es la sucesión cuyo n-ésimo elemento es la lista de las

-- descomposiciones de n como sumas cuyos sumandos son 1 ó 2. Por

-- ejemplo,

-- λ> take 4 sucSumas

-- [[[]],[[1]],[[1,1],[2]],[[1,1,1],[1,2],[2,1]]]

-- λ> mapM_ print (take 5 sucSumas)

-- [[]]

-- [[1]]

-- [[1,1],[2]]

-- [[1,1,1],[1,2],[2,1]]

-- [[1,1,1,1],[1,1,2],[1,2,1],[2,1,1],[2,2]]

sucSumas :: [[[Int]]]

sucSumas = [[]] : [[1]] : zipWith f (tail sucSumas) sucSumas

where f xs ys = map (1:) xs ++ map (2:) ys

-- Comprobación de equivalencia de sumas

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

-- La propiedad es

prop_sumas :: Positive Int -> Bool

prop_sumas (Positive n) =

all (== sumas1 n)

[sumas2 n,

sumas3 n,

sumas4 n]

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=20}) prop_sumas

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia de sumas

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

-- La comparación es

-- λ> length (sumas1 28)

-- 514229

-- (2.79 secs, 1,739,784,512 bytes)

-- λ> length (sumas2 28)

-- 514229

-- (1.33 secs, 1,512,291,248 bytes)

-- λ> length (sumas3 28)

-- 514229

-- (0.20 secs, 165,215,800 bytes)

-- λ> length (sumas4 28)

-- 514229

-- (0.17 secs, 165,201,592 bytes)

-- λ> length (sumas3 33)

-- 5702887

-- (2.16 secs, 1,830,761,864 bytes)

-- λ> length (sumas4 33)

-- 5702887

-- (1.44 secs, 1,830,749,832 bytes)

-- Definición de sumas

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

-- La cuarta solución es más eficiente y es la que usaremos en lo

-- sucesivo:

sumas :: Int -> [[Int]]

sumas = sumas4

-- 1ª solución de nSumas

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

nSumas1 :: Int -> Integer

nSumas1 = genericLength . sumas2

-- 2ª solución de nSumas

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

nSumas2 :: Int -> Integer

nSumas2 0 = 1

nSumas2 1 = 1

nSumas2 n = nSumas2 (n-1) + nSumas2 (n-2)

-- 3ª solución de nSumas

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

nSumas3 :: Int -> Integer

nSumas3 n = v ! n

where v = array (0,n) [(i,f i) | i <- [0..n]]

f 0 = 1

f 1 = 1

f k = v ! (k-1) + v ! (k-2)

-- 4ª solución de nSumas

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

nSumas4 :: Int -> Integer

nSumas4 n = aux `genericIndex` n

where aux = 1 : 1 : zipWith (+) aux (tail aux)

-- Comprobación de equivalencia de nSumas

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

-- La propiedad es

prop_nSumas :: Positive Int -> Bool

prop_nSumas (Positive n) =

all (== nSumas1 n)

[nSumas2 n,

nSumas3 n,

nSumas4 n]

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=20}) prop_nSumas

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia de nSumas

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

-- La comparación es

-- λ> nSumas1 33

-- 5702887

-- (17.32 secs, 23,140,562,600 bytes)

-- λ> nSumas2 33

-- 5702887

-- (3.48 secs, 1,870,676,904 bytes)

-- λ> nSumas3 33

-- 5702887

-- (0.00 secs, 152,960 bytes)

-- λ> nSumas4 33

-- 5702887

-- (0.00 secs, 139,456 bytes)

-- λ> length (show (nSumas3 (2*10^5)))

-- 41798

-- (1.41 secs, 1,895,295,528 bytes)

-- λ> length (show (nSumas4 (2*10^5)))

-- 41798

-- (2.39 secs, 1,834,998,800 bytes)

-- Nota. El valor de (nSumas n) es el n-ésimo término de la sucesión de

-- Fibonacci 1, 1, 2, 3, 5, 8, ...

El código se encuentra en GitHub.

Meses: junio 2022

Representación matricial de relaciones binarias

Soluciones

Codificación de Gödel

Soluciones

Primos circulares

Soluciones

Diccionario de frecuencias

Soluciones

Descomposiciones con sumandos 1 ó 2

Soluciones

Entradas recientes

Buscar

Correo electrónico