Orden superior

Superación de límites

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

Una sucesión de puntuaciones se puede representar mediante una lista de números. Por ejemplo, [7,5,9,9,4,5,4,2,5,9,12,1]. En la lista anterior, los puntos en donde se alcanzan un nuevo máximo son 7, 9 y 12 (porque son mayores que todos sus anteriores) y en donde se alcanzan un nuevo mínimo son 7, 5, 4, 2 y 1 (porque son menores que todos sus anteriores). Por tanto, el máximo se ha superado 2 veces y el mínimo 4 veces.

Definir las funciones

   nuevosMaximos :: [Int] -> [Int]
   nuevosMinimos :: [Int] -> [Int]
   nRupturas     :: [Int] -> (Int,Int)

nuevosMaximos :: [Int] -> [Int]

nuevosMinimos :: [Int] -> [Int]

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

tales que

(nuevosMaximos xs) es la lista de los nuevos máximos de xs. Por ejemplo,

     nuevosMaximos [7,5,9,9,4,5,4,2,5,9,12,1]  ==  [7,9,12]

1	nuevosMaximos [7,5,9,9,4,5,4,2,5,9,12,1] == [7,9,12]

(nuevosMinimos xs) es la lista de los nuevos mínimos de xs. Por ejemplo,

     nuevosMinimos [7,5,9,9,4,5,4,2,5,9,12,1]  ==  [7,5,4,2,1]

1	nuevosMinimos [7,5,9,9,4,5,4,2,5,9,12,1] == [7,5,4,2,1]

(nRupturas xs) es el par formado por el número de veces que se supera el máximo y el número de veces que se supera el mínimo en xs. Por ejemplo,

     nRupturas [7,5,9,9,4,5,4,2,5,9,12,1]  ==  (2,4)

1	nRupturas [7,5,9,9,4,5,4,2,5,9,12,1] == (2,4)

Soluciones

import Data.List (group, inits)

nuevosMaximos :: [Int] -> [Int]
nuevosMaximos xs = map head (group (map maximum xss))
  where xss = tail (inits xs)

nuevosMinimos :: [Int] -> [Int]
nuevosMinimos xs = map head (group (map minimum xss))
  where xss = tail (inits xs)

nRupturas :: [Int] -> (Int,Int)
nRupturas [] = (0,0)
nRupturas xs =
  ( length (nuevosMaximos xs) - 1
  , length (nuevosMinimos xs) - 1)

import Data.List (group, inits)

nuevosMaximos :: [Int] -> [Int]

nuevosMaximos xs = map head (group (map maximum xss))

where xss = tail (inits xs)

nuevosMinimos :: [Int] -> [Int]

nuevosMinimos xs = map head (group (map minimum xss))

where xss = tail (inits xs)

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

nRupturas [] = (0,0)

nRupturas xs =

( length (nuevosMaximos xs) - 1

, length (nuevosMinimos xs) - 1)

Pensamiento

«Todo necio confunde valor y precio.» ~ Antonio Machado.

Expresiones aritméticas generales

PorJosé A. Alonso 13-diciembre-201825-marzo-2022

Las expresiones aritméticas. generales se contruyen con las sumas generales (sumatorios) y productos generales (productorios). Su tipo es

   data Expresion = N Int
                  | S [Expresion]
                  | P [Expresion]
     deriving Show

data Expresion = N Int

| S [Expresion]

| P [Expresion]

deriving Show

Por ejemplo, la expresión (2 * (1 + 2 + 1) * (2 + 3)) + 1 se representa por S [P [N 2, S [N 1, N 2, N 1], S [N 2, N 3]], N 1]

Definir la función

   valor :: Expresion -> Int

1	valor :: Expresion -> Int

tal que (valor e) es el valor de la expresión e. Por ejemplo,

   λ> valor (S [P [N 2, S [N 1, N 2, N 1], S [N 2, N 3]], N 1])
   41

1 2	λ> valor (S [P [N 2, S [N 1, N 2, N 1], S [N 2, N 3]], N 1]) 41

Soluciones

data Expresion = N Int
               | S [Expresion]
               | P [Expresion]
  deriving Show

valor :: Expresion -> Int
valor (N x)  = x
valor (S es) = sum (map valor es)
valor (P es) = product (map valor es)

data Expresion = N Int

| S [Expresion]

| P [Expresion]

deriving Show

valor :: Expresion -> Int

