drop – Exercitium

Ordenada cíclicamente

PorJosé A. Alonso 22-abril-202230-abril-2022

Se dice que una sucesión x(1), …, x(n) está ordenada cíclicamente si existe un índice i tal que la sucesión

   x(i), x(i+1), ..., x(n), x(1), ..., x(i-1)

1	x(i), x(i+1), ..., x(n), x(1), ..., x(i-1)

está ordenada crecientemente de forma estricta.

Definir la función

   ordenadaCiclicamente :: Ord a => [a] -> Maybe Int

1	ordenadaCiclicamente :: Ord a => [a] -> Maybe Int

tal que (ordenadaCiclicamente xs) es el índice a partir del cual está ordenada, si la lista está ordenado cíclicamente y Nothing en caso contrario. Por ejemplo,

   ordenadaCiclicamente [1,2,3,4]      ==  Just 0
   ordenadaCiclicamente [5,8,1,3]      ==  Just 2
   ordenadaCiclicamente [4,6,7,5,1,3]  ==  Nothing
   ordenadaCiclicamente [1,0,3,2]      ==  Nothing
   ordenadaCiclicamente [1,2,0]        ==  Just 2
   ordenadaCiclicamente "cdeab"        ==  Just 3

ordenadaCiclicamente [1,2,3,4] == Just 0

ordenadaCiclicamente [5,8,1,3] == Just 2

ordenadaCiclicamente [4,6,7,5,1,3] == Nothing

ordenadaCiclicamente [1,0,3,2] == Nothing

ordenadaCiclicamente [1,2,0] == Just 2

ordenadaCiclicamente "cdeab" == Just 3

Nota: Se supone que el argumento es una lista no vacía sin elementos repetidos.

Soluciones

module Ordenada_ciclicamente where

import Test.QuickCheck (Arbitrary, Gen, NonEmptyList (NonEmpty), Property,
                        arbitrary, chooseInt, collect, quickCheck)
import Data.List       (nub, sort)
import Data.Maybe      (isJust, listToMaybe)

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

ordenadaCiclicamente1 :: Ord a => [a] -> Maybe Int
ordenadaCiclicamente1 xs = aux 0 xs
  where n = length xs
        aux i zs
          | i == n      = Nothing
          | ordenada zs = Just i
          | otherwise   = aux (i+1) (siguienteCiclo zs)

-- (ordenada xs) se verifica si la lista xs está ordenada
-- crecientemente. Por ejemplo,
--   ordenada "acd"   ==  True
--   ordenada "acdb"  ==  False
ordenada :: Ord a => [a] -> Bool
ordenada []     = True
ordenada (x:xs) = all (x <) xs && ordenada xs

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

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

ordenadaCiclicamente2 :: Ord a => [a] -> Maybe Int
ordenadaCiclicamente2 xs =
  listToMaybe [n | n <- [0..length xs-1],
                   ordenada (drop n xs ++ take n xs)]

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

ordenadaCiclicamente3 :: Ord a => [a] -> Maybe Int
ordenadaCiclicamente3 xs
  | ordenada (bs ++ as) = Just k
  | otherwise           = Nothing
  where (_,k)   = minimum (zip xs [0..])
        (as,bs) = splitAt k xs

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

-- La propiedad es
prop_ordenadaCiclicamente1 :: NonEmptyList Int -> Bool
prop_ordenadaCiclicamente1 (NonEmpty xs) =
  ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

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

-- La propiedad para analizar los casos de prueba
prop_ordenadaCiclicamente2 :: NonEmptyList Int -> Property
prop_ordenadaCiclicamente2 (NonEmpty xs) =
  collect (isJust (ordenadaCiclicamente1 xs)) $
  ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

-- El análisis es
--    λ> quickCheck prop_ordenadaCiclicamente2
--    +++ OK, passed 100 tests:
--    89% False
--    11% True

-- Tipo para generar listas
newtype Lista = L [Int]
  deriving Show

-- Generador de listas.
listaArbitraria :: Gen Lista
listaArbitraria = do
  x <- arbitrary
  xs <- arbitrary
  let ys = x : xs
  k <- chooseInt (0, length ys)
  let (as,bs) = splitAt k (sort (nub ys))
  return (L (bs ++ as))

-- Lista es una subclase de Arbitrary.
instance Arbitrary Lista where
  arbitrary = listaArbitraria

-- La propiedad para analizar los casos de prueba
prop_ordenadaCiclicamente3 :: Lista -> Property
prop_ordenadaCiclicamente3 (L xs) =
  collect (isJust (ordenadaCiclicamente1 xs)) $
  ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

-- El análisis es
--    λ> quickCheck prop_ordenadaCiclicamente3
--    +++ OK, passed 100 tests (100% True).

-- Tipo para generar
newtype Lista2 = L2 [Int]
  deriving Show

-- Generador de listas
listaArbitraria2 :: Gen Lista2
listaArbitraria2 = do
  x' <- arbitrary
  xs <- arbitrary
  let ys = x' : xs
  k <- chooseInt (0, length ys)
  let (as,bs) = splitAt k (sort (nub ys))
  n <- chooseInt (0,1)
  return (if even n
          then L2 (bs ++ as)
          else L2 ys)

-- Lista es una subclase de Arbitrary.
instance Arbitrary Lista2 where
  arbitrary = listaArbitraria2

-- La propiedad para analizar los casos de prueba
prop_ordenadaCiclicamente4 :: Lista2 -> Property
prop_ordenadaCiclicamente4 (L2 xs) =
  collect (isJust (ordenadaCiclicamente1 xs)) $
  ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

-- El análisis es
--    λ> quickCheck prop_ordenadaCiclicamente4
--    +++ OK, passed 100 tests:
--    51% True
--    49% False

-- La propiedad es
prop_ordenadaCiclicamente :: Lista2 -> Bool
prop_ordenadaCiclicamente (L2 xs) =
  all (== ordenadaCiclicamente1 xs)
      [ordenadaCiclicamente2 xs,
       ordenadaCiclicamente3 xs]

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

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

