Skip to content

Commit ad4e348

Browse files
AYadrovAYadrov
committed
more optimizations
1 parent 2159334 commit ad4e348

File tree

1 file changed

+86
-77
lines changed

1 file changed

+86
-77
lines changed

‎eval/tricks.rkt‎

Lines changed: 86 additions & 77 deletions
Original file line numberDiff line numberDiff line change
@@ -69,22 +69,26 @@
6969
[(bfinfinite? hi) (mpfr-exp lo)]
7070
[else (min (mpfr-exp lo) (mpfr-exp hi))])]))
7171

72-
; Returns (list x (minlog x) (maxlog x) (logspan x) (crosses-zero? x))
72+
; Returns (list (minlog x) (maxlog x) (logspan x) (crosses-zero? x) (bfzero? (ival-lo x)) (any-negative? x))
7373
(define (ival-info x)
7474
(define slack (get-slack))
7575
(define lo (ival-lo x))
7676
(define hi (ival-hi x))
7777
(match (and (boolean? lo) (boolean? hi))
78-
[#t (list x #f #f #f #f)]
78+
[#t (list #f #f #f #f #f #f)]
7979
[#f
8080
(define lo-exp (mpfr-exp lo))
8181
(define hi-exp (mpfr-exp hi))
82+
(define lo-sgn (mpfr-sign lo))
83+
(define hi-sgn (mpfr-sign hi))
84+
85+
(define any-negative? (or (equal? lo-sgn -1) (equal? hi-sgn -1)))
8286
(define-values (zero-lo? inf-lo? zero-hi? inf-hi? crosses-0?)
8387
(values (bfzero? lo)
8488
(bfinfinite? lo)
8589
(bfzero? hi)
8690
(bfinfinite? hi)
87-
(not (equal? (mpfr-sign lo) (mpfr-sign hi)))))
91+
(not (equal? lo-sgn hi-sgn))))
8892
; logspan
8993
(define lg
9094
(match (*bumps-activated*)
@@ -122,7 +126,7 @@
122126
[inf-hi? (values lo-exp (+ (max lo-exp 0) slack))] ; [+..., +inf]
123127
[else (values (min lo-exp hi-exp) (+ (max lo-exp hi-exp) 1))])]))
124128
; output
125-
(list x mn mx lg crosses-0?)]))
129+
(list mn mx lg crosses-0? zero-lo? any-negative?)]))
126130

127131
(define (logspan x)
128132
(match (*bumps-activated*)
@@ -149,8 +153,8 @@
149153
; Γ[*]'y = 1
150154
; ↑ampl[*]'y = logspan(x)
151155
; ↓ampl[*]'y = 0
152-
(match-define (list _ _ _ lg-x _) (first srcs))
153-
(match-define (list _ _ _ lg-y _) (second srcs))
156+
(match-define (list _ _ lg-x _ _ _) (first srcs))
157+
(match-define (list _ _ lg-y _ _ _) (second srcs))
154158
(list (cons lg-x 0) ; bounds per x
155159
(cons lg-y 0))] ; bounds per y
156160

@@ -162,8 +166,8 @@
162166
; Γ[/]'y = 1
163167
; ↑ampl[/]'y = logspan(x) + 2 * logspan(y)
164168
; ↓ampl[/]'y = 0
165-
(match-define (list _ _ _ lg-x _) (first srcs))
166-
(match-define (list _ _ _ lg-y _) (second srcs))
169+
(match-define (list _ _ lg-x _ _ _) (first srcs))
170+
(match-define (list _ _ lg-y _ _ _) (second srcs))
167171
(list (cons lg-y 0) ; bounds per x
168172
(cons (+ lg-x (* 2 lg-y)) 0))] ; bounds per y
169173

@@ -175,7 +179,7 @@
175179
; Γ[cbrt]'x = 1/3
176180
; ↑ampl[cbrt]'x = logspan(x)*2/3 - 1
177181
; ↓ampl[cbrt]'x = 0
178-
(match-define (list _ _ _ lg-x _) (first srcs))
182+
(match-define (list _ _ lg-x _ _ _) (first srcs))
179183
(list (cons (quotient lg-x 2) 0))]
180184

