Caminos reducidos

PorJosé A. Alonso 12-abril-201625-abril-2021

Un camino es una sucesión de pasos en una de las cuatros direcciones Norte, Sur, Este, Oeste. Ir en una dirección y a continuación en la opuesta es un esfuerzo que se puede reducir, Por ejemplo, el camino [Norte,Sur,Este,Sur] se puede reducir a [Este,Sur].

Un camino se dice que es reducido si no tiene dos pasos consecutivos en direcciones opuesta. Por ejemplo, [Este,Sur] es reducido y [Norte,Sur,Este,Sur] no lo es.

En Haskell, las direcciones y los caminos se pueden definir por

   data Direccion = N | S | E | O deriving (Show, Eq)
   type Camino = [Direccion]

1 2	data Direccion = N \| S \| E \| O deriving (Show, Eq) type Camino = [Direccion]

Definir la función

   reducido :: Camino -> Camino

1	reducido :: Camino -> Camino

tal que (reducido ds) es el camino reducido equivalente al camino ds. Por ejemplo,

   reducido []                              ==  []
   reducido [N]                             ==  [N]
   reducido [N,O]                           ==  [N,O]
   reducido [N,O,E]                         ==  [N]
   reducido [N,O,E,S]                       ==  [] 
   reducido [N,O,S,E]                       ==  [N,O,S,E]
   reducido [S,S,S,N,N,N]                   ==  []
   reducido [N,S,S,E,O,N]                   ==  []
   reducido [N,S,S,E,O,N,O]                 ==  [O]
   reducido (take (10^7) (cycle [N,E,O,S])) ==  []

reducido [] == []

reducido [N] == [N]

reducido [N,O] == [N,O]

reducido [N,O,E] == [N]

reducido [N,O,E,S] == []

reducido [N,O,S,E] == [N,O,S,E]

reducido [S,S,S,N,N,N] == []

reducido [N,S,S,E,O,N] == []

reducido [N,S,S,E,O,N,O] == [O]

reducido (take (10^7) (cycle [N,E,O,S])) == []

Nótese que en el penúltimo ejemplo las reducciones son

       [N,S,S,E,O,N,O]  
   --> [S,E,O,N,O]  
   --> [S,N,O]  
   --> [O]

[N,S,S,E,O,N,O]

--> [S,E,O,N,O]

--> [S,N,O]

--> [O]

Soluciones

data Direccion = N | S | E | O deriving (Show, Eq)

type Camino = [Direccion]

-- 1ª solución (por recursión):
reducido1 :: Camino -> Camino
reducido1 [] = []
reducido1 (d:ds) | null ds'                = [d]
                 | d == opuesta (head ds') = tail ds'
                 | otherwise               = d:ds'
    where ds' = reducido1 ds

opuesta :: Direccion -> Direccion
opuesta N = S
opuesta S = N
opuesta E = O
opuesta O = E

-- 2ª solución (por plegado)
reducido2 :: Camino -> Camino
reducido2 = foldr aux []
    where aux N (S:xs) = xs
          aux S (N:xs) = xs
          aux E (O:xs) = xs
          aux O (E:xs) = xs
          aux x xs     = x:xs

-- 3ª solución 
reducido3 :: Camino -> Camino
reducido3 []       = []
reducido3 (N:S:ds) = reducido3 ds
reducido3 (S:N:ds) = reducido3 ds
reducido3 (E:O:ds) = reducido3 ds
reducido3 (O:E:ds) = reducido3 ds
reducido3 (d:ds) | null ds'                = [d]
                 | d == opuesta (head ds') = tail ds'
                 | otherwise               = d:ds'
    where ds' = reducido3 ds

-- 4ª solución
reducido4 :: Camino -> Camino
reducido4 ds = reverse (aux ([],ds)) where 
    aux (N:xs, S:ys) = aux (xs,ys)
    aux (S:xs, N:ys) = aux (xs,ys)
    aux (E:xs, O:ys) = aux (xs,ys)
    aux (O:xs, E:ys) = aux (xs,ys)
    aux (  xs, y:ys) = aux (y:xs,ys)
    aux (  xs,   []) = xs

-- Comparación de eficiencia
--    ghci> reducido1 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (3.87 secs, 460160736 bytes)
--    ghci> reducido2 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (1.16 secs, 216582880 bytes)
--    ghci> reducido3 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (0.58 secs, 98561872 bytes)
--    ghci> reducido4 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (0.64 secs, 176154640 bytes)
--    
--    ghci> reducido3 (take (10^7) (cycle [N,E,O,S]))
--    []
--    (5.43 secs, 962694784 bytes)
--    ghci> reducido4 (take (10^7) (cycle [N,E,O,S]))
--    []
--    (9.29 secs, 1722601528 bytes)
-- 
--    ghci> length $ reducido3 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S])
--    400002
--    (4.52 secs, 547004960 bytes)
--    ghci> length $ reducido4 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S])
--    400002
--    (2.17 secs, 379049224 bytes)

