Initial commit

This commit is contained in:
Midgard 2021-07-23 17:28:53 +02:00
commit 97d05f7daf
Signed by: midgard
GPG key ID: 511C112F1331BBB4
2 changed files with 61 additions and 0 deletions

7
.gitignore vendored Normal file
View file

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

54
main.hs Normal file
View file

@ -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)