module Controller.Menu.Statistics.Pivot (eventHandler) where import Control.Monad (when,forM_) import Data.List (nub) import Data.Maybe (mapMaybe) import Controller (Controller,onView,onGridView,onGridModel) import Controller.Canonical (addColumnExpr,addRowExpr) import qualified Controller.Grid as Grid import Controller.Dialog (warning) import View.Component.Grid (getColumnLabels) import View.Dialog.Complex (Layout (..),Widget (..),Modifier (..) ,showSimpleDialog,okButton,cancelButton) import Model.Grid (getColumnValues) import Model.CellContent (CellValue (NumberValue),valueToExpr) import qualified Model.CellExpression.Evaluator.Math as Math import Model.CellExpression.Evaluator.Common (fLength,getNumList) import Util (justWhen) import I18n (__) data Aggregator = Count | Numeric ([Double] -> Double) data Parameters = Parameters { abscissaColumn :: Maybe Int , ordinateColumn :: Maybe Int , dataColumn :: Maybe Int , aggregatorIndex :: Int , makeTotals :: Bool } defaultParams :: Parameters defaultParams = Parameters Nothing Nothing Nothing 0 True aggregatorList :: [String] aggregatorList = [ __ "Sum",__ "Mean",__ "Median",__ "Maximum" , __ "Minimum",__ "Standard Deviation",__ "Count"] aggregatorFromInt :: Int -> Aggregator aggregatorFromInt i = case i of 0 -> Numeric sum; 1 -> Numeric Math.mean 2 -> Numeric Math.median; 3 -> Numeric maximum 4 -> Numeric minimum; 5 -> Numeric Math.stdDeviation 6 -> Count typecheck :: Aggregator -> [CellValue] -> Bool typecheck aggregator values = case aggregator of Numeric _ -> either (\_ -> False) (\_ -> True) $ getNumList values _ -> True apply :: Aggregator -> [CellValue] -> CellValue apply aggregator values = case aggregator of Count -> NumberValue $ fLength values Numeric f -> let Right vs = getNumList values in NumberValue $ f vs eventHandler :: Controller () eventHandler = eventHandlerWith defaultParams eventHandlerWith :: Parameters -> Controller () eventHandlerWith params = do labels <- onGridView getColumnLabels result <- onView $ showSimpleDialog (__ "Pivot table") (dialog labels) params justWhen result $ \params' -> do success <- processParams params' when (not success) $ eventHandlerWith params' dialog :: [String] -> Layout Parameters () dialog labels = let setAbscissa p a = p {abscissaColumn = a} setOrdinate p a = p {ordinateColumn = a} setData p a = p {dataColumn = a} setAggregator p a = p {aggregatorIndex = a} setTotals p b = p {makeTotals = b} in Modifier Margin $ Column [ Row [ Modifiers [Boxed $ __ "Abscissa column",HFill] $ Widget $ SingleListBox labels abscissaColumn setAbscissa , Modifiers [Boxed $ __ "Ordinate column",HFill] $ Widget $ SingleListBox labels ordinateColumn setOrdinate , Modifiers [Boxed $ __ "Data column",HFill] $ Widget $ SingleListBox labels dataColumn setData] , Grid [[ Label $ __ "Aggregator" , Widget $ Choice aggregatorList aggregatorIndex setAggregator] ,[ Label $ __ "Make totals" , Widget $ CheckBox "" makeTotals setTotals]] , Modifier Center $ Row [okButton (),cancelButton]] processParams :: Parameters -> Controller Bool processParams params = case (abscissaColumn params,ordinateColumn params,dataColumn params) of (Nothing,_,_) -> warning (__ "No abscissa column selected") >> return False (_,Nothing,_) -> warning (__ "No ordinate column selected") >> return False (_,_,Nothing) -> warning (__ "No data column selected") >> return False (Just absCol,Just ordCol,Just dataCol) -> do abscissa <- onGridModel $ getColumnValues absCol ordinate <- onGridModel $ getColumnValues ordCol datas <- onGridModel $ getColumnValues dataCol calcPivotTable abscissa ordinate datas (aggregatorFromInt $ aggregatorIndex params) (makeTotals params) calcPivotTable :: [CellValue] -> [CellValue] -> [CellValue] -> Aggregator -> Bool -> Controller Bool calcPivotTable abscissa ordinate datas aggregator makeTotals = if not $ typecheck aggregator datas then warning (__ "Can not apply aggregator to selected data column (e.g. because of non-numeric data).") >> return False else do Grid.new let association = zip3 abscissa ordinate datas nubOrdinate = nub ordinate nubAbscissa = nub abscissa aggregateSome select = let values = mapMaybe (\(a,o,value) -> if select a o then Just value else Nothing ) association in valueToExpr $ apply aggregator values aggregate abscissaValue ordinateValue = aggregateSome $ \a o -> a == abscissaValue && o == ordinateValue aggregateAbs abscissaValue = aggregateSome $ \a _ -> a == abscissaValue aggregateOrd ordinateValue = aggregateSome $ \_ o -> o == ordinateValue forM_ nubAbscissa $ \abscissaValue -> let column = map (aggregate abscissaValue) nubOrdinate in addColumnExpr (Just $ show abscissaValue) column Grid.updateRowLabels $ map show nubOrdinate when makeTotals $ let column = map aggregateOrd nubOrdinate row = map aggregateAbs nubAbscissa all = aggregateSome (\_ _ -> True) in do addColumnExpr (Just $ __ "Total") column addRowExpr (Just $ __ "Total") $ row ++ [all] return True