preallocation efficacity study

prealloc-lab.red

Red [
	title:   "Preallocation lab"
	author:  @hiiamboris
	license: MIT
]

sizes: repeat n 11 [append [] 2 ** (9 + n)]						;-- 1K .. 1M

gc-color: coal
strategies: #[
	"item by item" #[
		color: teal
		bad-code:  [buffer: make [] 1     loop size [append buffer 0]]
		good-code: [buffer: make [] size  loop size [append buffer 0]]
	]
	"doubling chunks" #[
		color: purple
		bad-code:  [buffer: make [] 1     repeat n log-2 size [append/dup buffer 0 2 ** (n - 1)]]
		good-code: [buffer: make [] size  repeat n log-2 size [append/dup buffer 0 2 ** (n - 1)]]
	]
	"single fill" #[
		color: olive
		bad-code:  [buffer: make [] 1     append/dup buffer 0 size]
		good-code: [buffer: make [] size  append/dup buffer 0 size]
	]
]

slowdown: 1
reset: function [] [
	foreach [name strategy] strategies [
		strategy/data: copy #[]
		strategy/color: do strategy/color
		foreach size sizes [
			strategy/data/:size: object [
				tries:   max 1 to integer! 2 ** 20 / size * slowdown
				; tries:   max 1 to integer! 2 ** 22 / size
				cpu-ratios: clear make vector! [percent! 64 64]
				gc-slacks:  clear make vector! [percent! 64 64]
				memory-ratio:    0%
				cpu-ratio-sum:   0.0
				cpu-ratio:       0.0
				cpu-ratio-stdev: 0.0
				gc-slack-sum:    0.0
				gc-slack:        0.0
			]
		]
	]
	set 'last-size 1
]
reset

slow-down: does [slowdown: slowdown * 10]

next-size: does [last-size: last-size - 2 // (length? sizes) + 1]
ram-usage?: func [code] [0 - stats + (do code stats)]
form-size: func [size] [
	rejoin case [
		size > 1e6 [[size / 1024 / 1024 "M"]]
		size > 1e3 [[size / 1024 "K"]]
		'else [size]
	]
]

measure: function [/extern size] [
	size:  pick sizes isize: next-size
	recycle
	foreach [name strategy] strategies [
		data: strategy/data/:size
		good-memory: ram-usage? [
			good-time: 1e3 * to float! dt [
				repeat i data/tries strategy/good-code
			]
		]
		good-gctime: 1e3 * to float! dt [recycle]
		bad-memory: ram-usage? [
			bad-time: 1e3 * to float! dt [
				repeat i data/tries strategy/bad-code
			]
		]
		if zero? bad-time [reset slow-down exit]
		bad-gctime:     1e3 * to float! dt [recycle]
		good-time-full: good-time + good-gctime
		bad-time-full:  max 1e-6 bad-time  + bad-gctime
		cpu-ratio:    to percent! good-time-full / bad-time-full
		gc-slack:     to percent! good-gctime    / bad-time-full
		memory-ratio: to percent! good-memory    / bad-memory
		append data/cpu-ratios    cpu-ratio 
		append data/gc-slacks     gc-slack
		data/cpu-ratio-sum: data/cpu-ratio-sum + cpu-ratio
		data/cpu-ratio:     data/cpu-ratio-sum / count: length? data/cpu-ratios
		data/memory-ratio:  data/memory-ratio * (1 - (1 / count)) + (memory-ratio * 1 / count)
		var: (var: (copy data/cpu-ratios) - data/cpu-ratio) * var
		data/cpu-ratio-stdev: sqrt (sum var) / (count - 1)
		data/gc-slack-sum: data/gc-slack-sum + gc-slack
		data/gc-slack:     data/gc-slack-sum / count
		recycle
	]	
]

opaque: func [color amount] [color + (1 - amount * 0.0.0.255)]
ox: (1,0)
oy: (0,1)

update-plot: function [] [
	plot-size:    plot/size * (0.9, 0.85)
	plot-offset:  plot/size * (0.05, 0.02)
	extra-height: 50%
	group-size:   1 + length? strategies
	cpu-scale:    plot-size/y / (1 + extra-height)				;-- +1 for the separator column
	col-width:    plot-size/x / (group-size * (length? sizes) - 1)
	colx:         ox * col-width
	drawn: collect [
		legend1: collect [
			keep [pen black text 0x0 "Array filling strategies:" pen off]
			foreach [name strategy] strategies [
				keep compose [translate 0x20 fill-pen (opaque strategy/color 40%) box 0x0 15x15 text 20x0 (name)]
			]
		]
		legend2: collect [
			keep [translate 200x0 pen black text 0x0 "Details:" pen off]
			keep compose [translate 0x20 fill-pen (opaque gc-color 40%) box 0x0 15x15 text 20x0 "garbage collection impact"]
			keep compose [translate 0x20 fill-pen off pen black         box 0x0 15x15 text 20x0 "95% confidence interval"]
		]
		keep compose/only/deep [
			translate (plot-offset)
			push (legend1) push (legend2)
			translate (plot-size * oy) scale 1 -1
			pen black  line (xy: cpu-scale * oy) (xy + (plot-size * ox))
			push [translate (xy) scale 1 -1 text -30x-10 "100%"]
			pen silver line (xy: xy * 80%)       (xy + (plot-size * ox))
			push [translate (xy) scale 1 -1 text -25x-10 "80%"]
			pen black push [scale 1 -1 text (plot-size/x * ox / 2 - 30x-25) "Buffer sizes"]
		]
		foreach size sizes [
			column-group: collect [
				keep compose/deep [push [scale 1 -1 text 10x5 (form-size size)]]
				foreach [name strategy] strategies [
					data:        strategy/data/:size
					col-height:  cpu-scale * data/cpu-ratio
					nogc-height: col-height * (1 - data/gc-slack)
					stdev:       cpu-scale * data/cpu-ratio-stdev * 2
					if nan? stdev [stdev: 0]
					column: compose [box 1x0 (pmid: as-point2D col-width - 2 nogc-height)]
					slack:  compose [box (pmid) (phi: col-height * oy + 1x0)]
					deviation: compose [
						box (phi - 1x0 - (stdev * oy)) (phi + (as-point2D col-width - 2 stdev))
					]
					points: collect [
						foreach ratio data/cpu-ratios [
							xy: oy * cpu-scale * ratio + (colx * 30%)
							keep compose [line (xy) (xy - 1x0 + (colx * 40%))]
						]
					]
					keep compose/only [
						pen off fill-pen (opaque strategy/color 40%) (column)
						fill-pen (opaque gc-color 40%) (slack)
						fill-pen off pen (opaque strategy/color 60%) (deviation)
						pen (strategy/color) fill-pen off (points)
						translate (colx)
					]
				]
			]
			keep compose/only [push (column-group) translate (colx * group-size)]
		]
	]
	; probe prettify/draw
	plot/draw: drawn
]

recycle/off
view [
	title "Is preallocation overrated?"
	below center
	text "The graph below displays code timing ratio with to without preallocation"
	plot: base white 600x400 rate 2 on-time [update-plot]
	status: text 600 center "Measuring... Turn off battery saving and close your browsers for best results"
	rate 99 on-time [measure]
]