Speed test for various key/val structures

speedtest-key-val2.r

;Red []
Rebol [
	Title: "Speed test key val2"
	purpose: "Evaluate which method and structures are better for key-val selection"
	Notes: {Actually supports Rebol3 and Red}
	Todo: {
		debug r3 for slowness
		debug r3 for error on saving
		create a text questions standard with "ask",choices,menu-map
		add integer validation 
		add choice of bases and tests
		add filename selection for saving
		add autosave flag
		add tab management
		add results on a secondary windows
		test for misfind overhead like in version 1
		implement r2
		create auto output table formatter
		add a wrapper contenxt
		
	}
	History: {
		Added Red Graphical UI
		Added R3 Text UI
		Added an init section
		Divided code in does blocks
		
	
	}
	release: 2.1.0
]



platform?: does [case [
	3 = system/version/1 ['Rebol3]
	2 = system/version/1 ['Rebol]
	not rebol ['Red]
	system/product = 'atronix-view ['Atronix]
	;REN-C?
	]
]

align: func [
	str [string!] "The string to aling right"
	len [integer!] "The length to pad"
	/padchar
	ch [String! char!] "The character to use for padding, deault SPACE"
	/local
	ln
	df
] [
	ch: any [ch " "]
	ln: length? str
	df: len - ln
	if df > 0 [
		loop df [
			insert head str ch
		]
	]
	str
]

initialized: false

top: 500000 ;Number of elements of each data pool
top2: 20000000		;Number of iterations per test
top2-static: top2	; some long test are executed for a fraction of times and 
									; results is multiplied to become time compatible with the other
									; This sotre the original number of iteraction because top2 is
									; changed dividing it for a factor in such tests
;top: 10
;top2: 2
;top: 1000000
;top2: 200


;TBD:
;
; Test searching the key each time
; Test with columns and index already translated
; testi with find


init-bases: does [
	
	initialized: true

	recycle/off
	;======== Setup

	test: copy []; this word builds the base container to create some of the others 

	results: copy [[language test-name structure structure-name execution-time]]
								;The table to store the results



	search-for: to-word rejoin ["s" top]	;we always search for the last element crated
																				;so the whole data pool is scanned in linear 
																				;ooperations




	;========= Preparing containers

	repeat idx top [append test reduce [to-word rejoin ["s" idx] either idx < top ["here"]["I am"]]]

	block: test	;block is the very basic data pool made of blocks and key-values


	mtest: make map! test
	bobtest: copy []
	if platform? = 'red [
		htest: make hash! test
		hbobtest: make hash! []
		hhbobtest: make hash! []
		hobobtest: make hash! []
	]
	obobtest: copy []
	object-proto: copy [] 

	foreach [id val] test [

		append/only bobtest reduce [id val]  	

		if platform? = 'red [
			append/only hbobtest reduce [id val]  	
			append/only hhbobtest make hash! reduce [id val]
			append/only hobobtest make object! reduce [to-set-word id val]  	

		]  	
		append/only obobtest make object! reduce [to-set-word id val]  	
		append object-proto reduce [to-set-word id val]
	]

	object: make object! object-proto

	;=== Container + description

	;[divider-for-long-test language name-of-the-container string-description]
	structures: [
		10 all block "Block of key-value"
		1 red htest "hashed-block of key-value"
		1 all mtest "a pure map"
		10 all bobtest "block + block of key-value"
		10 red hbobtest "hash-blk + block of key-val"
		10 red hhbobtest "hash-blk + hash-blk of key-val"
		10 all obobtest "block + object"
		10 red hobobtest "hashed block + object"
		1 all object "a pure object"
	]

	;[block htest mtest bobtest hbobtest hhbobtest obobtest hobobtest object]
	;[block htest object mtest] [bobtest hbobtest hhbobtest] [obobtest hobobtest]


	;------------------------------------------------------

	tests: [
		;test-name code data-pools
		test-select-skip [
			loop top2 [
				test: head test
				if select/skip test search-for 2 []
			]
		] [block htest] 

		test-SelectDirect [
			loop top2 [
				if select test :search-for []
			]
		] [mtest htest object] 

		test-SelectDirectRandom [

			random-keys: copy []
			random-keys-number: 1000
			loop random-keys-number [
				
				append random-keys to-word rejoin ["s" random top]
			]

			loop top2 [
				;pick random-keys random random-keys-number

				;random-keys/(random random-keys-number)
				if select test random/only random-keys []; :search-for [] ;
			]
		] [mtest htest object] 


		test-select-bob [
			loop top2 [
				test: head test
				forall test [if select/skip test/1 :search-for 2 []] 
			]	 			
		] [bobtest hbobtest hhbobtest]

		test-path [
			loop top2 [
				if test/:search-for []
			]
		] [block htest mtest object] ;Rifai solo questo
		
		test-foreach [
			loop top2 [
				test: head test
				foreach [k v] test [if k = :search-for []]
			]
		] [block htest]

		test-while-path-idx [
			loop top2 [
				test: head test
				ln: length? test
				idx: 1
				while [idx < ln] [
					k: test/:idx
					idx: idx + 2
					if k = :search-for []
				]	
			]
		] [block htest]
		
		test-while-idx-idx2	[
			loop top2 [
				test: head test
				ln: length? test
				idx: 1
				idx2: 1
				while [idx < ln] [
					k: test/:idx/:idx2
					idx: idx + 1
					if k = :search-for []
				]	
			]
		] [bobtest hbobtest hhbobtest]

		test-while-idx-key	[
			loop top2 [
				test: head test
				;ln: length? test
				idx: 1
				while [idx < ln] [
					v: test/:idx/:search-for
					idx: idx + 1
					if v []
				]	
			]
		] [
				bobtest 
				hbobtest 
				hhbobtest
			]

		test-while-idx-key-4ob	[
			loop top2 [
				test: head test
				;ln: length? test
				idx: 1
				while [idx < ln] [
					if in test/:idx :search-for [v: test/:idx/:search-for]
					idx: idx + 1
					if v []
				]	
			]
		] [
				obobtest 
				hobobtest
			]
			

		test-forall-path-idx-key	[
			loop top2 [
				test: head test
				forall test [if test/1/:search-for []] 
			];Object can't do this test because wrong path name leads to error
		] [bobtest hbobtest hhbobtest]

		test-forall-select-idx	[
			loop top2 [
				test: head test
				forall test [if select/skip test/1 :search-for 2 []] 
			]
		] [bobtest hbobtest hhbobtest obobtest hobobtest]
	]
]


