listArray

Puntos alcanzables en un mapa

PorJosé A. Alonso 8-junio-20187-julio-2018

Un mapa con dos tipos de regiones (por ejemplo, tierra y mar) se puede representar mediante una matriz de ceros y unos.

Para los ejemplos usaremos los mapas definidos por

   type Punto = (Int,Int) 
   type Mapa  = Array Punto Int
   
   mapa1, mapa2 :: Mapa
   mapa1 = listArray ((1,1),(3,4))
                     [1,1,0,0,
                      0,1,0,0,
                      1,0,0,0]
   mapa2 = listArray ((1,1),(10,20))
                     [1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
                      1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,
                      1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,
                      1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,
                      1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,
                      0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
                      0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
                      1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,
                      1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
                      1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1]

type Punto = (Int,Int)

type Mapa = Array Punto Int

mapa1, mapa2 :: Mapa

mapa1 = listArray ((1,1),(3,4))

[1,1,0,0,

0,1,0,0,

1,0,0,0]

mapa2 = listArray ((1,1),(10,20))

[1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,

1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,

1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,

0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,

1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1]

Definir las funciones

   alcanzables :: Mapa -> Punto -> [Punto]
   esAlcanzable :: Mapa -> Punto -> Punto -> Bool

1 2	alcanzables :: Mapa -> Punto -> [Punto] esAlcanzable :: Mapa -> Punto -> Punto -> Bool

tales que

(alcanzables p) es la lista de los puntos de mapa m que se pueden alcanzar a partir del punto p moviéndose en la misma región que p (es decir, a través de ceros si el elemento de m en p es un cero o a través de unos, en caso contrario) y los movimientos permitidos son ir hacia el norte, sur este u oeste (pero no en diagonal). Por ejemplo,

     alcanzables mapa1 (1,1)  ==  [(2,2),(1,2),(1,1)]
     alcanzables mapa1 (1,2)  ==  [(2,2),(1,1),(1,2)]
     alcanzables mapa1 (1,3)  ==  [(3,2),(3,4),(3,3),(2,3),(2,4),(1,4),(1,3)]
     alcanzables mapa1 (3,1)  ==  [(3,1)]

alcanzables mapa1 (1,1) == [(2,2),(1,2),(1,1)]

alcanzables mapa1 (1,2) == [(2,2),(1,1),(1,2)]

alcanzables mapa1 (1,3) == [(3,2),(3,4),(3,3),(2,3),(2,4),(1,4),(1,3)]

alcanzables mapa1 (3,1) == [(3,1)]

(esAlcanzable m p1 p2) se verifica si el punto p1 es alcanzable desde el p1 en el mapa m. Por ejemplo,

     esAlcanzable mapa1 (1,4) (3,2)    ==  True
     esAlcanzable mapa1 (1,4) (3,1)    ==  False
     esAlcanzable mapa2 (2,3) (8,16)   ==  True
     esAlcanzable mapa2 (8,1) (7,3)    ==  True
     esAlcanzable mapa2 (1,1) (10,20)  ==  False

esAlcanzable mapa1 (1,4) (3,2) == True

esAlcanzable mapa1 (1,4) (3,1) == False

esAlcanzable mapa2 (2,3) (8,16) == True

esAlcanzable mapa2 (8,1) (7,3) == True

esAlcanzable mapa2 (1,1) (10,20) == False

Nota: Este ejercicio está basado en el problema 10 kinds of people de Kattis.

Soluciones

import Data.Array

type Punto = (Int,Int) 
type Mapa  = Array Punto Int

mapa1, mapa2 :: Mapa
mapa1 = listArray ((1,1),(3,4))
                  [1,1,0,0,
                   0,1,0,0,
                   1,0,0,0]
mapa2 = listArray ((1,1),(10,20))
                  [1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
                   1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,
                   1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,
                   1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,
                   1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,
                   0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
                   0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
                   1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,
                   1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
                   1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1]

alcanzables :: Mapa -> Punto -> [Punto]
alcanzables mapa p = aux [p] []
  where region = mapa ! p
        (_,(m,n)) = bounds mapa
        vecinos (i,j) = [(a,b) | (a,b) <- [(i,j+1),(i,j-1),(i+1,j),(i-1,j)]
                               , 1 <= a && a <= m
                               , 1 <= b && b <= n  
                               , mapa ! (a,b) == region]
        aux [] ys = ys
        aux (x:xs) ys
          | x `elem` ys = aux xs ys
          | otherwise   = aux (vecinos x ++ xs) (x:ys)    

esAlcanzable :: Mapa -> Punto -> Punto -> Bool
esAlcanzable m p1 p2 =
  p2 `elem` alcanzables m p1

import Data.Array

type Punto = (Int,Int)

type Mapa = Array Punto Int

