Problems? Is your data what you think it is? PerlMonks

### Re: Find Length Of Longest Ascending/Descending Sequence

by ambrus (Abbot)
 on May 09, 2011 at 21:40 UTC ( #903838=note: print w/replies, xml ) Need Help??

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);
}
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");
};

Replies are listed 'Best First'.
Re^2: Find Length Of Longest Ascending/Descending Sequence
by Fletch (Chancellor) on May 10, 2011 at 19:08 UTC

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

(len,pos,str)
(5,12,"21098")
(5,37,"45678")
(5,35,"67890")

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

The cake is a lie.
The cake is a lie.
The cake is a lie.

Create A New User
Node Status?
node history
Node Type: note [id://903838]
help
Chatterbox?
 [Corion]: Discipulus: Yeah - but when writing Perl to save time (instead of having fun), it helps to look whether you're actually saving time ;) Why spend 5 minutes doing manually what you can spend three years automating? ;) [Corion]: choroba: Oh, yeah :-D

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (6)
As of 2017-07-27 09:34 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
I came, I saw, I ...

Results (408 votes). Check out past polls.