{- Group chunks of digits in a novel way that makes it (somewhat) easy to count the number of digits. Usage examples: Get the digit grouping of a 17 digit number: ./a.out get 17 Get digit groupings of all numbers of the form d*10^n where (d=1..9). program never terminates: ./a.out getall Add commas to the given number: ./a.out do 12345678912345678901 Add commas to numbers given in stdin, one number per line: ./a.out dolines < inputfile Copyright 2021 Ken Takusagawa This program is free software: you can redistribute it and/or modify it under the terms of the GNU 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . -} {-# LANGUAGE ScopedTypeVariables, LambdaCase, PackageImports #-} module Main where { import System.Environment(getArgs); import Control.Exception(assert); import Debug.Trace(trace); import Data.Function((&)); import Control.Category((>>>)); import Prelude hiding((.),(>>)); --import qualified Prelude; import System.IO(hSetBuffering,stdout,BufferMode(LineBuffering)); --import System.IO(stderr,hPutStrLn); import qualified Data.List as List; --import qualified Control.Monad as Monad; --import Control.Monad(guard); --import qualified Data.Maybe as Maybe; --import qualified Data.Map as Map; import Data.Map(Map); --import qualified Data.Set as Set; import Data.Set(Set); --import Data.Tuple(swap); --import Control.Monad.GenericReplicate(genericReplicateM); -- igenericReplicateM --import Data.Functor((<&>)); --foreach = flip map --import qualified Data.Bifunctor as Bifunctor; -- (first, second) import Data.Tuple(swap); main :: IO(); main = getArgs >>= \case{ ["get",n] -> getdigitgrouping (read n) & print; ["getall"] -> grow10 & zipmap getdigitgrouping & showlines; ["do",s] -> dodigitgrouping s & putStrLn; ["dolines"] -> getContents >>= (lines >>> map dodigitgrouping >>> printlines); _ -> undefined; }; type Ii = Integer; -- useful for (id :: Endo Integer) to assert a type in a pipeline type Endo a = a->a; -- to avoid the redundancy warning trace_placeholder :: (); trace_placeholder = (trace,assert,printlines) & (id >>> error) "trace_placeholder"; -- ghc -O2 -fno-ignore-asserts printlines :: [String] -> IO(); printlines l = do { hSetBuffering stdout LineBuffering; mapM_ putStrLn l; }; showlines :: (Show a) => [a] -> IO(); showlines = map show >>> printlines; digitanswer :: Ii -> [Ii]; digitanswer 1 = [1]; digitanswer 2 = [1,1]; digitanswer 3 = [1,1,1]; digitanswer 4 = [1,1,1,1]; digitanswer 5 = [1,1,3]; digitanswer 6 = [1,1,1,3]; digitanswer 7 = [1,1,1,1,3]; digitanswer 8 = [1,1,3,3]; digitanswer 9 = [1,1,1,3,3]; digitanswer 10 = [1,1,1,1,3,3]; -- general idea: one can count 3 chunks of the same length before losing track of how many (i.e., one can count to 3). 4, 7, and 10 seem to violate this, but the first value usually gets done with a smaller power of 10 (see "magic tail" below), with the exception of units place. -- chunk sizes grow only by 3 and 3.333, never larger leaps. if they shrink, they shrink down to 1. digitanswer n = error $ "single digit digitanswer failure " ++ show n; tenanswer :: Tenpow -> Ii -> [Ii]; tenanswer _ 0 = []; tenanswer (Tenpow 0) digit = digitanswer digit; tenanswer (Tenpow tenpow) digit = tenanswer (Tenpow$ tenpow-1) 10 ++ (digitanswer digit & tail {- the magic tail -} & map (\x -> x*(10^tenpow))); -- output is little-endian, i.e., the 1's place is at the head of the list. radix_convert :: Integer -> Integer -> [Integer]; radix_convert base = List.unfoldr $ \n -> if n==0 then Nothing else Just $ swap $ divMod n base; newtype Tenpow = Tenpow Ii deriving(Show); radixwithpowers :: Ii -> [(Tenpow,Ii)]; radixwithpowers n = radix_convert 10 n & zip (enumFrom 0 & map Tenpow) & reverse; getdigitgrouping :: Ii -> [Ii]; getdigitgrouping = radixwithpowers >>> concatMap (uncurry tenanswer); splitatexactly :: forall a. Ii -> [a] -> ([a],[a]); splitatexactly n l = let { answer = List.genericSplitAt n l } in if n==List.genericLength (fst answer) then answer else error "list too short in splitatexactly"; handleonegroup :: forall a.[Ii] -> [a] -> Maybe ([a],([Ii],[a])); handleonegroup [] [] = Nothing; handleonegroup [] _ = error "handleonegroup: unconsumed input"; handleonegroup (i:irest) l = let { answer :: ([a],[a]); answer = splitatexactly i l; } in Just (fst answer, (irest,snd answer)); dolistrouping :: [a] -> [[a]]; dolistrouping l = List.unfoldr (uncurry handleonegroup) (getdigitgrouping $ List.genericLength l,l); dodigitgrouping :: String -> String; dodigitgrouping = dolistrouping >>> List.intersperse "," >>> concat; positivedigits :: [Ii]; positivedigits = [1..9]; grow10withoutzero :: [Ii]; grow10withoutzero = positivedigits ++ map (\x -> 10*x) grow10withoutzero; grow10 :: [Ii]; grow10 = 0:grow10withoutzero; zipmap :: (a -> b) -> [a] -> [(a,b)]; zipmap f l = zip l $ map f l; } --end