mapa1, mapa2 :: Mapa

mapa1 = listArray ((1,1),(3,4))

[1,1,0,0,

0,1,0,0,

1,0,0,0]

mapa2 = listArray ((1,1),(10,20))

[1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,

1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,

1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,

0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,

1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1]

alcanzables :: Mapa -> Punto -> [Punto]

alcanzables mapa p = aux [p] []

where region = mapa ! p

(_,(m,n)) = bounds mapa

vecinos (i,j) = [(a,b) | (a,b) <- [(i,j+1),(i,j-1),(i+1,j),(i-1,j)]

, 1 <= a && a <= m

, 1 <= b && b <= n

, mapa ! (a,b) == region]

aux [] ys = ys

aux (x:xs) ys

| x `elem` ys = aux xs ys

| otherwise = aux (vecinos x ++ xs) (x:ys)

esAlcanzable :: Mapa -> Punto -> Punto -> Bool

esAlcanzable m p1 p2 =

p2 `elem` alcanzables m p1

Subconjuntos con suma dada

PorJosé A. Alonso 25-abril-20182-mayo-2018

Sea S un conjunto finito de números enteros positivos y n un número natural. El problema consiste en calcular los subconjuntos de S cuya suma es n.

Definir la función

   subconjuntosSuma:: [Int] -> Int -> [[Int]] tal que

1	subconjuntosSuma:: [Int] -> Int -> [[Int]] tal que

tal que (subconjuntosSuma xs n) es la lista de los subconjuntos de xs cuya suma es n. Por ejemplo,

   λ> subconjuntosSuma [3,34,4,12,5,2] 9
   [[4,5],[3,4,2]]
   λ> subconjuntosSuma [3,34,4,12,5,2] 13
   []
   λ> length (subconjuntosSuma [1..100] (sum [1..100]))
   1

λ> subconjuntosSuma [3,34,4,12,5,2] 9

[[4,5],[3,4,2]]

λ> subconjuntosSuma [3,34,4,12,5,2] 13

[]

λ> length (subconjuntosSuma [1..100] (sum [1..100]))

Soluciones

import Data.Array
import qualified Data.Matrix as M
import Data.Maybe
import Data.List
import Test.QuickCheck

-- 1ª definición (Calculando todos los subconjuntos)
-- =================================================

subconjuntosSuma1 :: [Int] -> Int -> [[Int]]
subconjuntosSuma1 xs n =
  [ys | ys <- subsequences xs, sum ys == n]

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

subconjuntosSuma2 :: [Int] -> Int -> [[Int]]
subconjuntosSuma2 _  0 = [[]]
subconjuntosSuma2 [] _ = []
subconjuntosSuma2 (x:xs) n
  | n < x     = subconjuntosSuma2 xs n
  | otherwise = subconjuntosSuma2 xs n ++
                [x:ys | ys <- subconjuntosSuma2 xs (n-x)]

-- 3ª definición (por programación dinámica)
-- =========================================

subconjuntosSuma3 :: [Int] -> Int -> [[Int]]
subconjuntosSuma3 xs n =
  map reverse (matrizSubconjuntosSuma3 xs n ! (length xs,n))

-- (matrizSubconjuntosSuma3 xs m) es la matriz q tal que q(i,j) es la
-- lista de los subconjuntos de (take i xs) que suman j. Por ejemplo,
--    λ> elems (matrizSubconjuntosSuma3 [1,3,5] 9)
--    [[[]],[],   [],[],   [],     [],   [],     [],[],    [],
--     [[]],[[1]],[],[],   [],     [],   [],     [],[],    [],
--     [[]],[[1]],[],[[3]],[[3,1]],[],   [],     [],[],    [],
--     [[]],[[1]],[],[[3]],[[3,1]],[[5]],[[5,1]],[],[[5,3]],[[5,3,1]]]
-- Con las cabeceras,
--            0    1     2  3     4       5     6       7  8       9 
--    []     [[[]],[],   [],[],   [],     [],   [],     [],[],    [],
--    [1]     [[]],[[1]],[],[],   [],     [],   [],     [],[],    [],
--    [1,3]   [[]],[[1]],[],[[3]],[[3,1]],[],   [],     [],[],    [],
--    [1,3,5] [[]],[[1]],[],[[3]],[[3,1]],[[5]],[[5,1]],[],[[5,3]],[[5,3,1]]]
matrizSubconjuntosSuma3 :: [Int] -> Int -> Array (Int,Int) [[Int]]
matrizSubconjuntosSuma3 xs n = q
  where m = length xs
        v = listArray (1,m) xs
        q = array ((0,0),(m,n)) [((i,j), f i j) | i <- [0..m],
                                                  j <- [0..n]]
        f _ 0 = [[]]
        f 0 _ = []
        f i j | j < v ! i = q ! (i-1,j)
              | otherwise = q ! (i-1,j) ++
                            [v!i:ys | ys <- q ! (i-1,j-v!i)]

