head

Posiciones en árboles binarios completos

PorJosé A. Alonso 5-diciembre-201819-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

   posicionDeElemento :: Integer -> Posicion

1	posicionDeElemento :: Integer -> Posicion

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  ==  []

   length (posicionDeElemento (10^50000))  ==  166096

posicionDeElemento 6 == [D,I]

posicionDeElemento 7 == [D,D]

posicionDeElemento 9 == [I,I,D]

posicionDeElemento 1 == []

length (posicionDeElemento (10^50000)) == 166096

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

posicionDeElemento :: Integer -> Posicion
posicionDeElemento n =
  head (posiciones n (arbolBinarioCompleto n))

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

-- (posiciones n a) es la lista de las posiciones del elemento n
-- en el árbol a. Por ejemplo,
--    posiciones 9 (arbolBinarioCompleto 9)  ==  [[I,I,D]]
posiciones :: Integer -> Arbol -> [Posicion]
posiciones n a = aux n a [[]]
  where aux _ H _                      = []
        aux n (N x i d) cs | x == n    = cs ++ ps
                           | otherwise = ps
          where ps = map (I:) (aux n i cs) ++
                     map (D:) (aux n d cs)

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

posicionDeElemento2 :: Integer -> Posicion
posicionDeElemento2 1 = []
posicionDeElemento2 n
  | even n    = posicionDeElemento2 (n `div` 2) ++ [I]
  | otherwise = posicionDeElemento2 (n `div` 2) ++ [D]

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

posicionDeElemento3 :: Integer -> Posicion
posicionDeElemento3 = reverse . aux
  where aux 1 = []
        aux n | even n    = I : aux (n `div` 2) 
              | otherwise = D : aux (n `div` 2) 

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

posicionDeElemento4 :: Integer -> Posicion
posicionDeElemento4 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)

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

-- La propiedad es
prop_posicionDeElemento_equiv :: Positive Integer -> Bool
prop_posicionDeElemento_equiv (Positive n) =
  posicionDeElemento n == posicionDeElemento2 n &&
  posicionDeElemento n == posicionDeElemento3 n &&
  posicionDeElemento n == posicionDeElemento4 n

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

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

