Menu Close

Elementos que respetan la ordenación

Se dice que un elemento x de una lista xs respeta la ordenación si x es mayor o igual que todos lo que tiene delante en xs y es menor o igual que todos lo que tiene detrás en xs. Por ejemplo, en la lista lista [3,2,1,4,6,5,7,9,8] el número 4 respeta la ordenación pero el número 5 no la respeta (porque es mayor que el 6 que está delante).

Definir la función

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

tal que (respetuosos xs) es la lista de los elementos de xs que respetan la ordenación. Por ejemplo,

   respetuosos [3,2,1,4,6,4,7,9,8]  ==  [4,7]
   respetuosos [2,1,3,4,6,4,7,8,9]  ==  [3,4,7,8,9]
   respetuosos "abaco"              ==  "aco"
   respetuosos "amor"               ==  "amor"
   respetuosos "romanos"            ==  "s"
   respetuosos [1..9]               ==  [1,2,3,4,5,6,7,8,9]
   respetuosos [9,8..1]             ==  []

Comprobar con QuickCheck que para cualquier lista de enteros xs se verifican las siguientes propiedades:

  • todos los elementos de (sort xs) respetan la ordenación y
  • en la lista (nub (reverse (sort xs))) hay como máximo un elemento que respeta la ordenación.

Soluciones

import Data.List (inits, nub, sort, tails)
import Test.QuickCheck
 
-- 1ª definición (por comprensión):
respetuosos :: Ord a => [a] -> [a]
respetuosos xs =
  [z | k <- [0..n-1]
     , let (ys,z:zs) = splitAt k xs
     , all (<=z) ys
     , all (>=z) zs]
  where n = length xs
 
-- 2ª definición (por recursión):
respetuosos2 :: Ord a => [a] -> [a]
respetuosos2 xs = aux [] [] xs
  where aux zs _  []      = reverse zs
        aux zs ys (x:xs)
          | all (<=x) ys && all (>=x) xs = aux (x:zs) (x:ys) xs
          | otherwise                    = aux zs     (x:ys) xs
 
-- 3ª definición
respetuosos3 :: Ord a => [a] -> [a]
respetuosos3 xs = [ x | (ys,x,zs) <- zip3 (inits xs) xs (tails xs)
                      , all (<=x) ys
                      , all (x<=) zs ]
 
-- 4ª solución
respetuosos4 :: Ord a =>[a] ->[a]
respetuosos4 xs =
  [x | (a, x, b) <- zip3 (scanl1 max xs) xs (scanr1 min xs)
     , a <= x && x <= b]
 
-- Comparación de eficiencia
--    λ> length (respetuosos [1..3000])
--    3000
--    (3.31 secs, 1,140,407,224 bytes)
--    λ> length (respetuosos2 [1..3000])
--    3000
--    (2.85 secs, 587,082,160 bytes)
--    λ> length (respetuosos3 [1..3000])
--    3000
--    (2.12 secs, 785,446,880 bytes)
--    λ> length (respetuosos4 [1..3000])
--    3000
--    (0.02 secs, 0 bytes)
 
-- 1ª propiedad
prop_respetuosos1 :: [Int] -> Bool
prop_respetuosos1 xs =
  respetuosos (sort xs) == sort xs
 
-- La comprobación es
--    λ> quickCheck prop_respetuosos1
--    +++ OK, passed 100 tests.
 
-- La 2ª propiedad
prop_respetuosos2 :: [Int] -> Bool
prop_respetuosos2 xs =
  length (respetuosos (nub (reverse (sort xs)))) <= 1
 
-- La comprobación es
--    λ> quickCheck prop_respetuosos2
--    +++ OK, passed 100 tests.

