nats = [1..]

natPairLists =
    (map (\x -> map (\y -> (x, y)) nats) nats)

diagPairs =
    concat (map (\d -> map (\x -> (x, d - x)) [1 .. d-1]) nats)

generateExponents k l =
    --map (\natPairs -> map (\(x,y) -> x^k * y^l) natPairs) natPairLists
    map (\(x,y) -> x^k * y^l) diagPairs


insertionSort :: Ord a => [a] -> [a]
--insertionSort :: [Int] -> [Int]
insertionSort xs = foldr insert [] xs
  where
    insert x [] = [x]
    insert x (y:ys)
      | x <= y = x : y : ys
      | otherwise = y : insert x ys


allEqualHelper :: Int -> [[Int]] -> [Int -> Int] -> [Int]
allEqualHelper _ [] [] = []
allEqualHelper expectedFx (l:ls) (f:fs) =
    decide (filter (\x -> f x == expectedFx) l)
    where
        decide [] = []
        decide (y:ys) = y : allEqualHelper expectedFx ls fs

zeroOrOne [] = []
zeroOrOne (x:_) = x

allEqual [] [] = []
allEqual (l:ls) (f:fs) =
    zeroOrOne
      $ filter (/= [])
      $ map callHelp l
    where
        callHelp x =
          let help = allEqualHelper (f x) ls fs
           in if help == []
              then []
              else x : help
        callHelp2 x =
          case allEqualHelper (f x) ls fs of
            [] -> []
            help -> x : help
   
test1 = allEqual [[1,2], [3,4], [5,6]] [(+1), id, (8-)]
-- [2,3,5]



type Name = String
type Amount = Int
type Medicine = (Name, [Ingredient])
type Ingredient = (Name, Amount)

fullAmount :: [Ingredient] -> Amount
fullAmount ingr = sum $ map snd ingr

--data Maybe a = Nothing | Just a
-- (assoc k l) in Scheme = (cons k v) or #f
lookup' :: Eq a => a -> [(a, b)] -> Maybe b
lookup' _ [] = Nothing
lookup' x ((k,v):kvs)
  | x == k = Just v
  | otherwise = lookup' x kvs

isSubstitute :: Medicine -> Medicine -> Bool
isSubstitute (_, ingrA) (_, ingrB) =
    and $ map searchIngr ingrA
    where
      searchIngr (name, amountA) =
        case lookup name ingrB of
            Nothing -> False
            Just amountB ->
                let
                  aFr = fromIntegral amountA / fromIntegral fullAmountA
                  bFr = fromIntegral amountB / fromIntegral fullAmountB
                in aFr == bFr

      fullAmountA = fullAmount ingrA
      fullAmountB = fullAmount ingrB

l = [("A",[("p",6),("q",9)]),("B",[("p",2),("q",3)]),("C",[("p",3)])]

test2 = isSubstitute (l!!0) (l!!1)

argMin :: (Medicine -> Int) -> [Medicine] -> Name
argMin _ [] = ""
argMin _ [x] = fst x
argMin f (x:y:xs) =
    if f x <= f y
    then argMin f (x : xs)
    else argMin f (y : xs)

bestSubstitute a l =
    argMin diff $ filter notOver $ filter (\b -> isSubstitute b a) l
    where
        (_, ingrA) = a
        notOver :: Medicine -> Bool
        notOver (_, ingrB) =
            all (\(nameA, amountA) ->
                    case lookup nameA ingrB of
                        Nothing ->
                            True
                        Just amountB ->
                            amountB <= amountA)
                ingrA

        diff :: Medicine -> Int
        diff (_, ingrB) =
            sum $
              map (\(nameA, amountA) ->
                    case lookup nameA ingrB of
                      Nothing -> 0
                      Just amountB ->
                          amountA - amountB)
                  ingrA


test3 = bestSubstitute (l!!0) (tail l)



groupBy [] = []
groupBy (x:xs) =
    (x : filter (\y -> isSubstitute y x) xs)
       : groupBy (filter (\y -> (not (isSubstitute y x)) xs))

Last modified: Friday, 20 January 2023, 8:17 PM