0votos

El rectángulo más grande en Haskell

por josejuan hace 5 años

Buscando esquinas tiene coste cuadrático, pero es cómodo. No se permiten cuadrados de un pixel en esta implementación.

Dada una imagen de tamaño fijo y de fondo siempre blanco con una cantidad variable de rectángulos de color negro de diferentes tamaños Calcular el rectángulo más grande (mayor altura y anchura) y diferenciarlo visualmente (con cualquier otro color) de los demás.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
import Graphics.GD 
import System.Environment 
import Data.Maybe 
import Data.List 
import Control.Monad 
import qualified Data.Map as M 
 
inBox pim pos = case M.lookup pos pim of {Nothing -> False; Just x  -> x} 
 
data CornerType = Open | Close | None deriving (Eq, Show, Ord) 
isCorner pim (x, y) = if o && a == b && c == d && a /= c then (if c then Open else Close) else None 
                      where [o,a,b,c,d] = map (inBox pim) [(x, y),(x,y-1),(x-1,y),(x+1,y),(x,y+1)] 
 
-- Un cuadrado contiene un punto Y NO ES esquina open/close 
insideBox' ((ax, ay), (bx, by)) (px, py) = and [ax <= px, px <= bx, ay <= py, py <= by, ax /= px || ay /= py, bx /= px || by /= py] 
 
allBoxes pim = [(o, c) | o@(x, y) <- oc, c@(x', y') <- cc, x < x', y < y', not$any (insideBox' (o, c)) ac] 
               where (oc:cc:_) = map (map snd) $ groupBy (\a b -> fst a == fst b) $ sort $ map ((,)=<<isCorner pim) $ M.keys pim 
                     ac = oc ++ cc 
 
searchBigBox = listToMaybe . sortBy (\a b -> (boxSize b) `compare` (boxSize a)) . allBoxes 
boxSize ((ax, ay), (bx, by)) = (bx - ax + 1) * (by - ay + 1) 
 
 
main = do 
  (fin:fout:_) <- getArgs 
  img <- loadPngFile fin 
  (w, h) <- imageSize img 
  pim <- (forM [0..h-1] $ \y -> do 
            forM [0..w-1] $ \x -> do 
              c <- getPixel (x, y) img 
              return ((x, y), c == 0)) >>= return . M.fromList . concat 
  case searchBigBox pim of 
    Nothing -> putStrLn "Box not found!" 
    Just (a, b) -> drawFilledRectangle a b (rgb 255 50 50) img >> 
                   savePngFile fout img 

Comenta la solución

Tienes que identificarte para poder publicar tu comentario.