1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
open Core
open Lacaml.D
module Params = struct
type t = { log_theta : float }
end
module Eval = struct
module Kernel = struct
type params = Params.t
type t = { params : params; const : float }
let create params = { params; const = exp (-2. *. params.Params.log_theta) }
let get_params k = k.params
end
module Inducing = struct
type t = int
let calc_upper k m = Mat.make m m k.Kernel.const
let get_n_points m = m
end
module Input = struct
type t = unit
let eval k () m = Vec.make m k.Kernel.const
let weighted_eval k () _ ~coeffs = k.Kernel.const *. Vec.sum coeffs
let eval_one k () = k.Kernel.const
end
module Inputs = struct
type t = int
let create = Array.length
let get_n_points n = n
let choose_subset _inputs indexes = Bigarray.Array1.dim indexes
let create_inducing _kernel n = n
let create_default_kernel_params _inputs ~n_inducing:_ =
{ Params.log_theta = 0. }
let calc_upper = Inducing.calc_upper
let calc_diag k n = Vec.make n k.Kernel.const
let calc_cross k ~inputs:n ~inducing:m = Mat.make n m k.Kernel.const
let weighted_eval k ~inputs:_ ~inducing:_ ~coeffs =
let res = copy coeffs in
scal k.Kernel.const res;
res
end
end
module Deriv = struct
module Eval = Eval
module Hyper = struct
type t = [ `Log_theta ]
let get_all _kernel _inducing _inputs = [| `Log_theta |]
let get_value { Eval.Kernel.params } _inducing _inputs = function
| `Log_theta -> params.Params.log_theta
let set_values kernel inducing inputs hypers values =
let { Eval.Kernel.params } = kernel in
let log_theta_ref = ref params.Params.log_theta in
let kernel_changed_ref = ref false in
for i = 1 to Array.length hypers do
match hypers.(i - 1) with
| `Log_theta ->
log_theta_ref := values.{i};
kernel_changed_ref := true
done;
let new_kernel =
if !kernel_changed_ref then
Eval.Kernel.create { Params.log_theta = !log_theta_ref }
else kernel
in
(new_kernel, inducing, inputs)
end
let calc_const_deriv k = -2. *. k.Eval.Kernel.const
module Inducing = struct
type upper = { m : int; deriv_const : float }
let calc_shared_upper k m =
(Eval.Inducing.calc_upper k m, { m; deriv_const = calc_const_deriv k })
let calc_deriv_upper shared `Log_theta = `Const shared.deriv_const
end
module Inputs = struct
type diag = { diag_eval_inputs : Eval.Inputs.t; diag_const_deriv : float }
type cross = { cross_const_deriv : float }
let calc_shared_diag k diag_eval_inputs =
( Eval.Inputs.calc_diag k diag_eval_inputs,
{ diag_eval_inputs; diag_const_deriv = calc_const_deriv k } )
let calc_shared_cross k ~inputs ~inducing =
( Eval.Inputs.calc_cross k ~inputs ~inducing,
{ cross_const_deriv = calc_const_deriv k } )
let calc_deriv_diag diag `Log_theta = `Const diag.diag_const_deriv
let calc_deriv_cross cross `Log_theta = `Const cross.cross_const_deriv
end
end