Welcome, guest! Login / Register - Why register?
Psst.. new poll here.
Psst.. new forums here.
Microsoft is blocking us again (TY IP Reputation!) so just use oauth login instead. :)

Paste

Pasted as Haskell by PN ( 15 years ago )
type PType = Integer
type Point = (PType, PType)
type Line = (Point, Point)

-- does not work when all four points are on one line
doIntersect :: Line -> Line -> Bool
doIntersect ((ax, ay), (bx, by)) ((cx, cy), (dx, dy)) = let
  x1 = bx-ax
  y1 = by-ay
  x2 = dx-cx
  y2 = dy-cy
  delta = x1*y2 - x2*y1
  rd = (ax-cx)*(cy-dy) - (cx-dx)*(ay-cy)
  sd = (ax-cx)*(ay-by) - (ax-bx)*(ay-cy)
  in
    if delta == 0 then False else
      if delta > 0 then rd >= 0 && rd <= delta && sd >= 0 && sd <= delta else rd <= 0 && rd >= delta && sd <= 0 && sd >= delta

areParallel :: Line -> Line -> Bool
areParallel ((x1,y1),(x2,y2)) ((x3,y3),(x4,y4)) = (y2-y1)*(x4-x3) == (y4-y3)*(x2-x1)

lineLengthSqr :: Line -> PType
lineLengthSqr ((x1, y1), (x2, y2)) = (x2-x1)^2 + (y2-y1)^2

sameLength :: Line -> Line -> Bool
sameLength l1 l2 = lineLengthSqr l1 == lineLengthSqr l2

getType' :: [Point] -> Int
getType' (a:b:c:d:[])
 | paragramm && sl_ab_bc && sl_ac_bd = 1
 | paragramm && sl_ac_bd = 2
 | paragramm && sl_ab_bc = 3
 | paragramm = 4
 | areParallel (a, b) (c, d) || areParallel (b, c) (d, a) = 5
 | True = 6
  where
   sl_ab_bc = sameLength (a,b) (b,c)
   sl_ab_cd = sameLength (a,b) (c,d)
   sl_bc_da = sameLength (b,c) (d,a)
   sl_ac_bd = sameLength (a,c) (b,d)
   paragramm = sl_ab_cd && sl_bc_da


selections :: [a] -> [(a, [a])]
selections []     = []
selections (x:xs) = (x,xs) : [ (y,x:ys) | (y,ys) <- selections xs ]

permutations :: [a] -> [[a]]
permutations [] = [[]]
permutations xs = [ y : zs | (y,ys) <- selections xs, zs <- permutations ys]

isViereck :: [Point] -> Bool
isViereck (a:b:c:d:[]) = not $ doIntersect (a,b) (c,d) || doIntersect (b,c) (d,a)

getType :: [Point] -> Int
getType ps = getType'.head $ dropWhile (not.isViereck) (permutations ps)
--getType (a:b:c:d:[]) = minimum $ map getType' $ filter isViereck [(a:ps) | ps <- permutations [b,c,d]]

numToName :: Int -> String
numToName 1 = "Quadrat"
numToName 2 = "Rechteck"
numToName 3 = "Rhombus"
numToName 4 = "Parallelogramm"
numToName 5 = "Trapez"
numToName 6 = "allgemeines Viereck"

lineToPoint :: String -> Point
lineToPoint l = let (w1:w2:[]) = words l in ((read w1)::PType, (read w2)::PType)

loop :: Int -> Int -> IO ()
loop _ 0 = return ()
loop n i = do
  l1 <- getLine
  l2 <- getLine
  l3 <- getLine
  l4 <- getLine
  ps <- return $ map lineToPoint [l1, l2, l3, l4]
  let t = getType ps in putStrLn $ "Fall " ++ (show n) ++ ": " ++ (numToName t)
  loop (n+1) (i-1)

main :: IO ()
main = getLine >>= (loop 1).read

 

Revise this Paste

Your Name: Code Language: