0votos

Encuentra el Punto Óptimo en Haskell

por josejuan hace 3 años

Si como parece por el enunciado las coordenadas son enteras y acotadas (ej. 1000x1000) una solución práctica óptima pasaría por usar la GPU y renderizar las cajas sobre un buffer acumulador. Mi solución es más general y admite cualquier rango de coordenadas (ej. 10e40x10e40) y coordenadas reales (no enteras).

Buscar el punto dentro de un mapa que cumpla con los siguientes requerimientos.

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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
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
{-# LANGUAGE TupleSections #-} 
module Lib( óptimos ) where 
 
import Data.List hiding (delete) 
import Data.IntMap.Strict hiding (foldr) 
import qualified Data.IntMap.Strict as M 
 
{- 
 
  El problema geométrico, salvo rotaciones, es isomorfo a la métrica 
 
          máximo (x1 - x2) (y1 - y2) 
 
  que es la métrica que yo usaría y parece más cómoda para resolver 
  el problema de proximidad pedido. 
 
  Aún así, resuelvo con la métrica solicitada, porque la solución 
  es prácticamente idéntica. 
 
  El problema solicita encontrar un punto óptimo, aquí se encuentran 
  todos aquellos que, siendo solución, forman parte del conjunto de 
  puntos de entrada (representantes de cada conjunto conexo con el 
  mismo máximo, en realidad, los vértices superiores "de entrada" de 
  cada caja que produzcan máximo). 
 
  El algoritmo consiste en: 
 
    1. para cada Y del conjunto de entrada, se meten todos los 
       intervalos X (en la métrica máx abs). 
    2. se recorre ordenadamente Y añadiendo los nuevos y sacando 
       los salientes de un acumulador de "cajas activas". 
    3. se recorre ordenadamente X con los intervalos de las cajas 
       activas incrementando o decrementando el contador según sea 
       x1 o x2. Si es máximo se añade a la lista solución. 
 
  Los descrito anteriormente es ideal para la métrica del máximo absoluto 
  pero puede transformarse desde manhattan viendo que 
 
        (x, y) <===> (x - y, x + y) 
        D d    <===> D d 
 
  La distancia se mantiene porque el tamaño de la cuadrícula sufre un cambio 
  de escala de raíz de 2 (el mismo que la distancia). 
 
-} 
 
data I = I { x1 :: !Int, x2 :: !Int, y2 :: !Int } deriving Show 
 
óptimos :: Int → [(Int, Int)] → (Int, [(Int, Int)]) 
óptimos d ps = 
    let caja (x, y) = let y2 = x + d + y 
                      in  [(x - d + y, [I (x - d - y) (x + d - y) y2]), (y2, [])] -- Entrada y salida 
        cajas       = assocs $ fromListWith (⧺) $ concatMap caja ps 
    in  óptimosY 0 [] cajas ∅ 
 
óptimosY :: Int → [(Int, Int)] → [(Int, [I])] → IntMap [I] → (Int, [(Int, Int)]) 
óptimosY sN sT [] _ = (sN, sT) -- la última sí hace falta revisar [.... [.... [.... ]]] (máx 3) 
óptimosY sN sT ((iY, iS): cs) mi = 
   let mi' = foldr (λi m → insertWith (⧺) (y2 i) [i] m) mi iS -- añadimos entradas que saldrán en y2 
       (xN, xT) = óptimosX 0 [] 0 $ sort $ concat [[(x1, 𝐹), (x2, 𝑇)] | I x1 x2 _ ← concat $ elems mi'] 
       sT' = (, iY) ↥ xT 
       mi'' = delete iY mi' -- quitamos las cajas que quedan ya arriba 
   in  case sN `compare` xN of 
         EQ → óptimosY sN (sT' ⧺ sT) cs mi'' 
         LT → óptimosY xN  sT'       cs mi'' 
         GT → óptimosY sN        sT  cs mi'' 
 
óptimosX :: Int → [Int] → Int → [(Int, 𝔹)] → (Int, [Int]) 
óptimosX xN xT _ [] = (xN, xT) 
óptimosX xN xT c ((x1, 𝐹): xs) = let c' = c + 1 
                                 in  case xN `compare` c' of 
                                       EQ → óptimosX xN (x1: xT) c' xs 
                                       LT → óptimosX c' [x1]     c' xs 
                                       GT → óptimosX xN      xT  c' xs 
óptimosX xN xT c ((_ , 𝑇): xs) = óptimosX xN xT (c - 1) xs 
 
{- 
 
 
Por ejemplo 
 
> let fromManhattan (x, y) = ((x + y) `div` 2, (y - x) `div` 2) 
> second (fromManhattan <$>) $ óptimos 1 [(1, 1)] 
(1,[(1,2),(0,1)]) 
> second (fmap fromManhattan) $ óptimos 1 [(1, 1)] 
(1,[(1,2),(0,1)]) 
> second (fmap fromManhattan) $ óptimos 1 [(1, 1), (3, 3)] 
(1,[(3,4),(2,3),(1,2),(0,1)]) 
> second (fmap fromManhattan) $ óptimos 1 [(1, 1), (3, 3), (3, 1)] 
(2,[(3,2),(2,1)]) 
> second (fmap fromManhattan) $ óptimos 1 [(1, 1), (3, 3), (3, 1), (4, 2)] 
(3,[(3,2)]) 
 
-} 
 
-- ================ Main.hs ========================== 
 
 
module Main where 
 
import Lib 
import System.Environment 
import System.Random 
 
randomP :: Int → IO (Int, Int) 
randomP n = do 
    x ← randomRIO (0, n) 
    y ← randomRIO (0, n) 
    η (x, y) 
 
main :: IO () 
main = do 
    (n:d:p:_) ← (↥read) ↥ getArgs 
    ps ← ↱(const $ randomP n) [1…p] 
    let (o, xs) = óptimos d ps 
    putStrLn $ "Máx agregado size: " ⧺ show o ⧺ ", núm óptimos: " ⧺ show (length xs) 
 
{- 
 
En un pobre Atom D510 a 1.66GHz arroja tiempos muy buenos, lógicamente depende del 
número de cajas en el acumulador, si el radio es muy grande, hay muchas más cajas 
simultáneamente. 
 
centroide$ time -f "%E, %M" /home/josejuan/.local/bin/centroide-exe 1000 5 50000 
Máx agregado size: 17, núm óptimos: 1 
0:02.79, 20992 
 
centroide$ time -f "%E, %M" /home/josejuan/.local/bin/centroide-exe 1000 5 50000 
Máx agregado size: 14, núm óptimos: 2 
0:02.80, 21436 
 
centroide$ time -f "%E, %M" /home/josejuan/.local/bin/centroide-exe 1000 15 10000 
Máx agregado size: 17, núm óptimos: 2 
0:01.13, 9284 
 
-} 
3 comentarios
0votos

Escrito por KYKEX hace 3 años

que pro, ni siquiera entiendo lo que pide :c no se ni como probar las soluciones XD
1votos

Escrito por josejuan hace 3 años

@KYKEX no hay nada especial, es normal que suene raro si no se ha visto antes, por eso he intentado detallarlo en el comentario. Para correrlo necesitas Haskell, si lo tienes instalado te puedo postear una versión sin las transformaciones conceal (ej. `η` realmente es `return`).

Lo que pide el problema es, dados unos puntos en el plano, encontrar aquel "círculo" de radio fijo (digamos 5) que contenga el mayor número de esos puntos.

Algo parecido a ésto ¿qué círculo contiene más puntos?
circulos

Lo que pasa es que en lugar de círculos r^2 = dx^2 + dy^2 son círculo r = |dx| + |dy| que es la métrica manhattan.

El algoritmo por lo demás, es bastante básico.

¡Un saludo!
0votos

Escrito por KYKEX hace 3 años

gracias por la explicación, intentare hacer algo al respecto para dar mi solución pronto.

Comenta la solución

Tienes que identificarte para poder publicar tu comentario.