valor (N x) = x

valor (S es) = sum (map valor es)

valor (P es) = product (map valor es)

Pensamiento

Vivir es devorar tiempo, esperar; y por muy trascendente que quiera ser nuestra espera, siempre será espera de seguir esperando.

Antonio Machado

Entre dos conjuntos

PorJosé A. Alonso 12-diciembre-201817-enero-2019

Se dice que un x número se encuentra entre dos conjuntos xs e ys si x es divisible por todos los elementos de xs y todos los elementos de zs son divisibles por x. Por ejemplo, 12 se encuentra entre los conjuntos {2, 6} y {24, 36}.

Definir la función

   entreDosConjuntos :: [Int] -> [Int] -> [Int]

1	entreDosConjuntos :: [Int] -> [Int] -> [Int]

tal que (entreDosConjuntos xs ys) es la lista de elementos entre xs e ys (se supone que xs e ys son listas no vacías de números enteros positivos). Por ejemplo,

   entreDosConjuntos [2,6] [24,36]     ==  [6,12]
   entreDosConjuntos [2,4] [32,16,96]  ==  [4,8,16]

1 2	entreDosConjuntos [2,6] [24,36] == [6,12] entreDosConjuntos [2,4] [32,16,96] == [4,8,16]

Otros ejemplos

   λ> (xs,a) = ([1..15],product xs) 
   λ> length (entreDosConjuntos5 xs [a,2*a..10*a])
   270
   λ> (xs,a) = ([1..16],product xs) 
   λ> length (entreDosConjuntos5 xs [a,2*a..10*a])
   360

λ> (xs,a) = ([1..15],product xs)

λ> length (entreDosConjuntos5 xs [a,2*a..10*a])

270

λ> (xs,a) = ([1..16],product xs)

λ> length (entreDosConjuntos5 xs [a,2*a..10*a])

360

Soluciones

import Test.QuickCheck 

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

entreDosConjuntos :: [Int] -> [Int] -> [Int]
entreDosConjuntos xs ys =
  [z | z <- [a..b]
     , and [z `mod` x == 0 | x <- xs]
     , and [y `mod` z == 0 | y <- ys]]
  where a = maximum xs
        b = minimum ys

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

entreDosConjuntos2 :: [Int] -> [Int] -> [Int]
entreDosConjuntos2 xs ys =
  [z | z <- [a..b]
     , all (`divideA` z) xs
     , all (z `divideA`) ys]
  where a = mcmL xs
        b = mcdL ys

--    mcmL [2,3,18]  ==  18
--    mcmL [2,3,15]  ==  30
mcdL :: [Int] -> Int
mcdL [x]    = x
mcdL (x:xs) = gcd x (mcdL xs)

--    mcmL [12,30,18]  ==  6
--    mcmL [12,30,14]  ==  2
mcmL :: [Int] -> Int
mcmL [x]    = x
mcmL (x:xs) = lcm x (mcmL xs)

divideA :: Int -> Int -> Bool
divideA x y = y `mod` x == 0

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

entreDosConjuntos3 :: [Int] -> [Int] -> [Int]
entreDosConjuntos3 xs ys =
  [z | z <- [a..b]
     , all (`divideA` z) xs
     , all (z `divideA`) ys]
  where a = mcmL2 xs
        b = mcdL2 ys

-- Definición equivalente
mcdL2 :: [Int] -> Int
mcdL2 = foldl1 gcd

-- Definición equivalente
mcmL2 :: [Int] -> Int
mcmL2 = foldl1 lcm

-- 4ª solución
-- ===========

entreDosConjuntos4 :: [Int] -> [Int] -> [Int]
entreDosConjuntos4 xs ys =
  [z | z <- [a,a+a..b]
     , z `divideA` b] 
  where a = mcmL2 xs
        b = mcdL2 ys

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

entreDosConjuntos5 :: [Int] -> [Int] -> [Int]
entreDosConjuntos5 xs ys =
  filter (`divideA` b) [a,a+a..b]
  where a = mcmL2 xs
        b = mcdL2 ys

-- Equivalencia
-- ============

-- Para comprobar la equivalencia se define el tipo de listas no vacías
-- de números enteros positivos:
newtype ListaNoVaciaDePositivos = L [Int]
  deriving Show