data Direccion = N | S | E | O deriving (Show, Eq)

type Camino = [Direccion]

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

reducido1 :: Camino -> Camino

reducido1 [] = []

reducido1 (d:ds) | null ds' = [d]

| d == opuesta (head ds') = tail ds'

| otherwise = d:ds'

where ds' = reducido1 ds

opuesta :: Direccion -> Direccion

opuesta N = S

opuesta S = N

opuesta E = O

opuesta O = E

-- 2ª solución (por plegado)

reducido2 :: Camino -> Camino

reducido2 = foldr aux []

where aux N (S:xs) = xs

aux S (N:xs) = xs

aux E (O:xs) = xs

aux O (E:xs) = xs

aux x xs = x:xs

-- 3ª solución

reducido3 :: Camino -> Camino

reducido3 [] = []

reducido3 (N:S:ds) = reducido3 ds

reducido3 (S:N:ds) = reducido3 ds

reducido3 (E:O:ds) = reducido3 ds

reducido3 (O:E:ds) = reducido3 ds

reducido3 (d:ds) | null ds' = [d]

| d == opuesta (head ds') = tail ds'

| otherwise = d:ds'

where ds' = reducido3 ds

-- 4ª solución

reducido4 :: Camino -> Camino

reducido4 ds = reverse (aux ([],ds)) where

aux (N:xs, S:ys) = aux (xs,ys)

aux (S:xs, N:ys) = aux (xs,ys)

aux (E:xs, O:ys) = aux (xs,ys)

aux (O:xs, E:ys) = aux (xs,ys)

aux ( xs, y:ys) = aux (y:xs,ys)

aux ( xs, []) = xs

-- Comparación de eficiencia

-- ghci> reducido1 (take (10^6) (cycle [N,E,O,S]))

-- []

-- (3.87 secs, 460160736 bytes)

-- ghci> reducido2 (take (10^6) (cycle [N,E,O,S]))

-- []

-- (1.16 secs, 216582880 bytes)

-- ghci> reducido3 (take (10^6) (cycle [N,E,O,S]))

-- []

-- (0.58 secs, 98561872 bytes)

-- ghci> reducido4 (take (10^6) (cycle [N,E,O,S]))

-- []

-- (0.64 secs, 176154640 bytes)

-- ghci> reducido3 (take (10^7) (cycle [N,E,O,S]))

-- []

-- (5.43 secs, 962694784 bytes)

-- ghci> reducido4 (take (10^7) (cycle [N,E,O,S]))

-- []

-- (9.29 secs, 1722601528 bytes)

-- ghci> length $ reducido3 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S])

-- 400002

-- (4.52 secs, 547004960 bytes)

-- ghci> length $ reducido4 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S])

-- 400002

-- (2.17 secs, 379049224 bytes)

10 Comentarios

data Direccion = N | S | E | O deriving (Show, Eq)
type Camino = [Direccion]

reducido :: Camino -> Camino
reducido xs = if length xs == length rxs then xs else reducido rxs
   where rxs = reduce xs

reduce :: Camino -> Camino
reduce (N:S:xs) = reduce xs
reduce (S:N:xs) = reduce xs
reduce (E:O:xs) = reduce xs
reduce (O:E:xs) = reduce xs
reduce (x:xs) = x : reduce xs
reduce [] = []

data Direccion = N | S | E | O deriving (Show, Eq)

type Camino = [Direccion]

reducido :: Camino -> Camino

reducido xs = if length xs == length rxs then xs else reducido rxs

where rxs = reduce xs

reduce :: Camino -> Camino

reduce (N:S:xs) = reduce xs

reduce (S:N:xs) = reduce xs

reduce (E:O:xs) = reduce xs

reduce (O:E:xs) = reduce xs

reduce (x:xs) = x : reduce xs

reduce [] = []

Responder

Si vamos al Norte, luego al Oeste, luego al Sur y luego al Este volvemos al mismo punto, NOSE, digo yo xD

