(require ffi/vector

racket/list

xgboost

xgboost/private/demo-utils)

(provide run-example)

(define ncol 10)

(define (split-rows rows)

(for/fold ([tr '()] [te '()] #:result (values (reverse tr) (reverse te)))

([row (in-list rows)] [i (in-naturals)])

(if (zero? (modulo i 5)) (values tr (cons row te)) (values (cons row tr) te))))

(define (rows->dmatrix rs)

(define n (length rs))

(define features (make-f32vector (* n ncol)))

(define labels (make-f32vector n))

(for ([row (in-list rs)] [i (in-naturals)])

(for ([v (in-list (take row ncol))] [j (in-naturals)])

(f32vector-set! features (+ (* i ncol) j) (exact->inexact v)))

(f32vector-set! labels i (exact->inexact (last row))))

(make-dmatrix features #:nrow n #:ncol ncol #:labels labels))

(define (run-example)

(define-values (train-rows test-rows) (split-rows (load-diabetes)))

(define n-q 3)

(define b

(train (rows->dmatrix train-rows)

#:objective "reg:quantileerror"

#:params (list (cons "quantile_alpha" "(0.1,0.5,0.9)")

(cons "tree_method" "hist"))

#:max-depth 4 #:eta 0.1 #:verbosity 0 #:rounds 100))

(define preds (predict b (rows->dmatrix test-rows) #:as 'f32vector))

(define n-test (length test-rows))

(define rows-with-q

(for/list ([i (in-range n-test)] [row (in-list test-rows)])

(define base (* i n-q))

(list (last row)

(f32vector-ref preds (+ base 0))

(f32vector-ref preds (+ base 1))

(f32vector-ref preds (+ base 2)))))

(define crossings

(for/sum ([qs (in-list rows-with-q)])

(if (or (> (cadr qs) (caddr qs)) (> (caddr qs) (cadddr qs))) 1 0)))

(define coverage-80

(for/sum ([qs (in-list rows-with-q)])

(if (and (<= (cadr qs) (car qs)) (<= (car qs) (cadddr qs))) 1 0)))

(define mean-band

(/ (for/sum ([qs (in-list rows-with-q)]) (- (cadddr qs) (cadr qs))) n-test))

(hash 'n-test n-test 'n-q n-q 'pred-len (f32vector-length preds)

'crossings crossings 'coverage-80 coverage-80

'mean-band mean-band 'rows-with-q rows-with-q))

<r08-require>

<r08-provide>

<r08-helpers>

<r08-run>