-- genListaNoVaciaDePositivos es un generador de listas no vacióas de
-- enteros positivos. Por ejemplo,
--    λ> sample genListaNoVaciaDePositivos
--    L [1]
--    L [1,2,2]
--    L [4,3,4]
--    L [1,6,5,2,4]
--    L [2,8]
--    L [11]
--    L [13,2,3]
--    L [7,3,9,15,11,12,13,3,9,6,13,3]
--    L [16,2,11,10,6,5,16,4,1,15,9,11,8,15,2,15,7]
--    L [5,4,9,13,5,6,7]
--    L [7,4,6,12,2,11,6,14,14,13,14,11,6,2,18,8,16,2,13,9]
genListaNoVaciaDePositivos :: Gen ListaNoVaciaDePositivos
genListaNoVaciaDePositivos = do
  x  <- arbitrary
  xs <- arbitrary
  return (L (map ((+1) . abs) (x:xs)))

-- Generación arbitraria de listas no vacías de enteros positivos.
instance Arbitrary ListaNoVaciaDePositivos where
  arbitrary = genListaNoVaciaDePositivos

-- La propiedad es
prop_entreDosConjuntos_equiv ::
     ListaNoVaciaDePositivos
  -> ListaNoVaciaDePositivos
  -> Bool
prop_entreDosConjuntos_equiv (L xs) (L ys) =
  entreDosConjuntos xs ys == entreDosConjuntos2 xs ys &&
  entreDosConjuntos xs ys == entreDosConjuntos3 xs ys &&
  entreDosConjuntos xs ys == entreDosConjuntos4 xs ys &&
  entreDosConjuntos xs ys == entreDosConjuntos5 xs ys 

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

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