-- La comparación es
--    λ> ordenadaCiclicamente1 ([100..4000] ++ [1..99])
--    Just 3901
--    (3.27 secs, 2,138,864,568 bytes)
--    λ> ordenadaCiclicamente2 ([100..4000] ++ [1..99])
--    Just 3901
--    (2.44 secs, 1,430,040,008 bytes)
--    λ> ordenadaCiclicamente3 ([100..4000] ++ [1..99])
--    Just 3901
--    (1.18 secs, 515,549,200 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

module Ordenada_ciclicamente where

import Test.QuickCheck (Arbitrary, Gen, NonEmptyList (NonEmpty), Property,

arbitrary, chooseInt, collect, quickCheck)

import Data.List (nub, sort)

import Data.Maybe (isJust, listToMaybe)

-- 1ª solución

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

ordenadaCiclicamente1 :: Ord a => [a] -> Maybe Int

ordenadaCiclicamente1 xs = aux 0 xs

where n = length xs

aux i zs

| i == n = Nothing

| ordenada zs = Just i

| otherwise = aux (i+1) (siguienteCiclo zs)

-- (ordenada xs) se verifica si la lista xs está ordenada

-- crecientemente. Por ejemplo,

-- ordenada "acd" == True

-- ordenada "acdb" == False

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

ordenada [] = True

ordenada (x:xs) = all (x <) xs && ordenada xs

-- (siguienteCiclo xs) es la lista obtenida añadiendo el primer elemento

-- de xs al final del resto de xs. Por ejemplo,

-- siguienteCiclo [3,2,5] => [2,5,3]

siguienteCiclo :: [a] -> [a]

siguienteCiclo [] = []

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

-- 2ª solución

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

ordenadaCiclicamente2 :: Ord a => [a] -> Maybe Int

ordenadaCiclicamente2 xs =

listToMaybe [n | n <- [0..length xs-1],

ordenada (drop n xs ++ take n xs)]

-- 3ª solución

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

ordenadaCiclicamente3 :: Ord a => [a] -> Maybe Int

ordenadaCiclicamente3 xs

| ordenada (bs ++ as) = Just k

| otherwise = Nothing

where (_,k) = minimum (zip xs [0..])

(as,bs) = splitAt k xs

-- Comprobación de equivalencia

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

-- La propiedad es

prop_ordenadaCiclicamente1 :: NonEmptyList Int -> Bool

prop_ordenadaCiclicamente1 (NonEmpty xs) =

ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

-- La comprobación es

-- λ> quickCheck prop_ordenadaCiclicamente1

-- +++ OK, passed 100 tests.

-- La propiedad para analizar los casos de prueba

prop_ordenadaCiclicamente2 :: NonEmptyList Int -> Property

prop_ordenadaCiclicamente2 (NonEmpty xs) =

collect (isJust (ordenadaCiclicamente1 xs)) $

ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

-- El análisis es

-- λ> quickCheck prop_ordenadaCiclicamente2

-- +++ OK, passed 100 tests:

-- 89% False

-- 11% True

-- Tipo para generar listas

newtype Lista = L [Int]

deriving Show

-- Generador de listas.

listaArbitraria :: Gen Lista

listaArbitraria = do

x <- arbitrary

xs <- arbitrary

let ys = x : xs

k <- chooseInt (0, length ys)

let (as,bs) = splitAt k (sort (nub ys))

return (L (bs ++ as))

-- Lista es una subclase de Arbitrary.

instance Arbitrary Lista where

arbitrary = listaArbitraria

-- La propiedad para analizar los casos de prueba

prop_ordenadaCiclicamente3 :: Lista -> Property

prop_ordenadaCiclicamente3 (L xs) =

collect (isJust (ordenadaCiclicamente1 xs)) $

ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

-- El análisis es

-- λ> quickCheck prop_ordenadaCiclicamente3

-- +++ OK, passed 100 tests (100% True).

-- Tipo para generar

newtype Lista2 = L2 [Int]

deriving Show

-- Generador de listas

listaArbitraria2 :: Gen Lista2

listaArbitraria2 = do

x' <- arbitrary

xs <- arbitrary

let ys = x' : xs

k <- chooseInt (0, length ys)

let (as,bs) = splitAt k (sort (nub ys))

n <- chooseInt (0,1)

return (if even n

then L2 (bs ++ as)

else L2 ys)

-- Lista es una subclase de Arbitrary.

instance Arbitrary Lista2 where

arbitrary = listaArbitraria2

-- La propiedad para analizar los casos de prueba

prop_ordenadaCiclicamente4 :: Lista2 -> Property

prop_ordenadaCiclicamente4 (L2 xs) =

collect (isJust (ordenadaCiclicamente1 xs)) $

ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

-- El análisis es

-- λ> quickCheck prop_ordenadaCiclicamente4

-- +++ OK, passed 100 tests:

-- 51% True

-- 49% False

-- La propiedad es

prop_ordenadaCiclicamente :: Lista2 -> Bool

prop_ordenadaCiclicamente (L2 xs) =

all (== ordenadaCiclicamente1 xs)

[ordenadaCiclicamente2 xs,

ordenadaCiclicamente3 xs]

-- La comprobación es

-- λ> quickCheck prop_ordenadaCiclicamente

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> ordenadaCiclicamente1 ([100..4000] ++ [1..99])

-- Just 3901

-- (3.27 secs, 2,138,864,568 bytes)

-- λ> ordenadaCiclicamente2 ([100..4000] ++ [1..99])

-- Just 3901

-- (2.44 secs, 1,430,040,008 bytes)

-- λ> ordenadaCiclicamente3 ([100..4000] ++ [1..99])

-- Just 3901

-- (1.18 secs, 515,549,200 bytes)

El código se encuentra en GitHub.

La elaboración de las soluciones se describe en el siguiente vídeo

Nuevas soluciones

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

Biparticiones de una lista

PorJosé A. Alonso 1-abril-20228-abril-2022

Definir la función

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

1	biparticiones :: [a] -> [([a],[a])]

tal que (biparticiones xs) es la lista de pares formados por un prefijo de xs y el resto de xs. Por ejemplo,

   λ> biparticiones [3,2,5]
   [([],[3,2,5]),([3],[2,5]),([3,2],[5]),([3,2,5],[])]
   λ> biparticiones "Roma"
   [("","Roma"),("R","oma"),("Ro","ma"),("Rom","a"),("Roma","")]

λ> biparticiones [3,2,5]

[([],[3,2,5]),([3],[2,5]),([3,2],[5]),([3,2,5],[])]

λ> biparticiones "Roma"

[("","Roma"),("R","oma"),("Ro","ma"),("Rom","a"),("Roma","")]

Soluciones

import Data.List (inits, tails)
import Control.Applicative (liftA2)
import Test.QuickCheck (quickCheck)

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

biparticiones1 :: [a] -> [([a],[a])]
biparticiones1 [] = [([],[])]
biparticiones1 (x:xs) =
  ([],(x:xs)) : [(x:ys,zs) | (ys,zs) <- biparticiones1 xs]

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

biparticiones2 :: [a] -> [([a],[a])]
biparticiones2 xs =
  [(take i xs, drop i xs) | i <- [0..length xs]]

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

biparticiones3 :: [a] -> [([a],[a])]
biparticiones3 xs =
  [splitAt i xs | i <- [0..length xs]]

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

biparticiones4 :: [a] -> [([a],[a])]
biparticiones4 xs =
  zip (inits xs) (tails xs)

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

biparticiones5 :: [a] -> [([a],[a])]
biparticiones5 = liftA2 zip inits tails

-- 6ª solución
-- ===========

biparticiones6 :: [a] -> [([a],[a])]
biparticiones6 = zip <$> inits <*> tails

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

-- La propiedad es
prop_biparticiones :: [Int] -> Bool
prop_biparticiones xs =
  all (== biparticiones1 xs)
      [biparticiones2 xs,
       biparticiones3 xs,
       biparticiones4 xs,
       biparticiones5 xs,
       biparticiones6 xs]

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

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

-- La comparación es
--    λ> length (biparticiones1 [1..6*10^3])
--    6001
--    (2.21 secs, 3,556,073,552 bytes)
--    λ> length (biparticiones2 [1..6*10^3])
--    6001
--    (0.01 secs, 2,508,448 bytes)
--
--    λ> length (biparticiones2 [1..6*10^6])
--    6000001
--    (2.26 secs, 2,016,494,864 bytes)
--    λ> length (biparticiones3 [1..6*10^6])
--    6000001
--    (2.12 secs, 1,584,494,792 bytes)
--    λ> length (biparticiones4 [1..6*10^6])
--    6000001
--    (0.78 secs, 1,968,494,704 bytes)
--    λ> length (biparticiones5 [1..6*10^6])
--    6000001
--    (0.79 secs, 1,968,494,688 bytes)
--    λ> length (biparticiones6 [1..6*10^6])
--    6000001
--    (0.77 secs, 1,968,494,720 bytes)
--
--    λ> length (biparticiones4 [1..10^7])
--    10000001
--    (1.30 secs, 3,280,495,432 bytes)
--    λ> length (biparticiones5 [1..10^7])
--    10000001
--    (1.42 secs, 3,280,495,416 bytes)
--    λ> length (biparticiones6 [1..10^7])
--    10000001
--    (1.30 secs, 3,280,495,448 bytes)

import Data.List (inits, tails)

import Control.Applicative (liftA2)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

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

biparticiones1 [] = [([],[])]

biparticiones1 (x:xs) =

([],(x:xs)) : [(x:ys,zs) | (ys,zs) <- biparticiones1 xs]

-- 2ª solución

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

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

biparticiones2 xs =

[(take i xs, drop i xs) | i <- [0..length xs]]

-- 3ª solución

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

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

biparticiones3 xs =

[splitAt i xs | i <- [0..length xs]]

-- 4ª solución

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

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

biparticiones4 xs =

zip (inits xs) (tails xs)

-- 5ª solución

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

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

biparticiones5 = liftA2 zip inits tails

-- 6ª solución

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

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

biparticiones6 = zip <$> inits <*> tails

-- Comprobación de equivalencia

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

-- La propiedad es

prop_biparticiones :: [Int] -> Bool

prop_biparticiones xs =

all (== biparticiones1 xs)

[biparticiones2 xs,

biparticiones3 xs,

biparticiones4 xs,

biparticiones5 xs,

biparticiones6 xs]

-- La comprobación es

-- λ> quickCheck prop_biparticiones

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (biparticiones1 [1..6*10^3])

-- 6001

-- (2.21 secs, 3,556,073,552 bytes)

-- λ> length (biparticiones2 [1..6*10^3])

-- 6001

-- (0.01 secs, 2,508,448 bytes)

-- λ> length (biparticiones2 [1..6*10^6])

-- 6000001

-- (2.26 secs, 2,016,494,864 bytes)

-- λ> length (biparticiones3 [1..6*10^6])

-- 6000001

-- (2.12 secs, 1,584,494,792 bytes)

-- λ> length (biparticiones4 [1..6*10^6])

-- 6000001

-- (0.78 secs, 1,968,494,704 bytes)

-- λ> length (biparticiones5 [1..6*10^6])

-- 6000001

-- (0.79 secs, 1,968,494,688 bytes)

-- λ> length (biparticiones6 [1..6*10^6])

-- 6000001

-- (0.77 secs, 1,968,494,720 bytes)

-- λ> length (biparticiones4 [1..10^7])

-- 10000001

-- (1.30 secs, 3,280,495,432 bytes)

-- λ> length (biparticiones5 [1..10^7])

-- 10000001

-- (1.42 secs, 3,280,495,416 bytes)

-- λ> length (biparticiones6 [1..10^7])

-- 10000001

-- (1.30 secs, 3,280,495,448 bytes)

El código se encuentra en GitHub.

La elaboración de las soluciones se describe en el siguiente vídeo

Nuevas soluciones

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

Enumeración de conjuntos finitos de naturales

PorJosé A. Alonso 25-diciembre-20191-enero-2020

Los conjuntos finitos de números naturales se pueden enumerar como sigue

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

0: []

1: [0]

2: [1]

3: [1,0]

4: [2]

5: [2,0]

6: [2,1]

7: [2,1,0]

8: [3]

9: [3,0]

10: [3,1]

11: [3,1,0]

12: [3,2]

13: [3,2,0]

14: [3,2,1]

15: [3,2,1,0]

16: [4]

17: [4,0]

18: [4,1]

19: [4,1,0]

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

Definir la constante

   enumeracionCFN :: [[Integer]]

1	enumeracionCFN :: [[Integer]]

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

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

λ> take 20 enumeracionCFN

[[],

[0],

[1],[1,0],

[2],[2,0],[2,1],[2,1,0],

[3],[3,0],[3,1],[3,1,0],[3,2],[3,2,0],[3,2,1],[3,2,1,0],

[4],[4,0],[4,1],[4,1,0]]

Comprobar con QuickCheck que

si (xs,ys) es un par de elementos consecutivos de enumeracionCFN, entonces xs < ys;
todo conjunto finito de números naturales, representado por una lista decreciente, está en enumeracionCFN.

Soluciones

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

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

enumeracionCFN :: [[Integer]]
enumeracionCFN = concatMap enumeracionCFNHasta [0..]

-- (enumeracionCFNHasta n) es la lista de conjuntos con la enumeración
-- anterior cuyo primer elemento es n. Por ejemplo,
--    λ> enumeracionCFNHasta 1
--    [[1],[1,0]]
--    λ> enumeracionCFNHasta 2
--    [[2],[2,0],[2,1],[2,1,0]]
--    λ> enumeracionCFNHasta 3
--    [[3],[3,0],[3,1],[3,1,0],[3,2],[3,2,0],[3,2,1],[3,2,1,0]]
enumeracionCFNHasta :: Integer -> [[Integer]]
enumeracionCFNHasta 0 = [[],[0]]
enumeracionCFNHasta n =
  [n:xs | k <- [0..n-1], xs <- enumeracionCFNHasta k]

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

enumeracionCFN2 :: [[Integer]]
enumeracionCFN2 = [] : aux 0 [[]]
  where aux n xs = yss ++ aux (n+1) (xs ++ yss)
          where yss = map (n:) xs

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

enumeracionCFN3 :: [[Integer]]
enumeracionCFN3 = map conjunto [0..]

-- (conjunto n) es el conjunto en la posición n. Por ejemplo,
--   conjunto 6  ==  [2,1]
conjunto :: Integer -> [Integer]
conjunto n = reverse [x | (x,y) <- zip [0..] (binario n), y == 1]

-- (binario n) es la representación binarioa del número n (en orden
-- inverso). Por ejemplo,
--   binario 6  ==  [0,1,1]
binario :: Integer -> [Integer]
binario 0 = [0]
binario 1 = [1]
binario n = n `mod` 2 : binario (n `div` 2)

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

--    λ> enumeracionCFN !! (4*10^5)
--    [18,17,12,11,9,7]
--    (1.18 secs, 576,924,344 bytes)
--    λ> enumeracionCFN2 !! (4*10^5)
--    [18,17,12,11,9,7]
--    (0.10 secs, 72,399,784 bytes)
--    λ> enumeracionCFN3 !! (4*10^5)
--    [18,17,12,11,9,7]
--    (0.07 secs, 64,123,952 bytes)
--
--    λ> enumeracionCFN2 !! (6*10^6)
--    [22,20,19,17,16,15,11,10,8,7]
--    (1.25 secs, 1,082,690,216 bytes)
--    λ> enumeracionCFN3 !! (6*10^6)
--    [22,20,19,17,16,15,11,10,8,7]
--    (0.38 secs, 960,134,256 bytes)

-- Propiedades
-- ===========

-- La primera propiedad es
prop_enumeracionCFN :: Int -> Property
prop_enumeracionCFN n =
  n >= 0 ==> xs < ys
  where (xs:ys:_) = drop n enumeracionCFN

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

-- La segunda propiedad es
prop_completa :: [Integer] -> Bool
prop_completa xs =
  xs' `elem` enumeracionCFN
  where xs' = reverse (sort (nub (map abs xs)))

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

import Data.List (genericLength, nub, sort)

import Test.QuickCheck

-- 1ª solución

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

enumeracionCFN :: [[Integer]]

enumeracionCFN = concatMap enumeracionCFNHasta [0..]

-- (enumeracionCFNHasta n) es la lista de conjuntos con la enumeración

-- anterior cuyo primer elemento es n. Por ejemplo,

-- λ> enumeracionCFNHasta 1

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

-- λ> enumeracionCFNHasta 2

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

-- λ> enumeracionCFNHasta 3

-- [[3],[3,0],[3,1],[3,1,0],[3,2],[3,2,0],[3,2,1],[3,2,1,0]]

enumeracionCFNHasta :: Integer -> [[Integer]]

enumeracionCFNHasta 0 = [[],[0]]

enumeracionCFNHasta n =

[n:xs | k <- [0..n-1], xs <- enumeracionCFNHasta k]

-- 2ª solución

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

enumeracionCFN2 :: [[Integer]]

enumeracionCFN2 = [] : aux 0 [[]]

where aux n xs = yss ++ aux (n+1) (xs ++ yss)

where yss = map (n:) xs

-- 3ª solución

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

enumeracionCFN3 :: [[Integer]]

enumeracionCFN3 = map conjunto [0..]

-- (conjunto n) es el conjunto en la posición n. Por ejemplo,

-- conjunto 6 == [2,1]

conjunto :: Integer -> [Integer]

conjunto n = reverse [x | (x,y) <- zip [0..] (binario n), y == 1]

-- (binario n) es la representación binarioa del número n (en orden

-- inverso). Por ejemplo,

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

binario :: Integer -> [Integer]

binario 0 = [0]

binario 1 = [1]

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

-- Comparación de eficiencia

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

-- λ> enumeracionCFN !! (4*10^5)

-- [18,17,12,11,9,7]

-- (1.18 secs, 576,924,344 bytes)

-- λ> enumeracionCFN2 !! (4*10^5)

-- [18,17,12,11,9,7]

-- (0.10 secs, 72,399,784 bytes)

-- λ> enumeracionCFN3 !! (4*10^5)

-- [18,17,12,11,9,7]

-- (0.07 secs, 64,123,952 bytes)

-- λ> enumeracionCFN2 !! (6*10^6)

-- [22,20,19,17,16,15,11,10,8,7]

-- (1.25 secs, 1,082,690,216 bytes)

-- λ> enumeracionCFN3 !! (6*10^6)

-- [22,20,19,17,16,15,11,10,8,7]

-- (0.38 secs, 960,134,256 bytes)

-- Propiedades

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

-- La primera propiedad es

prop_enumeracionCFN :: Int -> Property

prop_enumeracionCFN n =

n >= 0 ==> xs < ys

where (xs:ys:_) = drop n enumeracionCFN

-- La comprobación es

-- λ> quickCheck prop_enumeracionCFN

-- +++ OK, passed 100 tests.

-- La segunda propiedad es

prop_completa :: [Integer] -> Bool

prop_completa xs =

xs' `elem` enumeracionCFN

where xs' = reverse (sort (nub (map abs xs)))

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=15}) prop_completa

