zip – Página 3 – Exercitium

Mínima diferencia entre elementos de una lista

PorJosé A. Alonso 18-abril-201625-abril-2016

Definir la función

   minimaDiferencia :: (Num a, Ord a) => [a] -> a

1	minimaDiferencia :: (Num a, Ord a) => [a] -> a

tal que (minimaDiferencia xs) es el menor valor absoluto de las diferencias entre todos los pares de elementos de xs (que se supone que tiene al menos 2 elementos). Por ejemplo,

   minimaDiferencia [1,5,3,19,18,25]  ==  1
   minimaDiferencia [30,5,20,9]       ==  4
   minimaDiferencia [30,5,20,9,5]     ==  0
   minimaDiferencia [1..10^6]         ==  1

minimaDiferencia [1,5,3,19,18,25] == 1

minimaDiferencia [30,5,20,9] == 4

minimaDiferencia [30,5,20,9,5] == 0

minimaDiferencia [1..10^6] == 1

En el primer ejemplo la menor diferencia es 1 y se da entre los elementos 19 y 18; en el 2ª es 4 entre los elementos 5 y 9 y en la 3ª es 0 porque el elemento 5 está repetido.

Soluciones

import Data.List (delete, sort)

-- 1ª definición    
minimaDiferencia1 :: (Num a, Ord a) => [a] -> a
minimaDiferencia1 xs =
    minimum [abs (x - y) | x <- xs, y <- delete x xs]

-- 2ª definición    
minimaDiferencia2 :: (Num a, Ord a) => [a] -> a
minimaDiferencia2 [x,y]  = abs (x - y)
minimaDiferencia2 (x:xs) = min (minimum [abs (x - y) | y <- xs])
                               (minimaDiferencia2 xs)      

-- 3ª definición    
minimaDiferencia3 :: (Num a, Ord a) => [a] -> a
minimaDiferencia3 xs =
    minimum [y - x | (x,y) <- zip ys (tail ys)]
    where ys = sort xs

-- Comparación de eficiencia
--    λ> minimaDiferencia1 [1..2*10^3]
--    1
--    (3.47 secs, 1,419,790,688 bytes)
--    λ> minimaDiferencia2 [1..2*10^3]
--    1
--    (0.78 secs, 684,030,712 bytes)
--    λ> minimaDiferencia3 [1..2*10^3]
--    1
--    (0.02 secs, 0 bytes)
--    
--    λ> minimaDiferencia2 [1..5*10^3]
--    1
--    (5.14 secs, 4,233,952,776 bytes)
--    λ> minimaDiferencia3 [1..5*10^3]
--    1
--    (0.02 secs, 0 bytes)

import Data.List (delete, sort)

-- 1ª definición

minimaDiferencia1 :: (Num a, Ord a) => [a] -> a

minimaDiferencia1 xs =

minimum [abs (x - y) | x <- xs, y <- delete x xs]

-- 2ª definición

minimaDiferencia2 :: (Num a, Ord a) => [a] -> a

minimaDiferencia2 [x,y] = abs (x - y)

minimaDiferencia2 (x:xs) = min (minimum [abs (x - y) | y <- xs])

(minimaDiferencia2 xs)

-- 3ª definición

minimaDiferencia3 :: (Num a, Ord a) => [a] -> a

minimaDiferencia3 xs =

minimum [y - x | (x,y) <- zip ys (tail ys)]

where ys = sort xs

-- Comparación de eficiencia

-- λ> minimaDiferencia1 [1..2*10^3]

-- 1

-- (3.47 secs, 1,419,790,688 bytes)

-- λ> minimaDiferencia2 [1..2*10^3]

-- 1

-- (0.78 secs, 684,030,712 bytes)

-- λ> minimaDiferencia3 [1..2*10^3]

-- 1

-- (0.02 secs, 0 bytes)

-- λ> minimaDiferencia2 [1..5*10^3]

-- 1

-- (5.14 secs, 4,233,952,776 bytes)

-- λ> minimaDiferencia3 [1..5*10^3]

-- 1

-- (0.02 secs, 0 bytes)

Representación decimal de números racionales

PorJosé A. Alonso 1-abril-20168-abril-2016

Los números decimales se representan por ternas, donde el primer elemento es la parte entera, el segundo es el anteperíodo y el tercero es el período. Por ejemplo,

    6/2  = 3                  se representa por (3,[],[])
    1/2  = 0.5                se representa por (0,[5],[])
    1/3  = 0.333333...        se representa por (0,[],[3])  
   23/14 = 1.6428571428571... se representa por (1,[6],[4,2,8,5,7,1])

6/2 = 3 se representa por (3,[],[])

1/2 = 0.5 se representa por (0,[5],[])

1/3 = 0.333333... se representa por (0,[],[3])

23/14 = 1.6428571428571... se representa por (1,[6],[4,2,8,5,7,1])

Su tipo es

   type Decimal = (Integer,[Integer],[Integer])

1	type Decimal = (Integer,[Integer],[Integer])

Los números racionales se representan por un par de enteros, donde el primer elemento es el numerador y el segundo el denominador. Por ejemplo, el número 2/3 se representa por (2,3). Su tipo es

   type Racional = (Integer,Integer)

1	type Racional = (Integer,Integer)

Definir las funciones

   decimal  :: Racional -> Decimal
   racional :: Decimal -> Racional

1 2	decimal :: Racional -> Decimal racional :: Decimal -> Racional

tales que

(decimal r) es la representación decimal del número racional r. Por ejemplo,

        decimal (1,4)    ==  (0,[2,5],[])
        decimal (1,3)    ==  (0,[],[3])
        decimal (23,14)  ==  (1,[6],[4,2,8,5,7,1])

decimal (1,4) == (0,[2,5],[])

decimal (1,3) == (0,[],[3])

decimal (23,14) == (1,[6],[4,2,8,5,7,1])

(racional d) es el número racional cuya representación decimal es d. Por ejemplo,

        racional (0,[2,5],[])           ==  (1,4)
        racional (0,[],[3])             ==  (1,3)
        racional (1,[6],[4,2,8,5,7,1])  ==  (23,14)

racional (0,[2,5],[]) == (1,4)

racional (0,[],[3]) == (1,3)

racional (1,[6],[4,2,8,5,7,1]) == (23,14)

Con la función decimal se puede calcular los períodos de los números racionales. Por ejemplo,

   ghci> let (_,_,p) = decimal (23,14) in concatMap show p
   "428571"
   ghci> let (_,_,p) = decimal (1,47) in concatMap show p
   "0212765957446808510638297872340425531914893617"
   ghci> let (_,_,p) = decimal (1,541) in length (concatMap show p)
   540

ghci> let (_,_,p) = decimal (23,14) in concatMap show p

"428571"

ghci> let (_,_,p) = decimal (1,47) in concatMap show p

"0212765957446808510638297872340425531914893617"

ghci> let (_,_,p) = decimal (1,541) in length (concatMap show p)

540

Comprobar con QuickCheck si las funciones decimal y racional son inversas.

Soluciones

-- ---------------------------------------------------------------------
-- § Librerías auxiliares                                             --
-- ---------------------------------------------------------------------

import Data.List
import Test.QuickCheck

-- ---------------------------------------------------------------------
-- § Tipos                                                            --
-- ---------------------------------------------------------------------

-- Un número racional se representa por un par de enteros, donde el
-- primer elemento es el numerador y el segundo el denominador.
type Racional = (Integer,Integer)

-- Un número decimal es una terna donde el primer elemento es la parte
-- entera, el segundo es el anteperíodo y el tercero es el período.
type Decimal = (Integer,[Integer],[Integer])

-- ---------------------------------------------------------------------
-- § De racional a decimal                                            --
-- ---------------------------------------------------------------------

-- (mayorExponente a x) es el mayor n tal que a^n divide a x. Por ejemplo,
--    mayorExponente 2 40  ==  3
--    mayorExponente 5 40  ==  1
--    mayorExponente 5 41  ==  0
mayorExponente :: Integer -> Integer -> Integer
mayorExponente a x = head [n | n <- [1..], mod x (a^n) /= 0] - 1

-- (longitudAnteperiodo n) es la longitud del anteperíodo de 1/n (y de
-- cualquier fracción irreducible de denominador n). Por ejemplo, 
--    longitudAnteperiodo 2   ==  1
--    longitudAnteperiodo 3   ==  0
--    longitudAnteperiodo 14  ==  1
longitudAnteperiodo :: Integer -> Integer
longitudAnteperiodo n = max (mayorExponente 2 n) (mayorExponente 5 n)

-- (longitudPeriodo n) es la longitud del período de 1/n (y de
-- cualquier fracción irreducible de denominador n). Por ejemplo, 
--    longitudPeriodo 2  ==  0
--    longitudPeriodo 3  ==  1
--    longitudPeriodo 7  ==  6
longitudPeriodo :: Integer -> Integer
longitudPeriodo n
    | m == 1    = 0 
    | otherwise = head [k | k <- [1..], (10^k) `mod` m == 1]
    where m = n `div` (2^(mayorExponente 2 n) * 5^(mayorExponente 5 n))

-- (expansionDec (x,y)) es la expansión decimal de x/y. Por ejemplo, 
--    take 10 (expansionDec (1,4))    ==  [0,2,5]
--    take 10 (expansionDec (1,7))    ==  [0,1,4,2,8,5,7,1,4,2]
--    take 12 (expansionDec (90,7))   ==  [12,8,5,7,1,4,2,8,5,7,1,4]
--    take 12 (expansionDec (23,14))  ==  [1,6,4,2,8,5,7,1,4,2,8,5]
expansionDec :: Racional -> [Integer]
expansionDec (x,y) 
    | r == 0    = [q] 
    | otherwise = q : expansionDec (r*10,y)
    where (q,r) = quotRem x y

-- (parteEntera (a,b)) es la parte entera de a/b. Por ejemplo,
--    parteEntera (125,3)  ==  41
parteEntera :: Racional -> Integer
parteEntera (a,b) = a `div` b

-- (antePeriodo (a,b)) es el anteperíodo de a/b; es decir, la lista de
-- cifras que se encuentran entre la parte entera y el primer período de
-- a/b. Por ejemplo,
--    antePeriodo (23,14)  ==  [6]
--    antePeriodo (1,5)    ==  [2]
antePeriodo :: Racional -> [Integer]
antePeriodo (a,b) = genericTake s (tail xs)
    where xs = expansionDec (a,b)
          s  = longitudAnteperiodo b

-- (periodo (a,b)) es el período de a/b; es decir, la lista de cifras que
-- se encuentran entre la parte entera y el primer período de a/b. Por
-- ejemplo, 
--    periodo (1,3)                   ==  [3]
--    periodo (1,5)                   ==  []
--    periodo (1,7)                   ==  [1,4,2,8,5,7]
--    periodo (23,14)                 ==  [4,2,8,5,7,1]
--    concatMap show $ periodo (1,29) == "0344827586206896551724137931"
periodo :: Racional -> [Integer]
periodo (a,b) = genericTake t (genericDrop (1+s) xs)
    where xs = expansionDec (a,b)
          s  = longitudAnteperiodo b
          t  = longitudPeriodo b

-- (reducido (a,b)) es la forma reducida del número racional a/b. Por
-- ejemplo, 
--    reducido (40,80)  ==  (1,2)
reducido :: Racional -> Racional
reducido (a,b) = (a `div` m, b `div` m) 
    where m = gcd a b

-- (decimal (x,y)) es la forma decimal de x/y; es decir, la terna
-- formada por la parte entera, la parte decimal pura y la parte decimal
-- periódica. Por ejemplo, 
--    decimal (1,4)    ==  (0,[2,5],[])
--    decimal (1,3)    ==  (0,[],[3])
--    decimal (23,14)  ==  (1,[6],[4,2,8,5,7,1])
decimal :: Racional -> Decimal
decimal (a,b) = (parteEntera r, antePeriodo r, periodo r)
    where r = reducido (a,b)

-- ---------------------------------------------------------------------
-- § De decimal a racional                                            --
-- ---------------------------------------------------------------------

-- (digitosAnumero xs) es el número correspondiente a la lista de
-- dígitos xs. Por ejemplo,
--    digitosAnumero [3,2,5]  ==  325
digitosAnumero :: [Integer] -> Integer
digitosAnumero = foldl (\a y -> 10*a+y) 0

-- 2ª definición de digitosAnumero (por comprensión)
digitosAnumero2 :: [Integer] -> Integer
digitosAnumero2 xs = sum [x*(10^i) | (x,i) <- zip xs [n-1,n-2..0]]
    where n = length xs

-- (racional (x,ys,zs)) es el número racional cuya representación
-- decimal es (x,ys,zs). Por ejemplo,
--    racional (0,[2,5],[])           ==  (1,4)
--    racional (0,[],[3])             ==  (1,3)
--    racional (1,[6],[4,2,8,5,7,1])  ==  (23,14)
racional :: Decimal -> Racional
racional (x,ys,[]) = reducido (a,b) where
    a = digitosAnumero (x:ys)
    b = 10^(length ys)
racional (x,ys,zs) = reducido (a,b) where 
    a = digitosAnumero (x:ys++zs) - digitosAnumero (x:ys)
    b = digitosAnumero (replicate (length zs) 9 ++ replicate (length ys) 0)

-- ---------------------------------------------------------------------
-- § Propiedades                                                      --
-- ---------------------------------------------------------------------

-- La 1ª propiedad es
prop_RacionalDecimal :: Racional -> Property
prop_RacionalDecimal (a,b) =
    a >= 0 && b > 0  ==>
    racional (decimal (a,b)) == reducido (a,b)

-- La comprobación es 
--    ghci> quickCheck prop_RacionalDecimal
--    +++ OK, passed 100 tests.

-- En lugar de reducido se puede usar un generador de números racionales
numeroRacional :: Gen Racional
numeroRacional = do a <- arbitrary
                    b <- arbitrary
                    return (reducido (abs a, 1+ abs b))

-- La propiedad es
prop_RacionalDecimal2 :: Property
prop_RacionalDecimal2 =
    forAll numeroRacional
           (\(a,b) -> racional (decimal (a,b)) == (a,b))

-- La comprobación es
--   ghci> quickCheck prop_RacionalDecimal2
--   +++ OK, passed 100 tests.

-- Para la 2ª propiedad se define un generador de números decimales
numeroDecimal :: Gen Decimal
numeroDecimal = do a <- arbitrary
                   b <- arbitrary
                   return (decimal (abs a, 1+ abs b))

-- La 2ª propiedad es
prop_DecimalRacional :: Property
prop_DecimalRacional =
    forAll numeroDecimal 
           (\(x,ys,zs) -> decimal (racional (x,ys,zs)) == (x,ys,zs))

-- La comprobación es
--   ghci> quickCheck prop_DecimalRacional
--   +++ 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

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

171

172

173

174

175

176

177

178

179

-- ---------------------------------------------------------------------

-- § Librerías auxiliares --

-- ---------------------------------------------------------------------

import Data.List

import Test.QuickCheck

-- ---------------------------------------------------------------------

-- § Tipos --

-- ---------------------------------------------------------------------

-- Un número racional se representa por un par de enteros, donde el

-- primer elemento es el numerador y el segundo el denominador.

type Racional = (Integer,Integer)

-- Un número decimal es una terna donde el primer elemento es la parte

-- entera, el segundo es el anteperíodo y el tercero es el período.

type Decimal = (Integer,[Integer],[Integer])

-- ---------------------------------------------------------------------

-- § De racional a decimal --

-- ---------------------------------------------------------------------

-- (mayorExponente a x) es el mayor n tal que a^n divide a x. Por ejemplo,

-- mayorExponente 2 40 == 3

-- mayorExponente 5 40 == 1

-- mayorExponente 5 41 == 0

mayorExponente :: Integer -> Integer -> Integer

mayorExponente a x = head [n | n <- [1..], mod x (a^n) /= 0] - 1

-- (longitudAnteperiodo n) es la longitud del anteperíodo de 1/n (y de

-- cualquier fracción irreducible de denominador n). Por ejemplo,

-- longitudAnteperiodo 2 == 1

-- longitudAnteperiodo 3 == 0

-- longitudAnteperiodo 14 == 1

longitudAnteperiodo :: Integer -> Integer

longitudAnteperiodo n = max (mayorExponente 2 n) (mayorExponente 5 n)

-- (longitudPeriodo n) es la longitud del período de 1/n (y de

-- cualquier fracción irreducible de denominador n). Por ejemplo,

-- longitudPeriodo 2 == 0

-- longitudPeriodo 3 == 1

-- longitudPeriodo 7 == 6

longitudPeriodo :: Integer -> Integer

longitudPeriodo n

| m == 1 = 0

| otherwise = head [k | k <- [1..], (10^k) `mod` m == 1]

where m = n `div` (2^(mayorExponente 2 n) * 5^(mayorExponente 5 n))

-- (expansionDec (x,y)) es la expansión decimal de x/y. Por ejemplo,

-- take 10 (expansionDec (1,4)) == [0,2,5]

-- take 10 (expansionDec (1,7)) == [0,1,4,2,8,5,7,1,4,2]

-- take 12 (expansionDec (90,7)) == [12,8,5,7,1,4,2,8,5,7,1,4]

-- take 12 (expansionDec (23,14)) == [1,6,4,2,8,5,7,1,4,2,8,5]

expansionDec :: Racional -> [Integer]