--    λ> (xs,a) = ([1..10],product xs) 
--    λ> length (entreDosConjuntos xs [a,2*a..10*a])
--    36
--    (5.08 secs, 4,035,689,200 bytes)
--    λ> length (entreDosConjuntos2 xs [a,2*a..10*a])
--    36
--    (3.75 secs, 2,471,534,072 bytes)
--    λ> length (entreDosConjuntos3 xs [a,2*a..10*a])
--    36
--    (3.73 secs, 2,471,528,664 bytes)
--    λ> length (entreDosConjuntos4 xs [a,2*a..10*a])
--    36
--    (0.01 secs, 442,152 bytes)
--    λ> length (entreDosConjuntos5 xs [a,2*a..10*a])
--    36
--    (0.00 secs, 374,824 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

import Test.QuickCheck

-- 1ª solución

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

entreDosConjuntos :: [Int] -> [Int] -> [Int]

entreDosConjuntos xs ys =

[z | z <- [a..b]

, and [z `mod` x == 0 | x <- xs]

, and [y `mod` z == 0 | y <- ys]]

where a = maximum xs

b = minimum ys

-- 2ª solución

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

entreDosConjuntos2 :: [Int] -> [Int] -> [Int]

entreDosConjuntos2 xs ys =

[z | z <- [a..b]

, all (`divideA` z) xs

, all (z `divideA`) ys]

where a = mcmL xs

b = mcdL ys

-- mcmL [2,3,18] == 18

-- mcmL [2,3,15] == 30

mcdL :: [Int] -> Int

mcdL [x] = x

mcdL (x:xs) = gcd x (mcdL xs)

-- mcmL [12,30,18] == 6

-- mcmL [12,30,14] == 2

mcmL :: [Int] -> Int

mcmL [x] = x

mcmL (x:xs) = lcm x (mcmL xs)

divideA :: Int -> Int -> Bool

divideA x y = y `mod` x == 0

-- 3ª solución

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

entreDosConjuntos3 :: [Int] -> [Int] -> [Int]

entreDosConjuntos3 xs ys =

[z | z <- [a..b]

, all (`divideA` z) xs

, all (z `divideA`) ys]

where a = mcmL2 xs

b = mcdL2 ys

-- Definición equivalente

mcdL2 :: [Int] -> Int

mcdL2 = foldl1 gcd

-- Definición equivalente

mcmL2 :: [Int] -> Int

mcmL2 = foldl1 lcm

-- 4ª solución

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

entreDosConjuntos4 :: [Int] -> [Int] -> [Int]

entreDosConjuntos4 xs ys =

[z | z <- [a,a+a..b]

, z `divideA` b]

where a = mcmL2 xs

b = mcdL2 ys

-- 5ª solución

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

entreDosConjuntos5 :: [Int] -> [Int] -> [Int]

entreDosConjuntos5 xs ys =

filter (`divideA` b) [a,a+a..b]

where a = mcmL2 xs

b = mcdL2 ys

-- Equivalencia

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

-- Para comprobar la equivalencia se define el tipo de listas no vacías

-- de números enteros positivos:

newtype ListaNoVaciaDePositivos = L [Int]

deriving Show

-- genListaNoVaciaDePositivos es un generador de listas no vacióas de

-- enteros positivos. Por ejemplo,

-- λ> sample genListaNoVaciaDePositivos

-- L [1]

-- L [1,2,2]

-- L [4,3,4]

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

-- L [2,8]

-- L [11]

-- L [13,2,3]

-- L [7,3,9,15,11,12,13,3,9,6,13,3]

-- L [16,2,11,10,6,5,16,4,1,15,9,11,8,15,2,15,7]

-- L [5,4,9,13,5,6,7]

-- L [7,4,6,12,2,11,6,14,14,13,14,11,6,2,18,8,16,2,13,9]

genListaNoVaciaDePositivos :: Gen ListaNoVaciaDePositivos

genListaNoVaciaDePositivos = do

x <- arbitrary

xs <- arbitrary

return (L (map ((+1) . abs) (x:xs)))

-- Generación arbitraria de listas no vacías de enteros positivos.

instance Arbitrary ListaNoVaciaDePositivos where

arbitrary = genListaNoVaciaDePositivos

-- La propiedad es

prop_entreDosConjuntos_equiv ::

ListaNoVaciaDePositivos

-> ListaNoVaciaDePositivos

-> Bool

prop_entreDosConjuntos_equiv (L xs) (L ys) =

entreDosConjuntos xs ys == entreDosConjuntos2 xs ys &&

entreDosConjuntos xs ys == entreDosConjuntos3 xs ys &&

entreDosConjuntos xs ys == entreDosConjuntos4 xs ys &&

entreDosConjuntos xs ys == entreDosConjuntos5 xs ys

-- La comprobación es

-- λ> quickCheck prop_entreDosConjuntos_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> (xs,a) = ([1..10],product xs)

-- λ> length (entreDosConjuntos xs [a,2*a..10*a])

-- 36

-- (5.08 secs, 4,035,689,200 bytes)

-- λ> length (entreDosConjuntos2 xs [a,2*a..10*a])

-- 36

-- (3.75 secs, 2,471,534,072 bytes)

-- λ> length (entreDosConjuntos3 xs [a,2*a..10*a])

-- 36

-- (3.73 secs, 2,471,528,664 bytes)

-- λ> length (entreDosConjuntos4 xs [a,2*a..10*a])

-- 36

-- (0.01 secs, 442,152 bytes)

-- λ> length (entreDosConjuntos5 xs [a,2*a..10*a])

-- 36

-- (0.00 secs, 374,824 bytes)

Referencia

Este ejercicio está basado en el problema Between two sets de HackerRank.

Pensamiento

Las razones no se transmiten, se engendran, por cooperación, en el diálogo.

Antonio Machado

Menor contenedor de primos

PorJosé A. Alonso 10-diciembre-201817-enero-2019

El n-ésimo menor contenenedor de primos es el menor número que contiene como subcadenas los primeros n primos. Por ejemplo, el 6º menor contenedor de primos es 113257 ya que es el menor que contiene como subcadenas los 6 primeros primos (2, 3, 5, 7, 11 y 13).

Definir la función

   menorContenedor :: Int -> Int

1	menorContenedor :: Int -> Int

tal que (menorContenedor n) es el n-ésimo menor contenenedor de primos. Por ejemplo,

   menorContenedor 1  ==  2
   menorContenedor 2  ==  23
   menorContenedor 3  ==  235
   menorContenedor 4  ==  2357
   menorContenedor 5  ==  112357
   menorContenedor 6  ==  113257

menorContenedor 1 == 2

menorContenedor 2 == 23

menorContenedor 3 == 235

menorContenedor 4 == 2357

menorContenedor 5 == 112357

menorContenedor 6 == 113257

Soluciones

import Data.List           (isInfixOf)
import Data.Numbers.Primes (primes)

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

menorContenedor :: Int -> Int
menorContenedor n =
  head [x | x <- [2..]
          , and [contenido y x | y <- take n primes]]

contenido :: Int -> Int -> Bool
contenido x y =
  show x `isInfixOf` show y

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

menorContenedor2 :: Int -> Int
menorContenedor2 n =
  head [x | x <- [2..]
          , all (`contenido` x) (take n primes)]

import Data.List (isInfixOf)

import Data.Numbers.Primes (primes)

-- 1ª solución

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

menorContenedor :: Int -> Int

menorContenedor n =

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

, and [contenido y x | y <- take n primes]]