-- +++ OK, passed 100 tests.

Pensamiento

Junto al agua fría,
en la senda clara,
sombra dará algún día,
ese arbolillo en que nadie repara.

Antonio Machado

Posiciones del 2019 en el número pi

PorJosé A. Alonso 17-enero-201924-enero-2019

El fichero Digitos_de_pi.txt contiene el número pi con un millón de decimales; es decir,

   3.1415926535897932384626433832 ... 83996346460422090106105779458151

1	3.1415926535897932384626433832 ... 83996346460422090106105779458151

Definir la función

   posiciones :: String -> Int -> IO [Int]

1	posiciones :: String -> Int -> IO [Int]

tal que (posicion cs k) es es la lista de las posiciones iniciales de cs en la sucesión formada por los k primeros dígitos decimales del número pi. Por ejemplo,

   λ> posiciones "141" 1000
   [0,294]
   λ> posiciones "4159" 10000
   [1,5797,6955,9599]

λ> posiciones "141" 1000

[0,294]

λ> posiciones "4159" 10000

[1,5797,6955,9599]

Calcular la primera posición de 2019 en los decimales de pi y el número de veces que aparece 2019 en en el primer millón de decimales de pi.

Soluciones

import Data.List ( isPrefixOf
                 , findIndices
                 , tails  
                 )

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

posiciones :: String -> Int -> IO [Int]
posiciones cs k = do
  ds <- readFile "Digitos_de_pi.txt"
  return (posicionesEnLista cs (take (k-1) (drop 2 ds)))

--    posicionesEnLista "23" "234235523"  ==  [0,3,7]
posicionesEnLista :: Eq a => [a] -> [a] -> [Int]
posicionesEnLista xs ys = reverse (aux ys 0 [])
  where aux []      _ ns = ns
        aux (y:ys') n ns | xs `isPrefixOf` (y:ys') = aux ys' (n+1) (n:ns)
                         | otherwise               = aux ys' (n+1) ns

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

posiciones2 :: String -> Int -> IO [Int]
posiciones2 cs k = do
  ds <- readFile "Digitos_de_pi.txt"
  return (findIndices (cs `isPrefixOf`) (tails (take (k-1) (drop 2 ds))))

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

--    λ> length <$> posiciones "2019" (10^6)
--    112
--    (1.73 secs, 352,481,272 bytes)
--    λ> length <$> posiciones2 "2019" (10^6)
--    112
--    (0.16 secs, 144,476,384 bytes)

-- El cálculo es
--    λ> ps <- posiciones "2019" (10^6)
--    λ> head ps
--    243
--    λ> length ps
--    112
-- Por tanto, la posición de la primera ocurrencia es 243 y hay 112
-- ocurrencias. Otra forma de hacer los cálculos anteriores es
--    λ> head <$> posiciones "2019" (10^6)
--    243
--    λ> length <$> posiciones "2019" (10^6)
--    112

import Data.List ( isPrefixOf

, findIndices

, tails

)

-- 1ª definición

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

posiciones :: String -> Int -> IO [Int]

posiciones cs k = do

ds <- readFile "Digitos_de_pi.txt"

return (posicionesEnLista cs (take (k-1) (drop 2 ds)))

-- posicionesEnLista "23" "234235523" == [0,3,7]

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

posicionesEnLista xs ys = reverse (aux ys 0 [])

where aux [] _ ns = ns

aux (y:ys') n ns | xs `isPrefixOf` (y:ys') = aux ys' (n+1) (n:ns)

| otherwise = aux ys' (n+1) ns

-- 2ª definición

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

posiciones2 :: String -> Int -> IO [Int]

posiciones2 cs k = do

ds <- readFile "Digitos_de_pi.txt"

return (findIndices (cs `isPrefixOf`) (tails (take (k-1) (drop 2 ds))))

-- Comparación de eficiencia

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

-- λ> length <$> posiciones "2019" (10^6)

-- 112

-- (1.73 secs, 352,481,272 bytes)

-- λ> length <$> posiciones2 "2019" (10^6)

-- 112

-- (0.16 secs, 144,476,384 bytes)

-- El cálculo es

-- λ> ps <- posiciones "2019" (10^6)

-- λ> head ps

-- 243

-- λ> length ps

-- 112

-- Por tanto, la posición de la primera ocurrencia es 243 y hay 112

-- ocurrencias. Otra forma de hacer los cálculos anteriores es

-- λ> head <$> posiciones "2019" (10^6)

-- 243

-- λ> length <$> posiciones "2019" (10^6)

-- 112

Pensamiento

Aprendió tantas cosas, que no tuvo tiempo para pensar en ninguna de ellas.

