Skip to content

Commit

Permalink
Make groupsOf... family of functions fully tail recursive. (#47)
Browse files Browse the repository at this point in the history
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 <kopomir@gmail.com>
  • Loading branch information
jmbromley and gampleman committed Mar 23, 2024
1 parent 3ce1762 commit 2ab7ca0
Show file tree
Hide file tree
Showing 4 changed files with 197 additions and 4 deletions.
14 changes: 14 additions & 0 deletions LICENSE
Original file line number Diff line number Diff line change
Expand Up @@ -110,6 +110,20 @@ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.

Fully tail recursive take function (and helper):

Copyright 2014-present Evan Czaplicki
 Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
 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.
 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.
 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.

---

String.Extra:
Expand Down
29 changes: 27 additions & 2 deletions benchmarks/src/Benchmarks.elm
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,7 @@ import Benchmark exposing (Benchmark, describe)
import Benchmark.Alternative exposing (rank)
import Benchmark.Runner.Alternative as BenchmarkRunner
import List.Extra
import List.Extra.GroupsOf
import List.Extra.Unfoldr
import List.Extra.UniquePairs
import Set exposing (Set)
Expand Down Expand Up @@ -182,17 +183,41 @@ listExtra =
List.range 1 100
in
describe "List.Extra"
[ rank "uniquePairs"
([ rank "uniquePairs"
(\uniquePairs -> uniquePairs intList)
[ ( "original (++)", List.Extra.UniquePairs.originalConcat )
, ( "tail-recursive", List.Extra.UniquePairs.tailRecursive )
]
, rank "unfoldr"
, rank "unfoldr"
(\unfoldr -> unfoldr subtractOneUntilZero 100)
[ ( "original", List.Extra.Unfoldr.nonTailRecursive )
, ( "tail-recursive", List.Extra.Unfoldr.tailRecursive )
]
]
++ List.concatMap toComparisonsGroupsOfWithStep (List.range 1 4)
)


toComparisonsGroupsOfWithStep : Int -> List Benchmark
toComparisonsGroupsOfWithStep exponent =
let
listSize =
10 ^ exponent

range =
List.range 1 listSize
in
[ rank ("groupsOfWithStep 3 2 [1.." ++ String.fromInt listSize ++ "]")
(\impl -> impl 3 2 range)
[ ( "using elm-core's List.tail", List.Extra.GroupsOf.coreTailGroupsOfWithStep )
, ( "using fully tail-recursive List.tail", List.Extra.GroupsOf.tailRecGroupsOfWithStep )
]
, rank ("greedyGroupsOfWithStep 3 2 [1.." ++ String.fromInt listSize ++ "]")
(\impl -> impl 3 2 range)
[ ( "using elm-core's List.tail", List.Extra.GroupsOf.coreTailGreedyGroupsOfWithStep )
, ( "using fully tail-recursive List.tail", List.Extra.GroupsOf.tailRecGreedyGroupsOfWithStep )
]
]


tupleExtra : Benchmark
Expand Down
123 changes: 123 additions & 0 deletions benchmarks/src/List/Extra/GroupsOf.elm
Original file line number Diff line number Diff line change
@@ -0,0 +1,123 @@
module List.Extra.GroupsOf exposing (coreTailGreedyGroupsOfWithStep, coreTailGroupsOfWithStep, tailRecGreedyGroupsOfWithStep, tailRecGroupsOfWithStep)

import Benchmark
import Benchmark.Runner.Alternative as BenchmarkRunner


coreTailGroupsOfWithStep : Int -> Int -> List a -> List (List a)
coreTailGroupsOfWithStep size step list =
if size <= 0 || step <= 0 then
[]

else
let
go : List a -> List (List a) -> List (List a)
go xs acc =
if List.isEmpty xs then
List.reverse acc

else
let
thisGroup =
List.take size xs
in
if size == List.length thisGroup then
let
rest =
List.drop step xs
in
go rest (thisGroup :: acc)

else
List.reverse acc
in
go list []


coreTailGreedyGroupsOfWithStep : Int -> Int -> List a -> List (List a)
coreTailGreedyGroupsOfWithStep size step list =
if size <= 0 || step <= 0 then
[]

else
let
go : List a -> List (List a) -> List (List a)
go xs acc =
if List.isEmpty xs then
List.reverse acc

else
go
(List.drop step xs)
(List.take size xs :: acc)
in
go list []


tailRecGroupsOfWithStep : Int -> Int -> List a -> List (List a)
tailRecGroupsOfWithStep size step list =
if size <= 0 || step <= 0 then
[]

else
let
go : List a -> List (List a) -> List (List a)
go xs acc =
if List.isEmpty xs then
List.reverse acc

else
let
thisGroup =
takeTailRec size xs
in
if size == List.length thisGroup then
let
rest =
List.drop step xs
in
go rest (thisGroup :: acc)

else
List.reverse acc
in
go list []


tailRecGreedyGroupsOfWithStep : Int -> Int -> List a -> List (List a)
tailRecGreedyGroupsOfWithStep size step list =
if size <= 0 || step <= 0 then
[]

else
let
go : List a -> List (List a) -> List (List a)
go xs acc =
if List.isEmpty xs then
List.reverse acc

else
go
(List.drop step xs)
(takeTailRec size xs :: acc)
in
go list []


takeTailRec : Int -> List a -> List a
takeTailRec n list =
List.reverse (takeReverse n list [])


takeReverse : Int -> List a -> List a -> List a
takeReverse n list kept =
if n <= 0 then
kept

else
case list of
[] ->
kept

x :: xs ->
takeReverse (n - 1) xs (x :: kept)
35 changes: 33 additions & 2 deletions src/List/Extra.elm
Original file line number Diff line number Diff line change
Expand Up @@ -2011,7 +2011,7 @@ groupsOfWithStep size step list =
else
let
thisGroup =
List.take size xs
takeTailRec size xs
in
if size == List.length thisGroup then
let
Expand All @@ -2026,6 +2026,37 @@ groupsOfWithStep size step list =
go list []



{- List.take starts out non-tail-recursive and switches to a tail-recursive
implementation after the first 1000 iterations. For functions which are themselves
recursive and use List.take on each call (e.g. List.Extra.groupsOf), this can result
in potential call stack overflow from the successive accumulation of up to 1000-long
non-recursive List.take calls. Here we provide an always tail recursive version of
List.take to avoid this problem. The code is taken directly from the implementation
of elm/core and shares its copyright (see LICENSE file).
-}


takeTailRec : Int -> List a -> List a
takeTailRec n list =
List.reverse (takeReverse n list [])


takeReverse : Int -> List a -> List a -> List a
takeReverse n list kept =
if n <= 0 then
kept

else
case list of
[] ->
kept

x :: xs ->
takeReverse (n - 1) xs (x :: kept)


{-| `groupsOfVarying ns` takes `n` elements from a list for each `n` in `ns`, splitting the list into variably sized segments
groupsOfVarying [ 2, 3, 1 ] [ "a", "b", "c", "d", "e", "f" ]
Expand Down Expand Up @@ -2105,7 +2136,7 @@ greedyGroupsOfWithStep size step list =
else
go
(List.drop step xs)
(List.take size xs :: acc)
(takeTailRec size xs :: acc)
in
go list []

Expand Down

0 comments on commit 2ab7ca0

Please sign in to comment.