contenido :: Int -> Int -> Bool

contenido x y =

show x `isInfixOf` show y

-- 2ª solución

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

menorContenedor2 :: Int -> Int

menorContenedor2 n =

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

, all (`contenido` x) (take n primes)]

Pensamiento

¡Ya hay hombres activos!
Soñaba la charca
con sus mosquitos.

Antonio Machado

Elemento del árbol binario completo según su posición

PorJosé A. Alonso 6-diciembre-201817-enero-2019

Un árbol binario completo es un árbol binario que tiene todos los nodos posibles hasta el penúltimo nivel, y donde los elementos del último nivel están colocados de izquierda a derecha sin dejar huecos entre ellos.

La numeración de los árboles binarios completos se realiza a partir de la raíz, recorriendo los niveles de izquierda a derecha. Por ejemplo,

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

/ \

2 3

/ \ / \

4 5 6 7

/ \

8 9

Los árboles binarios se puede representar mediante el siguiente tipo

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

data Arbol = H

| N Integer Arbol Arbol

deriving (Show, Eq)

Cada posición de un elemento de un árbol es una lista de movimientos hacia la izquierda o hacia la derecha. Por ejemplo, la posición de 9 en al árbol anterior es [I,I,D].

Los tipos de los movimientos y de las posiciones se definen por

   data Movimiento = I | D deriving (Show, Eq)
   type Posicion   = [Movimiento]

1 2	data Movimiento = I \| D deriving (Show, Eq) type Posicion = [Movimiento]

Definir la función

   elementoEnPosicion :: Posicion -> Integer

1	elementoEnPosicion :: Posicion -> Integer

tal que (elementoEnPosicion ms) es el elemento en la posición ms. Por ejemplo,

   elementoEnPosicion [D,I]    ==  6
   elementoEnPosicion [D,D]    ==  7
   elementoEnPosicion [I,I,D]  ==  9
   elementoEnPosicion []       ==  1

elementoEnPosicion [D,I] == 6

elementoEnPosicion [D,D] == 7

elementoEnPosicion [I,I,D] == 9

elementoEnPosicion [] == 1

Soluciones

import Test.QuickCheck

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

data Movimiento = I | D deriving (Show, Eq)

type Posicion = [Movimiento]

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

elementoEnPosicion :: Posicion -> Integer
elementoEnPosicion ms =
  aux ms (arbolBinarioCompleto (2^(1 + length ms)))
  where aux []     (N x _ _) = x
        aux (I:ms) (N _ i _) = aux ms i
        aux (D:ms) (N _ _ d) = aux ms d

-- (arbolBinarioCompleto n) es el árbol binario completo con n
-- nodos. Por ejemplo, 
--    λ> arbolBinarioCompleto 4
--    N 1 (N 2 (N 4 H H) H) (N 3 H H)
--    λ> pPrint (arbolBinarioCompleto 9)
--    N 1
--      (N 2
--         (N 4
--            (N 8 H H)
--            (N 9 H H))
--         (N 5 H H))
--      (N 3
--         (N 6 H H)
--         (N 7 H H))
arbolBinarioCompleto :: Integer -> Arbol
arbolBinarioCompleto n = aux 1
  where aux i | i <= n    = N i (aux (2*i)) (aux (2*i+1))
              | otherwise = H

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

elementoEnPosicion2 :: Posicion -> Integer
elementoEnPosicion2 = aux . reverse
  where aux []     = 1
        aux (I:ms) = 2 * aux ms
        aux (D:ms) = 2 * aux ms + 1

-- Equivalencia
-- ============

-- La propiedad es
prop_elementoEnPosicion_equiv :: Positive Integer -> Bool
prop_elementoEnPosicion_equiv (Positive n) =
  elementoEnPosicion  ps == n &&
  elementoEnPosicion2 ps == n 
  where ps = posicionDeElemento n