181185
[(ival-add ival-sub ival-add! ival-sub!)
@@ -186,15 +190,17 @@
186190
; Γ[+ & -]'y = |y/(x+y)| & |-y/(x-y)|
187191
; ↑ampl[+ & -]'y = maxlog(y) - minlog(z)
188192
; ↓ampl[+ & -]'y = minlog(y) - maxlog(z)
189-
(match-define (list x _ mx-x _ _) (first srcs))
190-
(match-define (list y _ mx-y _ _) (second srcs))
191-
(match-define (list z mn-z _ _ _) output)
193+
(match-define (list _ mx-x _ _ _ _) (first srcs))
194+
(match-define (list _ mx-y _ _ _ _) (second srcs))
195+
(match-define (list mn-z _ _ _ _ _) output)
192196

193197
(if (*lower-bound-early-stopping*)
194198
(list (cons (- mx-x mn-z)
195-
(- (minlog x #:less-slack #t) (maxlog z #:less-slack #t))) ; bounds per x
199+
0
200+
#;(- (minlog x #:less-slack #t) (maxlog z #:less-slack #t))) ; bounds per x
196201
(cons (- mx-y mn-z)
197-
(- (minlog y #:less-slack #t) (maxlog z #:less-slack #t)))) ; bounds per y
202+
0
203+
#;(- (minlog y #:less-slack #t) (maxlog z #:less-slack #t)))) ; bounds per y
198204
(list (cons (- mx-x mn-z) 0) ; bounds per x
199205
(cons (- mx-y mn-z) 0)))] ; bounds per y
200206

@@ -206,30 +212,32 @@
206212
; Γ[pow]'y = |y*ln(x)|
207213
; ↑ampl[pow]'y = maxlog(y) + max(|minlog(x)|,|maxlog(x)|) + logspan(z)
208214
; ↓ampl[pow]'y = minlog(y)
209-
(match-define (list x mn-x mx-x lg-x _) (first srcs))
210-
(match-define (list y _ mx-y _ _) (second srcs))
211-
(match-define (list z _ _ lg-z cr-z) output)
215+
(match-define (list mn-x mx-x lg-x _ _ an-x) (first srcs))
216+
(match-define (list _ mx-y _ _ _ _) (second srcs))
217+
(match-define (list _ _ lg-z cr-z zl-z _) output)
212218

213219
; when output crosses zero and x is negative - means that y was fractional and not fixed (specific of Rival)
214220
; solution - add more slack for y to converge
215221
(define y-slack
216-
(if (and cr-z (bfnegative? (ival-lo x)))
222+
(if (and cr-z an-x)
217223
(get-slack)
218224
0))
219225

220226
; when output is (ival 0.bf ...) - it means that x was close to 1 or 0 but not narrow enough
221227
(define x-slack
222-
(if (bfzero? (ival-lo z))
228+
(if zl-z
223229
(get-slack)
224230
0))
225231

226232
(if (*lower-bound-early-stopping*)
227233
(list (cons (max (+ mx-y lg-x lg-z x-slack) x-slack)
228-
(minlog y #:less-slack #t)) ; bounds per x
234+
0
235+
#;(minlog y #:less-slack #t)) ; bounds per x
229236
(cons (max (+ mx-y (max (abs mx-x) (abs mn-x)) lg-z y-slack) y-slack)
230-
(cond
231-
[(zero? (min (abs mx-x) (abs mn-x))) 0]
232-
[else (minlog y #:less-slack #t)]))) ; bounds per y
237+
0
238+
#;(cond
239+
[(zero? (min (abs mx-x) (abs mn-x))) 0]
240+
[else (minlog y #:less-slack #t)]))) ; bounds per y
233241
(list (cons (max (+ mx-y lg-x lg-z x-slack) x-slack) 0) ; bounds per x
234242
(cons (max (+ mx-y (max (abs mx-x) (abs mn-x)) lg-z y-slack) y-slack)
235243
0)))] ; bounds per y
@@ -238,92 +246,94 @@
238246
; Γ[exp & exp2]'x = |x| & |x*ln(2)|
239247
; ↑ampl[exp & exp2]'x = maxlog(x) + logspan(z)
240248
; ↓ampl[exp & exp2]'x = minlog(x)
241-
(match-define (list x _ mx-x _ _) (first srcs))
242-
(match-define (list _ _ _ lg-z _) output)
249+
(match-define (list _ mx-x _ _ _ _) (first srcs))
250+
(match-define (list _ _ lg-z _ _ _) output)
243251

244252
(if (*lower-bound-early-stopping*)
245-
(list (cons (+ mx-x lg-z) (minlog x #:less-slack #t)))
253+
(list (cons (+ mx-x lg-z) 0 #;(minlog x #:less-slack #t)))
246254
(list (cons (+ mx-x lg-z) 0)))]
247255

248256
[(ival-tan)
249257
; Γ[tan]'x = |x / (cos(x) * sin(x))|
250258
; ↑ampl[tan]'x = maxlog(x) + max(|minlog(z)|,|maxlog(z)|) + logspan(z) + 1
251259
; ↓ampl[tan]'x = minlog(x) + min(|minlog(z)|,|maxlog(z)|) - 1
252-
(match-define (list x _ mx-x _ _) (first srcs))
253-
(match-define (list z mn-z mx-z lg-z _) output)
260+
(match-define (list _ mx-x _ _ _ _) (first srcs))
261+
(match-define (list mn-z mx-z lg-z _ _ _) output)
254262

255263
(if (*lower-bound-early-stopping*)
256264
(list (cons (+ mx-x (max (abs mx-z) (abs mn-z)) lg-z 1)
257-
(- (+ (minlog x #:less-slack #t)
258-
(min (abs (maxlog z #:less-slack #t)) (abs (minlog z #:less-slack #t))))
259-
1)))
265+
0
266+
#;(- (+ (minlog x #:less-slack #t)
267+
(min (abs (maxlog z #:less-slack #t)) (abs (minlog z #:less-slack #t))))
268+
1)))
260269
(list (cons (+ mx-x (max (abs mx-z) (abs mn-z)) lg-z 1) 0)))]
261270

262271
[(ival-sin)
263272
; Γ[sin]'x = |x * cos(x) / sin(x)|
264273
; ↑ampl[sin]'x = maxlog(x) - minlog(z)
265274
; ↓ampl[sin]'x = | - maxlog(z) - 1, if maxlog(x) > 1
266275
; | 0 else
267-
(match-define (list _ _ mx-x _ _) (first srcs))
268-
(match-define (list z mn-z _ _ _) output)
276+
(match-define (list _ mx-x _ _ _ _) (first srcs))
277+
(match-define (list mn-z _ _ _ _ _) output)
269278

270279
(if (*lower-bound-early-stopping*)
271280
(list (cons (- mx-x mn-z)
272-
(if (>= mx-x 1)
273-
(- -1 (maxlog z #:less-slack #t))
274-
0)))
281+
0
282+
#;(if (>= mx-x 1)
283+
(- -1 (maxlog z #:less-slack #t))
284+
0)))
275285
(list (cons (- mx-x mn-z) 0)))]
276286

277287
[(ival-cos)
278288
; Γ[cos]'x = |x * sin(x) / cos(x)|
279289
; ↑ampl[cos]'x = maxlog(x) - minlog(z) + min(maxlog(x), 0)
280290
; ↓ampl[cos]'x = - maxlog(x) - 2
281-
(match-define (list _ _ mx-x _ _) (first srcs))
282-
(match-define (list z mn-z _ _ _) output)
291+
(match-define (list _ mx-x _ _ _ _) (first srcs))
292+
(match-define (list mn-z _ _ _ _ _) output)
283293

284294
(if (*lower-bound-early-stopping*)
285-
(list (cons (+ (- mx-x mn-z) (min mx-x 0)) (- (- 2) (maxlog z #:less-slack #t))))
295+
(list (cons (+ (- mx-x mn-z) (min mx-x 0)) 0 #;(- (- 2) (maxlog z #:less-slack #t))))
286296
(list (cons (+ (- mx-x mn-z) (min mx-x 0)) 0)))]
287297

288298
[(ival-sinh)
289299
; Γ[sinh]'x = |x * cosh(x) / sinh(x)|
290300
; ↑ampl[sinh]'x = maxlog(x) + logspan(z) - min(minlog(x), 0)
291301
; ↓ampl[sinh]'x = max(0, minlog(x))
292-
(match-define (list x mn-x mx-x _ _) (first srcs))
293-
(match-define (list _ _ _ lg-z _) output)
302+
(match-define (list mn-x mx-x _ _ _ _) (first srcs))
303+
(match-define (list _ _ lg-z _ _ _) output)
294304

295305
(if (*lower-bound-early-stopping*)
296-
(list (cons (- (+ mx-x lg-z) (min mn-x 0)) (max 0 (minlog x #:less-slack #t))))
306+
(list (cons (- (+ mx-x lg-z) (min mn-x 0)) 0 #;(max 0 (minlog x #:less-slack #t))))
297307
(list (cons (- (+ mx-x lg-z) (min mn-x 0)) 0)))]
298308

299309
[(ival-cosh)
300310
; Γ[cosh]'x = |x * sinh(x) / cosh(x)|
301311
; ↑ampl[cosh]'x = maxlog(x) + logspan(z) + min(maxlog(x), 0)
302312
; ↓ampl[cosh]'x = max(0, minlog(x) - 1)
303-
(match-define (list x _ mx-x lg-x _) (first srcs))
304-
(match-define (list _ _ _ lg-z _) output)
313+
(match-define (list _ mx-x lg-x _ _ _) (first srcs))
314+
(match-define (list _ _ lg-z _ _ _) output)
305315

306316
(if (*lower-bound-early-stopping*)
307-
(list (cons (+ mx-x lg-z (min mx-x 0)) (max 0 (- (minlog x #:less-slack #t) 1))))
317+
(list (cons (+ mx-x lg-z (min mx-x 0)) 0 #;(max 0 (- (minlog x #:less-slack #t) 1))))
308318
(list (cons (+ mx-x lg-z (min mx-x 0)) 0)))]
309319

310320
[(ival-log ival-log2 ival-log10)
311321
; Γ[log & log2 & log10]'x = |1 / ln(x)| & |ln(2) / ln(x)| & |ln(10) / ln(x)|
312322
; ↑ampl[log & log2 & log10]'x = logspan(x) - minlog(z) + 1
313323
; ↓ampl[log & log2 & log10]'x = - maxlog(z)
314-
(match-define (list _ _ _ lg-x _) (first srcs))
315-
(match-define (list z mn-z _ _ _) output)
324+
(match-define (list _ _ lg-x _ _ _) (first srcs))
325+
(match-define (list mn-z _ _ _ _ _) output)
316326

317327
(if (*lower-bound-early-stopping*)
318-
(list (cons (+ (- lg-x mn-z) 1) (- (maxlog z #:less-slack #t))))
328+
(list (cons (+ (- lg-x mn-z) 1) 0 #;(- (maxlog z #:less-slack #t))))
319329
(list (cons (+ (- lg-x mn-z) 1) 0)))]
320330

321331
[(ival-asin)
322332
; Γ[asin]'x = |x / (sqrt(1-x^2) * arcsin(x))|
323333
; ↑ampl[asin]'x = | slack, if maxlog(z) > 1
324334
; | 1 else
325335
; ↓ampl[asin]'x = 0
326-
(match-define (list _ _ mx-z _ _) output)
336+
(match-define (list _ mx-z _ _ _ _) output)
327337

328338
(list (if (>= mx-z 1)
329339
(cons (get-slack) 0) ; assumes that log[1-x^2]/2 is equal to slack
@@ -334,7 +344,7 @@
334344
; ↑ampl[acos]'x = | slack, if maxlog(x) >= 0
335345
; | 0 else
336346
; ↓ampl[acos]'x = 0
337-
(match-define (list _ _ mx-x _ _) (first srcs))
347+
(match-define (list _ mx-x _ _ _ _) (first srcs))
338348

339349
(list (if (>= mx-x 0)
340350
(cons (get-slack) 0) ; assumes that log[1-x^2]/2 is equal to slack
@@ -344,14 +354,15 @@
344354
; Γ[atan]'x = | x / ((1+x^2) * arctan(x))|
345355
; ↑ampl[atan]'x = - min(|minlog(x)|, |maxlog(x)|) - minlog(z) + logspan(x)
346356
; ↓ampl[atan]'x = - max(|minlog(x)|, |maxlog(x)|) - maxlog(z) - 2
347-
(match-define (list x mn-x mx-x lg-x _) (first srcs))
348-
(match-define (list z mn-z _ _ _) output)
357+
(match-define (list mn-x mx-x lg-x _ _ _) (first srcs))
358+
(match-define (list mn-z _ _ _ _ _) output)
349359

350360
(if (*lower-bound-early-stopping*)
351361
(list (cons (- lg-x (min (abs mn-x) (abs mx-x)) mn-z)
352-
(- (- (max (abs (minlog x #:less-slack #t)) (abs (maxlog x #:less-slack #t))))
353-
(maxlog z #:less-slack #t)
354-
2)))
362+
0
363+
#;(- (- (max (abs (minlog x #:less-slack #t)) (abs (maxlog x #:less-slack #t))))
364+
(maxlog z #:less-slack #t)
365+
2)))
355366
(list (cons (- lg-x (min (abs mn-x) (abs mx-x)) mn-z) 0)))]
356367

357368
[(ival-fmod ival-remainder)
@@ -363,9 +374,9 @@
363374
; Γ[mod]'y ` |y/mod(x,y)|
364375
; ↑ampl[mod]'y = maxlog(y) - minlog(z)
365376
; ↓ampl[mod]'y = minlog(y) - maxlog(z) or just 0
366-
(match-define (list _ _ mx-x _ _) (first srcs))
367-
(match-define (list y _ _ _ cr-y) (second srcs))
368-
(match-define (list _ mn-z _ _ _) output)
377+
(match-define (list _ mx-x _ _ _ _) (first srcs))
378+
(match-define (list _ _ _ cr-y _ _) (second srcs))
379+
(match-define (list mn-z _ _ _ _ _) output)
369380

370381
(define slack
371382
(if cr-y
@@ -381,13 +392,10 @@
381392
; ↑ampl[log1p]'x = | maxlog(x) - minlog(z) + slack, if x is negative
382393
; | maxlog(x) - minlog(z), else
383394
; ↓ampl[log1p]'x = 0
384-
(match-define (list x _ mx-x _ _) (first srcs))
385-
(match-define (list _ mn-z _ _ _) output)
386-
387-
(define xhi (ival-hi x))
388-
(define xlo (ival-lo x))
395+
(match-define (list _ mx-x _ _ _ an-x) (first srcs))
396+
(match-define (list mn-z _ _ _ _ _) output)
389397

390-
(list (if (or (equal? (mpfr-sign xlo) -1) (equal? (mpfr-sign xhi) -1))
398+
(list (if an-x
391399
(cons (+ (- mx-x mn-z) (get-slack)) 0)
392400
(cons (- mx-x mn-z) 0)))]
393401

@@ -396,33 +404,34 @@
396404
; Γ[expm1]'x = |x * e^x / expm1|
397405
; ↑ampl[expm1]'x = max(1 + maxlog(x), 1 + maxlog(x) - minlog(z))
398406
; ↓ampl[expm1]'x = 0
399-
(match-define (list _ _ mx-x _ _) (first srcs))
400-
(match-define (list _ mn-z _ _ _) output)
407+
(match-define (list _ mx-x _ _ _ _) (first srcs))
408+
(match-define (list mn-z _ _ _ _ _) output)
401409

402410
(list (cons (max (+ 1 mx-x) (+ 1 (- mx-x mn-z))) 0))]
403411

404412
[(ival-atan2)
405413
; Γ[atan2]'x = Γ[atan2]'y = |xy / ((x^2 + y^2)*arctan(y/x))|
406414
; ↑ampl[expm1]'x = maxlog(x) + maxlog(y) - 2*min(minlog(x), minlog(y)) - minlog(z)
407415
; ↓ampl[expm1]'x = minlog(x) + minlog(y) - 2*max(maxlog(x), maxlog(y)) - maxlog(z)
408-
(match-define (list x mn-x mx-x _ _) (first srcs))
409-
(match-define (list y mn-y mx-y _ _) (second srcs))
410-
(match-define (list z mn-z _ _ _) output)
416+
(match-define (list mn-x mx-x _ _ _ _) (first srcs))
417+
(match-define (list mn-y mx-y _ _ _ _) (second srcs))
418+
(match-define (list mn-z _ _ _ _ _) output)
411419

412420
(if (*lower-bound-early-stopping*)
413421
(make-list 2
414422
(cons (- (+ mx-x mx-y) (* 2 (min mn-x mn-y)) mn-z)
415-
(- (+ (minlog x #:less-slack #t) (minlog y #:less-slack #t))
416-
(* 2 (max (maxlog x #:less-slack #t) (maxlog y #:less-slack #t)))
417-
(maxlog z #:less-slack #t))))
423+
0
424+
#;(- (+ (minlog x #:less-slack #t) (minlog y #:less-slack #t))
425+
(* 2 (max (maxlog x #:less-slack #t) (maxlog y #:less-slack #t)))
426+
(maxlog z #:less-slack #t))))
418427
(make-list 2 (cons (- (+ mx-x mx-y) (* 2 (min mn-x mn-y)) mn-z) 0)))]
419428

420429
[(ival-tanh)
421430
; Γ[tanh]'x = |x / (sinh(x) * cosh(x))|
422431
; ↑ampl[tanh]'x = logspan(z) + logspan(x)
423432
; ↓ampl[tanh]'x = 0
424-
(match-define (list _ _ _ lg-x _) (first srcs))
425-
(match-define (list _ _ _ lg-z _) output)
433+
(match-define (list _ _ lg-x _ _ _) (first srcs))
434+
(match-define (list _ _ lg-z _ _ _) output)
426435

427436
(list (cons (+ lg-z lg-x) 0))]
428437

@@ -431,7 +440,7 @@
431440
; ↑ampl[atanh]'x = | 1, if x < 0.5
432441
; | slack
433442
; ↓ampl[atanh]'x = 0
434-
(match-define (list _ _ mx-x _ _) (first srcs))
443+
(match-define (list _ mx-x _ _ _ _) (first srcs))
435444
(list (if (>= mx-x 1)
436445
(cons (get-slack) 0)
437446
(cons 1 0)))]
@@ -441,7 +450,7 @@
441450
; ↑ampl[acosh]'x = | -minlog(z) + slack, if minlog(z) < 2
442451
; | 0
443452
; ↓ampl[acosh]'x = 0
444-
(match-define (list _ mn-z _ _ _) output)
453+
(match-define (list mn-z _ _ _ _ _) output)
445454
(list (if (< mn-z 2) ; when acosh(x) < 1
446455
(cons (- (get-slack) mn-z) 0)
447456
(cons 0 0)))]
@@ -450,7 +459,7 @@
450459
; Γ[acosh]'x = |2 x x* / x^2|
451460
; ↑ampl[pow2]'x = logspan(x) + 1
452461
; ↓ampl[pow2]'x = 0
453-
(match-define (list _ _ _ lg-x _) (first srcs))
462+
(match-define (list _ _ lg-x _ _ _) (first srcs))
454463
(list (cons (+ lg-x 1) 0))]
455464

456465
; TODO

0 commit comments

Comments
 (0)