Stretching words and quotation scoping

Question

To play at Stretch the word, I've defined the following words, to try to work at the problem via the same method as this answer:

USING: kernel math sequences sequences.repeating ;
IN: stretch-words

! "bonobo" -> { "b" "bo" "bon" "bono" "bonob" "bonobo" }
: ascend-string ( string -- ascending-seqs )
    dup length 1 + iota [ 0 swap pick subseq ] map
    [ "" = not ] filter nip ;

! expected: "bonobo" -> "bonoobbooo"
! actual:   "bonobo" -> "bbbooonnnooobbbooo"
: stretch-word ( string -- stretched ) 
    dup ascend-string swap zip
    [ 
      dup first swap last 
      [ = ] curry [ dup ] dip count 
      repeat 
    ] map last ;

stretch-word is supposed to repeat a character in a string by the number of times it's appeared up to that position in the string. However, my implementation is repeating all instances of the 1string it gets.

I have the feeling this is easily implementable in Factor, but I can't quite figure it out. How do I make this do what I want?

Answer 1

Hm... not a great golf, but it works...

First, I made a minor change to ascend-string so it leaves the string on the stack:

: ascend-string ( string -- string ascending-seqs )
    dup length 1 + iota [ 0 swap pick subseq ] map
    [ "" = not ] filter ;

So stretch-word can work like this:

: stretch-word ( string -- stretched ) 
    ascend-string zip         ! just zip them in the same order
    [ 
      first2 over             ! first2 is the only golf I could make :/
      [ = ] curry count       ! same thing
      swap <array> >string    ! make an array of char size count and make it a string
    ] map concat ;            ! so you have to join the pieces

---

Edit: I think the problem was using repeat to do the job.

Answer 2

: ascend-string ( string -- seqs )
    "" [ suffix ] { } accumulate*-as  ;
: counts ( string -- counts )
    dup ascend-string [ indices length ] { } 2map-as ;
: stretch-word ( string -- stretched )
    [ counts ] keep [ <string> ] { } 2map-as concat ;
"bonobo" stretch-word print
bonoobbooo

indices length could also be [ = ] with count