Posts Tagged ‘longest’

Programming Praxis – Longest Substring Of Two Unique Characters

June 11, 2013

In today’s Programming Praxis exercise, our goal is to find the longest substring consisting of only two characters in a string. Let’s get started, shall we?

import Data.List

First, we group identical characters together and then take all the tails so that each tail starts with two unique groups of characters. This is to eliminate the need for special logic for cases where a substring starts with two identical characters. For each tail, we discard everything starting from the third unique letter. Of the remaining groups, we look for the longest one, giving preference to ones on the right.

lstuc :: Eq a => [a] -> [a]
lstuc xs = foldr (\x a -> if length x > length a then x else a) []
           [concat $ a:b:takeWhile (flip elem [head a, head b] . head) cs
           | (a:b:cs) <- tails $ group xs]

Some tests to see if everything is working properly:

main :: IO ()
main = do print $ lstuc "abcabcabcbcbc" == "bcbcbc"
          print $ lstuc "abababcabc"    == "ababab"
          print $ lstuc "abcacacabc"    == "cacaca"
          print $ lstuc "acacbdbd"      == "bdbd"
          print $ lstuc "aaccbdb"       == "aacc"
          print $ lstuc ""              == ""
Advertisements

Programming Praxis – Longest Duplicated Substring

December 14, 2010

In today’s Programming Praxis exercise, our task is to implement the algorithm to find the longest duplicated substring in a word. Let’s get started, shall we?

Some imports:

import Data.List
import Data.List.HT (mapAdjacent)
import qualified Data.List.Key as K

It seems we have yet another case of simply translating the English description to Haskell syntax: create a list of suffixes, sort, get the longest common prefix of all adjacent pairs and return the longest one.

lds :: Ord a => [a] -> [a]
lds = K.maximum length . mapAdjacent lcp . sort . tails where
    lcp (x:xs) (y:ys) | x == y = x : lcp xs ys
    lcp _      _               = []

Some tests to see if everything is working properly:

main :: IO ()
main = do print $ lds "banana"
          print $ lds "ask not what your country can do for you, \
                      \ask what you can do for your country"

Everything seems to be working fine.

Programming Praxis – Find The Longest Palindrome In A String

October 15, 2010

In today’s Programming Praxis exercise, our goal is to write an alogrithm to find the longest palindrome in a string. Let’s get started, shall we?

Some imports:

import qualified Data.ByteString.Char8 as B
import qualified Data.List.Key as K

Since the exercise is originally part of a group of 3 that is supposed to be completed in 20 minutes to 2 hours, I’m going to assume I don’t have time to figure out a fancy but complicated suffix trie-based approach. Below is the version I wrote in a minute or two, with two modifications:

1. The list comprehensions was originally a filter and a concatMap. Same thing, but different syntax. I like this version better.
2. The original worked on plain strings and ran in 8 seconds or so. Switching to ByteStrings speeds things up quite a bit and is trivial to do, requiring only a few additions of “B.”.

The algorithm is pretty trivial: get every possible substring, check if it’s a palindrome and return the longest one.

longestPalindrome :: B.ByteString -> B.ByteString
longestPalindrome s = K.maximum B.length
    [p | p <- B.inits =<< B.tails s, p == B.reverse p]

We test the algorithm on the Gettysburg Address.

gettysburg :: B.ByteString
gettysburg = B.pack
    "Fourscoreandsevenyearsagoourfaathersbroughtforthonthisconta\
    \inentanewnationconceivedinzLibertyanddedicatedtotheproposit\
    \ionthatallmenarecreatedequalNowweareengagedinagreahtcivilwa\
    \rtestingwhetherthatnaptionoranynartionsoconceivedandsodedic\
    \atedcanlongendureWeareqmetonagreatbattlefiemldoftzhatwarWeh\
    \avecometodedicpateaportionofthatfieldasafinalrestingplacefo\
    \rthosewhoheregavetheirlivesthatthatnationmightliveItisaltog\
    \etherfangandproperthatweshoulddothisButinalargersensewecann\
    \otdedicatewecannotconsecratewecannothallowthisgroundThebrav\
    \elmenlivinganddeadwhostruggledherehaveconsecrateditfarabove\
    \ourpoorponwertoaddordetractTgheworldadswfilllittlenotlenorl\
    \ongrememberwhatwesayherebutitcanneverforgetwhattheydidhereI\
    \tisforusthelivingrathertobededicatedheretotheulnfinishedwor\
    \kwhichtheywhofoughtherehavethusfarsonoblyadvancedItisrather\
    \forustobeherededicatedtothegreattdafskremainingbeforeusthat\
    \fromthesehonoreddeadwetakeincreaseddevotiontothatcauseforwh\
    \ichtheygavethelastpfullmeasureofdevotionthatweherehighlyres\
    \olvethatthesedeadshallnothavediedinvainthatthisnationunsder\
    \Godshallhaveanewbirthoffreedomandthatgovernmentofthepeopleb\
    \ythepeopleforthepeopleshallnotperishfromtheearth"

main :: IO ()
main = B.putStrLn $ longestPalindrome gettysburg

As expected, we get ranynar as the answer. Sure, it’s an O(n3) algorithm, but since this is a fairly short text it doesn’t matter all that much, as evidenced by the half-second running time. If you’re working with longer inputs, use a different algorithm.

Programming Praxis – Longest Common Subsequence

June 9, 2009

Today‚Äôs Programming Praxis problem is about finding the longest common subsequence of two sequences, and our target is 23 lines. Let’s go.

Our import:

import Data.Array

Hackage doesn’t seem to have an easily installable matrix package (hmatrix needs some C libraries), so we’re going to use an Array of Arrays to represent the grid of numbers. We’re going to define a little convenience function to access elements in the 2D array.

at :: Int -> Int -> Array Int (Array Int e) -> e
at x y a = a ! y ! x

And the longest common subsequence function itself.

lcs :: Eq a => [a] -> [a] -> [a]
lcs xs ys = reverse $ walk imax jmax where
    imax = length xs
    jmax = length ys
    ax = listArray (1, imax) xs
    ay = listArray (1, jmax) ys
    ls = listArray (0, jmax) [listArray (0, imax)
               [lcs' i j | i <- [0..imax]] | j <- [0..jmax]]

    lcs' 0 _ = 0
    lcs' _ 0 = 0
    lcs' i j | ax ! i == ay ! j = 1 + at (i-1) (j-1) ls
             | otherwise        = max (at (i-1) j ls) (at i (j-1) ls)

    walk 0 _ = []
    walk _ 0 = []
    walk i j | at (i-1) j ls == at i j ls = walk (i-1) j
             | at i (j-1) ls  < at i j ls = ax ! i : walk i (j-1)
             | otherwise                  = walk i (j-1)

And the usual test:

main :: IO ()
main = print $ lcs "programming" "praxis"

19 lines. Not much of an improvement. More importantly, the speed is far from optimal. The lcs in Data.List.LCS is considerably faster (though considerably longer). If anyone knows a better version, I’m all ears.