Data.List

Diferencia simétrica

PorJosé A. Alonso 29-marzo-20225-abril-2022

La diferencia simétrica de dos conjuntos es el conjunto cuyos elementos son aquellos que pertenecen a alguno de los conjuntos iniciales, sin pertenecer a ambos a la vez. Por ejemplo, la diferencia simétrica de {2,5,3} y {4,2,3,7} es {5,4,7}.

Definir la función

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

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

tal que (diferenciaSimetrica xs ys) es la diferencia simétrica de xs e ys. Por ejemplo,

   diferenciaSimetrica [2,5,3] [4,2,3,7]    ==  [4,5,7]
   diferenciaSimetrica [2,5,3] [5,2,3]      ==  []
   diferenciaSimetrica [2,5,2] [4,2,3,7]    ==  [3,4,5,7]
   diferenciaSimetrica [2,5,2] [4,2,4,7]    ==  [4,5,7]
   diferenciaSimetrica [2,5,2,4] [4,2,4,7]  ==  [5,7]

diferenciaSimetrica [2,5,3] [4,2,3,7] == [4,5,7]

diferenciaSimetrica [2,5,3] [5,2,3] == []

diferenciaSimetrica [2,5,2] [4,2,3,7] == [3,4,5,7]

diferenciaSimetrica [2,5,2] [4,2,4,7] == [4,5,7]

diferenciaSimetrica [2,5,2,4] [4,2,4,7] == [5,7]

Soluciones

import Test.QuickCheck
import Data.List ((\\), intersect, nub, sort, union)
import qualified Data.Set as S

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

diferenciaSimetrica1 :: Ord a => [a] -> [a] -> [a]
diferenciaSimetrica1 xs ys =
  sort (nub ([x | x <- xs, x `notElem` ys] ++ [y | y <- ys, y `notElem` xs]))

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

diferenciaSimetrica2 :: Ord a => [a] -> [a] -> [a]
diferenciaSimetrica2 xs ys =
  sort (nub (filter (`notElem` ys) xs ++ filter (`notElem` xs) ys))

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

diferenciaSimetrica3 :: Ord a => [a] -> [a] -> [a]
diferenciaSimetrica3 xs ys =
  sort (nub (union xs ys \\ intersect xs ys))

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

diferenciaSimetrica4 :: Ord a => [a] -> [a] -> [a]
diferenciaSimetrica4 xs ys =
  [x | x <- sort (nub (xs ++ ys))
     , x `notElem` xs || x `notElem` ys]

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

diferenciaSimetrica5 :: Ord a => [a] -> [a] -> [a]
diferenciaSimetrica5 xs ys =
  S.elems ((xs' `S.union` ys') `S.difference` (xs' `S.intersection` ys'))
  where xs' = S.fromList xs
        ys' = S.fromList ys

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

-- La propiedad es
prop_diferenciaSimetrica :: [Int] -> [Int] -> Bool
prop_diferenciaSimetrica xs ys =
  all (== diferenciaSimetrica1 xs ys)
      [diferenciaSimetrica2 xs ys,
       diferenciaSimetrica3 xs ys,
       diferenciaSimetrica4 xs ys,
       diferenciaSimetrica5 xs ys]

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

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

-- La comparación es
--    λ> length (diferenciaSimetrica1 [1..2*10^4] [2,4..2*10^4])
--    10000
--    (2.34 secs, 10,014,360 bytes)
--    λ> length (diferenciaSimetrica2 [1..2*10^4] [2,4..2*10^4])
--    10000
--    (2.41 secs, 8,174,264 bytes)
--    λ> length (diferenciaSimetrica3 [1..2*10^4] [2,4..2*10^4])
--    10000
--    (5.84 secs, 10,232,006,288 bytes)
--    λ> length (diferenciaSimetrica4 [1..2*10^4] [2,4..2*10^4])
--    10000
--    (5.83 secs, 14,814,184 bytes)
--    λ> length (diferenciaSimetrica5 [1..2*10^4] [2,4..2*10^4])
--    10000
--    (0.02 secs, 7,253,496 bytes)

import Test.QuickCheck

import Data.List ((\\), intersect, nub, sort, union)

import qualified Data.Set as S

-- 1ª solución

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

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

diferenciaSimetrica1 xs ys =

sort (nub ([x | x <- xs, x `notElem` ys] ++ [y | y <- ys, y `notElem` xs]))

-- 2ª solución

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

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

diferenciaSimetrica2 xs ys =

sort (nub (filter (`notElem` ys) xs ++ filter (`notElem` xs) ys))

-- 3ª solución

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

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

diferenciaSimetrica3 xs ys =

sort (nub (union xs ys \\ intersect xs ys))

-- 4ª solución

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

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

diferenciaSimetrica4 xs ys =

[x | x <- sort (nub (xs ++ ys))

, x `notElem` xs || x `notElem` ys]

-- 5ª solución

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

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

diferenciaSimetrica5 xs ys =

