centroids
This commit is contained in:
commit
eabfd8e143
|
@ -0,0 +1,3 @@
|
|||
# Changelog for centwo
|
||||
|
||||
## Unreleased changes
|
|
@ -0,0 +1,30 @@
|
|||
Copyright Author name here (c) 2020
|
||||
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
* Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
|
||||
* Redistributions in binary form must reproduce the above
|
||||
copyright notice, this list of conditions and the following
|
||||
disclaimer in the documentation and/or other materials provided
|
||||
with the distribution.
|
||||
|
||||
* Neither the name of Author name here nor the names of other
|
||||
contributors may be used to endorse or promote products derived
|
||||
from this software without specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
||||
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
||||
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
||||
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
||||
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
||||
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
||||
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
|
@ -0,0 +1,57 @@
|
|||
module Main where
|
||||
|
||||
import Lib
|
||||
import qualified Figs
|
||||
import qualified Graphics.Gloss as G
|
||||
|
||||
main :: IO ()
|
||||
main = solve Figs.owlcation
|
||||
|
||||
solve figure =
|
||||
print figure
|
||||
>> print (centroid figure)
|
||||
>> G.display (G.InWindow "Centroid Visualization" (200, 200) (10, 10)) G.black (toPicture figure)
|
||||
|
||||
-- the 'figure' value here shadows that global one
|
||||
toPicture :: Compound -> G.Picture
|
||||
toPicture figure@(Compound figures) = G.pictures $ map toPicture' figures ++ [centroid']
|
||||
where toPicture' (Figure geometry (Location dx dy) axis swapped negation) =
|
||||
color negation
|
||||
. G.translate (realToFrac dx) (realToFrac dy)
|
||||
. swap swapped
|
||||
. mirror axis
|
||||
. shape $ geometry
|
||||
|
||||
where swap NS = id
|
||||
swap S = G.rotate 90
|
||||
|
||||
mirror N = G.scale 1 1
|
||||
mirror X = G.scale 1 (-1)
|
||||
mirror Y = G.scale (-1) 1
|
||||
mirror XY = G.scale (-1) (-1)
|
||||
|
||||
color Positive = G.color G.blue
|
||||
color Negative = G.color G.red
|
||||
|
||||
centroid' = let dx = getX $ centroid figure
|
||||
dy = getY $ centroid figure
|
||||
in G.translate dx dy . G.color G.red $ G.circleSolid 5
|
||||
|
||||
where getX (Location x _) = realToFrac x
|
||||
getY (Location _ y) = realToFrac y
|
||||
|
||||
shape :: Geometry -> G.Picture
|
||||
shape (Rectangle w h) = rectangle (realToFrac w) (realToFrac h)
|
||||
shape (Triangle b h) = rightTriangle (realToFrac b) (realToFrac h)
|
||||
shape (Semicircle r) = semicircle (realToFrac r)
|
||||
|
||||
rightTriangle :: Float -> Float -> G.Picture
|
||||
rightTriangle b h = G.polygon [(0, 0), (b, 0), (0, h)]
|
||||
|
||||
-- defining our own rectangle so that the global origin is on the lower right
|
||||
-- the gloss builtin rectangle is centered on the global origin
|
||||
rectangle :: Float -> Float -> G.Picture
|
||||
rectangle w h = G.polygon [(0, 0), (w, 0), (w, h), (0, h)]
|
||||
|
||||
semicircle :: Float -> G.Picture
|
||||
semicircle r = G.arcSolid 0 180 r
|
|
@ -0,0 +1,49 @@
|
|||
name: centwo
|
||||
version: 0.1.0.0
|
||||
github: "githubuser/centwo"
|
||||
license: BSD3
|
||||
author: "Author name here"
|
||||
maintainer: "example@example.com"
|
||||
copyright: "2020 Author name here"
|
||||
|
||||
extra-source-files:
|
||||
- README.md
|
||||
- ChangeLog.md
|
||||
|
||||
# Metadata used when publishing your package
|
||||
# synopsis: Short description of your package
|
||||
# category: Web
|
||||
|
||||
# To avoid duplicated efforts in documentation and dealing with the
|
||||
# complications of embedding Haddock markup inside cabal files, it is
|
||||
# common to point users to the README.md file.
|
||||
description: Please see the README on GitHub at <https://github.com/githubuser/centwo#readme>
|
||||
|
||||
dependencies:
|
||||
- base >= 4.7 && < 5
|
||||
- gloss
|
||||
|
||||
library:
|
||||
source-dirs: src
|
||||
|
||||
executables:
|
||||
centwo-exe:
|
||||
main: Main.hs
|
||||
source-dirs: app
|
||||
ghc-options:
|
||||
- -threaded
|
||||
- -rtsopts
|
||||
- -with-rtsopts=-N
|
||||
dependencies:
|
||||
- centwo
|
||||
|
||||
tests:
|
||||
centwo-test:
|
||||
main: Spec.hs
|
||||
source-dirs: test
|
||||
ghc-options:
|
||||
- -threaded
|
||||
- -rtsopts
|
||||
- -with-rtsopts=-N
|
||||
dependencies:
|
||||
- centwo
|
|
@ -0,0 +1,14 @@
|
|||
module Figs
|
||||
( question3
|
||||
, owlcation
|
||||
) where
|
||||
|
||||
import Lib
|
||||
|
||||
question3 = Compound [ Figure (Rectangle 2 2) (Location 0 0) N NS Positive
|
||||
, Figure (Rectangle 0.75 0.5) (Location 0.625 0) N NS Negative
|
||||
, Figure (Semicircle 0.625) (Location 1 2) X NS Negative ]
|
||||
|
||||
owlcation = Compound [ Figure (Rectangle 300 250) (Location (-150) 0) N NS Positive
|
||||
, Figure (Triangle 120 120) (Location 150 250) XY NS Negative
|
||||
, Figure (Semicircle 100) (Location (-150) 135) N S Negative ]
|
|
@ -0,0 +1,76 @@
|
|||
module Lib
|
||||
( Geometry ( Rectangle, Triangle, Semicircle )
|
||||
, Location ( Location )
|
||||
, Mirror ( N, X, Y, XY )
|
||||
, Swap ( NS, S )
|
||||
, Negation ( Positive, Negative )
|
||||
, Figure ( Figure )
|
||||
, Centroid ( area, xb, yb )
|
||||
, Compound ( Compound )
|
||||
, centroid
|
||||
) where
|
||||
|
||||
data Geometry = Rectangle Double Double -- width x height
|
||||
| Triangle Double Double -- base x height
|
||||
| Semicircle Double -- radius
|
||||
deriving Show
|
||||
|
||||
data Location = Location Double Double deriving Show -- x, y
|
||||
data Mirror = N | X | Y | XY deriving Show
|
||||
data Swap = NS | S deriving Show
|
||||
data Negation = Positive | Negative deriving Show
|
||||
data Figure = Figure Geometry Location Mirror Swap Negation deriving Show
|
||||
|
||||
newtype Compound = Compound [Figure] deriving Show
|
||||
|
||||
class Centroid a where
|
||||
area :: a -> Double
|
||||
xb :: a -> Double
|
||||
yb :: a -> Double
|
||||
|
||||
instance Centroid Geometry where
|
||||
area (Rectangle w h) = w * h
|
||||
area (Triangle b h) = b * h / 2
|
||||
area (Semicircle r) = pi * r ^ 2 / 2
|
||||
|
||||
xb (Rectangle w _) = w / 2
|
||||
xb (Triangle b _) = b / 3
|
||||
xb (Semicircle r) = 0
|
||||
|
||||
yb (Rectangle _ h) = h / 2
|
||||
yb (Triangle _ h) = h / 3
|
||||
yb (Semicircle r) = 4 * r / (3 * pi)
|
||||
|
||||
-- xb' / yb' swap the actual xbs and ybs
|
||||
-- mirror reflects across the axis, origin stays (0, 0)
|
||||
-- negate' negates an area depending on whether its positive or negative space
|
||||
|
||||
instance Centroid Figure where
|
||||
area (Figure geometry _ _ _ negation) = negate' negation $ area geometry
|
||||
where negate' Positive = id
|
||||
negate' Negative = negate
|
||||
|
||||
xb (Figure geometry (Location dx _) axis swapped _) =
|
||||
(+ dx) . mirror axis . xb' swapped $ geometry
|
||||
|
||||
where mirror Y = negate
|
||||
mirror XY = negate
|
||||
mirror _ = id
|
||||
|
||||
xb' NS = xb
|
||||
xb' S = yb
|
||||
|
||||
yb (Figure geometry (Location _ dy) axis swapped _) =
|
||||
(+ dy) . mirror axis . yb' swapped $ geometry
|
||||
|
||||
where mirror X = negate
|
||||
mirror XY = negate
|
||||
mirror _ = id
|
||||
|
||||
yb' NS = yb
|
||||
yb' S = xb
|
||||
|
||||
centroid :: Compound -> Location
|
||||
centroid (Compound figures) = Location (dist xb) (dist yb)
|
||||
where dist f = (sum $ map (\figure -> area figure * f figure) figures)
|
||||
/ (sum $ map area figures)
|
|
@ -0,0 +1,66 @@
|
|||
# This file was automatically generated by 'stack init'
|
||||
#
|
||||
# Some commonly used options have been documented as comments in this file.
|
||||
# For advanced use and comprehensive documentation of the format, please see:
|
||||
# https://docs.haskellstack.org/en/stable/yaml_configuration/
|
||||
|
||||
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
|
||||
# A snapshot resolver dictates the compiler version and the set of packages
|
||||
# to be used for project dependencies. For example:
|
||||
#
|
||||
# resolver: lts-3.5
|
||||
# resolver: nightly-2015-09-21
|
||||
# resolver: ghc-7.10.2
|
||||
#
|
||||
# The location of a snapshot can be provided as a file or url. Stack assumes
|
||||
# a snapshot provided as a file might change, whereas a url resource does not.
|
||||
#
|
||||
# resolver: ./custom-snapshot.yaml
|
||||
# resolver: https://example.com/snapshots/2018-01-01.yaml
|
||||
resolver: lts-14.22
|
||||
|
||||
# User packages to be built.
|
||||
# Various formats can be used as shown in the example below.
|
||||
#
|
||||
# packages:
|
||||
# - some-directory
|
||||
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
|
||||
# subdirs:
|
||||
# - auto-update
|
||||
# - wai
|
||||
packages:
|
||||
- .
|
||||
# Dependency packages to be pulled from upstream that are not in the resolver.
|
||||
# These entries can reference officially published versions as well as
|
||||
# forks / in-progress versions pinned to a git hash. For example:
|
||||
#
|
||||
# extra-deps:
|
||||
# - acme-missiles-0.3
|
||||
# - git: https://github.com/commercialhaskell/stack.git
|
||||
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
|
||||
#
|
||||
# extra-deps: []
|
||||
|
||||
# Override default flag values for local packages and extra-deps
|
||||
# flags: {}
|
||||
|
||||
# Extra package databases containing global packages
|
||||
# extra-package-dbs: []
|
||||
|
||||
# Control whether we use the GHC we find on the path
|
||||
# system-ghc: true
|
||||
#
|
||||
# Require a specific version of stack, using version ranges
|
||||
# require-stack-version: -any # Default
|
||||
# require-stack-version: ">=2.1"
|
||||
#
|
||||
# Override the architecture used by stack, especially useful on Windows
|
||||
# arch: i386
|
||||
# arch: x86_64
|
||||
#
|
||||
# Extra directories used by stack for building
|
||||
# extra-include-dirs: [/path/to/dir]
|
||||
# extra-lib-dirs: [/path/to/dir]
|
||||
#
|
||||
# Allow a newer minor version of GHC than the snapshot specifies
|
||||
# compiler-check: newer-minor
|
|
@ -0,0 +1,12 @@
|
|||
# This file was autogenerated by Stack.
|
||||
# You should not edit this file by hand.
|
||||
# For more information, please see the documentation at:
|
||||
# https://docs.haskellstack.org/en/stable/lock_files
|
||||
|
||||
packages: []
|
||||
snapshots:
|
||||
- completed:
|
||||
size: 524164
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/22.yaml
|
||||
sha256: 7ad8f33179b32d204165a3a662c6269464a47a7e65a30abc38d01b5a38ec42c0
|
||||
original: lts-14.22
|
|
@ -0,0 +1,2 @@
|
|||
main :: IO ()
|
||||
main = putStrLn "Test suite not yet implemented"
|
Loading…
Reference in New Issue