0votos

Triangulación simple en Haskell

por josejuan hace 6 años

Creí que alguien se animaría, es fácil (y creo que divertido). No se han impuesto restricciones a la triangulación conseguida. Mi solución únicamente necesita una función que indique si dos segmentos de recta intersectan, nada más.

Dada una lista de coordenadas (x, y) en el plano; obtener una triangulación de la forma más sencilla (quizás no eficiente) posible.

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
triangular = trStart . sortBy (\a b -> compare (norma a) (norma b)) 
  where trStart (r:s:t:rs) = trNext rs (doArs r s t) (r:s:t:[]) (doArs r s t)  
        trNext [] ar _ _ = ar 
        trNext (r:rs) ar ps pr = trNext rs (concatMap (\(u, v) -> doArs u v r) ar' ++ ar) (r:ps) (pr ++ pr') 
          where pr' = filter (\v -> not $ any (segmentIsegment v) pr) $ map (\s -> (r, s)) ps 
                ar' = filter (\(u, v) -> any ((u==).snd) pr' && any ((v==).snd) pr') pr 
        doArs r s t = ((r, s):(r, t):(s, t):[]) 
 
 
 
{-- 
  * Los puntos pueden ordenarse de muchas formas, siempre que sea en un campo convexo. 
  * Una vez ordenados, los tres primeros puntos ya forman un triángulo, al que vamos añadiendo el resto de puntos. 
  * Como speedup, se van pasando los puntos de una lista a otra para ir formando las aristas más rápido. 
  * Como speedup, se van manteniendo el conjunto de aristas factible para evitar tener que recalcular intersecciones. 
 
  Un código completo que lee de disco una lista de puntos y genera una imagen como ésta 
 
     http://shared.computer-mind.com/JoseJuan/test.svg 
 
 es el siguiente: 
--} 
{-- lee de la entrada estandar una nube de puntos y escribe por la salida estandar una imagen SVG con la triangulación--} 
import Data.Cross 
import Data.VectorSpace 
import Data.List (sortBy) 
 
triangular = trStart . sortBy (\a b -> compare (norma a) (norma b)) 
  where trStart (r:s:t:rs) = trNext rs (doArs r s t) (r:s:t:[]) (doArs r s t)  
        trNext [] ar _ _ = ar 
        trNext (r:rs) ar ps pr = trNext rs (concatMap (\(u, v) -> doArs u v r) ar' ++ ar) (r:ps) (pr ++ pr') 
          where pr' = filter (\v -> not $ any (segmentIsegment v) pr) $ map (\s -> (r, s)) ps 
                ar' = filter (\(u, v) -> any ((u==).snd) pr' && any ((v==).snd) pr') pr 
        doArs r s t = ((r, s):(r, t):(s, t):[]) 
 
norma (x, y) = sqrt (x * x + y * y) 
 
segmentIsegment s1@(a, b) s2@(c, d) = 
  if isZero rs 
    then False 
    else and [0 < u, u < 1, 0 < t, t < 1] 
  where r = b - a 
        s = d - c 
        rs = r >< s 
        ca = c - a 
        t = (ca >< s) / rs 
        u = (ca >< r) / rs 
 
-- ¿Esta función existe en algún lado? 
isZero x = -1e-9 < x && x < 1e-9 
 
-- ¿Será posible que no encuentro un "cross product" decente? (no se como se aplica cross2) ¡¿@#!x&?! 
(><) :: (Double, Double) -> (Double, Double) -> Double 
(><) (x1, y1) (x2, y2) = x1 * y2 - x2 * y1 
 
readPoints :: [String] -> [(Double, Double)] 
readPoints [] = [] 
readPoints (x:y:ps) = (read x, read y): readPoints ps 
 
drawLine :: ((Double, Double), (Double, Double)) -> String 
drawLine ((x1, y1), (x2, y2)) = 
   "<line x1=\"" ++ (show x1) ++ "\" y1=\"" ++ (show y1) ++ 
      "\" x2=\"" ++ (show x2) ++ "\" y2=\"" ++ (show y2) ++ "\" style=\"stroke: rgb(0, 0, 0)\" />" 
 
main =  putStr "<svg xmlns=\"http://www.w3.org/2000/svg\">" >> 
        getContents >>= ((putStr.concatMap drawLine).(triangular.readPoints.words)) >> 
        putStr "</svg>" 
2 comentarios
0votos

Escrito por ebrasca hace 6 años

Agrade seria que me espliques que en que consiste la triangulación.
0votos

Escrito por josejuan hace 6 años

Hola ebrasca, consiste en reducir un polígono en un conjunto de triángulos tales que no se solapen y cubran totalmente al polígono inicial.

http://es.wikipedia.org/wiki/Triangulaci%C3%B3ndeun_pol%C3%ADgono

Comenta la solución

Tienes que identificarte para poder publicar tu comentario.