[2021-05-03] Challenge #388 [Intermediate] Next palindrome

Factor (build 2074), no mutations performed in this solution; just a composition of pure functions.

USING: arrays formatting kernel literals math math.functions
math.parser math.vectors present sequences sequences.extras
tools.time ;

: (next) ( m seq -- n newseq )     ! 1 { 2 1 3 3 } -> 1 { 2 1 4 3 }
    over 0 <array> 1 suffix over length 0 pad-tail reverse v+ ;

: next ( m seq -- n newseq )       ! 0 { 2 1 3 3 } -> 1 { 2 1 4 3 }
    2dup [ nth ] [ nth* ] 2bi < [ 1 + ] 2dip [ (next) ] when ;

: setup ( seq -- newseq )          ! { 2 1 3 3 } -> { 2 2 4 3 }
    0 swap dup [email protected] [ next ] times nip ;

: reflect-odd ( seq -- newseq )    ! { 3 2 1 } -> { 3 2 3 }
    dup [email protected] 1 + cut drop dup 1 head* reverse append ;

: reflect-even ( seq -- newseq )   ! { 2 2 4 3 } -> { 2 2 2 2 }
    halves drop dup reverse append ;

: reflect ( seq -- newseq )
    dup length odd? [ reflect-odd ] [ reflect-even ] if ;

: digits>num ( seq -- n )          ! { 1 2 3 4 } -> 1234
    0 [ 10^ * + ] reduce-index ;

: next-palindrome ( m -- n )       ! 2133 -> 2222
    1 + present [ digit> ] { } map-as setup reflect digits>num ;

[
    ${ 808 999 2133 3 39 ^ 192 998 0 1 9 120 }
    [ dup next-palindrome "%d -> %d\n" printf ] each
] time

Output:

808 -> 818
999 -> 1001
2133 -> 2222
4052555153018976267 -> 4052555153515552504
192 -> 201
998 -> 999
0 -> 1
1 -> 2
9 -> 11
120 -> 121
Running time: 0.001679014 seconds
/r/dailyprogrammer Thread