Skip to content

Commit 2ab7ca0

Browse files
jmbromleygampleman
andauthored
Make groupsOf... family of functions fully tail recursive. (#47)
Makes the `groupsOf...` family of functions fully tail recursive by forcing them to use the tail recursive version of List.take (normally List.take is only tail recursive for lists larger than 1000, but since the `groupsOf...` functions are themselves recursive this can result in potential call stack overflow from the successive accumulation of (up to) 1000-long non-recursive List.take calls during the recursion). This is an alternative to PR #46 which would instead just add a note to the documentation warning users about the potential overflow. Co-authored-by: Jakub Hampl <[email protected]>
1 parent 3ce1762 commit 2ab7ca0

File tree

4 files changed

+197
-4
lines changed

4 files changed

+197
-4
lines changed

LICENSE

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -110,6 +110,20 @@ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
110110
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
111111
SOFTWARE.
112112

113+
Fully tail recursive take function (and helper):
114+
115+
Copyright 2014-present Evan Czaplicki
116+
117+
 Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
118+
119+
 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
120+
121+
 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
122+
123+
 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.
124+
125+
 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
126+
113127
---
114128

115129
String.Extra:

benchmarks/src/Benchmarks.elm

Lines changed: 27 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,7 @@ import Benchmark exposing (Benchmark, describe)
1818
import Benchmark.Alternative exposing (rank)
1919
import Benchmark.Runner.Alternative as BenchmarkRunner
2020
import List.Extra
21+
import List.Extra.GroupsOf
2122
import List.Extra.Unfoldr
2223
import List.Extra.UniquePairs
2324
import Set exposing (Set)
@@ -182,17 +183,41 @@ listExtra =
182183
List.range 1 100
183184
in
184185
describe "List.Extra"
185-
[ rank "uniquePairs"
186+
([ rank "uniquePairs"
186187
(\uniquePairs -> uniquePairs intList)
187188
[ ( "original (++)", List.Extra.UniquePairs.originalConcat )
188189
, ( "tail-recursive", List.Extra.UniquePairs.tailRecursive )
189190
]
190-
, rank "unfoldr"
191+
, rank "unfoldr"
191192
(\unfoldr -> unfoldr subtractOneUntilZero 100)
192193
[ ( "original", List.Extra.Unfoldr.nonTailRecursive )
193194
, ( "tail-recursive", List.Extra.Unfoldr.tailRecursive )
194195
]
196+
]
197+
++ List.concatMap toComparisonsGroupsOfWithStep (List.range 1 4)
198+
)
199+
200+
201+
toComparisonsGroupsOfWithStep : Int -> List Benchmark
202+
toComparisonsGroupsOfWithStep exponent =
203+
let
204+
listSize =
205+
10 ^ exponent
206+
207+
range =
208+
List.range 1 listSize
209+
in
210+
[ rank ("groupsOfWithStep 3 2 [1.." ++ String.fromInt listSize ++ "]")
211+
(\impl -> impl 3 2 range)
212+
[ ( "using elm-core's List.tail", List.Extra.GroupsOf.coreTailGroupsOfWithStep )
213+
, ( "using fully tail-recursive List.tail", List.Extra.GroupsOf.tailRecGroupsOfWithStep )
214+
]
215+
, rank ("greedyGroupsOfWithStep 3 2 [1.." ++ String.fromInt listSize ++ "]")
216+
(\impl -> impl 3 2 range)
217+
[ ( "using elm-core's List.tail", List.Extra.GroupsOf.coreTailGreedyGroupsOfWithStep )
218+
, ( "using fully tail-recursive List.tail", List.Extra.GroupsOf.tailRecGreedyGroupsOfWithStep )
195219
]
220+
]
196221

197222

198223
tupleExtra : Benchmark
Lines changed: 123 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,123 @@
1+
module List.Extra.GroupsOf exposing (coreTailGreedyGroupsOfWithStep, coreTailGroupsOfWithStep, tailRecGreedyGroupsOfWithStep, tailRecGroupsOfWithStep)
2+
3+
import Benchmark
4+
import Benchmark.Runner.Alternative as BenchmarkRunner
5+
6+
7+
coreTailGroupsOfWithStep : Int -> Int -> List a -> List (List a)
8+
coreTailGroupsOfWithStep size step list =
9+
if size <= 0 || step <= 0 then
10+
[]
11+
12+
else
13+
let
14+
go : List a -> List (List a) -> List (List a)
15+
go xs acc =
16+
if List.isEmpty xs then
17+
List.reverse acc
18+
19+
else
20+
let
21+
thisGroup =
22+
List.take size xs
23+
in
24+
if size == List.length thisGroup then
25+
let
26+
rest =
27+
List.drop step xs
28+
in
29+
go rest (thisGroup :: acc)
30+
31+
else
32+
List.reverse acc
33+
in
34+
go list []
35+
36+
37+
coreTailGreedyGroupsOfWithStep : Int -> Int -> List a -> List (List a)
38+
coreTailGreedyGroupsOfWithStep size step list =
39+
if size <= 0 || step <= 0 then
40+
[]
41+
42+
else
43+
let
44+
go : List a -> List (List a) -> List (List a)
45+
go xs acc =
46+
if List.isEmpty xs then
47+
List.reverse acc
48+
49+
else
50+
go
51+
(List.drop step xs)
52+
(List.take size xs :: acc)
53+
in
54+
go list []
55+
56+
57+
tailRecGroupsOfWithStep : Int -> Int -> List a -> List (List a)
58+
tailRecGroupsOfWithStep size step list =
59+
if size <= 0 || step <= 0 then
60+
[]
61+
62+
else
63+
let
64+
go : List a -> List (List a) -> List (List a)
65+
go xs acc =
66+
if List.isEmpty xs then
67+
List.reverse acc
68+
69+
else
70+
let
71+
thisGroup =
72+
takeTailRec size xs
73+
in
74+
if size == List.length thisGroup then
75+
let
76+
rest =
77+
List.drop step xs
78+
in
79+
go rest (thisGroup :: acc)
80+
81+
else
82+
List.reverse acc
83+
in
84+
go list []
85+
86+
87+
tailRecGreedyGroupsOfWithStep : Int -> Int -> List a -> List (List a)
88+
tailRecGreedyGroupsOfWithStep size step list =
89+
if size <= 0 || step <= 0 then
90+
[]
91+
92+
else
93+
let
94+
go : List a -> List (List a) -> List (List a)
95+
go xs acc =
96+
if List.isEmpty xs then
97+
List.reverse acc
98+
99+
else
100+
go
101+
(List.drop step xs)
102+
(takeTailRec size xs :: acc)
103+
in
104+
go list []
105+
106+
107+
takeTailRec : Int -> List a -> List a
108+
takeTailRec n list =
109+
List.reverse (takeReverse n list [])
110+
111+
112+
takeReverse : Int -> List a -> List a -> List a
113+
takeReverse n list kept =
114+
if n <= 0 then
115+
kept
116+
117+
else
118+
case list of
119+
[] ->
120+
kept
121+
122+
x :: xs ->
123+
takeReverse (n - 1) xs (x :: kept)

src/List/Extra.elm

Lines changed: 33 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2011,7 +2011,7 @@ groupsOfWithStep size step list =
20112011
else
20122012
let
20132013
thisGroup =
2014-
List.take size xs
2014+
takeTailRec size xs
20152015
in
20162016
if size == List.length thisGroup then
20172017
let
@@ -2026,6 +2026,37 @@ groupsOfWithStep size step list =
20262026
go list []
20272027

20282028

2029+
2030+
{- List.take starts out non-tail-recursive and switches to a tail-recursive
2031+
implementation after the first 1000 iterations. For functions which are themselves
2032+
recursive and use List.take on each call (e.g. List.Extra.groupsOf), this can result
2033+
in potential call stack overflow from the successive accumulation of up to 1000-long
2034+
non-recursive List.take calls. Here we provide an always tail recursive version of
2035+
List.take to avoid this problem. The code is taken directly from the implementation
2036+
of elm/core and shares its copyright (see LICENSE file).
2037+
2038+
-}
2039+
2040+
2041+
takeTailRec : Int -> List a -> List a
2042+
takeTailRec n list =
2043+
List.reverse (takeReverse n list [])
2044+
2045+
2046+
takeReverse : Int -> List a -> List a -> List a
2047+
takeReverse n list kept =
2048+
if n <= 0 then
2049+
kept
2050+
2051+
else
2052+
case list of
2053+
[] ->
2054+
kept
2055+
2056+
x :: xs ->
2057+
takeReverse (n - 1) xs (x :: kept)
2058+
2059+
20292060
{-| `groupsOfVarying ns` takes `n` elements from a list for each `n` in `ns`, splitting the list into variably sized segments
20302061
20312062
groupsOfVarying [ 2, 3, 1 ] [ "a", "b", "c", "d", "e", "f" ]
@@ -2105,7 +2136,7 @@ greedyGroupsOfWithStep size step list =
21052136
else
21062137
go
21072138
(List.drop step xs)
2108-
(List.take size xs :: acc)
2139+
(takeTailRec size xs :: acc)
21092140
in
21102141
go list []
21112142

0 commit comments

Comments
 (0)