Antonio Machado

Búsqueda en los dígitos de pi

PorJosé A. Alonso 13-abril-201826-marzo-2022

El fichero Digitos_de_pi.txt contiene el número pi con un millón de decimales; es decir,

   3.1415926535897932384626433832 ... 83996346460422090106105779458151

1	3.1415926535897932384626433832 ... 83996346460422090106105779458151

Definir la función

   posicion :: String -> IO (Maybe Int)

1	posicion :: String -> IO (Maybe Int)

tal que (posicion n) es (Just k) si k es la posición de n en la sucesión formada por un millón dígitos decimales del número pi y Nothing si n no ocurre en dicha sucesión. Por ejemplo,

   λ> posicion "15"
   Just 3
   λ> posicion "2017"
   Just 8897
   λ> posicion "022017"
   Just 382052
   λ> posicion "14022017"
   Nothing
   λ> posicion "999999"
   Just 762
   λ> posicion "458151"
   Just 999995

λ> posicion "15"

Just 3

λ> posicion "2017"

Just 8897

λ> posicion "022017"

Just 382052

λ> posicion "14022017"

Nothing

λ> posicion "999999"

Just 762

λ> posicion "458151"

Just 999995

Nota. Se puede comprobar la función mediante The pi-search page o Pi search engine.

Soluciones

import Data.List (isPrefixOf)

posicion :: String -> IO (Maybe Int)
posicion ns = do
  ds <- readFile "Digitos_de_pi.txt"
  return (posicionEnLista (drop 2 ds) ns)

posicionEnLista :: Eq a => [a] -> [a] -> Maybe Int
posicionEnLista xs ys = aux xs 1
  where aux [] _ = Nothing
        aux (x:xs) n | ys `isPrefixOf` (x:xs) = Just n
                     | otherwise              = aux xs (n+1)

import Data.List (isPrefixOf)

posicion :: String -> IO (Maybe Int)

posicion ns = do

ds <- readFile "Digitos_de_pi.txt"

return (posicionEnLista (drop 2 ds) ns)

posicionEnLista :: Eq a => [a] -> [a] -> Maybe Int

posicionEnLista xs ys = aux xs 1

where aux [] _ = Nothing

aux (x:xs) n | ys `isPrefixOf` (x:xs) = Just n

| otherwise = aux xs (n+1)

Períodos de Fibonacci

PorJosé A. Alonso 9-febrero-201819-febrero-2018

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

   0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610

1	0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610

Al calcular sus restos módulo 3 se obtiene

   0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1

1	0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1

Se observa que es periódica y su período es

   0,1,1,2,0,2,2,1

1	0,1,1,2,0,2,2,1

Definir las funciones

   fibsMod                   :: Integer -> [Integer]
   periodoFibMod             :: Integer -> [Integer]
   longPeriodosFibMod        :: [Int]
   graficaLongPeriodosFibMod :: Int -> IO ()

fibsMod :: Integer -> [Integer]

periodoFibMod :: Integer -> [Integer]

longPeriodosFibMod :: [Int]

graficaLongPeriodosFibMod :: Int -> IO ()

tales que

(fibsMod n) es la lista de los términos de la sucesión de Fibonacci módulo n. Por ejemplo,

     λ> take 24 (fibsMod 3)
     [0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1]
     λ> take 24 (fibsMod 4)
     [0,1,1,2,3,1, 0,1,1,2,3,1, 0,1,1,2,3,1, 0,1,1,2,3,1]

λ> take 24 (fibsMod 3)

[0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1]

λ> take 24 (fibsMod 4)

[0,1,1,2,3,1, 0,1,1,2,3,1, 0,1,1,2,3,1, 0,1,1,2,3,1]

(periodoFibMod n) es la parte perioica de la sucesión de Fibonacci módulo n. Por ejemplo,

     periodoFibMod 3  ==  [0,1,1,2,0,2,2,1]
     periodoFibMod 4  ==  [0,1,1,2,3,1]
     periodoFibMod 7  ==  [0,1,1,2,3,5,1,6,0,6,6,5,4,2,6,1]

periodoFibMod 3 == [0,1,1,2,0,2,2,1]

periodoFibMod 4 == [0,1,1,2,3,1]

periodoFibMod 7 == [0,1,1,2,3,5,1,6,0,6,6,5,4,2,6,1]

longPeriodosFibMod es la sucesión de las longitudes de los períodos de las sucesiones de Fibonacci módulo n, para n > 0. Por ejemplo,

     λ> take 20 longPeriodosFibMod
     [1,3,8,6,20,24,16,12,24,60,10,24,28,48,40,24,36,24,18,60]

1 2	λ> take 20 longPeriodosFibMod [1,3,8,6,20,24,16,12,24,60,10,24,28,48,40,24,36,24,18,60]

(graficaLongPeriodosFibMod n) dibuja la gráfica de los n primeros términos de la sucesión longPeriodosFibMod. Por ejemplo, (graficaLongPeriodosFibMod n) dibuja

Soluciones

import Graphics.Gnuplot.Simple

fibsMod :: Integer -> [Integer]
fibsMod n = map (`mod` n) fibs

-- fibs es la sucesión de Fibonacci. Por ejemplo,
--    λ> take 20 fibs
--    [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181]
fibs :: [Integer]
fibs = 0 : 1 : zipWith (+) fibs (tail fibs)

periodoFibMod :: Integer -> [Integer]
periodoFibMod 1 = [0]
periodoFibMod n = 0 : 1 : aux (drop 2 (fibsMod n))
  where aux (0:1:xs) = []
        aux (a:b:xs) = a : aux (b:xs)

longPeriodosFibMod :: [Int]
longPeriodosFibMod =
  [length (periodoFibMod n) | n <- [1..]]

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

longPeriodosFibMod2 :: [Int]
longPeriodosFibMod2 = map longPeriodoFibMod [1..]

longPeriodoFibMod :: Integer -> Int
longPeriodoFibMod 1 = 1
longPeriodoFibMod n = aux 1 (tail (fibsMod n)) 0
  where aux 0 (1 : xs) k = k
        aux _ (x : xs) k = aux x xs (k + 1)

graficaLongPeriodosFibMod :: Int -> IO ()
graficaLongPeriodosFibMod n =
  plotList [ Key Nothing
           , Title ("graficaLongPeriodosFibMod " ++ show n)
           , PNG ("Periodos_de_Fibonacci " ++ show n ++ ".png")]
           (take n longPeriodosFibMod)

import Graphics.Gnuplot.Simple

fibsMod :: Integer -> [Integer]

fibsMod n = map (`mod` n) fibs

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

-- λ> take 20 fibs

-- [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181]

fibs :: [Integer]

fibs = 0 : 1 : zipWith (+) fibs (tail fibs)

periodoFibMod :: Integer -> [Integer]

periodoFibMod 1 = [0]

periodoFibMod n = 0 : 1 : aux (drop 2 (fibsMod n))

where aux (0:1:xs) = []

aux (a:b:xs) = a : aux (b:xs)

longPeriodosFibMod :: [Int]

longPeriodosFibMod =

[length (periodoFibMod n) | n <- [1..]]

-- 2ª definición de longPeriodosFibMod

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

longPeriodosFibMod2 :: [Int]

longPeriodosFibMod2 = map longPeriodoFibMod [1..]

longPeriodoFibMod :: Integer -> Int

longPeriodoFibMod 1 = 1

longPeriodoFibMod n = aux 1 (tail (fibsMod n)) 0

where aux 0 (1 : xs) k = k

aux _ (x : xs) k = aux x xs (k + 1)

graficaLongPeriodosFibMod :: Int -> IO ()

graficaLongPeriodosFibMod n =

plotList [ Key Nothing

, Title ("graficaLongPeriodosFibMod " ++ show n)

, PNG ("Periodos_de_Fibonacci " ++ show n ++ ".png")]

(take n longPeriodosFibMod)

Búsqueda en los dígitos de pi

PorJosé A. Alonso 15-febrero-201726-marzo-2022

El fichero Digitos_de_pi.txt contiene el número pi con un millón de decimales; es decir,

   3.1415926535897932384626433832 ... 83996346460422090106105779458151

1	3.1415926535897932384626433832 ... 83996346460422090106105779458151

Definir la función

   posicion :: String -> IO (Maybe Int)

1	posicion :: String -> IO (Maybe Int)

tal que (posicion n) es (Just k) si k es la posición de n en la sucesión formada por un millón dígitos decimales del número pi y Nothing si n no ocurre en dicha sucesión. Por ejemplo,

   λ> posicion "15"
   Just 3
   λ> posicion "2017"
   Just 8897
   λ> posicion "022017"
   Just 382052
   λ> posicion "14022017"
   Nothing
   λ> posicion "999999"
   Just 762
   λ> posicion "458151"
   Just 999995

λ> posicion "15"

Just 3

λ> posicion "2017"

Just 8897

λ> posicion "022017"

Just 382052

λ> posicion "14022017"

Nothing

λ> posicion "999999"

Just 762

λ> posicion "458151"

Just 999995

Nota. Se puede comprobar la función mediante The pi-search page o Pi search engine.

Soluciones

import Data.List (isPrefixOf)

posicion :: String -> IO (Maybe Int)
posicion ns = do
  ds <- readFile "Digitos_de_pi.txt"
  return (posicionEnLista (drop 2 ds) ns)

posicionEnLista :: Eq a => [a] -> [a] -> Maybe Int
posicionEnLista xs ys = aux xs 1
  where aux [] _ = Nothing
        aux (x:xs) n | ys `isPrefixOf` (x:xs) = Just n
                     | otherwise              = aux xs (n+1)

import Data.List (isPrefixOf)

posicion :: String -> IO (Maybe Int)

posicion ns = do

ds <- readFile "Digitos_de_pi.txt"

return (posicionEnLista (drop 2 ds) ns)

posicionEnLista :: Eq a => [a] -> [a] -> Maybe Int