-- Dada una posición la incrementa en la dirección indicada
(.+) ∷ (ℤ, ℤ) → Direccion → (ℤ, ℤ)
(x, y) .+ N = (x, y - 1)
(x, y) .+ S = (x, y + 1)
(x, y) .+ E = (x + 1, y)
(x, y) .+ O = (x - 1, y)

lazo ∷ (ℤ, ℤ) → Camino → Maybe Camino
lazo c (d:ds) = case c .+ d of        -- Si sumando deltas ...
                  (0, 0) → Just ds       -- ... volvemos al orígen, el camino es el resto.
                  c'     → lazo c' ds
lazo _ [] = Nothing

reducido ∷ Camino → Camino
reducido [] = []
reducido dss@(d:ds) = case lazo (0, 0) dss of
                        Nothing  → d: reducido ds  -- Si no hay lazo, vamos por ahí
                        Just ds' →    reducido ds' -- Si sí hay lazo, vamos por el alternativo

-- Dada una posición la incrementa en la dirección indicada

(.+) ∷ (ℤ, ℤ) → Direccion → (ℤ, ℤ)

(x, y) .+ N = (x, y - 1)

(x, y) .+ S = (x, y + 1)

(x, y) .+ E = (x + 1, y)

(x, y) .+ O = (x - 1, y)

lazo ∷ (ℤ, ℤ) → Camino → Maybe Camino

lazo c (d:ds) = case c .+ d of -- Si sumando deltas ...

(0, 0) → Just ds -- ... volvemos al orígen, el camino es el resto.

c' → lazo c' ds

lazo _ [] = Nothing

reducido ∷ Camino → Camino

reducido [] = []

reducido dss@(d:ds) = case lazo (0, 0) dss of

Nothing → d: reducido ds -- Si no hay lazo, vamos por ahí

Just ds' → reducido ds' -- Si sí hay lazo, vamos por el alternativo

Responder

El anterior tiene, en el peor caso, coste O(n^2), puede hacerse con coste lineal O(n) si se usa array o hash (aquí O(n log n) por usar Data.Map).

import Data.Map ((!))
import qualified Data.Map as M

reducido' ∷ Camino → Camino
reducido' = desenrolla (0, 0) ∘ enrolla

enrolla ∷ Camino → M.Map (ℤ, ℤ) Camino
enrolla = M.fromListWith const ∘ f (0, 0)
          where f c []         = [(c, [])]
                f c dss@(d:ds) = (c, dss): f (c .+ d) ds

desenrolla ∷ (ℤ, ℤ) → M.Map (ℤ, ℤ) Camino → Camino
desenrolla c m = case m ! c of
                   []    → []
                   (d:_) → d: desenrolla (c .+ d) m

{-

> length $ reducido $ replicate 4000 N
4000
(16.59 secs, 2,751,905,832 bytes)
> length $ reducido' $ replicate 4000 N
4000
(0.04 secs, 17,731,360 bytes)
>

-}

import Data.Map ((!))

import qualified Data.Map as M

reducido' ∷ Camino → Camino

reducido' = desenrolla (0, 0) ∘ enrolla

enrolla ∷ Camino → M.Map (ℤ, ℤ) Camino

enrolla = M.fromListWith const ∘ f (0, 0)

where f c [] = [(c, [])]

f c dss@(d:ds) = (c, dss): f (c .+ d) ds

desenrolla ∷ (ℤ, ℤ) → M.Map (ℤ, ℤ) Camino → Camino

desenrolla c m = case m ! c of

[] → []

(d:_) → d: desenrolla (c .+ d) m

> length $ reducido $ replicate 4000 N

4000

(16.59 secs, 2,751,905,832 bytes)

> length $ reducido' $ replicate 4000 N

4000

(0.04 secs, 17,731,360 bytes)

Responder

Vale, el enunciado no pide encontrar la subruta más corta (eliminar cualquier lazo), sólo «si no tiene dos pasos consecutivos en direcciones opuesta» :/

reducido ∷ Camino → Camino
reducido = reverse ∘ foldl' red []
  where red (y:ys) x = if [x,y] ∈ [[N,S],[S,N],[E,O],[O,E]] then ys else x: y: ys
        red  []    x = [x]

reducido ∷ Camino → Camino

reducido = reverse ∘ foldl' red []

where red (y:ys) x = if [x,y] ∈ [[N,S],[S,N],[E,O],[O,E]] then ys else x: y: ys

