quadratic-no-alloc.rkt

#lang racket

(require racket/flonum)

(define (xy->string x y)
  (string-append
   (~r x #:precision 1) ","
   (~r y #:precision 1)))

(define len 0)
(define dst1 (make-string 500000))
(define dst2 (make-string 500000))
(define (string-append! . strs)
  (string-copy! dst2 0 dst1 0 len) ;; intentionally performing pointless work to be n^2
  (for ([s (in-list strs)])
    (string-copy! dst1 len s)
    (set! len (+ len (string-length s)))))
(define (get-string)
  (substring dst1 0 len))

(define (xy-vectors->string x-vec y-vec)
  (for/fold ([sep ""] #:result (get-string))
            ([x (in-flvector x-vec)]
             [y (in-flvector y-vec)])
    (string-append! sep (xy->string x y))
    " "))

(time
 (void
  (let ([x (make-flvector 100000)]
        [y (make-flvector 100000)])
    (xy-vectors->string x y))))

quadratic-with-alloc-bytes.rkt

#lang racket

(require racket/flonum)

(define (xy->string x y)
  (string->bytes/utf-8
   (string-append
    (~r x #:precision 1) ","
    (~r y #:precision 1))))

(define (my-bytes-append . bss)
  (define len
    (for/sum ([s (in-list bss)])
      (bytes-length s)))
  (define dst (make-bytes len))
  (for/fold ([start 0])
            ([bs (in-list bss)])
    (bytes-copy! dst start bs)
    (+ start (bytes-length bs)))
  dst)

(define (xy-vectors->string x-vec y-vec)
  (for/fold ([s #""] [sep #""] #:result s)
            ([x (in-flvector x-vec)]
             [y (in-flvector y-vec)])
    (values (my-bytes-append s sep (xy->string x y)) #" ")))

(time
 (void
  (let ([x (make-flvector 100000)]
        [y (make-flvector 100000)])
    (xy-vectors->string x y))))

quadratic-with-alloc-no-fill.rkt

#lang racket

(require ffi/unsafe
         ffi/unsafe/define
         racket/flonum)

(define-ffi-definer define-libc #f)
(define-libc free (_fun _size -> _void))
(define-libc malloc (_fun _size -> _size))
(define-libc memcpy (_fun _size _size _size -> _size))
(define-libc memcpy-from-bs (_fun _size _bytes _size -> _size)
  #:c-id memcpy)
(define-libc memcpy-to-bs (_fun _bytes _size _size -> _size)
  #:c-id memcpy)

(struct unsafe-bs (len ptr))
(define (make-unsafe-bs len)
  (unsafe-bs len (malloc len)))
(define (unsafe-bs-free! ubs)
  (free (unsafe-bs-ptr ubs)))
(define (unsafe-bs-copy! dst pos src)
  (void (memcpy (+ (unsafe-bs-ptr dst) pos) (unsafe-bs-ptr src) (unsafe-bs-len src))))
(define (unsafe-bs-copy-bytes! dst pos src)
  (void (memcpy-from-bs (+ (unsafe-bs-ptr dst) pos) src (bytes-length src))))
(define (unsafe-bs-append-bytes ubs . bss)
  (define len
    (+ (unsafe-bs-len ubs)
       (for/sum ([bs (in-list bss)])
         (bytes-length bs))))
  (define dst (make-unsafe-bs len))
  (unsafe-bs-copy! dst 0 ubs)
  (unsafe-bs-free! ubs)
  (for/fold ([start (unsafe-bs-len ubs)])
            ([bs (in-list bss)])
    (unsafe-bs-copy-bytes! dst start bs)
    (+ start (bytes-length bs)))
  dst)
(define (unsafe-bs->bytes ubs [end #f])
  (define len (or end (unsafe-bs-len ubs)))
  (define out (make-bytes len))
  (begin0 out
    (memcpy-to-bs out (unsafe-bs-ptr ubs) len)))

(define (xy->bytes x y)
  (string->bytes/utf-8
   (string-append
    (~r x #:precision 1) ","
    (~r y #:precision 1))))

(define (xy-vectors->string x-vec y-vec)
  (for/fold ([s (make-unsafe-bs 0)] [sep #""] #:result (unsafe-bs->bytes s))
            ([x (in-flvector x-vec)]
             [y (in-flvector y-vec)])
    (values (unsafe-bs-append-bytes s sep (xy->bytes x y)) #" ")))

(time
 (void
  (let ([x (make-flvector 100000)]
        [y (make-flvector 100000)])
    (xy-vectors->string x y))))

quadratic-with-alloc.rkt

#lang racket

(require racket/flonum)

(define (xy->string x y)
  (string-append
   (~r x #:precision 1) ","
   (~r y #:precision 1)))

(define (my-string-append . strs)
  (define len
    (for/sum ([s (in-list strs)])
      (string-length s)))
  (define dst (make-string len))
  (for/fold ([start 0])
            ([s (in-list strs)])
    (string-copy! dst start s)
    (+ start (string-length s)))
  dst)

(define (xy-vectors->string x-vec y-vec)
  (for/fold ([s ""] [sep ""] #:result s)
            ([x (in-flvector x-vec)]
             [y (in-flvector y-vec)])
    (values (my-string-append s sep (xy->string x y)) " ")))

(time
 (void
  (let ([x (make-flvector 100000)]
        [y (make-flvector 100000)])
    (xy-vectors->string x y))))