--    λ> posicionDeElemento (10^7)
--    [I,I,D,D,I,I,I,D,I,I,D,I,D,D,I,D,I,I,I,I,I,I,I]
--    (5.72 secs, 3,274,535,328 bytes)
--    λ> posicionDeElemento2 (10^7)
--    [I,I,D,D,I,I,I,D,I,I,D,I,D,D,I,D,I,I,I,I,I,I,I]
--    (0.01 secs, 189,560 bytes)
--    λ> posicionDeElemento3 (10^7)
--    [I,I,D,D,I,I,I,D,I,I,D,I,D,D,I,D,I,I,I,I,I,I,I]
--    (0.01 secs, 180,728 bytes)
--    λ> posicionDeElemento4 (10^7)
--    [I,I,D,D,I,I,I,D,I,I,D,I,D,D,I,D,I,I,I,I,I,I,I]
--    (0.01 secs, 184,224 bytes)
--    
--    λ> length (posicionDeElemento2 (10^4000))
--    13287
--    (2.80 secs, 7,672,011,280 bytes)
--    λ> length (posicionDeElemento3 (10^4000))
--    13287
--    (0.03 secs, 19,828,744 bytes)
--    λ> length (posicionDeElemento4 (10^4000))
--    13287
--    (0.03 secs, 18,231,536 bytes)
--    
--    λ> length (posicionDeElemento3 (10^50000))
--    166096
--    (1.34 secs, 1,832,738,136 bytes)
--    λ> length (posicionDeElemento4 (10^50000))
--    166096
--    (1.70 secs, 1,812,806,080 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

import 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

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

posicionDeElemento :: Integer -> Posicion

posicionDeElemento n =

head (posiciones n (arbolBinarioCompleto n))

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

-- (posiciones n a) es la lista de las posiciones del elemento n

-- en el árbol a. Por ejemplo,

-- posiciones 9 (arbolBinarioCompleto 9) == [[I,I,D]]

posiciones :: Integer -> Arbol -> [Posicion]

posiciones n a = aux n a [[]]

where aux _ H _ = []

aux n (N x i d) cs | x == n = cs ++ ps

| otherwise = ps

where ps = map (I:) (aux n i cs) ++

map (D:) (aux n d cs)

-- 2ª solución

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

posicionDeElemento2 :: Integer -> Posicion

posicionDeElemento2 1 = []

posicionDeElemento2 n

| even n = posicionDeElemento2 (n `div` 2) ++ [I]

| otherwise = posicionDeElemento2 (n `div` 2) ++ [D]

-- 3ª solución

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

posicionDeElemento3 :: Integer -> Posicion

posicionDeElemento3 = reverse . aux

where aux 1 = []

aux n | even n = I : aux (n `div` 2)

| otherwise = D : aux (n `div` 2)

-- 4ª solución

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

posicionDeElemento4 :: Integer -> Posicion

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

-- Equivalencia

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

-- La propiedad es

prop_posicionDeElemento_equiv :: Positive Integer -> Bool

prop_posicionDeElemento_equiv (Positive n) =

posicionDeElemento n == posicionDeElemento2 n &&

posicionDeElemento n == posicionDeElemento3 n &&

posicionDeElemento n == posicionDeElemento4 n

-- La comprobación es

-- λ> quickCheck prop_posicionDeElemento_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> posicionDeElemento (10^7)

-- [I,I,D,D,I,I,I,D,I,I,D,I,D,D,I,D,I,I,I,I,I,I,I]

-- (5.72 secs, 3,274,535,328 bytes)

-- λ> posicionDeElemento2 (10^7)

-- [I,I,D,D,I,I,I,D,I,I,D,I,D,D,I,D,I,I,I,I,I,I,I]

-- (0.01 secs, 189,560 bytes)

-- λ> posicionDeElemento3 (10^7)

-- [I,I,D,D,I,I,I,D,I,I,D,I,D,D,I,D,I,I,I,I,I,I,I]

-- (0.01 secs, 180,728 bytes)

-- λ> posicionDeElemento4 (10^7)

-- [I,I,D,D,I,I,I,D,I,I,D,I,D,D,I,D,I,I,I,I,I,I,I]

-- (0.01 secs, 184,224 bytes)

-- λ> length (posicionDeElemento2 (10^4000))

-- 13287

-- (2.80 secs, 7,672,011,280 bytes)

-- λ> length (posicionDeElemento3 (10^4000))

-- 13287

-- (0.03 secs, 19,828,744 bytes)

-- λ> length (posicionDeElemento4 (10^4000))

-- 13287

-- (0.03 secs, 18,231,536 bytes)

-- λ> length (posicionDeElemento3 (10^50000))

-- 166096

-- (1.34 secs, 1,832,738,136 bytes)

-- λ> length (posicionDeElemento4 (10^50000))

-- 166096

-- (1.70 secs, 1,812,806,080 bytes)

Pensamiento

El ojo que ves no es
ojo porque tú lo veas;
es ojo porque te ve.

Antonio Machado

Números colinas

PorJosé A. Alonso 29-noviembre-201819-enero-2019

Se dice que un número natural n es una colina si su primer dígito es igual a su último dígito, los primeros dígitos son estrictamente creciente hasta llegar al máximo, el máximo se puede repetir y los dígitos desde el máximo al final son estrictamente decrecientes.

Definir la función

   esColina :: Integer -> Bool

1	esColina :: Integer -> Bool

tal que (esColina n) se verifica si n es un número colina. Por ejemplo,

   esColina 12377731  ==  True
   esColina 1237731   ==  True
   esColina 123731    ==  True
   esColina 122731    ==  False
   esColina 12377730  ==  False
   esColina 12377730  ==  False
   esColina 10377731  ==  False
   esColina 12377701  ==  False
   esColina 33333333  ==  True

esColina 12377731 == True

esColina 1237731 == True

esColina 123731 == True

esColina 122731 == False

esColina 12377730 == False

esColina 10377731 == False

esColina 12377701 == False

esColina 33333333 == True

Soluciones

import Data.Char (digitToInt)

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

esColina :: Integer -> Bool
esColina n =
  head ds == last ds &&
  esCreciente xs &&
  esDecreciente ys
  where ds = digitos n
        m  = maximum ds
        xs = takeWhile (<m) ds
        ys = dropWhile (==m) (dropWhile (<m) ds)

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 425  ==  [4,2,5]
digitos :: Integer -> [Int]
digitos n = map digitToInt (show n)

-- (esCreciente xs) se verifica si la lista xs es estrictamente
-- creciente. Por ejemplo,
--    esCreciente [2,4,7]  ==  True
--    esCreciente [2,2,7]  ==  False
--    esCreciente [2,1,7]  ==  False
esCreciente :: [Int] -> Bool
esCreciente xs = and [x < y | (x,y) <- zip xs (tail xs)]

-- (esDecreciente xs) se verifica si la lista xs es estrictamente
-- decreciente. Por ejemplo,
--    esDecreciente [7,4,2]  ==  True
--    esDecreciente [7,2,2]  ==  False
--    esDecreciente [7,1,2]  ==  False
esDecreciente :: [Int] -> Bool
esDecreciente xs = and [x > y | (x,y) <- zip xs (tail xs)]

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

esColina2 :: Integer -> Bool
esColina2 n =
  head ds == last ds &&
  null (dropWhile (==(-1)) (dropWhile (==0) (dropWhile (==1) xs)))
  where ds = digitos n
        xs = [signum (y-x) | (x,y) <- zip ds (tail ds)] 

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

-- La propiedad de equivalencia es
prop_esColina :: Integer -> Property
prop_esColina n =
  n >= 0 ==> esColina n == esColina2 n 

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

import Data.Char (digitToInt)

-- 1ª definición

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

esColina :: Integer -> Bool

esColina n =

head ds == last ds &&

esCreciente xs &&

esDecreciente ys

where ds = digitos n

m = maximum ds

xs = takeWhile (<m) ds

ys = dropWhile (==m) (dropWhile (<m) ds)

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,

-- digitos 425 == [4,2,5]

digitos :: Integer -> [Int]

digitos n = map digitToInt (show n)

-- (esCreciente xs) se verifica si la lista xs es estrictamente

-- creciente. Por ejemplo,

-- esCreciente [2,4,7] == True

-- esCreciente [2,2,7] == False

-- esCreciente [2,1,7] == False

esCreciente :: [Int] -> Bool

esCreciente xs = and [x < y | (x,y) <- zip xs (tail xs)]

-- (esDecreciente xs) se verifica si la lista xs es estrictamente

-- decreciente. Por ejemplo,

-- esDecreciente [7,4,2] == True

-- esDecreciente [7,2,2] == False

-- esDecreciente [7,1,2] == False

esDecreciente :: [Int] -> Bool

esDecreciente xs = and [x > y | (x,y) <- zip xs (tail xs)]

-- 2ª definición

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

esColina2 :: Integer -> Bool

esColina2 n =

head ds == last ds &&

null (dropWhile (==(-1)) (dropWhile (==0) (dropWhile (==1) xs)))

where ds = digitos n

xs = [signum (y-x) | (x,y) <- zip ds (tail ds)]

-- Equivalencia

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

-- La propiedad de equivalencia es

prop_esColina :: Integer -> Property

prop_esColina n =

n >= 0 ==> esColina n == esColina2 n

-- La comprobación es

-- λ> quickCheck prop_esColina

-- +++ OK, passed 100 tests.

Referencia

Basado en el problema Is this number a hill number? de Code Golf

Pensamiento

Si me tengo que morir
poco me importa aprender.
Y si no puedo saber,
poco me importa vivir.

Antonio Machado

Elemento solitario

PorJosé A. Alonso 28-noviembre-201819-enero-2019

Definir la función

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

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

tal que (solitario xs) es el único elemento que ocurre una vez en la lista xs (se supone que la lista xs tiene al menos 3 elementos y todos son iguales menos uno que es el solitario). Por ejemplo,

   solitario [2,2,7,2]  ==  7
   solitario [2,2,2,7]  ==  7
   solitario [7,2,2,2]  ==  7
   solitario (replicate (2*10^7) 1 ++ [2])  ==  2

solitario [2,2,7,2] == 7

solitario [2,2,2,7] == 7

solitario [7,2,2,2] == 7

solitario (replicate (2*10^7) 1 ++ [2]) == 2

Soluciones

import Test.QuickCheck 
import Data.List (group, nub, sort)

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

solitario :: Ord a => [a] -> a
solitario xs =
  head [x | x <- xs
          , cuenta xs x == 1]

cuenta :: Eq a => [a] -> a -> Int
cuenta xs x = length [y | y <- xs
                        , x == y]

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

solitario2 :: Ord a => [a] -> a
solitario2 xs = head (filter (\x -> cuenta2 xs x == 1) xs)

cuenta2 :: Eq a => [a] -> a -> Int
cuenta2 xs x = length (filter (==x) xs)

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

solitario3 :: Ord a => [a] -> a
solitario3 [x] = x
solitario3 (x1:x2:x3:xs)
  | x1 /= x2 && x2 == x3 = x1
  | x1 == x2 && x2 /= x3 = x3
  | otherwise            = solitario3 (x2:x3:xs)

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

solitario4 :: Ord a => [a] -> a
solitario4 xs 
  | y1 == y2  = last ys
  | otherwise = y1
  where (y1:y2:ys) = sort xs

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

solitario5 :: Ord a => [a] -> a
solitario5 xs | null ys   = y
              | otherwise = z
  where [y:ys,z:zs] = group (sort xs)

-- 6ª definición
-- =============

solitario6 :: Ord a => [a] -> a
solitario6 xs =
  head [x | x <- nub xs
          , cuenta xs x == 1]

-- 7ª definición
-- =============

solitario7 :: Ord a => [a] -> a
solitario7 (a:b:xs)
  | a == b        = solitario7 (b:xs)
  | elem a (b:xs) = b
  | elem b (a:xs) = a
solitario7 [a,b] = b

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

-- Propiedad de equivalencia
prop_solitario_equiv :: Property
prop_solitario_equiv =
  forAll listaSolitaria (\xs -> solitario xs == solitario2 xs &&
                                solitario xs == solitario3 xs &&
                                solitario xs == solitario4 xs &&
                                solitario xs == solitario5 xs &&
                                solitario xs == solitario6 xs &&
                                solitario xs == solitario7 xs)

-- Generador de listas con al menos 3 elementos y todos iguales menos
-- uno. Por ejemplo,
--    λ> sample listaSolitaria
--    [1,0,0,0,0]
--    [0,0,-1,0,0,0]
--    [4,1,1,1]
--    [6,6,4,6]
--    [8,8,8,8,8,-4,8,8,8,8,8,8]
--    ...
listaSolitaria :: Gen [Int]
listaSolitaria = do
  n <- arbitrary
  m <- arbitrary `suchThat` (\a -> n + a > 2)
  x <- arbitrary
  y <- arbitrary `suchThat` (\a -> a /= x)
  return (replicate n x ++ [y] ++ replicate m x)

-- Comprobación:
--    λ> quickCheck prop_solitario_equiv
--    +++ OK, passed 100 tests.

-- Comparación de eficiencia:
--    λ> solitario (replicate (5*10^3) 1 ++ [2])
--    2
--    (5.47 secs, 3,202,688,152 bytes)
--    λ> solitario2 (replicate (5*10^3) 1 ++ [2])
--    2
--    (2.08 secs, 1,401,603,960 bytes)
--    λ> solitario3 (replicate (5*10^3) 1 ++ [2])
--    2
--    (0.04 secs, 3,842,240 bytes)
--    λ> solitario4 (replicate (5*10^3) 1 ++ [2])
--    2
--    (0.02 secs, 1,566,472 bytes)
--    λ> solitario5 (replicate (5*10^3) 1 ++ [2])
--    2
--    (0.01 secs, 927,064 bytes)
--    λ> solitario6 (replicate (5*10^3) 1 ++ [2])
--    2
--    (0.01 secs, 1,604,176 bytes)
--    λ> solitario7 (replicate (5*10^3) 1 ++ [2])
--    2
--    (0.01 secs, 1,923,440 bytes)
--    
--    λ> solitario3 (replicate (5*10^6) 1 ++ [2])
--    2
--    (4.62 secs, 3,720,123,560 bytes)
--    λ> solitario4 (replicate (5*10^6) 1 ++ [2])
--    2
--    (1.48 secs, 1,440,124,240 bytes)
--    λ> solitario5 (replicate (5*10^6) 1 ++ [2])
--    2
--    (1.40 secs, 1,440,125,936 bytes)
--    λ> solitario6 (replicate (5*10^6) 1 ++ [2])
--    2
--    (2.65 secs, 1,480,125,032 bytes)
--    λ> solitario7 (replicate (5*10^6) 1 ++ [2])
--    2
--    (2.21 secs, 1,800,126,224 bytes)
--    
--    λ> solitario5 (2 : replicate (5*10^6) 1)
--    2
--    (1.38 secs, 1,520,127,864 bytes)
--    λ> solitario6 (2 : replicate (5*10^6) 1)
--    2
--    (1.18 secs, 560,127,664 bytes)
--    λ> solitario7 (2 : replicate (5*10^6) 1)
--    2
--    (0.29 secs, 280,126,888 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

144

145

146

147

148

149

150

151

import Test.QuickCheck

import Data.List (group, nub, sort)

-- 1ª definición

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

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

solitario xs =

head [x | x <- xs

, cuenta xs x == 1]

cuenta :: Eq a => [a] -> a -> Int

cuenta xs x = length [y | y <- xs

, x == y]

-- 2ª definición

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

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

solitario2 xs = head (filter (\x -> cuenta2 xs x == 1) xs)

cuenta2 :: Eq a => [a] -> a -> Int

cuenta2 xs x = length (filter (==x) xs)

-- 3ª definición

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

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

solitario3 [x] = x

solitario3 (x1:x2:x3:xs)

| x1 /= x2 && x2 == x3 = x1

| x1 == x2 && x2 /= x3 = x3

| otherwise = solitario3 (x2:x3:xs)

-- 4ª definición

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

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

solitario4 xs

| y1 == y2 = last ys

| otherwise = y1

where (y1:y2:ys) = sort xs

-- 5ª definición

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

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

solitario5 xs | null ys = y

| otherwise = z

where [y:ys,z:zs] = group (sort xs)

-- 6ª definición

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

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

solitario6 xs =

head [x | x <- nub xs

, cuenta xs x == 1]

-- 7ª definición

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

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

solitario7 (a:b:xs)

| a == b = solitario7 (b:xs)

| elem a (b:xs) = b

| elem b (a:xs) = a

solitario7 [a,b] = b

-- Equivalencia

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

-- Propiedad de equivalencia

prop_solitario_equiv :: Property

prop_solitario_equiv =

forAll listaSolitaria (\xs -> solitario xs == solitario2 xs &&

solitario xs == solitario3 xs &&

solitario xs == solitario4 xs &&

solitario xs == solitario5 xs &&

solitario xs == solitario6 xs &&

solitario xs == solitario7 xs)

-- Generador de listas con al menos 3 elementos y todos iguales menos

-- uno. Por ejemplo,

-- λ> sample listaSolitaria

-- [1,0,0,0,0]

-- [0,0,-1,0,0,0]

-- [4,1,1,1]

-- [6,6,4,6]

-- [8,8,8,8,8,-4,8,8,8,8,8,8]

-- ...

listaSolitaria :: Gen [Int]

listaSolitaria = do

n <- arbitrary

m <- arbitrary `suchThat` (\a -> n + a > 2)

x <- arbitrary

y <- arbitrary `suchThat` (\a -> a /= x)

return (replicate n x ++ [y] ++ replicate m x)

-- Comprobación:

-- λ> quickCheck prop_solitario_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia:

-- λ> solitario (replicate (5*10^3) 1 ++ [2])

-- 2

-- (5.47 secs, 3,202,688,152 bytes)

-- λ> solitario2 (replicate (5*10^3) 1 ++ [2])

-- 2

-- (2.08 secs, 1,401,603,960 bytes)

-- λ> solitario3 (replicate (5*10^3) 1 ++ [2])

-- 2

-- (0.04 secs, 3,842,240 bytes)

-- λ> solitario4 (replicate (5*10^3) 1 ++ [2])

-- 2

-- (0.02 secs, 1,566,472 bytes)

-- λ> solitario5 (replicate (5*10^3) 1 ++ [2])

-- 2

-- (0.01 secs, 927,064 bytes)

-- λ> solitario6 (replicate (5*10^3) 1 ++ [2])

-- 2

-- (0.01 secs, 1,604,176 bytes)

-- λ> solitario7 (replicate (5*10^3) 1 ++ [2])

-- 2

-- (0.01 secs, 1,923,440 bytes)

-- λ> solitario3 (replicate (5*10^6) 1 ++ [2])

-- 2

-- (4.62 secs, 3,720,123,560 bytes)

-- λ> solitario4 (replicate (5*10^6) 1 ++ [2])

-- 2

-- (1.48 secs, 1,440,124,240 bytes)

-- λ> solitario5 (replicate (5*10^6) 1 ++ [2])

-- 2

-- (1.40 secs, 1,440,125,936 bytes)

-- λ> solitario6 (replicate (5*10^6) 1 ++ [2])

-- 2

-- (2.65 secs, 1,480,125,032 bytes)

-- λ> solitario7 (replicate (5*10^6) 1 ++ [2])

-- 2

-- (2.21 secs, 1,800,126,224 bytes)

-- λ> solitario5 (2 : replicate (5*10^6) 1)

-- 2

-- (1.38 secs, 1,520,127,864 bytes)

-- λ> solitario6 (2 : replicate (5*10^6) 1)

-- 2

-- (1.18 secs, 560,127,664 bytes)

-- λ> solitario7 (2 : replicate (5*10^6) 1)

-- 2

-- (0.29 secs, 280,126,888 bytes)

Pensamiento

Sube y sube, pero ten
cuidado Nefelibata,
que entre las nubes también,
se puede meter la pata.

Antonio Machado

Números primos sumas de dos primos

PorJosé A. Alonso 26-noviembre-201819-enero-2019

Definir las funciones

   esPrimoSumaDeDosPrimos :: Integer -> Bool

1	esPrimoSumaDeDosPrimos :: Integer -> Bool

primosSumaDeDosPrimos :: [Integer]
tales que

(esPrimoSumaDeDosPrimos x) se verifica si x es un número primo que se puede escribir como la suma de dos números primos. Por ejemplo,

     esPrimoSumaDeDosPrimos 19        ==  True
     esPrimoSumaDeDosPrimos 20        ==  False
     esPrimoSumaDeDosPrimos 23        ==  False
     esPrimoSumaDeDosPrimos 18409541  ==  False

esPrimoSumaDeDosPrimos 19 == True

esPrimoSumaDeDosPrimos 20 == False

esPrimoSumaDeDosPrimos 23 == False

esPrimoSumaDeDosPrimos 18409541 == False

primosSumaDeDosPrimos es la lista de los números primos que se pueden escribir como la suma de dos números primos. Por ejemplo,

     λ> take 17 primosSumaDeDosPrimos
     [5,7,13,19,31,43,61,73,103,109,139,151,181,193,199,229,241]
     λ> primosSumaDeDosPrimos !! (10^5)
     18409543

λ> take 17 primosSumaDeDosPrimos

[5,7,13,19,31,43,61,73,103,109,139,151,181,193,199,229,241]

λ> primosSumaDeDosPrimos !! (10^5)

18409543

Soluciones

import Data.Numbers.Primes (isPrime, primes)

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

esPrimoSumaDeDosPrimos :: Integer -> Bool
esPrimoSumaDeDosPrimos x =
  isPrime x && isPrime (x - 2)

primosSumaDeDosPrimos :: [Integer]
primosSumaDeDosPrimos =
  [x | x <- primes
     , isPrime (x - 2)]

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

primosSumaDeDosPrimos2 :: [Integer]
primosSumaDeDosPrimos2 =
  [y | (x,y) <- zip primes (tail primes)
     , y == x + 2]

esPrimoSumaDeDosPrimos2 :: Integer -> Bool
esPrimoSumaDeDosPrimos2 x = 
  x == head (dropWhile (<x) primosSumaDeDosPrimos2)

-- Equivalencias
-- =============

-- Equivalencia de esPrimoSumaDeDosPrimos
prop_esPrimoSumaDeDosPrimos_equiv :: Integer -> Property
prop_esPrimoSumaDeDosPrimos_equiv x =
  x > 0 ==>
  esPrimoSumaDeDosPrimos x == esPrimoSumaDeDosPrimos2 x

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

-- Equivalencia de primosSumaDeDosPrimos
prop_primosSumaDeDosPrimos_equiv :: Int -> Property
prop_primosSumaDeDosPrimos_equiv n =
  n >= 0 ==>
  primosSumaDeDosPrimos !! n == primosSumaDeDosPrimos2 !! n

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

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

--    λ> primosSumaDeDosPrimos !! (10^4)
--    1261081
--    (2.07 secs, 4,540,085,256 bytes)
--
-- Se recarga para evitar memorización    
--    λ> primosSumaDeDosPrimos2 !! (10^4)
--    1261081
--    (0.49 secs, 910,718,408 bytes)

import Data.Numbers.Primes (isPrime, primes)

-- 1ª solución

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

esPrimoSumaDeDosPrimos :: Integer -> Bool

esPrimoSumaDeDosPrimos x =

isPrime x && isPrime (x - 2)

primosSumaDeDosPrimos :: [Integer]

primosSumaDeDosPrimos =

[x | x <- primes

, isPrime (x - 2)]

-- 2ª solución

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

primosSumaDeDosPrimos2 :: [Integer]

primosSumaDeDosPrimos2 =

[y | (x,y) <- zip primes (tail primes)

, y == x + 2]

esPrimoSumaDeDosPrimos2 :: Integer -> Bool

esPrimoSumaDeDosPrimos2 x =

x == head (dropWhile (<x) primosSumaDeDosPrimos2)

-- Equivalencias

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

-- Equivalencia de esPrimoSumaDeDosPrimos

prop_esPrimoSumaDeDosPrimos_equiv :: Integer -> Property

prop_esPrimoSumaDeDosPrimos_equiv x =

x > 0 ==>

esPrimoSumaDeDosPrimos x == esPrimoSumaDeDosPrimos2 x

-- La comprobación es

-- λ> quickCheck prop_esPrimoSumaDeDosPrimos_equiv

-- +++ OK, passed 100 tests.

-- Equivalencia de primosSumaDeDosPrimos

prop_primosSumaDeDosPrimos_equiv :: Int -> Property

prop_primosSumaDeDosPrimos_equiv n =

n >= 0 ==>

primosSumaDeDosPrimos !! n == primosSumaDeDosPrimos2 !! n

-- La comprobación es

-- λ> quickCheck prop_primosSumaDeDosPrimos_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> primosSumaDeDosPrimos !! (10^4)

-- 1261081

-- (2.07 secs, 4,540,085,256 bytes)

-- Se recarga para evitar memorización

-- λ> primosSumaDeDosPrimos2 !! (10^4)

-- 1261081

-- (0.49 secs, 910,718,408 bytes)

Pensamiento

Sed incompresivos; yo os aconsejo la incomprensión, aunque sólo sea para destripar los chistes de los tontos.

Antonio Machado

Último dígito no nulo del factorial

PorJosé A. Alonso 13-noviembre-201825-abril-2021

El factorial de 7 es

   7! = 1 * 2 * 3 * 4 * 5 * 6 * 7 = 5040

1	7! = 1 * 2 * 3 * 4 * 5 * 6 * 7 = 5040

por tanto, el último dígito no nulo del factorial de 7 es 4.

Definir la función

   ultimoNoNuloFactorial :: Integer -> Integer

1	ultimoNoNuloFactorial :: Integer -> Integer

tal que (ultimoNoNuloFactorial n) es el último dígito no nulo del factorial de n. Por ejemplo,

   ultimoNoNuloFactorial  7  == 4
   ultimoNoNuloFactorial 10  == 8
   ultimoNoNuloFactorial 12  == 6
   ultimoNoNuloFactorial 97  == 2
   ultimoNoNuloFactorial  0  == 1

ultimoNoNuloFactorial 7 == 4

ultimoNoNuloFactorial 10 == 8

ultimoNoNuloFactorial 12 == 6

ultimoNoNuloFactorial 97 == 2

ultimoNoNuloFactorial 0 == 1

Comprobar con QuickCheck que si n es mayor que 4, entonces el último dígito no nulo del factorial de n es par.

Soluciones

import Test.QuickCheck

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

ultimoNoNuloFactorial :: Integer -> Integer
ultimoNoNuloFactorial n = ultimoNoNulo (factorial n)

-- (ultimoNoNulo n) es el último dígito no nulo de n. Por ejemplo,
--    ultimoNoNulo 5040  ==  4
ultimoNoNulo :: Integer -> Integer
ultimoNoNulo n
  | m /= 0    = m
  | otherwise = ultimoNoNulo (n `div` 10)
  where m = n `rem` 10
        
-- (factorial n) es el factorial de n. Por ejemplo,
--    factorial 7  ==  5040
factorial :: Integer -> Integer
factorial n = product [1..n]

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

ultimoNoNuloFactorial2 :: Integer -> Integer
ultimoNoNuloFactorial2 n = ultimoNoNulo2 (factorial n)

-- (ultimoNoNulo2 n) es el último dígito no nulo de n. Por ejemplo,
--    ultimoNoNulo 5040  ==  4
ultimoNoNulo2 :: Integer -> Integer
ultimoNoNulo2 n = read [head (dropWhile (=='0') (reverse (show n)))]

-- Comprobación
-- ============

-- La propiedad es
prop_ultimoNoNuloFactorial :: Integer -> Property
prop_ultimoNoNuloFactorial n = 
  n > 4 ==> even (ultimoNoNuloFactorial n)
                  
-- La comprobación es
--    ghci> quickCheck prop_ultimoNoNuloFactorial
--    +++ OK, passed 100 tests.

import Test.QuickCheck

-- 1ª definición

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

ultimoNoNuloFactorial :: Integer -> Integer

ultimoNoNuloFactorial n = ultimoNoNulo (factorial n)

-- (ultimoNoNulo n) es el último dígito no nulo de n. Por ejemplo,

-- ultimoNoNulo 5040 == 4

ultimoNoNulo :: Integer -> Integer

ultimoNoNulo n

| m /= 0 = m

| otherwise = ultimoNoNulo (n `div` 10)

where m = n `rem` 10

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

-- factorial 7 == 5040

factorial :: Integer -> Integer

factorial n = product [1..n]

-- 2ª definición

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

ultimoNoNuloFactorial2 :: Integer -> Integer

ultimoNoNuloFactorial2 n = ultimoNoNulo2 (factorial n)

-- (ultimoNoNulo2 n) es el último dígito no nulo de n. Por ejemplo,

-- ultimoNoNulo 5040 == 4

ultimoNoNulo2 :: Integer -> Integer

ultimoNoNulo2 n = read [head (dropWhile (=='0') (reverse (show n)))]

-- Comprobación

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

-- La propiedad es

prop_ultimoNoNuloFactorial :: Integer -> Property

prop_ultimoNoNuloFactorial n =

n > 4 ==> even (ultimoNoNuloFactorial n)

-- La comprobación es

-- ghci> quickCheck prop_ultimoNoNuloFactorial

-- +++ OK, passed 100 tests.

Pensamiento

Incierto es, lo porvenir. ¿Quién sabe lo que va a pasar? Pero incierto es también lo pretérito. ¿Quién sabe lo que ha pasado? De suerte que ni el porvenir está escrito en ninguna parte, ni el pasado tampoco.

Antonio Machado

Posiciones en árboles binarios completos

Soluciones

Pensamiento

Números colinas

Soluciones

Referencia

Pensamiento

Números primos sumas de dos primos

Soluciones

Pensamiento

Último dígito no nulo del factorial

Soluciones

Pensamiento

Entradas recientes

Buscar

Correo electrónico