red [] x = [x]

Responder

Hay soluciones más rápida, pero esta ahorra un poco de duplicación

reducido :: Camino -> Camino
reducido [] = []
reducido (d:[]) = [d]
reducido ds@(d:e:dt) | opposites d e = reducido dt
                     | otherwise = reducido' $ d: reducido (e:dt)

reducido' :: Camino -> Camino
reducido' [] = []
reducido' (d:[]) = [d]
reducido' ds@(d:e:dt) | opposites d e = reducido' dt
                      | otherwise = d : reducido' (e:dt)

reducido :: Camino -> Camino

reducido [] = []

reducido (d:[]) = [d]

reducido ds@(d:e:dt) | opposites d e = reducido dt

| otherwise = reducido' $ d: reducido (e:dt)

reducido' :: Camino -> Camino

reducido' [] = []

reducido' (d:[]) = [d]

reducido' ds@(d:e:dt) | opposites d e = reducido' dt

| otherwise = d : reducido' (e:dt)

Responder

data Direccion = N | S | E | O deriving (Show, Eq)

type Camino = [Direccion]

aux :: Camino -> Camino
aux []       = []
aux [x]      = [x]
aux (O:y:xs) = if y == E then aux xs else O:aux (y:xs)
aux (E:y:xs) = if y == O then aux xs else E:aux (y:xs)
aux (N:y:xs) = if y == S then aux xs else N:aux (y:xs)
aux (S:y:xs) = if y == N then aux xs else S:aux (y:xs)

reducido :: Camino -> Camino
reducido xs | xs == aux xs = xs
            | otherwise = reducido (aux xs)

-- *Main> reducido (take (10^7) (cycle [N,E,O,S]))
-- []
-- (14.42 secs, 1,022,019,896 bytes)

data Direccion = N | S | E | O deriving (Show, Eq)

type Camino = [Direccion]

aux :: Camino -> Camino

aux [] = []

aux [x] = [x]

aux (O:y:xs) = if y == E then aux xs else O:aux (y:xs)

aux (E:y:xs) = if y == O then aux xs else E:aux (y:xs)

aux (N:y:xs) = if y == S then aux xs else N:aux (y:xs)

aux (S:y:xs) = if y == N then aux xs else S:aux (y:xs)

reducido :: Camino -> Camino

reducido xs | xs == aux xs = xs

| otherwise = reducido (aux xs)

-- *Main> reducido (take (10^7) (cycle [N,E,O,S]))

-- []

-- (14.42 secs, 1,022,019,896 bytes)

Responder

data Direccion = N | S | E | O deriving (Show, Eq)
type Camino = [Direccion]

reducido :: Camino -> Camino
reducido = foldr eliminaContrario []

eliminaContrario :: Direccion -> Camino -> Camino
eliminaContrario N (S:xs) = xs
eliminaContrario S (N:xs) = xs
eliminaContrario E (O:xs) = xs
eliminaContrario O (E:xs) = xs
eliminaContrario x  xs    = x:xs

data Direccion = N | S | E | O deriving (Show, Eq)

type Camino = [Direccion]

reducido :: Camino -> Camino

reducido = foldr eliminaContrario []

eliminaContrario :: Direccion -> Camino -> Camino

eliminaContrario N (S:xs) = xs

eliminaContrario S (N:xs) = xs

eliminaContrario E (O:xs) = xs

eliminaContrario O (E:xs) = xs

eliminaContrario x xs = x:xs

Responder

reducido :: Camino -> Camino
reducido [] = []     
reducido [x] = [x]
reducido a@(x:xs) 
        | irreducible a = a
        | elem ox xs && consecutivos x ox a 
                     = reducido $ elimina ox xs
        | otherwise = reducido $ x : reducido xs
        where ox = opuesto x

elimina :: Eq a => a -> [a] -> [a]
elimina _ [] = []
elimina y (x:xs) | y == x = xs
                 | otherwise = x:elimina y xs

consecutivos :: Eq a => a -> a -> [a] -> Bool
consecutivos _ _ [] = False
consecutivos _ _ [x] = False
consecutivos a b (x:y:xs) 
         | a == x = b == y || consecutivos a b xs
         | b == x = a == y || consecutivos a b xs
         | otherwise = consecutivos a b xs

irreducible :: Camino -> Bool
irreducible [] = True
irreducible a@(x:xs) = 
            sinOpuestoConsecutivo x a && irreducible xs