posicionEnLista xs ys = aux xs 1

where aux [] _ = Nothing

aux (x:xs) n | ys `isPrefixOf` (x:xs) = Just n

| otherwise = aux xs (n+1)

Particiones de una lista

PorJosé A. Alonso 2-febrero-20179-febrero-2017

Definir la función

   particiones :: [a] -> [[[a]]]

1	particiones :: [a] -> [[[a]]]

tal que (particiones xs) es la lista de las particiones de xs en segmentos de elementos consecutivos. Por ejemplo,

   λ> particiones [1..3]
   [[[1],[2],[3]],[[1],[2,3]],[[1,2],[3]],[[1,2,3]]]
   λ> mapM_ print (particiones "abcd")
   ["a","b","c","d"]
   ["a","b","cd"]
   ["a","bc","d"]
   ["a","bcd"]
   ["ab","c","d"]
   ["ab","cd"]
   ["abc","d"]
   ["abcd"]
   λ> length (particiones [1..22])
   2097152

λ> particiones [1..3]

[[[1],[2],[3]],[[1],[2,3]],[[1,2],[3]],[[1,2,3]]]

λ> mapM_ print (particiones "abcd")

["a","b","c","d"]

["a","b","cd"]

["a","bc","d"]

["a","bcd"]

["ab","c","d"]

["ab","cd"]

["abc","d"]

["abcd"]

λ> length (particiones [1..22])

2097152

Comprobar con QuickCheck que la concatenación de cada uno de los elementos de (particiones xs) es igual a xs.

Nota: En la comprobación usar ejemplos pequeños como se indica a continuación

   quickCheckWith (stdArgs {maxSize=10}) prop_particiones

1	quickCheckWith (stdArgs {maxSize=10}) prop_particiones

Soluciones

import Test.QuickCheck

particiones :: [a] -> [[[a]]]
particiones [] = [[]]
particiones xs =
  [(take k xs) : yss | k <- [1..n], yss <- particiones (drop k xs)]
  where n = length xs

-- La propiedad es
prop_particiones :: [Int] -> Bool
prop_particiones xs =
  all (\yss -> concat yss == xs) (particiones xs)

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

import Test.QuickCheck

particiones :: [a] -> [[[a]]]

particiones [] = [[]]

particiones xs =

[(take k xs) : yss | k <- [1..n], yss <- particiones (drop k xs)]

where n = length xs

-- La propiedad es

prop_particiones :: [Int] -> Bool

prop_particiones xs =

all (\yss -> concat yss == xs) (particiones xs)

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=10}) prop_particiones

-- +++ OK, passed 100 tests.

Posiciones de equilibrio

PorJosé A. Alonso 15-diciembre-201622-diciembre-2016

Se dice que k es una posición de equilibrio de una lista xs si la suma de los elementos de xs en las posiciones menores que k es igual a la suma de los elementos de xs en las posiciones mayores que k. Por ejemplo, en la lista [-7,1,5,2,-4,3,0] el 3 es una posición de equilibrio ya que -7+1+5 = -4+3+0; también lo es el 6 ya que -7+1+5+2+(-4)+3 = 0.

Definir la función,

   equilibrios :: (Num a, Eq a) => [a] -> [Int]

1	equilibrios :: (Num a, Eq a) => [a] -> [Int]

tal que (equilibrios xs) es la lista de las posiciones de equilibrio de xs. Por ejemplo,

   equilibrios [-7,1,5,2,-4,3,0]  ==  [3,6]
   equilibrios [1..10^6]          ==  []

1 2	equilibrios [-7,1,5,2,-4,3,0] == [3,6] equilibrios [1..10^6] == []

Soluciones

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

equilibrios1 :: (Num a, Eq a) => [a] -> [Int]
equilibrios1 xs =
  [n | n <- [0..length xs - 1]
     , sum (take n xs) == sum (drop (n+1) xs)]

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

equilibrios2 :: (Num a, Eq a) => [a] -> [Int]
equilibrios2 xs =
  [n | (n,x,y) <- zip3 [0..] (sumasI xs) (sumasD xs)
     , x == y]

sumasI :: (Num a, Eq a) => [a] -> [a]
sumasI xs = [sum (take n xs) | n <- [0..length xs - 1]] 

sumasD :: (Num a, Eq a) => [a] -> [a]
sumasD xs = [sum (drop (n+1) xs) | n <- [0..length xs - 1]] 

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

equilibrios3 :: (Num a, Eq a) => [a] -> [Int]
equilibrios3 xs =
  [n | (n,x,y) <- zip3 [0..] (sumasI' xs) (sumasD' xs)
     , x == y]

sumasI' :: (Num a, Eq a) => [a] -> [a]
sumasI'  = init . scanl (+) 0 

sumasD' :: (Num a, Eq a) => [a] -> [a]
sumasD' = tail . scanr (+) 0

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

equilibrios4 :: (Num a, Eq a) => [a] -> [Int]
equilibrios4 xs =
  [n | (n,x,y) <- zip3 [0..] (scanl1 (+) xs) (scanr1 (+) xs)
     , x == y]

-- Comparación de eficiencia
--    λ> let xs = [1..10^4] in equilibrios1 (xs ++ [5] ++ reverse xs)
--    [10000]
--    (20.92 secs, 46,240,541,256 bytes)
--    λ> let xs = [1..10^4] in equilibrios2 (xs ++ [5] ++ reverse xs)
--    [10000]
--    (21.12 secs, 46,249,562,520 bytes)
--    λ> let xs = [1..10^4] in equilibrios3 (xs ++ [5] ++ reverse xs)
--    [10000]
--    (0.02 secs, 11,858,768 bytes)
--    λ> let xs = [1..10^4] in equilibrios4 (xs ++ [5] ++ reverse xs)
--    [10000]
--    (0.02 secs, 13,963,952 bytes)

-- 1ª definición

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

equilibrios1 :: (Num a, Eq a) => [a] -> [Int]

equilibrios1 xs =

[n | n <- [0..length xs - 1]

, sum (take n xs) == sum (drop (n+1) xs)]

-- 2ª definición

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

equilibrios2 :: (Num a, Eq a) => [a] -> [Int]

equilibrios2 xs =

[n | (n,x,y) <- zip3 [0..] (sumasI xs) (sumasD xs)

, x == y]

sumasI :: (Num a, Eq a) => [a] -> [a]

sumasI xs = [sum (take n xs) | n <- [0..length xs - 1]]

sumasD :: (Num a, Eq a) => [a] -> [a]

sumasD xs = [sum (drop (n+1) xs) | n <- [0..length xs - 1]]

-- 3ª definición

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

equilibrios3 :: (Num a, Eq a) => [a] -> [Int]

equilibrios3 xs =

[n | (n,x,y) <- zip3 [0..] (sumasI' xs) (sumasD' xs)

, x == y]

sumasI' :: (Num a, Eq a) => [a] -> [a]

sumasI' = init . scanl (+) 0

sumasD' :: (Num a, Eq a) => [a] -> [a]

sumasD' = tail . scanr (+) 0

-- 4ª definición

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

equilibrios4 :: (Num a, Eq a) => [a] -> [Int]

equilibrios4 xs =

[n | (n,x,y) <- zip3 [0..] (scanl1 (+) xs) (scanr1 (+) xs)

, x == y]

-- Comparación de eficiencia

-- λ> let xs = [1..10^4] in equilibrios1 (xs ++ [5] ++ reverse xs)

-- [10000]

-- (20.92 secs, 46,240,541,256 bytes)

-- λ> let xs = [1..10^4] in equilibrios2 (xs ++ [5] ++ reverse xs)

-- [10000]

-- (21.12 secs, 46,249,562,520 bytes)

-- λ> let xs = [1..10^4] in equilibrios3 (xs ++ [5] ++ reverse xs)

-- [10000]

-- (0.02 secs, 11,858,768 bytes)

-- λ> let xs = [1..10^4] in equilibrios4 (xs ++ [5] ++ reverse xs)

-- [10000]

-- (0.02 secs, 13,963,952 bytes)

Mayores que la mitad

PorJosé A. Alonso 12-diciembre-201619-diciembre-2016

Definir la función

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

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

tal que (mayoresMitad xs) es la lista de los elementos de xs que son mayores que la mitad de los elementos de xs, suponiendo que los elementos de xs son distintos. Por ejemplo,

   sort (mayoresMitad [1,6,3,4])    ==  [4,6]
   sort (mayoresMitad [1,6,3,4,7])  ==  [4,6,7]
   sort (mayoresMitad [1,6,3,4,2])  ==  [3,4,6]
   length (mayoresMitad3 [1..10^6]) ==  500000

sort (mayoresMitad [1,6,3,4]) == [4,6]

sort (mayoresMitad [1,6,3,4,7]) == [4,6,7]

sort (mayoresMitad [1,6,3,4,2]) == [3,4,6]

length (mayoresMitad3 [1..10^6]) == 500000

Nota: Se considera que si la lista tiene 2n+1 elementos, su mitad tiene n elementos.

Soluciones

import Data.List (sort)

-- 1ª solución:
mayoresMitad1 :: Ord a => [a] -> [a]
mayoresMitad1 xs =
  [x | x <- xs
     , length (filter (<=x) xs) > k]
  where k = length xs `div` 2 

-- 2ª solución
mayoresMitad2 :: Ord a => [a] -> [a]
mayoresMitad2 xs = aux xs
  where aux [] = []
        aux (y:ys) | length [x | x <- xs, x <= y] > k = y : aux ys
                   | otherwise                        = aux ys
        k = length xs `div` 2 

-- 3ª solución
mayoresMitad3 :: Ord a => [a] -> [a]
mayoresMitad3 xs = drop k (sort xs)
  where k = length xs `div` 2 