S.elems ((xs' `S.union` ys') `S.difference` (xs' `S.intersection` ys'))

where xs' = S.fromList xs

ys' = S.fromList ys

-- Comprobación de equivalencia

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

-- La propiedad es

prop_diferenciaSimetrica :: [Int] -> [Int] -> Bool

prop_diferenciaSimetrica xs ys =

all (== diferenciaSimetrica1 xs ys)

[diferenciaSimetrica2 xs ys,

diferenciaSimetrica3 xs ys,

diferenciaSimetrica4 xs ys,

diferenciaSimetrica5 xs ys]

-- La comprobación es

-- λ> quickCheck prop_diferenciaSimetrica

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (diferenciaSimetrica1 [1..2*10^4] [2,4..2*10^4])

-- 10000

-- (2.34 secs, 10,014,360 bytes)

-- λ> length (diferenciaSimetrica2 [1..2*10^4] [2,4..2*10^4])

-- 10000

-- (2.41 secs, 8,174,264 bytes)

-- λ> length (diferenciaSimetrica3 [1..2*10^4] [2,4..2*10^4])

-- 10000

-- (5.84 secs, 10,232,006,288 bytes)

-- λ> length (diferenciaSimetrica4 [1..2*10^4] [2,4..2*10^4])

-- 10000

-- (5.83 secs, 14,814,184 bytes)

-- λ> length (diferenciaSimetrica5 [1..2*10^4] [2,4..2*10^4])

-- 10000

