Peaks and Valleys

In [1]:

    

import Data.List (sort)


    

In [2]:

    

peaksAndValleys :: Ord a => [a] -> [a]
peaksAndValleys =
    let 
        swapPairs :: [b] -> [b]
        swapPairs (y1:y2:ys) = y2 : y1 : swapPairs ys
        swapPairs ys = ys
    in
        swapPairs . sort


    

In [3]:

    

peaksAndValleys' :: Ord a => [a] -> [a]
peaksAndValleys' =
    let
        sortFirst :: Ord b => [b] -> [b]
        sortFirst [y1, y2, y3]
            | y1 < y2 = [y1, y2, y3]
            | otherwise = [y2, y1, y3]

        sortLast :: Ord b => [b] -> [b]
        sortLast [y1, y2, y3]
            | y2 < y3 = [y1, y2, y3]
            | otherwise = [y1, y3, y2]

        sortTriple = sortFirst . sortLast . sortFirst

        reorderElems :: Ord b => [b] -> [b]
        reorderElems (y1:y2:y3:ys) =
            let
                [smallest, middle, largest] = sortTriple [y1, y2, y3]
            in
                largest : smallest : reorderElems (middle:ys)
                
        reorderElems [y1, y2] = [max y1 y2, min y1 y2]

        reorderElems [y] = [y]
        reorderElems [] = []
        
    in
        reorderElems


    

In [4]:

    

import Test.QuickCheck


    

In [5]:

    

isAlternatingSequence :: Ord a => [a] -> Bool
isAlternatingSequence xs =
    let
        startsWithPeak :: Ord b => [b] -> Bool
        startsWithPeak (y1:y2:ys) = y1 >= y2 && startsWithValley (y2:ys)
        startsWithPeak _ = True
        
        startsWithValley :: Ord b => [b] -> Bool
        startsWithValley (y1:y2:ys) = y1 <= y2 && startsWithPeak (y2:ys)
        startsWithValley _ = True
    in
        startsWithPeak xs || startsWithValley xs


    

In [6]:

    

isAlternatingSequence [5, 3, 1, 2, 3]
isAlternatingSequence [5, 1, 3, 2, 3]


    

    






False






    






True

In [7]:

    

testPeaksAndValleys :: ([Int] -> [Int]) -> [Int] -> Bool
testPeaksAndValleys f xs =
    let
        xs' = f xs
    in
        isAlternatingSequence xs' && sort xs == sort xs'


    

In [8]:

    

quickCheck $ testPeaksAndValleys peaksAndValleys


    

    






+++ OK, passed 100 tests.

In [9]:

    

quickCheck $ testPeaksAndValleys peaksAndValleys'


    

    






+++ OK, passed 100 tests.