expansionDec (x,y)

| r == 0 = [q]

| otherwise = q : expansionDec (r*10,y)

where (q,r) = quotRem x y

-- (parteEntera (a,b)) es la parte entera de a/b. Por ejemplo,

-- parteEntera (125,3) == 41

parteEntera :: Racional -> Integer

parteEntera (a,b) = a `div` b

-- (antePeriodo (a,b)) es el anteperíodo de a/b; es decir, la lista de

-- cifras que se encuentran entre la parte entera y el primer período de

-- a/b. Por ejemplo,

-- antePeriodo (23,14) == [6]

-- antePeriodo (1,5) == [2]

antePeriodo :: Racional -> [Integer]

antePeriodo (a,b) = genericTake s (tail xs)

where xs = expansionDec (a,b)

s = longitudAnteperiodo b

-- (periodo (a,b)) es el período de a/b; es decir, la lista de cifras que

-- se encuentran entre la parte entera y el primer período de a/b. Por

-- ejemplo,

-- periodo (1,3) == [3]

-- periodo (1,5) == []

-- periodo (1,7) == [1,4,2,8,5,7]

-- periodo (23,14) == [4,2,8,5,7,1]

-- concatMap show $ periodo (1,29) == "0344827586206896551724137931"

periodo :: Racional -> [Integer]

periodo (a,b) = genericTake t (genericDrop (1+s) xs)

where xs = expansionDec (a,b)

s = longitudAnteperiodo b

t = longitudPeriodo b

-- (reducido (a,b)) es la forma reducida del número racional a/b. Por

-- ejemplo,

-- reducido (40,80) == (1,2)

reducido :: Racional -> Racional

reducido (a,b) = (a `div` m, b `div` m)

where m = gcd a b

-- (decimal (x,y)) es la forma decimal de x/y; es decir, la terna

-- formada por la parte entera, la parte decimal pura y la parte decimal

-- periódica. Por ejemplo,

-- decimal (1,4) == (0,[2,5],[])

-- decimal (1,3) == (0,[],[3])

-- decimal (23,14) == (1,[6],[4,2,8,5,7,1])

decimal :: Racional -> Decimal

decimal (a,b) = (parteEntera r, antePeriodo r, periodo r)

where r = reducido (a,b)

-- ---------------------------------------------------------------------

-- § De decimal a racional --

-- ---------------------------------------------------------------------

-- (digitosAnumero xs) es el número correspondiente a la lista de

-- dígitos xs. Por ejemplo,

-- digitosAnumero [3,2,5] == 325

digitosAnumero :: [Integer] -> Integer

digitosAnumero = foldl (\a y -> 10*a+y) 0

-- 2ª definición de digitosAnumero (por comprensión)

digitosAnumero2 :: [Integer] -> Integer

digitosAnumero2 xs = sum [x*(10^i) | (x,i) <- zip xs [n-1,n-2..0]]

where n = length xs

-- (racional (x,ys,zs)) es el número racional cuya representación

-- decimal es (x,ys,zs). Por ejemplo,

-- racional (0,[2,5],[]) == (1,4)

-- racional (0,[],[3]) == (1,3)

-- racional (1,[6],[4,2,8,5,7,1]) == (23,14)

racional :: Decimal -> Racional

racional (x,ys,[]) = reducido (a,b) where

a = digitosAnumero (x:ys)

b = 10^(length ys)

racional (x,ys,zs) = reducido (a,b) where

a = digitosAnumero (x:ys++zs) - digitosAnumero (x:ys)

b = digitosAnumero (replicate (length zs) 9 ++ replicate (length ys) 0)

-- ---------------------------------------------------------------------

-- § Propiedades --

-- ---------------------------------------------------------------------

-- La 1ª propiedad es

prop_RacionalDecimal :: Racional -> Property

prop_RacionalDecimal (a,b) =

a >= 0 && b > 0 ==>

racional (decimal (a,b)) == reducido (a,b)

-- La comprobación es

-- ghci> quickCheck prop_RacionalDecimal

-- +++ OK, passed 100 tests.

-- En lugar de reducido se puede usar un generador de números racionales

numeroRacional :: Gen Racional

numeroRacional = do a <- arbitrary

b <- arbitrary

return (reducido (abs a, 1+ abs b))

-- La propiedad es

prop_RacionalDecimal2 :: Property

prop_RacionalDecimal2 =

forAll numeroRacional

(\(a,b) -> racional (decimal (a,b)) == (a,b))

-- La comprobación es

-- ghci> quickCheck prop_RacionalDecimal2

-- +++ OK, passed 100 tests.

-- Para la 2ª propiedad se define un generador de números decimales

numeroDecimal :: Gen Decimal

numeroDecimal = do a <- arbitrary

b <- arbitrary

return (decimal (abs a, 1+ abs b))

-- La 2ª propiedad es

prop_DecimalRacional :: Property

prop_DecimalRacional =

forAll numeroDecimal

(\(x,ys,zs) -> decimal (racional (x,ys,zs)) == (x,ys,zs))

-- La comprobación es

-- ghci> quickCheck prop_DecimalRacional

-- +++ OK, passed 100 tests.

Comportamiento del último dígito en primos consecutivos

PorJosé A. Alonso 18-marzo-20162-mayo-2016

El pasado 11 de marzo se ha publicado el artículo Unexpected biases in the distribution of consecutive primes en el que muestra que los números primos repelen a otros primos que terminan en el mismo dígito.

La lista de los últimos dígitos de los 30 primeros números es

   [2,3,5,7,1,3,7,9,3,9,1,7,1,3,7,3,9,1,7,1,3,9,3,9,7,1,3,7,9,3]

1	[2,3,5,7,1,3,7,9,3,9,1,7,1,3,7,3,9,1,7,1,3,9,3,9,7,1,3,7,9,3]

Se observa que hay 6 números que su último dígito es un 1 y de sus consecutivos 4 terminan en 3 y 2 terminan en 7.

Definir la función

   distribucionUltimos :: Int -> M.Matrix Integer

1	distribucionUltimos :: Int -> M.Matrix Integer

tal que (distribucionUltimos n) es la matriz cuyo elemento (i,j) indica cuántos de los n primeros números primos terminan en i y su siguiente número primo termina en j. Por ejemplo,

   λ> distribucionUltimos 30
   ( 0 0 4 0 0 0 2 0 0 )
   ( 0 0 1 0 0 0 0 0 0 )
   ( 0 0 0 0 1 0 4 0 4 )
   ( 0 0 0 0 0 0 0 0 0 )
   ( 0 0 0 0 0 0 1 0 0 )
   ( 0 0 0 0 0 0 0 0 0 )
   ( 4 0 1 0 0 0 0 0 2 )
   ( 0 0 0 0 0 0 0 0 0 )
   ( 2 0 3 0 0 0 1 0 0 )
   
   λ> distribucionUltimos (10^5)
   ( 4104    0 7961    0    0    0 8297    0 4605 )
   (    0    0    1    0    0    0    0    0    0 )
   ( 5596    0 3604    0    1    0 7419    0 8387 )
   (    0    0    0    0    0    0    0    0    0 )
   (    0    0    0    0    0    0    1    0    0 )
   (    0    0    0    0    0    0    0    0    0 )
   ( 6438    0 6928    0    0    0 3627    0 8022 )
   (    0    0    0    0    0    0    0    0    0 )
   ( 8830    0 6513    0    0    0 5671    0 3995 )

λ> distribucionUltimos 30

( 0 0 4 0 0 0 2 0 0 )

( 0 0 1 0 0 0 0 0 0 )

( 0 0 0 0 1 0 4 0 4 )

( 0 0 0 0 0 0 0 0 0 )

( 0 0 0 0 0 0 1 0 0 )

( 0 0 0 0 0 0 0 0 0 )

( 4 0 1 0 0 0 0 0 2 )

( 0 0 0 0 0 0 0 0 0 )

( 2 0 3 0 0 0 1 0 0 )

λ> distribucionUltimos (10^5)

( 4104 0 7961 0 0 0 8297 0 4605 )

( 0 0 1 0 0 0 0 0 0 )

( 5596 0 3604 0 1 0 7419 0 8387 )

( 0 0 0 0 0 0 0 0 0 )

( 0 0 0 0 0 0 1 0 0 )

( 0 0 0 0 0 0 0 0 0 )

( 6438 0 6928 0 0 0 3627 0 8022 )

( 0 0 0 0 0 0 0 0 0 )

( 8830 0 6513 0 0 0 5671 0 3995 )

Nota: Se observa cómo se «repelen» ya que en las filas del 1, 3, 7 y 9 el menor elemento es el de la diagonal.

Soluciones

import Data.Numbers.Primes
import Data.Array
import qualified Data.Matrix as M

-- (ultimo n) es el último dígito de n.    
ultimo :: Integer -> Integer
ultimo n = n `mod` 10

-- ultimos es la lista de el último dígito de los primos.
--    λ> take 20 ultimos
--    [2,3,5,7,1,3,7,9,3,9,1,7,1,3,7,3,9,1,7,1]
ultimos :: [Integer]
ultimos = map ultimo primes

-- ultimosConsecutivos es la lista de los últimos dígitos de los primos
-- consecutivos. 
--    λ> take 10 ultimosConsecutivos
--    [(2,3),(3,5),(5,7),(7,1),(1,3),(3,7),(7,9),(9,3),(3,9),(9,1)]
ultimosConsecutivos :: [(Integer,Integer)]
ultimosConsecutivos = zip ultimos (tail ultimos)

-- (histograma r is) es el vector formado contando cuantas veces
-- aparecen los elementos del rango r en la lista de índices is. Por
-- ejemplo, 
--    ghci> histograma (0,5) [3,1,4,1,5,4,2,7]
--    array (0,5) [(0,0),(1,2),(2,1),(3,1),(4,2),(5,1)]
histograma :: (Ix a, Num b) => (a,a) -> [a] -> Array a b
histograma r is = 
    accumArray (+) 0 r [(i,1) | i <- is, inRange r i]

distribucionUltimos :: Int -> M.Matrix Integer
distribucionUltimos n =
    M.fromList 9 9 (elems (histograma ((1,1),(9,9)) (take n ultimosConsecutivos)))

import Data.Numbers.Primes

import Data.Array

import qualified Data.Matrix as M

-- (ultimo n) es el último dígito de n.

ultimo :: Integer -> Integer

ultimo n = n `mod` 10

-- ultimos es la lista de el último dígito de los primos.

-- λ> take 20 ultimos

-- [2,3,5,7,1,3,7,9,3,9,1,7,1,3,7,3,9,1,7,1]

ultimos :: [Integer]

ultimos = map ultimo primes

-- ultimosConsecutivos es la lista de los últimos dígitos de los primos

-- consecutivos.

-- λ> take 10 ultimosConsecutivos

-- [(2,3),(3,5),(5,7),(7,1),(1,3),(3,7),(7,9),(9,3),(3,9),(9,1)]

ultimosConsecutivos :: [(Integer,Integer)]

ultimosConsecutivos = zip ultimos (tail ultimos)

-- (histograma r is) es el vector formado contando cuantas veces

-- aparecen los elementos del rango r en la lista de índices is. Por

-- ejemplo,

-- ghci> histograma (0,5) [3,1,4,1,5,4,2,7]

-- array (0,5) [(0,0),(1,2),(2,1),(3,1),(4,2),(5,1)]

histograma :: (Ix a, Num b) => (a,a) -> [a] -> Array a b

histograma r is =

accumArray (+) 0 r [(i,1) | i <- is, inRange r i]

distribucionUltimos :: Int -> M.Matrix Integer

distribucionUltimos n =

M.fromList 9 9 (elems (histograma ((1,1),(9,9)) (take n ultimosConsecutivos)))

Solución en Maxima

distribucionUltimos (n) := block (
  [r : zeromatrix (9,9),
   xs : ultimos (n),
   i, j],
  unless length (xs) < 2 do
    ( i : first (xs),
      j : second (xs),
      r[i,j] : 1 + r[i,j],
      xs : rest (xs)),
  r)$

/* ultimos(n) es la lista del último dígito de los n primeros primos.
      (%i5) ultimos (30);
      (%o5) [2,3,5,7,1,3,7,9,3,9,1,7,1,3,7,3,9,1,7,1,3,9,3,9,7,1,3,7,9,3,7]
*/
ultimos (n) := block ([r:[], p:2],
  for k from 0 thru n do
    ( r : cons (mod (p,10), r),
      p : next_prime (p) ),
  reverse (r))$

distribucionUltimos (n) := block (

[r : zeromatrix (9,9),

xs : ultimos (n),

i, j],

unless length (xs) < 2 do

( i : first (xs),

j : second (xs),

r[i,j] : 1 + r[i,j],

xs : rest (xs)),

r)$

