Initial commit

.gitignore

@@ -0,0 +1,7 @@
+main
+*.o
+*.hi
+*~
+*.bak
+.*
+!.gitignore

main.hs

@@ -0,0 +1,54 @@
+import Data.Char (isLower, isUpper, isPunctuation, isSeparator)
+import Safe      (headMay)
+
+transitionsFirst :: Eq a => a -> [a] -> [Bool]
+transitionsFirst first_val    []  = []
+transitionsFirst first_val (x:xs) = (x /= first_val):transitions xs
+
+transitions :: Eq a => [a] -> [Bool]
+transitions    []        = []
+transitions (x:[])       = []
+transitions (x:xs@(y:_)) = (x /= y):transitions xs
+
+case_and_boundaries :: String -> ([Bool], [Int])
+case_and_boundaries string = do_lb 0 string
+	where do_lb _ []   = ([], [])
+	      do_lb i (x:xs)
+	      	| isUpper x = ( True:next_case, next_boundaries)
+	      	| isLower x = (False:next_case, next_boundaries)
+	      	| (isPunctuation x || isSeparator x) && (Just i) /= (headMay next_boundaries) = (next_case, i:next_boundaries)
+	      	| otherwise = (      next_case, next_boundaries)
+	      	where next_index
+	      	      	| isUpper x || isLower x = i + 1
+	      	      	| otherwise              = i
+	      	      (next_case, next_boundaries) = do_lb next_index xs
+
+sliding_window :: ([a] -> b) -> Int -> Int -> [a] -> [b]
+sliding_window kernel window_size step_size input = sw_do input
+	where sw_do [] = []
+	      sw_do xs = (kernel $ take window_size xs):(sw_do $ next xs)
+	      next xs
+	      	| length xs <= window_size            = []
+	      	| length xs + step_size < window_size = drop (length xs - window_size) xs
+	      	| otherwise                           = drop step_size xs
+
+drop_elements :: [Int] -> [a] -> [a]
+drop_elements indices xs = do_de 0 indices xs
+	where do_de :: Int -> [Int] -> [a] -> [a]
+	      do_de _        _      []  = []
+	      do_de _        []     xs  = xs
+	      do_de index (i:is) (x:xs)
+	      	| index == i =    do_de (index+1)    is  xs
+	      	| otherwise  = x:(do_de (index+1) (i:is) xs)
+
+has_retardcase :: String -> Bool
+has_retardcase string = any (>= threshold) $ sliding_window kernel window_size step_size non_initial_trans
+	where window_size = 7
+	      step_size   = 1
+	      threshold   = 4
+	      (casing, boundaries) = case_and_boundaries string
+	      trans = transitionsFirst False casing
+	      non_initial_trans = drop_elements (0:boundaries) trans
+	      kernel = length . filter id
+
+main = interact (unlines . (map $ show . has_retardcase) . lines)