-- 4ª definición (ordenando y por recursión)
-- =========================================

subconjuntosSuma4 :: [Int] -> Int -> [[Int]]
subconjuntosSuma4 xs = aux (sort xs)
  where aux _  0 = [[]]
        aux [] _ = []
        aux (y:ys) n
          | y > n     = []
          | otherwise = aux ys n ++ [y:zs | zs <- aux ys (n-y)]

-- 5ª definición (ordenando y dinámica)
-- ====================================

subconjuntosSuma5 :: [Int] -> Int -> [[Int]]
subconjuntosSuma5 xs n =
  matrizSubconjuntosSuma5 (reverse (sort xs)) n ! (length xs,n)

matrizSubconjuntosSuma5 :: [Int] -> Int -> Array (Int,Int) [[Int]]
matrizSubconjuntosSuma5 xs n = q
  where m = length xs
        v = listArray (1,m) xs
        q = array ((0,0),(m,n)) [((i,j), f i j) | i <- [0..m],
                                                  j <- [0..n]]
        f _ 0 = [[]]
        f 0 _ = []
        f i j | v ! i > j = []
              | otherwise = q ! (i-1,j) ++
                            [v!i:ys | ys <- q ! (i-1,j-v!i)]

-- Equivalencia
-- ============

prop_subconjuntosSuma :: [Int] -> Int -> Bool
prop_subconjuntosSuma xs n =
  all (`igual` subconjuntosSuma2 ys m) [ subconjuntosSuma3 ys m
                                       , subconjuntosSuma4 ys m
                                       , subconjuntosSuma5 ys m ]
  where ys = map (\y -> 1 + abs y) xs 
        m  = abs n
        ordenado = sort . map sort
        igual xss yss = ordenado xss == ordenado yss

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

100

101

102

import Data.Array

import qualified Data.Matrix as M

import Data.Maybe

import Data.List

import Test.QuickCheck

-- 1ª definición (Calculando todos los subconjuntos)

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

subconjuntosSuma1 :: [Int] -> Int -> [[Int]]

subconjuntosSuma1 xs n =

[ys | ys <- subsequences xs, sum ys == n]

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

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

subconjuntosSuma2 :: [Int] -> Int -> [[Int]]

subconjuntosSuma2 _ 0 = [[]]

subconjuntosSuma2 [] _ = []

subconjuntosSuma2 (x:xs) n

| n < x = subconjuntosSuma2 xs n

| otherwise = subconjuntosSuma2 xs n ++

[x:ys | ys <- subconjuntosSuma2 xs (n-x)]

-- 3ª definición (por programación dinámica)

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

subconjuntosSuma3 :: [Int] -> Int -> [[Int]]

subconjuntosSuma3 xs n =

map reverse (matrizSubconjuntosSuma3 xs n ! (length xs,n))

-- (matrizSubconjuntosSuma3 xs m) es la matriz q tal que q(i,j) es la

-- lista de los subconjuntos de (take i xs) que suman j. Por ejemplo,

-- λ> elems (matrizSubconjuntosSuma3 [1,3,5] 9)

-- [[[]],[], [],[], [], [], [], [],[], [],

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

-- [[]],[[1]],[],[[3]],[[3,1]],[], [], [],[], [],

-- [[]],[[1]],[],[[3]],[[3,1]],[[5]],[[5,1]],[],[[5,3]],[[5,3,1]]]

-- Con las cabeceras,

-- 0 1 2 3 4 5 6 7 8 9

-- [] [[[]],[], [],[], [], [], [], [],[], [],

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

-- [1,3] [[]],[[1]],[],[[3]],[[3,1]],[], [], [],[], [],

-- [1,3,5] [[]],[[1]],[],[[3]],[[3,1]],[[5]],[[5,1]],[],[[5,3]],[[5,3,1]]]

matrizSubconjuntosSuma3 :: [Int] -> Int -> Array (Int,Int) [[Int]]

matrizSubconjuntosSuma3 xs n = q

where m = length xs

v = listArray (1,m) xs

q = array ((0,0),(m,n)) [((i,j), f i j) | i <- [0..m],

j <- [0..n]]

f _ 0 = [[]]

f 0 _ = []

f i j | j < v ! i = q ! (i-1,j)

| otherwise = q ! (i-1,j) ++

[v!i:ys | ys <- q ! (i-1,j-v!i)]

-- 4ª definición (ordenando y por recursión)

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

subconjuntosSuma4 :: [Int] -> Int -> [[Int]]

subconjuntosSuma4 xs = aux (sort xs)

where aux _ 0 = [[]]

