np-linear-0.1.1.1: src/Auxiliary.hs

{-# LANGUAGE NoImplicitPrelude #-}
module Auxiliary where


import           Algebra.Additive    (zero)
import qualified Algebra.Ring
import           Algebra.Ring        (one)
import           NumericPrelude

import           Control.Applicative ((<$>))
import           Control.Arrow       (second)


adorn :: (Algebra.Ring.C k,Eq k) => [[k]] -> [[k]]
adorn vs = map f . zip [1 .. n] $ vs where
  f (i,v) = v ++ map (δ i) [1 .. n]
  n = length vs

δ :: (Eq a,Algebra.Ring.C k) => a -> a -> k
δ i j
  | i == j    = one
  | otherwise = zero

findAmong :: (a -> Bool) -> [a] -> Maybe (a,[a])
findAmong p [] = Nothing
findAmong p (x : xs)
  | p x       = Just (x,xs)
  | otherwise = second (x :) <$> findAmong p xs

minimumAmong :: (a -> a -> Ordering) -> [a] -> Maybe (a,[a])
minimumAmong _ []  = Nothing
minimumAmong _ [x] = Just (x,[])
minimumAmong (~~) (x : y : xs) = fmap (second (l :)) $ minimumAmong (~~) (s : xs) where
  (s,l) 
    | x ~~ y == LT = (x,y)
    | otherwise    = (y,x)

headE _ (x : _) = x
headE s _       = error s