-- (0.02 secs, 7,253,496 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>

Número de pares de elementos adyacentes iguales en una matriz

PorJosé A. Alonso 25-marzo-20221-abril-2022

Una matriz se puede representar mediante una lista de listas. Por ejemplo, la matriz

   |2 1 5|
   |4 3 7|

1 2	\|2 1 5\| \|4 3 7\|

se puede representar mediante la lista

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

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

Definir la función

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

1	numeroParesAdyacentesIguales :: Eq a => [[a]] -> Int

tal que (numeroParesAdyacentesIguales xss) es el número de pares de elementos consecutivos (en la misma fila o columna) iguales de la matriz xss. Por ejemplo,

   numeroParesAdyacentesIguales [[0,1],[0,2]]              ==  1
   numeroParesAdyacentesIguales [[0,0],[1,2]]              ==  1
   numeroParesAdyacentesIguales [[0,1],[0,0]]              ==  2
   numeroParesAdyacentesIguales [[1,2],[1,4],[4,4]]        ==  3
   numeroParesAdyacentesIguales ["ab","aa"]                ==  2
   numeroParesAdyacentesIguales [[0,0,0],[0,0,0],[0,0,0]]  ==  12
   numeroParesAdyacentesIguales [[0,0,0],[0,1,0],[0,0,0]]  ==  8

numeroParesAdyacentesIguales [[0,1],[0,2]] == 1

numeroParesAdyacentesIguales [[0,0],[1,2]] == 1

numeroParesAdyacentesIguales [[0,1],[0,0]] == 2

numeroParesAdyacentesIguales [[1,2],[1,4],[4,4]] == 3

numeroParesAdyacentesIguales ["ab","aa"] == 2

numeroParesAdyacentesIguales [[0,0,0],[0,0,0],[0,0,0]] == 12

numeroParesAdyacentesIguales [[0,0,0],[0,1,0],[0,0,0]] == 8

Soluciones

import Data.List (group,transpose)
import Data.Array ((!), listArray)
import Test.QuickCheck

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

numeroParesAdyacentesIguales1 :: Eq a => [[a]] -> Int
numeroParesAdyacentesIguales1 xss =
  length [(i,j) | i <- [1..m-1], j <- [1..n], p!(i,j) == p!(i+1,j)] +
  length [(i,j) | i <- [1..m], j <- [1..n-1], p!(i,j) == p!(i,j+1)]
  where m = length xss
        n = length (head xss)
        p = listArray ((1,1),(m,n)) (concat xss)

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

numeroParesAdyacentesIguales2 :: Eq a => [[a]] -> Int
numeroParesAdyacentesIguales2 xss =
  numeroParesAdyacentesIgualesFilas xss +
  numeroParesAdyacentesIgualesFilas (transpose xss)

-- (numeroParesAdyacentesIgualesFilas xss) es el número de pares de
-- elementos consecutivos (en la misma fila) iguales de la matriz
-- xss. Por ejemplo,
--    λ> numeroParesAdyacentesIgualesFilas [[0,0,1,0],[0,1,1,0],[0,1,0,1]]
--    2
--    λ> numeroParesAdyacentesIgualesFilas ["0010","0110","0101"]
--    2
numeroParesAdyacentesIgualesFilas :: Eq a => [[a]] -> Int
numeroParesAdyacentesIgualesFilas xss =
  sum [numeroParesAdyacentesIgualesFila xs | xs <- xss]

-- La función anterior se puede definir con map
numeroParesAdyacentesIgualesFilas2 :: Eq a => [[a]] -> Int
numeroParesAdyacentesIgualesFilas2 xss =
  sum (map numeroParesAdyacentesIgualesFila xss)

-- y también se puede definir sin argumentos:
numeroParesAdyacentesIgualesFilas3 :: Eq a => [[a]] -> Int
numeroParesAdyacentesIgualesFilas3 =
  sum . map numeroParesAdyacentesIgualesFila

-- (numeroParesAdyacentesIgualesFila xs) es el número de pares de
-- elementos consecutivos de la lista xs. Por ejemplo,
--    numeroParesAdyacentesIgualesFila [5,5,5,2,5] ==  2
numeroParesAdyacentesIgualesFila :: Eq a => [a] -> Int
numeroParesAdyacentesIgualesFila xs =
  length [(x,y) | (x,y) <- zip xs (tail xs), x == y]

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

numeroParesAdyacentesIguales3 :: Eq a => [[a]] -> Int
numeroParesAdyacentesIguales3 xss =
  length (concatMap tail (concatMap group (xss ++ transpose xss)))

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

numeroParesAdyacentesIguales4 :: Eq a => [[a]] -> Int
numeroParesAdyacentesIguales4 =
  length . (tail =<<) . (group =<<) . ((++) =<< transpose)

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

newtype Matriz = M [[Int]]
  deriving Show

-- Generador de matrices arbitrarias. Por ejemplo,
--    λ> generate matrizArbitraria
--    M [[-3,0],[8,-6],[-13,-13],[10,8],[14,29]]
--    λ> generate matrizArbitraria
--    M [[11,9,4,-25,-29,30,-18],[13,8,-2,-22,29,-3,-13]]
matrizArbitraria :: Gen Matriz
matrizArbitraria = do
  m <- chooseInt (1,10)
  n <- chooseInt (1,10)
  xss <- vectorOf m (vectorOf n arbitrary)
  return (M xss)

-- Matriz es una subclase de Arbitrary.
instance Arbitrary Matriz where
  arbitrary = matrizArbitraria

-- La propiedad es
prop_numeroParesAdyacentesIguales :: Matriz -> Bool
prop_numeroParesAdyacentesIguales (M xss) =
  all (== numeroParesAdyacentesIguales1 xss)
      [numeroParesAdyacentesIguales2 xss,
       numeroParesAdyacentesIguales3 xss,
       numeroParesAdyacentesIguales4 xss]

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

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

-- La comparación es
--    λ> numeroParesAdyacentesIguales1 (replicate (3*10^3) (replicate (10^3) 0))
--    5996000
--    (5.51 secs, 4,751,249,472 bytes)
--    λ> numeroParesAdyacentesIguales2 (replicate (3*10^3) (replicate (10^3) 0))
--    5996000
--    (2.62 secs, 1,681,379,960 bytes)
--    λ> numeroParesAdyacentesIguales3 (replicate (3*10^3) (replicate (10^3) 0))
--    5996000
--    (0.48 secs, 1,393,672,616 bytes)
--    λ> numeroParesAdyacentesIguales4 (replicate (3*10^3) (replicate (10^3) 0))
--    5996000
--    (0.38 secs, 1,393,560,848 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

import Data.List (group,transpose)

import Data.Array ((!), listArray)

import Test.QuickCheck

-- 1ª solución

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

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

numeroParesAdyacentesIguales1 xss =

length [(i,j) | i <- [1..m-1], j <- [1..n], p!(i,j) == p!(i+1,j)] +

length [(i,j) | i <- [1..m], j <- [1..n-1], p!(i,j) == p!(i,j+1)]

where m = length xss

n = length (head xss)

p = listArray ((1,1),(m,n)) (concat xss)

-- 2ª solución

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

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

numeroParesAdyacentesIguales2 xss =

numeroParesAdyacentesIgualesFilas xss +

numeroParesAdyacentesIgualesFilas (transpose xss)

-- (numeroParesAdyacentesIgualesFilas xss) es el número de pares de

-- elementos consecutivos (en la misma fila) iguales de la matriz

-- xss. Por ejemplo,

-- λ> numeroParesAdyacentesIgualesFilas [[0,0,1,0],[0,1,1,0],[0,1,0,1]]

-- 2

-- λ> numeroParesAdyacentesIgualesFilas ["0010","0110","0101"]

-- 2

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

numeroParesAdyacentesIgualesFilas xss =

sum [numeroParesAdyacentesIgualesFila xs | xs <- xss]

-- La función anterior se puede definir con map

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

numeroParesAdyacentesIgualesFilas2 xss =

sum (map numeroParesAdyacentesIgualesFila xss)

-- y también se puede definir sin argumentos:

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

numeroParesAdyacentesIgualesFilas3 =

sum . map numeroParesAdyacentesIgualesFila

-- (numeroParesAdyacentesIgualesFila xs) es el número de pares de

-- elementos consecutivos de la lista xs. Por ejemplo,

-- numeroParesAdyacentesIgualesFila [5,5,5,2,5] == 2

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

numeroParesAdyacentesIgualesFila xs =

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

-- 3ª solución

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

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

numeroParesAdyacentesIguales3 xss =

length (concatMap tail (concatMap group (xss ++ transpose xss)))

-- 4ª solución

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

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

numeroParesAdyacentesIguales4 =

length . (tail =<<) . (group =<<) . ((++) =<< transpose)

-- Comprobación de equivalencia

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

newtype Matriz = M [[Int]]

deriving Show

-- Generador de matrices arbitrarias. Por ejemplo,

-- λ> generate matrizArbitraria

-- M [[-3,0],[8,-6],[-13,-13],[10,8],[14,29]]

-- λ> generate matrizArbitraria

-- M [[11,9,4,-25,-29,30,-18],[13,8,-2,-22,29,-3,-13]]

matrizArbitraria :: Gen Matriz

matrizArbitraria = do

m <- chooseInt (1,10)

n <- chooseInt (1,10)

xss <- vectorOf m (vectorOf n arbitrary)

return (M xss)

-- Matriz es una subclase de Arbitrary.

instance Arbitrary Matriz where

arbitrary = matrizArbitraria

-- La propiedad es

prop_numeroParesAdyacentesIguales :: Matriz -> Bool

prop_numeroParesAdyacentesIguales (M xss) =

all (== numeroParesAdyacentesIguales1 xss)

[numeroParesAdyacentesIguales2 xss,

numeroParesAdyacentesIguales3 xss,

numeroParesAdyacentesIguales4 xss]

-- La comprobación es

-- λ> quickCheck prop_numeroParesAdyacentesIguales

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> numeroParesAdyacentesIguales1 (replicate (3*10^3) (replicate (10^3) 0))

-- 5996000

-- (5.51 secs, 4,751,249,472 bytes)

-- λ> numeroParesAdyacentesIguales2 (replicate (3*10^3) (replicate (10^3) 0))

-- 5996000

-- (2.62 secs, 1,681,379,960 bytes)

-- λ> numeroParesAdyacentesIguales3 (replicate (3*10^3) (replicate (10^3) 0))

-- 5996000

-- (0.48 secs, 1,393,672,616 bytes)

-- λ> numeroParesAdyacentesIguales4 (replicate (3*10^3) (replicate (10^3) 0))

-- 5996000

-- (0.38 secs, 1,393,560,848 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>

Elemento más repetido de manera consecutiva

PorJosé A. Alonso 24-marzo-202231-marzo-2022

Definir la función

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

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

tal que (masRepetido xs) es el elemento de xs que aparece más veces de manera consecutiva en la lista junto con el número de sus apariciones consecutivas; en caso de empate, se devuelve el mayor de dichos elementos. Por ejemplo,

   masRepetido [1,1,4,4,1]  ==  (4,2)
   masRepetido [4,4,1,1,5]  ==  (4,2)
   masRepetido "aadda"      ==  ('d',2)
   masRepetido "ddaab"      ==  ('d',2)
   masRepetido (show (product [1..5*10^4]))  ==  ('0',12499)

masRepetido [1,1,4,4,1] == (4,2)

masRepetido [4,4,1,1,5] == (4,2)

masRepetido "aadda" == ('d',2)

masRepetido "ddaab" == ('d',2)

masRepetido (show (product [1..5*10^4])) == ('0',12499)

Soluciones

import Data.List (group)
import Data.Tuple (swap)
import Control.Arrow ((&&&))
import Test.QuickCheck

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

masRepetido1 :: Ord a => [a] -> (a,Int)
masRepetido1 [x] = (x,1)
masRepetido1 (x:y:zs) | m > n      = (x,m)
                      | m == n     = (max x u,m)
                      | otherwise  = (u,n)
  where (u,n)  = masRepetido1 (y:zs)
        m      = length (takeWhile (==x) (x:y:zs))

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

masRepetido2 :: Ord a => [a] -> (a,Int)
masRepetido2 (x:xs)
  | null xs'   = (x,length (x:xs))
  | m > n      = (x,m)
  | m == n     = (max x u,m)
  | otherwise  = (u,n)
  where xs'    = dropWhile (== x) xs
        m      = length (takeWhile (==x) (x:xs))
        (u,n)  = masRepetido2 xs'

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

masRepetido3 :: Ord a => [a] -> (a,Int)
masRepetido3 xs = (n,z)
  where (z,n) = maximum [(1 + length ys,y) | (y:ys) <- group xs]

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

masRepetido4 :: Ord a => [a] -> (a,Int)
masRepetido4 xs =
  swap (maximum [(1 + length ys,y) | (y:ys) <- group xs])

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

masRepetido5 :: Ord a => [a] -> (a,Int)
masRepetido5 xs =
  swap (maximum (map (\ys -> (length ys, head ys)) (group xs)))

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

masRepetido6 :: Ord a => [a] -> (a,Int)
masRepetido6 =
  swap . maximum . map ((,) <$> length <*> head) . group

-- 7ª solución
-- ============

masRepetido7 :: Ord a => [a] -> (a,Int)
masRepetido7 =
  swap . maximum . map (length &&& head) . group

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

-- La propiedad es
prop_masRepetido :: NonEmptyList Int -> Bool
prop_masRepetido (NonEmpty xs) =
  all (== masRepetido1 xs)
      [masRepetido2 xs,
       masRepetido3 xs,
       masRepetido4 xs,
       masRepetido5 xs,
       masRepetido6 xs,
       masRepetido7 xs]

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

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

-- La comparación es
--    λ> masRepetido1 (show (product [1..3*10^4]))
--    ('0',7498)
--    (3.72 secs, 2,589,930,952 bytes)
--    λ> masRepetido2 (show (product [1..3*10^4]))
--    ('0',7498)
--    (1.27 secs, 991,406,232 bytes)
--    λ> masRepetido3 (show (product [1..3*10^4]))
--    ('0',7498)
--    (0.85 secs, 945,399,976 bytes)
--    λ> masRepetido4 (show (product [1..3*10^4]))
--    ('0',7498)
--    (0.86 secs, 945,399,888 bytes)
--    λ> masRepetido5 (show (product [1..3*10^4]))
--    ('0',7498)
--    (0.80 secs, 943,760,760 bytes)
--    λ> masRepetido6 (show (product [1..3*10^4]))
--    ('0',7498)
--    (0.78 secs, 945,400,400 bytes)
--    λ> masRepetido7 (show (product [1..3*10^4]))
--    ('0',7498)
--    (0.78 secs, 942,122,088 bytes)
--
--    λ> masRepetido2 (show (product [1..5*10^4]))
--    ('0',12499)
--    (3.27 secs, 2,798,156,008 bytes)
--    λ> masRepetido3 (show (product [1..5*10^4]))
--    ('0',12499)
--    (2.20 secs, 2,716,952,408 bytes)
--    λ> masRepetido4 (show (product [1..5*10^4]))
--    ('0',12499)
--    (2.22 secs, 2,716,952,320 bytes)
--    λ> masRepetido5 (show (product [1..5*10^4]))
--    ('0',12499)
--    (2.18 secs, 2,714,062,328 bytes)
--    λ> masRepetido6 (show (product [1..5*10^4]))
--    ('0',12499)
--    (2.17 secs, 2,716,952,832 bytes)
--    λ> masRepetido7 (show (product [1..5*10^4]))
--    ('0',12499)
--    (2.17 secs, 2,711,172,792 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

import Data.List (group)

import Data.Tuple (swap)

import Control.Arrow ((&&&))

import Test.QuickCheck

-- 1ª solución

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

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

masRepetido1 [x] = (x,1)

masRepetido1 (x:y:zs) | m > n = (x,m)

| m == n = (max x u,m)

| otherwise = (u,n)

where (u,n) = masRepetido1 (y:zs)

m = length (takeWhile (==x) (x:y:zs))

-- 2ª solución

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

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

masRepetido2 (x:xs)

| null xs' = (x,length (x:xs))

| m > n = (x,m)

| m == n = (max x u,m)

| otherwise = (u,n)

where xs' = dropWhile (== x) xs

m = length (takeWhile (==x) (x:xs))

(u,n) = masRepetido2 xs'

-- 3ª solución

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

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

masRepetido3 xs = (n,z)

where (z,n) = maximum [(1 + length ys,y) | (y:ys) <- group xs]

-- 4ª solución

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

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

masRepetido4 xs =

swap (maximum [(1 + length ys,y) | (y:ys) <- group xs])

-- 5ª solución

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

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

masRepetido5 xs =

swap (maximum (map (\ys -> (length ys, head ys)) (group xs)))

-- 6ª solución

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

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

masRepetido6 =

swap . maximum . map ((,) <$> length <*> head) . group

-- 7ª solución

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

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

masRepetido7 =

swap . maximum . map (length &&& head) . group

-- Comprobación de equivalencia

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

-- La propiedad es

prop_masRepetido :: NonEmptyList Int -> Bool

prop_masRepetido (NonEmpty xs) =

all (== masRepetido1 xs)

[masRepetido2 xs,

masRepetido3 xs,

masRepetido4 xs,

masRepetido5 xs,

masRepetido6 xs,

masRepetido7 xs]

-- La comprobación es

-- λ> quickCheck prop_masRepetido

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> masRepetido1 (show (product [1..3*10^4]))

-- ('0',7498)

-- (3.72 secs, 2,589,930,952 bytes)

-- λ> masRepetido2 (show (product [1..3*10^4]))

-- ('0',7498)

-- (1.27 secs, 991,406,232 bytes)

-- λ> masRepetido3 (show (product [1..3*10^4]))

-- ('0',7498)

-- (0.85 secs, 945,399,976 bytes)

-- λ> masRepetido4 (show (product [1..3*10^4]))

-- ('0',7498)

-- (0.86 secs, 945,399,888 bytes)

-- λ> masRepetido5 (show (product [1..3*10^4]))

-- ('0',7498)

-- (0.80 secs, 943,760,760 bytes)

-- λ> masRepetido6 (show (product [1..3*10^4]))

-- ('0',7498)

-- (0.78 secs, 945,400,400 bytes)

-- λ> masRepetido7 (show (product [1..3*10^4]))

-- ('0',7498)

-- (0.78 secs, 942,122,088 bytes)

-- λ> masRepetido2 (show (product [1..5*10^4]))

-- ('0',12499)

-- (3.27 secs, 2,798,156,008 bytes)

-- λ> masRepetido3 (show (product [1..5*10^4]))

-- ('0',12499)

-- (2.20 secs, 2,716,952,408 bytes)

-- λ> masRepetido4 (show (product [1..5*10^4]))

-- ('0',12499)

-- (2.22 secs, 2,716,952,320 bytes)

-- λ> masRepetido5 (show (product [1..5*10^4]))

-- ('0',12499)

-- (2.18 secs, 2,714,062,328 bytes)

-- λ> masRepetido6 (show (product [1..5*10^4]))

-- ('0',12499)

-- (2.17 secs, 2,716,952,832 bytes)

-- λ> masRepetido7 (show (product [1..5*10^4]))

-- ('0',12499)

-- (2.17 secs, 2,711,172,792 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>

Regiones determinadas por n rectas del plano

PorJosé A. Alonso 23-marzo-20222-abril-2022

En los siguientes dibujos se observa que el número máximo de regiones en el plano generadas con 1, 2 ó 3 líneas son 2, 4 ó 7, respectivamente.

                      \  |
                       \5|
                        \|
                         \
                         |\
                         | \
               |         |  \
    1        1 | 3     1 | 3 \  6
   ------   ---|---   ---|----\---
    2        2 | 4     2 | 4   \ 7
               |         |      \

\ |

\5|

| \

| | \

1 1 | 3 1 | 3 \ 6

------ ---|--- ---|----\---

2 2 | 4 2 | 4 \ 7

| | \

Definir la función

   regiones :: Integer -> Integer

1	regiones :: Integer -> Integer

tal que (regiones n) es el número máximo de regiones en el plano generadas con n líneas. Por ejemplo,

   regiones 1     ==  2
   regiones 2     ==  4
   regiones 3     ==  7
   regiones 100   ==  5051
   regiones 1000  ==  500501
   regiones 10000 ==  50005001
   length (show (regiones (10^(10^5)))) ==  200000
   length (show (regiones (10^(10^6)))) ==  2000000
   length (show (regiones (10^(10^6)))) ==  2000000
   length (show (regiones (10^(10^7)))) ==  20000000

regiones 1 == 2

regiones 2 == 4

regiones 3 == 7

regiones 100 == 5051

regiones 1000 == 500501

regiones 10000 == 50005001

length (show (regiones (10^(10^5)))) == 200000

length (show (regiones (10^(10^6)))) == 2000000

length (show (regiones (10^(10^7)))) == 20000000

Soluciones

import Data.List (genericIndex)
import Test.QuickCheck

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

regiones1 :: Integer -> Integer
regiones1 0 = 1
regiones1 n = regiones1 (n-1) + n

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

regiones2 :: Integer -> Integer
regiones2 n = 1 + sum [0..n]

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

regiones3 :: Integer -> Integer
regiones3 n = 1 + sumas `genericIndex` n

-- (sumas n) es la suma 0 + 1 + 2 +...+ n. Por ejemplo,
--    take 10 sumas  ==  [0,1,3,6,10,15,21,28,36,45]
sumas :: [Integer]
sumas = scanl1 (+) [0..]

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

regiones4 :: Integer -> Integer
regiones4 n = 1 + n*(n+1) `div` 2

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

-- La propiedad es
prop_regiones :: Positive Integer -> Bool
prop_regiones (Positive n) =
  all (== regiones1 n)
      [regiones2 n,
       regiones3 n,
       regiones4 n]

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

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

-- La comparación es
--    λ> regiones1 (4*10^6)
--    8000002000001
--    (2.20 secs, 938,105,888 bytes)
--    λ> regiones2 (4*10^6)
--    8000002000001
--    (0.77 secs, 645,391,624 bytes)
--    λ> regiones3 (4*10^6)
--    8000002000001
--    (1.22 secs, 1,381,375,296 bytes)
--    λ> regiones4 (4*10^6)
--    8000002000001
--    (0.01 secs, 484,552 bytes)

import Data.List (genericIndex)

import Test.QuickCheck

-- 1ª solución

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

regiones1 :: Integer -> Integer

regiones1 0 = 1

regiones1 n = regiones1 (n-1) + n

-- 2ª solución

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

regiones2 :: Integer -> Integer

regiones2 n = 1 + sum [0..n]

-- 3ª solución

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

regiones3 :: Integer -> Integer

regiones3 n = 1 + sumas `genericIndex` n

-- (sumas n) es la suma 0 + 1 + 2 +...+ n. Por ejemplo,

-- take 10 sumas == [0,1,3,6,10,15,21,28,36,45]

sumas :: [Integer]

sumas = scanl1 (+) [0..]

-- 4ª solución

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

regiones4 :: Integer -> Integer

regiones4 n = 1 + n*(n+1) `div` 2

-- Comprobación de equivalencia

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

-- La propiedad es

prop_regiones :: Positive Integer -> Bool

prop_regiones (Positive n) =

all (== regiones1 n)

[regiones2 n,

regiones3 n,

regiones4 n]

-- La comprobación es

-- λ> quickCheck prop_regiones

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> regiones1 (4*10^6)

-- 8000002000001

-- (2.20 secs, 938,105,888 bytes)

-- λ> regiones2 (4*10^6)

-- 8000002000001

-- (0.77 secs, 645,391,624 bytes)

-- λ> regiones3 (4*10^6)

-- 8000002000001

-- (1.22 secs, 1,381,375,296 bytes)

-- λ> regiones4 (4*10^6)

-- 8000002000001

-- (0.01 secs, 484,552 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>

Ordenación de estructuras

PorJosé A. Alonso 18-marzo-202225-marzo-2022

Las notas de los dos primeros exámenes se pueden representar mediante el siguiente tipo de dato

   data Notas = Notas String Int Int
     deriving (Read, Show, Eq)

1 2	data Notas = Notas String Int Int deriving (Read, Show, Eq)

Por ejemplo, (Notas «Juan» 6 5) representa las notas de un alumno cuyo nombre es Juan, la nota del primer examen es 6 y la del segundo es 5.

Definir la función

   ordenadas :: [Notas] -> [Notas]

1	ordenadas :: [Notas] -> [Notas]

tal que (ordenadas ns) es la lista de las notas ns ordenadas considerando primero la nota del examen 2, a continuación la del examen 1 y finalmente el nombre. Por ejemplo,

   λ> ordenadas [Notas "Juan" 6 5, Notas "Luis" 3 7]
   [Notas "Juan" 6 5,Notas "Luis" 3 7]
   λ> ordenadas [Notas "Juan" 6 5, Notas "Luis" 3 4]
   [Notas "Luis" 3 4,Notas "Juan" 6 5]
   λ> ordenadas [Notas "Juan" 6 5, Notas "Luis" 7 4]
   [Notas "Luis" 7 4,Notas "Juan" 6 5]
   λ> ordenadas [Notas "Juan" 6 4, Notas "Luis" 7 4]
   [Notas "Juan" 6 4,Notas "Luis" 7 4]
   λ> ordenadas [Notas "Juan" 6 4, Notas "Luis" 5 4]
   [Notas "Luis" 5 4,Notas "Juan" 6 4]
   λ> ordenadas [Notas "Juan" 5 4, Notas "Luis" 5 4]
   [Notas "Juan" 5 4,Notas "Luis" 5 4]
   λ> ordenadas [Notas "Juan" 5 4, Notas "Eva" 5 4]
   [Notas "Eva" 5 4,Notas "Juan" 5 4]

λ> ordenadas [Notas "Juan" 6 5, Notas "Luis" 3 7]

[Notas "Juan" 6 5,Notas "Luis" 3 7]

λ> ordenadas [Notas "Juan" 6 5, Notas "Luis" 3 4]

[Notas "Luis" 3 4,Notas "Juan" 6 5]

λ> ordenadas [Notas "Juan" 6 5, Notas "Luis" 7 4]

[Notas "Luis" 7 4,Notas "Juan" 6 5]

λ> ordenadas [Notas "Juan" 6 4, Notas "Luis" 7 4]

[Notas "Juan" 6 4,Notas "Luis" 7 4]

λ> ordenadas [Notas "Juan" 6 4, Notas "Luis" 5 4]

[Notas "Luis" 5 4,Notas "Juan" 6 4]

λ> ordenadas [Notas "Juan" 5 4, Notas "Luis" 5 4]

[Notas "Juan" 5 4,Notas "Luis" 5 4]

λ> ordenadas [Notas "Juan" 5 4, Notas "Eva" 5 4]

[Notas "Eva" 5 4,Notas "Juan" 5 4]

Soluciones

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

data Notas = Notas String Int Int
  deriving (Read, Show, Eq)

-- 1ª solución
ordenadas1 :: [Notas] -> [Notas]
ordenadas1 ns =
  [Notas n x y | (y,x,n) <- sort [(y1,x1,n1) | (Notas n1 x1 y1) <- ns]]

-- 2ª solución
ordenadas2 :: [Notas] -> [Notas]
ordenadas2 ns =
  map (\(y,x,n) -> Notas n x y) (sort [(y1,x1,n1) | (Notas n1 x1 y1) <- ns])

-- 3ª solución
ordenadas3 :: [Notas] -> [Notas]
ordenadas3 ns = sortBy (\(Notas n1 x1 y1) (Notas n2 x2 y2) ->
                          compare (y1,x1,n1) (y2,x2,n2))
                       ns

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

instance Ord Notas where
  Notas n1 x1 y1 <= Notas n2 x2 y2 = (y1,x1,n1) <= (y2,x2,n2)

ordenadas4 :: [Notas] -> [Notas]
ordenadas4 = sort

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

-- notasArbitraria es un generador aleatorio de notas. Por ejemplo,
--    λ> sample notasArbitraria
--    Notas "achjkqruvxy" 3 3
--    Notas "abfgikmptuvy" 10 10
--    Notas "degjmptvwx" 7 9
--    Notas "cdefghjmnoqrsuw" 0 9
--    Notas "bcdfikmstuxz" 1 8
--    Notas "abcdhkopqsvwx" 10 7
--    Notas "abghiklnoqstvwx" 0 0
--    Notas "abfghklmnoptuvx" 4 9
--    Notas "bdehjkmpqsxyz" 0 4
--    Notas "afghijmopsvwz" 3 7
--    Notas "bdefghjklnoqx" 2 3
notasArbitraria :: Gen Notas
notasArbitraria = do
  n <- sublistOf ['a'..'z']
  x <- chooseInt (0, 10)
  y <- chooseInt (0, 10)
  return (Notas n x y)

-- Notas es una subclase de Arbitrary
instance Arbitrary Notas where
  arbitrary = notasArbitraria

-- La propiedad es
prop_ordenadas :: [Notas] -> Bool
prop_ordenadas ns =
  all (== ordenadas1 ns)
      [f ns | f <- [ordenadas2,
                    ordenadas3,
                    ordenadas4]]

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

import Data.List (sort, sortBy)

import Test.QuickCheck

data Notas = Notas String Int Int

deriving (Read, Show, Eq)

-- 1ª solución

ordenadas1 :: [Notas] -> [Notas]

ordenadas1 ns =

[Notas n x y | (y,x,n) <- sort [(y1,x1,n1) | (Notas n1 x1 y1) <- ns]]

-- 2ª solución

ordenadas2 :: [Notas] -> [Notas]

ordenadas2 ns =

map (\(y,x,n) -> Notas n x y) (sort [(y1,x1,n1) | (Notas n1 x1 y1) <- ns])

-- 3ª solución

ordenadas3 :: [Notas] -> [Notas]

ordenadas3 ns = sortBy (\(Notas n1 x1 y1) (Notas n2 x2 y2) ->

compare (y1,x1,n1) (y2,x2,n2))

-- 4ª solución

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

instance Ord Notas where

Notas n1 x1 y1 <= Notas n2 x2 y2 = (y1,x1,n1) <= (y2,x2,n2)

ordenadas4 :: [Notas] -> [Notas]

ordenadas4 = sort

-- Comprobación de equivalencia

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

-- notasArbitraria es un generador aleatorio de notas. Por ejemplo,

-- λ> sample notasArbitraria

-- Notas "achjkqruvxy" 3 3

-- Notas "abfgikmptuvy" 10 10

-- Notas "degjmptvwx" 7 9

-- Notas "cdefghjmnoqrsuw" 0 9

-- Notas "bcdfikmstuxz" 1 8

-- Notas "abcdhkopqsvwx" 10 7

-- Notas "abghiklnoqstvwx" 0 0

-- Notas "abfghklmnoptuvx" 4 9

-- Notas "bdehjkmpqsxyz" 0 4

-- Notas "afghijmopsvwz" 3 7

-- Notas "bdefghjklnoqx" 2 3

notasArbitraria :: Gen Notas

notasArbitraria = do

n <- sublistOf ['a'..'z']

x <- chooseInt (0, 10)

y <- chooseInt (0, 10)

return (Notas n x y)

-- Notas es una subclase de Arbitrary

instance Arbitrary Notas where

arbitrary = notasArbitraria

-- La propiedad es

prop_ordenadas :: [Notas] -> Bool

prop_ordenadas ns =

all (== ordenadas1 ns)

[f ns | f <- [ordenadas2,

ordenadas3,

ordenadas4]]

-- La comprobación es

-- λ> quickCheck prop_ordenadas

-- +++ OK, passed 100 tests.

El código se encuentra en GitHub.

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

Diferencia simétrica

Soluciones

Nuevas soluciones

Número de pares de elementos adyacentes iguales en una matriz

Soluciones

Nuevas soluciones

Elemento más repetido de manera consecutiva

Soluciones

Nuevas soluciones

Regiones determinadas por n rectas del plano

Soluciones

Nuevas soluciones

Ordenación de estructuras

Soluciones

Entradas recientes

Buscar

Correo electrónico