sinOpuestoConsecutivo :: Direccion -> Camino -> Bool
sinOpuestoConsecutivo _ [] = True
sinOpuestoConsecutivo _ [x] = True
sinOpuestoConsecutivo y (x:b@(z:xs)) 
       | y == x = oy /= z && sinOpuestoConsecutivo y xs
       | otherwise = sinOpuestoConsecutivo y b
       where oy = opuesto y
             
opuesto :: Direccion -> Direccion
opuesto N = S
opuesto S = N
opuesto E = O
opuesto O = E

reducido :: Camino -> Camino

reducido [] = []

reducido [x] = [x]

reducido a@(x:xs)

| irreducible a = a

| elem ox xs && consecutivos x ox a

= reducido $ elimina ox xs

| otherwise = reducido $ x : reducido xs

where ox = opuesto x

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

elimina _ [] = []

elimina y (x:xs) | y == x = xs

| otherwise = x:elimina y xs

consecutivos :: Eq a => a -> a -> [a] -> Bool

consecutivos _ _ [] = False

consecutivos _ _ [x] = False

consecutivos a b (x:y:xs)

| a == x = b == y || consecutivos a b xs

| b == x = a == y || consecutivos a b xs

| otherwise = consecutivos a b xs

irreducible :: Camino -> Bool

irreducible [] = True

irreducible a@(x:xs) =

sinOpuestoConsecutivo x a && irreducible xs

sinOpuestoConsecutivo :: Direccion -> Camino -> Bool

sinOpuestoConsecutivo _ [] = True

sinOpuestoConsecutivo _ [x] = True

sinOpuestoConsecutivo y (x:b@(z:xs))

| y == x = oy /= z && sinOpuestoConsecutivo y xs

| otherwise = sinOpuestoConsecutivo y b

where oy = opuesto y

opuesto :: Direccion -> Direccion

opuesto N = S

opuesto S = N

opuesto E = O

opuesto O = E

Responder

data Direccion = N | S | E | O deriving (Show, Eq)
type Camino = [Direccion]


reducido :: Camino -> Camino
reducido = until esReducido paso

opuestos:: (Direccion,Direccion) -> Bool
opuestos (N,S) = True
opuestos (S,N) = True
opuestos (E,O) = True
opuestos (O,E) = True
opuestos _     = False

paso:: Camino -> Camino
paso (x:y:ds) | opuestos (x,y) = paso ds
              | otherwise      = x:paso (y:ds)
paso ds = ds

esReducido:: Camino -> Bool
esReducido ds = all (not . opuestos) $ zip ds (tail ds)

data Direccion = N | S | E | O deriving (Show, Eq)

type Camino = [Direccion]

reducido :: Camino -> Camino

reducido = until esReducido paso

opuestos:: (Direccion,Direccion) -> Bool

opuestos (N,S) = True

opuestos (S,N) = True

opuestos (E,O) = True

opuestos (O,E) = True

opuestos _ = False

paso:: Camino -> Camino

paso (x:y:ds) | opuestos (x,y) = paso ds

| otherwise = x:paso (y:ds)

paso ds = ds

esReducido:: Camino -> Bool

esReducido ds = all (not . opuestos) $ zip ds (tail ds)

Responder

import Data.List

data Direccion = N | S | E | O deriving (Show, Eq)
type Camino = [Direccion]

enOposicion :: Direccion -> Direccion -> Bool
enOposicion N S = True
enOposicion S N = True
enOposicion E O = True
enOposicion O E = True
enOposicion _ _ = False

reducido :: Camino -> Camino
reducido = foldr aux []
    where aux x [] = [x]
          aux x (y:ys) | enOposicion x y = ys
                       | otherwise       = (x:y:ys)

import Data.List

data Direccion = N | S | E | O deriving (Show, Eq)

type Camino = [Direccion]

enOposicion :: Direccion -> Direccion -> Bool

enOposicion N S = True

enOposicion S N = True

enOposicion E O = True

enOposicion O E = True

enOposicion _ _ = False

reducido :: Camino -> Camino

reducido = foldr aux []

where aux x [] = [x]

aux x (y:ys) | enOposicion x y = ys

| otherwise = (x:y:ys)

Responder

Caminos reducidos

Soluciones

10 Comentarios

Escribe tu soluciónCancel reply

Entradas recientes

Buscar

Correo electrónico

Soluciones

Se puede imprimir o compartir con

10 Comentarios

Escribe tu soluciónCancel reply

Entradas recientes

Buscar

Correo electrónico