/* ultimos(n) es la lista del último dígito de los n primeros primos.

(%i5) ultimos (30);

(%o5) [2,3,5,7,1,3,7,9,3,9,1,7,1,3,7,3,9,1,7,1,3,9,3,9,7,1,3,7,9,3,7]

ultimos (n) := block ([r:[], p:2],

for k from 0 thru n do

( r : cons (mod (p,10), r),

p : next_prime (p) ),

reverse (r))$

Máxima suma en una matriz

PorJosé A. Alonso 11-marzo-201628-marzo-2016

Las matrices puede representarse mediante tablas cuyos índices son pares de números naturales:

   type Matriz = Array (Int,Int) Int

1	type Matriz = Array (Int,Int) Int

Definir la función

   maximaSuma :: Matriz -> Int

1	maximaSuma :: Matriz -> Int

tal que (maximaSuma p) es el máximo de las sumas de las listas de elementos de la matriz p tales que cada elemento pertenece sólo a una fila y a una columna. Por ejemplo,

   ghci> maximaSuma (listArray ((1,1),(3,3)) [1,2,3,8,4,9,5,6,7])
   17

1 2	ghci> maximaSuma (listArray ((1,1),(3,3)) [1,2,3,8,4,9,5,6,7]) 17

ya que las selecciones, y sus sumas, de la matriz

   |1 2 3|
   |8 4 9|
   |5 6 7|

|1 2 3|

|8 4 9|

|5 6 7|

son

   [1,4,7] --> 12
   [1,9,6] --> 16
   [2,8,7] --> 17
   [2,9,5] --> 16
   [3,8,6] --> 17
   [3,4,5] --> 12

[1,4,7] --> 12

[1,9,6] --> 16

[2,8,7] --> 17

[2,9,5] --> 16

[3,8,6] --> 17

[3,4,5] --> 12

Hay dos selecciones con máxima suma: [2,8,7] y [3,8,6].

Soluciones

import Data.Array
import Data.List (permutations)

type Matriz = Array (Int,Int) Int

maximaSuma :: Matriz -> Int
maximaSuma p = maximum [sum xs | xs <- selecciones p]

-- (selecciones p) es la lista de las selecciones en las que cada
-- elemento pertenece a un única fila y a una única columna de la matriz
-- p. Por ejemplo,
--    ghci> selecciones (listArray ((1,1),(3,3)) [1,2,3,8,4,9,5,6,7])
--    [[1,4,7],[2,8,7],[3,4,5],[2,9,5],[3,8,6],[1,9,6]]
selecciones :: Matriz -> [[Int]]
selecciones p = 
    [[p!(i,j) | (i,j) <- ijs] | 
     ijs <- [zip [1..n] xs | xs <- permutations [1..n]]] 
    where (_,(m,n)) = bounds p

-- 2ª solución (mediante submatrices):
maximaSuma2 :: Matriz -> Int
maximaSuma2 p 
    | (m,n) == (1,1) = p!(1,1)
    | otherwise = maximum [p!(1,j) 
                  + maximaSuma2 (submatriz 1 j p) | j <- [1..n]]
    where (_,(m,n)) = bounds p

-- (submatriz i j p) es la matriz obtenida a partir de la p eliminando
-- la fila i y la columna j. Por ejemplo, 
--    ghci> submatriz 2 3 (listArray ((1,1),(3,3)) [1,2,3,8,4,9,5,6,7])
--    array ((1,1),(2,2)) [((1,1),1),((1,2),2),((2,1),5),((2,2),6)]
submatriz :: Int -> Int -> Matriz -> Matriz
submatriz i j p = 
    array ((1,1), (m-1,n -1))
          [((k,l), p ! f k l) | k <- [1..m-1], l <- [1.. n-1]]
    where (_,(m,n)) = bounds p
          f k l | k < i  && l < j  = (k,l)
                | k >= i && l < j  = (k+1,l)
                | k < i  && l >= j = (k,l+1)
                | otherwise        = (k+1,l+1)

import Data.Array

import Data.List (permutations)

type Matriz = Array (Int,Int) Int

maximaSuma :: Matriz -> Int

maximaSuma p = maximum [sum xs | xs <- selecciones p]

-- (selecciones p) es la lista de las selecciones en las que cada

-- elemento pertenece a un única fila y a una única columna de la matriz

-- p. Por ejemplo,

-- ghci> selecciones (listArray ((1,1),(3,3)) [1,2,3,8,4,9,5,6,7])

-- [[1,4,7],[2,8,7],[3,4,5],[2,9,5],[3,8,6],[1,9,6]]

selecciones :: Matriz -> [[Int]]

selecciones p =

[[p!(i,j) | (i,j) <- ijs] |

ijs <- [zip [1..n] xs | xs <- permutations [1..n]]]

where (_,(m,n)) = bounds p

-- 2ª solución (mediante submatrices):

maximaSuma2 :: Matriz -> Int

maximaSuma2 p

| (m,n) == (1,1) = p!(1,1)

| otherwise = maximum [p!(1,j)

+ maximaSuma2 (submatriz 1 j p) | j <- [1..n]]

where (_,(m,n)) = bounds p

-- (submatriz i j p) es la matriz obtenida a partir de la p eliminando

-- la fila i y la columna j. Por ejemplo,

-- ghci> submatriz 2 3 (listArray ((1,1),(3,3)) [1,2,3,8,4,9,5,6,7])

-- array ((1,1),(2,2)) [((1,1),1),((1,2),2),((2,1),5),((2,2),6)]

submatriz :: Int -> Int -> Matriz -> Matriz

submatriz i j p =

array ((1,1), (m-1,n -1))

[((k,l), p ! f k l) | k <- [1..m-1], l <- [1.. n-1]]

where (_,(m,n)) = bounds p

f k l | k < i && l < j = (k,l)

| k >= i && l < j = (k+1,l)

| k < i && l >= j = (k,l+1)

| otherwise = (k+1,l+1)

Índices de números de Fibonacci

PorJosé A. Alonso 2-marzo-201626-marzo-2022

Los primeros términos de la sucesión de Fibonacci son

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

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

Se observa que el 6º término de la sucesión (comenzando a contar en 0) es el número 8.

Definir la función

   indiceFib :: Integer -> Maybe Integer

1	indiceFib :: Integer -> Maybe Integer

tal que (indiceFib x) es justo el número n si x es el n-ésimo términos de la sucesión de Fibonacci o Nothing en el caso de que x no pertenezca a la sucesión. Por ejemplo,

    indiceFib 8                                           == Just 6
    indiceFib 9                                           == Nothing
    indiceFib 21                                          == Just 8
    indiceFib 22                                          == Nothing
    indiceFib 280571172992510140037611932413038677189525  == Just 200
    indiceFib 123456789012345678901234567890123456789012  == Nothing

indiceFib 8 == Just 6

indiceFib 9 == Nothing

indiceFib 21 == Just 8

indiceFib 22 == Nothing

indiceFib 280571172992510140037611932413038677189525 == Just 200

indiceFib 123456789012345678901234567890123456789012 == Nothing

Soluciones

indiceFib :: Integer -> Maybe Integer
indiceFib x | y == x    = Just n
            | otherwise = Nothing
    where (y,n) = head (dropWhile (\(z,m) -> z < x) fibsNumerados)

-- fibs es la lista de los términos de 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 : [x+y | (x,y) <- zip fibs (tail fibs)]

-- fibsNumerados es la lista de los términos de la sucesión de Fibonacci
-- juntos con sus posiciones. Por ejemplo,
--    ghci> take 10 fibsNumerados
--    [(0,0),(1,1),(1,2),(2,3),(3,4),(5,5),(8,6),(13,7),(21,8),(34,9)]
fibsNumerados :: [(Integer,Integer)]
fibsNumerados = zip fibs [0..]

indiceFib :: Integer -> Maybe Integer

indiceFib x | y == x = Just n

| otherwise = Nothing

where (y,n) = head (dropWhile (\(z,m) -> z < x) fibsNumerados)

-- fibs es la lista de los términos de 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 : [x+y | (x,y) <- zip fibs (tail fibs)]

-- fibsNumerados es la lista de los términos de la sucesión de Fibonacci

-- juntos con sus posiciones. Por ejemplo,

-- ghci> take 10 fibsNumerados

-- [(0,0),(1,1),(1,2),(2,3),(3,4),(5,5),(8,6),(13,7),(21,8),(34,9)]

fibsNumerados :: [(Integer,Integer)]

fibsNumerados = zip fibs [0..]

En Maxima

indiceFib (n) := block([a:0,b:1,c:1,p:0],
  unless n <= a do
   (a : b,
    b : c,
    c : a + b,
    p : p + 1),
  if n = a
  then Just (p)
  else Nothing)$

indiceFib (n) := block([a:0,b:1,c:1,p:0],

unless n <= a do

(a : b,

b : c,

c : a + b,

p : p + 1),

if n = a

then Just (p)

else Nothing)$

Cambios de signo

PorJosé A. Alonso 12-enero-201620-enero-2016

En una lista xs se produce un cambio de signo por cada elemento x de la lista junto el primero de los elementos de xs con signo opuesto al de x. Por ejemplo,en la lista [6,5,-4,0,-2,-7,0,-8,-1,4] hay 2 cambios de signo (entre (5,-4) y (-1,4)) y en la lista [6,5,-4,0, 2,-7,0,-8,-1,4] hay 4 cambios de signo (entre (5,-4), (-4,2), (2,-7) y(-1,4)).

Definir la función

   nCambios :: (Num a, Ord a) => [a] -> Int

1	nCambios :: (Num a, Ord a) => [a] -> Int

tal que (nCambios xs) es el número de cambios de signos de la lista xs. Por ejemplo,

   nCambios []                          ==  0
   nCambios [6,5,-4,0,-2,-7,0,-8,-1,4]  ==  2
   nCambios [6,5,-4,0, 2,-7,0,-8,-1,4]  ==  4

nCambios [] == 0

nCambios [6,5,-4,0,-2,-7,0,-8,-1,4] == 2

nCambios [6,5,-4,0, 2,-7,0,-8,-1,4] == 4

Soluciones

import Data.List (group)

-- 1ª definición
nCambios1 :: (Num a, Ord a) => [a] -> Int
nCambios1 = length . cambios

-- (cambios xs) es la lista de los pares de elementos de xs entre los
-- que se producen cambios de signo. Por ejemplo,
--    cambios [6,5,-4,0,-2,-7,0,-8,-1,4]  ==  [(5,-4),(-1,4)]
--    cambios [6,5,-4,0, 2,-7,0,-8,-1,4]  ==  [(5,-4),(-4,2),(2,-7),(-1,4)]
cambios :: (Num a, Ord a) => [a] -> [(a,a)]
cambios xs =
    [(x,y) | (x,y) <- zip ys (tail ys), x*y < 0]
    where ys = filter (/=0) xs

-- 2ª definición
nCambios2 :: (Num a, Ord a) => [a] -> Int
nCambios2 [] = 0
nCambios2 xs = length (group (filter (/=0) (map signum xs))) - 1

-- 3ª definición
nCambios3 :: (Num a, Ord a) => [a] -> Int
nCambios3 = pred . length . group . filter (/=0) . map signum

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

--    λ> nCambios1 (take (2*10^6) (cycle [3,0,-3]))
--    1333332
--    (3.84 secs, 679,805,392 bytes)
--    λ> nCambios2 (take (2*10^6) (cycle [3,0,-3]))
--    1333332
--    (0.98 secs, 694,247,368 bytes)
--    λ> nCambios3 (take (2*10^6) (cycle [3,0,-3]))
--    1333332
--    (0.95 secs, 708,118,976 bytes)

import Data.List (group)

-- 1ª definición

nCambios1 :: (Num a, Ord a) => [a] -> Int

nCambios1 = length . cambios

-- (cambios xs) es la lista de los pares de elementos de xs entre los

-- que se producen cambios de signo. Por ejemplo,

-- cambios [6,5,-4,0,-2,-7,0,-8,-1,4] == [(5,-4),(-1,4)]

-- cambios [6,5,-4,0, 2,-7,0,-8,-1,4] == [(5,-4),(-4,2),(2,-7),(-1,4)]

cambios :: (Num a, Ord a) => [a] -> [(a,a)]

cambios xs =

[(x,y) | (x,y) <- zip ys (tail ys), x*y < 0]

where ys = filter (/=0) xs

-- 2ª definición

nCambios2 :: (Num a, Ord a) => [a] -> Int

nCambios2 [] = 0

nCambios2 xs = length (group (filter (/=0) (map signum xs))) - 1

-- 3ª definición

nCambios3 :: (Num a, Ord a) => [a] -> Int

nCambios3 = pred . length . group . filter (/=0) . map signum

-- Comparación de eficiencia

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

-- λ> nCambios1 (take (2*10^6) (cycle [3,0,-3]))

-- 1333332

-- (3.84 secs, 679,805,392 bytes)

-- λ> nCambios2 (take (2*10^6) (cycle [3,0,-3]))

-- 1333332

-- (0.98 secs, 694,247,368 bytes)

-- λ> nCambios3 (take (2*10^6) (cycle [3,0,-3]))

-- 1333332

-- (0.95 secs, 708,118,976 bytes)

Puntos en una región

PorJosé A. Alonso 5-enero-20161-mayo-2016

Definir la función

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

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

tal que (puntos n) es la lista de los puntos (x,y) con coordenadas enteras de
la cuadrícula [1..n]x[1..n] (es decir, 1 ≤ x,y ≤ n) tales que |x²-xy-y²| = 1. Por ejemplo,

   length (puntos 10)          ==  5
   length (puntos 100)         ==  10
   length (puntos 1000)        ==  15
   length (puntos (10^50000))  ==  239249

length (puntos 10) == 5

length (puntos 100) == 10

length (puntos 1000) == 15

length (puntos (10^50000)) == 239249

Soluciones

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

puntos1 :: Integer -> [(Integer,Integer)]
puntos1 n =
    [(x,y) | x <- [1..n],
             y <- [1..n],
             abs (x^2-x*y-y^2) == 1] 

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

-- Calculando algunos elementos
--    λ> puntos1 10
--    [(1,1),(2,1),(3,2),(5,3),(8,5)]
--    λ> puntos1 20
--    [(1,1),(2,1),(3,2),(5,3),(8,5),(13,8)]
--    λ> puntos1 100
--    [(1,1),(2,1),(3,2),(5,3),(8,5),(13,8),(21,13),(34,21),(55,34),(89,55)]
--    λ> puntos1 89
--    [(1,1),(2,1),(3,2),(5,3),(8,5),(13,8),(21,13),(34,21),(55,34),(89,55)]
-- se observa una ley de construcción de cada elemento a partir del anterior.

puntos2 :: Integer -> [(Integer,Integer)]
puntos2 n = takeWhile menor (iterate siguiente (1,1))
    where siguiente (x,y) = (x+y,x)
          menor (x,y)     = x <= n

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

-- Se observa que la lista de las segundas componentes
--    1,1,2,3,5,8,13,21,34,55,89,...
-- y la lista de las primeras componentes es el resto de la segunda. 

puntos3 :: Integer -> [(Integer,Integer)]
puntos3 n = zip (tail xs) xs
    where xs = takeWhile (<=n) fibonacci

-- fibonacci es la sucesión de Fibonacci. Por ejemplo,
--    take 11 fibonacci  ==  [1,1,2,3,5,8,13,21,34,55,89]
fibonacci :: [Integer]
fibonacci = 1 : 1 : zipWith (+) fibonacci (tail fibonacci)

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

-- λ> length (puntos1 (10^3))
-- 15
-- (7.96 secs, 1,092,368,200 bytes)
-- λ> length (puntos2 (10^3))
-- 15
-- (0.02 secs, 0 bytes)
-- 
-- λ> length (puntos2 (10^30000))
-- 143549
-- (1.14 secs, 974,239,544 bytes)
-- λ> length (puntos3 (10^30000))
-- 143549
-- (3.28 secs, 967,206,560 bytes)

-- 1ª definición

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

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

puntos1 n =

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

y <- [1..n],

abs (x^2-x*y-y^2) == 1]

-- 2ª definición

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

-- Calculando algunos elementos

-- λ> puntos1 10

-- [(1,1),(2,1),(3,2),(5,3),(8,5)]

-- λ> puntos1 20

-- [(1,1),(2,1),(3,2),(5,3),(8,5),(13,8)]

-- λ> puntos1 100

-- [(1,1),(2,1),(3,2),(5,3),(8,5),(13,8),(21,13),(34,21),(55,34),(89,55)]

-- λ> puntos1 89

-- [(1,1),(2,1),(3,2),(5,3),(8,5),(13,8),(21,13),(34,21),(55,34),(89,55)]

-- se observa una ley de construcción de cada elemento a partir del anterior.

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

puntos2 n = takeWhile menor (iterate siguiente (1,1))

where siguiente (x,y) = (x+y,x)

menor (x,y) = x <= n

-- 3ª definición

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

-- Se observa que la lista de las segundas componentes

-- 1,1,2,3,5,8,13,21,34,55,89,...

-- y la lista de las primeras componentes es el resto de la segunda.

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

puntos3 n = zip (tail xs) xs

where xs = takeWhile (<=n) fibonacci

-- fibonacci es la sucesión de Fibonacci. Por ejemplo,

-- take 11 fibonacci == [1,1,2,3,5,8,13,21,34,55,89]

fibonacci :: [Integer]

fibonacci = 1 : 1 : zipWith (+) fibonacci (tail fibonacci)

-- Comparación de eficiencia

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

-- λ> length (puntos1 (10^3))

-- 15

-- (7.96 secs, 1,092,368,200 bytes)

-- λ> length (puntos2 (10^3))

-- 15

-- (0.02 secs, 0 bytes)

-- λ> length (puntos2 (10^30000))

-- 143549

-- (1.14 secs, 974,239,544 bytes)

-- λ> length (puntos3 (10^30000))

-- 143549

-- (3.28 secs, 967,206,560 bytes)

2016 es un número práctico

PorJosé A. Alonso 4-enero-20161-mayo-2016

Un entero positivo n es un número práctico si todos los enteros positivos menores que él se pueden expresar como suma de distintos divisores de n. Por ejemplo, el 12 es un número práctico, ya que todos los enteros positivos menores que 12 se pueden expresar como suma de divisores de 12 (1, 2, 3, 4 y 6) sin usar ningún divisor más de una vez en cada suma:

    1 = 1
    2 = 2
    3 = 3
    4 = 4
    5 = 2 + 3
    6 = 6
    7 = 1 + 6
    8 = 2 + 6
    9 = 3 + 6
   10 = 4 + 6
   11 = 1 + 4 + 6

1 = 1

2 = 2

3 = 3

4 = 4

5 = 2 + 3

6 = 6

7 = 1 + 6

8 = 2 + 6

9 = 3 + 6

10 = 4 + 6

11 = 1 + 4 + 6

En cambio, 14 no es un número práctico ya que 6 no se puede escribir como suma, con sumandos distintos, de divisores de 14.

Definir la función

   esPractico :: Integer -> Bool

1	esPractico :: Integer -> Bool

tal que (esPractico n) se verifica si n es un número práctico. Por ejemplo,

   esPractico 12                                      ==  True
   esPractico 14                                      ==  False
   esPractico 2016                                    ==  True
   esPractico 42535295865117307932921825928971026432  ==  True

esPractico 12 == True

esPractico 14 == False

esPractico 2016 == True

esPractico 42535295865117307932921825928971026432 == True

Soluciones

import Data.List (genericLength, group, nub, sort, subsequences)
import Data.Numbers.Primes (primeFactors)
import Graphics.Gnuplot.Simple

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

esPractico1 :: Integer -> Bool
esPractico1 n =
    takeWhile (<n) (sumas (divisores n)) == [0..n-1]

-- (divisores n) es la lista de los divisores de n. Por ejemplo,
--    divisores 12  ==  [1,2,3,4,6]
--    divisores 14  ==  [1,2,7]
divisores :: Integer -> [Integer]
divisores n = [k | k <- [1..n-1], n `mod` k == 0]

-- (sumas xs) es la lista ordenada de números que se pueden obtener como
-- sumas de elementos de xs sin usar ningún elemento más de una vez en
-- cada suma. Por ejemplo,  
--    sumas [1,2,3]  ==  [0,1,2,3,4,5,6]
--    sumas [1,2,7]  ==  [0,1,2,3,7,8,9,10]
sumas :: [Integer] -> [Integer]
sumas xs = sort (nub (map sum (subsequences xs)))

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

esPractico2 :: Integer -> Bool
esPractico2 n = all (esSumable (divisores n)) [1..n-1]

-- (esSumable xs n) se verifica si n se puede escribir como una suma de
-- elementos distintos de la lista creciente xs. Por ejemplo,
--    esSumable [1,2,7] 8  ==  True
--    esSumable [1,2,7] 6  ==  False
--    esSumable [1,2,7] 4  ==  False
--    esSumable [1,2,7] 2  ==  True
--    esSumable [1,2,7] 0  ==  True
esSumable :: [Integer] -> Integer -> Bool
esSumable _ 0  = True
esSumable [] _ = False
esSumable (x:xs) n = x <= n && (esSumable xs (n-x) || esSumable xs n)

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

-- Usando la caracterización de Stewart y Sierpiński: un entero n >= 2
-- es práctico syss para su factorización prima
--    n = p(1)^e(1) * p(2)*e(2) *...* p(k)^e(k)
-- se cumple que p(1) = 2 y, para cada i de 2 a k se cumple que
--                         1+e(j) 
--                i-1  p(j)       - 1
--    p(i) <= 1 +  ∏  ----------------
--                j=1     p(j) - 1

esPractico3 :: Integer -> Bool
esPractico3 1 = True
esPractico3 n = 
    x == 2 &&
    and [p <= 1 + c | (p,c) <- zip bases cotas]
    where xss       = factorizacion n
          (x:bases) = map fst xss
          cotas     = scanl1 (*) [(p^(1+e)-1) `div` (p-1) | (p,e) <- xss]

-- (factorizacion n) es la factorización de n. Por ejemplo, 
--    factorizacion  600  ==  [(2,3),(3,1),(5,2)]
--    factorizacion 1400  ==  [(2,3),(5,2),(7,1)]
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion n =
    [(head xs,genericLength xs) | xs <- group (primeFactors n)]

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

--    λ> length [n | n <- [1..400], esPractico1 n]
--    92
--    (40.21 secs, 8,378,539,464 bytes)
--    λ> length [n | n <- [1..400], esPractico2 n]
--    92
--    (8.29 secs, 1,109,669,760 bytes)
--    λ> length [n | n <- [1..400], esPractico3 n]
--    92
--    (0.02 secs, 0 bytes)

import Data.List (genericLength, group, nub, sort, subsequences)

import Data.Numbers.Primes (primeFactors)

import Graphics.Gnuplot.Simple

-- 1ª definición

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

esPractico1 :: Integer -> Bool

esPractico1 n =

takeWhile (<n) (sumas (divisores n)) == [0..n-1]

-- (divisores n) es la lista de los divisores de n. Por ejemplo,

-- divisores 12 == [1,2,3,4,6]

-- divisores 14 == [1,2,7]

divisores :: Integer -> [Integer]

divisores n = [k | k <- [1..n-1], n `mod` k == 0]

-- (sumas xs) es la lista ordenada de números que se pueden obtener como

-- sumas de elementos de xs sin usar ningún elemento más de una vez en

-- cada suma. Por ejemplo,

-- sumas [1,2,3] == [0,1,2,3,4,5,6]

-- sumas [1,2,7] == [0,1,2,3,7,8,9,10]

sumas :: [Integer] -> [Integer]

sumas xs = sort (nub (map sum (subsequences xs)))

-- 2ª definición

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

esPractico2 :: Integer -> Bool

esPractico2 n = all (esSumable (divisores n)) [1..n-1]

-- (esSumable xs n) se verifica si n se puede escribir como una suma de

-- elementos distintos de la lista creciente xs. Por ejemplo,

-- esSumable [1,2,7] 8 == True

-- esSumable [1,2,7] 6 == False

-- esSumable [1,2,7] 4 == False

-- esSumable [1,2,7] 2 == True

-- esSumable [1,2,7] 0 == True

esSumable :: [Integer] -> Integer -> Bool

esSumable _ 0 = True

esSumable [] _ = False

esSumable (x:xs) n = x <= n && (esSumable xs (n-x) || esSumable xs n)

-- 3ª definición

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

-- Usando la caracterización de Stewart y Sierpiński: un entero n >= 2

-- es práctico syss para su factorización prima

-- n = p(1)^e(1) * p(2)*e(2) *...* p(k)^e(k)

-- se cumple que p(1) = 2 y, para cada i de 2 a k se cumple que

-- 1+e(j)

-- i-1 p(j) - 1

-- p(i) <= 1 + ∏ ----------------

-- j=1 p(j) - 1

esPractico3 :: Integer -> Bool

esPractico3 1 = True

esPractico3 n =

x == 2 &&

and [p <= 1 + c | (p,c) <- zip bases cotas]

where xss = factorizacion n

(x:bases) = map fst xss

cotas = scanl1 (*) [(p^(1+e)-1) `div` (p-1) | (p,e) <- xss]

-- (factorizacion n) es la factorización de n. Por ejemplo,

-- factorizacion 600 == [(2,3),(3,1),(5,2)]

-- factorizacion 1400 == [(2,3),(5,2),(7,1)]

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

factorizacion n =

[(head xs,genericLength xs) | xs <- group (primeFactors n)]

-- Comparación de eficiencia

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

-- λ> length [n | n <- [1..400], esPractico1 n]

-- 92

-- (40.21 secs, 8,378,539,464 bytes)

-- λ> length [n | n <- [1..400], esPractico2 n]

-- 92

-- (8.29 secs, 1,109,669,760 bytes)

-- λ> length [n | n <- [1..400], esPractico3 n]

-- 92

-- (0.02 secs, 0 bytes)

Referencias

Basado en el artículo de Gaussianos Feliz Navidad y Feliz Año (número práctico) 2016.

Otras referencias

M. Margenstern (1991), Les nombres pratiques: théorie, observations et conjectures.
G. Melfi, Practical numbers.
G. Melfi (2008), A survey on practical numbers.
OEIS, Sucesión A005153.
PlanetMath.org, Practical number.
E.W. Weisstein, Practical number.
A. Weingartner (2015), Practical numbers and the distribution of divisors.
Wikipedia, Practical number.

Suma con redondeos

PorJosé A. Alonso 1-enero-20167-enero-2016

Definir las funciones

   sumaRedondeos       :: Integer -> [Integer]
   limiteSumaRedondeos :: Integer -> Integer

1 2	sumaRedondeos :: Integer -> [Integer] limiteSumaRedondeos :: Integer -> Integer

tales que

(sumaRedondeos n) es la sucesión cuyo k-ésimo término es

     redondeo (n/2) + redondeo (n/4) + ... + redondeo (n/2^k)

1	redondeo (n/2) + redondeo (n/4) + ... + redondeo (n/2^k)

Por ejemplo,

     take 5 (sumaRedondeos 1000)  ==  [500,750,875,937,968]

1	take 5 (sumaRedondeos 1000) == [500,750,875,937,968]

(limiteSumaRedondeos n) es la suma de la serie

     redondeo (n/2) + redondeo (n/4) + redondeo (n/8) + ...

1	redondeo (n/2) + redondeo (n/4) + redondeo (n/8) + ...

Por ejemplo,

     limiteSumaRedondeos 2000                    ==  1999
     limiteSumaRedondeos 2016                    ==  2016
     limiteSumaRedondeos (10^308) `mod` (10^10)  ==  123839487

limiteSumaRedondeos 2000 == 1999

limiteSumaRedondeos 2016 == 2016

limiteSumaRedondeos (10^308) `mod` (10^10) == 123839487

Soluciones

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

sumaRedondeos1 :: Integer -> [Integer]
sumaRedondeos1 n =
    [sum [round (n'/(fromIntegral (2^k))) | k <- [1..m]] | m <- [1..]]
    where n' = fromIntegral n

limiteSumaRedondeos1 :: Integer -> Integer
limiteSumaRedondeos1 = limite . sumaRedondeos1

limite :: [Integer] -> Integer
limite xs = head [x | (x,y) <- zip xs (tail xs), x == y]

-- 2ª definición
sumaRedondeos2 :: Integer -> [Integer]
sumaRedondeos2 n =
    scanl1 (+) [round (n'/(fromIntegral (2^k))) | k <- [1..]]
    where n' = fromIntegral n

limiteSumaRedondeos2 :: Integer -> Integer
limiteSumaRedondeos2 = limite . sumaRedondeos2

-- 3ª definición
sumaRedondeos3 :: Integer -> [Integer]
sumaRedondeos3 n = map fst (iterate f (round (n'/2),4))
    where f (s,d) = (s + round (n'/(fromIntegral d)), 2*d)
          n'      = fromIntegral n

limiteSumaRedondeos3 :: Integer -> Integer
limiteSumaRedondeos3 = limite . sumaRedondeos3

-- 4ª definición
sumaRedondeos4 :: Integer -> [Integer]
sumaRedondeos4 n = xs ++ repeat x
    where n' = fromIntegral n
          m  = round (logBase 2 n')
          xs = scanl1 (+) [round (n'/(fromIntegral (2^k))) | k <- [1..m]]
          x  = last xs

limiteSumaRedondeos4 :: Integer -> Integer
limiteSumaRedondeos4 = limite . sumaRedondeos4

-- Comparación de eficiencia
--    λ> (sumaRedondeos1 4) !! 20000
--    3
--    (0.92 secs, 197,782,232 bytes)
--    λ> (sumaRedondeos1 4) !! 30000
--    3
--    (2.20 secs, 351,084,816 bytes)
--    λ> (sumaRedondeos3 4) !! 20000
--    3
--    (0.30 secs, 53,472,392 bytes)
--    λ> (sumaRedondeos4 4) !! 20000
--    3
--    (0.01 secs, 0 bytes)

-- En lo que sigue, usaremos la 3ª definición
sumaRedondeos :: Integer -> [Integer]
sumaRedondeos = sumaRedondeos3

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

limiteSumaRedondeos5 :: Integer -> Integer
limiteSumaRedondeos5 n = 
    sum [round (n'/(fromIntegral (2^k))) | k <- [1..m]]
    where n' = fromIntegral n
          m  = round (logBase 2 n')

-- 1ª definición

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

sumaRedondeos1 :: Integer -> [Integer]

sumaRedondeos1 n =

[sum [round (n'/(fromIntegral (2^k))) | k <- [1..m]] | m <- [1..]]

where n' = fromIntegral n

limiteSumaRedondeos1 :: Integer -> Integer

limiteSumaRedondeos1 = limite . sumaRedondeos1

limite :: [Integer] -> Integer

limite xs = head [x | (x,y) <- zip xs (tail xs), x == y]

-- 2ª definición

sumaRedondeos2 :: Integer -> [Integer]

sumaRedondeos2 n =

scanl1 (+) [round (n'/(fromIntegral (2^k))) | k <- [1..]]

where n' = fromIntegral n

limiteSumaRedondeos2 :: Integer -> Integer

limiteSumaRedondeos2 = limite . sumaRedondeos2

-- 3ª definición

sumaRedondeos3 :: Integer -> [Integer]

sumaRedondeos3 n = map fst (iterate f (round (n'/2),4))

where f (s,d) = (s + round (n'/(fromIntegral d)), 2*d)

n' = fromIntegral n

limiteSumaRedondeos3 :: Integer -> Integer

limiteSumaRedondeos3 = limite . sumaRedondeos3

-- 4ª definición

sumaRedondeos4 :: Integer -> [Integer]

sumaRedondeos4 n = xs ++ repeat x

where n' = fromIntegral n

m = round (logBase 2 n')

xs = scanl1 (+) [round (n'/(fromIntegral (2^k))) | k <- [1..m]]

x = last xs

limiteSumaRedondeos4 :: Integer -> Integer

limiteSumaRedondeos4 = limite . sumaRedondeos4

-- Comparación de eficiencia

-- λ> (sumaRedondeos1 4) !! 20000

-- 3

-- (0.92 secs, 197,782,232 bytes)

-- λ> (sumaRedondeos1 4) !! 30000

-- 3

-- (2.20 secs, 351,084,816 bytes)

-- λ> (sumaRedondeos3 4) !! 20000

-- 3

-- (0.30 secs, 53,472,392 bytes)

-- λ> (sumaRedondeos4 4) !! 20000

-- 3

-- (0.01 secs, 0 bytes)

-- En lo que sigue, usaremos la 3ª definición

sumaRedondeos :: Integer -> [Integer]

sumaRedondeos = sumaRedondeos3

-- 5ª definición

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

limiteSumaRedondeos5 :: Integer -> Integer

limiteSumaRedondeos5 n =

sum [round (n'/(fromIntegral (2^k))) | k <- [1..m]]

where n' = fromIntegral n

m = round (logBase 2 n')

Listas hermanadas

PorJosé A. Alonso 21-diciembre-201528-diciembre-2015

Una lista hermanada es una lista de números estrictamente positivos en la que cada elemento tiene algún factor primo en común con el siguiente, en caso de que exista, o alguno de los dos es un 1. Por ejemplo,

[2,6,3,9,1,5] es una lista hermanada pues 2 y 6 tienen un factor en común (2); 6 y 3 tienen un factor en común (3); 3 y 9 tienen un factor en común (3); de 9 y 1 uno es el número 1; y de 1 y 5 uno es el número 1.
[2,3,5] no es una lista hermanada pues 2 y 3 no tienen ningún factor primo en común.

Definir la función

   hermanada :: [Int] -> Bool

1	hermanada :: [Int] -> Bool

tal que (hermanada xs) se verifica si la lista xs es hermanada según la definición anterior. Por ejemplo,

   hermanada [2,6,3,9,1,5]   ==  True
   hermanada [2,3,5]         ==  False
   hermanada [2,4..1000000]  ==  True

hermanada [2,6,3,9,1,5] == True

hermanada [2,3,5] == False

hermanada [2,4..1000000] == True

Nota: Este ejercicio es parte del examen del grupo 3 del 2 de diciembre.

Soluciones

-- 1ª definición (por comprensión)
hermanada1 :: [Int] -> Bool
hermanada1 xs = and [hermanos p | p <- zip xs (tail xs)]

-- (hermanos (x,y)) se verifica si x e y son hermanos; es decir, alguno es
-- igual a 1 o tienen algún factor primo en común
hermanos :: (Int, Int) -> Bool
hermanos (x,y) = x == 1 || y == 1 || gcd x y /= 1

-- 2ª definición (con all)
hermanada2 :: [Int] -> Bool
hermanada2 xs = all hermanos (zip xs (tail xs))

-- 3ª definición (por recursión)
hermanada3 :: [Int] -> Bool
hermanada3 (x1:x:xs) = hermanos (x1,x) && hermanada3 (x:xs)
hermanada3 _          = True

-- 4ª definición (por plegado)
hermanada4 :: [Int] -> Bool
hermanada4 xs =
    foldl (\ws p -> hermanos p && ws) True (zip xs (tail xs))

-- Comparación de eficiencia
--    λ> hermanada1 [2,4..1000000]
--    True
--    (2.33 secs, 476,586,552 bytes)
--    λ> hermanada2 [2,4..1000000]
--    True
--    (1.80 secs, 422,879,072 bytes)
--    λ> hermanada3 [2,4..1000000]
--    True
--    (2.58 secs, 477,251,896 bytes)
--    λ> hermanada4 [2,4..1000000]
--    True
--    (2.36 secs, 440,047,520 bytes)

-- 1ª definición (por comprensión)

hermanada1 :: [Int] -> Bool

hermanada1 xs = and [hermanos p | p <- zip xs (tail xs)]

-- (hermanos (x,y)) se verifica si x e y son hermanos; es decir, alguno es

-- igual a 1 o tienen algún factor primo en común

hermanos :: (Int, Int) -> Bool

hermanos (x,y) = x == 1 || y == 1 || gcd x y /= 1

-- 2ª definición (con all)

hermanada2 :: [Int] -> Bool

hermanada2 xs = all hermanos (zip xs (tail xs))

-- 3ª definición (por recursión)

hermanada3 :: [Int] -> Bool

hermanada3 (x1:x:xs) = hermanos (x1,x) && hermanada3 (x:xs)

hermanada3 _ = True

-- 4ª definición (por plegado)

hermanada4 :: [Int] -> Bool

hermanada4 xs =

foldl (\ws p -> hermanos p && ws) True (zip xs (tail xs))

-- Comparación de eficiencia

-- λ> hermanada1 [2,4..1000000]

-- True

-- (2.33 secs, 476,586,552 bytes)

-- λ> hermanada2 [2,4..1000000]

-- True

-- (1.80 secs, 422,879,072 bytes)

-- λ> hermanada3 [2,4..1000000]

-- True

-- (2.58 secs, 477,251,896 bytes)

-- λ> hermanada4 [2,4..1000000]

-- True

-- (2.36 secs, 440,047,520 bytes)

Separación y mezcla de listas

PorJosé A. Alonso 30-noviembre-20157-diciembre-2015

Definir las funciones

   separacion :: [a] -> ([a],[a])
   mezcla     :: ([a],[a]) -> [a]

1 2	separacion :: [a] -> ([a],[a]) mezcla :: ([a],[a]) -> [a]

tales que (separacion xs) es el par formado eligiendo alternativamente elementos de xs mientras que mezcla intercala los elementos de las dos listas. Por ejemplo,

   separacion [1..5]                   ==  ([1,3,5],[2,4])
   mezcla ([1,3,5],[2,4])              ==  [1,2,3,4,5]
   separacion "Telescopio"             ==  ("Tlsoi","eecpo")
   mezcla ("Tlsoi","eecpo")            ==  "Telescopio"
   take 5 (fst (separacion [2,4..]))   ==  [2,6,10,14,18]
   take 6 (mezcla ([2,4..],[7,14..]))  ==  [2,7,4,14,6,21]

separacion [1..5] == ([1,3,5],[2,4])

mezcla ([1,3,5],[2,4]) == [1,2,3,4,5]

separacion "Telescopio" == ("Tlsoi","eecpo")

mezcla ("Tlsoi","eecpo") == "Telescopio"

take 5 (fst (separacion [2,4..])) == [2,6,10,14,18]

take 6 (mezcla ([2,4..],[7,14..])) == [2,7,4,14,6,21]

Comprobar con QuickCheck que

   mezcla (separacion xs) == xs

1	mezcla (separacion xs) == xs

Soluciones

import Test.QuickCheck

-- 1ª definición (por recursión):
separacion1 :: [a] -> ([a],[a])
separacion1 []       = ([],  [])
separacion1 [x]      = ([x], [])
separacion1 (x:y:zs) = (x:us,y:vs)
    where (us,vs) = separacion1 zs

-- 2ª definición (por comprensión):
separacion2 :: [a] -> ([a],[a])
separacion2 xs = ([x | (x,n) <- aux, even n], 
                  [x | (x,n) <- aux, odd n])
    where aux = zip xs [0..]                                           

-- 3ª definición 
separacion3 :: [a] -> ([a],[a])
separacion3 []       = ([],[])
separacion3 (x:xs)   = (x:zs, ys)
    where (ys, zs) = separacion3 xs 

-- Comprobación de eficiencia
--    ghci> last (snd (separacion1 [1..10000000]))
--    10000000
--    (10.73 secs, 2,945,794,552 bytes)
--
--    ghci> last (snd (separacion2 [1..10000000]))
--    10000000
--    (16.33 secs, 4,351,366,976 bytes)
--    
--    λ> last (snd (separacion3 [1..10000000]))
--    10000000
--    (15.67 secs, 4,423,573,048 bytes)

mezcla :: ([a],[a]) -> [a]
mezcla ([],ys)     = ys 
mezcla (xs,[])     = xs 
mezcla (x:xs,y:ys) = x : y : mezcla (xs,ys)

-- La propiedad es
prop_mezcla_separacion :: [Int] -> Bool
prop_mezcla_separacion xs =
    mezcla (separacion xs) == xs

-- La comprobación es
--    ghci> quickCheck prop_mezcla_separacion
--    +++ OK, passed 100 tests.

import Test.QuickCheck

-- 1ª definición (por recursión):

separacion1 :: [a] -> ([a],[a])

separacion1 [] = ([], [])

separacion1 [x] = ([x], [])

separacion1 (x:y:zs) = (x:us,y:vs)

where (us,vs) = separacion1 zs

-- 2ª definición (por comprensión):

separacion2 :: [a] -> ([a],[a])

separacion2 xs = ([x | (x,n) <- aux, even n],

[x | (x,n) <- aux, odd n])

where aux = zip xs [0..]

-- 3ª definición

separacion3 :: [a] -> ([a],[a])

separacion3 [] = ([],[])

separacion3 (x:xs) = (x:zs, ys)

where (ys, zs) = separacion3 xs

-- Comprobación de eficiencia

-- ghci> last (snd (separacion1 [1..10000000]))

-- 10000000

-- (10.73 secs, 2,945,794,552 bytes)

-- ghci> last (snd (separacion2 [1..10000000]))

-- 10000000

-- (16.33 secs, 4,351,366,976 bytes)

-- λ> last (snd (separacion3 [1..10000000]))

-- 10000000

-- (15.67 secs, 4,423,573,048 bytes)

mezcla :: ([a],[a]) -> [a]

mezcla ([],ys) = ys

mezcla (xs,[]) = xs

mezcla (x:xs,y:ys) = x : y : mezcla (xs,ys)

-- La propiedad es

prop_mezcla_separacion :: [Int] -> Bool

prop_mezcla_separacion xs =

mezcla (separacion xs) == xs

-- La comprobación es

-- ghci> quickCheck prop_mezcla_separacion

-- +++ OK, passed 100 tests.

Repeticiones según la posición

PorJosé A. Alonso 26-noviembre-20151-mayo-2016

Definir la función

   transformada :: [a] -> [a]

1	transformada :: [a] -> [a]

tal que (transformada xs) es la lista obtenida repitiendo cada elemento tantas veces como indica su posición en la lista. Por ejemplo,

   transformada [7,2,5] == [7,2,2,5,5,5]
   transformada "eco"   == "eccooo"

1 2	transformada [7,2,5] == [7,2,2,5,5,5] transformada "eco" == "eccooo"

Comprobar con QuickCheck si la transformada de una lista de n números enteros, con n ≥ 2, tiene menos de n³ elementos.

Soluciones

import Test.QuickCheck

transformada :: [a] -> [a]
transformada xs = concat [replicate n x | (n,x) <- zip [1..] xs]

-- La propiedad es
prop_transformada :: [Int] -> Property
prop_transformada xs = n >= 2 ==> length (transformada xs) < n^3
    where n = length xs

-- La comprobación es
--    ghci> quickCheck prop_transformada
--    +++ OK, passed 100 tests.

import Test.QuickCheck

transformada :: [a] -> [a]

transformada xs = concat [replicate n x | (n,x) <- zip [1..] xs]

-- La propiedad es

prop_transformada :: [Int] -> Property

prop_transformada xs = n >= 2 ==> length (transformada xs) < n^3

where n = length xs

-- La comprobación es

-- ghci> quickCheck prop_transformada

-- +++ OK, passed 100 tests.

Listas de igual longitud

PorJosé A. Alonso 23-noviembre-201530-noviembre-2015

Definir la función

   mismaLongitud :: [[a]] -> Bool

1	mismaLongitud :: [[a]] -> Bool

tal que (mismaLongitud xss) se verifica si todas las listas de la lista de listas xss tienen la misma longitud. Por ejemplo,

   mismaLongitud [[1,2],[6,4],[0,0],[7,4]] == True
   mismaLongitud [[1,2],[6,4,5],[0,0]]     == False

1 2	mismaLongitud [[1,2],[6,4],[0,0],[7,4]] == True mismaLongitud [[1,2],[6,4,5],[0,0]] == False

Soluciones

import Data.List (nub)    

-- 1ª solución:
mismaLongitud1 :: [[a]] -> Bool
mismaLongitud1 []       = True
mismaLongitud1 (xs:xss) = and [length ys == n | ys <- xss]
    where n = length xs

-- 2ª solución:
mismaLongitud2 :: [[a]] -> Bool
mismaLongitud2 xss = 
    and [length xs == length ys | (xs,ys) <- zip xss (tail xss)]

-- 3ª solución:
mismaLongitud3 :: [[a]] -> Bool
mismaLongitud3 (xs:ys:xss) = 
    length xs == length ys && mismaLongitud3 (ys:xss)
mismaLongitud3 _ = True           

-- 4ª solución
mismaLongitud4 :: [[a]] -> Bool
mismaLongitud4 [] = True
mismaLongitud4 (xs:xss) =
    all (\ys -> length ys == n) xss
    where n = length xs 

-- 5ª solución
mismaLongitud5 :: [[a]] -> Bool
mismaLongitud5 xss = length (nub [length xs | xs <- xss]) == 1

-- 6ª solución
mismaLongitud6 :: [[a]] -> Bool
mismaLongitud6 = null . drop 1 . nub . map length

-- Comparación de eficiencia
--    λ> mismaLongitud1 (replicate 20000 (replicate 20000 5))
--    True
--    (5.05 secs, 0 bytes)
--    λ> mismaLongitud2 (replicate 20000 (replicate 20000 5))
--    True
--    (9.98 secs, 0 bytes)
--    λ> mismaLongitud3 (replicate 20000 (replicate 20000 5))
--    True
--    (10.17 secs, 0 bytes)
--    λ> mismaLongitud4 (replicate 20000 (replicate 20000 5))
--    True
--    (5.18 secs, 0 bytes)
--    λ> mismaLongitud5 (replicate 20000 (replicate 20000 5))
--    True
--    (4.30 secs, 0 bytes)
--    λ> mismaLongitud6 (replicate 20000 (replicate 20000 5))
--    True
--    (4.19 secs, 0 bytes)

import Data.List (nub)

-- 1ª solución:

mismaLongitud1 :: [[a]] -> Bool

mismaLongitud1 [] = True

mismaLongitud1 (xs:xss) = and [length ys == n | ys <- xss]

where n = length xs

-- 2ª solución:

mismaLongitud2 :: [[a]] -> Bool

mismaLongitud2 xss =

and [length xs == length ys | (xs,ys) <- zip xss (tail xss)]

-- 3ª solución:

mismaLongitud3 :: [[a]] -> Bool

mismaLongitud3 (xs:ys:xss) =

length xs == length ys && mismaLongitud3 (ys:xss)

mismaLongitud3 _ = True

-- 4ª solución

mismaLongitud4 :: [[a]] -> Bool

mismaLongitud4 [] = True

mismaLongitud4 (xs:xss) =

all (\ys -> length ys == n) xss

where n = length xs

-- 5ª solución

mismaLongitud5 :: [[a]] -> Bool

mismaLongitud5 xss = length (nub [length xs | xs <- xss]) == 1

-- 6ª solución

mismaLongitud6 :: [[a]] -> Bool

mismaLongitud6 = null . drop 1 . nub . map length

-- Comparación de eficiencia

-- λ> mismaLongitud1 (replicate 20000 (replicate 20000 5))

-- True

-- (5.05 secs, 0 bytes)

-- λ> mismaLongitud2 (replicate 20000 (replicate 20000 5))

-- True

-- (9.98 secs, 0 bytes)

-- λ> mismaLongitud3 (replicate 20000 (replicate 20000 5))

-- True

-- (10.17 secs, 0 bytes)

-- λ> mismaLongitud4 (replicate 20000 (replicate 20000 5))

-- True

-- (5.18 secs, 0 bytes)

-- λ> mismaLongitud5 (replicate 20000 (replicate 20000 5))

-- True

-- (4.30 secs, 0 bytes)

-- λ> mismaLongitud6 (replicate 20000 (replicate 20000 5))

-- True

-- (4.19 secs, 0 bytes)

Refinamiento de listas

PorJosé A. Alonso 21-octubre-201528-octubre-2015

Definir la función

   refinada :: [Float] -> [Float]

1	refinada :: [Float] -> [Float]

tal que (refinada xs) es la lista obtenida intercalando entre cada dos elementos consecutivos de xs su media aritmética. Por ejemplo,

   refinada [2,7,1,8]  ==  [2.0,4.5,7.0,4.0,1.0,4.5,8.0]
   refinada [2]        ==  [2.0]
   refinada []         ==  []

refinada [2,7,1,8] == [2.0,4.5,7.0,4.0,1.0,4.5,8.0]

refinada [2] == [2.0]

refinada [] == []

Soluciones

-- 1ª definición (por recursión):
refinada :: [Float] -> [Float]
refinada (x:y:zs) = x : (x+y)/2 : refinada (y:zs)
refinada xs       = xs

-- 2ª definición (por comprensión);
refinada2 :: [Float] -> [Float]
refinada2 []     = []
refinada2 (x:xs) = x : concat [[(a+b)/2,b] | (a,b) <- zip (x:xs) xs]

-- 1ª definición (por recursión):

refinada :: [Float] -> [Float]

refinada (x:y:zs) = x : (x+y)/2 : refinada (y:zs)

refinada xs = xs

-- 2ª definición (por comprensión);

refinada2 :: [Float] -> [Float]

refinada2 [] = []

refinada2 (x:xs) = x : concat [[(a+b)/2,b] | (a,b) <- zip (x:xs) xs]

Sucesión de números parientes

PorJosé A. Alonso 17-marzo-20151-mayo-2016

Se dice que dos números naturales son parientes sitienen exactamente un factor primo en común, independientemente de su multiplicidad. Por ejemplo,

Los números 12 (2²·3) y 40 (2³·5) son parientes, pues tienen al 2 como único factor primo en común.
Los números 49 (7²) y 63 (3²·7) son parientes, pues tienen al 7 como único factor primo en común.
Los números 12 (2²·3) y 30 (2·3·5) no son parientes, pues tienen dos factores primos en común.
Los números 49 (7²) y 25 (5²) no son parientes, pues no tienen factores primos en común.

Se dice que una lista de números naturales es una secuencia de parientes si cada par de números consecutivos son parientes. Por ejemplo,

La lista [12,40,35,28] es una secuencia de parientes.
La lista [12,30,21,49] no es una secuencia de parientes.

Definir la función

   secuenciaParientes :: [Integer] -> Bool

1	secuenciaParientes :: [Integer] -> Bool

tal que (secuenciaParientes xs) se verifica si xs es una secuencia de parientes. Por ejemplo,

   secuenciaParientes [12,40,35,28]           ==  True
   secuenciaParientes [12,30,21,49]           ==  False
   secuenciaParientes [2^n | n <- [1..2000]]  ==  True

secuenciaParientes [12,40,35,28] == True

secuenciaParientes [12,30,21,49] == False

secuenciaParientes [2^n | n <- [1..2000]] == True

Soluciones

import Data.List (intersect, nub)
import Data.Numbers.Primes (primes, primeFactors)

-- (parientes x y) se verifica si x e y son parientes. Por ejemplo,
--    parientes 12 40  ==  True
--    parientes 49 63  ==  True
--    parientes 12 30  ==  False
--    parientes 49 25  ==  False

-- 1ª definición (con gcd)
parientes1 :: Integer -> Integer -> Bool
parientes1 x y =
    length [p | p <- takeWhile (<= d) primes, d `mod` p == 0] == 1 
    where d = gcd x y

-- 2ª definición (con primeFactors)
parientes2 :: Integer -> Integer -> Bool
parientes2 0 0 = False
parientes2 x y = 
    length (nub (primeFactors x `intersect` primeFactors y)) == 1

-- Comparación de eficiencia
--    ghci> parientes1 (2^25) (2^25)
--    True
--    (34.34 secs, 15974866184 bytes)
--    ghci> parientes2 (2^25) (2^25)
--    True
--    (0.01 secs, 3093024 bytes)

-- Usaremos la 2ª definición
parientes :: Integer -> Integer -> Bool
parientes = parientes2

-- Definiciones de secuenciaParientes 
-- ==================================

-- 1ª definición (por recursión)
secuenciaParientes :: [Integer] -> Bool
secuenciaParientes []         = True
secuenciaParientes [x]        = True
secuenciaParientes (x1:x2:xs) =
    parientes x1 x2 && secuenciaParientes (x2:xs)

-- 2ª definición (por recursión con 2 ecuaciones)
secuenciaParientes2 :: [Integer] -> Bool
secuenciaParientes2 (x1:x2:xs) =
    parientes x1 x2 && secuenciaParientes2 (x2:xs)
secuenciaParientes2 _         = True

-- 3ª definición (sin recursión):
secuenciaParientes3 :: [Integer] -> Bool
secuenciaParientes3 xs = all (\(x,y) -> parientes x y) (zip xs (tail xs)) 

-- 4ª definición
secuenciaParientes4 :: [Integer] -> Bool
secuenciaParientes4 xs = all (uncurry parientes) (zip xs (tail xs))

import Data.List (intersect, nub)

import Data.Numbers.Primes (primes, primeFactors)

-- (parientes x y) se verifica si x e y son parientes. Por ejemplo,

-- parientes 12 40 == True

-- parientes 49 63 == True

-- parientes 12 30 == False

-- parientes 49 25 == False

-- 1ª definición (con gcd)

parientes1 :: Integer -> Integer -> Bool

parientes1 x y =

length [p | p <- takeWhile (<= d) primes, d `mod` p == 0] == 1

where d = gcd x y

-- 2ª definición (con primeFactors)

parientes2 :: Integer -> Integer -> Bool

parientes2 0 0 = False

parientes2 x y =

length (nub (primeFactors x `intersect` primeFactors y)) == 1

-- Comparación de eficiencia

-- ghci> parientes1 (2^25) (2^25)

-- True

-- (34.34 secs, 15974866184 bytes)

-- ghci> parientes2 (2^25) (2^25)

-- True

-- (0.01 secs, 3093024 bytes)

-- Usaremos la 2ª definición

parientes :: Integer -> Integer -> Bool

parientes = parientes2

-- Definiciones de secuenciaParientes

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

-- 1ª definición (por recursión)

secuenciaParientes :: [Integer] -> Bool

secuenciaParientes [] = True

secuenciaParientes [x] = True

secuenciaParientes (x1:x2:xs) =

parientes x1 x2 && secuenciaParientes (x2:xs)

-- 2ª definición (por recursión con 2 ecuaciones)

secuenciaParientes2 :: [Integer] -> Bool

secuenciaParientes2 (x1:x2:xs) =

parientes x1 x2 && secuenciaParientes2 (x2:xs)

secuenciaParientes2 _ = True

-- 3ª definición (sin recursión):

secuenciaParientes3 :: [Integer] -> Bool

secuenciaParientes3 xs = all (\(x,y) -> parientes x y) (zip xs (tail xs))

-- 4ª definición

secuenciaParientes4 :: [Integer] -> Bool

secuenciaParientes4 xs = all (uncurry parientes) (zip xs (tail xs))

Orden de divisibilidad

PorJosé A. Alonso 9-marzo-201525-abril-2021

El orden de divisibilidad de un número x es el mayor n tal que para todo i menor o igual que n, los i primeros dígitos de n es divisible por i. Por ejemplo, el orden de divisibilidad de 74156 es 3 porque

   7       es divisible por 1
   74      es divisible por 2
   741     es divisible por 3
   7415 no es divisible por 4

7 es divisible por 1

74 es divisible por 2

741 es divisible por 3

7415 no es divisible por 4

Definir la función

   ordenDeDivisibilidad :: Integer -> Int

1	ordenDeDivisibilidad :: Integer -> Int

tal que (ordenDeDivisibilidad x) es el orden de divisibilidad de x. Por ejemplo,

   ordenDeDivisibilidad 74156                      ==  3
   ordenDeDivisibilidad 3608528850368400786036725  ==  25

1 2	ordenDeDivisibilidad 74156 == 3 ordenDeDivisibilidad 3608528850368400786036725 == 25

Soluciones

import Data.List (inits)

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

ordenDeDivisibilidad :: Integer -> Int
ordenDeDivisibilidad n = 
    length (takeWhile (\(x,k) -> x `mod` k == 0) (zip (sucDigitos n) [1..]))

-- (sucDigitos x) es la sucesión de los dígitos de x. Por ejemplo,
--    sucDigitos 325    ==  [3,32,325]
--    sucDigitos 32050  ==  [3,32,320,3205,32050]
sucDigitos :: Integer -> [Integer]
sucDigitos n = 
    [n `div` (10^i) | i <- [k-1,k-2..0]]
    where k = length (show n)

-- 2ª definición de sucDigitos
sucDigitos2 :: Integer -> [Integer]
sucDigitos2 n = [read xs | xs <- aux (show n)]
    where aux []     = []
          aux (d:ds) = [d] : map (d:) (aux ds)

-- 3ª definición de sucDigitos
sucDigitos3 :: Integer -> [Integer]
sucDigitos3 n = 
    [read (take k ds) | k <- [1..length ds]]
    where ds = show n

-- 4ª definición de sucDigitos
sucDigitos4 :: Integer -> [Integer]
sucDigitos4 n = [read xs | xs <- tail (inits (show n))]

-- 5ª definición de sucDigitos
sucDigitos5 :: Integer -> [Integer]
sucDigitos5 n = map read (tail (inits (show n)))

-- 6ª definición de sucDigitos
sucDigitos6 :: Integer -> [Integer]
sucDigitos6 = map read . (tail . inits . show)

-- Eficiencia de las definiciones de sucDigitos
--    ghci> length (sucDigitos (10^5000))
--    5001
--    (0.01 secs, 1550688 bytes)
--    ghci> length (sucDigitos2 (10^5000))
--    5001
--    (1.25 secs, 729411872 bytes)
--    ghci> length (sucDigitos3 (10^5000))
--    5001
--    (0.02 secs, 2265120 bytes)
--    ghci> length (sucDigitos4 (10^5000))
--    5001
--    (1.10 secs, 728366872 bytes)
--    ghci> length (sucDigitos5 (10^5000))
--    5001
--    (1.12 secs, 728393864 bytes)
--    ghci> length (sucDigitos6 (10^5000))
--    5001
--    (1.20 secs, 728403052 bytes)
-- 
--    ghci> length (sucDigitos (10^3000000))
--    3000001
--    (2.73 secs, 820042696 bytes)
--    ghci> length (sucDigitos3 (10^3000000))
--    3000001
--    (3.69 secs, 820043688 bytes)

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

ordenDeDivisibilidad :: Integer -> Int
ordenDeDivisibilidad x =
    length $ takeWhile (==0) $ zipWith (mod . read) (tail $ inits $ show x) [1..]

import Data.List (inits)

-- 1ª definición de ordenDeDivisibilidad

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

ordenDeDivisibilidad :: Integer -> Int

ordenDeDivisibilidad n =

length (takeWhile (\(x,k) -> x `mod` k == 0) (zip (sucDigitos n) [1..]))

-- (sucDigitos x) es la sucesión de los dígitos de x. Por ejemplo,

-- sucDigitos 325 == [3,32,325]

-- sucDigitos 32050 == [3,32,320,3205,32050]

sucDigitos :: Integer -> [Integer]

sucDigitos n =

[n `div` (10^i) | i <- [k-1,k-2..0]]

where k = length (show n)

-- 2ª definición de sucDigitos

sucDigitos2 :: Integer -> [Integer]

sucDigitos2 n = [read xs | xs <- aux (show n)]

where aux [] = []

aux (d:ds) = [d] : map (d:) (aux ds)

-- 3ª definición de sucDigitos

sucDigitos3 :: Integer -> [Integer]

sucDigitos3 n =

[read (take k ds) | k <- [1..length ds]]

where ds = show n

-- 4ª definición de sucDigitos

sucDigitos4 :: Integer -> [Integer]

sucDigitos4 n = [read xs | xs <- tail (inits (show n))]

-- 5ª definición de sucDigitos

sucDigitos5 :: Integer -> [Integer]

sucDigitos5 n = map read (tail (inits (show n)))

-- 6ª definición de sucDigitos

sucDigitos6 :: Integer -> [Integer]

sucDigitos6 = map read . (tail . inits . show)

-- Eficiencia de las definiciones de sucDigitos

-- ghci> length (sucDigitos (10^5000))

-- 5001

-- (0.01 secs, 1550688 bytes)

-- ghci> length (sucDigitos2 (10^5000))

-- 5001

-- (1.25 secs, 729411872 bytes)

-- ghci> length (sucDigitos3 (10^5000))

-- 5001

-- (0.02 secs, 2265120 bytes)

-- ghci> length (sucDigitos4 (10^5000))

-- 5001

-- (1.10 secs, 728366872 bytes)

-- ghci> length (sucDigitos5 (10^5000))

-- 5001

-- (1.12 secs, 728393864 bytes)

-- ghci> length (sucDigitos6 (10^5000))

-- 5001

-- (1.20 secs, 728403052 bytes)

-- ghci> length (sucDigitos (10^3000000))

-- 3000001

-- (2.73 secs, 820042696 bytes)

-- ghci> length (sucDigitos3 (10^3000000))

-- 3000001

-- (3.69 secs, 820043688 bytes)

-- 2ª definición de ordenDeDivisibilidad

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

ordenDeDivisibilidad :: Integer -> Int

ordenDeDivisibilidad x =

length $ takeWhile (==0) $ zipWith (mod . read) (tail $ inits $ show x) [1..]

Mayor diferencia progresiva

PorJosé A. Alonso 26-febrero-20151-mayo-2016

La diferencia progresiva entre dos elementos de una lista es la resta entre el que ocupa la mayor posición y la menor. Por ejemplo, en la lista [1,5,8,2,9] la diferencia entre los elementos 5 y 8 es 3 y entre 5 y 2 es -3.

Definir la función

   mayorDiferencia :: [Int] -> Int

1	mayorDiferencia :: [Int] -> Int

tal que (mayorDiferencia xs) es la mayor diferencia progresiva entre los elementos de xs. Por ejemplo,

   mayorDiferencia [1,5,8,2,9]  ==  8
   mayorDiferencia [9,5,8,2,1]  ==  3
   mayorDiferencia [7,2,6]      ==  4
   mayorDiferencia [3,2,1]      ==  0
   mayorDiferencia [1..10^7]    ==  9999999

mayorDiferencia [1,5,8,2,9] == 8

mayorDiferencia [9,5,8,2,1] == 3

mayorDiferencia [7,2,6] == 4

mayorDiferencia [3,2,1] == 0

mayorDiferencia [1..10^7] == 9999999

Soluciones

import Data.List (inits)

-- 1ª definición (por recursión):
mayorDiferencia :: [Int] -> Int
mayorDiferencia ([_])  = 0
mayorDiferencia (x:xs) = 
    max (maximum [y-x | y <- xs]) (mayorDiferencia xs) 

-- 2ª definición (por comprensión)
mayorDiferencia2 :: [Int] -> Int
mayorDiferencia2 xs = 
    maximum [x-y | (x,y) <- zip xs (map minimum (tail (inits xs)))]

-- 3ª definición:
mayorDiferencia3 :: [Int] -> Int
mayorDiferencia3 xs = maximum (zipWith (-) xs (scanl1 min xs))

-- 4ª definición:
mayorDiferencia4 :: [Int] -> Int
mayorDiferencia4 xs = maximum . zipWith (-) xs $ scanl1 min xs

-- Comparación de eficiencia
--    ghci> mayorDiferencia [1..3000]
--    2999
--    (3.43 secs, 943439560 bytes)
--    
--    ghci> mayorDiferencia2 [1..3000]
--    2999
--    (3.38 secs, 978359192 bytes)
--    
--    ghci> mayorDiferencia3 [1..3000]
--    2999
--    (0.01 secs, 2877960 bytes)
--    
--    ghci> mayorDiferencia4 [1..3000]
--    2999
--    (0.01 secs, 2062616 bytes)

import Data.List (inits)

-- 1ª definición (por recursión):

mayorDiferencia :: [Int] -> Int

mayorDiferencia ([_]) = 0

mayorDiferencia (x:xs) =

max (maximum [y-x | y <- xs]) (mayorDiferencia xs)

-- 2ª definición (por comprensión)

mayorDiferencia2 :: [Int] -> Int

mayorDiferencia2 xs =

maximum [x-y | (x,y) <- zip xs (map minimum (tail (inits xs)))]

-- 3ª definición:

mayorDiferencia3 :: [Int] -> Int

mayorDiferencia3 xs = maximum (zipWith (-) xs (scanl1 min xs))

-- 4ª definición:

mayorDiferencia4 :: [Int] -> Int

mayorDiferencia4 xs = maximum . zipWith (-) xs $ scanl1 min xs

-- Comparación de eficiencia

-- ghci> mayorDiferencia [1..3000]

-- 2999

-- (3.43 secs, 943439560 bytes)

-- ghci> mayorDiferencia2 [1..3000]

-- 2999

-- (3.38 secs, 978359192 bytes)

-- ghci> mayorDiferencia3 [1..3000]

-- 2999

-- (0.01 secs, 2877960 bytes)

-- ghci> mayorDiferencia4 [1..3000]

-- 2999

-- (0.01 secs, 2062616 bytes)

Siguiente elemento en una lista

PorJosé A. Alonso 2-febrero-201526-marzo-2022

Definir la función

   siguiente :: Eq a => a -> [a] -> Maybe a

1	siguiente :: Eq a => a -> [a] -> Maybe a

tal que (siguiente x ys) es justo el elemento siguiente a la primera ocurrencia de x en ys o Nothing si x no pertenece a ys. Por ejemplo,

   siguiente 5 [3,5,2,5,7]                       ==  Just 2
   siguiente 9 [3,5,2,5,7]                       ==  Nothing
   siguiente 'd' "afdegdb"                       ==  Just 'e'
   siguiente "todo" ["En","todo","la","medida"]  ==  Just "la"
   siguiente "nada" ["En","todo","la","medida"]  ==  Nothing
   siguiente 999999 [1..1000000]                 ==  Just 1000000
   siguiente 1000000 [1..1000000]                ==  Nothing

siguiente 5 [3,5,2,5,7] == Just 2

siguiente 9 [3,5,2,5,7] == Nothing

siguiente 'd' "afdegdb" == Just 'e'

siguiente "todo" ["En","todo","la","medida"] == Just "la"

siguiente "nada" ["En","todo","la","medida"] == Nothing

siguiente 999999 [1..1000000] == Just 1000000

siguiente 1000000 [1..1000000] == Nothing

Soluciones

import Data.Maybe (listToMaybe) -- Para la 4ª solución

-- 1ª solución (por recursión):
siguiente1 :: Eq a => a -> [a] -> Maybe a
siguiente1 x (y1:y2:ys) | x == y1   = Just y2
                        | otherwise = siguiente1 x (y2:ys)
siguiente1 x _ = Nothing

-- 2ª solución (por comprensión):
siguiente2 :: Eq a => a -> [a] -> Maybe a
siguiente2 x ys 
    | null zs   = Nothing
    | otherwise = Just (snd (head zs))
    where zs = [(u,v) | (u,v) <- zip ys (tail ys), u == x]  

-- 3ª solución (con dropWhile)
siguiente3 :: Eq a => a -> [a] -> Maybe a
siguiente3 x = aux . drop 1 . dropWhile (/=x)
    where aux []    = Nothing
          aux (y:_) = Just y

-- 4ª solución (con dropWhile y listToMaybe):
siguiente4 :: Eq a => a -> [a] -> Maybe a
siguiente4 x = listToMaybe . drop 1 . dropWhile (/=x)

-- Nota: En la librería Data.Maybe está definida la función 
--    listToMaybe :: [a] -> Maybe a 
-- tal que (listToMaybe xs) es Nothing si la lista xs está vacía y es
-- justo el primer elemento, en caso contrario, Por ejemplo,
--    listToMaybe []       ==  Nothing
--    listToMaybe [3,2,5]  ==  Just 3

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

-- La comparación es
--    ghci> let n=10^6 in siguiente1 (n-1) [1..n]
--    Just 1000000
--    (1.34 secs, 277352616 bytes)
--    
--    ghci> let n=10^6 in siguiente2 (n-1) [1..n]
--    Just 1000000
--    (1.45 secs, 340836576 bytes)
--    
--    ghci> let n=10^6 in siguiente3 (n-1) [1..n]
--    Just 1000000
--    (0.26 secs, 84987544 bytes)
--    
--    ghci> let n=10^6 in siguiente4 (n-1) [1..n]
--    Just 1000000
--    (0.26 secs, 84987440 bytes)

import Data.Maybe (listToMaybe) -- Para la 4ª solución

-- 1ª solución (por recursión):

siguiente1 :: Eq a => a -> [a] -> Maybe a

siguiente1 x (y1:y2:ys) | x == y1 = Just y2

| otherwise = siguiente1 x (y2:ys)

siguiente1 x _ = Nothing

-- 2ª solución (por comprensión):

siguiente2 :: Eq a => a -> [a] -> Maybe a

siguiente2 x ys

| null zs = Nothing

| otherwise = Just (snd (head zs))

where zs = [(u,v) | (u,v) <- zip ys (tail ys), u == x]

-- 3ª solución (con dropWhile)

siguiente3 :: Eq a => a -> [a] -> Maybe a

siguiente3 x = aux . drop 1 . dropWhile (/=x)

where aux [] = Nothing

aux (y:_) = Just y

-- 4ª solución (con dropWhile y listToMaybe):

siguiente4 :: Eq a => a -> [a] -> Maybe a

siguiente4 x = listToMaybe . drop 1 . dropWhile (/=x)

-- Nota: En la librería Data.Maybe está definida la función

-- listToMaybe :: [a] -> Maybe a

-- tal que (listToMaybe xs) es Nothing si la lista xs está vacía y es

-- justo el primer elemento, en caso contrario, Por ejemplo,

-- listToMaybe [] == Nothing

-- listToMaybe [3,2,5] == Just 3

-- Comparación de eficiencia

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

-- La comparación es

-- ghci> let n=10^6 in siguiente1 (n-1) [1..n]

-- Just 1000000

-- (1.34 secs, 277352616 bytes)

-- ghci> let n=10^6 in siguiente2 (n-1) [1..n]

-- Just 1000000

-- (1.45 secs, 340836576 bytes)

-- ghci> let n=10^6 in siguiente3 (n-1) [1..n]

-- Just 1000000

-- (0.26 secs, 84987544 bytes)

-- ghci> let n=10^6 in siguiente4 (n-1) [1..n]

-- Just 1000000

-- (0.26 secs, 84987440 bytes)

Ordenación según una función

PorJosé A. Alonso 16-enero-201526-abril-2015

Definir la función

   ordenaSegun :: Ord b => (a -> b) -> [a] -> [a]

1	ordenaSegun :: Ord b => (a -> b) -> [a] -> [a]

tal que (ordenaSegun f xs) es la lista obtenida ordenando los elementos de xs según sus valores mediante la función f. Por ejemplo,

   ordenaSegun abs [-3,2,5,-2]                           ==  [2,-2,-3,5]
   ordenaSegun abs [-3,-2,5,2]                           ==  [-2,2,-3,5]
   ordenaSegun length ["pq","x","mn"]                    ==  ["x","pq","mn"]
   [g 0 | g <- ordenaSegun (\f -> f 4) [(+5),(+2),(+3)]] == [2,3,5]

ordenaSegun abs [-3,2,5,-2] == [2,-2,-3,5]

ordenaSegun abs [-3,-2,5,2] == [-2,2,-3,5]

ordenaSegun length ["pq","x","mn"] == ["x","pq","mn"]

[g 0 | g <- ordenaSegun (\f -> f 4) [(+5),(+2),(+3)]] == [2,3,5]

Comprobar con QuickCheck que (ordenaSegun id) es equivalente a sort.

Soluciones

import Data.List (sort, sortBy)
import Data.Ord (comparing)
import Test.QuickCheck

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

ordenaSegun :: Ord b => (a -> b) -> [a] -> [a]
ordenaSegun _ []  = []
ordenaSegun f (x:xs) = insertaSegun f x (ordenaSegun f xs)

insertaSegun :: Ord b => (a -> b) -> a -> [a] -> [a]
insertaSegun _ x [] = [x]
insertaSegun f x (y:ys) | f x <= f y = x : y : ys
                        | otherwise  = y : insertaSegun f x ys

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

ordenaSegun2 :: Ord b => (a -> b) -> [a] -> [a]
ordenaSegun2 f xs = [xs!!i | (_,i) <- sort (zip [f x | x <- xs] [0..])]

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

ordenaSegun3 :: Ord b => (a -> b) -> [a] -> [a]
ordenaSegun3 f xs = map ((xs!!) . snd) (sort (zip (map f xs) [0..]))

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

ordenaSegun4 :: Ord b => (a -> b) -> [a] -> [a]
ordenaSegun4 = sortBy . comparing

-- La propiedad es
prop_ordenaSegun :: Ord a => [a] -> Bool
prop_ordenaSegun xs =
    ordenaSegun id xs == sort xs

-- La comprobación es
--    ghci> quickCheck prop_ordenaSegun
--    +++ OK, passed 100 tests.

import Data.List (sort, sortBy)

import Data.Ord (comparing)

import Test.QuickCheck

-- 1ª definición

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

ordenaSegun :: Ord b => (a -> b) -> [a] -> [a]

ordenaSegun _ [] = []

ordenaSegun f (x:xs) = insertaSegun f x (ordenaSegun f xs)

insertaSegun :: Ord b => (a -> b) -> a -> [a] -> [a]

insertaSegun _ x [] = [x]

insertaSegun f x (y:ys) | f x <= f y = x : y : ys

| otherwise = y : insertaSegun f x ys

-- 2ª definición

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

ordenaSegun2 :: Ord b => (a -> b) -> [a] -> [a]

ordenaSegun2 f xs = [xs!!i | (_,i) <- sort (zip [f x | x <- xs] [0..])]

-- 3ª definición

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

ordenaSegun3 :: Ord b => (a -> b) -> [a] -> [a]

ordenaSegun3 f xs = map ((xs!!) . snd) (sort (zip (map f xs) [0..]))

-- 4ª definición

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

ordenaSegun4 :: Ord b => (a -> b) -> [a] -> [a]

ordenaSegun4 = sortBy . comparing

-- La propiedad es

prop_ordenaSegun :: Ord a => [a] -> Bool

prop_ordenaSegun xs =

ordenaSegun id xs == sort xs

-- La comprobación es

-- ghci> quickCheck prop_ordenaSegun

-- +++ OK, passed 100 tests.

Mayores elementos de una matriz

PorJosé A. Alonso 17-noviembre-201427-diciembre-2014

Enunciado

-- Las matrices se pueden representar mediante listas de listas. Por
-- ejemplo, la matriz
--    |3 2 5|
--    |4 9 7|
-- se puede representar por [[3,2,5],[4,9,7]].
-- 
-- Definir la función
--    mayores :: Ord a => Int -> [[a]] -> [(a,Int)]
-- tal que (mayores n xss) es la lista de los n mayores elementos de la
-- matriz xss junto con sus correspondientes número de fila. Por
-- ejemplo,
--    ghci> mayores 4 [[4,26,9],[2,37,53],[41,1,8]]
--    [(53,2),(41,3),(37,2),(26,1)]
-- 
-- Comprobar con QuickCheck que todos los elementos de (mayores n xss)
-- son mayores o iguales que los restantes elementos de xss.
-- 
-- Nota: Se pueden usar las funciones sort y (\\) de la librería
-- Data.List.

-- Las matrices se pueden representar mediante listas de listas. Por

-- ejemplo, la matriz

-- |3 2 5|

-- |4 9 7|

-- se puede representar por [[3,2,5],[4,9,7]].

-- Definir la función

-- mayores :: Ord a => Int -> [[a]] -> [(a,Int)]

-- tal que (mayores n xss) es la lista de los n mayores elementos de la

-- matriz xss junto con sus correspondientes número de fila. Por

-- ejemplo,

-- ghci> mayores 4 [[4,26,9],[2,37,53],[41,1,8]]

-- [(53,2),(41,3),(37,2),(26,1)]

-- Comprobar con QuickCheck que todos los elementos de (mayores n xss)

-- son mayores o iguales que los restantes elementos de xss.

-- Nota: Se pueden usar las funciones sort y (\\) de la librería

-- Data.List.

Soluciones

import Data.List (sort, (\\))
import Test.QuickCheck

-- 1ª solución (con auxiliares)
-- ============================

mayores1 :: Ord a => Int -> [[a]] -> [(a,Int)]
mayores1 n xss = take n (reverse (sort (enumeracion xss)))

-- (enumeracion xss) es la lista de los elementos de xs junto con el
-- número de su fila. Por ejemplo,
--    ghci> enumeracion [[4,26,9],[2,37,53],[41,1,8]]
--    [(4,1),(26,1),(9,1),(2,2),(37,2),(53,2),(41,3),(1,3),(8,3)]
enumeracion :: [[a]] -> [(a,Int)]
enumeracion xss =
    [(x,i) | (xs,i) <- enumeracionFilas xss, x <- xs]

-- (enumeracionFilas xss) es la lista de las filas de xs junto con su
-- número. Por ejemplo,
--    ghci> enumeracionFilas [[4,26,9],[2,37,53],[41,1,8]]
--    [([4,26,9],1),([2,37,53],2),([41,1,8],3)]
enumeracionFilas :: [[a]] -> [([a],Int)]
enumeracionFilas xss = zip xss [1..]

-- 2ª solución (sin auxiliares)
-- ============================

mayores2 :: Ord a => Int -> [[a]] -> [(a,Int)]
mayores2 n xss = 
    take n (reverse (sort [(x,i) | (xs,i) <- zip xss [1..], x <- xs]))

-- Comprobaciones
-- ==============

-- Las dos definiciones son equivalentes
prop_equivalencia :: Int -> [[Int]] -> Bool
prop_equivalencia n xss =
    mayores1 n xss == mayores2 n xss

-- La comprobación es
--    ghci> quickCheck prop_equivalencia
--    +++ OK, passed 100 tests.

-- La propiedad de mayores es
prop_mayores :: Int -> [[Int]] -> Bool
prop_mayores n xss =
    and [x <= y | x <- elementos \\ elementosMayores, y <- elementosMayores]
    where elementos = concat xss
          elementosMayores = [x | (x,_) <- mayores1 n xss]

-- La comprobación es
--    ghci> quickCheck prop_mayores
--    +++ OK, passed 100 tests.

-- Otra forma de expresa la propiedad es
prop_mayores2 :: Int -> [[Int]] -> Bool
prop_mayores2 n xss = 
    all (\x -> all (<=x) elementosRestantes) elementosMayores
    where elementosMayores   = map fst (mayores1 n xss)
          elementosRestantes = concat xss \\ elementosMayores

-- La comprobación es
--    ghci> quickCheck prop_mayores2
--    +++ OK, passed 100 tests.

import Data.List (sort, (\\))

import Test.QuickCheck

-- 1ª solución (con auxiliares)

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

mayores1 :: Ord a => Int -> [[a]] -> [(a,Int)]

mayores1 n xss = take n (reverse (sort (enumeracion xss)))

-- (enumeracion xss) es la lista de los elementos de xs junto con el

-- número de su fila. Por ejemplo,

-- ghci> enumeracion [[4,26,9],[2,37,53],[41,1,8]]

-- [(4,1),(26,1),(9,1),(2,2),(37,2),(53,2),(41,3),(1,3),(8,3)]

enumeracion :: [[a]] -> [(a,Int)]

enumeracion xss =

[(x,i) | (xs,i) <- enumeracionFilas xss, x <- xs]

-- (enumeracionFilas xss) es la lista de las filas de xs junto con su

-- número. Por ejemplo,

-- ghci> enumeracionFilas [[4,26,9],[2,37,53],[41,1,8]]

-- [([4,26,9],1),([2,37,53],2),([41,1,8],3)]

enumeracionFilas :: [[a]] -> [([a],Int)]

enumeracionFilas xss = zip xss [1..]

-- 2ª solución (sin auxiliares)

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

mayores2 :: Ord a => Int -> [[a]] -> [(a,Int)]

mayores2 n xss =

take n (reverse (sort [(x,i) | (xs,i) <- zip xss [1..], x <- xs]))

-- Comprobaciones

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

-- Las dos definiciones son equivalentes

prop_equivalencia :: Int -> [[Int]] -> Bool

prop_equivalencia n xss =

mayores1 n xss == mayores2 n xss

-- La comprobación es

-- ghci> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

-- La propiedad de mayores es

prop_mayores :: Int -> [[Int]] -> Bool

prop_mayores n xss =

and [x <= y | x <- elementos \\ elementosMayores, y <- elementosMayores]

where elementos = concat xss

elementosMayores = [x | (x,_) <- mayores1 n xss]

-- La comprobación es

-- ghci> quickCheck prop_mayores

-- +++ OK, passed 100 tests.

-- Otra forma de expresa la propiedad es

prop_mayores2 :: Int -> [[Int]] -> Bool

prop_mayores2 n xss =

all (\x -> all (<=x) elementosRestantes) elementosMayores

where elementosMayores = map fst (mayores1 n xss)

elementosRestantes = concat xss \\ elementosMayores

-- La comprobación es

-- ghci> quickCheck prop_mayores2

-- +++ OK, passed 100 tests.

Extensión de un fichero

PorJosé A. Alonso 10-noviembre-20141-mayo-2016

Enunciado

-- La extensión de un fichero es la palabra a continuación del último
-- punto en el nombre del fichero. Por ejemplo, la extensión de
-- "documento.txt" es "txt" 
-- 
-- Definir la función
--    extension :: String -> String
-- tal que (extension cs) es la extensión del fichero cs. Por ejemplo,
--    extension "ejercicio.hs"       ==  "hs"
--    extension "documento.txt"      ==  "txt"
--    extension "documento.txt.pdf"  ==  "pdf"
--    extension "resumen"            ==  ""

-- La extensión de un fichero es la palabra a continuación del último

-- punto en el nombre del fichero. Por ejemplo, la extensión de

-- "documento.txt" es "txt"

-- Definir la función

-- extension :: String -> String

-- tal que (extension cs) es la extensión del fichero cs. Por ejemplo,

-- extension "ejercicio.hs" == "hs"

-- extension "documento.txt" == "txt"

-- extension "documento.txt.pdf" == "pdf"

-- extension "resumen" == ""

Soluciones

-- 1ª definición (por recursión):
extension1 :: String -> String
extension1 cs | elem '.' cs = reverse (aux (reverse cs))
              | otherwise   = ""
    where aux []       = []
          aux ('.':cs) = []
          aux (c:cs)   = c : aux cs

-- 2ª definición (con takeWhile):
extension2 :: String -> String
extension2 cs
    | notElem '.' cs = ""
    | otherwise      = reverse (takeWhile (/= '.') (reverse cs))

-- 1ª definición (por recursión):

extension1 :: String -> String

extension1 cs | elem '.' cs = reverse (aux (reverse cs))

| otherwise = ""

where aux [] = []

aux ('.':cs) = []

aux (c:cs) = c : aux cs

-- 2ª definición (con takeWhile):

extension2 :: String -> String

extension2 cs

| notElem '.' cs = ""

| otherwise = reverse (takeWhile (/= '.') (reverse cs))

Distancia de Hamming

PorJosé A. Alonso 7-noviembre-201425-abril-2021

Enunciado

-- La distancia de Hamming entre dos listas es el número de posiciones
-- en que los correspondientes elementos son distintos. Por ejemplo, la
-- distancia de Hamming entre "roma" y "loba" es 2 (porque hay 2
-- posiciones en las que los elementos correspondientes son distintos:
-- la 1ª y la 3ª). 
-- 
-- Definir la función
--    distancia :: Eq a => [a] -> [a] -> Int
-- tal que (distancia xs ys) es la distancia de Hamming entre xs e
-- ys. Por ejemplo,
--    distancia "romano" "comino"  ==  2
--    distancia "romano" "camino"  ==  3
--    distancia "roma"   "comino"  ==  2
--    distancia "roma"   "camino"  ==  3
--    distancia "romano" "ron"     ==  1
--    distancia "romano" "cama"    ==  2
--    distancia "romano" "rama"    ==  1
--
-- Comprobar con QuickCheck si la distancia de Hamming tiene la
-- siguiente propiedad
--    distancia(xs,ys) = 0 si, y sólo si, xs = ys
-- y, en el caso de que no se verifique, modificar ligeramente la
-- propiedad para obtener una condición necesaria y suficiente de 
-- distancia(xs,ys) = 0.

-- La distancia de Hamming entre dos listas es el número de posiciones

-- en que los correspondientes elementos son distintos. Por ejemplo, la

-- distancia de Hamming entre "roma" y "loba" es 2 (porque hay 2

-- posiciones en las que los elementos correspondientes son distintos:

-- la 1ª y la 3ª).

-- Definir la función

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

-- tal que (distancia xs ys) es la distancia de Hamming entre xs e

-- ys. Por ejemplo,

-- distancia "romano" "comino" == 2

-- distancia "romano" "camino" == 3

-- distancia "roma" "comino" == 2

-- distancia "roma" "camino" == 3

-- distancia "romano" "ron" == 1

-- distancia "romano" "cama" == 2

-- distancia "romano" "rama" == 1

-- Comprobar con QuickCheck si la distancia de Hamming tiene la

-- siguiente propiedad

-- distancia(xs,ys) = 0 si, y sólo si, xs = ys

-- y, en el caso de que no se verifique, modificar ligeramente la

-- propiedad para obtener una condición necesaria y suficiente de

-- distancia(xs,ys) = 0.

Soluciones

import Test.QuickCheck

-- 1ª definición (por comprensión):
distancia :: Eq a => [a] -> [a] -> Int
distancia xs ys = sum [1 | (x,y) <- zip xs ys, x /= y] 

-- 2ª definición (por recursión):
distancia2 :: Eq a => [a] -> [a] -> Int
distancia2 [] ys = 0
distancia2 xs [] = 0
distancia2 (x:xs) (y:ys) | x /= y    = 1 + distancia2 xs ys
                         | otherwise = distancia2 xs ys

-- La propiedad es
prop_distancia1 :: [Int] -> [Int] -> Bool
prop_distancia1 xs ys =
    (distancia xs ys == 0) == (xs == ys)

-- La comprobación es
--    ghci> quickCheck prop_distancia1
--    *** Failed! Falsifiable (after 2 tests and 1 shrink): 
--    []
--    [1]
-- En efecto,
--    ghci> distancia [] [1] == 0
--    True
--    ghci> [] == [1]
--    False

-- La primera modificación es restringir la propiedad a lista de igual
-- longitud: 
prop_distancia2 :: [Int] -> [Int] -> Property
prop_distancia2 xs ys =
    length xs == length ys ==> 
    (distancia xs ys == 0) == (xs == ys)

-- La comprobación es
--    ghci> quickCheck prop_distancia2
--    *** Gave up! Passed only 33 tests.

-- Nota. La propiedad se verifica, pero al ser la condición demasiado
-- restringida sólo 33 de los casos la cumple.

-- La segunda restricción es limitar las listas a la longitud de la más
-- corta: 
prop_distancia3 :: [Int] -> [Int] -> Bool
prop_distancia3 xs ys =
    (distancia xs ys == 0) == (take n xs == take n ys)
    where n = min (length xs) (length ys)

-- La comprobación es
--    ghci> quickCheck prop_distancia3
--    +++ OK, passed 100 tests.

import Test.QuickCheck

-- 1ª definición (por comprensión):

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

distancia xs ys = sum [1 | (x,y) <- zip xs ys, x /= y]

-- 2ª definición (por recursión):

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

distancia2 [] ys = 0

distancia2 xs [] = 0

distancia2 (x:xs) (y:ys) | x /= y = 1 + distancia2 xs ys

| otherwise = distancia2 xs ys

-- La propiedad es

prop_distancia1 :: [Int] -> [Int] -> Bool

prop_distancia1 xs ys =

(distancia xs ys == 0) == (xs == ys)

-- La comprobación es

-- ghci> quickCheck prop_distancia1

-- *** Failed! Falsifiable (after 2 tests and 1 shrink):

-- []

-- [1]

-- En efecto,

-- ghci> distancia [] [1] == 0

-- True

-- ghci> [] == [1]

-- False

-- La primera modificación es restringir la propiedad a lista de igual

-- longitud:

prop_distancia2 :: [Int] -> [Int] -> Property

prop_distancia2 xs ys =

length xs == length ys ==>

(distancia xs ys == 0) == (xs == ys)

-- La comprobación es

-- ghci> quickCheck prop_distancia2

-- *** Gave up! Passed only 33 tests.

-- Nota. La propiedad se verifica, pero al ser la condición demasiado

-- restringida sólo 33 de los casos la cumple.

-- La segunda restricción es limitar las listas a la longitud de la más

-- corta:

prop_distancia3 :: [Int] -> [Int] -> Bool

prop_distancia3 xs ys =

(distancia xs ys == 0) == (take n xs == take n ys)

where n = min (length xs) (length ys)

-- La comprobación es

-- ghci> quickCheck prop_distancia3

-- +++ OK, passed 100 tests.

Suma de todos los anteriores.

PorJosé A. Alonso 5-noviembre-201427-diciembre-2014

Enunciado

-- Definir la función
--    sumaAnteriores :: [Integer] -> Bool
-- tal que (sumaAnteriores xs) se verifica si cada elemento de la lista
-- xs (excepto el primero) es la suma de sus anteriores elementos en la
-- lista. Por ejemplo,  
--    sumaAnteriores [3,3,6,12]  ==  True
--    sumaAnteriores [3,3,7,10]  ==  False
--    sumaAnteriores [3]         ==  True
--    sumaAnteriores []          ==  True

-- Definir la función

-- sumaAnteriores :: [Integer] -> Bool

-- tal que (sumaAnteriores xs) se verifica si cada elemento de la lista

-- xs (excepto el primero) es la suma de sus anteriores elementos en la

-- lista. Por ejemplo,

-- sumaAnteriores [3,3,6,12] == True

-- sumaAnteriores [3,3,7,10] == False

-- sumaAnteriores [3] == True

-- sumaAnteriores [] == True

Soluciones

import Test.QuickCheck

-- 1ª definición (por recursión):
sumaAnteriores :: [Integer] -> Bool
sumaAnteriores xs = aux (reverse xs)
    where aux []     = True
          aux [_]    = True
          aux (x:xs) = x == sum xs && aux xs

-- 2ª definición (por comprensión):
sumaAnteriores2 :: [Integer] -> Bool
sumaAnteriores2 (x:y:zs) = 
    x == y && and [b == 2*a | (a,b) <- adyacentes (y:zs)]
    where adyacentes xs = zip xs (tail xs)
sumaAnteriores2 _ = True

-- La propiedad de equivalencia es
prop_equiv_sumaAnteriores :: [Integer] -> Bool
prop_equiv_sumaAnteriores xs = 
    sumaAnteriores xs == sumaAnteriores2 xs

import Test.QuickCheck

-- 1ª definición (por recursión):

sumaAnteriores :: [Integer] -> Bool

sumaAnteriores xs = aux (reverse xs)

where aux [] = True

aux [_] = True

aux (x:xs) = x == sum xs && aux xs

-- 2ª definición (por comprensión):

sumaAnteriores2 :: [Integer] -> Bool

sumaAnteriores2 (x:y:zs) =

x == y && and [b == 2*a | (a,b) <- adyacentes (y:zs)]

where adyacentes xs = zip xs (tail xs)

sumaAnteriores2 _ = True

-- La propiedad de equivalencia es

prop_equiv_sumaAnteriores :: [Integer] -> Bool

prop_equiv_sumaAnteriores xs =

sumaAnteriores xs == sumaAnteriores2 xs

Código Morse

PorJosé A. Alonso 10-julio-201427-diciembre-2014

El código Morse es un sistema de representación de letras y números mediante señales emitidas de forma intermitente.

A los signos (letras mayúsculas o dígitos) se le asigna un código como se muestra a continuación

    +---+-------+---+-------+---+-------+---+-------+
    | A | .-    | J | .---  | S | ...   | 1 | ..--- |
    | B | -...  | K | -.-   | T | -     | 2 | ...-- |
    | C | -.-.  | L | .-..  | U | ..-   | 3 | ....- |
    | D | -..   | M | --    | V | ...-  | 4 | ..... |
    | E | .     | N | -.    | W | .--   | 5 | -.... |
    | F | ..-.  | O | ---   | X | -..-  | 6 | --... |
    | G | --.   | P | .--.  | Y | -.--  | 7 | ---.. |
    | H | ....  | Q | --.-  | Z | --..  | 8 | ----. |
    | I | ..    | R | .-.   | 0 | .---- | 9 | ----- |
    +---+-------+---+-------+---+-------+---+-------+

+---+-------+---+-------+---+-------+---+-------+

| A | .- | J | .--- | S | ... | 1 | ..--- |

| B | -... | K | -.- | T | - | 2 | ...-- |

| C | -.-. | L | .-.. | U | ..- | 3 | ....- |

| D | -.. | M | -- | V | ...- | 4 | ..... |

| E | . | N | -. | W | .-- | 5 | -.... |

| F | ..-. | O | --- | X | -..- | 6 | --... |

| G | --. | P | .--. | Y | -.-- | 7 | ---.. |

| H | .... | Q | --.- | Z | --.. | 8 | ----. |

| I | .. | R | .-. | 0 | .---- | 9 | ----- |

+---+-------+---+-------+---+-------+---+-------+

El código Morse de las palabras se obtiene a partir del de sus caracteres insertando un espacio entre cada uno. Por ejemplo, el código de "todo" es "- --- -.. ---"

El código Morse de las frases se obtiene a partir del de sus palabras insertando dos espacios entre cada uno. Por ejemplo, el código de "todo o nada" es "- --- -.. --- --- -. .- -.. .-"

Enunciado

-- Definir las funciones
--    fraseAmorse :: String -> String
--    morseAfrase :: String -> String
-- tales que
-- * (fraseAmorse cs) es la traducción de la frase cs a Morse. Por
--   ejemplo, 
--      ghci> fraseAmorse "En todo la medida"
--      ". -.  - --- -.. ---  .-.. .-  -- . -.. .. -.. .-"
-- * (morseAfrase cs) es la frase cuya traducción a Morse es cs. Por 
--   ejemplo, 
--      ghci> morseAfrase ". -.  - --- -.. ---  .-.. .-  -- . -.. .. -.. .-"
--      "EN TODO LA MEDIDA"
--
-- Nota: La lista de los códigos Morse de A, B, ..., Z, 0, 1, ..., 9 es
--    [".-","-...","-.-.","-..",".","..-.","--.","....","..",".---",
--     "-.-",".-..","--","-.","---",".--.","--.-",".-.","...","-",
--     "..-","...-",".--","-..-","-.--","--..",".----","..---","...--",
--     "....-",".....","-....","--...","---..","----.","-----"]

-- Definir las funciones

-- fraseAmorse :: String -> String

-- morseAfrase :: String -> String

-- tales que

-- * (fraseAmorse cs) es la traducción de la frase cs a Morse. Por

-- ejemplo,

-- ghci> fraseAmorse "En todo la medida"

-- ". -. - --- -.. --- .-.. .- -- . -.. .. -.. .-"

-- * (morseAfrase cs) es la frase cuya traducción a Morse es cs. Por

-- ejemplo,

-- ghci> morseAfrase ". -. - --- -.. --- .-.. .- -- . -.. .. -.. .-"

-- "EN TODO LA MEDIDA"

-- Nota: La lista de los códigos Morse de A, B, ..., Z, 0, 1, ..., 9 es

-- [".-","-...","-.-.","-..",".","..-.","--.","....","..",".---",

-- "-.-",".-..","--","-.","---",".--.","--.-",".-.","...","-",

-- "..-","...-",".--","-..-","-.--","--..",".----","..---","...--",

-- "....-",".....","-....","--...","---..","----.","-----"]

Ayuda: Se puede usar la función splitOn de la librería Data.List.Split.

Soluciones

import Data.Char (toUpper)
import Data.List (intercalate)
import Data.List.Split (splitOn)

-- caracteres es la lista ordenada de las caracteres (letras mayúsculas
-- y dígitos) que se usan en los mensajes Morse.
caracteres :: [Char]
caracteres = ['A'..'Z'] ++ ['0'..'9']

-- morse es la lista de los códigos Morse correspondientes a la lista
-- de caracteres.
morse :: [String]
morse = [".-","-...","-.-.","-..",".","..-.","--.","....","..",".---",
         "-.-",".-..","--","-.","---",".--.","--.-",".-.","...","-",
         "..-","...-",".--","-..-","-.--","--..",".----","..---","...--",
         "....-",".....","-....","--...","---..","----.","-----"]

-- (correspondiente xs ys x) es el elemento de ys en la misma posición
-- que x en xs. Por ejemplo,
--    correspondiente [1..10] [2,4..20] 3  ==  6
correspondiente :: Ord a => [a] -> [b] -> a -> b
correspondiente xs ys x = head [y | (z,y) <- zip xs ys, z == x]

-- (caracterAmorse x) es el código Morse correspondiente al carácter
-- x. Por ejemplo, 
--    caracterAmorse 'A'  ==  ".-"
--    caracterAmorse 'B'  ==  "-..."
--    caracterAmorse '1'  ==  "..---"
--    caracterAmorse 'a'  ==  ".-"
caracterAmorse :: Char -> String
caracterAmorse = correspondiente caracteres morse . toUpper

-- (morseAcaracter x) es el carácter cuyo código Morse es x. Por
-- ejemplo,  
--    morseAcaracter ".-"     ==  'A'
--    morseAcaracter "-..."   ==  'B'
--    morseAcaracter "..---"  ==  '1'
morseAcaracter :: String -> Char
morseAcaracter = correspondiente morse caracteres

-- (palabraAmorse cs) es el código Morse correspondiente a la palabra
-- cs. Por ejemplo,
--    palabraAmorse "En"  ==  ". -."
palabraAmorse :: [Char] -> String
palabraAmorse = unwords . map caracterAmorse

-- (morseApalabra cs) es la palabra cuyo traducción a Morse es cs. Por
-- ejemplo, 
--    morseApalabra ". -."  ==  "EN"
morseApalabra :: String -> [Char]
morseApalabra = map morseAcaracter . words

-- (fraseAmorse cs) es la traducción de la frase cs a Morse. Por ejemplo,
--    ghci> fraseAmorse "En todo la medida"
--    ". -.  - --- -.. ---  .-.. .-  -- . -.. .. -.. .-"
fraseAmorse :: String -> String
fraseAmorse = intercalate "  " . map palabraAmorse . words

-- Ejemplo de cálculo
--    fraseAmorse "En todo la medida"
--    = (intercalate "  " . map palabraAmorse . words)
--      "En todo la medida"
--    = (intercalate "  " . map palabraAmorse)
--      ["En","todo","la","medida"]
--    = intercalate "  " [". -.","- --- -.. ---",".-.. .-","-- . -.. .. -.. .-"]
--    = ". -.  - --- -.. ---  .-.. .-  -- . -.. .. -.. .-"
  
-- (morseAfrase cs) es la frase cuya traducción a Morse es cs. Por
-- ejemplo, 
--    ghci> morseAfrase ". -.  - --- -.. ---  .-.. .-  -- . -.. .. -.. .-"
--    "EN TODO LA MEDIDA"
morseAfrase :: String -> String
morseAfrase = unwords . map morseApalabra . splitOn "  "

-- Ejemplo de cálculo
--    morseAfrase ". -.  - --- -.. ---  .-.. .-  -- . -.. .. -.. .-"
--    = (unwords . map morseApalabra)
--      ". -.  - --- -.. ---  .-.. .-  -- . -.. .. -.. .-"
--    = (unwords . map morseApalabra)
--      [". -.","- --- -.. ---",".-.. .-","-- . -.. .. -.. .-"]
--    = unwords ["EN","TODO","LA","MEDIDA"]
--    = "EN TODO LA MEDIDA"

import Data.Char (toUpper)

import Data.List (intercalate)

import Data.List.Split (splitOn)

-- caracteres es la lista ordenada de las caracteres (letras mayúsculas

-- y dígitos) que se usan en los mensajes Morse.

caracteres :: [Char]

caracteres = ['A'..'Z'] ++ ['0'..'9']

-- morse es la lista de los códigos Morse correspondientes a la lista

-- de caracteres.

morse :: [String]

morse = [".-","-...","-.-.","-..",".","..-.","--.","....","..",".---",

"-.-",".-..","--","-.","---",".--.","--.-",".-.","...","-",

"..-","...-",".--","-..-","-.--","--..",".----","..---","...--",

"....-",".....","-....","--...","---..","----.","-----"]

-- (correspondiente xs ys x) es el elemento de ys en la misma posición

-- que x en xs. Por ejemplo,

-- correspondiente [1..10] [2,4..20] 3 == 6

correspondiente :: Ord a => [a] -> [b] -> a -> b

correspondiente xs ys x = head [y | (z,y) <- zip xs ys, z == x]

-- (caracterAmorse x) es el código Morse correspondiente al carácter

-- x. Por ejemplo,

-- caracterAmorse 'A' == ".-"

-- caracterAmorse 'B' == "-..."

-- caracterAmorse '1' == "..---"

-- caracterAmorse 'a' == ".-"

caracterAmorse :: Char -> String

caracterAmorse = correspondiente caracteres morse . toUpper

-- (morseAcaracter x) es el carácter cuyo código Morse es x. Por

-- ejemplo,

-- morseAcaracter ".-" == 'A'

-- morseAcaracter "-..." == 'B'

-- morseAcaracter "..---" == '1'

morseAcaracter :: String -> Char

morseAcaracter = correspondiente morse caracteres

-- (palabraAmorse cs) es el código Morse correspondiente a la palabra

-- cs. Por ejemplo,

-- palabraAmorse "En" == ". -."

palabraAmorse :: [Char] -> String

palabraAmorse = unwords . map caracterAmorse

-- (morseApalabra cs) es la palabra cuyo traducción a Morse es cs. Por

-- ejemplo,

-- morseApalabra ". -." == "EN"

morseApalabra :: String -> [Char]

morseApalabra = map morseAcaracter . words

-- (fraseAmorse cs) es la traducción de la frase cs a Morse. Por ejemplo,

-- ghci> fraseAmorse "En todo la medida"

-- ". -. - --- -.. --- .-.. .- -- . -.. .. -.. .-"

fraseAmorse :: String -> String

fraseAmorse = intercalate " " . map palabraAmorse . words

-- Ejemplo de cálculo

-- fraseAmorse "En todo la medida"

-- = (intercalate " " . map palabraAmorse . words)

-- "En todo la medida"

-- = (intercalate " " . map palabraAmorse)

-- ["En","todo","la","medida"]

-- = intercalate " " [". -.","- --- -.. ---",".-.. .-","-- . -.. .. -.. .-"]

-- = ". -. - --- -.. --- .-.. .- -- . -.. .. -.. .-"

-- (morseAfrase cs) es la frase cuya traducción a Morse es cs. Por

-- ejemplo,

-- ghci> morseAfrase ". -. - --- -.. --- .-.. .- -- . -.. .. -.. .-"

-- "EN TODO LA MEDIDA"

morseAfrase :: String -> String

morseAfrase = unwords . map morseApalabra . splitOn " "

-- Ejemplo de cálculo

-- morseAfrase ". -. - --- -.. --- .-.. .- -- . -.. .. -.. .-"

-- = (unwords . map morseApalabra)

-- ". -. - --- -.. --- .-.. .- -- . -.. .. -.. .-"

-- = (unwords . map morseApalabra)

-- [". -.","- --- -.. ---",".-.. .-","-- . -.. .. -.. .-"]

-- = unwords ["EN","TODO","LA","MEDIDA"]

-- = "EN TODO LA MEDIDA"

Filtro booleano

PorJosé A. Alonso 23-junio-201426-marzo-2022

Enunciado

-- Definir la función
--    filtroBooleano :: [Bool] -> [a] -> [Maybe a]
-- tal que (filtroBooleano xs ys) es la lista de los elementos de ys
-- tales que el elemento de xs en la misma posición es verdadero. Por
-- ejemplo, 
--    ghci> filtroBooleano [True,False,True] "Sevilla"
--    [Just 'S',Nothing,Just 'v']
--    ghci> filtroBooleano (repeat True) "abc"
--    [Just 'a',Just 'b',Just 'c']
--    ghci> take 3 (filtroBooleano (repeat True) [1..])
--    [Just 1,Just 2,Just 3]
--    ghci> take 3 (filtroBooleano (repeat False) [1..])
--    [Nothing,Nothing,Nothing]
--    ghci> take 3 (filtroBooleano (cycle [True,False]) [1..])
--    [Just 1,Nothing,Just 3]

-- Definir la función

-- filtroBooleano :: [Bool] -> [a] -> [Maybe a]

-- tal que (filtroBooleano xs ys) es la lista de los elementos de ys

-- tales que el elemento de xs en la misma posición es verdadero. Por

-- ejemplo,

-- ghci> filtroBooleano [True,False,True] "Sevilla"

-- [Just 'S',Nothing,Just 'v']

-- ghci> filtroBooleano (repeat True) "abc"

-- [Just 'a',Just 'b',Just 'c']

-- ghci> take 3 (filtroBooleano (repeat True) [1..])

-- [Just 1,Just 2,Just 3]

-- ghci> take 3 (filtroBooleano (repeat False) [1..])

-- [Nothing,Nothing,Nothing]

-- ghci> take 3 (filtroBooleano (cycle [True,False]) [1..])

-- [Just 1,Nothing,Just 3]

Soluciones

-- 1ª solución (por comprensión):
filtroBooleano1 :: [Bool] -> [a] -> [Maybe a]
filtroBooleano1 xs ys = [f (x,y) | (x,y) <- zip xs ys]
    where f (x,y) | x         = Just y
                  | otherwise = Nothing

-- 2ª solución (con zipWith):
filtroBooleano2 :: [Bool] -> [a] -> [Maybe a]
filtroBooleano2 = zipWith f
    where f x y  | x         = Just y
                 | otherwise = Nothing

-- 3ª solución (con zipWith y lambda):
filtroBooleano3 :: [Bool] -> [a] -> [Maybe a]
filtroBooleano3 = zipWith (\x y -> if x then Just y else Nothing)

-- 4ª solución (por recursión):
filtroBooleano4 :: [Bool] -> [a] -> [Maybe a]
filtroBooleano4 (x:xs) (y:ys) | x         = Just y : filtroBooleano4 xs ys
                              | otherwise = Nothing : filtroBooleano4 xs ys
filtroBooleano4 _ _                       = []

-- 1ª solución (por comprensión):

filtroBooleano1 :: [Bool] -> [a] -> [Maybe a]

filtroBooleano1 xs ys = [f (x,y) | (x,y) <- zip xs ys]

where f (x,y) | x = Just y

| otherwise = Nothing

-- 2ª solución (con zipWith):

filtroBooleano2 :: [Bool] -> [a] -> [Maybe a]

filtroBooleano2 = zipWith f

where f x y | x = Just y

| otherwise = Nothing

-- 3ª solución (con zipWith y lambda):

filtroBooleano3 :: [Bool] -> [a] -> [Maybe a]

filtroBooleano3 = zipWith (\x y -> if x then Just y else Nothing)

-- 4ª solución (por recursión):

filtroBooleano4 :: [Bool] -> [a] -> [Maybe a]

filtroBooleano4 (x:xs) (y:ys) | x = Just y : filtroBooleano4 xs ys

| otherwise = Nothing : filtroBooleano4 xs ys

filtroBooleano4 _ _ = []

Soluciones

Soluciones

Soluciones

Solución en Maxima

Soluciones

Soluciones

En Maxima

Soluciones

Soluciones

Soluciones

Referencias

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Entradas recientes

Buscar

Correo electrónico