-- Comprobación de eficiencia
--    λ> length (mayoresMitad1 [1..4*10^3])
--    2000
--    (3.79 secs, 442,631,712 bytes)
--    λ> length (mayoresMitad2 [1..4*10^3])
--    2000
--    (11.82 secs, 1,463,762,192 bytes)
--    λ> length (mayoresMitad3 [1..4*10^3])
--    2000
--    (0.02 secs, 0 bytes)

import Data.List (sort)

-- 1ª solución:

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

mayoresMitad1 xs =

[x | x <- xs

, length (filter (<=x) xs) > k]

where k = length xs `div` 2

-- 2ª solución

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

mayoresMitad2 xs = aux xs

where aux [] = []

aux (y:ys) | length [x | x <- xs, x <= y] > k = y : aux ys

| otherwise = aux ys

k = length xs `div` 2

-- 3ª solución

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

mayoresMitad3 xs = drop k (sort xs)

where k = length xs `div` 2

-- Comprobación de eficiencia

-- λ> length (mayoresMitad1 [1..4*10^3])

-- 2000

-- (3.79 secs, 442,631,712 bytes)

-- λ> length (mayoresMitad2 [1..4*10^3])

-- 2000

-- (11.82 secs, 1,463,762,192 bytes)

-- λ> length (mayoresMitad3 [1..4*10^3])

-- 2000

-- (0.02 secs, 0 bytes)

Cuadrados ondulantes

PorJosé A. Alonso 15-noviembre-201622-noviembre-2016

Un número se dice ondulante si sus cifras alternan entre dos valores. Por ejemplo, 272 es ondulante, así como 2727. El primer cuadrado ondulante no trivial (todos los cuadrados de dos cifras son ondulantes) es 121 = 11^2.

Definir la función

   cuadradosOndulantes :: Integer -> [Integer]

1	cuadradosOndulantes :: Integer -> [Integer]

tal que (cuadradosOndulantes n) es la lista de los cuadrados ondulantes menores que n^2. Por ejemplo,

   λ> cuadradosOndulantes 50000
   [0,1,4,9,16,25,36,49,64,81,121,484,676,69696]

1 2	λ> cuadradosOndulantes 50000 [0,1,4,9,16,25,36,49,64,81,121,484,676,69696]

Nota: Este ejercicio ha sido propuesto por Marcos Giráldez.

Soluciones

import Data.List (isPrefixOf)

cuadradosOndulantes :: Integer -> [Integer]
cuadradosOndulantes n =
  [x^2 | x <- [0..n]
       , ondulante (x^2)]

-- 1ª definición de ondulante
ondulante1 :: Integer -> Bool
ondulante1 n
  | n < 100   = True
  | otherwise = aux zs x y
  where (x:y:zs)       = show n
        aux [] _ _     = True
        aux (c:cs) a b = c == a && aux cs b a

-- 2ª definición de ondulante
ondulante2 :: Integer -> Bool
ondulante2 n = (drop 2 xs) `isPrefixOf` xs
  where xs = show n

-- Comparación de eficiencia
--    λ> length [n | n <- [1..10^6], ondulante1 n]
--    459
--    (5.73 secs, 1,115,105,408 bytes)
--    λ> length [n | n <- [1..10^6], ondulante2 n]
--    459
--    (2.01 secs, 467,856,432 bytes)

-- Se usará como ondulante la 2ª
ondulante :: Integer -> Bool
ondulante = ondulante2

import Data.List (isPrefixOf)

cuadradosOndulantes :: Integer -> [Integer]

cuadradosOndulantes n =

[x^2 | x <- [0..n]

, ondulante (x^2)]

-- 1ª definición de ondulante

ondulante1 :: Integer -> Bool

ondulante1 n

| n < 100 = True

| otherwise = aux zs x y

where (x:y:zs) = show n

aux [] _ _ = True

aux (c:cs) a b = c == a && aux cs b a

-- 2ª definición de ondulante

ondulante2 :: Integer -> Bool

ondulante2 n = (drop 2 xs) `isPrefixOf` xs

where xs = show n

-- Comparación de eficiencia

-- λ> length [n | n <- [1..10^6], ondulante1 n]

-- 459

-- (5.73 secs, 1,115,105,408 bytes)

-- λ> length [n | n <- [1..10^6], ondulante2 n]

-- 459

-- (2.01 secs, 467,856,432 bytes)

-- Se usará como ondulante la 2ª

ondulante :: Integer -> Bool

ondulante = ondulante2

Referencias

Sucesión A016073 de la OEIS.
Undulating number de Eric W. Weisstein en MathWorld.

Inserciones por posición

PorJosé A. Alonso 25-diciembre-20151-enero-2016

Definir la función

   inserta :: [a] -> [[a]] -> [[a]]

1	inserta :: [a] -> [[a]] -> [[a]]

tal que (inserta xs yss) es la lista obtenida insertando

el primer elemento de xs como primero en la primera lista de yss,
el segundo elemento de xs como segundo en la segunda lista de yss (si la segunda lista de yss tiene al menos un elemento),
el tercer elemento de xs como tercero en la tercera lista de yss (si la tercera lista de yss tiene al menos dos elementos),

y así sucesivamente. Por ejemplo,

   inserta [1,2,3] [[4,7],[6],[9,5,8]]  ==  [[1,4,7],[6,2],[9,5,3,8]]
   inserta [1,2,3] [[4,7],[] ,[9,5,8]]  ==  [[1,4,7],[],   [9,5,3,8]]
   inserta [1,2]   [[4,7],[6],[9,5,8]]  ==  [[1,4,7],[6,2],[9,5,8]]
   inserta [1,2,3] [[4,7],[6]]          ==  [[1,4,7],[6,2]]
   inserta "tad"   ["odo","pra","naa"]  ==  ["todo","para","nada"]

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

inserta [1,2,3] [[4,7],[] ,[9,5,8]] == [[1,4,7],[], [9,5,3,8]]

inserta [1,2] [[4,7],[6],[9,5,8]] == [[1,4,7],[6,2],[9,5,8]]

inserta [1,2,3] [[4,7],[6]] == [[1,4,7],[6,2]]

inserta "tad" ["odo","pra","naa"] == ["todo","para","nada"]

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

Soluciones

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

inserta :: [a] -> [[a]] -> [[a]]
inserta xs yss = aux xs yss 0 where
    aux [] yss _ = yss
    aux xs []  _ = []
    aux (x:xs) (ys:yss) n 
        | length us == n = (us ++ x : vs) : aux xs yss (n+1)
        | otherwise      = ys : aux xs yss (n+1)
        where (us,vs) = splitAt n ys

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

inserta2 :: [a] -> [[a]] -> [[a]]
inserta2 xs yss =  
    [ins n x ys | (n,x,ys) <- zip3 [0..] xs yss] ++ drop (length xs) yss
 
ins :: Int -> a -> [a] -> [a]
ins n x ys | length ys < n  = ys
           | otherwise      = take n ys ++ x : drop n ys

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

--    λ> let n = 10000 in length (inserta [1..n] (replicate n (replicate n 0)))
--    10000
--    (3.28 secs, 6,400,568,776 bytes)
--    λ> let n = 10000 in length (inserta2 [1..n] (replicate n (replicate n 0)))
--    10000
--    (0.02 secs, 0 bytes)

-- 1ª solución

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

inserta :: [a] -> [[a]] -> [[a]]

inserta xs yss = aux xs yss 0 where

aux [] yss _ = yss

aux xs [] _ = []

aux (x:xs) (ys:yss) n

| length us == n = (us ++ x : vs) : aux xs yss (n+1)

| otherwise = ys : aux xs yss (n+1)

where (us,vs) = splitAt n ys

-- 2ª solución

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

inserta2 :: [a] -> [[a]] -> [[a]]

inserta2 xs yss =

[ins n x ys | (n,x,ys) <- zip3 [0..] xs yss] ++ drop (length xs) yss

ins :: Int -> a -> [a] -> [a]

ins n x ys | length ys < n = ys

| otherwise = take n ys ++ x : drop n ys

-- Comparación de eficiencia

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

-- λ> let n = 10000 in length (inserta [1..n] (replicate n (replicate n 0)))

-- 10000

-- (3.28 secs, 6,400,568,776 bytes)

-- λ> let n = 10000 in length (inserta2 [1..n] (replicate n (replicate n 0)))

-- 10000

-- (0.02 secs, 0 bytes)

Actualización de una lista

PorJosé A. Alonso 10-marzo-20152-mayo-2016

Definir la función

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

1	actualiza :: [a] -> [(Int,a)] -> [a]

tal que (actualiza xs ps) es la lista obtenida sustituyendo en xs los elementos cuyos índices son las primeras componentes de ps por las segundas. Por ejemplo,

   actualiza [3,5,2,4] [(2,1),(0,7)]  ==  [7,5,1,4]
   sum (actualiza [1..10^4] [(i,2*i) | i <- [0..10^4-1]]) == 99990000

1 2	actualiza [3,5,2,4] [(2,1),(0,7)] == [7,5,1,4] sum (actualiza [1..10^4] [(i,2*i) \| i <- [0..10^4-1]]) == 99990000

Soluciones

import qualified Data.Vector as V
import Data.Array 

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

actualiza :: [a] -> [(Int,a)] -> [a]
actualiza xs []         = xs
actualiza xs ((n,y):ps) = actualiza (actualizaE xs (n,y)) ps

-- (actualizaE xs (n,y)) es la lista obtenida sustituyendo el  elemento
-- n-ésimo de xs por y. Por ejemplo, 
--    actualiza [3,5,2,4] (2,1) ==  [3,5,1,4]
actualizaE :: [a] -> (Int,a) -> [a]
actualizaE xs (n,y) =
    take n xs ++ y : drop (n+1) xs

-- 2ª solución (por tablas)
-- ========================