aux [] _ = []

aux (y:ys) n

| y > n = []

| otherwise = aux ys n ++ [y:zs | zs <- aux ys (n-y)]

-- 5ª definición (ordenando y dinámica)

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

subconjuntosSuma5 :: [Int] -> Int -> [[Int]]

subconjuntosSuma5 xs n =

matrizSubconjuntosSuma5 (reverse (sort xs)) n ! (length xs,n)

matrizSubconjuntosSuma5 :: [Int] -> Int -> Array (Int,Int) [[Int]]

matrizSubconjuntosSuma5 xs n = q

where m = length xs

v = listArray (1,m) xs

q = array ((0,0),(m,n)) [((i,j), f i j) | i <- [0..m],

j <- [0..n]]

f _ 0 = [[]]

f 0 _ = []

f i j | v ! i > j = []

| otherwise = q ! (i-1,j) ++

[v!i:ys | ys <- q ! (i-1,j-v!i)]

-- Equivalencia

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

prop_subconjuntosSuma :: [Int] -> Int -> Bool

prop_subconjuntosSuma xs n =

all (`igual` subconjuntosSuma2 ys m) [ subconjuntosSuma3 ys m

, subconjuntosSuma4 ys m

, subconjuntosSuma5 ys m ]

where ys = map (\y -> 1 + abs y) xs

m = abs n

ordenado = sort . map sort

igual xss yss = ordenado xss == ordenado yss

-- La comprobación es

-- λ> quickCheck prop_subconjuntosSuma

-- +++ OK, passed 100 tests.

Decidir si existe un subconjunto con suma dada

PorJosé A. Alonso 16-abril-201826-abril-2018

Sea S un conjunto finito de números naturales y m un número natural. El problema consiste en determinar si existe un subconjunto de S cuya suma es m. Por ejemplo, si S = [3,34,4,12,5,2] y m = 9, existe un subconjunto de S, [4,5], cuya suma es 9. En cambio, no hay ningún subconjunto de S que sume 13.

Definir la función

    existeSubSuma :: [Int] -> Int -> Bool

1	existeSubSuma :: [Int] -> Int -> Bool

tal que (existeSubSuma xs m) se verifica si existe algún subconjunto de xs que sume m. Por ejemplo,

    existeSubSuma [3,34,4,12,5,2] 9                == True
    existeSubSuma [3,34,4,12,5,2] 13               == False
    existeSubSuma ([3,34,4,12,5,2]++[20..400]) 13  == False
    existeSubSuma ([3,34,4,12,5,2]++[20..400]) 654 == True
    existeSubSuma [1..200] (sum [1..200])          == True

existeSubSuma [3,34,4,12,5,2] 9 == True

existeSubSuma [3,34,4,12,5,2] 13 == False

existeSubSuma ([3,34,4,12,5,2]++[20..400]) 13 == False

existeSubSuma ([3,34,4,12,5,2]++[20..400]) 654 == True

existeSubSuma [1..200] (sum [1..200]) == True

Soluciones

import Data.List  (subsequences, sort)
import Data.Array (Array, array, listArray, (!))
 
-- 1ª definición (Calculando todos los subconjuntos)
-- =================================================
 
existeSubSuma1 :: [Int] -> Int -> Bool
existeSubSuma1 xs n =
  any (\ys -> sum ys == n) (subsequences xs)
 
-- 2ª definición (por recursión)
-- =============================
 
existeSubSuma2 :: [Int] -> Int -> Bool
existeSubSuma2 _  0 = True
existeSubSuma2 [] _ = False
existeSubSuma2 (x:xs) n
  | n < x     = existeSubSuma2 xs n
  | otherwise = existeSubSuma2 xs (n-x) || existeSubSuma2 xs n 
  
-- 3ª definición (por programación dinámica)
-- =========================================
 
existeSubSuma3 :: [Int] -> Int -> Bool
existeSubSuma3 xs n =
  matrizExisteSubSuma3 xs n ! (length xs,n) 
 
-- (matrizExisteSubSuma3 xs m) es la matriz q tal que q(i,j) se verifica
-- si existe algún subconjunto de (take i xs) que sume j. Por ejemplo,
--    λ> elems (matrizExisteSubSuma3 [1,3,5] 9)
--    [True,False,False,False,False,False,False,False,False,False,
--     True,True, False,False,False,False,False,False,False,False,
--     True,True, False,True, True, False,False,False,False,False,
--     True,True, False,True, True, True, True, False,True, True]
-- Con las cabeceras,
--            0     1     2     3     4     5     6     7     8     9
--    []     [True,False,False,False,False,False,False,False,False,False,
--    [1]     True,True, False,False,False,False,False,False,False,False,
--    [1,3]   True,True, False,True, True, False,False,False,False,False,
--    [1,3,5] True,True, False,True, True, True, True, False,True, True]
matrizExisteSubSuma3 :: [Int] -> Int -> Array (Int,Int) Bool
matrizExisteSubSuma3 xs n = q
  where m = length xs
        v = listArray (1,m) xs
        q = array ((0,0),(m,n)) [((i,j), f i j) | i <- [0..m],
                                                  j <- [0..n]]
        f _ 0 = True
        f 0 _ = False
        f i j | j < v ! i = q ! (i-1,j)
              | otherwise = q ! (i-1,j-v!i) || q ! (i-1,j)
 