5 soluciones de “Elementos que respetan la ordenación

  1. Chema Cortés
    import Data.List
    import Test.QuickCheck
     
    respetuosos :: Ord a => [a] -> [a]
    respetuosos xs = [ x | (x,ys,zs) <- zip3 xs (inits xs) (tails xs)
                         , all (<=x) ys
                         , all (>=x) zs ]
     
    prop_respetuosos1 :: [Int] -> Bool
    prop_respetuosos1 xs = respetuosos ys == ys
      where ys = sort xs
     
    prop_respetuosos2 :: [Int] -> Bool
    prop_respetuosos2 xs = length (respetuosos ys) <= 1
      where ys = nub (reverse (sort xs))
  2. josejuan
    {-
      Se pide devolver aquellos elementos que cumplan que:
     
        - los elementos a su izq son menores o iguales
        - los elementos a su der son mayores o iguales
     
      Ésto es lo mismo que decir que cualquier elemento debe
      estar acotado (comprendido) entre la función máximo
      acumulado por la izquierda y la función mínimo acumulado
      por la derecha (ambas monótonas).
     
      Quizás se ve mejor si consideramos los cuatro cuadrantes
      centrados en él y hacemos mover la gráfica a izq o der:
     
                           :        #########
                           :   #####
                           : ##
        ··················#X···················
                       ### :
                #######    :
        __######___________:___________________
     
      Así, podemos obtener los respetuosos con coste lineal.
    -}
    respetuosos :: Ord a =>[a] ->[a]
    respetuosos xs = [x | (a, x, b) <-zip3 (scanl1 max xs) xs (scanr1 min xs), a <= x && x <= b]
     
    {-
      Que todos los elementos de `sort` son respetuosos parece obvio.
     
      Que en `nub . reverse . sort` hay a lo sumo uno se ve fácilmente
      con la gráfica anterior pues, siempre que en la lista resultante haya
      más de un elemento no habrá respetuosos al caer todos ellos en el 2º y
      4º cuadrantes.
     
      Así, una propiedad más fuerte podrían ser que `(nub . reverse . sort) xs`
      tendrá un respetuoso sii `(length . nub) xs == 1` y 0 en otro caso.
    -}
    prop_reverse_sort xs = (not . null) xs ==>
      case ((length . nub) xs, (length . respetuosos . nub . reverse . sort) xs) of
        (1, 1) ->True
        (_, 0) ->True
        _      ->False
    • josejuan

      De hecho, dado que en una posición sólo hay un único elemento, cuando se cumple la condición el mínimo y el máximo coinciden luego puede simplificarse (aunque apenas hay optimización) a:

      respetuosos xs = [a | (a, b) <-zip (scanl1 max xs) (scanr1 min xs), a == b]
  3. albcercid

    respetuosos :: Ord a => [a] -> [a]
    respetuosos xs = reverse $ aux [] [] xs
      where aux v y [] = v
            aux v y (x:xs) | ny y && nx xs           = aux (x:v) (x:y) xs
                           | ny y && mx xs >= x      = aux (x:v) (x:y) xs
                           | ny y                    = aux v (x:y) xs
                           | nx xs &&  x >= my y     = aux (x:v) (x:y) xs
                           | nx xs                   = aux v (x:y) xs
                           | x >= my y && mx xs >= x = aux (x:v) (x:y) xs    
                           | otherwise               = aux v (x:y) xs
            ny y  = null y
            nx xs = null xs
            mx xs = minimum xs
            my y  = maximum y
    
    prop_respetuosos :: Ord a => [a] -> Bool
    prop_respetuosos xs = sort xs == respetuosos (sort xs)
    
    --    λ> quickCheck prop_respetuosos
    --    +++ OK, passed 100 tests.
    
    prop_respetuosos2 :: Ord a => [a] -> Bool
    prop_respetuosos2 xs = 1 >= length (nub (reverse (sort xs)))
    
    --    quickCheck prop_respetuosos2
    --    +++ OK, passed 100 tests.
    

  4. enrnarbej
    respetuosos :: Ord a => [a] -> [a]
    respetuosos ns = reverse $ aux (reverse ns)
      where
        aux [] = []
        aux (x:xs) | x == maxi = x : aux xs
                   | otherwise = aux $ tail $ dropWhile (/= maximum xs) xs
          where maxi = maximum (x:xs)
     
    prop_resp1 :: Ord a => [a] -> Bool
    prop_resp1 xs = respetuosos (sort xs) == xs
     
    -- *Main> quickCheck prop_resp1
    -- +++ OK, passed 100 tests.
     
    prop_resp2 :: Ord a => [a] -> Bool
    prop_resp2 xs = length (respetuosos (nub (reverse (sort xs)))) <= 1
     
    -- *Main> quickCheck prop_resp2
    -- +++ OK, passed 100 tests.

Escribe tu solución

Este sitio usa Akismet para reducir el spam. Aprende cómo se procesan los datos de tus comentarios.