actualiza2 :: [a] -> [(Int,a)] -> [a]
actualiza2 xs ps = 
    elems (listArray (0,length xs - 1) xs // ps)

-- 3ª solución (por vectores)
-- ==========================

actualiza3 :: [a] -> [(Int,a)] -> [a]
actualiza3 xs ps = 
    V.toList (V.fromList xs V.// ps)

-- Comparación de eficiencia
--    ghci> let n = 10^2 in sum $ actualiza [1..n] [(i,2*i) | i <- [0..n-1]]
--    9900
--    (0.02 secs, 4668984 bytes)
--    ghci> let n = 10^3 in sum $ actualiza [1..n] [(i,2*i) | i <- [0..n-1]]
--    999000
--    (0.28 secs, 77454496 bytes)
--    ghci> let n = 10^4 in sum $ actualiza [1..n] [(i,2*i) | i <- [0..n-1]]
--    99990000
--    (63.46 secs, 8769501704 bytes)
--    
--    ghci> let n = 10^2 in sum $ actualiza2 [1..n] [(i,2*i) | i <- [0..n-1]]
--    9900
--    (0.02 secs, 4147304 bytes)
--    ghci> let n = 10^3 in sum $ actualiza2 [1..n] [(i,2*i) | i <- [0..n-1]]
--    999000
--    (0.02 secs, 4694784 bytes)
--    ghci> let n = 10^4 in sum $ actualiza2 [1..n] [(i,2*i) | i <- [0..n-1]]
--    99990000
--    (0.05 secs, 12276800 bytes)
--    
--    ghci> let n = 10^2 in sum $ actualiza3 [1..n] [(i,2*i) | i <- [0..n-1]]
--    9900
--    (0.01 secs, 4147304 bytes)
--    ghci> let n = 10^3 in sum $ actualiza3 [1..n] [(i,2*i) | i <- [0..n-1]]
--    999000
--    (0.02 secs, 4682680 bytes)
--    ghci> let n = 10^4 in sum $ actualiza3 [1..n] [(i,2*i) | i <- [0..n-1]]
--    99990000
--    (0.04 secs, 12595224 bytes)

import qualified Data.Vector as V

import Data.Array

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

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

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

actualiza xs [] = xs

actualiza xs ((n,y):ps) = actualiza (actualizaE xs (n,y)) ps

-- (actualizaE xs (n,y)) es la lista obtenida sustituyendo el elemento

-- n-ésimo de xs por y. Por ejemplo,

-- actualiza [3,5,2,4] (2,1) == [3,5,1,4]

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

actualizaE xs (n,y) =

take n xs ++ y : drop (n+1) xs

-- 2ª solución (por tablas)

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

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

actualiza2 xs ps =

elems (listArray (0,length xs - 1) xs // ps)

-- 3ª solución (por vectores)

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

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

actualiza3 xs ps =

V.toList (V.fromList xs V.// ps)

-- Comparación de eficiencia

-- ghci> let n = 10^2 in sum $ actualiza [1..n] [(i,2*i) | i <- [0..n-1]]

-- 9900

-- (0.02 secs, 4668984 bytes)

-- ghci> let n = 10^3 in sum $ actualiza [1..n] [(i,2*i) | i <- [0..n-1]]

-- 999000

-- (0.28 secs, 77454496 bytes)

-- ghci> let n = 10^4 in sum $ actualiza [1..n] [(i,2*i) | i <- [0..n-1]]

-- 99990000

-- (63.46 secs, 8769501704 bytes)

-- ghci> let n = 10^2 in sum $ actualiza2 [1..n] [(i,2*i) | i <- [0..n-1]]

-- 9900

-- (0.02 secs, 4147304 bytes)

-- ghci> let n = 10^3 in sum $ actualiza2 [1..n] [(i,2*i) | i <- [0..n-1]]

-- 999000

-- (0.02 secs, 4694784 bytes)

-- ghci> let n = 10^4 in sum $ actualiza2 [1..n] [(i,2*i) | i <- [0..n-1]]

-- 99990000

-- (0.05 secs, 12276800 bytes)

-- ghci> let n = 10^2 in sum $ actualiza3 [1..n] [(i,2*i) | i <- [0..n-1]]

-- 9900

-- (0.01 secs, 4147304 bytes)

-- ghci> let n = 10^3 in sum $ actualiza3 [1..n] [(i,2*i) | i <- [0..n-1]]

-- 999000

-- (0.02 secs, 4682680 bytes)

-- ghci> let n = 10^4 in sum $ actualiza3 [1..n] [(i,2*i) | i <- [0..n-1]]

-- 99990000

-- (0.04 secs, 12595224 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)

Sustitución de listas

PorJosé A. Alonso 22-enero-201530-noviembre-2015

Definir la función

   sustituye :: Eq a => [a] -> [a] -> [a] -> [a]

1	sustituye :: Eq a => [a] -> [a] -> [a] -> [a]

tal que (sustituye xs ys zs) es la lista obtenida sustituyendo las ocurrencias de la lista no vacía xs en zs por ys. Por ejemplo,

   sustituye "as" "_" "las casaderas"   ==  "l_ c_ader_"
   sustituye "as" "es" "las casaderas"  ==  "les cesaderes"
   sustituye "asa" "a" "las casaderas"  ==  "las caderas"
   sustituye "asd" "a" "las casaderas"  ==  "las casaderas"

sustituye "as" "_" "las casaderas" == "l_ c_ader_"

sustituye "as" "es" "las casaderas" == "les cesaderes"

sustituye "asa" "a" "las casaderas" == "las caderas"

sustituye "asd" "a" "las casaderas" == "las casaderas"

Soluciones

import Data.List (isPrefixOf)

sustituye :: Eq a => [a] -> [a] -> [a] -> [a]
sustituye xs ys [] = []
sustituye xs ys (z:zs) 
    | isPrefixOf xs (z:zs) = ys ++ sustituye xs ys (drop n zs)
    | otherwise            = z : sustituye xs ys zs
    where n = length xs - 1

import Data.List (isPrefixOf)

sustituye :: Eq a => [a] -> [a] -> [a] -> [a]

sustituye xs ys [] = []

sustituye xs ys (z:zs)

| isPrefixOf xs (z:zs) = ys ++ sustituye xs ys (drop n zs)

| otherwise = z : sustituye xs ys zs

where n = length xs - 1

Representaciones de matrices

PorJosé A. Alonso 16-diciembre-201427-diciembre-2014

Enunciado

-- Las matrices se pueden representar de distintas formas. Por ejemplo,
-- la matriz
--    |7 5 6|
--    |1 9 4|
-- se puede representar como la terna
--    ([7,5,6,1,9,4],2,3)
-- (donde la primera componente es la lista de los elementos de la
-- matriz, la segunda es su número de filas y la tercera es su número de
-- columnas) y también se puede representar como una lista de listas
--    [[[7,5,6],[1,9,4]]
-- (donde cada elemento es una de las filas de la matriz).
-- 
-- Definir las funciones
--    ternaAlistas :: ([a],Int,Int) -> [[a]]
--    listasAterna :: [[a]] -> ([a],Int,Int) 
-- tales que ternaAlistas pase de la primera representación a la
-- segunda y listasAterna pase de la segunda a la primera. Por ejemplo, 
--    ternaAlistas ([7,5,6,1,9,4],2,3)  ==  [[7,5,6],[1,9,4]]
--    listasAterna [[7,5,6],[1,9,4]]    ==  ([7,5,6,1,9,4],2,3)
--    ternaAlistas ([7,5,6,1,9,4],3,2)  ==  [[7,5],[6,1],[9,4]]
--    listasAterna [[7,5],[6,1],[9,4]]  ==  ([7,5,6,1,9,4],3,2)

-- Las matrices se pueden representar de distintas formas. Por ejemplo,

-- la matriz

-- |7 5 6|

-- |1 9 4|

-- se puede representar como la terna

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

-- (donde la primera componente es la lista de los elementos de la

-- matriz, la segunda es su número de filas y la tercera es su número de

-- columnas) y también se puede representar como una lista de listas

-- [[[7,5,6],[1,9,4]]

-- (donde cada elemento es una de las filas de la matriz).

-- Definir las funciones

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

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

-- tales que ternaAlistas pase de la primera representación a la

-- segunda y listasAterna pase de la segunda a la primera. Por ejemplo,

-- ternaAlistas ([7,5,6,1,9,4],2,3) == [[7,5,6],[1,9,4]]

-- listasAterna [[7,5,6],[1,9,4]] == ([7,5,6,1,9,4],2,3)

-- ternaAlistas ([7,5,6,1,9,4],3,2) == [[7,5],[6,1],[9,4]]

-- listasAterna [[7,5],[6,1],[9,4]] == ([7,5,6,1,9,4],3,2)

Soluciones

ternaAlistas :: ([a],Int,Int) -> [[a]]
ternaAlistas (xs,n,m) = aux xs
    where aux [] = []
          aux xs = take m xs : aux (drop m xs)

listasAterna :: [[a]] -> ([a],Int,Int) 
listasAterna xss = (concat xss, length xss, length (head xss))

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

ternaAlistas (xs,n,m) = aux xs

where aux [] = []

aux xs = take m xs : aux (drop m xs)

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

listasAterna xss = (concat xss, length xss, length (head xss))

Inversa a trozos

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

Enunciado

-- Definir la función 
--    inversa :: Int -> [a] -> [a]
-- tal que (inversa k xs) es la lista obtenida invirtiendo elementos de
-- xs, k elementos cada vez. Si el número de elementos de xs no es un
-- múltiplo de k, entonces los finales elementos de xs se dejen sin
-- invertir. Por ejemplo,
--    inversa 3 [1..11]  ==  [3,2,1,6,5,4,9,8,7,10,11]
--    inversa 4 [1..11]  ==  [4,3,2,1,8,7,6,5,9,10,11]
--
-- Comprobar con QuickCheck que la función inversa es involutiva; es
-- decir, para todo número k>0 y toda lista xs, se tiene que
-- (inversa k (inversa k xs)) es igual a xs

-- Definir la función

-- inversa :: Int -> [a] -> [a]

-- tal que (inversa k xs) es la lista obtenida invirtiendo elementos de

-- xs, k elementos cada vez. Si el número de elementos de xs no es un

-- múltiplo de k, entonces los finales elementos de xs se dejen sin

-- invertir. Por ejemplo,

-- inversa 3 [1..11] == [3,2,1,6,5,4,9,8,7,10,11]

-- inversa 4 [1..11] == [4,3,2,1,8,7,6,5,9,10,11]

-- Comprobar con QuickCheck que la función inversa es involutiva; es

-- decir, para todo número k>0 y toda lista xs, se tiene que

-- (inversa k (inversa k xs)) es igual a xs

Soluciones

[schedule expon=’2014-11-27′ expat=»06:00″]

Las soluciones se pueden escribir en los comentarios hasta el 27 de noviembre.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

[/schedule]

[schedule on=’2014-11-27′ at=»06:00″]

import Test.QuickCheck

-- 1ª definición
inversa1 :: Int -> [a] -> [a]
inversa1 k xs 
    | length xs < k = xs
    | otherwise     = reverse (take k xs) ++ inversa1 k (drop k xs) 

-- 2ª definición 
inversa2 :: Int -> [a] -> [a]
inversa2 k xs = aux xs (length xs) where
    aux xs n
        | n < k     = xs
        | otherwise = reverse (take k xs) ++ aux (drop k xs) (n-k)


-- La dos definiciones son equivalentes
prop_equivalencia ::Int -> [Int] -> Property
prop_equivalencia k xs =
    k > 0 ==> inversa1 k xs == inversa2 k xs

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

-- La segunda es más eficiente
--    ghci> :set +s 
--    
--    ghci> last (inversa1 3 [1..100000])
--    100000
--    (16.42 secs, 17576420 bytes)
--     
--    ghci> last (inversa2 3 [1..100000])
--    100000
--    (0.11 secs, 18171356 bytes)

-- La propiedad es 
prop_inversa :: Int -> [Int] -> Property
prop_inversa k xs =
    k > 0 ==> inversa2 k (inversa2 k xs) == xs

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

import Test.QuickCheck

-- 1ª definición

inversa1 :: Int -> [a] -> [a]

inversa1 k xs

| length xs < k = xs

| otherwise = reverse (take k xs) ++ inversa1 k (drop k xs)

-- 2ª definición

inversa2 :: Int -> [a] -> [a]

inversa2 k xs = aux xs (length xs) where

aux xs n

| n < k = xs

| otherwise = reverse (take k xs) ++ aux (drop k xs) (n-k)

-- La dos definiciones son equivalentes

prop_equivalencia ::Int -> [Int] -> Property

prop_equivalencia k xs =

k > 0 ==> inversa1 k xs == inversa2 k xs

-- La comprobación es

-- ghci> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

-- La segunda es más eficiente

-- ghci> :set +s

-- ghci> last (inversa1 3 [1..100000])

-- 100000

-- (16.42 secs, 17576420 bytes)

-- ghci> last (inversa2 3 [1..100000])

-- 100000

-- (0.11 secs, 18171356 bytes)

-- La propiedad es

prop_inversa :: Int -> [Int] -> Property

prop_inversa k xs =

k > 0 ==> inversa2 k (inversa2 k xs) == xs

-- La comprobación es

-- ghci> quickCheck prop_inversa

-- +++ OK, passed 100 tests.

[/schedule]

Mínimos locales

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

Enunciado

-- Un mínimo local de una lista es un elemento de la lista que es menor
-- que su predecesor y que su sucesor en la lista. Por ejemplo, 1 es un
-- mínimo local de [3,2,1,3,7,7,1,0,2] ya que es menor  que 2 (su
-- predecesor) y que 3 (su sucesor). 
-- 
-- Definir la función
--    minimosLocales :: Ord a => [a] -> [a]
-- tal que (minimosLocales xs) es la lista de los mínimos locales de la
-- lista xs. Por ejemplo,
--    minimosLocales [3,2,1,3,7,7,9,6,8]  ==  [1,6]
--    minimosLocales [1..100]             ==  []
--    minimosLocales "mqexvzat"           ==  "eva"

-- Un mínimo local de una lista es un elemento de la lista que es menor

-- que su predecesor y que su sucesor en la lista. Por ejemplo, 1 es un

-- mínimo local de [3,2,1,3,7,7,1,0,2] ya que es menor que 2 (su

-- predecesor) y que 3 (su sucesor).

-- Definir la función

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

-- tal que (minimosLocales xs) es la lista de los mínimos locales de la

-- lista xs. Por ejemplo,

-- minimosLocales [3,2,1,3,7,7,9,6,8] == [1,6]

-- minimosLocales [1..100] == []

-- minimosLocales "mqexvzat" == "eva"

Soluciones

[schedule expon=’2014-11-26′ expat=»06:00″]

Las soluciones se pueden escribir en los comentarios hasta el 26 de noviembre.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

[/schedule]

[schedule on=’2014-11-26′ at=»06:00″]

-- 1ª definición (por recursión):
minimosLocales1 :: Ord a => [a] -> [a]
minimosLocales1 (x:y:z:xs) | y < x && y < z = y : minimosLocales1 (z:xs)
                           | otherwise      = minimosLocales1 (y:z:xs)
minimosLocales1 _                           = []

-- 2ª definición (por comprensión):
minimosLocales2 :: Ord a => [a] -> [a]
minimosLocales2 xs = 
    [y | (x,y,z) <- zip3 xs (tail xs) (drop 2 xs), y < x, y < z]

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

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

minimosLocales1 (x:y:z:xs) | y < x && y < z = y : minimosLocales1 (z:xs)

| otherwise = minimosLocales1 (y:z:xs)

minimosLocales1 _ = []

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

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

minimosLocales2 xs =

[y | (x,y,z) <- zip3 xs (tail xs) (drop 2 xs), y < x, y < z]

[/schedule]

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

Ordenada cíclicamente

PorJosé A. Alonso 12-junio-201421-abril-2022

Enunciado

-- Se dice que una sucesión x(1), ..., x(n) está ordenada cíclicamente
-- si existe un índice i tal que la sucesión  
--    x(i), x(i+1), ..., x(n), x(1), ..., x(i-1)
-- está ordenada crecientemente. 
-- 
-- Definir la función 
--    ordenadaCiclicamente :: Ord a => [a] -> Int
-- tal que (ordenadaCiclicamente xs) es el índice (empezando en 1) a
-- partir del cual está ordenada, si el la lista está ordenado cíclicamente
-- y 0 en caso contrario. Por ejemplo,
--    ordenadaCiclicamente [1,2,3,4]      ==  1  
--    ordenadaCiclicamente [5,8,2,3]      ==  3 
--    ordenadaCiclicamente [4,6,7,5,4,3]  ==  0 
--    ordenadaCiclicamente [1,0,1,2]      ==  0
--    ordenadaCiclicamente [0,2,0]        ==  3
--    ordenadaCiclicamente "cdeab"        ==  4

-- Se dice que una sucesión x(1), ..., x(n) está ordenada cíclicamente

-- si existe un índice i tal que la sucesión

-- x(i), x(i+1), ..., x(n), x(1), ..., x(i-1)

-- está ordenada crecientemente.

-- Definir la función

-- ordenadaCiclicamente :: Ord a => [a] -> Int

-- tal que (ordenadaCiclicamente xs) es el índice (empezando en 1) a

-- partir del cual está ordenada, si el la lista está ordenado cíclicamente

-- y 0 en caso contrario. Por ejemplo,

-- ordenadaCiclicamente [1,2,3,4] == 1

-- ordenadaCiclicamente [5,8,2,3] == 3

-- ordenadaCiclicamente [4,6,7,5,4,3] == 0

-- ordenadaCiclicamente [1,0,1,2] == 0

-- ordenadaCiclicamente [0,2,0] == 3

-- ordenadaCiclicamente "cdeab" == 4

Soluciones

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

ordenadaCiclicamente1 :: Ord a => [a] -> Int
ordenadaCiclicamente1 xs = 
    primero [n+1 | n <- [0..length xs-1], 
                   ordenada (drop n xs ++ take n xs)]
    where primero []     = 0
          primero (x:xs) = x

-- (ordenada xs) se verifica si la lista xs está ordenada
-- crecientemente. Por ejemplo,
--   ordenada "acd"   ==  True
--   ordenada "acdb"  ==  False
ordenada :: Ord a => [a] -> Bool 
ordenada (x:y:zs) = x <= y && ordenada (y:zs) 
ordenada _        = True 
 
-- 2ª definición (por recursión)
-- =============================

ordenadaCiclicamente2 :: Ord a => [a] -> Int
ordenadaCiclicamente2 xs = aux xs 1 (length xs)  
    where aux xs i k 
              | i > k       = 0 
              | ordenada xs = i 
              | otherwise   = aux (siguienteCiclo xs) (i+1) k 

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

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

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

ordenadaCiclicamente1 :: Ord a => [a] -> Int

ordenadaCiclicamente1 xs =

primero [n+1 | n <- [0..length xs-1],

ordenada (drop n xs ++ take n xs)]

where primero [] = 0

primero (x:xs) = x

-- (ordenada xs) se verifica si la lista xs está ordenada

-- crecientemente. Por ejemplo,

-- ordenada "acd" == True

-- ordenada "acdb" == False

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

ordenada (x:y:zs) = x <= y && ordenada (y:zs)

ordenada _ = True

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

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

ordenadaCiclicamente2 :: Ord a => [a] -> Int

ordenadaCiclicamente2 xs = aux xs 1 (length xs)

where aux xs i k

| i > k = 0

| ordenada xs = i

| otherwise = aux (siguienteCiclo xs) (i+1) k

-- (siguienteCiclo xs) es la lista obtenida añadiendo el primer elemento

-- de xs al final del resto de xs. Por ejemplo,

-- siguienteCiclo [3,2,5] => [2,5,3]

siguienteCiclo [] = []

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

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Referencias

Soluciones

Soluciones

Soluciones

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Entradas recientes

Buscar

Correo electrónico