-- 4ª definición (ordenando y por recursión)
-- =========================================
 
existeSubSuma4 :: [Int] -> Int -> Bool
existeSubSuma4 xs = aux (sort xs)
  where aux _  0 = True
        aux [] _ = False
        aux (y:ys) n
          | y <= n    = aux ys (n-y) || aux ys n
          | otherwise = False
 
-- 5ª definición (ordenando y dinámica)
-- ====================================
 
existeSubSuma5 :: [Int] -> Int -> Bool
existeSubSuma5 xs n =
  matrizExisteSubSuma5 (reverse (sort xs)) n ! (length xs,n) 
 
matrizExisteSubSuma5 :: [Int] -> Int -> Array (Int,Int) Bool
matrizExisteSubSuma5 xs n = q
  where m = length xs
        v = listArray (1,m) xs
        q = array ((0,0),(m,n)) [((i,j), f i j) | i <- [0..m],
                                                  j <- [0..n]]
        f _ 0 = True
        f 0 _ = False
        f i j | v ! i <= j = q ! (i-1,j-v!i) || q ! (i-1,j) 
              | otherwise  = False
 
-- Equivalencia
-- ============
 
prop_existeSubSuma :: [Int] -> Int -> Bool
prop_existeSubSuma xs n =
  all (== existeSubSuma2 ys m) [ existeSubSuma3 ys m
                               , existeSubSuma4 ys m
                               , existeSubSuma5 ys m ]
  where ys = map abs xs
        m  = abs n
 
-- La comprobación es
--    λ> quickCheck prop_existeSubSuma
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia:
-- ==========================

--    λ> let xs = [1..22] in existeSubSuma1 xs (sum xs)
--    True
--    (7.76 secs, 3,892,403,928 bytes)
--    λ> let xs = [1..22] in existeSubSuma2 xs (sum xs)
--    True
--    (0.02 secs, 95,968 bytes)
--    λ> let xs = [1..22] in existeSubSuma3 xs (sum xs)
--    True
--    (0.03 secs, 6,055,200 bytes)
--    λ> let xs = [1..22] in existeSubSuma4 xs (sum xs)
--    True
--    (0.01 secs, 98,880 bytes)
--    λ> let xs = [1..22] in existeSubSuma5 xs (sum xs)
--    True
--    (0.02 secs, 2,827,560 bytes)
  
