Skip to content

Instantly share code, notes, and snippets.

@giesse
Last active November 20, 2021 19:13
Show Gist options
  • Save giesse/1232d7f71a15a3a8417ec6f091398811 to your computer and use it in GitHub Desktop.
Save giesse/1232d7f71a15a3a8417ec6f091398811 to your computer and use it in GitHub Desktop.
profile function for Red (two variants)
Red []
e.g.: :comment
; ideally not exported on the global context
delta-time*: function [code count] [
start: now/precise
loop count code
difference now/precise start
]
delta-time: function [
"Return the time it takes to evaluate a block"
code [block! word! function!] "Code to evaluate"
/accuracy run-time [time! none!] "Longer time gives more accurate results, but takes longer to compute. Default 0:00:00.1"
][
run-time: any [run-time 0:00:00.1]
time: 0:00:00
count: 1
if word? :code [code: get code]
cd: either block? :code [code] [[code]]
while [time < run-time] [
time: delta-time* cd count
; if your computer is really really fast, or now/precise is not accurate enough
; (hello Windows users!)
either time > 0 [
result: time / count
; multiply by 1.5 for faster convergence
; (ie. aim for 1.5*run-time)
count: to integer! run-time * count * 1.5 / time
] [
count: count * 10
]
]
result
]
runs-per: function [
"Return the number of times code can run in a given period"
code [block! word! function!] "Code to evaluate"
time [time!]
][
t: delta-time/accuracy :code time
to integer! time / t
]
format-time: function [
"Convert a time value to a human readable string"
time [time!]
] [
if time >= 0:00:01 [
; work around a bug in the current stable release
time: form round/to time 0.001
if decimals: find/tail time #"." [
clear skip decimals 3
]
return time
]
units: ["ms" "μs" "ns" "ps"]
foreach u units [
time: time * 1000
if time >= 0:00:01 [
time: to integer! round time
return append form time u
]
]
]
print-table: function [
"Print a block of blocks as an ASCII table"
headers [block!]
block [block!]
] [
format: clear []
header: clear []
sep: []
i: 1
unless parse headers [
some [
(text: width: fmt-func: none)
set text string! any [set width integer! | set fmt-func word! | set fmt-func path!]
(
append header sep
append header either width [pad text width] [text]
either width [
either fmt-func [
append format compose [(sep) pad (fmt-func) pick block (i) (width)]
] [
append format compose [(sep) pad pick block (i) (width)]
]
] [
either fmt-func [
append format compose [(sep) (fmt-func) pick block (i)]
] [
append format compose [(sep) pick block (i)]
]
]
sep: "|"
i: i + 1
)
]
] [
cause-error "Invalid headers spec"
]
print header
format: func [block] reduce ['print format]
foreach row block [format row]
]
; Putting the runtime first in results, and memory second, helps things
; line up nicely. It's a problem if we want to add more stats though,
; as any code using the data with expected field indexes will break if
; we don't add the new stats at the end. We could use named fields as
; well but, for now, we'll stick with this and let this comment serve
; as a warning. More stats will certainly come in the future, as will
; GC, but this is just a quickie function in any case.
; Memory stats and formatted output added by @toomasv.
profile: function [
"Profile code, returning [time memory source] results"
blocks [block!] "Block of code values (block, word, or function) to profile"
/accuracy run-time [time!] "Longer time gives more accurate results, but takes longer to compute. Default 0:00:00.1"
/show "Display results, instead of returning them as a block"
][
baseline: delta-time/accuracy [] run-time
res: collect [
foreach blk blocks [
; I'm not convinced about the significance of memory stats when computed this way,
; but I'm going to leave it here -Gab
stats-1: stats ; get current stats before evaluation
n: subtract delta-time/accuracy :blk run-time baseline
keep/only reduce [
n
stats - stats-1
; any practical purpose for copying blk here? -Gab
either block? :blk [copy blk][:blk]
]
]
]
sort res ; sort by time
either show [
unless empty? res [
reference: res/1/1
]
fmt-time: function [time] [
rel: time / reference
rejoin [round/to rel 0.01 "x (" format-time time ")"]
]
print-table [
"Time" 20 fmt-time
"Memory" 11
"Code" mold/flat
] res
][
insert/only res copy [Time Memory Code]
new-line/all res on ; Return formatted results
]
]
e.g. [
probe profile []
profile/show []
print ""
probe profile [[wait 1] [wait .25] [wait .5]]
probe profile [[100 / 1 * (100 / 1)] [100.0 / 1.0 ** 2] [100% / 1%]]
one: [1 + 1]
two: [2 + 2]
probe profile [one two]
print ""
profile/show [[wait 1] [wait .25] [wait .5]]
print ""
profile/show [[100 / 1 * (100 / 1)] [100.0 / 1.0 ** 2] [100% / 1%]]
print ""
profile/show [one two]
print ""
b1: [wait .25]
b2: [wait .5]
profile/show reduce [b1 b2]
print ""
f1: does [wait .25]
f2: does [wait .5]
profile/show reduce [:f1 :f2]
]
Red []
e.g.: :comment
; ideally not exported on the global context
delta-time*: function [code count] [
start: now/precise
loop count code
difference now/precise start
]
delta-time: function [
"Return the time it takes to evaluate a block"
code [block! word! function!] "Code to evaluate"
/count ct [integer! time! none!] "Eval the code this many times, rather than once; if time! determine automatically"
][
if word? :code [code: get code]
cd: either block? :code [code] [[code]]
ct: any [ct 0:00:00.1]
either time? ct [
run-time: to float! ct
time: 0
count: 1
while [time < run-time] [
time: to float! delta-time* cd count
; if your computer is really really fast, or now/precise is not accurate enough
; (hello Windows users!)
either time > 0 [
result: time / count
; multiply by 1.5 for faster convergence
; (ie. aim for 1.5*run-time)
count: to integer! run-time * count * 1.5 / time
] [
count: count * 10
]
]
; because of time! limited accuracy, we return time needed to run 10000 times.
to time! 10000 * result
] [
delta-time* cd ct
]
]
runs-per: function [
"Return the number of times code can run in a given period"
code [block! word! function!] "Code to evaluate"
time [time!]
][
t: delta-time/count :code time
to integer! 10000 * time / t
]
; Putting the runtime first in results, and memory second, helps things
; line up nicely. It's a problem if we want to add more stats though,
; as any code using the data with expected field indexes will break if
; we don't add the new stats at the end. We could use named fields as
; well but, for now, we'll stick with this and let this comment serve
; as a warning. More stats will certainly come in the future, as will
; GC, but this is just a quickie function in any case.
; Memory stats and formatted output added by @toomasv.
profile: function [
"Profile code, returning [total-time time memory source] results"
blocks [block!] "Block of code values (block, word, or function) to profile"
/count ct [integer! time!] "Eval code this many times, rather than determine automatically; or time! for accuracy (longer = more accurate)"
/show "Display results, instead of returning them as a block"
][
ct: any [ct 0:00:00.1]
baseline: delta-time/count [] ct
count: either time? ct [10000] [ct]
res: collect [
foreach blk blocks [
; I'm not convinced about the significance of memory stats when computed this way,
; but I'm going to leave it here -Gab
stats-1: stats ; get current stats before evaluation
n: subtract delta-time/count :blk ct baseline
keep/only reduce [
round/to n .001
round/to n / count .001
stats - stats-1
; any practical purpose for copying blk here? -Gab
either block? :blk [copy blk][:blk]
]
]
]
sort res ; sort by time
either show [
print ["Count: " count]
template: [pad (time) 12 #"|" pad (time-per) 12 #"|" pad (memory) 11 #"|" (mold/flat :code)]
insert/only res ["Time" "Time (Per)" "Memory" Code] ; last column is molded, so not a string here
foreach blk res [
set [time: time-per: memory: code:] blk
print compose template
]
][
insert/only res compose [count: (count) fields: [Time Time-Per Memory Code]]
new-line/all res on ; Return formatted results
]
]
e.g. [
profile []
profile/show []
profile [[wait 1] [wait .25] [wait .5]]
profile/count [[100 / 1 * (100 / 1)] [100.0 / 1.0 ** 2] [100% / 1%]] 1000000
one: [1 + 1]
two: [2 + 2]
profile [one two]
profile/show [[wait 1] [wait .25] [wait .5]]
profile/show/count [[100 / 1 * (100 / 1)] [100.0 / 1.0 ** 2] [100% / 1%]] 1000000
profile/show [one two]
b1: [wait .25]
b2: [wait .5]
profile/show/count reduce [b1 b2] 2
f1: does [wait .25]
f2: does [wait .5]
profile/show/count reduce [:f1 :f2] 2
]
@hiiamboris
Copy link

; any practical purpose for copying blk here? -Gab

This is a wrong solution actually, ideally there should be mold. Try it with profile/show [[repeat i 1000 [put #() i 1]]] to see the rationale.

@giesse
Copy link
Author

giesse commented Dec 29, 2020

Right... but personally I'd rather give names to the blocks and show the names instead (eg. pass a map instead of a block of blocks). Admittedly you normally use this on the console and you're just calling a function, so it's ok as it is, but in general just molding the code block doesn't sound like a great idea to me.

@hiiamboris
Copy link

doesn't sound like a great idea to me.

Why?

@giesse
Copy link
Author

giesse commented Dec 29, 2020

Because code doesn't really fit well in a table cell.

@hiiamboris
Copy link

Well, that's not mold's problem ;)
At least for me, mold/flat/part is usually okay because I can guess the code by first 50-100 chars.
Next step is an IDE. Or is there something in between?

@giesse
Copy link
Author

giesse commented Dec 30, 2020

I've never said that it was mold's problem :) It's just not ideal in this kind of situation. That being said, I use it all the time too, and as I said above, given how profile is generally used, mold is probably ok. The code would need to be molded before being executed though, to avoid the problem you mentioned.

@hiiamboris
Copy link

copy/deep is a necessary evil sometimes too, e.g. in my in-place profiler I cannot mold because I do not know the bounds of each expression before they are evaluated. And after they are evaluated they may change already. So, literal maps are not pretty printed :(

@Oldes
Copy link

Oldes commented Nov 19, 2021

@giesse the memory reporting is not correct, I see this:

>> profile/show [[make string! 5]]
Time                 | Memory      | Code
1.0x (323ns)         | -181080     | [make string! 5]
>> profile/show [[make string! 5]]
Time                 | Memory      | Code
1.0x (317ns)         | 510288      | [make string! 5]

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