-- tal que (posicionDeElemento n) es la posición del elemento n en el
-- árbol binario completo. Por ejemplo,
--    posicionDeElemento 6  ==  [D,I]
--    posicionDeElemento 7  ==  [D,D]
--    posicionDeElemento 9  ==  [I,I,D]
--    posicionDeElemento 1  ==  []
posicionDeElemento :: Integer -> Posicion
posicionDeElemento n =
  [f x | x <- tail (reverse (binario n))]
  where f 0 = I
        f 1 = D

-- (binario n) es la lista de los dígitos de la representación binaria
-- de n. Por ejemplo,
--    binario 11  ==  [1,1,0,1]
binario :: Integer -> [Integer]
binario n
  | n < 2     = [n]
  | otherwise = n `mod` 2 : binario (n `div` 2)

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

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

--    λ> length (show (elementoEnPosicion (replicate (3*10^5) D)))
--    90310
--    (1.96 secs, 11,518,771,016 bytes)
--    λ> length (show (elementoEnPosicion2 (replicate (3*10^5) D)))
--    90310
--    (14.32 secs, 11,508,181,176 bytes)

import Test.QuickCheck

data Arbol = H

| N Integer Arbol Arbol

deriving (Eq, Show)

data Movimiento = I | D deriving (Show, Eq)

type Posicion = [Movimiento]

-- 1ª solución

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

elementoEnPosicion :: Posicion -> Integer

elementoEnPosicion ms =

aux ms (arbolBinarioCompleto (2^(1 + length ms)))

where aux [] (N x _ _) = x

aux (I:ms) (N _ i _) = aux ms i

aux (D:ms) (N _ _ d) = aux ms d

-- (arbolBinarioCompleto n) es el árbol binario completo con n

-- nodos. Por ejemplo,

-- λ> arbolBinarioCompleto 4

-- N 1 (N 2 (N 4 H H) H) (N 3 H H)

-- λ> pPrint (arbolBinarioCompleto 9)

-- N 1

-- (N 2

-- (N 4

-- (N 8 H H)

-- (N 9 H H))

-- (N 5 H H))

-- (N 3

-- (N 6 H H)

-- (N 7 H H))

arbolBinarioCompleto :: Integer -> Arbol

arbolBinarioCompleto n = aux 1

where aux i | i <= n = N i (aux (2*i)) (aux (2*i+1))

| otherwise = H

-- 2ª solución

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

elementoEnPosicion2 :: Posicion -> Integer

elementoEnPosicion2 = aux . reverse

where aux [] = 1

aux (I:ms) = 2 * aux ms

aux (D:ms) = 2 * aux ms + 1

-- Equivalencia

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

-- La propiedad es

prop_elementoEnPosicion_equiv :: Positive Integer -> Bool

prop_elementoEnPosicion_equiv (Positive n) =

elementoEnPosicion ps == n &&

elementoEnPosicion2 ps == n

where ps = posicionDeElemento n

-- tal que (posicionDeElemento n) es la posición del elemento n en el

-- árbol binario completo. Por ejemplo,

-- posicionDeElemento 6 == [D,I]

-- posicionDeElemento 7 == [D,D]

-- posicionDeElemento 9 == [I,I,D]

-- posicionDeElemento 1 == []

posicionDeElemento :: Integer -> Posicion

posicionDeElemento n =

[f x | x <- tail (reverse (binario n))]

where f 0 = I

f 1 = D

-- (binario n) es la lista de los dígitos de la representación binaria

-- de n. Por ejemplo,

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

binario :: Integer -> [Integer]

binario n

| n < 2 = [n]

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

-- La comprobación es

-- λ> quickCheck prop_elementoEnPosicion_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> length (show (elementoEnPosicion (replicate (3*10^5) D)))

-- 90310

-- (1.96 secs, 11,518,771,016 bytes)

-- λ> length (show (elementoEnPosicion2 (replicate (3*10^5) D)))

-- 90310

-- (14.32 secs, 11,508,181,176 bytes)

Pensamiento

Las más hondas palabras
del sabio nos enseñan
lo que el silbar del viento cuando sopla
o el sonar de las aguas cuando ruedan.

Antonio Machado

Expresiones aritméticas generales

Soluciones

Pensamiento

Entre dos conjuntos

Soluciones

Referencia

Pensamiento

Menor contenedor de primos

Soluciones

Pensamiento

Elemento del árbol binario completo según su posición

Soluciones

Pensamiento

Entradas recientes

Buscar

Correo electrónico