X-Git-Url: https://git.cyclocoop.org/?p=tool%2Fhledger.git;a=blobdiff_plain;f=hledger-range-voting.hs;fp=hledger-range-voting.hs;h=0000000000000000000000000000000000000000;hp=2bcc33001647a9e01843abf24f303c907ab56ed2;hb=707b0a621cd3c97d5d7e22e855272b3f865a2d56;hpb=30e9b83c521f5149836e1ef0b544676370721efe

diff --git a/hledger-range-voting.hs b/hledger-range-voting.hs
deleted file mode 100755
index 2bcc330..0000000
--- a/hledger-range-voting.hs
+++ /dev/null
@@ -1,201 +0,0 @@
-#!/usr/bin/env runhaskell
-{-|
-hledger-range-voting [-f JOURNALFILE]
-
-Perform range voting calculus
-on the default or specified journal.
-|-}
-
-import Data.List
---import Data.List (mapAccumL)
-import Data.Maybe
-import Data.Ord
-import Data.Time.Calendar
-import System.Console.CmdArgs.Explicit
-import Text.Printf
-import qualified Data.Map as Map
-
-import Hledger
-import Hledger.Cli
-import Hledger.Cli.Options
--- import Prelude hiding (putStr)
-import Hledger.Utils.UTF8IOCompat (putStr)
-
-
-argsmode :: Mode RawOpts
-argsmode = (defCommandMode ["range-voting"])
-	{ modeHelp = "perform range voting"
-	, modeGroupFlags = Group
-		{ groupNamed =
-			[ ("Input",inputflags)
-			, ("Reporting",reportflags)
-			, ("Misc",helpflags)
-			]
-		, groupUnnamed = []
-		, groupHidden = []
-		}
-	}
-
-
--- like Register.summarisePostings
--- | Print various statistics for the journal.
-main :: IO ()
-main = do
-	opts <- getCliOpts argsmode
-	withJournalDo opts $
-	 \CliOpts{reportopts_=reportopts_} j -> do
-		d <- getCurrentDay
-		let q = queryFromOpts d reportopts_
-		let l = ledgerFromJournal q j
-		let reportspan = (ledgerDateSpan l) `spanDefaultsFrom` (queryDateSpan False q)
-		let intervalspans = splitSpan (intervalFromOpts reportopts_) reportspan
-		let s = intercalate "\n" $ map (showRangeVoting reportopts_{empty_=True} l d) intervalspans
-		putStr s
-
-data Stats =
-	Stats
-	 { stats_choice      :: String
-	 , stats_sum         :: Double
-	 , stats_blank_count :: Int
-	 , stats_null_count  :: Int
-	 , stats_null_value  :: Double
-	 , stats_values      :: [(Int,Int)]
-	 }
-stats :: Stats
-stats = Stats
- { stats_choice      = ""
- , stats_sum         = 0.0
- , stats_blank_count = 0
- , stats_null_count  = 0
- , stats_null_value  = 0.0
- , stats_values      = []
- }
-
-
-showRangeVoting :: ReportOpts -> Ledger -> Day -> DateSpan -> String
-showRangeVoting ropts l today span =
-	unlines $ map (\(label,value) -> concatBottomPadded [printf fmt1 label, value]) main
-	 where
-		fmt1 = "%-" ++ show w1 ++ "s: "
-		-- fmt2 = "%-" ++ show w2 ++ "s"
-		w1 = maximum $ map (length . fst) main
-		-- w2 = maximum $ map (length . show . snd) main
-		main =
-		 concat $
-		 [ [("Span vote (official)", printf "%s to %s (%d days)" (show $ (tdate opening)) (show $ (tdate2 opening)) votedays)
-			 ,("Span vote (actual)", printf "%s to %s (%d days)" (start span) (end span) days)
-			 ,("Cardinal", printf "%d" cardinal)
-			 ,("Values", "{"++(intercalate "," $ map (printf "%d") values)++"}")
-			 ,("Quorum", printf "%d/%d (%f%%)" votesnum votersnum (fromIntegral votesnum*100.0/fromIntegral votersnum::Double))
-			 ,("Blanks", printf "%d" $ foldl (\acc t -> acc + stats_blank_count t) 0 stats)
-			 ,("Nulls", printf "%d" $ foldl (\acc t -> acc + stats_null_count t) 0 stats)
-			 ,("Medians", "")
-			 ]
-		 , map (\t ->
-			( printf "  - %s" (stats_choice t)
-			, printf "sum: %+.f" (stats_sum t)
-			) ) medians
-		 , [("Choices", printf "%d" nchoices)
-			 ]
-		 , map
-			 (\t ->
-				( printf "  - %s" (stats_choice t)
-				, printf "sum: %+f = %d*(0:blank) + %d*(%+.2f:null) + %s"
-					 (stats_sum t)
-					 (stats_blank_count t)
-					 (stats_null_count t)
-					 (stats_null_value t)
-					 (intercalate " + " $ map (\(value,sum) -> printf "%d*(%+d)" sum value) (stats_values t))
-				)
-			 ) stats
-		 --,("Commodities", printf "%s (%s)" (show $ length cs) (intercalate ", " cs))
-		 ]
-		 where
-			j = ljournal l
-			ts = sortBy (comparing tdate) $ filter (spanContainsDate span . tdate) $ jtxns j
-			as = nub $ map paccount $ concatMap tpostings ts
-			cs = Map.keys $ canonicalStyles $ concatMap amounts $ map pamount $ concatMap tpostings ts
-			showelapsed Nothing = ""
-			showelapsed (Just days) = printf " (%d %s)" days' direction
-				where days' = abs days
-				      direction | days >= 0 = "days ago" :: String
-				                | otherwise = "days from now"
-			start (DateSpan (Just d) _) = show d
-			start _ = ""
-			end (DateSpan _ (Just d)) = show d
-			end _ = ""
-			days = fromMaybe 0 $ daysInSpan span
-			votedays = fromMaybe 0 $ daysInSpan
-			 (DateSpan
-				 (Just (tdate opening))
-				 (maybe Nothing Just (tdate2 opening)))
-			acctnum = length as
-			openings = filter ((== "Opening") . tdescription) $ ts
-			opening | null openings = error' "\"Opening\" transaction is missing"
-			        | otherwise     = head $ openings
-			cardinals = filter ((== "Cardinal") . fst) $ ttags opening
-			cardinal | null cardinals = error' "\"Cardinal\" tag is missing on \"Opening\" transaction"
-			         | otherwise      = read $ snd $ head $ cardinals :: Int
-			values | (cardinal `mod` 2 == 0) = delete 0 [-cardinal`div`2..cardinal`div`2]
-			       | otherwise               = [-(cardinal-1)`div`2..(cardinal-1)`div`2]
-			choices =
-				map paccount $
-				filter (isPrefixOf "Choice:" . paccount) $
-				tpostings opening
-			
-			votes = filter ((== "Vote") . tdescription) $ ts
-			stats =
-				sortBy (\a b -> (stats_sum b) `compare` (stats_sum a)) $
-				map (\s ->
-					let mean = fromIntegral (foldl (\acc (v,c) -> acc + (v * c)) 0 (stats_values s)) / fromIntegral (length (stats_values s)) in
-					s
-					 { stats_null_value = mean
-					 , stats_sum        = (stats_sum s) + (mean * fromIntegral (stats_null_count s))
-					 }) $
-				foldl (\s vote ->
-					map (\s ->
-						case filter ((== stats_choice s) . paccount) (tpostings vote) of
-						 [] -> s { stats_blank_count = stats_blank_count s + 1 }
-						 [choice_posting] ->
-							case pamount choice_posting of
-							 Mixed [Amount{acommodity="", aquantity=q, aprice=NoPrice}] ->
-								let i = floor q in
-								if snd (properFraction q) == 0.0 && i `elem` values
-								then s
-									 { stats_sum    = stats_sum s + fromIntegral i
-									 , stats_values = map (\(v,c) -> if v == i then (v,c+1) else (v,c)) (stats_values s)
-									 }
-								else s { stats_null_count = stats_null_count s + 1 } -- error' $ printf "TODO: null vote: invalid value: %f" q
-							 _ ->  s { stats_null_count = stats_null_count s + 1 } -- error' "TODO: null vote: too much informations"
-						 _ ->    s { stats_null_count = stats_null_count s + 1 }
-					 )
-					 s
-				 )
-				 [ Stats
-					{ stats_choice      = choice
-					, stats_sum         = 0.0
-					, stats_blank_count = 0
-					, stats_null_count  = 0
-					, stats_null_value  = 0.0
-					, stats_values      = [(value,0) | value<-values]
-					}
-				 | choice<-choices ]
-				 votes
-			
-			medians =
-				filter (\c -> stats_sum c `elem` medians) stats
-				 where medians =
-					if length choices `mod` 2 == 0
-					then map (stats_sum . (!!) stats) [nchoices `div` 2 - 1, nchoices `div` 2 + 1]
-					else map (stats_sum . (!!) stats) [(nchoices - 1) `div` 2]
-				
-			nchoices = length choices
-			
-			-- choicesbalancesropts = ropts{query_="Choice:"}
-			-- choicesbalances = tail $ fst $ balanceReport ropts (queryFromOpts today choicesbalancesropts) j
-			
-			voteras = filter (isPrefixOf "Voter:" . paccount) $ tpostings opening
-			votests = filter ((== "Vote") . tdescription) $ ts
-			votesnum = length votests
-			votersnum = length voteras
-			votechoicesps = filter (isPrefixOf "Choice:" . paccount) $ tpostings opening