-- Copyright 2017 Marcelo Garlet Millani -- This file is part of pictikz. -- pictikz is free software: you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation, either version 3 of the License, or -- (at your option) any later version. -- pictikz is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- You should have received a copy of the GNU General Public License -- along with pictikz. If not, see . module Pictikz.Organizer where import Pictikz.Drawing import Pictikz.Graph import Data.List import qualified Debug.Trace as D (trace) fitToBox w h objects = let positions = map getPos objects xs = map fst positions ys = map snd positions shiftx = - minimum xs shifty = - minimum ys scalex = maximum xs scaley = maximum ys scale = max (scalex + shiftx) (scaley + shifty) in map (fPos (\(x,y) -> ((x + shiftx) * w/scale, (y + shifty) * h/scale))) objects scaleToBox w h objects = let positions = map getPos objects xs = map fst positions ys = map snd positions shiftx = - minimum xs shifty = - minimum ys scalex = shiftx + maximum xs scaley = shifty + maximum ys in map (fPos (\(x,y) -> ((x + shiftx) * w/scalex, (y + shifty) * h/scaley))) objects average xs = realToFrac (sum xs) / genericLength xs -- | Organizes nodes in a way that the amount of x and y coordinates used is decreased. -- | The given parameter `d` the maximum difference in order to merge two coordinates. -- | The function `groupf` should convert coordinates into their grouped form uniformCoordinatesBy groupf d ns = let nsx = sortBy (\n m -> compare (fst $ getPos n) (fst $ getPos m)) ns xs = map (fst . getPos) nsx dx = d * ((maximum xs) - (minimum xs)) ux = concat $ groupf dx xs -- update x coordinates ns1 = zipWith (\n x1 -> fPos (\(x,y) -> (x1,y)) n) nsx ux nsy = sortBy (\n m -> compare (snd $ getPos n) (snd $ getPos m)) ns1 ys = map (snd . getPos) nsy dy = d * ((maximum ys) - (minimum ys)) uy = concat $ groupf dy ys in zipWith (\n y1 -> fPos (\(x,y) -> (x,y1)) n) nsy uy genGroup f d [] = [] genGroup f d as = let (bs, r1) = f d as in bs : genGroup f d r1 distanceGroup d0 [] = ([], []) distanceGroup d0 (a:as) = group' d0 d0 0 a (a:as) where group' d d0 l a0 as = let (g, rest) = span (\x -> x - a0 < d0) as a1 = average g l1 = genericLength g d1 = 0.55 * d in if g == [] then (take l $ repeat a0, rest) else (group' d d1 (l + l1) a1 rest) isometricGroup d0 as = let gs = genGroup distanceGroup d0 as in zipWith (\g i -> map (\x -> fromIntegral i) g) gs [0,1..]