quick-tests: does [

;=== Looping

;For very quick test I uncomment this and set the parameters

;foreach test-base [object mtest htest]  [
;	test: get test-base 
;	pstr: align rejoin [to-string test-base " - " "test-path" ":"] 30 
;	print [pstr  dt tests/test-path]
;] 
;foreach test-base [object mtest htest]  [
;	test: get test-base 
;	pstr: align rejoin [to-string test-base " - " "test-SelectDirect" ":"] 30 
;	print [pstr dt tests/test-SelectDirect]
;] 


	foreach test-base [object]  [
		test: get test-base 
		pstr: align rejoin [to-string test-base " - " "test-SelectDirect" ":"] 30 
		print [pstr dt tests/test-SelectDirectRandom]
	] 
]



;
;halt

full-tests: does [
	
	
	
	
	foreach [divider language structure name] structures [
		if any [platform? = language language = 'all] [
			foreach [test-name code candidates] tests [
				;probe candidates
				if find candidates structure [
					top2: top2 / divider
					test: get structure
					
					out-string: rejoin [
					to-string align to-string test-name 25 "     ----- structure > " align to-string structures/:structure 34 " : "]
					prin align out-string 80
					execution-time: dt code
					execution-time: execution-time * divider
					append results reduce [reduce [platform? test-name structure structures/:structure execution-time]]
					;append results: reduce [reduce [platform? test-name structures/:structure execution-time]]
					print execution-time 
					top2: top2-static
				]
			]
		]
	]

	save-results
	;=== I am saving the results

]

save-results: does [
	case [
		platform? = 'Red [suffix: %.red] 
		platform? = 'Rebol3 [suffix: %.r3] 
		platform? = 'Rebol [suffix: %.r2] 
	]

	savename: rejoin [%speedtest-results suffix]
	save savename
	
]

ask-test: does [
		Print ""
		Print "1) Quick test"
		Print "2) Full test" 
		Print "3) Quit" 
		text-choice: ask "1 or 2 >> "
		
		case [
				text-choice = "1" [
					Print ["Data pool elements: " top lf "Itarations: " top2] 
					ask-iterations 

					print ""
					Print "Starting test in few seconds"

					wait 2 
					if not initialized [init-bases] init-bases 
					quick-tests
					ask-test

				]
				text-choice = "2" [
					Print ["Data pool elements: " top lf "Itarations: " top2 lf] 

					ask-iterations
					print ""
					Print "Starting test in few seconds"
 
					wait 2 
					if not initialized [init-bases]
					full-tests
					ask-test					
				]

				text-choice = "3" [
					Print "Quitting"
					halt
				]
				
				
				true [
					Print "Wrong Choice"
					Print ""
					ask-test
				]
			
		]
]

ask-iterations: does [
	
	Print ""
	Print ["(D)ata pool elements, actual: " Top " "]
	Print  ["(I)terations, actual :" Top2 " "]
	Print  ["TBD: (L)oad preset!"]
	Print ["(R)un test" ]
	Print ["(Q) Quit" ]
	Print ""

	text-choice: Ask "Change which? >> "
	text-choice: to-string text-choice
	case [
		text-choice = "D" [top: any [attempt [to-integer ask "New data pool elements count: "] top] ask-iterations]
		text-choice = "I" [top2: any [attempt [to-integer ask "New Iterations: "] top2] ask-iterations]
		text-choice = "L" [Print "Not implemented" ask-iterations ]
		text-choice = "R" [print "Running test" ]
		text-choice = "Q" [print "Stopping" halt]
		true [
			ask-iterations
		]
		
	]
	
]


case [
	platform? = 'red [
			view [

			Text "Data elements: " Field  data top on-change [top: face/data] return 
			Text "Iterations per test" Field  data top2 on-change [top2: face/data] return

			button "Full tests" [Print ["Top: " top "Top2: " top2] warn/text: "Starting test in few seconds" wait 2 if not initialized [init-bases] full-tests]
			button "Short Tests" [Print ["Top: " top "Top2: " top2] warn/text: "Starting test in few seconds" wait 2 if not initialized [init-bases] init-bases quick-tests]
			button "quit" [quit] return
			Warn: Text "                                                   "

		]
	]
	true [
		ask-test
	]
]

And you should avoid appending values to a hash like you do, especially when it is not preallocated... append to simple block and make a hash from it, when there are all values!

You can replace:

		loop df [
			insert head str ch
		]

With: insert/dup str ch df

Ok, tomorrow I will work on this. Actually have changed some text and gui UI.

And you should avoid appending values to a hash like you do, especially when it is not preallocated... append to simple block and make a hash from it, when there are all values!

Thank you for your review