├── .Rbuildignore ├── .gitignore ├── COPYING ├── DESCRIPTION ├── NAMESPACE ├── R ├── data.R ├── misc.R ├── mlmm.r ├── mlmm_cof.r └── plot_mlmm.r ├── README.md ├── data-raw └── make_data_mlmm.R ├── data └── example_data.rda ├── inst └── CITATION ├── man ├── example_data.Rd ├── mlmm.Rd ├── mlmm_cof.Rd ├── plot_GWAS.Rd ├── plot_fwd_GWAS.Rd ├── plot_fwd_region.Rd ├── plot_opt_GWAS.Rd ├── plot_opt_region.Rd ├── plot_region.Rd ├── plot_step_RSS.Rd ├── plot_step_RSS_cof.Rd ├── plot_step_table.Rd ├── qqplot_fwd_GWAS.Rd └── qqplot_opt_GWAS.Rd ├── misc ├── PCs.txt ├── code_mlmm.r ├── emma.r ├── emmax.r ├── example_data.Rdata ├── example_data_bis.Rdata ├── genot.txt ├── map.txt └── phenot.txt ├── mlmm.Rproj └── vignettes ├── mlmm.Rmd └── mlmm_cof.Rmd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^data-raw$ 4 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | .Rproj.user 3 | .Rhistory 4 | .RData 5 | inst/doc 6 | -------------------------------------------------------------------------------- /COPYING: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | The GNU General Public License is a free, copyleft license for 11 | software and other kinds of works. 12 | 13 | The licenses for most software and other practical works are designed 14 | to take away your freedom to share and change the works. By contrast, 15 | the GNU General Public License is intended to guarantee your freedom to 16 | share and change all versions of a program--to make sure it remains free 17 | software for all its users. We, the Free Software Foundation, use the 18 | GNU General Public License for most of our software; it applies also to 19 | any other work released this way by its authors. You can apply it to 20 | your programs, too. 21 | 22 | When we speak of free software, we are referring to freedom, not 23 | price. Our General Public Licenses are designed to make sure that you 24 | have the freedom to distribute copies of free software (and charge for 25 | them if you wish), that you receive source code or can get it if you 26 | want it, that you can change the software or use pieces of it in new 27 | free programs, and that you know you can do these things. 28 | 29 | To protect your rights, we need to prevent others from denying you 30 | these rights or asking you to surrender the rights. Therefore, you have 31 | certain responsibilities if you distribute copies of the software, or if 32 | you modify it: responsibilities to respect the freedom of others. 33 | 34 | For example, if you distribute copies of such a program, whether 35 | gratis or for a fee, you must pass on to the recipients the same 36 | freedoms that you received. You must make sure that they, too, receive 37 | or can get the source code. And you must show them these terms so they 38 | know their rights. 39 | 40 | Developers that use the GNU GPL protect your rights with two steps: 41 | (1) assert copyright on the software, and (2) offer you this License 42 | giving you legal permission to copy, distribute and/or modify it. 43 | 44 | For the developers' and authors' protection, the GPL clearly explains 45 | that there is no warranty for this free software. For both users' and 46 | authors' sake, the GPL requires that modified versions be marked as 47 | changed, so that their problems will not be attributed erroneously to 48 | authors of previous versions. 49 | 50 | Some devices are designed to deny users access to install or run 51 | modified versions of the software inside them, although the manufacturer 52 | can do so. This is fundamentally incompatible with the aim of 53 | protecting users' freedom to change the software. The systematic 54 | pattern of such abuse occurs in the area of products for individuals to 55 | use, which is precisely where it is most unacceptable. Therefore, we 56 | have designed this version of the GPL to prohibit the practice for those 57 | products. If such problems arise substantially in other domains, we 58 | stand ready to extend this provision to those domains in future versions 59 | of the GPL, as needed to protect the freedom of users. 60 | 61 | Finally, every program is threatened constantly by software patents. 62 | States should not allow patents to restrict development and use of 63 | software on general-purpose computers, but in those that do, we wish to 64 | avoid the special danger that patents applied to a free program could 65 | make it effectively proprietary. To prevent this, the GPL assures that 66 | patents cannot be used to render the program non-free. 67 | 68 | The precise terms and conditions for copying, distribution and 69 | modification follow. 70 | 71 | TERMS AND CONDITIONS 72 | 73 | 0. Definitions. 74 | 75 | "This License" refers to version 3 of the GNU General Public License. 76 | 77 | "Copyright" also means copyright-like laws that apply to other kinds of 78 | works, such as semiconductor masks. 79 | 80 | "The Program" refers to any copyrightable work licensed under this 81 | License. Each licensee is addressed as "you". "Licensees" and 82 | "recipients" may be individuals or organizations. 83 | 84 | To "modify" a work means to copy from or adapt all or part of the work 85 | in a fashion requiring copyright permission, other than the making of an 86 | exact copy. The resulting work is called a "modified version" of the 87 | earlier work or a work "based on" the earlier work. 88 | 89 | A "covered work" means either the unmodified Program or a work based 90 | on the Program. 91 | 92 | To "propagate" a work means to do anything with it that, without 93 | permission, would make you directly or secondarily liable for 94 | infringement under applicable copyright law, except executing it on a 95 | computer or modifying a private copy. Propagation includes copying, 96 | distribution (with or without modification), making available to the 97 | public, and in some countries other activities as well. 98 | 99 | To "convey" a work means any kind of propagation that enables other 100 | parties to make or receive copies. Mere interaction with a user through 101 | a computer network, with no transfer of a copy, is not conveying. 102 | 103 | An interactive user interface displays "Appropriate Legal Notices" 104 | to the extent that it includes a convenient and prominently visible 105 | feature that (1) displays an appropriate copyright notice, and (2) 106 | tells the user that there is no warranty for the work (except to the 107 | extent that warranties are provided), that licensees may convey the 108 | work under this License, and how to view a copy of this License. If 109 | the interface presents a list of user commands or options, such as a 110 | menu, a prominent item in the list meets this criterion. 111 | 112 | 1. Source Code. 113 | 114 | The "source code" for a work means the preferred form of the work 115 | for making modifications to it. "Object code" means any non-source 116 | form of a work. 117 | 118 | A "Standard Interface" means an interface that either is an official 119 | standard defined by a recognized standards body, or, in the case of 120 | interfaces specified for a particular programming language, one that 121 | is widely used among developers working in that language. 122 | 123 | The "System Libraries" of an executable work include anything, other 124 | than the work as a whole, that (a) is included in the normal form of 125 | packaging a Major Component, but which is not part of that Major 126 | Component, and (b) serves only to enable use of the work with that 127 | Major Component, or to implement a Standard Interface for which an 128 | implementation is available to the public in source code form. A 129 | "Major Component", in this context, means a major essential component 130 | (kernel, window system, and so on) of the specific operating system 131 | (if any) on which the executable work runs, or a compiler used to 132 | produce the work, or an object code interpreter used to run it. 133 | 134 | The "Corresponding Source" for a work in object code form means all 135 | the source code needed to generate, install, and (for an executable 136 | work) run the object code and to modify the work, including scripts to 137 | control those activities. However, it does not include the work's 138 | System Libraries, or general-purpose tools or generally available free 139 | programs which are used unmodified in performing those activities but 140 | which are not part of the work. For example, Corresponding Source 141 | includes interface definition files associated with source files for 142 | the work, and the source code for shared libraries and dynamically 143 | linked subprograms that the work is specifically designed to require, 144 | such as by intimate data communication or control flow between those 145 | subprograms and other parts of the work. 146 | 147 | The Corresponding Source need not include anything that users 148 | can regenerate automatically from other parts of the Corresponding 149 | Source. 150 | 151 | The Corresponding Source for a work in source code form is that 152 | same work. 153 | 154 | 2. Basic Permissions. 155 | 156 | All rights granted under this License are granted for the term of 157 | copyright on the Program, and are irrevocable provided the stated 158 | conditions are met. This License explicitly affirms your unlimited 159 | permission to run the unmodified Program. The output from running a 160 | covered work is covered by this License only if the output, given its 161 | content, constitutes a covered work. This License acknowledges your 162 | rights of fair use or other equivalent, as provided by copyright law. 163 | 164 | You may make, run and propagate covered works that you do not 165 | convey, without conditions so long as your license otherwise remains 166 | in force. You may convey covered works to others for the sole purpose 167 | of having them make modifications exclusively for you, or provide you 168 | with facilities for running those works, provided that you comply with 169 | the terms of this License in conveying all material for which you do 170 | not control copyright. Those thus making or running the covered works 171 | for you must do so exclusively on your behalf, under your direction 172 | and control, on terms that prohibit them from making any copies of 173 | your copyrighted material outside their relationship with you. 174 | 175 | Conveying under any other circumstances is permitted solely under 176 | the conditions stated below. Sublicensing is not allowed; section 10 177 | makes it unnecessary. 178 | 179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law. 180 | 181 | No covered work shall be deemed part of an effective technological 182 | measure under any applicable law fulfilling obligations under article 183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or 184 | similar laws prohibiting or restricting circumvention of such 185 | measures. 186 | 187 | When you convey a covered work, you waive any legal power to forbid 188 | circumvention of technological measures to the extent such circumvention 189 | is effected by exercising rights under this License with respect to 190 | the covered work, and you disclaim any intention to limit operation or 191 | modification of the work as a means of enforcing, against the work's 192 | users, your or third parties' legal rights to forbid circumvention of 193 | technological measures. 194 | 195 | 4. Conveying Verbatim Copies. 196 | 197 | You may convey verbatim copies of the Program's source code as you 198 | receive it, in any medium, provided that you conspicuously and 199 | appropriately publish on each copy an appropriate copyright notice; 200 | keep intact all notices stating that this License and any 201 | non-permissive terms added in accord with section 7 apply to the code; 202 | keep intact all notices of the absence of any warranty; and give all 203 | recipients a copy of this License along with the Program. 204 | 205 | You may charge any price or no price for each copy that you convey, 206 | and you may offer support or warranty protection for a fee. 207 | 208 | 5. Conveying Modified Source Versions. 209 | 210 | You may convey a work based on the Program, or the modifications to 211 | produce it from the Program, in the form of source code under the 212 | terms of section 4, provided that you also meet all of these conditions: 213 | 214 | a) The work must carry prominent notices stating that you modified 215 | it, and giving a relevant date. 216 | 217 | b) The work must carry prominent notices stating that it is 218 | released under this License and any conditions added under section 219 | 7. This requirement modifies the requirement in section 4 to 220 | "keep intact all notices". 221 | 222 | c) You must license the entire work, as a whole, under this 223 | License to anyone who comes into possession of a copy. This 224 | License will therefore apply, along with any applicable section 7 225 | additional terms, to the whole of the work, and all its parts, 226 | regardless of how they are packaged. This License gives no 227 | permission to license the work in any other way, but it does not 228 | invalidate such permission if you have separately received it. 229 | 230 | d) If the work has interactive user interfaces, each must display 231 | Appropriate Legal Notices; however, if the Program has interactive 232 | interfaces that do not display Appropriate Legal Notices, your 233 | work need not make them do so. 234 | 235 | A compilation of a covered work with other separate and independent 236 | works, which are not by their nature extensions of the covered work, 237 | and which are not combined with it such as to form a larger program, 238 | in or on a volume of a storage or distribution medium, is called an 239 | "aggregate" if the compilation and its resulting copyright are not 240 | used to limit the access or legal rights of the compilation's users 241 | beyond what the individual works permit. Inclusion of a covered work 242 | in an aggregate does not cause this License to apply to the other 243 | parts of the aggregate. 244 | 245 | 6. Conveying Non-Source Forms. 246 | 247 | You may convey a covered work in object code form under the terms 248 | of sections 4 and 5, provided that you also convey the 249 | machine-readable Corresponding Source under the terms of this License, 250 | in one of these ways: 251 | 252 | a) Convey the object code in, or embodied in, a physical product 253 | (including a physical distribution medium), accompanied by the 254 | Corresponding Source fixed on a durable physical medium 255 | customarily used for software interchange. 256 | 257 | b) Convey the object code in, or embodied in, a physical product 258 | (including a physical distribution medium), accompanied by a 259 | written offer, valid for at least three years and valid for as 260 | long as you offer spare parts or customer support for that product 261 | model, to give anyone who possesses the object code either (1) a 262 | copy of the Corresponding Source for all the software in the 263 | product that is covered by this License, on a durable physical 264 | medium customarily used for software interchange, for a price no 265 | more than your reasonable cost of physically performing this 266 | conveying of source, or (2) access to copy the 267 | Corresponding Source from a network server at no charge. 268 | 269 | c) Convey individual copies of the object code with a copy of the 270 | written offer to provide the Corresponding Source. This 271 | alternative is allowed only occasionally and noncommercially, and 272 | only if you received the object code with such an offer, in accord 273 | with subsection 6b. 274 | 275 | d) Convey the object code by offering access from a designated 276 | place (gratis or for a charge), and offer equivalent access to the 277 | Corresponding Source in the same way through the same place at no 278 | further charge. You need not require recipients to copy the 279 | Corresponding Source along with the object code. If the place to 280 | copy the object code is a network server, the Corresponding Source 281 | may be on a different server (operated by you or a third party) 282 | that supports equivalent copying facilities, provided you maintain 283 | clear directions next to the object code saying where to find the 284 | Corresponding Source. Regardless of what server hosts the 285 | Corresponding Source, you remain obligated to ensure that it is 286 | available for as long as needed to satisfy these requirements. 287 | 288 | e) Convey the object code using peer-to-peer transmission, provided 289 | you inform other peers where the object code and Corresponding 290 | Source of the work are being offered to the general public at no 291 | charge under subsection 6d. 292 | 293 | A separable portion of the object code, whose source code is excluded 294 | from the Corresponding Source as a System Library, need not be 295 | included in conveying the object code work. 296 | 297 | A "User Product" is either (1) a "consumer product", which means any 298 | tangible personal property which is normally used for personal, family, 299 | or household purposes, or (2) anything designed or sold for incorporation 300 | into a dwelling. In determining whether a product is a consumer product, 301 | doubtful cases shall be resolved in favor of coverage. For a particular 302 | product received by a particular user, "normally used" refers to a 303 | typical or common use of that class of product, regardless of the status 304 | of the particular user or of the way in which the particular user 305 | actually uses, or expects or is expected to use, the product. A product 306 | is a consumer product regardless of whether the product has substantial 307 | commercial, industrial or non-consumer uses, unless such uses represent 308 | the only significant mode of use of the product. 309 | 310 | "Installation Information" for a User Product means any methods, 311 | procedures, authorization keys, or other information required to install 312 | and execute modified versions of a covered work in that User Product from 313 | a modified version of its Corresponding Source. The information must 314 | suffice to ensure that the continued functioning of the modified object 315 | code is in no case prevented or interfered with solely because 316 | modification has been made. 317 | 318 | If you convey an object code work under this section in, or with, or 319 | specifically for use in, a User Product, and the conveying occurs as 320 | part of a transaction in which the right of possession and use of the 321 | User Product is transferred to the recipient in perpetuity or for a 322 | fixed term (regardless of how the transaction is characterized), the 323 | Corresponding Source conveyed under this section must be accompanied 324 | by the Installation Information. But this requirement does not apply 325 | if neither you nor any third party retains the ability to install 326 | modified object code on the User Product (for example, the work has 327 | been installed in ROM). 328 | 329 | The requirement to provide Installation Information does not include a 330 | requirement to continue to provide support service, warranty, or updates 331 | for a work that has been modified or installed by the recipient, or for 332 | the User Product in which it has been modified or installed. Access to a 333 | network may be denied when the modification itself materially and 334 | adversely affects the operation of the network or violates the rules and 335 | protocols for communication across the network. 336 | 337 | Corresponding Source conveyed, and Installation Information provided, 338 | in accord with this section must be in a format that is publicly 339 | documented (and with an implementation available to the public in 340 | source code form), and must require no special password or key for 341 | unpacking, reading or copying. 342 | 343 | 7. Additional Terms. 344 | 345 | "Additional permissions" are terms that supplement the terms of this 346 | License by making exceptions from one or more of its conditions. 347 | Additional permissions that are applicable to the entire Program shall 348 | be treated as though they were included in this License, to the extent 349 | that they are valid under applicable law. If additional permissions 350 | apply only to part of the Program, that part may be used separately 351 | under those permissions, but the entire Program remains governed by 352 | this License without regard to the additional permissions. 353 | 354 | When you convey a copy of a covered work, you may at your option 355 | remove any additional permissions from that copy, or from any part of 356 | it. (Additional permissions may be written to require their own 357 | removal in certain cases when you modify the work.) You may place 358 | additional permissions on material, added by you to a covered work, 359 | for which you have or can give appropriate copyright permission. 360 | 361 | Notwithstanding any other provision of this License, for material you 362 | add to a covered work, you may (if authorized by the copyright holders of 363 | that material) supplement the terms of this License with terms: 364 | 365 | a) Disclaiming warranty or limiting liability differently from the 366 | terms of sections 15 and 16 of this License; or 367 | 368 | b) Requiring preservation of specified reasonable legal notices or 369 | author attributions in that material or in the Appropriate Legal 370 | Notices displayed by works containing it; or 371 | 372 | c) Prohibiting misrepresentation of the origin of that material, or 373 | requiring that modified versions of such material be marked in 374 | reasonable ways as different from the original version; or 375 | 376 | d) Limiting the use for publicity purposes of names of licensors or 377 | authors of the material; or 378 | 379 | e) Declining to grant rights under trademark law for use of some 380 | trade names, trademarks, or service marks; or 381 | 382 | f) Requiring indemnification of licensors and authors of that 383 | material by anyone who conveys the material (or modified versions of 384 | it) with contractual assumptions of liability to the recipient, for 385 | any liability that these contractual assumptions directly impose on 386 | those licensors and authors. 387 | 388 | All other non-permissive additional terms are considered "further 389 | restrictions" within the meaning of section 10. If the Program as you 390 | received it, or any part of it, contains a notice stating that it is 391 | governed by this License along with a term that is a further 392 | restriction, you may remove that term. If a license document contains 393 | a further restriction but permits relicensing or conveying under this 394 | License, you may add to a covered work material governed by the terms 395 | of that license document, provided that the further restriction does 396 | not survive such relicensing or conveying. 397 | 398 | If you add terms to a covered work in accord with this section, you 399 | must place, in the relevant source files, a statement of the 400 | additional terms that apply to those files, or a notice indicating 401 | where to find the applicable terms. 402 | 403 | Additional terms, permissive or non-permissive, may be stated in the 404 | form of a separately written license, or stated as exceptions; 405 | the above requirements apply either way. 406 | 407 | 8. Termination. 408 | 409 | You may not propagate or modify a covered work except as expressly 410 | provided under this License. Any attempt otherwise to propagate or 411 | modify it is void, and will automatically terminate your rights under 412 | this License (including any patent licenses granted under the third 413 | paragraph of section 11). 414 | 415 | However, if you cease all violation of this License, then your 416 | license from a particular copyright holder is reinstated (a) 417 | provisionally, unless and until the copyright holder explicitly and 418 | finally terminates your license, and (b) permanently, if the copyright 419 | holder fails to notify you of the violation by some reasonable means 420 | prior to 60 days after the cessation. 421 | 422 | Moreover, your license from a particular copyright holder is 423 | reinstated permanently if the copyright holder notifies you of the 424 | violation by some reasonable means, this is the first time you have 425 | received notice of violation of this License (for any work) from that 426 | copyright holder, and you cure the violation prior to 30 days after 427 | your receipt of the notice. 428 | 429 | Termination of your rights under this section does not terminate the 430 | licenses of parties who have received copies or rights from you under 431 | this License. If your rights have been terminated and not permanently 432 | reinstated, you do not qualify to receive new licenses for the same 433 | material under section 10. 434 | 435 | 9. Acceptance Not Required for Having Copies. 436 | 437 | You are not required to accept this License in order to receive or 438 | run a copy of the Program. Ancillary propagation of a covered work 439 | occurring solely as a consequence of using peer-to-peer transmission 440 | to receive a copy likewise does not require acceptance. However, 441 | nothing other than this License grants you permission to propagate or 442 | modify any covered work. These actions infringe copyright if you do 443 | not accept this License. Therefore, by modifying or propagating a 444 | covered work, you indicate your acceptance of this License to do so. 445 | 446 | 10. Automatic Licensing of Downstream Recipients. 447 | 448 | Each time you convey a covered work, the recipient automatically 449 | receives a license from the original licensors, to run, modify and 450 | propagate that work, subject to this License. You are not responsible 451 | for enforcing compliance by third parties with this License. 452 | 453 | An "entity transaction" is a transaction transferring control of an 454 | organization, or substantially all assets of one, or subdividing an 455 | organization, or merging organizations. If propagation of a covered 456 | work results from an entity transaction, each party to that 457 | transaction who receives a copy of the work also receives whatever 458 | licenses to the work the party's predecessor in interest had or could 459 | give under the previous paragraph, plus a right to possession of the 460 | Corresponding Source of the work from the predecessor in interest, if 461 | the predecessor has it or can get it with reasonable efforts. 462 | 463 | You may not impose any further restrictions on the exercise of the 464 | rights granted or affirmed under this License. For example, you may 465 | not impose a license fee, royalty, or other charge for exercise of 466 | rights granted under this License, and you may not initiate litigation 467 | (including a cross-claim or counterclaim in a lawsuit) alleging that 468 | any patent claim is infringed by making, using, selling, offering for 469 | sale, or importing the Program or any portion of it. 470 | 471 | 11. Patents. 472 | 473 | A "contributor" is a copyright holder who authorizes use under this 474 | License of the Program or a work on which the Program is based. The 475 | work thus licensed is called the contributor's "contributor version". 476 | 477 | A contributor's "essential patent claims" are all patent claims 478 | owned or controlled by the contributor, whether already acquired or 479 | hereafter acquired, that would be infringed by some manner, permitted 480 | by this License, of making, using, or selling its contributor version, 481 | but do not include claims that would be infringed only as a 482 | consequence of further modification of the contributor version. For 483 | purposes of this definition, "control" includes the right to grant 484 | patent sublicenses in a manner consistent with the requirements of 485 | this License. 486 | 487 | Each contributor grants you a non-exclusive, worldwide, royalty-free 488 | patent license under the contributor's essential patent claims, to 489 | make, use, sell, offer for sale, import and otherwise run, modify and 490 | propagate the contents of its contributor version. 491 | 492 | In the following three paragraphs, a "patent license" is any express 493 | agreement or commitment, however denominated, not to enforce a patent 494 | (such as an express permission to practice a patent or covenant not to 495 | sue for patent infringement). To "grant" such a patent license to a 496 | party means to make such an agreement or commitment not to enforce a 497 | patent against the party. 498 | 499 | If you convey a covered work, knowingly relying on a patent license, 500 | and the Corresponding Source of the work is not available for anyone 501 | to copy, free of charge and under the terms of this License, through a 502 | publicly available network server or other readily accessible means, 503 | then you must either (1) cause the Corresponding Source to be so 504 | available, or (2) arrange to deprive yourself of the benefit of the 505 | patent license for this particular work, or (3) arrange, in a manner 506 | consistent with the requirements of this License, to extend the patent 507 | license to downstream recipients. "Knowingly relying" means you have 508 | actual knowledge that, but for the patent license, your conveying the 509 | covered work in a country, or your recipient's use of the covered work 510 | in a country, would infringe one or more identifiable patents in that 511 | country that you have reason to believe are valid. 512 | 513 | If, pursuant to or in connection with a single transaction or 514 | arrangement, you convey, or propagate by procuring conveyance of, a 515 | covered work, and grant a patent license to some of the parties 516 | receiving the covered work authorizing them to use, propagate, modify 517 | or convey a specific copy of the covered work, then the patent license 518 | you grant is automatically extended to all recipients of the covered 519 | work and works based on it. 520 | 521 | A patent license is "discriminatory" if it does not include within 522 | the scope of its coverage, prohibits the exercise of, or is 523 | conditioned on the non-exercise of one or more of the rights that are 524 | specifically granted under this License. You may not convey a covered 525 | work if you are a party to an arrangement with a third party that is 526 | in the business of distributing software, under which you make payment 527 | to the third party based on the extent of your activity of conveying 528 | the work, and under which the third party grants, to any of the 529 | parties who would receive the covered work from you, a discriminatory 530 | patent license (a) in connection with copies of the covered work 531 | conveyed by you (or copies made from those copies), or (b) primarily 532 | for and in connection with specific products or compilations that 533 | contain the covered work, unless you entered into that arrangement, 534 | or that patent license was granted, prior to 28 March 2007. 535 | 536 | Nothing in this License shall be construed as excluding or limiting 537 | any implied license or other defenses to infringement that may 538 | otherwise be available to you under applicable patent law. 539 | 540 | 12. No Surrender of Others' Freedom. 541 | 542 | If conditions are imposed on you (whether by court order, agreement or 543 | otherwise) that contradict the conditions of this License, they do not 544 | excuse you from the conditions of this License. If you cannot convey a 545 | covered work so as to satisfy simultaneously your obligations under this 546 | License and any other pertinent obligations, then as a consequence you may 547 | not convey it at all. For example, if you agree to terms that obligate you 548 | to collect a royalty for further conveying from those to whom you convey 549 | the Program, the only way you could satisfy both those terms and this 550 | License would be to refrain entirely from conveying the Program. 551 | 552 | 13. Use with the GNU Affero General Public License. 553 | 554 | Notwithstanding any other provision of this License, you have 555 | permission to link or combine any covered work with a work licensed 556 | under version 3 of the GNU Affero General Public License into a single 557 | combined work, and to convey the resulting work. The terms of this 558 | License will continue to apply to the part which is the covered work, 559 | but the special requirements of the GNU Affero General Public License, 560 | section 13, concerning interaction through a network will apply to the 561 | combination as such. 562 | 563 | 14. Revised Versions of this License. 564 | 565 | The Free Software Foundation may publish revised and/or new versions of 566 | the GNU General Public License from time to time. Such new versions will 567 | be similar in spirit to the present version, but may differ in detail to 568 | address new problems or concerns. 569 | 570 | Each version is given a distinguishing version number. If the 571 | Program specifies that a certain numbered version of the GNU General 572 | Public License "or any later version" applies to it, you have the 573 | option of following the terms and conditions either of that numbered 574 | version or of any later version published by the Free Software 575 | Foundation. If the Program does not specify a version number of the 576 | GNU General Public License, you may choose any version ever published 577 | by the Free Software Foundation. 578 | 579 | If the Program specifies that a proxy can decide which future 580 | versions of the GNU General Public License can be used, that proxy's 581 | public statement of acceptance of a version permanently authorizes you 582 | to choose that version for the Program. 583 | 584 | Later license versions may give you additional or different 585 | permissions. However, no additional obligations are imposed on any 586 | author or copyright holder as a result of your choosing to follow a 587 | later version. 588 | 589 | 15. Disclaimer of Warranty. 590 | 591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY 592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT 593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY 594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, 595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM 597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF 598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 599 | 600 | 16. Limitation of Liability. 601 | 602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS 604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY 605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE 606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF 607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD 608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), 609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF 610 | SUCH DAMAGES. 611 | 612 | 17. Interpretation of Sections 15 and 16. 613 | 614 | If the disclaimer of warranty and limitation of liability provided 615 | above cannot be given local legal effect according to their terms, 616 | reviewing courts shall apply local law that most closely approximates 617 | an absolute waiver of all civil liability in connection with the 618 | Program, unless a warranty or assumption of liability accompanies a 619 | copy of the Program in return for a fee. 620 | 621 | END OF TERMS AND CONDITIONS 622 | 623 | How to Apply These Terms to Your New Programs 624 | 625 | If you develop a new program, and you want it to be of the greatest 626 | possible use to the public, the best way to achieve this is to make it 627 | free software which everyone can redistribute and change under these terms. 628 | 629 | To do so, attach the following notices to the program. It is safest 630 | to attach them to the start of each source file to most effectively 631 | state the exclusion of warranty; and each file should have at least 632 | the "copyright" line and a pointer to where the full notice is found. 633 | 634 | 635 | Copyright (C) 636 | 637 | This program is free software: you can redistribute it and/or modify 638 | it under the terms of the GNU General Public License as published by 639 | the Free Software Foundation, either version 3 of the License, or 640 | (at your option) any later version. 641 | 642 | This program is distributed in the hope that it will be useful, 643 | but WITHOUT ANY WARRANTY; without even the implied warranty of 644 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 645 | GNU General Public License for more details. 646 | 647 | You should have received a copy of the GNU General Public License 648 | along with this program. If not, see . 649 | 650 | Also add information on how to contact you by electronic and paper mail. 651 | 652 | If the program does terminal interaction, make it output a short 653 | notice like this when it starts in an interactive mode: 654 | 655 | Copyright (C) 656 | This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 657 | This is free software, and you are welcome to redistribute it 658 | under certain conditions; type `show c' for details. 659 | 660 | The hypothetical commands `show w' and `show c' should show the appropriate 661 | parts of the General Public License. Of course, your program's commands 662 | might be different; for a GUI interface, you would use an "about box". 663 | 664 | You should also get your employer (if you work as a programmer) or school, 665 | if any, to sign a "copyright disclaimer" for the program, if necessary. 666 | For more information on this, and how to apply and follow the GNU GPL, see 667 | . 668 | 669 | The GNU General Public License does not permit incorporating your program 670 | into proprietary programs. If your program is a subroutine library, you 671 | may consider it more useful to permit linking proprietary applications with 672 | the library. If this is what you want to do, use the GNU Lesser General 673 | Public License instead of this License. But first, please read 674 | . 675 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: mlmm 2 | Title: An efficient multi-locus mixed-model approach for genome-wide association 3 | studies in structured populations 4 | Version: 0.1.1 5 | Authors@R: c( 6 | person("Vincent", "Segura", email="vincent.segura@orleans.inra.fr", role=c("aut")), 7 | person("Bjarni J.", "Vilhjalmsson", email="bjvl@birc.au.dk", role=c("aut")), 8 | person("Uemit", "Seren", email="uemit.seren@gmail.com", role=c("cre")), 9 | person("Timothee", "Flutre", email="timothee.flutre@supagro.inra.fr", role=c("ctb")) 10 | ) 11 | Description: The mlmm R package contains functions to carry out GWAS with MLMM 12 | and plot the results from the analysis. Two versions are currently available: 13 | mlmm, the original MLMM as described in Segura, Vilhjálmsson et al (Nat Gen 14 | 2012), and mlmm_cof, a modified version of MLMM that allows including a fixed 15 | covariate in the association model, for example a matrix of principal components 16 | scores (MLMM version of the "PK" model) or any feature that would make sense to 17 | regress out (e.g. sex). 18 | Depends: 19 | R (>= 3.2.2), 20 | emma (>= 1.1.2) 21 | License: GPL-3 22 | Encoding: UTF-8 23 | LazyData: true 24 | URL: https://github.com/Gregor-Mendel-Institute/mlmm 25 | BugReports: https://github.com/Gregor-Mendel-Institute/mlmm/issues 26 | Suggests: 27 | knitr, 28 | rmarkdown 29 | VignetteBuilder: knitr 30 | RoxygenNote: 6.0.1 31 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(mlmm) 4 | export(mlmm_cof) 5 | export(plot_GWAS) 6 | export(plot_fwd_GWAS) 7 | export(plot_fwd_region) 8 | export(plot_opt_GWAS) 9 | export(plot_opt_region) 10 | export(plot_region) 11 | export(plot_step_RSS) 12 | export(plot_step_RSS_cof) 13 | export(plot_step_table) 14 | export(qqplot_fwd_GWAS) 15 | export(qqplot_opt_GWAS) 16 | import(emma) 17 | -------------------------------------------------------------------------------- /R/data.R: -------------------------------------------------------------------------------- 1 | #' Genotypes, SNP info, kinship and phenotypes. 2 | #' 3 | #' A dataset used as example for the mlmm function. 4 | #' 5 | #' @format A list with 4 components: 6 | #' \describe{ 7 | #' \item{X}{matrix of imputed genotypes} 8 | #' \item{Y}{vector of phenotypes} 9 | #' \item{K}{kinship matrix} 10 | #' \item{snp_info}{SNP coordinates} 11 | #' } 12 | "example_data" 13 | -------------------------------------------------------------------------------- /R/misc.R: -------------------------------------------------------------------------------- 1 | ##' @import emma 2 | 3 | .onAttach <- function(libname, pkgname) { 4 | if(! requireNamespace("utils", quietly=TRUE)) 5 | stop("Pkg utils needed for this function to work. Please install it.", 6 | call.=FALSE) 7 | msg <- paste0("package '", pkgname, 8 | "' (version ", utils::packageVersion(pkgname), ")", 9 | " is loaded", 10 | "\ndev at https://github.com/Gregor-Mendel-Institute/mlmm") 11 | packageStartupMessage(msg) 12 | } 13 | -------------------------------------------------------------------------------- /R/mlmm.r: -------------------------------------------------------------------------------- 1 | ############################################################################################################################################## 2 | ###MLMM - Multi-Locus Mixed Model 3 | ###SET OF FUNCTIONS TO CARRY GWAS CORRECTING FOR POPULATION STRUCTURE WHILE INCLUDING COFACTORS THROUGH A STEPWISE-REGRESSION APPROACH 4 | ####### 5 | # 6 | ##note: require EMMA 7 | #library(emma) 8 | #source('emma.r') 9 | # 10 | ##REQUIRED DATA & FORMAT 11 | # 12 | #PHENOTYPE - Y: a vector of length m, with names(Y)=individual names 13 | #GENOTYPE - X: a n by m matrix, where n=number of individuals, m=number of SNPs, with rownames(X)=individual names, and colnames(X)=SNP names 14 | #KINSHIP - K: a n by n matrix, with rownames(K)=colnames(K)=individual names 15 | #each of these data being sorted in the same way, according to the individual name 16 | # 17 | ##FOR PLOTING THE GWAS RESULTS 18 | #SNP INFORMATION - snp_info: a data frame having at least 3 columns: 19 | # - 1 named 'SNP', with SNP names (same as colnames(X)), 20 | # - 1 named 'Chr', with the chromosome number to which belong each SNP 21 | # - 1 named 'Pos', with the position of the SNP onto the chromosome it belongs to. 22 | ####### 23 | # 24 | ##FUNCTIONS USE 25 | #save this file somewhere on your computer and source it! 26 | #source('path/mlmm.r') 27 | # 28 | ###FORWARD + BACKWARD ANALYSES 29 | #mygwas<-mlmm(Y,X,K,nbchunks,maxsteps) 30 | #X,Y,K as described above 31 | #nbchunks: an integer defining the number of chunks of X to run the analysis, allows to decrease the memory usage ==> minimum=2, increase it if you do not have enough memory 32 | #maxsteps: maximum number of steps desired in the forward approach. The forward approach breaks automatically once the pseudo-heritability is close to 0, 33 | # however to avoid doing too many steps in case the pseudo-heritability does not reach a value close to 0, this parameter is also used. 34 | # It's value must be specified as an integer >= 3 35 | # 36 | ###RESULTS 37 | # 38 | ##STEPWISE TABLE 39 | #mygwas$step_table 40 | # 41 | ##PLOTS 42 | # 43 | ##PLOTS FORM THE FORWARD TABLE 44 | #plot_step_table(mygwas,type=c('h2','maxpval','BIC','extBIC')) 45 | # 46 | ##RSS PLOT 47 | #plot_step_RSS(mygwas) 48 | # 49 | ##GWAS MANHATTAN PLOTS 50 | # 51 | #FORWARD STEPS 52 | #plot_fwd_GWAS(mygwas,step,snp_info,pval_filt) 53 | #step=the step to be plotted in the forward approach, where 1 is the EMMAX scan (no cofactor) 54 | #snp_info as described above 55 | #pval_filt=a p-value threshold for filtering the output, only p-vals below this threshold will be displayed in the plot 56 | # 57 | #OPTIMAL MODELS 58 | #Automatic identification of the optimal models within the forwrad-backward models according to the extendedBIC or multiple-bonferonni criteria 59 | # 60 | #plot_opt_GWAS(mygwas,opt=c('extBIC','mbonf'),snp_info,pval_filt) 61 | #snp_info as described above 62 | #pval_filt=a p-value threshold for filtering the output, only p-vals below this threshold will be displayed in the plot 63 | # 64 | ##GWAS MANHATTAN PLOT ZOOMED IN A REGION OF INTEREST 65 | #plot_fwd_region(mygwas,step,snp_info,pval_filt,chrom,pos1,pos2) 66 | #step=the step to be plotted in the forward approach, where 1 is the EMMAX scan (no cofactor) 67 | #snp_info as described above 68 | #pval_filt=a p-value threshold for filtering the output, only p-vals below this threshold will be displayed in the plot 69 | #chrom is an integer specifying the chromosome on which the region of interest is 70 | #pos1, pos2 are integers delimiting the region of interest in the same unit as Pos in snp_info 71 | # 72 | #plot_opt_region(mygwas,opt=c('extBIC','mbonf'),snp_info,pval_filt,chrom,pos1,pos2) 73 | #snp_info as described above 74 | #pval_filt=a p-value threshold for filtering the output, only p-vals below this threshold will be displayed in the plot 75 | #chrom is an integer specifying the chromosome on which the region of interest is 76 | #pos1, pos2 are integers delimiting the region of interest in the same unit as Pos in snp_info 77 | # 78 | ##QQPLOTS of pvalues 79 | #qqplot_fwd_GWAS(mygwas,nsteps) 80 | #nsteps=maximum number of forward steps to be displayed 81 | # 82 | #qqplot_opt_GWAS(mygwas,opt=c('extBIC','mbonf')) 83 | # 84 | ############################################################################################################################################## 85 | 86 | ##' MLMM 87 | ##' 88 | ##' MLMM 89 | ##' @param Y phenotypes, a vector of length m, with names(Y)=individual names 90 | ##' @param X genotypes, a n by m matrix, where n=number of individuals, m=number of SNPs, with rownames(X)=individual names, and colnames(X)=SNP names 91 | ##' @param K kinship, a n by n matrix, with rownames(K)=colnames(K)=individual names 92 | ##' @param nbchunks an integer defining the number of chunks of X to run the analysis, allows to decrease the memory usage ==> minimum=2, increase it if you do not have enough memory 93 | ##' @param maxsteps maximum number of steps desired in the forward approach. The forward approach breaks automatically once the pseudo-heritability is close to 0, however to avoid doing too many steps in case the pseudo-heritability does not reach a value close to 0, this parameter is also used. It's value must be specified as an integer >= 3 94 | ##' @param thresh threshold 95 | ##' @return results 96 | ##' @author V. Segura & B. J. Vilhjalmsson 97 | ##' @export 98 | mlmm <- function(Y,X,K,nbchunks,maxsteps,thresh = NULL) { 99 | 100 | n<-length(Y) 101 | m<-ncol(X) 102 | 103 | stopifnot(ncol(K) == n) 104 | stopifnot(nrow(K) == n) 105 | stopifnot(nrow(X) == n) 106 | stopifnot(nbchunks >= 2) 107 | stopifnot(maxsteps >= 3) 108 | 109 | ##INTERCEPT 110 | 111 | Xo<-rep(1,n) 112 | 113 | ##K MATRIX NORMALISATION 114 | 115 | K_norm<-(n-1)/sum((diag(n)-matrix(1,n,n)/n)*K)*K 116 | rm(K) 117 | 118 | ##step 0 : NULL MODEL 119 | cof_fwd<-list() 120 | cof_fwd[[1]]<-as.matrix(Xo) 121 | colnames(cof_fwd[[1]])<-'Xo' 122 | 123 | mod_fwd<-list() 124 | mod_fwd[[1]]<-emma::emma.REMLE(Y,cof_fwd[[1]],K_norm) 125 | 126 | herit_fwd<-list() 127 | herit_fwd[[1]]<-mod_fwd[[1]]$vg/(mod_fwd[[1]]$vg+mod_fwd[[1]]$ve) 128 | 129 | RSSf<-list() 130 | RSSf[[1]]<-'NA' 131 | 132 | RSS_H0<-list() 133 | RSS_H0[[1]]<-'NA' 134 | 135 | df1<-1 136 | df2<-list() 137 | df2[[1]]<-'NA' 138 | 139 | Ftest<-list() 140 | Ftest[[1]]<-'NA' 141 | 142 | pval<-list() 143 | pval[[1]]<-'NA' 144 | 145 | fwd_lm<-list() 146 | 147 | cat('null model done! pseudo-h=',round(herit_fwd[[1]],3),'\n') 148 | 149 | ##step 1 : EMMAX 150 | 151 | M<-solve(chol(mod_fwd[[1]]$vg*K_norm+mod_fwd[[1]]$ve*diag(n))) 152 | Y_t<-crossprod(M,Y) 153 | cof_fwd_t<-crossprod(M,cof_fwd[[1]]) 154 | fwd_lm[[1]]<-summary(stats::lm(Y_t~0+cof_fwd_t)) 155 | Res_H0<-fwd_lm[[1]]$residuals 156 | Q_<-qr.Q(qr(cof_fwd_t)) 157 | 158 | RSS<-list() 159 | for (j in 1:(nbchunks-1)) { 160 | X_t<-crossprod(M %*% (diag(n)-tcrossprod(Q_,Q_)),(X[,!colnames(X) %in% colnames(cof_fwd[[1]])])[,((j-1)*round(m/nbchunks)+1):(j*round(m/nbchunks))]) 161 | RSS[[j]]<-apply(X_t,2,function(x){sum(stats::lsfit(x,Res_H0,intercept = FALSE)$residuals^2)}) 162 | rm(X_t)} 163 | X_t<-crossprod(M %*% (diag(n)-tcrossprod(Q_,Q_)),(X[,!colnames(X) %in% colnames(cof_fwd[[1]])])[,((j)*round(m/nbchunks)+1):(m-(ncol(cof_fwd[[1]])-1))]) 164 | RSS[[nbchunks]]<-apply(X_t,2,function(x){sum(stats::lsfit(x,Res_H0,intercept = FALSE)$residuals^2)}) 165 | rm(X_t,j) 166 | 167 | RSSf[[2]]<-unlist(RSS) 168 | RSS_H0[[2]]<-sum(Res_H0^2) 169 | df2[[2]]<-n-df1-ncol(cof_fwd[[1]]) 170 | Ftest[[2]]<-(rep(RSS_H0[[2]],length(RSSf[[2]]))/RSSf[[2]]-1)*df2[[2]]/df1 171 | pval[[2]]<-stats::pf(Ftest[[2]],df1,df2[[2]],lower.tail=FALSE) 172 | 173 | cof_fwd[[2]]<-cbind(cof_fwd[[1]],X[,colnames(X) %in% names(which(RSSf[[2]]==min(RSSf[[2]]))[1])]) 174 | colnames(cof_fwd[[2]])<-c(colnames(cof_fwd[[1]]),names(which(RSSf[[2]]==min(RSSf[[2]]))[1])) 175 | mod_fwd[[2]]<-emma::emma.REMLE(Y,cof_fwd[[2]],K_norm) 176 | herit_fwd[[2]]<-mod_fwd[[2]]$vg/(mod_fwd[[2]]$vg+mod_fwd[[2]]$ve) 177 | rm(M,Y_t,cof_fwd_t,Res_H0,Q_,RSS) 178 | 179 | cat('step 1 done! pseudo-h=',round(herit_fwd[[2]],3),'\n') 180 | 181 | ##FORWARD 182 | 183 | for (i in 3:(maxsteps)) { 184 | if (herit_fwd[[i-2]] < 0.01){ 185 | break 186 | } else { 187 | 188 | M<-solve(chol(mod_fwd[[i-1]]$vg*K_norm+mod_fwd[[i-1]]$ve*diag(n))) 189 | Y_t<-crossprod(M,Y) 190 | cof_fwd_t<-crossprod(M,cof_fwd[[i-1]]) 191 | fwd_lm[[i-1]]<-summary(stats::lm(Y_t~0+cof_fwd_t)) 192 | Res_H0<-fwd_lm[[i-1]]$residuals 193 | Q_ <- qr.Q(qr(cof_fwd_t)) 194 | 195 | RSS<-list() 196 | for (j in 1:(nbchunks-1)) { 197 | X_t<-crossprod(M %*% (diag(n)-tcrossprod(Q_,Q_)),(X[,!colnames(X) %in% colnames(cof_fwd[[i-1]])])[,((j-1)*round(m/nbchunks)+1):(j*round(m/nbchunks))]) 198 | RSS[[j]]<-apply(X_t,2,function(x){sum(stats::lsfit(x,Res_H0,intercept = FALSE)$residuals^2)}) 199 | rm(X_t)} 200 | X_t<-crossprod(M %*% (diag(n)-tcrossprod(Q_,Q_)),(X[,!colnames(X) %in% colnames(cof_fwd[[i-1]])])[,((j)*round(m/nbchunks)+1):(m-(ncol(cof_fwd[[i-1]])-1))]) 201 | RSS[[nbchunks]]<-apply(X_t,2,function(x){sum(stats::lsfit(x,Res_H0,intercept = FALSE)$residuals^2)}) 202 | rm(X_t,j) 203 | 204 | RSSf[[i]]<-unlist(RSS) 205 | RSS_H0[[i]]<-sum(Res_H0^2) 206 | df2[[i]]<-n-df1-ncol(cof_fwd[[i-1]]) 207 | Ftest[[i]]<-(rep(RSS_H0[[i]],length(RSSf[[i]]))/RSSf[[i]]-1)*df2[[i]]/df1 208 | pval[[i]]<-stats::pf(Ftest[[i]],df1,df2[[i]],lower.tail=FALSE) 209 | 210 | cof_fwd[[i]]<-cbind(cof_fwd[[i-1]],X[,colnames(X) %in% names(which(RSSf[[i]]==min(RSSf[[i]]))[1])]) 211 | colnames(cof_fwd[[i]])<-c(colnames(cof_fwd[[i-1]]),names(which(RSSf[[i]]==min(RSSf[[i]]))[1])) 212 | mod_fwd[[i]]<-emma::emma.REMLE(Y,cof_fwd[[i]],K_norm) 213 | herit_fwd[[i]]<-mod_fwd[[i]]$vg/(mod_fwd[[i]]$vg+mod_fwd[[i]]$ve) 214 | rm(M,Y_t,cof_fwd_t,Res_H0,Q_,RSS)} 215 | cat('step ',i-1,' done! pseudo-h=',round(herit_fwd[[i]],3),'\n')} 216 | rm(i) 217 | 218 | ##gls at last forward step 219 | M<-solve(chol(mod_fwd[[length(mod_fwd)]]$vg*K_norm+mod_fwd[[length(mod_fwd)]]$ve*diag(n))) 220 | Y_t<-crossprod(M,Y) 221 | cof_fwd_t<-crossprod(M,cof_fwd[[length(mod_fwd)]]) 222 | fwd_lm[[length(mod_fwd)]]<-summary(stats::lm(Y_t~0+cof_fwd_t)) 223 | 224 | Res_H0<-fwd_lm[[length(mod_fwd)]]$residuals 225 | Q_ <- qr.Q(qr(cof_fwd_t)) 226 | 227 | RSS<-list() 228 | for (j in 1:(nbchunks-1)) { 229 | X_t<-crossprod(M %*% (diag(n)-tcrossprod(Q_,Q_)),(X[,!colnames(X) %in% colnames(cof_fwd[[length(mod_fwd)]])])[,((j-1)*round(m/nbchunks)+1):(j*round(m/nbchunks))]) 230 | RSS[[j]]<-apply(X_t,2,function(x){sum(stats::lsfit(x,Res_H0,intercept = FALSE)$residuals^2)}) 231 | rm(X_t)} 232 | X_t<-crossprod(M %*% (diag(n)-tcrossprod(Q_,Q_)),(X[,!colnames(X) %in% colnames(cof_fwd[[length(mod_fwd)]])])[,((j)*round(m/nbchunks)+1):(m-(ncol(cof_fwd[[length(mod_fwd)]])-1))]) 233 | RSS[[nbchunks]]<-apply(X_t,2,function(x){sum(stats::lsfit(x,Res_H0,intercept = FALSE)$residuals^2)}) 234 | rm(X_t,j) 235 | 236 | RSSf[[length(mod_fwd)+1]]<-unlist(RSS) 237 | RSS_H0[[length(mod_fwd)+1]]<-sum(Res_H0^2) 238 | df2[[length(mod_fwd)+1]]<-n-df1-ncol(cof_fwd[[length(mod_fwd)]]) 239 | Ftest[[length(mod_fwd)+1]]<-(rep(RSS_H0[[length(mod_fwd)+1]],length(RSSf[[length(mod_fwd)+1]]))/RSSf[[length(mod_fwd)+1]]-1)*df2[[length(mod_fwd)+1]]/df1 240 | pval[[length(mod_fwd)+1]]<-stats::pf(Ftest[[length(mod_fwd)+1]],df1,df2[[length(mod_fwd)+1]],lower.tail=FALSE) 241 | rm(M,Y_t,cof_fwd_t,Res_H0,Q_,RSS) 242 | 243 | ##get max pval at each forward step 244 | max_pval_fwd<-vector(mode="numeric",length=length(fwd_lm)) 245 | max_pval_fwd[1]<-0 246 | for (i in 2:length(fwd_lm)) {max_pval_fwd[i]<-max(fwd_lm[[i]]$coef[2:i,4])} 247 | rm(i) 248 | 249 | ##get the number of parameters & Loglikelihood from ML at each step 250 | mod_fwd_LL<-list() 251 | mod_fwd_LL[[1]]<-list(nfixed=ncol(cof_fwd[[1]]),LL=emma::emma.MLE(Y,cof_fwd[[1]],K_norm)$ML) 252 | for (i in 2:length(cof_fwd)) {mod_fwd_LL[[i]]<-list(nfixed=ncol(cof_fwd[[i]]),LL=emma::emma.MLE(Y,cof_fwd[[i]],K_norm)$ML)} 253 | rm(i) 254 | 255 | cat('backward analysis','\n') 256 | 257 | ##BACKWARD (1st step == last fwd step) 258 | 259 | dropcof_bwd<-list() 260 | cof_bwd<-list() 261 | mod_bwd <- list() 262 | bwd_lm<-list() 263 | herit_bwd<-list() 264 | 265 | dropcof_bwd[[1]]<-'NA' 266 | cof_bwd[[1]]<-as.matrix(cof_fwd[[length(mod_fwd)]][,!colnames(cof_fwd[[length(mod_fwd)]]) %in% dropcof_bwd[[1]]]) 267 | colnames(cof_bwd[[1]])<-colnames(cof_fwd[[length(mod_fwd)]])[!colnames(cof_fwd[[length(mod_fwd)]]) %in% dropcof_bwd[[1]]] 268 | mod_bwd[[1]]<-emma::emma.REMLE(Y,cof_bwd[[1]],K_norm) 269 | herit_bwd[[1]]<-mod_bwd[[1]]$vg/(mod_bwd[[1]]$vg+mod_bwd[[1]]$ve) 270 | M<-solve(chol(mod_bwd[[1]]$vg*K_norm+mod_bwd[[1]]$ve*diag(n))) 271 | Y_t<-crossprod(M,Y) 272 | cof_bwd_t<-crossprod(M,cof_bwd[[1]]) 273 | bwd_lm[[1]]<-summary(stats::lm(Y_t~0+cof_bwd_t)) 274 | 275 | rm(M,Y_t,cof_bwd_t) 276 | 277 | for (i in 2:length(mod_fwd)) { 278 | dropcof_bwd[[i]]<-(colnames(cof_bwd[[i-1]])[2:ncol(cof_bwd[[i-1]])])[which(abs(bwd_lm[[i-1]]$coef[2:nrow(bwd_lm[[i-1]]$coef),3])==min(abs(bwd_lm[[i-1]]$coef[2:nrow(bwd_lm[[i-1]]$coef),3])))] 279 | cof_bwd[[i]]<-as.matrix(cof_bwd[[i-1]][,!colnames(cof_bwd[[i-1]]) %in% dropcof_bwd[[i]]]) 280 | colnames(cof_bwd[[i]])<-colnames(cof_bwd[[i-1]])[!colnames(cof_bwd[[i-1]]) %in% dropcof_bwd[[i]]] 281 | mod_bwd[[i]]<-emma::emma.REMLE(Y,cof_bwd[[i]],K_norm) 282 | herit_bwd[[i]]<-mod_bwd[[i]]$vg/(mod_bwd[[i]]$vg+mod_bwd[[i]]$ve) 283 | M<-solve(chol(mod_bwd[[i]]$vg*K_norm+mod_bwd[[i]]$ve*diag(n))) 284 | Y_t<-crossprod(M,Y) 285 | cof_bwd_t<-crossprod(M,cof_bwd[[i]]) 286 | bwd_lm[[i]]<-summary(stats::lm(Y_t~0+cof_bwd_t)) 287 | rm(M,Y_t,cof_bwd_t)} 288 | 289 | rm(i) 290 | 291 | ##get max pval at each backward step 292 | max_pval_bwd<-vector(mode="numeric",length=length(bwd_lm)) 293 | for (i in 1:(length(bwd_lm)-1)) {max_pval_bwd[i]<-max(bwd_lm[[i]]$coef[2:(length(bwd_lm)+1-i),4])} 294 | max_pval_bwd[length(bwd_lm)]<-0 295 | 296 | ##get the number of parameters & Loglikelihood from ML at each step 297 | mod_bwd_LL<-list() 298 | mod_bwd_LL[[1]]<-list(nfixed=ncol(cof_bwd[[1]]),LL=emma::emma.MLE(Y,cof_bwd[[1]],K_norm)$ML) 299 | for (i in 2:length(cof_bwd)) {mod_bwd_LL[[i]]<-list(nfixed=ncol(cof_bwd[[i]]),LL=emma::emma.MLE(Y,cof_bwd[[i]],K_norm)$ML)} 300 | rm(i) 301 | 302 | cat('creating output','\n') 303 | 304 | ##Forward Table: Fwd + Bwd Tables 305 | ##Compute parameters for model criteria 306 | BIC<-function(x){-2*x$LL+(x$nfixed+1)*log(n)} 307 | extBIC<-function(x){BIC(x)+2*lchoose(m,x$nfixed-1)} 308 | 309 | fwd_table<-data.frame(step=ncol(cof_fwd[[1]])-1,step_=paste('fwd',ncol(cof_fwd[[1]])-1,sep=''),cof='NA',ncof=ncol(cof_fwd[[1]])-1,h2=herit_fwd[[1]] 310 | ,maxpval=max_pval_fwd[1],BIC=BIC(mod_fwd_LL[[1]]),extBIC=extBIC(mod_fwd_LL[[1]])) 311 | for (i in 2:(length(mod_fwd))) {fwd_table<-rbind(fwd_table, 312 | data.frame(step=ncol(cof_fwd[[i]])-1,step_=paste('fwd',ncol(cof_fwd[[i]])-1,sep=''),cof=paste('+',colnames(cof_fwd[[i]])[i],sep=''),ncof=ncol(cof_fwd[[i]])-1,h2=herit_fwd[[i]] 313 | ,maxpval=max_pval_fwd[i],BIC=BIC(mod_fwd_LL[[i]]),extBIC=extBIC(mod_fwd_LL[[i]])))} 314 | 315 | rm(i) 316 | 317 | bwd_table<-data.frame(step=length(mod_fwd),step_=paste('bwd',0,sep=''),cof=paste('-',dropcof_bwd[[1]],sep=''),ncof=ncol(cof_bwd[[1]])-1,h2=herit_bwd[[1]] 318 | ,maxpval=max_pval_bwd[1],BIC=BIC(mod_bwd_LL[[1]]),extBIC=extBIC(mod_bwd_LL[[1]])) 319 | for (i in 2:(length(mod_bwd))) {bwd_table<-rbind(bwd_table, 320 | data.frame(step=length(mod_fwd)+i-1,step_=paste('bwd',i-1,sep=''),cof=paste('-',dropcof_bwd[[i]],sep=''),ncof=ncol(cof_bwd[[i]])-1,h2=herit_bwd[[i]] 321 | ,maxpval=max_pval_bwd[i],BIC=BIC(mod_bwd_LL[[i]]),extBIC=extBIC(mod_bwd_LL[[i]])))} 322 | 323 | rm(i,BIC,extBIC,max_pval_fwd,max_pval_bwd,dropcof_bwd) 324 | 325 | fwdbwd_table<-rbind(fwd_table,bwd_table) 326 | 327 | ##RSS for plot 328 | mod_fwd_RSS<-vector() 329 | mod_fwd_RSS[1]<-sum((Y-cof_fwd[[1]]%*%fwd_lm[[1]]$coef[,1])^2) 330 | for (i in 2:length(mod_fwd)) {mod_fwd_RSS[i]<-sum((Y-cof_fwd[[i]]%*%fwd_lm[[i]]$coef[,1])^2)} 331 | mod_bwd_RSS<-vector() 332 | mod_bwd_RSS[1]<-sum((Y-cof_bwd[[1]]%*%bwd_lm[[1]]$coef[,1])^2) 333 | for (i in 2:length(mod_bwd)) {mod_bwd_RSS[i]<-sum((Y-cof_bwd[[i]]%*%bwd_lm[[i]]$coef[,1])^2)} 334 | expl_RSS<-c(1-sapply(mod_fwd_RSS,function(x){x/mod_fwd_RSS[1]}),1-sapply(mod_bwd_RSS,function(x){x/mod_bwd_RSS[length(mod_bwd_RSS)]})) 335 | h2_RSS<-c(unlist(herit_fwd),unlist(herit_bwd))*(1-expl_RSS) 336 | unexpl_RSS<-1-expl_RSS-h2_RSS 337 | plot_RSS<-t(apply(cbind(expl_RSS,h2_RSS,unexpl_RSS),1,cumsum)) 338 | 339 | ##GLS pvals at each step 340 | pval_step<-list() 341 | pval_step[[1]]<-list(out=data.frame("SNP"=colnames(X),"pval"=pval[[2]]),"cof"=NA, "coef"=fwd_lm[[1]]$coef) 342 | for (i in 2:(length(mod_fwd))) {pval_step[[i]]<-list(out=rbind(data.frame(SNP=colnames(cof_fwd[[i]])[-1],'pval'=fwd_lm[[i]]$coef[2:i,4]), 343 | data.frame(SNP=colnames(X)[-which(colnames(X) %in% colnames(cof_fwd[[i]]))],'pval'=pval[[i+1]])),"cof"=colnames(cof_fwd[[i]])[-1], "coef"=fwd_lm[[i]]$coef)} 344 | 345 | ##GLS pvals for best models according to extBIC and mbonf 346 | 347 | opt_extBIC<-fwdbwd_table[which(fwdbwd_table$extBIC==min(fwdbwd_table$extBIC))[1],] 348 | opt_mbonf<-(fwdbwd_table[which(fwdbwd_table$maxpval<=0.05/m),])[which(fwdbwd_table[which(fwdbwd_table$maxpval<=0.05/m),]$ncof==max(fwdbwd_table[which(fwdbwd_table$maxpval<=0.05/m),]$ncof))[1],] 349 | if(! is.null(thresh)){ 350 | opt_thresh<-(fwdbwd_table[which(fwdbwd_table$maxpval<=thresh),])[which(fwdbwd_table[which(fwdbwd_table$maxpval<=thresh),]$ncof==max(fwdbwd_table[which(fwdbwd_table$maxpval<=thresh),]$ncof))[1],] 351 | } 352 | bestmodel_pvals<-function(model) { 353 | if(substr(model$step_,start=0,stop=3)=='fwd') { 354 | pval_step[[as.integer(substring(model$step_,first=4))+1]] 355 | } else if (substr(model$step_,start=0,stop=3)=='bwd') { 356 | cof<-cof_bwd[[as.integer(substring(model$step_,first=4))+1]] 357 | mixedmod<-emma::emma.REMLE(Y,cof,K_norm) 358 | M<-solve(chol(mixedmod$vg*K_norm+mixedmod$ve*diag(n))) 359 | Y_t<-crossprod(M,Y) 360 | cof_t<-crossprod(M,cof) 361 | GLS_lm<-summary(stats::lm(Y_t~0+cof_t)) 362 | Res_H0<-GLS_lm$residuals 363 | Q_ <- qr.Q(qr(cof_t)) 364 | RSS<-list() 365 | for (j in 1:(nbchunks-1)) { 366 | X_t<-crossprod(M %*% (diag(n)-tcrossprod(Q_,Q_)),(X[,!colnames(X) %in% colnames(cof)])[,((j-1)*round(m/nbchunks)+1):(j*round(m/nbchunks))]) 367 | RSS[[j]]<-apply(X_t,2,function(x){sum(stats::lsfit(x,Res_H0,intercept = FALSE)$residuals^2)}) 368 | rm(X_t)} 369 | X_t<-crossprod(M %*% (diag(n)-tcrossprod(Q_,Q_)),(X[,!colnames(X) %in% colnames(cof)])[,((j)*round(m/nbchunks)+1):(m-(ncol(cof)-1))]) 370 | RSS[[nbchunks]]<-apply(X_t,2,function(x){sum(stats::lsfit(x,Res_H0,intercept = FALSE)$residuals^2)}) 371 | rm(X_t,j) 372 | RSSf<-unlist(RSS) 373 | RSS_H0<-sum(Res_H0^2) 374 | df2<-n-df1-ncol(cof) 375 | Ftest<-(rep(RSS_H0,length(RSSf))/RSSf-1)*df2/df1 376 | pval<-stats::pf(Ftest,df1,df2,lower.tail=FALSE) 377 | list('out'=rbind(data.frame(SNP=colnames(cof)[-1],'pval'=GLS_lm$coef[2:(ncol(cof)),4]), 378 | data.frame('SNP'=colnames(X)[-which(colnames(X) %in% colnames(cof))],'pval'=pval)), 379 | 'cof'=colnames(cof)[-1], 380 | 'coef'=GLS_lm$coef)} else {cat('error \n')}} 381 | opt_extBIC_out<-bestmodel_pvals(opt_extBIC) 382 | opt_mbonf_out<-bestmodel_pvals(opt_mbonf) 383 | if(! is.null(thresh)){ 384 | opt_thresh_out<-bestmodel_pvals(opt_thresh) 385 | } 386 | output <- list(step_table=fwdbwd_table,pval_step=pval_step,RSSout=plot_RSS,bonf_thresh=-log10(0.05/m),opt_extBIC=opt_extBIC_out,opt_mbonf=opt_mbonf_out) 387 | if(! is.null(thresh)){ 388 | output$thresh <- -log10(thresh) 389 | output$opt_thresh <- opt_thresh_out 390 | } 391 | return(output) 392 | } 393 | -------------------------------------------------------------------------------- /R/mlmm_cof.r: -------------------------------------------------------------------------------- 1 | ############################################################################################################################################## 2 | ###MLMM_COF - Multi-Locus Mixed Model 3 | ###SET OF FUNCTIONS TO CARRY GWAS CORRECTING FOR POPULATION STRUCTURE WHILE INCLUDING COFACTORS THROUGH A STEPWISE-REGRESSION APPROACH 4 | ####### 5 | # 6 | ##note: require EMMA 7 | #library(emma) 8 | #source('emma.r') 9 | # 10 | ##REQUIRED DATA & FORMAT 11 | # 12 | #PHENOTYPE - Y: a vector of length m, with names(Y)=individual names 13 | #GENOTYPE - X: a n by m matrix, where n=number of individuals, m=number of SNPs, with rownames(X)=individual names, and colnames(X)=SNP names 14 | #KINSHIP - K: a n by n matrix, with rownames(K)=colnames(K)=individual names 15 | #COVARIANCE MATRIX - cofs: a n by p matrix, where n=number of individuals, p=number of covariates in the matrix (e.g. PC axes) 16 | #each of these data being sorted in the same way, according to the individual name 17 | # 18 | ##FOR PLOTING THE GWAS RESULTS 19 | #SNP INFORMATION - snp_info: a data frame having at least 3 columns: 20 | # - 1 named 'SNP', with SNP names (same as colnames(X)), 21 | # - 1 named 'Chr', with the chromosome number to which belong each SNP 22 | # - 1 named 'Pos', with the position of the SNP onto the chromosome it belongs to. 23 | ####### 24 | # 25 | ##FUNCTIONS USE 26 | #save this file somewhere on your computer and source it! 27 | #source('path/mlmm.r') 28 | # 29 | ###FORWARD + BACKWARD ANALYSES 30 | #mygwas<-mlmm_cof(Y,X,K,nbchunks,maxsteps) 31 | #X,Y,K as described above 32 | #nbchunks: an integer defining the number of chunks of X to run the analysis, allows to decrease the memory usage ==> minimum=2, increase it if you do not have enough memory 33 | #maxsteps: maximum number of steps desired in the forward approach. The forward approach breaks automatically once the pseudo-heritability is close to 0, 34 | # however to avoid doing too many steps in case the pseudo-heritability does not reach a value close to 0, this parameter is also used. 35 | # It's value must be specified as an integer >= 3 36 | # 37 | ###RESULTS 38 | # 39 | ##STEPWISE TABLE 40 | #mygwas$step_table 41 | # 42 | ##PLOTS 43 | # 44 | ##PLOTS FORM THE FORWARD TABLE 45 | #plot_step_table(mygwas,type=c('h2','maxpval','BIC','extBIC')) 46 | # 47 | ##RSS PLOT 48 | #plot_step_RSS(mygwas) 49 | # 50 | ##GWAS MANHATTAN PLOTS 51 | # 52 | #FORWARD STEPS 53 | #plot_fwd_GWAS(mygwas,step,snp_info,pval_filt) 54 | #step=the step to be plotted in the forward approach, where 1 is the EMMAX scan (no cofactor) 55 | #snp_info as described above 56 | #pval_filt=a p-value threshold for filtering the output, only p-vals below this threshold will be displayed in the plot 57 | # 58 | #OPTIMAL MODELS 59 | #Automatic identification of the optimal models within the forwrad-backward models according to the extendedBIC or multiple-bonferonni criteria 60 | # 61 | #plot_opt_GWAS(mygwas,opt=c('extBIC','mbonf'),snp_info,pval_filt) 62 | #snp_info as described above 63 | #pval_filt=a p-value threshold for filtering the output, only p-vals below this threshold will be displayed in the plot 64 | # 65 | ##GWAS MANHATTAN PLOT ZOOMED IN A REGION OF INTEREST 66 | #plot_fwd_region(mygwas,step,snp_info,pval_filt,chrom,pos1,pos2) 67 | #step=the step to be plotted in the forward approach, where 1 is the EMMAX scan (no cofactor) 68 | #snp_info as described above 69 | #pval_filt=a p-value threshold for filtering the output, only p-vals below this threshold will be displayed in the plot 70 | #chrom is an integer specifying the chromosome on which the region of interest is 71 | #pos1, pos2 are integers delimiting the region of interest in the same unit as Pos in snp_info 72 | # 73 | #plot_opt_region(mygwas,opt=c('extBIC','mbonf'),snp_info,pval_filt,chrom,pos1,pos2) 74 | #snp_info as described above 75 | #pval_filt=a p-value threshold for filtering the output, only p-vals below this threshold will be displayed in the plot 76 | #chrom is an integer specifying the chromosome on which the region of interest is 77 | #pos1, pos2 are integers delimiting the region of interest in the same unit as Pos in snp_info 78 | # 79 | ##QQPLOTS of pvalues 80 | #qqplot_fwd_GWAS(mygwas,nsteps) 81 | #nsteps=maximum number of forward steps to be displayed 82 | # 83 | #qqplot_opt_GWAS(mygwas,opt=c('extBIC','mbonf')) 84 | # 85 | ############################################################################################################################################## 86 | 87 | ##' MLMM_COF 88 | ##' 89 | ##' MLMM_COF 90 | ##' @param Y phenotypes, a vector of length m, with names(Y)=individual names 91 | ##' @param X genotypes, a n by m matrix, where n=number of individuals, m=number of SNPs, with rownames(X)=individual names, and colnames(X)=SNP names 92 | ##' @param cofs covariates, a n by p matrix, where n=number of individuals, p=number of covariates in the matrix (e.g. PC axes) 93 | ##' @param K kinship, a n by n matrix, with rownames(K)=colnames(K)=individual names 94 | ##' @param nbchunks an integer defining the number of chunks of X to run the analysis, allows to decrease the memory usage ==> minimum=2, increase it if you do not have enough memory 95 | ##' @param maxsteps maximum number of steps desired in the forward approach. The forward approach breaks automatically once the pseudo-heritability is close to 0, however to avoid doing too many steps in case the pseudo-heritability does not reach a value close to 0, this parameter is also used. It's value must be specified as an integer >= 3 96 | ##' @param thresh threshold 97 | ##' @return results 98 | ##' @author V. Segura & B. J. Vilhjalmsson 99 | ##' @export 100 | mlmm_cof<-function(Y,X,cofs,K,nbchunks,maxsteps,thresh = NULL) { 101 | 102 | n<-length(Y) 103 | m<-ncol(X) 104 | 105 | stopifnot(ncol(K) == n) 106 | stopifnot(nrow(K) == n) 107 | stopifnot(nrow(X) == n) 108 | stopifnot(nrow(cofs) == n) 109 | stopifnot(nbchunks >= 2) 110 | stopifnot(maxsteps >= 3) 111 | 112 | ##INTERCEPT 113 | 114 | Xo<-rep(1,n) 115 | 116 | ##K MATRIX NORMALISATION 117 | 118 | K_norm<-(n-1)/sum((diag(n)-matrix(1,n,n)/n)*K)*K 119 | rm(K) 120 | 121 | ##step 0 : NULL MODEL 122 | 123 | fix_cofs<-cbind(Xo,cofs) 124 | rm(cofs) 125 | 126 | addcof_fwd<-list() 127 | addcof_fwd[[1]]<-'NA' 128 | 129 | cof_fwd<-list() 130 | cof_fwd[[1]]<-as.matrix(X[,colnames(X) %in% addcof_fwd[[1]]]) 131 | 132 | mod_fwd<-list() 133 | mod_fwd[[1]]<-emma::emma.REMLE(Y,cbind(fix_cofs,cof_fwd[[1]]),K_norm) 134 | 135 | herit_fwd<-list() 136 | herit_fwd[[1]]<-mod_fwd[[1]]$vg/(mod_fwd[[1]]$vg+mod_fwd[[1]]$ve) 137 | 138 | RSSf<-list() 139 | RSSf[[1]]<-'NA' 140 | 141 | RSS_H0<-list() 142 | RSS_H0[[1]]<-'NA' 143 | 144 | df1<-1 145 | df2<-list() 146 | df2[[1]]<-'NA' 147 | 148 | Ftest<-list() 149 | Ftest[[1]]<-'NA' 150 | 151 | pval<-list() 152 | pval[[1]]<-'NA' 153 | 154 | fwd_lm<-list() 155 | 156 | cat('null model done! pseudo-h=',round(herit_fwd[[1]],3),'\n') 157 | 158 | ##step 1 : EMMAX 159 | 160 | M<-solve(chol(mod_fwd[[1]]$vg*K_norm+mod_fwd[[1]]$ve*diag(n))) 161 | Y_t<-crossprod(M,Y) 162 | cof_fwd_t<-crossprod(M,cbind(fix_cofs,cof_fwd[[1]])) 163 | fwd_lm[[1]]<-summary(stats::lm(Y_t~0+cof_fwd_t)) 164 | Res_H0<-fwd_lm[[1]]$residuals 165 | Q_<-qr.Q(qr(cof_fwd_t)) 166 | 167 | RSS<-list() 168 | for (j in 1:(nbchunks-1)) { 169 | X_t<-crossprod(M %*% (diag(n)-tcrossprod(Q_,Q_)),(X[,!colnames(X) %in% addcof_fwd[[1]]])[,((j-1)*round(m/nbchunks)+1):(j*round(m/nbchunks))]) 170 | RSS[[j]]<-apply(X_t,2,function(x){sum(stats::lsfit(x,Res_H0,intercept = FALSE)$residuals^2)}) 171 | rm(X_t)} 172 | X_t<-crossprod(M %*% (diag(n)-tcrossprod(Q_,Q_)),(X[,!colnames(X) %in% addcof_fwd[[1]]])[,((j)*round(m/nbchunks)+1):(m-(ncol(cof_fwd[[1]])))]) 173 | RSS[[nbchunks]]<-apply(X_t,2,function(x){sum(stats::lsfit(x,Res_H0,intercept = FALSE)$residuals^2)}) 174 | rm(X_t,j) 175 | 176 | RSSf[[2]]<-unlist(RSS) 177 | RSS_H0[[2]]<-sum(Res_H0^2) 178 | df2[[2]]<-n-df1-ncol(fix_cofs)-ncol(cof_fwd[[1]]) 179 | Ftest[[2]]<-(rep(RSS_H0[[2]],length(RSSf[[2]]))/RSSf[[2]]-1)*df2[[2]]/df1 180 | pval[[2]]<-stats::pf(Ftest[[2]],df1,df2[[2]],lower.tail=FALSE) 181 | addcof_fwd[[2]]<-names(which(RSSf[[2]]==min(RSSf[[2]]))[1]) 182 | cof_fwd[[2]]<-cbind(cof_fwd[[1]],X[,colnames(X) %in% addcof_fwd[[2]]]) 183 | colnames(cof_fwd[[2]])[ncol(cof_fwd[[2]])]<-addcof_fwd[[2]] 184 | mod_fwd[[2]]<-emma::emma.REMLE(Y,cbind(fix_cofs,cof_fwd[[2]]),K_norm) 185 | herit_fwd[[2]]<-mod_fwd[[2]]$vg/(mod_fwd[[2]]$vg+mod_fwd[[2]]$ve) 186 | rm(M,Y_t,cof_fwd_t,Res_H0,Q_,RSS) 187 | 188 | cat('step 1 done! pseudo-h=',round(herit_fwd[[2]],3),'\n') 189 | 190 | ##FORWARD 191 | 192 | for (i in 3:(maxsteps)) { 193 | if (herit_fwd[[i-2]] < 0.01){ 194 | break 195 | } else { 196 | 197 | M<-solve(chol(mod_fwd[[i-1]]$vg*K_norm+mod_fwd[[i-1]]$ve*diag(n))) 198 | Y_t<-crossprod(M,Y) 199 | cof_fwd_t<-crossprod(M,cbind(fix_cofs,cof_fwd[[i-1]])) 200 | fwd_lm[[i-1]]<-summary(stats::lm(Y_t~0+cof_fwd_t)) 201 | Res_H0<-fwd_lm[[i-1]]$residuals 202 | Q_ <- qr.Q(qr(cof_fwd_t)) 203 | 204 | RSS<-list() 205 | for (j in 1:(nbchunks-1)) { 206 | X_t<-crossprod(M %*% (diag(n)-tcrossprod(Q_,Q_)),(X[,!colnames(X) %in% colnames(cof_fwd[[i-1]])])[,((j-1)*round(m/nbchunks)+1):(j*round(m/nbchunks))]) 207 | RSS[[j]]<-apply(X_t,2,function(x){sum(stats::lsfit(x,Res_H0,intercept = FALSE)$residuals^2)}) 208 | rm(X_t)} 209 | X_t<-crossprod(M %*% (diag(n)-tcrossprod(Q_,Q_)),(X[,!colnames(X) %in% colnames(cof_fwd[[i-1]])])[,((j)*round(m/nbchunks)+1):(m-(ncol(cof_fwd[[i-1]])))]) 210 | RSS[[nbchunks]]<-apply(X_t,2,function(x){sum(stats::lsfit(x,Res_H0,intercept = FALSE)$residuals^2)}) 211 | rm(X_t,j) 212 | 213 | RSSf[[i]]<-unlist(RSS) 214 | RSS_H0[[i]]<-sum(Res_H0^2) 215 | df2[[i]]<-n-df1-ncol(fix_cofs)-ncol(cof_fwd[[i-1]]) 216 | Ftest[[i]]<-(rep(RSS_H0[[i]],length(RSSf[[i]]))/RSSf[[i]]-1)*df2[[i]]/df1 217 | pval[[i]]<-stats::pf(Ftest[[i]],df1,df2[[i]],lower.tail=FALSE) 218 | addcof_fwd[[i]]<-names(which(RSSf[[i]]==min(RSSf[[i]]))[1]) 219 | cof_fwd[[i]]<-cbind(cof_fwd[[i-1]],X[,colnames(X) %in% addcof_fwd[[i]]]) 220 | colnames(cof_fwd[[i]])[ncol(cof_fwd[[i]])]<-addcof_fwd[[i]] 221 | mod_fwd[[i]]<-emma::emma.REMLE(Y,cbind(fix_cofs,cof_fwd[[i]]),K_norm) 222 | herit_fwd[[i]]<-mod_fwd[[i]]$vg/(mod_fwd[[i]]$vg+mod_fwd[[i]]$ve) 223 | rm(M,Y_t,cof_fwd_t,Res_H0,Q_,RSS)} 224 | cat('step ',i-1,' done! pseudo-h=',round(herit_fwd[[i]],3),'\n')} 225 | rm(i) 226 | 227 | ##gls at last forward step 228 | M<-solve(chol(mod_fwd[[length(mod_fwd)]]$vg*K_norm+mod_fwd[[length(mod_fwd)]]$ve*diag(n))) 229 | Y_t<-crossprod(M,Y) 230 | cof_fwd_t<-crossprod(M,cbind(fix_cofs,cof_fwd[[length(mod_fwd)]])) 231 | fwd_lm[[length(mod_fwd)]]<-summary(stats::lm(Y_t~0+cof_fwd_t)) 232 | 233 | Res_H0<-fwd_lm[[length(mod_fwd)]]$residuals 234 | Q_ <- qr.Q(qr(cof_fwd_t)) 235 | 236 | RSS<-list() 237 | for (j in 1:(nbchunks-1)) { 238 | X_t<-crossprod(M %*% (diag(n)-tcrossprod(Q_,Q_)),(X[,!colnames(X) %in% colnames(cof_fwd[[length(mod_fwd)]])])[,((j-1)*round(m/nbchunks)+1):(j*round(m/nbchunks))]) 239 | RSS[[j]]<-apply(X_t,2,function(x){sum(stats::lsfit(x,Res_H0,intercept = FALSE)$residuals^2)}) 240 | rm(X_t)} 241 | X_t<-crossprod(M %*% (diag(n)-tcrossprod(Q_,Q_)),(X[,!colnames(X) %in% colnames(cof_fwd[[length(mod_fwd)]])])[,((j)*round(m/nbchunks)+1):(m-(ncol(cof_fwd[[length(mod_fwd)]])))]) 242 | RSS[[nbchunks]]<-apply(X_t,2,function(x){sum(stats::lsfit(x,Res_H0,intercept = FALSE)$residuals^2)}) 243 | rm(X_t,j) 244 | 245 | RSSf[[length(mod_fwd)+1]]<-unlist(RSS) 246 | RSS_H0[[length(mod_fwd)+1]]<-sum(Res_H0^2) 247 | df2[[length(mod_fwd)+1]]<-n-df1-ncol(fix_cofs)-ncol(cof_fwd[[length(mod_fwd)]]) 248 | Ftest[[length(mod_fwd)+1]]<-(rep(RSS_H0[[length(mod_fwd)+1]],length(RSSf[[length(mod_fwd)+1]]))/RSSf[[length(mod_fwd)+1]]-1)*df2[[length(mod_fwd)+1]]/df1 249 | pval[[length(mod_fwd)+1]]<-stats::pf(Ftest[[length(mod_fwd)+1]],df1,df2[[length(mod_fwd)+1]],lower.tail=FALSE) 250 | rm(M,Y_t,cof_fwd_t,Res_H0,Q_,RSS) 251 | 252 | ##get max pval at each forward step 253 | max_pval_fwd<-vector(mode="numeric",length=length(fwd_lm)) 254 | max_pval_fwd[1]<-0 255 | for (i in 2:length(fwd_lm)) {max_pval_fwd[i]<-max(fwd_lm[[i]]$coef[(ncol(fix_cofs)+1):(ncol(fix_cofs)+ncol(cof_fwd[[i]])),4])} 256 | rm(i) 257 | 258 | ##get the number of parameters & Loglikelihood from ML at each step 259 | mod_fwd_LL<-list() 260 | mod_fwd_LL[[1]]<-list(nfixed=ncol(cbind(fix_cofs,cof_fwd[[1]])),LL=emma::emma.MLE(Y,cbind(fix_cofs,cof_fwd[[1]]),K_norm)$ML) 261 | for (i in 2:length(cof_fwd)) {mod_fwd_LL[[i]]<-list(nfixed=ncol(cbind(fix_cofs,cof_fwd[[i]])),LL=emma::emma.MLE(Y,cbind(fix_cofs,cof_fwd[[i]]),K_norm)$ML)} 262 | rm(i) 263 | 264 | cat('backward analysis','\n') 265 | 266 | ##BACKWARD (1st step == last fwd step) 267 | 268 | dropcof_bwd<-list() 269 | cof_bwd<-list() 270 | mod_bwd <- list() 271 | bwd_lm<-list() 272 | herit_bwd<-list() 273 | 274 | dropcof_bwd[[1]]<-'NA' 275 | cof_bwd[[1]]<-as.matrix(cof_fwd[[length(mod_fwd)]][,!colnames(cof_fwd[[length(mod_fwd)]]) %in% dropcof_bwd[[1]]]) 276 | colnames(cof_bwd[[1]])<-colnames(cof_fwd[[length(mod_fwd)]])[!colnames(cof_fwd[[length(mod_fwd)]]) %in% dropcof_bwd[[1]]] 277 | mod_bwd[[1]]<-emma::emma.REMLE(Y,cbind(fix_cofs,cof_bwd[[1]]),K_norm) 278 | herit_bwd[[1]]<-mod_bwd[[1]]$vg/(mod_bwd[[1]]$vg+mod_bwd[[1]]$ve) 279 | M<-solve(chol(mod_bwd[[1]]$vg*K_norm+mod_bwd[[1]]$ve*diag(n))) 280 | Y_t<-crossprod(M,Y) 281 | cof_bwd_t<-crossprod(M,cbind(fix_cofs,cof_bwd[[1]])) 282 | bwd_lm[[1]]<-summary(stats::lm(Y_t~0+cof_bwd_t)) 283 | 284 | rm(M,Y_t,cof_bwd_t) 285 | 286 | 287 | for (i in 2:length(mod_fwd)) { 288 | dropcof_bwd[[i]]<-colnames(cof_bwd[[i-1]])[which(abs(bwd_lm[[i-1]]$coef[(ncol(fix_cofs)+1):nrow(bwd_lm[[i-1]]$coef),3])==min(abs(bwd_lm[[i-1]]$coef[(ncol(fix_cofs)+1):nrow(bwd_lm[[i-1]]$coef),3])))] 289 | cof_bwd[[i]]<-as.matrix(cof_bwd[[i-1]][,!colnames(cof_bwd[[i-1]]) %in% dropcof_bwd[[i]]]) 290 | colnames(cof_bwd[[i]])<-colnames(cof_bwd[[i-1]])[!colnames(cof_bwd[[i-1]]) %in% dropcof_bwd[[i]]] 291 | mod_bwd[[i]]<-emma::emma.REMLE(Y,cbind(fix_cofs,cof_bwd[[i]]),K_norm) 292 | herit_bwd[[i]]<-mod_bwd[[i]]$vg/(mod_bwd[[i]]$vg+mod_bwd[[i]]$ve) 293 | M<-solve(chol(mod_bwd[[i]]$vg*K_norm+mod_bwd[[i]]$ve*diag(n))) 294 | Y_t<-crossprod(M,Y) 295 | cof_bwd_t<-crossprod(M,cbind(fix_cofs,cof_bwd[[i]])) 296 | bwd_lm[[i]]<-summary(stats::lm(Y_t~0+cof_bwd_t)) 297 | rm(M,Y_t,cof_bwd_t)} 298 | 299 | rm(i) 300 | 301 | ##get max pval at each backward step 302 | max_pval_bwd<-vector(mode="numeric",length=length(bwd_lm)) 303 | for (i in 1:(length(bwd_lm)-1)) {max_pval_bwd[i]<-max(bwd_lm[[i]]$coef[(ncol(fix_cofs)+1):(ncol(fix_cofs)+ncol(cof_bwd[[i]])),4])} 304 | max_pval_bwd[length(bwd_lm)]<-0 305 | 306 | ##get the number of parameters & Loglikelihood from ML at each step 307 | mod_bwd_LL<-list() 308 | mod_bwd_LL[[1]]<-list(nfixed=ncol(cbind(fix_cofs,cof_bwd[[1]])),LL=emma::emma.MLE(Y,cbind(fix_cofs,cof_bwd[[1]]),K_norm)$ML) 309 | for (i in 2:length(cof_bwd)) {mod_bwd_LL[[i]]<-list(nfixed=ncol(cbind(fix_cofs,cof_bwd[[i]])),LL=emma::emma.MLE(Y,cbind(fix_cofs,cof_bwd[[i]]),K_norm)$ML)} 310 | rm(i) 311 | 312 | cat('creating output','\n') 313 | 314 | ##Forward Table: Fwd + Bwd Tables 315 | ##Compute parameters for model criteria 316 | BIC<-function(x){-2*x$LL+(x$nfixed+1)*log(n)} 317 | extBIC<-function(x){BIC(x)+2*lchoose(m,x$nfixed-1)} 318 | 319 | fwd_table<-data.frame(step=ncol(cof_fwd[[1]]),step_=paste('fwd',ncol(cof_fwd[[1]]),sep=''),cof=paste('+',addcof_fwd[[1]],sep=''),ncof=ncol(cof_fwd[[1]]),h2=herit_fwd[[1]] 320 | ,maxpval=max_pval_fwd[1],BIC=BIC(mod_fwd_LL[[1]]),extBIC=extBIC(mod_fwd_LL[[1]])) 321 | for (i in 2:(length(mod_fwd))) {fwd_table<-rbind(fwd_table, 322 | data.frame(step=ncol(cof_fwd[[i]]),step_=paste('fwd',ncol(cof_fwd[[i]]),sep=''),cof=paste('+',addcof_fwd[[i]],sep=''),ncof=ncol(cof_fwd[[i]]),h2=herit_fwd[[i]] 323 | ,maxpval=max_pval_fwd[i],BIC=BIC(mod_fwd_LL[[i]]),extBIC=extBIC(mod_fwd_LL[[i]])))} 324 | 325 | rm(i) 326 | 327 | bwd_table<-data.frame(step=length(mod_fwd),step_=paste('bwd',0,sep=''),cof=paste('-',dropcof_bwd[[1]],sep=''),ncof=ncol(cof_bwd[[1]]),h2=herit_bwd[[1]] 328 | ,maxpval=max_pval_bwd[1],BIC=BIC(mod_bwd_LL[[1]]),extBIC=extBIC(mod_bwd_LL[[1]])) 329 | for (i in 2:(length(mod_bwd))) {bwd_table<-rbind(bwd_table, 330 | data.frame(step=length(mod_fwd)+i-1,step_=paste('bwd',i-1,sep=''),cof=paste('-',dropcof_bwd[[i]],sep=''),ncof=ncol(cof_bwd[[i]]),h2=herit_bwd[[i]] 331 | ,maxpval=max_pval_bwd[i],BIC=BIC(mod_bwd_LL[[i]]),extBIC=extBIC(mod_bwd_LL[[i]])))} 332 | 333 | rm(i,BIC,extBIC,max_pval_fwd,max_pval_bwd,dropcof_bwd) 334 | 335 | fwdbwd_table<-rbind(fwd_table,bwd_table) 336 | 337 | ##RSS for plot 338 | 339 | ##null model only with intercept 340 | null<-emma::emma.REMLE(Y,as.matrix(Xo),K_norm) 341 | M<-solve(chol(null$vg*K_norm+null$ve*diag(n))) 342 | Y_t<-crossprod(M,Y) 343 | Xo_t<-crossprod(M,as.matrix(Xo)) 344 | null_lm<-summary(stats::lm(Y_t~0+Xo_t)) 345 | rm(null,M,Y_t,Xo_t) 346 | RSS_null<-sum((Y-as.matrix(Xo)%*%null_lm$coef[,1])^2) 347 | 348 | mod_fwd_RSS<-vector() 349 | mod_fwd_RSS[1]<-sum((Y-cbind(fix_cofs,cof_fwd[[1]])%*%fwd_lm[[1]]$coef[,1])^2) 350 | for (i in 2:length(mod_fwd)) {mod_fwd_RSS[i]<-sum((Y-cbind(fix_cofs,cof_fwd[[i]])%*%fwd_lm[[i]]$coef[,1])^2)} 351 | mod_bwd_RSS<-vector() 352 | mod_bwd_RSS[1]<-sum((Y-cbind(fix_cofs,cof_bwd[[1]])%*%bwd_lm[[1]]$coef[,1])^2) 353 | for (i in 2:length(mod_bwd)) {mod_bwd_RSS[i]<-sum((Y-cbind(fix_cofs,cof_bwd[[i]])%*%bwd_lm[[i]]$coef[,1])^2)} 354 | 355 | expl_RSS<-c(1-sapply(mod_fwd_RSS,function(x){x/RSS_null}),1-sapply(mod_bwd_RSS,function(x){x/RSS_null})) 356 | fix_cofs_RSS<-rep(expl_RSS[1],length(expl_RSS)) 357 | cofs_RSS<-expl_RSS-fix_cofs_RSS 358 | h2_RSS<-c(unlist(herit_fwd),unlist(herit_bwd))*(1-expl_RSS) 359 | unexpl_RSS<-1-expl_RSS-h2_RSS 360 | plot_RSS<-t(apply(cbind(fix_cofs_RSS,cofs_RSS,h2_RSS,unexpl_RSS),1,cumsum)) 361 | 362 | ##GLS pvals at each step 363 | pval_step<-list() 364 | pval_step[[1]]<-list(out=data.frame('SNP'=names(pval[[2]]),'pval'=pval[[2]]),cof=addcof_fwd[[1]], "coef"=fwd_lm[[1]]$coef) 365 | for (i in 2:(length(mod_fwd))) { 366 | pval_step[[i]]<-list('out'=rbind(data.frame('SNP'=colnames(cof_fwd[[i]]),'pval'=fwd_lm[[i]]$coef[(ncol(fix_cofs)+1):(ncol(fix_cofs)+ncol(cof_fwd[[i]])),4]), 367 | data.frame('SNP'=names(pval[[i+1]]),'pval'=pval[[i+1]])), 368 | 'cof'=colnames(cof_fwd[[i]]), 369 | 'coef'=fwd_lm[[i]]$coef) 370 | } 371 | 372 | ##GLS pvals for best models according to extBIC and mbonf 373 | 374 | opt_extBIC<-fwdbwd_table[which(fwdbwd_table$extBIC==min(fwdbwd_table$extBIC))[1],] 375 | opt_mbonf<-(fwdbwd_table[which(fwdbwd_table$maxpval<=0.05/m),])[which(fwdbwd_table[which(fwdbwd_table$maxpval<=0.05/m),]$ncof==max(fwdbwd_table[which(fwdbwd_table$maxpval<=0.05/m),]$ncof))[1],] 376 | if(! is.null(thresh)){ 377 | opt_thresh<-(fwdbwd_table[which(fwdbwd_table$maxpval<=thresh),])[which(fwdbwd_table[which(fwdbwd_table$maxpval<=thresh),]$ncof==max(fwdbwd_table[which(fwdbwd_table$maxpval<=thresh),]$ncof))[1],] 378 | } 379 | bestmodel_pvals<-function(model) { 380 | if(substr(model$step_,start=0,stop=3)=='fwd') { 381 | pval_step[[as.integer(substring(model$step_,first=4))+1]] 382 | } else if (substr(model$step_,start=0,stop=3)=='bwd') { 383 | cof<-cof_bwd[[as.integer(substring(model$step_,first=4))+1]] 384 | mixedmod<-emma::emma.REMLE(Y,cbind(fix_cofs,cof),K_norm) 385 | M<-solve(chol(mixedmod$vg*K_norm+mixedmod$ve*diag(n))) 386 | Y_t<-crossprod(M,Y) 387 | cof_t<-crossprod(M,cbind(fix_cofs,cof)) 388 | GLS_lm<-summary(stats::lm(Y_t~0+cof_t)) 389 | Res_H0<-GLS_lm$residuals 390 | Q_ <- qr.Q(qr(cof_t)) 391 | RSS<-list() 392 | for (j in 1:(nbchunks-1)) { 393 | X_t<-crossprod(M %*% (diag(n)-tcrossprod(Q_,Q_)),(X[,!colnames(X) %in% colnames(cof)])[,((j-1)*round(m/nbchunks)+1):(j*round(m/nbchunks))]) 394 | RSS[[j]]<-apply(X_t,2,function(x){sum(stats::lsfit(x,Res_H0,intercept = FALSE)$residuals^2)}) 395 | rm(X_t)} 396 | X_t<-crossprod(M %*% (diag(n)-tcrossprod(Q_,Q_)),(X[,!colnames(X) %in% colnames(cof)])[,((j)*round(m/nbchunks)+1):(m-ncol(cof))]) 397 | RSS[[nbchunks]]<-apply(X_t,2,function(x){sum(stats::lsfit(x,Res_H0,intercept = FALSE)$residuals^2)}) 398 | rm(X_t,j) 399 | RSSf<-unlist(RSS) 400 | RSS_H0<-sum(Res_H0^2) 401 | df2<-n-df1-ncol(fix_cofs)-ncol(cof) 402 | Ftest<-(rep(RSS_H0,length(RSSf))/RSSf-1)*df2/df1 403 | pval<-stats::pf(Ftest,df1,df2,lower.tail=FALSE) 404 | list('out'=rbind(data.frame(SNP=colnames(cof),'pval'=GLS_lm$coef[(ncol(fix_cofs)+1):(ncol(fix_cofs)+ncol(cof)),4]), 405 | data.frame('SNP'=names(pval),'pval'=pval)), 406 | 'cof'=colnames(cof), 407 | 'coef'=GLS_lm$coef)} else {cat('error \n')}} 408 | opt_extBIC_out<-bestmodel_pvals(opt_extBIC) 409 | opt_mbonf_out<-bestmodel_pvals(opt_mbonf) 410 | if(! is.null(thresh)){ 411 | opt_thresh_out<-bestmodel_pvals(opt_thresh) 412 | } 413 | output <- list(step_table=fwdbwd_table,pval_step=pval_step,RSSout=plot_RSS,bonf_thresh=-log10(0.05/m),opt_extBIC=opt_extBIC_out,opt_mbonf=opt_mbonf_out) 414 | if(! is.null(thresh)){ 415 | output$thresh <- -log10(thresh) 416 | output$opt_thresh <- opt_thresh_out 417 | } 418 | return(output) 419 | } 420 | -------------------------------------------------------------------------------- /R/plot_mlmm.r: -------------------------------------------------------------------------------- 1 | ##' Plot 2 | ##' 3 | ##' Plot 4 | ##' @param x x 5 | ##' @param type type 6 | ##' @param ... arguments to be passed to \code{\link[graphics]{plot}}, such as \code{main} 7 | ##' @author V. Segura & B. J. Vilhjalmsson 8 | ##' @export 9 | plot_step_table<-function(x,type,...){ 10 | if (type=='h2') {graphics::plot(x$step_table$step,x$step_table$h2,type='b',lty=2,pch=20,col='darkblue',xlab='step',ylab='h2',...) 11 | graphics::abline(v=(nrow(x$step_table)/2-0.5),lty=2)} 12 | else if (type=='maxpval'){graphics::plot(x$step_table$step,-log10(x$step_table$maxpval),type='b',lty=2,pch=20,col='darkblue',xlab='step',ylab='-log10(max_Pval)',...) 13 | graphics::abline(h=x$bonf_thresh,lty=2) 14 | if(! is.null(x$thresh)){graphics::abline(h=x$thresh,lty=2,col=2)} 15 | graphics::abline(v=(nrow(x$step_table)/2-0.5),lty=2)} 16 | else if (type=='BIC'){graphics::plot(x$step_table$step,x$step_table$BIC,type='b',lty=2,pch=20,col='darkblue',xlab='step',ylab='BIC',...) 17 | graphics::abline(v=(nrow(x$step_table)/2-0.5),lty=2)} 18 | else if (type=='extBIC'){graphics::plot(x$step_table$step,x$step_table$extBIC,type='b',lty=2,pch=20,col='darkblue',xlab='step',ylab='EBIC',...) 19 | graphics::abline(v=(nrow(x$step_table)/2-0.5),lty=2)} 20 | else {cat('error! \n argument type must be one of h2, maxpval, BIC, extBIC')}} 21 | 22 | ##' Plot 23 | ##' 24 | ##' Plot 25 | ##' @param x x 26 | ##' @param ... arguments to be passed to \code{\link[graphics]{plot}}, such as \code{main} 27 | ##' @author V. Segura & B. J. Vilhjalmsson 28 | ##' @export 29 | plot_step_RSS<-function(x,...){ 30 | op<-graphics::par(mar=c(5, 5, 2, 2)) 31 | graphics::plot(0,0,xlim=c(0,nrow(x$RSSout)-1),ylim=c(0,1),xlab='step',ylab='%var',col=0,...) 32 | graphics::polygon(c(0:(nrow(x$RSSout)-1),(nrow(x$RSSout)-1),0), c(x$RSSout[,3],0,0), col='brown1', border=0) 33 | graphics::polygon(c(0:(nrow(x$RSSout)-1),(nrow(x$RSSout)-1),0), c(x$RSSout[,2],0,0), col='forestgreen', border=0) 34 | graphics::polygon(c(0:(nrow(x$RSSout)-1),(nrow(x$RSSout)-1),0), c(x$RSSout[,1],0,0), col='dodgerblue4', border=0) 35 | graphics::abline(v=(nrow(x$step_table)/2-0.5),lty=2) 36 | graphics::par(op)} 37 | 38 | ##' Plot 39 | ##' 40 | ##' Plot 41 | ##' @param x x 42 | ##' @param ... arguments to be passed to \code{\link[graphics]{plot}}, such as \code{main} 43 | ##' @author V. Segura & B. J. Vilhjalmsson 44 | ##' @export 45 | plot_step_RSS_cof<-function(x,...){ 46 | op<-graphics::par(mar=c(5, 5, 2, 2)) 47 | graphics::plot(0,0,xlim=c(0,nrow(x$RSSout)-1),ylim=c(0,1),xlab='step',ylab='%var',col=0,...) 48 | graphics::polygon(c(0:(nrow(x$RSSout)-1),(nrow(x$RSSout)-1),0), c(x$RSSout[,4],0,0), col='brown1', border=0) 49 | graphics::polygon(c(0:(nrow(x$RSSout)-1),(nrow(x$RSSout)-1),0), c(x$RSSout[,3],0,0), col='forestgreen', border=0) 50 | graphics::polygon(c(0:(nrow(x$RSSout)-1),(nrow(x$RSSout)-1),0), c(x$RSSout[,2],0,0), col='dodgerblue4', border=0) 51 | graphics::polygon(c(0:(nrow(x$RSSout)-1),(nrow(x$RSSout)-1),0), c(x$RSSout[,1],0,0), col='grey', border=0) 52 | graphics::abline(v=(nrow(x$step_table)/2-0.5),lty=2) 53 | graphics::par(op)} 54 | 55 | ##' Plot 56 | ##' 57 | ##' Plot 58 | ##' @param x x 59 | ##' @param ... arguments to be passed to \code{\link[graphics]{plot}}, such as \code{main} 60 | ##' @author V. Segura & B. J. Vilhjalmsson 61 | ##' @export 62 | plot_GWAS<-function(x,...) { 63 | output_<-x$out[order(x$out$Pos),] 64 | output_ok<-output_[order(output_$Chr),] 65 | maxpos<-c(0,cumsum(as.numeric(stats::aggregate(output_ok$Pos,list(output_ok$Chr),max)$x+max(cumsum(as.numeric(stats::aggregate(output_ok$Pos,list(output_ok$Chr),max)$x)))/200))) 66 | plot_col<-rep(c('gray10','gray60'),ceiling(max(unique(output_ok$Chr))/2)) 67 | # plot_col<-c('blue','darkgreen','red','cyan','purple') 68 | size<-stats::aggregate(output_ok$Pos,list(output_ok$Chr),length)$x 69 | a<-rep(maxpos[1],size[1]) 70 | b<-rep(plot_col[1],size[1]) 71 | if (length(unique(output_ok$Chr))>1){ 72 | for (i in 2:length(unique(output_ok$Chr))){ 73 | a<-c(a,rep(maxpos[i],size[i])) 74 | b<-c(b,rep(plot_col[i],size[i]))}} 75 | output_ok$xpos<-output_ok$Pos+a 76 | output_ok$col<-b 77 | output_ok$col[output_ok$SNP %in% x$cof]<-'red' 78 | d<-(stats::aggregate(output_ok$xpos,list(output_ok$Chr),min)$x+stats::aggregate(output_ok$xpos,list(output_ok$Chr),max)$x)/2 79 | graphics::plot(output_ok$xpos,-log10(output_ok$pval),col=output_ok$col,pch=20,ylab=expression(-log[10](italic(p))),xaxt='n',xlab='chromosome',...) 80 | graphics::axis(1,tick=FALSE,at=d,labels=unique(output_ok$Chr)) 81 | graphics::abline(h=x$bonf_thresh,lty=3,col='black')} 82 | 83 | ##' Plot 84 | ##' 85 | ##' Plot 86 | ##' @param x x 87 | ##' @param chrom chrom 88 | ##' @param pos1 pos1 89 | ##' @param pos2 pos2 90 | ##' @author V. Segura & B. J. Vilhjalmsson 91 | ##' @export 92 | plot_region<-function(x,chrom,pos1,pos2){ 93 | Chr<-Pos<-NULL # to avoid R CMD check issuing a NOTE 94 | region<-subset(x$out,Chr==chrom & Pos>=pos1 & Pos <=pos2) 95 | region$col<- if (chrom %% 2 == 0) {'gray60'} else {'gray10'} 96 | region$col[which(region$SNP %in% x$cof)]<-'red' 97 | graphics::plot(region$Pos,-log10(region$pval),type='p',pch=20,main=paste('chromosome',chrom,sep=''),xlab='position (bp)',ylab=expression(-log[10](italic(p))),col=region$col,xlim=c(pos1,pos2)) 98 | graphics::abline(h=x$bonf_thresh,lty=3,col='black')} 99 | 100 | ##' Plot 101 | ##' 102 | ##' Plot 103 | ##' @param x x 104 | ##' @param step step 105 | ##' @param snp_info snp_info 106 | ##' @param pval_filt pval_filt 107 | ##' @param ... arguments to be passed to \code{\link[graphics]{plot}}, such as \code{main} 108 | ##' @author V. Segura & B. J. Vilhjalmsson 109 | ##' @export 110 | plot_fwd_GWAS<-function(x,step,snp_info,pval_filt,...) { 111 | stopifnot(step<=length(x$pval_step)) 112 | pval<-NULL # to avoid R CMD check issuing a NOTE 113 | output<-list(out=subset(merge(snp_info,x$pval_step[[step]]$out,by='SNP'),pval<=pval_filt),cof=x$pval_step[[step]]$cof,bonf_thresh=x$bonf_thresh) 114 | plot_GWAS(output,...)} 115 | 116 | ##' Plot 117 | ##' 118 | ##' Plot 119 | ##' @param x x 120 | ##' @param step step 121 | ##' @param snp_info snp_info 122 | ##' @param pval_filt pval_filt 123 | ##' @param chrom chrom 124 | ##' @param pos1 pos1 125 | ##' @param pos2 pos2 126 | ##' @author V. Segura & B. J. Vilhjalmsson 127 | ##' @export 128 | plot_fwd_region<-function(x,step,snp_info,pval_filt,chrom,pos1,pos2) { 129 | stopifnot(step<=length(x$pval_step)) 130 | pval<-NULL # to avoid R CMD check issuing a NOTE 131 | output<-list(out=subset(merge(snp_info,x$pval_step[[step]]$out,by='SNP'),pval<=pval_filt),cof=x$pval_step[[step]]$cof,bonf_thresh=x$bonf_thresh) 132 | plot_region(output,chrom,pos1,pos2)} 133 | 134 | ##' Plot 135 | ##' 136 | ##' Plot 137 | ##' @param x x 138 | ##' @param opt opt 139 | ##' @param snp_info snp_info 140 | ##' @param pval_filt pval_filt 141 | ##' @param ... arguments to be passed to \code{\link[graphics]{plot}}, such as \code{main} 142 | ##' @author V. Segura & B. J. Vilhjalmsson 143 | ##' @export 144 | plot_opt_GWAS<-function(x,opt,snp_info,pval_filt,...) { 145 | pval<-NULL # to avoid R CMD check issuing a NOTE 146 | if (opt=='extBIC') {output<-list(out=subset(merge(snp_info,x$opt_extBIC$out,by='SNP'),pval<=pval_filt),cof=x$opt_extBIC$cof,bonf_thresh=x$bonf_thresh) 147 | plot_GWAS(output,...)} 148 | else if (opt=='mbonf') {output<-list(out=subset(merge(snp_info,x$opt_mbonf$out,by='SNP'),pval<=pval_filt),cof=x$opt_mbonf$cof,bonf_thresh=x$bonf_thresh) 149 | plot_GWAS(output,...)} 150 | else if (opt=='thresh') {output<-list(out=subset(merge(snp_info,x$opt_thresh$out,by='SNP'),pval<=pval_filt),cof=x$opt_thresh$cof,bonf_thresh=x$thresh) 151 | plot_GWAS(output,...)} 152 | else {cat('error! \n opt must be extBIC, mbonf or thresh')}} 153 | 154 | ##' Plot 155 | ##' 156 | ##' Plot 157 | ##' @param x x 158 | ##' @param opt opt 159 | ##' @param snp_info snp_info 160 | ##' @param pval_filt pval_filt 161 | ##' @param chrom chrom 162 | ##' @param pos1 pos1 163 | ##' @param pos2 pos2 164 | ##' @author V. Segura & B. J. Vilhjalmsson 165 | ##' @export 166 | plot_opt_region<-function(x,opt,snp_info,pval_filt,chrom,pos1,pos2) { 167 | pval<-NULL # to avoid R CMD check issuing a NOTE 168 | if (opt=='extBIC') {output<-list(out=subset(merge(snp_info,x$opt_extBIC$out,by='SNP'),pval<=pval_filt),cof=x$opt_extBIC$cof,bonf_thresh=x$bonf_thresh) 169 | plot_region(output,chrom,pos1,pos2)} 170 | else if (opt=='mbonf') {output<-list(out=subset(merge(snp_info,x$opt_mbonf$out,by='SNP'),pval<=pval_filt),cof=x$opt_mbonf$cof,bonf_thresh=x$bonf_thresh) 171 | plot_region(output,chrom,pos1,pos2)} 172 | else if (opt=='thresh') {output<-list(out=subset(merge(snp_info,x$opt_thresh$out,by='SNP'),pval<=pval_filt),cof=x$opt_thresh$cof,bonf_thresh=x$thresh) 173 | plot_region(output,chrom,pos1,pos2)} 174 | else {cat('error! \n opt must be extBIC, mbonf or thresh')}} 175 | 176 | ##' Plot 177 | ##' 178 | ##' Plot 179 | ##' @param x x 180 | ##' @param nsteps nsteps 181 | ##' @author V. Segura & B. J. Vilhjalmsson 182 | ##' @export 183 | qqplot_fwd_GWAS<-function(x,nsteps){ 184 | stopifnot(nsteps<=length(x$pval_step)) 185 | e<--log10(stats::ppoints(nrow(x$pval_step[[1]]$out))) 186 | ostep<-list() 187 | ostep[[1]]<--log10(sort(x$pval_step[[1]]$out$pval)) 188 | for (i in 2:nsteps) {ostep[[i]]<--log10(sort(x$pval_step[[i]]$out$pval))} 189 | 190 | maxp<-ceiling(max(unlist(ostep))) 191 | 192 | graphics::plot(e,ostep[[1]],type='l',col=1,xlab=expression(Expected~~-log[10](italic(p))), ylab=expression(Observed~~-log[10](italic(p))),xlim=c(0,max(e)+1),ylim=c(0,maxp)) 193 | graphics::abline(0,1,col="dark grey") 194 | 195 | for (i in 2:nsteps) { 196 | graphics::par(new=T) 197 | graphics::plot(e,ostep[[i]],type='l',col=i,axes='F',xlab='',ylab='',xlim=c(0,max(e)+1),ylim=c(0,maxp))} 198 | graphics::legend(0,maxp,lty=1,pch=20,col=c(1:length(ostep)),paste(c(0:(length(ostep)-1)),'cof',sep=' ')) 199 | } 200 | 201 | ##' Plot 202 | ##' 203 | ##' Plot 204 | ##' @param x x 205 | ##' @param opt opt 206 | ##' @author V. Segura & B. J. Vilhjalmsson 207 | ##' @export 208 | qqplot_opt_GWAS<-function(x,opt){ 209 | if (opt=='extBIC') { 210 | e<--log10(stats::ppoints(nrow(x$opt_extBIC$out))) 211 | o<--log10(sort(x$opt_extBIC$out$pval)) 212 | maxp<-ceiling(max(o)) 213 | graphics::plot(e,o,type='l',col=1,xlab=expression(Expected~~-log[10](italic(p))), ylab=expression(Observed~~-log[10](italic(p))),xlim=c(0,max(e)+1),ylim=c(0,maxp),main=paste('optimal model according to extBIC')) 214 | graphics::abline(0,1,col="dark grey")} 215 | else if (opt=='mbonf') { 216 | e<--log10(stats::ppoints(nrow(x$opt_mbonf$out))) 217 | o<--log10(sort(x$opt_mbonf$out$pval)) 218 | maxp<-ceiling(max(o)) 219 | graphics::plot(e,o,type='l',col=1,xlab=expression(Expected~~-log[10](italic(p))), ylab=expression(Observed~~-log[10](italic(p))),xlim=c(0,max(e)+1),ylim=c(0,maxp),main=paste('optimal model according to mbonf')) 220 | graphics::abline(0,1,col="dark grey")} 221 | else if (opt=='thresh') { 222 | e<--log10(stats::ppoints(nrow(x$opt_thresh$out))) 223 | o<--log10(sort(x$opt_thresh$out$pval)) 224 | maxp<-ceiling(max(o)) 225 | graphics::plot(e,o,type='l',col=1,xlab=expression(Expected~~-log[10](italic(p))), ylab=expression(Observed~~-log[10](italic(p))),xlim=c(0,max(e)+1),ylim=c(0,maxp),main=paste('optimal model according to the user defined threshold')) 226 | graphics::abline(0,1,col="dark grey")} 227 | else {cat('error! \n opt must be extBIC, mbonf or thresh')}} 228 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # MLMM 2 | 3 | ## Introduction 4 | 5 | This directory contains the `mlmm` package for the R programming language. It implements an efficient multi-locus mixed-model approach for genome-wide association studies in structured populations. 6 | 7 | ## Authors and license 8 | 9 | The main authors are Vincent Segura and Bjarni J. Vilhjalmsson. The code is available under the GNU Public License (version 3 and later). See the COPYING file for usage permissions. 10 | 11 | ## Development 12 | 13 | The content of this directory is versioned using git, the central repository being hosted on [GitHub](https://github.com/Gregor-Mendel-Institute/mlmm). Please report issues directly [online](https://github.com/Gregor-Mendel-Institute/mlmm/issues). 14 | 15 | ## Installation 16 | 17 | For users, the easiest is to directly install the package from GitHub: 18 | ``` 19 | R> library(devtools); install_github("Gregor-Mendel-Institute/MultLocMixMod") 20 | ``` 21 | 22 | Note that this package depends on the `emma` package (not the one on CRAN, but the one from UCLA available [here](http://mouse.cs.ucla.edu/emma/)). 23 | 24 | There is an issue in installing the original `emma` package on Windows, so Windows users must in place use [emma_1.1.2.tar.gz](https://github.com/Gregor-Mendel-Institute/mlmm/files/1356516/emma_1.1.2.tar.gz) which can be installed with the following command: 25 | ``` 26 | R> install.packages("https://github.com/Gregor-Mendel-Institute/mlmm/files/1356516/emma_1.1.2.tar.gz", repos = NULL) 27 | ``` 28 | 29 | For developpers, when editing the content of this repo, increment the version of the package in `DESCRIPTION` and execute the following commands: 30 | ``` 31 | $ Rscript -e 'library(devtools); devtools::document()' 32 | $ R CMD build mlmm 33 | $ R CMD check mlmm_.tar.gz 34 | $ sudo R CMD INSTALL mlmm_.tar.gz 35 | ``` 36 | 37 | More information is available in Hadley Wickham's [book](http://r-pkgs.had.co.nz/). 38 | 39 | ## Usage 40 | 41 | Two main functions can be used to carry out GWAS with MLMM and plot the results from the analysis: 42 | 43 | * `mlmm`, the original MLMM as described in [Segura, Vilhjálmsson et al. (Nat Gen 2012)](http://www.nature.com/ng/journal/v44/n7/full/ng.2314.html). 44 | 45 | * `mlmm_cof`, a modified version of MLMM that allows including a fixed covariate in the association model. This could be for example a matrix of principal components scores (MLMM version of the "PK" model) or any feature that would make sense to regress out (e.g. sex). 46 | 47 | In their current versions, the MLMM functions do not allow for missing values in the genotype matrix. Whenever possible we would suggest imputing the genotypic data prior to the analysis. 48 | 49 | Once the package is installed, browse the vignettes: 50 | ``` 51 | R> library(mlmm) 52 | R> browseVignettes("mlmm") 53 | ``` 54 | 55 | When used for a scientific article, don't forget to cite it: 56 | ``` 57 | R> citation("mlmm") 58 | ``` 59 | 60 | See also `citation()` for citing R itself. 61 | -------------------------------------------------------------------------------- /data-raw/make_data_mlmm.R: -------------------------------------------------------------------------------- 1 | library(devtools) 2 | 3 | setwd("/mlmm") 4 | 5 | ## load all input files 6 | genot <- read.table("misc/genot.txt", sep = "\t", header = T) 7 | genot_mat <- as.matrix(genot[, 2:ncol(genot)]) 8 | rownames(genot_mat) <- genot$Ind_id 9 | 10 | phenot <- read.table("misc/phenot.txt", sep = "\t", header = T) 11 | 12 | map <- read.table("misc/map.txt", sep = "\t", header = T) 13 | 14 | PCs <- read.table("misc/PCs.txt", sep = "\t", header = T) 15 | PC_mat <- as.matrix(PCs[, 2:ncol(PCs)]) 16 | rownames(PC_mat) <- PCs$Ind_id 17 | 18 | ## impute the missing genotypes and calculate the kinship matrix 19 | genot_imp <- genot_mat 20 | average <- colMeans(genot_imp, na.rm = T) 21 | for (i in 1:ncol(genot_imp)) 22 | genot_imp[is.na(genot_imp[,i]), i] <- average[i] 23 | stdev <- apply(genot_imp, 2, sd) 24 | genot_stand <- sweep(sweep(genot_imp, 2, average, "-"), 2, stdev, "/") 25 | K_mat <- (genot_stand %*% t(genot_stand)) / ncol(genot_stand) 26 | 27 | ## format the data for the examples and save them 28 | example_data <- list(X=genot_imp, 29 | Y=phenot$Phenot1, 30 | K=K_mat, 31 | snp_info=map, 32 | PC=PC_mat) 33 | devtools::use_data(example_data, overwrite=TRUE) 34 | -------------------------------------------------------------------------------- /data/example_data.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Gregor-Mendel-Institute/MultLocMixMod/e1aa9ab4779d98b95d1f83a4edc7f9df5f4e7c14/data/example_data.rda -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | citHeader("To cite the mlmm function in publications, use:") 2 | 3 | citEntry(entry = "Article", 4 | title = "An efficient multi-locus mixed-model approach for genome-wide association studies in structured populations", 5 | author = personList(as.person("Segura, Vilhjalmsson et al")), 6 | journal = "Nature Genetics", 7 | year = "2012", 8 | volume = "44", 9 | pages = "825--830", 10 | url = "http://www.nature.com/ng/journal/v44/n7/full/ng.2314.html", 11 | 12 | textVersion = 13 | paste("Segura, Vilhjalmsson et al (2012).", 14 | "An efficient multi-locus mixed-model approach for genome-wide association studies in structured populations.", 15 | "Nature Genetics, 44, 825-830.", 16 | "URL http://www.nature.com/ng/journal/v44/n7/full/ng.2314.html.") 17 | ) 18 | -------------------------------------------------------------------------------- /man/example_data.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{example_data} 5 | \alias{example_data} 6 | \title{Genotypes, SNP info, kinship and phenotypes.} 7 | \format{A list with 4 components: 8 | \describe{ 9 | \item{X}{matrix of imputed genotypes} 10 | \item{Y}{vector of phenotypes} 11 | \item{K}{kinship matrix} 12 | \item{snp_info}{SNP coordinates} 13 | }} 14 | \usage{ 15 | example_data 16 | } 17 | \description{ 18 | A dataset used as example for the mlmm function. 19 | } 20 | \keyword{datasets} 21 | -------------------------------------------------------------------------------- /man/mlmm.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mlmm.r 3 | \name{mlmm} 4 | \alias{mlmm} 5 | \title{MLMM} 6 | \usage{ 7 | mlmm(Y, X, K, nbchunks, maxsteps, thresh = NULL) 8 | } 9 | \arguments{ 10 | \item{Y}{phenotypes, a vector of length m, with names(Y)=individual names} 11 | 12 | \item{X}{genotypes, a n by m matrix, where n=number of individuals, m=number of SNPs, with rownames(X)=individual names, and colnames(X)=SNP names} 13 | 14 | \item{K}{kinship, a n by n matrix, with rownames(K)=colnames(K)=individual names} 15 | 16 | \item{nbchunks}{an integer defining the number of chunks of X to run the analysis, allows to decrease the memory usage ==> minimum=2, increase it if you do not have enough memory} 17 | 18 | \item{maxsteps}{maximum number of steps desired in the forward approach. The forward approach breaks automatically once the pseudo-heritability is close to 0, however to avoid doing too many steps in case the pseudo-heritability does not reach a value close to 0, this parameter is also used. It's value must be specified as an integer >= 3} 19 | 20 | \item{thresh}{threshold} 21 | } 22 | \value{ 23 | results 24 | } 25 | \description{ 26 | MLMM 27 | } 28 | \author{ 29 | V. Segura & B. J. Vilhjalmsson 30 | } 31 | -------------------------------------------------------------------------------- /man/mlmm_cof.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mlmm_cof.r 3 | \name{mlmm_cof} 4 | \alias{mlmm_cof} 5 | \title{MLMM_COF} 6 | \usage{ 7 | mlmm_cof(Y, X, cofs, K, nbchunks, maxsteps, thresh = NULL) 8 | } 9 | \arguments{ 10 | \item{Y}{phenotypes, a vector of length m, with names(Y)=individual names} 11 | 12 | \item{X}{genotypes, a n by m matrix, where n=number of individuals, m=number of SNPs, with rownames(X)=individual names, and colnames(X)=SNP names} 13 | 14 | \item{cofs}{covariates, a n by p matrix, where n=number of individuals, p=number of covariates in the matrix (e.g. PC axes)} 15 | 16 | \item{K}{kinship, a n by n matrix, with rownames(K)=colnames(K)=individual names} 17 | 18 | \item{nbchunks}{an integer defining the number of chunks of X to run the analysis, allows to decrease the memory usage ==> minimum=2, increase it if you do not have enough memory} 19 | 20 | \item{maxsteps}{maximum number of steps desired in the forward approach. The forward approach breaks automatically once the pseudo-heritability is close to 0, however to avoid doing too many steps in case the pseudo-heritability does not reach a value close to 0, this parameter is also used. It's value must be specified as an integer >= 3} 21 | 22 | \item{thresh}{threshold} 23 | } 24 | \value{ 25 | results 26 | } 27 | \description{ 28 | MLMM_COF 29 | } 30 | \author{ 31 | V. Segura & B. J. Vilhjalmsson 32 | } 33 | -------------------------------------------------------------------------------- /man/plot_GWAS.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_mlmm.r 3 | \name{plot_GWAS} 4 | \alias{plot_GWAS} 5 | \title{Plot} 6 | \usage{ 7 | plot_GWAS(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{x} 11 | 12 | \item{...}{arguments to be passed to \code{\link[graphics]{plot}}, such as \code{main}} 13 | } 14 | \description{ 15 | Plot 16 | } 17 | \author{ 18 | V. Segura & B. J. Vilhjalmsson 19 | } 20 | -------------------------------------------------------------------------------- /man/plot_fwd_GWAS.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_mlmm.r 3 | \name{plot_fwd_GWAS} 4 | \alias{plot_fwd_GWAS} 5 | \title{Plot} 6 | \usage{ 7 | plot_fwd_GWAS(x, step, snp_info, pval_filt, ...) 8 | } 9 | \arguments{ 10 | \item{x}{x} 11 | 12 | \item{step}{step} 13 | 14 | \item{snp_info}{snp_info} 15 | 16 | \item{pval_filt}{pval_filt} 17 | 18 | \item{...}{arguments to be passed to \code{\link[graphics]{plot}}, such as \code{main}} 19 | } 20 | \description{ 21 | Plot 22 | } 23 | \author{ 24 | V. Segura & B. J. Vilhjalmsson 25 | } 26 | -------------------------------------------------------------------------------- /man/plot_fwd_region.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_mlmm.r 3 | \name{plot_fwd_region} 4 | \alias{plot_fwd_region} 5 | \title{Plot} 6 | \usage{ 7 | plot_fwd_region(x, step, snp_info, pval_filt, chrom, pos1, pos2) 8 | } 9 | \arguments{ 10 | \item{x}{x} 11 | 12 | \item{step}{step} 13 | 14 | \item{snp_info}{snp_info} 15 | 16 | \item{pval_filt}{pval_filt} 17 | 18 | \item{chrom}{chrom} 19 | 20 | \item{pos1}{pos1} 21 | 22 | \item{pos2}{pos2} 23 | } 24 | \description{ 25 | Plot 26 | } 27 | \author{ 28 | V. Segura & B. J. Vilhjalmsson 29 | } 30 | -------------------------------------------------------------------------------- /man/plot_opt_GWAS.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_mlmm.r 3 | \name{plot_opt_GWAS} 4 | \alias{plot_opt_GWAS} 5 | \title{Plot} 6 | \usage{ 7 | plot_opt_GWAS(x, opt, snp_info, pval_filt, ...) 8 | } 9 | \arguments{ 10 | \item{x}{x} 11 | 12 | \item{opt}{opt} 13 | 14 | \item{snp_info}{snp_info} 15 | 16 | \item{pval_filt}{pval_filt} 17 | 18 | \item{...}{arguments to be passed to \code{\link[graphics]{plot}}, such as \code{main}} 19 | } 20 | \description{ 21 | Plot 22 | } 23 | \author{ 24 | V. Segura & B. J. Vilhjalmsson 25 | } 26 | -------------------------------------------------------------------------------- /man/plot_opt_region.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_mlmm.r 3 | \name{plot_opt_region} 4 | \alias{plot_opt_region} 5 | \title{Plot} 6 | \usage{ 7 | plot_opt_region(x, opt, snp_info, pval_filt, chrom, pos1, pos2) 8 | } 9 | \arguments{ 10 | \item{x}{x} 11 | 12 | \item{opt}{opt} 13 | 14 | \item{snp_info}{snp_info} 15 | 16 | \item{pval_filt}{pval_filt} 17 | 18 | \item{chrom}{chrom} 19 | 20 | \item{pos1}{pos1} 21 | 22 | \item{pos2}{pos2} 23 | } 24 | \description{ 25 | Plot 26 | } 27 | \author{ 28 | V. Segura & B. J. Vilhjalmsson 29 | } 30 | -------------------------------------------------------------------------------- /man/plot_region.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_mlmm.r 3 | \name{plot_region} 4 | \alias{plot_region} 5 | \title{Plot} 6 | \usage{ 7 | plot_region(x, chrom, pos1, pos2) 8 | } 9 | \arguments{ 10 | \item{x}{x} 11 | 12 | \item{chrom}{chrom} 13 | 14 | \item{pos1}{pos1} 15 | 16 | \item{pos2}{pos2} 17 | } 18 | \description{ 19 | Plot 20 | } 21 | \author{ 22 | V. Segura & B. J. Vilhjalmsson 23 | } 24 | -------------------------------------------------------------------------------- /man/plot_step_RSS.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_mlmm.r 3 | \name{plot_step_RSS} 4 | \alias{plot_step_RSS} 5 | \title{Plot} 6 | \usage{ 7 | plot_step_RSS(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{x} 11 | 12 | \item{...}{arguments to be passed to \code{\link[graphics]{plot}}, such as \code{main}} 13 | } 14 | \description{ 15 | Plot 16 | } 17 | \author{ 18 | V. Segura & B. J. Vilhjalmsson 19 | } 20 | -------------------------------------------------------------------------------- /man/plot_step_RSS_cof.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_mlmm.r 3 | \name{plot_step_RSS_cof} 4 | \alias{plot_step_RSS_cof} 5 | \title{Plot} 6 | \usage{ 7 | plot_step_RSS_cof(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{x} 11 | 12 | \item{...}{arguments to be passed to \code{\link[graphics]{plot}}, such as \code{main}} 13 | } 14 | \description{ 15 | Plot 16 | } 17 | \author{ 18 | V. Segura & B. J. Vilhjalmsson 19 | } 20 | -------------------------------------------------------------------------------- /man/plot_step_table.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_mlmm.r 3 | \name{plot_step_table} 4 | \alias{plot_step_table} 5 | \title{Plot} 6 | \usage{ 7 | plot_step_table(x, type, ...) 8 | } 9 | \arguments{ 10 | \item{x}{x} 11 | 12 | \item{type}{type} 13 | 14 | \item{...}{arguments to be passed to \code{\link[graphics]{plot}}, such as \code{main}} 15 | } 16 | \description{ 17 | Plot 18 | } 19 | \author{ 20 | V. Segura & B. J. Vilhjalmsson 21 | } 22 | -------------------------------------------------------------------------------- /man/qqplot_fwd_GWAS.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_mlmm.r 3 | \name{qqplot_fwd_GWAS} 4 | \alias{qqplot_fwd_GWAS} 5 | \title{Plot} 6 | \usage{ 7 | qqplot_fwd_GWAS(x, nsteps) 8 | } 9 | \arguments{ 10 | \item{x}{x} 11 | 12 | \item{nsteps}{nsteps} 13 | } 14 | \description{ 15 | Plot 16 | } 17 | \author{ 18 | V. Segura & B. J. Vilhjalmsson 19 | } 20 | -------------------------------------------------------------------------------- /man/qqplot_opt_GWAS.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_mlmm.r 3 | \name{qqplot_opt_GWAS} 4 | \alias{qqplot_opt_GWAS} 5 | \title{Plot} 6 | \usage{ 7 | qqplot_opt_GWAS(x, opt) 8 | } 9 | \arguments{ 10 | \item{x}{x} 11 | 12 | \item{opt}{opt} 13 | } 14 | \description{ 15 | Plot 16 | } 17 | \author{ 18 | V. Segura & B. J. Vilhjalmsson 19 | } 20 | -------------------------------------------------------------------------------- /misc/code_mlmm.r: -------------------------------------------------------------------------------- 1 | #load the tutorial data for carrying out mlmm analysis 2 | genot <- read.table("data/genot.txt", sep = "\t", header = T) 3 | genot_mat <- as.matrix(genot[, 2:ncol(genot)]) 4 | rownames(genot_mat) <- genot$Ind_id 5 | 6 | phenot <- read.table("data/phenot.txt", sep = "\t", header = T) 7 | 8 | map <- read.table("data/map.txt", sep = "\t", header = T) 9 | 10 | genot_imp <- genot_mat 11 | average <- colMeans(genot_imp, na.rm = T) 12 | 13 | for (i in 1:ncol(genot_imp)){ 14 | genot_imp[is.na(genot_imp[,i]), i] <- average[i] 15 | } 16 | 17 | stdev <- apply(genot_imp, 2, sd) 18 | genot_stand <- sweep(sweep(genot_imp, 2, average, "-"), 2, stdev, "/") 19 | K_mat <- (genot_stand %*% t(genot_stand)) / ncol(genot_stand) 20 | 21 | #load the mlmm function as well as the emma package (if it does not install with your current R version, just download and source it, as recommended on the emma website). 22 | source("mlmm.r") 23 | source("emma.r") 24 | 25 | #perform mlmm (10 steps), it can take few minutes... 26 | mygwas <- mlmm(Y = phenot$Phenot1, X = genot_imp, K = K_mat, nbchunks = 2, maxsteps = 10, thresh = 1.2 * 10^-5) 27 | 28 | #display and plot the results 29 | source("plot_mlmm.r") 30 | #mlmm stepwise table 31 | mygwas$step_table 32 | #EBIC plot 33 | plot_step_table(mygwas, "extBIC") 34 | #mbonf criterion plot 35 | plot_step_table(mygwas, "maxpval") #user define threshold if defined is automatically drawn in red 36 | #% variance plot 37 | plot_step_RSS(mygwas) 38 | #1st mlmm step plot 39 | plot_fwd_GWAS(mygwas, step = 1, snp_info = map, pval_filt = 0.1) 40 | #2nd mlmm step plot 41 | plot_fwd_GWAS(mygwas, step = 2, snp_info = map, pval_filt = 0.1) 42 | #3rd mlmm step plot 43 | plot_fwd_GWAS(mygwas, step = 3, snp_info = map, pval_filt = 0.1) 44 | #QQplot 7 steps 45 | qqplot_fwd_GWAS(mygwas, nsteps = 7) 46 | 47 | #optimal step according to ebic plot 48 | plot_opt_GWAS(mygwas, opt = "extBIC", snp_info = map, pval_filt = 0.1) 49 | qqplot_opt_GWAS(mygwas, opt = "extBIC") 50 | #optimal step according to mbonf plot 51 | plot_opt_GWAS(mygwas, opt = "mbonf", snp_info = map, pval_filt = 0.1) 52 | qqplot_opt_GWAS(mygwas, opt = "mbonf") 53 | #optimal step according to user defined threshold 54 | plot_opt_GWAS(mygwas, opt = "thresh", snp_info = map, pval_filt = 0.1)#dotted line correspond to the user defined threshold 55 | qqplot_opt_GWAS(mygwas, opt = "thresh") 56 | 57 | #plot a region 58 | plot_fwd_region(mygwas, step = 4, snp_info = map, pval_filt = 0.1, chrom = 2, pos1 = 17000000, pos2 = 19000000) 59 | plot_opt_region(mygwas, opt = "thresh", snp_info = map, pval_filt = 0.1, chrom = 2, pos1 = 17000000, pos2 = 19000000) 60 | 61 | #retrieving pvals 62 | #step 1 63 | head(mygwas$pval_step[[1]]$out) 64 | #step 2 65 | head(mygwas$pval_step[[2]]$out) 66 | #opt extBIC 67 | head(mygwas$opt_extBIC$out) 68 | #including SNP effects 69 | mygwas$opt_extBIC$coef 70 | 71 | ############ 72 | ##including PCs to the model 73 | PCs <- read.table("data/PCs.txt", sep = "\t", header = T) 74 | PC_mat <- as.matrix(PCs[, 2:ncol(PCs)]) 75 | rownames(PC_mat) <- PCs$Ind_id 76 | 77 | source("mlmm_cof.r") 78 | mygwas_cof <- mlmm_cof(Y = phenot$Phenot1, X = genot_imp, cofs = PC_mat, K = K_mat, nbchunks = 2, maxsteps = 10, thresh = 10^-5) 79 | 80 | #mlmm stepwise table 81 | mygwas_cof$step_table 82 | #EBIC plot 83 | plot_step_table(mygwas_cof, "extBIC") 84 | #mbonf criterion plot 85 | plot_step_table(mygwas_cof, "maxpval") 86 | #% variance plot 87 | plot_step_RSS_cof(mygwas_cof) 88 | #1st mlmm step plot 89 | plot_fwd_GWAS(mygwas_cof, step = 1, snp_info = map, pval_filt = 0.1) 90 | #2nd mlmm step plot 91 | plot_fwd_GWAS(mygwas_cof, step = 2, snp_info = map, pval_filt = 0.1) 92 | #3rd mlmm step plot 93 | plot_fwd_GWAS(mygwas_cof, step = 3, snp_info = map, pval_filt = 0.1) 94 | #QQplot 7 steps 95 | qqplot_fwd_GWAS(mygwas_cof, nsteps = 7) 96 | 97 | #optimal step according to ebic plot 98 | plot_opt_GWAS(mygwas_cof, opt = "extBIC", snp_info = map, pval_filt = 0.1) 99 | qqplot_opt_GWAS(mygwas_cof, opt = "extBIC") 100 | #optimal step according to mbonf plot 101 | plot_opt_GWAS(mygwas_cof, opt = "mbonf", snp_info = map, pval_filt = 0.1) 102 | qqplot_opt_GWAS(mygwas_cof, opt = "mbonf") 103 | #optimal step according to user defined threshold 104 | plot_opt_GWAS(mygwas_cof, opt = "thresh", snp_info = map, pval_filt = 0.1) 105 | qqplot_opt_GWAS(mygwas_cof, opt = "thresh") 106 | 107 | #plot a region 108 | plot_fwd_region(mygwas_cof, step = 4, snp_info = map, pval_filt = 0.1, chrom = 2, pos1 = 17000000, pos2 = 19000000) 109 | plot_opt_region(mygwas_cof, opt = "thresh", snp_info = map, pval_filt = 0.1, chrom = 2, pos1 = 17000000, pos2 = 19000000) 110 | 111 | #retrieving pvals 112 | #step 1 113 | head(mygwas_cof$pval_step[[1]]$out) 114 | #step 2 115 | head(mygwas_cof$pval_step[[2]]$out) 116 | #opt extBIC 117 | head(mygwas_cof$opt_extBIC$out) 118 | #including SNP effects 119 | mygwas_cof$opt_extBIC$coef 120 | 121 | -------------------------------------------------------------------------------- /misc/emma.r: -------------------------------------------------------------------------------- 1 | emma.kinship <- function(snps, method="additive", use="all") { 2 | n0 <- sum(snps==0,na.rm=TRUE) 3 | nh <- sum(snps==0.5,na.rm=TRUE) 4 | n1 <- sum(snps==1,na.rm=TRUE) 5 | nNA <- sum(is.na(snps)) 6 | 7 | stopifnot(n0+nh+n1+nNA == length(snps)) 8 | 9 | if ( method == "dominant" ) { 10 | flags <- matrix(as.double(rowMeans(snps,na.rm=TRUE) > 0.5),nrow(snps),ncol(snps)) 11 | snps[!is.na(snps) & (snps == 0.5)] <- flags[!is.na(snps) & (snps == 0.5)] 12 | } 13 | else if ( method == "recessive" ) { 14 | flags <- matrix(as.double(rowMeans(snps,na.rm=TRUE) < 0.5),nrow(snps),ncol(snps)) 15 | snps[!is.na(snps) & (snps == 0.5)] <- flags[!is.na(snps) & (snps == 0.5)] 16 | } 17 | else if ( ( method == "additive" ) && ( nh > 0 ) ) { 18 | dsnps <- snps 19 | rsnps <- snps 20 | flags <- matrix(as.double(rowMeans(snps,na.rm=TRUE) > 0.5),nrow(snps),ncol(snps)) 21 | dsnps[!is.na(snps) & (snps==0.5)] <- flags[!is.na(snps) & (snps==0.5)] 22 | flags <- matrix(as.double(rowMeans(snps,na.rm=TRUE) < 0.5),nrow(snps),ncol(snps)) 23 | rsnps[!is.na(snps) & (snps==0.5)] <- flags[!is.na(snps) & (snps==0.5)] 24 | snps <- rbind(dsnps,rsnps) 25 | } 26 | 27 | if ( use == "all" ) { 28 | mafs <- matrix(rowMeans(snps,na.rm=TRUE),nrow(snps),ncol(snps)) 29 | snps[is.na(snps)] <- mafs[is.na(snps)] 30 | } 31 | else if ( use == "complete.obs" ) { 32 | snps <- snps[rowSums(is.na(snps))==0,] 33 | } 34 | 35 | n <- ncol(snps) 36 | K <- matrix(nrow=n,ncol=n) 37 | diag(K) <- 1 38 | 39 | for(i in 2:n) { 40 | for(j in 1:(i-1)) { 41 | x <- snps[,i]*snps[,j] + (1-snps[,i])*(1-snps[,j]) 42 | K[i,j] <- sum(x,na.rm=TRUE)/sum(!is.na(x)) 43 | K[j,i] <- K[i,j] 44 | } 45 | } 46 | return(K) 47 | } 48 | 49 | emma.eigen.L <- function(Z,K,complete=TRUE) { 50 | if ( is.null(Z) ) { 51 | return(emma.eigen.L.wo.Z(K)) 52 | } 53 | else { 54 | return(emma.eigen.L.w.Z(Z,K,complete)) 55 | } 56 | } 57 | 58 | emma.eigen.L.wo.Z <- function(K) { 59 | eig <- eigen(K,symmetric=TRUE) 60 | return(list(values=eig$values,vectors=eig$vectors)) 61 | } 62 | 63 | emma.eigen.L.w.Z <- function(Z,K,complete=TRUE) { 64 | if ( complete == FALSE ) { 65 | vids <- colSums(Z)>0 66 | Z <- Z[,vids] 67 | K <- K[vids,vids] 68 | } 69 | eig <- eigen(K%*%crossprod(Z,Z),symmetric=FALSE,EISPACK=TRUE) 70 | return(list(values=eig$values,vectors=qr.Q(qr(Z%*%eig$vectors),complete=TRUE))) 71 | } 72 | 73 | emma.eigen.R <- function(Z,K,X,complete=TRUE) { 74 | if ( ncol(X) == 0 ) { 75 | return(emma.eigen.L(Z,K)) 76 | } 77 | else if ( is.null(Z) ) { 78 | return(emma.eigen.R.wo.Z(K,X)) 79 | } 80 | else { 81 | return(emma.eigen.R.w.Z(Z,K,X,complete)) 82 | } 83 | } 84 | 85 | emma.eigen.R.wo.Z <- function(K, X) { 86 | n <- nrow(X) 87 | q <- ncol(X) 88 | S <- diag(n)-X%*%solve(crossprod(X,X))%*%t(X) 89 | eig <- eigen(S%*%(K+diag(1,n))%*%S,symmetric=TRUE) 90 | stopifnot(!is.complex(eig$values)) 91 | return(list(values=eig$values[1:(n-q)]-1,vectors=eig$vectors[,1:(n-q)])) 92 | } 93 | 94 | emma.eigen.R.w.Z <- function(Z, K, X, complete = TRUE) { 95 | if ( complete == FALSE ) { 96 | vids <- colSums(Z) > 0 97 | Z <- Z[,vids] 98 | K <- K[vids,vids] 99 | } 100 | n <- nrow(Z) 101 | t <- ncol(Z) 102 | q <- ncol(X) 103 | 104 | SZ <- Z - X%*%solve(crossprod(X,X))%*%crossprod(X,Z) 105 | eig <- eigen(K%*%crossprod(Z,SZ),symmetric=FALSE,EISPACK=TRUE) 106 | if ( is.complex(eig$values) ) { 107 | eig$values <- Re(eig$values) 108 | eig$vectors <- Re(eig$vectors) 109 | } 110 | qr.X <- qr.Q(qr(X)) 111 | return(list(values=eig$values[1:(t-q)], 112 | vectors=qr.Q(qr(cbind(SZ%*%eig$vectors[,1:(t-q)],qr.X)), 113 | complete=TRUE)[,c(1:(t-q),(t+1):n)])) 114 | } 115 | 116 | emma.delta.ML.LL.wo.Z <- function(logdelta, lambda, etas, xi) { 117 | n <- length(xi) 118 | delta <- exp(logdelta) 119 | return( 0.5*(n*(log(n/(2*pi))-1-log(sum((etas*etas)/(lambda+delta))))-sum(log(xi+delta))) ) 120 | } 121 | 122 | emma.delta.ML.LL.w.Z <- function(logdelta, lambda, etas.1, xi.1, n, etas.2.sq ) { 123 | t <- length(xi.1) 124 | delta <- exp(logdelta) 125 | # stopifnot(length(lambda) == length(etas.1)) 126 | return( 0.5*(n*(log(n/(2*pi))-1-log(sum(etas.1*etas.1/(lambda+delta))+etas.2.sq/delta))-(sum(log(xi.1+delta))+(n-t)*logdelta)) ) 127 | } 128 | 129 | emma.delta.ML.dLL.wo.Z <- function(logdelta, lambda, etas, xi) { 130 | n <- length(xi) 131 | delta <- exp(logdelta) 132 | etasq <- etas*etas 133 | ldelta <- lambda+delta 134 | return( 0.5*(n*sum(etasq/(ldelta*ldelta))/sum(etasq/ldelta)-sum(1/(xi+delta))) ) 135 | } 136 | 137 | emma.delta.ML.dLL.w.Z <- function(logdelta, lambda, etas.1, xi.1, n, etas.2.sq ) { 138 | t <- length(xi.1) 139 | delta <- exp(logdelta) 140 | etasq <- etas.1*etas.1 141 | ldelta <- lambda+delta 142 | return( 0.5*(n*(sum(etasq/(ldelta*ldelta))+etas.2.sq/(delta*delta))/(sum(etasq/ldelta)+etas.2.sq/delta)-(sum(1/(xi.1+delta))+(n-t)/delta) ) ) 143 | } 144 | 145 | emma.delta.REML.LL.wo.Z <- function(logdelta, lambda, etas) { 146 | nq <- length(etas) 147 | delta <- exp(logdelta) 148 | return( 0.5*(nq*(log(nq/(2*pi))-1-log(sum(etas*etas/(lambda+delta))))-sum(log(lambda+delta))) ) 149 | } 150 | 151 | emma.delta.REML.LL.w.Z <- function(logdelta, lambda, etas.1, n, t, etas.2.sq ) { 152 | tq <- length(etas.1) 153 | nq <- n - t + tq 154 | delta <- exp(logdelta) 155 | return( 0.5*(nq*(log(nq/(2*pi))-1-log(sum(etas.1*etas.1/(lambda+delta))+etas.2.sq/delta))-(sum(log(lambda+delta))+(n-t)*logdelta)) ) 156 | } 157 | 158 | emma.delta.REML.dLL.wo.Z <- function(logdelta, lambda, etas) { 159 | nq <- length(etas) 160 | delta <- exp(logdelta) 161 | etasq <- etas*etas 162 | ldelta <- lambda+delta 163 | return( 0.5*(nq*sum(etasq/(ldelta*ldelta))/sum(etasq/ldelta)-sum(1/ldelta)) ) 164 | } 165 | 166 | emma.delta.REML.dLL.w.Z <- function(logdelta, lambda, etas.1, n, t1, etas.2.sq ) { 167 | t <- t1 168 | tq <- length(etas.1) 169 | nq <- n - t + tq 170 | delta <- exp(logdelta) 171 | etasq <- etas.1*etas.1 172 | ldelta <- lambda+delta 173 | return( 0.5*(nq*(sum(etasq/(ldelta*ldelta))+etas.2.sq/(delta*delta))/(sum(etasq/ldelta)+etas.2.sq/delta)-(sum(1/ldelta)+(n-t)/delta)) ) 174 | } 175 | 176 | emma.MLE <- function(y, X, K, Z=NULL, ngrids=100, llim=-10, ulim=10, 177 | esp=1e-10, eig.L = NULL, eig.R = NULL) 178 | { 179 | n <- length(y) 180 | t <- nrow(K) 181 | q <- ncol(X) 182 | 183 | # stopifnot(nrow(K) == t) 184 | stopifnot(ncol(K) == t) 185 | stopifnot(nrow(X) == n) 186 | 187 | if ( det(crossprod(X,X)) == 0 ) { 188 | warning("X is singular") 189 | return (list(ML=0,delta=0,ve=0,vg=0)) 190 | } 191 | 192 | if ( is.null(Z) ) { 193 | if ( is.null(eig.L) ) { 194 | eig.L <- emma.eigen.L.wo.Z(K) 195 | } 196 | if ( is.null(eig.R) ) { 197 | eig.R <- emma.eigen.R.wo.Z(K,X) 198 | } 199 | etas <- crossprod(eig.R$vectors,y) 200 | 201 | 202 | logdelta <- (0:ngrids)/ngrids*(ulim-llim)+llim 203 | m <- length(logdelta) 204 | delta <- exp(logdelta) 205 | Lambdas <- matrix(eig.R$values,n-q,m) + matrix(delta,n-q,m,byrow=TRUE) 206 | Xis <- matrix(eig.L$values,n,m) + matrix(delta,n,m,byrow=TRUE) 207 | Etasq <- matrix(etas*etas,n-q,m) 208 | LL <- 0.5*(n*(log(n/(2*pi))-1-log(colSums(Etasq/Lambdas)))-colSums(log(Xis))) 209 | dLL <- 0.5*delta*(n*colSums(Etasq/(Lambdas*Lambdas))/colSums(Etasq/Lambdas)-colSums(1/Xis)) 210 | 211 | optlogdelta <- vector(length=0) 212 | optLL <- vector(length=0) 213 | if ( dLL[1] < esp ) { 214 | optlogdelta <- append(optlogdelta, llim) 215 | optLL <- append(optLL, emma.delta.ML.LL.wo.Z(llim,eig.R$values,etas,eig.L$values)) 216 | } 217 | if ( dLL[m-1] > 0-esp ) { 218 | optlogdelta <- append(optlogdelta, ulim) 219 | optLL <- append(optLL, emma.delta.ML.LL.wo.Z(ulim,eig.R$values,etas,eig.L$values)) 220 | } 221 | 222 | for( i in 1:(m-1) ) 223 | { 224 | if ( ( dLL[i]*dLL[i+1] < 0-esp*esp ) && ( dLL[i] > 0 ) && ( dLL[i+1] < 0 ) ) 225 | { 226 | r <- uniroot(emma.delta.ML.dLL.wo.Z, lower=logdelta[i], upper=logdelta[i+1], lambda=eig.R$values, etas=etas, xi=eig.L$values) 227 | optlogdelta <- append(optlogdelta, r$root) 228 | optLL <- append(optLL, emma.delta.ML.LL.wo.Z(r$root,eig.R$values, etas, eig.L$values)) 229 | } 230 | } 231 | # optdelta <- exp(optlogdelta) 232 | } 233 | else { 234 | if ( is.null(eig.L) ) { 235 | eig.L <- emma.eigen.L.w.Z(Z,K) 236 | } 237 | if ( is.null(eig.R) ) { 238 | eig.R <- emma.eigen.R.w.Z(Z,K,X) 239 | } 240 | etas <- crossprod(eig.R$vectors,y) 241 | etas.1 <- etas[1:(t-q)] 242 | etas.2 <- etas[(t-q+1):(n-q)] 243 | etas.2.sq <- sum(etas.2*etas.2) 244 | 245 | logdelta <- (0:ngrids)/ngrids*(ulim-llim)+llim 246 | 247 | m <- length(logdelta) 248 | delta <- exp(logdelta) 249 | Lambdas <- matrix(eig.R$values,t-q,m) + matrix(delta,t-q,m,byrow=TRUE) 250 | Xis <- matrix(eig.L$values,t,m) + matrix(delta,t,m,byrow=TRUE) 251 | Etasq <- matrix(etas.1*etas.1,t-q,m) 252 | #LL <- 0.5*(n*(log(n/(2*pi))-1-log(colSums(Etasq/Lambdas)+etas.2.sq/delta))-colSums(log(Xis))+(n-t)*log(deltas)) 253 | dLL <- 0.5*delta*(n*(colSums(Etasq/(Lambdas*Lambdas))+etas.2.sq/(delta*delta))/(colSums(Etasq/Lambdas)+etas.2.sq/delta)-(colSums(1/Xis)+(n-t)/delta)) 254 | 255 | optlogdelta <- vector(length=0) 256 | optLL <- vector(length=0) 257 | if ( dLL[1] < esp ) { 258 | optlogdelta <- append(optlogdelta, llim) 259 | optLL <- append(optLL, emma.delta.ML.LL.w.Z(llim,eig.R$values,etas.1,eig.L$values,n,etas.2.sq)) 260 | } 261 | if ( dLL[m-1] > 0-esp ) { 262 | optlogdelta <- append(optlogdelta, ulim) 263 | optLL <- append(optLL, emma.delta.ML.LL.w.Z(ulim,eig.R$values,etas.1,eig.L$values,n,etas.2.sq)) 264 | } 265 | 266 | for( i in 1:(m-1) ) 267 | { 268 | if ( ( dLL[i]*dLL[i+1] < 0-esp*esp ) && ( dLL[i] > 0 ) && ( dLL[i+1] < 0 ) ) 269 | { 270 | r <- uniroot(emma.delta.ML.dLL.w.Z, lower=logdelta[i], upper=logdelta[i+1], lambda=eig.R$values, etas.1=etas.1, xi.1=eig.L$values, n=n, etas.2.sq = etas.2.sq ) 271 | optlogdelta <- append(optlogdelta, r$root) 272 | optLL <- append(optLL, emma.delta.ML.LL.w.Z(r$root,eig.R$values, etas.1, eig.L$values, n, etas.2.sq )) 273 | } 274 | } 275 | # optdelta <- exp(optlogdelta) 276 | } 277 | 278 | maxdelta <- exp(optlogdelta[which.max(optLL)]) 279 | maxLL <- max(optLL) 280 | if ( is.null(Z) ) { 281 | maxva <- sum(etas*etas/(eig.R$values+maxdelta))/n 282 | } 283 | else { 284 | maxva <- (sum(etas.1*etas.1/(eig.R$values+maxdelta))+etas.2.sq/maxdelta)/n 285 | } 286 | maxve <- maxva*maxdelta 287 | 288 | return (list(ML=maxLL,delta=maxdelta,ve=maxve,vg=maxva)) 289 | } 290 | 291 | emma.MLE.noX <- function(y, K, Z=NULL, ngrids=100, llim=-10, ulim=10, 292 | esp=1e-10, eig.L = NULL) 293 | { 294 | n <- length(y) 295 | t <- nrow(K) 296 | 297 | # stopifnot(nrow(K) == t) 298 | stopifnot(ncol(K) == t) 299 | 300 | if ( is.null(Z) ) { 301 | if ( is.null(eig.L) ) { 302 | eig.L <- emma.eigen.L.wo.Z(K) 303 | } 304 | etas <- crossprod(eig.L$vectors,y) 305 | 306 | logdelta <- (0:ngrids)/ngrids*(ulim-llim)+llim 307 | m <- length(logdelta) 308 | delta <- exp(logdelta) 309 | Xis <- matrix(eig.L$values,n,m) + matrix(delta,n,m,byrow=TRUE) 310 | Etasq <- matrix(etas*etas,n,m) 311 | LL <- 0.5*(n*(log(n/(2*pi))-1-log(colSums(Etasq/Xis)))-colSums(log(Xis))) 312 | dLL <- 0.5*delta*(n*colSums(Etasq/(Xis*Xis))/colSums(Etasq/Xis)-colSums(1/Xis)) 313 | 314 | optlogdelta <- vector(length=0) 315 | optLL <- vector(length=0) 316 | #print(dLL) 317 | if ( dLL[1] < esp ) { 318 | optlogdelta <- append(optlogdelta, llim) 319 | optLL <- append(optLL, emma.delta.ML.LL.wo.Z(llim,eig.L$values,etas,eig.L$values)) 320 | } 321 | if ( dLL[m-1] > 0-esp ) { 322 | optlogdelta <- append(optlogdelta, ulim) 323 | optLL <- append(optLL, emma.delta.ML.LL.wo.Z(ulim,eig.L$values,etas,eig.L$values)) 324 | } 325 | 326 | for( i in 1:(m-1) ) 327 | { 328 | #if ( ( dLL[i]*dLL[i+1] < 0 ) && ( dLL[i] > 0 ) && ( dLL[i+1] < 0 ) ) 329 | if ( ( dLL[i]*dLL[i+1] < 0-esp*esp ) && ( dLL[i] > 0 ) && ( dLL[i+1] < 0 ) ) 330 | { 331 | r <- uniroot(emma.delta.ML.dLL.wo.Z, lower=logdelta[i], upper=logdelta[i+1], lambda=eig.L$values, etas=etas, xi=eig.L$values) 332 | optlogdelta <- append(optlogdelta, r$root) 333 | optLL <- append(optLL, emma.delta.ML.LL.wo.Z(r$root,eig.L$values, etas, eig.L$values)) 334 | } 335 | } 336 | # optdelta <- exp(optlogdelta) 337 | } 338 | else { 339 | if ( is.null(eig.L) ) { 340 | eig.L <- emma.eigen.L.w.Z(Z,K) 341 | } 342 | etas <- crossprod(eig.L$vectors,y) 343 | etas.1 <- etas[1:t] 344 | etas.2 <- etas[(t+1):n] 345 | etas.2.sq <- sum(etas.2*etas.2) 346 | 347 | logdelta <- (0:ngrids)/ngrids*(ulim-llim)+llim 348 | 349 | m <- length(logdelta) 350 | delta <- exp(logdelta) 351 | Xis <- matrix(eig.L$values,t,m) + matrix(delta,t,m,byrow=TRUE) 352 | Etasq <- matrix(etas.1*etas.1,t,m) 353 | #LL <- 0.5*(n*(log(n/(2*pi))-1-log(colSums(Etasq/Lambdas)+etas.2.sq/delta))-colSums(log(Xis))+(n-t)*log(deltas)) 354 | dLL <- 0.5*delta*(n*(colSums(Etasq/(Xis*Xis))+etas.2.sq/(delta*delta))/(colSums(Etasq/Xis)+etas.2.sq/delta)-(colSums(1/Xis)+(n-t)/delta)) 355 | 356 | optlogdelta <- vector(length=0) 357 | optLL <- vector(length=0) 358 | if ( dLL[1] < esp ) { 359 | optlogdelta <- append(optlogdelta, llim) 360 | optLL <- append(optLL, emma.delta.ML.LL.w.Z(llim,eig.L$values,etas.1,eig.L$values,n,etas.2.sq)) 361 | } 362 | if ( dLL[m-1] > 0-esp ) { 363 | optlogdelta <- append(optlogdelta, ulim) 364 | optLL <- append(optLL, emma.delta.ML.LL.w.Z(ulim,eig.L$values,etas.1,eig.L$values,n,etas.2.sq)) 365 | } 366 | 367 | for( i in 1:(m-1) ) 368 | { 369 | if ( ( dLL[i]*dLL[i+1] < 0-esp*esp ) && ( dLL[i] > 0 ) && ( dLL[i+1] < 0 ) ) 370 | { 371 | r <- uniroot(emma.delta.ML.dLL.w.Z, lower=logdelta[i], upper=logdelta[i+1], lambda=eig.L$values, etas.1=etas.1, xi.1=eig.L$values, n=n, etas.2.sq = etas.2.sq ) 372 | optlogdelta <- append(optlogdelta, r$root) 373 | optLL <- append(optLL, emma.delta.ML.LL.w.Z(r$root,eig.L$values, etas.1, eig.L$values, n, etas.2.sq )) 374 | } 375 | } 376 | # optdelta <- exp(optlogdelta) 377 | } 378 | 379 | maxdelta <- exp(optlogdelta[which.max(optLL)]) 380 | maxLL <- max(optLL) 381 | if ( is.null(Z) ) { 382 | maxva <- sum(etas*etas/(eig.L$values+maxdelta))/n 383 | } 384 | else { 385 | maxva <- (sum(etas.1*etas.1/(eig.L$values+maxdelta))+etas.2.sq/maxdelta)/n 386 | } 387 | maxve <- maxva*maxdelta 388 | 389 | return (list(ML=maxLL,delta=maxdelta,ve=maxve,vg=maxva)) 390 | } 391 | 392 | emma.REMLE <- function(y, X, K, Z=NULL, ngrids=100, llim=-10, ulim=10, 393 | esp=1e-10, eig.L = NULL, eig.R = NULL) { 394 | n <- length(y) 395 | t <- nrow(K) 396 | q <- ncol(X) 397 | 398 | # stopifnot(nrow(K) == t) 399 | stopifnot(ncol(K) == t) 400 | stopifnot(nrow(X) == n) 401 | 402 | if ( det(crossprod(X,X)) == 0 ) { 403 | warning("X is singular") 404 | return (list(REML=0,delta=0,ve=0,vg=0)) 405 | } 406 | 407 | if ( is.null(Z) ) { 408 | if ( is.null(eig.R) ) { 409 | eig.R <- emma.eigen.R.wo.Z(K,X) 410 | } 411 | etas <- crossprod(eig.R$vectors,y) 412 | 413 | logdelta <- (0:ngrids)/ngrids*(ulim-llim)+llim 414 | m <- length(logdelta) 415 | delta <- exp(logdelta) 416 | Lambdas <- matrix(eig.R$values,n-q,m) + matrix(delta,n-q,m,byrow=TRUE) 417 | Etasq <- matrix(etas*etas,n-q,m) 418 | LL <- 0.5*((n-q)*(log((n-q)/(2*pi))-1-log(colSums(Etasq/Lambdas)))-colSums(log(Lambdas))) 419 | dLL <- 0.5*delta*((n-q)*colSums(Etasq/(Lambdas*Lambdas))/colSums(Etasq/Lambdas)-colSums(1/Lambdas)) 420 | 421 | optlogdelta <- vector(length=0) 422 | optLL <- vector(length=0) 423 | if ( dLL[1] < esp ) { 424 | optlogdelta <- append(optlogdelta, llim) 425 | optLL <- append(optLL, emma.delta.REML.LL.wo.Z(llim,eig.R$values,etas)) 426 | } 427 | if ( dLL[m-1] > 0-esp ) { 428 | optlogdelta <- append(optlogdelta, ulim) 429 | optLL <- append(optLL, emma.delta.REML.LL.wo.Z(ulim,eig.R$values,etas)) 430 | } 431 | 432 | for( i in 1:(m-1) ) 433 | { 434 | if ( ( dLL[i]*dLL[i+1] < 0-esp*esp ) && ( dLL[i] > 0 ) && ( dLL[i+1] < 0 ) ) 435 | { 436 | r <- uniroot(emma.delta.REML.dLL.wo.Z, lower=logdelta[i], upper=logdelta[i+1], lambda=eig.R$values, etas=etas) 437 | optlogdelta <- append(optlogdelta, r$root) 438 | optLL <- append(optLL, emma.delta.REML.LL.wo.Z(r$root,eig.R$values, etas)) 439 | } 440 | } 441 | # optdelta <- exp(optlogdelta) 442 | } 443 | else { 444 | if ( is.null(eig.R) ) { 445 | eig.R <- emma.eigen.R.w.Z(Z,K,X) 446 | } 447 | etas <- crossprod(eig.R$vectors,y) 448 | etas.1 <- etas[1:(t-q)] 449 | etas.2 <- etas[(t-q+1):(n-q)] 450 | etas.2.sq <- sum(etas.2*etas.2) 451 | 452 | logdelta <- (0:ngrids)/ngrids*(ulim-llim)+llim 453 | m <- length(logdelta) 454 | delta <- exp(logdelta) 455 | Lambdas <- matrix(eig.R$values,t-q,m) + matrix(delta,t-q,m,byrow=TRUE) 456 | Etasq <- matrix(etas.1*etas.1,t-q,m) 457 | dLL <- 0.5*delta*((n-q)*(colSums(Etasq/(Lambdas*Lambdas))+etas.2.sq/(delta*delta))/(colSums(Etasq/Lambdas)+etas.2.sq/delta)-(colSums(1/Lambdas)+(n-t)/delta)) 458 | 459 | optlogdelta <- vector(length=0) 460 | optLL <- vector(length=0) 461 | if ( dLL[1] < esp ) { 462 | optlogdelta <- append(optlogdelta, llim) 463 | optLL <- append(optLL, emma.delta.REML.LL.w.Z(llim,eig.R$values,etas.1,n,t,etas.2.sq)) 464 | } 465 | if ( dLL[m-1] > 0-esp ) { 466 | optlogdelta <- append(optlogdelta, ulim) 467 | optLL <- append(optLL, emma.delta.REML.LL.w.Z(ulim,eig.R$values,etas.1,n,t,etas.2.sq)) 468 | } 469 | 470 | for( i in 1:(m-1) ) 471 | { 472 | if ( ( dLL[i]*dLL[i+1] < 0-esp*esp ) && ( dLL[i] > 0 ) && ( dLL[i+1] < 0 ) ) 473 | { 474 | r <- uniroot(emma.delta.REML.dLL.w.Z, lower=logdelta[i], upper=logdelta[i+1], lambda=eig.R$values, etas.1=etas.1, n=n, t1=t, etas.2.sq = etas.2.sq ) 475 | optlogdelta <- append(optlogdelta, r$root) 476 | optLL <- append(optLL, emma.delta.REML.LL.w.Z(r$root,eig.R$values, etas.1, n, t, etas.2.sq )) 477 | } 478 | } 479 | # optdelta <- exp(optlogdelta) 480 | } 481 | 482 | maxdelta <- exp(optlogdelta[which.max(optLL)]) 483 | maxLL <- max(optLL) 484 | if ( is.null(Z) ) { 485 | maxva <- sum(etas*etas/(eig.R$values+maxdelta))/(n-q) 486 | } 487 | else { 488 | maxva <- (sum(etas.1*etas.1/(eig.R$values+maxdelta))+etas.2.sq/maxdelta)/(n-q) 489 | } 490 | maxve <- maxva*maxdelta 491 | 492 | return (list(REML=maxLL,delta=maxdelta,ve=maxve,vg=maxva)) 493 | } 494 | 495 | emma.ML.LRT <- function(ys, xs, K, Z=NULL, X0 = NULL, ngrids=100, llim=-10, ulim=10, esp=1e-10, ponly = FALSE) { 496 | if ( is.null(dim(ys)) || ncol(ys) == 1 ) { 497 | ys <- matrix(ys,1,length(ys)) 498 | } 499 | if ( is.null(dim(xs)) || ncol(xs) == 1 ) { 500 | xs <- matrix(xs,1,length(xs)) 501 | } 502 | if ( is.null(X0) ) { 503 | X0 <- matrix(1,ncol(ys),1) 504 | } 505 | 506 | g <- nrow(ys) 507 | n <- ncol(ys) 508 | m <- nrow(xs) 509 | t <- ncol(xs) 510 | q0 <- ncol(X0) 511 | q1 <- q0 + 1 512 | 513 | if ( !ponly ) { 514 | ML1s <- matrix(nrow=m,ncol=g) 515 | ML0s <- matrix(nrow=m,ncol=g) 516 | vgs <- matrix(nrow=m,ncol=g) 517 | ves <- matrix(nrow=m,ncol=g) 518 | } 519 | stats <- matrix(nrow=m,ncol=g) 520 | ps <- matrix(nrow=m,ncol=g) 521 | ML0 <- vector(length=g) 522 | 523 | stopifnot(nrow(K) == t) 524 | stopifnot(ncol(K) == t) 525 | stopifnot(nrow(X0) == n) 526 | 527 | if ( sum(is.na(ys)) == 0 ) { 528 | eig.L <- emma.eigen.L(Z,K) 529 | eig.R0 <- emma.eigen.R(Z,K,X0) 530 | 531 | for(i in 1:g) { 532 | ML0[i] <- emma.MLE(ys[i,],X0,K,Z,ngrids,llim,ulim,esp,eig.L,eig.R0)$ML 533 | } 534 | 535 | x.prev <- vector(length=0) 536 | 537 | for(i in 1:m) { 538 | vids <- !is.na(xs[i,]) 539 | nv <- sum(vids) 540 | xv <- xs[i,vids] 541 | 542 | if ( ( mean(xv) <= 0 ) || ( mean(xv) >= 1 ) ) { 543 | if (!ponly) { 544 | stats[i,] <- rep(NA,g) 545 | vgs[i,] <- rep(NA,g) 546 | ves[i,] <- rep(NA,g) 547 | ML1s[i,] <- rep(NA,g) 548 | ML0s[i,] <- rep(NA,g) 549 | } 550 | ps[i,] = rep(1,g) 551 | } 552 | else if ( identical(x.prev, xv) ) { 553 | if ( !ponly ) { 554 | stats[i,] <- stats[i-1,] 555 | vgs[i,] <- vgs[i-1,] 556 | ves[i,] <- ves[i-1,] 557 | ML1s[i,] <- ML1s[i-1,] 558 | ML0s[i,] <- ML0s[i-1,] 559 | } 560 | ps[i,] <- ps[i-1,] 561 | } 562 | else { 563 | if ( is.null(Z) ) { 564 | X <- cbind(X0[vids,,drop=FALSE],xs[i,vids]) 565 | eig.R1 = emma.eigen.R.wo.Z(K[vids,vids],X) 566 | } 567 | else { 568 | vrows <- as.logical(rowSums(Z[,vids])) 569 | nr <- sum(vrows) 570 | X <- cbind(X0[vrows,,drop=FALSE],Z[vrows,vids]%*%t(xs[i,vids,drop=FALSE])) 571 | eig.R1 = emma.eigen.R.w.Z(Z[vrows,vids],K[vids,vids],X) 572 | } 573 | 574 | for(j in 1:g) { 575 | if ( nv == t ) { 576 | MLE <- emma.MLE(ys[j,],X,K,Z,ngrids,llim,ulim,esp,eig.L,eig.R1) 577 | # MLE <- emma.MLE(ys[j,],X,K,Z,ngrids,llim,ulim,esp,eig.L,eig.R1) 578 | if (!ponly) { 579 | ML1s[i,j] <- MLE$ML 580 | vgs[i,j] <- MLE$vg 581 | ves[i,j] <- MLE$ve 582 | } 583 | stats[i,j] <- 2*(MLE$ML-ML0[j]) 584 | 585 | } 586 | else { 587 | if ( is.null(Z) ) { 588 | eig.L0 <- emma.eigen.L.wo.Z(K[vids,vids]) 589 | MLE0 <- emma.MLE(ys[j,vids],X0[vids,,drop=FALSE],K[vids,vids],NULL,ngrids,llim,ulim,esp,eig.L0) 590 | MLE1 <- emma.MLE(ys[j,vids],X,K[vids,vids],NULL,ngrids,llim,ulim,esp,eig.L0) 591 | } 592 | else { 593 | if ( nr == n ) { 594 | MLE1 <- emma.MLE(ys[j,],X,K,Z,ngrids,llim,ulim,esp,eig.L) 595 | } 596 | else { 597 | eig.L0 <- emma.eigen.L.w.Z(Z[vrows,vids],K[vids,vids]) 598 | MLE0 <- emma.MLE(ys[j,vrows],X0[vrows,,drop=FALSE],K[vids,vids],Z[vrows,vids],ngrids,llim,ulim,esp,eig.L0) 599 | MLE1 <- emma.MLE(ys[j,vrows],X,K[vids,vids],Z[vrows,vids],ngrids,llim,ulim,esp,eig.L0) 600 | } 601 | } 602 | if (!ponly) { 603 | ML1s[i,j] <- MLE1$ML 604 | ML0s[i,j] <- MLE0$ML 605 | vgs[i,j] <- MLE1$vg 606 | ves[i,j] <- MLE1$ve 607 | } 608 | stats[i,j] <- 2*(MLE1$ML-MLE0$ML) 609 | } 610 | } 611 | if ( ( nv == t ) && ( !ponly ) ) { 612 | ML0s[i,] <- ML0 613 | } 614 | ps[i,] <- pchisq(stats[i,],1,lower.tail=FALSE) 615 | } 616 | } 617 | } 618 | else { 619 | eig.L <- emma.eigen.L(Z,K) 620 | eig.R0 <- emma.eigen.R(Z,K,X0) 621 | 622 | for(i in 1:g) { 623 | vrows <- !is.na(ys[i,]) 624 | if ( is.null(Z) ) { 625 | ML0[i] <- emma.MLE(ys[i,vrows],X0[vrows,,drop=FALSE],K[vrows,vrows],NULL,ngrids,llim,ulim,esp)$ML 626 | } 627 | else { 628 | vids <- colSums(Z[vrows,]>0) 629 | 630 | ML0[i] <- emma.MLE(ys[i,vrows],X0[vrows,,drop=FALSE],K[vids,vids],Z[vrows,vids],ngrids,llim,ulim,esp)$ML 631 | } 632 | } 633 | 634 | x.prev <- vector(length=0) 635 | 636 | for(i in 1:m) { 637 | vids <- !is.na(xs[i,]) 638 | nv <- sum(vids) 639 | xv <- xs[i,vids] 640 | 641 | if ( ( mean(xv) <= 0 ) || ( mean(xv) >= 1 ) ) { 642 | if (!ponly) { 643 | stats[i,] <- rep(NA,g) 644 | vgs[i,] <- rep(NA,g) 645 | ves[i,] <- rep(NA,g) 646 | ML1s[i,] <- rep(NA,g) 647 | ML0s[,i] <- rep(NA,g) 648 | } 649 | ps[i,] = rep(1,g) 650 | } 651 | else if ( identical(x.prev, xv) ) { 652 | if ( !ponly ) { 653 | stats[i,] <- stats[i-1,] 654 | vgs[i,] <- vgs[i-1,] 655 | ves[i,] <- ves[i-1,] 656 | ML1s[i,] <- ML1s[i-1,] 657 | } 658 | ps[i,] = ps[i-1,] 659 | } 660 | else { 661 | if ( is.null(Z) ) { 662 | X <- cbind(X0,xs[i,]) 663 | if ( nv == t ) { 664 | eig.R1 = emma.eigen.R.wo.Z(K,X) 665 | } 666 | } 667 | else { 668 | vrows <- as.logical(rowSums(Z[,vids])) 669 | X <- cbind(X0,Z[,vids,drop=FALSE]%*%t(xs[i,vids,drop=FALSE])) 670 | if ( nv == t ) { 671 | eig.R1 = emma.eigen.R.w.Z(Z,K,X) 672 | } 673 | } 674 | 675 | for(j in 1:g) { 676 | # print(j) 677 | vrows <- !is.na(ys[j,]) 678 | if ( nv == t ) { 679 | nr <- sum(vrows) 680 | if ( is.null(Z) ) { 681 | if ( nr == n ) { 682 | MLE <- emma.MLE(ys[j,],X,K,NULL,ngrids,llim,ulim,esp,eig.L,eig.R1) 683 | } 684 | else { 685 | MLE <- emma.MLE(ys[j,vrows],X[vrows,],K[vrows,vrows],NULL,ngrids,llim,ulim,esp) 686 | } 687 | } 688 | else { 689 | if ( nr == n ) { 690 | MLE <- emma.MLE(ys[j,],X,K,Z,ngrids,llim,ulim,esp,eig.L,eig.R1) 691 | } 692 | else { 693 | vtids <- as.logical(colSums(Z[vrows,,drop=FALSE])) 694 | MLE <- emma.MLE(ys[j,vrows],X[vrows,],K[vtids,vtids],Z[vrows,vtids],ngrids,llim,ulim,esp) 695 | } 696 | } 697 | 698 | if (!ponly) { 699 | ML1s[i,j] <- MLE$ML 700 | vgs[i,j] <- MLE$vg 701 | ves[i,j] <- MLE$ve 702 | } 703 | stats[i,j] <- 2*(MLE$ML-ML0[j]) 704 | } 705 | else { 706 | if ( is.null(Z) ) { 707 | vtids <- vrows & vids 708 | eig.L0 <- emma.eigen.L(NULL,K[vtids,vtids]) 709 | MLE0 <- emma.MLE(ys[j,vtids],X0[vtids,,drop=FALSE],K[vtids,vtids],NULL,ngrids,llim,ulim,esp,eig.L0) 710 | MLE1 <- emma.MLE(ys[j,vtids],X[vtids,],K[vtids,vtids],NULL,ngrids,llim,ulim,esp,eig.L0) 711 | } 712 | else { 713 | vtids <- as.logical(colSums(Z[vrows,])) & vids 714 | vtrows <- vrows & as.logical(rowSums(Z[,vids])) 715 | eig.L0 <- emma.eigen.L(Z[vtrows,vtids],K[vtids,vtids]) 716 | MLE0 <- emma.MLE(ys[j,vtrows],X0[vtrows,,drop=FALSE],K[vtids,vtids],Z[vtrows,vtids],ngrids,llim,ulim,esp,eig.L0) 717 | MLE1 <- emma.MLE(ys[j,vtrows],X[vtrows,],K[vtids,vtids],Z[vtrows,vtids],ngrids,llim,ulim,esp,eig.L0) 718 | } 719 | if (!ponly) { 720 | ML1s[i,j] <- MLE1$ML 721 | vgs[i,j] <- MLE1$vg 722 | ves[i,j] <- MLE1$ve 723 | ML0s[i,j] <- MLE0$ML 724 | } 725 | stats[i,j] <- 2*(MLE1$ML-MLE0$ML) 726 | } 727 | } 728 | if ( ( nv == t ) && ( !ponly ) ) { 729 | ML0s[i,] <- ML0 730 | } 731 | ps[i,] <- pchisq(stats[i,],1,lower.tail=FALSE) 732 | } 733 | } 734 | } 735 | if ( ponly ) { 736 | return (ps) 737 | } 738 | else { 739 | return (list(ps=ps,ML1s=ML1s,ML0s=ML0s,stats=stats,vgs=vgs,ves=ves)) 740 | } 741 | } 742 | 743 | emma.test <- function(ys, xs, K, Z=NULL, x0s = NULL, X0 = NULL, dfxs = 1, dfx0s = 1, use.MLE = FALSE, use.LRT = FALSE, ngrids = 100, llim = -10, ulim = 10, esp=1e-10, ponly = FALSE) 744 | { 745 | stopifnot (dfxs > 0) 746 | 747 | if ( is.null(dim(ys)) || ncol(ys) == 1 ) { 748 | ys <- matrix(ys,1,length(ys)) 749 | } 750 | 751 | if ( is.null(dim(xs)) || ncol(xs) == 1 ) { 752 | xs <- matrix(xs,1,length(xs)) 753 | } 754 | nx <- nrow(xs)/dfxs 755 | 756 | if ( is.null(x0s) ) { 757 | dfx0s = 0 758 | x0s <- matrix(NA,0,ncol(xs)) 759 | } 760 | # X0 automatically contains intercept. If no intercept is to be used, 761 | # X0 should be matrix(nrow=ncol(ys),ncol=0) 762 | if ( is.null(X0) ) { 763 | X0 <- matrix(1,ncol(ys),1) 764 | } 765 | 766 | stopifnot(Z == NULL) # The case where Z is not null is not implemented 767 | 768 | ny <- nrow(ys) 769 | iy <- ncol(ys) 770 | ix <- ncol(xs) 771 | 772 | stopifnot(nrow(K) == ix) 773 | stopifnot(ncol(K) == ix) 774 | stopifnot(nrow(X0) == iy) 775 | 776 | if ( !ponly ) { 777 | LLs <- matrix(nrow=m,ncol=g) 778 | vgs <- matrix(nrow=m,ncol=g) 779 | ves <- matrix(nrow=m,ncol=g) 780 | } 781 | dfs <- matrix(nrow=m,ncol=g) 782 | stats <- matrix(nrow=m,ncol=g) 783 | ps <- matrix(nrow=m,ncol=g) 784 | 785 | # The case with no missing phenotypes 786 | if ( sum(is.na(ys)) == 0 ) { 787 | if ( ( use.MLE ) || ( !use.LRT ) ) { 788 | eig.L0 <- emma.eigen.L(Z,K) 789 | } 790 | if ( dfx0s == 0 ) { 791 | eig.R0 <- emma.eigen.R(Z,K,X0) 792 | } 793 | x.prev <- NULL 794 | 795 | for(i in 1:ix) { 796 | x1 <- t(xs[(dfxs*(i-1)+1):(dfxs*i),,drop=FALSE]) 797 | if ( dfxs0 == 0 ) { 798 | x0 <- X0 799 | } 800 | else { 801 | x0 <- cbind(t(x0s[(dfx0s*(i-1)+1):(dfx0s*i),,drop=FALSE]),X0) 802 | } 803 | x <- cbind(x1,x0) 804 | xvids <- rowSums(is.na(x) == 0) 805 | nxv <- sum(xvids) 806 | xv <- x[xvids,,drop=FALSE] 807 | Kv <- K[xvids,xvids,drop=FALSE] 808 | yv <- ys[j,xvids] 809 | 810 | if ( identical(x.prev, xv) ) { 811 | if ( !ponly ) { 812 | vgs[i,] <- vgs[i-1,] 813 | ves[i,] <- ves[i-1,] 814 | dfs[i,] <- dfs[i-1,] 815 | REMLs[i,] <- REMLs[i-1,] 816 | stats[i,] <- stats[i-1,] 817 | } 818 | ps[i,] <- ps[i-1,] 819 | } 820 | else { 821 | eig.R1 = emma.eigen.R.wo.Z(Kv,xv) 822 | 823 | for(j in 1:iy) { 824 | if ( ( use.MLE ) || ( !use.LRT ) ) { 825 | if ( nxv < t ) { 826 | # NOTE: this complexity can be improved by avoiding eigen computation for identical missing patterns 827 | eig.L0v <- emma.eigen.L.wo.Z(Kv) 828 | } 829 | else { 830 | eig.L0v <- eig.L0 831 | } 832 | } 833 | 834 | if ( use.MLE ) { 835 | MLE <- emma.REMLE(yv,xv,Kv,NULL,ngrids,llim,ulim,esp,eig.R1) 836 | stop("Not implemented yet") 837 | } 838 | else { 839 | REMLE <- emma.REMLE(yv,xv,Kv,NULL,ngrids,llim,ulim,esp,eig.R1) 840 | if ( use.LRT ) { 841 | stop("Not implemented yet") 842 | } 843 | else { 844 | U <- eig.L0v$vectors * matrix(sqrt(1/(eig.L0v$values+REMLE$delta)),t,t,byrow=TRUE) 845 | dfs[i,j] <- length(eig.R1$values) 846 | yt <- crossprod(U,yv) 847 | xt <- crossprod(U,xv) 848 | ixx <- solve(crossprod(xt,xt)) 849 | beta <- ixx%*%crossprod(xt,yt) 850 | if ( dfxs == 1 ) { 851 | stats[i,j] <- beta[q1]/sqrt(iXX[q1,q1]*REMLE$vg) 852 | } 853 | else { 854 | model.m <- c(rep(1,dfxs),rep(0,ncol(xv)-dfxs)) 855 | stats[i,j] <- 856 | crossprod(crossprod(solve(crossprod(crossprod(iXX,model.m), 857 | model.m)), 858 | model.m*beta),model.m*beta) 859 | 860 | } 861 | if ( !ponly ) { 862 | vgs[i,j] <- REMLE$vg 863 | ves[i,j] <- REMLE$ve 864 | REMLs[i,j] <- REMLE$REML 865 | } 866 | } 867 | } 868 | } 869 | if ( dfxs == 1 ) { 870 | ps[i,] <- 2*pt(abs(stats[i,]),dfs[i,],lower.tail=FALSE) 871 | } 872 | else { 873 | ps[i,] <- pf(abs(stats[i,]),dfs[i,],lower.tail=FALSE) 874 | } 875 | } 876 | } 877 | } 878 | # The case with missing genotypes - not implemented yet 879 | else { 880 | stop("Not implemented yet") 881 | eig.L <- emma.eigen.L(Z,K) 882 | eig.R0 <- emma.eigen.R(Z,K,X0) 883 | 884 | x.prev <- vector(length=0) 885 | 886 | for(i in 1:m) { 887 | vids <- !is.na(xs[i,]) 888 | nv <- sum(vids) 889 | xv <- xs[i,vids] 890 | 891 | if ( ( mean(xv) <= 0 ) || ( mean(xv) >= 1 ) ) { 892 | if (!ponly) { 893 | vgs[i,] <- rep(NA,g) 894 | ves[i,] <- rep(NA,g) 895 | REMLs[i,] <- rep(NA,g) 896 | dfs[i,] <- rep(NA,g) 897 | } 898 | ps[i,] = rep(1,g) 899 | } 900 | else if ( identical(x.prev, xv) ) { 901 | if ( !ponly ) { 902 | stats[i,] <- stats[i-1,] 903 | vgs[i,] <- vgs[i-1,] 904 | ves[i,] <- ves[i-1,] 905 | REMLs[i,] <- REMLs[i-1,] 906 | dfs[i,] <- dfs[i-1,] 907 | } 908 | ps[i,] = ps[i-1,] 909 | } 910 | else { 911 | if ( is.null(Z) ) { 912 | X <- cbind(X0,xs[i,]) 913 | if ( nv == t ) { 914 | eig.R1 = emma.eigen.R.wo.Z(K,X) 915 | } 916 | } 917 | else { 918 | vrows <- as.logical(rowSums(Z[,vids,drop=FALSE])) 919 | X <- cbind(X0,Z[,vids,drop=FALSE]%*%t(xs[i,vids,drop=FALSE])) 920 | if ( nv == t ) { 921 | eig.R1 = emma.eigen.R.w.Z(Z,K,X) 922 | } 923 | } 924 | 925 | for(j in 1:g) { 926 | vrows <- !is.na(ys[j,]) 927 | if ( nv == t ) { 928 | yv <- ys[j,vrows] 929 | nr <- sum(vrows) 930 | if ( is.null(Z) ) { 931 | if ( nr == n ) { 932 | REMLE <- emma.REMLE(yv,X,K,NULL,ngrids,llim,ulim,esp,eig.R1) 933 | U <- eig.L$vectors * matrix(sqrt(1/(eig.L$values+REMLE$delta)),n,n,byrow=TRUE) 934 | } 935 | else { 936 | eig.L0 <- emma.eigen.L.wo.Z(K[vrows,vrows,drop=FALSE]) 937 | REMLE <- emma.REMLE(yv,X[vrows,,drop=FALSE],K[vrows,vrows,drop=FALSE],NULL,ngrids,llim,ulim,esp) 938 | U <- eig.L0$vectors * matrix(sqrt(1/(eig.L0$values+REMLE$delta)),nr,nr,byrow=TRUE) 939 | } 940 | dfs[i,j] <- nr-q1 941 | } 942 | else { 943 | if ( nr == n ) { 944 | REMLE <- emma.REMLE(yv,X,K,Z,ngrids,llim,ulim,esp,eig.R1) 945 | U <- eig.L$vectors * matrix(c(sqrt(1/(eig.L$values+REMLE$delta)),rep(sqrt(1/REMLE$delta),n-t)),n,n,byrow=TRUE) 946 | } 947 | else { 948 | vtids <- as.logical(colSums(Z[vrows,,drop=FALSE])) 949 | eig.L0 <- emma.eigen.L.w.Z(Z[vrows,vtids,drop=FALSE],K[vtids,vtids,drop=FALSE]) 950 | REMLE <- emma.REMLE(yv,X[vrows,,drop=FALSE],K[vtids,vtids,drop=FALSE],Z[vrows,vtids,drop=FALSE],ngrids,llim,ulim,esp) 951 | U <- eig.L0$vectors * matrix(c(sqrt(1/(eig.L0$values+REMLE$delta)),rep(sqrt(1/REMLE$delta),nr-sum(vtids))),nr,nr,byrow=TRUE) 952 | } 953 | dfs[i,j] <- nr-q1 954 | } 955 | 956 | yt <- crossprod(U,yv) 957 | Xt <- crossprod(U,X[vrows,,drop=FALSE]) 958 | iXX <- solve(crossprod(Xt,Xt)) 959 | beta <- iXX%*%crossprod(Xt,yt) 960 | if ( !ponly ) { 961 | vgs[i,j] <- REMLE$vg 962 | ves[i,j] <- REMLE$ve 963 | REMLs[i,j] <- REMLE$REML 964 | } 965 | stats[i,j] <- beta[q1]/sqrt(iXX[q1,q1]*REMLE$vg) 966 | } 967 | else { 968 | if ( is.null(Z) ) { 969 | vtids <- vrows & vids 970 | eig.L0 <- emma.eigen.L.wo.Z(K[vtids,vtids,drop=FALSE]) 971 | yv <- ys[j,vtids] 972 | nr <- sum(vtids) 973 | REMLE <- emma.REMLE(yv,X[vtids,,drop=FALSE],K[vtids,vtids,drop=FALSE],NULL,ngrids,llim,ulim,esp) 974 | U <- eig.L0$vectors * matrix(sqrt(1/(eig.L0$values+REMLE$delta)),nr,nr,byrow=TRUE) 975 | Xt <- crossprod(U,X[vtids,,drop=FALSE]) 976 | dfs[i,j] <- nr-q1 977 | } 978 | else { 979 | vtids <- as.logical(colSums(Z[vrows,,drop=FALSE])) & vids 980 | vtrows <- vrows & as.logical(rowSums(Z[,vids,drop=FALSE])) 981 | eig.L0 <- emma.eigen.L.w.Z(Z[vtrows,vtids,drop=FALSE],K[vtids,vtids,drop=FALSE]) 982 | yv <- ys[j,vtrows] 983 | nr <- sum(vtrows) 984 | REMLE <- emma.REMLE(yv,X[vtrows,,drop=FALSE],K[vtids,vtids,drop=FALSE],Z[vtrows,vtids,drop=FALSE],ngrids,llim,ulim,esp) 985 | U <- eig.L0$vectors * matrix(c(sqrt(1/(eig.L0$values+REMLE$delta)),rep(sqrt(1/REMLE$delta),nr-sum(vtids))),nr,nr,byrow=TRUE) 986 | Xt <- crossprod(U,X[vtrows,,drop=FALSE]) 987 | dfs[i,j] <- nr-q1 988 | } 989 | yt <- crossprod(U,yv) 990 | iXX <- solve(crossprod(Xt,Xt)) 991 | beta <- iXX%*%crossprod(Xt,yt) 992 | if ( !ponly ) { 993 | vgs[i,j] <- REMLE$vg 994 | ves[i,j] <- REMLE$ve 995 | REMLs[i,j] <- REMLE$REML 996 | } 997 | stats[i,j] <- beta[q1]/sqrt(iXX[q1,q1]*REMLE$vg) 998 | 999 | } 1000 | } 1001 | ps[i,] <- 2*pt(abs(stats[i,]),dfs[i,],lower.tail=FALSE) 1002 | } 1003 | } 1004 | } 1005 | if ( ponly ) { 1006 | return (ps) 1007 | } 1008 | else { 1009 | return (list(ps=ps,REMLs=REMLs,stats=stats,dfs=dfs,vgs=vgs,ves=ves)) 1010 | } 1011 | } 1012 | 1013 | emma.REML.t <- function(ys, xs, K, Z=NULL, X0 = NULL, ngrids=100, llim=-10, ulim=10, esp=1e-10, ponly = FALSE) { 1014 | if ( is.null(dim(ys)) || ncol(ys) == 1 ) { 1015 | ys <- matrix(ys,1,length(ys)) 1016 | } 1017 | if ( is.null(dim(xs)) || ncol(xs) == 1 ) { 1018 | xs <- matrix(xs,1,length(xs)) 1019 | } 1020 | if ( is.null(X0) ) { 1021 | X0 <- matrix(1,ncol(ys),1) 1022 | } 1023 | 1024 | g <- nrow(ys) 1025 | n <- ncol(ys) 1026 | m <- nrow(xs) 1027 | t <- ncol(xs) 1028 | q0 <- ncol(X0) 1029 | q1 <- q0 + 1 1030 | 1031 | stopifnot(nrow(K) == t) 1032 | stopifnot(ncol(K) == t) 1033 | stopifnot(nrow(X0) == n) 1034 | 1035 | if ( !ponly ) { 1036 | REMLs <- matrix(nrow=m,ncol=g) 1037 | vgs <- matrix(nrow=m,ncol=g) 1038 | ves <- matrix(nrow=m,ncol=g) 1039 | } 1040 | dfs <- matrix(nrow=m,ncol=g) 1041 | stats <- matrix(nrow=m,ncol=g) 1042 | ps <- matrix(nrow=m,ncol=g) 1043 | 1044 | if ( sum(is.na(ys)) == 0 ) { 1045 | eig.L <- emma.eigen.L(Z,K) 1046 | 1047 | x.prev <- vector(length=0) 1048 | 1049 | for(i in 1:m) { 1050 | vids <- !is.na(xs[i,]) 1051 | nv <- sum(vids) 1052 | xv <- xs[i,vids] 1053 | 1054 | if ( ( mean(xv) <= 0 ) || ( mean(xv) >= 1 ) ) { 1055 | if ( !ponly ) { 1056 | vgs[i,] <- rep(NA,g) 1057 | ves[i,] <- rep(NA,g) 1058 | dfs[i,] <- rep(NA,g) 1059 | REMLs[i,] <- rep(NA,g) 1060 | stats[i,] <- rep(NA,g) 1061 | } 1062 | ps[i,] = rep(1,g) 1063 | 1064 | } 1065 | else if ( identical(x.prev, xv) ) { 1066 | if ( !ponly ) { 1067 | vgs[i,] <- vgs[i-1,] 1068 | ves[i,] <- ves[i-1,] 1069 | dfs[i,] <- dfs[i-1,] 1070 | REMLs[i,] <- REMLs[i-1,] 1071 | stats[i,] <- stats[i-1,] 1072 | } 1073 | ps[i,] <- ps[i-1,] 1074 | } 1075 | else { 1076 | if ( is.null(Z) ) { 1077 | X <- cbind(X0[vids,,drop=FALSE],xs[i,vids]) 1078 | eig.R1 = emma.eigen.R.wo.Z(K[vids,vids],X) 1079 | } 1080 | else { 1081 | vrows <- as.logical(rowSums(Z[,vids])) 1082 | X <- cbind(X0[vrows,,drop=FALSE],Z[vrows,vids,drop=FALSE]%*%t(xs[i,vids,drop=FALSE])) 1083 | eig.R1 = emma.eigen.R.w.Z(Z[vrows,vids],K[vids,vids],X) 1084 | } 1085 | 1086 | for(j in 1:g) { 1087 | if ( nv == t ) { 1088 | REMLE <- emma.REMLE(ys[j,],X,K,Z,ngrids,llim,ulim,esp,eig.R1) 1089 | if ( is.null(Z) ) { 1090 | U <- eig.L$vectors * matrix(sqrt(1/(eig.L$values+REMLE$delta)),t,t,byrow=TRUE) 1091 | dfs[i,j] <- nv - q1 1092 | } 1093 | else { 1094 | U <- eig.L$vectors * matrix(c(sqrt(1/(eig.L$values+REMLE$delta)),rep(sqrt(1/REMLE$delta),n-t)),n,n,byrow=TRUE) 1095 | dfs[i,j] <- n - q1 1096 | } 1097 | yt <- crossprod(U,ys[j,]) 1098 | Xt <- crossprod(U,X) 1099 | iXX <- solve(crossprod(Xt,Xt)) 1100 | beta <- iXX%*%crossprod(Xt,yt) 1101 | 1102 | if ( !ponly ) { 1103 | vgs[i,j] <- REMLE$vg 1104 | ves[i,j] <- REMLE$ve 1105 | REMLs[i,j] <- REMLE$REML 1106 | } 1107 | stats[i,j] <- beta[q1]/sqrt(iXX[q1,q1]*REMLE$vg) 1108 | } 1109 | else { 1110 | if ( is.null(Z) ) { 1111 | eig.L0 <- emma.eigen.L.wo.Z(K[vids,vids]) 1112 | nr <- sum(vids) 1113 | yv <- ys[j,vids] 1114 | REMLE <- emma.REMLE(yv,X,K[vids,vids,drop=FALSE],NULL,ngrids,llim,ulim,esp,eig.R1) 1115 | U <- eig.L0$vectors * matrix(sqrt(1/(eig.L0$values+REMLE$delta)),nr,nr,byrow=TRUE) 1116 | dfs[i,j] <- nr - q1 1117 | } 1118 | else { 1119 | eig.L0 <- emma.eigen.L.w.Z(Z[vrows,vids,drop=FALSE],K[vids,vids]) 1120 | yv <- ys[j,vrows] 1121 | nr <- sum(vrows) 1122 | tv <- sum(vids) 1123 | REMLE <- emma.REMLE(yv,X,K[vids,vids,drop=FALSE],Z[vrows,vids,drop=FALSE],ngrids,llim,ulim,esp,eig.R1) 1124 | U <- eig.L0$vectors * matrix(c(sqrt(1/(eig.L0$values+REMLE$delta)),rep(sqrt(1/REMLE$delta),nr-tv)),nr,nr,byrow=TRUE) 1125 | dfs[i,j] <- nr - q1 1126 | } 1127 | yt <- crossprod(U,yv) 1128 | Xt <- crossprod(U,X) 1129 | iXX <- solve(crossprod(Xt,Xt)) 1130 | beta <- iXX%*%crossprod(Xt,yt) 1131 | if (!ponly) { 1132 | vgs[i,j] <- REMLE$vg 1133 | ves[i,j] <- REMLE$ve 1134 | REMLs[i,j] <- REMLE$REML 1135 | } 1136 | stats[i,j] <- beta[q1]/sqrt(iXX[q1,q1]*REMLE$vg) 1137 | } 1138 | } 1139 | ps[i,] <- 2*pt(abs(stats[i,]),dfs[i,],lower.tail=FALSE) 1140 | } 1141 | } 1142 | } 1143 | else { 1144 | eig.L <- emma.eigen.L(Z,K) 1145 | eig.R0 <- emma.eigen.R(Z,K,X0) 1146 | 1147 | x.prev <- vector(length=0) 1148 | 1149 | for(i in 1:m) { 1150 | vids <- !is.na(xs[i,]) 1151 | nv <- sum(vids) 1152 | xv <- xs[i,vids] 1153 | 1154 | if ( ( mean(xv) <= 0 ) || ( mean(xv) >= 1 ) ) { 1155 | if (!ponly) { 1156 | vgs[i,] <- rep(NA,g) 1157 | ves[i,] <- rep(NA,g) 1158 | REMLs[i,] <- rep(NA,g) 1159 | dfs[i,] <- rep(NA,g) 1160 | } 1161 | ps[i,] = rep(1,g) 1162 | } 1163 | else if ( identical(x.prev, xv) ) { 1164 | if ( !ponly ) { 1165 | stats[i,] <- stats[i-1,] 1166 | vgs[i,] <- vgs[i-1,] 1167 | ves[i,] <- ves[i-1,] 1168 | REMLs[i,] <- REMLs[i-1,] 1169 | dfs[i,] <- dfs[i-1,] 1170 | } 1171 | ps[i,] = ps[i-1,] 1172 | } 1173 | else { 1174 | if ( is.null(Z) ) { 1175 | X <- cbind(X0,xs[i,]) 1176 | if ( nv == t ) { 1177 | eig.R1 = emma.eigen.R.wo.Z(K,X) 1178 | } 1179 | } 1180 | else { 1181 | vrows <- as.logical(rowSums(Z[,vids,drop=FALSE])) 1182 | X <- cbind(X0,Z[,vids,drop=FALSE]%*%t(xs[i,vids,drop=FALSE])) 1183 | if ( nv == t ) { 1184 | eig.R1 = emma.eigen.R.w.Z(Z,K,X) 1185 | } 1186 | } 1187 | 1188 | for(j in 1:g) { 1189 | vrows <- !is.na(ys[j,]) 1190 | if ( nv == t ) { 1191 | yv <- ys[j,vrows] 1192 | nr <- sum(vrows) 1193 | if ( is.null(Z) ) { 1194 | if ( nr == n ) { 1195 | REMLE <- emma.REMLE(yv,X,K,NULL,ngrids,llim,ulim,esp,eig.R1) 1196 | U <- eig.L$vectors * matrix(sqrt(1/(eig.L$values+REMLE$delta)),n,n,byrow=TRUE) 1197 | } 1198 | else { 1199 | eig.L0 <- emma.eigen.L.wo.Z(K[vrows,vrows,drop=FALSE]) 1200 | REMLE <- emma.REMLE(yv,X[vrows,,drop=FALSE],K[vrows,vrows,drop=FALSE],NULL,ngrids,llim,ulim,esp) 1201 | U <- eig.L0$vectors * matrix(sqrt(1/(eig.L0$values+REMLE$delta)),nr,nr,byrow=TRUE) 1202 | } 1203 | dfs[i,j] <- nr-q1 1204 | } 1205 | else { 1206 | if ( nr == n ) { 1207 | REMLE <- emma.REMLE(yv,X,K,Z,ngrids,llim,ulim,esp,eig.R1) 1208 | U <- eig.L$vectors * matrix(c(sqrt(1/(eig.L$values+REMLE$delta)),rep(sqrt(1/REMLE$delta),n-t)),n,n,byrow=TRUE) 1209 | } 1210 | else { 1211 | vtids <- as.logical(colSums(Z[vrows,,drop=FALSE])) 1212 | eig.L0 <- emma.eigen.L.w.Z(Z[vrows,vtids,drop=FALSE],K[vtids,vtids,drop=FALSE]) 1213 | REMLE <- emma.REMLE(yv,X[vrows,,drop=FALSE],K[vtids,vtids,drop=FALSE],Z[vrows,vtids,drop=FALSE],ngrids,llim,ulim,esp) 1214 | U <- eig.L0$vectors * matrix(c(sqrt(1/(eig.L0$values+REMLE$delta)),rep(sqrt(1/REMLE$delta),nr-sum(vtids))),nr,nr,byrow=TRUE) 1215 | } 1216 | dfs[i,j] <- nr-q1 1217 | } 1218 | 1219 | yt <- crossprod(U,yv) 1220 | Xt <- crossprod(U,X[vrows,,drop=FALSE]) 1221 | iXX <- solve(crossprod(Xt,Xt)) 1222 | beta <- iXX%*%crossprod(Xt,yt) 1223 | if ( !ponly ) { 1224 | vgs[i,j] <- REMLE$vg 1225 | ves[i,j] <- REMLE$ve 1226 | REMLs[i,j] <- REMLE$REML 1227 | } 1228 | stats[i,j] <- beta[q1]/sqrt(iXX[q1,q1]*REMLE$vg) 1229 | } 1230 | else { 1231 | if ( is.null(Z) ) { 1232 | vtids <- vrows & vids 1233 | eig.L0 <- emma.eigen.L.wo.Z(K[vtids,vtids,drop=FALSE]) 1234 | yv <- ys[j,vtids] 1235 | nr <- sum(vtids) 1236 | REMLE <- emma.REMLE(yv,X[vtids,,drop=FALSE],K[vtids,vtids,drop=FALSE],NULL,ngrids,llim,ulim,esp) 1237 | U <- eig.L0$vectors * matrix(sqrt(1/(eig.L0$values+REMLE$delta)),nr,nr,byrow=TRUE) 1238 | Xt <- crossprod(U,X[vtids,,drop=FALSE]) 1239 | dfs[i,j] <- nr-q1 1240 | } 1241 | else { 1242 | vtids <- as.logical(colSums(Z[vrows,,drop=FALSE])) & vids 1243 | vtrows <- vrows & as.logical(rowSums(Z[,vids,drop=FALSE])) 1244 | eig.L0 <- emma.eigen.L.w.Z(Z[vtrows,vtids,drop=FALSE],K[vtids,vtids,drop=FALSE]) 1245 | yv <- ys[j,vtrows] 1246 | nr <- sum(vtrows) 1247 | REMLE <- emma.REMLE(yv,X[vtrows,,drop=FALSE],K[vtids,vtids,drop=FALSE],Z[vtrows,vtids,drop=FALSE],ngrids,llim,ulim,esp) 1248 | U <- eig.L0$vectors * matrix(c(sqrt(1/(eig.L0$values+REMLE$delta)),rep(sqrt(1/REMLE$delta),nr-sum(vtids))),nr,nr,byrow=TRUE) 1249 | Xt <- crossprod(U,X[vtrows,,drop=FALSE]) 1250 | dfs[i,j] <- nr-q1 1251 | } 1252 | yt <- crossprod(U,yv) 1253 | iXX <- solve(crossprod(Xt,Xt)) 1254 | beta <- iXX%*%crossprod(Xt,yt) 1255 | if ( !ponly ) { 1256 | vgs[i,j] <- REMLE$vg 1257 | ves[i,j] <- REMLE$ve 1258 | REMLs[i,j] <- REMLE$REML 1259 | } 1260 | stats[i,j] <- beta[q1]/sqrt(iXX[q1,q1]*REMLE$vg) 1261 | 1262 | } 1263 | } 1264 | ps[i,] <- 2*pt(abs(stats[i,]),dfs[i,],lower.tail=FALSE) 1265 | } 1266 | } 1267 | } 1268 | if ( ponly ) { 1269 | return (ps) 1270 | } 1271 | else { 1272 | return (list(ps=ps,REMLs=REMLs,stats=stats,dfs=dfs,vgs=vgs,ves=ves)) 1273 | } 1274 | } 1275 | -------------------------------------------------------------------------------- /misc/emmax.r: -------------------------------------------------------------------------------- 1 | ############################################################################################################################################## 2 | ###EMMAX 3 | ###SET OF FUNCTIONS TO RUN GWAS CORRECTING FOR POPULATION STRUCTURE WITH EMMAX (Kang et al. 2010, NatGen 42:348-354) 4 | ####### 5 | # 6 | ##note: require EMMA 7 | #library(emma) 8 | #source('emma.r') 9 | # 10 | ##REQUIRED DATA & FORMAT 11 | # 12 | #PHENOTYPE - Y: a vector of length n with names(Y)=ecotype names 13 | #GENOTYPE - X: a n by m matrix, where n=number of ecotypes, m=number of markers, with rownames(X)=ecotype names, and colnames(X)=SNP names 14 | #KINSHIP - K: a n by n matrix, with rownames(K)=colnames(K)=ecotype names 15 | #each of these data being sorted in the same way, according to the ecotype name 16 | # 17 | ##FOR PLOTING THE GWAS RESULTS 18 | #SNP INFORMATION - snp_info: a data frame having at least 3 columns: 19 | # - 1 named 'SNP', with SNP names (same as colnames(X)), 20 | # - 1 named 'Chr', with the chromosome number to which belong each SNP 21 | # - 1 named 'Pos', with the position of the SNP onto the chromosome it belongs to. 22 | ####### 23 | # 24 | ##FUNCTIONS USE 25 | #save this file somewhere on your computer and source it! 26 | #source('path/fwd_emmax.r') 27 | # 28 | ###EMMAX SCAN 29 | #mygwas<-emmax(Y,X,K,nbchunks) 30 | #X,Y,K as described above 31 | #nbchunks: an integer defining the number of chunks of X to run the analysis, allows to decrease the memory usage ==> minimum=2, increase it if you do not have enough memory 32 | # 33 | ###RESULTS 34 | # 35 | ##FUNCTION OUTPUT 36 | #A LIST: 37 | # $output: a data.frame with the F statitics, pvals and R2 for each SNP tested 38 | # $bonf_thresh: pval threshold according to a bonferonni correction for an alpha of 0.05 39 | # 40 | ##PLOTS 41 | # 42 | #GWAS MANHATTAN PLOT 43 | #plot_GWAS(mygwas,snp_info,pval_filt) 44 | #snp_info as described above 45 | #pval_filt=a p-value threshold for filtering the output, only p-vals below this threshold will be displayed in the plot 46 | # 47 | #GWAS MANHATTAN PLOT ZOOMED IN A REGION OF INTEREST 48 | #plot_region(mygwas,snp_info,chrom,pos1,pos2) 49 | #step, snp_info as described above 50 | #chrom=on which chromosome is the region of interest 51 | #pos1, pos2=delimitations of the region of interest in the same unit as Pos in snp_info 52 | # 53 | #p-values QQplot 54 | #qqplot_GWAS(mygwas) 55 | ############################################################################################################################################## 56 | 57 | emmax<-function(Y,X,K,nbchunks) { 58 | 59 | n<-length(Y) 60 | m<-ncol(X) 61 | 62 | stopifnot(ncol(K) == n) 63 | stopifnot(nrow(K) == n) 64 | stopifnot(nrow(X) == n) 65 | stopifnot(nbchunks >= 2) 66 | 67 | #INTERCEPT 68 | 69 | Xo<-rep(1,n) 70 | 71 | #K MATRIX NORMALISATION 72 | 73 | K_norm<-(n-1)/sum((diag(n)-matrix(1,n,n)/n)*K)*K 74 | rm(K) 75 | 76 | #NULL MODEL 77 | 78 | null<-emma.REMLE(Y,as.matrix(Xo),K_norm) 79 | 80 | pseudoh<-null$vg/(null$vg+null$ve) 81 | 82 | cat('null model done! pseudo-h =',round(pseudoh,3),'\n') 83 | 84 | #EMMAX 85 | 86 | M<-solve(chol(null$vg*K_norm+null$ve*diag(n))) 87 | Y_t<-crossprod(M,Y) 88 | Xo_t<-crossprod(M,Xo) 89 | 90 | RSS<-list() 91 | for (j in 1:(nbchunks-1)) { 92 | X_t<-crossprod(M,X[,((j-1)*round(m/nbchunks)+1):(j*round(m/nbchunks))]) 93 | RSS[[j]]<-apply(X_t,2,function(x){sum(lsfit(cbind(Xo_t,x),Y_t,intercept = FALSE)$residuals^2)}) 94 | rm(X_t)} 95 | X_t<-crossprod(M,X[,((j)*round(m/nbchunks)+1):(m)]) 96 | RSS[[nbchunks]]<-apply(X_t,2,function(x){sum(lsfit(cbind(Xo_t,x),Y_t,intercept = FALSE)$residuals^2)}) 97 | rm(X_t,j) 98 | 99 | RSSf<-unlist(RSS) 100 | RSS_H0<-rep(sum(lsfit(Xo_t,Y_t,intercept = FALSE)$residuals^2),m) 101 | df1<-1 102 | df2<-n-df1-1 103 | R2<-1-1/(RSS_H0/RSSf) 104 | F<-(RSS_H0/RSSf-1)*df2/df1 105 | pval<-pf(F,df1,df2,lower.tail=FALSE) 106 | 107 | cat('EMMAX scan done! \n') 108 | 109 | cat('creating output','\n') 110 | 111 | list(output=data.frame(SNP=colnames(X),'F'=F,'pval'=pval,'Rsq'=R2),bonf_thresh=-log10(0.05/m))} 112 | 113 | linreg<-function(Y,X,nbchunks) { 114 | 115 | n<-length(Y) 116 | m<-ncol(X) 117 | 118 | stopifnot(nrow(X) == n) 119 | stopifnot(nbchunks >= 2) 120 | 121 | #INTERCEPT 122 | 123 | Xo<-rep(1,n) 124 | 125 | RSS<-list() 126 | for (j in 1:(nbchunks-1)) {RSS[[j]]<-apply(X[,((j-1)*round(m/nbchunks)+1):(j*round(m/nbchunks))],2,function(x){sum(lsfit(cbind(Xo,x),Y,intercept=FALSE)$residuals^2)})} 127 | RSS[[nbchunks]]<-apply(X[,((j)*round(m/nbchunks)+1):(m)],2,function(x){sum(lsfit(cbind(Xo,x),Y,intercept=FALSE)$residuals^2)}) 128 | rm(j) 129 | 130 | RSSf<-unlist(RSS) 131 | RSS_H0<-rep(sum(lsfit(Xo,Y,intercept=FALSE)$residuals^2),m) 132 | df1<-1 133 | df2<-n-df1-1 134 | R2<-1-1/(RSS_H0/RSSf) 135 | F<-(RSS_H0/RSSf-1)*df2/df1 136 | pval<-pf(F,df1,df2,lower.tail=FALSE) 137 | 138 | cat('linreg scan done! \n') 139 | 140 | cat('creating output','\n') 141 | 142 | list(output=data.frame(SNP=colnames(X),'F'=F,'pval'=pval,'Rsq'=R2),bonf_thresh=-log10(0.05/m))} 143 | 144 | 145 | plot_GWAS<-function(x,snp_info,pval_filt) { 146 | 147 | output<-subset(merge(snp_info,x$output,by='SNP'),pval<=pval_filt) 148 | output_<-output[order(output$Pos),] 149 | output_ok<-output_[order(output_$Chr),] 150 | 151 | maxpos<-c(0,cumsum(aggregate(output_ok$Pos,list(output_ok$Chr),max)$x+max(cumsum(aggregate(output_ok$Pos,list(output_ok$Chr),max)$x))/100)) 152 | plot_col<-rep(c('gray10','gray60'),ceiling(max(unique(output_ok$Chr))/2)) 153 | #plot_col<-c('blue','darkgreen','red','cyan','purple') 154 | size<-aggregate(output_ok$Pos,list(output_ok$Chr),length)$x 155 | 156 | a<-rep(maxpos[1],size[1]) 157 | b<-rep(plot_col[1],size[1]) 158 | if (length(unique(output_ok$Chr))>1){ 159 | for (i in 2:length(unique(output_ok$Chr))){ 160 | a<-c(a,rep(maxpos[i],size[i])) 161 | b<-c(b,rep(plot_col[i],size[i]))}} 162 | 163 | output_ok$xpos<-output_ok$Pos+a 164 | output_ok$col<-b 165 | 166 | d<-(aggregate(output_ok$xpos,list(output_ok$Chr),min)$x+aggregate(output_ok$xpos,list(output_ok$Chr),max)$x)/2 167 | 168 | plot(output_ok$xpos,-log10(output_ok$pval),col=output_ok$col,pch=20,ylab='-log10(pval)',xaxt='n',xlab='chromosome') 169 | axis(1,tick=FALSE,at=d,labels=unique(output_ok$Chr)) 170 | abline(h=x$bonf_thresh,lty=3,col='black')} 171 | 172 | 173 | plot_region<-function(x,snp_info,chrom,pos1,pos2){ 174 | 175 | output<-merge(snp_info,x$output,by='SNP') 176 | region<-subset(output,Chr==chrom & Pos>=pos1 & Pos <=pos2) 177 | 178 | plot(region$Pos,-log10(region$pval),type='p',pch=20,main=paste('chromosome',chrom,sep=''),xlab='position (bp)',ylab='-log10(pval)',col='gray40',xlim=c(pos1,pos2)) 179 | abline(h=x$bonf_thresh,lty=3,col='black')} 180 | 181 | qqplot_GWAS<-function(x){ 182 | e<--log10(ppoints(nrow(x$output))) 183 | o<--log10(sort(x$output$pval)) 184 | 185 | plot(e,o,type='b',pch=20,cex=0.8,col=1,xlab=expression(Expected~~-log[10](italic(p))), ylab=expression(Observed~~-log[10](italic(p)))) 186 | abline(0,1,col="dark grey")} 187 | -------------------------------------------------------------------------------- /misc/example_data.Rdata: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Gregor-Mendel-Institute/MultLocMixMod/e1aa9ab4779d98b95d1f83a4edc7f9df5f4e7c14/misc/example_data.Rdata -------------------------------------------------------------------------------- /misc/example_data_bis.Rdata: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Gregor-Mendel-Institute/MultLocMixMod/e1aa9ab4779d98b95d1f83a4edc7f9df5f4e7c14/misc/example_data_bis.Rdata -------------------------------------------------------------------------------- /misc/phenot.txt: -------------------------------------------------------------------------------- 1 | Ind_id Phenot1 Phenot2 2 | Ind1 -2.9985936006411 -2.9985936006411 3 | Ind2 -2.68669426456267 -2.68669426456267 4 | Ind3 -18.2181577678362 -18.2181577678362 5 | Ind4 -12.5401016500159 -12.5401016500159 6 | Ind5 7.72670043773802 7.72670043773802 7 | Ind6 5.25010246801007 5.25010246801007 8 | Ind7 0.417402126827894 0.417402126827894 9 | Ind8 10.6214497655125 10.6214497655125 10 | Ind9 -18.3014674338768 -18.3014674338768 11 | Ind10 -18.6098675031914 NA 12 | Ind11 -4.03477186214533 -4.03477186214533 13 | Ind12 -15.9882829569252 -15.9882829569252 14 | Ind13 -1.04632067604619 -1.04632067604619 15 | Ind14 -5.66838909636386 -5.66838909636386 16 | Ind15 2.58509745805752 2.58509745805752 17 | Ind16 -3.24187957417854 -3.24187957417854 18 | Ind17 -23.2729677083008 -23.2729677083008 19 | Ind18 6.96435357361898 6.96435357361898 20 | Ind19 -8.86432852665433 -8.86432852665433 21 | Ind20 -2.43021151820351 -2.43021151820351 22 | Ind21 -11.4044395258052 -11.4044395258052 23 | Ind22 4.77444855571111 4.77444855571111 24 | Ind23 18.2425783461208 NA 25 | Ind24 -16.1003230103367 -16.1003230103367 26 | Ind25 3.48578405180521 3.48578405180521 27 | Ind26 -13.6317796013066 -13.6317796013066 28 | Ind27 -17.8299036740888 -17.8299036740888 29 | Ind28 12.8760218262878 12.8760218262878 30 | Ind29 0.982337452944073 0.982337452944073 31 | Ind30 6.89441228302578 NA 32 | Ind31 -9.79070987759412 -9.79070987759412 33 | Ind32 -7.33335887602666 -7.33335887602666 34 | Ind33 -9.38112263525387 -9.38112263525387 35 | Ind34 -17.418514681802 -17.418514681802 36 | Ind35 -1.36926657800065 NA 37 | Ind36 -15.8925185459182 -15.8925185459182 38 | Ind37 -16.6664415036233 -16.6664415036233 39 | Ind38 -17.6113176227666 -17.6113176227666 40 | Ind39 8.09960655518536 8.09960655518536 41 | Ind40 -14.9600772642048 -14.9600772642048 42 | Ind41 -2.46258520207899 -2.46258520207899 43 | Ind42 3.52692956060259 3.52692956060259 44 | Ind43 -2.56849421725468 NA 45 | Ind44 0.462204831714866 0.462204831714866 46 | Ind45 -3.38429200532215 -3.38429200532215 47 | Ind46 -9.02868604003372 -9.02868604003372 48 | Ind47 5.19312365030726 5.19312365030726 49 | Ind48 11.362118479605 11.362118479605 50 | Ind49 -4.7016396675323 -4.7016396675323 51 | Ind50 -6.49221835766938 -6.49221835766938 52 | Ind51 8.74611923535598 8.74611923535598 53 | Ind52 20.0594288752544 20.0594288752544 54 | Ind53 -1.11475618282811 -1.11475618282811 55 | Ind54 -10.6088037144513 -10.6088037144513 56 | Ind55 -1.02045642033812 -1.02045642033812 57 | Ind56 -9.96139275677573 -9.96139275677573 58 | Ind57 3.07304203895751 3.07304203895751 59 | Ind58 -12.1924312705288 -12.1924312705288 60 | Ind59 3.05865100310952 3.05865100310952 61 | Ind60 7.09555942891504 7.09555942891504 62 | Ind61 -11.8186149500922 -11.8186149500922 63 | Ind62 -1.65105172480334 -1.65105172480334 64 | Ind63 1.30018923413375 1.30018923413375 65 | Ind64 -13.4333408135065 -13.4333408135065 66 | Ind65 -7.02813352566701 -7.02813352566701 67 | Ind66 13.8480146064731 13.8480146064731 68 | Ind67 -0.984981720446856 -0.984981720446856 69 | Ind68 -16.5795212756351 -16.5795212756351 70 | Ind69 4.17245531503865 4.17245531503865 71 | Ind70 -6.42799646672008 -6.42799646672008 72 | Ind71 13.5192944193829 13.5192944193829 73 | Ind72 -2.80402277594647 -2.80402277594647 74 | Ind73 -15.0486960942153 -15.0486960942153 75 | Ind74 0.0372137470215899 0.0372137470215899 76 | Ind75 -0.854371678661337 -0.854371678661337 77 | Ind76 11.5856619179338 11.5856619179338 78 | Ind77 -26.4907768158664 -26.4907768158664 79 | Ind78 -3.12931669517017 -3.12931669517017 80 | Ind79 -13.760048976086 -13.760048976086 81 | Ind80 -1.03667332000764 -1.03667332000764 82 | Ind81 1.98118654229534 1.98118654229534 83 | Ind82 -9.63094615407686 -9.63094615407686 84 | Ind83 -11.6395266623602 -11.6395266623602 85 | Ind84 -7.08357127398883 -7.08357127398883 86 | Ind85 12.9387551173972 12.9387551173972 87 | Ind86 -1.30834381449001 -1.30834381449001 88 | Ind87 13.6609913266554 13.6609913266554 89 | Ind88 6.39847190987683 6.39847190987683 90 | Ind89 -1.34730952287177 -1.34730952287177 91 | Ind90 -16.6048003152535 -16.6048003152535 92 | Ind91 16.6084424113242 16.6084424113242 93 | Ind92 6.64141034078026 NA 94 | Ind93 -9.40744181889942 -9.40744181889942 95 | Ind94 14.4360126037192 14.4360126037192 96 | Ind95 17.0774285382076 17.0774285382076 97 | Ind96 21.5510873447909 21.5510873447909 98 | Ind97 -8.72639590607163 -8.72639590607163 99 | Ind98 -8.68619309548353 -8.68619309548353 100 | Ind99 8.40048931868843 8.40048931868843 101 | Ind100 13.1300525230761 13.1300525230761 102 | Ind101 -2.92830356953823 -2.92830356953823 103 | Ind102 -2.94262901105908 -2.94262901105908 104 | Ind103 3.82836898455099 3.82836898455099 105 | Ind104 -9.10393737141981 -9.10393737141981 106 | Ind105 -4.85359562916628 -4.85359562916628 107 | Ind106 -16.3977102849185 -16.3977102849185 108 | Ind107 14.3067808268272 NA 109 | Ind108 -10.7110724319878 -10.7110724319878 110 | Ind109 -13.793436350179 -13.793436350179 111 | Ind110 5.97728570044173 5.97728570044173 112 | Ind111 17.1428248668007 17.1428248668007 113 | Ind112 12.4605869492483 12.4605869492483 114 | Ind113 3.75244657699406 3.75244657699406 115 | Ind114 -18.7971775261737 -18.7971775261737 116 | Ind115 -9.1709149242581 -9.1709149242581 117 | Ind116 -29.3270528589892 NA 118 | Ind117 -22.3814867931523 -22.3814867931523 119 | Ind118 1.28363190425234 1.28363190425234 120 | Ind119 -14.050944671816 -14.050944671816 121 | Ind120 -10.3732426881542 -10.3732426881542 122 | Ind121 -5.17498301406097 -5.17498301406097 123 | Ind122 2.90844279253387 2.90844279253387 124 | Ind123 -0.146565603565181 -0.146565603565181 125 | Ind124 -10.9243149535139 NA 126 | Ind125 -5.00827211221728 -5.00827211221728 127 | Ind126 -18.1213282800367 -18.1213282800367 128 | Ind127 4.14427812212841 4.14427812212841 129 | Ind128 0.804018588062293 0.804018588062293 130 | Ind129 -3.60570310975079 -3.60570310975079 131 | Ind130 -6.21857387301066 -6.21857387301066 132 | Ind131 -8.76660307460427 -8.76660307460427 133 | Ind132 -21.0015355437525 -21.0015355437525 134 | Ind133 -11.6823507360326 -11.6823507360326 135 | Ind134 -3.66842415962014 -3.66842415962014 136 | Ind135 -5.36621147209504 -5.36621147209504 137 | Ind136 4.35407712512925 4.35407712512925 138 | Ind137 -2.78914861613039 -2.78914861613039 139 | Ind138 1.05480446657816 1.05480446657816 140 | Ind139 0.817741011930843 0.817741011930843 141 | Ind140 -7.488134380328 -7.488134380328 142 | Ind141 -18.8417124408817 -18.8417124408817 143 | Ind142 7.86611857010879 7.86611857010879 144 | Ind143 -3.57321345565342 -3.57321345565342 145 | Ind144 1.33350838474607 1.33350838474607 146 | Ind145 -15.0218067857209 -15.0218067857209 147 | Ind146 -6.0890403283266 -6.0890403283266 148 | Ind147 -11.1983489132634 -11.1983489132634 149 | Ind148 8.88229065380888 8.88229065380888 150 | Ind149 -2.254091293164 -2.254091293164 151 | Ind150 -13.0978058402696 -13.0978058402696 152 | Ind151 0.534854717387266 0.534854717387266 153 | Ind152 7.17175734100575 7.17175734100575 154 | Ind153 -5.07571735672902 -5.07571735672902 155 | Ind154 5.15096178583793 5.15096178583793 156 | Ind155 2.9595766045094 2.9595766045094 157 | Ind156 -4.35882640452958 -4.35882640452958 158 | Ind157 -15.9604112424327 -15.9604112424327 159 | Ind158 -14.6692853963644 -14.6692853963644 160 | Ind159 -16.0822058113192 -16.0822058113192 161 | Ind160 3.60131510823639 3.60131510823639 162 | Ind161 12.6261685927466 12.6261685927466 163 | Ind162 12.8491127253766 12.8491127253766 164 | Ind163 -7.57846722041949 -7.57846722041949 165 | Ind164 -8.99044093923668 -8.99044093923668 166 | Ind165 -18.2010242462012 -18.2010242462012 167 | Ind166 0.0971652315124167 0.0971652315124167 168 | Ind167 7.98511217698198 7.98511217698198 169 | Ind168 -12.5595908253226 -12.5595908253226 170 | Ind169 -19.268360017165 -19.268360017165 171 | Ind170 -8.44358628215928 -8.44358628215928 172 | Ind171 -1.40270042453906 -1.40270042453906 173 | Ind172 5.27488162654375 5.27488162654375 174 | Ind173 -7.77350565768314 -7.77350565768314 175 | Ind174 2.41079646458619 2.41079646458619 176 | Ind175 -7.77007029594849 -7.77007029594849 177 | Ind176 4.16103859171198 4.16103859171198 178 | Ind177 13.7235336938684 13.7235336938684 179 | Ind178 -6.14271890464263 NA 180 | Ind179 -9.33983756951788 -9.33983756951788 181 | Ind180 -8.59252105055351 -8.59252105055351 182 | Ind181 -8.90543844445217 -8.90543844445217 183 | Ind182 -3.86947268831417 -3.86947268831417 184 | Ind183 3.02034433484337 3.02034433484337 185 | Ind184 -15.1333319967984 -15.1333319967984 186 | Ind185 8.56712696044838 8.56712696044838 187 | Ind186 -24.6653144941308 -24.6653144941308 188 | Ind187 4.47197229405334 4.47197229405334 189 | Ind188 21.570009247379 21.570009247379 190 | Ind189 8.06529969199982 8.06529969199982 191 | Ind190 1.45948181345615 1.45948181345615 192 | Ind191 12.0848887401151 12.0848887401151 193 | Ind192 -0.534808502956222 -0.534808502956222 194 | Ind193 3.26249249163004 3.26249249163004 195 | Ind194 -6.7375128754922 -6.7375128754922 196 | Ind195 13.4438565144384 13.4438565144384 197 | Ind196 13.7654162494864 13.7654162494864 198 | Ind197 -6.89801032155838 -6.89801032155838 199 | Ind198 10.3654528153198 10.3654528153198 200 | Ind199 -1.88088038414184 NA 201 | Ind200 -2.0923519085769 NA 202 | Ind201 -21.9201339707461 -21.9201339707461 203 | Ind202 -13.3348697854015 -13.3348697854015 204 | Ind203 7.53458551198368 7.53458551198368 205 | Ind204 -8.36959296588587 -8.36959296588587 206 | Ind205 5.94328584128221 5.94328584128221 207 | Ind206 -7.4207205804062 -7.4207205804062 208 | Ind207 -4.2895173279968 -4.2895173279968 209 | Ind208 -11.9853354755388 -11.9853354755388 210 | Ind209 -18.9105153044226 -18.9105153044226 211 | Ind210 -0.0192079561930187 -0.0192079561930187 212 | Ind211 0.0727256907528968 0.0727256907528968 213 | Ind212 0.160497797951634 0.160497797951634 214 | Ind213 2.02757848484629 2.02757848484629 215 | Ind214 -0.786148539497564 -0.786148539497564 216 | Ind215 -19.7964056829759 -19.7964056829759 217 | Ind216 -8.91259853485513 -8.91259853485513 218 | Ind217 -12.0577132753139 -12.0577132753139 219 | Ind218 -6.01154843007384 -6.01154843007384 220 | Ind219 5.29809804075035 5.29809804075035 221 | Ind220 -10.045617932656 -10.045617932656 222 | Ind221 4.13470933878406 4.13470933878406 223 | Ind222 -6.15163736919749 -6.15163736919749 224 | Ind223 -6.45951957655563 -6.45951957655563 225 | Ind224 5.92593035169213 5.92593035169213 226 | Ind225 11.6296956939284 11.6296956939284 227 | Ind226 1.28928656926097 1.28928656926097 228 | Ind227 -22.4206562755942 -22.4206562755942 229 | Ind228 3.36641564850795 3.36641564850795 230 | Ind229 3.75600758539542 3.75600758539542 231 | Ind230 -10.0776515107476 -10.0776515107476 232 | Ind231 -8.9001832294721 -8.9001832294721 233 | Ind232 -7.93429595471802 -7.93429595471802 234 | Ind233 -23.620523239262 -23.620523239262 235 | Ind234 -3.20607073192818 -3.20607073192818 236 | Ind235 -2.69697816837255 -2.69697816837255 237 | Ind236 -16.4799607284778 -16.4799607284778 238 | Ind237 0.488956323716927 0.488956323716927 239 | Ind238 -5.00820287274718 -5.00820287274718 240 | Ind239 -10.5169717844646 -10.5169717844646 241 | Ind240 -18.9530968440583 -18.9530968440583 242 | Ind241 8.67616457549299 8.67616457549299 243 | Ind242 -7.01684005949727 -7.01684005949727 244 | Ind243 -5.0246056176016 -5.0246056176016 245 | Ind244 3.77027275248025 3.77027275248025 246 | Ind245 -3.81478914430244 -3.81478914430244 247 | Ind246 -7.26475947536474 -7.26475947536474 248 | Ind247 -8.60662346567962 -8.60662346567962 249 | Ind248 -2.70269743251903 -2.70269743251903 250 | Ind249 -2.54481604112126 -2.54481604112126 251 | Ind250 -13.7929257735676 -13.7929257735676 252 | Ind251 7.93220285782777 7.93220285782777 253 | Ind252 -13.5558785801114 -13.5558785801114 254 | Ind253 9.45199045080389 9.45199045080389 255 | Ind254 5.32481032092939 5.32481032092939 256 | Ind255 -2.48938461691617 -2.48938461691617 257 | Ind256 5.78233459717692 5.78233459717692 258 | Ind257 -12.6834394252676 -12.6834394252676 259 | Ind258 0.0258155892380869 0.0258155892380869 260 | Ind259 4.74192466967429 4.74192466967429 261 | Ind260 2.68731832494476 2.68731832494476 262 | Ind261 -22.7964905826344 -22.7964905826344 263 | Ind262 -0.833885484652638 -0.833885484652638 264 | Ind263 1.91968508068336 1.91968508068336 265 | Ind264 -6.76510250624199 -6.76510250624199 266 | Ind265 -8.58359103228776 -8.58359103228776 267 | Ind266 -4.48540475330758 -4.48540475330758 268 | Ind267 -12.5327962996933 -12.5327962996933 269 | Ind268 -14.9219959125905 -14.9219959125905 270 | Ind269 -12.2322883145138 -12.2322883145138 271 | Ind270 -7.67598402043898 -7.67598402043898 272 | Ind271 -2.34362418897725 -2.34362418897725 273 | Ind272 4.36337827290926 4.36337827290926 274 | Ind273 -17.9467087802355 -17.9467087802355 275 | Ind274 -1.19041276947988 NA 276 | Ind275 7.72310795563776 7.72310795563776 277 | Ind276 3.5016576294811 3.5016576294811 278 | Ind277 -14.8164758269748 -14.8164758269748 279 | Ind278 6.47458625706743 6.47458625706743 280 | Ind279 -11.0601124021084 -11.0601124021084 281 | Ind280 5.80223419603082 5.80223419603082 282 | Ind281 3.60510461117572 3.60510461117572 283 | Ind282 6.05566907450489 6.05566907450489 284 | Ind283 -3.10086193507285 -3.10086193507285 285 | Ind284 -19.1041779629724 -19.1041779629724 286 | Ind285 -15.1130411906293 -15.1130411906293 287 | Ind286 -0.0667396166575374 -0.0667396166575374 288 | Ind287 -7.64651391164885 -7.64651391164885 289 | Ind288 2.02979157289482 NA 290 | Ind289 -10.8448549255713 -10.8448549255713 291 | Ind290 4.80856865719752 4.80856865719752 292 | Ind291 16.1646672390601 16.1646672390601 293 | Ind292 -0.567870439225785 -0.567870439225785 294 | Ind293 -4.20859502012268 -4.20859502012268 295 | Ind294 -7.28669071671718 -7.28669071671718 296 | Ind295 10.3464246678888 10.3464246678888 297 | Ind296 -6.74349162732319 -6.74349162732319 298 | Ind297 8.96957748948525 8.96957748948525 299 | Ind298 9.93652300752593 9.93652300752593 300 | Ind299 3.35113650538986 3.35113650538986 301 | Ind300 -3.383235716659 -3.383235716659 302 | Ind301 8.95951138238703 8.95951138238703 303 | Ind302 3.06891557818857 3.06891557818857 304 | Ind303 4.03404531375539 4.03404531375539 305 | Ind304 -16.1895162404003 -16.1895162404003 306 | Ind305 -4.15364879433127 -4.15364879433127 307 | Ind306 9.79863365897241 9.79863365897241 308 | Ind307 18.0625003790269 18.0625003790269 309 | Ind308 -13.4650724901232 -13.4650724901232 310 | Ind309 -3.33772724225896 -3.33772724225896 311 | Ind310 -11.3401865713567 -11.3401865713567 312 | Ind311 6.78794120666559 6.78794120666559 313 | Ind312 -5.6392572368876 -5.6392572368876 314 | Ind313 -10.6988844455389 -10.6988844455389 315 | Ind314 -8.34314976446663 -8.34314976446663 316 | Ind315 -2.72242100540515 -2.72242100540515 317 | Ind316 -4.33849107597602 NA 318 | Ind317 -10.1730647960328 -10.1730647960328 319 | Ind318 -8.49575963920392 NA 320 | Ind319 -12.772266161195 -12.772266161195 321 | Ind320 19.8551330501056 19.8551330501056 322 | Ind321 -13.9676231153734 -13.9676231153734 323 | Ind322 -13.4989455309342 NA 324 | Ind323 -23.8265009039074 -23.8265009039074 325 | Ind324 2.12873500115358 2.12873500115358 326 | Ind325 -11.0419035408938 -11.0419035408938 327 | Ind326 -7.68462385453668 -7.68462385453668 328 | Ind327 0.680589353140042 0.680589353140042 329 | Ind328 -6.62909412213503 -6.62909412213503 330 | Ind329 -1.41353659900502 -1.41353659900502 331 | Ind330 1.57313311665376 1.57313311665376 332 | Ind331 -14.7968731503767 -14.7968731503767 333 | Ind332 -17.1515186016499 -17.1515186016499 334 | Ind333 21.1212349101327 21.1212349101327 335 | Ind334 13.0338757470657 13.0338757470657 336 | Ind335 6.62632736793051 6.62632736793051 337 | Ind336 7.65469728540538 7.65469728540538 338 | Ind337 -7.82644378710383 -7.82644378710383 339 | Ind338 6.50830211794911 NA 340 | Ind339 2.8155359671071 2.8155359671071 341 | Ind340 4.01316776310646 4.01316776310646 342 | Ind341 -2.52055097156208 -2.52055097156208 343 | Ind342 9.68125999702142 9.68125999702142 344 | Ind343 -23.0380872017253 -23.0380872017253 345 | Ind344 6.0546633723654 6.0546633723654 346 | Ind345 -8.70457002019241 -8.70457002019241 347 | Ind346 -15.8223562118312 -15.8223562118312 348 | Ind347 17.8578918896843 17.8578918896843 349 | Ind348 2.56011393577987 2.56011393577987 350 | Ind349 16.5382242070131 16.5382242070131 351 | Ind350 -0.418502173399471 -0.418502173399471 352 | Ind351 -5.48006711752555 -5.48006711752555 353 | Ind352 19.3258241951788 19.3258241951788 354 | Ind353 -3.92923821934185 -3.92923821934185 355 | Ind354 -14.3720408668199 -14.3720408668199 356 | Ind355 8.03437461732022 8.03437461732022 357 | Ind356 -6.9808072207318 -6.9808072207318 358 | Ind357 -2.5461722752345 -2.5461722752345 359 | Ind358 7.40558820019407 7.40558820019407 360 | Ind359 16.2502057086946 16.2502057086946 361 | Ind360 -1.01095696373171 -1.01095696373171 362 | Ind361 -3.73272987168673 -3.73272987168673 363 | Ind362 8.13317846226302 NA 364 | Ind363 -20.3449108109546 -20.3449108109546 365 | Ind364 9.2218922429141 9.2218922429141 366 | Ind365 -5.00081165625105 -5.00081165625105 367 | Ind366 -4.04736694631235 -4.04736694631235 368 | Ind367 2.38411348535499 2.38411348535499 369 | Ind368 -1.39287622541061 -1.39287622541061 370 | Ind369 -16.5117491999506 NA 371 | Ind370 -14.6494091055374 -14.6494091055374 372 | Ind371 -7.11238835713166 -7.11238835713166 373 | Ind372 -14.1516523426913 -14.1516523426913 374 | Ind373 12.0306115988504 12.0306115988504 375 | Ind374 -8.40454161192661 -8.40454161192661 376 | Ind375 -5.20558362752534 -5.20558362752534 377 | Ind376 -2.738445702205 NA 378 | Ind377 -3.46991640567611 -3.46991640567611 379 | Ind378 3.56873471713344 3.56873471713344 380 | Ind379 -8.61635774156941 -8.61635774156941 381 | Ind380 -10.2803455043502 -10.2803455043502 382 | Ind381 -6.82617455466369 -6.82617455466369 383 | Ind382 10.6747020342023 10.6747020342023 384 | Ind383 7.45614888073872 7.45614888073872 385 | Ind384 0.0258033523950927 0.0258033523950927 386 | Ind385 -10.2548123063749 -10.2548123063749 387 | Ind386 6.0718619347095 6.0718619347095 388 | Ind387 -7.93275993000319 -7.93275993000319 389 | Ind388 -1.49012871721596 -1.49012871721596 390 | Ind389 4.46218352304845 4.46218352304845 391 | Ind390 6.31742473301081 6.31742473301081 392 | Ind391 8.11941301453443 8.11941301453443 393 | Ind392 19.4539305886578 19.4539305886578 394 | Ind393 -5.93244201270524 -5.93244201270524 395 | Ind394 -5.04383025801379 -5.04383025801379 396 | Ind395 20.5704126628621 20.5704126628621 397 | Ind396 7.95489939103644 7.95489939103644 398 | Ind397 8.86435303756314 8.86435303756314 399 | Ind398 -13.2428299993248 -13.2428299993248 400 | Ind399 3.78285212162381 3.78285212162381 401 | Ind400 -4.02253528029895 -4.02253528029895 402 | Ind401 8.09637270590488 8.09637270590488 403 | Ind402 -5.07311160743699 -5.07311160743699 404 | Ind403 25.3246706605623 25.3246706605623 405 | Ind404 -9.37831355864463 -9.37831355864463 406 | Ind405 1.51090747802638 1.51090747802638 407 | Ind406 5.43167444762335 5.43167444762335 408 | Ind407 8.87906274024805 8.87906274024805 409 | Ind408 -4.66094750608225 -4.66094750608225 410 | Ind409 13.9523371383942 13.9523371383942 411 | Ind410 -21.7489986447953 -21.7489986447953 412 | Ind411 3.63087289660466 3.63087289660466 413 | Ind412 -7.28557138176745 -7.28557138176745 414 | Ind413 9.90771261975745 9.90771261975745 415 | Ind414 -6.63360770716923 -6.63360770716923 416 | Ind415 -11.6462997607846 -11.6462997607846 417 | Ind416 -5.16413899142312 -5.16413899142312 418 | Ind417 4.18820760770602 4.18820760770602 419 | Ind418 -7.99453947508391 -7.99453947508391 420 | Ind419 -7.36353065076308 -7.36353065076308 421 | Ind420 1.55602020780775 1.55602020780775 422 | Ind421 -9.49723313250572 -9.49723313250572 423 | Ind422 -6.88614454868852 -6.88614454868852 424 | Ind423 -12.3248092127303 -12.3248092127303 425 | Ind424 -18.671461132403 -18.671461132403 426 | Ind425 1.36473273071079 NA 427 | Ind426 -5.8867712610241 -5.8867712610241 428 | Ind427 -9.50273004869248 -9.50273004869248 429 | Ind428 -4.81943622063048 -4.81943622063048 430 | Ind429 -26.2142525264157 -26.2142525264157 431 | Ind430 14.8425350408079 14.8425350408079 432 | Ind431 -9.16761728314715 -9.16761728314715 433 | Ind432 -1.00320200216495 -1.00320200216495 434 | Ind433 13.774402701527 13.774402701527 435 | Ind434 -13.1693917708243 -13.1693917708243 436 | Ind435 -15.6696471881704 -15.6696471881704 437 | Ind436 -3.67159990332953 -3.67159990332953 438 | Ind437 13.5297254120583 13.5297254120583 439 | Ind438 -0.112602110411935 -0.112602110411935 440 | Ind439 -13.8888752459368 -13.8888752459368 441 | Ind440 -5.06357674519975 -5.06357674519975 442 | Ind441 3.70142882013138 3.70142882013138 443 | Ind442 -8.99091178928531 -8.99091178928531 444 | Ind443 7.17805994018753 7.17805994018753 445 | Ind444 -0.266253301970805 -0.266253301970805 446 | Ind445 8.94133832711641 8.94133832711641 447 | Ind446 11.8626382537432 11.8626382537432 448 | Ind447 1.46579823769644 1.46579823769644 449 | Ind448 4.97944326839486 4.97944326839486 450 | Ind449 -6.12599552963873 -6.12599552963873 451 | Ind450 2.02124592400588 2.02124592400588 452 | Ind451 5.99343387340862 5.99343387340862 453 | Ind452 5.91859404910017 5.91859404910017 454 | Ind453 5.26076650830962 NA 455 | Ind454 21.079384146455 21.079384146455 456 | Ind455 -19.8109434066481 -19.8109434066481 457 | Ind456 -1.95890830148838 -1.95890830148838 458 | Ind457 -21.7572487645643 -21.7572487645643 459 | Ind458 6.68427079420261 6.68427079420261 460 | Ind459 -0.00848186185855004 -0.00848186185855004 461 | Ind460 0.173826840582155 0.173826840582155 462 | Ind461 2.91595224945219 2.91595224945219 463 | Ind462 -9.29007019936385 -9.29007019936385 464 | Ind463 0.381452713728563 0.381452713728563 465 | Ind464 -3.89608517962285 -3.89608517962285 466 | Ind465 13.158651656358 13.158651656358 467 | Ind466 -2.4007151168472 -2.4007151168472 468 | Ind467 13.4474547090651 13.4474547090651 469 | Ind468 12.856692609112 12.856692609112 470 | Ind469 -3.25976986805755 -3.25976986805755 471 | Ind470 -6.35949771507445 -6.35949771507445 472 | Ind471 20.3208227858756 NA 473 | Ind472 5.67442559054238 5.67442559054238 474 | Ind473 -4.47561172897561 -4.47561172897561 475 | Ind474 -9.14418324318106 -9.14418324318106 476 | Ind475 1.1887403231858 1.1887403231858 477 | Ind476 -13.5862130319871 -13.5862130319871 478 | Ind477 16.6879999050854 16.6879999050854 479 | Ind478 -17.1389687195975 -17.1389687195975 480 | Ind479 -13.551122507557 -13.551122507557 481 | Ind480 -8.94167774042331 -8.94167774042331 482 | Ind481 7.29409149872752 7.29409149872752 483 | Ind482 -1.77917153389365 -1.77917153389365 484 | Ind483 -7.09889887976419 -7.09889887976419 485 | Ind484 -24.1386330395452 -24.1386330395452 486 | Ind485 0.834467682805625 0.834467682805625 487 | Ind486 -2.57299735289436 -2.57299735289436 488 | Ind487 -21.3142343190533 -21.3142343190533 489 | Ind488 -15.3242121153467 -15.3242121153467 490 | Ind489 -1.26949587391629 -1.26949587391629 491 | Ind490 -17.2632576427363 -17.2632576427363 492 | Ind491 2.62910436373452 2.62910436373452 493 | Ind492 -11.4255273107226 -11.4255273107226 494 | Ind493 -8.51899200969042 -8.51899200969042 495 | Ind494 -1.07660369147835 -1.07660369147835 496 | Ind495 -13.876458194635 NA 497 | Ind496 -16.303864296789 -16.303864296789 498 | Ind497 0.539683578070243 0.539683578070243 499 | Ind498 -0.51004693545679 -0.51004693545679 500 | Ind499 -6.12081197198746 -6.12081197198746 501 | Ind500 -9.94515897141559 -9.94515897141559 502 | -------------------------------------------------------------------------------- /mlmm.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: No 4 | SaveWorkspace: No 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | Encoding: UTF-8 9 | 10 | AutoAppendNewline: Yes 11 | StripTrailingWhitespace: Yes 12 | 13 | BuildType: Package 14 | PackageUseDevtools: Yes 15 | PackageInstallArgs: --no-multiarch --with-keep.source 16 | PackageRoxygenize: rd,collate,namespace 17 | -------------------------------------------------------------------------------- /vignettes/mlmm.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "How to use MLMM" 3 | author: "Vincent Segura & Bjarni J. Vilhjalmsson" 4 | date: "`r Sys.Date()`" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{MLMM} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | %\VignetteEncoding{UTF-8} 10 | --- 11 | 12 | Load the `emma` package (available [online](http://mouse.cs.ucla.edu/emma/)): 13 | ```{r load_emma} 14 | library(emma) 15 | ``` 16 | 17 | Load the `mlmm` package: 18 | ```{r load_mlmm} 19 | library(mlmm) 20 | ``` 21 | 22 | Retrieve the data provided with the package: 23 | ```{r get_data} 24 | data(example_data, package="mlmm") 25 | str(example_data) 26 | ``` 27 | 28 | Perform mlmm (10 steps), it can take few minutes... 29 | ```{r fit_mlmm} 30 | mygwas <- mlmm(Y=example_data$Y, X=example_data$X, K=example_data$K, 31 | nbchunks=2, maxsteps=10) 32 | ``` 33 | 34 | Display the results (stepwise table): 35 | ```{r res} 36 | mygwas$step_table 37 | ``` 38 | 39 | Plot the results: 40 | ```{r plots} 41 | plot_step_table(mygwas,'extBIC') # EBIC plot 42 | plot_step_table(mygwas,'maxpval') # mbonf criterion plot 43 | plot_step_RSS(mygwas) # % variance plot 44 | plot_fwd_GWAS(mygwas,1,example_data$snp_info,0.1,main="step 1") # 1st mlmm step plot 45 | plot_fwd_GWAS(mygwas,2,example_data$snp_info,0.1,main="step 2") # 2nd mlmm step plot 46 | plot_fwd_GWAS(mygwas,3,example_data$snp_info,0.1,main="step 3") # 3rd mlmm step plot 47 | plot_opt_GWAS(mygwas,'extBIC',example_data$snp_info,0.1,main="optimal (EBIC)") # optimal step according to eBIC plot 48 | plot_opt_GWAS(mygwas,'mbonf',example_data$snp_info,0.1,main="optimal (mBonf)") # optimal step according to mbonf plot 49 | ``` 50 | -------------------------------------------------------------------------------- /vignettes/mlmm_cof.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "How to use MLMM_COF" 3 | author: "Vincent Segura & Bjarni J. Vilhjalmsson" 4 | date: "`r Sys.Date()`" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{MLMM_COF} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | %\VignetteEncoding{UTF-8} 10 | --- 11 | 12 | Load the `emma` package (available [online](http://mouse.cs.ucla.edu/emma/)): 13 | ```{r load_emma} 14 | library(emma) 15 | ``` 16 | 17 | Load the `mlmm` package: 18 | ```{r load_mlmm} 19 | library(mlmm) 20 | ``` 21 | 22 | Retrieve the data provided with the package: 23 | ```{r get_data} 24 | data(example_data, package="mlmm") 25 | str(example_data) 26 | ``` 27 | 28 | Perform mlmm (5 steps), it can take few minutes... 29 | ```{r fit_mlmm_cof} 30 | mygwas <- mlmm_cof(Y=example_data$Y, X=example_data$X, 31 | cofs=example_data$PC[,1:10], K=example_data$K, 32 | nbchunks=10, maxsteps=5) 33 | ``` 34 | 35 | Display the results (stepwise table): 36 | ```{r res} 37 | mygwas$step_table 38 | ``` 39 | 40 | Plot the results: 41 | ```{r plots} 42 | plot_step_table(mygwas,'extBIC') # EBIC plot 43 | plot_step_table(mygwas,'maxpval') # mbonf criterion plot 44 | plot_step_RSS(mygwas) # % variance plot 45 | plot_fwd_GWAS(mygwas,1,example_data$snp_info,0.1) # 1st mlmm step plot 46 | plot_fwd_GWAS(mygwas,2,example_data$snp_info,0.1) # 2nd mlmm step plot 47 | plot_fwd_GWAS(mygwas,3,example_data$snp_info,0.1) # 3rd mlmm step plot 48 | plot_opt_GWAS(mygwas,'extBIC',example_data$snp_info,0.1) # optimal step according to eBIC plot 49 | plot_opt_GWAS(mygwas,'mbonf',example_data$snp_info,0.1) # optimal step according to mbonf plot 50 | qqplot_fwd_GWAS(mygwas,5) # qqplot for 5 steps 51 | qqplot_opt_GWAS(mygwas,'extBIC') # qqplot for optimal model according to eBIC 52 | qqplot_opt_GWAS(mygwas,'mbonf') # qqplot for optimal model according to mbonf 53 | ``` 54 | --------------------------------------------------------------------------------