Skip to content

Instantly share code, notes, and snippets.

@GiuseppeChillemi
Last active September 4, 2023 22:03
Show Gist options
  • Save GiuseppeChillemi/45053d2d0a2cada811b262fd3660b0e3 to your computer and use it in GitHub Desktop.
Save GiuseppeChillemi/45053d2d0a2cada811b262fd3660b0e3 to your computer and use it in GitHub Desktop.
Speed test for various key/val structures
;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
]
]
@Oldes
Copy link

Oldes commented Sep 2, 2023

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!

@GiuseppeChillemi
Copy link
Author

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.

@GiuseppeChillemi
Copy link
Author

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

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment