├── .gitignore ├── LICENSE ├── README.md ├── project.clj └── src └── dbda ├── ch08 └── complete_example.clj ├── ch09 ├── multiple-coins-lik.cl ├── multiple-coins.cl ├── multiple_coins.clj ├── single-coin.cl ├── single_coin.clj ├── therapeutic-touch-data.csv ├── therapeutic-touch-lik.cl ├── therapeutic-touch.cl └── therapeutic_touch.clj ├── ch16 ├── smart-drug-normal.cl ├── smart-drug-student-t.cl ├── smart-drug.csv ├── smart_drug_normal.clj └── smart_drug_student_t.clj ├── ch17 ├── hier-lin-regress-data.csv ├── ht-wt-data-30.csv ├── ht-wt-data-300.csv ├── income-famz-state.csv ├── quadratic-trend.cl ├── quadratic_trend.clj ├── robust-hierarchical-linear-regression.cl ├── robust-linear-regression.cl ├── robust_hierarchical_linear_regression.clj └── robust_linear_regression.clj ├── ch18 ├── multiple-linear-regression.cl ├── multiple_linear_regression.clj └── sat-spending.csv └── ch19 ├── fruitfly-data-reduced.csv ├── fruitfly.cl └── sex_and_death.clj /.gitignore: -------------------------------------------------------------------------------- 1 | target 2 | /.nrepl-port 3 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Eclipse Public License - v 2.0 2 | 3 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE 4 | PUBLIC LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION 5 | OF THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 6 | 7 | 1. DEFINITIONS 8 | 9 | "Contribution" means: 10 | 11 | a) in the case of the initial Contributor, the initial content 12 | Distributed under this Agreement, and 13 | 14 | b) in the case of each subsequent Contributor: 15 | i) changes to the Program, and 16 | ii) additions to the Program; 17 | where such changes and/or additions to the Program originate from 18 | and are Distributed by that particular Contributor. A Contribution 19 | "originates" from a Contributor if it was added to the Program by 20 | such Contributor itself or anyone acting on such Contributor's behalf. 21 | Contributions do not include changes or additions to the Program that 22 | are not Modified Works. 23 | 24 | "Contributor" means any person or entity that Distributes the Program. 25 | 26 | "Licensed Patents" mean patent claims licensable by a Contributor which 27 | are necessarily infringed by the use or sale of its Contribution alone 28 | or when combined with the Program. 29 | 30 | "Program" means the Contributions Distributed in accordance with this 31 | Agreement. 32 | 33 | "Recipient" means anyone who receives the Program under this Agreement 34 | or any Secondary License (as applicable), including Contributors. 35 | 36 | "Derivative Works" shall mean any work, whether in Source Code or other 37 | form, that is based on (or derived from) the Program and for which the 38 | editorial revisions, annotations, elaborations, or other modifications 39 | represent, as a whole, an original work of authorship. 40 | 41 | "Modified Works" shall mean any work in Source Code or other form that 42 | results from an addition to, deletion from, or modification of the 43 | contents of the Program, including, for purposes of clarity any new file 44 | in Source Code form that contains any contents of the Program. Modified 45 | Works shall not include works that contain only declarations, 46 | interfaces, types, classes, structures, or files of the Program solely 47 | in each case in order to link to, bind by name, or subclass the Program 48 | or Modified Works thereof. 49 | 50 | "Distribute" means the acts of a) distributing or b) making available 51 | in any manner that enables the transfer of a copy. 52 | 53 | "Source Code" means the form of a Program preferred for making 54 | modifications, including but not limited to software source code, 55 | documentation source, and configuration files. 56 | 57 | "Secondary License" means either the GNU General Public License, 58 | Version 2.0, or any later versions of that license, including any 59 | exceptions or additional permissions as identified by the initial 60 | Contributor. 61 | 62 | 2. GRANT OF RIGHTS 63 | 64 | a) Subject to the terms of this Agreement, each Contributor hereby 65 | grants Recipient a non-exclusive, worldwide, royalty-free copyright 66 | license to reproduce, prepare Derivative Works of, publicly display, 67 | publicly perform, Distribute and sublicense the Contribution of such 68 | Contributor, if any, and such Derivative Works. 69 | 70 | b) Subject to the terms of this Agreement, each Contributor hereby 71 | grants Recipient a non-exclusive, worldwide, royalty-free patent 72 | license under Licensed Patents to make, use, sell, offer to sell, 73 | import and otherwise transfer the Contribution of such Contributor, 74 | if any, in Source Code or other form. This patent license shall 75 | apply to the combination of the Contribution and the Program if, at 76 | the time the Contribution is added by the Contributor, such addition 77 | of the Contribution causes such combination to be covered by the 78 | Licensed Patents. The patent license shall not apply to any other 79 | combinations which include the Contribution. No hardware per se is 80 | licensed hereunder. 81 | 82 | c) Recipient understands that although each Contributor grants the 83 | licenses to its Contributions set forth herein, no assurances are 84 | provided by any Contributor that the Program does not infringe the 85 | patent or other intellectual property rights of any other entity. 86 | Each Contributor disclaims any liability to Recipient for claims 87 | brought by any other entity based on infringement of intellectual 88 | property rights or otherwise. As a condition to exercising the 89 | rights and licenses granted hereunder, each Recipient hereby 90 | assumes sole responsibility to secure any other intellectual 91 | property rights needed, if any. For example, if a third party 92 | patent license is required to allow Recipient to Distribute the 93 | Program, it is Recipient's responsibility to acquire that license 94 | before distributing the Program. 95 | 96 | d) Each Contributor represents that to its knowledge it has 97 | sufficient copyright rights in its Contribution, if any, to grant 98 | the copyright license set forth in this Agreement. 99 | 100 | e) Notwithstanding the terms of any Secondary License, no 101 | Contributor makes additional grants to any Recipient (other than 102 | those set forth in this Agreement) as a result of such Recipient's 103 | receipt of the Program under the terms of a Secondary License 104 | (if permitted under the terms of Section 3). 105 | 106 | 3. REQUIREMENTS 107 | 108 | 3.1 If a Contributor Distributes the Program in any form, then: 109 | 110 | a) the Program must also be made available as Source Code, in 111 | accordance with section 3.2, and the Contributor must accompany 112 | the Program with a statement that the Source Code for the Program 113 | is available under this Agreement, and informs Recipients how to 114 | obtain it in a reasonable manner on or through a medium customarily 115 | used for software exchange; and 116 | 117 | b) the Contributor may Distribute the Program under a license 118 | different than this Agreement, provided that such license: 119 | i) effectively disclaims on behalf of all other Contributors all 120 | warranties and conditions, express and implied, including 121 | warranties or conditions of title and non-infringement, and 122 | implied warranties or conditions of merchantability and fitness 123 | for a particular purpose; 124 | 125 | ii) effectively excludes on behalf of all other Contributors all 126 | liability for damages, including direct, indirect, special, 127 | incidental and consequential damages, such as lost profits; 128 | 129 | iii) does not attempt to limit or alter the recipients' rights 130 | in the Source Code under section 3.2; and 131 | 132 | iv) requires any subsequent distribution of the Program by any 133 | party to be under a license that satisfies the requirements 134 | of this section 3. 135 | 136 | 3.2 When the Program is Distributed as Source Code: 137 | 138 | a) it must be made available under this Agreement, or if the 139 | Program (i) is combined with other material in a separate file or 140 | files made available under a Secondary License, and (ii) the initial 141 | Contributor attached to the Source Code the notice described in 142 | Exhibit A of this Agreement, then the Program may be made available 143 | under the terms of such Secondary Licenses, and 144 | 145 | b) a copy of this Agreement must be included with each copy of 146 | the Program. 147 | 148 | 3.3 Contributors may not remove or alter any copyright, patent, 149 | trademark, attribution notices, disclaimers of warranty, or limitations 150 | of liability ("notices") contained within the Program from any copy of 151 | the Program which they Distribute, provided that Contributors may add 152 | their own appropriate notices. 153 | 154 | 4. COMMERCIAL DISTRIBUTION 155 | 156 | Commercial distributors of software may accept certain responsibilities 157 | with respect to end users, business partners and the like. While this 158 | license is intended to facilitate the commercial use of the Program, 159 | the Contributor who includes the Program in a commercial product 160 | offering should do so in a manner which does not create potential 161 | liability for other Contributors. Therefore, if a Contributor includes 162 | the Program in a commercial product offering, such Contributor 163 | ("Commercial Contributor") hereby agrees to defend and indemnify every 164 | other Contributor ("Indemnified Contributor") against any losses, 165 | damages and costs (collectively "Losses") arising from claims, lawsuits 166 | and other legal actions brought by a third party against the Indemnified 167 | Contributor to the extent caused by the acts or omissions of such 168 | Commercial Contributor in connection with its distribution of the Program 169 | in a commercial product offering. The obligations in this section do not 170 | apply to any claims or Losses relating to any actual or alleged 171 | intellectual property infringement. In order to qualify, an Indemnified 172 | Contributor must: a) promptly notify the Commercial Contributor in 173 | writing of such claim, and b) allow the Commercial Contributor to control, 174 | and cooperate with the Commercial Contributor in, the defense and any 175 | related settlement negotiations. The Indemnified Contributor may 176 | participate in any such claim at its own expense. 177 | 178 | For example, a Contributor might include the Program in a commercial 179 | product offering, Product X. That Contributor is then a Commercial 180 | Contributor. If that Commercial Contributor then makes performance 181 | claims, or offers warranties related to Product X, those performance 182 | claims and warranties are such Commercial Contributor's responsibility 183 | alone. Under this section, the Commercial Contributor would have to 184 | defend claims against the other Contributors related to those performance 185 | claims and warranties, and if a court requires any other Contributor to 186 | pay any damages as a result, the Commercial Contributor must pay 187 | those damages. 188 | 189 | 5. NO WARRANTY 190 | 191 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, AND TO THE EXTENT 192 | PERMITTED BY APPLICABLE LAW, THE PROGRAM IS PROVIDED ON AN "AS IS" 193 | BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER EXPRESS OR 194 | IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR CONDITIONS OF 195 | TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A PARTICULAR 196 | PURPOSE. Each Recipient is solely responsible for determining the 197 | appropriateness of using and distributing the Program and assumes all 198 | risks associated with its exercise of rights under this Agreement, 199 | including but not limited to the risks and costs of program errors, 200 | compliance with applicable laws, damage to or loss of data, programs 201 | or equipment, and unavailability or interruption of operations. 202 | 203 | 6. DISCLAIMER OF LIABILITY 204 | 205 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, AND TO THE EXTENT 206 | PERMITTED BY APPLICABLE LAW, NEITHER RECIPIENT NOR ANY CONTRIBUTORS 207 | SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 208 | EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION LOST 209 | PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 210 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 211 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 212 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE 213 | POSSIBILITY OF SUCH DAMAGES. 214 | 215 | 7. GENERAL 216 | 217 | If any provision of this Agreement is invalid or unenforceable under 218 | applicable law, it shall not affect the validity or enforceability of 219 | the remainder of the terms of this Agreement, and without further 220 | action by the parties hereto, such provision shall be reformed to the 221 | minimum extent necessary to make such provision valid and enforceable. 222 | 223 | If Recipient institutes patent litigation against any entity 224 | (including a cross-claim or counterclaim in a lawsuit) alleging that the 225 | Program itself (excluding combinations of the Program with other software 226 | or hardware) infringes such Recipient's patent(s), then such Recipient's 227 | rights granted under Section 2(b) shall terminate as of the date such 228 | litigation is filed. 229 | 230 | All Recipient's rights under this Agreement shall terminate if it 231 | fails to comply with any of the material terms or conditions of this 232 | Agreement and does not cure such failure in a reasonable period of 233 | time after becoming aware of such noncompliance. If all Recipient's 234 | rights under this Agreement terminate, Recipient agrees to cease use 235 | and distribution of the Program as soon as reasonably practicable. 236 | However, Recipient's obligations under this Agreement and any licenses 237 | granted by Recipient relating to the Program shall continue and survive. 238 | 239 | Everyone is permitted to copy and distribute copies of this Agreement, 240 | but in order to avoid inconsistency the Agreement is copyrighted and 241 | may only be modified in the following manner. The Agreement Steward 242 | reserves the right to publish new versions (including revisions) of 243 | this Agreement from time to time. No one other than the Agreement 244 | Steward has the right to modify this Agreement. The Eclipse Foundation 245 | is the initial Agreement Steward. The Eclipse Foundation may assign the 246 | responsibility to serve as the Agreement Steward to a suitable separate 247 | entity. Each new version of the Agreement will be given a distinguishing 248 | version number. The Program (including Contributions) may always be 249 | Distributed subject to the version of the Agreement under which it was 250 | received. In addition, after a new version of the Agreement is published, 251 | Contributor may elect to Distribute the Program (including its 252 | Contributions) under the new version. 253 | 254 | Except as expressly stated in Sections 2(a) and 2(b) above, Recipient 255 | receives no rights or licenses to the intellectual property of any 256 | Contributor under this Agreement, whether expressly, by implication, 257 | estoppel or otherwise. All rights in the Program not expressly granted 258 | under this Agreement are reserved. Nothing in this Agreement is intended 259 | to be enforceable by any entity that is not a Contributor or Recipient. 260 | No third-party beneficiary rights are created under this Agreement. 261 | 262 | Exhibit A - Form of Secondary Licenses Notice 263 | 264 | "This Source Code may also be made available under the following 265 | Secondary Licenses when the conditions for such availability set forth 266 | in the Eclipse Public License, v. 2.0 are satisfied: {name license(s), 267 | version(s), and exceptions or additional permissions here}." 268 | 269 | Simply including a copy of this Agreement, including this Exhibit A 270 | is not sufficient to license the Source Code under Secondary Licenses. 271 | 272 | If it is not possible or desirable to put the notice in a particular 273 | file, then You may include the notice in a location (such as a LICENSE 274 | file in a relevant directory) where a recipient would be likely to 275 | look for such a notice. 276 | 277 | You may add additional accurate notices of copyright ownership. 278 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | [New books available for subscription](https://aiprobook.com) 3 | 4 | Deep Learning for Programmers 5 | 6 | Numerical Linear Algebra for Programmers 7 | 8 | # doing-bayesian-data-analysis-gpu-opencl 9 | Doing Bayesian Data Analysis book examples with [Bayadera](https://github.com/uncomplicate/bayadera) (Clojure + GPU) 10 | ## License 11 | 12 | Copyright © 2015-2020 Dragan Djuric 13 | 14 | Distributed under the Eclipse Public License either version 1.0 or (at your option) any later version. 15 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Dragan Djuric. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) or later 4 | ;; which can be found in the file LICENSE at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (defproject dbda "0.4.0-SNAPSHOT" 10 | :description "Doing Bayesian Data Analysis book on the GPU with Clojure, CUDA, and OpenCL" 11 | :author "Dragan Djuric" 12 | :url "http://github.com/dragandj/doing-bayesian-data-analysis-gpu" 13 | :scm {:name "git" 14 | :url "http://github.com/dragandj/doing-bayesian-data-analysis-gpu"} 15 | :license {:name "Eclipse Public License" 16 | :url "http://www.eclipse.org/legal/epl-v10.html"} 17 | :dependencies [[org.clojure/clojure "1.10.1"] 18 | [uncomplicate/bayadera "0.4.0-SNAPSHOT"] 19 | [org.clojure/data.csv "0.1.4"]] 20 | 21 | :profiles {:dev {:dependencies [[midje "1.9.9"]] 22 | :plugins [[lein-midje "3.2.1"]] 23 | :global-vars {*warn-on-reflection* true 24 | *unchecked-math* :warn-on-boxed 25 | *print-length* 16} 26 | :jvm-opts ^:replace ["-Dclojure.compiler.direct-linking=true" 27 | "-XX:MaxDirectMemorySize=16g" "-XX:+UseLargePages" 28 | #_"--add-opens=java.base/jdk.internal.ref=ALL-UNNAMED"]}} 29 | 30 | :javac-options ["-target" "1.8" "-source" "1.8" "-Xlint:-options"]) 31 | -------------------------------------------------------------------------------- /src/dbda/ch08/complete_example.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Dragan Djuric. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) or later 4 | ;; which can be found in the file LICENSE at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:author "Dragan Djuric"} 10 | dbda.ch08.complete-example 11 | (:require [quil.core :as q] 12 | [quil.applet :as qa] 13 | [quil.middlewares.pause-on-error :refer [pause-on-error]] 14 | [uncomplicate.commons.core :refer [with-release]] 15 | [uncomplicate.fluokitten.core :refer [op]] 16 | [uncomplicate.neanderthal 17 | [core :refer [row native scal! vctr]] 18 | [native :refer [fv]]] 19 | [uncomplicate.bayadera 20 | [core :refer [sampler dataset density distribution evidence sample]] 21 | [library :refer [beta likelihood]] 22 | [distributions :refer [beta-params binomial-lik-params]] 23 | [mcmc :refer [mix!]] 24 | [opencl :refer [with-default-bayadera]]] 25 | [uncomplicate.bayadera.internal.protocols :as p] 26 | [uncomplicate.bayadera.toolbox 27 | [processing :refer :all] 28 | [scaling :refer [axis vector-axis]] 29 | [plots :refer [render-sample]]])) 30 | 31 | (def all-data (atom {})) 32 | (def plots (atom nil)) 33 | 34 | (defn analysis [] 35 | (with-default-bayadera 36 | (let [a 1 b 1 37 | z 15 N 50] 38 | (with-release [prior-dist (beta a b) 39 | prior-sampler (sampler prior-dist) 40 | prior-sample (dataset (sample prior-sampler)) 41 | prior-pdf (density prior-dist prior-sample) 42 | binomial-lik (likelihood :binomial) 43 | coin-data (vctr prior-sample (binomial-lik-params N z)) 44 | post (distribution "beta_binomial" binomial-lik prior-dist) 45 | post-dist (post coin-data) 46 | post-sampler (time (doto (sampler post-dist) (mix!))) 47 | post-sample (dataset (sample post-sampler)) 48 | post-pdf (scal! (/ 1.0 (evidence binomial-lik coin-data prior-sample)) 49 | (density post-dist post-sample))] 50 | 51 | {:prior {:sample (native (row (p/data prior-sample) 0)) 52 | :pdf (native prior-pdf)} 53 | :posterior {:sample (native (row (p/data post-sample) 0)) 54 | :pdf (native post-pdf)}})))) 55 | 56 | (defn setup [] 57 | (reset! plots 58 | {:data @all-data 59 | :prior (plot2d (qa/current-applet) {:width 1000 :height 700}) 60 | :posterior (plot2d (qa/current-applet) {:width 1000 :height 700})})) 61 | 62 | (defn draw [] 63 | (when-not (= @all-data (:data @plots)) 64 | (swap! plots assoc :data @all-data) 65 | (q/background 0) 66 | (q/image (show (render (:prior @plots) 67 | {:x-axis (axis 0 1) :x (:sample (:prior @all-data)) 68 | :y-axis (axis 0 2) :y (:pdf (:prior @all-data))})) 0 0) 69 | (q/image (show (render-sample (:posterior @plots) 70 | (:sample (:posterior @all-data)) 71 | (:pdf (:posterior @all-data)))) 0 720))) 72 | 73 | (defn display-sketch [] 74 | (q/defsketch diagrams 75 | :renderer :p2d 76 | :size :fullscreen 77 | :display 2 78 | :setup setup 79 | :draw draw 80 | :middleware [pause-on-error])) 81 | 82 | ;; This is how to run it: 83 | ;; 1. Display empty window (preferrably spanning the screen) 84 | #_(display-sketch) 85 | ;; 2. Run the analysis to populate the data that the plots draw 86 | #_(reset! all-data (analysis)) 87 | ;; It is awkward, but I was constrained by how quil and processing 88 | ;; manage display. 89 | -------------------------------------------------------------------------------- /src/dbda/ch09/multiple-coins-lik.cl: -------------------------------------------------------------------------------- 1 | inline REAL multiple_coins_loglik(const uint data_len, const REAL* data, const uint dim, const REAL* p) { 2 | return binomial_log(data[0], p[0], data[1]) + binomial_log(data[2], p[1], data[3]); 3 | } 4 | -------------------------------------------------------------------------------- /src/dbda/ch09/multiple-coins.cl: -------------------------------------------------------------------------------- 1 | inline REAL multiple_coins_logpdf(const uint data_len, const uint hyperparams_len, const REAL* params, 2 | const uint dim, REAL* x) { 3 | const REAL a = params[0]; 4 | const REAL b = params[1]; 5 | const REAL k = params[2]; 6 | const REAL theta0 = x[0]; 7 | const REAL theta1 = x[1]; 8 | const REAL omega = x[2]; 9 | const REAL ak = omega * (k - 2) + 1; 10 | const REAL bk = (1 - omega) * (k - 2) + 1; 11 | const bool valid = (0.0f < omega) && (omega < 1.0f) 12 | && (0.0f < theta0) && (theta0 < 1.0f) 13 | && (0.0f < theta1) && (theta1 < 1.0f); 14 | return valid ? 15 | beta_log(a, b, omega) - lbeta(a, b) 16 | + beta_log(ak, bk, theta0) - lbeta(ak, bk) 17 | + beta_log(ak, bk, theta1) - lbeta(ak, bk) 18 | : NAN; 19 | 20 | } 21 | -------------------------------------------------------------------------------- /src/dbda/ch09/multiple_coins.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Dragan Djuric. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) or later 4 | ;; which can be found in the file LICENSE at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:author "Dragan Djuric"} 10 | dbda.ch09.multiple-coins 11 | (:require [quil.core :as q] 12 | [quil.applet :as qa] 13 | [quil.middlewares.pause-on-error :refer [pause-on-error]] 14 | [uncomplicate.commons.core :refer [with-release let-release wrap-float]] 15 | [uncomplicate.neanderthal 16 | [core :refer [row native dot imax imin scal! col submatrix vctr]] 17 | [real :refer [entry entry!]] 18 | [native :refer [fv fge]]] 19 | [uncomplicate.bayadera 20 | [core :refer :all] 21 | [library :as library] 22 | [util :refer [bin-mapper hdi]] 23 | [opencl :refer [with-default-bayadera]] 24 | [mcmc :refer [mix! anneal! burn-in! acc-rate! run-sampler!]]] 25 | [uncomplicate.bayadera.internal.protocols :as p] 26 | [uncomplicate.bayadera.toolbox 27 | [processing :refer :all] 28 | [plots :refer [render-sample render-histogram]]] 29 | [clojure.java.io :as io])) 30 | 31 | (def all-data (atom {})) 32 | (def state (atom nil)) 33 | 34 | (defn analysis [] 35 | (with-default-bayadera 36 | (let [walker-count (* 256 44 32) 37 | sample-count (* 16 walker-count) 38 | z0 3 N0 15 39 | z1 4 N1 5] 40 | (with-release [multiple-coins-prior 41 | (library/distribution-model [:beta (slurp (io/resource "dbda/ch09/multiple-coins.cl"))] 42 | {:name "multiple_coins" :params-size 3 :dimension 3 43 | :limits (fge 2 3 [0 1 0 1 0 1])}) 44 | multiple-coins-likelihood-model 45 | (library/likelihood-model [:binomial (slurp (io/resource "dbda/ch09/multiple-coins-lik.cl"))] 46 | {:name "multiple_coins" :params-size 4}) 47 | prior (distribution multiple-coins-prior) 48 | prior-dist-5 (prior (fv 2 2 5)) 49 | prior-sampler-5 (time (doto (sampler prior-dist-5) (mix!))) 50 | prior-sample-5 (dataset (sample prior-sampler-5)) 51 | prior-dist-75 (prior (fv 2 2 75)) 52 | prior-sampler-75 (time (doto (sampler prior-dist-75) (mix!))) 53 | prior-sample-75 (dataset (sample prior-sampler-75)) 54 | multiple-coins-likelihood (likelihood multiple-coins-likelihood-model) 55 | post-model (posterior-model multiple-coins-likelihood multiple-coins-prior) 56 | post (distribution post-model) 57 | coin-data (vctr prior-sample-5 N0 z0 N1 z1) 58 | post-dist-5 (post coin-data (fv 2 2 5)) 59 | post-sampler-5 (time (doto (sampler post-dist-5) (mix!))) 60 | post-sample-5 (dataset (sample post-sampler-5)) 61 | post-dist-75 (post coin-data (fv 2 2 75)) 62 | post-sampler-75 (time (doto (sampler post-dist-75) (mix!))) 63 | post-sample-75 (dataset (sample post-sampler-75))] 64 | 65 | (println "Bayes Factor p(D|k=5)/p(D|k=75) = " 66 | (/ (evidence multiple-coins-likelihood coin-data prior-sample-5) 67 | (evidence multiple-coins-likelihood coin-data prior-sample-75))) 68 | 69 | {:prior-5 (histogram prior-sampler-5) 70 | :prior-75 (histogram prior-sampler-75) 71 | :posterior-5 (time (histogram post-sampler-5)) 72 | :posterior-75 (time (histogram post-sampler-75))})))) 73 | 74 | (defn setup [] 75 | (reset! state 76 | {:data @all-data 77 | :plots (repeatedly 12 (partial plot2d (qa/current-applet) {:width 300 :height 300}))})) 78 | 79 | (defn draw-plots [[omega theta0 theta1] data ^long x-position ^long y-position] 80 | (q/image (show (render-histogram omega data 2)) 81 | x-position y-position) 82 | (q/image (show (render-histogram theta0 data 0)) 83 | (+ x-position 20 (width omega)) y-position) 84 | (q/image (show (render-histogram theta1 data 1)) 85 | (+ x-position 20 (+ (width omega) (width theta1))) y-position)) 86 | 87 | (defn draw [] 88 | (when-not (= @all-data (:data @state)) 89 | (swap! state assoc :data @all-data) 90 | (q/background 0) 91 | (draw-plots (:plots @state) (:prior-5 @all-data) 0 0) 92 | (draw-plots (drop 3 (:plots @state)) (:posterior-5 @all-data) 0 320) 93 | (draw-plots (drop 6 (:plots @state)) (:prior-75 @all-data) 0 640) 94 | (draw-plots (drop 9 (:plots @state)) (:posterior-75 @all-data) 0 960))) 95 | 96 | (defn display-sketch [] 97 | (q/defsketch diagrams 98 | :renderer :p2d 99 | :size :fullscreen 100 | :display 2 101 | :setup setup 102 | :draw draw 103 | :middleware [pause-on-error])) 104 | 105 | ;; This is how to run it: 106 | ;; 1. Display empty window (preferrably spanning the screen) 107 | #_(display-sketch) 108 | ;; 2. Run the analysis to populate the data that the plots draw 109 | #_(reset! all-data (analysis)) 110 | ;; It is awkward, but I was constrained by how quil and processing 111 | ;; manage display. 112 | -------------------------------------------------------------------------------- /src/dbda/ch09/single-coin.cl: -------------------------------------------------------------------------------- 1 | inline REAL single_coin_logpdf(const uint data_len, const uint hyperparams_len, const REAL* params, 2 | const uint dim, REAL* x) { 3 | const REAL a = params[0]; 4 | const REAL b = params[1]; 5 | const REAL k = params[2]; 6 | const REAL theta = x[0]; 7 | const REAL omega = x[1]; 8 | const REAL ak = omega * (k - 2) + 1; 9 | const REAL bk = (1 - omega) * (k - 2) + 1; 10 | const bool valid = (0.0f < omega) && (omega < 1.0f) && (0.0f < theta) && (theta < 1.0f); 11 | return valid ? 12 | beta_log(ak, bk, theta) - lbeta(ak, bk) 13 | + beta_log(a, b, omega) - lbeta(a, b) 14 | : NAN; 15 | 16 | } 17 | -------------------------------------------------------------------------------- /src/dbda/ch09/single_coin.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Dragan Djuric. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) or later 4 | ;; which can be found in the file LICENSE at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:author "Dragan Djuric"} 10 | dbda.ch09.single-coin 11 | (:require [quil.core :as q] 12 | [quil.applet :as qa] 13 | [quil.middlewares.pause-on-error :refer [pause-on-error]] 14 | [uncomplicate.commons.core :refer [with-release let-release wrap-float]] 15 | [uncomplicate.neanderthal 16 | [core :refer [row native dot imax imin scal! col submatrix vctr]] 17 | [real :refer [entry entry!]] 18 | [native :refer [fv fge]]] 19 | [uncomplicate.bayadera 20 | [core :refer :all] 21 | [library :as library] 22 | [distributions :refer [binomial-lik-params]] 23 | [util :refer [bin-mapper hdi]] 24 | [opencl :refer [with-default-bayadera]] 25 | [mcmc :refer [mix! anneal! burn-in! acc-rate! run-sampler!]]] 26 | [uncomplicate.bayadera.internal.protocols :as p] 27 | [uncomplicate.bayadera.toolbox 28 | [processing :refer :all] 29 | [plots :refer [render-sample render-histogram]]] 30 | [clojure.java.io :as io])) 31 | 32 | (def all-data (atom {})) 33 | (def state (atom nil)) 34 | 35 | (defn analysis [] 36 | (with-default-bayadera 37 | (let [walker-count (* 256 44 32) 38 | sample-count (* 16 walker-count) 39 | z 9 N 12] 40 | (with-release [single-coin-model 41 | (library/distribution-model [:beta (slurp (io/resource "dbda/ch09/single-coin.cl"))] 42 | {:name "single_coin" :params-size 3 :dimension 2 43 | :limits (fge 2 2 [0 1 0 1])}) 44 | prior (distribution single-coin-model) 45 | prior-dist (prior (fv 2 2 100)) 46 | prior-sampler (time (doto (sampler prior-dist) (mix! {:a 2.68}))) 47 | prior-sample (dataset (sample prior-sampler sample-count)) 48 | prior-pdf (density prior-dist prior-sample) 49 | binomial-lik (library/likelihood :binomial) 50 | post (distribution "posterior" binomial-lik prior-dist) 51 | coin-data (vctr prior-sample (binomial-lik-params N z)) 52 | post-dist (post coin-data) 53 | post-sampler (time (doto (sampler post-dist) (mix!))) 54 | post-sample (dataset (sample post-sampler sample-count)) 55 | post-pdf (scal! (/ 1.0 (evidence binomial-lik coin-data prior-sample)) 56 | (density post-dist post-sample))] 57 | 58 | {:prior {:sample (native (submatrix (p/data prior-sample) 0 0 2 walker-count)) 59 | :pdf (native prior-pdf) 60 | :histogram (histogram! prior-sampler 100)} 61 | :posterior {:sample (native (submatrix (p/data post-sample) 0 0 2 walker-count)) 62 | :pdf (native post-pdf) 63 | :histogram (time (histogram! post-sampler 100))}})))) 64 | 65 | (defn setup [] 66 | (reset! state 67 | {:data @all-data 68 | :plots (repeatedly 6 (partial plot2d (qa/current-applet) {:width 400 :height 400}))})) 69 | 70 | (defn draw-plots [[scatterplot omega theta] data ^long x-position ^long y-position] 71 | (q/image (show (render-sample scatterplot 72 | (row (:sample data) 0) 73 | (row (:sample data) 1) 74 | (:pdf data))) 75 | x-position y-position) 76 | (q/image (show (render-histogram omega (:histogram data) 1 :rotate)) 77 | (+ x-position 20 (width scatterplot)) y-position) 78 | (q/image (show (render-histogram theta (:histogram data) 0)) 79 | x-position (+ y-position 20 (height scatterplot)))) 80 | 81 | (defn draw [] 82 | (when-not (= @all-data (:data @state)) 83 | (swap! state assoc :data @all-data) 84 | (q/background 0) 85 | (draw-plots (:plots @state) (:prior @all-data) 0 0) 86 | (draw-plots (drop 3 (:plots @state)) (:posterior @all-data) 0 840))) 87 | 88 | (defn display-sketch [] 89 | (q/defsketch diagrams 90 | :renderer :p2d 91 | :size :fullscreen 92 | :setup setup 93 | :draw draw 94 | :middleware [pause-on-error])) 95 | 96 | ;; This is how to run it: 97 | ;; 1. Display empty window (preferrably spanning the screen) 98 | #_(display-sketch) 99 | ;; 2. Run the analysis to populate the data that the plots draw 100 | #_(reset! all-data (analysis)) 101 | ;; It is awkward, but I was constrained by how quil and processing 102 | ;; manage display. 103 | -------------------------------------------------------------------------------- /src/dbda/ch09/therapeutic-touch-data.csv: -------------------------------------------------------------------------------- 1 | "y","s" 2 | "1","S01" 3 | "0","S01" 4 | "0","S01" 5 | "0","S01" 6 | "0","S01" 7 | "0","S01" 8 | "0","S01" 9 | "0","S01" 10 | "0","S01" 11 | "0","S01" 12 | "0","S02" 13 | "0","S02" 14 | "0","S02" 15 | "1","S02" 16 | "0","S02" 17 | "0","S02" 18 | "1","S02" 19 | "0","S02" 20 | "0","S02" 21 | "0","S02" 22 | "0","S03" 23 | "0","S03" 24 | "0","S03" 25 | "0","S03" 26 | "0","S03" 27 | "1","S03" 28 | "0","S03" 29 | "0","S03" 30 | "1","S03" 31 | "1","S03" 32 | "0","S04" 33 | "1","S04" 34 | "1","S04" 35 | "0","S04" 36 | "1","S04" 37 | "0","S04" 38 | "0","S04" 39 | "0","S04" 40 | "0","S04" 41 | "0","S04" 42 | "0","S05" 43 | "1","S05" 44 | "0","S05" 45 | "0","S05" 46 | "0","S05" 47 | "1","S05" 48 | "0","S05" 49 | "0","S05" 50 | "1","S05" 51 | "0","S05" 52 | "0","S06" 53 | "0","S06" 54 | "0","S06" 55 | "1","S06" 56 | "1","S06" 57 | "0","S06" 58 | "0","S06" 59 | "0","S06" 60 | "1","S06" 61 | "0","S06" 62 | "0","S07" 63 | "0","S07" 64 | "1","S07" 65 | "0","S07" 66 | "0","S07" 67 | "1","S07" 68 | "1","S07" 69 | "0","S07" 70 | "0","S07" 71 | "0","S07" 72 | "0","S08" 73 | "1","S08" 74 | "1","S08" 75 | "0","S08" 76 | "0","S08" 77 | "1","S08" 78 | "0","S08" 79 | "0","S08" 80 | "0","S08" 81 | "0","S08" 82 | "1","S09" 83 | "0","S09" 84 | "1","S09" 85 | "0","S09" 86 | "0","S09" 87 | "0","S09" 88 | "0","S09" 89 | "0","S09" 90 | "1","S09" 91 | "0","S09" 92 | "0","S10" 93 | "1","S10" 94 | "0","S10" 95 | "0","S10" 96 | "0","S10" 97 | "0","S10" 98 | "1","S10" 99 | "0","S10" 100 | "1","S10" 101 | "0","S10" 102 | "0","S11" 103 | "1","S11" 104 | "0","S11" 105 | "1","S11" 106 | "0","S11" 107 | "0","S11" 108 | "0","S11" 109 | "1","S11" 110 | "1","S11" 111 | "0","S11" 112 | "0","S12" 113 | "1","S12" 114 | "0","S12" 115 | "0","S12" 116 | "0","S12" 117 | "0","S12" 118 | "0","S12" 119 | "1","S12" 120 | "1","S12" 121 | "1","S12" 122 | "1","S13" 123 | "0","S13" 124 | "1","S13" 125 | "1","S13" 126 | "1","S13" 127 | "0","S13" 128 | "0","S13" 129 | "0","S13" 130 | "0","S13" 131 | "0","S13" 132 | "0","S14" 133 | "0","S14" 134 | "0","S14" 135 | "0","S14" 136 | "0","S14" 137 | "0","S14" 138 | "1","S14" 139 | "1","S14" 140 | "1","S14" 141 | "1","S14" 142 | "1","S15" 143 | "0","S15" 144 | "0","S15" 145 | "1","S15" 146 | "0","S15" 147 | "0","S15" 148 | "0","S15" 149 | "1","S15" 150 | "1","S15" 151 | "0","S15" 152 | "0","S16" 153 | "1","S16" 154 | "1","S16" 155 | "1","S16" 156 | "0","S16" 157 | "0","S16" 158 | "0","S16" 159 | "1","S16" 160 | "0","S16" 161 | "1","S16" 162 | "0","S17" 163 | "1","S17" 164 | "1","S17" 165 | "0","S17" 166 | "1","S17" 167 | "0","S17" 168 | "0","S17" 169 | "1","S17" 170 | "0","S17" 171 | "1","S17" 172 | "1","S18" 173 | "1","S18" 174 | "0","S18" 175 | "1","S18" 176 | "1","S18" 177 | "0","S18" 178 | "1","S18" 179 | "0","S18" 180 | "0","S18" 181 | "0","S18" 182 | "1","S19" 183 | "0","S19" 184 | "1","S19" 185 | "1","S19" 186 | "1","S19" 187 | "1","S19" 188 | "0","S19" 189 | "0","S19" 190 | "0","S19" 191 | "0","S19" 192 | "0","S20" 193 | "0","S20" 194 | "1","S20" 195 | "0","S20" 196 | "1","S20" 197 | "1","S20" 198 | "1","S20" 199 | "0","S20" 200 | "0","S20" 201 | "1","S20" 202 | "1","S21" 203 | "0","S21" 204 | "0","S21" 205 | "1","S21" 206 | "1","S21" 207 | "1","S21" 208 | "0","S21" 209 | "0","S21" 210 | "1","S21" 211 | "0","S21" 212 | "0","S22" 213 | "1","S22" 214 | "1","S22" 215 | "0","S22" 216 | "0","S22" 217 | "1","S22" 218 | "0","S22" 219 | "1","S22" 220 | "1","S22" 221 | "0","S22" 222 | "1","S23" 223 | "1","S23" 224 | "1","S23" 225 | "0","S23" 226 | "0","S23" 227 | "0","S23" 228 | "1","S23" 229 | "1","S23" 230 | "1","S23" 231 | "0","S23" 232 | "1","S24" 233 | "0","S24" 234 | "0","S24" 235 | "1","S24" 236 | "1","S24" 237 | "1","S24" 238 | "0","S24" 239 | "0","S24" 240 | "1","S24" 241 | "1","S24" 242 | "1","S25" 243 | "0","S25" 244 | "0","S25" 245 | "1","S25" 246 | "0","S25" 247 | "1","S25" 248 | "1","S25" 249 | "1","S25" 250 | "1","S25" 251 | "1","S25" 252 | "1","S26" 253 | "1","S26" 254 | "1","S26" 255 | "1","S26" 256 | "1","S26" 257 | "0","S26" 258 | "1","S26" 259 | "0","S26" 260 | "0","S26" 261 | "1","S26" 262 | "0","S27" 263 | "0","S27" 264 | "1","S27" 265 | "1","S27" 266 | "1","S27" 267 | "0","S27" 268 | "1","S27" 269 | "1","S27" 270 | "1","S27" 271 | "1","S27" 272 | "1","S28" 273 | "1","S28" 274 | "1","S28" 275 | "1","S28" 276 | "0","S28" 277 | "1","S28" 278 | "1","S28" 279 | "1","S28" 280 | "0","S28" 281 | "1","S28" 282 | -------------------------------------------------------------------------------- /src/dbda/ch09/therapeutic-touch-lik.cl: -------------------------------------------------------------------------------- 1 | REAL touch_loglik(const uint data_len, const REAL* data, const uint dim, const REAL* p) { 2 | REAL loglik = 0.0f; 3 | for (uint i = 0; i < (dim - 2); i++) { 4 | const REAL theta = p[i]; 5 | loglik += binomial_log_unscaled(data[2*i], theta, data[2*i+1]); 6 | } 7 | return loglik; 8 | 9 | } 10 | -------------------------------------------------------------------------------- /src/dbda/ch09/therapeutic-touch.cl: -------------------------------------------------------------------------------- 1 | REAL touch_logpdf(const uint data_len, const uint hyperparams_len, const REAL* params, 2 | const uint dim, REAL* x) { 3 | const REAL a = params[0]; 4 | const REAL b = params[1]; 5 | const REAL omega = x[dim - 2]; 6 | const REAL kappam2 = x[dim - 1]; 7 | const REAL ak = omega * kappam2 + 1.0f; 8 | const REAL bk = (1 - omega) * kappam2 + 1.0f; 9 | 10 | bool valid = (0.0f <= omega) & (omega <= 1.0f) && (0.0f <= kappam2); 11 | REAL logp = beta_log(a, b, omega) + gamma_log(params[2], params[3], kappam2) 12 | - (dim - 2) * lbeta(ak, bk); 13 | 14 | for (uint i = 0; i < (dim - 2); i++) { 15 | const REAL theta = x[i]; 16 | valid = valid && (0.0f <= theta) && (theta <= 1.0f); 17 | logp += beta_log_unscaled(ak, bk, theta); 18 | } 19 | 20 | return valid ? logp : NAN; 21 | 22 | } 23 | -------------------------------------------------------------------------------- /src/dbda/ch09/therapeutic_touch.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Dragan Djuric. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) or later 4 | ;; which can be found in the file LICENSE at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:author "Dragan Djuric"} 10 | dbda.ch09.therapeutic-touch 11 | (:require [quil.core :as q] 12 | [quil.applet :as qa] 13 | [quil.middlewares.pause-on-error :refer [pause-on-error]] 14 | [uncomplicate.commons.core :refer [with-release let-release wrap-float info]] 15 | [uncomplicate.fluokitten.core :refer [op]] 16 | [uncomplicate.neanderthal 17 | [core :refer [row native dot imax imin scal! col submatrix transfer]] 18 | [real :refer [entry entry!]] 19 | [native :refer [fv fge]]] 20 | [uncomplicate.bayadera 21 | [core :refer :all] 22 | [library :as library] 23 | [util :refer [bin-mapper hdi]] 24 | [opencl :refer [with-default-bayadera]] 25 | [mcmc :refer [mix!]]] 26 | [uncomplicate.bayadera.toolbox 27 | [processing :refer :all] 28 | [plots :refer [render-sample render-histogram]]] 29 | [clojure.java.io :as io] 30 | [clojure.data.csv :as csv])) 31 | 32 | (def all-data (atom {})) 33 | (def state (atom nil)) 34 | 35 | (def subjects 28) 36 | 37 | (let [in-file (slurp (io/resource "dbda/ch09/therapeutic-touch-data.csv"))] 38 | (def params (fv (seq (reduce (fn [^ints acc [b c]] 39 | (let [c (* 2 (dec (int (bigint (subs c 1)))))] 40 | (aset acc c (inc (aget acc c) )) 41 | (aset acc (inc c) (+ (aget acc (inc c)) (int (read-string b)))) 42 | acc)) 43 | (int-array 56) 44 | (drop 1 (csv/read-csv in-file))))))) 45 | 46 | (defn analysis [] 47 | (with-default-bayadera 48 | (let [walker-count (* 256 44)] 49 | (with-release [touch-prior 50 | (library/distribution-model [:beta :gamma 51 | (slurp (io/resource "dbda/ch09/therapeutic-touch.cl"))] 52 | {:name "touch" :params-size 4 :dimension (+ subjects 2)}) 53 | touch-likelihood 54 | (library/likelihood-model [:binomial 55 | (slurp (io/resource "dbda/ch09/therapeutic-touch-lik.cl"))] 56 | {:name "touch"}) 57 | limits (fge 2 (+ subjects 2) 58 | (op (take (+ 2 (* subjects 2)) 59 | (interleave (repeat 0) (repeat 1))) 60 | [0 30])) 61 | prior (distribution touch-prior) 62 | prior-dist (prior (fv 1 1 1.105125 1.105125)) 63 | post (distribution "touch" touch-likelihood prior-dist) 64 | post-dist (post (fv (take (* subjects 2) params))) 65 | post-sampler (sampler post-dist {:walkers walker-count :limits limits})] 66 | (println (time (mix! post-sampler {:refining 20}))) 67 | (println (info post-sampler)) 68 | (histogram! post-sampler 320))))) 69 | 70 | (defn setup [] 71 | (reset! state 72 | {:data @all-data 73 | :omega (plot2d (qa/current-applet) {:width 300 :height 300}) 74 | :kappa-2 (plot2d (qa/current-applet) {:width 300 :height 300}) 75 | :thetas (vec (repeatedly 28 (partial plot2d (qa/current-applet) 76 | {:width 180 :height 180})))})) 77 | 78 | (defn draw [] 79 | (when-not (= @all-data (:data @state)) 80 | (swap! state assoc :data @all-data) 81 | (let [data @all-data] 82 | (q/background 0) 83 | (q/image (show (render-histogram (:omega @state) data subjects)) 0 0) 84 | (q/image (show (render-histogram (:kappa-2 @state) data (inc subjects))) 350 0) 85 | (dotimes [i 6] 86 | (dotimes [j 5] 87 | (let [index (+ (* i 5) j)] 88 | (when (< index 28) 89 | (q/image (show (render-histogram ((:thetas @state) index) data index)) 90 | (* j 200) (+ 320 (* i 200)))))))))) 91 | 92 | (defn display-sketch [] 93 | (q/defsketch diagrams 94 | :renderer :p2d 95 | :size :fullscreen 96 | :display 2 97 | :setup setup 98 | :draw draw 99 | :middleware [pause-on-error])) 100 | 101 | ;; This is how to run it: 102 | ;; 1. Display empty window (preferrably spanning the screen) 103 | #_(display-sketch) 104 | ;; 2. Run the analysis to populate the data that the plots draw 105 | #_(reset! all-data (analysis)) 106 | ;; It is awkward, but I was constrained by how quil and processing 107 | ;; manage display. 108 | -------------------------------------------------------------------------------- /src/dbda/ch16/smart-drug-normal.cl: -------------------------------------------------------------------------------- 1 | REAL smart_drug_logpdf(const uint data_len, const uint hyperparams_len, const REAL* params, 2 | const uint dim, REAL* x) { 3 | 4 | return gaussian_log(params[0], params[1], x[0]) 5 | + uniform_log(params[2], params[3], x[1]); 6 | 7 | } 8 | -------------------------------------------------------------------------------- /src/dbda/ch16/smart-drug-student-t.cl: -------------------------------------------------------------------------------- 1 | REAL smart_drug_mcmc_logpdf(const uint data_len, const uint hyperparams_len, const REAL* params, 2 | const uint dim, REAL* x) { 3 | 4 | return exponential_log_unscaled(params[0], x[0] - 1) 5 | + gaussian_log_unscaled(params[1], params[2], x[1]) 6 | + uniform_log(params[3], params[4], x[2]); 7 | 8 | } 9 | 10 | REAL smart_drug_logpdf(const uint data_len, const uint hyperparams_len, const REAL* params, 11 | const uint dim, REAL* x) { 12 | 13 | return exponential_log(params[0], x[0] - 1) 14 | + gaussian_log(params[1], params[2], x[1]) 15 | + uniform_log(params[3], params[4], x[2]); 16 | 17 | } 18 | -------------------------------------------------------------------------------- /src/dbda/ch16/smart-drug.csv: -------------------------------------------------------------------------------- 1 | "Score","Group" 2 | 102,"Smart Drug" 3 | 107,"Smart Drug" 4 | 92,"Smart Drug" 5 | 101,"Smart Drug" 6 | 110,"Smart Drug" 7 | 68,"Smart Drug" 8 | 119,"Smart Drug" 9 | 106,"Smart Drug" 10 | 99,"Smart Drug" 11 | 103,"Smart Drug" 12 | 90,"Smart Drug" 13 | 93,"Smart Drug" 14 | 79,"Smart Drug" 15 | 89,"Smart Drug" 16 | 137,"Smart Drug" 17 | 119,"Smart Drug" 18 | 126,"Smart Drug" 19 | 110,"Smart Drug" 20 | 71,"Smart Drug" 21 | 114,"Smart Drug" 22 | 100,"Smart Drug" 23 | 95,"Smart Drug" 24 | 91,"Smart Drug" 25 | 99,"Smart Drug" 26 | 97,"Smart Drug" 27 | 106,"Smart Drug" 28 | 106,"Smart Drug" 29 | 129,"Smart Drug" 30 | 115,"Smart Drug" 31 | 124,"Smart Drug" 32 | 137,"Smart Drug" 33 | 73,"Smart Drug" 34 | 69,"Smart Drug" 35 | 95,"Smart Drug" 36 | 102,"Smart Drug" 37 | 116,"Smart Drug" 38 | 111,"Smart Drug" 39 | 134,"Smart Drug" 40 | 102,"Smart Drug" 41 | 110,"Smart Drug" 42 | 139,"Smart Drug" 43 | 112,"Smart Drug" 44 | 122,"Smart Drug" 45 | 84,"Smart Drug" 46 | 129,"Smart Drug" 47 | 112,"Smart Drug" 48 | 127,"Smart Drug" 49 | 106,"Smart Drug" 50 | 113,"Smart Drug" 51 | 109,"Smart Drug" 52 | 208,"Smart Drug" 53 | 114,"Smart Drug" 54 | 107,"Smart Drug" 55 | 50,"Smart Drug" 56 | 169,"Smart Drug" 57 | 133,"Smart Drug" 58 | 50,"Smart Drug" 59 | 97,"Smart Drug" 60 | 139,"Smart Drug" 61 | 72,"Smart Drug" 62 | 100,"Smart Drug" 63 | 144,"Smart Drug" 64 | 112,"Smart Drug" 65 | 109,"Placebo" 66 | 98,"Placebo" 67 | 106,"Placebo" 68 | 101,"Placebo" 69 | 100,"Placebo" 70 | 111,"Placebo" 71 | 117,"Placebo" 72 | 104,"Placebo" 73 | 106,"Placebo" 74 | 89,"Placebo" 75 | 84,"Placebo" 76 | 88,"Placebo" 77 | 94,"Placebo" 78 | 78,"Placebo" 79 | 108,"Placebo" 80 | 102,"Placebo" 81 | 95,"Placebo" 82 | 99,"Placebo" 83 | 90,"Placebo" 84 | 116,"Placebo" 85 | 97,"Placebo" 86 | 107,"Placebo" 87 | 102,"Placebo" 88 | 91,"Placebo" 89 | 94,"Placebo" 90 | 95,"Placebo" 91 | 86,"Placebo" 92 | 108,"Placebo" 93 | 115,"Placebo" 94 | 108,"Placebo" 95 | 88,"Placebo" 96 | 102,"Placebo" 97 | 102,"Placebo" 98 | 120,"Placebo" 99 | 112,"Placebo" 100 | 100,"Placebo" 101 | 105,"Placebo" 102 | 105,"Placebo" 103 | 88,"Placebo" 104 | 82,"Placebo" 105 | 111,"Placebo" 106 | 96,"Placebo" 107 | 92,"Placebo" 108 | 109,"Placebo" 109 | 91,"Placebo" 110 | 92,"Placebo" 111 | 123,"Placebo" 112 | 61,"Placebo" 113 | 59,"Placebo" 114 | 105,"Placebo" 115 | 184,"Placebo" 116 | 82,"Placebo" 117 | 138,"Placebo" 118 | 99,"Placebo" 119 | 93,"Placebo" 120 | 93,"Placebo" 121 | 72,"Placebo" 122 | -------------------------------------------------------------------------------- /src/dbda/ch16/smart_drug_normal.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Dragan Djuric. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) or later 4 | ;; which can be found in the file LICENSE at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:author "Dragan Djuric"} 10 | dbda.ch16.smart-drug-normal 11 | (:require [quil.core :as q] 12 | [quil.applet :as qa] 13 | [quil.middlewares.pause-on-error :refer [pause-on-error]] 14 | [uncomplicate.commons.core :refer [with-release let-release wrap-float info]] 15 | [uncomplicate.fluokitten.core :refer [op]] 16 | [uncomplicate.neanderthal 17 | [core :refer [dim]] 18 | [real :refer [entry entry!]] 19 | [math :refer [sqrt]] 20 | [native :refer [fv fge]]] 21 | [uncomplicate.bayadera 22 | [core :refer :all] 23 | [library :as library] 24 | [opencl :refer [with-default-bayadera]] 25 | [mcmc :refer [mix!]]] 26 | [uncomplicate.bayadera.toolbox 27 | [processing :refer :all] 28 | [plots :refer [render-sample render-histogram]]] 29 | [clojure.java.io :as io] 30 | [clojure.data.csv :as csv])) 31 | 32 | (def all-data (atom {})) 33 | (def state (atom nil)) 34 | 35 | (let [in-file (slurp (io/resource "dbda/ch16/smart-drug.csv"))] 36 | (let [data (loop [s 0 p 0 data (drop 1 (csv/read-csv in-file)) 37 | smart (transient []) placebo (transient [])] 38 | (if data 39 | (let [[b c] (first data)] 40 | (case c 41 | "Smart Drug" 42 | (recur (inc s) p (next data) (conj! smart (double (read-string b))) placebo) 43 | "Placebo" 44 | (recur s (inc p) (next data) smart (conj! placebo (double (read-string b)))))) 45 | [(op [s] (persistent! smart)) 46 | (op [p] (persistent! placebo))]))] 47 | (def params {:smart-drug (fv (data 0)) 48 | :placebo (fv (data 1))}))) 49 | 50 | (defn analysis [] 51 | (with-default-bayadera 52 | (let [gaussian-lik-model (library/likelihood-model :gaussian)] 53 | (with-release [smart-drug-prior 54 | (library/distribution-model [:gaussian :uniform 55 | (slurp (io/resource "dbda/ch16/smart-drug-normal.cl"))] 56 | {:name "smart_drug" :params-size 4 :dimension 2}) 57 | prior (distribution smart-drug-prior) 58 | prior-dist (prior (fv 100 60 0 100)) 59 | smart-drug-post (distribution "smart_drug" gaussian-lik-model prior-dist) 60 | smart-drug-dist (smart-drug-post (:smart-drug params)) 61 | smart-drug-sampler (sampler smart-drug-dist {:limits (fge 2 2 [80 120 0 40])}) 62 | placebo-post (distribution "placebo" gaussian-lik-model prior-dist) 63 | placebo-dist (placebo-post (:placebo params)) 64 | placebo-sampler (sampler placebo-dist {:limits (fge 2 2 [80 120 0 40])})] 65 | (println (time (mix! smart-drug-sampler {:step 128}))) 66 | (println (info smart-drug-sampler)) 67 | (println (time (mix! placebo-sampler {:step 128}))) 68 | (println (info placebo-sampler)) 69 | {:smart-drug (histogram! smart-drug-sampler 10) 70 | :placebo (histogram! placebo-sampler 10)})))) 71 | 72 | (defn setup [] 73 | (reset! state 74 | {:data @all-data 75 | :smart-drug-mean (plot2d (qa/current-applet) {:width 500 :height 500}) 76 | :smart-drug-std (plot2d (qa/current-applet) {:width 500 :height 500}) 77 | :placebo-mean (plot2d (qa/current-applet) {:width 500 :height 500}) 78 | :placebo-std (plot2d (qa/current-applet) {:width 500 :height 500})})) 79 | 80 | (defn draw [] 81 | (when-not (= @all-data (:data @state)) 82 | (swap! state assoc :data @all-data) 83 | (q/background 0) 84 | (q/image (show (render-histogram (:smart-drug-mean @state) (:smart-drug @all-data) 0)) 0 0) 85 | (q/image (show (render-histogram (:smart-drug-std @state) (:smart-drug @all-data) 1)) 520 0) 86 | (q/image (show (render-histogram (:placebo-mean @state) (:placebo @all-data) 0)) 0 520) 87 | (q/image (show (render-histogram (:placebo-std @state) (:placebo @all-data) 1)) 520 520))) 88 | 89 | (defn display-sketch [] 90 | (q/defsketch diagrams 91 | :renderer :p2d 92 | :size :fullscreen 93 | :display 2 94 | :setup setup 95 | :draw draw 96 | :middleware [pause-on-error])) 97 | 98 | ;; This is how to run it: 99 | ;; 1. Display empty window (preferrably spanning the screen) 100 | #_(display-sketch) 101 | ;; 2. Run the analysis to populate the data that the plots draw 102 | #_(reset! all-data (analysis)) 103 | ;; It is awkward, but I was constrained by how quil and processing 104 | ;; manage display. 105 | -------------------------------------------------------------------------------- /src/dbda/ch16/smart_drug_student_t.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Dragan Djuric. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) or later 4 | ;; which can be found in the file LICENSE at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:author "Dragan Djuric"} 10 | dbda.ch16.smart-drug-student-t 11 | (:require [quil.core :as q] 12 | [quil.applet :as qa] 13 | [quil.middlewares.pause-on-error :refer [pause-on-error]] 14 | [uncomplicate.commons.core :refer [with-release let-release wrap-float]] 15 | [uncomplicate.fluokitten.core :refer [op]] 16 | [uncomplicate.neanderthal 17 | [core :refer [dim]] 18 | [real :refer [entry entry!]] 19 | [math :refer [sqrt]] 20 | [native :refer [fv fge]]] 21 | [uncomplicate.bayadera 22 | [core :refer :all] 23 | [library :as library] 24 | [opencl :refer [with-default-bayadera]] 25 | [mcmc :refer [mix!]]] 26 | [uncomplicate.bayadera.toolbox 27 | [processing :refer :all] 28 | [plots :refer [render-sample render-histogram]]] 29 | [clojure.java.io :as io] 30 | [clojure.data.csv :as csv])) 31 | 32 | (def all-data (atom {})) 33 | (def state (atom nil)) 34 | 35 | (let [in-file (slurp (io/resource "dbda/ch16/smart-drug.csv"))] 36 | (let [data (loop [s 0 p 0 data (drop 1 (csv/read-csv in-file)) 37 | smart (transient []) placebo (transient [])] 38 | (if data 39 | (let [[b c] (first data)] 40 | (case c 41 | "Smart Drug" 42 | (recur (inc s) p (next data) (conj! smart (double (read-string b))) placebo) 43 | "Placebo" 44 | (recur s (inc p) (next data) smart (conj! placebo (double (read-string b)))))) 45 | [(op [s] (persistent! smart)) 46 | (op [p] (persistent! placebo))]))] 47 | (def params {:smart-drug (fv (data 0)) 48 | :placebo (fv (data 1))}))) 49 | 50 | (defn analysis [] 51 | (with-default-bayadera 52 | (with-release [smart-drug-prior 53 | (library/distribution-model [:gaussian :uniform :exponential 54 | (slurp (io/resource "dbda/ch16/smart-drug-student-t.cl"))] 55 | {:name "smart_drug" :mcmc-logpdf "smart_drug_mcmc_logpdf" 56 | :params-size 5 :dimension 3}) 57 | prior (distribution smart-drug-prior) 58 | prior-dist (prior (fv 10 100 60 0 100)) 59 | smart-drug-post (distribution "smart_drug" (library/likelihood-model :student-t) prior-dist) 60 | smart-drug-dist (smart-drug-post (:smart-drug params)) 61 | smart-drug-sampler (sampler smart-drug-dist {:limits (fge 2 3 [0 30 80 120 0 40])}) 62 | placebo-post (distribution "placebo" (library/likelihood-model :student-t) prior-dist) 63 | placebo-dist (placebo-post (:placebo params)) 64 | placebo-sampler (sampler placebo-dist {:limits (fge 2 3 [0 30 80 120 0 40])})] 65 | (println (time (mix! smart-drug-sampler {:step 256}))) 66 | (println (time (mix! placebo-sampler {:step 256}))) 67 | {:smart-drug (histogram! smart-drug-sampler 10) 68 | :placebo (histogram! placebo-sampler 10)}))) 69 | 70 | (defn setup [] 71 | (reset! state 72 | {:data @all-data 73 | :smart-drug-nu (plot2d (qa/current-applet) {:width 500 :height 500}) 74 | :smart-drug-mean (plot2d (qa/current-applet) {:width 500 :height 500}) 75 | :smart-drug-std (plot2d (qa/current-applet) {:width 500 :height 500}) 76 | :placebo-mean (plot2d (qa/current-applet) {:width 500 :height 500}) 77 | :placebo-std (plot2d (qa/current-applet) {:width 500 :height 500})})) 78 | 79 | (defn draw [] 80 | (when-not (= @all-data (:data @state)) 81 | (swap! state assoc :data @all-data) 82 | (q/background 0) 83 | (q/image (show (render-histogram (:smart-drug-nu @state) (:smart-drug @all-data) 0)) 0 0) 84 | (q/image (show (render-histogram (:smart-drug-mean @state) (:smart-drug @all-data) 1)) 0 520) 85 | (q/image (show (render-histogram (:smart-drug-std @state) (:smart-drug @all-data) 2)) 0 1040) 86 | (q/image (show (render-histogram (:placebo-mean @state) (:placebo @all-data) 1)) 520 520) 87 | (q/image (show (render-histogram (:placebo-std @state) (:placebo @all-data) 2)) 520 1040))) 88 | 89 | (defn display-sketch [] 90 | (q/defsketch diagrams 91 | :renderer :p2d 92 | :size :fullscreen 93 | :display 2 94 | :setup setup 95 | :draw draw 96 | :middleware [pause-on-error])) 97 | 98 | ;; This is how to run it: 99 | ;; 1. Display empty window (preferrably spanning the screen) 100 | #_(display-sketch) 101 | ;; 2. Run the analysis to populate the data that the plots draw 102 | #_(reset! all-data (analysis)) 103 | ;; It is awkward, but I was constrained by how quil and processing 104 | ;; manage display. 105 | -------------------------------------------------------------------------------- /src/dbda/ch17/hier-lin-regress-data.csv: -------------------------------------------------------------------------------- 1 | "Subj","X","Y" 2 | 1,60.2,145.6 3 | 1,61.5,157.3 4 | 1,61.7,165.6 5 | 1,62.3,158.8 6 | 1,67.6,196.1 7 | 1,69.2,183.9 8 | 2,53.7,165 9 | 2,60.1,166.9 10 | 2,60.5,179 11 | 2,62.3,196.2 12 | 2,63,192.3 13 | 2,64,200.7 14 | 2,64.1,187.8 15 | 2,66.7,158.9 16 | 2,67.1,178.2 17 | 3,63.5,161.4 18 | 3,65.4,98.8 19 | 3,69.6,145.9 20 | 3,71,151.6 21 | 3,77.6,144.8 22 | 3,79.1,140.4 23 | 3,81.1,165.1 24 | 4,65,172.2 25 | 4,69.8,191.4 26 | 5,65.1,119 27 | 5,68.5,168.6 28 | 5,71.8,136.7 29 | 5,76.6,119.7 30 | 5,83.3,189 31 | 6,69.9,70 32 | 6,71.3,86.4 33 | 6,75,93.6 34 | 6,75.4,113.8 35 | 6,76.9,122.2 36 | 6,77.4,120.8 37 | 6,79.1,161.8 38 | 6,86.2,188.1 39 | 7,67.2,144.5 40 | 7,73.4,187.3 41 | 7,77.3,171.9 42 | 8,59.7,91.9 43 | 8,62.3,131 44 | 8,65.3,157.7 45 | 8,66.2,162.7 46 | 8,74.1,201.8 47 | 8,74.8,142.6 48 | 9,59.1,125.4 49 | 9,63.3,122.3 50 | 9,68.5,122.5 51 | 9,70.1,141.3 52 | 9,73.9,167.6 53 | 10,65.5,101.8 54 | 10,68.5,127.3 55 | 10,68.7,119.2 56 | 10,68.9,124.4 57 | 10,80.5,124.1 58 | 10,83.3,146.9 59 | 11,62,147.5 60 | 11,62.2,144.4 61 | 11,62.5,167.4 62 | 11,63.4,193.3 63 | 11,65.1,172.4 64 | 11,68,196.6 65 | 12,63.6,120.2 66 | 12,71.7,160 67 | 12,72,165.3 68 | 12,75.4,158.7 69 | 13,56,203.4 70 | 13,57.8,152.1 71 | 13,57.9,157.9 72 | 13,57.9,167.2 73 | 13,60,147.7 74 | 13,66.9,240.4 75 | 14,50.8,131.4 76 | 14,56.3,143.7 77 | 14,57.3,159.5 78 | 14,62.4,198.3 79 | 14,62.6,194.7 80 | 14,66.4,174 81 | 14,67.9,189.4 82 | 15,59.6,146.6 83 | 15,66,153.7 84 | 16,56.3,146.6 85 | 16,64.2,144.6 86 | 16,65.9,159.4 87 | 16,69.4,163.8 88 | 16,73.3,202.6 89 | 17,63.6,153.6 90 | 17,63.8,146.8 91 | 17,64.8,137.8 92 | 17,65.9,145 93 | 17,68.9,166.1 94 | 17,72.3,154 95 | 17,72.8,189.7 96 | 17,76.2,184.8 97 | 17,76.6,172.5 98 | 18,61.8,126.4 99 | 18,61.9,94.2 100 | 18,63.2,97.7 101 | 18,70.2,141.9 102 | 18,70.4,117.6 103 | 18,71.2,133.9 104 | 18,71.9,156 105 | 18,75.4,162.6 106 | 18,75.5,184.3 107 | 19,66.5,132.6 108 | 19,68.2,202 109 | 20,63.6,152.4 110 | 20,64.5,202.1 111 | 20,64.6,171.9 112 | 20,68.2,146.5 113 | 20,70.4,221.9 114 | 21,49.1,114.8 115 | 21,57.5,172.7 116 | 21,60.4,201.7 117 | 21,63.9,208.7 118 | 22,58.3,94.5 119 | 22,63,91.5 120 | 22,65.3,116.1 121 | 22,66.3,137.8 122 | 22,66.5,134.8 123 | 22,67.4,152.4 124 | 22,72.1,152.6 125 | 23,61.9,104.5 126 | 23,62.5,111.8 127 | 23,63.1,129.8 128 | 23,63.7,99.8 129 | 23,64,124.6 130 | 23,66.7,175.6 131 | 23,81.8,203.6 132 | 24,49.1,153.6 133 | 25,86.2,153.6 134 | -------------------------------------------------------------------------------- /src/dbda/ch17/ht-wt-data-30.csv: -------------------------------------------------------------------------------- 1 | "male","height","weight" 2 | 0,64,136.4 3 | 0,62.3,215.1 4 | 1,67.9,173.6 5 | 0,64.2,117.3 6 | 0,64.8,123.3 7 | 0,57.5,96.5 8 | 0,65.6,178.3 9 | 1,70.2,191.1 10 | 0,63.9,158 11 | 1,71.1,193.9 12 | 1,66.5,127.1 13 | 0,68.1,147.9 14 | 0,62.9,119 15 | 1,75.1,204.4 16 | 1,64.6,143.4 17 | 1,69.2,124.4 18 | 1,68.1,140.9 19 | 1,72.6,164.7 20 | 0,63.2,139.8 21 | 0,64.1,110.2 22 | 0,64.1,134.1 23 | 1,71.5,193.6 24 | 1,76,180 25 | 1,69.7,155 26 | 1,73.3,188.2 27 | 0,61.7,187.4 28 | 0,66.4,139.2 29 | 0,65.7,147.9 30 | 1,68.3,178.6 31 | 0,66.9,111.1 32 | -------------------------------------------------------------------------------- /src/dbda/ch17/ht-wt-data-300.csv: -------------------------------------------------------------------------------- 1 | "male","height","weight" 2 | 0,64,136.4 3 | 0,62.3,215.1 4 | 1,67.9,173.6 5 | 0,64.2,117.3 6 | 0,64.8,123.3 7 | 0,57.5,96.5 8 | 0,65.6,178.3 9 | 1,70.2,191.1 10 | 0,63.9,158 11 | 1,71.1,193.9 12 | 1,66.5,127.1 13 | 0,68.1,147.9 14 | 0,62.9,119 15 | 1,75.1,204.4 16 | 1,64.6,143.4 17 | 1,69.2,124.4 18 | 1,68.1,140.9 19 | 1,72.6,164.7 20 | 0,63.2,139.8 21 | 0,64.1,110.2 22 | 0,64.1,134.1 23 | 1,71.5,193.6 24 | 1,76,180 25 | 1,69.7,155 26 | 1,73.3,188.2 27 | 0,61.7,187.4 28 | 0,66.4,139.2 29 | 0,65.7,147.9 30 | 1,68.3,178.6 31 | 0,66.9,111.1 32 | 0,62.4,119.2 33 | 0,64.5,184.4 34 | 0,60.6,100.1 35 | 1,70.8,207.3 36 | 0,61,159.8 37 | 0,66,120.7 38 | 0,59.6,102.8 39 | 1,70.1,195.7 40 | 1,66.6,130.1 41 | 0,59.8,156.5 42 | 1,68.5,113.7 43 | 0,61.4,119.1 44 | 0,64.7,142.8 45 | 1,67.4,179.9 46 | 1,68.3,166.3 47 | 1,67.3,135.4 48 | 0,62.5,118.9 49 | 1,72.4,173.9 50 | 0,64.4,117.8 51 | 1,70.6,192.6 52 | 0,66.3,122 53 | 0,65.9,129.5 54 | 0,61.1,116.9 55 | 1,67.8,177.1 56 | 0,64.4,160.1 57 | 1,71.2,199.5 58 | 0,64.5,111 59 | 1,65.4,177.4 60 | 1,67,187.9 61 | 1,70.9,177.1 62 | 0,62.4,185.3 63 | 1,70.4,223.5 64 | 1,64.6,128.4 65 | 1,69.6,184.4 66 | 0,65.9,122.1 67 | 1,70.6,216.8 68 | 1,65.4,173.8 69 | 1,73.9,197.8 70 | 1,70.1,181.1 71 | 0,64.8,136.6 72 | 0,59.7,105 73 | 1,69.2,150.1 74 | 0,61.4,125 75 | 1,70.4,172.2 76 | 1,71.1,143.9 77 | 0,60.8,132 78 | 0,68.3,110.7 79 | 1,67.4,155.9 80 | 0,63.5,174.9 81 | 1,66.8,176.6 82 | 1,73.4,167.1 83 | 0,64.8,133.5 84 | 1,68.9,211.4 85 | 1,66.5,150.6 86 | 0,64.7,144.7 87 | 0,66.2,120.7 88 | 1,69.1,222.5 89 | 1,66,168.4 90 | 0,60.9,134.3 91 | 1,72.4,182.8 92 | 1,67.5,187.2 93 | 1,71.6,193.4 94 | 1,70.6,195.2 95 | 0,64.7,131.1 96 | 1,72.7,204.5 97 | 0,64.7,108.6 98 | 0,67.9,128.1 99 | 0,65.9,152.7 100 | 0,54.6,120.3 101 | 0,64.1,183.5 102 | 1,68.3,210.6 103 | 1,72.9,163.1 104 | 0,64,143.9 105 | 0,62.1,114.4 106 | 1,67.3,170.5 107 | 0,60.4,93.2 108 | 0,63.4,147.8 109 | 0,63.3,161.2 110 | 0,61.4,114.6 111 | 1,67.7,158 112 | 0,65.1,144.5 113 | 1,67.5,184 114 | 1,67,225 115 | 0,65.6,116.9 116 | 1,70.9,183.2 117 | 0,61.5,131.5 118 | 0,59.4,217.1 119 | 0,59.7,123.6 120 | 1,69,145.9 121 | 1,71.7,170.6 122 | 0,65.7,133.5 123 | 1,67.2,165.9 124 | 1,65.9,134.1 125 | 0,64.9,111.1 126 | 1,73.6,201.1 127 | 1,70.5,156.3 128 | 0,63.6,161.5 129 | 0,64.7,145 130 | 1,69.4,159.8 131 | 1,69.2,149 132 | 0,64.5,222 133 | 1,70.9,149.7 134 | 0,63.6,130.6 135 | 1,73.7,242.5 136 | 1,67.6,150 137 | 1,65.9,191.3 138 | 1,68.1,164.1 139 | 0,64.1,135.6 140 | 0,61.6,139.4 141 | 1,71.2,114.8 142 | 0,66.7,191.6 143 | 1,71.1,194.7 144 | 1,68.6,170 145 | 0,62.8,146.9 146 | 1,67.6,186.1 147 | 0,63.1,125.8 148 | 0,65.2,96.2 149 | 1,67.4,156.8 150 | 0,64.3,117.6 151 | 0,59.9,149.6 152 | 0,61.9,125.4 153 | 0,63.4,140.7 154 | 0,59.8,150.2 155 | 1,67.7,156.5 156 | 0,64.5,137.6 157 | 0,67.4,140.3 158 | 0,66.1,174.7 159 | 1,75.1,186.1 160 | 1,67.9,191.3 161 | 1,65.7,135.2 162 | 0,64.9,130.5 163 | 0,64.8,137.1 164 | 0,55.3,166.5 165 | 0,63,280.5 166 | 0,64.1,126 167 | 0,64.3,128.3 168 | 0,63.8,166.5 169 | 0,65.1,124 170 | 1,71.8,120.8 171 | 0,66.7,193.8 172 | 0,64.5,157 173 | 0,60.7,190.8 174 | 0,59.6,110.9 175 | 1,68.4,185.9 176 | 0,63.2,163.2 177 | 0,66,167.9 178 | 0,62.5,119.8 179 | 0,67.9,122 180 | 1,70.2,178.8 181 | 1,70.3,181.1 182 | 0,67.1,168.8 183 | 0,66.2,120.9 184 | 0,62.1,96.5 185 | 1,72.4,210.4 186 | 0,65.2,139.3 187 | 1,72.1,187 188 | 1,65.6,146.5 189 | 1,67.2,141.8 190 | 1,66.2,162 191 | 1,66,173.8 192 | 0,63.6,160.7 193 | 0,65,125.3 194 | 0,57.5,125.9 195 | 0,63.4,193.7 196 | 0,67.2,234.9 197 | 0,62.8,156.9 198 | 0,65.3,221.2 199 | 1,66.7,241.6 200 | 1,70.3,170.4 201 | 1,68.6,152.6 202 | 0,66.4,172.8 203 | 0,62.9,176.6 204 | 0,57.6,123.5 205 | 0,65.3,202.1 206 | 1,70.9,182.2 207 | 1,68,190.9 208 | 1,65.4,146.6 209 | 1,67.4,158.5 210 | 1,62.8,140.5 211 | 1,73.3,168 212 | 0,64.6,182 213 | 0,70,275.2 214 | 1,68.1,164.1 215 | 1,69.4,153.5 216 | 1,71.9,159.5 217 | 0,67.8,141.7 218 | 1,63.5,194.1 219 | 1,69.8,149.6 220 | 0,66.1,157.5 221 | 0,62,149.9 222 | 1,71.5,210.8 223 | 1,71.9,154.5 224 | 1,72.6,206.5 225 | 0,64.3,123.4 226 | 1,71.7,166 227 | 1,70.1,160.8 228 | 0,64.3,167.6 229 | 0,63.9,141.9 230 | 1,74.6,186.2 231 | 1,65.5,155.7 232 | 0,63.1,148.7 233 | 1,66.7,132.6 234 | 0,65.2,356.8 235 | 0,62,164.9 236 | 1,71,187.2 237 | 1,69.4,169.6 238 | 1,69.8,178.8 239 | 1,66.6,202.2 240 | 1,71,158.9 241 | 1,74.7,186.1 242 | 0,63.6,169.7 243 | 1,69.8,147.6 244 | 0,58.9,110.6 245 | 0,67.9,146.8 246 | 0,65.2,146.2 247 | 1,70.6,164.8 248 | 0,59.8,115.7 249 | 1,71.2,191.5 250 | 1,71.5,198.6 251 | 0,63.7,143.7 252 | 1,65.1,126.7 253 | 0,64.8,123.1 254 | 0,66.8,231.5 255 | 0,64.5,134.7 256 | 1,68.6,159.4 257 | 0,65.4,141.5 258 | 1,66.5,144.5 259 | 1,68.8,150.5 260 | 1,70.4,173.7 261 | 0,57,215.5 262 | 0,60.6,146.4 263 | 0,62.8,133.6 264 | 1,73.3,240.2 265 | 1,73.2,216.6 266 | 0,61.9,89 267 | 0,66.4,213.6 268 | 1,69.9,211.3 269 | 1,60.8,140.4 270 | 0,65.9,135.7 271 | 0,61.8,151.7 272 | 0,66.5,198.3 273 | 1,64,158.7 274 | 1,68.2,218 275 | 1,71.8,172.7 276 | 1,70.4,161.9 277 | 0,63,130.3 278 | 0,60.1,123 279 | 1,66.3,157 280 | 0,67.1,131.2 281 | 0,61.5,108.7 282 | 1,66.4,202.7 283 | 1,63.8,131.9 284 | 1,69.9,164.5 285 | 1,66.1,179.2 286 | 1,66.2,154.4 287 | 0,66.5,120.1 288 | 1,70.2,189.7 289 | 0,64,160.2 290 | 1,69,145.7 291 | 0,65.7,186.2 292 | 1,69.5,144.8 293 | 0,64.1,147.4 294 | 0,61.2,120.8 295 | 0,62.6,134.9 296 | 1,67.9,164.8 297 | 1,68.5,205.9 298 | 1,69.2,172.5 299 | 0,65.9,130.8 300 | 1,68.3,146.5 301 | 1,70.2,173.8 302 | -------------------------------------------------------------------------------- /src/dbda/ch17/income-famz-state.csv: -------------------------------------------------------------------------------- 1 | "Income","Famsz","State" 2 | 48075,2,"Alabama" 3 | 55631,3,"Alabama" 4 | 65311,4,"Alabama" 5 | 62431,5,"Alabama" 6 | 57482,6,"Alabama" 7 | 49656,7,"Alabama" 8 | 74073,2,"Alaska" 9 | 77544,3,"Alaska" 10 | 85422,4,"Alaska" 11 | 89221,5,"Alaska" 12 | 94893,6,"Alaska" 13 | 81200,7,"Alaska" 14 | 56894,2,"Arizona" 15 | 62066,3,"Arizona" 16 | 69452,4,"Arizona" 17 | 63472,5,"Arizona" 18 | 57657,6,"Arizona" 19 | 56663,7,"Arizona" 20 | 44415,2,"Arkansas" 21 | 48721,3,"Arkansas" 22 | 57905,4,"Arkansas" 23 | 49443,5,"Arkansas" 24 | 51465,6,"Arkansas" 25 | 44501,7,"Arkansas" 26 | 64878,2,"California" 27 | 70890,3,"California" 28 | 79477,4,"California" 29 | 68073,5,"California" 30 | 67499,6,"California" 31 | 74290,7,"California" 32 | 64985,2,"Colorado" 33 | 69977,3,"Colorado" 34 | 81644,4,"Colorado" 35 | 73105,5,"Colorado" 36 | 74100,6,"Colorado" 37 | 74289,7,"Colorado" 38 | 72586,2,"Connecticut" 39 | 86643,3,"Connecticut" 40 | 102124,4,"Connecticut" 41 | 108055,5,"Connecticut" 42 | 89435,6,"Connecticut" 43 | 89260,7,"Connecticut" 44 | 60953,2,"Delaware" 45 | 70075,3,"Delaware" 46 | 88725,4,"Delaware" 47 | 78364,5,"Delaware" 48 | 86105,6,"Delaware" 49 | 69190,7,"Delaware" 50 | 68892,2,"District of Columbia" 51 | 69294,3,"District of Columbia" 52 | 60418,4,"District of Columbia" 53 | 82458,5,"District of Columbia" 54 | 30253,6,"District of Columbia" 55 | 51720,7,"District of Columbia" 56 | 52259,2,"Florida" 57 | 58574,3,"Florida" 58 | 69009,4,"Florida" 59 | 66248,5,"Florida" 60 | 63759,6,"Florida" 61 | 66941,7,"Florida" 62 | 55258,2,"Georgia" 63 | 61104,3,"Georgia" 64 | 68502,4,"Georgia" 65 | 63364,5,"Georgia" 66 | 64654,6,"Georgia" 67 | 59212,7,"Georgia" 68 | 67199,2,"Hawaii" 69 | 77539,3,"Hawaii" 70 | 91483,4,"Hawaii" 71 | 86463,5,"Hawaii" 72 | 89544,6,"Hawaii" 73 | 117593,7,"Hawaii" 74 | 51474,2,"Idaho" 75 | 52765,3,"Idaho" 76 | 62051,4,"Idaho" 77 | 58400,5,"Idaho" 78 | 57479,6,"Idaho" 79 | 61398,7,"Idaho" 80 | 60052,2,"Illinois" 81 | 71329,3,"Illinois" 82 | 81465,4,"Illinois" 83 | 76898,5,"Illinois" 84 | 70010,6,"Illinois" 85 | 76118,7,"Illinois" 86 | 52554,2,"Indiana" 87 | 59650,3,"Indiana" 88 | 70873,4,"Indiana" 89 | 69530,5,"Indiana" 90 | 65006,6,"Indiana" 91 | 64880,7,"Indiana" 92 | 55284,2,"Iowa" 93 | 64372,3,"Iowa" 94 | 72961,4,"Iowa" 95 | 71070,5,"Iowa" 96 | 64788,6,"Iowa" 97 | 55270,7,"Iowa" 98 | 57767,2,"Kansas" 99 | 63438,3,"Kansas" 100 | 72610,4,"Kansas" 101 | 70213,5,"Kansas" 102 | 60738,6,"Kansas" 103 | 62020,7,"Kansas" 104 | 45653,2,"Kentucky" 105 | 54683,3,"Kentucky" 106 | 64459,4,"Kentucky" 107 | 57596,5,"Kentucky" 108 | 60480,6,"Kentucky" 109 | 60663,7,"Kentucky" 110 | 48287,2,"Louisiana" 111 | 53461,3,"Louisiana" 112 | 66256,4,"Louisiana" 113 | 62991,5,"Louisiana" 114 | 59281,6,"Louisiana" 115 | 54074,7,"Louisiana" 116 | 50912,2,"Maine" 117 | 62076,3,"Maine" 118 | 70374,4,"Maine" 119 | 66259,5,"Maine" 120 | 72620,6,"Maine" 121 | 62269,7,"Maine" 122 | 73061,2,"Maryland" 123 | 85455,3,"Maryland" 124 | 101803,4,"Maryland" 125 | 94750,5,"Maryland" 126 | 95544,6,"Maryland" 127 | 97272,7,"Maryland" 128 | 69451,2,"Massachusetts" 129 | 82591,3,"Massachusetts" 130 | 99648,4,"Massachusetts" 131 | 96141,5,"Massachusetts" 132 | 104012,6,"Massachusetts" 133 | 106985,7,"Massachusetts" 134 | 52620,2,"Michigan" 135 | 61737,3,"Michigan" 136 | 74824,4,"Michigan" 137 | 73576,5,"Michigan" 138 | 64639,6,"Michigan" 139 | 57733,7,"Michigan" 140 | 62384,2,"Minnesota" 141 | 75073,3,"Minnesota" 142 | 86637,4,"Minnesota" 143 | 83506,5,"Minnesota" 144 | 84013,6,"Minnesota" 145 | 66475,7,"Minnesota" 146 | 42758,2,"Mississippi" 147 | 46685,3,"Mississippi" 148 | 58518,4,"Mississippi" 149 | 51038,5,"Mississippi" 150 | 44196,6,"Mississippi" 151 | 44760,7,"Mississippi" 152 | 51568,2,"Missouri" 153 | 60371,3,"Missouri" 154 | 71059,4,"Missouri" 155 | 67664,5,"Missouri" 156 | 67079,6,"Missouri" 157 | 62052,7,"Missouri" 158 | 52497,2,"Montana" 159 | 58636,3,"Montana" 160 | 65827,4,"Montana" 161 | 63701,5,"Montana" 162 | 63582,6,"Montana" 163 | 59479,7,"Montana" 164 | 56861,2,"Nebraska" 165 | 63702,3,"Nebraska" 166 | 72542,4,"Nebraska" 167 | 70402,5,"Nebraska" 168 | 70199,6,"Nebraska" 169 | 65345,7,"Nebraska" 170 | 60449,2,"Nevada" 171 | 67052,3,"Nevada" 172 | 71104,4,"Nevada" 173 | 70660,5,"Nevada" 174 | 61087,6,"Nevada" 175 | 81426,7,"Nevada" 176 | 64204,2,"New Hampshire" 177 | 79668,3,"New Hampshire" 178 | 93926,4,"New Hampshire" 179 | 91560,5,"New Hampshire" 180 | 97314,6,"New Hampshire" 181 | 90152,7,"New Hampshire" 182 | 72000,2,"New Jersey" 183 | 86070,3,"New Jersey" 184 | 103261,4,"New Jersey" 185 | 100126,5,"New Jersey" 186 | 100992,6,"New Jersey" 187 | 98415,7,"New Jersey" 188 | 50637,2,"New Mexico" 189 | 50630,3,"New Mexico" 190 | 55561,4,"New Mexico" 191 | 60951,5,"New Mexico" 192 | 56930,6,"New Mexico" 193 | 61156,7,"New Mexico" 194 | 58109,2,"New York" 195 | 69421,3,"New York" 196 | 82457,4,"New York" 197 | 80515,5,"New York" 198 | 77393,6,"New York" 199 | 78728,7,"New York" 200 | 52194,2,"North Carolina" 201 | 56930,3,"North Carolina" 202 | 67295,4,"North Carolina" 203 | 62396,5,"North Carolina" 204 | 57644,6,"North Carolina" 205 | 51448,7,"North Carolina" 206 | 54662,2,"North Dakota" 207 | 62635,3,"North Dakota" 208 | 75140,4,"North Dakota" 209 | 73505,5,"North Dakota" 210 | 63750,6,"North Dakota" 211 | 49328,7,"North Dakota" 212 | 52216,2,"Ohio" 213 | 61772,3,"Ohio" 214 | 73301,4,"Ohio" 215 | 71930,5,"Ohio" 216 | 69136,6,"Ohio" 217 | 68978,7,"Ohio" 218 | 50891,2,"Oklahoma" 219 | 54522,3,"Oklahoma" 220 | 62037,4,"Oklahoma" 221 | 58603,5,"Oklahoma" 222 | 55680,6,"Oklahoma" 223 | 50884,7,"Oklahoma" 224 | 56019,2,"Oregon" 225 | 62832,3,"Oregon" 226 | 72667,4,"Oregon" 227 | 67164,5,"Oregon" 228 | 62927,6,"Oregon" 229 | 69807,7,"Oregon" 230 | 53763,2,"Pennsylvania" 231 | 67757,3,"Pennsylvania" 232 | 77867,4,"Pennsylvania" 233 | 76179,5,"Pennsylvania" 234 | 71453,6,"Pennsylvania" 235 | 67571,7,"Pennsylvania" 236 | 62806,2,"Rhode Island" 237 | 76846,3,"Rhode Island" 238 | 87002,4,"Rhode Island" 239 | 77853,5,"Rhode Island" 240 | 84644,6,"Rhode Island" 241 | 74797,7,"Rhode Island" 242 | 51374,2,"South Carolina" 243 | 55296,3,"South Carolina" 244 | 65655,4,"South Carolina" 245 | 64046,5,"South Carolina" 246 | 60504,6,"South Carolina" 247 | 54201,7,"South Carolina" 248 | 54331,2,"South Dakota" 249 | 63153,3,"South Dakota" 250 | 70182,4,"South Dakota" 251 | 66960,5,"South Dakota" 252 | 60732,6,"South Dakota" 253 | 59306,7,"South Dakota" 254 | 49110,2,"Tennessee" 255 | 54014,3,"Tennessee" 256 | 64228,4,"Tennessee" 257 | 63052,5,"Tennessee" 258 | 55590,6,"Tennessee" 259 | 56194,7,"Tennessee" 260 | 55859,2,"Texas" 261 | 59222,3,"Texas" 262 | 66381,4,"Texas" 263 | 58607,5,"Texas" 264 | 54391,6,"Texas" 265 | 55052,7,"Texas" 266 | 56932,2,"Utah" 267 | 61905,3,"Utah" 268 | 69990,4,"Utah" 269 | 71190,5,"Utah" 270 | 80574,6,"Utah" 271 | 79855,7,"Utah" 272 | 56858,2,"Vermont" 273 | 65326,3,"Vermont" 274 | 74163,4,"Vermont" 275 | 73579,5,"Vermont" 276 | 77288,6,"Vermont" 277 | 51141,7,"Vermont" 278 | 65122,2,"Virginia" 279 | 74151,3,"Virginia" 280 | 85939,4,"Virginia" 281 | 85590,5,"Virginia" 282 | 75200,6,"Virginia" 283 | 86963,7,"Virginia" 284 | 64158,2,"Washington" 285 | 72533,3,"Washington" 286 | 82716,4,"Washington" 287 | 73804,5,"Washington" 288 | 67489,6,"Washington" 289 | 72990,7,"Washington" 290 | 43224,2,"West Virginia" 291 | 51836,3,"West Virginia" 292 | 58479,4,"West Virginia" 293 | 60418,5,"West Virginia" 294 | 58353,6,"West Virginia" 295 | 45281,7,"West Virginia" 296 | 57405,2,"Wisconsin" 297 | 68123,3,"Wisconsin" 298 | 80530,4,"Wisconsin" 299 | 76261,5,"Wisconsin" 300 | 68438,6,"Wisconsin" 301 | 61223,7,"Wisconsin" 302 | 59830,2,"Wyoming" 303 | 65820,3,"Wyoming" 304 | 76964,4,"Wyoming" 305 | 82446,5,"Wyoming" 306 | 68660,6,"Wyoming" 307 | 86135,7,"Wyoming" 308 | 17550,2,"Puerto Rico" 309 | 23196,3,"Puerto Rico" 310 | 27532,4,"Puerto Rico" 311 | 26896,5,"Puerto Rico" 312 | 27753,6,"Puerto Rico" 313 | 23454,7,"Puerto Rico" 314 | -------------------------------------------------------------------------------- /src/dbda/ch17/quadratic-trend.cl: -------------------------------------------------------------------------------- 1 | REAL qt_loglik(const uint data_len, const REAL* data, const uint dim, const REAL* x) { 2 | 3 | const REAL nu = x[0]; 4 | const REAL sigma = x[1]; 5 | const bool valid = (0.0f < nu) && (0.0f < sigma); 6 | 7 | if (valid) { 8 | const REAL scale = student_t_log_scale(nu, sigma); 9 | REAL res = 0.0; 10 | uint idx = 1; 11 | for (uint i = 2; i < dim; i+=3) { 12 | const REAL b0 = x[i]; 13 | const REAL b1 = x[i+1]; 14 | const REAL b2 = x[i+2]; 15 | const uint next = idx + (uint)data[idx]; 16 | while (idx < next) { 17 | const REAL xij = data[idx+1]; 18 | res += student_t_log_unscaled(nu, b0 + b1 * xij + b2 * pown(xij, 2), 19 | sigma, data[idx+2]) 20 | + scale; 21 | idx += 2; 22 | } 23 | idx++; 24 | } 25 | return res; 26 | } 27 | 28 | return NAN; 29 | } 30 | 31 | REAL qt_mcmc_logpdf(const uint data_len, const uint hyperparams_len, const REAL* params, 32 | const uint dim, REAL* x) { 33 | const REAL nu = x[0]; 34 | const bool valid = (1.0f < nu); 35 | 36 | if (valid) { 37 | REAL logp = exponential_log_unscaled(params[0], nu - 1) 38 | + uniform_log(params[1], params[2], x[1]); 39 | for (uint i = 0; i < dim-2; i++) { 40 | logp += gaussian_log_unscaled(params[2*i+3], params[2*i+4], x[i+2]); 41 | } 42 | return logp; 43 | } 44 | return NAN; 45 | } 46 | 47 | REAL qt_logpdf(const uint data_len, const uint hyperparams_len, const REAL* params, 48 | const uint dim, REAL* x) { 49 | const REAL nu = x[0]; 50 | const bool valid = (1.0f < nu); 51 | 52 | if (valid) { 53 | REAL logp = exponential_log(params[0], nu - 1) 54 | + uniform_log(params[1], params[2], x[1]); 55 | for (uint i = 0; i < dim-2; i++) { 56 | logp += gaussian_log(params[2*i+3], params[2*i+4], x[i+2]); 57 | } 58 | return logp; 59 | } 60 | return NAN; 61 | 62 | } 63 | -------------------------------------------------------------------------------- /src/dbda/ch17/quadratic_trend.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Dragan Djuric. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) or later 4 | ;; which can be found in the file LICENSE at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:author "Dragan Djuric"} 10 | dbda.ch17.quadratic-trend 11 | (:require [quil.core :as q] 12 | [quil.applet :as qa] 13 | [quil.middlewares.pause-on-error :refer [pause-on-error]] 14 | [uncomplicate.commons.core :refer [with-release let-release wrap-float info]] 15 | [uncomplicate.fluokitten.core :refer [op fmap]] 16 | [uncomplicate.neanderthal 17 | [core :refer [dim]] 18 | [real :refer [entry entry!]] 19 | [math :refer [sqrt]] 20 | [native :refer [fv fge]]] 21 | [uncomplicate.bayadera 22 | [core :refer :all] 23 | [library :as library] 24 | [util :refer [bin-mapper hdi]] 25 | [opencl :refer [with-default-bayadera]] 26 | [mcmc :refer [mix! burn-in! pow-n acc-rate! run-sampler!]]] 27 | [uncomplicate.bayadera.toolbox 28 | [processing :refer :all] 29 | [plots :refer [render-sample render-histogram]]] 30 | [clojure.java.io :as io] 31 | [clojure.data.csv :as csv])) 32 | 33 | (def all-data (atom {})) 34 | (def state (atom nil)) 35 | 36 | (defn read-data [in-file] 37 | (loop [c 0 data (drop 1 (csv/read-csv in-file)) income (transient {})] 38 | (if data 39 | (let [[icm fsize st] (first data)] 40 | (recur (inc c) (next data) 41 | (let [icm-st (get income st (transient []))] 42 | (assoc! income st 43 | (-> icm-st 44 | (conj! (double (read-string fsize))) 45 | (conj! (double (read-string icm)))))))) 46 | (let [persistent-income (into (sorted-map) (fmap persistent! (persistent! income))) 47 | subject-count (count persistent-income)] 48 | (apply op [subject-count] (map (fn [[k v]] (op [(count v)] v)) persistent-income)))))) 49 | 50 | (def params (fv (read-data (slurp (io/resource "dbda/ch17/income-famz-state.csv"))))) 51 | 52 | (defn analysis [] 53 | (with-default-bayadera 54 | (with-release [qt-prior 55 | (library/distribution-model [:gaussian :uniform :exponential :student-t 56 | (slurp (io/resource "dbda/ch17/quadratic-trend.cl"))] 57 | {:name "qt" :mcmc-logpdf "qt_mcmc_logpdf" 58 | :params-size 315 :dimension 158}) 59 | qt-likelihood (library/likelihood-model (slurp (io/resource "dbda/ch17/quadratic-trend.cl")) 60 | {:name "qt"}) 61 | prior (distribution qt-prior) 62 | prior-dist (prior (fv (op [4 10000 20000] (take 312 (cycle [10000 10000 20000 5000 -1000 1000]))))) 63 | post (distribution "qt" qt-likelihood prior-dist) 64 | post-dist (post params) 65 | post-sampler (sampler post-dist {:walkers (* 64 256) 66 | :limits (fge 2 158 (op [2 10 10000 20000] (take 312 (interleave (repeat 0) (repeat 2000) (repeat 10000) (repeat 30000) (repeat -2000) (repeat 0)))))})] 67 | (println (time (mix! post-sampler {:dimension-power 0.2 :cooling-schedule (pow-n 4)}))) 68 | (println (info post-sampler)) 69 | #_(println (time (do (burn-in! post-sampler 10000) (acc-rate! post-sampler)))) 70 | #_(println (time (run-sampler! post-sampler 64))) 71 | (time (histogram! post-sampler 500))))) 72 | 73 | (defn setup [] 74 | (reset! state 75 | {:data @all-data 76 | :nu (plot2d (qa/current-applet) {:width 300 :height 300}) 77 | :sigma (plot2d (qa/current-applet) {:width 300 :height 300}) 78 | :betas (vec (repeatedly 50 (partial plot2d (qa/current-applet) 79 | {:width 300 :height 300})))})) 80 | 81 | (defn draw [] 82 | (when-not (= @all-data (:data @state)) 83 | (swap! state assoc :data @all-data) 84 | (let [data @all-data] 85 | (q/background 0) 86 | (q/image (show (render-histogram (:nu @state) data 0)) 0 0) 87 | (q/image (show (render-histogram (:sigma @state) data 1)) 350 0) 88 | (dotimes [i 4] 89 | (dotimes [j 3] 90 | (let [index (+ (* i 3) j)] 91 | (when (< index 12) 92 | (q/image (show (render-histogram ((:betas @state) index) data (+ index 2))) 93 | (* j 320) (+ 320 (* i 320)))))))))) 94 | 95 | (defn display-sketch [] 96 | (q/defsketch diagrams 97 | :renderer :p2d 98 | :size :fullscreen 99 | :display 2 100 | :setup setup 101 | :draw draw 102 | :middleware [pause-on-error])) 103 | 104 | ;; This is how to run it: 105 | ;; 1. Display empty window (preferrably spanning the screen) 106 | #_(display-sketch) 107 | ;; 2. Run the analysis to populate the data that the plots draw 108 | #_(reset! all-data (analysis)) 109 | ;; It is awkward, but I was constrained by how quil and processing 110 | ;; manage display. 111 | -------------------------------------------------------------------------------- /src/dbda/ch17/robust-hierarchical-linear-regression.cl: -------------------------------------------------------------------------------- 1 | REAL rhlr_loglik(const uint data_len, const REAL* data, const uint dim, const REAL* x) { 2 | 3 | const REAL nu = x[0]; 4 | const REAL sigma = x[1]; 5 | const bool valid = (0.0f < nu) && (0.0f < sigma); 6 | 7 | if (valid) { 8 | const REAL scale = student_t_log_scale(nu, sigma); 9 | REAL res = 0.0; 10 | uint idx = 1; 11 | for (uint i = 2; i < dim; i+=2) { 12 | const REAL b0 = x[i]; 13 | const REAL b1 = x[i+1]; 14 | const uint next = idx + (uint)data[idx]; 15 | while (idx < next) { 16 | res += student_t_log_unscaled(nu, b0 + b1 * data[idx+1], sigma, data[idx+2]) 17 | + scale; 18 | idx += 2; 19 | } 20 | idx++; 21 | } 22 | return res; 23 | } 24 | 25 | return NAN; 26 | } 27 | 28 | REAL rhlr_mcmc_logpdf(const uint data_len, const uint hyperparams_len, const REAL* params, 29 | const uint dim, REAL* x) { 30 | const bool valid = (1.0f < x[0]); 31 | 32 | if (valid) { 33 | REAL logp = exponential_log_unscaled(params[0], x[0] - 1) 34 | + uniform_log(params[1], params[2], x[1]); 35 | for (uint i = 0; i < dim-2; i++) { 36 | logp += gaussian_log_unscaled(params[2*i+3], params[2*i+4], x[i+2]); 37 | } 38 | return logp; 39 | } 40 | return NAN; 41 | 42 | } 43 | 44 | REAL rhlr_logpdf(const uint data_len, const uint hyperparams_len, const REAL* params, 45 | const uint dim, REAL* x) { 46 | const bool valid = (1.0f < x[0]); 47 | 48 | if (valid) { 49 | REAL logp = exponential_log(params[0], x[0] - 1) 50 | + uniform_log(params[1], params[2], x[1]); 51 | for (uint i = 0; i < dim-2; i++) { 52 | logp += gaussian_log(params[2*i+3], params[2*i+4], x[i+2]); 53 | } 54 | return logp; 55 | } 56 | return NAN; 57 | 58 | } 59 | -------------------------------------------------------------------------------- /src/dbda/ch17/robust-linear-regression.cl: -------------------------------------------------------------------------------- 1 | REAL rlr_loglik(const uint data_len, const REAL* data, const uint dim, const REAL* x) { 2 | 3 | const REAL nu = x[0]; 4 | const REAL b0 = x[1]; 5 | const REAL b1 = x[2]; 6 | const REAL sigma = x[3]; 7 | 8 | const uint n = (uint)data[0]; 9 | 10 | const bool valid = (0.0f < nu) && (0.0f < sigma); 11 | 12 | if (valid) { 13 | const REAL scale = student_t_log_scale(nu, sigma); 14 | REAL res = 0.0; 15 | for (uint i = 0; i < n; i = i+2) { 16 | res += student_t_log_unscaled(nu, b0 + b1 * data[i+1], sigma, data[i+2]) 17 | + scale; 18 | } 19 | return res; 20 | } 21 | return NAN; 22 | 23 | } 24 | 25 | REAL rlr_mcmc_logpdf(const uint data_len, const uint hyperparams_len, const REAL* params, 26 | const uint dim, REAL* x) { 27 | const bool valid = (1.0f < x[0]); 28 | if (valid) { 29 | return exponential_log_unscaled(params[0], x[0] - 1) 30 | + gaussian_log_unscaled(params[1], params[2], x[1]) 31 | + gaussian_log_unscaled(params[3], params[4], x[2]) 32 | + uniform_log(params[5], params[6], x[3]); 33 | } 34 | return NAN; 35 | 36 | } 37 | 38 | REAL rlr_logpdf(const uint data_len, const uint hyperparams_len, const REAL* params, 39 | const uint dim, REAL* x) { 40 | return exponential_log(params[0], x[0] - 1) 41 | + gaussian_log(params[1], params[2], x[1]) 42 | + gaussian_log(params[3], params[4], x[2]) 43 | + uniform_log(params[5], params[6], x[3]); 44 | 45 | } 46 | -------------------------------------------------------------------------------- /src/dbda/ch17/robust_hierarchical_linear_regression.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Dragan Djuric. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) or later 4 | ;; which can be found in the file LICENSE at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:author "Dragan Djuric"} 10 | dbda.ch17.robust-hierarchical-linear-regression 11 | (:require [quil.core :as q] 12 | [quil.applet :as qa] 13 | [quil.middlewares.pause-on-error :refer [pause-on-error]] 14 | [uncomplicate.commons.core :refer [with-release let-release wrap-float]] 15 | [uncomplicate.fluokitten.core :refer [op fmap]] 16 | [uncomplicate.neanderthal 17 | [core :refer [dim]] 18 | [real :refer [entry entry!]] 19 | [math :refer [sqrt]] 20 | [native :refer [fv fge]]] 21 | [uncomplicate.bayadera 22 | [core :refer :all] 23 | [library :as library] 24 | [util :refer [bin-mapper hdi]] 25 | [opencl :refer [with-default-bayadera]] 26 | [mcmc :refer [mix! burn-in! pow-n acc-rate! run-sampler!]]] 27 | [uncomplicate.bayadera.toolbox 28 | [processing :refer :all] 29 | [plots :refer [render-sample render-histogram]]] 30 | [clojure.java.io :as io] 31 | [clojure.data.csv :as csv])) 32 | 33 | (def all-data (atom {})) 34 | (def state (atom nil)) 35 | 36 | (defn read-data [in-file] 37 | (loop [c 0 data (drop 1 (csv/read-csv in-file)) hws (transient {})] 38 | (if data 39 | (let [[s h w] (first data)] 40 | (recur (inc c) (next data) 41 | (let [s (read-string s) 42 | hw (get hws s (transient []))] 43 | (assoc! hws s 44 | (-> hw 45 | (conj! (double (read-string h))) 46 | (conj! (double (read-string w)))))))) 47 | (let [persistent-hws (into (sorted-map) (fmap persistent! (persistent! hws))) 48 | subject-count (count persistent-hws)] 49 | (apply op [subject-count] (map (fn [[k v]] (op [(count v)] v)) persistent-hws)))))) 50 | 51 | (def params (fv (read-data (slurp (io/resource "dbda/ch17/hier-lin-regress-data.csv"))))) 52 | 53 | (defn analysis [] 54 | (with-default-bayadera 55 | (with-release [rhlr-prior 56 | (library/distribution-model [:gaussian :uniform :exponential :student-t 57 | (slurp (io/resource "dbda/ch17/robust-hierarchical-linear-regression.cl"))] 58 | {:name "rhlr" :mcmc-logpdf "rhlr_mcmc_logpdf" 59 | :params-size 103 :dimension 52}) 60 | rhlr-likelihood 61 | (library/likelihood-model (slurp (io/resource "dbda/ch17/robust-hierarchical-linear-regression.cl")) 62 | {:name "rhlr"}) 63 | prior (distribution rhlr-prior) 64 | prior-dist (prior (fv (op [4 0.01 1000] (take 100 (cycle [0 100 3 10]))))) 65 | post (distribution "rhlr" rhlr-likelihood prior-dist) 66 | post-dist (post params) 67 | post-sampler (sampler post-dist {:limits (fge 2 52 (op [2 20 0.001 100] (take 100 (interleave (repeat -100) (repeat 100) (repeat -3) (repeat 9)))))})] 68 | (println (time (mix! post-sampler {:dimension-power 0.2 :cooling-schedule (pow-n 4)}))) 69 | (println (time (do (burn-in! post-sampler 3000) (acc-rate! post-sampler)))) 70 | (println (time (run-sampler! post-sampler 64))) 71 | (time (histogram! post-sampler 1))))) 72 | 73 | (defn setup [] 74 | (reset! state 75 | {:data @all-data 76 | :nu (plot2d (qa/current-applet) {:width 300 :height 300}) 77 | :sigma (plot2d (qa/current-applet) {:width 300 :height 300}) 78 | :betas (vec (repeatedly 50 (partial plot2d (qa/current-applet) 79 | {:width 300 :height 300})))})) 80 | 81 | (defn draw [] 82 | (when-not (= @all-data (:data @state)) 83 | (swap! state assoc :data @all-data) 84 | (let [data @all-data] 85 | (q/background 0) 86 | (q/image (show (render-histogram (:nu @state) data 0)) 0 0) 87 | (q/image (show (render-histogram (:sigma @state) data 1)) 350 0) 88 | (dotimes [i 4] 89 | (dotimes [j 3] 90 | (let [index (+ (* i 3) j)] 91 | (when (< index 12) 92 | (q/image (show (render-histogram ((:betas @state) index) data (+ index 2))) 93 | (* j 320) (+ 320 (* i 320)))))))))) 94 | 95 | (defn display-sketch [] 96 | (q/defsketch diagrams 97 | :renderer :p2d 98 | :size :fullscreen 99 | :display 2 100 | :setup setup 101 | :draw draw 102 | :middleware [pause-on-error])) 103 | 104 | ;; This is how to run it: 105 | ;; 1. Display empty window (preferrably spanning the screen) 106 | #_(display-sketch) 107 | ;; 2. Run the analysis to populate the data that the plots draw 108 | #_(reset! all-data (analysis)) 109 | ;; It is awkward, but I was constrained by how quil and processing 110 | ;; manage display. 111 | -------------------------------------------------------------------------------- /src/dbda/ch17/robust_linear_regression.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Dragan Djuric. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) or later 4 | ;; which can be found in the file LICENSE at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:author "Dragan Djuric"} 10 | dbda.ch17.robust-linear-regression 11 | (:require [quil.core :as q] 12 | [quil.applet :as qa] 13 | [quil.middlewares.pause-on-error :refer [pause-on-error]] 14 | [uncomplicate.commons.core :refer [with-release info]] 15 | [uncomplicate.fluokitten.core :refer [op]] 16 | [uncomplicate.clojurecl.core :refer [finish!]] 17 | [uncomplicate.neanderthal 18 | [core :refer [dim]] 19 | [native :refer [fv fge]]] 20 | [uncomplicate.bayadera 21 | [core :refer :all] 22 | [library :as library] 23 | [opencl :refer [with-default-bayadera]] 24 | [mcmc :refer [mix!]]] 25 | [uncomplicate.bayadera.toolbox 26 | [processing :refer :all] 27 | [plots :refer [render-sample render-histogram]]] 28 | [clojure.java.io :as io] 29 | [clojure.data.csv :as csv])) 30 | 31 | (def all-data (atom {})) 32 | (def state (atom nil)) 33 | 34 | (defn read-data [in-file] 35 | (loop [c 0 data (drop 1 (csv/read-csv in-file)) hw (transient [])] 36 | (if data 37 | (let [[_ h w] (first data)] 38 | (recur (inc c) (next data) 39 | (-> hw 40 | (conj! (double (read-string h))) 41 | (conj! (double (read-string w)))))) 42 | (op [c] (persistent! hw))))) 43 | 44 | (def params-30 (fv (read-data (slurp (io/resource "dbda/ch17/ht-wt-data-30.csv"))))) 45 | (def params-300 (fv (read-data (slurp (io/resource "dbda/ch17/ht-wt-data-300.csv"))))) 46 | 47 | (defn analysis [] 48 | (with-default-bayadera 49 | (with-release [rlr-prior 50 | (library/distribution-model [:gaussian :uniform :exponential :student-t 51 | (slurp (io/resource "dbda/ch17/robust-linear-regression.cl"))] 52 | {:name "rlr" :mcmc-logpdf "rlr_mcmc_logpdf" 53 | :params-size 7 :dimension 4}) 54 | rlr-likelihood 55 | (library/likelihood-model (slurp (io/resource "dbda/ch17/robust-linear-regression.cl")) 56 | {:name "rlr"}) 57 | prior (distribution rlr-prior) 58 | prior-dist (prior (fv 10 -100 100 5 10 0.001 1000)) 59 | prior-sampler (sampler prior-dist {:walkers 22528 :limits (fge 2 4 [1 20 -400 100 0 20 0.01 100])}) 60 | post (distribution "rlr" rlr-likelihood prior-dist) 61 | post-30-dist (post params-30) 62 | post-30-sampler (sampler post-30-dist {:limits (fge 2 4 [1 20 -400 100 0 20 0.01 100])}) 63 | post-300-dist (post params-300) 64 | post-300-sampler (sampler post-300-dist {:limits (fge 2 4 [1 10 -400 100 0 20 0.01 100])})] 65 | (println (time (mix! post-30-sampler {:step 128}))) 66 | (println (time (mix! post-300-sampler {:step 384}))) 67 | (println (info post-300-sampler)) 68 | [(histogram! post-30-sampler 1000) 69 | (histogram! post-300-sampler 1000)]))) 70 | 71 | (defn setup [] 72 | (reset! state 73 | {:data @all-data 74 | :nu-30 (plot2d (qa/current-applet) {:width 350 :height 350}) 75 | :b0-30 (plot2d (qa/current-applet) {:width 350 :height 350}) 76 | :b1-30 (plot2d (qa/current-applet) {:width 350 :height 350}) 77 | :sigma-30 (plot2d (qa/current-applet) {:width 350 :height 350}) 78 | :nu-300 (plot2d (qa/current-applet) {:width 350 :height 350}) 79 | :b0-300 (plot2d (qa/current-applet) {:width 350 :height 350}) 80 | :b1-300 (plot2d (qa/current-applet) {:width 350 :height 350}) 81 | :sigma-300 (plot2d (qa/current-applet) {:width 350 :height 350})})) 82 | 83 | (defn draw [] 84 | (when-not (= @all-data (:data @state)) 85 | (swap! state assoc :data @all-data) 86 | (q/background 0) 87 | (q/image (show (render-histogram (:nu-30 @state) (@all-data 0) 0)) 0 0) 88 | (q/image (show (render-histogram (:b0-30 @state) (@all-data 0) 1)) 0 370) 89 | (q/image (show (render-histogram (:b1-30 @state) (@all-data 0) 2)) 0 740) 90 | (q/image (show (render-histogram (:sigma-30 @state) (@all-data 0) 3)) 0 1110) 91 | (q/image (show (render-histogram (:nu-300 @state) (@all-data 1) 0)) 370 0) 92 | (q/image (show (render-histogram (:b0-300 @state) (@all-data 1) 1)) 370 370) 93 | (q/image (show (render-histogram (:b1-300 @state) (@all-data 1) 2)) 370 740) 94 | (q/image (show (render-histogram (:sigma-300 @state) (@all-data 1) 3)) 370 1110))) 95 | 96 | (defn display-sketch [] 97 | (q/defsketch diagrams 98 | :renderer :p2d 99 | :size :fullscreen 100 | :display 2 101 | :setup setup 102 | :draw draw 103 | :middleware [pause-on-error])) 104 | 105 | ;; This is how to run it: 106 | ;; 1. Display empty window (preferrably spanning the screen) 107 | #_(display-sketch) 108 | ;; 2. Run the analysis to populate the data that the plots draw 109 | #_(reset! all-data (analysis)) 110 | ;; It is awkward, but I was constrained by how quil and processing 111 | ;; manage display. 112 | -------------------------------------------------------------------------------- /src/dbda/ch18/multiple-linear-regression.cl: -------------------------------------------------------------------------------- 1 | REAL mlr_loglik(const uint data_len, const REAL* data, const uint dim, const REAL* x) { 2 | 3 | const REAL nu = x[0]; 4 | const REAL sigma = x[1]; 5 | const REAL b0 = x[2]; 6 | const REAL b1 = x[3]; 7 | const REAL b2 = x[4]; 8 | 9 | const bool valid = (0.0f < nu) && (0.0f < sigma); 10 | 11 | if (valid) { 12 | const REAL scale = student_t_log_scale(nu, sigma); 13 | REAL res = 0.0; 14 | for (uint i = 0; i < data_len; i = i+3) { 15 | res += student_t_log_unscaled(nu, b0 + b1 * data[i] + b2 * data[i+1], sigma, data[i+2]) 16 | + scale; 17 | } 18 | return res; 19 | } 20 | return NAN; 21 | 22 | } 23 | 24 | REAL mlr_mcmc_logpdf(const uint data_len, const uint hyperparams_len, const REAL* params, 25 | const uint dim, const REAL* x) { 26 | const bool valid = (1.0f < x[0]); 27 | if (valid) { 28 | REAL logp = exponential_log_unscaled(params[0], x[0] - 1) 29 | + uniform_log(params[1], params[2], x[3]); 30 | for (uint i = 0; i < dim-2; i++) { 31 | logp += gaussian_log_unscaled(params[2*i+3], params[2*i+4], x[i+2]); 32 | } 33 | return logp; 34 | } 35 | return NAN; 36 | } 37 | 38 | REAL mlr_logpdf(const uint data_len, const uint hyperparams_len, const REAL* params, 39 | const uint dim, const REAL* x) { 40 | bool valid = (1.0f < x[0]); 41 | if (valid) { 42 | REAL logp = exponential_log(params[0], x[0] - 1) 43 | + uniform_log(params[1], params[2], x[3]); 44 | for (uint i = 0; i < dim-2; i++) { 45 | logp += gaussian_log(params[2*i+3], params[2*i+4], x[i+2]); 46 | } 47 | return logp; 48 | } 49 | return NAN; 50 | } 51 | -------------------------------------------------------------------------------- /src/dbda/ch18/multiple_linear_regression.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Dragan Djuric. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) or later 4 | ;; which can be found in the file LICENSE at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:author "Dragan Djuric"} 10 | dbda.ch18.multiple-linear-regression 11 | (:require [quil.core :as q] 12 | [quil.applet :as qa] 13 | [quil.middlewares.pause-on-error :refer [pause-on-error]] 14 | [uncomplicate.commons.core :refer [with-release let-release wrap-float]] 15 | [uncomplicate.fluokitten.core :refer [op fmap]] 16 | [uncomplicate.neanderthal 17 | [core :refer [dim]] 18 | [real :refer [entry entry!]] 19 | [math :refer [sqrt]] 20 | [native :refer [fv fge]]] 21 | [uncomplicate.bayadera 22 | [core :refer :all] 23 | [library :as library] 24 | [util :refer [bin-mapper hdi]] 25 | [opencl :refer [with-default-bayadera]] 26 | [mcmc :refer [mix! burn-in! pow-n acc-rate! run-sampler!]]] 27 | [uncomplicate.bayadera.toolbox 28 | [processing :refer :all] 29 | [plots :refer [render-sample render-histogram]]] 30 | [clojure.java.io :as io] 31 | [clojure.data.csv :as csv])) 32 | 33 | (def all-data (atom {})) 34 | (def state (atom nil)) 35 | 36 | (defn read-data [in-file] 37 | (loop [data (drop 1 (csv/read-csv in-file)) res (transient [])] 38 | (if data 39 | (let [[_ spend _ _ prcnt-take _ _ satt] (first data)] 40 | (recur (next data) 41 | (-> res 42 | (conj! (double (read-string spend))) 43 | (conj! (double (read-string prcnt-take))) 44 | (conj! (double (read-string satt)))))) 45 | (fv (persistent! res))))) 46 | 47 | (def data (fv (read-data (slurp (io/resource "dbda/ch18/sat-spending.csv"))))) 48 | 49 | (defn analysis [] 50 | (with-default-bayadera 51 | (with-release [mlr-prior 52 | (library/distribution-model [:gaussian :uniform :exponential :student-t 53 | (slurp (io/resource "dbda/ch18/multiple-linear-regression.cl"))] 54 | {:name "mlr" :mcmc-logpdf "mlr_mcmc_logpdf" 55 | :params-size 9 :dimension 5}) 56 | rhlr-likelihood 57 | (library/likelihood-model (slurp (io/resource "dbda/ch18/multiple-linear-regression.cl")) 58 | {:name "mlr"}) 59 | prior (distribution mlr-prior) 60 | prior-dist (prior (fv [26 0.001 1000 1000 500 0 20 0 5])) 61 | post (distribution "mlr" rhlr-likelihood prior-dist) 62 | post-dist (post data) 63 | post-sampler (sampler post-dist {:limits (fge 2 5 [1 30 0.001 1000 0 2000 -20 20 -5 5])})] 64 | (println (time (mix! post-sampler {:cooling-schedule (pow-n 2)}))) 65 | (println (time (do (burn-in! post-sampler 1000) (acc-rate! post-sampler)))) 66 | (println (time (run-sampler! post-sampler 64))) 67 | (time (histogram! post-sampler 1000))))) 68 | 69 | (defn setup [] 70 | (reset! state 71 | {:data @all-data 72 | :nu (plot2d (qa/current-applet) {:width 500 :height 500}) 73 | :sigma (plot2d (qa/current-applet) {:width 500 :height 500}) 74 | :b0 (plot2d (qa/current-applet) {:width 500 :height 500}) 75 | :b1 (plot2d (qa/current-applet) {:width 500 :height 500}) 76 | :b2 (plot2d (qa/current-applet) {:width 500 :height 500})})) 77 | 78 | (defn draw [] 79 | (when-not (= @all-data (:data @state)) 80 | (swap! state assoc :data @all-data) 81 | (let [data @all-data] 82 | (q/background 0) 83 | (q/image (show (render-histogram (:nu @state) data 0)) 0 0) 84 | (q/image (show (render-histogram (:sigma @state) data 1)) 520 0) 85 | (q/image (show (render-histogram (:b0 @state) data 2)) 0 520) 86 | (q/image (show (render-histogram (:b1 @state) data 3)) 0 1040) 87 | (q/image (show (render-histogram (:b1 @state) data 4)) 520 1040)))) 88 | 89 | (defn display-sketch [] 90 | (q/defsketch diagrams 91 | :renderer :p2d 92 | :size :fullscreen 93 | :display 2 94 | :setup setup 95 | :draw draw 96 | :middleware [pause-on-error])) 97 | 98 | ;; This is how to run it: 99 | ;; 1. Display empty window (preferrably spanning the screen) 100 | #_(display-sketch) 101 | ;; 2. Run the analysis to populate the data that the plots draw 102 | #_(reset! all-data (analysis)) 103 | ;; It is awkward, but I was constrained by how quil and processing 104 | ;; manage display. 105 | -------------------------------------------------------------------------------- /src/dbda/ch18/sat-spending.csv: -------------------------------------------------------------------------------- 1 | State,Spend,StuTeaRat,Salary,PrcntTake,SATV,SATM,SATT 2 | Alabama,4.405,17.2,31.144,8,491,538,1029 3 | Alaska,8.963,17.6,47.951,47,445,489,934 4 | Arizona,4.778,19.3,32.175,27,448,496,944 5 | Arkansas,4.459,17.1,28.934,6,482,523,1005 6 | California,4.992,24,41.078,45,417,485,902 7 | Colorado,5.443,18.4,34.571,29,462,518,980 8 | Connecticut,8.817,14.4,50.045,81,431,477,908 9 | Delaware,7.03,16.6,39.076,68,429,468,897 10 | Florida,5.718,19.1,32.588,48,420,469,889 11 | Georgia,5.193,16.3,32.291,65,406,448,854 12 | Hawaii,6.078,17.9,38.518,57,407,482,889 13 | Idaho,4.21,19.1,29.783,15,468,511,979 14 | Illinois,6.136,17.3,39.431,13,488,560,1048 15 | Indiana,5.826,17.5,36.785,58,415,467,882 16 | Iowa,5.483,15.8,31.511,5,516,583,1099 17 | Kansas,5.817,15.1,34.652,9,503,557,1060 18 | Kentucky,5.217,17,32.257,11,477,522,999 19 | Louisiana,4.761,16.8,26.461,9,486,535,1021 20 | Maine,6.428,13.8,31.972,68,427,469,896 21 | Maryland,7.245,17,40.661,64,430,479,909 22 | Massachusetts,7.287,14.8,40.795,80,430,477,907 23 | Michigan,6.994,20.1,41.895,11,484,549,1033 24 | Minnesota,6,17.5,35.948,9,506,579,1085 25 | Mississippi,4.08,17.5,26.818,4,496,540,1036 26 | Missouri,5.383,15.5,31.189,9,495,550,1045 27 | Montana,5.692,16.3,28.785,21,473,536,1009 28 | Nebraska,5.935,14.5,30.922,9,494,556,1050 29 | Nevada,5.16,18.7,34.836,30,434,483,917 30 | New Hampshire,5.859,15.6,34.72,70,444,491,935 31 | New Jersey,9.774,13.8,46.087,70,420,478,898 32 | New Mexico,4.586,17.2,28.493,11,485,530,1015 33 | New York,9.623,15.2,47.612,74,419,473,892 34 | North Carolina,5.077,16.2,30.793,60,411,454,865 35 | North Dakota,4.775,15.3,26.327,5,515,592,1107 36 | Ohio,6.162,16.6,36.802,23,460,515,975 37 | Oklahoma,4.845,15.5,28.172,9,491,536,1027 38 | Oregon,6.436,19.9,38.555,51,448,499,947 39 | Pennsylvania,7.109,17.1,44.51,70,419,461,880 40 | Rhode Island,7.469,14.7,40.729,70,425,463,888 41 | South Carolina,4.797,16.4,30.279,58,401,443,844 42 | South Dakota,4.775,14.4,25.994,5,505,563,1068 43 | Tennessee,4.388,18.6,32.477,12,497,543,1040 44 | Texas,5.222,15.7,31.223,47,419,474,893 45 | Utah,3.656,24.3,29.082,4,513,563,1076 46 | Vermont,6.75,13.8,35.406,68,429,472,901 47 | Virginia,5.327,14.6,33.987,65,428,468,896 48 | Washington,5.906,20.2,36.151,48,443,494,937 49 | West Virginia,6.107,14.8,31.944,17,448,484,932 50 | Wisconsin,6.93,15.9,37.746,9,501,572,1073 51 | Wyoming,6.16,14.9,31.285,10,476,525,1001 52 | -------------------------------------------------------------------------------- /src/dbda/ch19/fruitfly-data-reduced.csv: -------------------------------------------------------------------------------- 1 | Longevity,CompanionNumber,Thorax 2 | 35,Pregnant8,0.64 3 | 37,Pregnant8,0.68 4 | 49,Pregnant8,0.68 5 | 46,Pregnant8,0.72 6 | 63,Pregnant8,0.72 7 | 39,Pregnant8,0.76 8 | 46,Pregnant8,0.76 9 | 56,Pregnant8,0.76 10 | 63,Pregnant8,0.76 11 | 65,Pregnant8,0.76 12 | 56,Pregnant8,0.8 13 | 65,Pregnant8,0.8 14 | 70,Pregnant8,0.8 15 | 63,Pregnant8,0.84 16 | 65,Pregnant8,0.84 17 | 70,Pregnant8,0.84 18 | 77,Pregnant8,0.84 19 | 81,Pregnant8,0.84 20 | 86,Pregnant8,0.84 21 | 70,Pregnant8,0.88 22 | 70,Pregnant8,0.88 23 | 77,Pregnant8,0.92 24 | 77,Pregnant8,0.92 25 | 81,Pregnant8,0.92 26 | 77,Pregnant8,0.94 27 | 40,None0,0.64 28 | 37,None0,0.7 29 | 44,None0,0.72 30 | 47,None0,0.72 31 | 47,None0,0.72 32 | 47,None0,0.76 33 | 68,None0,0.78 34 | 47,None0,0.8 35 | 54,None0,0.84 36 | 61,None0,0.84 37 | 71,None0,0.84 38 | 75,None0,0.84 39 | 89,None0,0.84 40 | 58,None0,0.88 41 | 59,None0,0.88 42 | 62,None0,0.88 43 | 79,None0,0.88 44 | 96,None0,0.88 45 | 58,None0,0.92 46 | 62,None0,0.92 47 | 70,None0,0.92 48 | 72,None0,0.92 49 | 75,None0,0.92 50 | 96,None0,0.92 51 | 75,None0,0.94 52 | 46,Pregnant1,0.64 53 | 42,Pregnant1,0.68 54 | 65,Pregnant1,0.72 55 | 46,Pregnant1,0.76 56 | 58,Pregnant1,0.76 57 | 42,Pregnant1,0.8 58 | 48,Pregnant1,0.8 59 | 58,Pregnant1,0.8 60 | 50,Pregnant1,0.82 61 | 80,Pregnant1,0.82 62 | 63,Pregnant1,0.84 63 | 65,Pregnant1,0.84 64 | 70,Pregnant1,0.84 65 | 70,Pregnant1,0.84 66 | 72,Pregnant1,0.84 67 | 97,Pregnant1,0.84 68 | 46,Pregnant1,0.88 69 | 56,Pregnant1,0.88 70 | 70,Pregnant1,0.88 71 | 70,Pregnant1,0.88 72 | 72,Pregnant1,0.88 73 | 76,Pregnant1,0.88 74 | 90,Pregnant1,0.88 75 | 76,Pregnant1,0.92 76 | 92,Pregnant1,0.92 77 | 21,Virgin1,0.68 78 | 40,Virgin1,0.68 79 | 44,Virgin1,0.72 80 | 54,Virgin1,0.76 81 | 36,Virgin1,0.78 82 | 40,Virgin1,0.8 83 | 56,Virgin1,0.8 84 | 60,Virgin1,0.8 85 | 48,Virgin1,0.84 86 | 53,Virgin1,0.84 87 | 60,Virgin1,0.84 88 | 60,Virgin1,0.84 89 | 65,Virgin1,0.84 90 | 68,Virgin1,0.84 91 | 60,Virgin1,0.88 92 | 81,Virgin1,0.88 93 | 81,Virgin1,0.88 94 | 48,Virgin1,0.9 95 | 48,Virgin1,0.9 96 | 56,Virgin1,0.9 97 | 68,Virgin1,0.9 98 | 75,Virgin1,0.9 99 | 81,Virgin1,0.9 100 | 48,Virgin1,0.92 101 | 68,Virgin1,0.92 102 | 16,Virgin8,0.64 103 | 19,Virgin8,0.64 104 | 19,Virgin8,0.68 105 | 32,Virgin8,0.72 106 | 33,Virgin8,0.72 107 | 33,Virgin8,0.74 108 | 30,Virgin8,0.76 109 | 42,Virgin8,0.76 110 | 42,Virgin8,0.76 111 | 33,Virgin8,0.78 112 | 26,Virgin8,0.8 113 | 30,Virgin8,0.8 114 | 40,Virgin8,0.82 115 | 54,Virgin8,0.82 116 | 34,Virgin8,0.84 117 | 34,Virgin8,0.84 118 | 47,Virgin8,0.84 119 | 47,Virgin8,0.84 120 | 42,Virgin8,0.88 121 | 47,Virgin8,0.88 122 | 54,Virgin8,0.88 123 | 54,Virgin8,0.88 124 | 56,Virgin8,0.88 125 | 60,Virgin8,0.88 126 | 44,Virgin8,0.92 127 | -------------------------------------------------------------------------------- /src/dbda/ch19/fruitfly.cl: -------------------------------------------------------------------------------- 1 | REAL ff_loglik(const uint data_len, const REAL* data, const uint dim, const REAL* x) { 2 | 3 | const REAL sigma = x[0]; 4 | 5 | REAL a[5]; 6 | REAL a_mean = 0.0f; 7 | for (uint i = 0; i < 5; i++) { 8 | a[i] = x[i+2]; 9 | a_mean += a[i]; 10 | } 11 | a_mean = a_mean / 5.0; 12 | 13 | const REAL bcov = x[7]; 14 | const REAL xcov_mean = data[0]; 15 | 16 | const REAL b0 = x[1] + a_mean - bcov * xcov_mean; 17 | 18 | const bool valid = (0.0f < sigma); 19 | 20 | const REAL scale = gaussian_log_scale(sigma); 21 | 22 | REAL res = 0.0; 23 | for (uint i = 0; i < data_len; i += 3) { 24 | const uint j = (uint)data[i*3+1]; 25 | res += gaussian_log_unscaled(b0 + a[j] - a_mean + bcov * data[i*3+2], 26 | sigma, data[i*3+3]) + scale; 27 | } 28 | return res; 29 | } 30 | 31 | REAL ff_mcmc_logpdf(const uint data_len, const uint hyperparams_len, const REAL* params, 32 | const uint dim, REAL* x) { 33 | REAL logp = uniform_log(params[0], params[1], x[0]) 34 | + gaussian_log_unscaled(params[2], params[3], x[1]) 35 | + gaussian_log_unscaled(params[9], params[10], x[dim-1]); 36 | for (uint i = 2; i < dim-1; i++) { 37 | logp += gaussian_log_unscaled(0, params[i+2], x[i]); 38 | } 39 | return logp; 40 | } 41 | 42 | REAL ff_logpdf(const uint data_len, const uint hyperparams_len, const REAL* params, 43 | const uint dim, REAL* x) { 44 | REAL logp = uniform_log(params[0], params[1], x[0]) 45 | + gaussian_log(params[2], params[3], x[1]) 46 | + gaussian_log(params[9], params[10], x[dim-1]); 47 | for (uint i = 2; i < dim-1; i++) { 48 | logp += gaussian_log(0, params[i+2], x[i]); 49 | } 50 | return logp; 51 | } 52 | -------------------------------------------------------------------------------- /src/dbda/ch19/sex_and_death.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Dragan Djuric. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) or later 4 | ;; which can be found in the file LICENSE at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:author "Dragan Djuric"} 10 | dbda.ch19.sex-and-death 11 | (:require [quil.core :as q] 12 | [quil.applet :as qa] 13 | [quil.middlewares.pause-on-error :refer [pause-on-error]] 14 | [uncomplicate.commons.core :refer [with-release let-release wrap-float]] 15 | [uncomplicate.fluokitten.core :refer [op fmap]] 16 | [uncomplicate.neanderthal 17 | [core :refer [dim row subvector sum]] 18 | [real :refer [entry entry!]] 19 | [math :refer [sqrt]] 20 | [native :refer [fv fge]]] 21 | [uncomplicate.bayadera 22 | [core :refer :all] 23 | [library :as library] 24 | [util :refer [bin-mapper hdi]] 25 | [opencl :refer [with-default-bayadera]] 26 | [mcmc :refer [mix! burn-in! pow-n acc-rate! run-sampler!]]] 27 | [uncomplicate.bayadera.toolbox 28 | [processing :refer :all] 29 | [plots :refer [render-sample render-histogram]]] 30 | [clojure.java.io :as io] 31 | [clojure.data.csv :as csv])) 32 | 33 | (def all-data (atom {})) 34 | (def state (atom nil)) 35 | 36 | (defn read-data [in-file] 37 | (loop [data (drop 1 (csv/read-csv in-file)) acc (transient [])] 38 | (if data 39 | (let [[longevity group thorax] (first data)] 40 | (recur (next data) 41 | (-> acc 42 | (conj! (case group 43 | "None0" 0 44 | "Pregnant1" 1 45 | "Pregnant8" 2 46 | "Virgin1" 3 47 | "Virgin8" 4)) 48 | (conj! (double (read-string thorax))) 49 | (conj! (double (read-string longevity)))))) 50 | (fv (persistent! acc))))) 51 | 52 | (def ff-data (read-data (slurp (io/resource "dbda/ch19/fruitfly-data-reduced.csv")))) 53 | (def ff-matrix (fge 3 (first ff-data) (drop 1 ff-data))) 54 | (def y-sd (double (sd (row ff-matrix 2)))) 55 | (def y-mean (double (mean (row ff-matrix 2)))) 56 | (def x-sd (double (sd (row ff-matrix 1)))) 57 | (def params (fv (op [(mean (row ff-matrix 1))] ff-data))) 58 | 59 | (defn analysis [] 60 | (with-default-bayadera 61 | (with-release [ff-prior 62 | (library/distribution-model [:gaussian :uniform (slurp (io/resource "dbda/ch19/fruitfly.cl"))] 63 | {:name "ff" :mcmc-logpdf "ff_mcmc_logpdf" 64 | :params-size 11 :dimension 8}) 65 | ff-likelihood 66 | (library/likelihood-model (slurp (io/resource "dbda/ch19/fruitfly.cl")) 67 | {:name "ff"}) 68 | prior (distribution ff-prior) 69 | prior-dist (prior (fv (op [(/ y-sd 100.0) (* y-sd 10.0) 70 | y-mean (* y-sd 5)] 71 | (vec (repeat 5 (* y-sd 5))) 72 | [0 (/ (* 2 y-sd) x-sd)]))) 73 | prior-sampler (sampler prior-dist 74 | {:limits (fge 2 8 (op [0 150 0 100] 75 | (vec (take 10 (cycle [-20 50]))) 76 | [-500 500]))}) 77 | post (distribution "ff" ff-likelihood prior-dist) 78 | post-dist (post params) 79 | post-sampler (sampler post-dist {:position prior-dist 80 | :limits (fge 2 8 (op [0 150 0 100] 81 | (vec (take 10 (cycle [-20 50]))) 82 | [-500 500]))})] 83 | (println (time (mix! prior-sampler))) 84 | (println (time (mix! post-sampler {:cooling-schedule (pow-n 1.5)}))) 85 | (time (histogram! post-sampler 100))))) 86 | 87 | 88 | ;; TODO It does not mix well by default. I'd have to revisit this example. 89 | #_(defn setup [] 90 | (reset! state 91 | {:data @all-data 92 | :nu (plot2d (qa/current-applet) {:width 500 :height 500}) 93 | :sigma (plot2d (qa/current-applet) {:width 500 :height 500}) 94 | :b0 (plot2d (qa/current-applet) {:width 500 :height 500}) 95 | :b1 (plot2d (qa/current-applet) {:width 500 :height 500}) 96 | :b2 (plot2d (qa/current-applet) {:width 500 :height 500})})) 97 | 98 | #_(defn draw [] 99 | (when-not (= @all-data (:data @state)) 100 | (swap! state assoc :data @all-data) 101 | (let [data @all-data] 102 | (q/background 0) 103 | (q/image (show (render-histogram (:nu @state) data 0)) 0 0) 104 | (q/image (show (render-histogram (:sigma @state) data 1)) 520 0) 105 | (q/image (show (render-histogram (:b0 @state) data 2)) 0 520) 106 | (q/image (show (render-histogram (:b1 @state) data 3)) 0 1040) 107 | (q/image (show (render-histogram (:b1 @state) data 4)) 520 1040)))) 108 | 109 | #_(defn display-sketch [] 110 | (q/defsketch diagrams 111 | :renderer :p2d 112 | :size :fullscreen 113 | :display 2 114 | :setup setup 115 | :draw draw 116 | :middleware [pause-on-error])) 117 | --------------------------------------------------------------------------------