--    λ> let xs = [1..200] in existeSubSuma2 xs (sum xs)
--    True
--    (0.01 secs, 182,280 bytes)
--    λ> let xs = [1..200] in existeSubSuma3 xs (sum xs)
--    True
--    (8.89 secs, 1,875,071,968 bytes)
--    λ> let xs = [1..200] in existeSubSuma4 xs (sum xs)
--    True
--    (0.02 secs, 217,128 bytes)
--    λ> let xs = [1..200] in existeSubSuma5 xs (sum xs)
--    True
--    (8.66 secs, 1,875,087,976 bytes)
--
--    λ> and [existeSubSuma2 [1..20] n | n <- [1..sum [1..20]]]
--    True
--    (2.82 secs, 323,372,512 bytes)
--    λ> and [existeSubSuma3 [1..20] n | n <- [1..sum [1..20]]]
--    True
--    (0.65 secs, 221,806,376 bytes)
--    λ> and [existeSubSuma4 [1..20] n | n <- [1..sum [1..20]]]
--    True
--    (4.12 secs, 535,153,152 bytes)
--    λ> and [existeSubSuma5 [1..20] n | n <- [1..sum [1..20]]]
--    True
--    (0.73 secs, 238,579,696 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

import Data.List (subsequences, sort)

import Data.Array (Array, array, listArray, (!))

-- 1ª definición (Calculando todos los subconjuntos)

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

existeSubSuma1 :: [Int] -> Int -> Bool

existeSubSuma1 xs n =

any (\ys -> sum ys == n) (subsequences xs)

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

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

existeSubSuma2 :: [Int] -> Int -> Bool

existeSubSuma2 _ 0 = True

existeSubSuma2 [] _ = False

existeSubSuma2 (x:xs) n

| n < x = existeSubSuma2 xs n

| otherwise = existeSubSuma2 xs (n-x) || existeSubSuma2 xs n

-- 3ª definición (por programación dinámica)

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

existeSubSuma3 :: [Int] -> Int -> Bool

existeSubSuma3 xs n =

matrizExisteSubSuma3 xs n ! (length xs,n)

-- (matrizExisteSubSuma3 xs m) es la matriz q tal que q(i,j) se verifica

-- si existe algún subconjunto de (take i xs) que sume j. Por ejemplo,

-- λ> elems (matrizExisteSubSuma3 [1,3,5] 9)

-- [True,False,False,False,False,False,False,False,False,False,

-- True,True, False,False,False,False,False,False,False,False,

-- True,True, False,True, True, False,False,False,False,False,

-- True,True, False,True, True, True, True, False,True, True]

-- Con las cabeceras,

-- 0 1 2 3 4 5 6 7 8 9

-- [] [True,False,False,False,False,False,False,False,False,False,

-- [1] True,True, False,False,False,False,False,False,False,False,

-- [1,3] True,True, False,True, True, False,False,False,False,False,

-- [1,3,5] True,True, False,True, True, True, True, False,True, True]

matrizExisteSubSuma3 :: [Int] -> Int -> Array (Int,Int) Bool

matrizExisteSubSuma3 xs n = q

where m = length xs

v = listArray (1,m) xs

q = array ((0,0),(m,n)) [((i,j), f i j) | i <- [0..m],

j <- [0..n]]

f _ 0 = True

f 0 _ = False

f i j | j < v ! i = q ! (i-1,j)

| otherwise = q ! (i-1,j-v!i) || q ! (i-1,j)

-- 4ª definición (ordenando y por recursión)

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

existeSubSuma4 :: [Int] -> Int -> Bool

existeSubSuma4 xs = aux (sort xs)

where aux _ 0 = True

aux [] _ = False

aux (y:ys) n

| y <= n = aux ys (n-y) || aux ys n

| otherwise = False

-- 5ª definición (ordenando y dinámica)

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

existeSubSuma5 :: [Int] -> Int -> Bool

existeSubSuma5 xs n =

matrizExisteSubSuma5 (reverse (sort xs)) n ! (length xs,n)

matrizExisteSubSuma5 :: [Int] -> Int -> Array (Int,Int) Bool

matrizExisteSubSuma5 xs n = q

where m = length xs

v = listArray (1,m) xs

q = array ((0,0),(m,n)) [((i,j), f i j) | i <- [0..m],

j <- [0..n]]

f _ 0 = True

f 0 _ = False

f i j | v ! i <= j = q ! (i-1,j-v!i) || q ! (i-1,j)

| otherwise = False

-- Equivalencia

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

prop_existeSubSuma :: [Int] -> Int -> Bool

prop_existeSubSuma xs n =

all (== existeSubSuma2 ys m) [ existeSubSuma3 ys m

, existeSubSuma4 ys m

, existeSubSuma5 ys m ]

where ys = map abs xs

m = abs n

-- La comprobación es

-- λ> quickCheck prop_existeSubSuma

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia:

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

-- λ> let xs = [1..22] in existeSubSuma1 xs (sum xs)

-- True

-- (7.76 secs, 3,892,403,928 bytes)

-- λ> let xs = [1..22] in existeSubSuma2 xs (sum xs)

-- True

-- (0.02 secs, 95,968 bytes)

-- λ> let xs = [1..22] in existeSubSuma3 xs (sum xs)

-- True

-- (0.03 secs, 6,055,200 bytes)

-- λ> let xs = [1..22] in existeSubSuma4 xs (sum xs)

-- True

-- (0.01 secs, 98,880 bytes)

-- λ> let xs = [1..22] in existeSubSuma5 xs (sum xs)

-- True

-- (0.02 secs, 2,827,560 bytes)

-- λ> let xs = [1..200] in existeSubSuma2 xs (sum xs)

-- True

-- (0.01 secs, 182,280 bytes)

-- λ> let xs = [1..200] in existeSubSuma3 xs (sum xs)

-- True

-- (8.89 secs, 1,875,071,968 bytes)

-- λ> let xs = [1..200] in existeSubSuma4 xs (sum xs)

-- True

-- (0.02 secs, 217,128 bytes)

-- λ> let xs = [1..200] in existeSubSuma5 xs (sum xs)

-- True

-- (8.66 secs, 1,875,087,976 bytes)

-- λ> and [existeSubSuma2 [1..20] n | n <- [1..sum [1..20]]]

-- True

-- (2.82 secs, 323,372,512 bytes)

-- λ> and [existeSubSuma3 [1..20] n | n <- [1..sum [1..20]]]

-- True

-- (0.65 secs, 221,806,376 bytes)

-- λ> and [existeSubSuma4 [1..20] n | n <- [1..sum [1..20]]]

-- True

-- (4.12 secs, 535,153,152 bytes)

-- λ> and [existeSubSuma5 [1..20] n | n <- [1..sum [1..20]]]

-- True

-- (0.73 secs, 238,579,696 bytes)

Mayor número obtenido intercambiando dos dígitos

PorJosé A. Alonso 3-abril-201810-abril-2018

Definir la función

   maximoIntercambio :: Int -> Int

1	maximoIntercambio :: Int -> Int

tal que (maximoIntercambio x) es el máximo número que se puede obtener intercambiando dos dígitos de x. Por ejemplo,

   maximoIntercambio 983562  ==  986532
   maximoIntercambio 31524   ==  51324
   maximoIntercambio 897     ==  987

maximoIntercambio 983562 == 986532

maximoIntercambio 31524 == 51324

maximoIntercambio 897 == 987

Soluciones

import Data.Array

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

maximoIntercambio :: Int -> Int
maximoIntercambio = maximum . intercambios

-- (intercambios x) es la lista de los números obtenidos intercambiando
-- dos dígitos de x. Por ejemplo,
--    intercambios 1234  ==  [2134,3214,4231,1324,1432,1243]
intercambios :: Int -> [Int]
intercambios x = [intercambio i j x | i <- [0..n-2], j <- [i+1..n-1]]
    where n = length (show x)

-- (intercambio i j x) es el número obtenido intercambiando las cifras
-- que ocupan las posiciones i y j (empezando a contar en cero) del
-- número x. Por ejemplo,
--    intercambio 2 5 123456789  ==  126453789
intercambio :: Int -> Int -> Int -> Int
intercambio i j x = read (concat [as,[d],cs,[b],ds])
    where xs        = show x
          (as,b:bs) = splitAt i xs 
          (cs,d:ds) = splitAt (j-i-1) bs

-- 2ª solución (con vectores)
-- ==========================

maximoIntercambio2 :: Int -> Int
maximoIntercambio2 = read . elems . maximum . intercambios2

-- (intercambios2 x) es la lista de los vectores obtenidos
-- intercambiando dos elementos del vector de dígitos de x. Por ejemplo, 
--    ghci> intercambios2 1234
--    [array (0,3) [(0,'2'),(1,'1'),(2,'3'),(3,'4')],
--     array (0,3) [(0,'3'),(1,'2'),(2,'1'),(3,'4')],
--     array (0,3) [(0,'4'),(1,'2'),(2,'3'),(3,'1')],
--     array (0,3) [(0,'1'),(1,'3'),(2,'2'),(3,'4')],
--     array (0,3) [(0,'1'),(1,'4'),(2,'3'),(3,'2')],
--     array (0,3) [(0,'1'),(1,'2'),(2,'4'),(3,'3')]]
intercambios2 :: Int -> [Array Int Char]
intercambios2 x = [intercambioV i j v | i <- [0..n-2], j <- [i+1..n-1]]
    where xs = show x
          n  = length xs
          v  = listArray (0,n-1) xs

-- (intercambioV i j v) es el vector obtenido intercambiando los
-- elementos de v que ocupan las posiciones i y j. Por ejemplo,
--    ghci> intercambioV 2 4 (listArray (0,4) [3..8])
--    array (0,4) [(0,3),(1,4),(2,7),(3,6),(4,5)]
intercambioV :: Int -> Int -> Array Int a -> Array Int a
intercambioV i j v = v // [(i,v!j),(j,v!i)]

import Data.Array

-- 1ª solución

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

maximoIntercambio :: Int -> Int

maximoIntercambio = maximum . intercambios

-- (intercambios x) es la lista de los números obtenidos intercambiando

-- dos dígitos de x. Por ejemplo,

-- intercambios 1234 == [2134,3214,4231,1324,1432,1243]

intercambios :: Int -> [Int]

intercambios x = [intercambio i j x | i <- [0..n-2], j <- [i+1..n-1]]

where n = length (show x)

-- (intercambio i j x) es el número obtenido intercambiando las cifras

-- que ocupan las posiciones i y j (empezando a contar en cero) del

-- número x. Por ejemplo,

-- intercambio 2 5 123456789 == 126453789

intercambio :: Int -> Int -> Int -> Int

intercambio i j x = read (concat [as,[d],cs,[b],ds])

where xs = show x

(as,b:bs) = splitAt i xs

(cs,d:ds) = splitAt (j-i-1) bs

-- 2ª solución (con vectores)

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

maximoIntercambio2 :: Int -> Int

maximoIntercambio2 = read . elems . maximum . intercambios2

-- (intercambios2 x) es la lista de los vectores obtenidos

-- intercambiando dos elementos del vector de dígitos de x. Por ejemplo,

-- ghci> intercambios2 1234

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

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

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

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

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

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

intercambios2 :: Int -> [Array Int Char]

intercambios2 x = [intercambioV i j v | i <- [0..n-2], j <- [i+1..n-1]]

where xs = show x

n = length xs

v = listArray (0,n-1) xs

-- (intercambioV i j v) es el vector obtenido intercambiando los

-- elementos de v que ocupan las posiciones i y j. Por ejemplo,

-- ghci> intercambioV 2 4 (listArray (0,4) [3..8])

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

intercambioV :: Int -> Int -> Array Int a -> Array Int a

intercambioV i j v = v // [(i,v!j),(j,v!i)]

Operaciones binarias con matrices

PorJosé A. Alonso 28-marzo-20185-abril-2018

Entre dos matrices de la misma dimensión se pueden aplicar distintas operaciones binarias entre los elementos en la misma posición. Por ejemplo, si a y b son las matrices

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

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

entonces a+b y a-b son, respectivamente

   |4 8 8|     |2 0 4|
   |7 7 9|     |3 5 5

1 2	\|4 8 8\| \|2 0 4\| \|7 7 9\| \|3 5 5

Definir la función

   opMatriz :: (Int -> Int -> Int) -> 
               Matriz Int -> Matriz Int -> Matriz Int

1 2	opMatriz :: (Int -> Int -> Int) -> Matriz Int -> Matriz Int -> Matriz Int

tal que (opMatriz f p q) es la matriz obtenida aplicando la operación f entre los elementos de p y q de la misma posición. Por ejemplo,

   λ> a = listArray ((1,1),(2,3)) [3,4,6,5,6,7]
   λ> b = listArray ((1,1),(2,3)) [1,4,2,2,1,2]
   λ> elems (opMatriz (+) a b)
   [4,8,8,7,7,9]
   λ> elems (opMatriz max a b)
   [3,4,6,5,6,7]
   λ> c = listArray ((1,1),(2,2)) ["ab","c","d","ef"]
   λ> d = listArray ((1,1),(2,2)) [3,1,0,5]
   λ> elems (opMatriz menor c d)
   [True,False,False,True]

λ> a = listArray ((1,1),(2,3)) [3,4,6,5,6,7]

λ> b = listArray ((1,1),(2,3)) [1,4,2,2,1,2]

λ> elems (opMatriz (+) a b)

[4,8,8,7,7,9]

λ> elems (opMatriz max a b)

[3,4,6,5,6,7]

λ> c = listArray ((1,1),(2,2)) ["ab","c","d","ef"]

λ> d = listArray ((1,1),(2,2)) [3,1,0,5]

λ> elems (opMatriz menor c d)

[True,False,False,True]

Soluciones

import Data.Array

-- 1ª solución
opMatriz :: (a -> b -> c) ->
            Array (Int,Int) a -> Array (Int,Int) b -> Array (Int,Int) c
opMatriz f p q =
  array (bounds p) [(k, f (p!k) (q!k)) | k <- indices p]
          
-- 2ª solución
opMatriz2 :: (a -> b -> c) ->
            Array (Int,Int) a -> Array (Int,Int) b -> Array (Int,Int) c
opMatriz2 f p q = 
  listArray (bounds p) [f x y | (x,y) <- zip (elems p) (elems q)]

-- 3ª solución
opMatriz3 :: (a -> b -> c) ->
            Array (Int,Int) a -> Array (Int,Int) b -> Array (Int,Int) c
opMatriz3 f p q = 
  listArray (bounds p) (zipWith f (elems p) (elems q))

import Data.Array

-- 1ª solución

opMatriz :: (a -> b -> c) ->

Array (Int,Int) a -> Array (Int,Int) b -> Array (Int,Int) c

opMatriz f p q =

array (bounds p) [(k, f (p!k) (q!k)) | k <- indices p]

-- 2ª solución

opMatriz2 :: (a -> b -> c) ->

Array (Int,Int) a -> Array (Int,Int) b -> Array (Int,Int) c

opMatriz2 f p q =

listArray (bounds p) [f x y | (x,y) <- zip (elems p) (elems q)]

-- 3ª solución

opMatriz3 :: (a -> b -> c) ->

Array (Int,Int) a -> Array (Int,Int) b -> Array (Int,Int) c

opMatriz3 f p q =

listArray (bounds p) (zipWith f (elems p) (elems q))

Puntos alcanzables en un mapa

Soluciones

Subconjuntos con suma dada

Soluciones

Decidir si existe un subconjunto con suma dada

Soluciones

Mayor número obtenido intercambiando dos dígitos

Soluciones

Operaciones binarias con matrices

Soluciones

Entradas recientes

Buscar

Correo electrónico