Advertisement
banovski

Word reorderer (writing)

Sep 27th, 2024 (edited)
227
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Haskell 2.28 KB | Source Code | 0 0
  1. -- It's an educational app that turns sentences into sets of words and
  2. -- shuffles the words. Characters that don't make up words, e.g.
  3. -- punctuation marks, are removed, capital letters are replaced with
  4. -- their lowercase counterparts. The sentences are read from stdin.
  5. -- Each sentence should be on a separate line. If a sentence consists
  6. -- of only one word, the app changes the order of the letters in the
  7. -- word. The result is written to stdout as sets of comma-separated
  8. -- words, each set is on a separate line. The order of the shuffled
  9. -- words isn't random, but its "randomness" is sufficient. A
  10. -- "sentence" like this "One two three, four five six — seven eight
  11. -- nine; ten eleven twelve: thirteen fourteen fifteen." will be
  12. -- changed into the following set of words: "four, eleven, seven,
  13. -- twelve, two, thirteen, eight, fourteen, one, fifteen, nine, five,
  14. -- ten, six, three".
  15.  
  16. import Data.List (intercalate, sort)
  17. import Data.Char (toLower)
  18. import System.Exit (die)
  19.  
  20. main :: IO ()
  21. main = do
  22.   input <- getContents
  23.   if null input
  24.     then die "No input given!"
  25.     else mapM_ putStrLn $
  26.          listsOfWordsToLines $
  27.          map
  28.            ((shuffleList . processSingleWords) . words)
  29.            (lines $ proccessChars input)
  30.  
  31. processChars :: String -> String
  32. processChars [] = []
  33. processChars string =
  34.   filter (`elem` "abcdefghijklmnopqrstuvwxyz’'- \n") $ map toLower string
  35.  
  36. processSingleWords :: [String] -> [String]
  37. processSingleWords [] = []
  38. processSingleWords [x]
  39.   | x == sort x =  [reverse x]
  40.   | otherwise =  [sort x]
  41. processSingleWords x = x
  42.  
  43. increasingChunks :: [String] -> [[String]]
  44. increasingChunks [] = []
  45. increasingChunks list = aux 1 list
  46.   where
  47.     aux _ [] = []
  48.     aux n lst = take n lst : aux (n + 1) (drop n lst)
  49.  
  50. interlaceLists :: [String] -> [String] -> [String]
  51. interlaceLists x [] = x
  52. interlaceLists [] x = x
  53. interlaceLists listOne@(x:xs) listTwo@(y:ys)
  54.   | length listOne > length listTwo = x : y : interlaceLists xs ys
  55.   | otherwise = y : x : interlaceLists ys xs
  56.  
  57. shuffleList :: [String] -> [String]
  58. shuffleList [] = []
  59. shuffleList list = foldl1 interlaceLists $ increasingChunks list
  60.  
  61. listsOfWordsToLines :: [[String]] -> [String]
  62. listsOfWordsToLines [[]] = []
  63. listsOfWordsToLines list = map (intercalate ", ") list
  64.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement