Re: Find Length Of Longest Ascending/Descending Sequence

[ambrus]

Let me try to make a solution without looking at the other replies.

I apologize in advance, for such an APL-style solution translates to very ugly code in perl. It would look nicer in haskell or some ml or apl language, but I'll stick to perl in this reply. In fact the code looks a bit like some of my prolog homework, where more than half of the code is defining several generic list handling functions.

use warnings; use strict;

my $s = @ARGV ? $ARGV[0] : "82665409266027476709324472";

use List::Util qw"min";
sub zip {
    my($p, $x, $y) = @_;
    map { scalar &$p($$x[$_], $$y[$_]) } 0 .. min(@$x - 1, @$y - 1);
}
sub zipadj2 { 
    my($p, @y) = @_;
    zip $p, [@y[0 .. @y - 2]], [@y[1 .. @y - 1]];
}
sub scanr1 (&@) {
    my($p, @y) = @_;
    my @r = my $m = pop @y;
    for my $y (reverse @y) {
        unshift @r, ($m = &$p($y, $m));
    }
    @r;
}
sub maxind {
    my(@y) = @_;
    my($p, $m) = (0, $y[0]);
    for my $i (1 .. @y - 1) {
        if ($m < $y[$i]) { ($p, $m) = ($i, $y[$i]); }
    }
    wantarray ? ($p, $m) : $p;
}

my @s = split //, $s;
my @d = map { do { no integer; $_ % 10 } } 
    zipadj2 sub { my($a, $w) = @_; $a - $w }, @s;
my $lu = sub { 
    my($k) = @_;
    my($p, $m) = maxind scanr1 sub { my($x, $y) = @_; $x * (1 + $y) },
+ 
        map { $k == $_ } @d;
    $p, $m + 1;
};
my($p1, $l1) = &$lu(1); # decreasing
my($p9, $l9) = &$lu(9); # increasing
my($p, $l) = $l9 <= $l1 ? ($p1, $l1) : ($p9, $l9);
print "The longest subsequence you want starts at position ", $p, 
    " and has length ", $l, " and its contents are (",
    join("", @s[$p .. $p + $l - 1]), ").\n";
my $v = $s;
substr $v, $p + $l, 0, ")";
substr $v, $p, 0, "(";
print "In context, it's here: ", $v, ".\n";

__END__

Update: thanks for the test cases, wind.

Update: It turns out, it comes out pretty ugly and long in Haskell too. (Maybe that's because I don't have too much practice in Haskell.)

import Data.Char (digitToInt, intToDigit);
import Data.List (elemIndex);
import Data.Maybe (fromJust);
import System (getArgs);

egin :: String;
egin = "82665409266027476709324472";

zipadj2 :: (a -> a -> b) -> [a] -> [b];
zipadj2 p y = zipWith p (init y) (tail y);

main = do {    
    args <- getArgs;
    let { 
        ss = head (args ++ [egin]); 
        s = map digitToInt ss;
        d = map (flip mod 10) (zipadj2 (-) s);
        gr x y = x * succ y;
        lu k = let {
            h = scanr1 gr (map (fromEnum . (k ==)) d :: [Int]);
            mh = maximum h;
        } in (fromJust (elemIndex mh h), succ mh);
        pl1@(_, l1) = lu 1;
        pl9@(_, l9) = lu 9;
        (p, l) = if l9 <= l1 then pl1 else pl9;
        fs = map intToDigit;
    };
    putStr ("The longest subsequence you want starts at position " ++ 
        show p ++ " and has length " ++ show l ++ " and its contents a
+re (" ++
        fs (take l (drop p s)) ++ ").\n" ++ 
        "In context, it's here: " ++
        fs (take p s) ++ "(" ++ fs (take l (drop p s)) ++ ")" ++
        fs (drop l (drop p s)) ++ ".\n");
};

[Fletch]

My haskell approach. Only prints the length and the longest substring which I think was the original problem. And there's probably a module function that does take2While that I just don't know about.

import Data.List (sort,tails)

isAscP x y | succ x == y        = True
isAscP x y | x == '9', y == '0' = True
isAscP _ _                      = False

isDescP x y | succ y == x        = True
isDescP x y | x == '0', y == '9' = True
isDescP _ _                      = False

take2While :: (a -> a -> Bool) -> [a] -> [a]
take2While _ []     = []
take2While _ (x:[]) = [x]
take2While p (x:xs@(y:ys)) | p x y == True = x : take2While p xs
                           | otherwise     = [x]

longestSeq p s = last . sort . map (\x -> (length x, x)) . map (take2W
+hile p) $ tails s
longestAsc s   = longestSeq isAscP s
longestDesc s  = longestSeq isDescP s

main = do
  mapM_ print $ map ( \x -> last $ sort [ longestAsc x, longestDesc x 
+] ) test_data

test_data = ["46177162136821098372191324396358023311290325514995512037
+4576",
             "41218287161128572793732981048741734764567889966242600855
+8163",
             "80644516862271572985414541535685057678903372416444198119
+0358",
             "73799320594284321094463204375578307048769141937606874852
+0835",
             "79783673261130165104915794140267749392590890126803346772
+1123",
             "80034367333583441342569006349963696554752767153578901036
+0222",
             "36455695473823274009541290542819284921805886986823415432
+1153",
             "65688601631846538985084526162069491656561155920969515432
+1950",
             "43982308548391881824360236063248675793848336789046458690
+9210",
             "27501082572643841973404198765708516277381582187277161932
+2197",
             "36286200318698643562895639299746227057153878528789011116
+5953",
             "86578896980048397890987639695689642805948383465444378364
+0994",
             "08494326244468225664919617082669975678940469991751181340
+4654",
             "03802243561219785083513947890147183878904240719985858365
+4421",
             "24471232554189661569782092544273572763854030957460498432
+1042",
             "79927259366563301479296432100629590729754503939144233930
+9443",
             "87513484093393755250506962456969217890137276421097350124
+0868",
             "16060437323320876543354855484294170848344644764967947362
+3104",
             "78796640372485356789004027625810549218342470476191585852
+4942",
             "23456532982436100867707549226413076264717737053820267894
+9041" ]

Produces the same strings as the first response for the same test data.

$ runhaskell ascruns.hs
(5,"21098")
(5,"45678")
(5,"67890")
(6,"432109")
(5,"89012")
(5,"78901")
(5,"54321")
(5,"54321")
(5,"67890")
(5,"98765")
(5,"78901")
(5,"09876")
(5,"56789")
(5,"78901")
(5,"43210")
(5,"43210")
(5,"78901")
(6,"876543")
(6,"567890")
(5,"23456")

Update: Revised version that produces offsets as well as being a bit shorter terser (thanks ambrus for maximum vice last . sort)

longestSeq p s = maximum tuples
                 where ts = tails s
                       runs = map (take2While p) ts
                       tuples = zip3 (map length runs) [0..] runs

$ runhaskell ascruns.hs | head -n 4
(len,pos,str)
(5,12,"21098")
(5,37,"45678")
(5,35,"67890")

Further Duh: isDescP is really just flip isAscP . . .