Hi all !
The problem seemed like too much fun so I made my own version. See
below. You will have to fix rows cut by the mail system to run it.
It handles 10000 numbers in some minutes on my computer.
All comments are welcome.
Cheers,
Erling
NB. Draws numbers from the end of the sequence. Each number is placed in
one or more groups.
NB. If the number is less than or equal to the first number in a group
this group is duplicated and
NB. the new number placed first in one of the two groups.
NB. If the number is not less than or equal to the first number in any
group a new group is
NB. created with only this number.
NB. Of the resulting groups which now starts with the new number the
longest group is selected.
NB. All groups which do not start with the new number are kept.
NB. When all numbers are drawn the longest remaining group is selected.
LargestIncreasingSubsequence=: [: SelectFirstGroupOfMaxLength [: > [:
([: DoBetweenElementsInFold&.> / PackElements ,
GroupOfEmptyGroupInitialState) ]
PackElements=: <@+
GroupOfEmptyGroupInitialState=: [: < a:"_
DoBetweenElementsInFold=: [ (( LeftIsNotFirstInGroup +.
FirstGroupOfMaxLenghtInGroupsWithLeftFirstInGroup) # ]
)AppendGroupsWithEmptyLeftOrGroupsWithLeftAppendedFirst
AppendGroupsWithEmptyLeftOrGroupsWithLeftAppendedFirst=: ] , [
AddGroupWIthLeftIfNoGroups [ PrependLeftInGroups
SelectGroupsWithLeftLessOrEqualToFirstElement
SelectGroupsWithLeftLessOrEqualToFirstElement=:([: , [ <: [: (1 {. ])@>
]) # ]
PrependLeftInGroups=: ( [: < [) ,&.> ]
AddGroupWIthLeftIfNoGroups=:(((0 = [: # ]) {. [: < [),])
FirstGroupOfMaxLenghtInGroupsWithLeftFirstInGroup=:[:
FirstGroupOfMaxLength LengthOfGroups * LeftIsFirstInGroup
LeftIsFirstInGroup=: [: , [ = [: (1 {. ])@> ]
LengthOfGroups=:([: #@> ])
FirstGroupOfMaxLength=: [: </\ [ = '' $ [: >./ ]
LeftIsNotFirstInGroup=: [: , [ ~: [: ( 1 {. ])@> ]
SelectFirstGroupOfMaxLength=:([: FirstGroupOfMaxLength ([: #@> ]))#]
PackElements 6 1 3 4 2 8
GroupOfEmptyGroupInitialState ''
2 DoBetweenElementsInFold (<1 2 3),<4 5
2 AppendGroupsWithEmptyLeftOrGroupsWithLeftAppendedFirst (<1 2 3),<4 5
1 AppendGroupsWithEmptyLeftOrGroupsWithLeftAppendedFirst (<1 2 3),<4 5
8 AppendGroupsWithEmptyLeftOrGroupsWithLeftAppendedFirst (<1 2 3),<4 5
2 SelectGroupsWithLeftLessOrEqualToFirstElement (<1 2 3),<4 5
2 PrependLeftInGroups <4 5
2 AddGroupWIthLeftIfNoGroups 0 {. <i.0
2 AddGroupWIthLeftIfNoGroups , <1 2
2 FirstGroupOfMaxLenghtInGroupsWithLeftFirstInGroup (<2),(<2 4 5),<2 6 7
2 LeftIsFirstInGroup (<1 2 3),<2 4 5
2 LengthOfGroups (<1 2 3),<2 4 5
FirstGroupOfMaxLength 3 3
2 LeftIsNotFirstInGroup (<1 2 3),<2 4 5
2 LeftIsNotFirstInGroup (<1 2 3),<2 4 5
SelectFirstGroupOfMaxLength (<2),(<2 4 5),<2 6 7
LargestIncreasingSubsequence=: LargestIncreasingSubsequence f.
LargestIncreasingSubsequence 6 1 3 4 2 8
l =: 7 4 4 5 2 7 1 8 13 2 10 4 9 1 4 5 5 4 3 10 3 4 5 8 15 7 11 19
LargestIncreasingSubsequence l
LargestIncreasingSubsequence 1000?1000
On 2016-09-05 09:07, 'Jon Hough' via Programming wrote:
Just out of interest, I compared the various results.
I wrote a fully imperative version, which uses in-place modification of the
results array.
I also wrote a version that avoids any while / for loops (because I wanted to
avoid using them), and ended up putting
most of the logic in anonymous verbs. Which is probably a big mistake because
that gets very slow. Also barely readable.
NB.===========================================================================
NB. Jon - bizarre version. Uses anonymous verbs for most of the logic.
NB. Slow and, uses huge amounts of memory.
appendOrInsert=:(3 : 'insert max' [ 3 : '(max=:<:#lst)[(min=:0)[val=:i{r[i=:y')`(3
: '(lst=:lst,y)[prev=:(_1{lst) y} prev')@.(3 : '(val>({:lst){r)[val=:y{r')
insert=:(3 : '(prev=: ((y-1){lst)i}prev)[(lst=: i y }lst)' ] ])@:(3 : 'mid'`(3 : 'min=:
mid+1')@.(3 : '(val>(mid{lst){r)[(mid=:<.(min+y)%2)')^:(0&<)^:_)
lisJ =: 3 : 0
r=:y NB. array
[val=:0[max=:0[mid=:0[min=:0 NB. useful numbers
lst=:0 NB. list of indices
prev=: (#y)#0 NB. previous indices
i=:0 NB. current index
appendOrInsert"0 >: i.<: # y NB. append the items, or insert them, into lst
(and update prev)
res=:''
ptr=: _1{lst
(ptr&buildEx)^:(#lst) res
|. res
)
buildEx =: 4 : 0
res=:y,ptr{r
ptr=: ptr{prev
res
)
NB.===========================================================================
NB. Imperative version. just for benchmarking
lisI =: 3 : 0
lst =: 0
r=: y
parent=: (#y)#0
for_i.>:i.<:# r do.
if.((i{r) > ({: lst){r ) do.
parent=:(_1{lst) i}parent
lst =: lst, i
else.
min=: 0
max =: <:#lst
while. min < max do.
mid =: <. (min + max) % 2
if. (i{r) > ((mid { lst{r)) do. min =: mid + 1
else. max =: mid end.
end.
lst=: (i) max} lst
parent=: ((max-1){lst)(i}) parent
end.
end.
res=: ''
ptr=: _1{lst
while. (# res) < # lst do.
res=:res,ptr{r
ptr=:ptr{parent
end.
I. res
)
NB.===========================================================================
NB. Mike's version.
lisM =: 3 : 0
n =. #x =. y
if. 2>#x do. x return. end. NB. special case empty or singleton array
if. (-:/:~)x do. ~.x return. end. NB. special case sorted arrays
if. (-:\:~)x do. {.x return. end.
p =. n#0
NB. seed m with trailing _1 so that final L (as in wiki algorithm) can be found
m =. n 0 } _1#~>:n
NB. set up sorted mx, with just the first element of x, so that I. works
mx =. ({.x) 1 } (<:<./x), n#>:>./x
for_i. i.n do.
xi =. i{x
lo =. mx I. xi
p =. (m{~<:lo) i } p NB. better than appending to short p for larger x
m =. i lo } m
mx =. xi lo } mx
end.
|. x{~(p{~])^:(i.L) m{~ L =. <: m i. _1
)
NB.===========================================================================
NB. Louis' version.
p=: ] , [ ,&.> ] #~ (< {.&>) (= >./)@:* #&>@]
e=: }:@>@(#~ (= >./)@:(#&>))@>
s=: [: e (<<_) p&.>/@,~ <"0
pi=: ] , [ ,&.> ] {~ (< {.&>) (i. >./)@:* #&>@]
lisL =: [: e (<<_) pi&.>/@,~ <"0 NB.
<------------- this one.
f=: ((] >: (-~ >./)) #&>) # ]
P=: ] , [ ,&.> ] #~ (< {.&>) (,@[ #^:_1 (= >./)@#) #&>@]
sp=: [: e (<<_) ({:@[ f {.@[ P ])&.>/@,~ (,&.> i.@#)
NB.===========================================================================
NB. Xiao's version with Raul's modifications. Renamed verbs to avoid clashing.
NB. dyads
exr=: (1 + {:@[ < ]) {. [ ; ,
hxr=: [: ; exr&.>
NB. monads
gxr=: (}.@] ;~ {.@] ; (hxr {.))&>/
cxr=: ({::~ [: (i. >./) #@>)@>@{.
dxr=: (<_) ; ]
lisXR=: ([: cxr gxr^:(#@(>@{:)))@dxr
NB.===========================================================================
a=: 25 ? 25
timespacex 'lisI a'
timespacex 'lisJ a'
timespacex 'lisM a'
timespacex 'lisL a'
timespacex 'lisXR a' NB. comment out for larger arrays,a.
Playing around with various arrays, it seems lisM is the most efficient in time
and space (more than the imperative version).
lisM and lisI can handle array larger than 10000. The others struggle or give
up with them.
--------------------------------------------
On Sun, 9/4/16, 'Mike Day' via Programming <programm...@jsoftware.com> wrote:
Subject: Re: [Jprogramming] Greatest Increasing Subsequence
To: programm...@jsoftware.com
Date: Sunday, September 4, 2016, 4:30 AM
This version of
"lis" is a bit more J-like, especially in using
dyadic I.
instead of the diy binary search,
at the expense of a slightly more
complicated set-up for the m and mx arrays.
lis =: 3 : 0
n =. #x =. y
if. 2>#x do. x return. end.
NB. special case empty or singleton array
if. (-:/:~)x do. ~.x return. end. NB. special
case sorted arrays
if. (-:\:~)x do. {.x
return. end.
p =. n#0
NB. seed m with trailing _1 so that final L (as
in wiki algorithm) can
be found
m =. n 0 } _1#~>:n
NB. set up sorted mx, with just the first
element of x, so that I. works
mx =.
({.x) 1 } (<:<./x), n#>:>./x
for_i. i.n do.
xi =.
i{x
lo =. mx I. xi
p =. (m{~<:lo) i } p
NB. better than appending to short p for
larger x
m
=. i lo } m
mx =.
xi lo } mx
end.
|.
x{~(p{~])^:(i.L) m{~ L =. <: m i. _1
)
Mike
On 02/09/2016 20:45, 'Mike
Day' via Programming wrote:
> Well,
assuming for now that it does work, here's an attempt
at a J
> version of
>
the pseudo-code listed at
>
https://en.wikipedia.org/wiki/Longest_increasing_subsequence#Efficient_algorithms
>
>
> lis =: 3 : 0 NB. longest
increasing subsequence
> m
=. 0#~>:n =.
#x =. y
> L
=. #p =. ''
> mx =. m{x NB. added this vector
for better look-up of x{~mid{m
> for_i.
i.n do.
> 'lo hi' =.
1, L
> xi =. i{x
> while. lo <: hi do.
> mid =. >.@-: lo + hi
>
NB. if. xi > x{~ mid{m do. NB. next
line a bit better
>
if. xi > mid{mx do.
>
lo =. >: mid
>
else.
> hi =.
<: mid
> end.
> end.
> p
=. p, m{~<:lo
> m
=. i lo } m
> mx
=. xi lo } mx NB. update my additional array
> L =. L >. lo
> NB. smoutput i; (x{.~ >:i);
L{.m NB. diagnostic
>
end.
> |. x{~(p{~])^:(i.L) L{m
> )
>
> It's reasonably fast on ?10000#5000 -
but possibly wrong!It does
> fail on an
empty array.
>
>
Mike
>
>
> On 02/09/2016 17:30, Raul Miller wrote:
>> It seems to me that the
"efficient algorithm" documented on the
>> wikipedia page would have an analogous
flaw. It is performing binary
>>
searches on unsorted lists. That said, it does perform
correctly for
>> this example.
>>
>> Thanks,
>>
>
>
> ---
> This email has been checked for viruses by
Avast antivirus software.
> https://www.avast.com/antivirus
>
>
----------------------------------------------------------------------
> For information about J forums see http://www.jsoftware.com/forums.htm
---
This email
has been checked for viruses by Avast antivirus software.
https://www.avast.com/antivirus
----------------------------------------------------------------------
For information about J forums see http://www.jsoftware.com/forums.htm
----------------------------------------------------------------------
For information about J forums see http://www.jsoftware.com/forums.htm
----------------------------------------------------------------------
For information about J forums see http://www.jsoftware.com/forums.htm
