{-
  Encode a number as permutation, or decode.

  Usage:
    `./a.out itoa` reads integers separated by whitespace from standard input and outputs corresponding permutations of the string "a-zA-Z" (demoalphabet).  Input numbers must be between 0 and 52!-1.

    `./a.out atoi` reads permutations of the string "a-zA-Z" from standard input and outputs the corresponding integer.

    `./a.out test [integer]` shows the intermediate steps of conversion of the integer specified on the command line.

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 <http://www.gnu.org/licenses/>.
-}

{-# LANGUAGE ScopedTypeVariables, LambdaCase, PackageImports #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-} -- for deriving Enum

module Main where {
import System.Environment(getArgs);
import Data.Function((&));
import Control.Category((>>>));
import Prelude hiding((.),(>>));
--import qualified Prelude;
import System.IO(hSetBuffering,stdout,BufferMode(LineBuffering));
import qualified Data.List as List;
import qualified Data.Map as Map; import Data.Map(Map);
import qualified Data.Array as Array; import Data.Array(Array);
import qualified Data.Set as Set; import Data.Set(Set);

main :: IO();
main = getArgs >>= \case{
["itoa"] -> getContents >>= (words >>> map(read >>> demoitoa) >>> printlines);
["atoi"] -> getContents >>= (words >>> map demoatoi >>> showlines);
["test",i] -> test demostartfactorial Nothing (read i) & print;
_ -> undefined;
};

type Ii = Integer;

printlines :: [String] -> IO();
printlines l = do {
hSetBuffering stdout LineBuffering;
mapM_ putStrLn l;
};

showlines :: (Show a) => [a] -> IO();
showlines = map show >>> printlines;

newtype Index = Index Ii deriving (Show, Ord, Eq, Enum);
-- Enum provides succ

newtype Startfactorial = Startfactorial Index deriving (Show);
demostartfactorial :: Startfactorial;
demostartfactorial = makestartfactorial 1;

-- least significant digit is mod (startfactorial!).

-- startfactorial=1 makes the least significant digit always 0, which does not convey any information.

-- 6 items, 4 slots, 6 * 5 * 4 * 3 = 360, startfactorial=3, can encode numbers 0..359

makestartfactorial :: Ii -> Startfactorial;
makestartfactorial x = Startfactorial $ toindex x;

newtype Littleendian = Littleendian [Ii] deriving (Show, Eq);
-- do not derive an Ord instance because lexicographic sort is different from numerical.
-- I think the elements of the list could also be of type Index.

-- we do not define this with record syntax because it makes "Show" noisy.
unli :: Littleendian -> [Ii];
unli (Littleendian x)=x;

-- output is little endian
integertofactorialbase :: Startfactorial -> Ii -> Littleendian;
integertofactorialbase (Startfactorial startfactorial) = go startfactorial >>> Littleendian where {
 go :: Index -> Ii -> [Ii];
 go _ 0 = [];
 go base n = case divMod n $ fromindex base of {
  (q,r) -> r:go ( succ base) q;
 };
};

-- little endian
factorialbasetointeger :: Startfactorial -> Littleendian -> Ii;
factorialbasetointeger (Startfactorial startfactorial) = unli >>> go startfactorial where
{ go :: Index -> [Ii] -> Ii
; go _ [] = 0;
; go base (h:t) = h + fromindex base*(go (succ base) t)
-- perhaps this could be improved with an accumulator
};

newtype Bigendian = Bigendian [Ii] deriving (Show,Eq);
-- lexicographic sort is not the same as numeric sort because longer strings are larger, so we do not derive Ord.

-- we do not define this with record syntax because it makes "Show" noisy.
unbi :: Bigendian -> [Ii];
unbi (Bigendian x)=x;

littletobig :: Maybe Ii -> Littleendian -> Bigendian;
littletobig pad (Littleendian x) = (case pad of
{ Nothing -> x
; Just width -> if width < List.genericLength x
then error $ "ERROR: actual size ("++ show (length x) ++") is greater than requested pad size (" ++ show width ++ ")"
else x ++ repeat 0 & List.genericTake width
}) & reverse & Bigendian;

calculatepad :: Startfactorial -> Ii -> Ii;
calculatepad (Startfactorial start) alphabetsize = alphabetsize - (fromindex start)+1 ;

type Seti = Set Index;

fromindex :: Index -> Ii;
fromindex (Index x)=x;

toindex :: Ii -> Index;
toindex = Index;

factorialbasetopermutation :: Startfactorial -> Bigendian -> (Index,[Index]);
factorialbasetopermutation (Startfactorial startfactorial) (Bigendian bi) = let
{ highestbase :: Index
; highestbase = if null bi then startfactorial -- this is an arbitrary choice; there are many encodings of zero.
else enumFrom startfactorial & zip bi & last & snd;
; go :: (Seti,[Ii]) -> Maybe (Index,(Seti,[Ii]))
; go (_,[]) = Nothing
; go (set, bigdigit:rest) = let
{ gotindex :: Index
; gotindex = Set.elemAt (fromInteger bigdigit) set
; newset :: Seti
; newset = Set.deleteAt (fromInteger bigdigit) set
} in Just (gotindex,(newset,rest))
} in (highestbase, List.unfoldr go (makeset highestbase, bi));

makeset :: Index -> Seti;
makeset highestbase = enumFrom (Index 0) & List.genericTake (highestbase & fromindex) & Set.fromAscList;

permutationtofactorialbase :: (Index,[Index]) -> Bigendian;
permutationtofactorialbase (highestbase,permu) = let
{ go :: (Seti,[Index]) -> Maybe (Ii,(Seti,[Index]))
; go (_,[]) = Nothing
; go (myset,bigperm:rest) = let
{ foundindex :: Int
; foundindex = Set.findIndex bigperm myset
; newset :: Seti
; newset = Set.delete bigperm myset
} in Just (toInteger foundindex,(newset,rest))
} in List.unfoldr go (makeset highestbase,permu) & Bigendian;

bigtolittle :: Bigendian -> Littleendian;
bigtolittle (Bigendian bi) = dropWhile (\x->x==0) bi & reverse & Littleendian;

type Arraylookup a = Array Int a;

makearray :: [a] -> Arraylookup a;
makearray l = Array.listArray (0,length l-1) l;

permutationtolabels :: forall a . [a] -> [Index] -> [a];
permutationtolabels labels indices = let
{ labelarray :: Arraylookup a
; labelarray = makearray labels
; dolookup :: Index -> a
; dolookup inin = labelarray Array.! (inin & fromindex & fromInteger)
} in map dolookup indices;

type Maplookup a = Map a Index;

makemap :: (Ord a) => [a] -> Maplookup a;
makemap l = let
{ collision :: Index -> Index -> Index
; collision x y = error $ "same label for outputs "++show x++" and "++ show y
} in zip l ([0..]& map toindex) & Map.fromListWith collision;

labelstopermutation :: forall a . (Ord a) => [a] -> [a] -> (Index,[Index]);
labelstopermutation labels inpermutation = let
{ revmap :: Map a Index
; revmap = makemap labels
; highestindex :: Index
; highestindex = List.genericLength labels & toindex;  -- not sure
} in (highestindex, map (\x -> revmap Map.! x) inpermutation);

twicealphabet :: String;
twicealphabet = ['a'..'z'] ++ ['A'..'Z'];

demoalphabet :: String;
demoalphabet = twicealphabet;

{-
*Main> :set +s
*Main> [0..10^6] & map (test demostartfactorial Nothing) & map snd & and
True
(43.71 secs, 28,175,277,688 bytes)
-}
test :: Startfactorial -> Maybe Ii -> Ii
 -> ((Ii, Startfactorial, Littleendian, Bigendian, (Index, [Index]),Bigendian, Littleendian, Ii),
 Bool);
test startfactorial pad (x :: Ii) = let
{ li :: Littleendian
; li = integertofactorialbase startfactorial x
; bi :: Bigendian
; bi = littletobig pad li
; permu :: (Index,[Index])
; permu = factorialbasetopermutation startfactorial bi
; outbi :: Bigendian
; outbi = permutationtofactorialbase permu
; outli :: Littleendian
; outli = bigtolittle outbi
; outint :: Ii
; outint = factorialbasetointeger startfactorial outli
} in ((x,startfactorial,li,bi,permu,outbi,outli,outint),x == outint);

demoitoa :: Ii -> String;
demoitoa = let
{ pad :: Ii;
; pad = calculatepad demostartfactorial $ List.genericLength demoalphabet;
} in integertofactorialbase demostartfactorial >>> littletobig (Just pad) >>> factorialbasetopermutation demostartfactorial >>> snd >>> permutationtolabels demoalphabet;

demoatoi :: String -> Ii;
demoatoi = labelstopermutation demoalphabet >>> permutationtofactorialbase >>> bigtolittle >>> factorialbasetointeger demostartfactorial;
} --end