71 lines
3.0 KiB
Haskell
71 lines
3.0 KiB
Haskell
-- ReTardCasE DetEcTor: determine whether a portion of a string is ReTard CasED
|
|
-- CopYriGhT © 2021 MiDgaRD
|
|
--
|
|
-- This program is free software: you can redistribute it and/or modify
|
|
-- it under the terms of the GNU Affero General Public License as
|
|
-- published by the Free Software Foundation, either version 3 of the
|
|
-- License, or (at your option) any later version.
|
|
--
|
|
-- This program 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 Affero General Public License for more details.
|
|
--
|
|
-- You should have received a copy of the GNU Affero General Public License
|
|
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
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)
|