sm/0000755000176200001440000000000013353200333010664 5ustar liggesuserssm/po/0000755000176200001440000000000012266061255011314 5ustar liggesuserssm/po/R-sm.pot0000744000176200001440000000260312266061255012660 0ustar liggesusersmsgid "" msgstr "" "Project-Id-Version: R 2.1.0\n" "Report-Msgid-Bugs-To: bugs@r-project.org\n" "POT-Creation-Date: 2005-02-02 11:30\n" "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" "Last-Translator: FULL NAME \n" "Language-Team: LANGUAGE \n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=CHARSET\n" "Content-Transfer-Encoding: 8bit\n" msgid "breaks do not span the range of x" msgstr "" msgid "wrong parameter x for binning" msgstr "" msgid "illegal breaks" msgstr "" msgid "if weights are set, nbins must be 0 or NA" msgstr "" msgid "negative or NA weights are meaningless" msgstr "" msgid "lags must be in increasing order" msgstr "" msgid "dim(lags)[2] must be 2" msgstr "" msgid "x and y have different length" msgstr "" msgid "N and y have different length" msgstr "" msgid "if weights are set, nbins must be either 0 or NA" msgstr "" msgid "length of x and weights do not match" msgstr "" msgid "use of h.weights is incompatible with binning - set nbins=0" msgstr "" msgid "length(h) != 1" msgstr "" msgid "length(h) != 2" msgstr "" msgid "invalid argument:" msgstr "" msgid "options must be given by name" msgstr "" msgid "size of x and y do not match" msgstr "" msgid "length(h) does not match size of x" msgstr "" msgid "x and y must have equal length" msgstr "" msgid "y must be a matrix" msgstr "" msgid "cannot find '.sm.Options'" msgstr "" sm/inst/0000755000176200001440000000000012266061221011644 5ustar liggesuserssm/inst/COPYING0000744000176200001440000004307012266061201012702 0ustar liggesusers GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 675 Mass Ave, Cambridge, MA 02139, USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19yy name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. sm/inst/history.txt0000744000176200001440000000342113263641272014117 0ustar liggesusersHistory of the `sm' library by Adrian W. Bowman & Adelchi Azzalini -------------------------------------- September 1997: version 1 of the library for S-plus is released. February 1999: porting to R by Brian Ripley July 2000: porting to XLisp-Stat by Luca Scrucca November 2000: version 2 for S-plus is released. The main differences from version 1 are: - datasets of arbitrary size can be handled, using binning operations; this feature operates on the main functions: sm.density, sm.regression, sm.ancova, sm.binomial, sm.poisson, but not for all functions (for instance it does not operate for time series related functions); - missing data are allowed, by simply removing them, together with associated variates of the same case; - sm.options is introduced, providing an improved mechanism for parameter passing (but this is essentially trasparent to the user); - the code of GLM-type functions has been modified somewhat; sm.logit has been renamed to sm.binomial, and similarly sm.logit.bootstrap to sm.binomial.bootstrap; - some of the associated scripts have been modified slightly; - some other minor changes (e.g. the function type() has been removed). September 2005: version 2.1 for R is released. - more extensive methods of selecting smoothing parameters have been implemented, and in a more systematic manner, for density estimation and regression; the methods for regression now include one based on AIC, proposed by Hurvich, Simonoff and Tsai; - the operation of the code has been streamlined; - some other minor changes have been implemented. September 2007: version 2.2 for R is released. - rotatable rgl plots can be produced by sm.density and sm.regression. - rpanel interactive controls are available in sm.density and sm.regression. - other minor changes. sm/inst/CITATION0000744000176200001440000000142713353154535013017 0ustar liggesuserscitHeader("To cite the sm package in publications use:") citEntry(entry="manual", title = paste("{R} package \\texttt{sm}:", "nonparametric smoothing methods (version 2.2-5.6)", sep=" "), author = personList(as.person("A. W. Bowman"), as.person("A. Azzalini")), address = "University of Glasgow, UK and Universit\\`a di Padova, Italia", year = "2018", url = "http://www.stats.gla.ac.uk/~adrian/sm/", textVersion = paste( "Bowman, A. W. and Azzalini, A. (2018). ", "R package 'sm': nonparametric smoothing methods", " (version 2.2-5.6)", " URL http://www.stats.gla.ac.uk/~adrian/sm", sep="") ) sm/inst/smdata/0000755000176200001440000000000012266061237013124 5ustar liggesuserssm/inst/smdata/stanford.dat0000744000176200001440000001131012266061232015426 0ustar liggesusers Log.time Status Age 1.17609 1 54.0000 0.477121 1 40.0000 1.66276 1 42.0000 2.79449 1 51.0000 2.10037 1 48.0000 1.80618 1 54.0000 3.13033 1 54.0000 1.36173 1 56.0000 2.44560 1 49.0000 3.01030 1 43.0000 1.00000 1 56.0000 1.59106 1 42.0000 2.86332 1 58.0000 3.29248 1 33.0000 2.13354 1 52.0000 0. 1 54.0000 2.92221 1 44.0000 1.77815 1 64.0000 3.56761 0 40.0000 3.30016 1 49.0000 0. 1 41.0000 1.67210 1 62.0000 1.73239 1 49.0000 1.70757 1 50.0000 3.45909 1 49.0000 3.53275 0 45.0000 1.64345 1 36.0000 2.99739 1 48.0000 1.70757 1 47.0000 3.16967 1 36.0000 2.40483 1 48.0000 2.95279 1 46.0000 2.17026 1 47.0000 1.70757 1 52.0000 2.50920 1 48.0000 3.48015 0 38.0000 1.81954 1 49.0000 3.47480 0 32.0000 3.43505 1 32.0000 2.74036 1 48.0000 1.81954 1 51.0000 1.81291 1 45.0000 2.35603 1 19.0000 3.44793 0 48.0000 1.39794 1 53.0000 2.80003 1 26.0000 3.43680 0 47.0000 1.07918 1 29.0000 1.79934 1 56.0000 3.39340 1 52.0000 3.14114 1 46.0000 2.73560 1 52.0000 1.46240 1 53.0000 1.68124 1 53.0000 2.47276 1 42.0000 3.11992 1 48.0000 3.13098 1 54.0000 1.69897 1 46.0000 2.73799 1 49.0000 2.63448 1 47.0000 1.83251 1 51.0000 1.41497 1 52.0000 2.20683 1 43.0000 1.14613 1 40.0000 3.36418 0 26.0000 3.21325 1 23.0000 2.16435 1 45.0000 1.68124 1 28.0000 3.32777 1 35.0000 2.41996 1 49.0000 3.32346 0 40.0000 2.46687 1 43.0000 3.30643 0 30.0000 3.30233 0 15.0000 3.30103 0 45.0000 3.29994 0 47.0000 3.28892 0 38.0000 1.81291 1 55.0000 2.86392 1 38.0000 3.27091 0 49.0000 2.73078 1 49.0000 3.26623 0 44.0000 1.83251 1 35.0000 3.24993 0 27.0000 3.23603 0 40.0000 2.96755 1 50.0000 3.23502 0 39.0000 1.34242 1 27.0000 1.60206 1 42.0000 0.845098 1 28.0000 3.21431 0 48.0000 3.20737 0 51.0000 1.39794 1 52.0000 3.18583 1 44.0000 3.18949 0 50.0000 3.10415 1 32.0000 1.64345 1 46.0000 3.09587 1 41.0000 3.09061 1 18.0000 2.28103 1 42.0000 3.14395 0 46.0000 3.07990 1 38.0000 3.13925 0 41.0000 3.13767 0 41.0000 2.43775 1 31.0000 1.49136 1 33.0000 3.12743 0 50.0000 1.62325 1 19.0000 2.58092 1 45.0000 3.10175 0 52.0000 3.10106 0 34.0000 3.10072 0 47.0000 1.67210 1 36.0000 3.07664 0 24.0000 2.79657 1 53.0000 1.68124 1 51.0000 3.06070 1 32.0000 1.65321 1 48.0000 3.04766 0 14.0000 3.04415 0 18.0000 3.04218 0 39.0000 2.29003 1 39.0000 1.47712 1 34.0000 3.01703 0 43.0000 2.99695 0 30.0000 2.97772 0 46.0000 2.86273 1 49.0000 2.08279 1 59.0000 2.30535 1 48.0000 2.92480 0 48.0000 2.92117 0 49.0000 2.42325 1 49.0000 0. 1 21.0000 2.89927 0 19.0000 2.51587 1 34.0000 2.89265 0 20.0000 2.87622 0 43.0000 2.86806 0 41.0000 1.93450 1 12.0000 2.12057 1 46.0000 2.82151 0 36.0000 2.81954 0 42.0000 2.34439 1 35.0000 1.95424 1 38.0000 2.79169 0 47.0000 2.79099 0 50.0000 2.76042 0 53.0000 2.75051 0 41.0000 1.55630 1 45.0000 2.73957 0 40.0000 2.73878 0 30.0000 2.73320 0 47.0000 2.72754 0 20.0000 2.22789 1 51.0000 2.08636 1 51.0000 2.58206 1 36.0000 2.67025 0 24.0000 2.66652 0 38.0000 1.00000 1 13.0000 0.698970 1 20.0000 2.13354 1 55.0000 2.60853 0 39.0000 2.59218 0 27.0000 2.57287 0 47.0000 1.69897 1 50.0000 2.14301 1 51.0000 2.50786 0 36.0000 2.46538 0 43.0000 2.44404 0 41.0000 1.34242 1 45.0000 2.36361 0 52.0000 2.16137 1 50.0000 2.27416 0 52.0000 2.24551 0 29.0000 2.13988 1 41.0000 2.17319 0 21.0000 2.07555 0 20.0000 2.02938 0 46.0000 1.99123 0 19.0000 1.94939 0 27.0000 1.77815 0 13.0000 1.74819 0 27.0000 0.301030 0 39.0000 0. 0 27.0000 sm/inst/smdata/magrem.dat0000744000176200001440000000433612266061227015074 0ustar liggesusersmaglong maglat 319.1 30.7 347.4 -49.2 344.5 -37.3 313.6 -11.4 177.0 31.3 3.0 -31.3 308.0 4.6 165.0 42.8 352.6 -22.2 307.0 8.8 190.3 19.3 3.6 -28.2 306.1 -2.3 180.2 32.4 9.1 -29.7 355.7 -39.3 286.8 21.2 207.7 19.8 192.1 18.9 202.3 35.8 44.9 41.3 23.8 -41.4 9.3 -25.9 18.3 -15.8 186.2 27.3 31.1 -0.8 165.5 12.7 202.3 37.2 191.5 59.7 297.2 -16.4 248.7 6.3 155.8 -57.5 190.1 11.8 341.3 -11.4 346.3 -3.4 184.6 3.0 323.2 62.6 210.5 62.3 316.0 -16.3 306.9 -19.2 331.0 -31.0 298.1 -12.3 296.2 -21.7 10.9 -14.5 249.0 28.8 262.3 38.2 270.0 31.8 338.5 -6.0 332.2 -2.8 222.3 3.4 3.3 -20.6 325.9 -5.7 345.6 4.6 294.4 -34.4 358.7 -8.2 23.8 -44.3 20.8 -43.5 280.5 8.7 347.4 -47.2 341.9 -48.3 10.2 -17.4 12.4 -2.7 321.0 -17.6 16.7 -45.5 353.5 -22.7 264.8 26.8 258.5 39.1 310.6 15.3 281.2 -12.0 7.0 -15.4 342.8 23.2 243.6 47.2 89.4 22.5 339.7 70.3 359.9 71.9 314.1 -45.1 325.4 -24.4 1.9 -19.6 177.3 -7.1 324.5 -68.3 346.9 -58.1 350.0 -57.5 321.4 -1.6 314.6 -5.7 320.6 -22.3 304.7 -17.3 314.2 -22.6 306.3 -16.5 271.6 -18.4 316.0 -36.7 309.8 -20.3 313.0 -20.5 329.4 -32.3 334.9 -29.3 312.3 -15.7 269.8 5.9 318.2 -24.9 0.4 -40.0 309.0 -15.2 310.4 -21.6 348.0 -43.3 291.9 41.0 272.2 51.4 273.0 43.9 338.2 -25.1 318.5 -4.7 298.2 19.2 sm/inst/smdata/stanford.doc0000744000176200001440000000057212266061232015433 0ustar liggesusers Stanford data These data refer to the survival times of patients of different ages from the Stanford Heart Transplant Study. The variables are: Log.time: survival time on a log scale Status: indicator of death (1) or censoring (0) Age: age of the patient in years Source: Miller & Halpern (1980). Regression with censored data. Biometrika 69, 521-531. sm/inst/smdata/trout.doc0000744000176200001440000000143212266061235014767 0ustar liggesusers Trout data These data were collected in a toxocological experiment conducted at the University of Waterloo. Different concentrations of potassium cyanate were applied to vials of trout eggs. The eggs in half of the vials were allowed to water-harden before the toxicant was applied. The variables are: Concentr: toxicant concentration Trouts: number of trout eggs Dead: number of eggs which died Insert: an indicator of whether the eggs were allowed to water-harden Source: O'Hara Hines & Carter (1993). Improved added variable and partial residual plots for the detection of influential observations in generalized linear models. Applied Statistics 42, 3-20. The data are also reported by Hand et al. (1994), A Handbook of Small Data Sets, data set no.418. sm/inst/smdata/geys3d.dat0000744000176200001440000000574412266061226015025 0ustar liggesusersWaiting Next.waiting Duration 80 71 4.02 71 57 2.15 57 80 4 80 75 4 75 77 4 77 60 2 60 86 4.38 86 77 4.28 77 56 2.03 56 81 4.83 81 50 1.83 50 89 5.45 89 54 1.62 54 90 4.87 90 73 4.38 73 60 1.77 60 83 4.67 83 65 2 65 82 4.73 82 84 4.22 84 54 1.9 54 85 4.97 85 58 2 58 79 4 79 57 2 57 88 4 88 68 2.83 68 76 4.5 76 78 4.07 78 74 3.72 74 85 3.52 85 75 4.47 75 65 2.22 65 76 4.88 76 58 2.6 58 91 4.15 91 50 2.2 50 87 4.77 87 48 1.83 48 93 4.6 93 54 2.27 54 86 4.13 86 53 2 53 78 4 78 52 2 52 83 4 83 60 1.88 60 87 4.27 87 49 2.08 49 80 4.47 80 60 2.22 60 92 4 92 43 1.77 43 89 4.33 89 60 2.18 60 84 4.48 84 69 3.88 69 74 3.33 74 71 3.73 71 108 4 108 50 1.95 50 77 5.27 77 57 2 57 80 4 80 61 2 61 82 4 82 48 2 48 81 4 81 73 3.53 73 62 2.17 62 79 4.5 79 54 2.02 54 80 4.15 80 73 4.2 73 81 4.33 81 62 1.93 62 81 4.65 81 71 3.82 71 79 4.03 79 81 4.17 81 74 4.67 74 59 1.82 59 81 4 81 66 3 66 87 4 87 53 2 53 80 4.45 80 50 2.05 50 87 4.25 87 51 1.92 51 82 4.67 82 58 1.73 58 81 4.38 81 49 1.77 49 92 4.6 92 50 1.87 50 88 4.45 88 62 1.63 62 93 5.03 93 56 1.82 56 89 5.1 89 51 1.63 51 79 4.28 79 58 2 58 82 4 82 52 2 52 88 4.53 88 52 2 52 78 4 78 69 2.93 69 75 4.73 75 77 3.9 77 53 1.95 53 80 4.12 80 55 1.8 55 87 4.67 87 53 1.83 53 85 4.7 85 61 2.12 61 93 4.78 93 54 1.82 54 76 4.1 76 80 4.65 80 81 4 81 59 2 59 86 4 86 78 4 78 71 4.22 71 77 4.13 77 76 3.93 76 94 3.75 94 75 4.42 75 50 2.47 50 83 4.17 83 82 3.8 82 72 4.32 72 77 3.87 77 75 4.68 75 65 1.7 65 79 4.97 79 72 4.27 72 78 4.58 78 77 4 77 79 4 79 75 4 75 78 4 78 64 1.98 64 80 4.6 80 49 0.83 49 88 4.92 88 54 1.73 54 85 4.58 85 51 1.7 51 96 4.75 96 50 1.83 50 80 4.5 80 78 1.87 78 81 4.45 81 72 4.45 72 75 4 75 78 4.8 78 87 4 87 69 4 69 55 2 55 83 4 83 49 1.93 49 82 4.58 82 57 2 57 84 3.7 84 57 2.87 57 84 4.83 84 73 3.45 73 78 4.38 78 57 1.8 57 79 4.4 79 57 2.48 57 90 4.52 90 62 2.1 62 87 4.35 87 78 4.37 78 52 1.78 52 98 4.92 98 48 1.82 48 78 4 78 79 4 79 65 4 65 84 3.87 84 50 1.85 50 83 4.7 83 60 2.02 60 80 4.47 80 50 1.87 50 88 4.17 88 50 1.9 50 84 4.25 84 74 3.25 74 76 4.22 76 65 1.88 65 89 4.98 89 49 1.85 49 88 4 88 51 1.97 51 78 4.77 78 85 4 85 65 2 65 75 4 75 77 4 77 69 2.38 69 92 4.42 92 68 4.22 68 87 4.37 87 61 2 61 81 4.45 81 55 1.75 55 93 4.5 93 53 1.62 53 84 4.7 84 70 2.57 70 73 3.7 73 93 4.23 93 50 1.93 50 87 4.35 87 77 4 77 74 4 74 72 4 72 82 4.22 82 74 4 74 80 4.13 80 49 1.88 49 91 4.47 91 53 1.95 53 86 4.22 86 49 1.72 49 79 4.45 79 89 4.25 89 87 3.97 87 76 4.38 76 59 1.97 59 80 4.45 80 89 4.27 89 45 1.92 45 93 4.42 93 72 3 72 71 4 71 54 2 54 79 4 79 74 3.28 74 65 1.83 65 78 4.62 78 57 1.83 57 87 4.62 87 72 4.6 72 84 4.25 84 47 1.93 47 84 4.98 84 57 1.97 57 87 4.3 87 68 4.2 68 86 4.53 86 75 4.4 75 73 4.62 73 53 2 53 82 4 82 93 4 93 77 3.92 77 54 2 54 96 4.5 96 48 1.8 48 89 4 89 63 2.75 63 84 4.73 84 76 3.97 76 62 1.95 62 83 4.97 83 50 1.85 50 85 4.8 85 78 4 78 78 4 78 81 4 81 78 4 78 76 4 76 74 4 74 81 4 81 66 2 66 84 4 84 48 1.93 48 93 4.33 93 47 1.67 47 87 4.77 87 51 1.95 51 78 4.68 78 54 1.93 54 87 4.42 87 52 2.13 52 85 4.08 85 58 2.07 58 88 4 88 79 4 sm/inst/smdata/smacker.dat0000744000176200001440000002704312266061232015245 0ustar liggesusersDensity smack.lat smack.long smack.depth Temperature D200 0 44.57 4.65 4342 8.23 -92.5 0 44.57 4.48 4334 9.68 -86.1 0 44.57 4.3 4286 10.9 -78.3 18.26 44.02 2.87 1438 19.33 -50.6 90.16 44.02 2.07 166 8.78 2.2 62.93 44.02 2.13 460 9.42 -3.5 0 44.02 2.27 810 10.53 -7.3 23 44.02 2.35 887 11 -15.3 0 44.02 2.42 946 11.42 -20.1 0 44.02 2.48 1012 12 -23.9 0 44.12 2.48 1011 13.27 -27.8 0 44.12 2.33 969 14.67 -27.2 0 44.12 2.27 929 15.18 -18.2 36.35 44.12 2.2 847 15.75 -14.2 0 44.12 2.13 704 16.27 -10.2 19.3 44.12 2.07 266 16.9 -6.2 58.71 44.37 2.07 181 5.67 -2.3 19.16 44.37 2.13 467 6.25 2.8 0 44.37 2.2 696 7.17 6.8 0 44.37 2.35 1012 8.08 9.8 0 44.62 2.35 1335 10.83 14.5 0 44.62 2.27 922 16.42 17.4 0 44.62 2.18 606 17.17 22.3 0 44.62 2.13 539 17.68 27.2 42.46 44.62 2.07 883 18.33 5 21.26 44.87 2.07 135 8.58 8.9 0 44.88 2.13 147 9.25 13.7 0 44.87 2.2 268 9.75 16.6 19.81 44.87 2.27 783 10.25 21.5 0 44.87 2.35 1892 10.75 25.4 0 44.87 2.42 2034 11.58 27.6 0 44.87 2.48 2580 12.08 24.6 0 44.87 2.55 2709 12.58 19.7 0 44.87 2.62 2681 13.33 15.7 0 44.87 2.7 2879 13.92 10.8 0 44.87 2.77 2852 14.4 6.9 0 44.87 2.83 3158 14.95 4.2 0 44.87 2.9 2943 15.6 -2.6 0 44.87 2.97 3097 16.1 -5.9 0 44.98 3.12 2249 17.75 -9.7 0 45.12 3.27 1202 19 -18.6 0 45.12 3.2 964 23.62 -18.4 0 45.12 3.13 161 0.25 -14.8 0 45.12 3.05 1039 0.78 -10.3 21.96 45.12 2.98 242 1.28 -7.4 41.69 45.12 2.92 1159 1.83 -3.7 0 45.12 2.85 155 2.33 2.5 93.63 45.12 2.77 156 3.08 6 0 45.12 2.7 306 3.62 9.9 22.3 45.12 2.63 126 4.12 13.9 0 45.12 2.55 127 4.68 17.9 0 45.12 2.48 125 5.2 21.9 0 45.12 2.42 126 5.72 26.8 0 45.12 2.35 120 9.08 27.3 0 45.12 2.27 120 9.42 23.4 22.12 45.12 2.2 116 10.22 18.7 0 45.12 2.13 111 10.67 14.9 0 45.12 2.07 104 11.25 8.4 0 45.12 1.98 100 11.75 2.7 0 45.12 1.92 95 12.25 5 0 45.12 1.78 79 16.18 1.8 0 45.12 1.7 71 16.83 -3.4 46.74 45.12 1.57 60 17.77 6.7 0 45.12 1.48 52 18.42 -6.8 0 45.12 1.42 40 18.83 -9 0 45.12 1.35 31 19.33 -12.1 0 45.12 1.28 26 19.92 -12.7 0 45.18 1.28 27 20.42 14 0 45.25 1.28 27 21.17 -13.5 0 45.3 1.28 29 21.75 -14.2 0 45.37 1.28 29 22.33 -15.9 0 45.37 1.37 35 22.9 16.4 0 45.37 1.42 41 23.42 -12.8 0 45.37 1.48 46 0.08 -10 0 45.37 1.57 51 0.7 -6.8 0 45.37 1.63 51 1.25 -5 0 45.37 1.72 56 1.92 -4.9 0 45.37 1.78 66 2.5 -1.5 0 45.37 1.85 74 3 3.6 0 45.37 1.92 78 3.53 -5.6 25.27 45.37 1.98 82 4 -1.6 0 45.37 2.07 92 4.57 3.9 0 45.37 2.13 97 5.08 -5.2 0 45.37 2.2 103 5.73 2.8 0 45.52 2.28 102 10.5 5.3 0 45.62 2.28 99 11.58 -8.8 0 45.62 2.2 92 12.2 8.7 24.56 45.62 2.12 83 12.67 10.9 89.82 45.62 2.07 79 13.17 13.5 0 45.43 1.35 31 22.03 14.3 93.04 45.3 1.35 34 0.75 16.1 0 45.23 1.35 33 1.25 18.5 0 45.23 1.42 41 1.87 20.1 23.3 45.23 1.48 50 2.37 24.9 0 45.25 1.57 57 2.82 28.2 46.38 45.23 1.63 63 3.23 34 51.3 45.25 1.7 68 3.68 38.1 61.56 45.25 1.78 74 4.23 41.4 0 45.25 1.85 77 4.82 44.9 0 45.23 1.92 84 5.4 48.5 0 45.25 1.98 90 5.92 50.4 24.24 45.25 2.13 105 6.67 52.5 0 45.37 2.28 108 8.25 54.2 0 45.37 2.35 108 8.67 56.7 22.65 45.37 2.48 112 9.58 52.9 0 45.37 2.63 120 10.5 50.8 0 45.37 2.7 124 11 48.1 0 45.37 2.77 133 14.6 44.7 21.31 45.37 2.85 130 15.28 42.1 23.02 45.37 2.92 139 15.72 39.1 0 45.37 2.98 136 16.32 37.1 20.47 45.37 3.05 147 16.75 35.4 107.79 45.37 3.13 158 17.22 33.6 0 45.37 3.2 178 17.67 31.7 0 45.37 3.27 592 18.17 29.8 196.28 45.37 3.35 941 18.62 27.8 47.25 45.37 3.42 2570 19.5 25.9 0 45.37 3.48 3200 20.17 31.5 0 45.37 3.55 3527 20.67 36.7 0 45.37 3.62 3611 21.08 39.2 0 45.37 3.7 3723 21.5 41.6 0 45.37 3.83 3691 22.2 42.9 0 45.37 3.98 3960 22.9 45.3 49.59 45.52 4.12 3789 0.37 47 112.71 45.62 4.27 3964 1.48 48.7 22.09 45.62 4.2 4015 2.27 50.6 20.62 45.62 4.13 3498 2.7 52.3 45.7 45.62 4.05 2602 3.15 54.5 0 45.62 3.98 2183 3.67 56.6 0 45.62 3.92 1879 5.02 69.7 21.21 45.62 3.85 2354 5.47 68 23.48 45.62 3.78 1794 5.92 66.1 21.81 45.62 3.7 2101 6.42 63.9 40.89 45.62 3.63 1294 6.8 62.3 25.45 45.62 3.55 1144 7.25 60.3 0 45.62 3.48 419 13.92 58.6 0 45.62 3.42 169 14.33 62.2 0 45.62 3.35 148 14.88 64.8 21.82 45.62 3.27 136 15.6 68.2 18.89 45.62 3.2 135 16 71.7 0 45.62 3.13 139 16.5 73.7 18.53 45.62 3.07 133 16.88 75.5 0 45.62 2.98 133 17.42 77.8 22.15 45.62 2.92 125 17.95 79.7 0 45.62 2.77 121 18.92 81.3 0 45.62 2.7 121 19.33 76 0 45.62 2.63 117 19.9 71.6 0 45.62 2.57 114 20.4 66.1 0 45.62 2.48 112 20.83 62.6 0 45.62 2.42 106 21.27 60 0 45.48 2.2 90 23 53.3 0 45.52 2.07 82 23.83 51.6 21.28 45.87 2.07 73 17.33 56.4 0 45.87 2.13 77 17.82 51 117.62 45.87 2.2 79 18.58 48.6 148.56 45.87 2.28 84 19.03 45.4 0 45.87 2.35 91 19.5 42.4 0 45.87 2.42 98 20.17 39.5 0 45.87 2.48 98 20.67 36.2 0 45.87 2.57 101 21 34.1 0 45.87 2.7 106 21.93 31.1 0 45.87 2.85 114 22.67 29 19.92 45.87 2.98 120 23.5 26.4 0 45.87 3.13 123 0.25 25.6 0 45.87 3.28 135 1 22 0 45.87 3.35 138 1.58 24.2 0 45.87 3.42 138 2.08 21.8 0 45.87 3.48 139 2.62 18.3 0 45.87 3.57 137 3.17 18.2 19.2 45.87 3.63 151 3.82 16.9 20.25 45.87 3.7 180 4.28 -16.5 0 45.87 3.78 175 4.93 15.5 19.9 45.87 3.85 934 5.43 14 20.42 45.87 3.92 598 5.85 13.1 19.49 45.87 3.98 1003 6.42 11 19.42 45.87 4.07 1972 6.83 7.1 0 45.87 4.13 2443 7.25 3.3 0 45.87 4.2 2323 7.83 -2.1 61.33 45.87 4.28 3024 8.33 -6.4 0 45.87 4.35 3463 9.08 -8.5 0 45.87 4.42 4097 9.5 -10.8 0 45.87 4.57 4142 10.25 -13.9 0 45.87 4.63 3640 11.07 -15.9 0 46.02 4.8 3496 12.17 -19.1 19.44 46.12 4.95 3883 13.42 -24.3 0 46.12 4.88 2765 14.17 -30.8 0 46.12 4.73 2254 15 -27.7 21.32 46.12 4.58 2208 15.72 -27.2 42.66 46.12 4.52 3518 16.15 -26.1 0 46.12 4.45 1581 16.62 -24.3 377.91 46.12 4.37 1346 17.02 -20.6 150.1 46.12 4.3 1698 17.75 -17.9 115.09 46.12 4.23 1200 18.27 -15.8 17.18 46.12 4.15 1220 18.65 -14.6 0 46.12 4.08 189 3.83 -11.6 18.16 46.12 4.02 154 4.27 -9 0 46.12 3.93 151 4.7 -5.4 0 46.12 3.87 148 5.25 2.7 124.29 46.12 3.8 152 5.63 -2.2 0 46.12 3.72 147 6.17 3.6 0 46.12 3.65 141 6.62 7.3 0 46.12 3.58 138 7.23 9.1 0 46.12 3.48 137 7.83 12 0 46.12 3.43 133 8.33 15.3 0 46.12 3.37 133 8.77 18.9 0 46.12 3.28 128 9.33 23.1 0 46.12 3.15 121 10.13 26 0 46.12 2.98 117 10.97 31.2 0 46.12 2.92 111 11.42 31.7 0 46.12 2.72 102 12.55 32.4 0 46.12 2.57 94 13.35 -32.8 0 46.12 2.48 84 13.82 33.1 0 46.08 2.42 71 14.33 33.9 0 46.08 2.35 64 16.83 32.4 36.63 46.08 2.28 51 15.38 37.6 41.25 46.12 2.22 56 16.05 40 0 46.12 2.13 58 16.5 41.5 0 46.12 2.07 54 16.93 43.4 0 46.37 2.07 36 7.33 45.2 0 46.37 2.22 41 8.25 46.9 0 46.37 2.35 54 9.08 49.4 0 46.37 2.48 67 10.08 51.1 0 46.37 2.57 73 13 58.1 0 46.37 2.63 83 13.5 61.7 0 46.37 2.72 83 14 60 0 46.37 2.87 100 14.82 57.6 0 46.37 2.98 108 15.57 55.9 0 46.37 3.15 113 16.47 54.2 0 46.37 3.22 117 16.9 52.3 0 46.37 3.28 119 17.67 56.2 0 46.37 3.37 119 18.28 54.2 0 46.37 3.43 124 22.25 52.4 19.76 46.37 3.52 124 22.75 50.5 0 46.37 3.58 127 23.25 49.4 0 46.37 3.65 133 23.87 48.5 0 46.37 3.73 136 0.35 48 0 46.37 3.8 138 0.8 -47.8 0 46.37 3.87 139 1.25 45.3 0 46.37 3.95 139 1.72 37.8 0 46.37 4.02 141 2.17 31.6 0 46.37 4.08 145 2.88 26 0 46.37 4.17 148 3.35 20.2 0 46.37 4.23 154 8.17 17.4 0 46.37 4.3 151 8.5 14.9 0 46.37 4.38 153 9.25 11.9 18.01 46.37 4.45 166 9.67 8.2 19.42 46.37 4.53 360 10.03 6.6 95.09 46.37 4.6 690 10.47 6.3 220.08 46.37 4.67 914 11.15 1.4 233.61 46.37 4.73 1317 11.57 -2.9 0 46.37 4.82 1330 11.93 -6.8 0 46.37 4.88 1699 12.42 -7.2 0 46.37 4.95 2198 12.82 -9.4 0 46.37 5.03 2402 13.27 -10.6 0 46.37 5.1 2580 13.72 -11.7 0 46.37 5.17 2866 14.13 -14.6 0 46.37 5.25 3291 14.57 -17.6 0 46.37 5.32 3370 15 -21 294.27 46.52 5.47 3198 16.53 -28.3 19.14 46.62 5.62 3793 17.88 -30.9 22.29 46.62 5.55 3225 18.77 -25.9 149.86 46.62 5.47 2776 19.32 -24.4 272.9 46.62 5.4 2523 19.72 -24 40.06 46.62 5.33 2867 20.17 -18.6 0 46.62 5.25 1721 20.72 -15.6 111.7 46.62 5.18 1985 21.27 15.8 82.62 46.62 5.1 1841 21.73 -13.8 35.3 46.62 5.03 1152 22.15 -9.4 198.1 46.62 4.97 667 22.63 -6.4 0 46.62 4.67 158 2.67 -4.9 15.79 46.62 4.88 388 6.33 -4 318.36 46.62 4.82 271 6.73 2.1 0 46.62 4.73 189 7.5 3.3 37.12 46.62 4.6 154 8.25 7.6 0 46.62 4.53 150 8.68 9.8 0 46.62 4.45 145 9.08 12.6 37.37 46.62 4.38 145 9.5 16.5 0 46.62 4.32 143 10 18.2 0 46.62 4.23 144 10.5 20.5 0 46.62 4.17 141 11 23.8 0 46.62 4.1 138 11.55 25.2 0 46.62 4.02 136 12.02 27.4 22.64 46.62 3.95 135 12.53 30.8 0 46.62 3.88 132 13.02 36.6 0 46.62 3.8 127 13.47 43.1 0 46.62 3.73 121 13.92 45.7 0 46.62 3.67 125 14.45 53.6 0 46.62 3.58 120 15.1 60.4 0 46.62 3.52 113 15.77 62.9 0 46.62 3.45 117 16.28 61.4 0 46.62 3.37 118 16.83 62 0 46.62 3.3 115 17.33 63 0 46.62 3.22 108 17.83 66 0 46.62 3.15 108 18.47 67.8 0 46.62 3.08 102 18.93 69.4 0 46.62 2.98 100 19.47 66.6 0 46.63 2.93 92 19.9 68.8 0 46.62 2.87 86 20.6 72 0 46.62 2.78 81 21.17 74.2 0 46.62 2.65 68 21.98 76 0 46.62 2.57 61 22.57 83.2 0 46.62 2.48 58 23.05 84 0 46.62 2.42 51 23.55 87.2 0 46.75 2.48 39 0.85 86.8 0 46.87 2.48 27 1.82 85.1 0 46.87 2.65 44 2.7 83.2 0 46.87 2.72 51 3.45 80.4 0 46.87 2.8 53 4 78.8 0 46.87 2.87 57 4.62 74.1 0 46.87 2.93 50 5.42 70.6 0 44.37 2.97 1420 17.28 68 0 44.37 2.9 1427 18.18 64.9 0 44.37 2.83 1467 18.58 59.1 0 44.37 2.68 1383 19.47 54.2 0 44.37 2.62 1349 19.82 47.3 0 44.37 2.55 1348 20.23 44.9 0 44.37 2.48 1328 20.65 42.7 0 44.37 2.42 1492 21.05 40.3 0 44.62 2.42 1735 23.03 37.9 0 44.62 2.48 2080 23.55 34.5 0 44.62 2.62 2634 0.42 30.8 0 44.62 2.77 2280 1 27.2 0 44.62 2.9 2262 2 22.9 0 45.48 4.33 4173 9.45 19.6 0 45.58 4.35 3943 10.35 16.7 0 45.62 4.42 4102 10.87 13.9 0 45.62 4.48 4231 11.22 12.7 0 45.62 4.63 4360 11.85 -12.6 0 45.62 4.77 4390 12.53 10.8 0 45.62 4.83 4414 13.03 7.3 0 44.57 4.65 4342 8.23 3.9 0 44.57 4.48 4334 9.68 -3.5 0 44.57 4.3 4286 10.9 -6.7 18.26 44.02 2.87 1438 19.33 1.9 90.16 44.02 2.07 166 8.78 -2.3 62.93 44.02 2.13 460 9.42 -5.1 0 44.02 2.27 810 10.53 -6.7 23 44.02 2.35 887 11 9.5 0 44.02 2.42 946 11.42 -9 0 44.02 2.48 1012 12 -10.1 0 44.12 2.48 1011 13.27 -13.2 0 44.12 2.33 969 14.67 -16.4 0 44.12 2.27 929 15.18 -19.9 36.35 44.12 2.2 847 15.75 -24.5 0 44.12 2.13 704 16.27 -27.9 19.3 44.12 2.07 266 16.9 -23.5 58.71 44.37 2.07 181 5.67 -25.2 19.16 44.37 2.13 467 6.25 -22.7 0 44.37 2.2 696 7.17 -19.2 0 44.37 2.35 1012 8.08 -16.4 0 44.62 2.35 1335 10.83 -14.1 0 44.62 2.27 922 16.42 -12.5 0 44.62 2.18 606 17.17 12.5 0 44.62 2.13 539 17.68 -10.4 42.46 44.62 2.07 883 18.33 -9.3 21.26 44.87 2.07 135 8.58 -6.7 0 44.88 2.13 147 9.25 -9.9 0 44.87 2.2 268 9.75 -2.1 19.81 44.87 2.27 783 10.25 2.8 0 44.87 2.35 1892 10.75 7.6 0 44.87 2.42 2034 11.58 10.5 0 44.87 2.48 2580 12.08 12.5 0 44.87 2.55 2709 12.58 15.9 0 44.87 2.62 2681 13.33 -17.8 0 44.87 2.7 2879 13.92 17.8 0 44.87 2.77 2852 14.4 19 0 44.87 2.83 3158 14.95 20.7 0 44.87 2.9 2943 15.6 23.1 0 44.87 2.97 3097 16.1 26.6 0 44.98 3.12 2249 17.75 28.2 0 45.12 3.27 1202 19 29.3 0 45.12 3.2 964 23.62 31.4 0 45.12 3.13 161 0.25 33.5 0 45.12 3.05 1039 0.78 35.9 21.96 45.12 2.98 242 1.28 39.3 41.69 45.12 2.92 1159 1.83 42.3 0 45.12 2.85 155 2.33 45.4 93.63 45.12 2.77 156 3.08 49.5 0 45.12 2.7 306 3.62 52.9 22.3 45.12 2.63 126 4.12 57.2 0 45.12 2.55 127 4.68 59.6 0 45.12 2.48 125 5.2 61.8 0 45.12 2.42 126 5.72 65.2 0 45.12 2.35 120 9.08 67.9 0 45.12 2.27 120 9.42 69.8 22.12 45.12 2.2 116 10.22 73.2 0 45.12 2.13 111 10.67 79 0 45.12 2.07 104 11.25 82.2 0 45.12 1.98 100 11.75 85.3 0 45.12 1.92 95 12.25 87.8 0 45.12 1.78 79 16.18 91.5 0 45.12 1.7 71 16.83 96.6 46.74 45.12 1.57 60 17.77 89.6 0 45.12 1.48 52 18.42 87 0 45.12 1.42 40 18.83 83.8 0 45.12 1.35 31 19.33 81.5 0 45.12 1.28 26 19.92 79.2 0 45.18 1.28 27 20.42 -45.2 0 45.25 1.28 27 21.17 -44.3 0 45.3 1.28 29 21.75 -43.7 0 45.37 1.28 29 22.33 -38.5 0 45.37 1.37 35 22.9 -34.5 0 45.37 1.42 41 23.42 -30.5 0 45.37 1.48 46 0.08 -26.5 0 45.37 1.57 51 0.7 -22.6 0 45.37 1.63 51 1.25 -20.5 0 45.37 1.72 56 1.92 -22.4 0 45.37 1.78 66 2.5 -25.8 0 45.37 1.85 74 3 -28.5 0 45.37 1.92 78 3.53 -29.7 25.27 45.37 1.98 82 4 -36 0 45.37 2.07 92 4.57 -31 0 45.37 2.13 97 5.08 -31.3 0 45.37 2.2 103 5.73 -33.8 0 45.52 2.28 102 10.5 -40.3 0 45.62 2.28 99 11.58 -46.7 0 45.62 2.2 92 12.2 -48.4 sm/inst/smdata/radioc.dat0000744000176200001440000001062012266061232015052 0ustar liggesusersRc.age Precision Cal.age 111 10 110 140 18 140 214 18 160 211 18 180 176 16 200 117 16 220 89 12 240 102 17 260 245 16 280 280 12 300 367 17 320 374 16 340 357 14 360 379 16 380 323 11 400 306 10 420 367 09 440 343 17 460 403 18 480 411 10 490 469 17 500 511 19 520 525 14 540 617 13 560 687 14 580 650 16 600 589 14 620 603 14 640 720 13 660 792 10 690 824 10 720 874 18 735 841 18 755 886 09 780 946 09 800 910 12 820 936 12 840 929 11 860 904 10 880 920 12 900 981 12 920 1051 11 940 1067 10 960 1090 10 980 1135 14 995 1124 16 1010 1132 14 1030. 1119 14 1050 1212 14 1070 1196 17 1090 1225 17 1100 1206 17 1120 1238 16 1140 1254 16 1160 1261 16 1180 1292 16 1200 1260 12 1220 1294 12 1240 1291 18 1260 1341 18 1280 1424 12 1300 1414 18 1320 1475 18 1340 1536 18 1360 1499 18 1380 1545 19 1400 1546 18 1420 1564 17 1440 1602 17 1460 1567 17 1480 1585 17 1500 1631 17 1520 1659 17 1540 1695 17 1560 1719 17 1580 1692 18 1600 1738 18 1620 1761 17 1640 1742 17 1660 1734 18 1680 1728 18 1700 1812 18 1720 1822 18 1740 1883 18 1760 1850 18 1780 1825 18 1800 1854 18 1820 1923 18 1840 1934 18 1860 1990 16 1880 1975 18 1900 1971 16 1920 2018 17 1940 2018 18 1960. 2045 18 1980 2065 17 2000 2077 16 2020 2090 16 2040 2116 14 2060 2127 16 2080 2133 16 2100 2136 12 2120 2165 12 2140 2220 13 2160 2197 17 2180 2209 16 2200 2265 16 2220 2205 18 2240 2223 13 2260 2216 18 2280 2203 16 2300 2240 13 2320 2295 15 2340 2457 18 2360 2437 11 2380 2406 12 2400 2423 11 2420 2432 13 2440 2433 10 2460 2457 10 2480 2497 9 2500 2506 10 2520 2494 11 2540 2521 10 2560 2502 10 2580 2486 14 2600 2524 12 2620 2476 12 2640 2459 15 2660 2466 13 2680 2458 13 2700 2522 16 2720 2541 12 2740 2654 18 2760 2675 18 2780 2716 16 2800 2744 14 2820 2728 14 2840 2765 13 2860 2824 19 2880 2829 19 2900. 2806 11 2920 2828 12 2940 2872 8 2960 2876 12 2980 2905 10 3000 2916 10 3020 2903 12 3040 2876 12 3060 2913 15 3070 2946 15 3090 2952 16 3100 2987 14 3120 2954 16 3140 2969 16 3160 3020 14 3180 2946 14 3200 3039 17 3220 3038 17 3240 3055 17 3260 3111 16 3280 3054 16 3300 3044 18 3320 3069 15 3340 3133 14 3360 3195 16 3380 3215 10 3400 3216 15 3420 3180 16 3460 3318 15 3480 3335 18 3500 3299 16 3520 3303 14 3540 3301 15 3560 3341 15 3580 3340 13 3600 3344 15 3620 3417 16 3640 3447 19 3660 3391 13 3680 3451 15 3700 3478 14 3720 3546 17 3740 3503 19 3760 3528 19 3780 3465 14 3800 3479 14 3820. 3560 13 3840 3592 18 3860 3576 14 3880 3611 13 3900 3604 17 3920 3677 11 3940 3634 15 3960 3631 16 3980 3721 16 4000 3718 18 4020 3675 15 4040 3676 18 4060 3703 18 4080 3805 13 4100 3752 18 4120 3808 14 4140 3834 14 4160 3819 16 4180 3797 13 4200 3794 16 4220 3844 16 4240 3849 16 4260 3873 13 4280 3877 16 4300 3890 13 4320 3882 16 4340 3922 12 4360 3898 7 4380 3899 10 4400 3979 13 4420 3981 13 4440 4052 10 4460 4049 15 4480 3992 14 4500 4039 11 4520 4085 11 4540 4088 18 4560 4164 10 4580 4092 14 4600 4175 12 4620 4133 12 4640 4225 12 4660 4144 9 4680 4168 12 4700 4156 16 4720 4263 13 4740 4165 13 4760. 4102 8 4780 4098 11 4800 4176 13 4820 4289 13 4840 4296 12 4860 4406 13 4880 4422 13 4900 4414 18 4920 4402 14 4940 4364 14 4960 4406 13 4980 4477 13 5000 4437 14 5020 4442 16 5040 4513 20 5060 4517 15 5080 4539 14 5100 4486 18 5120 4531 15 5140 4543 16 5160 4527 12 5180 4467 13 5200 4491 17 5220 4489 14 5240 4524 14 5260 4536 14 5280 4596 14 5300 4636 18 5320 4743 16 5340 4702 18 5360 4678 18 5380 4680 17 5400 4682 18 5420 4664 19 5440 4733 19 5460 4781 19 5480 4826 19 5500 4800 20 5520 4739 20 5540 4759 20 5560 4815 20 5580 4878 20 5600 4871 18 5620 4881 18 5640 4973 18 5660 4986 18 5680 4955 18 5700. 4926 17 5720 5045 18 5740 5034 17 5760 5136 15 5780 5090 11 5800 5070 13 5820 5034 13 5840 5055 12 5860 5058 12 5880 5107 12 5900 5148 12 5920 5183 15 5940 5271 14 5960 5222 13 5980 5332 13 6000 5308 14 6020 5321 14 6040 5314 18 6060 5275 18 6080 5319 21 6100 5370 16 6120 5360 19 6140 5275 17 6160 5356 16 6180 5434 16 6200 5440 17 6220 5408 17 6240 5413 15 6260 5425 16 6280 5507 15 6300 5591 14 6320. 5573 16 6340 5608 16 6360 5573 16 6380 5568 16 6400 5656 16 6420 5659 16 6440 5683 17 6460 5709 17 6480 5728 17 6500 5710 18 6520 5756 17 6540 5773 16 6560 5792 16 6580 5727 19 6600 5781 17 6620 5812 16 6640 5794 16 6600 5861 18 6680 5859 18 6700 5848 18 6720 5928 19 6740 5953 18 6760 5940 14 6780 5976 18 6800 5999 19 6820 5945 18 6840 6046 15 6860 6039 10 6880 6119 12 6900 6126 12 6920 6113 12 6940 sm/inst/smdata/coalash.doc0000744000176200001440000000126712266061225015231 0ustar liggesusers Coalash data These data record the percentage of coal ash found in mining samples originally reported by Gomez and Hazen (1970) and subsequently used by Cressie (1993). The variables are: East: a code for east-west direction North: a code for north-south direction Percent: the percentage of coalash References: Cressie, N. (1993). Statistics for Spatial Data, revised edition. New York: Wiley. Gomez, M. and Hazen, K. (1970). Evaluating sulfur and ash distribution in coal seams by statistical response surface regression analysis. Report RI 7377, U.S. Bureau of Mines, Washington, D. C. sm/inst/smdata/bissell.doc0000744000176200001440000000045012266061224015244 0ustar liggesusers Bissell data These data refer to the length and the observed number of flaws in rolls of cloth. The variables are: Length: length of each roll (m) Flaws: number of flaws detected Source: Bissell (1972). A negative binomial model with varying element sizes. Biometrika 59, 435-41. sm/inst/smdata/mildew.doc0000744000176200001440000000116412266061230015070 0ustar liggesusers Mildew data The data refer to study of mildew control sponsored by Bainbridge, Jenkyn and Dyke at Rothamsted Experimental Station. There were four treatments, one of which was a control. There were 36 adjacent plots, with an extra plot at each end. Nine blocks were created by grouping the plots in fours. The variables are: t1, t2, t3: indicators of the four treatment groups p1, ..., p8: indicators of the nine blocks Yield: tons of grain per hectare Source: Draper & Guttman (1980). Incorporating overlap effects from neighbouring units into response surface models. Applied Statistics 29, 128-134. sm/inst/smdata/tephra.dat0000744000176200001440000000062012266061233015074 0ustar liggesusersAl2O3 14.82 14.71 14.93 14.93 15.04 14.61 14.66 15.12 14.14 14.86 13.32 15.07 14 13.14 13.15 13.22 12.84 13.59 14.74 15.9 14.62 14.98 14.97 14.96 15.61 14.13 14.3 14.08 14.38 15.06 15.3 14.82 14.52 15.09 15.27 13.93 13.71 13.71 13.82 14.09 14.84 14.33 14.68 14.35 15.1 14.95 14.75 14.41 16.22 14.73 14.49 14.97 15.38 14.89 13.87 13.86 14.43 15.65 14.79 sm/inst/smdata/aircraft.doc0000744000176200001440000000116012266061221015376 0ustar liggesusers Aircraft data These data record six characteristics of aircraft designs which appeared during the twentieth century. The variables are: Yr: year of first manufacture Period: a code to indicate one of three broad time periods Power: total engine power (kW) Span: wing span (m) Length: length (m) Weight: maximum take-off weight (kg) Speed: maximum speed (km/h) Range: range (km) Source: The data were collected by P. Saviotti and are described in detail in Saviotti (1996), "Technological Evolution, Variety and Economy", Edward Elgar: Cheltenham. sm/inst/smdata/bonions.dat0000744000176200001440000000240312266061224015261 0ustar liggesusersDensity Yield Locality 20.64 176.58 1 26.91 159.07 1 26.91 122.41 1 28.02 128.32 1 32.44 125.77 1 34.28 126.81 1 35.76 147.77 1 36.49 117.29 1 38.71 133.49 1 39.44 128.87 1 39.81 110.04 1 40.92 111.15 1 42.76 134.12 1 43.5 99.94 1 45.34 128.7 1 45.71 152.17 1 46.82 100.36 1 47.18 123.32 1 47.92 114.44 1 48.66 131.27 1 53.45 115.12 1 55.66 95.52 1 59.35 94.94 1 59.72 119.28 1 63.04 93.64 1 67.09 85.73 1 68.93 89.26 1 69.3 88.55 1 73.36 76.81 1 80.73 76.63 1 89.58 90.53 1 95.47 71.28 1 98.05 56.61 1 98.42 75.09 1 102.48 65.26 1 105.8 64.48 1 106.53 61.84 1 108.75 65.19 1 115.38 57.1 1 150.77 52.68 1 152.24 47.01 1 155.19 44.28 1 22.3 148.57 2 25.86 125.3 2 29.09 150.69 2 29.74 147.42 2 31.68 117.1 2 31.68 116.64 2 32 129.66 2 32.32 131.54 2 32.32 151.5 2 34.91 121.8 2 35.23 125.67 2 38.47 117.78 2 39.44 101.5 2 41.05 113.22 2 41.7 136.43 2 44.28 117.54 2 45.9 87.2 2 46.55 107.41 2 48.16 129.68 2 48.49 104.63 2 48.81 114.15 2 49.78 99.85 2 50.43 111.65 2 51.72 98.09 2 61.42 87.85 2 65.29 75.45 2 67.23 87.01 2 71.44 90.1 2 73.05 81.08 2 86.63 65.33 2 96 58.49 2 98.91 65.67 2 103.44 67.19 2 105.05 54.01 2 111.19 60.92 2 113.78 53.48 2 119.92 61.62 2 120.89 26.32 2 126.71 61.21 2 138.99 41.67 2 146.75 45.26 2 160.97 46.45 2 sm/inst/smdata/propsim.dat0000744000176200001440000000270612266061231015307 0ustar liggesusers0.875 1 0.7514 2.788 1 0.3682 0.918 1 0.1189 2.583 1 0.5661 1.184 1 0.9223 0.235 1 0.18 1.08 1 0.0383 0.509 1 0.0487 0.579 0 0.6911 1.033 0 0.8104 1.102 1 0.8738 0.733 1 0.1028 0.337 1 0.7284 1.707 1 0.3863 0.969 0 0.36 6.021 1 0.805 0.439 0 0.2733 1.553 1 0.0227 1.221 1 0.4704 2.386 1 0.1972 0.538 0 0.9119 2.004 1 0.0269 0.363 1 0.2628 2.314 1 0.986 6.113 1 0.5367 6.948 1 0.9356 0.998 1 0.3912 0.115 1 0.3816 0.647 1 0.2934 2.2 1 0.341 0.378 1 0.0776 3.485 1 0.6247 0.092 1 0.5385 3.173 1 0.9323 1.563 1 0.5265 1.198 0 0.6496 2.449 1 0.1737 0.574 1 0.9758 1.32 1 0.7288 0.379 1 0.5051 0.217 1 0.0746 0.722 0 0.112 2.012 1 0.9563 0.273 1 0.048 0.174 1 0.3573 0.805 1 0.3146 2.442 1 0.815 0.525 1 0.3213 1.171 1 0.6316 0.15 1 0.9595 1.718 1 0.2654 1.519 0 0.2972 0.84 1 0.4891 0.343 1 0.67 1.035 1 0.2431 0.572 1 0.1642 0.027 0 0.5121 1.444 1 0.9912 3.123 1 0.4387 0.08 1 0.8616 4.31 1 0.7728 2.012 1 0.8526 0.235 0 0.1187 0.468 0 0.9969 0.522 1 0.1214 3.102 1 0.8242 4.663 1 0.5174 1.132 0 0.8508 0.906 1 0.3565 0.149 1 0.1214 1.952 1 0.1276 2.258 1 0.4853 0.429 0 0.0601 0.126 0 0.1193 0.408 1 0.1418 2.268 1 0.4707 0.619 0 0.3131 2.338 1 0.8541 1.054 1 0.7098 0.128 1 0.5655 1.298 0 0.8506 1.106 0 0.478 2.446 1 0.9539 1.774 1 0.2828 1.776 1 0.9472 3.111 1 0.7796 0.121 0 0.6841 0.143 0 0.663 0.663 0 0.4221 0.647 1 0.2673 0.695 0 0.1633 3.746 1 0.5291 3.007 1 0.5252 0.257 1 0.1064 1.428 1 0.0459 0.105 1 0.5839 0.412 1 0.0069 0.019 0 0.6253 2.437 1 0.6514 1.369 1 0.9582 sm/inst/smdata/smacker.doc0000744000176200001440000000122212266061232015231 0ustar liggesusers Mackerel data from the Spanish survey These data were recorded by a Spanish survey, as part of a multi-country survey of the abundance of mackerel eggs off the coast of north-western Europe, in 1992. The variables are: Density: egg density smack.lat: latitude of sampling position smack.long: longitude of sampling position smack.depth: bottom depth Temperature: surface temperature D200: distance from the 200m depth contour line Source: Background to the survey and the data are provided by Watson et al. (1992), Priede and Watson (1993) and Priede et al (1995). Borchers et al (1997) describe an analysis of the data. sm/inst/smdata/citrate.dat0000744000176200001440000000140212266061225015244 0ustar liggesusers C08 C09 C10 C11 C12 C13 C14 C15 C16 C17 C18 C19 C20 C21 93 109 114 121 101 109 112 107 97 117 89 132 121 124 116 116 111 135 107 115 114 106 92 98 116 105 135 93 125 166 180 137 142 114 119 121 95 105 152 154 102 110 144 157 161 173 158 138 148 147 133 124 122 133 122 130 105 134 128 119 136 126 125 125 103 91 98 112 133 124 109 121 100 83 87 110 109 100 93 80 98 100 104 97 89 109 107 95 101 96 88 83 85 91 95 109 116 86 116 138 138 128 102 116 122 100 123 107 117 120 119 99 151 165 156 149 136 142 141 128 130 126 154 148 138 127 137 155 145 139 150 141 125 109 118 109 112 102 107 107 sm/inst/smdata/muscle.dat0000744000176200001440000000055012266061230015100 0ustar liggesusers TypeI.R TypeI.P TypeI.B TypeII 1 1 13 5 15 2 2 8 4 12 3 9 27 16 46 4 4 5 2 12 5 2 12 7 24 6 2 31 16 66 7 1 13 15 45 8 8 27 16 50 9 1 5 5 18 10 1 8 5 15 11 1 2 2 4 12 1 11 3 17 13 1 8 6 15 14 2 17 5 30 15 1 14 4 17 16 1 11 3 16 17 2 12 2 19 18 1 8 7 14 19 1 8 4 14 20 0 4 3 7 21 1 18 5 26 22 0 11 10 26 23 2 15 7 24 24 0 0 4 5 25 0 4 3 6 sm/inst/smdata/tephra.doc0000744000176200001440000000072412266061233015076 0ustar liggesusers Tephra data These data record the percentages of aluminium oxide found in samples from a tephra layer resulting from a volcanic eruption in Iceland around 3500 years ago. The variables are: Al2O3: percentage of aluminium oxide Source: The data were collected by A.Dugmore. The geological background to the data is given by Dugmore et al (1992), Geochemical stability of finegrained silicic tephra in Iceland and Scotland, J.Quatern.Sci. 7, 173-83. sm/inst/smdata/phosphat.doc0000744000176200001440000000043012266061231015431 0ustar liggesusersPhoshat.dat: data on plasma inorganic phosphate (mg/dl) measured at hours (0, 0.5, 1, 1.5, 2, 3, 4, 5) after glucose challenge, in 13 control patients (group 1), and 20 obese patients (group 2). Source: Zerbe, Randomization Analysis of Growth Curves (JASA, March 1979, p.219) sm/inst/smdata/geys3d.doc0000744000176200001440000000126012266061227015010 0ustar liggesusers Geyser data These data document the duration of eruptions, and the time between eruptions, for the Old Faithful Geyser in Yellowstone National Park. The variables are: Waiting: the waiting time before each eruption (minutes) Next.waiting: the waiting time following each eruption (minutes) Duration: the length of an eruption ( minutes) Source: The data were collected by by the Park Geologist, R.A.Hutchinson. An earlier set of data is reported in Weisberg (1990), Applied Linear Regression, Wiley, New York. The later set, used here, was reported by Azzalini & Bowman (1990), "A look at some data on the Old Faithful Geyser", Applied Statistics 39, 357-65. sm/inst/smdata/mackerel.doc0000744000176200001440000000106312266061227015376 0ustar liggesusers Mackerel data These data record the abundance of mackerel eggs off the coast of north-western Europe, from a multi-country survey in 1992. The variables are: Density: egg density mack.lat: latitude of sampling position mack.long: longitude of sampling position mack.depth: bottom depth Temperature: surface temperature Salinity: salinity Source: Background to the survey and the data are provided by Watson et al. (1992), Priede and Watson (1993) and Priede et al (1995). Borchers et al (1997) describe an analysis of the data. sm/inst/smdata/follicle.doc0000744000176200001440000000066212266061226015407 0ustar liggesusers Follicle data These data record the number of ovarian follicles, on a log scale, counted from sectioned ovaries of women of various ages. The variables are: Age: age of the woman Count: follicle count Source: an indicator of the source of the data Source: The data were reported by Block (1952; 1953), Richardson et al (1987), and A Gougeon. They are analysed by Faddy & Gosden (1996) and Faddy & Jones (1997). sm/inst/smdata/airpc.doc0000744000176200001440000000115712266061222014710 0ustar liggesusers Aircraft pc data These data list the first two principal component scores from the aircraft data, which record six characteristics of aircraft designs throughout the twentieth century. The variables are: Comp.1: first principal component score Comp.2: second principal component score Yr: year of first manufacture Period: a code to indicate one of three broad time periods Source: The aircraft data were collected by P. Saviotti and are described in detail in Saviotti (1996), "Technological Evolution, Variety and Economy", Edward Elgar: Cheltenham. sm/inst/smdata/coalash.dat0000744000176200001440000000472312266061225015234 0ustar liggesusersEast North Percent 1 16 11.17 1 15 9.92 1 14 10.21 2 16 10.14 2 15 10.82 2 14 10.73 2 12 9.92 2 11 11.31 2 10 11.15 2 8 10.01 3 17 9.97 3 16 9.93 3 15 11.65 3 14 9.46 3 13 12.50 3 12 11.05 3 11 9.41 3 10 9.91 3 9 10.82 3 8 8.23 3 7 10.39 3 6 10.41 3 5 9.76 3 4 10.93 4 20 9.79 4 19 10.74 4 18 11.21 4 17 9.70 4 16 10.27 4 15 8.96 4 14 9.35 4 13 9.63 4 12 10.11 4 11 9.37 4 10 10.17 4 9 11.75 4 8 11.04 4 7 11.11 4 6 10.82 4 5 11.10 4 4 10.94 4 3 9.64 4 2 9.29 4 1 10.59 5 21 10.39 5 20 9.06 5 19 12.80 5 18 9.89 5 17 9.84 5 16 10.21 5 15 9.88 5 14 9.78 5 13 10.82 5 12 11.46 5 11 11.21 5 10 10.55 5 9 9.78 5 8 10.28 5 7 10.96 5 6 17.61 5 5 10.80 5 4 9.53 5 3 9.52 5 2 8.75 5 1 10.43 6 21 10.65 6 20 10.70 6 19 10.03 6 18 10.34 6 17 10.29 6 16 11.09 6 15 8.90 6 14 10.38 6 13 10.12 6 12 10.41 6 11 9.93 6 10 11.61 6 9 11.00 6 8 13.07 6 7 10.83 6 6 10.87 6 5 8.86 6 4 10.61 6 3 10.06 6 2 8.96 6 1 9.32 7 22 11.62 7 21 10.36 7 20 11.21 7 19 9.36 7 18 8.20 7 17 9.84 7 16 10.63 7 15 10.18 7 14 9.79 7 13 9.40 7 12 8.45 7 11 10.70 7 10 9.16 7 9 9.79 7 8 10.47 7 7 10.09 7 5 9.48 7 4 10.27 7 3 12.65 7 2 8.27 8 22 10.91 8 21 9.58 8 20 8.98 8 19 8.57 8 18 9.82 8 17 10.01 8 16 8.82 8 15 9.34 8 14 8.91 8 13 9.48 8 12 8.90 8 11 9.27 8 10 10.04 8 9 10.19 8 8 11.58 8 7 8.69 8 6 13.06 8 5 9.22 8 4 9.59 8 3 9.63 8 2 8.14 9 22 8.76 9 21 10.66 9 20 9.27 9 19 9.01 9 18 10.06 9 17 9.01 9 16 10.18 9 15 10.56 9 14 9.22 9 13 10.99 9 12 8.07 9 11 9.28 9 10 11.19 9 9 9.15 9 8 9.46 9 7 11.17 9 6 11.41 9 5 9.61 9 4 9.82 10 23 8.59 10 22 8.89 10 21 8.92 10 20 8.19 10 19 9.04 10 18 8.58 10 17 7.68 10 16 9.34 10 15 9.06 10 14 11.43 10 13 9.92 10 12 7.96 10 11 10.13 10 10 8.10 10 9 8.15 10 8 8.54 10 7 9.39 10 6 9.96 10 5 8.20 10 4 7.81 11 23 9.00 11 22 9.10 11 21 7.80 11 20 7.88 11 19 7.28 11 18 8.89 11 17 9.25 11 16 8.61 11 13 7.85 11 12 7.00 11 11 8.61 11 10 11.30 11 9 9.20 11 8 10.87 11 7 9.56 11 6 9.15 12 23 11.86 12 22 7.62 12 21 7.84 12 20 7.61 12 19 9.58 12 18 8.64 12 17 7.83 12 13 8.21 12 12 7.90 12 11 8.78 13 23 8.91 13 22 9.65 13 21 9.03 13 20 8.20 13 19 9.69 13 18 7.04 13 17 9.14 14 23 9.99 14 21 8.60 14 20 8.77 14 19 9.96 14 18 8.81 15 19 9.91 15 18 7.95 15 17 7.63 16 17 9.07 sm/inst/smdata/worm.dat0000744000176200001440000000411512266061236014603 0ustar liggesusersAge Infection Sex 0.1 1 2 0.1 0 1 0.25 0 1 0.25 0 2 0.25 0 2 0.4 0 1 0.4 0 2 0.4 0 1 0.5 0 2 0.5 0 1 0.5 0 2 0.6 0 2 0.6 0 2 0.9 0 2 1 0 2 1.2 1 1 1.4 0 1 1.4 1 2 1.5 1 2 1.5 1 2 1.5 1 1 2 0 1 2 1 2 2 0 1 2 1 2 2 1 1 2 0 1 2 0 2 2.25 0 2 2.5 1 2 2.5 1 1 2.5 1 1 3 1 2 3 1 1 3 0 2 3 1 2 3 0 1 3 1 2 3 1 2 3 1 1 3 0 1 3.25 1 1 3.5 1 2 4 0 2 4 1 2 4 0 2 4 0 2 4 1 1 4.5 1 1 4.8 1 1 5 1 1 5 1 1 5 1 2 5 0 1 5 1 2 5 0 1 5 0 2 6 1 2 6 1 2 6 0 1 6 1 1 6 1 2 6 1 1 6.25 1 2 7 0 1 7 0 2 7 1 1 7 1 2 7 1 2 7 1 1 7 1 1 8 1 2 8 0 1 8 1 2 8 1 2 8 1 2 8 1 1 9 1 1 9 1 2 9 1 2 9 1 1 9 0 2 9 1 2 9 1 2 9 1 2 10 1 2 10 1 1 10 1 1 11 0 1 11 0 2 11 1 1 11 1 1 11 1 1 11 1 1 12 1 2 12 0 1 12 1 1 12 1 2 13 0 2 13 0 1 13 1 2 13 0 1 13 1 1 14 1 2 14 0 2 14 1 1 15 1 1 15 1 2 15 0 1 15 1 2 15 0 1 15 1 1 15 1 1 15 0 1 15 1 1 15 1 2 16 0 1 16 1 2 16 1 2 16 1 1 16 1 1 17 1 1 17 1 2 17 1 2 17 1 2 18 0 2 18 1 1 18 0 1 18 1 2 18 0 1 18 1 2 18 1 2 18 1 2 19 0 1 19 1 2 19 0 2 19 0 1 19 1 2 20 0 1 20 1 2 20 1 1 20 1 2 20 1 2 20 0 2 20 1 2 20 0 2 20 1 2 21 1 2 21 1 1 21 1 2 21 0 2 21 1 2 22 1 2 22 1 1 22 0 2 22 1 2 22 0 1 23 0 1 23 1 1 23 1 2 23 1 1 23 1 2 23 1 1 23 1 1 23 0 1 23 0 1 24 0 1 24 1 1 24 1 2 24 0 2 24 0 2 25 1 2 25 0 2 25 1 2 25 1 2 25 0 2 25 1 1 25 0 1 26 0 1 26 1 2 26 1 1 26 1 2 26 0 1 27 0 2 27 0 1 27 1 2 27 1 1 27 0 2 27 0 1 28 0 1 28 1 1 28 0 1 28 0 2 29 1 1 29 1 1 29 1 1 30 1 1 30 0 2 30 1 2 30 1 1 30 0 2 30 0 1 30 1 1 30 0 1 30 0 1 30 1 2 31 1 2 31 1 2 31 1 2 31 1 2 32 1 2 33 1 1 33 1 2 33 0 2 35 0 1 35 1 1 35 0 1 35 1 1 36 1 1 36 1 1 36 1 2 36 1 2 36 0 1 37 1 1 37 1 2 37 1 1 39 1 1 40 1 2 40 0 2 41 1 2 42 0 1 42 1 2 42 0 1 43 1 2 44 1 2 45 0 1 45 1 2 45 0 1 45 1 2 46 0 2 46 0 2 47 1 2 47 1 2 47 1 1 47 0 2 48 1 1 48 1 1 48 1 2 48 0 1 49 1 2 49 0 2 50 1 2 50 0 1 51 0 1 51 1 2 51 0 2 52 0 1 52 1 2 53 0 1 53 1 2 53 1 2 54 0 1 54 0 1 54 1 1 54 0 1 54 0 1 56 0 1 56 1 2 56 0 1 56 1 2 56 0 1 56 1 1 56 0 2 57 0 2 58 1 2 58 1 1 59 1 1 60 1 2 60 0 1 60 1 2 62 1 2 62 1 2 62 0 1 63 1 1 63 0 1 63 1 2 64 0 2 64 0 1 64 1 2 65 1 2 66 0 2 67 1 2 67 1 1 70 0 2 70 0 1 71 1 2 75 0 1 76 1 2 79 0 1 79 1 2 80 0 1 80 0 2 81 1 1 86 0 2 sm/inst/smdata/lcancer.doc0000744000176200001440000000125512266061227015225 0ustar liggesusers Laryngeal cancer data These data record the spatial positions of cases of laryngeal cancer in the North-West of England between 1974 and 1983, together with the positions of a number of lung cancer patients who were used as controls. The data have been adjusted to preserve anonymity. The variables are: Easting: a west-east grid reference Northing: a north-south grid reference Cancer: an indicator of laryngeal (1) or lung (2) cancer Source: Bailey & Gatrell (1995). Interactive Spatial Data Analysis. Longman Scientific and Technical, Harlow. A more extensive set of data is analysed in Kelsall & Diggle, kernel estimation of relative risk, Bernoulli 1, 3-16. sm/inst/smdata/mackerel.dat0000744000176200001440000002070512266061227015405 0ustar liggesusersDensity mack.lat mack.long mack.depth Temperature Salinity 5.43 48.25 5.75 124 18.63 120 3.2 48.25 6.25 140 20.98 136 6.04 48.23 6.8 160 23.25 155 7.79 48.25 7.27 173 1.47 166 0.82 48.25 7.78 184 3.73 180 14.98 48.27 8.23 206 6.62 195 55.53 48.23 8.75 192 6.65 195 62.85 48.25 9.25 256 9.18 199 52.25 48.23 9.75 875 11.53 200 69.2 48.25 10.27 3000 13.85 201 47.45 48.25 10.77 2700 16.78 200 21.52 48.25 11.25 4000 19.03 200 30.86 48.23 11.73 2800 21.45 200 75.5 48.73 12.73 1600 2.72 200 29.17 48.73 12.25 1300 5.05 200 36.69 48.73 11.87 1400 7 200 151.14 48.75 11.62 2600 8.42 200 172.63 48.75 11.37 1600 9.83 200 107.87 48.73 11.12 1000 11.18 200 178.81 48.75 10.87 1100 12.6 200 133.62 48.73 10.62 1400 14.2 200 116.25 48.73 10.37 162 16.77 162 123.28 48.75 10.07 425 20.3 200 213.32 48.75 9.85 193 21.77 188 144.01 48.75 9.6 176 23.07 172 58.24 48.75 9.37 175 0.4 171 14.81 48.75 9.13 165 1.72 157 1.85 48.73 8.87 170 3.02 168 5.6 48.73 8.63 146 4.38 135 6.85 48.75 8.23 153 6.15 158 5.22 48.75 7.75 158 8.63 153 19.53 48.75 7.23 153 10.85 144 10.37 48.75 6.77 145 12.98 74 2.74 48.75 6.27 137 14.87 70 2.46 49.25 6.73 126 18.32 60 7.17 49.25 7.22 135 20.13 61 12.26 49.25 7.72 138 21.97 60 12.21 49.25 8.25 127 0 125 13.87 49.25 8.63 152 1.82 146 3.99 49.25 8.88 154 3.27 149 1.12 49.25 9.12 151 4.57 145 9.8 49.25 9.38 153 5.87 147 6.61 49.23 9.65 154 7.18 150 8.1 49.25 9.88 132 8.53 122 82.04 49.25 10.15 162 9.77 157 254.57 49.25 10.37 136 11.02 128 133.75 49.25 10.63 163 12.32 156 35.34 49.23 10.88 177 13.7 169 79.52 49.25 11.08 187 14.88 181 124.71 49.23 11.37 350 16.87 200 351.88 49.25 11.73 830 17.5 200 82.05 49.25 12.25 1100 20.42 200 123.08 49.25 12.75 1200 22.78 200 53.92 49.73 12.73 2200 2.72 200 56.16 49.73 12.25 1200 4.87 200 275.73 49.75 11.75 780 7 200 204.49 49.73 11.33 450 8.88 200 50.83 49.73 11.1 320 10.35 200 25.37 49.75 10.83 175 11.75 167 230.82 49.75 10.6 147 13.15 143 10.97 49.75 10.35 143 14.43 139 36.55 49.75 10.08 141 15.73 141 36.63 49.73 9.85 131 17.03 128 43.18 49.73 9.62 158 18.22 152 83.48 49.73 9.33 118 20.88 112 4.25 49.75 9.12 142 23.3 140 5.32 49.75 8.85 126 1.03 136 4.02 49.75 8.6 136 2.55 140 2.42 49.73 7.72 133 6.9 131 4.94 50.25 7.73 103 11.15 97 31.02 50.25 8.73 126 16.92 132 51.51 50.25 9.23 140 20 135 50.61 50.25 9.75 126 22.93 118 15.27 50.23 10.1 137 1.1 132 9.25 50.23 10.37 147 3.33 142 8.93 50.23 10.62 164 5.3 162 5.59 50.23 10.87 208 7.22 201 176.86 50.23 11.13 550 9.23 200 326.13 50.23 11.38 1100 11.45 200 253.29 50.25 11.73 1600 13.88 200 122.37 50.25 12.25 2300 16.82 200 191.62 50.23 12.75 2400 19.48 200 46.51 50.75 12.75 2300 0.37 200 89.16 50.73 12.25 2100 2.82 200 99.45 50.75 11.87 2000 4.72 200 131.17 50.73 11.6 1800 6.1 200 202.89 50.75 11.37 1300 7.5 200 62.67 50.73 11.12 330 8.92 200 32.44 50.73 10.85 181 10.67 175 24.85 50.73 10.55 166 12.08 160 10.65 50.75 10.23 140 14.53 133 1.19 50.75 9.72 123 16.8 118 20.62 50.73 9.23 130 18.55 124 18.96 50.73 8.73 105 20.47 96 0.85 51.25 8.25 101 1.9 96 1.88 51.23 8.75 105 3.75 99 0.8 51.25 9.25 110 5.7 107 1.75 51.25 9.75 108 7.73 102 5.58 51.23 10.25 136 9.72 130 11.41 51.23 10.63 165 11.37 160 17.91 51.25 10.88 178 4.55 172 58.98 51.23 11.3 211 6.35 200 128.27 51.23 11.65 610 8.05 200 306.81 51.25 11.88 1100 9.35 200 150.92 51.25 12.12 1200 10.72 200 137.45 51.25 12.38 1300 12.17 200 214.4 51.23 12.75 1500 13.88 200 13.29 51.75 14.73 470 15.07 200 22.19 51.73 14.35 375 19.52 200 29.5 51.73 14.08 380 20.92 200 59.55 51.75 13.85 450 22.32 200 82.04 51.73 13.62 590 23.63 200 43.92 51.73 13.37 790 1.03 200 226.99 51.73 13.12 1000 2.45 200 288.36 51.73 12.88 1200 3.87 200 301.44 51.75 12.62 1300 5.27 201 132.6 51.75 12.38 1300 6.63 200 202.84 51.73 12.12 1000 8.03 200 143.54 51.75 11.88 710 9.45 200 76.81 51.73 11.62 350 10.88 200 49.1 51.73 11.35 210 12.4 200 16.32 51.75 11.1 183 13.85 178 31.82 51.75 10.73 133 15.77 135 0.56 51.23 8.23 101 5.23 95 2.67 51.25 9.73 102 13.1 95 18 51.25 10.23 133 16.03 125 19.51 51.25 10.72 171 18.63 166 8.45 51.23 11.22 203 21.63 183 219.77 51.25 11.72 1161 0.33 183 601.78 51.25 12.18 1645 3.17 183 140.85 51.23 12.7 1885 5.75 183 151.25 51.73 14.7 481 13.92 183 156.6 51.75 14.28 377 17.13 183 96 51.73 13.78 509 19.6 183 348.08 51.73 13.28 912 22.42 183 164.13 51.73 12.78 1085 0.9 183 281.81 51.75 12.28 996 3.52 183 164.93 51.73 11.77 523 5.8 183 13.6 51.73 11.28 195 8.57 183 10.38 51.75 10.78 138 11.6 138 0.79 51.75 10.3 68 14.15 58 2.28 52.23 10.7 117 17.78 93 1.63 52.25 11.2 139 19.98 129 36.56 52.23 11.7 306 22.33 183 165.28 52.25 12.23 749 1.12 183 93.67 52.25 12.72 689 3.27 183 173.42 52.25 13.2 572 5.68 183 79.42 52.23 13.7 387 8.05 183 35.91 52.23 14.2 334 10.77 183 131.4 52.25 14.68 436 12.93 183 365.88 52.73 14.78 559 16.88 183 20.7 52.75 14.28 332 19.28 183 203.39 52.75 13.78 234 21.65 183 75.11 52.73 13.28 347 23.97 183 109.68 52.73 12.8 487 2.6 183 52.99 52.75 12.28 337 5.13 183 0.9 52.75 11.78 168 7.52 165 2.92 52.73 11.27 130 9.85 130 0.97 53.22 11.25 143 13.35 129 3.66 53.25 11.68 182 15.88 165 8.33 53.23 12.2 308 18.38 183 29.2 53.25 12.7 338 20.82 183 51.55 53.23 13.2 236 23.1 183 51.48 53.23 13.68 171 1.42 166 38.12 53.25 14.2 208 3.83 183 104 53.25 14.7 949 6.33 183 179.54 53.72 14.75 1500 10.18 183 28.9 53.75 14.28 1358 12.73 183 74.9 53.75 13.8 418 15.13 183 42.12 53.75 13.28 303 17.53 183 42.11 53.73 12.77 283 20.25 183 26.43 53.73 12.28 333 22.43 183 22.55 53.73 11.77 295 0.67 183 9.97 53.75 11.3 205 3.08 183 18.89 53.75 10.78 148 5.45 139 0.89 53.2 10.72 119 13.83 118 1.9 52.73 10.27 100 19.25 93 84.06 54.25 10.72 214 19.82 183 155.83 54.25 11.2 340 22.15 183 69.66 54.25 11.73 1172 0.65 183 82.33 54.23 12.2 2030 2.97 183 21.88 54.23 12.7 2200 5.38 183 12.69 54.73 12.27 2000 9.47 183 10.5 54.75 11.78 2873 12.08 183 11.41 54.75 11.3 2900 14.48 183 211.63 54.75 10.78 1750 16.88 183 49.99 54.75 10.28 120 19.25 118 21.52 54.73 9.73 100 22 88 0.6 55.23 8.7 93 6.45 80 6.91 55.25 9.22 109 8.57 102 20.4 55.25 9.72 128 10.73 80 31.47 55.23 10.18 1291 12.75 183 13.62 55.23 10.65 2480 14.83 183 35.12 55.73 10.27 2300 19.07 183 33.96 55.75 9.78 1785 21.25 183 22.53 55.73 9.27 140 23.48 128 6.1 55.73 8.77 106 1.73 101 2.1 55.73 8.28 104 3.9 93 0.92 56.25 8.23 167 7.17 155 2.27 56.23 8.72 131 9.32 120 32.23 56.25 9.2 711 11.38 183 92.77 56.23 9.68 1595 13.98 183 18.57 56.75 9.77 1795 17.53 183 188.9 56.75 9.28 1260 19.58 183 9.12 56.73 8.78 117 21.75 101 3.97 57.23 8.73 134 1.13 129 41.55 57.23 9.18 174 3.12 146 63.62 57.25 9.7 1940 5.2 183 55.3 57.75 9.77 1088 8.88 95 2.61 57.75 9.27 144 10.95 133 5.25 57.75 8.78 146 13.2 133 2.02 57.73 8.28 111 15.98 110 0.66 56.77 8.25 132 22.37 120 0.52 48.25 5.75 120 13.08 50 13.69 48.25 6.23 139 15.52 50 9.24 48.25 6.75 155 18.23 50 2.21 48.25 7.25 172 20.8 65 9.17 48.25 7.75 177 23.25 60 14.62 48.25 7.8 178 23.57 65 15.66 48.25 8.25 205 1.55 60 93.56 48.25 8.75 200 3.98 173 77.66 48.25 8.8 190 5.12 180 59.52 48.25 9.23 560 8.8 200 57.72 48.25 9.25 520 9.22 200 118.79 48.25 9.75 775 11.7 150 62.8 48.25 9.77 906 12.13 150 176.81 48.25 10.23 2000 14.58 207 133.23 48.25 10.23 2000 15.07 205 254.14 48.25 10.73 1800 17.57 205 227.16 48.25 10.75 1900 18 200 237.37 48.25 11.25 3600 20.35 200 75.04 48.25 11.73 3000 10.78 150 20.15 47.75 10.77 2000 3.83 206 27.89 47.75 10.25 2000 5.22 200 14.64 47.75 9.75 4450 8.53 200 20.43 47.75 9.23 3500 11.5 110 95.08 47.75 8.73 2500 13.77 200 126.78 47.75 8.27 1560 15.92 200 189.65 47.75 8.23 1350 16.47 210 154.51 47.75 7.77 900 18.53 200 116.22 47.75 7.75 770 18.97 200 23.52 47.75 7.25 176 21.3 150 42.18 47.75 6.75 167 23.88 118 3.08 47.75 6.27 152 2.33 57 6.39 47.75 5.75 134 4.37 59 2.1 47.75 4.75 100 8.45 75 8.51 47.25 4.73 122 11.37 72 11.18 47.25 6.23 1314 18.2 120 26.19 47.25 6.28 1115 18.75 120 126.44 47.25 6.75 2300 21.23 200 67.27 47.25 7.25 2500 0.53 200 59.44 47.25 7.32 2500 1.33 200 31.42 47.25 7.73 3000 3.67 203 16.47 47.25 8.25 3000 6.83 200 6.96 47.25 9.25 3000 14.07 231 4.44 47.25 9.73 3000 16.52 210 1.54 47.25 10.23 3000 19.23 212 12.15 46.75 8.25 4000 3.45 221 0.95 46.75 7.75 4000 5.87 204 21.64 46.75 7.23 4000 8.6 200 33.61 46.75 6.73 2000 11.22 230 17.88 46.75 6.25 2000 13.73 205 5.02 46.75 6.18 2000 14.5 205 31.37 46.75 5.78 2000 16.68 200 49.77 46.75 5.73 2000 17.42 210 79.99 46.75 5.22 1000 19.93 200 31.65 46.75 5.12 800 21.02 195 5.77 46.75 4.77 163 23.23 140 4.05 46.75 4.72 158 23.97 140 4.85 46.75 4.3 138 2.37 64 5.01 46.75 4.27 142 2.73 57 3.44 46.75 3.78 128 4.95 75 4.1 46.75 3.75 124 5.38 71 2.04 46.25 3.25 123 22.13 100 0.98 46.25 3.72 133 0.97 100 23.09 46.25 4.22 205 4.35 157 20.71 46.25 4.28 237 5.13 155 5.03 47.23 4.25 114 22.15 80 2.34 47.25 3.72 100 0.53 80 sm/inst/smdata/trees.dat0000744000176200001440000000075012266061234014740 0ustar liggesusersDiameter Height Volume 8.2 70 10.3 8.6 65 10.3 8.8 63 10.2 10.5 72 16.4 10.7 81 18.8 10.8 83 19.7 11.0 66 15.6 11.0 75 18.2 11.1 80 22.6 11.2 75 19.9 11.3 79 24.2 11.4 76 21.0 11.4 76 21.4 11.7 69 21.3 12.0 75 19.1 12.9 74 22.2 12.9 85 33.8 13.3 86 27.4 13.7 71 25.7 13.8 64 24.9 14.0 78 34.5 14.2 80 31.7 14.5 74 36.3 16.0 72 38.3 16.3 77 42.6 17.3 81 55.4 17.5 82 55.7 17.9 80 58.3 18.0 80 51.5 18.0 80 51.0 20.6 87 77.0 sm/inst/smdata/nile.doc0000744000176200001440000000060612266061231014537 0ustar liggesusers Nile data These data record historical data on the water level of the River Nile. The variables are: Volume: Annual volume of the Nile River (discharge at Aswan, 10^8 m^3) Year: 1871-1970 References: Cobb, G. (1978). The problem of the Nile: conditional solution to a change-point problem. Biometrika 65, 243-251. sm/inst/smdata/bissell.dat0000744000176200001440000000032512266061223015247 0ustar liggesusersLength Flaws 551 6 651 4 832 17 375 9 715 14 868 8 271 5 630 7 491 7 372 7 645 6 441 8 895 28 458 4 642 10 492 4 543 8 842 9 905 23 542 9 522 6 122 1 657 9 170 4 738 9 371 14 735 17 749 10 495 7 716 3 952 9 417 2 sm/inst/smdata/airpc.dat0000744000176200001440000003063012266061222014711 0ustar liggesusersComp.1 Comp.2 Year Period -3.413 -1.349 14 1 -3.32 -0.874 14 1 -2.1 -1.475 14 1 -2.435 -1.217 15 1 -3.093 -1.002 15 1 -4.023 -0.042 15 1 -3.486 -1.142 15 1 -1.999 -0.574 16 1 -3.698 -0.15 16 1 -3.705 -1.187 16 1 -2.959 -0.927 16 1 -2.604 -0.814 16 1 -3.71 -0.164 16 1 -2.761 -1.003 16 1 -2.176 -0.878 16 1 -2.589 -0.469 16 1 -4.134 -0.059 16 1 -2.58 -1.343 16 1 -2.357 -1.545 16 1 -1.675 -1.69 17 1 -1.015 -1.628 17 1 -2.06 -0.87 17 1 -1.405 -1.753 17 1 -2.626 -0.636 17 1 -2.303 -0.916 17 1 -2.338 -0.904 17 1 -2.823 -0.199 17 1 -3.709 0.041 17 1 -3.698 -0.331 17 1 -2.821 -1.241 17 1 -3.482 -0.267 17 1 -3.303 0.171 17 1 -3.182 -0.518 17 1 -0.437 -1.511 17 1 -1.017 -1.661 18 1 0.641 -2.731 18 1 -1.869 -0.791 18 1 -1.274 -2.132 18 1 -0.013 -2.161 18 1 -2.891 0.019 18 1 -1.787 -0.693 18 1 -2.819 0.001 18 1 -2.088 -0.985 19 1 -2.721 0.092 19 1 -1.826 -0.942 20 1 -1.487 -0.86 20 1 -1.703 -0.924 20 1 -1.679 -0.935 20 1 -1.69 -0.583 21 1 -1.853 -1.043 21 1 -1.943 -1.044 21 1 -2.305 -0.2 22 1 0.767 -1.876 22 1 -2.864 0.11 22 1 -0.347 -1.553 22 1 -3.43 0.319 22 1 -2.618 0.142 23 1 -2.479 0.183 23 1 -1.031 -1.149 23 1 -0.999 -1.13 23 1 -1.031 -1.149 23 1 -0.999 -1.13 23 1 -2.416 -0.965 23 1 -1.565 -0.917 23 1 -2.809 0.335 23 1 -2.93 0.138 24 1 -2.484 -0.077 24 1 -1.381 -0.626 24 1 -3.009 0.203 24 1 0.303 -1.828 24 1 -0.512 -1.556 25 1 -2.119 0.463 25 1 -3.774 -0.569 25 1 -1.906 -0.191 25 1 -1.035 -0.691 25 1 -1.739 -0.126 25 1 -2.074 -0.334 25 1 -1.792 -0.361 26 1 -2.686 0.184 26 1 -1.659 -0.559 26 1 -2.933 0.234 26 1 -1.646 -1.229 26 1 -1.56 -0.687 26 1 -1.496 -0.903 26 1 -0.131 -1.98 26 1 -0.637 -1.363 26 1 -1.082 -0.779 26 1 -2.482 0.319 27 1 -0.219 -1.481 27 1 -0.524 -1.345 27 1 -0.984 -1.018 27 1 -2.382 0.2 27 1 -2.298 -0.015 27 1 -2.557 0.408 27 1 -1.808 -0.533 27 1 -0.258 -1.147 28 1 -0.201 -1.25 28 1 -2.117 -0.845 28 1 -3.726 -0.542 28 1 -1.863 0.055 28 1 -1.332 -0.666 28 1 -2.485 -0.206 28 1 -1.174 -0.677 28 1 -3.237 -0.732 28 1 -2.514 0.084 28 1 -2.556 0.537 28 1 -2.036 -0.326 28 1 -3.551 -0.405 29 1 -2.629 -0.606 29 1 -3.205 -0.622 29 1 -2.079 -0.068 29 1 -2.423 0.81 29 1 -1.776 -0.783 29 1 -3.529 -0.494 29 1 -2.872 -0.33 29 1 -0.24 -1.16 29 1 0.148 -1.639 29 1 0.016 -0.925 30 1 -1.407 -0.572 30 1 1.037 -2.122 30 1 -1.402 -1.082 30 1 0.016 -0.899 30 1 -2.437 0.242 30 1 -2.435 0.354 30 1 -3.404 -0.605 31 1 -2.881 0.626 31 1 -3.45 -0.319 31 1 -2.23 0.151 31 1 -1.641 0.38 31 1 -1.277 -0.034 31 1 -1.447 -0.368 31 1 -2.001 0.532 31 1 -0.391 -0.951 32 1 -2.94 -0.448 32 1 -2.029 -0.991 32 1 -2.029 -0.991 32 1 -1.79 0.274 32 1 1.436 -1.364 32 1 -1.903 0.396 32 1 -0.561 -1.097 32 1 -1.846 -0.046 32 1 -1.99 0.063 32 1 -0.768 -0.212 32 1 0.837 -1.26 32 1 -1.574 -0.295 32 1 0.505 -1.452 32 1 0.686 -0.469 32 1 -2.07 0.319 32 1 -2.061 0.309 32 1 1.226 -1.889 32 1 -1.982 0.787 33 1 0.611 -1.903 33 1 -2.06 0.627 33 1 -2.84 0.065 33 1 -0.008 -1.128 33 1 -1.925 0.3 33 1 -2.157 0.359 33 1 1.334 -1.647 33 1 -0.977 -0.071 33 1 -2.276 1.243 33 1 0.104 -0.853 33 1 -1.781 0.694 33 1 -1.949 0.737 33 1 0.699 -1.357 33 1 -1.11 -0.167 33 1 -1.229 -0.596 33 1 -1.016 -0.522 33 1 -0.85 -0.702 33 1 0.537 -0.504 34 1 -0.624 -1.049 34 1 -1.592 -0.752 34 1 -1.818 0.389 34 1 0.762 -0.273 34 1 1.11 -1.361 34 1 -0.923 -0.612 34 1 -1.417 -0.671 34 1 -1.785 0.111 34 1 -0.393 -1.036 34 1 0.512 -0.816 34 1 -0.854 -0.386 34 1 -0.546 -0.434 34 1 -1.671 0.353 34 1 0.22 -1.12 34 1 -1.595 0.08 34 1 -1.086 -0.162 34 1 1.552 -1.508 34 1 0.527 -1.009 34 1 0.065 -0.899 34 1 -0.452 1.155 34 1 -1.141 -0.658 34 1 -0.099 -1.153 34 1 -1.42 -0.832 35 1 -0.775 -0.214 35 1 1.581 -1.498 35 1 -1.967 0.537 35 1 -1.935 0.762 35 1 0.189 -1.308 35 1 0.303 -0.118 35 1 1.018 -0.456 35 1 -1.683 0.407 35 1 -0.501 0.195 35 1 -0.719 -1.179 35 1 -1.08 0.42 35 1 -1.853 0.736 35 1 0.513 -1.276 35 1 -1.467 0.204 35 1 -1.284 1.258 35 1 -1.617 0.594 35 1 1.273 -0.971 35 1 0.671 -0.955 35 1 0.239 -0.789 35 1 -1.074 0.65 35 1 0.761 -0.902 35 1 -2.953 -0.549 35 1 -1.295 0.5 35 1 -1.038 -0.486 35 1 0.977 -1.353 36 2 -0.446 -0.19 36 2 0.975 -0.493 36 2 -2.278 -0.957 36 2 2.403 -1.606 36 2 -0.355 -0.514 36 2 2.417 -1.968 36 2 -0.022 0.274 36 2 1.308 -0.968 36 2 -1.107 -0.345 36 2 0.231 -0.086 36 2 1.648 -1.439 36 2 0.48 -0.211 36 2 0.186 -0.202 36 2 -1.484 0.859 37 2 -1.433 0.711 37 2 2.267 -1.234 37 2 -1.095 -0.444 37 2 -1.625 0.085 37 2 1.977 -1.311 37 2 -1.817 0.681 37 2 1.296 -1.248 37 2 -2.295 0.686 37 2 -1.023 0.711 37 2 1.026 -0.46 37 2 -1.199 -0.18 37 2 -0.578 0.029 37 2 -0.019 0.269 37 2 0.9 -0.376 37 2 -0.922 -0.094 37 2 0.592 -0.479 37 2 -1.508 0.813 37 2 1.245 -0.515 37 2 -0.82 -0.04 37 2 -1.952 0.684 37 2 -0.608 0.15 37 2 -0.972 0.837 37 2 0.363 -0.772 37 2 0.389 0.137 38 2 3.377 -1.948 38 2 1.298 0.04 38 2 -0.826 -0.409 38 2 2.283 -0.893 38 2 -1.052 -0.582 38 2 -1.038 -0.035 38 2 0.752 -0.815 38 2 2.144 -1.13 38 2 2.28 -1.628 38 2 -0.401 -0.065 38 2 -0.581 -0.527 38 2 -0.525 -0.552 38 2 0.386 -0.104 38 2 0.43 -0.433 38 2 -1.183 0.868 38 2 -0.442 0.216 38 2 -1.31 0.002 38 2 -1.067 0.623 38 2 0.852 -0.424 38 2 1.534 -0.793 38 2 -1.136 -0.03 38 2 1.826 -0.694 39 2 -0.927 0.715 39 2 -1.357 -0.133 39 2 -1.24 -0.188 39 2 0.961 -0.191 39 2 -1.399 1.066 39 2 -1.68 0.81 39 2 2.279 -0.884 39 2 0.027 0.695 39 2 -0.933 1.051 39 2 0.493 -0.187 39 2 2.269 -1.533 39 2 0.733 0.072 39 2 -1.587 0.395 39 2 1.668 -0.652 39 2 -0.797 0.561 39 2 0.235 0.503 39 2 -1.161 0.416 39 2 -1.525 0.789 39 2 0.917 -0.98 39 2 -3.245 -0.105 39 2 0.925 -0.356 39 2 -1.335 1.029 39 2 2.19 -0.682 40 2 0.927 -0.487 40 2 3.184 -1.199 40 2 0.461 0.085 40 2 1.401 -0.984 40 2 -0.405 -0.022 40 2 0.768 -0.405 40 2 0.822 0.185 40 2 -1.167 -0.159 40 2 -0.588 0.276 40 2 0.783 0.065 40 2 -1.018 0.718 40 2 -1.003 1.131 40 2 -0.887 0.853 40 2 -0.457 0.184 40 2 1.168 -0.266 40 2 2.614 -1.287 40 2 -0.934 0.891 40 2 2.263 -0.867 40 2 0.028 1.052 40 2 0.225 0.167 40 2 1.881 -1.126 40 2 1.761 -1.394 40 2 -1.424 -0.123 40 2 1.29 0.467 40 2 1.216 -0.172 41 2 3.233 -1.376 41 2 -0.686 0.774 41 2 -1.234 1.044 41 2 0.443 0.425 41 2 2.279 -2.326 41 2 0.166 0.764 41 2 -1.319 -0.147 41 2 -0.918 0.8 41 2 0.241 0.269 41 2 -0.897 1.188 41 2 -1.119 0.876 41 2 -0.13 1.009 41 2 0.155 0.027 41 2 -0.103 1.019 42 2 -0.498 0.984 42 2 -1.058 0.327 42 2 -1.43 0.96 42 2 -0.133 0.461 42 2 -0.65 0.918 42 2 -0.171 0.734 42 2 1.096 -0.086 42 2 1.065 -0.418 42 2 2.478 -1.499 42 2 -1.015 1.188 42 2 0.802 -0.311 42 2 2.347 -0.975 42 2 2.479 -1.096 42 2 -0.833 0.987 42 2 -0.242 -0.078 42 2 0.895 0.145 42 2 -0.358 0.235 42 2 -1.009 1.09 42 2 -0.401 0.776 42 2 2.548 -0.818 43 2 3.689 -1.126 43 2 0.366 0.181 43 2 -2.046 -0.376 43 2 -0.12 1.282 43 2 0.38 0.794 43 2 1.609 -1.178 44 2 3.943 -1.035 44 2 1.036 0.885 44 2 0.356 0.48 44 2 0.311 0.428 44 2 -1.571 1.864 44 2 0.32 1.291 44 2 -0.696 0.552 44 2 0.815 0.645 44 2 0.619 0.483 44 2 -2.356 2.177 44 2 -0.135 1.223 44 2 2.84 -1.292 44 2 -1.084 0.016 44 2 -2.599 -0.446 44 2 -0.277 0.272 44 2 0.38 0.701 44 2 -2.708 -0.415 44 2 -0.452 0.962 44 2 1.311 0.033 44 2 0.289 0.351 44 2 -0.209 0.884 44 2 0.74 0.277 44 2 -1.246 0.998 44 2 0.258 0.186 44 2 -0.273 1.133 45 2 -0.543 0.796 45 2 -0.543 -0.444 45 2 3.113 -0.605 45 2 -0.339 1.156 45 2 -4.127 -0.863 45 2 -0.225 1.077 45 2 -1.873 0.195 45 2 -2.387 -0.237 45 2 1.542 -1.146 45 2 0.075 0.422 45 2 0.131 0.824 45 2 2.089 -0.898 45 2 0.386 1.507 46 2 -3.506 -0.576 46 2 5.457 -1.61 46 2 -1.522 -0.648 47 2 0.763 1.113 47 2 -0.651 -0.726 47 2 3.068 -0.846 47 2 1.717 -1.118 47 2 -0.429 1.5 47 2 -2.862 -0.598 47 2 0.363 1.351 48 2 1.73 -1.048 48 2 -0.471 1.795 48 2 4.111 -0.15 48 2 1.515 0.918 48 2 -0.259 -0.312 48 2 1.83 0.497 48 2 0.268 1.444 48 2 2.499 -0.476 48 2 2.978 -0.382 49 2 0.485 1.364 49 2 -0.788 -0.023 49 2 0.74 0.006 49 2 0.401 1.549 49 2 -0.886 0.401 49 2 0.196 0.21 49 2 -3.082 -0.486 49 2 -2.653 -0.529 49 2 1.813 -1.071 49 2 1.718 0.619 49 2 4.203 -1.158 50 2 0.209 -0.919 50 2 3.094 -1.585 50 2 2.004 -0.777 51 2 -0.684 -0.84 51 2 1.612 1.863 51 2 3.277 -1.031 51 2 0.185 1.412 51 2 -1.512 -0.345 52 2 4.143 0.076 52 2 0.734 1.547 52 2 0.097 -0.565 52 2 4.31 -1.146 52 2 1.405 1.368 52 2 -0.49 1.012 52 2 0.658 1.594 52 2 4.175 -0.187 52 2 2.761 -1.262 53 2 0.129 1.908 53 2 1.575 -0.969 53 2 -2.257 -0.102 53 2 1.57 1.794 53 2 -1.139 0.078 53 2 1.714 -1.394 53 2 0.307 1.567 53 2 0.423 0.749 53 2 1.08 2.085 54 2 0.824 1.906 54 2 -1.682 0.467 54 2 -0.799 1.029 54 2 5.463 -0.81 54 2 1.733 2.714 54 2 1.654 1.17 54 2 1.027 3.155 54 2 -1.864 -0.426 54 2 6.117 -0.814 54 2 5.687 -0.915 54 2 0.238 2.383 55 2 -1.968 -0.012 55 2 -0.714 1.046 55 2 2.336 2.394 55 2 1.095 2.656 55 2 2.031 0.298 55 2 4.123 -0.256 55 2 1.843 -0.726 55 2 -1.933 -0.475 55 2 1.215 2.431 55 2 2.564 0.56 56 3 2.062 2.47 56 3 3.701 -0.791 56 3 -2.514 -0.352 56 3 3.254 -1.506 56 3 0.35 1.239 56 3 3.765 1.765 56 3 -0.386 2.098 56 3 0.691 1.69 56 3 0.978 2.892 56 3 0.483 0.095 56 3 -0.316 -1.032 56 3 1.92 1.19 56 3 1.263 2.453 56 3 0.183 1.879 56 3 3.91 -0.99 56 3 5.14 -0.476 57 3 -1.611 0.008 57 3 3.113 -0.417 57 3 4.026 -1.281 57 3 3.748 -0.361 57 3 0.475 1.836 57 3 1.952 -0.837 58 3 -3.282 -0.38 58 3 -1.012 -1.167 58 3 1.373 -1.128 58 3 1.949 2.538 58 3 -2.608 -0.209 59 3 3.765 -0.689 59 3 0.706 2.346 59 3 4.42 -1.036 59 3 0.309 2.245 59 3 0.17 0.301 59 3 -1.257 -0.55 59 3 1.433 1.663 59 3 -0.932 1.058 59 3 3.118 -1.089 59 3 2.219 2.38 59 3 -2.636 -0.11 59 3 3.471 -0.446 59 3 -0.555 1.095 59 3 4.279 -0.237 60 3 4.279 -0.187 60 3 1.87 -0.792 60 3 -1.346 0.146 60 3 2.949 -0.591 61 3 -2.374 -0.104 61 3 4.687 -0.233 61 3 2.226 2.142 61 3 3.327 -0.055 61 3 -0.447 -0.23 61 3 3.959 0.657 61 3 3.596 1.406 61 3 3.719 -0.592 61 3 -1.842 -0.262 61 3 3.78 -0.758 61 3 1.904 1.484 61 3 3.132 1.831 62 3 4.558 -0.131 62 3 -2.57 -0.023 62 3 -1.73 0.102 62 3 -2.576 -0.403 62 3 3.868 -0.04 62 3 1.187 0.465 62 3 2.433 0.592 62 3 -3.412 0.088 62 3 2.563 0.198 62 3 0.677 -0.525 62 3 1.895 -1.179 62 3 5.102 -0.558 62 3 2.029 -0.813 63 3 -0.359 1.365 63 3 -0.56 1.505 63 3 -0.187 -0.544 63 3 -0.554 1.294 63 3 3.019 -1.006 63 3 5.312 -0.691 63 3 -0.019 0.632 63 3 0.728 -0.185 63 3 -0.913 0.159 64 3 -2.04 -0.023 64 3 0.991 0.808 64 3 0.633 1.083 64 3 -2.257 0.491 64 3 2.432 -0.906 64 3 2.964 2.591 64 3 1.675 -0.773 64 3 -2.324 -0.297 65 3 -1.16 -0.428 65 3 5.605 -1.268 65 3 -0.453 0.301 65 3 2.175 1.261 65 3 -3.128 0.049 65 3 0.195 -0.657 65 3 1.538 0.722 65 3 -2.331 -0.37 65 3 -1.495 -0.116 65 3 -1.933 -0.255 65 3 -1.159 0.246 65 3 2.295 -0.54 65 3 1.531 1.537 65 3 -2.705 -0.122 65 3 4.145 2.133 66 3 2.683 -1.055 66 3 -0.75 0.358 66 3 4.645 -1.281 66 3 2.947 0.455 66 3 -0.755 0.188 66 3 0.022 -0.114 66 3 -0.353 -0.405 66 3 0.46 1.316 66 3 -0.966 0.518 67 3 -2.245 -0.245 67 3 -0.824 0.429 67 3 2.952 -0.726 67 3 3.47 0.056 67 3 5.316 -0.644 67 3 1.495 2.719 67 3 5.437 -0.658 67 3 1.512 -1.198 67 3 -0.08 1.135 67 3 3.283 0.012 67 3 2.601 0.131 67 3 -1.962 -0.138 67 3 4.471 -0.338 68 3 0.407 0.584 68 3 -1.873 0.195 68 3 -2.64 -0.116 68 3 6.308 -1.159 68 3 0.194 1.28 68 3 -0.197 1.281 68 3 1.398 2.562 69 3 0.501 0.222 69 3 1.39 2.191 69 3 -0.014 -0.663 69 3 -0.364 0.481 69 3 -0.107 -0.449 69 3 -0.585 0.103 69 3 6.523 -0.931 69 3 3.663 -0.261 69 3 5.672 1.284 69 3 1.869 2.485 70 3 0.305 0.942 70 3 1.011 3.176 70 3 -2.939 -0.3 70 3 5.204 0.728 70 3 -0.259 -0.026 70 3 -0.405 -0.711 70 3 -1.88 0.251 70 3 2.156 -0.509 70 3 0.16 0.27 71 3 2.611 2.535 71 3 -1.184 0.627 71 3 -0.044 0.131 71 3 0.241 -0.493 71 3 -2.544 -0.232 71 3 5.242 -0.865 71 3 1.247 2.478 71 3 -0.758 0.333 71 3 -0.621 -0.478 71 3 0.506 0.067 72 3 1.52 2.28 72 3 -2.253 0.051 72 3 -1.05 0.077 72 3 2.036 1.075 72 3 5.768 -0.716 72 3 1.245 0.69 72 3 0.117 -0.069 72 3 2.909 2.437 72 3 5.711 -0.63 72 3 0.269 1.746 73 3 1.105 2.38 73 3 1.019 2.472 73 3 3.124 1.836 74 3 -0.438 1.824 74 3 1.983 2.205 74 3 2.149 0.501 74 3 1.036 2.754 74 3 -1.647 -0.408 74 3 0.782 -0.726 74 3 0.331 2.008 74 3 2.154 -0.593 74 3 -0.19 -0.015 75 3 -1.597 2.549 75 3 -1.54 -0.815 75 3 1.654 -0.933 75 3 3.098 -0.184 75 3 -1.65 0.141 75 3 2.111 0.716 76 3 -2.428 -0.251 76 3 0.998 2.988 76 3 5.391 -0.657 76 3 0.006 1.372 76 3 0.29 2.202 76 3 5.812 1.075 77 3 1.361 2.459 77 3 0.148 1.956 77 3 -2.584 -0.283 77 3 2.29 0.144 77 3 -3.131 -0.368 77 3 -1.681 -0.052 77 3 0.446 2.649 77 3 2.459 0.399 78 3 -0.606 0.02 78 3 0.164 0.253 78 3 4.995 -0.856 78 3 -3.075 -0.417 78 3 0.767 2.835 78 3 -1.666 -0.048 78 3 0.55 0.381 78 3 -1.938 0.051 78 3 1.586 2.369 78 3 1.3 0.938 78 3 -2.263 -0.072 79 3 1.449 0.859 79 3 3.188 0.242 79 3 -2.284 -0.342 79 3 2.454 2.474 79 3 0.034 0.151 80 3 -1.121 -0.26 80 3 -0.133 1.425 80 3 5.094 -0.69 81 3 1.05 -0.691 81 3 -0.314 -0.664 82 3 2.23 2.424 82 3 2.901 0.025 82 3 4.661 -0.407 82 3 1.917 -0.807 82 3 1.253 -0.231 83 3 -0.382 1.309 84 3 sm/inst/smdata/trees.doc0000744000176200001440000000062712266061235014741 0ustar liggesusers Trees data These data record the dimensions of a sample of black cherry trees, together with the volume of usable timber obtained from each tree. The variables are: Diameter: diameter of the tree trunk (inches) Height: height of the tree (feet) Volume: volume of timber (cubic feet) Source: Ryan, Joiner & Ryan (1985). Minitab Handbook, 2nd edition. PWS-Kent Publishing Company, Boston. sm/inst/smdata/bonions.doc0000744000176200001440000000100212266061225015251 0ustar liggesusers Brown onions data These data were colllected in a study of the relationship between the yield of Brown Imperial Spanish onion plants and the density of planting. The variables are: Density: density of planting (plants/m^2) Yield: yield (g/plant) Locality: a code to indicate Mount Gambier (1) or Uraidla (2) Source: The data were collected by I.S.Rogers (South Australian Dept. of Agriculture & Fisheries). They are listed in Ratkowsky (1983), Nonlinear Regression Modeling. Dekker, New York. sm/inst/smdata/dogs.doc0000744000176200001440000000121712266061226014547 0ustar liggesusers Dogs data Measurements of coronary sinus potassium (mil equivalent per litre) were made at (1,3,5,7,9,11,13) minutes after coronary occlusion in a number of different dogs. There are four treatment groups (group 1 is the control). The paper by Grizzle and Allen provides a full description of the treatments. A few subjects develop ventricular fibrillation (see paper for details). The variables are: Group: a treatment group indicator P1, P3, P5, P7, P9, P11, P13: measurements at indicated times Source: J.E.Grizzle & D.M.Allen (1969) Analysis of growth and dose response curves. Biometrics vol.25, p.357-381 sm/inst/smdata/mildew.dat0000744000176200001440000000224712266061230015076 0ustar liggesuserst1 t2 t3 p1 p2 p3 p4 p5 p6 p7 p8 Yield 0 1 0 1 0 0 0 0 0 0 0 5.73 0 0 1 1 0 0 0 0 0 0 0 6.08 0 0 0 1 0 0 0 0 0 0 0 5.26 1 0 0 1 0 0 0 0 0 0 0 5.89 0 0 0 0 1 0 0 0 0 0 0 5.37 0 1 0 0 1 0 0 0 0 0 0 5.95 0 0 1 0 1 0 0 0 0 0 0 5.95 1 0 0 0 1 0 0 0 0 0 0 5.59 0 0 0 0 0 1 0 0 0 0 0 5.16 1 0 0 0 0 1 0 0 0 0 0 5.89 0 1 0 0 0 1 0 0 0 0 0 6.14 0 0 1 0 0 1 0 0 0 0 0 6.01 0 1 0 0 0 0 1 0 0 0 0 5.63 1 0 0 0 0 0 1 0 0 0 0 5.39 0 0 1 0 0 0 1 0 0 0 0 5.46 0 0 0 0 0 0 1 0 0 0 0 5.05 0 0 1 0 0 0 0 1 0 0 0 5.76 0 0 0 0 0 0 0 1 0 0 0 5.23 0 1 0 0 0 0 0 1 0 0 0 6.20 1 0 0 0 0 0 0 1 0 0 0 6.26 0 1 0 0 0 0 0 0 1 0 0 6.48 0 0 0 0 0 0 0 0 1 0 0 5.79 1 0 0 0 0 0 0 0 1 0 0 6.45 0 0 1 0 0 0 0 0 1 0 0 6.44 1 0 0 0 0 0 0 0 0 1 0 6.31 0 0 1 0 0 0 0 0 0 1 0 6.18 0 1 0 0 0 0 0 0 0 1 0 6.43 0 0 0 0 0 0 0 0 0 1 0 5.82 0 1 0 0 0 0 0 0 0 0 1 6.47 0 0 0 0 0 0 0 0 0 0 1 5.73 0 0 1 0 0 0 0 0 0 0 1 6.54 1 0 0 0 0 0 0 0 0 0 1 5.99 0 1 0 0 0 0 0 0 0 0 0 5.76 1 0 0 0 0 0 0 0 0 0 0 5.04 0 0 0 0 0 0 0 0 0 0 0 4.38 0 0 1 0 0 0 0 0 0 0 0 5.06 sm/inst/smdata/nile.dat0000744000176200001440000000176412266061230014547 0ustar liggesusersVolume Year 1120 1871 1160 1872 963 1873 1210 1874 1160 1875 1160 1876 813 1877 1230 1878 1370 1879 1140 1880 995 1881 935 1882 1110 1883 994 1884 1020 1885 960 1886 1180 1887 799 1888 958 1889 1140 1890 1100 1891 1210 1892 1150 1893 1250 1894 1260 1895 1220 1896 1030 1897 1100 1898 774 1899 840 1900 874 1901 694 1902 940 1903 833 1904 701 1905 916 1906 692 1907 1020 1908 1050 1909 969 1910 831 1911 726 1912 456 1913 824 1914 702 1915 1120 1916 1100 1917 832 1918 764 1919 821 1920 768 1921 845 1922 864 1923 862 1924 698 1925 845 1926 744 1927 796 1928 1040 1929 759 1930 781 1931 865 1932 845 1933 944 1934 984 1935 897 1936 822 1937 1010 1938 771 1939 676 1940 649 1941 846 1942 812 1943 742 1944 801 1945 1040 1946 860 1947 874 1948 848 1949 890 1950 744 1951 749 1952 838 1953 1050 1954 918 1955 986 1956 797 1957 923 1958 975 1959 815 1960 1020 1961 906 1962 901 1963 1170 1964 912 1965 746 1966 919 1967 718 1968 714 1969 740 1970 sm/inst/smdata/britpts.dat0000744000176200001440000004706612266061225015320 0ustar liggesusers britlong britlat -7.236 57.94 -3.190 58.50 -3.140 58.50 -3.122 58.47 -3.160 58.43 -3.160 58.38 -3.160 58.32 -3.160 58.27 -3.226 58.25 -3.295 58.18 -3.395 58.14 -3.497 58.09 -3.661 58.02 -3.811 57.94 -3.917 57.85 -4.037 57.77 -4.166 57.73 -4.018 57.73 -3.830 57.76 -3.921 57.68 -4.091 57.64 -4.168 57.60 -4.266 57.55 -4.266 57.55 -4.266 57.51 -4.128 57.53 -4.062 57.57 -3.991 57.60 -3.991 57.53 -4.091 57.47 -4.187 57.45 -4.235 57.35 -4.046 57.38 -3.921 57.44 -3.743 57.52 -3.428 57.58 -3.274 57.60 -2.822 57.54 -2.453 57.58 -2.185 57.58 -2.185 57.38 -2.244 57.24 -2.309 57.03 -2.410 56.82 -2.546 56.64 -2.707 56.49 -2.940 56.41 -3.253 56.34 -3.336 56.27 -3.085 56.32 -2.959 56.30 -2.921 56.20 -3.148 56.06 -3.305 55.96 -3.517 55.96 -3.663 55.91 -3.721 55.86 -3.437 55.86 -3.106 55.84 -2.939 55.94 -2.694 55.90 -2.629 55.90 -2.573 55.75 -2.496 55.78 -2.353 55.67 -2.117 55.60 -2.002 55.52 -1.919 55.40 -1.816 55.15 -1.710 54.95 -1.550 54.71 -1.535 54.48 -0.9641 54.38 -0.7537 54.26 -0.6906 54.15 -0.5306 54.05 -0.4465 53.91 -0.3329 53.73 -0.2810 53.59 -0.4410 53.65 -0.5209 53.67 -0.5209 53.59 -0.3344 53.54 -0.2011 53.44 3.7361E-02 53.26 3.7342E-02 53.18 -3.2861E-02 52.99 -0.2489 52.92 -8.4818E-02 52.82 8.2128E-02 52.77 0.1930 52.91 0.3712 52.91 0.5354 52.99 0.7220 52.96 0.7216 51.69 0.6584 51.57 0.3427 51.49 8.8129E-03 51.45 -0.1189 51.42 0.1603 51.42 0.3778 51.42 0.5742 51.38 0.7215 51.40 0.7214 50.94 0.4913 50.83 0.1910 50.74 -4.1887E-02 50.74 -0.2130 50.80 -0.4614 50.71 -0.6578 50.71 -0.8599 50.71 -1.084 50.71 -1.330 50.76 -1.448 50.69 -1.658 50.64 -1.922 50.64 -1.961 50.53 -2.153 50.50 -2.452 50.51 -2.760 50.59 -3.164 50.62 -3.206 50.54 -3.412 50.50 -3.537 50.37 -3.599 50.30 -3.453 50.30 -3.648 50.16 -3.757 50.10 -3.968 50.17 -4.171 50.28 -4.393 50.21 -4.577 50.24 -4.708 50.17 -4.791 50.10 -4.964 50.10 -5.120 50.02 -5.186 49.84 -5.288 49.95 -5.504 50.02 -5.605 49.96 -5.699 50.00 -5.609 50.05 -5.482 50.12 -5.303 50.12 -5.209 50.19 -5.108 50.27 -5.054 50.34 -4.868 50.41 -4.822 50.51 -4.621 50.56 -4.621 50.64 -4.502 50.64 -4.470 50.75 -4.530 50.84 -4.395 50.85 -4.297 50.88 -4.200 50.93 -4.200 51.04 -4.071 51.10 -3.938 51.08 -3.782 51.14 -3.586 51.17 -3.423 51.10 -3.297 51.10 -3.156 51.12 -3.051 51.18 -2.929 51.26 -2.865 51.35 -2.747 51.41 -2.667 51.50 -2.561 51.58 -2.474 51.69 -2.653 51.63 -2.779 51.54 -2.942 51.48 -3.078 51.42 -3.263 51.29 -3.597 51.32 -3.734 51.37 -3.732 51.47 -3.838 51.53 -3.943 51.46 -4.151 51.45 -4.247 51.45 -4.221 51.54 -4.123 51.50 -4.123 51.56 -4.322 51.60 -4.270 51.67 -4.482 51.63 -4.606 51.54 -4.757 51.53 -4.924 51.53 -5.056 51.53 -5.000 51.50 -5.081 51.61 -5.020 51.69 -5.000 51.77 -5.108 51.79 -5.043 51.87 -4.934 51.85 -4.875 51.91 -4.695 51.93 -4.667 51.99 -4.566 52.02 -4.388 52.07 -4.218 52.09 -4.099 52.15 -4.121 52.21 -4.099 52.28 -4.026 52.31 -4.026 52.40 -4.079 52.45 -4.036 52.58 -4.119 52.63 -4.082 52.70 -4.169 52.78 -4.339 52.78 -4.417 52.69 -4.448 52.65 -4.573 52.68 -4.619 52.71 -4.668 52.75 -4.611 52.79 -4.538 52.81 -4.461 52.82 -4.402 52.87 -4.335 52.93 -4.267 52.95 -4.267 53.00 -4.200 53.04 -4.124 53.10 -4.083 53.14 -4.022 53.09 -3.915 53.13 -3.740 53.18 -3.571 53.19 -3.451 53.25 -3.344 53.18 -3.229 53.12 -3.184 53.09 -3.063 53.13 -3.110 53.20 -3.160 53.22 -2.931 53.21 -2.858 53.24 -2.938 53.28 -3.027 53.32 -3.004 53.43 -3.079 53.42 -3.125 53.48 -3.010 53.53 -2.872 53.58 -2.757 53.60 -2.722 53.66 -2.891 53.63 -2.979 53.62 -3.037 53.67 -3.088 53.70 -3.029 53.78 -3.116 53.79 -3.011 53.84 -2.944 53.84 -2.923 53.89 -2.923 53.89 -2.983 53.89 -2.969 53.94 -2.905 53.97 -2.905 54.04 -2.905 54.12 -2.987 54.05 -3.104 53.99 -3.202 53.99 -3.269 54.04 -3.372 54.06 -3.337 54.15 -3.394 54.19 -3.438 54.28 -3.551 54.34 -3.637 54.43 -3.567 54.53 -3.574 54.65 -3.470 54.70 -3.395 54.78 -3.395 54.85 -3.543 54.90 -3.578 54.84 -3.551 54.79 -3.701 54.74 -3.783 54.72 -3.808 54.67 -3.965 54.65 -4.108 54.68 -4.288 54.70 -4.371 54.73 -4.334 54.68 -4.282 54.63 -4.375 54.56 -4.498 54.65 -4.602 54.73 -4.762 54.73 -4.787 54.67 -4.775 54.62 -4.793 54.59 -4.733 54.54 -4.674 54.59 -4.770 54.56 -4.901 54.62 -4.832 54.59 -4.967 54.69 -5.024 54.77 -5.006 54.83 -5.044 54.88 -4.961 54.87 -4.884 54.80 -4.862 54.87 -4.901 54.95 -4.825 55.02 -4.815 55.08 -4.710 55.12 -4.689 55.23 -4.563 55.28 -4.532 55.38 -4.532 55.48 -4.675 55.50 -4.676 55.54 -4.739 55.58 -4.739 55.66 -4.725 55.77 -4.663 55.82 -4.513 55.80 -4.446 55.83 -4.555 55.86 -4.642 55.88 -4.642 55.96 -4.710 56.01 -4.745 55.91 -4.823 55.81 -4.823 55.72 -4.823 55.63 -4.896 55.62 -4.951 55.67 -4.964 55.73 -4.993 55.81 -5.044 55.75 -5.082 55.72 -5.082 55.81 -5.082 55.81 -5.056 55.87 -5.035 55.95 -4.972 56.01 -4.858 56.07 -4.964 56.07 -5.118 55.96 -5.170 55.82 -5.209 55.68 -5.272 55.61 -5.272 55.55 -5.221 55.48 -5.306 55.41 -5.268 55.29 -5.369 55.20 -5.449 55.18 -5.482 55.25 -5.439 55.29 -5.465 55.35 -5.386 55.42 -5.386 55.47 -5.361 55.56 -5.326 55.65 -5.359 55.74 -5.321 55.83 -5.299 55.86 -5.361 55.88 -5.293 55.93 -5.321 55.97 -5.279 56.10 -5.349 56.11 -5.232 56.17 -5.195 56.25 -5.109 56.33 -5.074 56.39 -5.028 56.46 -4.992 56.52 -5.152 56.48 -5.223 56.40 -5.333 56.30 -5.507 56.14 -5.674 56.01 -5.683 56.06 -5.755 56.06 -5.633 56.13 -5.919 56.12 -5.919 56.19 -5.810 56.21 -5.678 56.25 -5.790 56.27 -5.759 56.32 -5.668 56.31 -5.759 56.36 -5.873 56.36 -5.873 56.46 -5.744 56.55 -5.700 56.51 -5.602 56.51 -5.720 56.58 -5.696 56.64 -5.558 56.67 -5.528 56.62 -5.436 56.68 -5.359 56.70 -5.442 56.74 -5.471 56.81 -5.400 56.81 -5.309 56.84 -5.349 56.89 -5.349 56.94 -5.280 56.97 -5.177 56.99 -5.268 57.00 -5.320 57.05 -5.442 57.02 -5.418 56.97 -5.502 56.92 -5.603 56.93 -5.543 57.03 -5.631 57.07 -5.686 57.01 -5.788 57.03 -5.934 57.02 -5.863 57.11 -5.965 57.12 -5.952 57.21 -5.926 57.25 -5.961 57.28 -6.098 57.25 -6.230 57.32 -6.183 57.39 -6.136 57.35 -6.084 57.40 -6.146 57.44 -6.058 57.47 -5.940 57.40 -5.910 57.50 -5.816 57.56 -5.735 57.54 -5.742 57.45 -5.776 57.38 -5.693 57.36 -5.693 57.28 -5.634 57.29 -5.582 57.26 -5.454 57.18 -5.355 57.18 -5.453 57.24 -5.453 57.34 -5.463 57.44 -5.342 57.44 -5.266 57.38 -5.301 57.48 -5.338 57.48 -5.356 57.53 -5.306 57.56 -5.369 57.64 -5.310 57.69 -5.378 57.72 -5.258 57.75 -5.185 57.63 -5.075 57.55 -5.176 57.70 -5.109 57.76 -4.946 57.67 -4.872 57.67 -4.908 57.78 -5.014 57.85 -5.060 57.93 -4.942 57.93 -5.004 58.03 -4.959 58.09 -4.959 58.09 -4.886 58.03 -4.806 58.08 -4.751 58.15 -4.812 58.23 -4.740 58.31 -4.809 58.36 -4.736 58.38 -4.706 58.48 -4.543 58.48 -4.465 58.43 -4.372 58.38 -4.205 58.36 -4.045 58.37 -3.892 58.43 -3.716 58.44 -3.596 58.47 -3.480 58.47 -3.347 58.51 -6.967 55.29 -6.770 55.23 -6.694 55.13 -6.770 55.02 -6.876 54.92 -6.739 54.98 -6.667 54.95 -6.552 55.02 -6.469 55.08 -6.259 55.12 -5.942 55.12 -5.890 55.04 -5.783 54.95 -5.740 54.82 -5.630 54.68 -5.549 54.64 -5.705 54.58 -5.685 54.49 -5.466 54.51 -5.441 54.32 -5.358 54.27 -5.378 54.20 -5.403 54.14 -5.649 54.11 -5.652 54.01 -5.805 53.92 -5.767 53.83 -5.729 53.76 -5.945 53.81 -6.056 53.85 -6.206 53.85 -6.146 53.78 -5.970 53.70 -6.060 53.59 -6.060 53.50 -5.921 53.47 -5.883 53.38 -5.934 53.28 -5.906 53.22 -5.982 53.15 -5.945 53.00 -5.872 52.89 -5.841 52.79 -5.952 52.70 -5.928 52.68 -6.051 52.50 -6.105 52.36 -6.229 52.27 -6.305 52.22 -6.166 52.14 -6.331 52.05 -6.460 52.05 -6.460 52.13 -6.566 52.10 -6.720 52.04 -6.824 52.10 -6.968 52.06 -7.120 52.06 -7.285 52.02 -7.400 51.98 -7.517 51.90 -7.639 51.93 -7.751 51.84 -7.835 51.78 -8.018 51.77 -8.133 51.82 -8.220 51.71 -8.317 51.60 -8.451 51.54 -8.590 51.53 -8.642 51.57 -8.768 51.51 -8.834 51.53 -8.948 51.50 -9.021 51.54 -9.129 51.48 -9.188 51.55 -9.337 51.52 -9.383 51.54 -9.463 51.45 -9.544 51.45 -9.508 51.51 -9.414 51.55 -9.526 51.57 -9.386 51.61 -9.261 51.65 -9.208 51.73 -9.394 51.68 -9.612 51.68 -9.673 51.61 -9.849 51.61 -9.849 51.69 -9.651 51.73 -9.484 51.79 -9.349 51.81 -9.349 51.88 -9.596 51.80 -9.757 51.79 -9.757 51.91 -9.844 51.89 -9.951 51.84 -10.01 51.87 -9.964 51.94 -9.878 52.01 -9.836 51.99 -9.759 52.06 -9.641 52.06 -9.603 52.13 -9.738 52.14 -9.773 52.17 -9.980 52.14 -10.01 52.21 -9.993 52.28 -9.853 52.30 -9.753 52.33 -9.616 52.28 -9.459 52.31 -9.458 52.41 -9.360 52.47 -9.207 52.59 -9.095 52.68 -9.293 52.63 -9.499 52.61 -9.463 52.64 -9.301 52.69 -9.176 52.74 -9.028 52.80 -8.953 52.94 -8.924 53.08 -8.746 53.12 -8.612 53.16 -8.750 53.22 -8.800 53.26 -8.922 53.20 -9.008 53.25 -9.100 53.25 -9.172 53.33 -9.294 53.29 -9.332 53.37 -9.467 53.34 -9.366 53.42 -9.507 53.38 -9.634 53.44 -9.614 53.52 -9.524 53.52 -9.558 53.60 -9.450 53.63 -9.389 53.60 -9.371 53.70 -9.311 53.73 -9.279 53.79 -9.245 53.81 -9.162 53.76 -9.036 53.81 -9.064 53.90 -9.173 53.93 -9.238 53.98 -9.322 53.97 -9.302 54.06 -9.361 54.06 -9.328 54.14 -9.270 54.21 -9.135 54.28 -8.949 54.32 -8.724 54.29 -8.625 54.19 -8.515 54.18 -8.504 54.25 -8.386 54.27 -8.249 54.24 -8.093 54.26 -8.066 54.32 -8.093 54.36 -8.023 54.43 -7.924 54.49 -7.750 54.52 -7.783 54.56 -7.743 54.64 -7.906 54.60 -8.075 54.58 -8.201 54.61 -8.218 54.64 -8.178 54.72 -8.011 54.75 -7.847 54.81 -7.808 54.86 -7.822 54.92 -7.732 55.07 -7.552 55.11 -7.430 55.03 -7.318 55.04 -7.362 55.11 -7.276 55.11 -7.276 55.19 -7.164 55.18 -7.155 55.08 -7.155 54.99 -7.171 54.88 -7.038 54.95 -7.004 55.01 -7.066 55.03 -7.024 55.12 -7.080 55.17 -7.002 55.20 -7.002 55.20 -6.987 55.29 -6.866 55.29 -5.166 55.49 -5.166 55.56 -5.045 55.57 -5.019 55.51 -4.923 55.43 -5.003 55.35 -5.068 55.29 -4.480 54.20 -4.361 54.27 -4.329 54.16 -4.413 54.02 -4.522 53.95 -4.622 53.92 -4.667 54.00 -4.461 53.25 -4.304 53.28 -4.160 53.24 -4.130 53.18 -4.250 53.07 -4.176 53.15 -4.461 53.15 -4.461 53.24 -5.582 55.73 -5.490 55.87 -5.473 55.98 -5.592 55.88 -5.658 55.77 -5.806 55.82 -6.013 55.75 -5.964 55.70 -6.051 55.60 -5.825 55.63 -5.879 55.51 -6.156 56.52 -6.021 56.57 -6.076 56.51 -6.125 56.57 -6.337 56.46 -6.247 56.42 -6.303 56.35 -6.424 56.37 -6.354 56.39 -6.393 56.43 -5.917 56.89 -5.812 56.85 -5.756 56.91 -5.857 56.94 -5.636 58.36 -5.694 58.28 -5.781 58.15 -5.926 58.02 -5.882 57.97 -5.993 57.93 -5.917 57.91 -5.986 57.84 -6.058 57.78 -6.202 57.78 -6.213 57.71 -6.320 57.63 -6.435 57.68 -6.376 57.73 -6.376 57.79 -6.439 57.81 -6.328 57.83 -6.299 57.87 -6.375 57.90 -6.300 57.94 -6.403 57.98 -6.391 58.10 -6.275 58.08 -6.164 58.09 -6.147 58.18 -6.070 58.24 -5.850 58.31 -5.754 58.35 -6.574 57.59 -6.574 57.50 -6.724 57.55 -6.780 57.49 -6.633 57.44 -6.640 57.39 -6.695 57.32 -6.695 57.22 -6.662 57.18 -6.758 57.18 -6.758 57.25 -6.668 57.13 -6.748 57.07 -6.748 57.12 -6.817 56.97 -6.817 56.90 -6.900 56.86 -6.870 56.94 -6.940 56.75 -6.940 56.78 sm/inst/smdata/follicle.dat0000744000176200001440000000303112266061226015403 0ustar liggesusersAge Count Source 0 706000 1 0 722000 1 0 694000 1 0 1126000 1 0 951000 1 0 470000 1 6 324700 2 7 764600 2 7 416200 2 8 271000 2 9 718600 2 12 349100 2 13 522800 2 14 599400 2 15 88000 2 16 385200 2 18 307300 2 18 154700 2 19 216100 2 19 195395 3 20 40020 2 20 56500 2 23 210100 2 24 150800 2 25 80500 2 25 57200 2 25 100080 3 25 198770 3 26 237200 2 27 67800 2 28 62300 2 28 25020 2 29 31400 2 30 26280 2 31 10300 2 31 44690 2 31 42460 2 31 81265 3 32 129500 2 32 80000 2 32 59800 2 33 30800 2 33 32800 2 34 62715 3 35 102380 3 35 44850 3 35 40860 3 36 105800 2 36 54965 3 37 224500 2 37 28335 3 37 13031 3 38 63200 2 38 55355 3 39 53825 3 40 8280 2 40 37400 2 40 65455 3 40 29305 3 41 2380 2 41 16410 3 42 7900 2 42 50560 3 42 5060 3 43 7020 2 43 11730 2 43 28665 3 43 6620 3 43 5350 3 43 774 3 43 1215 3 43 62040 3 43 34160 3 44 1250 2 44 12400 3 44 1358 3 44 18380 3 44 2280 3 45 7350 3 45 13145 3 45 3115 3 45 6735 3 45 43068 3 45 3490 4 45 4820 4 46 12930 3 46 1606 3 46 6467 3 46 5155 3 46 7340 3 46 7980 3 46 8360 3 46 692 4 46 1272 4 47 2693 3 47 10495 3 47 4835 3 47 5695 3 47 6776 4 47 368 4 48 1737 3 48 538 3 48 785 3 49 1820 3 49 2800 3 49 316 4 49 3132 4 50 2678 3 50 1110 3 51 1744 4 sm/inst/smdata/birth.dat0000744000176200001440000000653512266061223014733 0ustar liggesusers Smoke Lwt Low N 182 0 N 155 0 S 105 0 S 108 0 S 107 0 N 124 0 N 118 0 N 103 0 S 123 0 S 113 0 N 95 0 N 150 0 N 95 0 N 107 0 S 100 0 S 100 0 N 98 0 S 118 0 N 120 0 S 120 0 N 121 0 N 100 0 N 202 0 N 120 0 N 120 0 N 167 0 S 122 0 N 150 0 S 168 0 N 113 0 N 113 0 S 90 0 S 121 0 N 155 0 N 125 0 S 140 0 S 138 0 S 124 0 S 215 0 S 109 0 S 185 0 N 189 0 N 130 0 N 160 0 S 90 0 S 90 0 N 132 0 N 132 0 N 115 0 S 85 0 N 120 0 N 128 0 S 130 0 S 95 0 N 115 0 N 110 0 S 110 0 N 153 0 N 103 0 N 119 0 N 119 0 N 119 0 N 110 0 N 140 0 S 133 0 N 169 0 N 115 0 S 250 0 N 141 0 N 158 0 S 112 0 S 150 0 S 115 0 N 112 0 S 135 0 N 229 0 N 140 0 S 134 0 S 121 0 N 190 0 N 131 0 N 170 0 N 110 0 N 127 0 N 123 0 S 120 0 N 105 0 N 130 0 N 175 0 N 125 0 N 133 0 N 134 0 S 235 0 S 95 0 S 135 0 N 135 0 N 154 0 S 147 0 S 147 0 N 137 0 N 110 0 S 184 0 N 110 0 N 110 0 N 120 0 N 241 0 N 112 0 N 169 0 S 120 0 N 170 0 N 186 0 N 120 0 S 130 0 N 117 0 S 170 0 N 134 0 N 135 0 N 130 0 N 120 0 N 95 0 N 158 0 N 160 0 N 115 0 N 129 0 N 130 0 N 120 0 N 170 0 S 120 0 N 116 0 N 123 0 S 120 1 N 130 1 S 187 1 N 105 1 N 85 1 N 150 1 N 97 1 N 128 1 N 132 1 S 165 1 S 105 1 S 91 1 N 115 1 N 130 1 S 92 1 S 150 1 N 200 1 S 155 1 N 103 1 N 125 1 N 89 1 N 102 1 S 112 1 S 117 1 N 138 1 S 130 1 S 120 1 S 130 1 N 130 1 S 80 1 S 110 1 N 105 1 N 109 1 N 148 1 S 110 1 S 121 1 N 100 1 N 96 1 S 102 1 N 110 1 S 187 1 S 122 1 S 105 1 N 115 1 N 120 1 S 142 1 S 130 1 S 120 1 S 110 1 N 120 1 N 154 1 N 105 1 S 190 1 S 101 1 S 95 1 N 100 1 S 94 1 N 142 1 S 130 1 sm/inst/smdata/poles.dat0000744000176200001440000000115512266061231014735 0ustar liggesusersLatitude Longitude -26.4 324.0 -32.2 163.7 -73.1 51.9 -80.2 140.5 -71.1 267.2 -58.7 32.0 -40.8 28.1 -14.9 266.3 -66.1 144.3 -1.8 256.2 -52.1 83.2 -77.3 182.1 -68.8 110.4 -68.4 142.2 -29.2 246.3 -78.5 222.6 -65.4 247.7 -49.0 65.6 -67.0 282.6 -56.7 56.2 -80.5 108.4 -77.7 266.0 -6.9 19.1 -59.4 281.7 -5.6 107.4 -62.6 105.3 -74.7 120.2 -65.3 286.6 -71.6 106.4 -23.3 96.5 -74.3 90.2 -81.0 170.9 -12.7 199.4 -75.4 118.6 -85.9 63.7 -84.8 74.9 -7.4 93.8 -29.8 72.8 -85.2 113.2 -53.1 51.5 -38.3 146.8 -72.7 103.1 -60.2 33.2 -63.4 154.8 -17.2 89.9 -81.6 295.6 -40.4 41.0 -53.6 59.1 -56.2 35.6 -75.1 70.7 sm/inst/smdata/trout.dat0000744000176200001440000000323512266061235014775 0ustar liggesusers Concentr Trouts Dead Insert 90 111 8 hard 90 97 10 hard 90 108 10 hard 90 122 9 hard 180 68 4 hard 180 109 6 hard 180 109 11 hard 180 118 6 hard 360 98 6 hard 360 110 5 hard 360 129 9 hard 360 103 17 hard 720 83 2 hard 720 87 3 hard 720 118 16 hard 720 100 9 hard 1440 140 60 hard 1440 114 47 hard 1440 103 49 hard 1440 110 20 hard 2880 143 79 hard 2880 131 85 hard 2880 111 78 hard 2880 111 74 hard 90 130 7 no.hard 90 179 25 no.hard 90 126 5 no.hard 90 129 3 no.hard 180 114 12 no.hard 180 149 4 no.hard 180 121 4 no.hard 180 105 0 no.hard 360 102 4 no.hard 360 145 21 no.hard 360 61 1 no.hard 360 118 3 no.hard 720 99 29 no.hard 720 109 53 no.hard 720 99 40 no.hard 720 70 0 no.hard 1440 100 14 no.hard 1440 127 10 no.hard 1440 132 8 no.hard 1440 113 3 no.hard 2880 145 113 no.hard 2880 103 84 no.hard 2880 143 105 no.hard 2880 102 78 no.hard sm/inst/smdata/dogs.dat0000744000176200001440000000251112266061226014550 0ustar liggesusers Group P1 P3 P5 P7 P9 P11 P13 1 4.0 4.0 4.1 3.6 3.6 3.8 3.1 1 4.2 4.3 3.7 3.7 4.8 5.0 5.2 1 4.3 4.2 4.3 4.3 4.5 5.8 5.4 1 4.2 4.4 4.6 4.9 5.3 5.6 4.9 1 4.6 4.4 5.3 5.6 5.9 5.9 5.3 1 3.1 3.6 4.9 5.2 5.3 4.2 4.1 1 3.7 3.9 3.9 4.8 5.2 5.4 4.2 1 4.3 4.2 4.4 5.2 5.6 5.4 4.7 2 3.4 3.4 3.5 3.1 3.1 3.7 3.3 2 3.0 3.2 3.0 3.0 3.1 3.2 3.1 2 3.0 3.1 3.2 3.0 3.3 3.0 3.0 2 3.1 3.2 3.2 3.2 3.3 3.1 3.1 2 3.8 3.9 4.0 2.9 3.5 3.5 3.4 2 3.0 3.6 3.2 3.1 3.0 3.0 3.0 2 3.3 3.3 3.3 3.4 3.6 3.1 3.1 2 4.2 4.0 4.2 4.1 4.2 4.0 4.0 3 3.2 3.3 3.8 3.8 4.4 4.2 3.7 3 3.3 3.4 3.4 3.7 3.7 3.6 3.7 3 3.1 3.3 3.2 3.1 3.2 3.1 3.1 3 3.6 3.4 3.5 4.6 4.9 5.2 4.4 3 4.5 4.5 5.4 5.7 4.9 4.0 4.0 3 3.7 4.0 4.4 4.2 4.6 4.8 5.4 3 3.5 3.9 5.8 5.4 4.9 5.3 5.6 3 3.9 4.0 4.1 5.0 5.4 4.4 3.9 4 3.1 3.5 3.5 3.2 3.0 3.0 3.2 4 3.3 3.2 3.6 3.7 3.7 4.2 4.4 4 3.5 3.9 4.7 4.3 3.9 3.4 3.5 4 3.4 3.4 3.5 3.3 3.4 3.2 3.4 4 3.7 3.8 4.2 4.3 3.6 3.8 3.7 4 4.0 4.6 4.8 4.9 5.4 5.6 4.8 4 4.2 3.9 4.5 4.7 3.9 3.8 3.7 4 4.1 4.1 3.7 4.0 4.1 4.6 4.7 sm/inst/smdata/muscle.doc0000744000176200001440000000107312266061230015076 0ustar liggesusers Muscle data The data refer to the counts of fibres of different types in groups of fibres taken from rat skeletal muscles. The variables are: row.labels: an indicator of the 'fascicle', or group of fibres TypeI.R: number of Type I (reticulated) fibres TypeI.P: number of Type I (punctate) fibres TypeI.B: number of Type I fibres of both types TypeII: number of Type II fibres Source: Hand, Daly, Lunn, McConway and Ostrowski (1994). A handbook of Small Data Sets. Chapman & Hall: London. The data were collected by M. Khan and M. Khan. sm/inst/smdata/trawl.dat0000744000176200001440000001325012266061233014745 0ustar liggesusersZone Year Latitude Longitude Depth Score1 Score2 0 0 -11.12 142.84 20 1.63515 -0.30103 0 1 -11.28 142.85 9 -0.30103 1.54345 1 1 -11.48 142.86 11 1.54921 1.75813 0 0 -11.19 142.87 22 1.03278 -0.30103 1 0 -11.69 142.88 7 0.18235 2.45885 1 0 -11.39 142.89 18 2.05702 -0.30103 1 0 -11.45 142.91 18 0.90181 -0.30103 1 1 -11.67 142.92 9 1.43321 0.60025 1 1 -11.82 142.92 6 1.47654 -0.30103 1 0 -11.69 142.93 13 1.45626 0.40255 0 1 -11.29 142.93 24 1.74282 0.79192 1 1 -11.36 142.93 21 1.79877 0.30928 1 1 -11.5 142.93 19 1.69361 0.84105 0 0 -11.27 142.95 25 0.75439 -0.30103 0 1 -11.2 142.95 25 1.78013 -0.30103 1 1 -11.67 142.95 17 0.1443 -0.30103 1 0 -11.53 142.97 20 1.93157 0.62359 1 1 -11.86 142.97 6 2.02831 0.30821 1 0 -11.78 142.98 11 1.75211 1.09032 1 0 -11.58 142.98 26 1.68343 0.86913 0 0 -11.23 143 30 1.14073 -0.30103 1 0 -11.4 143 26 1.95323 -0.30103 0 1 -11.13 143.01 26 1.39761 1.17691 1 0 -11.82 143.02 14 0.86164 -0.30103 1 0 -11.69 143.02 20 1.44659 0.8148 1 0 -11.47 143.02 24 1.44434 0.86431 1 1 -11.62 143.02 24 1.31032 -0.30103 1 1 -11.79 143.02 18 1.31033 -0.30103 1 1 -11.7 143.03 20 1.62 1.26889 1 1 -11.36 143.04 23 1.82646 -0.30103 1 0 -11.35 143.05 26 1.4406 0.80357 0 1 -11.17 143.05 27 1.07275 -0.30103 1 0 -11.89 143.06 7 1.74185 0.7802 1 0 -11.7 143.06 22 0.88506 0.31175 1 1 -11.52 143.06 29 1.83026 -0.30103 0 1 -11.2 143.06 27 2.07749 0.56269 1 1 -11.44 143.07 27 1.44237 -0.30103 0 0 -11.28 143.08 27 1.28264 -0.30103 1 0 -11.87 143.1 15 1.042 -0.30103 1 0 -11.36 143.1 27 1.67624 0.02257 1 0 -11.5 143.11 28 1.7286 1.0926 0 1 -11.71 143.11 26 1.5668 -0.30103 0 0 -11.27 143.12 28 1.48091 0.33445 1 0 -11.6 143.13 30 1.37675 -0.30103 1 0 -11.44 143.14 29 1.52753 -0.30103 1 1 -11.3 143.14 27 0.98929 -0.30103 0 1 -11.22 143.14 27 1.70427 0.61472 0 1 -11.87 143.14 26 0.98895 0.53908 0 0 -11.15 143.15 28 1.88238 1.06602 1 0 -11.64 143.15 31 0.89995 -0.30103 1 1 -11.58 143.15 34 1.50541 -0.30103 1 1 -11.4 143.16 32 1.41495 -0.30103 0 0 -11.92 143.17 18 0.96969 0.90445 0 1 -11.92 143.17 16 1.54944 1.96762 1 0 -11.68 143.18 30 1.36306 -0.30103 1 0 -11.56 143.18 31 1.83052 1.31963 0 0 -11.13 143.19 27 1.90547 0.055 0 0 -11.87 143.19 28 0.60072 -0.30103 1 1 -11.57 143.2 33 0.99294 -0.30103 0 1 -11.74 143.2 28 1.04677 -0.30103 1 0 -11.35 143.21 30 1.53996 0.02735 1 0 -11.32 143.21 31 1.85491 0.52677 0 1 -11.79 143.23 26 1.31007 -0.30103 0 1 -11.28 143.23 31 1.76138 -0.30103 0 1 -11.82 143.23 33 0.77167 -0.30103 0 0 -11.75 143.24 30 1.09363 -0.30103 1 1 -11.61 143.24 36 0.78779 -0.30103 1 0 -11.64 143.25 30 1.49429 0.50037 0 0 -11.79 143.25 24 1.54767 -0.30103 1 1 -11.53 143.25 33 1.61349 0.47202 0 1 -11.82 143.25 30 1.31714 0.63127 1 1 -11.35 143.26 32 1.40901 1.31376 1 0 -11.6 143.27 35 1.58437 -0.30103 0 1 -11.84 143.27 22 1.17696 -0.30103 0 1 -11.82 143.27 22 1.34074 -0.30103 0 0 -11.26 143.28 30 1.76123 -0.30103 0 0 -11.88 143.28 44 1.18785 -0.30103 1 1 -11.69 143.28 26 1.85408 -0.30103 0 0 -11.28 143.29 31 1.76239 2.05024 0 0 -11.13 143.29 30 1.2622 1.90342 0 0 -11.92 143.29 47 0.48897 -0.30103 1 1 -11.66 143.29 29 1.50759 -0.30103 1 1 -11.33 143.3 31 1.36588 0.43002 1 1 -11.55 143.33 33 1.79746 1.12052 0 1 -11.2 143.33 18 1.4968 1.14613 0 1 -11.13 143.33 30 1.78815 1.56394 0 0 -11.13 143.34 30 0.54129 0.29226 1 0 -11.71 143.35 15 -0.06402 2.41032 0 1 -11.92 143.37 49 1.21904 -0.30103 0 1 -11.87 143.38 NA -0.30103 1.5873 0 1 -11.8 143.39 16 1.61387 2.83911 1 1 -11.37 143.39 33 0.89268 1.14968 0 1 -11.8 143.4 15 1.39598 -0.30103 1 1 -11.46 143.4 NA 0.07188 1.00832 1 0 -11.43 143.41 31 0.44825 1.95275 1 0 -11.73 143.42 17 -0.13984 1.66922 1 1 -11.56 143.42 42 -0.30103 -0.30103 0 1 -11.22 143.43 33 1.25955 1.804 0 0 -11.8 143.44 15 1.27355 2.41915 0 0 -11.83 143.45 14 0.47576 2.04809 0 1 -11.87 143.45 50.9 1.31433 -0.30103 1 1 -11.71 143.47 18 -0.30103 0.75089 0 0 -11.92 143.5 14 0.20222 2.72572 1 1 -11.35 143.5 18 0.65952 3.16518 1 0 -11.33 143.52 34 0.2669 1.77617 1 1 -11.57 143.52 40 0.76462 2.60278 0 1 -11.13 143.53 29 1.15724 2.19439 0 0 -11.3 143.54 28 -0.30103 2.09267 0 1 -11.19 143.54 NA 1.03397 2.2903 0 0 -11.15 143.55 33 -0.30103 1.58053 0 0 -11.25 143.56 33 -0.30103 2.10716 1 0 -11.35 143.56 31 0.11688 2.2135 1 1 -11.43 143.57 18 0.67362 2.2725 1 1 -11.32 143.58 27 -0.30103 3.05634 0 1 -11.25 143.58 NA -0.02796 2.57178 1 0 -11.48 143.59 30 -0.30103 1.58578 0 1 -11.91 143.59 20 -0.30103 2.93159 0 1 -11.81 143.6 60 1.12169 1.32715 0 0 -11.18 143.61 31 0.5017 0.76455 0 1 -11.87 143.62 18 0.11316 1.50669 1 1 -11.72 143.63 36 0.46765 2.26803 1 0 -11.77 143.64 32 -0.30103 1.68314 1 0 -11.76 143.64 24 -0.30103 0.77851 1 0 -11.72 143.66 30 0.2574 2.11103 1 1 -11.73 143.66 42 -0.30103 2.89317 0 1 -11.23 143.66 31 -0.08246 2.86208 0 0 -11.22 143.67 31 0.84499 2.41843 1 1 -11.32 143.67 32 -0.02823 2.2984 0 1 -11.83 143.68 20 0.57478 1.64192 1 1 -11.67 143.7 28 -0.30103 1.71089 1 1 -11.51 143.7 26 1.15337 2.6243 1 0 -11.65 143.71 30 -0.30103 2.60845 0 0 -11.22 143.72 33 -0.30103 2.55426 0 1 -11.9 143.72 23 -0.30103 0.52526 1 1 -11.65 143.73 28 -0.30103 1.98179 0 1 -11.82 143.75 NA -0.30103 0.59715 1 1 -11.3 143.77 NA -0.30103 2.39139 0 1 -11.25 143.77 35 0.82474 2.52883 0 0 -11.25 143.78 25 -0.14231 1.20579 1 0 -11.6 143.78 28 -0.30103 2.36317 1 0 -11.48 143.79 32 -0.28204 2.45237 0 1 -11.12 143.79 33 0.19898 2.30713 0 1 -11.2 143.79 35 1.49393 1.18982 1 1 -11.62 143.8 31 -0.30103 2.16717 1 0 -11.53 143.82 30 -0.30103 2.31907 1 1 -11.38 143.84 37 0.59093 2.59179 1 0 -11.32 143.87 29 0.01814 2.18528 1 1 -11.43 143.87 23 0.83288 3.5486 1 1 -11.34 143.88 31 -0.30103 3.57759 0 1 -11.23 143.88 35 -0.1325 2.18367 1 0 -11.3 143.89 32 -0.30103 2.31835 0 0 -11.15 143.9 33 -0.30103 -0.30103 0 0 -11.26 143.91 33 0.04624 1.69945 1 1 -11.39 143.92 35 -0.30103 0.71878 1 0 -11.42 143.93 37 -0.30103 1.81865 sm/inst/smdata/poles.doc0000744000176200001440000000057712266061231014741 0ustar liggesusers Poles data These data refer to positions of the south pole determined from the palaeomagnetic study of New Caledonian laterites. The variables are: Latitude Longitude Source: The data were collected by Falvey and Musgrave. They are listed in Fisher, Lewis & Embleton (1987), Statistical Analysis of Spherical Data, Cambridge University Press, Cambridge, dataset B1. sm/inst/smdata/aircraft.dat0000744000176200001440000005746312266061221015422 0ustar liggesusersYr Period Power Span Length Weight Speed Range 14 1 82 12.8 7.6 1070 105 400 14 1 82 11 9 830 145 402 14 1 223.6 17.9 10.35 2200 135 500 15 1 164 14.5 9.8 1946 138 500 15 1 119 12.9 7.9 1190 140 400 15 1 74.5 7.5 6.3 653 177 350 15 1 74.5 11.13 8.28 930 113 402 16 1 279.5 14.3 9.4 1575 230 700 16 1 82 7.8 6.7 676 175 525 16 1 67 11 8.3 920 106 300 16 1 112 11.7 8 1353 140 560 16 1 149 12.8 8.7 1550 170 550 16 1 119 8.5 7.4 888 175 250 16 1 119 13.3 9.6 1275 157 450 16 1 238.5 14.9 8.9 1537 183 700 16 1 205 12 7.9 1292 201 600 16 1 82 9.4 6.2 611 209 175 16 1 119 15.95 10.25 1350 145 450 16 1 194 16.74 10.77 1700 120 450 17 1 336 22.2 10.9 3312 135 450 17 1 558.9 23.4 12.6 4920 152 600 17 1 287 14.3 9.4 1510 176 800 17 1 388 23.72 11.86 3625 140 500 17 1 164 11.9 9.8 900 190 600 17 1 194 14.4 9.2 1665 175 600 17 1 194 14.4 8.9 1640 175 600 17 1 186.3 9.7 8 1081 205 600 17 1 119 8 6.5 625 196 400 17 1 119 9.4 6.95 932 165 250 17 1 89.4 14.55 9.83 1378 146 400 17 1 126.7 9.1 7.3 886 175 350 17 1 149 8.11 6.38 902 222 547 17 1 119 9.5 8.5 1070 159 450 17 1 536.6 20.73 13.27 5670 166 1770 18 1 402 22.8 13.5 3636 158 800 18 1 298 38.4 20.85 12925 146 2365 18 1 298 14 9.2 2107 185 925 18 1 342.8 26.5 14.33 4770 120 400 18 1 536 30.48 19.16 6060 157 1205 18 1 223.6 9.7 6.5 1192 226 580 18 1 521.6 15.5 9.7 1900 205 600 18 1 186.3 9.1 8.1 1050 230 600 19 1 238.5 14.17 9.68 2155 161 684 19 1 287 10.1 7.7 1379 251 402 20 1 335.3 14.8 10.8 2858 171 563 20 1 335.3 15.62 11.89 3380 206 644 20 1 335.3 14.05 10.97 2290 171 885 20 1 335.3 14.05 11.28 2290 171 885 21 1 335.3 14.8 9.5 2347 235 800 21 1 335.3 15.24 11.42 3308 161 440 21 1 357.7 14 11 2630 145 557 22 1 313 12.24 7.3 1333 245 750 22 1 782.6 27.2 18.2 10000 183 3600 22 1 298 8.84 7.01 1351 214 500 22 1 670.6 22.86 18.08 6250 180 805 22 1 223.5 7.7 6.8 885 220 330 23 1 335.3 9.5 6.8 1531 237 600 23 1 391 9.8 7.1 1438 254 628 23 1 391 15.93 11.5 3820 169 1640 23 1 436 15.93 11.5 3820 169 1640 23 1 391 15.93 11.5 3820 169 1640 23 1 436 15.93 11.5 3820 169 1640 23 1 171.4 13.08 9.27 1905 153 604 23 1 350 15.21 9.78 2646 183 1046 23 1 298 8.94 6.17 1151 261 644 24 1 223.6 9.6 6.4 1266 245 500 24 1 298 10.8 7.32 1575 235 600 24 1 634 13.72 10.74 2383 200 1046 24 1 223.5 8.9 6.9 860 246 550 24 1 864.4 26.72 18.97 7983 174 1585 25 1 760 25 15.1 6200 180 650 25 1 503.5 9.6 7.06 1484 319 917 25 1 63.3 8.84 7.17 567 146 515 25 1 357.7 11.58 9.5 1867 251 805 25 1 812 17.3 10.55 4350 230 750 25 1 335.3 12.5 8.38 1935 290 1110 25 1 298 12.1 8.7 1823 230 772 26 1 298 12.09 8.81 2253 233 1127 26 1 335.3 9.8 6.7 1487 250 500 26 1 298 15.3 9.42 2220 255 850 26 1 317 9.08 5.99 1244 233 523 26 1 231 17.75 10.27 2700 175 850 26 1 335.3 15.3 10.22 2280 230 900 26 1 432 15.15 11 3652 180 700 26 1 918 27.4 19.8 8165 145 668 26 1 745.2 22 14.63 5500 185 700 26 1 424.8 13.7 11.2 3568 196 1706 27 1 372.6 10.3 6.56 1414 298 600 27 1 782 22.76 14.88 5875 183 1385 27 1 626 22.25 13.81 5460 198 1000 27 1 544 17.25 12.6 4310 195 902 27 1 335.3 11 7 1500 300 600 27 1 372.6 12 7.5 1795 270 500 27 1 373 9.5 7.2 1628 297 450 27 1 391.2 14.15 9.91 2449 225 579 28 1 864 20.4 14.8 6900 212 1125 28 1 894 20.4 15 6900 195 1300 28 1 179 14.5 9.8 1900 197 660 28 1 74.5 8.84 7.17 567 146 515 28 1 391.2 11.35 8.94 2102 296 756 28 1 372.5 15.3 10 2710 235 1200 28 1 313 12.2 7.55 1376 237 500 28 1 507 15.5 10.56 3247 228 1100 28 1 74.5 11.4 8.1 1016 170 430 28 1 317 10.1 7.6 1515 251 547 28 1 410 9.1 6.1 1638 303 595 28 1 335 12.4 8.2 1927 230 800 29 1 67 9.1 7.1 710 175 547 29 1 97 12.2 7.5 1025 209 1050 29 1 89.4 11.2 7.62 930 177 483 29 1 410 12.24 7.64 1580 270 750 29 1 447 8.5 7.2 1340 376 580 29 1 164 13.5 10.2 2758 206 1046 29 1 89.4 8.5 7.4 726 145 579 29 1 179 10.4 8.1 1115 196 500 29 1 1066 23.2 15.06 6470 230 800 29 1 1014 28.7 18 6810 207 1000 30 1 820 22.6 15.7 6193 304 1207 30 1 391 13.94 11.19 2674 233 965 30 1 1654.4 39.62 27.36 13381 204 805 30 1 447 16.5 11.68 3950 170 650 30 1 723 19.7 15.3 5350 280 2000 30 1 358 10.02 6.78 1355 278 725 30 1 361.4 10.3 7.16 1355 317 560 31 1 89.4 9.8 7.4 839 153 515 31 1 313 7.77 6.12 1256 285 590 31 1 97 8.94 7.29 803 175 483 31 1 372 11.2 8.4 1930 300 450 31 1 559 10.52 7.47 2177 340 1261 31 1 559 11.5 10.6 2745 290 1200 31 1 484.4 14 9.5 2300 260 1050 31 1 480.7 10.72 7.55 1630 390 700 32 1 503 19.8 13 4377 265 1770 32 1 104.5 9.41 7.85 952 177 906 32 1 194 14.43 10.52 1905 175 740 32 1 194 14.43 10.52 1905 175 740 32 1 514 12.09 7.74 1710 359 850 32 1 2742.4 36 21.57 18700 325 1200 32 1 447 10.5 7.83 1895 350 850 32 1 507 19 13.5 4300 220 1500 32 1 399 11.35 9.02 2023 272 845 32 1 391 11.35 8.99 2023 293 604 32 1 469.5 14.8 12 3460 360 1400 32 1 1855.5 29.25 18.9 11030 286 1300 32 1 387.5 13.71 10.36 2640 280 700 32 1 1013.2 27.4 21.8 9526 251 1030 32 1 1341.4 21.39 13.47 6983 418 3347 32 1 313 9.8 8 2132 319 805 32 1 372.6 10.56 7.24 1581 328 950 32 1 1014 41.8 25.2 18786 288 960 33 1 715 8.8 7.5 1680 372 800 33 1 425 24.99 14.78 7258 177 8047 33 1 447 9.5 7.46 1865 375 750 33 1 179 10.5 7.65 996 278 460 33 1 1296 22.5 15.8 7280 230 1000 33 1 533.4 11 9.5 2020 335 483 33 1 559 11 8.4 1900 330 390 33 1 2013 35.1 18.9 16500 255 2100 33 1 615 14.54 9.87 3400 354 1175 33 1 820 9 6.1 1912 500 400 33 1 1028 22.1 16.2 5908 310 1250 33 1 671 10.68 7.6 2000 430 700 33 1 633 9.4 8.2 1980 394 600 33 1 1118 24.36 16.31 7700 236 3500 33 1 641 15.4 10 2560 340 1000 33 1 577.5 13.97 11.45 3259 217 966 33 1 603.6 14.94 11.48 3856 251 1006 33 1 476 17.2 12.9 3476 272 1062 34 1 1416 20.1 17.9 8526 385 1500 34 1 596 19.66 14.05 4649 228 974 34 1 298 14.63 10.5 2495 212 933 34 1 596 11.8 7.44 1860 370 750 34 1 1490 18 15.8 8836 423 3000 34 1 894 23.7 19.25 10000 260 5350 34 1 514 13.87 11.07 4196 224 1658 34 1 421 13.7 11.7 3452 206 800 34 1 477 11.35 9.02 2403 301 692 34 1 864 22 14 5443 246 877 34 1 1356 22.8 18.9 10200 334 1100 34 1 521.5 10.7 14 3651 225 2027 34 1 596 16.76 11.76 4763 325 1416 34 1 596 11.8 7.76 2100 368 860 34 1 656 22.5 15 5750 275 2600 34 1 432 11.4 9.3 2610 310 925 34 1 507 13.95 9.68 3526 319 1250 34 1 2236 36 20.73 19050 302 1930 34 1 1192 24.5 18.2 9700 310 1300 34 1 1029 21.2 15.4 6700 280 1350 34 1 1527.7 11.23 9.96 3851 721 1368 34 1 484.4 14.94 11.48 3674 229 1006 34 1 783 22.61 17 6350 251 1000 35 1 149 17.6 13.7 3500 287 560 35 1 671 15.24 10.67 4623 332 1152 35 1 1788 31.7 19.5 16066 282 3782 35 1 480.7 9.99 7.98 1792 370 740 35 1 484.4 8.69 6.53 1701 381 1396 35 1 857 22.86 17.68 7598 228 1480 35 1 1371.2 17.2 13 6532 428 2350 35 1 2012 22.6 16.4 14000 435 1950 35 1 656 10.5 8.33 2217 341 860 35 1 1043.3 13.8 11.5 6585 410 1000 35 1 537 19.7 14.4 3950 208 1000 35 1 745.2 12.1 9.6 2950 430 1100 35 1 633.4 9.55 7.2 1650 400 1000 35 1 1296.6 25.5 17.54 9380 250 1500 35 1 522 12 8.7 2230 355 1100 35 1 1294.5 9.92 8.84 3414 621 536 35 1 529 11 7.56 1670 440 1200 35 1 1677 26.5 19.2 12400 364 2745 35 1 745.2 25 16.45 8000 368 2600 35 1 1296.6 22.45 17.32 7500 325 1000 35 1 782.5 11.36 8.77 2726 483 1330 35 1 1296.6 24 17.8 9300 340 2000 35 1 97 9.73 7.6 907 169 1002 35 1 708 10.36 8.37 2838 378 1376 35 1 507 14.15 10.41 2608 254 1802 36 2 1636 28.96 19.63 12701 274 1650 36 2 762.5 16.46 12.9 4895 388 1090 36 2 1490 21.56 16.17 10100 430 3000 36 2 179 14.25 9.9 1326 175 695 36 2 3189.6 40 25.63 21500 340 4100 36 2 636 15.5 12.56 4800 290 2200 36 2 2474 39.62 27.62 23587 262 5150 36 2 1099 16.26 13 10024 550 900 36 2 1603 25.6 22.1 12790 367 2414 36 2 611 15.5 9.7 3500 290 1000 36 2 1368 17.93 12.92 8900 445 1500 36 2 3010.4 34.75 26.84 19732 311 1245 36 2 1342 18.8 13.7 9600 440 2000 36 2 1430 20.32 12.27 6500 450 1500 37 2 745.2 10.5 9.1 2800 509 600 37 2 626 10.9 7.8 2706 472 1000 37 2 2802 33 23.8 22700 384 4440 37 2 529 16.3 10.6 3447 293 885 37 2 484.4 12 9.2 2250 320 830 37 2 3576 35.1 24.2 30344 343 1720 37 2 618.5 9.83 8.36 2155 402 660 37 2 1378.6 26.95 25.04 10432 322 2486 37 2 555 9.14 8.15 1642 359 427 37 2 883 12.19 9.75 3742 538 740 37 2 1640 21.39 14.3 10050 425 4000 37 2 663 14.1 10.8 3732 301 700 37 2 708 15 11.64 3762 423 1350 37 2 1490.4 15.6 10.8 6750 490 1640 37 2 1699 22.52 17.17 11398 480 1675 37 2 670.6 14.5 10.4 3561 346 1126 37 2 1118 19.96 13.47 7938 393 3315 37 2 626 10.58 8.19 2328 503 870 37 2 2626.8 24.8 18.5 13621 456 1795 37 2 760 15.5 10.3 4100 380 980 37 2 529 11.3 7.53 1790 460 545 37 2 801 14.4 10.2 3800 428 1561 37 2 894 10.7 8 3247 517 1610 37 2 689.3 22.73 11.96 5035 367 4168 38 2 1699 17.9 12.2 7160 530 2000 38 2 4768 46.3 32.3 38102 320 8369 38 2 2608 19 17 16700 560 2500 38 2 670.6 18.4 12 3950 344 690 38 2 3576 31.6 22.7 29710 462 3219 38 2 663 14 10.8 3606 217 1303 38 2 671 12.5 11 3720 312 1078 38 2 1342 23.15 17.38 9100 350 2100 38 2 3280 32.7 22.7 19051 396 3846 38 2 2548 37.5 34.8 23813 338 2205 38 2 805 14.5 11.3 4000 376 2100 38 2 794 15.24 12.14 4749 259 1496 38 2 794 15.24 12.94 4749 259 1496 38 2 1684 17.6 13.6 9629 426 1666 38 2 1386 18 15.5 8368 354 2044 38 2 678 10.2 8.75 2780 530 1250 38 2 1014 15.4 9.8 5000 464 1400 38 2 410 12.8 8.99 2548 341 1400 38 2 708 10.97 7.72 2855 454 1931 38 2 1192 22.8 14.5 11300 480 2495 38 2 2364 26.26 19.68 13834 410 3034 38 2 663.2 15.24 9.3 2685 369 966 39 2 2623 27.5 21 22680 473 2623 39 2 894 11.58 8.79 3607 512 1239 39 2 365 12.8 10 2585 314 1207 39 2 633.4 14.5 10.85 3090 311 700 39 2 1997 20 14.3 14000 470 2500 39 2 820 9.8 8.87 3200 560 650 39 2 626 9.7 8.26 2295 450 775 39 2 3576 33.5 20.5 29527 483 3380 39 2 2198 15.85 11.53 9798 666 724 39 2 894 10.4 9.2 3765 620 1086 39 2 1565 18.69 14.22 7516 443 2092 39 2 3130 35.97 24.33 27350 314 3700 39 2 2384 18.68 14.63 10931 523 1650 39 2 648.3 11.89 9 2410 391 632 39 2 2757 25 19.6 12500 440 3960 39 2 670.7 12 8.7 2480 510 2400 39 2 1569 14.7 11 5050 595 2880 39 2 708 12.1 9.21 2920 424 1060 39 2 641 10.61 8.17 2540 488 800 39 2 1342 23.77 18.96 9072 325 2575 39 2 119 9.17 6.83 844 211 566 39 2 2235.6 21.2 16.2 11300 434 2000 39 2 820 10 8.48 2820 558 850 40 2 5365.6 31.75 21.82 30844 502 2028 40 2 1460 21.08 16.33 8508 426 3200 40 2 5516 38 28.13 32500 467 7180 40 2 1714 17.45 12.75 6750 505 2400 40 2 1788 28.6 20.1 15000 390 2300 40 2 1222 14.97 12.34 6577 367 953 40 2 1490.4 19.96 15.19 7938 417 3041 40 2 2570 17.6 13 11521 531 2414 40 2 514 14 9.76 2850 320 1200 40 2 894 12.65 10.08 4317 410 1794 40 2 2534 18.69 14.78 12633 515 1577 40 2 894 11.1 7.8 3450 476 1500 40 2 894 10.3 8.16 3350 640 1250 40 2 842 11 9.06 2744 570 1570 40 2 853 14.14 12.27 4445 450 1288 40 2 2757.2 20.6 16.1 18960 443 2052 40 2 3280 40 24.5 30950 448 4000 40 2 894 10.97 8.68 3423 565 1287 40 2 4918 30.2 26.59 31751 435 2093 40 2 1714 12.5 10.2 6398 756 1802 40 2 1267 15.16 11.18 6370 473 3098 40 2 2235 27 22 18400 340 4750 40 2 2980 32.92 23.27 25400 301 1883 40 2 335.3 10.96 10.25 2722 275 1460 40 2 2548 16.51 12.65 11567 684 5633 41 2 2647 22 14.95 14530 520 2500 41 2 4769.2 42 28.2 45000 450 6060 41 2 820 12 8.75 3250 592 1900 41 2 894 10.58 8.85 2937 600 765 41 2 1640 16.4 11.2 8100 620 2400 41 2 5097 55 28.46 45000 218 1100 41 2 1677 12.55 11.56 7301 618 2090 41 2 402 12.19 9.47 2500 290 1600 41 2 857 10.86 8.9 2640 533 1680 41 2 1952 17.16 12.6 8520 540 1200 41 2 1192 10.5 8.96 4900 657 800 41 2 857 11 8.36 3267 545 1040 41 2 1889 12.4 11.03 8800 690 950 41 2 1416 16.51 12.49 8117 444 1625 42 2 1882 12.5 10.49 6211 711 1352 42 2 1639.4 12.62 9.73 6010 663 821 42 2 984 13.5 9.75 5250 408 560 42 2 732.3 10 8.16 2386 530 950 42 2 1565 15.02 10.6 5276 547 1500 42 2 1099 11.85 8.37 3710 620 1650 42 2 1490 13.06 10.24 6383 597 1520 42 2 2757.2 19.96 15.77 14061 502 2141 42 2 1490.4 21.64 17.75 17327 462 1931 42 2 2160 35.81 28.6 33113 365 4025 42 2 1080.5 9.45 8.8 2770 610 1300 42 2 1080.5 20.3 16.2 10680 490 2400 42 2 4472 32 22.29 29885 420 3520 42 2 4828 31.1 24 30844 375 4345 42 2 987 11.7 10 4763 657 724 42 2 1043.2 16.7 11.8 6618 408 1200 42 2 2757.2 18.85 13.8 12800 550 1950 42 2 1267 14.64 12.12 6123 449 960 42 2 1014 10 8.55 3200 592 1225 42 2 1043.3 11.5 10.2 3910 580 2110 43 2 4396 31.44 22 31000 488 4750 43 2 6556 43.1 30.2 64000 576 6598 43 2 1520 17 12.2 7250 533 2175 43 2 155 12.04 8.59 1588 253 1255 43 2 1340 11.58 9.37 5620 869 1963 43 2 1592 14.1 12.6 9850 742 1630 44 2 2646 31.67 21.31 17250 350 2125 44 2 10432 43.1 33.6 66134 604 6437 44 2 3024 13.72 11.79 9480 760 4828 44 2 2236 15.57 11.45 7300 580 2000 44 2 1360 14.4 11.5 6500 566 3040 44 2 704 7.2 9.05 2700 840 610 44 2 1840 12.17 10.52 7646 933 2221 44 2 1006 12.5 11.08 4082 504 1006 44 2 3130 15.7 13.82 11666 687 1777 44 2 2235.6 15.26 12.55 11604 591 2090 44 2 1499.2 9.32 5.69 4309 960 80 44 2 1587.2 12.5 10.61 7045 868 1050 44 2 5208 36.6 23.9 37194 383 5745 44 2 670.7 11.89 10.36 3492 306 1255 44 2 149 10.97 8.53 1243 203 724 44 2 1147.6 14.9 10.85 5430 480 1450 44 2 1490.4 12.5 11.1 5260 624 4640 44 2 149 11.07 7.26 1307 200 748 44 2 1416 11.3 9.92 3600 625 1700 44 2 2980 21.34 15.62 15876 600 2253 44 2 2012 15.47 11.84 11340 512 1448 44 2 1006 12.19 9.86 5285 684 2133 44 2 2198 17 13.2 8800 575 2600 44 2 1013 11.38 10.16 4014 608 386 44 2 1416 15.16 11.18 6370 473 3098 45 2 1841 11.7 10.57 5602 724 1127 45 2 1118 12 8.82 3500 580 2000 45 2 596 17.4 11.96 4060 338 1415 45 2 5216 31.65 27.94 36240 648 5930 45 2 1565 10.92 8.61 5875 678 1778 45 2 30 10.9 6.3 481 149 402 45 2 1280 12.42 11.82 5164 810 1105 45 2 212.4 10.2 8.1 1542 338 1648 45 2 149 11.02 6.78 1361 241 1320 45 2 2951 32.9 22.4 19958 362 1320 45 2 1878 15.6 11.8 7938 547 1191 45 2 1528 14.5 10.7 5220 760 2000 45 2 3130 29.38 24.25 20577 440 3200 46 2 2240 11.1 11.62 10670 1001 1609 46 2 67 10.7 6.6 658 176 560 46 2 16992 70.1 49.4 162386 700 10943 47 2 335.3 14.64 9.24 2313 225 1252 47 2 2520 13.67 12.24 10120 917 2374 47 2 746 18.2 12.4 5500 258 900 47 2 4992 34.44 24.89 36287 560 6840 47 2 4024 35.1 24.7 23587 386 995 47 2 2160 11.89 12.09 7348 964 370 47 2 123 11.4 7.7 930 183 734 48 2 2080 11.85 11.51 6550 965 2165 48 2 5514 33.3 26.36 9070 391 1595 48 2 2381 10.08 10.04 5400 1015 680 48 2 14400 35.4 33 91625 1013 5150 48 2 6400 18.19 16.41 19160 982 1408 48 2 820 17.07 13.06 4990 368 1451 48 2 4762 21.45 17.65 21000 900 2180 48 2 2800 11.33 13.59 7100 956 1143 48 2 5932 28.56 26.11 32885 575 2554 49 2 7120 35 28.35 47627 788 2186 49 2 2500 11.58 11.84 8491 932 2092 49 2 506.6 13.8 9.6 3175 375 2172 49 2 1788.5 18.49 13.21 11340 507 2414 49 2 2388 11.91 11.44 9350 1105 1485 49 2 596 12.23 9.76 3068 461 1612 49 2 2262 16.56 13.11 8891 481 1065 49 2 112 10.76 6.86 794 185 742 49 2 159 11 7.9 1103 184 848 49 2 2124 29.46 19.18 17010 379 4587 49 2 5920 19.5 20 24925 871 1296 50 2 10134.4 45.72 35.41 70760 607 8690 50 2 745.2 21.79 14.78 6123 307 2200 50 2 8496 49.4 30.3 61200 383 2092 51 2 3577 28.42 22.73 19800 450 2961 51 2 447 17.69 12.8 3629 257 1520 51 2 6880 11.6 20.8 14187 1529 1770 51 2 6260 35.81 32.18 48534 507 4835 51 2 2040 11.25 11.43 5579 950 1915 52 2 335 13.75 8.65 2700 270 1200 52 2 32000 33.8 30.4 81645 1005 4630 52 2 3080 11.92 11.07 10750 1094 2390 52 2 819 19.66 14.02 6125 360 1850 52 2 12280 43.4 37.9 84345 574 8545 52 2 4253 13 14.94 13600 1114 3219 52 2 1216 12.2 10.1 3260 725 1400 52 2 3780 11.8 13.5 14353 1094 1062 52 2 16760 33.5 36.5 68000 945 6400 53 2 5067.4 36.03 30.66 34761 404 3300 53 2 2980 9.6 11.36 6069 1145 1400 53 2 2832 31.67 22.34 17250 415 1508 53 2 171.5 10.9 7.8 1270 274 1168 53 2 6800 11.81 16.54 15800 1390 2410 53 2 212.5 11.3 9.7 2495 383 2800 53 2 2832 32.4 22.3 18000 300 2500 53 2 2000 11 10.13 6060 1060 2700 53 2 2735 13.42 12.88 11113 616 1448 54 2 11200 8.38 12.27 11113 1038 3225 54 2 4200 9.64 13.69 10921 1207 2044 54 2 298 10.2 8.8 1938 414 1205 54 2 704 10.15 10.05 3375 650 1500 54 2 30688 50.48 47.2 158750 901 11265 54 2 13088 10.6 16.2 22680 2446 1287 54 2 10712 15.85 17.3 19473 998 1497 54 2 7160 6.68 16.69 14061 2372 1247 54 2 298 12.8 9.7 2463 233 709 54 2 40000 56.4 48 221350 1040 20120 54 2 44132 51.1 49.5 188000 805 12550 55 2 5732 9 12.54 8700 1452 685 55 2 201 11.12 8.78 1680 309 1095 55 2 704 10.93 8.97 3700 700 1700 55 2 10600 10.65 20.43 23968 2230 3330 55 2 7060 9.4 15.35 16000 2124 1003 55 2 6800 24.38 15.11 7189 850 6437 55 2 16000 34.85 32.99 63503 912 7242 55 2 3192 29 23.56 20410 480 1935 55 2 201 12 9.6 1850 227 1100 55 2 6400 10.87 16.61 15420 2127 965 56 3 8160 22.21 22.91 37648 1015 2414 56 3 9800 11.7 21.6 15876 2613 1851 56 3 13448 40.41 29.79 79379 621 4002 56 3 119 10.9 8.2 1043 232 1066 56 3 7152 43 28.9 54000 380 4700 56 3 2400 13.06 11.75 7167 933 1561 56 3 24960 17.3 29.5 73935 2229 3862 56 3 3264 8.56 10.3 5440 1078 770 56 3 3400 10.51 14.78 9344 1135 1610 56 3 5468 8.22 15.03 13500 2372 1200 56 3 1565 15.6 13.9 8200 470 2500 56 3 954 23.33 13.8 6620 256 759 56 3 6170 15.09 15.57 20700 1100 4000 56 3 8818.4 8.93 17.37 13500 1725 1450 56 3 3780 9.86 12.88 9707 1102 773 56 3 10136 38.86 34.21 64864 571 7410 57 3 30400 44.4 46.6 151315 1010 6920 57 3 231 11.2 8.6 1723 325 1973 57 3 11932 38 33.1 61000 777 1200 57 3 11028 43.4 39.1 67130 507 6440 57 3 15344 34.54 38.85 76000 800 2650 57 3 3880 10.51 14.04 10000 1195 965 58 3 3137.2 28.88 23.01 19500 443 2830 58 3 74.5 10 7.3 726 201 629 58 3 448 22 11.4 3600 222 800 58 3 2160 29.15 22.13 11793 347 2103 58 3 14320 11.77 19.2 28030 2414 1031 59 3 134 10.7 7.2 844 245 1180 59 3 12676 37.4 35.9 61200 675 4250 59 3 3264 7.7 14.38 9379 1488 2232 59 3 17080 43.4 46.3 95250 621 5245 59 3 3080 7.7 14.13 5485 1326 1759 59 3 2086 14.63 12.5 8214 465 1520 59 3 410 15.13 10.9 2770 259 1036 59 3 5700 10.77 17.96 15377 1170 2414 59 3 784 10.3 10.8 3540 655 894 59 3 7364 35.1 27.1 47610 433 5220 59 3 12698.4 11.85 23.5 31600 2340 1240 59 3 134 9.74 7.24 1050 240 1110 59 3 11178 30.18 31.81 52664 652 5014 59 3 1000 10.8 10.3 3866 708 1450 60 3 17920 36.6 39.4 87540 990 4630 60 3 17400 32.9 46.7 95027 964 3966 60 3 3400 30 20.4 21092 452 2483 60 3 388 11.5 8.5 2313 348 1836 61 3 5960 29.7 32.9 29500 610 4000 61 3 134 10.67 7.06 1168 272 1410 61 3 25600 36.6 42.4 114760 990 6115 61 3 11904 12.09 20.55 21180 1963 2500 61 3 10040 28.5 32.6 47400 871 3484 61 3 566 15.3 10.8 3992 362 2441 61 3 21600 27.7 40.53 83900 1509 2250 61 3 21600 20 26 45000 1887 4989 61 3 14860 35.97 37.45 63957 684 3331 61 3 298 12 8.8 2040 251 1038 61 3 9100 36.3 31.8 43500 658 9000 61 3 10496 12.95 21.65 15875 1186 2253 62 3 14287.2 16.15 23.35 30300 2228 4830 62 3 32960 36.58 35.03 79379 992 7403 62 3 134 9.14 7.16 1089 245 1360 62 3 238 10.97 7.67 1690 330 1930 62 3 194 11.12 8.1 1300 201 680 62 3 14352 29.9 40 68040 959 3798 62 3 2960 14.3 15.5 10977 592 4318 62 3 9920 22.1 23.27 37195 982 1690 62 3 74.5 8.02 5.79 630 230 1000 62 3 9524 25.55 30.58 38000 870 1220 62 3 1708 22.6 19.3 10800 418 1020 62 3 3430 33.53 23.92 27215 367 1666 62 3 32592 44.6 48.4 146510 935 6275 63 3 4206 29.2 23.8 24000 435 2250 63 3 1312 9.5 10.5 4500 770 1780 63 3 2280 10.9 8.6 6350 816 740 63 3 1066 19.79 12.6 6577 327 1115 63 3 1000 10.47 10.34 4300 812 1240 63 3 9098 40 32.4 51000 513 1852 63 3 33600 48.74 44.2 143607 919 9880 63 3 1066 11.94 12.02 5250 571 2584 63 3 1386 19.59 15.3 7750 500 2575 64 3 462 12.4 9.94 2948 399 1973 64 3 224 10.9 8.6 1633 290 1028 64 3 2480 14.49 16.61 9200 825 2370 64 3 2688 13.2 12.85 8165 852 2128 64 3 194 8.34 7.1 1200 340 1650 64 3 4560 32 26.3 24500 469 3215 64 3 20080 9.74 22.4 45360 2335 4707 64 3 4672 29.26 24.08 22316 420 1112 65 3 223.5 12.4 8 1814 243 595 65 3 388 14.9 10.9 2993 290 1136 65 3 44744 64.4 57.8 250000 740 5000 65 3 560 12.5 11.1 3379 478 2755 65 3 8880 13.41 19.33 28123 1038 3700 65 3 119 8.5 6.6 840 227 800 65 3 972 19.81 15.77 5670 338 1825 65 3 3600 16.3 17.15 13000 862 3350 65 3 149 10.86 8 1300 221 1258 65 3 156.5 11.6 9.1 2100 332 2288 65 3 220 11.89 9.45 1542 269 1062 65 3 424.8 11.5 8.8 2405 386 2103 65 3 7624 29.2 23.8 26000 510 2200 65 3 5360 11.79 14.05 19050 1112 3671 65 3 112 9.14 7.1 975 229 1350 66 3 26000 16.94 32.74 77111 3219 4800 66 3 4564 29.78 29.23 34019 402 4450 66 3 566 12 10.3 3073 455 2060 66 3 17080 48.42 41.69 104300 566 8530 66 3 9120 20.98 24.36 29711 936 6025 66 3 448 12.2 11 2858 424 2280 66 3 1014 15.49 12.07 5670 391 2575 66 3 566 15.55 11.41 3842 325 2950 66 3 2360 10.84 13.18 6123 877 2512 67 3 1066 12.19 12.67 6552 452 367 67 3 134 10.8 8.3 1134 257 1445 67 3 432 11.18 10.61 2721 476 2305 67 3 9128 33.15 33.46 43000 547 2168 67 3 11600 28.4 29.5 53070 927 4448 67 3 37040 43.2 53.12 162000 860 7950 67 3 10934.4 10.53 20.5 16000 2588 725 67 3 28800 45.23 57.1 158760 965 8820 67 3 3132 28.6 19.8 19731 291 2260 67 3 1364 11.2 10.3 5215 760 2224 67 3 11200 28.47 36.37 54885 907 2148 67 3 7920 25.07 29.61 32200 843 1852 67 3 253.5 11.7 8.7 1700 278 990 68 3 19424 35 38.6 87090 880 8000 68 3 1760 14.4 13.3 5375 649 2474 68 3 212.4 10.2 8.1 1542 338 1648 68 3 149 10.1 7.1 1066 241 1000 68 3 65600 67.88 75.54 348810 919 6033 68 3 2360 11.62 11.67 5983 852 1722 68 3 1517 9.5 12.3 5270 730 1600 69 3 10406 10.6 16.3 17750 2156 1000 69 3 1522 14.5 14.25 6800 500 3042 69 3 8600 7.7 13.9 11340 1186 5560 69 3 1118 20.96 13.03 6903 319 1306 69 3 924 13.01 10.57 4082 524 2020 69 3 1088 19.49 14.47 5700 365 1040 69 3 462 13.5 11.1 3062 443 2426 69 3 80000 59.6 70.5 365140 969 10424 69 3 14644 30.37 35.61 64410 761 3835 69 3 60880 25.6 62.1 185065 2691 6580 70 3 25350 14.25 16.8 13850 2480 960 70 3 2000 12.9 13.8 6600 760 1555 70 3 14550 7.15 15.76 9400 2264 1100 70 3 112 10.2 6.9 748 212 977 70 3 35272 34.45 40.23 122500 2156 8050 70 3 820 15.3 10.8 4377 412 2374 70 3 582 16.2 15 4536 267 1610 70 3 223.5 10.4 8 1508 357 1512 70 3 5070 28.7 22.7 26500 540 2220 71 3 1044 14.23 13.52 4683 526 2718 71 3 19400 13.95 22.3 36200 3019 1300 71 3 324 10.7 8.8 1860 532 2357 71 3 1014 14 12.2 5216 436 2483 71 3 1158 19 15.2 6500 359 1760 71 3 134 10 7.9 1111 228 1106 71 3 42328 50.5 46.59 170000 775 6700 71 3 5844 7.88 17.84 9805 1725 2593 71 3 462 11.6 10.5 2717 452 2552 71 3 596 16.46 12.56 3855 311 1352 72 3 1268 16.6 13.3 5670 515 3495 72 3 9800 14 18.75 17700 2340 630 72 3 156.6 10.85 7.63 1338 315 1106 72 3 261 12.4 10.55 3175 409 1761 72 3 7440 16.15 16.69 27397 1043 3096 72 3 58800 50.41 55.5 259450 908 7413 72 3 7252 17.53 16.26 21500 722 1000 72 3 1118 15.3 15.1 5670 417 1900 72 3 20000 13.05 19.43 25401 2696 4631 72 3 60000 47.35 50.05 224982 898 9653 73 3 2368 9.11 12.29 7000 1020 2000 73 3 6880 8.69 16.83 15500 1593 1315 73 3 4000 8.13 14.68 11193 1757 2483 74 3 19760 17.15 21.29 39500 2156 3600 74 3 2136 9.4 11.2 7755 1000 556 74 3 12200 13.9 16.7 26490 2156 1390 74 3 7420 20.93 16.25 23831 834 3706 74 3 10000 9.45 14.52 12652 2156 925 74 3 254 13.1 9.3 2040 259 1297 74 3 1786 22.76 17.69 10387 352 1695 74 3 4410 9.6 14.31 12000 1204 650 74 3 4206 29.2 24.3 23000 540 2360 75 3 560 14.1 12 3810 430 3402 75 3 1800 6.73 9.04 4170 1152 204 75 3 426 17 12.02 3500 220 400 75 3 1670 28.34 24.58 19731 436 2093 75 3 17040 34.2 36.38 52000 820 1000 75 3 298 11.85 8.69 2073 361 1129 76 3 5280 16.6 18.42 20185 880 5132 76 3 134 9.73 7.11 960 220 2000 76 3 7160 8.22 16.35 14600 2480 835 76 3 45856 48.06 59.54 198000 925 4600 76 3 1600 10.9 11 5895 898 1760 76 3 7000 7.32 15.25 11565 1009 740 77 3 70544 28.8 65.7 180000 2534 6500 77 3 5844 7.88 17.85 13700 1700 2593 77 3 4000 9.62 14.9 10097 1160 520 77 3 119 10.67 7.25 1054 233 1176 77 3 11464 25.83 26.58 33000 760 1000 77 3 82 10 7.3 757 204 769 77 3 268 11.6 8.9 1769 308 1445 77 3 5844 7.88 17.84 13674 1725 417 78 3 6000 19.61 20.85 19096 833 6486 78 3 506 12.94 12.03 3151 393 2226 78 3 924 15 11.9 4468 547 3402 78 3 40000 43.89 46.66 150000 667 6540 78 3 83.5 10.36 7.04 757 202 867 78 3 7054 7.15 16 18000 1810 780 78 3 268 11.75 8.41 1723 311 1631 78 3 1342 14.1 12.85 5670 571 4567 78 3 224 9.99 8.45 1542 289 1548 78 3 12800 11.43 17.07 21319 1941 1019 78 3 2960 13.65 15.93 10659 872 3983 79 3 149 10.67 7.62 1247 282 1334 79 3 2960 15.37 14.3 10886 916 5106 79 3 9120 23.72 25.27 30935 916 7495 79 3 149 11.58 7.6 1220 241 1327 79 3 17108 12 18.7 16100 2500 3700 80 3 1342 15.85 14.37 6600 488 1167 80 3 566 15.55 11.41 3842 325 642 80 3 1780 11.05 10.79 6150 907 1222 81 3 38320 47.57 48.51 136080 863 5749 81 3 1750 22.81 21.59 11793 393 1697 82 3 746 17.23 14.86 5500 282 1280 82 3 10000 10.43 16.51 21772 2156 4630 82 3 11152 26.34 28.55 40597 778 2473 82 3 32000 37.95 47.32 104325 863 4800 82 3 3580 30.63 26.06 22090 474 1545 83 3 2237 19.78 20 9600 500 2907 84 3 1400 9.69 10.93 4650 740 1500 sm/inst/smdata/lcancer.dat0000744000176200001440000003637012266061227015236 0ustar liggesusersEasting Northing Cancer 353214 427676 1 352909 422335 1 349548 418172 1 352802 420526 1 352995 421125 1 351884 426490 1 350083 425035 1 357166 425846 1 348767 418580 1 356523 425252 1 359125 417215 1 359447 413317 1 351720 428201 1 355207 423685 1 359832 417370 1 359567 427575 1 354758 422782 1 353989 421856 1 351900 428827 1 348716 425864 1 360779 413426 1 353713 425658 1 356837 425909 1 355880 418558 1 360057 419028 1 351919 417257 1 357543 423090 1 352243 427156 1 350619 424959 1 355142 422115 1 355672 427119 1 358770 416352 1 357996 417037 1 358977 417306 1 351973 428127 1 358358 417482 1 358943 418061 1 353222 427197 1 356397 426301 1 348273 425545 1 353143 415030 1 357998 416205 1 357487 415937 1 352051 421499 1 351276 425833 1 354438 422333 1 354738 426567 1 355479 419132 1 354374 425609 1 355859 425680 1 355535 424264 1 353150 427008 1 356340 413295 1 355903 413619 1 355563 414116 1 355398 414390 1 355350 414031 1 359014 416976 2 352909 426935 2 353848 422172 2 359202 417326 2 357795 415825 2 352784 426890 2 354777 421668 2 354983 422135 2 355366 414446 2 362767 421680 2 356323 426452 2 354225 422015 2 357847 417617 2 360920 422301 2 352407 421885 2 356732 426370 2 353567 427375 2 359658 417482 2 351289 417356 2 358400 416427 2 355816 427164 2 354179 422426 2 357513 423658 2 353837 426909 2 348480 426458 2 353757 422128 2 355119 424957 2 354643 422790 2 355543 427356 2 358119 419159 2 353842 422315 2 360972 414019 2 354170 421752 2 360396 426837 2 359277 427206 2 358573 416227 2 358158 418082 2 359943 413061 2 353422 427397 2 357697 416901 2 361273 413645 2 360443 413130 2 356098 426705 2 358587 416237 2 355951 422299 2 347976 425833 2 358438 416633 2 351279 425132 2 360074 419409 2 355859 426480 2 354135 423064 2 358250 421108 2 356040 426095 2 359703 416819 2 357363 416516 2 353398 422990 2 357850 416731 2 356555 426361 2 351595 428278 2 351195 427532 2 358727 417958 2 358838 418786 2 356153 418404 2 353842 421955 2 352290 421779 2 351276 427253 2 355346 428245 2 351014 425588 2 348044 424681 2 347880 424127 2 357898 416594 2 358247 418543 2 355680 412911 2 354746 422805 2 347595 424463 2 354751 425940 2 352979 422538 2 356682 425688 2 356202 425983 2 359284 426593 2 357865 425718 2 350607 427645 2 354866 425588 2 353807 422416 2 357630 421956 2 357136 427977 2 357615 417178 2 360747 413850 2 351953 421858 2 359765 412876 2 357864 415815 2 356572 427055 2 356492 425472 2 356535 418845 2 354696 421895 2 359441 417968 2 353455 427991 2 357764 426707 2 355915 426491 2 353223 422452 2 357439 416037 2 358063 417177 2 353680 422280 2 348105 426103 2 357952 416626 2 351421 423320 2 355907 427533 2 357157 426444 2 356502 418591 2 354967 419471 2 353952 418689 2 363288 421890 2 359568 413101 2 359407 418144 2 357765 416301 2 357466 415985 2 352342 417336 2 353536 422007 2 361821 421458 2 348021 424120 2 355146 422954 2 358023 416833 2 357826 419878 2 352516 421020 2 352627 421515 2 356175 426229 2 356196 426482 2 348497 423912 2 355922 426199 2 353471 428238 2 355714 414740 2 362418 421162 2 354904 421383 2 353876 421916 2 355559 420188 2 348540 419391 2 355999 427103 2 352129 421583 2 354114 422132 2 360405 414364 2 351878 428284 2 359500 412554 2 357444 415710 2 358126 418056 2 351231 425139 2 358351 417046 2 362106 421297 2 358484 425727 2 357946 417520 2 349408 426166 2 353849 425372 2 357768 416251 2 358637 416102 2 352560 426394 2 354422 422625 2 357862 416757 2 357028 416247 2 353908 422528 2 355410 427319 2 348785 418558 2 356810 426166 2 352163 427981 2 358400 418375 2 359635 427135 2 357152 418005 2 348476 426104 2 354078 422289 2 359605 417296 2 347390 425396 2 354945 418483 2 350408 425720 2 351079 424510 2 355687 427377 2 352793 427008 2 357175 426354 2 353898 423213 2 363371 422506 2 356527 425821 2 351103 424594 2 353245 422228 2 358965 426636 2 353004 421538 2 352954 421755 2 355044 419836 2 355450 422937 2 357221 414239 2 354150 417385 2 359497 418042 2 349928 426994 2 359455 427346 2 351024 428316 2 352915 421163 2 354304 421536 2 353428 421610 2 356120 426111 2 352771 426813 2 354744 421881 2 352953 427161 2 351221 427359 2 352426 427709 2 361378 422332 2 357576 416759 2 355134 423078 2 358814 417542 2 354658 422937 2 358743 416301 2 358220 416920 2 358895 417723 2 361174 413831 2 355945 426405 2 358614 417646 2 347782 426705 2 358160 418751 2 353136 423169 2 355304 413479 2 350754 427577 2 348365 424629 2 351724 428904 2 358698 417633 2 358729 422036 2 352300 428647 2 353040 422243 2 347557 424814 2 356924 426335 2 349169 418090 2 358881 417424 2 360211 421595 2 356360 414149 2 358228 417551 2 359341 417474 2 359986 413533 2 358827 413520 2 356440 413725 2 351546 427996 2 348923 418473 2 358833 417362 2 352720 421451 2 352773 427758 2 356057 426951 2 360477 413941 2 355557 423427 2 352635 426987 2 356451 425908 2 354794 421944 2 352750 426898 2 358495 417689 2 354470 425790 2 355426 427268 2 356593 414692 2 360169 412819 2 358177 417785 2 352749 427227 2 354652 423286 2 357041 416544 2 358131 427181 2 358489 416795 2 358956 416122 2 353954 426153 2 353754 422375 2 352314 425021 2 358469 416842 2 360467 419203 2 352044 421697 2 346929 422869 2 348734 426261 2 357700 422388 2 355288 423190 2 350622 425097 2 358218 420003 2 356308 426675 2 359886 414426 2 356888 425566 2 351478 422949 2 356829 414247 2 357914 415816 2 356668 425648 2 350898 427626 2 354249 425547 2 357791 416814 2 355281 421803 2 360709 414414 2 352190 426279 2 356953 414960 2 353520 414738 2 356028 427155 2 357050 414339 2 354487 422955 2 351824 421755 2 349448 426042 2 349294 427325 2 358423 427564 2 357852 416767 2 358111 415603 2 358558 419169 2 358090 417337 2 357864 413868 2 358258 422572 2 358105 417849 2 354860 422612 2 351778 416776 2 351855 428425 2 349677 426869 2 357800 415858 2 358688 417998 2 351207 418719 2 356431 414809 2 358927 417824 2 359741 419372 2 359214 418309 2 358749 417125 2 353432 422998 2 358344 421342 2 358774 418077 2 356403 426060 2 354813 419065 2 352197 417357 2 352158 422073 2 359534 427458 2 352733 416892 2 352067 416631 2 358953 417116 2 356520 418241 2 357614 416324 2 355569 419238 2 350854 425732 2 355634 421637 2 355027 418153 2 354308 425671 2 356932 426057 2 360482 414279 2 358242 417469 2 359604 416789 2 358878 417123 2 356014 426288 2 353262 427176 2 358698 416324 2 357518 416819 2 353514 427221 2 360324 412891 2 358118 416876 2 355910 423321 2 359355 417999 2 358985 416714 2 348733 425977 2 358209 420501 2 352344 427913 2 359673 416974 2 352074 427731 2 358112 422514 2 362728 427595 2 350620 420050 2 357837 418326 2 355575 422151 2 351880 428675 2 352065 416370 2 352955 421328 2 357304 422378 2 353467 422708 2 352538 428378 2 354948 415944 2 358127 416842 2 354580 425875 2 351911 417480 2 354444 422760 2 360634 413955 2 348749 423859 2 359135 427071 2 353984 426358 2 358996 417852 2 356030 425902 2 351037 427423 2 355692 422908 2 356557 414624 2 350866 427727 2 358308 416762 2 360924 414526 2 353404 421430 2 353522 422245 2 356353 426212 2 356497 425022 2 358208 419778 2 355699 427529 2 357027 416415 2 350282 426709 2 354543 419682 2 361421 413667 2 358334 420730 2 356881 426294 2 356179 425699 2 354494 422290 2 352413 421602 2 357978 421847 2 357749 418535 2 350247 427575 2 357990 427608 2 359260 417133 2 360593 413231 2 359240 426422 2 351910 416377 2 357819 417135 2 362175 420920 2 354750 425804 2 356543 413892 2 350023 424038 2 358877 417860 2 354837 423097 2 353464 422653 2 357868 417197 2 358468 416144 2 351578 427483 2 360505 412827 2 359203 417176 2 352742 427083 2 353193 421272 2 354226 421962 2 357442 416564 2 348261 424017 2 347148 420727 2 357959 416556 2 353051 427586 2 354923 422320 2 354966 425787 2 358198 417437 2 352957 427264 2 350078 426157 2 358179 418549 2 354341 421503 2 356600 414619 2 353067 414790 2 356378 425685 2 357989 417030 2 353940 425778 2 357921 427471 2 362174 421736 2 352693 427571 2 358919 416796 2 355615 426896 2 359909 412721 2 357257 416753 2 354683 421668 2 364330 422137 2 358510 416845 2 354498 422644 2 356159 426606 2 358094 417967 2 354855 419152 2 353418 427627 2 353034 421482 2 354600 422932 2 359290 417231 2 350957 425738 2 355014 422992 2 359208 418473 2 347410 423760 2 352866 427396 2 356783 414302 2 348372 425466 2 357703 427885 2 356511 414078 2 354727 418968 2 351236 428042 2 353473 421884 2 353769 422675 2 352048 416434 2 358408 427171 2 350624 425999 2 358083 417318 2 354839 423604 2 360113 412632 2 354838 421542 2 352001 428080 2 355638 414283 2 355213 421550 2 357509 416981 2 360488 413552 2 362865 421904 2 354210 422208 2 355567 419499 2 354211 416599 2 358821 417320 2 358617 420344 2 360569 414027 2 351805 425783 2 352072 428679 2 355707 426811 2 351066 428150 2 348903 419268 2 351403 428665 2 358642 426816 2 358148 417395 2 351654 428498 2 357649 416522 2 356467 418237 2 353559 428088 2 352106 426546 2 353902 426553 2 350986 428014 2 358293 417285 2 355770 427246 2 355488 425985 2 352513 427512 2 353362 421784 2 358654 416991 2 359024 416119 2 355391 426360 2 359935 413908 2 352679 426712 2 351151 424750 2 352500 422266 2 359961 421261 2 353559 421133 2 358336 419264 2 357522 416812 2 347359 425364 2 356170 426791 2 358054 415808 2 353295 426709 2 355286 427065 2 353483 427649 2 350943 426036 2 348538 424147 2 359381 413118 2 356275 427264 2 358534 416631 2 359547 426304 2 352582 421445 2 359319 412843 2 357760 416602 2 350771 425435 2 352022 426871 2 356340 413671 2 356331 425651 2 358263 413643 2 352860 421912 2 348593 418625 2 356201 425512 2 354086 422742 2 359601 413388 2 356358 426630 2 355588 418825 2 353422 422090 2 352179 427530 2 357807 422336 2 357927 418454 2 357631 422235 2 353360 427004 2 356976 426839 2 352871 426425 2 351427 421233 2 353200 425917 2 357505 416713 2 352045 416956 2 351248 427918 2 353657 422890 2 354672 421830 2 355348 422974 2 359977 417461 2 358576 418116 2 347501 423653 2 352725 426604 2 352331 427600 2 360450 413580 2 364435 422413 2 359215 416933 2 353135 421854 2 351961 417269 2 358199 426848 2 358079 416051 2 359357 417601 2 355187 425543 2 356425 426231 2 356098 418265 2 360034 413042 2 359290 418492 2 359262 417460 2 357944 417891 2 357858 427031 2 354579 422758 2 348553 425833 2 359035 426815 2 356049 427085 2 351291 421295 2 358253 423136 2 352797 422064 2 354480 421690 2 358554 417653 2 355576 414538 2 355845 427917 2 354802 418780 2 349009 425990 2 356543 419012 2 360556 413564 2 359564 416980 2 358016 416988 2 357902 418089 2 356493 412437 2 354463 425122 2 353966 421942 2 356193 414436 2 352855 422271 2 359110 427019 2 352928 422058 2 351886 428543 2 352410 427145 2 351535 427194 2 358400 417951 2 356786 414338 2 351511 419248 2 351617 420613 2 355573 421323 2 353124 416078 2 358869 418037 2 350814 425483 2 353596 422397 2 358640 418656 2 358086 418163 2 347778 426050 2 359013 418511 2 354184 421764 2 359218 416518 2 356898 426064 2 355725 427798 2 359829 418740 2 351489 427669 2 356246 425659 2 357670 416647 2 350902 427633 2 358483 416723 2 354744 426232 2 355258 422014 2 359033 419154 2 352964 427130 2 348658 426668 2 355132 426249 2 353233 421453 2 354025 422750 2 355972 423354 2 352704 416094 2 359751 412563 2 356215 426193 2 359224 418560 2 359507 425717 2 352536 422731 2 355525 424198 2 354796 422207 2 358494 416253 2 353318 422094 2 351758 416556 2 358676 419109 2 355268 418828 2 357837 417107 2 357074 418121 2 353759 421205 2 358095 415838 2 356358 414292 2 349393 425406 2 356508 427205 2 352710 421878 2 354652 425377 2 356105 426071 2 351191 417372 2 354576 423092 2 357176 415662 2 357766 416600 2 353551 422010 2 350991 427530 2 353200 421665 2 353030 422145 2 348844 426358 2 357100 427269 2 356814 426198 2 356041 426945 2 358967 424752 2 358005 417071 2 355003 422747 2 354755 419722 2 355118 428126 2 359226 417349 2 358736 417780 2 358219 417474 2 346475 422316 2 355376 421831 2 359305 417740 2 359454 418200 2 354211 425609 2 356872 427931 2 352878 422089 2 351233 421908 2 352174 427972 2 354316 422252 2 355263 421774 2 348227 425407 2 358100 417904 2 358444 416624 2 348121 424076 2 356633 425938 2 352695 421501 2 354417 419709 2 355809 427615 2 355303 417857 2 346959 425204 2 358796 418907 2 358840 417136 2 355549 427213 2 358837 417818 2 358017 417120 2 355273 427468 2 357922 417116 2 357213 416812 2 356396 426621 2 351996 422149 2 355539 426639 2 352945 428189 2 348287 426443 2 359552 426912 2 356161 425958 2 358938 418000 2 351801 426809 2 352931 421517 2 353197 421670 2 357560 423500 2 358138 421013 2 356197 426684 2 348897 418197 2 354185 426212 2 356034 418974 2 348913 418889 2 354437 426111 2 346576 425429 2 355626 427105 2 351966 422629 2 351084 425295 2 353669 426997 2 357270 416273 2 361514 413217 2 356409 415640 2 358965 417525 2 350416 427107 2 359950 421607 2 360255 413738 2 355007 422954 2 358665 416771 2 351294 428987 2 353500 421575 2 356483 414626 2 354352 421586 2 350854 428137 2 356025 422314 2 348544 425745 2 353784 423178 2 354184 422584 2 353791 427163 2 350768 424744 2 354997 421733 2 356704 426411 2 356063 426692 2 352079 421452 2 357857 423371 2 357519 416919 2 353539 426388 2 354360 421788 2 357520 427887 2 356521 425697 2 360662 413730 2 352532 427007 2 354640 425401 2 359163 418379 2 354881 422201 2 356156 414634 2 359017 418805 2 359325 416886 2 358458 426431 2 355247 422569 2 358514 417845 2 351913 421568 2 360224 413431 2 358754 418879 2 351729 421419 2 347812 420586 2 354116 425766 2 358671 416403 2 353515 422005 2 358332 417059 2 355365 421985 2 353517 427620 2 358078 422154 2 352089 421458 2 358257 421572 2 358353 422200 2 358901 419251 2 352557 427782 2 353523 427474 2 352870 421638 2 359025 416582 2 355340 422366 2 359439 424383 2 358775 417110 2 352320 417289 2 355139 425571 2 357476 416300 2 353089 421536 2 359317 417453 2 355980 418223 2 357966 417724 2 352416 416702 2 353202 422245 2 357914 424664 2 358552 416558 2 355788 414379 2 361091 413508 2 357594 417521 2 356128 425916 2 357761 426764 2 362144 421597 2 353291 426746 2 361132 413994 2 360437 413335 2 348773 426483 2 358037 419000 2 358580 418018 2 358457 415837 2 358265 416988 2 359012 417052 2 355095 423196 2 358448 423289 2 354718 422092 2 359770 418827 2 357938 417709 2 357720 420819 2 349419 426258 2 359249 418496 2 358076 416057 2 361859 427839 2 357860 417963 2 351023 425357 2 352126 417211 2 357401 416747 2 355020 422017 2 357035 416476 2 357700 424387 2 353889 421994 2 359315 418280 2 353723 422188 2 357077 425987 2 359781 427094 2 354840 422025 2 358519 418126 2 352891 427569 2 359485 413141 2 351645 427634 2 357600 415952 2 352442 417125 2 357812 415903 2 357754 421272 2 349216 426192 2 354612 425530 2 356004 415264 2 359226 426169 2 356195 427612 2 347200 422495 2 357971 418677 2 355576 421712 2 358138 417252 2 354701 422062 2 356919 425883 2 358776 417910 2 356212 426576 2 351308 428493 2 358804 417244 2 356546 427081 2 359392 417493 2 357810 416811 2 351994 423747 2 352797 422078 2 350423 427214 2 352076 428363 2 356383 418562 2 353005 427599 2 359875 427305 2 357926 416121 2 358810 417037 2 359565 414476 2 359017 418415 2 347505 425869 2 360453 419927 2 352593 421448 2 359832 420473 2 352437 421831 2 353778 420311 2 358123 415713 2 351886 422065 2 360246 413665 2 356713 414831 2 357794 416705 2 359016 417329 2 358896 420194 2 355703 415056 2 361730 423386 2 359357 417338 2 355288 421731 2 358004 426121 2 358538 416283 2 357704 416828 2 357075 425398 2 356771 425249 2 354325 426224 2 352253 427073 2 361209 413615 2 347524 422478 2 358278 415995 2 358500 422105 2 354639 425855 2 349313 427601 2 358203 416990 2 352184 416978 2 351619 428422 2 351421 428040 2 sm/inst/smdata/wonions.doc0000744000176200001440000000100512266061236015303 0ustar liggesusers White onions data These data were colllected in a study of the relationship between the yield of White Imperial Spanish onion plants and the density of planting. The variables are: Density: density of planting (plants/m^2) Yield: yield (g/plant) Locality: a code to indicate Purnong Landing (1) or Virginia (2) Source: The data were collected by I.S.Rogers (South Australian Dept. of Agriculture & Fisheries). They are listed in Ratkowsky (1983), Nonlinear Regression Modeling. Dekker, New York. sm/inst/smdata/citrate.doc0000744000176200001440000000151512266061225015246 0ustar liggesusers Citrate data These data were collected in an experiment to study the relationship between possible daily rhythms of plasma citrate and daily rhythms of carbohydrate metabolites during feeding with a citrate-poor diet. During the experiment, plasma citrate concentrations were determined for each of 10 subjects at 14 successive time points during the day. The measurements covered the period 8a.m. to 9p.m. at hourly intervals. Meals were given at 8a.m., noon and 5p.m. The variables are: C08 ... C21: plasma citrate measurements at the indiated hours. Source: Anderson,A.H., Jensen,E.B. & Schou,G.(1981). Two-way analysis of variance with correlated errors. Int.Stat.Rev. 49,153-67. The data were taken from a report by T.T.Nielsen, N.S.Sorensen and E.B.Jensen. sm/inst/smdata/trawl.doc0000744000176200001440000000152512266061234014745 0ustar liggesusers Trawl data These data refer to a survey of the fauna on the sea bed lying between the coast of northern Queensland and the Great Barrier Reef. The sampling region covered a zone which was closed to commercial fishing, as well as neighbouring zones where fishing was permitted. The variables are: Zone: an indicator for the closed (1) and open (0) zones Year: an indicator of 1992 (0) or 1993 (1) Latitude: latitude of the sampling position Longitude: longitude of the sampling position Depth: bottom depth Score1: catch score 1 Score2: catch score 2 Source: The details of the survey and an analysis of the data are provided by Poiner et al. (1997), The effects of prawn trawling in the far northern section of the Great Barrier Reef, CSIRO Division of Marine Research, Queensland Dept. of Primary Industries. sm/inst/smdata/birth.doc0000744000176200001440000000105612266061223014721 0ustar liggesusers Low birthweight data The data refer to a study on low birthweight in babies, defined as "less than 2500 grams", and related factors. The variables are: Smoke: indicator of whether the mother is a smoker. Lwt: last menstrual weight of the mother, Low: indicator variable of low weight, Source: Hosmer & Lemeshow (1989). Applied Logistic Regresion. Wiley, NY. The original source contains additional variables; see Appendix 1 of Hosmer & Lemeshow for a full list of the data, pp.29-30 and p.92 for additional information. sm/inst/smdata/radioc.doc0000744000176200001440000000074612266061232015057 0ustar liggesusers Radiocarbon data These data record high precision measurements of radiocarbon on Irish oak, used to construct a calibration curve. The variables are: Rc.age: age predicted from the radiocarbon dating process Precision: a measure of precision of the dating process Cal.age: true calendar age Source: Pearson & Qua (1993). High precision 14Cmeasurement of Irish oaks to show the natural 14C variations from AD 1840 - 5000 BC: a correction. Radiocarbon 35, 105-123. sm/inst/smdata/worm.doc0000744000176200001440000000072612266061237014605 0ustar liggesusers Worm data These data record the occurence of a human parasitic worm infection in residents of a rural community in China. The variables are: Age: age of the resident Infection: presence (1) or absence (0) of infection Sex: male (1) or female (2) Source: The background to the data, and an analysis, are described by Weidong et al. (1996), Ascaris, people and pigs in a rural community of Jiangxi province, China, Parasitology 113, 545-57. sm/inst/smdata/magrem.doc0000744000176200001440000000073412266061230015061 0ustar liggesusers Magnetic remanence data These data record measurements of magnetic remanence in specimens of Precambrian volcanics. The variables are: maglong: directional component on a longitude scale maglat: directional component on a latitude scale Source: Schmidt & Embleton (1985) J.Geophys.Res. 90 (B4), 2967-2984. The data are also listed in Fisher, Lewis & Embleton (1987), Statistical Analysis of Spherical Data, Cambridge University Press, Cambridge, dataset B6. sm/inst/smdata/wonions.dat0000744000176200001440000000240312266061236015311 0ustar liggesusersDensity Yield Locality 23.48 223.02 1 26.22 234.24 1 27.79 221.68 1 32.88 221.94 1 33.27 197.45 1 36.79 189.64 1 37.58 211.2 1 37.58 191.36 1 41.49 156.62 1 42.66 168.12 1 44.23 197.89 1 44.23 154.14 1 51.67 153.26 1 55.58 142.79 1 55.58 126.17 1 57.93 167.95 1 58.71 144.54 1 59.5 151.3 1 60.67 130.52 1 62.63 125.3 1 67.71 114.05 1 70.06 116.31 1 70.45 120.71 1 73.98 134.16 1 73.98 114.48 1 78.67 91.17 1 95.9 101.27 1 96.68 97.33 1 96.68 101.37 1 101.38 97.2 1 103.72 87.12 1 104.51 81.71 1 105.68 76.44 1 108.03 87.1 1 117.82 84.54 1 127.21 69.09 1 134.26 64.4 1 137.39 66.81 1 151.87 63.01 1 163.61 55.45 1 166.35 62.54 1 184.75 54.68 1 18.78 272.15 2 21.25 235.23 2 23.23 180.47 2 27.18 177.31 2 30.15 141.28 2 31.63 169.39 2 32.12 138.17 2 32.62 171.81 2 32.62 112.02 2 33.61 156.09 2 37.07 137.29 2 38.55 154.1 2 39.54 124.17 2 39.54 146.28 2 41.02 105.47 2 42.5 139.24 2 43.98 148.31 2 45.47 110.44 2 49.92 90.72 2 50.9 102.61 2 53.87 107.36 2 57.82 92.66 2 61.78 96.52 2 61.78 94.71 2 63.75 99.86 2 67.71 93.37 2 71.66 89.78 2 77.59 69.34 2 80.56 73.74 2 86.49 75.17 2 88.46 72.98 2 89.45 79.94 2 90.93 79.13 2 92.91 70.93 2 101.81 60.99 2 103.78 74.09 2 115.15 49.45 2 123.06 56.65 2 144.31 47.84 2 155.68 40.03 2 158.15 38.7 2 180.39 28.96 2 sm/inst/scripts/0000755000176200001440000000000013353155222013336 5ustar liggesuserssm/inst/scripts/air_band.q0000744000176200001440000000013712266061202015255 0ustar liggesuserswith(aircraft, { y <- log(Span)[Period==3] sm.density(y, xlab = "Log span", display = "se") }) sm/inst/scripts/onionplt.q0000744000176200001440000000010512266061212015354 0ustar liggesuserswith(wonions, { sm.ancova(Density, log(Yield), Locality, h = 15) }) sm/inst/scripts/nyc.q0000744000176200001440000000067112266061211014312 0ustar liggesusersTemp <- c( 67,72,74,62,65,59,61,69,66,68,58,64,66,57,68,62,59,73,61,61,67,81,79,76,82, 90,87,82,77,72,65,73,76,84,85,81,83,83,88,92,92,89,73,81,80,81,82,84,87,85, 74,86,85,82,86,88,86,83,81,81,81,82,89,90,90,86,82,80,77,79,76,78,78,77,72, 79,81,86,97,94,96,94,91,92,93,93,87,84,80,78,75,73,81,76,77,71,71,78,67,76, 68,82,64,71,81,69,63,70,75,76,68) ts.plot(Temp) title("Temperature at NYC") sm.regression.autocor(y=Temp, h.first=10, maxh=6) sm/inst/scripts/mildew.q0000744000176200001440000000053512266061207015006 0ustar liggesusersX <- cbind(rep(1, 36), as.matrix(mildew[ , 1:11])) e <- residuals(lsfit(X, mildew$Yield, intercept = FALSE)) position <- 1:36 par(mfrow = c(1,2)) sig.trace(sm.regression(position, e, design.mat=X, model = "no.effect", display="none"), hvec = seq(1, 20, by=1.5)) sm.regression(position, e, design.mat=X, h=7, model="no.effect") par(mfrow=c(1,1)) sm/inst/scripts/air_scat.q0000744000176200001440000000116412266061203015305 0ustar liggesuserswith(airpc, { pc <- cbind(Comp.1, Comp.2) pc1 <- pc[Period==1,] pc2 <- pc[Period==2,] pc3 <- pc[Period==3,] xlim <- range(Comp.1) ylim <- range(Comp.2) par(mfrow=c(2,2)) plot(Comp.1, Comp.2, xlim = xlim, ylim = ylim, main="1914-84") lines(xlim, c(0,0), lty=2) lines(c(0,0), ylim, lty=2) plot(pc1, xlim = xlim, ylim = ylim, main="1914-35") lines(xlim, c(0,0), lty=2) lines(c(0,0), ylim, lty=2) plot(pc2, xlim = xlim, ylim = ylim, main="1936-55") lines(xlim, c(0,0), lty=2) lines(c(0,0), ylim, lty=2) plot(pc3, xlim = xlim, ylim = ylim, main="1956-84") lines(xlim, c(0,0), lty=2) lines(c(0,0), ylim, lty=2) par(mfrow=c(1,1)) }) sm/inst/scripts/te_var.q0000744000176200001440000000044612266061216015006 0ustar liggesuserswith(tephra, { logit <- log(Al2O3/(100-Al2O3)) nn <- nnbr(logit, 7) hw <- nn/exp(mean(log(nn))) sm.density(logit, h.weights = hw, lty = 2, yht = 12.2) hw <- sqrt(nn) hw <- hw/exp(mean(log(hw))) sm.density(logit, h.weights = hw, lty = 3, add = TRUE) sm.density(logit, add = TRUE) }) sm/inst/scripts/geys_ts.q0000744000176200001440000000031612266061205015175 0ustar liggesusersd<-geyser$duration cat("Data are: d=(duration of geyser eruption)\n") cat("Marginal density of d(t) first, followed by\n") cat("estimated density of (d(t-k),d(t)), for k=1,2\n") a<-sm.ts.pdf(d,lags=c(1,2)) sm/inst/scripts/sp_comp2.q0000744000176200001440000000077412266061214015252 0ustar liggesuserswith(aircraft, { par(mfrow = c(1,2)) h <- exp(mean(log(tapply(log(Span), Period, FUN = "hnorm")))) ind <- (Period!=3) sm.density.compare(log(Span)[ind], Period[ind], h = h, xlab = "log(Span)", lty = c(3,2), ylim = c(0, 1.2)) legend(3.0, 1.1, c("Period 1", "Period 2"), lty = c(3,2)) ind <- (Period!=1) sm.density.compare(log(Span)[ind], Period[ind], h = h, xlab = "log(Span)", lty = c(2,1), ylim = c(0, 1.2)) legend(3.0, 1.1, c("Period 2", "Period 3"), lty = c(2,1)) par(mfrow = c(1,1)) }) sm/inst/scripts/bissell3.q0000744000176200001440000000221713326314231015240 0ustar liggesusers# run this script immediately after "bissel2" # which produces the nonparametric regression estimate with(bissell, { plot(Length, Flaws, xlim=c(0,1000), pch="o") Y <- Flaws[order(Length)] X <- sort(Length) h <- 100 beta <- sum(Y)/sum(X) abline(0,beta,col=2) dev<-function(y,mu){ d<-(mu-y+y*log(y/mu)) d[y==0] <- mu[y==0] return(2*sum(d)) } W<-sm.weight(X, X, h, options=list(poly.index=0)) glm.fitted<- beta*X p.boot <- 0 denom <-(W %*% X) sm.fitted <- ((W %*% Y)/denom)*X disp <- dev(Y,sm.fitted)/(length(Y)-1) ts.orig <- (dev(Y,glm.fitted)-dev(Y,sm.fitted))/disp cat("Dispersion parameter = ", disp,"\n") cat("Test statistic = ", ts.orig,"\n") nboot <- 500 cat("Bootstrap samples: ") for (i in 1:nboot) { yboot<-rpois(length(glm.fitted),glm.fitted) sm.fitted <- ((W %*% yboot)/denom)*X disp <- dev(yboot,sm.fitted)/(length(yboot)-1) ts.boot <- (dev(yboot,glm.fitted)-dev(yboot,sm.fitted))/disp if (ts.boot > ts.orig) p.boot <- p.boot + 1 lines(X, sm.fitted, lty=2,col=6) if((i %% 100)==0) {cat(i);cat(" ")} } cat("\n") lines(x,sm.beta*x,col=1) cat("Observed significance = ", p.boot/nboot,"\n") }) sm/inst/scripts/edfgrad.q0000744000176200001440000000064212266061205015116 0ustar liggesuserswith(aircraft, { y <- log(Span[Period==3]) n <- length(y) plot(sort(y),(1:n)/n, type="S", xlab="y", ylab="Empirical distribution function") h <- 0.3 x <- 3.1 x1 <- x - h x2 <- x + h y1 <- length(y[y2000 & Cal.age<3000] rc.age <- Rc.age[Cal.age>2000 & Cal.age<3000] par(mfrow=c(2,2)) add.window <- function(x, y, h, x.eval) { polygon(rep(c(x.eval - 2 * h, x.eval + 2 * h), rep(2,2)), c(range(y), rev(range(y))), col = "cyan", border = FALSE) lines(rep(x.eval, 2), range(y), lty = 2) points(x, y) xseq <- seq(x.eval - 3 * h, x.eval + 3 * h, length = 20) kernel <- dnorm(xseq, x.eval, h) kernel <- min(y) + 120 * kernel / max(kernel) lines(xseq, kernel, lty = 2) } x.eval <- 2670 hvec <- c(30, 100, 8, 100) for (i in 1:4) { plot(cal.age, rc.age, xlab = "Calendar age", ylab = "Radiocarbon age") if (i == 2) { sm.regression(cal.age, rc.age, h = 100, poly.index = 0, lty = 2, add = TRUE)} else { add.window(cal.age, rc.age, hvec[i], x.eval)} sm.regression(cal.age, rc.age, h = hvec[i], add = TRUE) } par(mfrow=c(1,1)) }) sm/inst/scripts/speed.q0000744000176200001440000000016412266061215014622 0ustar liggesuserswith(aircraft, { par(mfrow=c(1,2)) hist(Speed, ylab="Frequency") sm.density(Speed, yht=0.0016) par(mfrow=c(1,1)) }) sm/inst/scripts/dogs.q0000744000176200001440000000154512266061204014460 0ustar liggesuserswith(dogs, { Time <- c(1,3,5,7,9,11,13) plot(c(1,13), c(3,6), type="n", xlab="time", ylab="potassium") G <- as.numeric(dogs$Group) for(i in 1:nrow(dogs)) lines(Time,as.matrix(dogs[i,2:8]),lty=G[i],col=G[i]) title("Coronary sinus potassium") cat("\nChoose two groups to compare (Group 1=control)\n") G <- ask("First group (1-4)") id <- (dogs$Group==G) Title<- paste(c("Coronary sinus potassium - groups", as.character(G))) gr1 <- as.matrix(dogs[id,2:8]) plot(c(1,13), c(3,6),xlab="time", ylab="potassium", type="n") sm1 <- sm.rm(Time, gr1, display="se", add=TRUE) points(Time, sm1$aux$mean, pch=G) G <- ask("Second group (1-4)") id <- (dogs$Group==G) gr2 <- as.matrix(dogs[id,2:8]) sm2 <- sm.rm(Time, gr2, display="se", add=TRUE) points(Time,sm2$aux$mean,pch=G) Title <- paste(c(Title, "and", as.character(G)), collapse=" ") title(Title) }) sm/inst/scripts/lc_dens.q0000744000176200001440000000106512266061206015132 0ustar liggesuserswith(lcancer, { cases <- cbind(Easting, Northing)[Cancer == 1,]/10000 controls <- cbind(Easting, Northing)[Cancer == 2,]/10000 xlim <- range(Easting/10000) ylim <- range(Northing/10000) par(mfrow=c(2,2)) plot(Easting/10000, Northing/10000, type = "n") points(cases) points(35.45, 41.3, pch = 6) plot(Easting/10000, Northing/10000, type = "n") points(controls) points(35.45, 41.3, pch = 6) h <- c(0.12,0.12) sm.density(cases, h = h, xlim=xlim, ylim=ylim, zlim=c(0,2)) sm.density(controls, h = h, xlim=xlim, ylim=ylim, zlim=c(0,2)) par(mfrow=c(1,1)) }) sm/inst/scripts/lynx.q0000744000176200001440000000041012266061206014506 0ustar liggesusersts.plot(lynx) title("Canadian lynx trapping (1821-1934)") pause() cat("Data are now log-transformed\n") log.lynx <- log(lynx) sm.ts.pdf(log.lynx, lags=4:5) pause() sm.autoregression(log.lynx, maxlag=5, se=TRUE) pause() sm.autoregression(log.lynx, lags=cbind(4,5)) sm/inst/scripts/trw_lf.q0000744000176200001440000000053612266061216015023 0ustar liggesuserswith(trawl, { ind <- (Year == 0 & Zone == 1) score <- Score1[ind] longitude <- Longitude[ind] par(mfrow=c(1,2)) plot(longitude, score, pch="o") ls.fit <- lm(score ~ longitude) abline(ls.fit$coefficients, lty=3) plot(longitude, residuals(ls.fit), pch="o") abline(0,0,lty=3) par(mfrow=c(1,1)) print(summary(lm(score ~ poly(longitude,2)))) }) sm/inst/scripts/smackgam.q0000744000176200001440000000140012266061213015275 0ustar liggesuserslibrary(gam) Presence <- smacker$Density Presence[Presence > 0] <- 1 position <- cbind(Latitude=smacker$smack.lat, Longitude=smacker$smack.long) Log.depth <- log(smacker$smack.depth) temperature <- smacker$Temperature model1 <- gam(Presence ~ lo(position) + lo(Log.depth) + lo(temperature), family = binomial) model2 <- gam(Presence ~ lo(position) + lo(temperature), family = binomial) model3 <- gam(Presence ~ lo(position) + lo(Log.depth), family = binomial) model4 <- gam(Presence ~ lo(Log.depth) + lo(temperature), family = binomial) print(anova(model1)) par(mfrow=c(2,2)) sm.regression(position, Presence, h=c(0.3, 0.3), poly.index=0, zlim = c(0,0.8)) plot(model1, se = TRUE) par(mfrow=c(1,1)) sm/inst/scripts/trout1.q0000744000176200001440000000050612266061216014761 0ustar liggesuserswith(trout, { # first, select treatment group 1 ("water hardening") # and pool data with equal concentration conc <- N <- dead <-rep(0,6) for(i in 1:6){ conc[i] <- Concentr[i*4] for(j in 1:4){ N[i] <- N[i] + Trouts[(i-1)*4+j] dead[i] <- dead[i] + Dead[(i-1)*4+j] }} sm.binomial(log(conc), dead, N, 0.5) }) sm/inst/scripts/trw_nebd.q0000744000176200001440000000041612266061217015330 0ustar liggesuserswith(trawl, { ind <- (Year == 1 & Zone == 1 & !is.na(Depth)) score1 <- Score1[ind] depth <- Depth[ind] par(mfrow=c(1,2)) sm.regression(depth, score1, h = 5, model = "no.effect") sm.regression(depth, score1, h = 10, model = "no.effect") par(mfrow=c(1,1)) }) sm/inst/scripts/lc_comp.q0000744000176200001440000000226312266061206015140 0ustar liggesuserswith(lcancer, { cases <- cbind(Easting/10000, Northing/10000)[Cancer == 1,] controls <- cbind(Easting/10000, Northing/10000)[Cancer == 2,] xlim <- range(Easting/10000) ylim <- range(Northing/10000) h <- c(0.05,0.05) cases.sm <- sm.density(cases, h = h, xlim = xlim, ylim = ylim, display = "none") controls.sm <- sm.density(controls, h = h, xlim = xlim, ylim = ylim, display = "none") diff.obs <- sum((cases.sm$estimate - controls.sm$estimate)^2) cat("Observed value:",diff.obs, "\n") nboot <- 20 p <- 0 ncase <- nrow(cases) ncontrol <- nrow(controls) for (i in 1:nboot) { ind.control <- sample((1:ncontrol), ncontrol, replace=TRUE) ind.case <- sample((1:ncontrol), ncase, replace=TRUE) controls.star <- controls[ind.control,] cases.star <- controls[ind.case,] cases.sm.star <- sm.density(cases.star, h = h, xlim=xlim, ylim = ylim, display = "none") controls.sm.star <- sm.density(controls.star, h = h, xlim=xlim, ylim = ylim, display = "none") diff.star <- sum((cases.sm.star$estimate - controls.sm.star$estimate)^2) if (diff.star > diff.obs) p <- p + 1 cat(i, " ") } p <- p/nboot cat("\np-value = ", p, "\n") }) sm/inst/scripts/air_hcv.q0000744000176200001440000000044412266061202015132 0ustar liggesuserswith(aircraft, { y <- log(Span)[Period==3] par(mfrow=c(1,2)) sm.density(y, h = hcv(y), xlab="Log span", lty=3, yht=1.4) sm.density(y, h = hsj(y), add = TRUE) with(airpc, { pc3 <- cbind(Comp.1, Comp.2)[Period==3,] sm.density(pc3, h = hcv(pc3), display = "slice") }) par(mfrow=c(1,1)) }) sm/inst/scripts/birth2.q0000744000176200001440000000042712266061204014714 0ustar liggesuserswith(birth, { Low0 <- Low[Smoke=="N"]; Lwt0 <- Lwt[Smoke=="N"] Low1 <- Low[Smoke=="S"]; Lwt1 <- Lwt[Smoke=="S"] sm.binomial(Lwt0, Low0, h=20, pch="N", col=2, xlab="Mother weight", ylab="Prob{Low}", xlim=c(80,260)) sm.binomial(Lwt1, Low1, h=20, pch="S", col=3, add=TRUE) }) sm/inst/scripts/trw_nesg.q0000744000176200001440000000043712266061217015357 0ustar liggesusersind <- (trawl$Year == 1 & trawl$Zone == 1 & !is.na(trawl$Depth)) score1 <- trawl$Score1[ind] depth <- trawl$Depth[ind] summary(lm(score1 ~ depth)) sig.trace(sm.regression(depth, score1, model = "no.effect", display="none"), hvec = seq(5, 20, length = 10)) sm/inst/scripts/trwlplot.q0000744000176200001440000000100312266061220015376 0ustar liggesuserswith(trawl, { par(mfrow = c(2,2)) plot(Longitude, Latitude, type = "n") points(Longitude[Zone == 1], Latitude[Zone == 1]) text(Longitude[Zone == 0], Latitude[Zone == 0], "o") Zone93 <- (Year == 1 & Zone == 1) Position <- cbind(Longitude - 143, Latitude) sm.regression(Latitude[Zone93], Score1[Zone93], h = 0.1) sm.regression(Position[Zone93,], Score1[Zone93], h= c(0.1, 0.1), eye.mult = c(8,-6,5), xlab="Longitude - 143") sm.regression(Longitude[Zone93], Score1[Zone93], h = 0.1) par(mfrow = c(1,1)) }) sm/inst/scripts/noeff.q0000744000176200001440000000073112266061210014612 0ustar liggesuserswith(trawl, { ind <- (Year == 1 & Zone == 1 & !is.na(Depth)) y <- Score1[ind] x <- Depth[ind] model <- sm.regression(x, y, h = 5, display = "none", eval.points = x) rss.obs <- sum((y - model$estimate)^2) p <- 0 for (i in 1:100) { z <- sample(y) model <- sm.regression(x, z, h = 5, display = "none", eval.points = x) rss <- sum((z - model$estimate)^2) if (rss < rss.obs) p <- p + 1 cat(i," ") } cat("\nEmpirical p-value: ", round(p/100, 2),"\n") }) sm/inst/scripts/sp_hist.q0000744000176200001440000000023412266061214015170 0ustar liggesuserswith(aircraft, { y <- log(Span[Period==3]) par(mfrow=c(1,2)) hist(y, xlab="Log Span", ylab="Frequency") sm.density(y, xlab="Log Span") par(mfrow=c(1,1)) }) sm/inst/scripts/birth1.q0000744000176200001440000000040012266061203014701 0ustar liggesusers with(birth, { Low1<-Low[Smoke=="S"]; Lwt1<-Lwt[Smoke=="S"] Lj <- jitter(Low1, amount = 0) plot(Lwt1,Lj,type="n",xlab="Mother weight",ylab="prob(Low)") text(Lwt1,Lj,"S",col=3) abline(0,0, lty=3) abline(1,0, lty=3) sm.regression(Lwt1,Low1,h=20,add=TRUE) }) sm/inst/scripts/mag_scat.q0000744000176200001440000000023412266061207015277 0ustar liggesuserswith(magrem, { par(mfrow=c(1,2)) sm.sphere(maglat, maglong, theta = 60, phi = 10) sm.sphere(maglat, maglong, theta = 240, phi = -10) par(mfrow=c(1,1)) }) sm/inst/scripts/sp_comp.q0000744000176200001440000000040412266061214015156 0ustar liggesuserswith(aircraft, { y1 <- log(Span)[Period==1] y2 <- log(Span)[Period==2] y3 <- log(Span)[Period==3] sm.density(y3, xlab="Log span") sm.density(y2, add=TRUE, lty=2) sm.density(y1, add=TRUE, lty=3) legend(3.5, 1, c("Period 1", "Period 2", "Period 3"), lty=3:1) }) sm/inst/scripts/trwlgam1.q0000744000176200001440000000146612266061220015262 0ustar liggesuserslibrary(gam) ind <- (trawl$Year == 0 & trawl$Zone == 1) score1 <- trawl$Score1[ind] latitude <- trawl$Latitude[ind] longitude <- trawl$Longitude[ind] - 143 position <- cbind(latitude, longitude = -longitude) par(mfrow = c(2,2)) par(cex=0.7) model1 <- sm.regression(position, score1, h = c(0.1, 0.1)) model2 <- gam(score1 ~ lo(latitude) + lo(longitude)) ex <- model1$eval.points[,1] ey <- model1$eval.points[,2] ngrid <- length(ex) grid <- data.frame(cbind(latitude = rep(ex, ngrid), longitude = rep(-ey, rep(ngrid, ngrid)))) surface <- predict(model2, grid) mask <- model1$estimate mask[!is.na(mask)] <- 1 persp(ex, ey, matrix(surface * mask, ncol = ngrid), xlab = "latitude", ylab = "longitude") summary(model2) plot(model2, se=TRUE) par(cex=1) par(mfrow = c(1,1)) sm/inst/scripts/air_imag.q0000744000176200001440000000024012266061203015262 0ustar liggesuserswith(airpc, { pc3 <- cbind(Comp.1, Comp.2)[Period==3,] par(mfrow=c(1,2)) sm.density(pc3, display="image") sm.density(pc3, display="slice") par(mfrow=c(1,1)) }) sm/inst/scripts/rc_plot.q0000744000176200001440000000042612266061212015162 0ustar liggesuserswith(radioc, { par(mfrow=c(1,2)) plot(Cal.age, Rc.age) abline(0,1,lty=2) ind <- (Cal.age>2000 & Cal.age<3000) cal.age <- Cal.age[ind] rc.age <- Rc.age[ind] sm.regression(cal.age, rc.age, h = 30) sm.regression(cal.age, rc.age, h = 1000, lty = 2, add=TRUE) par(mfrow=c(1,1)) }) sm/inst/scripts/stananim.q0000744000176200001440000000113612266061215015334 0ustar liggesuserswith(stanford, { x <- Age y <- Log.time status <- Status st.code <- 1 hseq <- seq(5, 10, by = 1) model <- sm.survival(x, y, status, h = hseq[1]) estimate.old <- model$estimate for (i in (2:length(hseq))) { model <- sm.survival(x, y, status, h = hseq[i], display = "none") estimate.new <- model$estimate lines(model$eval.points, estimate.old, col = 0) lines(model$eval.points, estimate.new) text(x[status == st.code], y[status == st.code], "x") text(x[status != st.code], y[status != st.code], "o") estimate.old <- estimate.new } }) sm/inst/scripts/sp_test2.q0000744000176200001440000000063312266061214015265 0ustar liggesuserswith(aircraft, { y <- log(Span) for (i in 1:3) { yi <- y[Period == i] med <- median(yi) sc <- diff(quantile(yi, c(0.25, 0.75))) / 1.349 y[Period == i] <- (yi - med) / sc } h <- exp(mean(log(tapply(y, Period, FUN = "hnorm")))) sm.density.compare(y, Period, h = h, lty = c(3,2,1), xlab = "Standardised scale") legend(1.5, 0.55, c("Period 1","Period 2","Period 3"), lty=c(3,2,1)) }) sm/inst/scripts/air_cont.q0000744000176200001440000000046712266061202015322 0ustar liggesuserswith(airpc, { pc <- cbind(Comp.1, Comp.2) pc1 <- pc[Period==1,] pc2 <- pc[Period==2,] pc3 <- pc[Period==3,] plot(pc, type="n") sm.density(pc1, display="slice", props=75, add=TRUE, lty=3) sm.density(pc2, display="slice", props=75, add=TRUE, lty=2) sm.density(pc3, display="slice", props=75, add=TRUE, lty=1) }) sm/inst/scripts/speedvar.q0000744000176200001440000000034012266061215015327 0ustar liggesuserswith(aircraft, { hw <- nnbr(Speed, 30) hw <- hw/exp(mean(log(hw))) par(mfrow=c(1,2)) sm.density(Speed, yht=0.0022, positive=TRUE) sm.density(Speed, yht=0.0022, xlim=c(-700,4000), h.weights=hw, nbins=0) par(mfrow=c(1,1)) }) sm/inst/scripts/follicle.q0000744000176200001440000000020612266061205015307 0ustar liggesuserswith(follicle, { sm.regression(Age, log(Count), h = 4, lty = 2) model <- loess(log(Count) ~ Age) lines(Age, model$fitted, col = 6) }) sm/inst/scripts/sp_build.q0000744000176200001440000000150412266061214015321 0ustar liggesuserswith(aircraft, { log.span.3 <- log(Span[Period==3]) par(mfrow=c(1,2)) subsamp <- log.span.3[1+seq(1,length(log.span.3),20)] hist.info <- hist(subsamp, plot=FALSE) freq <- hist.info$counts nfreq <- length(freq) hist(subsamp, xlab="Log Span", ylab="Frequency", xlim=c(1,5), col="blue") for (i in 1:nfreq) { if (freq[i] > 1) { left <- rep(hist.info$breaks[i],freq[i]-1) right <- rep(hist.info$breaks[i+1],freq[i]-1) segments(left,1:(freq[i]-1),right,1:(freq[i]-1),col=0) } } h <- 0.25 nsub <- length(subsamp) sm.density(subsamp, h=h, xlab="Log span", xlim=c(1,5)) for (i in 1:nsub) { points(subsamp[i],0) temp <- sm.density(subsamp[i], h=h, display="none", xlim=subsamp[i]+c(-1,1)*3*h) lines(temp$eval.points, temp$estimate/nsub, lty=2) } par(mfrow=c(1,1)) }) sm/inst/scripts/trwlgam2.q0000744000176200001440000000041212266061220015251 0ustar liggesuserslibrary(gam) with(trawl, { ind <- (Year == 0 & Zone == 1) score1 <- Score1[ind] latitude <- Latitude[ind] longitude <- Longitude[ind] print(gam(score1 ~ lo(longitude) + lo(latitude))) print(gam(score1 ~ lo(longitude))) print(gam(score1 ~ lo(latitude))) }) sm/inst/scripts/bin_use.q0000744000176200001440000000165212266061203015146 0ustar liggesusers# example of use of binning cat("Examples of use of function binning()\n") # 1-d example x <- rnorm(1000) xb <-binning(x) h <-hnorm(x) sm.density(xb$x, h=h, weights=xb$x.freq, ylim=c(0,0.5/sqrt(var(x)))) pause() # 2-d example x <-cbind(x,x+rnorm(1000)) xb <-binning(x) h <-hnorm(x) par(mfrow=c(1,2)) sm.density(xb$x, h=h, weights=xb$x.freq) sm.density(xb$x, h=h, weights=xb$x.freq, display="slice") par(mfrow=c(1,1)) pause() # and another with(airpc, { pc3 <- cbind(Comp.1, Comp.2)[Period==3,] pc.bin <- binning(pc3) par(mfrow=c(1,2)) sm.density(pc.bin$x, h = hnorm(pc3), display = "image", ngrid=100, weights=pc.bin$x.freq) plot(pc3, xlab="First Principal Component", ylab="Second Principal Component") cat("this time original data rather than grid data are plotted\n") sm.density(pc.bin$x, h = hnorm(pc3), display = "slice", ngrid=30, add=TRUE, weights=pc.bin$x.freq) par(mfrow=c(1,1)) }) sm/inst/scripts/te_norm.q0000744000176200001440000000043512266061216015167 0ustar liggesuserswith(tephra, { logit <- log(Al2O3/(100-Al2O3)) par(mfrow=c(1,2)) qqnorm(logit) qqline(logit) cat("ISE statistic:", nise(logit),"\n") sm <- sm.density(logit) y <- sm$eval.points sd <- sqrt(hnorm(logit)^2 + var(logit)) lines(y, dnorm(y, mean(logit), sd), lty = 3) par(mfrow=c(1,1)) }) sm/inst/scripts/mackplot.q0000744000176200001440000000056712266061207015344 0ustar liggesuserswith(mackerel, { Position <- cbind(Latitude=mack.lat, Longitude=mack.long) depth <- mack.depth par(mfrow=c(2,2)) sm.regression(Position, log(Density), h=c(0.3, 0.3), hull=FALSE) sm.regression(Position, log(depth), h=c(0.3, 0.3), hull=FALSE) sm.regression(log(depth), log(Density), h = 0.2) sm.regression(Temperature, log(Density), h = 3) par(mfrow = c(1,1)) }) sm/inst/scripts/mackgam.q0000744000176200001440000000077313236345667015146 0ustar liggesuserslibrary(gam) model1 <- gam(log(Density) ~ lo(log(mack.depth)) + lo(Temperature) + lo(mack.lat, mack.long), data = mackerel) print(model1) print(gam(log(Density) ~ lo(Temperature) + lo(mack.lat, mack.long), data = mackerel)) print(gam(log(Density) ~ lo(log(mack.depth)) + lo(mack.lat, mack.long), data = mackerel)) print(gam(log(Density) ~ lo(log(mack.depth)) + lo(Temperature), data = mackerel)) par(mfrow=c(2,2)) plot(model1, se = TRUE) par(mfrow=c(1,1)) sm/inst/scripts/trout2.q0000744000176200001440000000037112266061216014762 0ustar liggesuserswith(trout, { conc <- N <- dead <-rep(0,6) for(i in 1:6){ conc[i] <- Concentr[i*4] for(j in 1:4){ N[i] <- N[i] + Trouts[(i-1)*4+j] dead[i] <- dead[i] + Dead[(i-1)*4+j] }} sm.binomial.bootstrap(log(conc), dead, N, 0.5, nboot=50) }) sm/inst/scripts/sin_cv.q0000744000176200001440000000040012266061213014772 0ustar liggesusersn <- 50 x <- seq(0, 1, length = n) m <- sin(2 * pi * x) h <- 0.05 sigma <- 0.2 y <- rnorm(n, m, sigma) par(mfrow=c(1,2)) h.cv <- hcv(x, y, display="line", ngrid=32) plot(x, y) lines(x, m) sm.regression(x, y, h=hcv(x, y), add=TRUE, lty=2) par(mfrow=c(1,1)) sm/inst/scripts/trwlboot.q0000744000176200001440000000065412266061217015404 0ustar liggesuserswith(trawl, { ind <- (Year == 1 & Zone == 1 & !is.na(Depth)) par(mfrow=c(1,2)) sm.regression(Depth[ind], Score1[ind], h = 5, xlab="Depth", ylab="Score1") plot(Depth[ind], Score1[ind], type = "n", xlab="Depth", ylab="Score1") for (i in 1:100) sm.regression(Depth[ind], sample(Score1[ind]), h = 5, col = 6, lty = 2, add = TRUE) sm.regression(Depth[ind], Score1[ind], h = 5, add = TRUE) par(mfrow=c(1,1)) }) sm/inst/scripts/geys3d.q0000744000176200001440000000046712266061205014725 0ustar liggesusers# This script may take a long time to execute on # some computers. The default grid size for # evaluation of the estimate is 12. This can be # increased by adding an argument such as "ngrid=20" # to sm.density. with(geys3d, { par(mfrow=c(1,2)) plot(Waiting, Duration) sm.density(geys3d) par(mfrow=c(1,1)) }) sm/inst/scripts/te_band.q0000744000176200001440000000025712266061215015121 0ustar liggesuserswith(tephra, { logit <- log(Al2O3/(100-Al2O3)) par(mfrow=c(1,2)) sm.density(logit, model = "Normal") sm.density(logit, h = hsj(logit), model = "Normal") par(mfrow=c(1,1)) }) sm/inst/scripts/stanplot.q0000744000176200001440000000034012266061215015362 0ustar liggesuserswith(stanford, { sm.survival(Age, Log.time, Status, h = 7) sm.survival(Age, Log.time, Status, h = 7, p = 0.25, add = TRUE, lty = 2) sm.survival(Age, Log.time, Status, h = 7, p = 0.10, add = TRUE, lty = 3) }) sm/inst/scripts/air_dens.q0000744000176200001440000000040112266061202015274 0ustar liggesuserswith(airpc, { pc3 <- cbind(Comp.1, Comp.2)[Period==3,] par(mfrow=c(2,2)) par(cex=0.6) plot(pc3) sm.density(pc3, zlim=c(0,0.08)) sm.density(pc3, hmult=1/2, zlim=c(0,0.15)) sm.density(pc3, hmult=2, zlim=c(0,0.04)) par(cex=1) par(mfrow=c(1,1)) }) sm/inst/scripts/rc_boot.q0000744000176200001440000000063512266061212015151 0ustar liggesuserswith(radioc, { x <- Cal.age[Cal.age>2000 & Cal.age<3000] y <- Rc.age[Cal.age>2000 & Cal.age<3000] plot(x, y, xlab="Calendar.age", ylab="Radiocarbon.age", type="n") model <- sm.regression(x, y, h=30, eval.points=x, display="none") mhat <- model$estimate r <- y - mhat r <- r - mean(r) for (i in 1:50) sm.regression(x, mhat + sample(r, replace=TRUE), h=30, add=TRUE, col=6, lty=2) }) sm/inst/scripts/muscle.q0000744000176200001440000000034112266061210015002 0ustar liggesuserswith(muscle, { TypeI <- TypeI.P+TypeI.R+TypeI.B sm.poisson(log(TypeI), TypeII, 0.25, display="se") pm <- glm(TypeII ~ log(TypeI), family=poisson) lines(sort(log(TypeI)), fitted(pm)[order(log(TypeI))], col=4, lty=6) }) sm/inst/scripts/citrate.q0000744000176200001440000000056512266061204015160 0ustar liggesuserswith(citrate, { Citrate<-as.matrix(citrate) nSubj<-dim(Citrate)[1] nTime<-dim(Citrate)[2] Time<-(1:nTime) plot(c(min(Time),max(Time)), c(min(Citrate),max(Citrate)), type="n", xlab="time", ylab="Citrate") for(i in 1:nSubj) lines(Time,as.vector(Citrate[i,])) pause() a <- sm.rm(y=Citrate, display.rice=TRUE) sm.regression(Time,a$aux$mean,h=1.2,hmult=1,add=TRUE,lty=3) }) sm/inst/scripts/bissell2.q0000744000176200001440000000062413326300436015241 0ustar liggesusersplot(bissell$Length, bissell$Flaws, xlim=c(0,1000), pch="o") beta <- sum(bissell$Flaws)/sum(bissell$Length) x <- seq(0, 1000, length=50) lines(x, beta*x, lty=3) h <- 100 W<-sm.weight(bissell$Length, x, h, options=list(poly.index=0)) sm.beta <- (W %*% bissell$Flaws)/(W %*% bissell$Length) lines(x,sm.beta*x) lines(x,sm.beta*x+2*sqrt(sm.beta*x),lty=3) lines(x,pmax(0,sm.beta*x-2*sqrt(sm.beta*x)),lty=3) sm/inst/scripts/lc_rr.q0000744000176200001440000000257212266061206014630 0ustar liggesuserswith(lcancer, { cases <- cbind(Easting, Northing)[Cancer == 1,]/10000 controls <- cbind(Easting, Northing)[Cancer == 2,]/10000 xlim <- range(Easting/10000) ylim <- range(Northing/10000) par(mfrow=c(2,2)) h <- c(0.12,0.12) cases.sm <- sm.density(cases, h = h, xlim = xlim, ylim = ylim, display = "none") controls.sm <- sm.density(controls, h = h, xlim = xlim, ylim = ylim, display = "none") delta <- 0.1 ratio <- (cases.sm$estimate + delta)/(controls.sm$estimate + delta) xgrid <- cases.sm$eval.points[,1] ygrid <- cases.sm$eval.points[,2] rr <- ratio/(1+ratio) par(cex=0.8) persp(xgrid, ygrid, rr, zlim=c(0,0.8), theta = -30, phi = 40, d = 4, expand = 0.7, xlab="Easting", ylab="Northing", zlab="Risk") persp(xgrid, ygrid, log(rr), zlim=c(-1.5,0), theta = -30, phi = 40, d = 4, expand = 0.7, xlab="Easting", ylab="Northing", zlab="Log risk") diff.sm <- sqrt(cases.sm$estimate) - sqrt(controls.sm$estimate) se <- sqrt(cases.sm$se^2 + controls.sm$se^2) persp(xgrid, ygrid, diff.sm/se, theta = -30, phi = 40, d = 4, expand = 0.7, xlab="Easting", ylab="Northing", zlab="Std. difference") plot(xgrid, ygrid, type = "n", xlab="Easting", ylab="Northing") contour(xgrid, ygrid, diff.sm/se, levels = c(-4, -2), col = 2, add = TRUE) contour(xgrid, ygrid, diff.sm/se, levels = c( 2, 4), col = 6, add = TRUE) par(cex=1) par(mfrow=c(1,1)) }) sm/inst/scripts/rc_vband.q0000744000176200001440000000032212266061213015272 0ustar liggesuserswith(radioc, { Calendar.age <- Cal.age[Cal.age>2000 & Cal.age<3000] Radiocarbon.age <- Rc.age[Cal.age>2000 & Cal.age<3000] sm.regression(Calendar.age, Radiocarbon.age, h = 30, display = "se") }) sm/inst/scripts/trwlcomp.q0000744000176200001440000000024212266061220015362 0ustar liggesuserswith(trawl, { ind <- (Year == 0) longitude <- Longitude[ind] zone <- Zone[ind] score1 <- Score1[ind] sm.ancova(longitude, score1, zone, h = 0.1) }) sm/inst/scripts/sp_alter.q0000744000176200001440000000025212266061213015327 0ustar liggesuserswith(aircraft, { y <- log(Span[Period==3]) par(mfrow=c(1,2)) sm.density(y, hmult = 1/3, xlab="Log span") sm.density(y, hmult = 2, xlab="Log span") par(mfrow=c(1,1)) }) sm/inst/scripts/trw_lfsg.q0000744000176200001440000000060212266061217015350 0ustar liggesusersind <- (trawl$Year == 0 & trawl$Zone == 1) score <- trawl$Score1[ind] longitude <- trawl$Longitude[ind] par(mfrow=c(1,2)) sig.trace(sm.regression(longitude, score, model = "linear", display="none"), hvec = seq(0.02, 0.2, length = 10)) sm.regression(longitude, score, h = 0.1, model = "linear") par(mfrow=c(1,1)) print(summary(lm(score ~ poly(longitude,2)))) sm/inst/scripts/air_inds.q0000744000176200001440000000200512266061203015303 0ustar liggesuserswith(aircraft, { Speed3 <- log(Speed[Period==3]) Span3 <- log(Span[Period==3]) air3 <- cbind(Span3, Speed3) result.12 <- sm.density(air3, eval.points = air3, display = "none") result.1 <- sm.density(Span3, eval.points = Span3, display = "none") result.2 <- sm.density(Speed3, eval.points = Speed3, display = "none") tobs <- mean(log(result.12$estimate / (result.1$estimate * result.2$estimate))) cat("Observed value: ", round(tobs,5), "\n") nsim <- 200 simval <- rep(0,nsim) p <- 0 for (i in 1:nsim) { samp <- cbind(y1 = Span3, y2 = sample(Speed3)) result.12 <- sm.density(samp, eval.points = samp, display = "none") result.1 <- sm.density(samp[,1], eval.points = samp[,1], display = "none") result.2 <- sm.density(samp[,2], eval.points = samp[,2], display = "none") simval[i] <- mean(log(result.12$estimate / (result.1$estimate * result.2$estimate))) if (simval[i] > tobs) p <- p+1 cat(i, " ") } cat("Empirical significance:", round(p/nsim,3), "\n") }) sm/inst/scripts/bissell1.q0000744000176200001440000000050613326300351015233 0ustar liggesusers# full script for Bissell data # sections of it generate individual figures # parametric fit plot(bissell$Length, bissell$Flaws, xlim=c(0,1000), pch="o") beta <- sum(bissell$Flaws)/sum(bissell$Length) x <- seq(0, 1000, length=50) bx <- beta*x lines(x, bx) lines(x,bx+2*sqrt(bx),lty=3) lines(x,pmax(0,bx-2*sqrt(bx)),lty=3) sm/inst/scripts/trwlcmp2.q0000744000176200001440000000274512266061217015305 0ustar liggesuserswith(trawl, { ind <- (Zone == 1) score1 <- Score1[ind] latitude <- Latitude[ind] longitude <- Longitude[ind] - 140 position <- cbind(longitude, latitude) year <- Year[ind] par(mfrow=c(2,2)) par(cex=0.7) sm.regression(position[year == 0,], score1[year == 0], h= c(0.1, 0.1), eye.mult = c(8,-6,5), zlab="Score.92") sm.regression(position[year == 1,], score1[year == 1], zlab="Score.93", h= c(0.1, 0.1), eye.mult = c(8,-6,5), zlim=c(-1,2)) sig <- 0 adf <- 0 for (i in c(0, 1)) { X <- position[year == i, ] y <- score1[year == i] W <- sm.weight2(X, X, h = c(0.1, 0.1)) est <- W %*% y adf <- adf + length(X[,1]) - sum(diag(W)) sig <- sig + sum((y - est)^2) } sig <- sqrt(sig / adf) ngrid <- 20 x1 <- seq(min(longitude), max(longitude), length=ngrid) x2 <- seq(min(latitude), max(latitude), length=ngrid) evp <- cbind(longitude=rep(x1, ngrid), latitude=rep(x2, rep(ngrid, ngrid))) se <- rep(0, nrow(evp)) for (i in c(0, 1)) { X <- position[year == i,] y <- score1[year == i] W <- sm.weight2(X, evp, h = c(0.1, 0.1)) if (i == 0) est0 <- as.vector(W %*% y) else est1 <- as.vector(W %*% y) se <- se + as.vector((W^2) %*% rep(1,nrow(X))) } se <- matrix(sig * sqrt(se), ncol = ngrid) sdiff <- as.vector((est0 - est1)/se) ind <- !is.na(sdiff) sm.regression(evp[ind,], sdiff[ind], h = c(0.01, 0.01), eye.mult = c(8,-6,5)) contour(x1, x2, (est1 - est0)/se, xlab = "longitude", ylab = "latitude") par(cex=1) par(mfrow = c(1,1)) }) sm/inst/scripts/te_hcvsj.q0000744000176200001440000000047512266061215015334 0ustar liggesuserswith(tephra, { logit <- log(Al2O3/(100-Al2O3)) par(mfrow=c(1,2)) h.cv <- hcv(logit, display = "line", ngrid = 32) n <- length(logit) sd <- sqrt(var(logit)) h <- seq(0.003, 0.054, length=32) lines(h, nmise(sd, n, h) - 5.5, lty = 3) sm.density(logit, h.cv) sm.density(logit, lty = 3, add = TRUE) par(mfrow=c(1,1)) }) sm/inst/scripts/trwlband.q0000744000176200001440000000026312266061217015341 0ustar liggesuserswith(trawl, { ind <- (Year == 0) longitude <- Longitude[ind] zone <- Zone[ind] score1 <- Score1[ind] sm.ancova(longitude, score1, zone, h = 0.1, model = "equal") }) sm/inst/scripts/sin_prop.q0000744000176200001440000000101512266061213015345 0ustar liggesusersn <- 100 x <- seq(0, 1, length = n) m <- sin(2 * pi * x) h <- 0.05 true.sigma <- 0.2 model <- sm.regression(x, m, h = h, display = "none") upper <- model$estimate + 2 * (true.sigma/model$sigma)*model$se lower <- model$estimate - 2 * (true.sigma/model$sigma)*model$se y <- rnorm(n, m, true.sigma) plot(range(x), range(y, upper, lower), type = "n", xlab="x", ylab="y") z <- model$eval.points polygon(c(z, rev(z)), c(upper, rev(lower)), border = FALSE, col = "cyan") lines(x, m) lines(z, model$estimate, lty = 3) points(x, y) sm/inst/scripts/smackplt.q0000744000176200001440000000054712266061213015343 0ustar liggesuserswith(smacker, { Presence <- Density Presence[Presence > 0] <- 1 Position <- cbind(Longitude=-smack.long, Latitude=smack.lat) Log.depth <- log(smack.depth) par(mfrow = c(1,2)) plot(Position, type="n") points(Position[Presence==1,], pch=16) points(Position[Presence==0,], pch=1) sm.binomial(Log.depth, Presence, h = 0.7, display = "se") par(mfrow = c(1,1)) }) sm/inst/scripts/onionbnd.q0000744000176200001440000000041512266061211015323 0ustar liggesusersdata(wonions, { par(mfrow=c(1,2)) sig.trace(sm.ancova(Density, log(Yield), Locality, model = "parallel",display = "none"), hvec = seq(5,30, length = 12)) sm.ancova(Density, log(Yield), Locality, h = 15, model = "parallel") par(mfrow=c(1,1)) }) sm/inst/scripts/mackmap.q0000744000176200001440000000020312266061206015125 0ustar liggesuserswith(mackerel, { plot(-mack.long, mack.lat, xlim=c(-15,1), ylim=c(45,59), xlab="Longitude", ylab="Latitude") britmap() }) sm/inst/scripts/index.doc0000744000176200001440000001272012266061205015136 0ustar liggesusers Index of scripts for the sm library ----------------------------------- To run a script called "sname", give the command sm.script(sname) Script Illus. Fig. Description ------ ------ ---- ----------- sp_hist 1.1 1.1 Density estimate from the aircraft span data sp_build 1.2 Construction of a density estimate sp_alter 1.2 1.3 Changing the bandwidth in a density estimate sp_comp 1.3 1.4 Comparing density estimates from the span data air_scat 1.5 Scatterplots of the airpc data air_dens 1.4 1.6 Density estimates from the airpc data air_imag 1.5 1.7 Imageplot and sliceplot from the airpc data air_cont 1.6 1.8 Sliceplots for the three groups of airpc data geys3d 1.7 1.9 Three-dimensional contour from the geyser data mag_scat 1.8 1.10 Spherical plot of the magnetic remanence data mag_dens 1.9 1.11 Density estimate from the magnetic remanence data speed 1.10 1.12 Density estimate from the aircraft speed data speedvar 1.11 1.13 Modified estimates from the aircraft speed data edfgrad 1.14 The gradient of an empirical distribution function te_var 2.1 2.1 Variable bandwidths with the tephra data air_band 2.2 2.2 A variability band from the aircraft span data te_hcvsj 2.3 2.3 Bandwidth choices for the tephra data air_hcv 2.4 2.4 Bandwidth choices for the aircraft data te_norm 2.5 2.5 Assessing normality for the tephra data te_band 2.6 2.6 Reference bands for normality with the tephra data air_ind 2.7 2.7 Exploring independence in the aircraft data air_inds Testing independence in the aircraft data air_boot 2.8 2.8 Bootstrapping density estimates rc_plot 3.1 3.1 Nonparametric regression with the radiocarbon data rc_alter 3.2 Changing the bandwidth in a nonparametric regression trwlplot 3.2 3.3 Nonparametric regressions with the reef data birth1 3.3 3.4 Standard smoothing with the birthweight data birth2 3.4 3.5 Local logistic regression with the birthweight data muscle 3.5 3.6 Nonparametric regression with the rat muscle data stanplot 3.6 3.7 Percentile curves for the Stanford data follicle 3.7 3.8 Variable bandwidths with the follicle data stananim Animation of percentile curves (Exercise 3.5) sin_prop 4.1 Mean and s.d. of a nonparametric regression rc_vband 4.1 4.2 A variability band with the radiocarbon data sin_cv 4.2 4.3 Cross-validation for bandwidth choice trwlboot 4.3 4.4 A reference band for no effect in the reef data noeff A bootstrap test of no effect in the reef data rc_boot 4.4 4.5 A bootstrap band from the radiocarbon data trw_nesg 5.1 5.1 A significance trace for no effect in the reef data trw_nebd 5.2 5.2 A reference band for no effect in the reef data trw_lf 5.3 A linear model for the reef data trw_lfsg 5.3 5.4 Assessing a linear model for the reef data mildew 5.4 5.5 Assessing spatial trend in the mildew data trees 5.5 5.6 Assessing linearity in the cherry trees data trout1 5.7 Local logistic regression with the trout data trout2 5.6 5.8 Assessing a logistic model for the trout data bissell1 5.9 A parametric prediction band from Bissell's data bissell2 5.7 5.10 A nonparametric prediction band from Bissell's data bissell3 5.11 A reference band for linearity with Bissell's data (execute bissell3 immediately after bissell2) sp_comp2 6.1 6.1 Comparing density estimates for the span data sp_test1 6.2 Assessing equality of densities for the span data sp_test2 6.2 6.3 Assessing equality for the standardised span data lc_dens 6.3 6.4 Density estimates from the laryngeal cancer data lc_rr 6.5 Comparing case and control cancer groups lc_comp A bootstrap test of equality for bivariate densities trwlcomp 6.4 6.6 Nonparametric regression curves for the reef data trwlband 6.5 6.7 A reference band for equality with the reef data trwlcmp2 6.8 Comparing regression surfaces from the reef data wormcomp 6.6 6.9 A reference band for equality with the worm data onionplt 6.7 6.10 Nonparametric regression curves for the onions data onionbnd 6.8 6.11 A reference band for parallelism geys_ts 7.1 7.1-3 Density estimates from the geyser data lynx 7.2 7.4 Analysis of the Canadian lynx data citrate 7.3 7.5-7 Analysis of plasma citrate concentration data dogs 7.4 7.8-9 Analysis of coronary sinus potassium data nyc 7.5 7.10-13 Analysis of New York city air temperature data trwlgam1 8.1 8.1 An additive model for the reef data trwlgam2 8.2 Model comparison for the reef data mackmap 8.3 8.2 Sampling points for the mackerel data mackplot 8.4 8.3 Plots of the mackerel data mackgam 8.5 8.4 Additive models for the mackerel data trwlgam3 8.6 8.5 Semiparametric and varying coefficient models smackplt 8.7 8.6 Plots for the Spanish survey data smackgam 8.8 8.7 An additive model for the Spanish survey data sm/inst/scripts/air_ind.q0000744000176200001440000000044212266061203015123 0ustar liggesuserswith(aircraft, { Speed3 <- log(Speed[Period==3]) Span3 <- log(Span[Period==3]) par(mfrow=c(1,2)) plot(Span3, Speed3, xlab = "Log Span", ylab = "Log Speed") air3 <- cbind(Span3, Speed3) sm.density(air3, display="slice", xlab= "Log Span", ylab = "Log Speed") par(mfrow=c(1,1)) }) sm/inst/scripts/mag_dens.q0000744000176200001440000000030212266061207015272 0ustar liggesuserswith(magrem, { par(mfrow=c(1,2)) sm.sphere(20, -30, theta=60, phi=10, sphim=TRUE, kappa=13.6) sm.sphere(maglat, maglong, theta=60, phi=10, sphim=TRUE, kappa=13.6) par(mfrow=c(1,1)) }) sm/inst/scripts/trees.q0000744000176200001440000000103412266061216014642 0ustar liggesusersdiameter <- trees$Girth volume <- trees$Volume height <- trees$Height h1 <- 1.5 h2 <- 4 par(mfrow=c(2,2)) par(cex=0.7) sm.regression(diameter, volume, h = h1, model = "linear") sm.regression(height, volume, h = h2, model = "linear") X <- cbind(diameter, height) sm.regression(X, volume, h = c(h1, h2), model = "linear", zlim = c(0,80)) X <- cbind(log(diameter), log(height)) colnames(X) <- c("log(Diameter)","log(Height)") sm.regression(X, log(volume), h = log(c(h1, h2)), model = "linear") par(cex=1) par(mfrow=c(1,1)) sm/inst/scripts/wormcomp.q0000744000176200001440000000124612266061221015364 0ustar liggesuserswith(worm, { Males <- sm.binomial(Age[Sex == 1], Infection[Sex == 1], h = 10, display = "none") agem <- Males$eval.points Females <- sm.binomial(Age[Sex == 2], Infection[Sex == 2], h = 10, eval.points = agem, display = "none") estm <- Males$estimate sem <- Males$se estf <- Females$estimate sef <- Females$se plot(Age, Infection, ylab = "Proportion infected", type= "n") av <- (log(estm/(1-estm)) + log(estf/(1-estf)))/2 se <- sqrt(sem^2 + sef^2) upper <- 1/(1+exp(-(av + se))) lower <- 1/(1+exp(-(av - se))) polygon(c(agem, rev(agem)), c(upper, rev(lower)), col = "cyan", border = FALSE) lines(agem, estm) lines(agem, estf, lty = 3) }) sm/inst/scripts/sp_test1.q0000744000176200001440000000105512266061214015263 0ustar liggesuserswith(aircraft, { par(mfrow = c(1,2)) h <- exp(mean(log(tapply(log(Span), Period, FUN = "hnorm")))) ind <- (Period!=3) sm.density.compare(log(Span)[ind], Period[ind], h = h, xlab = "log(Span)", model = "equal", test = FALSE, lty = c(3,2), ylim = c(0, 1.2)) legend(3.0, 1.1, c("Period 1", "Period 2"), lty = c(3,2)) ind <- (Period!=1) sm.density.compare(log(Span)[ind], Period[ind], h = h, xlab = "log(Span)", model = "equal", test = FALSE, lty = c(2,1), ylim = c(0, 1.2)) legend(3.0, 1.1, c("Period 2", "Period 3"), lty = c(2,1)) par(mfrow = c(1,1)) }) sm/inst/scripts/air_boot.q0000744000176200001440000000027712266061202015321 0ustar liggesuserswith(aircraft, { y <- log(Span)[Period==3] sm.density(y, xlab = "Log span") for (i in 1:20) sm.density(sample(y, replace=TRUE), col=6, add=TRUE) sm.density(y, xlab = "Log span", add=TRUE) }) sm/inst/scripts/trwlgam3.q0000744000176200001440000000174712266061220015266 0ustar liggesuserslibrary(gam) with(trawl, { ind <- (Year == 0 & Zone == 1) score1 <- Score1[ind] latitude <- Latitude[ind] longitude <- Longitude[ind] - 143 position <- cbind(latitude, longitude = -longitude) model1 <- gam(score1 ~ lo(longitude) + lo(latitude)) model2 <- gam(score1 ~ lo(longitude) + latitude) model3 <- gam(score1 ~ lo(longitude)) print(anova(model1)) print(anova(model2, model1)) print(anova(model3, model2)) par(mfrow = c(1,2)) model4 <- sm.regression(position, score1, h = c(0.1, 0.1), display = "none") ex <- model4$eval.points[,1] ey <- model4$eval.points[,2] ngrid <- length(ex) grid <- data.frame(cbind(latitude = rep(ex, ngrid), longitude = rep(-ey, rep(ngrid, ngrid)))) surface <- predict(model2, grid) mask <- model4$estimate mask[!is.na(mask)] <- 1 persp(ex, ey, matrix(surface * mask, ncol = ngrid), xlab = "Latitude", ylab = "Longitude") sm.regression(position, score1, h = c(100, 0.1)) par(mfrow=c(1,1)) }) sm/src/0000755000176200001440000000000013353155222011461 5ustar liggesuserssm/src/fgamma.c0000744000176200001440000000024313353155222013055 0ustar liggesusers#include /* to define fgamma, etc */ #include /* to define F77_NAME */ double F77_NAME(fgamma)(double *x) { return gammafn(*x); } sm/src/variogram.f900000744000176200001440000002723112266061263014001 0ustar liggesusers ! CONVENTIONS AND CHANGES: ! 1) All the periods have been changed by underscores ! 2) Instead using a derive type in fortran, fields of variable "vgm" has been split ! into two new arrays: "vgm_ibin" and "vgm_ipair" ! 3) The integers n,p,n_out has been introduced to define the array sizes ! B= size of gamma_hat ! n= size of vgm_pair ! p= size of rho_grid ! 4) The output of the original R-function is included as the last argument in the subrutine !------------------- hg function --------------------------------------- subroutine hg(rho,m,value) implicit none integer,parameter:: dp = KIND(1.0d0) integer,intent(in)::m real(kind=dp),intent(in)::rho(m) real(kind=dp)::value(m),a,b,cc,fn(m),fnold(m),facn integer::n real(kind=dp),external::fgamma ! Note: the Gamma function was included as intrinsic in Gfortran 4.3 a = 3.0_dp/4.0_dp b = 3.0_dp/4.0_dp cc = 1.0_dp/2.0_dp fn = fgamma(a)*fgamma(b)/fgamma(cc) facn = 1.0_dp n = 1 fnold = 0.1_dp do while (maxval(abs(fn-fnold)/fnold) > 0.0001_dp) facn = facn*n fnold = fn fn = fn + fgamma(a + n)*fgamma(b + n)*rho**n/(fgamma(cc+n)*facn) n = n + 1 end do value=fn*fgamma(cc)/(fgamma(a)*fgamma(b)) end subroutine hg !------------------- cor_sqrtabs function ------------------------------ subroutine cor_sqrtabs(rho,m,value) implicit none interface subroutine hg(rho,m,value) integer,parameter:: dp = KIND(1.0d0) integer,intent(in)::m real(kind=dp),intent(in)::rho(m) real(kind=dp)::value(m) end subroutine hg end interface integer,parameter:: dp = KIND(1.0d0) integer,intent(in)::m real(kind=dp),intent(in)::rho(m) real(kind=dp)::pi,value(m),val(m) real(kind=dp),external::fgamma pi=acos(-1.0_dp) ! Note: the Gamma function was included as intrinsi! in Gfortran 4.3 call hg(rho**2,m,val) value=fgamma(0.75_dp)**2*((1.0_dp-rho**2)*val-1.0_dp)/(sqrt(pi)-fgamma(0.75_dp)**2) end subroutine cor_sqrtabs !------------------- approx_linear function ------------------------------ subroutine approx_linear(x,y,n,v,m,yleft,yright,value) implicit none integer,parameter:: dp = KIND(1.0d0) integer,intent(in)::n,m integer::j,l real(kind=dp)::value(m) real(kind=dp),intent(in)::x(n),y(n),v(m),yleft,yright ! Loop in the components of v do j=1,m if(v(j)<=x(1)) then value(j)=yleft elseif(v(j)>=x(n)) then value(j)=yright else l=count(v(j)>x) value(j)=y(l)+(y(l+1)-y(l))*((v(j)-x(l))/(x(l+1)-x(l))) endif enddo end subroutine approx_linear subroutine cov_bin_fun(B,n,p,i,j,vgm_ibin,vgm_ipair,gamma_hat,mean_cv) implicit none interface subroutine approx_linear(x,y,n,v,m,yleft,yright,value) integer,parameter:: dp = KIND(1.0d0) integer,intent(in)::n,m real(kind=dp)::value(m) real(kind=dp),intent(in)::x(n),y(n),v(m),yleft,yright end subroutine approx_linear end interface interface subroutine cor_sqrtabs(rho,m,value) integer,parameter:: dp = KIND(1.0d0) integer,intent(in)::m real(kind=dp),intent(in)::rho(m) real(kind=dp)::value(m) end subroutine cor_sqrtabs end interface ! Simple precision ! integer,parameter:: dp = KIND(1.0) ! Double precision integer,parameter:: dp = KIND(1.0d0) integer,intent(in)::B,n,p,i,j integer,intent(in):: vgm_ipair(n,2),vgm_ibin(n) real(kind=dp),intent(in):: gamma_hat(B) real(kind=dp),intent(inout):: mean_cv integer::iter,k,l,m,m1,m2,m3,m4,n_bin_i,n_bin_j,nmax,ib,jb,n_out,unique_vgm_ibin(B) integer,dimension(:),allocatable::vrow1,vrow2,aux, & vind1,vind2,vind3,vind4,ind,ind1,ind2,ind3,ind4 integer,dimension(:,:),allocatable::aux1,aux2,mp,mp1,mp2, & mpair1(:,:),mpair2(:,:),mpair3(:,:),mpair4(:,:) real(kind=dp):: rho_grid(p+1),f_grid(p+1) real(kind=dp),allocatable::cr(:),cv(:),tmp(:),mpair1_hat(:),mpair2_hat(:), & mpair3_hat(:),mpair4_hat(:),auxcv(:) logical,allocatable::ind_bin_i(:),ind_bin_j(:), & mask(:),mask1(:),mask2(:),mask3(:),mask4(:) ! Memory allocation for ind_bin_i,ind_bin_j allocate(ind_bin_i(n),ind_bin_j(n)) ! ------------ rho evaluation ------------------------------------------ k=0; rho_grid(1:p) = (/((0.96_dp/(p-1))*(k-1),k=1,p)/) call cor_sqrtabs(rho_grid(1:p),p,f_grid(1:p)) rho_grid(p+1) = 1.0_dp f_grid(p+1) = 1.0_dp ! ------------- Sort computations -------------------------------------- ind_bin_i = (vgm_ibin == i) ind_bin_j = (vgm_ibin == j) n_bin_i = count(ind_bin_i) n_bin_j = count(ind_bin_j) ! Memory allocation for ind_bin_i,ind_bin_j n_out=n_bin_i*n_bin_j allocate(vrow1(n_out),vrow2(n_out)) ! Computing the values for vrow1,vrow2 do k=1,n_bin_j vrow1(1+(k-1)*n_bin_i:k*n_bin_i) = (/(l,l=1,n_bin_i)/) enddo do k=1,n_bin_j vrow2(1+(k-1)*n_bin_i:k*n_bin_i) = k enddo ! Memory allocation for mp1,mp2 and mp allocate(aux1(n_bin_i,2),aux2(n_bin_j,2), & mp1(n_out,2),mp2(n_out,2)) ! Construction mp1 aux1=vgm_ipair(pack((/(l,l=1,n)/),ind_bin_i),:) mp1=aux1(vrow1,:) ! Construction mp2 aux2=vgm_ipair(pack((/(l,l=1,n)/),ind_bin_j),:) mp2=aux2(vrow2,:) ! Construction mp allocate(mp(n_out,4)) mp(:,1:2)=mp1 mp(:,3:4)=mp2 ! Memory deallocation deallocate(aux1,aux2,vrow1,vrow2,mp1,mp2,ind_bin_i,ind_bin_j) !---------------- mpair* matrices: -------------------------------------- ! 1: pair(1) ! 2: pair(2) ! 3: pair(1)-pair(2) ! 4: index ! 5: gamma_hat, if different pairs --> go to mpair*_hat(:) ! Memory allocation allocate(mpair1(n_out,4),mpair2(n_out,4), & mpair3(n_out,4),mpair4(n_out,4)) ! Initialize to zero mpair1 = 0; mpair2 = 0; mpair3 = 0; mpair4 = 0 ! Compute the values for mpair*(:,1:3) mpair1(:,1)= merge(mp(:,2),mp(:,3),mp(:,2)<=mp(:,3)) mpair1(:,2)= merge(mp(:,2),mp(:,3),mp(:,2)>=mp(:,3)) mpair2(:,1)= merge(mp(:,1),mp(:,4),mp(:,1)<=mp(:,4)) mpair2(:,2)= merge(mp(:,1),mp(:,4),mp(:,1)>=mp(:,4)) mpair3(:,1)= merge(mp(:,1),mp(:,3),mp(:,1)<=mp(:,3)) mpair3(:,2)= merge(mp(:,1),mp(:,3),mp(:,1)>=mp(:,3)) mpair4(:,1)= merge(mp(:,2),mp(:,4),mp(:,2)<=mp(:,4)) mpair4(:,2)= merge(mp(:,2),mp(:,4),mp(:,2)>=mp(:,4)) mpair1(:,3)= mpair1(:,2)-mpair1(:,1) mpair2(:,3)= mpair2(:,2)-mpair2(:,1) mpair3(:,3)= mpair3(:,2)-mpair3(:,1) mpair4(:,3)= mpair4(:,2)-mpair4(:,1) ! Memory allocation for temporal arrays allocate(mask1(n_out),mask2(n_out),aux(n_out),mask3(n_out),mask4(n_out)) ! Compute the mask for the mpair* (the pairs outside the diagonal) mask1=(mpair1(:,3) /= 0) mask2=(mpair2(:,3) /= 0) mask3=(mpair3(:,3) /= 0) mask4=(mpair4(:,3) /= 0) m1=count(mask1) m2=count(mask2) m3=count(mask3) m4=count(mask4) ! Memory allocation for vind* allocate(vind1(m1),vind2(m2),vind3(m3),vind4(m4)) aux=(/(k,k=1,n_out)/) vind1= pack(aux,mask1) vind2= pack(aux,mask2) vind3= pack(aux,mask3) vind4= pack(aux,mask4) ! Memory deallocation deallocate(mask1,mask2,mask3,mask4) nmax= maxval(vgm_ipair) mpair1(vind1,4) = (mpair1(vind1,1)-1)*nmax- & ((mpair1(vind1,1)-1)*mpair1(vind1,1))/2 + & mpair1(vind1,2)-mpair1(vind1,1) mpair2(vind2,4) = (mpair2(vind2,1)-1)*nmax- & ((mpair2(vind2,1)-1)*mpair2(vind2,1))/2 + & mpair2(vind2,2)-mpair2(vind2,1) mpair3(vind3,4) = (mpair3(vind3,1)-1)*nmax- & ((mpair3(vind3,1)-1)*mpair3(vind3,1))/2 + & mpair3(vind3,2)-mpair3(vind3,1) mpair4(vind4,4) = (mpair4(vind4,1)-1)*nmax- & ((mpair4(vind4,1)-1)*mpair4(vind4,1))/2 + & mpair4(vind4,2)-mpair4(vind4,1) ! For gamma_hat at each bin allocate(ind1(m1),ind2(m2),ind3(m3),ind4(m4)) ! Construction of the uniquenness for vgm_ibin unique_vgm_ibin=maxval(vgm_ibin)+1 iter=1 do k=1,int(maxval(vgm_ibin)) if(any(vgm_ibin==k)) then unique_vgm_ibin(iter)=k iter=iter+1 endif enddo do k=1,m1 ind1(k)=count(unique_vgm_ibin=0.0_dp) ! Memory deallocation deallocate(mpair1_hat,mpair2_hat,mpair3_hat,mpair4_hat) ! Compute mult (using the function "approx" to compute a linear interpolation) allocate(mask(n_out)) ! Memory allocation and compute the index array "ind" mask=(abs(cr)<=0.96_dp) m=count(mask) allocate(ind(m),auxcv(m)) ind=pack(aux,mask) cv=1.0_dp call approx_linear(rho_grid,f_grid,p+1,abs(cr(ind)),m,f_grid(1),f_grid(p+1),auxcv) cv(ind)=auxcv !cv=cv*0.172402_dp*sqrt(sqrt((gamma_hat(ib)* gamma_hat(jb)))) !<------------- cv=cv*0.172402_dp*sqrt(sqrt(abs(gamma_hat(ib)* gamma_hat(jb)))) mean_cv=sum(cv)/n_out ! Memory deallocation deallocate(mask,ind,cr,cv,aux,auxcv) end subroutine cov_bin_fun subroutine diag_cov_bin_fun(B,n,p,vgm_ibin,vgm_ipair,gamma_hat,mean_cv) implicit none interface subroutine cov_bin_fun(B,n,p,i,j,vgm_ibin,vgm_ipair,gamma_hat,mean_cv) integer,parameter:: dp = KIND(1.0d0) integer,intent(in)::B,n,p,i,j integer,intent(in):: vgm_ipair(n,2),vgm_ibin(n) real(kind=dp),intent(in):: gamma_hat(B) real(kind=dp),intent(inout):: mean_cv end subroutine cov_bin_fun end interface integer,parameter:: dp = KIND(1.0d0) integer,intent(in)::B,n,p integer,intent(in):: vgm_ipair(n,2),vgm_ibin(n) real(kind=dp),intent(in):: gamma_hat(B) real(kind=dp),intent(inout):: mean_cv(B) integer:: i do i=1,B call cov_bin_fun(B,N,p,i,i,vgm_ibin,vgm_ipair,gamma_hat,mean_cv(i)) enddo end subroutine diag_cov_bin_fun subroutine full_cov_bin_fun(B,n,p,vgm_ibin,vgm_ipair,gamma_hat,mean_cv) implicit none interface subroutine cov_bin_fun(B,n,p,i,j,vgm_ibin,vgm_ipair,gamma_hat,mean_cv) integer,parameter:: dp = KIND(1.0d0) integer,intent(in)::B,n,p,i,j integer,intent(in):: vgm_ipair(n,2),vgm_ibin(n) real(kind=dp),intent(in):: gamma_hat(B) real(kind=dp),intent(inout):: mean_cv end subroutine cov_bin_fun end interface integer,parameter:: dp = KIND(1.0d0) integer,intent(in)::B,n,p integer,intent(in):: vgm_ipair(n,2),vgm_ibin(n) real(kind=dp),intent(in):: gamma_hat(B) real(kind=dp),intent(inout):: mean_cv(B,B) integer:: i,j do i=1,B do j=i,B call cov_bin_fun(B,N,p,i,j,vgm_ibin,vgm_ipair,gamma_hat,mean_cv(i,j)) mean_cv(j,i)=mean_cv(i,j) enddo enddo end subroutine full_cov_bin_fun sm/src/init.c0000644000176200001440000000132113353155222012565 0ustar liggesusers#include #include // for NULL #include /* FIXME: Check these declarations against the C/Fortran source code. */ /* .Fortran calls */ extern void F77_NAME(diag_cov_bin_fun)(void *, void *, void *, void *, void *, void *, void *); extern void F77_NAME(full_cov_bin_fun)(void *, void *, void *, void *, void *, void *, void *); static const R_FortranMethodDef FortranEntries[] = { {"diag_cov_bin_fun", (DL_FUNC) &F77_NAME(diag_cov_bin_fun), 7}, {"full_cov_bin_fun", (DL_FUNC) &F77_NAME(full_cov_bin_fun), 7}, {NULL, NULL, 0} }; void R_init_sm(DllInfo *dll) { R_registerRoutines(dll, NULL, NULL, FortranEntries, NULL); R_useDynamicSymbols(dll, FALSE); } sm/NAMESPACE0000744000176200001440000000274613273414604012126 0ustar liggesusersuseDynLib(sm, .registration = TRUE) export(binning, britmap, hcv, hnorm, hsj, nise, nmise, nnbr, pause, provide.data, sig.trace, sm.ancova, sm.autoregression, sm.binomial, sm.binomial.bootstrap, sm.density, sm.density.compare, sm.options, sm.poisson, sm.poisson.bootstrap, sm.regression, sm.regression.autocor, sm.rm, sm.script, sm.sphere, sm.survival, sm.ts.pdf, sm.weight, sm.weight2, sm.surface3d, h.select, sm.sigma, sm.sigma2.compare, sm.variogram, sm.discontinuity, sm.monotonicity, sm.pca) importFrom("grDevices", "chull", "col2rgb", "contourLines", "rainbow", "rgb", "topo.colors") importFrom("graphics", "abline", "axis", "box", "contour", "filled.contour", "image", "lines", "par", "persp", "plot", "points", "polygon", "rect", "rug", "segments", "text", "title") importFrom("stats", "acf", "approxfun", "as.formula", "binomial", "df", "dnorm", "fitted", "glm.fit", "model.matrix", "na.omit", "nobs", "optim", "optimise", "pchisq", "poisson", "poly", "qchisq", "quantile", "rbeta", "rbinom", "residuals", "rgamma", "rpois", "sd", "terms", "uniroot", "var") importFrom("utils", "menu") import(tcltk) # import(tkrplot) # import(rpanel) # importFrom("rpanel", "rp.plot3d", "rp.do", "rp.tkrplot", "rp.tkrreplot", # "rp.radiogroup", "rp.slider", "rp.checkbox", "rp.control") # importFrom("tkrplot", "tkrplot", "tkrreplot") sm/data/0000755000176200001440000000000013353155222011603 5ustar liggesuserssm/data/stanford.rda0000744000176200001440000000353312266061177014127 0ustar liggesusers‹µW P”×þ÷ýÿÿ‰ ‰Zµ†4(Ššäž••— ã€ÊkÁ`äµ$ É'$€@U,)2V|V#…@0Æ„™Dë+¨¡‰@}L!6BäͲÝÅÿlÊ°i'¹3ÿ~ÿ¹çÜïœ{ιwöT‡.åCy†aÄŒØBĈ%ÆW©Øø#b¤ gDV›•—”Ë0+£l2˜j|>"=_¹ŸMMYIÚrí¶_Q¸¡Ò#._åÛ<|vqí(Ì¥‚óá)iŸeèRøÇw¦eë6’Þó5o×”‚¤pÏÇ{¿¸ ì ‡?.ù„¨®êT©j“‡9ÿ\Ö®äØï:Ûnä¶Ø¾{7ÉûÍýÂ6†dï™l]QCÐ5ˆI^•íÎÙÀÙ]QõX6[y ,½t p³?SþI:p¶=õü*$ºm¦Æ#ý-e~‡œtH6ý¥~28p]ÿCHÖEç±öj´_S÷`/¼_òfˆ=¼ _»€} lYoâ±2oŠ´.¹èbÎ?›à5ó¡‚ ió^YñÑ°Qû ;÷'¶%àdO°ÁÑé ~y˜ü¹m„ôðÚÕèù9°óo•wlvÅ ÉMöËAÞÞ6’ùÛ`ç_:U â”ð·£+@ñ¸Ï@±± R§ IôÕFªr<§NÕo®^¢é\6¤= L ; ñÛºbòîóÉýu·Èè5k*.œ¦ïA|ºb?È‹µ7ê?4ê F.Ï ñ9ÿ÷C VƒºÈþÝ;@U4}ç· _ßSx´zÈg„L¯ûÛf‹”1|Ñz2Ð^z}‘k9È:+Û4ûå¾,Û:ç:ÈZKú&t€¬‰É¾®Z¢¦ÚQöÄ00'[sô¯ßi•…åg™1 ‹8Æ:ÙÝY›<·2ßOíB_÷HÛÔƹ‚´áË6‡Ïçƒt·kë×·|ÍçJ´àÎV/Q?HŸ¶¹R\’:[ãA·ÉXºa?‚¸ã˜é¤€È'+¬1¥ÄN™× ä¨ïRñJÑœŒø F¾èSÉþœ)­ëýÝé«À¸.Üõ dCËØ9#†%§M ïE2<°ÇêÚ³ûÈ5õXÿ2?Ž§L÷øØ]ÿó<Ìÿ©›Èn2{f’÷_"îÿŒ…“ÅËL0'š@÷¿ølïOò5‘ÍdsOòõ$Ž‰8'Z÷ß|ýÔXiîÉjC±ÿ+°ö±j×è­{Œ^‚¼–B_½»5ºñóÈã' zŠÇCÀ*äU èOÍ{S²‡€«q^@ÏÉæ)½¥w§øh‡yBÿË(½0ïBù[%Ș/ôïIɸóJ××a¼èãC>¬æãZɌ߇« «tãyÍ}"Èn‚ìH­Gÿ˜Çµ”Œ|æúQþ^bÆûÃz»SzÌÆK×÷üÈbÞ°Ï–R¼¨w§ì òéÆóc`>0ò óØ—/ ˆuÆø1NÜ×"f|œ˜Dä§ëC÷‡Ÿn<¯¥G\Níù)?˜ç)¸?Ì'ÖóiîSAÆý#æûÀZ‡q`¾é¼¢?*~s_ ˆ}EÇEóÒû¦ëlÞ€xÞÑóŠq`¾0χ%SqRߥ²Ä¨­­ñåiÆôQ*|¬ú&Å;¦½ºU#ÈòõiQi¯kI¢Š×Ð,1¯Ei‘'ùب´(ǸT£ÊœKMJwDǦObSŒƒÁÔS£¦çßñìþðQsm/data/bonions.rda0000744000176200001440000000152412266061173013750 0ustar liggesusers‹ÕUßKSQ¿NÅXQR>ø²^$2KMë¬Ímê\wÓ¹»ß÷Þ¹¥¡›:£²—~`A/‘T ödöE$A¥‰ÖC…=¡Ù9û|¯ÿîÎÎù~¾Ÿóùþ8÷úìÊ^³b–$É$™¶äI¦|þ·ÀÄò¤©˜ÏEz&ÝIg%);_ ûfþ´³}c³æ†¾Û¬îÛò³+‘Ýks}aÙ¤wi˜±þ[6ɬÀY¥C‹ìÈ!a.g¶Ø8Ãl“ÀÙ¾ ³‹ÙOpË kÔ€oœ’Ä`Ž»åýÁóðsvá<ç5N?6ËœËðsµ k~tÖòëÖñ>^±Ö‹@²£ÃÐ)?‡Ÿ÷ ø½mUb0_¼í•ÐÛ‘>ð©T2åpÊôoÊb?4*Âò±ðèÌ!N}N$®Ÿ%Šo"¾ýnè«%} ;q~ÃÓ>áÀOgÌL/³ ÆlD¼Ö›ð³ÕƒÏȳýbJ fÿˆü8¨>Ž_ÐítÀî*‹êå:½®/À7€¾&Òëyˆ<Ê>>-O3ù5ü¼d÷ÙÀï¿ éW 3 .D¸ð Ö‘~ä1úyŽÕ Îø=ħšK!ë,ÏéZëÓÔ6èI|Æ9±̪s¼}€¸ôS¨O”âPïƒ_Ý{ø<öÃ/‘?uûÊèUw ‰Bè RcÔ‡‘„ëÂ9‘àÐý<=úq¨ÏýiêC~ÈS[Îo³ ¯Ôw^òw{Ð/>ês™üå2ðy–Ð÷²çº/£›©ÿç Ëèý*åî‰þüz/âRÿD©ÕjÜ•ò¬ÿDbtOâÇQ×(Õ9¨Ò}!ÝZ tGuäÝ?}¡yªc5ì!Š?r uQV #üÖÃÀùiß·ÿå“îE{#½ü˜[©ÿeÒ)S_¶ä!½¯šéžzÞD€Õy‡Þö÷À9Fáç¬Íéâ¡–ˆ>ͽr7ÆcÚÏŸ±Â´Ö›ä1ikî#Fß6{2í1ùr±|ûÇÅÕ´åyïh_¡˜¡8R.¡¹C¹KùjÎ GsѬ[Šç»­Ù——ClšÏ‚/çô{,ÉŒO2Ïœô¢ãh])²wÏåÚ}ójróÍ+ÅÐì Ý®ŽÛw)iíÒþIkŒ= ¡ýåZ4—ϧ潑ÆHk—Ö:¡s)¹¼çW›{žÏ´ï,†ÎŠÒ‰ÿÌôÚë {3 îO³Qeyámo«Ë½ngmó]¿—¶µ:hŒµ÷í4FZY{ÓÞl×»žt¯ú[õtÚ)—“±/{{»;–]wý^Ç …ësm/data/poles.rda0000744000176200001440000000077212266061176013432 0ustar liggesusers‹]SMKQ}&šÐªPJº*U0Y¥[J&M2Ó˜Daò¥Ò4ß*ÝuÕ• ¡«èÆE)ºëª+AH»éÊ? îWbœ™sf““›sî»çÞwï{z,åCJ)ŸòMO(ŸßþðÙ?* ‚¶l·µžRþÇî&¥¦ì/l½¬»Ë’'{Xú[`ãáÐ^­Ì)prþ÷/ áOuññ-q‚qÙlÄYV&BKý(qöH9ËJS÷Ýb V#o<Î6 ût>ù:³¬'¥Á¯ÿb]^þ ø—=ÿ7ð†@wžñú9tW>Ó²Î9æ‹ò|+ÔIìÁ¾yÎøÀïyÎë[¢ŽÁ<1âõ4¯ïè³7é£>©î¸¼Ä¯Ý81÷Á·¡/ئät¤ýÝÕ•rØ}òIý¸ˆs‰‰¼Ò<þøþæ ø4ê–ÎOøY¯½|˜£Dˆ;‡ˆ/ ŸRÀd÷B:—ä™?ùJý”Z vó víò§¨§ÿýЃ®Ž~J s‘8î”qd•çæ«ÏaÎÒ¥áþI’u¼f¿2¸Oã©i~r“šqÈšÙßêoWkÄA­ÕÜ1]i˜=/Ú#CU³o.Ö»¶ðØö`·µ»è%|ä$tjFÿlsç|÷ÆOþsm/data/lcancer.rda0000744000176200001440000001206412266061174013712 0ustar liggesusers‹íÚex,çyàñ±wb;IƆNœÄA' £s@pŽ}$-ƒXZÒ¢VÒ®h¥c'q8i¸¡†™™™¡aæ¤aF÷žŽÝ^éÏþì¥ãÍ|ß Ïû¼Ïûíå3þ‰óΞ8;‚CÁ¡sN îñŒCþsZpFp–û•–Šùrqº§_ÓŸÑ÷«º}"Hß$ .¹ßÜõ ‘yT8¹$VÎ ãÙ Q}iXý|X»nHÿ0H,î‰õ§úûÒ 1ÿ 1ó~{žaí‚Äæá 1ýê Qû^(ß&Hlt}{ehü[Èþ:HL>Ýþ‡‰å‰ Ñ­‰¿«´Æúö¿{¾‰˜Ø¬Þ1HŒÖ<·­)Û_±ÿ®A"ÅÇÜß׉¥§xf«|MÏŸ´v#HT~ãïûûû'.ß–®ÃæLœã̽‚DOŽÍçùûjl|)H,ˆkéVAâÔ9öÊ}VìÍ/Èã‹A"Ç~mM>bZû1ßç‰N v̧qŠMqŽ=Àš¯ÉëNlgÏþÖ|;/Hl]ÅÚÕ ÑÿßËö¿\žÿ—+‰Òcø’û6»ý?óÈ÷·Š_®#ð,®›Ç9Ξ´wÁó‡à¯+ð,µØø2¼>ª6‹A"ù¸>ÜõöÎcÈÝ<Æmé¾³9¢¾ÇäÐ:›½YùäÄý– q”ùwÂæ³ò~¤ý|õìÿHÝÔz­85þÆ7ü?‡ÓíÕîÓâ¹Ð:6«_u±_}#[ûp»ºÕ¿¹#nÜ(~Ð>õiy7ýX±|Ø3üRo÷ýÁìÞÒÞ'óû™ç‰K®Ç†u=¾š»öNÉç"{Õa7mîbmádó=A"†kEì#®’ÚŒ±;.y-o‰=¼YÀ½™ðP£1õ-?·6áû uÀó ~­áë!ìþ f—Á ¿†êر¯uï qâ›lÀ·)ÇÎOù¼3.Fµø~¨?ß7¸-ñ;ŽÃµ°ÿ¼˜;k°]¹)¿ÿÌßýýú qž üO¨k2ª‡«p}ëîÉŽ\¢®Ux%ûðóջûþ.5[ø.?âZ™fÏ×.©ÃÎ&ÅTx‚¸ø-=°,œ®.or³ï¿…åKðï¹rå{ñ~xó,ß î×`Ð…û–¾,Ï‹ßýlÚj_¬ZÏÏn~÷ÄÓ½‹ÿ®­9úXÈóø/½ÿlq¸z¦ý0ìéƒ |êÒ–ªz¤a:®ºú/ÿ)ñ%øÔŸƒÉ6ä{ÖŦójÒ¡Ks/ôM¬Uö7p´}3ßÔb>Å/;-ýÑ™„—xfä8­OrütÊ®X²Þ¾ ¿ònªõ¢žŸ”;âþçpš>Öa–ú½uwùLáÐ,Þ6ñf÷7Åš¥£u¾J¿÷Û<«ÍœÈŒÒV9Ÿ a=ÛÔ­oxæ§õ‘¸gÚ‘FZ$ž <3úÿBy4_\IâiŸWõÞú}aG—»¸_¢Ámuëâ]•6ÎÿU´8Ëöy1gõÔêm}g«·%XM©á2ìpqN¿Ôå>෠˵ױ÷u9¼B ×´A§Jpïëá~—éjN­ªõ¸xÚ4,§†kä/êE½±/¯I3¡‰K¿—“>ÉZW°oÿJîyx.D6qlþZÖÐâ9Ú1€ÝøQöá4ó.w|)Ã7ÉײyQesêñüê³Mx–ôpéWÞŸæzœ÷ôd™ÔõÜ„xæØ߶§ÕˆUhôœçÜ3ù¦'M2qkÏú§‡;6zô7ƒ_MqiǼõU÷“‘¶ÂuáÚ|Ê£‰÷ø¥ÙЃÞ-ä£â‹qO4eTo1Zöoh¯~^ qí{Àƒî4·ÚöÍEÚ÷khj6-ûfôm ¯‡üçiŪ¹±¬·×õÄŠù3¯/.U£ŽzÏÑ¿J¤­x» Ÿ’¹Q¤ñóæpFLáÔ‚ÙÚó÷Q³  Þ5º2ŠëM±Uñy^ R8Qz·~ÑSYÒÁßIZÜz¯ý8¼¡·ÌÕ,¼—å°h¶6hó€ÝSônV¯-Á|þ]Љú8:¨_®ËbNÂk¯Sú¿£vm>ÓÞêSU»i~²´oF^ÉhN=É>¼XGžßmíÐÍU:´$çu{R>9g€ëÇ6ÚøÓÀ•#¸T‰¸ÉGI-Ò²’y7åýlzt¿òZ6#í_>â¸ÔX£·²×‰Ï状3IOÆàP¡‹³fêšçj(Æ3⹞e«)––:4ÄV¢u±h{ ŽÅWyOó³Î)Z9 Ÿù(}°¡_;¾u^È‹+gnœ .¥å=ç"}ÈÀ´m>´p²‡C‹0«^Ÿ!6 q½{ßyšßf›Þá˪ÜÊ4+uûÙ/Ð×9¾:Oã÷Ê´l^=ŽÅ|è·5=Ù‚C˹¥ªÖsx2C*yû͉Uœ*¨KFÞ9vÒwŠg] ÿÓÑ™QžKfMÑ<îÊgJ\Ót´C+[ö3—W£ùE#zt©N‹–ùYWó´ZWôJÆSÎ4ãñüZÄ…U˜Þ'/ñ.²W”× Î–iJ^Ý×qº¢V=¬Ù—§åKôq>êY1”ØÌÈ© óÅ÷ÅZUÿŒØp¢õɸž'جұüâ¹R9 ÇœïæÕl%Â_¦ñ)yN\Ó¢=ã/c‡š>,›«QhÌ-™WûEúÝ3‡º8ÑVÛ èÁ’>ë©ÏÚ㾩ë¹î§äŸ…õýXTQzÞÒ¯³bjxž7gæôݲ»¨§›]5ëÂi‰VuéFK £³lWÌŽj4kþâ»PÀÝQg‹55®ÐèUÚ“¡eqÍé;­?ù¦Fã|ÌŠ³LkÆÍ’9}y½Lƒ2æF_¦½[Q³ïªçÇç• k6`Ý׫ òèÂ1eî–¢ó¢³ôÜã¹Tv.Çôb>Lë)ßäPsN-«MV~Mq4œI§gæÔ¡áŒX¥¹}WÏyØ®:O,ȧ‚«ú´Gï;p_Ô—37c}ß|íê—´\Ž™'³´¼«–¥¨ÏÍñ%š\¢›-ú›5ßÛpnãDŸóz·äŒQ07V½_R£5{»8—3ƒÕªóE1ôp¹õÑ1ßôJñ5ñy¢c†/ûm°ýžp>©ˆ§©VCkJWö—ú|þÅFÇ|îÀ´û«l/ê¯|æÍüušÚÒ?M³ø„ø{z¸%‡]¶›Î‰I}™5k8³Àgý¥ñ¹gF÷hË4~Öõç:_ z¥é½X£ÛiØ5Ìõœ¾kŠ¡I_Nˆuþnòz~ÌçŠóÙy·ŽÇZqf^×ñ¿ÛñÝ™8)Í´*þôØkÂ!ó§X‡&ôUÖ÷ªùV€ùº^iéÑ.MY{t\ãpШüXü4‡Óú¿õ“XúæQͺ¦´:g/Y–Çî¡ËuÒ¯%ŽŽÙØ4‹êÑo<Ÿ3ϳÎO[Î0GéG;ðǵêѦ—Y}Þþ¯ß*Wü~‡ÏÂÚ;ƒ0¿„ ¯ÂåDnþ)×a¿„Åkáú?aÚšc»A¸ÿâ l[“™²÷žA¸²„•oá%7´~ßš_áÆ[<¿>  ÂÒçìýQ6^„;O ÂÞeAXýŽçJNå|»*[7`7ëþqø{çíb¸/;á…÷ÂÉáÄ»ƒ°Ücw^¼¾o=<ip¸qÊõ© ì>¾€vG^„cÏÂñ7¸aÊ÷í7Ú÷|œËÖ˜¿/·¼ª¿·îgžï̧X«ý Ìú^{¦wõn+w+ql™#b~)?0«‹¹õcv¬Ûü²}¿›õ+CëSb;Ɇµcf§cÝ…ö}@.rÏß<ÂrוrÈï(û[Ÿöý§ö==Î3ÙU‡—áŒx6Ùo<5—~„ñ¤îêûÞsÿŠïÖîÿNM®„¹ªÛ·á_Wäÿ |ÿÖ÷Ïê„«êÑQÏä¸5?Â#®•'y¿0¨Ãfã‹žÕj+ï9²»ï­_͇áÞ‡ÕîiA8êªðuäcpU“;Y§¥Yw%±¼ÊÚ/°óY1þÙþ»Éñ–öþ‹<ñeÐG=›rªý&;Å›ÈùR÷M6Áæå0Õ©;òñKu¸—÷öù]vÞƒÛÁãA8w+ø¨Mùv廉‹ízæ×Oà2Ëâªâ‚yÎÜ_̸Wþ¤w°·ÿ/Ax'¿Îï™j€OéëØûj¹Á$£ÜZ·vRN“3|Á¡þ-¹ð;‰SõúÞ3îhíž"|ð+§œ¨=Ž-x®¿Î7>6þ ÷³¯sy3ÂEÎõµHûöx{NÀòQâ}.ÜõìXéa8³ ÎäôwasJŽË··ö9.\ð½­¯*dþ»òê¥ÚÛÄ-æÞdÃØ^„uJM²oUã=±¼Às9æhwš§áí­í?_\zý’9ßq¥ªÇ/že³¨¬ßä#óÌcÅ€§cï·Ï2ï±_N#£ìãÊÞWa@[2â.Óž¡žÜþ oðlîù'0€SUí·á?ÂJÿ.þáx6Ê‹&ÝJÞÔ3Þ¤èÒäªÜÙ®ý@-åŸz¤þ܆ά¨Åæµ}Sû¦¯Ñ“¹çÉS=ÆõõFø:.× ³ÏCõØcŠ–Tôø8nmú~/N\ƒ_±Œ³ß¸}\£Á½ÅÉïð⟓+üÃÊ%ÕßuWÎs]ï¥ð픶›ü©Žíâ³Ùô,§6 ô7=ÍþEêq~ÚT’æ(ŒÞÌ|S4=©OÒxž§ŸSúvZû0«°‘Ç— èì8nfp!‹´ÚmÒÃÅ{"­ÙÓئ–àûœ~IÒ¬>Ÿ ´cOÌ©hžè󺸇ð™ûŒXaZÓoÃcÊûeZ\ÃÅ:pÊ ™øP\>Ì2žWðhL½ÛðßÑ››j™£ó}³i+ø~Ÿ‡‘\?Že3¢¬ù{Vîóø³~Kܳ<£»‹x°ií†ç•éV…6~ϲá„ܗͶ©g§hjšÖ.á\¾£ï£7z=“Œëô>c“¸½ ›#t;­gvä¾ì^•WRžú½éœÚ Ä7õï#_³cWŸØ(àyYgãÄÃÄ(î´^ìŸg\+pªCJOoówä.ìýòò¦)u¯ãð–žË½RõÕp‘M\mн4ý³=Æ}ÖvßÝQwü^‡ãž¼ÇÌò’¸÷­«Àyåš0ˆæ¶~D=K_[zð°ÙPÆ£}—kYmRâ©Š…žÕ€§ú"ifnCgéÚXtž€ñÅ´d[îûê: Ï‹a¼m}FOœÂ¿•Ã<îÃ|Kî[úbdðuÇ}@wvÙ«ˆ3õ ØÃu“–Žê-qõôdMýþ —Í“éwY÷uº´õðbNì°;4_Q}pöè;âZDý²iMù¡0ŽrÀÑuµÝö~O6ðrä£ò¼ž¾¤ò[чÇÌ­-³¿„wU}1”Gï“ݓöÃs›x³LßûrLš¡)Ú»÷6ôDÅù ¿zšÇ±Ö÷ØÔoCµ¡ùuù¤èpEϧñeÛLœÄ‰l‡þÐðü—ä¢Ï ìfÔ*§—w®ËþL|¦ØŽæ®,ãˆópXÅÅ }ÊÒ›ãøº·"-à^I}FhH*Ò%ïò·U{ú°föTõѸ~«áìΕýýõ£m;t`Çù/§÷ƦÙ_T»e˜M:«äĽa}MïÅŸW÷ž(DÇÇ$¿ùîÑ¢ø‡´eà JâÍnIµ¨W§ÍŠµö#Ü„{Y^+øÜäÒý0MDóJ]7ø]ÁÁ.û5Lò_ýDÜ“Óô½äÜ”>.Z¸ì¬6aÿ¸Y»Ž;fVÅhý_Ù‹8MOb;‰÷IšQ]ë]¹ۧŚµ+g¿åÂmºÛÓ'iš²‚³Îûlgð+û›xÖÄ_¡ÃYÊ?5>ÓîÑ*~Tõîž:Ôð ‚'ëfoNŸ%]œè뙲³Ù¬khÖæpaÝ_ikvœ;rΪiXï~,žQ?lY_ã–sÖ~t†UŸmºÚÿ¾õÑyY”q¡õ<í[R‡-œÊ?)ÖÙÒ³\ÄgŠõ¨ŸÌ³:¾®;ooÃzêêz'å“ñ÷–õÏèí.?¯ÑøKÔµ,ïãøT–Ç~t¶Ç£¾½MxÖívàÐÓc~»‡›úq eñ4Å›zŠwúºâ¶G§7œ¿F­·ñp]ŸÔ»&ãlÅR—MøÕé_îîìèÏcz¦„e³zAöå;…7Uý¾…»¼†Îѵ³ãóf9ªmš¦{¸´+îŠ{’f×ôe—ý4=Èà㆜§îŸ¿2ÑVÏe£³Ö;âyµJ¯’ôj\^#ú=CÏû¾oãbùkr¥Ëc°:åùkqÂ#gfM¤ã~L›Í袡Uµõ{;Ìò³µC ò›ŒôS~9>ÖÕ3õ’³T•öM±Ñ}¯g3"ïœ\ë@]vÄ_ÅÁ¼~š3GÕwHS&>Ÿ;&žÏ·¿7hÇEÎ%xq«ŽƒEØUôpOªz¤¯†9Øoyw ÓüîàN†ÝÜÛ~£T£>Ó§Ô¬èÌ?Ä£]z3Ù#‡IAûr˜Óƒeg±…nÜ7óføIµ¯:Ÿ¸Ÿ°.©ï2bŸ7û/ä·é,—«ßøá@nSÎ…)çŠõè§g·½3¢FuyO8×Wii¿‡æwJmSj}ŠÆïŸùß¿Ÿ£ÿEýÿÿ:tp\×Áup\×Áup\×Áup\ÿ·ëïþyw¢œ_ž^ñpµ úÇÝ—ÿ›ï‡æWóåÙËÿ<óX¥Þ˜ûŸ¿Ã_þ/ÂÿÞRq)¿r…¥+^ž]Ê7òçÎÔ9ù_ËϪWÚç^áüªQdÿ¹ì²¿œçö·èúO)#ôœ.sm/data/trawl.rda0000744000176200001440000000616212266061200013424 0ustar liggesusers‹Y X×B”¥¨­¨OÔ↠ڊ n zÅŠ}UT”FÄâ(„¢âú,­EëÞÚ*RëRmµ. Ö¥Bµ®PAë*Ù7‘°„@€739wÀI‚ôåûŸ{ï¹çœÿ?çÞ àåêmoîmNQ”ˆu3¢DÆÌG±ˆùaD‰)3;ÉCdá«(ÊØ’˜0ï.Ìû0Õú2jƒúÞ”à³!ÛŽøÒç³½½úâQo˜×7Ö7¯Ï¾#¶oŠoÈNhßžÿölô­·ÇËF†âèóÙ‘ú··¯mÏu´†úïŸÖ¥½¼þßwT{C>Þ´¦¯úìÿI]ÚË‹¢ôÇ“íåmh½#9¿)¦¾yJ°Þ•yVH&®>þÌ|¢B²ÛǶ6i·BÂüð±­SHdnçz¬ÏUH%¿³à®.c_ éd~ ò¼H>DÇn¯Û¿„§”5w;׺É%¨&a~²×uäó&¼¸°^ Éi-©êEê€öü>Ô›ßOø…ã2¬Ï_¨ö¯#© ÚKIÄ ¯+±CÝùê–ºD®NºX€: ¾<¢ž ¹ú·AÔ•Gî\´bꪃ\´b1êm±Ũ³¢îB,Á:D¬K)ꭃدe¨ê]Žz—£®<¢ž+P× Ô“GÔó%êøõ#X‰ýù ùóˆ|yDžUȇGäU…}EP‰ý¥D~<"O‚ÕÈ·û¬y× ïäK°yê òåy×!O±_TÈ›Gì—zä_¼yDþÕÈ_Qä߀<‘A òãùi°žMÈ« ù4q|øûm´öû=Q‚8±¢½‰}oÄaˆãÇ : : p"‰OüøNˆ“c‚ï ö ½`}œ`ÿ?Âw¢`]ˆv‚±³À/“¼ ùÚ¢ "-à1Rà—Ø ó ·èσØ; ÆÄžØMìoÀŽäç‚óD?‚ÄîqɺîŸ(X'ñìöIܵv›¹ãfrŒ×‰ìG;~ø'ý7U¿=ß_¡Ú{Å^0OƤ^®Ôë<œq‰‚$âg‚Àžð$ý;“Ò¿Ô‹F$õ"û§ öÀžøö1_gÌwÜëv$O>_ÒŽ¯Ûñqˆb'ìƒÉ8Oô#ñøs±E¿?¡_ôCáý C÷¿•“ž˜îjù‘Û{¨¿·gÕýá—áÕç®^ðI-ü>oÒ™±ëߦ)ùÂŒ„Pžuô¤äëo îeàáüGa ú¾8Àá*ÏgÒ½/:šõÍïÉ]F®x­:?<–µŠ×mžqC šˆåßNëêIkW 0{ ÍEñU 5Ghʱá`®}yBS1q– ƒ Ae©ÜsæÒL¨‰¼éþÓ xuÖt”¤d4<Î5M®ÎÆÓÞë&flõ;Ñ9auM º˜r~H?+¨3yOdáq êW'{ö‰º•§§lÙ>;]/Ä|ûWTž\Ï*ÍÖNžuÊúU¹ ðú^¶ÛLƒºãǢí„J“8¯ÓS¶Býý­ßV¥W@mjoêÔí³Ðä‘:·ôîÇм!¥Ÿ÷…çh%q‰ •w†õõÙ¯÷~P5êÿÒ;mñshúårß ¾ç¡¦î­ÚgÛ»ƒÆ.úÁF9³´~k‚ªÍÿy/áþY(³ß7ùR¨Š£Øñç¨Ov‰i4ÔdæÞºµ–FK?ëú/¨Û1ó¬ûA=ÿÀÂUãd |òD4Ý! jCÏÜsë< 4Ã[‡ Ú(˜ ÈÚ M ÉÉçƒÆ>1Ë3i6ÔŒª?ºgxü=Ý=ý\Àb¨ïßëb¿@k¨Í<¡91¬4Iþ+näi@¥Ìßµ&4ÑSÞg$ƒ\¦+k²r/øYªìÿ¼,b—]ópþ²þº0àÖá“y‰7Yu¬Þá÷ÕHß-<ô„é›™*lìÌî#~ „Z“Mù/Ýy»{/¼gyAAŸ{çs3#àq¼ßÒ|Åá·|®']%#Ž•JÍÛ¿Úa3`õ•?ȘŸ¿Q–a´+l0Ý{#Õ˜_çT¿¥c_¥\3ö¥œ.¶;‹Äð[}—äqŸÂóŠ†)Í>ûtìÿ`»rɯü||?« N±Pfnþr¦41ºøà o‡»Á‹¥ß±”ߧ”¶Ê£z ý½ ¡téTæ„ÏLL7ö‘rÙ5~=Í¢j‹ù†…poíðñnÁÃ@U4ØæîXý/Š MMÆl‚}û§Ýo t€Ò«kG$µÚ)´ß3uö:{«rûÕµÂyr¿µÞkµý¦èYîò¼™§Ï\ݹÉÖFÇoÞØP±7€g$Ë,é™'¡d^["H0iÞ‡ÇË¡´$÷—G¥uÉ« J„ô«—ƒ÷Iƒª5ÕK–<8e©%¿&ZïÒ±W>ùþ@ä¢c­ºvÚ[3ÊN2;ýtìkfø~—¼£?.¹üß ››®óãb•STæ5H¯¾<õ‡û7[õf»Ï6×`Þ¹ë³3TELì¨(ççŸ~rTm¶òša¾ìñŸ™ ¹´MÜÄó» ªë sC´/gn½…Š>ÐáÛ·Ò#•Ÿ¯}w´÷£à¬öïu÷G²»x rØ[%Ä´Ãýšcl¢t¾›Í³ñÞËwXdãÚµ†Ž>{^õOÏM-Ëw:uø:4˾8ýç ¸Y‘!‡m»YBUÅ2[G1(çî\>"h¨;TwÝ\i—ü<"ä=ic÷2¥¶|½Aíàü¬.ŸÑ/3ÑúPú÷Êêòß‘­÷Ì ’æ5; eÒ§w/9zCCü“ç®–üºæùˆ>ß'„ÓÆ Vξ Ü@SK6Š¢ÞÕ´ö‰É´p¦ät§”<˜o´™—Gþ¬£s@³rÔ„v‹iqÚ&¯žŸFÑF»ØÇ1Mݸw+s˜ymOYíÔjŒô©;Óh*ëÓ¸ëÛRi£xîüÐ";íïæ¡lÛ;ÐâýÚç‡ÚwAÆŠF´IhA˜Ó$Ô:³…ŒeîÑQ»o‹™ç]ßej‡ECh‘Myɱ;Ë¡á¥Í˜åAó¡¸ä«GqÑTž_ìÜ–›´É±³­‡DÒ ¢ìk<,icoæ)鵉ùõ2eCÃÔE¥¾‘Ðè›2jvf>-nÞÓrÐFN‹³ÙÇ~-f"ÈIyÙÍ9®Zâ—yy}3çX¥˜ÐÆ÷öØÑD‹'¼ÅÏ÷—…àgSO™|¹ôqDÒØy¹ [øËŸe¨+ÙO0¯¨D\Ueð[³#Ê9tÅ )¤å&ľD¾†}íi: ”cöŸ€MšÀ™û3ÿåõc0bG=ëÓˆóð7àÛ>·é=òѤ}8¹º_.8îí°ó\Ž—óì €ïCÔÅW‰}röòwÔ7ðü´NB*€>|øáÇÀ‰žËÖ;קñYð•° ¾ñû°£NíÔ'v<‰òùâ Ÿ‡?5²} va—;9ÏoÁKð,x‹,'´úÐGÄßÆû3èB]ƒ-EÀoÝËû‡ó¸„>õNW'y°.û—dCþÞGîp\Á§ç)âñlï¢upl@\Ž»œÇSÀox½Ý ? >üwÝzà$bà1: }´|(7Ñ*ï{ÅŒ8Ô~Σøá䣔ò¹u YãoOJ y…Χyyy3X—o ÿ ¤oúHÚ |ßÄ!ñóÃÇëæížÈÏg y9y½5üœø.þ_‹¼_›´ódû­¼n6ί…÷‘‰÷QÆúAü_´GW³>͹ËãÑ/ç¿klERI¨ôÖf/1~·™Ôdº£·_³‘;ÔΟ¬²¥ÂJ'[\îTÒ¦4D”^¥,ÚC},1/èIõ•i¾Ñú“ôµ¸¸x›ŠöüXÕÒŒƒsm/data/citrate.rda0000744000176200001440000000063612266061173013737 0ustar liggesusers‹m’ÉNA„›c qI|ÂŒûYÀhTŒF ¸€ãn4×à’xЛ7ŸÍ£Xjì–xø蚟êéîñѸ‰G„†0ºÂB† üDH„±¶§2å¢]N ìÁg'èrË<(ƒ¸àÆïÁ‰æ÷Ïàl0~ ÞÀ£æ/‚<ø¯`8 Kÿ¸Òü2×k~€ ˜ î½gš?Í\àƒiÆ]~ßµô_b_²þ6ÈÎ%óœkþ½²ž“Ì›ôÖ4¿ìe™s\ó?‡38œÁÓü6˜ã|`‘w2 ¶ÀXÓü« É{ª‚Y0Æ5Ëyôüþ=>°ß$I0W3úþ}殳Ÿû–9×yî?÷å2¿Ü³ÄšžqVóW9_Ž³UyS všþ?Ï·-g{iyiÝB>Þf08RrøWš1%M%-%{•ìS²_É%•TÕLUÍRÕ,³µíÔŠ]òÛöƒÇ.ÛQ·ˆ‰Zìáb¾õ'•ÇeÈ·Òh4¾°|K~$È^ésm/data/radioc.rda0000744000176200001440000000411512266061176013544 0ustar liggesusers‹…˜ pTg†ÿ\HözöœÝͦ3VÅ;ê ÖŽSµj´è´Ž— £½ÊRÀ@‹¶XÓ–R ”¦å–@›ûuI²W:Š÷êÔŠZµjÕT«2cUf¬Úqjñ]Ïs&‡5*3OÞ=·ÿûßïýÎY½jí•¡µ!cL­©Õ˜Ú:}¬¯ÕSo‚Ò†Žt[û–õÆÔ%tT¹ÕÅ5Ò-b¿ø±ø¡ÈŠÛÅ b£ø«î»L辚;Äq—¸V\Éy­SsP?µ­_Û.fÄ>ñaq“8§òZ¯îjñiq½Ðºu³â€ýbèZ¯þââ}BõêÛÄ&ñ ñ˜˜ßy!õ¿4fYDú¼Ôañ.Ñ%v‹¯©)²·ìçRu¨AÝk¸\¨FëÅ[„Öo׆“¢ zÅwijâIñMq֘Ƥx•¿Æwˆ×ˆw‹û„<5ê¾F=ß8'~ ÿ4&àˆWŠ7ˆUâ£âãb­Pù êGà§â„P?êQ@½¨vàïÆ{ÄýBywˆNqç¿"´çà—„Öj/Aõ)øŒÐúA­ÇÄÏ„úºUlò* Õ }טp@(×ÐߤêmX†¯š•°2 ¯á8-îÊ0K³a)Gëf¡5­_ù·Ä?Ä„fÒú1±z¡Ù‰)ïØë„Ö‰)ËØj¡9ˆ½S<(O‰ï Ítì[BïULû°•{ì%©²·µ†­Üì•â:¡^Ú#âýBÃjë¶[…2µåËy›ø€Ð¬9ªíD8÷¡9rnšgHœòæh/ õÆQÆŽöçÈ·£Yp”µó‚1q½ñ„æ ®õãÚKüƒByǵv|J¨¿qÍ_\3Woãß3&¡÷,¡œšëÄmâN¡^&´¿DNŒ“T^ ÍâI÷8¡½$¾*þ¢kª›T†I­—Ô,'Õ³¤Þï¤Þí¤îIjV“ê]R9$/p¬÷»I½njË…zؤw·Iûjú‰ø†8j¿)}÷¤”}ê­BßI©uâ#b§PN©ŒÐ{ŸÒ{—šz7Rš·”f/õ´1ÍWˆ÷Š«„ÞÓf}5¿]ô í»YóÙ¬yn~Ö÷[ùfŽû°Ayg‰ÏæÙ ×âW>'¸/ê»ßò UÕ B¼µ«CK¬gQÓîÂ[ëåÿì‘@ÿC¼ê¾êuþ¶O«×ñöi™ÿÜs´êž8ç¼µ*Ÿc‡}½ò÷8ˆV÷Ыãþ¨¯¶ßþÜàÕ  Þºþ5cKøú_yÅyÆ»?ä[Ãóè­á­õÝ“ð{5¼ýú=Ä}Ÿ¼xkø÷áõÀÿŒ··¨¹tÆ¢UZéA#¼Þz~,j†Íâ;ãÏ#bßÛ÷|À,f5‹óQ½?פ¯®çÍ6—ΗU…f½9õÞ?É%XjþŸÆ–ðáÇ۫߇å[«É,æíŸÇ·¾m.¥¥¨~¯ýkU¯½Ôw…Uu\©ç"î=5kZnê4•?-i´Í¸º‘ãvŽ?ÃñfŽ·¶¸úYÎwœuu;×oçú\ßÁõÏsýN®ßÅõ\¿›ëwg\ý"÷uzºàê=ê÷Q¿ú}Ô?Iý“Ô?Iý ùd¸ž!§ ÷eÈ+ÃýýäÖϾû×¢ì¿ÅG?s7€ŸëP| 0ø8ïê)|žºÅï©=(¾O=íê þ¯@éÃàçPú1ø8J_†ð?„ÿ!üáÿCøÆÿ0þ‡ñ?Œÿaüãÿ#øÁÿþGð?‚ÿü¼äêèkQú0JFéÃ(}¥côaŒ>ŒÑ‡1ú0FÆèÃ}§ãôaœ>ŒÓ‡qú0ÿ üOàÿøŸÀÿþ'ñ?‰ÿIüOâÿ“øŸ²Q|Oá{ ßSøžÂ÷4¾§ñ=ïi|Oã{ßÓøžÁ÷ ¾gð=ƒï|Ï,¸š­Gy.û&”ç³CY'»e½ì ʺÙ'Poý\=MŸO_Ž®DW¡ôýô&´=„’ÃéÇÐsès(¹ÌFÐåèU(9ÍÞŒnEw¡ä6;‰žEŸBÉq–9ž³QæyŽ\ç>„®C·£ä<׋fѯ£ä>÷¼«óM¢ÌÁü5h+Ú†2óûÑ :2'óÏ \Í‘ŽüsäŸkAÉ?Gþ9òÏu¡äŸ#ÿùçPòÏ“žüó+QòÏ“žüó(ùçÉ?Oþùs(ùçÉ¿@þ…å(ùÈ¿@þ…­(ùÈ¿@þ…³(ùÈ¿@þE%ÿ"ùÉ¿¸%ÿ"ùÉ¿˜EÉ¿HþEò/”üKä_"ÿR+Jþ%ò/‘)ƒ’‰üKä_ºpéù2ù—É¿Ü‚’™üËä_îBÉ¿Lþeò// ä†üϸùWý–vÙæôm¶÷ÄuÞ¯nW¯_‘þ䎂­Ö·okß²™צ7ýûzÕRë7¥·yKy'Cméíé;T¥êö`Ç–+¼ê•ÿÔvêÇÅ‹/Wþây¹Â¿]¸dsm/data/geyser.tab.gz0000644000176200001440000000217213353155222014212 0ustar liggesusers‹•Y[ŠI üŸSô šªÊ¬|Ç`0ó3†ÅË^ËöT(#Pàv B¨2¥P(Róß—÷ïß_ÿýçË÷ïo±=·ß¿ÇãQŸÛÞ®_{ô}±Ïýüõ÷Ûãìì¿}Ú5Îm隣wŠ{ã8e”Ÿ¿+~#ûqÛ5Nù´Ÿì?nûX﵇ý\¿{>ë}ß1É¿Ýù9+ÇoŸöiÎß Åé·¿Ü·ÝöQL~8Ÿ÷:8?÷9G¥ïÎ;Žœâ»gþÝs˜:Nãïp2ÈùoÿD|®ãvŸ³¯þåÙÛJösÏîUŸqø¾È›äy Žü›Éúerð纣S½ŸÊññÝÉ89î8Rß8i¦^ÅÔwÿÃÔ—qŽ¼ Îô¾WÌۿμ^Ä3Gà¤þ™y®|ß‚ü0žwsþ ^b¼Å}'Ù_ð‰þ%¾óïÛ óOð0óòéxõ%Þ^y&?óÌâ_ ?ß^ýˆû2nwð!ã*x@xÆð0úNæú®»ºó\˜à%>OC|¾×HçfyÔϸï`ðgÞFüs¾”gØ[3þ'œŸšæóòOqxåþÌcç7÷Ò§˜ËŒ«Ð\¯èkÎOð$ÇǼ–óÇ}¹ïZŠ‡3ê;‹©W#ÿùŸy|ÉOè7g]ß™>ÞF?Ž¿äy™ Ñ/œÿà·už–Ð!]p\1wÌñóŒsžWfžJüŽ¼±Àw…ûøSÝ…—p_îÇfø y»©‹ãÓïqr¾‚N º”¨/ÿš_Ð9|ߊøœÏjú.ø°P|ÔWômAüƒýÓ9xåyd8Ü£î¢÷ ‡…·cÎJ!¾ÓÉfþvSGûn=½Áù﮶EOòwÁÏÂ{ÁÃ5¿ï0ù œ4òÏß_ËÜ×~OõÿÊÛ{nïŽÇDç§yvss±7ÇϦŽ¢“§©KäÙñ9÷iðX%ÿ˜w|þx³.¼‰^Jq¾ò0ǯÈ'çúYüñ^›¬7ÀŸ¢ÇJª7.{Š“=x[æð?å^·Ýé[Û羚ÏAÔEÞéÃ諨¯ì0§DϤï&¯‚‡…gîïZ½Çø½3oÄÜ ÿ3ÏOusPÎû />‰8fÒ?¿¶ï*é;q™›óÈó&{àÜéùføPõ3ðÆç‹Î‰=˜ÓQÌ?'ò¼Nà/úQôLºç,Ë>Px5݃­ýe¾«ïqÄç¾WÙס/Xºz…ÝégWwÎC¼¿„ŸKÎWè ÀmÏý%ÏÐoŠÃ”oWýÀqfº§Zë%õ½¿+çÁþD÷´À9¿;bî»ü˜ý¶ÛCº¾<?v&:qdÝv»×b=þl‡F_ÅûBúqDŸ¤ï#¯âÝôÊ;âû0û@ǽCMß¹w®Ý_9üË|4sûé·‡–ý•ÑÃ1§Ì»Xæ5æ…î[ÒwÖÿ±ûŸ¿ûÍÿ–Ôå/sm/data/geys3d.rda0000744000176200001440000000234112266061174013476 0ustar liggesusers‹í˜=P[GÇOÁ¶èI·NK’ 6ˆƒïœða!, Û8c%Æfì'N“Ƶë¤Mj×ÔI›´qM›¤ufb@òÝ{¿=IѨMÁ›YîÝÝÞîÿ»·X™ÙNo¤•RI•Ì$T2e^»’æGBu© fì~´õÝ^þR)ßÌìv¯ÙüÈŒ7Ì™àý†‘%#SFÖy¿j¤ldØÈm#cFîY@ï–‘ëFVŒ¬²¿fdÒÈ2¶7ŒÌ))YDçg‹èßÅOÅÈ#÷°g±ŒrvŸSè ÝÎ7| Î)ðÌâÏÆùûKM1À~…8m\Ó`Cg½iÆ9öËؾÆû§`åœÄ’ÇÇ$zC`†›ib½ ö<ö'97‚ÞÌ6åJ|7ù^#.ᯈN¬ëؙÆÝÿ›Ãðkýγ/yZf­Äú2{v®ñ1V©Ë}ìÞD·Œ9[!¦q|á‚ʸ€þ„jÔÖø«¨F}|A>Kè]ç¼Ä6Õ”Ÿ ÆUrYDÿvS,yl­±'ÜÏ’ÇüˆmîG±ûØï©FM,áožX›ø»ËÙuæËà©€ïºvíìΓÏ1ôÁ*|Uбx.7ñZÿ:q-à{»Kؼ§ÖgÀù"Üß"®5üIŽKè,ªÆýXU»}Y5îG ?r(=Äò/ýê¬Wõª³^uÖ«þϽÊÆÓgû•öúŸνê׉|øhO…Ï©Q1f_\:(ÿýBgÃá­ O~.hßÌ.¬'ÆØóÃy}ñwûüüg—Ëÿh?t󽜎#}{pösè{‡¡¡ ö0|´Í^—Ì»-š§¿èœ¬ƒ§÷×—›o~Ó=oÌÛ‡:‹½ë>quE¸µ÷£}~Ò F?âÉÅ—W{ç;à jðeTàã}á)˘éþZgá)“ ÓØé}.¸óuòzQüuà/>ï!¿‰Í0PÇ«’¸áǃ7p5âɱß÷24 =êÆ#ïä?8‘uìŸoWøQðŸ^BÇÎÞöOÕ[t.8?ìoá§?Âáðô£/û®îÛà˵Ù?GÞ¤¾3Q^\~¼è~ÇÄçx‘z“¸-íÿj?†Óƒá»]>ÝH~¤n3àëžá/%õȼOxWxrÿÁñÈ}•:ÏÁÿ)­cP—º€÷¿¨?–Wì5üqÞñ%óÖ<»Qüúmú^Œ·F=‡ì÷Âw·ä…ý÷Ywõ'þYOqOsr/e_ø•z oúmîI|$Á ~\Ý´ö=Ç yu}–û¤Ó­uâú–sö]Þ¨#údÇúKÑ·¤Î¤‰Û“ûyÌ\ò*߉¯‹:‘|xà”¼ ¯mëOîƒÌÉ›ë×ðàî+ó#ùJþ8ŸáÞHþëq=¾'Ò·„‡v}Oæm…FS'±¹û>¹þH|’?‡G⑾C}Iæbùˆó–á» û’ŸãØ=ë–}é?ŽO_êR¾·~é4Æð6ꀾñÞå».8¤9}ò’ ^=¹ÿò=kõû¯Ö{;Õ¯¶öÌ‹ÝN±x®RÝÞßÞyÄ´§´õíþà³–µó3ßìV÷·ŸìÄí}ù¸º'öd1ý º_|¸k\ÅÔ/ì>y6(Ìߧ*ùƒùQ¯×þ4CÍÊ;Hͽ‰™sm/data/trout.rda0000744000176200001440000000060112266061200013440 0ustar liggesusers‹µÓ»NÃ0`ÇIo)W;S¹Hl !Q!ÁQ±™\Z¤4NZ÷ 1°óð }¢†ßÍ1"Ù;|qâcŸcÇÉI³½i·mÆg|Ö`ÜÄ­Åq1˜ÅjhK‰Œú cæ‚ŠÀ4¬ÃEÁOžÑÍãüÒW^}7oâùõ>"À4¡Gp !p*ÌQß6¬Á,Â1œÁB–)‡š7E5FíSN_-X¥ø ­­Jqµ—½Ô0õ>Œ ã“•ûyÊ7ð‚˜Þ2§^«+¤K÷•0jŒ ˆXÏûËæ '‰Ô÷3*EÏÓÃ-ê¬îE¡ã…‰ÔÓ[êOŽõ"šžÐ‹(„±'“,©™ÊÚ®HD×(Q([“ÑMC—VçÇqIÓt˜­‘~ ©è`sm/data/mackerel.rda0000744000176200001440000000730312266061174014066 0ustar liggesusers‹Íšp•UÇ/ ¤B‰´´÷ò’H^^¾V„Pš  ‚‚¡HQIJˆºöÞ kïk]ÝÙ2¶Õݱ­nqtÔµ+¶u-kÁ=÷ßyÂßÜÙÂÌáä¶SþçÜöÝ7}¿Ùñ¼Ùyι,—Õ§‹ËÊ–?»fÉ]\W×CxîÒÖG¶­lkw.»¿”» õ–æAÁ€§½wêðƒWøWƒcŸ>rÞaÁåÉwǬ¸î…¼1Aµ/Æ> &=*¥×¶?%ÿžš‹œÿL›¬å ¿T9õ"T$û¾œL߬ýÆTù†­Á¸Ùªwþëë¶L¸³ h»Xûòùë¶L 웧-÷ª¾9}uüÜç´~É­)ÂùNåLI©T_“âÉoðgà¢Ô¿`¼Àk[·%¨;Mõ”ýFýËyOíÊöÕî †Âcø;RÛ«èßGû'?f\)úvO5Õ¥þ37lŸ>,^ímyPý{›Ž›=óªUîšmªwæÉ:~îïT3øO.P¼ŽÚ[í_|žò¦%*ϹŠCûKZŽ|¤öŒÛ_ý7UËã/Ë󂙯jÿ|§v ˜ òú¢'û0KÿGÔdŽÚÓô°ÚÝt€Ú;êLÕW²^å÷Œ_4Dý]=_û/¿EÇϽLõþ‰ÆyÂX­ÿq³Ê›ý²æUK›â³ø0µëÀƒ`ÿ/*þÍÃä'y:>¡ùÄ¿ä{—¤Â\|Gã–üÿNÓüŠ’gµoë|˜r‚êoÉUüVÔúù¯h}ë(ÅwÉSjoåÅjgCö.S×~–ã‰kû<ÅaeŽ–W¾ ñi¹Hó`ñ!^ÜqAëÇŠÏŒ:ÅkâÙª¯»“jwr y™þqü«CoÑ›jÇ‘kÕ¾ Ï(^­W©¾ùokÿèŸÍø5Ä}á)*÷¨«‡…Õî*ò¾Ló%ùù”¥ëHòKòjõ oÖñ³–¨mw(ž3^ÒòØhÿÖ›£_ÕüIÜ .íÚ>ý ÅëPæió‰ºl%݇ä‡äE/ô¡ v7Ÿ&æùú¤‡àÿ¢£Ôÿ}Ào:ëÝxúï­öíµLyñ)eÆ_KÅ-¹5eöqÉm¬Kek<¬ÓøLc>ϼDç[=ëDE«òöXž.Y­ñ˜¸Móõ7ù~ ¹Nå'З\«ó¦Šõ}ìyjð¥âÞÀú8˜þNqL¾Ïú–Å> Óñ³jÕ®øjÏáW«ß%ÈïÃú±øø¬ê›t£–»âßürì?o躞܌ýUø_¢ø]X§Kfiü«Ñ7šù0kŽ›žS°c2ëÓœ{´| ~.*dß¹Ií[þ˜æW{›Æaém*o:rQ··Æ5¨&¯Äë÷¼»Áå>ÅeÁTÅùÒÈ>3~ú‘‹¿…ÄüƒbÖß(óz/Ö—yWkyêsŠÏöõ$ó¡†xa]Ég~~žëæàPO}ðŒÚWK| ˜¿Iö™‰Sf|«v&‰ç úõ%ÿúÛþËü뉿}-¿4^Éñ«÷ëºRÀþž¥~¥Ï/9¤9ùØ¡¾DíìО©¸}NÞB?ãáúÎúgâ?tܦ“oDß®öëlûdšoî¤>÷ïlíMEZÎȉóNóLã‰CÓœ,‡¹µgêžMCåp}¸=S}¦ñà×dø½ÒI}¦~áþÉݲ£3;3Õ﬽;iO3ñµûN‡r˜[{¸ql&¾inõµ³Î7ão3þv(‡ë³ï5›_aŽÿx¸÷³kþuàøŸæÖ¿2r뇓°?Í7†Ú±sö¥Ë!>»&ËPFšcÇä!Ž“7gà¦o>ûzþßø„Íÿe¾é?Ä[þǼ¨NÞ`¯³óË -…ð!œ—†q~Á¹§hžƒŠ×k¿x)¼Œûw¥¾œqð˜Õs¿)ç¼¥¥¡¡lßIÊJõ\XÊý«{Kh/§ù^L¹˜²Ù??‡r?‚Ÿ…ðÝ©Êys8¼»M^1ço»_”P.å;T)å2Êf„ñÚ£ÜcÌÿòNÆÃøÁ£Ü£à¡±{08•¡'›ÙMó£˜öbÆ›ÿÃÁ¥;Jàéø›¾PÜ,ŽQüŽâwF?áòùò{#…º”™]ÜÍN³;ÇLy ï'ö›râYN} ;b”Íþjôľ‘à_EÙøSI¹Âä„äšÓ›ž7ÈKÇßü4à†K\¢ðrxŒ{O÷¡jøHîUðJx</·yO9/·ò¢ðrxÌÖ쨤¾Êô›=ØWÜŒv¡/m<^—C¾ùÖO{Z¿qƧõ£/­=p1 üM¯›ÃÇæGȾýÓ~…ä–Á-îÅŒ+A¾Í‹2ü‹Øú„ÜRÆ—P.†QŸÞl~!¿y¥ö–þÅÆmÝ°~6Îú›>Óc¼mŸlë6åap[×G0Âó¼œl=Ï{³ÃæIz¾·õ6´¯Ù~W’×aÝ1m²ý5ä‡ùeû‘ùÝÞÿ ‡Böç0Ãødë¶á‘ö;䧵‡÷GÛí|0˜ï:ƒÐ;v{×(à»XìïG}>qɧ¾7ëWoäæÁ{±¾õµqÃw| ]þìåÏ/Â:[h“ÐBþÛÌ3Bùç'ç²t®§ÔåIŸ>Ò'ï#çºÎå­•rLËÙo;×u²Ö¹keì-ºKèçB7Ý*t¡ÐB×À/:CèD¡Ó„Îú‰ÐåBW ]F?ÿ÷)*Û.tÐÝB¿]sEÿ¾ª¿«è˽\yönÒöˆP€  'tŽÐÉØp´Ð¹è÷rO:œòÙð3{½ÐËŠª.ïwî×ÎõhQž›p®»´wÏU|º4Kÿû…nDÖqB„ µÁ— µ£ÛctПDÇüïüIaý²Èû«Ð1BÇ«_YˆÁÞúh9ëqÅÅ=/ô~y‹øû6¡'eœøÖm©ØRL»ˆM]î“òháb¿{Wø¡Bo M“òÍ`àãð ©̺L—¿·b“à—}¿ú›ãeù\ò²d†v™"T.}žºXH°p …<.3Å^©ëþÆßÇ¡çžBRßMÚÝZúŠŸNüuëE¾øÕã.]·£%BGݤ9’õ„´í-ò²EþV|ÿ©ÐR'úºúÜ:Ÿ¼^NŽ®U|ÜUB·“§÷`÷ï…~+rk„$O²» IÞ;Ý%z÷Õygõù’½DVÇÄžÁbûþ2Nteûwâ»°÷rló~®“>%bß¡äècJ^f˜ü¼6JÛ±ù|Ê.bÎ]Cœ«¦ÖãÈ)ïŸäƒ[‰ zGŠÿL×¢o2ç’Ÿó ¹× ú­xwÖ¾Ým¯a¯+çmÆÎ~5OèÚ\×]yý*­Ïaí+`­šRã‚"ä—ÚYßÎjô³3J ßúìéõ”óõÛö‹¼5~…ݹœIó)Æn»ãØÙº‚7ÂjΪqÞ6ÅŠKýöM\qù†5;ùýØ‹ÏPöbp±½7Ê·ùØuzdz3`5¸ÔðV\»^qIð¶Ðž†_Ó~vW³»Ý*Ái$ߤF³Ö—8o» ö¢FÞ(>B~WìnQäÕ°'&ÐßðAjÓK~L¿<ü`qF¾¢or5¿yc«ãÍîÞœºqF²=ÖÞʆ›ßäMd–òñ¨÷Þtâ¼&ô&ý&h{ó@úÙYÂÎv뇅Œ+â.Vbw3»c`‡ù5Š»|ù—@~ùÕ¨ó.w6øõ&ØñEøU~vw‹a¿Í¿Ñä[ú*±¿ÆâÎ|¯Gÿ_ÈçÌ;;“Uo-ó û4/Óo¿»û ôã·ÝiG’7µ¶.ØèLý€ýÆÃæÓ@æálgÐ ò¸Æ~c¼«çM¬Qçiл Àm88Ú·Jà üâ¼y&ÈÃFÕ›ü ;z“Ï…ÄÍîöÍbëI-oº‰€y¡o”É7È{s`ñb½«£úô’”|ÝÞÖ±sþ”|D¾×Hò%‹é'Ž…ö¶I\ìÌŸ¾Ë›ºŽõŒod>~Å|ìcóÙÞ„ñǾyTa‡áPÇo4êÒuóïÄ!—~fã#oîxGM¿ÞB+ñw4ëh|/Í£rÍn}#O~A}òØÎîé»’}#°»'q¬FÍßZÞÜí7‰ƒw¼“Z~ØÁÖýr›Gäïhì°·â88ÅÉÛzæI#r²›Ýö›[—âÄ#®øõŠGr³â–ü”ùÑ‹|BþŽÄ¯ò©{‚‹ícö̾¥T‘7ÕøUCÔ²OÕé>Ôó†Þˆ\›—YÄ3úËë]gÒ¿!É'.6m^àŸûîŽäÏsþ|îÏsþ,/çÛÔyØ“œSgº?Àw–®…ÿÚéÑŸ}7:=û{ÝÎò÷9ï99c»1ðœž9/qz‡ò÷“K]êÜ—’ã'ßÕBþvÿNÚäÏþ\îÏ®ç ß)W8=Ÿ÷w§V§g]oëÑü}.~í*þn¶ÉéÒËògÊhÜAS÷– ô»}åoO™l»_æA_ëv‘üÙx/§÷Œ“~ÀxO7àëIü½}Û®ØtxÎÙÉþ¾¯ÿ¥ØTðžú=}Ö;½Gz™~>¬ýž>mØ~!åyÄÖÓ2ÆÄ·£±NsÚ¸ÿqßv±¹zÖéãéPÛ3Û•—m÷÷ó¡~Þ?¹:¹Ï¹IB±e­Û1ž„¿…Œ? ½"ôõo†ì0=~=8 ÐåõLpzò´ܦ*íð;ßœe­KÛVÉ}ÿ‘¯Vv߯m٪ūÝþ·À£Ú[WSî¡åå˧"/U±°mÅê#¨é9³m銶•­«×¬l3)3ZÛ/óRC,ho]eXeÞÂÖÕ­£­ãBÝ{¬\~Ì(3ZVK—åÓãÛo·½#l›§ÿ†žÝ,sm/data/smacker.rda0000744000176200001440000001025112266061177013727 0ustar liggesusers‹íœ p\e€o¶y7Í£…ZšW›¤ylv³»IKÙ¿iž¥m’&m*Ò–b>±<•a@ž"ÊqqGq¬2ÈdF†‡:Œ£ƒƒ P”·çîÿÛfÓ%M…*˜9=ùÿ{þóŸ÷îÝ»]ÙyB8ÿ„|ÇqN 8à L‘?3òO†“éä ÎÙqÖÈi›7lwœ)e2Ì(’«·;i>&ÜqíÚÚ½›ÕW-ÚzÇ3ù¦W¾÷‡=žne~ ÉçqY–›å'¾ÐsOù&R»÷¡k×ÖMŒ«ðéZ`×G­¼c®G~·Ö㦽+©È„×µ]›ô«Y½ó|/üù5iâ >Ú¾¦'$Q½h›é»s£÷1+½§üüzÓï—LƒEcæcv}ÚuÑ~+gà>fÅÝÉ@;ø}“춙Z?t Î]·Ùº¾îa+ïÚG¬¿[šÊ=BŸ.|àzlN)=`¼®é°yÛ¹û¿%¨‰iøü¢úýƒùÿ3ÜC½í)füiÅù¶ƒÓÑ7OâÿÓ·öô3žÄŽ¹?ŸðºSíyÒ³…ñAâqû¥ñpÿAb­³¿¶ùvÐõ¹wïd?y(x²Ÿ<<øÀ}‘?Tzsò9±)±ÏEM Ï9³÷ÚûP}28‡µ6¾Ùûñ)ÉËkÍ”g¬¾Šö9OŸÁ>ÊGù¦òW:åïcåC|4ŸqäÍÜhý’‰¾Y¬Ëf]6zä`—ì™ }>ty¬Ëcÿ\øæ°Oûf#‡ò×ý²X§òøödÝ;Øž‰îI>çM¼¿'ù¼ ñ®}ΟxÇÊŸxË>Hüº7¡Ûkù%Þ€~<¼×Æ‹¿^ù)ÿ·“ÃòÄ;—%'|9Þc•yÓûÏ~/ãcwFǧ/*W>ì2ž|~ü«<OøIý7&~ SÿkˆÜAÖYWL½-"ÞŠ«:XŸâÏ ÖåkÄyZGSâ ~éüî×?­Ч=¸žš§¾ß5_¡ÓóÎ÷?ræqÝèT¿âWõW{ÂGí¥ö+V;k^ª½ñs0å.Á¯ê¿R⣾¥¬+#N44>ÊYWκrÖMã¹ê4ÖM{!ù‡™NœLGŸ†üÓ[×—Ûz¹?û•±NåôåÒxÖxU}4þ5^UÍWµëüxE¾büëÇ+þ($žÔ_ê¿©Z5^µ>ã‡\í4~‰Ÿlâ$ útñœÚ/)½ìïÇ%ûhÿ¡ýˆö'Y\×>&]1¦ªÜØAù–àßÔ:¤}¢_‡°{™Ö›É~r²Ÿüäõ“R íûrÁ7^ø¹ãdÝ&ówÊücŽ3¥^`—ÀÞx]àW²fJ¿ã\¡óÞëø±àßËx¥ËŠ þ“Ž’¿wÍå× ]Œ‹'g½ÀkŽ“_.ð5ógjB Úq V þ¢àŽ“+ûezûÿRÖ˾™²Ö‘u™¿[¾!<¿ kœ‹øû\`§ÀM²§sŠ€Èîô+Ð*P+à}ß7Sà(`P%à}çÚ$Ú:– ¬ðÞÉY+0"pº€÷ÐiÌ ±ŸÇ¿R ~žÌí¢³Ó ¯åÃ' œ!p&°].ð¾¼Dàj+¬MÏgb£À€ØéûbKñIÁÅâÞGå–Wt)ڢ͎S,<Š,|Šï•ëw ­ø8Wl™³ÆqòD¦œ€Œ£âC¹WÎúŒ;„÷wn`¿ËÙû2À³÷yÀ9Û‘÷sèáÙ¦ÝúÑï$uÀh·£ãìqàíu¥ÀM÷ ˆÜS$>#S^ye.OhòÊ$fždm0C@üU$~*¼Kt/zŠÞ¹¿Ø-sçÙ¢£ø0û[¢ç¼øz@àöòôý:öý2²\¹ŸÞï§ó|~2úy±eö‹•1j|ïý½» ëñõ6xî.¾È¾Wìg—«‘í:äUÙovlK̼ÜùªèZ# þÍæÞ(öZgsoªÌüQl"qP ySô¤`YŸÿ¬ÐÈüTÑ!û§bç_´ˆDïÀ­6æ2.(ÞÏn7"‹Þó–¯ìg;KÑå››sŽí ª8³k8³#ö?SÁWÉÙ^Ã3añ÷1s™¯e\Ï»9kì||›/¶×CöÝ âÆ霥3X4ã9ô 5wYâµ–ù`èÂ*'ô•ìS®×€çAW ®׳Ï|ôiÀÈÙL/šaÏø×òã­4·ïÄ&ž°ãÄ‹¶×ò{÷¸·ÐS{|}Æ¢ÏRJõ‡ý§soS©ú!_5=e vž«úkÕÞöLzÊÚ©åkÿ0ö 3¯þæÝUÿ]Ó(öŽ¢o ºv‰[ºÄ}èi§7&ÞÀôL&;å‚ è‚ŒõÙC9=þtä¨qRüF¯Y‡Þõà˜}—0ñ"ûêþïÁ' ÷ ÄsžÞ«aÇ`ʽ­ÞƒAœÍԸĮì[¥qªùn$^šØ¯™}Bèž-mÖ>-ßÃØ;Ì;Ööke¾º(÷DQ®ÇØ¿$ž¡·¥Çõ{píÝõ^SïUËá§÷àª÷ ðQÐÏB??OÈ›Fî1ü<.¤qßÍã×-]»ûñG\µâçVâ3J݈k¾i<³®EßçÝЈ‡ôöƒOô«_Œù¸¥÷óøUð[Ä…CÞê½Wž>ÓÄÏúl­Œ¸Ÿ>}|{jÏcÏÁžšïU\×:6—wjk5þÕZo¡÷ãm®Ý7D<µØßøõ+Œ]Ãwò ýô™n)uHŸÁLçžüHÍ êÖÑø1U ΃JÆÕ|^óª•OÏ:êjýl\ÌG/­_MÄY¨ÀÊåÇ~œ¥û3¯v¬Ö:¯ñ nÐ|e¿fìâ·zNùùIÄ y‡ãŒã¶çÀÓÔÁ¿ë=*qĽ¥ÉÐgõú ;ÏÁÈU‰UÌWsþV«ýxgurÏû“å[«vE/=—ç ø¡‘u7!û ÓB¾†9/"Ø5B<ûùÄXó3ú3ü6ÃÄn·|²Ðw|f/³Ùׯ«Ð‰pjGÜÔbÇ:ìSϸ;ùõ 6Q§š±K¿†Rë ã0ñ&Î"ŒýzE]õÏË·±ƒý ‰‰¯ñk’8ñÏ6Þ£^h]Ög„Aô+%¿¦‘o-Èæ\÷ëÊClåäVò:ªûSUŽ?X?k³QìÅzU“5¼»0—ø™Ç¼ooðd?9ÙO~ûI‡û!wÍœäuwÕ—’óîÐõI?¹}ÔYžå¹–;ËúÑmb¾ÕúÓ[ÁÝ…ÖîîBèÂ໯[ >º}B6Xû®*êB#ò·pwô ü ¿Ò2ø{>t!­Oø±ù…Ì·#äu3×k˜?Jërf‚@ï*ô33nd\ žÖï0ÕG‚«Tnp q/`~!zÇ‘3ŒÜzŽ‚µ®b—Ä»È={ÍdŒÝJüZ˸þô .}ƒï¿fö 1®S}¡S¾ìï–ÙëþKã–ý§Ûõ¾…¼ÅºNŸ½#Ç4æ+ «P?©ÝàÛÀu­/aüN|š6ìy,vX̺%œس{‡ÅÒù&¯÷A¿”ññð[ö‹—B߇\½ðëæzã%öü1àÅìgÐ#Áx‘úÜŽÜ ôé€ïôí„® 9ô¨è{¡×|^:×^?}–1?x&» Øz`ú¹oégÝ ðrÖõcì4ˆ¾ƒ/[¼¾+Ÿ·|‡sˆëÃCŒÙw}ýýÙg×—¢_z/cß>ÕúnìÙÅõ%.öCÞÅÈ™`̯”ÍüØŽ}cÌ·Á'ʾaö ë¹fåvµ?oÖ¸×C§çþÑìÃw¢®C^Ì Ÿè‡]ê‘K}Ðüs#ÔÝ6+‡{ó ­Þ~ý]BGßæRgÜfÆÜ¿»óRê‚> ®¸úyl8L%XûÎÆŸqì¼€ë è5îù1°k°‹!OÌ룮›öí„O'~íÒüeßÍcæûà·¿¯xÎÒi\-ƒïñì§y®ù²Œ±?¯qGé>Z7ø•§Ûƒþš—šÏ7¶G+üôœÓº><‡ù™à–>ñ&ñÃwŸ~ý=šx¨ר¡W·àWž¸Çj<Ô·umÐ鹧}ÆÑ|°î«ñÌ9àÑ—x÷ß ˜ Ös¿NóŠ|Òû}‰ÆkÍh>Fës ôŠõ>§{úõûi_²ˆ¸MÀßPßã·%ø· ê9× ö#Ëà»\ã¿Àà-{}ú•ÌÁg˜¸Z5Dœ²ÿêçíõØ5r®ÒuÐ ŸjÇC؃ºìvÛun—ÍGw‰C—xtà À1Öµê?¶Ã÷Xæáïü™PL=3Ä yàöؼp{­ÝSþ러³GÎÚà}Yt¼ÿø‡ÿ¨sÃÙ;ÎØyüäÔtæÈN&ò™ØröéÌLµ3ë7lݹI§†7œµuÃö‘çlßÀTfg8Jà´3Gv¨:™¿~dçHÓÆí"[ yÞö-»šTæB€g–>xßû’í}þ QøfïHsm/data/tephra.rda0000744000176200001440000000060612266061200013553 0ustar liggesusers‹ r‰0âŠàb```b`âgd`b2Y˜€# 'f+I-È(Jd``‹20𱵃îâë\¶Kt³[åv¾qн£ñõP œÖ©zè¾NÄA×"ð5P…ƒ.˜ rг-étÐJV=ôpÐÝ‘ׂš§§ ¡uÀÀA ªNËç œuÐk/tÐ\¶ÀAb‘ƒ.غjý3uºP{tA®Ñøæ û¢O÷5ĽúPwé8¥¿vЙ ³tÀÎ×tÐ9ד9PÞA*÷7Ø=¨ýz]¾6ÔÿÚÐpÓP}:0÷Bݯ³bŸn DŸÎfcpÐ3†ÐºÏÒ@ÀA·:!áh ×Rˆÿt~Aüó§ÔýºÇ!᧽ÚÐðÖºS®ºSÀˆû¬y‰¹©Å@†² cŽ‘¿1ºÊäœÄbt•\)‰%‰ziE@CДså—ëÁ ç¥?ÿþÿÿHýað&œu›sm/data/britpts.rda0000744000176200001440000001144112266061173013767 0ustar liggesusers‹…› ˜TÕ•Ç›­÷¥öWÕÝÐ]¯Ô˜q_ШIªM¨w_ãBF‰cT”Õ5¢1jtâŒKŒë˜¸¢‰hÜp4£Öu_ˆ¢¢£Fˆ ƒMpЩ÷ÎïÜž¯ûó¾Ïê½ûîrÎÿüÏÿÜ|~ÐÔ=[§¶644ŒlÙ5¢aä¨ú_G¬ÿψ†Ñ -uÛtÌüãÎ]¸ ¡aT:ÖÐÐYÿ{¿í}ÿ÷[ÖϾжœ7îÞÃÞ9϶ĦÏ6úšÿܺÚ–oß–9}í¤/·Ï¾š;§‘¶õè?~øâ£m[l¾jÛø¾£ú§ï//²güãÒ™óo·]GŒÎ_¶ð~›ØþÍ)›ž}Õ&â岉ԉWþû!¯ÛÎÅ/·~cîomWý«ú'6ñ½Ýº¯{ð›XÚ¼Ç;Í&Ç ¼ðþ†ÙÄ9чÚDôÕ̶+^®è¬›§&ïïE ͳ‰èñÉO¹õ:ðGÛì '^~v£m­¯zê‹ŸÛÆú¦gù™UýäÝûÙ§¯­{à'ƒöÃ{¾áé‡ìÈS_Üöá=ß²£ðÏhæsÓ»¿¾s—NÛ„Ÿ[·[½[÷õ¶õöþGÿcÉ›¶9þíÛlçlâ»ö×:WöÛyõÀµõS×wj;¢¯§l¶mgÆ·Íq8ÚmþSwêÇeÇDÓžú’]?T}e;jS8;2žæÛoïÛ‡gVíó»÷›š8frm[g°“j[$¾µÍŽþ¥É¶lNðcs?Ž€þw›[.ûÈÍ|eÉÇì>õt±çØÌ dâe°™}£ÿƦɣ4ü‘úIŒ›A»k¼M®hSðVòWâ—äî’W Áë ÄvÅiÐc;#÷>~³m'Û":ùýVÛŠß[à“æ™Q€¯µMì³ñ9ßxn ¼6ž…ßÇ·Æz”z—6Û¦h¹›Þ³ÍÄ£UpiÛc7íb;^ÚüÜ)x¶]1mo×ÈøÄVY'ñ†ì7±(" åÎ&ñ[œ$ñ{ ^K7Å8³éN›aŸ™†øÍ.¼á{÷\ã´³ðTºžÝŸ¾V²éŸÊûÔÂ{©[âÙ”äMÂC Η˜98´ âé~ãgèn_›ˆèòºmâ4ñwbJL`6qk d›üñW’u“ø?`ù.¿¦æ ϧÀmò•8m2¢ÓM+lòÈzZü²M&£À?æ¬Ã|›øŽäGBxÁvãpÛ>Ú/•ïÚ˜·UòÚ¶W-à¼<6ƒg­¯MÂ+¶qµÔ¯&Gž4ÃëÍQ6¥æØâÔLÜÁg#ù>œ5ÅpÿŽmbÍðE3xk¯Íঙó5Ç&òÄYÝçkúF\°†Ûuçf=?|ÖJZÙo+¸lãyçn';bš9˶“Oí1,³mG…é‘A‚m¾µí䛇¸t‚ÓΘζëÞ86Þ“Šðš$ß“ø1 þ“Û$ÿRÌŸŽiªlÓètáêúŸklšüIm”ùSœ7MÜÒäyœ§ÿ*z ù3è‡Ì.‚ÿ4øMã4¸qó„‚ÛôñOêeÁwê!á¿TEâ–â<ÎÞµWôǦÀEê£8áí[3¢?6õ;ñOªCð‘”BlS_?¦ÈguýϤŽ¤ÉÓa½’~FôŽÖŸôfÉ=? ³Êk%Ñ•é8 žMWWÏÈà :LëRÜ«ÍÀ·YæÍ¢[³ðK–zçêþÍ®}œ…Ç…‡²è¹¬ÖIêTvOÁ…nÜû±’?Yø3úx8Ã|ò;Ó M£ÿ2à?ó?Qºïa³ðYŽú—¹ÿ>ðƈ~Í] ¼ãÁ¿Î’ç¹{¤¾{äŸ×"¸ÌÁ¿úÛ£^©Í‘ÿ9x6GåàŸÊÁO9ΓU¢þCg5^WKÞe¿.õJýå,ú!³,.øƒq…‡Ý|ì?‡þÈÇæˆKîç’—9öãÁuÒ[ }‚<ú'üòÈãüqʃ×rô;9âîQ_sÅ…cÐÂ9ò'ûœÔß,z.»Bô¦³‰¶ù›¥_ÉÒe÷–ódâ=ºÃåæ xÉÒ¯d©g™äyÞÊàÅs¤Ñ[iê_†:—aÞ4qË KÓäµ³ø3;Ò#¤Î¤Ñ}©(J;~bÓà&E˜¢oJ÷$ñL²ŸÄó¢» ŸtißUƒ36ÚvíÛàÁVêr<ßCèÖçüî¡vÿÝèîñ‚ÛÂÑ­Í/Öñ¤_³^Qü”ã\9úÑ<“cß9üŸ¥®geáM¯k%ÿrWI]ÊÁ'¼ï¡›roG‚éyëÁKyüÇŠc<Ï?µý‰§¼£ùD=÷à=ß#}¿Ë3x)>óà:Ïþ ì;ϽD\ Nj»É«nöÛ¿ö o{éÆRwÆÂ?ãðǸ‹§}à­½ÙOÜú¼öÓ÷÷ß(<Öÿ–ðI\©Eò¶Šè,¿Uê¨?Aøʧ¯ñ—J>úÊ:þ?„¿KÔ¹ùâ¯(Q×}xÂ?;Küæ?%ýF‰¸–¦ JwŠqv€yà!ŸçjKÜ·”Îÿ:KVâüÛQ‡JĽD-ÁÏ¥s÷¥I‚—ÒÞ’/%x§t¡Ä«D¸ù¶ ®Jw3þlæ…_ýwÄ¿>xñщþñ‚w‰—…ð‹ÿ…ðˆú׿FøЇ}øª¸^Üß©‡EüYD_ÁQ‘:ákœöæ£sý+$Ž>8öß•üñ©#¥Qøõ ü´¿ðR ½ZBWøè;ÿ Ñþ²/ÿ:Á¹‘ä•¿HòÔ'_|꧎ôÁƒÿýßJ?ç£Oý{EùÜ“ù¿ˆßúK\ŠëD?ѵŠþh’|/RûÁgÿYâ÷þݤ^ôÃ{îw›Ä¿}ÓGßÔǸqèË>ø¥ñCÿ Á_?u¨Ÿ¾³Œ¬Ûw¬èË>ðÒG>œŽƒ§Ç‚›±Ëwc9×Xê²Ú^üÑûÑ'·½è‹^pÐ /õÒ'ôÒöâµ=Èz=ô;pâ,ü’I˽gúÉËÌ(áý ûN¢O’èÓ$ýzRûø$ë½€ë·écè•õ(I<Ô}7ëô ù›E¿æÐ!9ô€§uþòÐûÊÿúÂ;Wü—'Þù,º ]ž'ÿ ß•üÌsÿRà«Ž ða{4ózè ¾Í;AðCä¨ó^õLõ ÜZ<ºùÐ!ªûòÔ·cÿßäýÞq@*áNâŸ?†ø5Üsاð|ÅÈ}Á ýHæ1c¾´ÂKƒ¿Í‡1ží‰—ySöi^Šy¤b8§áüæ.Æ_†=MöcŽb}ѧ.LQâ`ÒŒo”sì3 ¾ÁrÙ_°RƬïžãç€x7ȼÁ•‚‡àLñcpßáçàÙw°õÔêxɃJõ™· NªÊû*¸¨.“y‡Yâ\Å/ÕS™g–à ú}æQ+|P©â¯/µÓä|Õ©Ì^œ(qª’—ÕoÄ_ÕCbþ¨TE/ ŽÛçàÉYé§*Õv‰w5ËùJ¬Ó;Æq}¯ãՒדÀÛ¤OñŸ>§Õöª]ìKmžs“Uò¢Jž¸ó Ï÷Ï™ÿÇ|7›ýÍ%^§nªçáŸãý/ˆÛ¥Ìs9çÔ÷j/fŸà¯ «ðGõnöiÙ¼àpöû×U©Kƒ¸ZÂó›ÁãY¾ªÂ_Õ?áOÅ©ZW×?‘ÏUòkØ>tÞ¡VçyVøľ®®ãûwÙ'|^%Ï«›ðÓçäxšÉSêBOà-ÁWdÿÁ^¼ßOÎâ×àP9Gð]žËwjÉ£` ß oox ¦Ã3?b=å‘9r®Üð^ðS¾GøÀOp!纄ý)_]Å~®ç{}®†}w5ë]+ñ®aßÔ—`1ç/Á2x ÀW@<ð€‡àEx<+؇òð«¬O}ˆw@ž;û>çj©;ÁVÙ¿‘þ²bÈwWX7NëÖøÁ€?t‰ ñ6à€˜¼‡' ñ7ðµ9šýþ3õPç?nÞïQ÷ô9x4ð“ûNÇ©ÕyákxÛýÖy†Ž׆:g¨;ž3àÖPwÜo­Û?ã;xÏ€?ókö® u΀#xÀ'Ž ¼`6Í[¬ÿ6ãT—¼Ç¼Ô…pzAuÌzνŠ8€O>NAG¸ñªgô;}®ž2Ô']7„Ô:]¥ç@xР7_à}òÖ߆|w渚<5𻯠zÈü<~™ÿàWC~…Ôã°SÆ…Ôë]þ:utèþøº·N¢ã¿ÈKgè^ò:$OCøÜ­?TßÂïá®ìW­îë[¬OÝwþwzš| É“| ÉÓ¼áwgÉÿpó ãÂ3ð'z1„ïß³òÇC†Ô §û/àœg³o}®ß_ÄyÉ¿~ÁKHºßð|xûÕ¾êúíoô9y‚/׿hÿ£}ËmìGׯ!:'ÏÎjŸs ~ÔõÕê¼ä‰³Ú‡é~´¯C_„äoH>‡ä¿ëó¨K®?„œ¥^¹þ’o| PwÆʾÀë8u}0yãìÐ>YÇ£ÃÝû¯Ñok­œ;¾P^F8þwfïÿ?~W‹nqãÑ;®Ž‘W†<3ô«F÷EþòÙПxÂÀ?¾>FOÀcq àå€89«zCõ‡öƒà8ßør:Hu}ªÓiä·ÓyªUÒ'Ä)à\A/óq®@õŠZx/€wt‹û ?:‹þ­nC÷Ó‡;Œžªr~§³©CÕ¿ ûUÏÕïÚÇr2LÇí;ȧ*}¾{?´¯Ðùt¼®£}õªJ=®R/ÕqCû¯}x¨Rߪè÷^û ô¥ó—öª7Áë;†ÆAã¦q¥NºßCûê`@ý֟Пäo€NsøÒ>e2ø"¿\B} Ðku( ]ð+ÖQœë}ˆö ÚW¨ýßÃ#ýd_»>AóHïYÀƒ³Ú/hŸ ¿5?õ>GûÍë¡yÞð®?P½¯Vù„x8ݯü³=<¦}÷Ž½áø‰û w/¥ß“ï®PžC9ý­|¢Û”‰§{¯}}¥Ag˜§|.0Ôƒ.p¼¬ÏÕÒ7:=©¼Ž>qº_ù½áæUÞç^ÃéSµZgÔræô(ùnàCŸét¬~§u@ýÎý’ѾÝ­õÀ4 Á«ò¸ö·Úã/ÇëjçúÕ÷àÊéä¡}‰ö à×ÝwjŸ¡÷Ȫ‹'¡»TêoÕ©ãÑ;£7¨óNgƒ/§3éCCî%Uw:ÎþÐ{sÕùªgàÃtºG-õÂé'øØݯ“¯!ùRŸCü’¯î¾¿PßœNRýDþ oN/©_¨ãNªžoN7ª¾U½ ß ÓŸª‹ÑENo«žV}N¿’‡N瓧¡Ü ùç"cNœvÂôõ¿$¢,"›£C2{Ή?ú¿ÿ¦dö´…C¿=vö´ú­>l=nÚÂi»Î˜_ŸvÈð–ùsNÙU—눖‹”Ë_l€úyôßÿž FdÞ2sm/data/magrem.rda0000744000176200001440000000143712266061174013555 0ustar liggesusers‹]•ÝK“qÇçK9íSðBÍj^4ç6§åËu[ Š! ç–9{^ÝDPD]Q`WEtAЭ?è*°?@è"¢ ¢o´çÙù<’>°ó;ç{¾çå·çBb.ìŸókšæÓ|G*4_¥ó³Êç|UhUZ­#k–Ó9caYÓ*Ë^švØù,éæï5çy¢Ûï²î£Û÷4÷ÑÍ5±gÛD?¨a×EfžŠ,ÕŠŸ=÷Aôú ÷ù¨›íàÜüŽHùÑK"‹?Äoñ¯œ_­ûâ„Ä¥LÑûÀë€WxRô\Jââ-bϼ^|î—èÆCÁ)4‰ÿü Îߋݾ(xö pÅnÁ÷ÚyêWÈ àXä3ž žq[üOÀ·@ÿV3¢¯~݈´È¿DßüYp¯0ê5°—–öö#Š,2·Ý9ßI\?ë¨ø…Þ2‡fø݇¼ÌEÉ[¤o­ÌßÎ‹ß s™½Äþ0ÏÒMÉgÒk¶¬Ç·á‘íÂ>ÞkøÒ‹ù˜¯ðóö«NðÍçÈNønqîÍå2{÷¼Çôó'¸wˆû„ß—2^|“>›Þœákƒk ‹^d?‹ôÑ>Ÿoø ¿Ýû5,}VクF_–qÔIæ—=VH½¼I‘*ÆþµÃ/‚ÿ Ø•}ˆ|c’Gï%>B¾ðW± ðIwF쪛|’oý;zùFѧ6¥®öxLÒ·SÔM½ª>ÞÿÉ4uOŸ”¼!ê‹€?§ž§‰¤®1îœ<ÍÄÕÀ‹¼* NÓÆž~«ÎÛÐSðIRG;ösÄsÞƒ½{2%q*Æ=;ëñäžñ À3Èyý!»%ùg¸‡3[à Žê'¼VôùÿRSõâÇ<Ö·öÖ¯bô»ã<$yU¼Q¹ç*Š_”s> aï¦ßÇÀégŸ^àõrždOÔ9A¿’ØG™«j ?ìž·[õJzyÁt~¸·Ò‡ñ€óÊËVrÿ½óikä|>mz‘žÑŸI[é`Öp@÷¹×…ëA/Ù!7™Ë{ggç‘#¶ÝÏ?lgÝë‹sm/data/mosses.rda0000744000176200001440000001223612266061175013616 0ustar liggesusers‹íYy\ŒÝÛ?í3CÍ}ϾTB‘”¥H]-š™ò$…´ M’ •²%Y£I¢©H–ˆ"²dIõD Im”R(é=Ïïeü>ïßïïûùüþ¸æºÎ9לk=ßûÜ3ö–Îú4gBHÉa’•Ã¢¼,þAòˆŠ¹¢@p°g0V`þ3Â\/j#ª,QMŠuãD¹ˆòSQç}Åãgˆzá*¢vº!ÊþHDyxQFæc]cDÝÄAÔó#ˆÚžŠ”^ÞEž1¢ØOG”˜{ˆRF"ªÜD3QC#êEOD}ˆhã­‘Rz3RjZ(Üv¬¿ë#J9÷=mr±ÍFl3 ë@´‰’×'¤”*À6¶! Ùˆ(å@>¢<0Ä6V!ªñiì Žï¢¢~ˆC4]ÖBJ¯ÅˆÂ)E»ýˆ²ïŽ«ÛHÁú,l£QómµKÑÆ&#š+ëãÙÙØ'SDÙ;ëãøPŽ•@Ô$ë k¢i¯Á1¨cÿ·"Ê¢:ì?û‚m£8^kì‹¢ž ºÑ´ðÓQlË°ÏÛq^U†‡¨rXûQ€ãìXƒhêçm¥6¢0.`ûø;Òåþ3DöBÔÙϱý¿5óNsDÓ™†h[íÈFDaéàøLå ‰(±~>¢Î­@Ô`o¼w¢v/B4ÍCˆæ4)½âaŸw Š#ö=çïÑgìKÎöwó0·>¢~ŒÀ>ÏCJ ·p.å/\§21î˸6C8oJˆz©çyÑ&¬F”Ý«å6®õFDÍÅvt=±/~HR I^Æ#I£'’¤é#Ij’¤,ÁÔe;$9:€$žiHâ‹©Iüº‘dµ&<öÖ@íR$Ñy‰© I¦f`~It{0 Éä:L›dz#’èY q÷XL^HÜ3 ‰{ñ< ˘ ñ'{,ëâù@ÌëðÜ $.X ë&ar@â«6H|Yî¿ç/7á±_ú‰ÄWL8_ÈAâðHJCâMVH¼¥‰7¿À¤Œi‡¼ÁëyXvÅT‚Äɘ¾!±é1Lwx®'æ\$6?…Ä€}*¦Hl¦‰Ä&Θ×#±ÞWžÄJ3‘˜ª‡y¦$V<€×> ±²–U1¥"ÑS-$z´‰žüDý0mA¢gÓ¨|–‡ñš<•e!QUÅB¢Ø˜¬±¼S–›‘(~ægèP-Ü€D 3‘èØ}$rŽD"' -ÖÇòZ$ZbŠDöx?‡uH´ü-{׺hi 2ˆ;‰ø‘H­‰Æk"‘P‰Ô50MÅk˜«¶àõ6dõf ²z—‚¬Zd‘UãdÕƒ¬Þc:‚¬šÔð|5žóAV9_‘ÕÙTdu®s²ÊÆßÍù(&·Ú×3åB ¿øÏ_p6áÿœýÊþeÿ[Pöûÿc²#ÿ†]ñ° ©üƒeÀ륽>?8¯ “Û—\Õx-ý*Ò8±}ªé+W€Ð¯G\4@÷AÊnž-ð/~Ô]φ:£¬¦ã=0pË^»Ü¦[&»;–ä•­ãòÖ€ÀskÚ† àô¶³f}²°û~cl ð¶ÃáAà‡eÿ•ù„‚Cî_Î:£*µ@60-϶¶¥K&÷ØЈW¦1úbPî<9aEs°ƒ½w¿(Ÿä…图? “±ÐÖ¡«X+#cɵö <ã€mýóÀ´²»¹Ïn ðáµìÃ@úÏg·Ç/¸ñ I+ô+¥ùcè­ÕW+ð–žÆeçs³3¶ÜhòðLÌ=öO÷Snÿ̇÷Ç@ £î}ø¶NïsÒ ×R1³q0KÜNÏ(0ŽÓZçíÏIÜ ½Ò¶1¸=¤BôŒÀüJý,Ú¼¢ !sï=nÑ;™ÖÁÀ«}5¨³@péa³Qapˆ&ËWïä£{k‹+€¥usDVx™þ±•©Àië߶×5¸ºËslZ¤ùãûïû­öx¤Í¼ëFŽ |A*wÞ¼O±ré8ß±ct†>'GeRoh© ð4ãû6™ä{Öñù)›{€st¥õÉ·Àh¿mb·|=°'Ûí8²È¸ë*;’“¿÷$<µö¾£xzÏ–ò;þJ³¶•YaÝøA`¦„_ºáΞúÇVû¸Y¸ ]c’@ððÍeMH`ï˜sìJ·â/œŠîmê–ó ÁÀq)™ì3 Øâ»×TÊ7»ÉÕ}#f¼Ó6ž…ë9÷¢ª_êSàÝvA©xh(4ºW/jµ¦¦Æg©zÀ›¥h5¿-ØeØ-2ëAýÀûÇ9À½1ig‹ŽïʘA°¹*ŠvËT_y¿Þx[„}Ù™«C1~TÛ,‰iÿ¼Š¡Ež~†ÀÞ©1árl:pjÇ»|ªÑî^÷ô ‘6P{Jw?3C8Ur×æûµŸZýu‡+Ö=˜þØ7Çžìã~+ävÐÞ\‡zD™îüìÕßÎëx‚ {÷±Œ¬©Àùl®Ÿ üÙ•ôãy+Aø³ç‡0l<°Çíš.eàþ¶|ë#Äýq2|Û=#àì9ýd9XC‹3J_a|ÜĶ¸³Âxú§•›°ÓÂð98?ýn²YÆÜ€ÚDWðÝíÌýUk€¶Pçzp ‚þ®|– Üœºð§Ÿ·çºþ¨£\pgÒÚO€ïØ¡fñ$¸¦Ï·¯öÆùLPIUÔNz_ŸÛW)ΫNH/·Üž %áqÞbœø˜P1WÚÇj—î×6é»YÁ¨üŸsÖíÛ_CPoX¾•ê\Íè„TK p¹õö†¨øåÆ%'µ€ªoˆœÃám Œ ’5q¸>ÈØëDp´çmÞ8¾ãZo²ke€?ÒèļÜs%'Š “©Ðù¤@„‡'[˜Ltþ‰Û‹BÔØÀ“óØŬ˜ÌÀì…û€O©ùñšÄýú5Í⪂9°¿ß,3O+îì• kž”«nJ¦¶¿'`©Ùc—Hàw‚û®€8`ß_áöÈ{:Âs®ÿ¬È£ßÝåòùs÷lëáÀÏ‹§N»÷¡ªÓ¨Âo zø3eæaà{P‚¬¨¹ Zeõ½ë{*ð‚G¿›±ö üO\™‚ÏÁî¾#DY ð¼9þíñS¸÷§/÷_ü  lÿéC‹yâüK5âÍá= °ÓÌXçaØîâè°› Þ¯5|Ù&Tod¯¿P}÷C÷µ­U'—¾}ÓÞgýОš6àYúÌcß¾ ê£vÞû\ ê’¹o{ëË»«ïŒí±Bték-æWMÔä͂Mõ®{)wábÇÃÉvÀ 1Ø®ÌõÆy¨¸`óãÓ• m†;2@-}ñ èPm߶[aÆ!Õê%§*Œ7 ?O'ù‘ÆÁÎCÀ_}*°Ög/Š–V÷”òAàè· gl$¨z™›ï½(Uïå‹Å'÷·˜¾ß×ËÔ±µž›€§«4)Ÿ»wbþK ?`ïê·}~é50%']ºú€¯i=½lq3ð¢“fu3p?}7Ÿr¸„låü3à*§Þ06íö-³«QoŸ8|zLb6ðÛ,Tõ ’aLDÙð–~Î{IO§V¦ôEplZ2.µ‚Êš.þË)Ã@ôæ/;ë D’²rŸãBé:Quü³6©ä‡ÔÎO´¹@±jñm4èwµ}Æ™äHŸÓ¿ÇôGM­gŒ‰·>:Éè# ¶Lâ¯lÉzËköÕkë¦  Ò3>xsŒ>è­½ ˆ#•ƒ^¥±ôŽÇÈcu ­c†£<:ÔÌ× Vzì‚É˪?¹È>9lÔ  [¤¸híì"çšwèÔYú÷ ÀБ8¬;TDäÔ¨‰¯:>.è¼þ2§?ñV2WÕ篢Èo™Å-P M4s>Êù«ûݾo•†qäë Ð[3³˜Äý–µé'Æ#Pþ9ôS¿ð3—¡Ã3€Ì?ºlÎW ”YN)[°oäÝz±«ó}ZÄÑúA÷·yÏÊõ[Mzo’Æizv9«2ÈøŽÍyr£€aì¥PQô·4>fvlsÛR:fÔy 7škÁà §‘@¦moìÞ œÒ–²íò³¡!ºI_¥ÄÝÒâ¶Enûp½©®ûUÎ ´(® 4ðFY3gÿé@º«ì^ oäÊ«û”õ¤õ'ÍÝN¦Þr”ÆE²“zƒu%ôG}Ñ|QÄô…ʽ@N8%Û¶×%e°áÅO êg ª½v’â(;ý½›ZŸe¸ƒ³°äŒÏ n*³×ã{sØ»æø…¹@­”~«X툙m2߀0¬8Y‰ëtcÈÒ÷!Ž£ÉòE¢‘~_t+èƒÊ‰¤ñù/@4T[NnR[±A»Ç?´;|Ùgšî¹CliŸÐ×:víÑôºÎ#«Üþ+@$@ ÅDi~nÕ Á_ÀdOYzz}!U°¦½Ø ˜¼¬ÐSj{ÿô…Á¼Jç½øþ•;E¿§ÒˆOsýžÍî†ié#•^S`¤ïSªS ~Öä·½Þ@Ž‰u±¾sÈä°±Ö½]@æœ>:WÈ¿,}ƒLž™=ÕáévÜ߇ãÚZx¸ž!×h>J@žéèìrGÚg¤ÐÖå‹ÞsÏÅ[\o²~{­îe`)–/(‘-²Œ|Øb7äíÀÚñG€´Ï¹s»dj¸ìéO`ŒR/Õr)R/ͦvÏc U‹ h#_ìTçl°Á÷gJÖ—§§q•Ôû]Áó#Â麌›y³/•ùcås{Cg齟pLÜs>z&0¾ì{¥0WŠ+Ò8Âä·õn» ÅäOË¥÷(BX¾%&0”‹V†,Ð;äeËÛYõzÀZ_]²áHêŸ÷œeŽ'*Ÿá7dD Ž¼›`Ú²¿Úyk;½§PÏ|7æò¤Éöãß³Ë{åƒg“­m4vó¤IÒû1ékß²96ˆ7÷SoT̲ghÜ— Ò÷&úù‚hôS?MòFÍU‡º«?€è¾ž’ ¸ä@vT×ω@´<Œ]¡Œ¡KNäÆ£@Ÿ•wüà\`ðöÊhO&è}ƒ8˜¦yfAGÛ=í+*­ÊþóªÆ‘#ø^6ô2¼UCø´cã3ýk€uÀü­a[ì_6…k *(Ò ž†v·c ¾·{²ãR€óé³¼¼#î××–ÚïuqÝžæºô ßé(¿±ÞÀBš?²Îuð(¤UhkT­ŸŽÅ–â;cçà›×jo€x*Ý?e âuyãˆkÒ÷eRöʼnùŒ ÃOLl ð¢ëvnnÛFi?0"¾\¿°l «©o=&yIqë÷¹$6)ß9•¬üÓ•4éùbìûò`pŒ¥t_Æ$ú¶7ª¤ýñ‡Iþ[ßPG)ný>7 ú‰ÈâÄx`°õOÇúÌÂõýÑÁ5Û‘X¾kìêh)þHÏ×ÍŠ¤í7ƒ€žSk¤ì|g\â{<ñ÷/ÕŽLº¶ HzãÒÀ«Z@|K´Zì'äÄ`•Yƒ@XèM ¯—â‘ô|™ìÉfÁÞѦ^rÜê(9¡:°é™m;òí€h fc\Î4²oh™ Ä[Q}É™ ÖFì˜nÄ:]ù(¦¨tzLäã÷!b¦’šü€5Uâ9Åÿøýë}žð:êQrÔ¾°ášGÀzvÿý¦:_)~“ºsüÒbK¥öóòeC¦aœ6M»Sׂ÷QÒo—­Å8áîªËËÚô3¯¦©wñb ÿÍD# ‡£; ŸH9ñUÝeÖÝ)îÿîóßÏ¢P’o´Pë>üÂßûÑÉlÃë¥2@îéd¬UnµéäD–¹ô9Ï I29=õ¾4ÏŒ‰_ ‚‘å¿í…]ÆŸºíøvãTÒŸ¾û…ûÌÙÏÕõV ¹teɆÍò@xÚe´iKóD.ŒŽÿÄnV÷ì‡fÓ>®S &>ßßòï4纤¹êò«~?‡È=a!:ŸÿÇOî ë<üÿùßÿúßð×äÚ€USüÿ}ük o ]øG–΋½ÿÌc9ø×O_?ÿ íÄ“(»sm/data/coalash.rda0000744000176200001440000000161012266061173013707 0ustar liggesusers‹ÕW=LA^îñVP”˜àîÎßGAT’‰ÑhaŒG#Í!$*àqÆŒ±ÁŠƆÆ L°¢±¡±Á qææ{lÈi¼ÃÄMÞÍíÌ›o¾÷½÷ær#WG/ù£¾çy/ÓÙâe²æk.c>Z¼œ—7cÛøLr?™›ò¼ìiój×;ŒmT]ö,SDzi¹&[ëر#°¶&Ûñ#°|Ío²hÐÚÿÐ:êØÉC¬sŸuy{}Ô…¹“©ïíàãCóîÔzGÊ'?›s[G¶>mÝ÷³½{ª ÛîZð¼3ÿ æÙqÓ˜âƳ™˜½ÿïw8õöïß[ϯ÷ùýë݈iCÇwüáÙåM-6Ý(ï-«¥¯Z^_é™ßº¡Õ²]x­Õ£µÅ±þï5¿øÕji{!ÔñÍuó|Ô²5°Z|³jñ¹ÇìЬóm‡[ôªŽÏ-™ç…æŸìˆé¼çÉŽ‡$¿wŽ¾x>¿e¨jUžèüÅdõÑò™¥ëk†óùÛ!ûhqÅÀï¼×òrÉ®hþκ k = OÁ³ÇáÇð#~ñÃQ[U¡´€^œø V7ÖøóÀéU\rq Ì‹øï5ÇKØamqï<ð§øô#?Iþð»øÒé£è¼N·.|èø$tTÈ“"Ýà/‰âŠ[GÞÁWC?ÊåºÅÈû€@=½±ËE­ ;[…¾ð—Ы–7èP sàOzp¼GàOº*ÊóØÁzáà}qþ7/?ü$êY"n¾ƒºD]¡[„wEñ÷»øü∃ú…áƒ/Ã~:‡tæÀ—¨G™¸º+Ð9x€n|}ÞTïê”Q!^ÂçàEú×Þ¡ŸJá«®ï"ÄÇQ‡1øðTÿÓ}“NÈ7騾Ð ÷MDxˆŸ!îy'ý¨Ïbº°?¤ût@ÿFàǀ˩/Á—ê)DÝqÔ1ÇþFèyžê–ú}Æg¼>ïà|Œ>åX§¾¤7xo€û.D^Ê7Õò"¿ú$Ä9 y¢z”'ô}­ {p9pòÎ?Cýn ¿t¯‡¨ã:qW/©¿M­ÓɃ‰9üPf1™»–ÌUÈáÖL¹2E²nO”Ç'¦+iqóÏ‹@hÒ¿›T’ÁɲÁO¹çË3é\û›±)ÛÝݽ`†ŸÖ~}s¬;ï sm/data/aircraft.rda0000744000176200001440000002500012266061172014066 0ustar liggesusers‹í}yxUÕ¹þÚû !LB!dNÈDBHàDQ#jÅÖŠ8¢¢R¥8¡¢"jŠ¢8áŒÃUTp¸¢‚Ú:¡µ­ö§–Zk½ÕöR‡VoµÞwï}žsµ¢žßò<ËuöÞk}ëßï[kŸgî0kdî¬\ç\è‚À…|Œ†øOà¢.}öœCŽž{ôœ:éï¯Ñzaø&ô½?× 2ZŸ¯Ùúþ­ßW´þl2ÚvŸk¿  Ú†Vø­èï´ÁÛ؆|E+þšmè6¶’¿Ó†}E+ý'µ²R+ÿ¶ŠC«ü†­ê_ܪÿE­æ_Øjÿ mø7luÿäVÿ%­áßпAkú\ñwZó6´–¯ÑF~®µ~Aµ ­mZû×h£·±uüƒmÌ—´±_ÐÆ}Ã֙Ѻ¾fÿ ÚöÛÐ_Ñ&ümâ6´Iß íðwÚäml;nC›²mê6¶iŸkÓ·¡íô%mÆ—´¿¢íò5Ú®_к?×vc›ùmw´=Ügµqðmû¶}Ûþe-ü¶}Û¾m߶/h‘oÛ·íÛöÿ]ëðÜ”Øc‰óÿRýaïµú‰x½ïëg®NïZ”>¯›ãöqÖuú|õ‡o¶þÕéóõüà„õ? SŽ3~ŽÚj׋ø\üi¼úƒ¦]Š«þϺßÙÛîïëÓø÷ÌÿáoÉF»ÿÃR»>zuzÿƒùö|Ɇt=-™a÷µ®ä¿ ß·çÛÚû=£{LÍ_¶Ðî‹¥wXýE ¨öÇ'¾øzåøÁ–tù$®O£Zçìˆ=?“òŸLûïzÃþ_Šï³f§ó•©ÇÌûÇpù[ÒŸïìúœµÖŸIý.>ÇžÇëe”ï4êë—NGãŽë¦>Ž1>Ï渳)ßä[þ­qÇM%Ÿ¤òÚôqâÿ‡’ô³¨wùŸÆÏqòc==k¬?ë%¾(ï¥/ÛxÑ9ãëåüc/6»ˆ®ø?DZ?eQzÒŽ6ï¤<“ÿd®÷ÝRë3ãmI믧_‰éiÑÖt¾OœeýåãýÊy“ñ¹âƒt~e?éá Î_Ü“®Gém…øºÅø—\W-´þ´Žt}öÿ¥òù“ÖŸÏyK³­?5Ÿý+&ç‰ìúbêåTÒ“_ëz%ýG~&}-î¦>6ó¹³þ¢fŽ›‘NGýÒ%”›ã¥ç«Éï’k×Íø•]—qœðOr_Fþdw_N}\Dû^µ ž‰ƒ§8=í)»¿b¢ÑYByWŒ¥|ˬ_5*}žÆ/£½t-¿=£4]îK{8ÿÅt}ËÖ¼m|œ¶Å®¯ÝÃúó8Ÿv=­rrÞKMÞÔÏų2äãº×¿‘.ôv õy×»h¹Ý?…tÎf¼^*;Ü—.ßJ®³ê>'žÉ/µþu§Û8á²ø8‹~+¿;ë‹Þ\÷ºÙéôÅ·ø‘H7qÞµoqZë—mNïWuSnâØéÍÖ+Ž…ƒ’W~{ân½ÉuÝIérKúò¯«è?ŠgéEr\Ý>ÿúÕö×pÞRúÙõËyMºdi:ŸÂéCõÃÕ¬SÄÇ:ο˜üÞM½¯bœ(Þ.¤ßÉÞ×1n…âûÚ§Ó¯Õ/ïfO=_O;ËNwW{úú’ÞÕÇZ#ãFySö½î6ëï¼:]>Ñ•ÿÞõ_¤O{¨Ž~\¹ÄzÙY÷¯ ~…£WLºW˜>~´Á®ÏxÝä’ý¿ŠwÉ-=®Þb÷{^Oïï ÝùŠõ?z‰ÏYljŽô#ÎÝÁu×_ÎõÉßÜÙÖ¯ ^.áú×ÝjýF>¿‘ò ¯/JP>gýå¤wÞëå§ò¯•ÄáKž¶~ñDþ*\?ÿéúÐ}éYöžk=ÅËykÒÇ_¾‘tÉ·òÑ:Ê%»Œ§+ØzNz½}coë¯ ß+·dȹÄzÕO›‰“)¿\k×gv[ÇßNþe÷ý8uÂú»×׬²þiʵž|ʯïäóëIç^êãÍÖ_K|=™õÊeï’îšt½\M»k?4—ôVSž{¹þcÄ1å• |~ 骾¹Ÿó®âµêÍ_QÎ5}(é<ñ±õk¯°þBòó”có~Ößõ”ù‹üâò7o×ï±þОôçWqÝëIgùZË8V=$ÿ~•¸ùcÒÙøŽõ|˜>þ7äï·ç,Iö÷`ׇ”¦ÓÛ¸ŽóW¤óùœô±5}žìý0ù|¬ÒúŸì`½ðüλ†×/Ͷþ¦%ÖßÌuî6§üÿÜÍÖß7ØúGƘ}¥ïLj+¯®µ^ûž'v±~ýôêã¶nÊqªÙGûŽ(‡üý)ŽŸM~Ÿ|4ßÍÄqùÇjÖ—ÊÃ÷Pþeÿ ãýÉgŒÑÝô3ëÏKXÿ¼èÿ-]/Ú§ß;5¯—É÷|þqôêãg…éý3qëåd'íc!ÝÇùüõÖoâ¹Â+äòf7Ÿo±þ?Éï‘\ïík(_fÚMçk%qdã6Д÷Îázç“oÙó=Æ÷Óô£?ÜoýK$HáäÓ‡Y/½þzŒõÊ?§6[/;ßõ¬õ=”÷æ……¤'=_áÿoÜbý=/¦ó©ütáfë…s/4=/à:õ±þ{¬Pû&ê᧔÷Ä‘k–X¯Qq'ÿ¾¼ÔúÅ”cåÞ|õ‰u«Óõ¡üò&ýøRÇûŒ—?ÑÒ—øW=Îy:¯\°!}ü½ ¬?™ëÊO”Çöàõ?JŸ¯}„ðàÇì…S©º‰×Š3Ýß|w:ÅÛe÷:íw™ö¯ÝÖKï›èçªn!«[‘ñít^<üRÃÛjòÙò¦å¥F^g]ZÂëê‰çíSûÁc‰ÎÖj~¦ù5Ú|Ñ-ãý:^7’^-ï—óz×m~hÁµ¿ÈíJ´“îhÒÓz£ïÛííÓKîKÔp^CF_Áñ¥ô‹l~9é–v Žuÿ¯§Ü6àøD;ÇOâ¸>»Äúñ‹mœÖ¡u4~¯Ü.H¨äu#ùÑer5õzÞDºZ¯–×ãH§ì¶þN¢ý•Ú=oŸD‰äåø ­Ãç_Ö×%»á‰¦Ã ýnï$Êü2‹¨à:U¤SŸd÷¨D×K½Ñz|Õn ÷]Ã%ÇÕ6Ù8ñÙľ\ó6ØxÝo"qÔs;éÕóº’ãÚ5l§¿·°—?ÊϤ§ÒE:êåï’§ú.ã[üÔfØ»šz‘eÿZÞO]s^5{ÙUqQ¯uÙWrþhÎï$í² í5é¹}¼æÍôËVŽ«Lº_nJ?Ò÷°¤XRö?U_#ý°¯¢ý[%ÏóÞü3 ô#õ²ëDÍcß*=‘/õò÷.Ú©ž~(;·ÍŲ ®Kñ]UâoXbâCïw|bñT‘±nû’tû«ŸÀz¡‘z(×xÆaÕ>&ð¢ƒ×M¼®ßjúh¤þZhŸQœßºÆü¸‘øXC>GrÑ”¿žø&?–^äߟ*>o~4^J>ñE½Hÿ|Þ&\þ'ðçßí—›\-¸³=ù¨øú玧%¯üPú®çµüOñ^A½ŒY’‡¿0|”]„«Â•öcÈ7ñ¦Có(G%ï+Ž;?°ûÍ|ÞvžÅEéîÀùŠÛTÜÐNc„›|ÞòGóç ³íz$õµRÞ*âf‡ò§üò4døQ;ó›òû€TœŽä¸í5Ÿ÷…ã£9>±·=Ÿ¸Áî‹/ù‘ú– ÿ¯$}Å“êƒ*Æ•ü~,í":ã¨_åÍÓº£äÂ;®“ #„‹¤?r­­7ácóë‘Ê_O˜]䇲c£p[ù‘uÃèMf—ræ{Å[%çmÏõÛˆ7“ä_ôïNÉAùe×–LýÏHç»ZëdÔm ô«Q¼/¿—~ÇsžìÙDÇëã§êmÃãæS™Wù|r†^äÍÔÏN´Ópƽü»ŠñÚÂñŠŸT~¦]´žøÎzIùQzmR¾¢]똤¿¶k-ž&üÎôQNE=&dò©zµ™ôF¾L»PŸZWùq{æÅÉŒïÉA;ËOÏÛßbúÔxÕU#*÷”¿Xu1ýIz¡¸!”S>=ŸH¹ä¿²·êl«æz‡6®ÓÄñ²—ä©fÞ‘ŸHO²‹ðâÖÄuáb-¯÷Õ´[‚þ/|Swq}ù·pk·3XŸÑõä{$ÇM`< o¥åGùI‚|VÒ>dïf“¿¥¯ÉÙ¦üCÜîd>™@ÿ–}•÷Fžh~ZÃú¨–qÔÌyU´›ü½‹Ï[IoGæ׶Ÿ˜~¦’¯NÖE-ŒûÉK¿®æüzö úy õ®zd²âD~J½ªžNNŒ°îÊð[Ù³æJ‹3ùOBõéÖqÝRúM…â‡ëUÒO§1®«8_ø<˜8!|ŸÁçÓhWÕkÕšO½U‘nªn£M˜o×]™¸¥ýe›ÙA~½Ã(‹_É;™z¾h_SÆ몘ٵTñL~GïatšX—‘Ï Ê7黿£ôÇõ•d¯ “¾Öédý&<.w1/×,7ÿQÜL$í'g\«Nmb_µ<}ߊ'Ϋ`>O¹´Oþ(®õ¾HxÙÅùUŒ[×¾¡“zÖ>kÇ+¯+OË~)ïpú{3¯'N7þU_ å/]¯sÕý¥Ä¥1”Wõmâ1‹‡Éoí•ÚoP­ŒÛJ®§¼;u?ó“Ú­u¥É¯|§ù ¬·ëh·RÖ# Ò‘Þ»h';wSá|qHûÉVÕ»”CùXx"¼LÙK÷WpŸD}6S¾.Ž—=¦2ŽFQáK¯GhE¹Ruêî³÷8²êÃãÇ+ÌŽª›7‹x.Ñ7=O ¯•_S8Dùº?¤º2ö‘yIñ2ŠõEã±õÄôúdgŽO»k_¡}ˆÎÑŠy_üLÃ}ï7s}Õ«Úÿ70oh¿§8W¨:^ø0Í(1ŒùGöÖ>©9£Î¬â:©zŒq5¸Ør¦Ù]|ÖÑ®Sn%þ2kßXJm!ás½ôÉ}–ê³:ò§óå!ù£ê©Á¬OU§tW&¨ž£’OûFáôÔ,âùJÿîäµôU¡U3¯ä¾dï«/V(þ’¾œrVpýBâxùTüT1O Q]L|mÒzŒ§bÎOá­ò0ã^~PÆzSþRNy‡+U¯0®¥Wª¾QžÌõ¹N=éË_Š…÷ì‹å̧©szÙ‘×’§,£>+!]_ÊÞŠŸBù{ÙCë—PŸ%Ô»øQÞPœˆn×Ñy‹öÕÄãqô³krþÎ+æ¾Rt ¹þPúo©ð’r*OVdÈ«}Æ0®¯óeõ%Ú§ŸozÆý¥â¨œãÊTOðþHæ áhù©c|(Ž‹IŒôÍûÔãPúQ å!¼á8É©õ*ˆ»²Ws†e¿æ]¾ì_ÍùÕäGù_çozÿ£ó¡ôKñÓš îÛU×H? zÑu qjÇÉ_Ë%'í¯÷] ËU0¿ŠoåYW+iÿ:ŒãkŸÄxè|¨”x˜zÏ õÒã:…¤WÂømUsŒõ-ôŸ2Îk!”}h¿JÆq+ó›ìÑ\oüWðzŒžSžqÄ É£}ƒp|8ýi,{é©–üè=Þ“ŽÎ+Oq|‡ò¥Þ³Ñ~¥¬*¨oí_RyBøËëÊ£ú1Ä‘¤£}^ å®(ŽjhWÕóÒÏλ¤æÿT=Ïû-zÀç„GWK¾U/ÕS~c—-IÇYáA ǧÎÃéòï6Í_‘^¯©¾•þÊ襌—Q\¯†ûTg~éà¾^yEõO«èI>ÅÏoJu^ÅxBŽ” éŸÍ\§³Œ~H¾ôž©–ò6Q¿òË Ê¡ó-áü®”ë–ÓÞòÏfÒÕ{£2âÃØ•çw¼¯s‡Ñ<ŸP¦sêFâQ§ê7Ñ¥þ«I¯“uy ù)ßšþ¾Yy¹Œ~¨¸¨¦}jé•ìUç+N$¯â,…Ìk#„l¼ö•z¿(û´ó\Aï¡Rõ?Çé°–øTF}JoÒ—ÎßOe<ÿ('_’·y$¡ú•~¬|’ªË”?ˆÕ:—Ôù0Ÿd^I½·ÈÈ£eÔ§âCç¯CIWïëôý…Õoœ¯s‹Jê[~RżUF~„'ãdgò£}B Ç©žQ]ÒNúÒ·ö½ Ú| æ}Ÿ–ÓÎzß®}mÇolŽÓ9”êïîïÇRŽJÖÏ©÷|›žSç‚7غõ¤3¶ØæuîM|–¾Tªõ½ Æmõ1„x£ýN+é¦ÎÃÖ‡ßãwz¿7œóFQžÄ î¸ß+ãøñŠk½‡ ½'¾g|ê}±ÎKTŸM¤ÞÇ3Ÿë=m;qNxÓ¬}ƒâ€ëV?‡Ó/…CõÄ3Å_%ýwJF<궙çâ¢?•üMe<×÷¨§2úÝ(ž¿6ÑþMÔ{â$³çhí³$÷õío™¼m䧋ç~ªÿ:Ÿô“.öʳ²WãMç ½jáù‘ô3a°Ùu å.#_‰sìz’úùÖ7PîÑ¡Í×¾PïCÚ™WZy_u×Ú½ëNa¾o½”GU§é=4ùG{¦ÜªÃ·ç¹ƒô0‰zŸÂøÐ÷o´¯Ö9²ö‹“Éç(Ê™˜‘¾OÞa’ém¬üs}:ŽoO~Û§£¹î„Ólžö=%ŒSáOæ÷”ïgÇ—[ÉÏhâÛTÎOÕyªGx_8_©s^^ï¨ü®º]õ:ãPóåéGíÇ „ôƒÒ »Í Ÿ ç[Yo?Sy±:½T«ó:éWrj?#~ôã.7É^/ñ{Ä×Ô{`½ŸdTÇçÉ+:/RKïgÓ_ªãfÐ_t õ'Ž°q]Ô£ê¶IÔŸ¾§(?<3_ç÷pÈO­p‰ótΫ¸®S^¾ê‡tw[M<Öü`×|âZ&.0?è\e‡¡<—äµöw²“êízú‘pWöJϳWž™²ÏUõ—ô´’^F_KÈ—Îo„Ç;ñ¹¾_£óŸVâî´¸­[Ëøiæ¹j#íÝÆzKu¢ÞË73ï4R.Õûz?ÚÀ}ZåM}¿”q ¸êàºùÞWçÕ#™—‹™›‰;oJÛD;wo[^&¾ÓnC9n,×þª®•~u^XK?Ñ÷Y§0‹õý Ù—q¡¸/eê½µ¾ß©s#ísÆ·´Éù ¬;oUäwê~/‰õ#󻾟Ñɸš¢ï5‘Õ'|/ëR«- Œw.ûç²VáúÜ?÷®q.Žj6¼Ÿñ,6 ×½ñyÆüŸÜËÇó¹èwÄ5Æåou®?*ñØ›ÎõFFŠ,ÅýSÐÆœ1{îa\ìûèE;ÃÖëõ‡#Oãœë‡µÝŠgkÀÓ|ôƒqÿ0ÌÃZyØQõÂØìw­å òÉǹ\ðÃú)Î ú?Àgð»ôßIoYà%÷; }2Ú»&kή˜Ý CV)ôr< žGcìNÎõùúóІaÝgðì9ôžÇW@ç|~ t‘•†ýÖ¹íNÐE ò |×{`þÏq±Y¬…5rÎwnðûÖ¼Œ~lìFr/ƸÙévðò!>¿ñbÌ™ó8Ö h›<ëÄxÜ A;ú=犠ƒÁ°aa îíܨÉÎáÜØ#¶“µt¯‘ Ð\Ž5aŸÜõè?Íýœë[„g÷™~|‹ßæÜ4Ø9ë È}dýÎZ/ض~ æv;W¾‡€n6äŒcç? ö÷8Wü]Œ…ßDÞÀçøü†ÉšXˆù¨³àKƒ ßŒö s%øìÿwþàvìµÂ¹²]à𥜇1ú-_j6îsžCÏ9ð‰í&áÞKÐ?ú~—øÇ@øWîHŒ~¦Ãª°ö`è¬ ãÀWá³xûõ+pnü£ uã×;7òaöµ s>¯7æÁ–qè´þ›}æÂwâ¸× ¹†ü†ÎÀzˆJè r6Æ{ÝZ®@LÀgj s ¾¾;ôÜ ¼ô_lù³ñQ¾Ñ¹!¬²åÂr/pnžõ:kþĹc—YÔb~2õ†_×LD=õ¾òÁ~ à©×§º)t® 1Ñ'ŠñðßÞ/™_õ¿ö‚o­€ßLè4ù"¶{ƒçÞX£þ<ëìÃ3$Â~çZ«‚,¥ÐK.ü¸?ÆåÀwó7 Øu·Ãp¹ˆßYÀŠÞƒð~”ßÏô˜™²ÿâÜ1{9W í}7ô…8ë×Ý:¥ùEôÛÿ~Ð^ä F+ ÛÈ £ŸÁÞeà÷¤÷MÖ±X«è“µq‘WY_…N÷†£yÀ—ûî yà3‹½öwî»ú(|ݹ)[œ›‹XÏEL5"î;à ·? ž¡Ï¼‚öuv]|:xÚhþ^ßížòƒÝ«Ã O!|oÖp*ÆÍD9ä< ÷ÿ:øƒs“ ÷SÀWî Î O 2y¼¿ýÒþ ï ·MWÐÑa»ÿÁ½bЊß·ƒÌÕ ?éû.á{UÙx¶”¾{ } ó€cð™F7?ƒÁóùÓ!3dˆþ?Ð@œÀØØð}Œ‡N ß×›·™N¶{Ý|²v>·Ç0,ø5Æ!~âqÌß ¾úgÓû¬ß=2anx ƒßœøå2ÃÁs6_/^g¸U|«€¿mWè‚yðÓéðÉþÐÓLÈ3°˜}?b´ÌãúAÆ_%|:qS\ˆ DÓ‹söuÁ€ƒMoÿ yvž¹€?£á»aížJê&ý‡½ýÁÓ`Ó6TcùX«£¯ ràßgþÏîNêÖE!W×}†7;v[ª?ÄZð úí5Â…óKÌ×gô5ûæ\å"³opákÐcÙdž½óû‚þxØ´x;ç>Öì ÿÎÂn¨~|¡Ù hïuÑ^@ÌùÔ¥È-ÛSüáÝ(ðY ÝÁݯØuäýd¶ wÅœ8tòÇ©.ˆuAíÃÆ –¼›Àßá'YyU^ë‚…ˆËíÝæÓ ñ·wüË·Ï@ƒ]°çû.8¦ö9Àìz øŽö¸`b`&xY +¸ÄS´8ù~—l¹ ñ;¹îØ}(ßðŠÜc\üé|ä£8½kÖ+ÝÕ…À{ÿ#°¾+ £}|û¼óD‡ ›ÿbñU‚øÈóµü®b«åÜ(°cøØ ³äÏ‚lyw¸ÈfØ¡ø?þ™jµÆÈ'“|$ó„÷çœyÎÍë±<yÎÈÅK \°ùjaÕ~nAhþVÛGáǹW;w#ä}n.Úœ´u8:Ù2Öü´O|2Y{ È|jkFë\l&òï Œ_Œ˜Ücþ>ø/Ë‘ïòþìb žÿºÊ…/ ^Úa›"Ы„}Âw\ðÚRËÙ}qCŽ;×ý ×s¶|9`¶aDt/^ûWï žã&ÏdàXl¬ÅÚa1ù`±å(ÿlî9~4qÕ Ü¨G.\þJ@ÿ ŒÛ8ß2ßì]{!| þ··ÏÃÀ>Ó C¼žB¼eƒÇ]^†~aÛ1Ù.ƒÍ‡]ø0ž·ù¼Žz#Š¸Z‚ú$üz‚¼m°Étè:1ßw¡ §mµg>6½ï{>½>wGý1üZÌÿ| x±èø ¼ÿ†éËÛ­0îÂþ=›öD]såE°1pò;Ó-÷ö«û¬6vˆyçyŠÚËùŠû?*tàÓ!—8`º;”÷oæµÿáÿ½hþ—…Ïsþ"Òð$`-Çÿ'Çû†zÒù€û_%_À{Àswj w%ï¯'-¿Æëœçù€:Ô¹ÎÿõYö¾½Ígž‡Èìéüoýän9ÿCò›2Ú¥66ˆqž§ã¸lt·Ùü`{òôWã!('/þ“øÄõ)?ßÎûëÈÇz“5¨#?þæÈ£b6@ ø“,ÿ}–í¾ÛdëµäÃóüõµƒŸ³ÅófŸ$EÔÅùÔ­\ šÉ×ÓF#@ž €A—É 5ZI~ö0¹äÉ>äÐþ´[€˜ Pcû™>ƒ>hØ™ˆ½ Äh'y¼Æôøz°|gk'õÿ¦›Þä¡ù>@¾ ïÀûÞ;Æ{™4ýZ§PÐU€|Üh¼º-&{Ðh6 v1&y]€ÖŸ´=OMü ^C¯¿ß’>jÖ± &ím­1 f öDó?¾ÞL{Ìîêñ¹%ó¹ž_÷7äþ,6¿ ‡‚¥6?©Oéñ"®ƒ#yZ)Mš¨Ï‚OЀ3Áê;†Ú2ð~2Ñìz¾o2$õò{4è%@휅Œ àÓp xÚä c¶fØÏh†ð•ØDØn6»%çn¦~çšÐSÌ^¶?ÑŒ¥~ŸvB½êcÃÓIÎñ¾ð×ÝÁ䶞ƒ/DcÃ7Í6!öá‡6.l·œ®þ|,ÜÕrP91ÀÞ?ð…÷Sf§páœ?§HÊç(7â$œMû½H`ÿ5nèñù"Ы³{îO襌ší"oÖâúA‹ÃÆ!mz&²Ñ°0²ÉìoF€»‘Ÿ[üøs”ȃÆGd€¡$±qE- øú<‰­ÞWŽÇ¨-‚VÊéíìÏl>²yìa=NF€§QÔS³ÂñøŒøf÷"£P‡EQ3WY¼ÆŽ =àcµCèÏv@'êóòT¬Šø½ÒÐÃ&9;ÞFWÄjÌãG›éÂ1è-Òc6pˆƒì]M¹m†%î-‹SoÇlÔéQØ5z¤Ñö1äÿ$ztâÀ‰(°.‡±ïZŒDr(/p7z‹ùz27#¿ß ÿ ëµCl³­ç÷éÁó×Q`Jx>C9þíòV\#þCØ,òšÙ.ðmúo»Ÿu‹ÙÀûB ˜šµ¿ù’ÇVì“\9!ÛØúIì_‘‡ÍϽí}^ˆè,@ÞÈŸøNÄûjžˆ¯õý™ÐJ“;™7γxŒŒAÛƒq ›æ ³Ørï1^=ž¿föóz÷þñ¹ {è$ö÷2ÿôØe¹!u^gŸ`|­!&I}N}ÄÄAä*;WË-¦36ü9Iµ¤ÏøyxÖg1äåñ¼‡À—ìù&W”y4Ì7¼ð¶Œ@g!|:÷4;?ðt³_²œ˜œ‡}xàqt± ²æ!ÞCÄQà똃,¯E²Ì’¼6œôö¼N/µýYÄÛýÃÔ\Ä~ÄÇ®ßëAÏñWm½È[ì'r}·ÀŽè:[ßçºèÖ Þþ؃‡˜üþž—!riC9oÚÙjt™Å‘—Ï×.Á(ã7‚}•ÏgI¼¹ Ï~_ëG<ïÀá,O¾&ANŒ¬°æuìÏ3”K’¶ØßhùqIryï—¦ï/ª}¾OúÁûl=†¿þží°—a„Ç8ßÉÚàQ>›Å|ÿègÍßó1š\gVzKÕ\ÃËêçÄosrºLgþyônb¿æßJž€ƒáR;N¶RÃæù-ü£í•ýÚ£|,&ç.´³ëÏ7Ÿ_¢–xM^û}H ñï"óOËÓŽboA]=ˆk̴ܞĽ¥ÔÉåÖÇo6š±CÌ—üyRïSO“@gží_öŽÏ×~ÿ›Œ‘æcIØÝäôŸýž>YcüÑô“äyù)µµ¢ÌAI¾—Û¹¬ÏIúuv1žèlMO7É··Åróß¼lþ¹ïý¹wdgÓ]lyÇœ(ê¼^ým=Ÿ’y¼ ;Òøôu™ç+¹æ¶_®¤_ÿÌ—ü>3©+Ô[¯ïj®ù¬å O+ï>;/¦NÖVy}ea_[FŒª5_òôýù¸çտ߈Í2Ú~¯ý7Ycð“ê†ä¬+N’Ÿ·Œ¾ï=?þsXhzñgîɵü³‘¦ëÈïíì?+×Κ£ïð^;Ãõïh”˜Ïø¼•¢ûªÍ÷Ÿ“q„û}gÑÏ‘Óã÷™¯äøœ‹ñìÏu½þ’ïn¼o#þ£È5ùïYÎñï)"¾Ö~ıw#&úLµuJï0ìðõϱA–“½} `Óì+ìsì%kq`YÖǦӤýѲζ3¶¼_šÝrëÑ_˜z¾’ô—.û÷=¾îŠú÷T v®æõ‚NZt–—°zÄÛ6·ÀrSR§ð¿¬wì\µ8ßÆúwè?ïצGo,äÔøpê|Æ‘c¨w³£¦«øÈn4ÛäÃçû¡¾ÉBýƒ Œ_V˜|—ó‰­ãíº0ž°óÀd<”²‚-â{c¾¯OÛ̧ü=¿¾—-†:#{_ÓSÁzóCO³b¤ÏGÔÇZúîE‘³Ç_EÐg¶¯õ;«Cü{lÄ_â¬ß+¦—¼-V¯dÿ‡ùuüOÆ«ÿ=ù˜x”Í÷ëÄ€Iý|̼c¹(ùþ 9?{Oóa_#xx|Kú!jA^îw {}G~‹ÕZ‹Þhã¼MâÓLö:øB~™³£ù÷`_7û¸÷vF’ _Ž#Ÿ…k,b˜ƒlÙE-œƒü½Üü#û³k |Æaƒ(ìê÷ÈÖ×Ç:ô_ö®Å“Ÿw¾éÛcX?¬™u¼é¶02ç;v^[6‡¾¾Èð!áòß ?¿‘<M¾Çðïm’ï Î1å_Jß¿ÛlÛ˜/Å^¶³*ŸKw-~Ï [D§˜Ž{ùïm³Yñt{÷˜Ä’M&[tQpMòÑõÛÇb´` Õ†>V=ÿÉú ý6Œ`[ ¹‡À¯³î¶1E°Gîwnžÿ sc6ê‡(øŒ"/õÁ¾1Ûã牠ý+ÓU4Ÿt’½ˆ¾dy®ÿÅôðR€g9¨W³ÈüdÐoŒ¯^ ›s–½×꺽"V‡VÔšõƒÍ‹½­º ‡½Ý{£&îóš#'±u#ë/Ð-<ÍhÅY§ø÷¡ž§¬N窡ßÜBÃ…¤Üˆé_Ÿu[¬åC·ýæZësft½ßÊ}Ì°Æë#«ÌÞ'Eá#Ù[ͼŽ¼õÞËpÔ¿×ëëc º)î :ËÞ ûuýûÃœÍVÇÇ“ràÙð¾ˆéa½-Ï–c­l_·Â.Ùï~/áß/æÜl1äåßo¸â¯óü;Ø'6ØÞ±z|ÉAž«Å½ÞØo­3Œˆ÷§ao3ìh‹5ï+±·ì]vî•Ä™6³[iïMs!·†W½¿þÜÞ?‹Có¡ÛâŒýªî&T-__… ¶ì½Ørl¬/æ_e8ŸÓºÓYÛöÖ&mŒ:h@>±õJß/oãä»/ÎŽ^Âœ˜~}^̾Óè!#°q´â¨iû"×Äñ9ýÀþ1ä‹þˆ¡ˆ¿Ø³{÷CøVx:Ðãhú#Ñ$.ÜdöŽc™÷=æäáÿßѱ#æ>ïgÿƒçlÞ ÷>šŸâÝóŽ>äÈ4¸ûÈãæéQt÷sŽÐ°óŽ8háÁºÚkÞ!¼P“v_0o^ŠÂÌ9G4/“‡¹óç#t3÷€9 ç4x4ØËžsô‘Ç5‰í^ž]€¬ûôÓOü_!ñçÄû_ e'3{sm/data/dogs.rda0000744000176200001440000000101612266061173013231 0ustar liggesusers‹…–ÁN1†ë‚qYØu¯> c¼íÁÄ+ñ䕨xQ1 ñêkè3é;ø$bç«ñ'H“ÒN;Ó™ÿŸi—óÓ‹Ãä"qÎE.êl¹¨æ§õÈÿl¹ºkTÂÕôfî\­ðóØ÷–ïûËýÿ{´¡×6ôú†Þ®â(3·leö^µ2.[w'ËVÆ&·^«öôš6ÆvNM¿½­'&s~ÃÎKÄOŠ³Ãojr¿¦‡=ûÄ…âÌ~ôWxPü9xñoëÑÃxbÁ‡~*ñfÂ ç¨ ™àG·úÞ<Ï`¯<ؾ滞ɅøÉ%?±ÄØɺÖC[p7äÜžäcï/Ž ê‡z’ü«á <`¯<€»oþºr2ù×{ž©ß¦àhKÐ#}êØFx銾rñ·î½xä½<¨_ðÞ¥ŽÃwDò¿r?$®u<´„OöÁ‰q§#xõ½ÒïE!²Å/ßöíûñݵÿ¸»ÊmÌâÙlúô`B4„Ù0ÌŽÂì8ÌNlV ¿Ó¡z¼¼ÏñÈbr5~Lf>Qo̦ÏYýóˆ^üÏb±øôÃWÕ¿øiÁsm/data/airpc.rda0000744000176200001440000001161612266061172013401 0ustar liggesusers‹íœy\ÕuÆ{›Ui$´€ 6ÆØÆq€€CˆCȽ°1fs¹HŠ¢—í°Y8†8¶ãÄ•rˆã8^‰7ðBQ”›( p¯„díbF#–iö}ëu¦»gz&ýÞù1¨ DåMÕ¡ÕÛ{÷žå;ßùn7\qÓ…µ7ÕF"‘X$¶0‰ÅËÿLÄÊÿ‰F‘šòcÅÊϬº÷“‘Hü”à²-(v£Ÿwͮԯ'û|í·n>'·þ[>²=øÛáã_ìøГKþÎW¿ð…Í¿yÿM¾~ù7¯m»äv?¯ëƉû—»™É¾;¿qù|Ý÷ÿ¡òìƒçûºÿÚ[{é½úª'ª/x×ÀßúÄîRæÙ+ÿÓ×=¹$¸’¯\öõ÷ÆæÄG?½jõ™~ìÏ^ùÈVÿ5_ÿàÅWÿî—IŸàû±–³zný€+Ê:\òÒ{ƒw|DÖãÆYWElþUko¹ÈÇÊ«(/ÁÇÊ‹¬¿íc¾R×Ã:t}•ßn\Þ¯\ß×ò½šÏ?÷Ù¯Z\KyWå%ºd¸¬Å¦ûk‹ï~è›×¹R_øA—½-pÔ”û—Ÿ…ñUgnxø±®»©‡Ä/•áÃ_ùë¨Þ¾1ïJÁöÆ~ê&‚«ÞýnÒ|iäÛŸ¾Ïž¿âg/Üï&kà ºÒc¡cÝ ~Š…Ûþœé—ùN_9ð@àQ×|Qx?OÞ÷‰ zw~ÃÇÅß.YÞLy‡nL÷óÊç>~cøWûúÊð²ôU\/ìâô'Üø©ß-{æï}uà†kÛLSðjõ®]üà#™ €ëü‚²—Ø=í¦¹ORòÈM†iu—ˆÜñ¨V¿jµ+²¯ª0½ê]ñ‰àŽ._þòÍ猻‰±Ÿ<}î‚O8»ñ*tó>Nžl.ûÀ×ÎçÆäú>¾ ¸àßøëMç©ðí·»⻥œDæK£>"÷óu¡›b®ÄcNï¤Ý;\:\îm¾¦çÖ˼ø£>qz¸1ŸÒúá_øH•æË~>y^!ëó5äw$L¯{|œýL«:«ÑÏÝ^í+C7Þêv®¹~èŸÞºÆ¬—øšçóã²n“įãax.Ñ÷}\â0[¿ó¸nUX.ÆÏûað÷#Ý&€+^à¯\V®ã&‚p–²>"õåöÕ³â羪¼˜òŠ|„ëñè¦d_fœuO‹\‡ä‡+I}»îפÕWŠfPüè A|a‹i²ææ÷˜ò*¢x$ñ4™0< 7#¸aº´ÞØg¥øË}?MƒcQÙŸÉ•ovÍ®´»<“:2k¥žÝù;Ãzzo ?àRA:æ^t™0 W¸$þz_øg:äó®‹z+H=¹’Ô±é—õ½Îþ—zpSÔË~ñ»¡¾ÜuÚÁõŠaú¾Ãl?¹‚ÄÃ¥‚4¼z“ÉKý›vÁ³ZââZÉ÷4ëþü0Ž¿úÅO¦ÀÔOžv3ÜoZêÐl–úÖú7IÉoWäºíÔ_ù’ ËäÊg¦]òÛMpݬԽ+Θ¬øÙôÈûf'y"ýámßí«ˆS–u'ƒrŸxÉO×*×5c ²ëš&—G×,ß³qpæAx®Zk²ì#E^í>aŠ¬ëu¸ <˜~èÆå{6dýeºñ(FÂ?3#uîJàgVâçca¸ovI®ŸÄ?ò¨“<ü®à•¦Ž„mì-¦SðÀå¥ÿ˜L°ºë‡Ý ôI7C]vwc+BÇ™½òºÙ'¸eç…nø¬É‚›ƒRÿ6†?“ÚOðs6©ÇmTòÔƸß~ꢓ¸µ“Oû¤šü’ÆÏ­äOœOáŸ!¹¯É“ésC7Ú?G¸ONâä2‚'fÔ‡€èÆ©›¢à´±ß‡é«#Ò/L›à†Qo}ø©@~W‡Žuø{gH_–¸´à–Ë*ü3#RG¾†:\u9‰¯Ê¾ ë¶5ä÷A®;NÜ÷KüÌ,. sið¡3L¯‹Í€ô3§õ—áë.#|È(Oj¿;$žúh«Yÿž°=ŸæëÿQúùåJÊ;ɳ<ù÷ ý~g#à/¸áçK~Û¥MÒó’g¦Ÿºé–øÙjü:ÉúZ$_}¥àÜ,îM²¯CO[ÿ9áUyp¬¸”į¦œ‹·yd›­’|2mðõÁ%õ—Qf[àñÕ’_¾Bú)IŸ4“ÂklýK!¿4øßVó¡¯ö߉«­å¾›ØO^ú³­ÿŽàh|i þYDþ37¹6Á'Ó#xbë%–ùÌxòº }T>g !œ½Í¥ÙǤä½i¢Ï·€ãô3H=©£é«véñÏ$ùYþo’ðÏ’øÙžz˜7v™\ÛÉœ0ÃüÐ+u`c‚w†þk#‚?¶þËaÜL‰ÏO“÷™slBöi#’ÿ¶Núœòy[+þ7Í‚÷vû×¾Ö+Ÿ3c›Ì!ö¹ÿLƒYxæ&ñ—]HÝ.÷À#êÈÖ nÚ:™¯Í!ú }Ý×Âã’ð²œÔ—·ú„à´®×ôJ_¶‹ÈÓ&¹ŸÙͲøŒÁÿÕÂ3lTÂWH~Øyð…ù¾]tFXøúhJð‘œà±­b>ŽQG‹%ž6*xfkáõ­â»PðÁÎêèï%©o»€|ž–|°5äñbü“ÐùÝ!Áu0G¥YG\¾ïçIül‚¾Ü#ul¦7í™ã¬Î;ÍÌ9ìssj‡ä³­7–Ò•ÇõÁ¯G¤~}„þ0îuK\µÞlœ¾[Åûè!>ÏJË>í²¿–u´²¯¨ä‹¯‘>i6ÃOòäw >4Áú§u>µðS“gŽ¬~h뿈­ û…çÚż^?êgŽƒ_»fY¯9(uçF¥N|þNØ*É;¼Z dv)8޹ߞÙZùœMÀÏg„ÇÙE2w€'iªº°§Ñ6ö€«ãðræ3NøWøØ^âø¿è!Ì+D³uÂßì2p ýÈ4Á“³|ø³DøöåƒnZú¾Âë6°ßú[š9àÌ1ð+Ÿ€-2ðµ~p£‹¹«üÈÃbðª¤ä™EÇ°ËÁuæ ó¼\ÏV ?±Ëö…¼Ã4â¿8“ÄÕ’—®ÎP'QîrEúæy»GðÌF©»Í²NWþîòðFú‡­FO(‚×ñ“ӧƤNíÒP(yÜ<@¿ßE-ÇÏ9ðÝÅ'À£~ª!ŸŠð æN'?º˜#6P§ÑQe>P=Ï…˜æ†xA¾œÕz‡·OàÁ)Ãÿq™3Í#‚S.Á“í®G\ÝnáaýÇVI²‹ ‡™†ŸeÙç>ÑsT/v9ÑSÝzÇëÏÀ¿’ð–Çd.-ëtð…W8pxv®ä~øí÷ó¬×’yÕ=)ëu9úzþ«:j‘ï 1OLñ¼[òˈžç†Á½-Ìer_òÎeÐáEÌ®]ç@楢<÷ðòôÂ(úcTêÈÐ\/síuÌmcà“ףÌCÌÍ#›Ü¸Ðɼ’dNM2Om!ÓÌõÏ¡åe]f·ðf³žûÃG\šu¤uÎ=ìù(só®Ùƒ.½Ž¸=Ã<ÞM}oÞâJô¿×£yO¢¿n#?'àªÓ‚ª§¾@ä}x˜òQ—F§> ñ4}Ä?K·2—dÑ9»Ð—Çðë(ù>@ßV=h˜zê@Çm§^ÛУrð_åmŠ»ì¯>´³oæÍÙ¼%?šÁÇgéKäÿ6Ö¹½qˆï÷2Ç ›¹Vöù[èÃô› þEo›ý¾òèM‚?F`à4å_nŸä“[Ãã!xÆ ël'¾Ê£Q}¾<{.ÓÏœ»NÏoBšy‹á{îýo˜<ìĨ­ý„GíËZwí'ðQÏaZÀ‰!òxú­œ£tÁoZÀ…êí§ð­ËÞÃôÂÍøƒ¾cR芫Ãô^æË$¼\ç»<<ûiÎÛösÎÑMsÞeÚѹÈ~ ùéÆÐýײ.Õÿ’àBze›øYÏfóƒsM=·˜ÕUÚnd~ÅϦ—¼J³.Å/í«ø'Ëœ6ŒÞ7„¾Ë9€Q\K“GãèÔŽü>>þNß—ûÁ•¤ž¨®¤ç ÔÙzÕ¹áÉ:OdàÅÃð ðJu}3 þ1»é÷£ôqÕÛU‡F›­ÛÔÕz ÷sªËržäT_Ÿ¡>× é9Ié¹½êËÔ ~3›ˆ/uj²èmôÓ4<’st3ŒN çP-Ìèd&«sqï&îèQ6 Îdà‘Yø½ž'ë¹Y#<£—þ}€û’§?‡Ç5£×i½¨ÎÌ|¥çd& nÐÏÀ»Y~‘Fw3)Çé;9§KË£i!TWæ<4OÿëdÝ꥛÷SðÀ>øÂý#îåé]èï9xU’¼WÉ#×DüÛØïýåõÌÜdà9î!xÎyüŠnl¶‚ Ú§Úõ\’u¡ÿ»4õ?B¾À•~ðt~ª¿_à÷f>@ß2Ï KåÉÿNÅküÃ?ª3˜ç³¼>Ízƨ›µôí)ê:Q¼0ô„>yÝFÐ øýˆâÈ,.‚϶‚¾Fo©A—iá¼RçÇôÕ8xÿÏø;)ù`ãèsð†&ò¡zÐÚÁyO|qR?6Jþ&Á#=OÍjs>¡¼ìyæ4å59ø™ê-/Ñ78ßÓ:5O×Ýèüä³Î/xk]Zñ@ã¯:Æt´Nt[íCºoôq“%/؇M°ŸíÒßl<è¿¢[éGz¾=Bž5€“YÕñ:­çu>Õs„Q̦?¶k_ÄGç^Ý·Î=;ØßÄYÏÍÍðí¼ð©WþîÃ5p®1ÄzÁw[IýýŠ¼ÝÇ„ÿmŒ¹c>«ó‰Îè;n¿‰KÞ©žãô÷{à˜ÆMu¹ÎSãð΢+é¹ÊüF7•œ,Sªº@/ÝxÖfõÇh‹^‡->Š‚-9Ì–¾Ì–Á–ÏÁN=‚ö¶bŽö–£ØéÇhgÌÑÞúö¶£Ø™o½ý ²³N ½ãM°³ÓÞy‚í]'ÈÞ}íœ7ÁÞsœöo°½÷Uìß;÷8ì¼—Ùù¯a4»àì—ÙûŽ`<»hö'Ç`ÏÑþôuÚû_ÅþìvÉqÚŸf—£ýÅq˜™ƒÙ£Øe¯Ã>0»ü8ìŠ×°+çhœƒ}hŽöá9ÚU/³ÌÁ®~ûè«Ø5G±ƒ]{»îev=vÃìƲ}<ò{n=i'í¤0‹´“vÒNÚ,~ÒNÚIûÿf¯üŸVܽò®;ø›àÅÊËï¹ëÞó.xų y–øË;V®Òw®»cÕgî¹ýðK~òΕ÷é%õÅÚÛW~~åyŸZU¾Ûa¯YuÏýçé*Ê´=ûjù?33¥`tìÿh†œÚ{Csm/data/bissell.rda0000744000176200001440000000043312266061172013733 0ustar liggesusers‹]=NÃ@…'kÇI,Aˆ(hÐÑ¥à)JEåv!æG2AÊZX¢!B¢@T6'Wî¢Ä b¾uÖJäâí÷<ûfw¼GûÑ^…"¢Dµk¢<¬¯XjâK 6Ž/Œ‰“DÄ[/b"+h»‹©÷Hgø7üßÆ_Ão”âïá {·ð•ï;ø·©¢ü²cÜÀ'8_ä ü@¿ø?øN~Š^Ì!uy5QÝŽ¿¤ÀÕ7]>tlº¾ Ç øý¹÷—Îì¸{–çêªò\õ¡¾ŒZÖŠÍy1èÇóô¼Œ$:3Õ¾“D›²¯,†êîéˆ#+ñÖè*ë–WÙwPc–<Ï?ÁÌêöÂØåÚsm/data/follicle.rda0000744000176200001440000000122112266061174014065 0ustar liggesusers‹”KhSA†ÿûÈëöm‚Zk­­V«±Vâ-uµXѲ i¢Â5‰iªÕU(Ô­Ò…tQ¡H±]Dq!è‚‚‹RD²X|€‹ A­ãœ`¸$iè…ïÎÜ9gÎ3çŸ9uØÝ©¹52ä ²Â®*ó%A…­5Òõ >Ý(v~gªHÅ3±¬$§RÌ«&5¤–¬ØÁ*²š¬1POÖ’Á:ÒHÖhÊcƒ ™lÌ£EКÇ&ÁfÒf`‹`kíe°­ÛKà,ƒEèÈc§NÁ.äê§ÍÌ¢Bív+…:gÕà XÚSPÓT\£RÇ£C}k)Ž3v%Ñ.sîúÌâÿù“Š /e [){9q²¡-Ô/d+åSˆ¥ì9TÁr|JÍ5ÚTÃýj z/úðïBTÄ ÒuΟ³w‡ƒQñaî F|~cŸîÈ…È jýި׈0ºÁÝ ]qæþš•’ã+“ÉðâO–¿n×sm/data/nile.rda0000744000176200001440000000106212266061175013227 0ustar liggesusers‹]ÓKHUAÀñqæè‡BÁ]Ѿ ¥-z˜ù¸ö²“^K»ºjZÚ[{Xi3­¬ÔÞ–•D A jQ-já2%BjÓ¦MtýŸ;çÜÅï~ßÌ3gæ›9¥k‚+Á€RJ+“¡´!u4?ÊQÙ^#Z)eò’c”Z€Zºwá,ýo‰6O¶—?)•¹•ØD{É+ˆßðohß".Á”ç¬÷ç9 Æ9?ñYö?C4ëÐÀ2^Ÿb5ù$±—øÊÎí,$~@}_ØÆ{òUäSþš½¹Ši{ë(Û1Àf'ý¶­1>—ü9û6®?ö¾â ñL¤ïáùF,#ÿN\jç0ÛíÚM Ûùõ/òµþšû0Ÿ‰ÏXá׫ Œ»B¼ÄssÄëDê¬?böÿ¹È&ðÙŒRlAÊÁH%‚¨g$ÛÀÚdØ¿TƒZ{•Ý¨7/w@ê°{Qö#ûFQÄ°G#8_iÆA´ ‡@¤ í8Î^Žá8¨­œÄ)t€ýËiœ÷L¨³P9 ¸ˆnô€ÉeP/¹ î‡\5ê&ýÀ Pká.Ê nãîbÃç*÷ñÜey„Çx‚QpåÆðÜy‰ñ´o)3êFBDå&?&Û™U 7GB©Ï­*äÆÓ« »©ÇRZ·Éͯ‹3cÚðìx¬%?õ&ïZhꩉÛTÿ<óØ“+¿ösm/data/mildew.rda0000744000176200001440000000065012266061175013563 0ustar liggesusers‹ r‰0âŠàb```b`âgd`b2Y˜€# 'fËÍÌII-g``òx€˜ˆUP#>.qtÀˆ…K-.50waÓ‡OŒ›H•Gç#‡©n#Æ„ÔàC/d<Ð[úv'.w¡z»“Xw¡Z»“\w¡j»“ZîB”º“VîB¤º“^îB„ÜÉÄ*b¯[åv¾q1‚D¹l _çrïÑøz¨ßA´ê¡û:‘jñ3 pN‹¥cD€Šm –ÀÕKÀh¨9b ã_·:ˆÂÌ»–p1q¨:˜; æKBÅ%¡ââ`ë4$aò‡@v+³uØö€ƒ$”ººê¡‡ƒäC0îO)¨9â JãÂ~¨¸ Ô½"sÑjsÖ¼ÄÜÔb C€T™C™J á,#8ËÆ*€ËÀe ²&p–)œeg™ÃY0'Df¦æ¤ »+9'±æ.˜ WJbI¢^ZÐÉhÊ9‹òËõ`^¥O¦ ñÿÿÿ;@ꃭ;¼Ùsm/data/birth.rda0000744000176200001440000000105512266061172013407 0ustar liggesusers‹í•MKAÇgw£` ´à÷ðàW¨G)R ¤VŒ«n¬äÍ&«±¾ Æ7Zj/•B-/¢ñÒ[Ñ=K¿@?'O½öøÌdv7jO~;3Ï<ó¼Í ó¼/ÙOÆ•R¶²[ÊvÐÙøY*¦ºÐvŒMýWJ9Ý`Öy„öôZ¡m`È­ykDN«m;„vñ´³SÐÚ°zDùˆ²V·ûÆ–{»ç^ÒžèSïœû8É|_€4ãžá¾V ?Âs›²×;ë34JyÆ5OÝí|0lêZíRGöÆc ÄÖˆ¡¯ÏþÃ÷ðÉw×'é?¦ù™È»9O?Žæ §¿ìßt åÆz§®š_–ø„ë»=é"¬µxè*Ê=Ú‹\;{¿z½þT5ž¡ÚØLÅÐ sm/data/muscle.rda0000744000176200001440000000050212266061175013566 0ustar liggesusers‹u’OOÂ@ŧÛ?” Täšè'°‘…^‰n†xàÚ ž@ Õ¿¼q¶y3–&’¼ÎofwæMõÃÆ&›„ˆ ™Ô#ã3†Ôæ>Ëí~GäÜ«ËU7\U·°A=FlÊüÃT‹†þ>âÕÅÌ+VÈê°nP—ZŒÞ3pŸÕCÞA-Æ®¨§ð©¿WˆüóZà1„Ü™ûº¢Z_ë‘Ü%šx¥Ø-C²–¬[–Åž)úúàk°Ûe€wìaþ%4„oÔø5Ã×â°+Ñ Øzú~ß­²õiúxš.åÿP¥«æÜí¾(e®“çâ£È^ŽlÙ¸Þ>¾}eõUF8ðÆV`"0Èfs…À=ÀŒï”ÆJVi¢4UÊ•fJs¥…’zXõ°êaÕê‡U›óóÇéäüeׂsm/R/0000755000176200001440000000000013274255072011101 5ustar liggesuserssm/R/survival.r0000744000176200001440000000373312266061262013142 0ustar liggesusers "sm.survival" <- function (x, y, status, h, hv = 0.05, p = 0.5, status.code = 1, ...) { opt <- sm.options(list(...)) replace.na(opt, display, "line") replace.na(opt, ngrid, 50) replace.na(opt, xlab, deparse(substitute(x))) replace.na(opt, ylab, deparse(substitute(y))) replace.na(opt, eval.points, seq(min(x), max(x), length = opt$ngrid)) eval.points <- opt$eval.points if (!(opt$display %in% "none" | opt$add == TRUE)) { plot(x, y, type = "n", xlab = opt$xlab, ylab = opt$ylab, ...) text(x[status == status.code], y[status == status.code], "x") text(x[status != status.code], y[status != status.code], "o") } n <- length(x) ne <- length(eval.points) xr <- x[order(y)] statusr <- status[order(y)] yr <- sort(y) w <- matrix(rep(eval.points, rep(n, ne)), ncol = n, byrow = TRUE) w <- w - matrix(rep(xr, ne), ncol = n, byrow = TRUE) w <- exp(-0.5 * (w/h)^2) wf <- t(apply(w, 1, rev)) wf <- t(apply(wf, 1, cumsum)) wf <- t(apply(wf, 1, rev)) w <- w/wf st <- rep(0, n) st[statusr == status.code] <- 1 w <- 1 - w * matrix(rep(st, ne), ncol = n, byrow = TRUE) w <- w[, st == 1] if (ne == 1) w <- matrix(w, ncol = length(w)) yw <- yr[st == 1] w <- t(apply(w, 1, cumprod)) w <- cbind(rep(1, ne), w) j <- -t(apply(w, 1, diff)) J <- t(apply(j, 1, cumsum)) wd <- J - p w <- exp(-0.5 * (wd/hv)^2) ns <- length(yw) s0 <- w %*% rep(1, ns) s1 <- (w * wd) %*% rep(1, ns) s2 <- (w * wd^2) %*% rep(1, ns) w <- w * (matrix(rep(s2, ns), ncol = ns) - wd * matrix(rep(s1, ns), ncol = ns)) w <- w/(matrix(rep(s2, ns), ncol = ns) * matrix(rep(s0, ns), ncol = ns) - matrix(rep(s1, ns), ncol = ns)^2) estimate <- w %*% yw if (!(opt$display %in% "none")) lines(eval.points, estimate, lty = opt$lty) invisible(list(estimate = estimate, eval.points = eval.points, h = h, hv = hv, call = match.call())) } sm/R/ancova.r0000744000176200001440000002062312266061255012535 0ustar liggesusers "sm.ancova" <- function(x, y, group, h, model = "none", h.alpha = NA, weights = NA, covar = diag(1/weights), ...) { x.name <- deparse(substitute(x)) y.name <- deparse(substitute(y)) data <- sm.check.data(x, y, weights, group, ...) x <- data$x y <- data$y weights<- data$weights group <- data$group nobs <- data$nobs ndim <- data$ndim opt <- data$options if(missing(h)) h <- h.select(x, y, weights = weights, group = group, ...) else {if(length(h)!=ndim) stop("length(h) does not match size of x")} covar.set <- FALSE if (!missing(covar)) { if (!is.na(opt$nbins) & opt$nbins!=0) stop("if covar is set, nbins must be 0 or NA") if (!all(weights == as.integer(rep(1,length(y))))) stop("if covar is set, weights must not be set") covar.set <- TRUE } if (missing(weights) & missing(covar)) replace.na(opt, nbins, round((nobs > 500) * 8 * log(nobs) / ndim)) replace.na(opt, band, TRUE) if (model == "none") opt$band <- FALSE if (ndim == 1) { if (is.na(h.alpha)) h.alpha <- 2 * diff(range(x)) / nobs replace.na(opt, display, "line") replace.na(opt, ngrid, 50) replace.na(opt, xlab, x.name) replace.na(opt, ylab, y.name) } else { opt$display <- "none" } fact <- factor(group) if (ndim==1) { ord <- order(fact, x) xx <- x[ord] } else { ord <- order(fact) xx <- x[ord,] } yy <- y[ord] weights <- weights[ord] fact <- fact[ord] fac.levels <- levels(fact) nlev <- length(fac.levels) rawdata <- list(x = xx, y = yy, fac = fact, nbins = opt$nbins, nobs = nobs, ndim = ndim, devs = 0) if ((!is.na(opt$nbins)) & (opt$nbins>0)) { for (i in 1:nlev) { ind <- (fact==fac.levels[i]) if (ndim==1) {xx.ind <- xx[ind]} else {xx.ind <- xx[ind,]} bins <- binning(xx.ind, yy[ind], nbins=opt$nbins) if (i ==1 ) { x <- matrix(as.vector(bins$x), ncol=ndim) y <- bins$means fac <- rep(fac.levels[1], length(bins$means)) weights <- bins$x.freq rawdata$devs <- bins$devs } else { x <- rbind(x, matrix(as.vector(bins$x), ncol=ndim)) y <- c(y, bins$means) fac <- c(fac, rep(fac.levels[i], length(bins$means))) weights <- c(weights, bins$x.freq) rawdata$devs <- c(rawdata$devs, bins$devs) } } if (ndim == 1) x <- as.vector(x) weights <- as.integer(weights) fac <- factor(fac) covar <- diag(1/weights) } else { x <- xx y <- yy fac <- fact } n <- table(fac) #--------------------------Model testing------------------------ B <- diag(0, sum(n)) Sd <- diag(0, sum(n)) istart <- 1 for (i in 1:nlev) { irange <- istart:(istart + n[i] - 1) wi <- weights[irange] if (ndim==1) { xi <- x[irange] Sd[irange, irange] <- sm.weight(xi, xi, h, weights=wi, options=opt) } else { xi <- x[irange,] Sd[irange, irange] <- sm.weight2(xi, xi, h, weights=wi, options=opt) } B[irange, irange] <- sm.sigweight(xi, weights=wi) istart <- istart + n[i] } if (ndim==1) { Ss <- sm.weight(x, x, h, weights=weights, options=opt) } else { Ss <- sm.weight2(x, x, h, weights=weights, options=opt) } sigma <- sqrt((y %*% B %*% y)[1, 1] + sum(rawdata$devs)) if (model == "equal") { Q <- Sd - Ss Q <- t(Q) %*% diag(weights) %*% Q obs <- ((y %*% Q %*% y) / sigma^2)[1,1] } if (model == "parallel") { D <- matrix(0, ncol = nlev - 1, nrow = sum(n)) istart <- n[1] + 1 for (i in 2:nlev) { D[istart:(istart + n[i] - 1),i - 1] <- 1 } if (ndim==1) { Q <- diag(sum(n)) - sm.weight(x, x, h.alpha, weights=weights, options=opt) } else { Q <- diag(sum(n)) - sm.weight2(x, x, h, weights=weights, options=opt) } Q <- solve(t(D) %*% t(Q) %*% diag(weights) %*% Q %*% D) %*% t(D) %*% t(Q) %*% diag(weights) %*% Q alpha <- as.vector(Q %*% y) ghat <- as.vector(Ss %*% (diag(sum(n)) - D %*% Q) %*% y) ghati <- as.vector(Sd %*% y) obs <- sum(weights*(as.vector(D %*% alpha) + ghat - ghati)^2) / sigma^2 Q <- D %*% Q + Ss %*% (diag(sum(n)) - D %*% Q) - Sd Q <- t(Q) %*% diag(weights) %*% Q } p <- NULL if (!(model == "none")) { if (!covar.set) { p <- p.quad.moment(Q - B * obs, covar, obs, sum(weights)-length(weights)) } else { p <- p.quad.moment.old(Q, covar, obs * sigma^2) } if (model == "equal") model.name <- "equality" if (model == "parallel") model.name <- "parallelism" if (opt$verbose > 0) cat("Test of", model.name, ": h = ", signif(h), " p-value = ", round(p, 4), "\n") } if (ndim == 1) sigma <- sigma / sqrt(nobs - 2 * nlev) else sigma <- sigma / sqrt(nobs) #--------------------------Graphical display------------------------ if (!(opt$display %in% "none")) { replace.na(opt, xlim, range(rawdata$x)) replace.na(opt, ylim, range(rawdata$y)) if (length(opt$lty) < nlev) opt$lty <- 1:nlev if (length(opt$col) < nlev) opt$col <- 2:(nlev + 1) plot(rawdata$x, rawdata$y, type = "n", xlab = opt$xlab, ylab = opt$ylab, xlim = opt$xlim, ylim = opt$ylim) for (i in 1:nlev) text(rawdata$x[fac == fac.levels[i]], rawdata$y[fac == fac.levels[i]], as.character(fac.levels[i]), col = opt$col[i]) if (opt$band & nlev > 2) { if (opt$verbose > 0) cat("Band available only to compare two groups.\n") opt$band <- FALSE } if (opt$band & covar.set) { if (opt$verbose > 0) cat("Band not available when covariance is set.\n") opt$band <- FALSE } if (!opt$band) { for (i in 1:nlev) { ind <- (fac == fac.levels[i]) sm.regression(x[ind], y[ind], h = h, weights = weights[ind], ngrid = opt$ngrid, add = TRUE, lty = opt$lty[i], col = opt$col[i]) } } else { eval.points <- opt$eval.points if (any(is.na(eval.points))) { start.eval <- max(tapply(x, fac, min)) stop.eval <- min(tapply(x, fac, max)) eval.points <- seq(start.eval, stop.eval, length = opt$ngrid) } ind <- (fac == fac.levels[1]) model1 <- sm.regression(x[ind], y[ind], h = h, eval.points = eval.points, weights = weights[ind], options = opt, display = "none", ngrid = opt$ngrid, add = TRUE, lty = 1) ind <- fac == fac.levels[2] model2 <- sm.regression(x[ind], y[ind], h = h, eval.points = eval.points, weights = weights[ind], options = opt, display = "none", ngrid = opt$ngrid, add = TRUE, lty = 2) model.y <- (model1$estimate + model2$estimate) / 2 if (model == "parallel") model.y <- cbind(model.y - alpha/2, model.y + alpha/2) se <- sqrt((model1$se/model1$sigma)^2 + (model2$se/model2$sigma)^2) se <- se * sigma upper <- model.y + se lower <- model.y - se if (model == "equal") { upper <- pmin(pmax(upper, par()$usr[3]), par()$usr[4]) lower <- pmin(pmax(lower, par()$usr[3]), par()$usr[4]) polygon(c(eval.points, rev(eval.points)), c(lower, rev(upper)), border = FALSE, col = 5) } else if (model == "parallel") { upper[,1] <- pmin(pmax(upper[,1], par()$usr[3]), par()$usr[4]) lower[,1] <- pmin(pmax(lower[,1], par()$usr[3]), par()$usr[4]) upper[,2] <- pmin(pmax(upper[,2], par()$usr[3]), par()$usr[4]) lower[,2] <- pmin(pmax(lower[,2], par()$usr[3]), par()$usr[4]) polygon(c(eval.points, rev(eval.points)), c(lower[,1], rev(upper[,1])), density = 20, angle = 90, border = FALSE, col = 5) polygon(c(eval.points, rev(eval.points)), c(lower[,2], rev(upper[,2])), density = 20, angle = 0, border = FALSE, col = 6) } for (i in 1:nlev) text(rawdata$x[fac == fac.levels[i]], rawdata$y[fac == fac.levels[i]], as.character(fac.levels[i]), col = opt$col[i]) lines(eval.points, model1$estimate, lty = opt$lty[1], col = opt$col[1]) lines(eval.points, model2$estimate, lty = opt$lty[2], col = opt$col[2]) } } #-------------------------------Output----------------------------- r <- list(p = p, model = model, sigma = sigma) if (model == "parallel") r <- list(p = p, model = model, sigma = sigma, alphahat = alpha) if (!(opt$display == "none") & opt$band) { r$upper <- upper r$lower <- lower r$eval.points <- eval.points } r$data <- list(x=x, y=y, group=fac, nbins=rawdata$nbins, devs=rawdata$devs, weights=weights) r$call <- match.call() invisible(r) } sm/R/sm.r0000744000176200001440000006043013272352667011715 0ustar liggesuserssm <- function(x, y, weights, bdeg = 3, pord = 2, h, model, ... # increasing = FALSE, decreasing = FALSE, kappa = lambda * 100, ) { weights.missing <- missing(weights) if (!missing(y)) { x.name <- deparse(substitute(x)) y.name <- deparse(substitute(y)) if (weights.missing) weights <- NA if (missing(model)) model <- "none" return(sm.regression(x, y, h, model = model, weights = weights, ...)) } else if (class(x) != "formula") { x.name <- deparse(substitute(x)) if (weights.missing) weights <- NA if (missing(model)) model <- "none" return(sm.density(x, h, model = model, weights = weights, xlab = x.name, ...)) } opt <- sm.options(list(...)) replace.na(opt, display, "lines") # replace.na(opt, reference, "none") opt$reference <- "none" # replace.na(opt, panel, FALSE) opt$panel <- FALSE pam.formula <- x terms.obj <- terms(pam.formula, specials = "s") vars.inf <- eval.parent(attr(terms.obj, "variables")) term.labels <- attr(terms.obj, "term.labels") s.ind <- attr(terms.obj, "specials")$s response.ind <- attr(terms.obj, "response") involved <- attr(terms.obj, "factors") terms.linear <- matrix(c(involved[s.ind, ]), ncol = length(term.labels)) terms.linear <- which(apply(terms.linear, 2, sum) == 0) nterms <- length(term.labels) terms.smooth <- which(!(1:nterms %in% terms.linear)) rhs.linear <- paste(term.labels[terms.linear], collapse = " + ") rhs.linear <- if (nchar(rhs.linear) == 0) "1" else rhs.linear formula.linear <- paste(rownames(involved)[response.ind], "~", rhs.linear) formula.linear <- as.formula(formula.linear) names(vars.inf) <- rownames(involved) bricks.type <- sapply(vars.inf[-response.ind], mode) ind <- (bricks.type == "numeric") & sapply(vars.inf[-response.ind], is.factor) bricks.type[ind] <- "factor" Xlinear <- vars.inf[-response.ind][bricks.type != "list"] names(Xlinear) <- names(bricks.type)[bricks.type != "list"] ylab <- attr(terms.obj, "variables") ylab <- strsplit(deparse(ylab), ",")[[1]][1] ylab <- substr(ylab, 6, nchar(ylab)) y <- unlist(vars.inf[[response.ind]]) X <- list() xlabels <- list() xlab <- list() ndims <- list() df <- list() nseg <- list() lambda <- list() period <- list() xrange <- list() fixed <- list() fac <- list() xmissing <- FALSE if (any(apply(involved, 2, sum) > 3)) stop("four-way interactions not yet implemented.") for (i in 1:length(terms.smooth)) { inv <- which(involved[ , terms.smooth[i]] == 1) ilinear <- which(bricks.type[names(inv)] == "numeric") ifactor <- which(bricks.type[names(inv)] == "factor") if (length(ilinear) > 0) stop("interactions with linear terms are not yet implemented.") if (length(ifactor) > 1) stop("interactions with more than one factor are not yet implemented.") else if (length(ifactor) == 1) { fact <- names(bricks.type)[ifactor] inv <- inv[-match(fact, names(inv))] fac[[i]] <- Xlinear[[fact]] } else fac[[i]] <- NA nvars <- length(inv) X[[i]] <- matrix(nrow = length(y), ncol = 0) xlabels[[i]] <- vector("character") xlab[[i]] <- vector("character") ndims[[i]] <- numeric() df[[i]] <- numeric() lambda[[i]] <- numeric() period[[i]] <- numeric() nseg[[i]] <- numeric() xrange[[i]] <- matrix( , nrow = 0, ncol = 2) fixed[[i]] <- matrix( , nrow = 0, ncol = 2) for (j in inv) { lambda[[i]] <- c(lambda[[i]], vars.inf[[j]]$lambda) nseg[[i]] <- c(nseg[[i]], vars.inf[[j]]$nseg) xlabels[[i]] <- c(xlabels[[i]], vars.inf[[j]]$variables) newvar <- eval.parent(parse(text = vars.inf[[j]]$variables)) if (is.matrix(newvar)) { nms <- colnames(newvar) if (any(is.null(colnames(newvar)))) nms <- paste(vars.inf[[j]]$variables, "[", 1:ncol(newvar), "]", sep = "") } else nms <- vars.inf[[j]]$variables xlab[[i]] <- c(xlab[[i]], nms) newvar <- as.matrix(newvar) ndims.new <- ncol(newvar) ndims[[i]] <- c(ndims[[i]], ndims.new) prd <- vars.inf[[j]]$period if (length(prd) == 1 && is.na(prd)) prd <- rep(NA, ndims.new) if (length(prd) != ndims.new) stop("period does not match the columns of x.") period[[i]] <- c(period[[i]], prd) if (any(!is.na(prd))) { for (k in 1:ndims.new) if (!is.na(prd[k])) newvar[ , k] <- newvar[ , k] %% prd[k] } xrng <- vars.inf[[j]]$xrange if ((ndims.new == 1) & (length(xrng) == 2)) xrng <- matrix(xrng, nrow = 1) if (!is.matrix(xrng)) xrng <- matrix(NA, nrow = ndims.new, ncol = 2) if (nrow(xrng) != ndims.new) stop("xrange does not match columns of x.") for (k in 1:ndims.new) { if (any(is.na(xrng[k, ]))) { if (!is.na(prd[k])) xrng[k, ] <- c(0, prd[k]) else xrng[k, ] <- c(min(newvar[ , k]), max(newvar[ , k])) # xrange <- t(apply(xrange, 1, function(x) c(x[1] - 0.05 * diff(x), x[2] + 0.05 * diff(x)))) } } xrange[[i]] <- rbind(xrange[[i]], xrng) fixed[[i]] <- rbind(fixed[[i]], vars.inf[[j]]$fixed) X[[i]] <- cbind(X[[i]], newvar) df.new <- vars.inf[[j]]$df if (is.na(df.new)) df.new <- switch(ndims.new, 6, 12, 18) df[[i]] <- c(df[[i]], df.new) } # if (any(is.na(nseg[[i]])) | prod(nseg[[i]]) > 400) if (any(is.na(nseg[[i]]))) nseg[[i]] <- rep(switch(sum(ndims[[i]]), 100, 17, 7), sum(ndims[[i]])) if (any(is.na(X[[i]]))) xmissing <- TRUE } # Remove observations which have missing data. ind.missing <- lapply(X, function(x) apply(x, 1, function(z) any(is.na(z)))) ind.missing <- cbind(is.na(y), matrix(unlist(ind.missing), ncol = length(X))) ind.missing <- apply(ind.missing, 1, any) if (any(ind.missing)) { y <- y[!ind.missing] for (i in 1:length(X)) X[[i]] <- as.matrix(X[[i]][!ind.missing, ]) cat("warning: missing data removed.\n") } if (opt$verbose > 1) tim <- proc.time() P <- list(length = length(terms.smooth)) B <- model.matrix(formula.linear, parent.frame()) m <- ncol(B) for (i in 1:length(terms.smooth)) { mat <- ps.matrices(X[[i]], xrange[[i]], ndims = ndims[[i]], nseg = nseg[[i]], period = period[[i]]) if (all(is.na(fac[[i]]))) { B <- cbind(B, mat$B) m <- c(m, ncol(mat$B)) P[[i]] <- mat$P } else { Btemp <- matrix(nrow = length(y), ncol = 0) for (j in levels(fac[[i]])) Btemp <- cbind(Btemp, mat$B * as.numeric(fac[[i]] == j)) B <- cbind(B, Btemp) m <- c(m, ncol(Btemp)) nlevs <- length(levels(fac[[i]])) pdim <- nlevs * ncol(mat$P) P[[i]] <- matrix(0, nrow = pdim, ncol = pdim) for (j in 1:nlevs) { ind <- (j - 1) * ncol(mat$P) + (1:ncol(mat$P)) P[[i]][ind, ind] <- mat$P } P[[i]] <- P[[i]] + matrix(1, ncol = nlevs, nrow = nlevs) %x% diag(ncol(mat$B)) } xrange[[i]] <- mat$xrange } if (opt$verbose > 1) { cat("Timings:\nconstructing matrices", (proc.time() - tim)[1], "seconds\n") tim <- proc.time() } b.ind <- list(length = length(m)) for (i in 1:length(terms.smooth)) b.ind[[i]] <- (cumsum(m)[i] + 1):cumsum(m)[i + 1] if (weights.missing) { # btb <- t(B) %*% B btb <- crossprod(B) # Does crossprod also work with a vector, below? bty <- t(B) %*% y } else if (is.vector(weights)) { btb <- t(B * weights) %*% B bty <- t(B * weights) %*% y } else if (is.matrix(weights)) { btb <- t(B) %*% weights %*% B bty <- t(B) %*% weights %*% y } else stop("the weights argument is inappropriate.") if (opt$verbose > 1) { cat("matrix products", (proc.time() - tim)[1], "seconds\n") tim <- proc.time() } # Select the smoothing parameters, if required lambda.df <- function(lambda, btb, P) { B1 <- solve(btb + lambda * P) sum(diag(btb %*% B1)) } for (i in 1:length(terms.smooth)) { if (any(is.na(df[[i]]))) df[[i]] <- switch(sum(ndims[[i]]), 6, 12, 18) # code doesn't currently handle more than one df for terms with more than one variable. df[[i]] <- sum(df[[i]]) if (df[[i]] > prod(nseg[[i]] + 3)) stop(paste("df is too large for the value of nseg in term", i)) if (any(is.na(lambda[[i]]))) lambda[[i]] <- lambda.select(btb[b.ind[[i]], b.ind[[i]]], bty[b.ind[[i]]], P[[i]], df[[i]]) } if (opt$verbose > 1) { cat("selecting smoothing parameters", (proc.time() - tim)[1], "seconds\n") tim <- proc.time() } # Fit Pall <- matrix(0, nrow = ncol(B), ncol = ncol(B)) for (i in 1:length(terms.smooth)) Pall[b.ind[[i]], b.ind[[i]]] <- lambda[[i]] * P[[i]] B1 <- solve(btb + Pall) # btb <- t(B[,-1]) %*% diag(rep(1, length(y))) %*% B[,-1] # return(list(btb = btb)) # B1 <- solve(btb[-1, -1] + Pall[-1, -1] - lambda[[i]] * mat$cmat) alpha <- as.vector(B1 %*% bty) # alpha <- as.vector(B1 %*% bty[-1]) # mu <- c(B[, -1] %*% alpha) # return(list(alpha = alpha, B = B[ , -1], btb = btb[-1, -1])) if (opt$verbose > 1) { cat("fitting", (proc.time() - tim)[1], "seconds\n") tim <- proc.time() } # Force the estimate to pass through fixed points (1 covariate only) if (length(terms.smooth) == 1 & ndims[[1]] == 1 & all(!is.na(fixed[[1]]))) { fxd <- fixed[[1]] if (any(fxd[,1] < xrange[[1]][1]) | any(fxd[,1] > xrange[[1]][2])) stop("fixed points must be inside the range of the data.") A <- cbind(1, ps.matrices(as.matrix(fxd[ , 1]), xrange[[1]], ndims[[1]], nseg[[1]])$B) alpha <- alpha + B1 %*% t(A) %*% solve(A %*% B1 %*% t(A)) %*% (fxd[ , 2] - A %*% alpha) } mu <- c(B %*% alpha) df.model <- sum(btb * t(B1)) df.error <- length(y) - sum(btb * (2 * B1 - B1 %*% btb %*% B1)) sigma <- sqrt(sum((y - mu)^2) / df.error) cov.alpha <- B1 %*% btb %*% t(B1) * sigma^2 rss <- sum((y - mu)^2) tss <- sum((y - mean(y))^2) R.squared <- 100 * (tss - rss) / tss if (opt$verbose > 1) { cat("summaries", (proc.time() - tim)[1], "seconds\n") tim <- proc.time() } # If there is only one term, include the mean # if (nterms == 1) b.ind[[1]] <- c(1, b.ind[[1]]) result <- list(fitted = mu, alpha = alpha, m = m, B = B, bty = bty, btb = btb, B1 = B1, Pall = Pall, xlabels = xlabels, linear.matrix = model.matrix(formula.linear, parent.frame()), terms.linear = terms.linear, terms.smooth = terms.smooth, xlab = xlab, ylab = ylab, term.labels = term.labels, lambda = lambda, ndims = ndims, y = y, X = X, fac = fac, Xlinear = Xlinear, bricks.type = bricks.type, sigma = sigma, cov.alpha = cov.alpha, b.ind = b.ind, df = df, df.model = df.model, df.error = df.error, rss = rss, R.squared = R.squared, xrange = xrange, nseg = nseg, bdeg = bdeg, period = period, pam.formula = pam.formula, involved = involved, nterms = nterms) if (!weights.missing) result$weights <- weights class(result) <- "pam" if (nterms == 1 & ndims[[1]] <= 2) { if (opt$panel) { replace.na(opt, df.max, switch(ndims[[1]], 20, 50, 100)) df.min <- switch(ndims[[1]], 2, 4, 8) + 0.1 df.max <- if (!opt$panel) df[[1]] else min(length(y) - 5, opt$df.max) df.min <- if (!opt$panel) df[[1]] else df.min Pall <- rbind(0, cbind(0, P[[1]])) llambda <- 0 llambda.df <- lambda.df(exp(max(llambda)), btb, Pall) while (min(llambda.df) >= df.min) { llambda <- c(llambda, max(llambda) + log(10)) llambda.df <- c(llambda.df, lambda.df(exp(max(llambda)), btb, Pall)) } while (max(llambda.df) <= df.max) { llambda <- c(llambda, min(llambda) - log(10)) llambda.df <- c(llambda.df, lambda.df(exp(min(llambda)), btb, Pall)) } df.fun <- approxfun(llambda.df, llambda) sm.pam.draw <- function(pam.panel) { plot(pam.panel$model, options = pam.panel$opt) title(pam.panel$df) pam.panel } sm.pam.redraw <- function(pam.panel) { # pam.panel$model$lambda <- lambda.select(pam.panel$model$btb, pam.panel$model$bty, # Pall, pam.panel$df) pam.panel$model$lambda <- exp(pam.panel$df.fun(pam.panel$df)) B1 <- solve(pam.panel$model$btb + pam.panel$model$lambda * pam.panel$Pall) pam.panel$model$alpha <- as.vector(B1 %*% pam.panel$model$bty) pam.panel$model$fitted <- c(pam.panel$model$B %*% pam.panel$model$alpha) pam.panel$opt$se <- pam.panel$se pam.panel$opt$theta <- pam.panel$theta pam.panel$opt$phi <- pam.panel$phi rpanel::rp.tkrreplot(pam.panel, plot) pam.panel } opt1 <- opt opt1$panel <- FALSE pam.panel <- rpanel::rp.control(model = result, opt = opt1, Pall = rbind(0, cbind(0, P[[1]])), df = opt$df, df.fun = df.fun, theta = opt$theta, phi = opt$phi) rpanel::rp.tkrplot(pam.panel, plot, sm.pam.draw, hscale = opt$hscale, vscale = opt$vscale, pos = "right") rpanel::rp.slider(pam.panel, df, df.min, df.max, sm.pam.redraw, showvalue = TRUE) rpanel::rp.checkbox(pam.panel, se, sm.pam.redraw, title = "Standard errors") if (ndims[[1]] == 2) { rpanel::rp.slider(pam.panel, theta, -180, 180, sm.pam.redraw, "persp angle 1") rpanel::rp.slider(pam.panel, phi, 0, 90, sm.pam.redraw, "persp angle 2") } } else if (opt$display != "none") plot(result, ...) } invisible(result) } #---------------------------------------------------------------------------- lambda.select <- function(btb, bty, P, df, method = "df") { # This currently uses the same lambda in all dimensions lambda.df <- function(lambda, btb, P) { B1 <- solve(btb + lambda * P) # print(c(lambda, sum(diag(btb %*% B1)))) sum(diag(btb %*% B1)) } if (method == "df") { lambda <- 1 while (lambda.df(lambda, btb, P) <= df) lambda <- lambda / 10 lower <- lambda lambda <- 1 while (lambda.df(lambda, btb, P) >= df) lambda <- lambda * 10 upper <- lambda lambda.crit <- function(lambda, btb, P, df) lambda.df(lambda, btb, P) - df result <- uniroot(lambda.crit, interval = c(lower, upper), btb, P, df) # cat("result$root", result$root, "\n") lambda <- result$root } lambda } #---------------------------------------------------------------------------- predict.pam <- function(model, newdata, se.fit = FALSE, verbose = 1, deriv = 0) { if (!is.list(newdata)) { newdata <- list(newdata) # names(newdata) <- vars.inf[[2]]$variables names(newdata) <- model$xlabels[[1]] } if (!all(unlist(model$xlabels) %in% names(newdata))) stop("some required variables are not present in the new data.") nnew <- if (is.matrix(newdata[[1]])) nrow(newdata[[1]]) else length(newdata[[1]]) X <- list() for (i in 1:model$nterms) { inv <- which(model$involved[ , i] == 1) - 1 nvars <- length(inv) X[[i]] <- matrix(nrow = nnew, ncol = 0) for (j in inv) { newvar <- eval(parse(text = model$xlabels[[i]][j]), newdata) X[[i]] <- cbind(X[[i]], newvar) } } inrange <- rep(TRUE, nnew) for (i in 1:model$nterms) for (j in 1:ncol(X[[i]])) inrange <- inrange & X[[i]][ , j] >= model$xrange[[i]][j, 1] & X[[i]][ , j] <= model$xrange[[i]][j, 2] outrange <- which(!inrange) if (length(outrange) > 0 & verbose > 0) warning("some evaluation points are out of range and have been omitted.") nnew <- length(which(inrange)) B <- rep(1, nnew) for (i in 1:model$nterms) { mat <- ps.matrices(as.matrix(X[[i]][inrange, ]), xrange = model$xrange[[i]], ndims = model$ndims[[i]], nseg = model$nseg[[i]], period = model$period[[i]]) B <- cbind(B, mat$B) } fv <- rep(NA, nnew) fv[inrange] <- c(B %*% model$alpha) if (model$nterms == 1 & model$ndims[[1]] == 1 & deriv > 0) { mat <- ps.matrices(as.matrix(X[[1]][inrange, ]), xrange = model$xrange[[1]], ndims = model$ndims[[1]], nseg = model$nseg[[1]], bdeg = model$bdeg - deriv, period = model$period[[1]]) alpha1 <- diff(model$alpha[-1], differences = deriv) h <- model$xrange[[1]][,2] - model$xrange[[1]][,1] fv[inrange] <- c(mat$B %*% alpha1) / (h / mat$nseg)^deriv } results <- list(fit = fv, inrange = inrange, B = B) if (se.fit) results$se.fit = sqrt(diag(B %*% model$cov.alpha %*% t(B))) return(invisible(results)) } sm.pam.colour.chart <- function(panel) { par(mar = c(5, 1, 4, 2) + 0.1) rp.colour.chart(panel$col.palette, panel$ylim) panel } rp.colour.chart <- function(cols, zlim) { ngrid <- length(cols) plot(0:1, zlim, type = "n", xaxs = "i", yaxs = "i", xaxt = "n", yaxt = "n", xlab = "", ylab = "") axis(4) xvec <- rep(0, ngrid) yvec <- seq(zlim[1], zlim[2], length = ngrid + 1) rect(xvec, yvec[-length(yvec)], xvec + 1, yvec[-1], col = cols, border = NA) box() } #---------------------------------------------------------------------------- fitted.pam <- function(model) model$fitted residuals.pam <- function(model) model$y - model$fitted #---------------------------------------------------------------------------- sm.mask <- function(x, eval.points, mask.method = "hull") { ngrid <- nrow(eval.points) grid.points <- cbind(rep(eval.points[, 1], ngrid), rep(eval.points[, 2], rep(ngrid, ngrid))) if (mask.method == "hull") { hull.points <- as.matrix(x[order(x[, 1], x[, 2]), ]) dh <- diff(hull.points) hull.points <- hull.points[c(TRUE, !((dh[, 1] == 0) & (dh[, 2] == 0))), ] hull.points <- hull.points[chull(hull.points), ] nh <- nrow(hull.points) gstep <- matrix(rep(eval.points[2, ] - eval.points[1, ], nh), ncol = 2, byrow = TRUE) hp.start <- matrix(rep(eval.points[1, ], nh), ncol = 2, byrow = TRUE) hull.points <- hp.start + gstep * round((hull.points - hp.start)/gstep) hull.points <- hull.points[chull(hull.points), ] D <- diff(rbind(hull.points, hull.points[1, ])) temp <- D[, 1] D[, 1] <- D[, 2] D[, 2] <- (-temp) C <- as.vector((hull.points * D) %*% rep(1, 2)) C <- matrix(rep(C, ngrid^2), nrow = ngrid^2, byrow = TRUE) D <- t(D) wy <- ((grid.points %*% D) >= C) wy <- apply(wy, 1, all) wy[wy] <- 1 wy[!wy] <- NA mask <- matrix(wy, ncol = ngrid) } else if (mask.method == "near") { del1 <- eval.points[2, 1] - eval.points[1, 1] del2 <- eval.points[2, 2] - eval.points[1, 2] mask <- apply(grid.points, 1, function(z) any(((z[1] - x[,1])/del1)^2 + ((z[2] - x[,2])/del2)^2 < 4^2)) mask <- matrix(as.numeric(mask), ncol = ngrid) mask[mask == 0] <- NA } else mask <- matrix(1, ncol = ngrid, nrow = ngrid) return(invisible(mask)) } #---------------------------------------------------------------------------- s <- function(..., lambda = NA, df = NA, period = NA, xrange = NA, nseg = NA, fixed = c(NA, NA)) { vars.list <- as.list(substitute(list(...)))[-1] nvar <- length(vars.list) if (nvar > 3) stop("smooth terms can be constructed from only 1, 2 or 3 variables.") variables <- character(0) for (i in 1:nvar) variables <- c(variables, deparse(vars.list[[i]])) list(variables = variables, lambda = lambda, df = df, period = period, xrange = xrange, nseg = nseg, fixed = fixed) } #---------------------------------------------------------------------------- ps.matrices <- function(x, xrange, ndims, nseg, bdeg = 3, pord = 2, period = NA, decompose = TRUE) { # Compute a set of basis functions and a penalty matrix associated with x. # An intercept term and the main effect of any interaction terms are removed. ndimx <- ncol(x) if (ndimx > 3) stop("terms with more than three dimensions cannot be used.") n <- nrow(x) if (missing(nseg)) nseg <- rep(switch(ndimx, 100, 17, 7), ndimx) # Compute B-spline basis b <- list(length = ndimx) m <- vector(length = ndimx) for (i in 1:ndimx) { b[[i]] <- bbase(x[,i], xl = xrange[i , 1], xr = xrange[i, 2], nseg = nseg[i], deg = bdeg) m[i] <- ncol(b[[i]]) } B <- b[[1]] if (ndimx > 1) B <- t(apply(cbind(b[[1]], b[[2]]), 1, function(x) c(x[1:m[1]] %x% x[-(1:m[1])]))) if (ndimx == 3) B <- t(apply(cbind(B, b[[3]]), 1, function(x) c(x[1:(m[1]*m[2])] %x% x[-(1:(m[1]*m[2]))]))) # Construct smoothness penalty matrices P <- list() for (i in 1:ndimx) { P[[i]] <- diff(diag(m[i]), diff = pord) if (!is.na(period[i])) { z <- c(1, rep(0, m[i] - 4), -1) P[[i]] <- rbind(P[[i]], c(z, 0, 0)) P[[i]] <- rbind(P[[i]], c(0, z, 0)) P[[i]] <- rbind(P[[i]], c(0, 0, z)) } P[[i]] <- crossprod(P[[i]]) } if (ndimx >= 2) { P[[1]] <- P[[1]] %x% diag(m[2]) P[[2]] <- diag(m[2]) %x% P[[2]] } if (ndimx == 3) { P[[1]] <- P[[1]] %x% diag(m[3]) P[[2]] <- P[[2]] %x% diag(m[3]) P[[3]] <- diag(m[1]) %x% diag(m[2]) %x% P[[3]] } pmat <- matrix(0, nrow = ncol(B), ncol = ncol(B)) for (i in 1:ndimx) pmat <- pmat + P[[i]] # Construct anova constraint penalty matrices if (length(ndims) == 1) { # Sum of coefficients constraint # cmat <- matrix(1, nrow = prod(m), ncol = prod(m)) # Sum of estimated values constraint Bsum <- apply(B, 2, sum) cmat <- Bsum %o% Bsum # Corner point constraint (first coefficient is 0 # cmat <- diag(c(1, rep(0, ncol(B) - 1))) pmat <- pmat + cmat } else if (length(ndims) == 2) { if (all(ndims == c(1, 1))) ind <- c(m[1], m[2]) if (all(ndims == c(1, 2))) ind <- c(m[1], m[2] * m[3]) if (all(ndims == c(2, 1))) ind <- c(m[1] * m[2], m[3]) pmat <- pmat + matrix(1, nrow = ind[1], ncol = ind[1]) %x% diag(ind[2]) pmat <- pmat + diag(ind[1]) %x% matrix(1, nrow = ind[2], ncol = ind[2]) } else if (length(ndims) == 3) { pmat <- pmat + matrix(1, nrow = m[1], ncol = m[1]) %x% diag(m[2]) %x% diag(m[3]) pmat <- pmat + diag(m[1]) %x% matrix(1, nrow = m[2], ncol = m[2]) %x% diag(m[3]) pmat <- pmat + diag(m[1]) %x% diag(m[2]) %x% matrix(1, nrow = m[3], ncol = m[3]) } result <- list(B = B, P = pmat, xrange = xrange, nseg = nseg, bdeg = bdeg, pord = pord) if (length(ndims) == 1) result$cmat <- cmat invisible(result) } sm/R/density.r0000744000176200001440000007772513353154163012763 0ustar liggesusers"sm.density" <- function(x, h, model = "none", weights = NA, group = NA, ...) { x.name <- deparse(substitute(x)) data <- sm.check.data(x, NA, weights, group, ...) x <- data$x weights<- data$weights group <- data$group nobs <- data$nobs ndim <- data$ndim opt <- data$options if (ndim > 3) stop("data with >3 dimensions are not allowed.") if(!all(is.na(group))) { if (!all(weights == 1) & opt$verbose > 0) cat("Warning: weights ignored in sm.density.compare\n") return(sm.density.compare(x, group, h, model, ...)) } replace.na(opt, nbins, round((nobs > 500) * 8 * log(nobs) / ndim)) rawdata <- list(nbins = opt$nbins, x = x, nobs = nobs, ndim = ndim) if(opt$nbins > 0) { if (!all(weights == 1) & opt$verbose>0) cat("Warning: weights overwritten by binning\n") bins <- binning(x, nbins = opt$nbins) x <- bins$x weights <- bins$x.freq nx <- length(bins$x.freq) if(!all(is.na(opt$h.weights))) stop("use of h.weights is incompatible with binning - set nbins = 0") } else nx <- nobs if(opt$positive) { replace.na(opt, delta, apply(as.matrix(x), 2, min)) if ((ndim == 3 ) & (opt$verbose > 0)) cat("the positive estimation is not available for 3 variables.\n") } if(missing(h)){ if(opt$positive) { xlog <- log(as.matrix(x) + outer(rep(1, nx), opt$delta)) if (ndim == 1) xlog <- as.vector(xlog) h <- h.select(xlog, y = NA, weights = weights, ...) } else h <- h.select(x = x, y = NA, weights = weights, ...) } if (opt$panel) { if (!requireNamespace("rpanel", quietly = TRUE) | !requireNamespace("tkrplot", quietly = TRUE) | !requireNamespace("tcltk", quietly = TRUE)) { if (opt$verbose > 0) cat("The rpanel package is not available.\n") opt$panel <- FALSE } } if (is.na(opt$band)) { if (model == "none") opt$band <- FALSE else opt$band <- TRUE } if ((model == "none") && opt$band) opt$band <- FALSE if (ndim == 1) { if(length(h)!=1) stop("length(h) != 1") replace.na(opt, xlab, x.name) replace.na(opt, ylab, "Probability density function") if (!opt$panel) est <- sm.density.1d(x, h, model, weights, rawdata, options = opt) else rp.density1(x, h, model, weights, rawdata, opt) } if (ndim == 2) { if(length(h) != 2) stop("length(h) != 2") dimn <- dimnames(x)[[2]] name.comp <- if (length(dimn) == 2) dimn else outer(x.name, c("[1]","[2]"), paste, sep="") replace.na(opt, xlab, name.comp[1]) replace.na(opt, ylab, name.comp[2]) if (!opt$panel) est <- sm.density.2d(x, h, weights, rawdata, options = opt) else rp.density2(x, h, model, weights, rawdata, opt) } if (ndim == 3) { dimn <- dimnames(x)[[2]] name.comp <- if (length(dimn) == 3) dimn else outer(x.name,c("[1]","[2]","[3]"),paste,sep="") replace.na(opt, xlab, name.comp[1]) replace.na(opt, ylab, name.comp[2]) replace.na(opt, zlab, name.comp[3]) opt$nbins <- 0 if (!opt$panel) est <- sm.density.3d(x, h = h, weights, rawdata, options = opt) else rp.density3(x, h, model, weights, rawdata, opt) } if (!opt$panel) { est$data <- list(x = x, nbins = opt$nbins, freq = weights) est$call <- match.call() invisible(est) } else invisible() } "sm.density.1d" <- function (x, h = hnorm(x, weights), model = "none", weights, rawdata = list(x = x), options = list()) { absent <- function(x) missing(x) | any(is.na(x) | is.null(x)) opt <- sm.options(options) replace.na(opt, display, "line") replace.na(opt, col, "black") replace.na(opt, col.band, "cyan") replace.na(opt, col.points, "black") replace.na(opt, se, FALSE) replace.na(opt, ngrid, 100) panel <- opt$panel band <- opt$band hmult <- opt$hmult if (any(is.na(opt$h.weights))) replace.na(opt, h.weights, rep(1, length(x))) else band <- panel <- FALSE if (model == "none") band <- FALSE if (opt$add | opt$display %in% "none") panel <- FALSE a <- if (opt$positive) c(1 / opt$ngrid, max(x) * 1.05) else c(min(x) - diff(range(x)) / 4, max(x) + diff(range(x)) / 4) replace.na(opt, xlim, a) long.x <- rep(x, weights) a <- if (opt$positive) max(0.4/(quantile(long.x, 0.75) - quantile(long.x, 0.5)), 0.4/(quantile(long.x, 0.5) - quantile(long.x, 0.25))) else 0.6/sqrt(wvar(x, weights)) replace.na(opt, yht, a) replace.na(opt, ylim, c(0, opt$yht)) replace.na(opt, ngrid, 100) if (!opt$add & !(opt$display %in% "none")) plot(opt$xlim, opt$ylim, type = "n", xlab = opt$xlab, ylab = opt$ylab) opt$band <- band opt$panel <- panel if (!(opt$display %in% "none")) est <- smplot.density(x, h, weights, rawdata, options = opt) if (all(!is.na(opt$eval.points))) { if (opt$positive) est <- sm.density.positive.1d(x, h, weights, options = opt) else est <- sm.density.eval.1d(x, h, weights, options = opt) } else if (opt$display %in% "none") { if (opt$positive) est <- sm.density.positive.1d(x, h, weights, options = opt) else est <- sm.density.eval.1d(x, h, weights = weights, options = opt) } if (all(opt$h.weights == rep(1, length(x))) & opt$positive == FALSE) { se <- sqrt(dnorm(0, sd = sqrt(2))/(4 * sum(weights) * h)) upper <- sqrt(est$estimate) + 2 * se lower <- pmax(sqrt(est$estimate) - 2 * se, 0) upper <- upper^2 lower <- lower^2 est$se <- rep(se, length(est$eval.points)) est$upper <- upper est$lower <- lower } invisible(est) } "sm.density.2d" <- function (X, h = hnorm(X, weights), weights = rep(1, length(x)), rawdata = list(), options = list()) { opt <- sm.options(options) x <- X[, 1] y <- X[, 2] replace.na(opt, display, "persp") if (opt$display == "contour") opt$display <- "slice" replace.na(opt, ngrid, 50) replace.na(opt, xlab, deparse(substitute(x))) replace.na(opt, ylab, deparse(substitute(y))) replace.na(opt, zlab, "Density function") if (any(is.na(opt$eval.points))) { replace.na(opt, xlim, range(X[, 1])) replace.na(opt, ylim, range(X[, 2])) replace.na(opt, eval.points, cbind(seq(opt$xlim[1], opt$xlim[2], length = opt$ngrid), seq(opt$ylim[1], opt$ylim[2], length = opt$ngrid))) } else { replace.na(opt, xlim, range(opt$eval.points[, 1])) replace.na(opt, ylim, range(opt$eval.points[, 2])) } replace.na(opt, h.weights, rep(1, length(x))) hmult <- opt$hmult display <- opt$display if ((display == "rgl") & (!requireNamespace("rgl", quietly = TRUE))) { display <- "persp" cat("The rgl package is not available.\n") } if ((display == "rgl") & (!requireNamespace("rpanel", quietly = TRUE) | !requireNamespace("tkrplot", quietly = TRUE) | !requireNamespace("tcltk", quietly = TRUE))) { display <- "persp" cat("The rpanel package is not available.\n") } surf.ids <- rep(NA, 2) if (!opt$eval.grid) est <- sm.density.eval.2d(x, y, h, xnew = opt$eval.points[,1], ynew = opt$eval.points[, 2], eval.type = "points", weights = weights, options = opt) else if (display == "none") est <- sm.density.eval.2d(x, y, h, xnew = opt$eval.points[,1], ynew = opt$eval.points[, 2], eval.type = "grid", weights = weights, options = opt) else if (display == "persp") est <- sm.persplot(x, y, h, weights, rawdata, options = opt) else if (display == "image") est <- sm.imageplot(x, y, h, weights, rawdata, options = opt) else if (display == "slice") est <- sm.sliceplot(x, y, h, weights, rawdata, options = opt) else if (display == "rgl") est <- sm.rglplot(x, y, h, weights, rawdata, options = opt) else stop("invalid setting for display.") if (all(opt$h.weights == rep(1, length(x)))) { se <- dnorm(0, sd = sqrt(2)) / sqrt(4 * sum(weights) * h[1] * h[2]) upper <- sqrt(est$estimate) + 2 * se lower <- pmax(sqrt(est$estimate) - 2 * se, 0) upper <- upper^2 lower <- lower^2 est$se <- est$estimate - est$estimate + se est$upper <- upper est$lower <- lower } invisible(est) } "smplot.density" <- function (x, h, weights = rep(1, length(x)), rawdata = list(x = x), options = list()) { opt <- sm.options(options) if (opt$positive) est <- sm.density.positive.1d(x, h, weights = weights, options = opt) else { est <- sm.density.eval.1d(x, h, weights = weights, options = opt) if (opt$band) normdens.band(x, h, weights, options = opt) else if (!opt$add) polygon(c(par()$usr[1:2], par()$usr[2:1]), rep(c(par()$usr[3], par()$usr[4] * 0.999), c(2, 2)), col = 0, border = 0) } box() lines(est$eval.points, est$estimate, lty = opt$lty, col = opt$col, lwd = opt$lwd) if (opt$rugplot && !opt$add) rug(jitter(rawdata$x, amount = 0), 0.015) if ((opt$se | opt$display %in% "se") & (!opt$band) & all(opt$h.weights == rep(1, length(x)))) { se <- sqrt(dnorm(0, sd = sqrt(2))/(4 * h * sum(weights))) upper <- sqrt(est$estimate) + 2 * se lower <- pmax(sqrt(est$estimate) - 2 * se, 0) upper <- upper^2 lower <- lower^2 lines(est$eval.points, upper, lty = 3, col = opt$col) lines(est$eval.points, lower, lty = 3, col = opt$col) } invisible(est) } "normdens.band" <- function (x, h, weights = rep(1, length(x)), options = list()) { opt <- sm.options(options) xlim <- opt$xlim yht <- opt$yht ngrid <- opt$ngrid x.points <- seq(xlim[1], xlim[2], length = ngrid) xbar <- wmean(x, weights) sx <- sqrt(wvar(x, weights)) hm <- h * opt$hmult dmean <- dnorm(x.points, xbar, sqrt(sx^2 + hm^2)) dvar <- (dnorm(0, 0, sqrt(2 * hm^2)) * dnorm(x.points, xbar, sqrt(sx^2 + 0.5 * hm^2)) - (dmean)^2)/sum(weights) upper <- pmin(dmean + 2 * sqrt(dvar), par()$usr[4]) lower <- pmax(0, dmean - 2 * sqrt(dvar)) polygon(c(par()$usr[1:2], par()$usr[2:1]), rep(c(par()$usr[3], par()$usr[4] * 0.999), c(2, 2)), col = 0, border = FALSE) polygon(c(x.points, rev(x.points)), c(upper, rev(lower)), col = opt$col.band, border = FALSE) } "sm.density.compare" <- function (x, group, h, model = "none", ...) { if (!is.vector(x)) stop("sm.density.compare can handle only 1-d data") opt <- sm.options(list(...)) replace.na(opt, ngrid, 50) replace.na(opt, display, "line") replace.na(opt, xlab, deparse(substitute(x))) replace.na(opt, ylab, "Density") replace.na(opt, xlim, c(min(x) - diff(range(x))/4, max(x) + diff(range(x))/4)) replace.na(opt, eval.points, seq(opt$xlim[1], opt$xlim[2], length=opt$ngrid)) if (is.na(opt$band)) { if (model == "none") opt$band <- FALSE else opt$band <- TRUE } if ((model == "none") && opt$band) opt$band <- FALSE band <- opt$band ngrid <- opt$ngrid xlim <- opt$xlim nboot <- opt$nboot y <- x if (is.na(opt$test)) { if (model == "none") opt$test <- FALSE else opt$test <- TRUE } if ((model == "none") && opt$test) opt$test <- FALSE test <- opt$test if (opt$display %in% "none") band <- FALSE fact <- factor(group) fact.levels <- levels(fact) nlev <- length(fact.levels) ni <- table(fact) if (band & (nlev > 2)) { cat("Reference band available to compare two groups only.", "\n") band <- FALSE } if (length(opt$lty) < nlev) opt$lty <- 1:nlev if (length(opt$col) < nlev) opt$col <- 2:(nlev + 1) if (missing(h)) h <- h.select(x, y = NA, group = group, ...) opt$band <- band opt$test <- test estimate <- matrix(0, ncol = opt$ngrid, nrow = nlev) se <- matrix(0, ncol = opt$ngrid, nrow = nlev) for (i in 1:nlev) { sm <- sm.density(y[fact == fact.levels[i]], h = h, display = "none", eval.points = opt$eval.points) estimate[i, ] <- sm$estimate se[i, ] <- sm$se } eval.points <- sm$eval.points if (!(opt$display %in% "none" | band)) { replace.na(opt, yht, 1.1 * max(as.vector(estimate))) replace.na(opt, ylim, c(0, opt$yht)) plot(xlim, opt$ylim, xlab = opt$xlab, ylab = opt$ylab, type = "n") for (i in 1:nlev) lines(eval.points, estimate[i, ], lty = opt$lty[i], col = opt$col[i], lwd = opt$lwd) } est <- NULL p <- NULL if (model == "equal" & test) { if (nlev == 2) { ts <- sum((estimate[1, ] - estimate[2, ])^2) } else { sm.mean <- sm.density(y, h = h, xlim = opt$xlim, ngrid = opt$ngrid, display = "none")$estimate ts <- 0 for (i in 1:nlev) ts <- ts + ni[i] * sum((estimate[i,] - sm.mean)^2) } p <- 0 est.star <- matrix(0, ncol = opt$ngrid, nrow = nlev) for (iboot in 1:nboot) { ind <- (1:length(y)) for (i in 1:nlev) { indi <- sample((1:length(ind)), ni[i]) est.star[i, ] <- sm.density(y[ind[indi]], h = h, ngrid = opt$ngrid, xlim = opt$xlim, display = "none")$estimate ind <- ind[-indi] } if (nlev == 2) { ts.star <- sum((est.star[1, ] - est.star[2, ])^2) } else { sm.mean <- sm.density(y, h = h, xlim = opt$xlim, ngrid = opt$ngrid, display = "none")$estimate ts.star <- 0 for (i in 1:nlev) { ts.star <- ts.star + ni[i] * sum((est.star[i,] - sm.mean)^2) } } if (ts.star > ts) p <- p + 1 if (opt$verbose > 1) { cat(iboot) cat(" ") } } p <- p/nboot cat("\nTest of equal densities: p-value = ", round(p,3), "\n") est <- list(p = p, estimaate = estimate, eval.points = eval.points, h = h) } if (model == "equal" & band) { av <- (sqrt(estimate[1, ]) + sqrt(estimate[2, ]))/2 se <- sqrt(se[1, ]^2 + se[2, ]^2) upper <- (av + se)^2 lower <- pmax(av - se, 0)^2 replace.na(opt, yht, 1.1 * max(as.vector(estimate), upper)) replace.na(opt, ylim, c(0, opt$yht)) plot(xlim, opt$ylim, xlab = opt$xlab, ylab = opt$ylab, type = "n") polygon(c(eval.points, rev(eval.points)), c(upper, rev(lower)), col = "cyan", border = 0) lines(eval.points, estimate[1, ], lty = opt$lty[1], col = opt$col[1], lwd = opt$lwd) lines(eval.points, estimate[2, ], lty = opt$lty[2], col = opt$col[2], lwd = opt$lwd) est <- list(p = p, estimate = estimate, eval.points = eval.points, upper = upper, lower = lower, h = h) } invisible(est) } "sm.density.eval.1d" <- function (x, h, weights = rep(1, n), options = list()) { opt <- sm.options(options) replace.na(opt, h.weights, rep(1, length(x))) replace.na(opt, xlim, c(min(x) - diff(range(x))/4, max(x) + diff(range(x))/4)) replace.na(opt, ngrid, 100) hmult <- opt$hmult h.weights <- opt$h.weights xlim <- opt$xlim ngrid <- opt$ngrid replace.na(opt, eval.points, seq(xlim[1], xlim[2], length = ngrid)) xnew <- opt$eval.points n <- length(x) neval <- length(xnew) W <- matrix(rep(xnew, rep(n, neval)), ncol = n, byrow = TRUE) W <- W - matrix(rep(x, neval), ncol = n, byrow = TRUE) W1 <- matrix(rep(h.weights, neval), ncol = n, byrow = TRUE) W <- exp(-0.5 * (W/(hmult * h * W1))^2)/W1 est <- W %*% weights/(sum(weights) * sqrt(2 * pi) * hmult * h) invisible(list(eval.points = xnew, estimate = as.vector(est), h = h * hmult, h.weights = h.weights, weights = weights)) } "sm.density.eval.2d" <- function (x, y, h, xnew, ynew, eval.type = "points", weights = rep(1, n), options = list()) { opt <- sm.options(options) replace.na(opt, xlim, range(x)) replace.na(opt, ylim, range(y)) replace.na(opt, ngrid, 50) replace.na(opt, h.weights, rep(1, length(x))) if (missing(xnew)) xnew <- seq(opt$xlim[1], opt$xlim[2], length = opt$ngrid) if (missing(ynew)) ynew <- seq(opt$ylim[1], opt$ylim[2], length = opt$ngrid) n <- length(x) nnew <- length(xnew) h.weights <- opt$h.weights hmult <- opt$hmult W1 <- matrix(rep(xnew, rep(n, nnew)), ncol = n, byrow = TRUE) W1 <- W1 - matrix(rep(x, nnew), ncol = n, byrow = TRUE) W2 <- matrix(rep(h.weights, nnew), ncol = n, byrow = TRUE) Wx <- exp(-0.5 * (W1/(hmult * h[1] * W2))^2)/W2 W1 <- matrix(rep(ynew, rep(n, nnew)), ncol = n, byrow = TRUE) W1 <- W1 - matrix(rep(y, nnew), ncol = n, byrow = TRUE) Wy <- exp(-0.5 * (W1/(opt$hmult * h[2] * W2))^2)/W2 if (eval.type == "points") est <- as.vector(((Wx * Wy) %*% weights)/(sum(weights) * 2 * pi * h[1] * h[2] * hmult^2)) else est <- (Wx %*% (weights * t(Wy)))/(sum(weights) * 2 * pi * h[1] * h[2] * hmult^2) invisible(list(eval.points = cbind(xnew, ynew), estimate = est, h = h * hmult, h.weights = h.weights, weights = weights)) } "sm.density.positive.1d" <- function (x, h, weights, options = list()) { opt <- sm.options(options) if (min(x) <= 0 & opt$verbose>0) cat("Warning: some data are not positive\n") delta <- opt$delta replace.na(opt, ngrid, 100) replace.na(opt, xlim, c(min(x), max(x))) if (min(opt$xlim) < 0 & opt$verbose>0) cat("Warning: xlim<0 with positive=TRUE \n") if (missing(h)) h <- hnorm(log(x + delta), weights) ngrid <- opt$ngrid ev.pt <- opt$eval.points if (any(is.na(ev.pt))) { a <- log(opt$xlim + 1/ngrid) ev.pt <- exp(seq(min(a), max(a), length=opt$ngrid)) } opt$eval.points <- log(ev.pt + delta) f <- sm.density.eval.1d(log(x + delta), h = h, weights = weights, options = opt) est <- f$estimate/(ev.pt + delta) est[is.na(est)] <- 0 list(eval.points = ev.pt, estimate = as.vector(est), h = h) } "sm.density.positive.2d" <- function (X, h = c(hnorm(log(X[, 1] + delta[1]), weights), hnorm(log(X[,2] + delta[2]), weights)), eval.type = "points", weights = rep(1, nrow(X)), options = list()) { opt <- sm.options(options) replace.na(opt, ngrid, 50) replace.na(opt, delta, apply(X, 2, min)) if (min(X) <= 0 & opt$verbose > 0) cat("Warning: some data are not positive\n") if (dim(X)[2] != 2) cat("parameter X must be a two-column matrix\n") x1 <- X[, 1] x2 <- X[, 2] delta <- opt$delta replace.na(opt, xlim, range(x1)) replace.na(opt, ylim, range(x2)) replace.na(opt, ngrid, 50) xlim <- opt$xlim ylim <- opt$ylim ngrid <- opt$ngrid ax <- log(xlim + 1/ngrid) ay <- log(ylim + 1/ngrid) eval1 <- exp(seq(ax[1], ax[2], length = ngrid)) - 1/ngrid eval2 <- exp(seq(ay[1], ay[2], length = ngrid)) - 1/ngrid replace.na(opt, eval.points, cbind(eval1, eval2)) eval1 <- opt$eval.points[, 1] eval2 <- opt$eval.points[, 2] pdf <- sm.density.eval.2d(log(x1 + delta[1]), log(x2 + delta[2]), h = h, xnew = log(eval1 + delta[1]), ynew = log(eval2 + delta[2]), eval.type = eval.type, weights = weights) if (eval.type == "points") est <- pdf$estimate/((eval1 + delta[1]) * (eval2 + delta[2])) else est <- pdf$estimate/outer(eval1 + delta[1], eval2 + delta[2]) invisible(list(x1 = eval1, x2 = eval2, estimate = est, h = h)) } "sm.density.positive.grid" <- function (X, h = c(hnorm(log(X[, 1] + delta[1])), hnorm(log(X[, 2] + delta[2]))), weights=NA, options=list()) { f <- sm.density.positive.2d(X, h, eval.type = "grid", weights=weights, options=options) invisible(list(eval.points = cbind(f$x1, f$x2), estimate = f$est, h = h)) } "sm.imageplot" <- function (x, y, h, weights, rawdata, options = list()) { opt <- sm.options(options) ngrid <- opt$ngrid xlim <- opt$xlim ylim <- opt$ylim xgrid <- opt$eval.points[,1] ygrid <- opt$eval.points[,2] if (!opt$positive) dgrid <- sm.density.eval.2d(x, y, h, xgrid, ygrid, eval.type = "grid", weights, opt)$estimate else { f <- sm.density.positive.grid(cbind(x, y), h, weights=weights, options=opt) xgrid <- f$eval.points[, 1] ygrid <- f$eval.points[, 2] dgrid <- f$estimate } image(xgrid, ygrid, dgrid, xlab = opt$xlab, ylab = opt$ylab, xlim = xlim, ylim = ylim, add = opt$add, col = opt$col.palette) invisible(list(eval.points = cbind(xgrid, ygrid), estimate = dgrid, h = h * opt$hmult, h.weights = opt$h.weights, weights = weights)) } "sm.persplot" <- function (x, y, h = hnorm(cbind(x, y), weights), weights, rawdata = list(), options = list()) { opt <- sm.options(options) ngrid <- opt$ngrid xlim <- opt$xlim ylim <- opt$ylim xgrid <- opt$eval.points[,1] ygrid <- opt$eval.points[,2] if (!opt$positive) dgrid <- sm.density.eval.2d(x, y, h, xgrid, ygrid, eval.type = "grid", weights, options = opt)$estimate else { f <- sm.density.positive.grid(cbind(x, y), h, weights=weights, options=opt) xgrid <- f$eval.points[, 1] ygrid <- f$eval.points[, 2] dgrid <- f$estimate } zlim <- replace.na(opt, zlim, c(0, max(dgrid, na.rm = TRUE))) if (is.na(opt$col)) opt$col <- "green" persp(xgrid, ygrid, dgrid, xlab = opt$xlab, ylab = opt$ylab, zlab = opt$zlab, xlim = xlim, ylim = ylim, zlim = opt$zlim, theta = opt$theta, phi = opt$phi, ticktype = "detailed", col = opt$col, d = 4) invisible(list(eval.points = cbind(xgrid, ygrid), estimate = dgrid, h = h * opt$hmult, h.weights = opt$h.weights, weights = weights)) } "sm.sliceplot" <- function (x, y, h, weights, rawdata = list(), options = list()) { opt <- sm.options(options) ngrid <- opt$ngrid xlim <- opt$xlim ylim <- opt$ylim xgrid <- opt$eval.points[,1] ygrid <- opt$eval.points[,2] if (!opt$add) { plot(x, y, xlim = opt$xlim, ylim = opt$ylim, xlab = opt$xlab, ylab = opt$ylab, type = "n") points(rawdata$x[, 1], rawdata$x[, 2], col = opt$col, pch = opt$pch, cex = 2/log(rawdata$nobs)) } if (opt$positive) f <- sm.density.positive.grid(cbind(x, y), h, weights=weights, options=opt) else f <- sm.density.eval.2d(x, y, h, xgrid, ygrid, eval.type = "grid", weights = weights, options = opt) dgrid <- f$estimate xgrid <- f$eval.points[, 1] ygrid <- f$eval.points[, 2] if (opt$positive) { opt$eval.points <- cbind(x, y) dobs <- sm.density.positive.2d(cbind(x, y), h, eval.type = "points", weights = weights, options = opt)$estimate } else dobs <- sm.density.eval.2d(x, y, h, xnew = x, ynew = y, weights = weights)$estimate props <- opt$props hts <- quantile(rep(dobs, weights), prob = (100 - props)/100) for (i in 1:length(props)) { scale <- props[i]/hts[i] contour(xgrid, ygrid, dgrid * scale, level = hts[i] * scale, add = TRUE, lty = opt$lty, col = opt$col) } invisible(list(eval.points = cbind(xgrid, ygrid), estimate = dgrid, h = h * opt$hmult, h.weights = opt$h.weights, weights = weights)) } "sm.rglplot" <- function (x, y, h, weights, rawdata, options = list()) { opt <- sm.options(options) ngrid <- opt$ngrid xlim <- opt$xlim ylim <- opt$ylim xgrid <- opt$eval.points[, 1] ygrid <- opt$eval.points[, 2] if (!opt$positive) dgrid <- sm.density.eval.2d(x, y, h, xgrid, ygrid, eval.type = "grid", weights, opt)$estimate else { f <- sm.density.positive.grid(cbind(x, y), h, weights = weights, options = opt) xgrid <- f$eval.points[, 1] ygrid <- f$eval.points[, 2] dgrid <- f$estimate } if (!opt$add) { if (any(is.na(opt$zlim))) opt$zlim <- c(0, max(dgrid * 1.5)) opt$scaling <- rpanel::rp.plot3d(xgrid, dgrid, ygrid, type = "n", xlab = opt$xlab, ylab = opt$zlab, zlab = opt$ylab, xlim = opt$xlim, ylim = opt$zlim, zlim = opt$ylim, size = opt$size, col = opt$col.points) } surf.ids <- sm.surface3d(cbind(xgrid, ygrid), dgrid, opt$scaling, col = opt$col, col.mesh = opt$col.mesh, alpha = opt$alpha, lit = opt$lit) invisible(list(eval.points = cbind(xgrid, ygrid), estimate = dgrid, h = h * opt$hmult, h.weights = opt$h.weights, weights = weights, scaling = opt$scaling, surf.ids = surf.ids)) } "sm.density.3d" <- function(x, h = hnorm(x, weights), weights = rep(1, length(x)), rawdata = list(), options = list()) { opt <- sm.options(options) replace.na(opt, ngrid, 20) replace.na(opt, xlab, deparse(substitute(x))) replace.na(opt, ylab, deparse(substitute(y))) replace.na(opt, zlab, deparse(substitute(z))) replace.na(opt, display, "rgl") if (any(is.na(opt$col)) | length(opt$col) != length(opt$props)) opt$col <- topo.colors(length(opt$props)) if (length(opt$alpha) != length(opt$props)) opt$alpha <- seq(1, 0.5, length = length(opt$props)) if (any(is.na(opt$eval.points))) { replace.na(opt, xlim, range(x[, 1])) replace.na(opt, ylim, range(x[, 2])) replace.na(opt, zlim, range(x[, 3])) evp <- cbind(seq(opt$xlim[1], opt$xlim[2], length = opt$ngrid), seq(opt$ylim[1], opt$ylim[2], length = opt$ngrid), seq(opt$zlim[1], opt$zlim[2], length = opt$ngrid)) replace.na(opt, eval.points, evp) } else { replace.na(opt, xlim, range(opt$eval.points[, 1])) replace.na(opt, ylim, range(opt$eval.points[, 2])) replace.na(opt, zlim, range(opt$eval.points[, 3])) } replace.na(opt, h.weights, rep(1, nrow(x))) hmult <- opt$hmult display <- opt$display est <- sm.density.eval.3d(x, h, opt$eval.points, eval.type = "grid", weights = weights, rawdata = rawdata, options = opt) invisible(est) } "sm.density.eval.3d" <- function (x, h, eval.points, eval.type = "points", weights = rep(1, nrow(x)), rawdata = list(), options = list()) { opt <- sm.options(options) replace.na(opt, xlim, range(x[, 1])) replace.na(opt, ylim, range(x[, 2])) replace.na(opt, zlim, range(x[, 3])) replace.na(opt, ngrid, 20) replace.na(opt, h.weights, rep(1, nrow(x))) n <- nrow(x) nnew <- nrow(eval.points) h.weights <- opt$h.weights hmult <- opt$hmult result <- list(eval.points = eval.points, h = h * hmult, h.weights = h.weights, weights = weights) surf.ids <- NA Wh <- matrix(rep(h.weights, nnew), ncol = n, byrow = TRUE) W1 <- matrix(rep(eval.points[, 1], rep(n, nnew)), ncol = n, byrow = TRUE) W1 <- W1 - matrix(rep(x[, 1], nnew), ncol = n, byrow = TRUE) W1 <- exp(-0.5 * (W1/(hmult * h[1] * Wh))^2)/Wh W2 <- matrix(rep(eval.points[, 2], rep(n, nnew)), ncol = n, byrow = TRUE) W2 <- W2 - matrix(rep(x[, 2], nnew), ncol = n, byrow = TRUE) W2 <- exp(-0.5 * (W2/(hmult * h[2] * Wh))^2)/Wh W3 <- matrix(rep(eval.points[, 3], rep(n, nnew)), ncol = n, byrow = TRUE) W3 <- W3 - matrix(rep(x[, 3], nnew), ncol = n, byrow = TRUE) W3 <- exp(-0.5 * (W3/(hmult * h[3] * Wh))^2)/Wh if (eval.type == "points") est <- as.vector(((W1 * W2 * W3) %*% weights) / (sum(weights) * (2 * pi)^1.5 * h[1] * h[2] * h[3] * hmult^3)) else { est <- sm.density.eval.3d(x, h, x, eval.type = "points", weights = weights, options = opt)$estimate levels <- quantile(est, opt$props / 100) est <- apply(W3, 1, function(x) (W1 %*% (weights * x * t(W2))) / (sum(weights) * (2 * pi)^1.5 * h[1] * h[2] * h[3] * hmult^3)) est <- array(c(est), dim = rep(opt$ngrid, 3)) if (opt$display != "none") { if (requireNamespace("rpanel", quietly = TRUE) & requireNamespace("tcltk", quietly = TRUE) & requireNamespace("rgl", quietly = TRUE) & requireNamespace("misc3d", quietly = TRUE)) { struct <- misc3d::contour3d(est, levels, eval.points[, 1], eval.points[, 2], eval.points[, 3], engine = "none") if (!opt$add) { opt$scaling <- rpanel::rp.plot3d(rawdata$x[, 1], rawdata$x[, 2], rawdata$x[, 3], xlab = opt$xlab, ylab = opt$ylab, zlab = opt$zlab, col = opt$col.points, size = opt$size) result$scaling <- opt$scaling } surf.ids <- integer(0) for (i in 1:length(opt$props)) { if (length(opt$props) > 1) strct <- struct[[i]] else strct <- struct trngs.x <- c(t(cbind(strct$v1[, 1], strct$v2[, 1],strct$v3[, 1]))) trngs.y <- c(t(cbind(strct$v1[, 2], strct$v2[, 2],strct$v3[, 2]))) trngs.z <- c(t(cbind(strct$v1[, 3], strct$v2[, 3],strct$v3[, 3]))) a <- opt$scaling(trngs.x, trngs.y, trngs.z) surf.ids <- c(surf.ids, rgl::triangles3d(a$x, a$y, a$z, col = opt$col[i], alpha = opt$alpha[i])) } } else if (opt$verbose > 0) cat("at least one of the rpanel, rgl or misc3d packages", " is not available.\n") } } result$estimate <- est result$surf.ids <- surf.ids invisible(result) } "nise" <- function (y, ...) { n <- length(y) opt <- sm.options(list(...)) replace.na(opt, nbins, round((n > 500) * 8 * log(n))) replace.na(opt, hmult, 1) if (opt$nbins > 0) { bins <- binning(y, nbins = opt$nbins) y <- bins$x weights <- bins$x.freq } else weights <- rep(1, n) y <- (y - wmean(y, weights)) / sqrt(wvar(y, weights)) h <- hnorm(y) * opt$hmult result <- dnorm(0, sd = sqrt(2 + 2 * h^2)) result <- result - 2 * sm.density(y, h = sqrt(1 + 2 * h^2), eval.points = 0, display = "none", weights = weights, nbins = 0)$estimate result <- result + wmean(sm.density(y, h = sqrt(2) * h, eval.points = y, display = "none", weights = weights, nbins = 0)$estimate, weights) result } "nmise" <- function (sd, n, h) { dnorm(0, sd = sqrt(2) * h)/n + (1 - 1/n) * dnorm(0, sd = sqrt(2 * (sd^2 + h^2))) - 2 * dnorm(0, sd = sqrt(2 * sd^2 + h^2)) + dnorm(0, sd = sqrt(2) * sd) } "nnbr" <- function (x, k) { if (isMatrix(x)) { ndim <- 2 n <- nrow(x) } else { ndim <- 1 n <- length(x) } knn <- vector("numeric", n) if (ndim == 1) { for (i in 1:length(x)) knn[i] <- sort(abs(x - x[i]))[k + 1]} if (ndim == 2) { for (i in 1:length(x[, 1])) knn[i] <- sort(sqrt(((x[, 1] - x[i, 1])^2)/var(x[, 1]) + ((x[, 2] - x[i, 2])^2)/var(x[, 2])))[k + 1] } knn } sm/R/ps-normal.r0000744000176200001440000002343312266061257013202 0ustar liggesusersps.normal <- function(x, y, lambda, df = 5, method = "df", weights, eval.points, ngrid, weights.penalty = FALSE, nseg, bdeg = 3, pord = 2, display = "lines", increasing = FALSE, decreasing = FALSE, kappa = lambda * 100, fixed, negative = TRUE) { # Function ps.normal: smooths scatterplot data with P-splines. # Input: x = abcissae of data. # Input: y = response (counts). # Input: nseg = number of intervals for B-splines. # Input: bdeg = degree of B-splines. # Input: pord = order of difference penalty. # Input: lambda = smoothness parameter. # # Based on code written by Paul Eilers and Brian Marx, 2007 # The ordering of matrices, axes etc. needs to be corrected. if (is.vector(x)) x <- matrix(x, ncol = 1) ndim <- ncol(x) n <- nrow(x) if (missing(ngrid)) ngrid <- switch(ndim, 100, 20, 20) lambda.select <- missing(lambda) if (missing(nseg)) nseg <- switch(ndim, 100, 17, 10) # if (ndim == 1 & (!missing(fixed)) & (increasing | decreasing)) # stop("monotonic increasing estimation is not available with fixed points.") if (ndim == 1 & increasing & decreasing) stop("only one of increasing and decreasing can be set to TRUE.") if (missing(weights)) weights <- rep(1, length(y)) weights <- diag(weights) if (missing(eval.points)) { eval.points <- list(length = ndim) for (i in 1:ndim) eval.points[[i]] <- seq(min(x[,i]) - 0.05 * diff(range(x[,i])), max(x[,i]) + 0.05 * diff(range(x[,i])), length = ngrid) evp <- eval.points eval.points <- as.matrix(expand.grid(eval.points)) } else if (ndim == 1) eval.points <- matrix(eval.points, ncol = 1) # Compute B-spline basis tim <- proc.time() b <- list(length = ndim) m <- vector(length = ndim) for (i in 1:ndim) { b[[i]] <- bbase(x[,i], xl = min(x[,i]) - 0.05 * diff(range(x[,i])), xr = max(x[,i]) + 0.05 * diff(range(x[,i])), nseg = nseg, deg = bdeg) m[i] <- dim(b[[i]])[2] } B <- b[[1]] if (ndim > 1) B <- t(apply(cbind(b[[1]], b[[2]]), 1, function(x) c(x[1:m[1]] %x% x[-(1:m[1])]))) if (ndim == 3) B <- t(apply(cbind(B, b[[3]]), 1, function(x) c(x[1:(m[1]*m[2])] %x% x[-(1:(m[1]*m[2]))]))) # cat("bases:", proc.time()[3] - tim[3], "\n") # tim <- proc.time() # Construct penalty matrices P <- list(length = ndim) for (i in 1:ndim) { P[[i]] <- diff(diag(m[1]), diff = pord) if (weights.penalty) P[[i]] <- t(P[[i]]) %*% diag(exp(seq(1:nrow(P[[i]])) * log(100) / (nrow(P[[i]]) - 1))) %*% P[[i]] else P[[i]] <- t(P[[i]]) %*% P[[i]] } if (ndim >= 2) { P[[1]] <- P[[1]] %x% diag(m[2]) P[[2]] <- diag(m[2]) %x% P[[2]] } if (ndim == 3) { P[[1]] <- P[[1]] %x% diag(m[3]) P[[2]] <- P[[2]] %x% diag(m[3]) P[[3]] <- diag(m[1]) %x% diag(m[2]) %x% P[[3]] } # cat("penalties:", proc.time()[3] - tim[3], "\n") # tim <- proc.time() btb <- t(B) %*% weights %*% B bty <- t(B) %*% weights %*% y # Identify lambda (ndim = 1 only at the moment) if (lambda.select) { if (method == "df") { lambda.df <- function(lambda, btb, bty, P) { mat <- 0 for (i in 1:length(P)) mat <- mat + lambda[i] * P[[i]] B1 <- solve(btb + mat) beta <- as.vector(B1 %*% bty) sum(diag(btb %*% B1)) } lambda <- 1 # print(lambda.df(lambda, btb, bty, P)) # print(adf) while (lambda.df(lambda, btb, bty, P) <= df) lambda <- lambda / 10 lower <- lambda lambda <- 1 while (lambda.df(lambda, btb, bty, P) >= df) lambda <- lambda * 10 upper <- lambda lambda.crit <- function(lambda, btb, bty, P, df) lambda.df(lambda, btb, bty, P) - df result <- uniroot(lambda.crit, interval = c(lower, upper), btb, bty, P, df) lambda <- result$root } } # Fit btb <- t(B) %*% weights %*% B bty <- t(B) %*% weights %*% y # cat("matrices:", proc.time()[3] - tim[3], "\n") # tim <- proc.time() mat <- 0 # print(lambda) for (i in 1:length(P)) mat <- mat + lambda[i] * P[[i]] B1 <- solve(btb + mat) # cat("inversion:", proc.time()[3] - tim[3], "\n") # tim <- proc.time() beta <- as.vector(B1 %*% bty) # cat("solution:", proc.time()[3] - tim[3], "\n") # tim <- proc.time() # f <- lsfit(rbind(B, P1, P2, P3), c(y, nix), intercept = FALSE) # h <- hat(f$qr)[1:m] # beta <- f$coef mu <- c(B %*% beta) edf <- sum(diag(btb %*% B1)) # cat("fitting:", proc.time()[3] - tim[3], "\n") # tim <- proc.time() # Adjust for monotonicity and for fixed points - one covariate only if (ndim == 1 & !missing(fixed)) { if (any(fixed[,1] <= min(x) - 0.05 * diff(range(x[,i]))) | any(fixed[,1] >= max(x) + 0.05 * diff(range(x[,i])))) stop("fixed points must be inside the range of the data.") fixed <- matrix(c(fixed), ncol = ndim + 1) A <- bbase(fixed[ , 1:ndim], xl = min(x[,i]) - 0.05 * diff(range(x[,i])), xr = max(x[,i]) + 0.05 * diff(range(x[,i])), nseg = nseg, deg = bdeg) beta <- beta + B1 %*% t(A) %*% solve(A %*% B1 %*% t(A)) %*% (fixed[ , ndim + 1] - A %*% beta) edf <- NA } if (ndim == 1 & (increasing | decreasing | !negative)) { if (!missing(fixed)) stop("fixed values cannot be used with increasing/decreasing/non-negative constraints") D1 <- diff(diag(m[1]), diff = 1) delta <- 1 while (delta > 1e-5) { mat1 <- mat if (increasing | decreasing) { if (increasing) v <- as.numeric(diff(beta) <= 0) if (decreasing) v <- as.numeric(diff(beta) >= 0) mat1 <- mat1 + kappa * t(D1) %*% diag(v) %*% D1 } if (!negative) { # A <- bbase(seq(0, 1, length = 20), xl = 0, xr = 1, nseg = nseg, deg = bdeg) # v <- as.numeric(c(A %*% beta) < 0) # mat1 <- mat1 + kappa * (t(A) %*% diag(v) %*% A) v <- as.numeric(beta < 0) mat1 <- mat1 + kappa * diag(v) } B1 <- solve(t(B) %*% weights %*% B + mat1) beta.old <- beta beta <- as.vector(B1 %*% t(B) %*% weights %*% y) delta <- sum((beta - beta.old)^2) / sum(beta.old^2) } } # Cross-validation and dispersion # r <- (y - mu ) / (1 - h) # cv <- sqrt(sum(r ^2)) # sigma <- sqrt(sum((y - mu) ^2) / (n - sum(h))) # Evaluate the estimate at eval.points for (i in 1:ndim) { b[[i]] <- bbase(eval.points[,i], xl = min(x[,i]) - 0.05 * diff(range(x[,i])), xr = max(x[,i]) + 0.05 * diff(range(x[,i])), nseg = nseg, deg = bdeg) m[i] <- dim(b[[i]])[2] } B <- b[[1]] if (ndim > 1) B <- t(apply(cbind(b[[1]], b[[2]]), 1, function(x) c(x[1:m[1]] %x% x[-(1:m[1])]))) if (ndim == 3) B <- t(apply(cbind(B, b[[3]]), 1, function(x) c(x[1:(m[1]*m[2])] %x% x[-(1:(m[1]*m[2]))]))) est <- c(B %*% beta) if (ndim > 1) est <- array(est, dim = rep(ngrid, ndim)) # cat("estimate:", proc.time()[3] - tim[3], "\n") # tim <- proc.time() # Plot data and fit if (display != "none") { if (ndim == 1) { plot(x, y, main = '', xlab = '', ylab = '') lines(eval.points[,1], est, col = 'blue') # if (se > 0 ) { # Covb = solve(btb + P[[1]]) # Covz = sigma^2 * B %*% Covb %*% t(B) # seb = se * sqrt(diag(Covz)) # lines(u, est + seb, lty = 2, col = 'red') # lines(u, est - seb, lty = 2, col = 'red') # } } else if (ndim == 2) { persp(evp[[1]], evp[[2]], est, ticktype = "detailed", col = "green", d = 10, theta = 30) } } # Return list pp <- list(x = x, y = y, muhat = mu, nseg = nseg, bdeg = bdeg, pord = pord, beta = beta, B = B, b = b, lambda = lambda, eval.points = eval.points, estimate = est, btb = btb, P = P, bty = bty, df = edf, eval.points = eval.points, # cv = cv, effdim = sum(h), ed.resid = m - sum(h), sigma = sigma, family = "gaussian", link = "identity") class(pp) = "pspfit" return(invisible(pp)) } # Paul Eilers material tpower <- function(x, t, p) # Truncated p-th power function (x - t) ^ p * (x > t) bbase <- function(x, xl = min(x), xr = max(x), nseg = 10, deg = 3){ # Construct B-spline basis dx <- (xr - xl) / nseg knots <- seq(xl - deg * dx, xr + deg * dx, by = dx) P <- outer(x, knots, tpower, deg) n <- dim(P)[2] D <- diff(diag(n), diff = deg + 1) / (gamma(deg + 1) * dx ^ deg) B <- (-1) ^ (deg + 1) * P %*% t(D) B } gauss <- function(x, mu, sig) { # Gaussian-shaped function u <- (x - mu) / sig y <- exp(- u * u / 2) y } gbase <- function(x, mus) { # Construct Gaussian basis sig <- (mus[2] - mus[1]) / 2 G <- outer(x, mus, gauss, sig) G } pbase <- function(x, n) { # Construct polynomial basis u <- (x - min(x)) / (max(x) - min(x)) u <- 2 * (u - 0.5); P <- outer(u, seq(0, n, by = 1), "^") P } sm/R/utilities.r0000744000176200001440000002523113272354355013305 0ustar liggesusers"sm.options" <- function (...) { if (nargs() == 0) return(.sm.Options) current <- .sm.Options temp <- list(...) if (length(temp) == 1 && is.null(names(temp))) { arg <- temp[[1]] switch(mode(arg), list = temp <- arg, character = return(.sm.Options[arg]), stop("invalid argument: ", sQuote(arg))) } if (length(temp) == 0) return(current) n <- names(temp) if (is.null(n)) stop("options must be given by name") changed <- current[n] current[n] <- temp if (sys.parent() == 0) env <- asNamespace("sm") else env <- parent.frame() assign(".sm.Options", current, envir = env) invisible(current) } # Not sure where this version came from. It doesn't seem to work. # "sm.options" <- function (...) { # if (nargs() == 0) return(.sm.Options) # current <- .sm.Options # if (is.character(...)) # temp <- eval(parse(text = paste(c("list(", ..., ")")))) # else temp <- list(...) # if (length(temp) == 1 && is.null(names(temp))) { # arg <- temp[[1]] # switch(mode(arg), # list = temp <- arg, # character = return(.Options[arg]), # stop(paste("invalid argument:", arg))) # } # if (length(temp) == 0) return(current) # n <- names(temp) # if (is.null(n)) stop("options must be given by name") # changed <- current[n] # current[n] <- temp # if (sys.parent() == 0) env <- pos.to.env( match(".GlobalEnv", search()) ) # else env <- parent.frame() # assign(".sm.Options", current, envir = env) # invisible(current) # } "binning" <- function (x, y, breaks, nbins) { binning.1d <- function(x, y, breaks, nbins) { f <- cut(x, breaks = breaks) if (any(is.na(f))) stop("breaks do not span the range of x") freq <- tabulate(f, length(levels(f))) midpoints <- (breaks[-1] + breaks[-(nbins + 1)])/2 id <- (freq > 0) x <- midpoints[id] x.freq <- as.vector(freq[id]) result <- list(x = x, x.freq = x.freq, table.freq = freq, breaks = breaks) if (!all(is.na(y))) { result$means <- as.vector(tapply(y, f, mean))[id] result$sums <- as.vector(tapply(y, f, sum))[id] result$devs <- as.vector(tapply(y, f, function(x) sum((x - mean(x))^2)))[id] } result } binning.2d <- function(x, y, breaks, nbins) { f1 <- cut(x[, 1], breaks = breaks[, 1]) f2 <- cut(x[, 2], breaks = breaks[, 2]) freq <- t(table(f1, f2)) dimnames(freq) <- NULL midpoints <- (breaks[-1, ] + breaks[-(nbins + 1), ])/2 z1 <- midpoints[, 1] z2 <- midpoints[, 2] X <- cbind(rep(z1, length(z2)), rep(z2, rep(length(z1), length(z2)))) X.f <- as.vector(t(freq)) id <- (X.f > 0) X <- X[id, ] dimnames(X) <- list(NULL, dimnames(x)[[2]]) X.f <- X.f[id] result <- list(x = X, x.freq = X.f, midpoints = midpoints, breaks = breaks, table.freq = freq) if (!all(is.na(y))) { result$means <- as.numeric(tapply(y, list(f1, f2), mean))[id] result$devs <- as.numeric(tapply(y, list(f1, f2), function(x) sum((x - mean(x))^2)))[id] } result } binning.3d <- function(x, y, breaks, nbins) { f1 <- cut(x[, 1], breaks = breaks[, 1]) f2 <- cut(x[, 2], breaks = breaks[, 2]) f3 <- cut(x[, 3], breaks = breaks[, 3]) freq <- table(f1, f2, f3) dimnames(freq) <- NULL midpoints <- (breaks[-1, ] + breaks[-(nbins + 1), ])/2 z1 <- midpoints[, 1] z2 <- midpoints[, 2] z3 <- midpoints[, 3] X <- as.matrix(expand.grid(z1, z2, z3)) X.f <- as.vector(freq) id <- (X.f > 0) X <- X[id, ] dimnames(X) <- list(NULL, dimnames(x)[[2]]) X.f <- X.f[id] result <- list(x = X, x.freq = X.f, midpoints = midpoints, breaks = breaks, table.freq = freq) if (!all(is.na(y))) { result$means <- as.numeric(tapply(y, list(f1, f2, f3), mean))[id] result$devs <- as.numeric(tapply(y, list(f1, f2, f3), function(x) sum((x - mean(x))^2)))[id] } result } if (length(dim(x)) > 0) { if (!isMatrix(x)) stop("wrong parameter x for binning") ndim <- dim(x)[2] if (ndim > 3) stop("binning can be carried out only with 1-3 variables") if (missing(y)) y <- rep(NA, nrow(x)) if (missing(nbins)) nbins <- round(log(nrow(x)) / log(2) + 1) if (missing(breaks)) { breaks <- cbind(seq(min(x[, 1]), max(x[, 1]), length = nbins + 1), seq(min(x[, 2]), max(x[, 2]), length = nbins + 1)) if (ndim == 3) breaks <- cbind(breaks, seq(min(x[, 3]), max(x[, 3]), length = nbins + 1)) breaks[1, ] <- breaks[1, ] - rep(10^(-5), ncol(breaks)) } else nbins <- nrow(breaks) - 1 if (max(abs(breaks)) == Inf | is.na(max(abs(breaks)))) stop("illegal breaks") if (ndim == 2) result <- binning.2d(x, y, breaks = breaks, nbins = nbins) else result <- binning.3d(x, y, breaks = breaks, nbins = nbins) } else { x <- as.vector(x) if (missing(y)) y <- rep(NA, length(x)) if (missing(nbins)) nbins <- round(log(length(x))/log(2) + 1) if (missing(breaks)) { breaks <- seq(min(x), max(x), length = nbins + 1) breaks[1] <- breaks[1] - 10^(-5) } else nbins <- length(breaks) - 1 if (max(abs(breaks)) == Inf | is.na(max(abs(breaks)))) stop("illegal breaks") result <- binning.1d(x, y, breaks = breaks, nbins = nbins) } result } "replace.na" <- function (List, comp, value) { arg <- paste(substitute(List), "$", substitute(comp), sep = "") arg.value <- eval(parse(text = arg), parent.frame(1)) if (any(is.na(arg.value))) { change <- paste(arg, "<-", deparse(substitute(value))) a <- eval(parse(text = change), parent.frame(1)) } invisible() } # "attach.frame" <- function (data, name, ...) { # if (missing(name)) # name <- deparse(substitute(data)) # if (is.data.frame(data)) { # if (!is.na(pos <- match(name, search()))) { # cat(paste(name, "already attached, re-attached in 2nd position\n")) # detach(pos = pos) # } # cat(paste("attaching", name, "\n", sep = " ")) # attach(what = data, pos = 2, name = name, ...) # } # else { # cat(name) # cat(" is not a data.frame\n") # } # invisible() # } "provide.data" <- function (data, path, options = list()) { cat("This function is no longer available in the sm package.\n") cat("The data and attach functions should be used instead.\n") } # "provide.data" <- function (data, path, options = list()) { # describe <- sm.options(options)$describe # name <- deparse(substitute(data)) # if (missing(path)) # path <- system.file("smdata", package="sm") # datafile <- file.path(path, paste(name, ".dat", sep = "")) # docfile <- file.path(path, paste(name, ".doc", sep = "")) # if (!exists(name, where=.GlobalEnv, inherits = FALSE)) { # if (file.exists(datafile)) { # cat("Data file being loaded\n") # env <- .GlobalEnv # assign(name, read.table(datafile, header = TRUE), envir = env) # attach(what = data, name = name) # } # else cat("Data file does not exist\n") # } # else { # if (!is.data.frame(data)) # cat("object exists, not as a data.frame\n") # else { # cat(paste(name, "already loaded\n")) # attach.frame(data, name = name) # } # } # if (describe) { # if(file.exists(docfile)) file.show(docfile) # else cat("Data description file not found\n") # } # invisible() # } "sm.check.data" <- function (x, y = NA, weights = NA, group = NA, ...) { opt <- sm.options(list(...)) density <- all(is.na(y)) if (density) X <- x else X <- cbind(x, y) if(all(is.na(weights)) | all(weights == 1)) X <- cbind(X, 1) else{ if(!is.na(opt$nbins) & opt$nbins!=0) stop("if weights are set, nbins must be either 0 or NA") if(any(weights<0 | is.na(weights))) stop("negative or NA weights are meaningless") if(any(weights!=round(weights))) { weights <- round(weights/min(weights[weights>0])) if(opt$verbose>0) cat("Warning: weights have been rescaled to integer values\n") } X <- cbind(X, weights) } ndim <- ncol(X) - 1 - (!density) # dimensionality of x if (!all(is.na(group))) { X <- cbind(X, group) group.col <- ncol(X) } if (!all(is.na(opt$h.weights))) { X <- cbind(X,opt$h.weights) hw.col <- ncol(X) } if (any(is.na(X)) & opt$verbose > 0) cat("missing data are removed\n") X <- na.omit(data.matrix(X)) if (ndim > 2 + density) stop("x has too many columns") weights <- as.vector(X[, ndim + (!density) + 1]) if (!density) y <- as.vector(X[, ndim + 1]) x <- if (ndim == 1) as.vector(X[, 1]) else X[, 1:ndim] if (!all(is.na(group))) group <- as.vector(X[, group.col]) if (!all(is.na(opt$h.weights))) opt$h.weights <- X[, hw.col] list(x = x, y = y, weights = weights, group = group, ndim = ndim, nobs = nrow(X), density = density, options = opt) } "britmap" <- function () { jump <- c(0, sqrt(diff(sm::britpts$britlat)^2 + diff(sm::britpts$britlong)^2)) flag <- rep(1, nrow(sm::britpts)) flag[jump >= 0.6] <- NA lines(sm::britpts * flag) } "pause" <- function () { if(interactive()) readline("Pause. Press to continue...") invisible() } "wmean" <- function (x, w) sum(x * w)/sum(w) "wvar" <- function (x, w) sum(w * (x - wmean(x, w))^2)/(sum(w) - 1) if(getRversion() >= "2.15.1") utils::globalVariables(c("xyzcheck", "llong", "llat", "X", "Y", "britlat", "britlong", "theta", "phi", "h.weights", "nbins", "hmult", "long2", "lat2", "invislong", "invislat", "smplot", "display", "se", "panel.plot", "method", "h.manual", "se.test", "smplot", "band", "xgrid", "xlab", "ylab", "xlim", "ylim", "eval.points", "ndim", "delta", "col.band", "col.points", "yht", "pch", "test", "cex", "zlab", "fmat", "ngrid", "zlim")) sm/R/pca.r0000755000176200001440000002065612266061257012043 0ustar liggesuserssm.pca <- function(x, Y, h, cor = TRUE, nperm = 100, pc = 1, ...) { opt <- sm.options(list(...)) replace.na(opt, test, TRUE) replace.na(opt, band, TRUE) replace.na(opt, display, c("eigenvalues", "eigenvectors")) replace.na(opt, col, "red") # If x is a previously computed sm.pca object then plot as required if (is.list(x) & ("evals" %in% names(x))) { evalmat <- t(x$evals) evec <- x$evecs zgrid <- x$eval.points ngrid <- length(zgrid) if ("evals.perm" %in% names(x)) neweval <- x$evals.perm if ("evecs.perm" %in% names(x)) newevec <- x$evecs.perm ylim.missing <- any(is.na(opt$ylim)) if ("eigenvalues" %in% opt$display) { e <- evalmat[pc, ] rng <- range(e) if (opt$band & ("evals.perm" %in% names(x))) { r <- neweval[pc, , ] neweig1 <- apply(r, 1, function(x) quantile(x, prob = 0.025)) neweig2 <- apply(r, 1, function(x) quantile(x, prob = 0.975)) rng <- range(rng, neweig1, neweig2) mtch <- match("band", names(x)) x$band <- cbind(q1 = neweig2, q2 = neweig1) } if (ylim.missing) opt$ylim <- rng plot(zgrid, e, type = "n", xlab = opt$xlab, ylab = "Variance", ylim = opt$ylim) if (opt$band & ("evals.perm" %in% names(x))) polygon(c(zgrid, rev(zgrid)), c(neweig1, rev(neweig2)), col = opt$col.band, border = NA) lines(zgrid, e, lwd = opt$lwd, col = opt$col) } if ("eigenvectors" %in% opt$display) { e <- evec[ , pc, ] p <- dim(e)[1] if (opt$band & ("evecs.perm" %in% names(x))) { r <- newevec[ , pc, , ] for(k in 1:p) { for(i in 1:nperm) { for(j in 1:ngrid) { if((sign(sum(e[k, ])) == sign(r[k, j, i])) == FALSE) r[k, j, i] <- -1 * r[k, j, i] }}} xmat <- matrix(nrow = 2 * ngrid - 1, ncol = p) clrmat <- matrix(nrow = 2 * ngrid - 2, ncol = p) for (i in 1:p) { q <- apply(r[i, , ], 1, function(x) quantile(x, prob = c(0.025, 0.975))) ind <- as.numeric(sign((q[1, ] - e[i, ]) * (q[2, ] - e[i, ])) < 1) ind <- rep(ind, each = 2) ind <- ind[-c(1, 2 * ngrid)] clrb <- rep(255, 3) clri <- col2rgb(i) clri <- rgb(clri[1] + ind * (clrb[1] - clri[1]) * 0.9, clri[2] + ind * (clrb[2] - clri[2]) * 0.9, clri[3] + ind * (clrb[3] - clri[3]) * 0.9, maxColorValue = 255) xg <- c(rbind(e[i, ], e[i, ] + c(0.5 * diff(e[i, ]), 0))) xmat[ , i] <- xg[-2 * ngrid] clrmat[ , i] <- clri } zg <- c(rbind(zgrid, zgrid + c(0.5 * diff(zgrid), 0))) zg <- zg[-2 * ngrid] if (ylim.missing) opt$ylim <- range(xmat) plot(range(zg), range(xmat), type = "n", xlab = opt$xlab, ylab = "PC loadings", ylim = opt$ylim) for (i in 1:p) segments(zg[-length(zg)], xmat[-nrow(xmat), i], zg[-1], xmat[-1, i], col = clrmat[ , i], lty = i) x$xgrid.plot <- zg x$evecs.plot <- xmat x$col.plot <- clrmat } else { replace.na(opt, ylim, range(e)) plot(range(zgrid), range(e), type = "n", xlab = opt$xlab, ylab = "PC loadings", ylim = opt$ylim) for (i in 1:p) lines(zgrid, e[i, ], col = i, lty = i) } } if (opt$test & ("evals.perm" %in% names(x))) { n <- length(x$x) p <- ncol(x$Y) S <- sm.weight(x$x, x$x, h = x$h, options = list(poly.index = 1)) mht <- S %*% x$Y S <- x$Y - mht # S <- sweep(x$Y, 2, apply(x$Y, 2, mean)) sdv <- if (cor) apply(x$Y, 2, sd) else rep(1, p) S <- S / matrix(rep(sdv, each = n), ncol = p) S <- t(S) %*% S / n pc0 <- eigen(S, symmetric = TRUE) e <- evalmat[pc, ] r <- neweval[pc, , ] tst1 <- sum(abs(e - pc0$values[pc])) ref1 <- apply(abs(r - pc0$values[pc]), 2, sum) pv1 <- length(which(ref1 > tst1)) / length(ref1) e0 <- pc0$vectors[ , pc] e <- evec[ , pc, ] r <- newevec[ , pc, , ] tst2 <- sum(1 - apply(sweep(e, 1, e0, "*"), 2, sum)^2) ref2 <- apply(1 - apply(sweep(r, 1, e0, "*"), 2:3, sum)^2, 2, sum) pv2 <- length(which(ref2 > tst2)) / length(ref2) x$p.values <- pv1 x$p.vectors <- pv2 if (opt$verbose > 0) { cat("Eigenvalues: p =", round(pv1, 3), "\n") cat("Eigenvectors: p =", round(pv2, 3), "\n") } } return(invisible(x)) } # Compute the information needed for plotting if (!is.vector(x)) stop("x should be a vector.") if (!is.matrix(Y)) stop("Y should be a matrix.") if (!(length(x) == nrow(Y))) stop("the length of x should match the number of rows of Y.") x.name <- deparse(substitute(x)) y.name <- deparse(substitute(Y)) z <- x ind <- apply(cbind(x, Y), 1, function(x) any(is.na(x))) z <- z[!ind] Y <- Y[!ind, ] if(missing(h)) h <- h.select(x, Y[ , 1], ...) replace.na(opt, ngrid, 25) replace.na(opt, eval.points, seq(min(z), max(z), length = opt$ngrid)) replace.na(opt, xlab, x.name) zgrid <- opt$eval.points ngrid <- opt$ngrid n <- nrow(Y) p <- ncol(Y) evec <- array(0, c(p, p, ngrid)) evalmat <- matrix(0, nrow = p, ncol = ngrid) varmat <- matrix(0, nrow = p, ncol = ngrid) mhat <- matrix(0, nrow = p, ncol = ngrid) indmat <- matrix(0, nrow = p, ncol = ngrid) indmat[,1] <- 1:p max.ind <- function(x, p) which(abs(x) == max(abs(x))) # Vtot <- matrix(0, p, p) for (i in 1:ngrid) { S <- sm.weight(z, zgrid[i], h = h, options = list(poly.index = 1)) mhat[, i] <- as.vector(S %*% Y) D <- Y - matrix(rep(mhat[, i], n), ncol = p, byrow = TRUE) sdvec <- if (cor) apply(Y, 2, sd) else rep(1, p) D <- D / matrix(rep(sdvec, each = n), ncol = p) S <- sm.weight(z, zgrid[i], h = h, options = list(poly.index = 1)) V <- t(D) %*% diag(as.vector(S)) %*% D # Vtot <- Vtot + length(z) * V pca <- eigen(V, symmetric = TRUE) if (i > 1) { d <- crossprod(pca$vectors, old.vectors) indmat[,i] <- apply(d, 1, max.ind, p = p) indmat[,i] <- indmat[ , i - 1][indmat[ , i]] dmax <- d[cbind(1:p, indmat[ , i])] for (j in (1:p)[dmax < 0]) pca$vectors[ , j] <- -pca$vectors[ , j] } pca$values[pca$values < 0] <- 0 pcvar <- pca$values / sum(pca$values) ord <- order(indmat[ , i]) varmat[, i] <- pcvar[ord] evalmat[, i] <- pca$values[ord] evec[ , , i] <- pca$vectors[, ord] old.vectors <- pca$vectors ind.old <- indmat[,i] } result <- list(xgrid = zgrid, evecs = evec, evals = t(evalmat), mhat = t(mhat), var.explained = t(varmat), eval.points = opt$eval.points, xlab = opt$xlab, h = h, x = x, Y = Y, nperm = nperm, cor = cor) if (opt$test | opt$band) { newevec <- array(NA, c(ncol(Y), ncol(Y), ngrid, nperm)) neweval <- array(NA, c(ncol(Y), ngrid, nperm)) # Vtot <- array(NA, c(dim(Y)[2], dim(Y)[2], nperm)) znew <- replicate(nperm, sample(z, length(z)), simplify = TRUE) spc <- function(x){ spc2 <- sm.pca(x, Y, h, cor = cor, eval.points = opt$eval.points, test = FALSE, band = FALSE, display = "none") # Vtot <- spc2$Vtot newevec <- spc2$evecs neweval <- t(spc2$evals) list(newevec = newevec, neweval = neweval) } res <- apply(znew, 2, spc) for(i in 1:nperm){ # Vtot[ , , i] <- res[[i]]$Vtot newevec[ , , , i] <- res[[i]]$newevec neweval[ , , i] <- res[[i]]$neweval } result$evecs.perm <- newevec result$evals.perm <- neweval } if (!("none" %in% opt$display)) result <- sm.pca(result, display = opt$display, pc = pc) invisible(result) } sm/R/monotonicity.r0000744000176200001440000001235412266061257014025 0ustar liggesuserssm.monotonicity <- function(x, y, N = rep(1, length(y)), h, type = "continuous", ...) { # A test of monotonicity with nonparametric regression if (!(type %in% c("continuous", "binomial"))) stop("only continuous and binomial data can be handed.") x.name <- deparse(substitute(x)) y.name <- deparse(substitute(y)) if (isMatrix(x)) { cat("Warning: only the first covariate has been used.\n") x <- x[, 1] } opt <- sm.options(list(...)) data <- sm.check.data(x = cbind(x, N), y = y, ...) x <- data$x[, 1] y <- data$y N <- data$x[, 2] n <- data$nobs ndim <- data$ndim opt <- data$options replace.na(opt, display, "lines") replace.na(opt, nboot, 200) replace.na(opt, col, "black") replace.na(opt, df, 5) replace.na(opt, ngrid, 100) replace.na(opt, xlab, x.name) replace.na(opt, ylab, y.name) replace.na(opt, xlim, range(x)) if (type == "continuous") replace.na(opt, ylim, range(y)) else replace.na(opt, ylim, range(y / N)) ngrid <- opt$ngrid nboot <- opt$nboot display <- opt$display if ((type == "continuous")) { if (missing(h)) h <- h.select(x, y, ...) h0 <- h } #....................Find boundary h value............................... n <- length(y) r <- (max(x) - min(x)) hstart <- r / 50 hend <- r / 2 if (type == "binomial") { hstart <- hstart * 2 hend <- hend * 2 } hstep <- (hend - hstart) / (ngrid - 1) h <- hstart shape <- shapesmooth(x, y, N, h, ngrid, type) if (shape == "increasing" | shape == "decreasing") { cat("The test cannot be performed as the smooth curve is already", "monotonic at the smallest value of h.\n") return() } while (shape == "non-monotonic" & h < hend) { h <- h + hstep shape <- shapesmooth(x, y, N, h, ngrid, type) } if (shape == "flat") { cat("The test cannot be performed as the only monotonic shape identified is flat.\n") return() } else if (shape == "non-monotonic") { stop("The test cannot be performed as the smooth curves are non-monotonic at all values of h.\n") return() } if (shape == "increasing") article <- "an" else article <- "a" if (opt$verbose > 0) cat("The smallest h which produces", article, shape,"curve is",signif(h, digits = 5), "\n") #............Find residuals from which to bootstrap (continuous case)........ if (type=="continuous") { smres <- sm.regression(x, y, h0, eval.points = x, display = "none") e <- y - smres$estimate e <- e - mean(e) if (opt$verbose > 0) { cat("Standard deviation of estimated errors is:", signif(sqrt(var(e)), digits = 5), "\n") cat("Smoothing parameter used for estimation of residuals is:", signif(h0, digits = 5), "\n") } } #.............Bootstrap data from monotonic estimator.................... if (type=="continuous") sm <- sm.regression(x, y, h, eval.points = x, display = "none") else if (type=="binomial") sm <- sm.binomial(x, y, N, h, eval.points = x, display = "none") if (display != "none") { if (!opt$add) { if (type == "continuous") yy <- y else yy <- jitter(y / N, amount = 0) plot(x, yy, xlab = opt$xlab, ylab = opt$ylab, xlim = opt$xlim, ylim = opt$ylim, col = opt$col.points, pch = opt$pch) } } p <- 0 for (i in 1:nboot) { if (type=="continuous") ystar <- sm$estimate + sample(e, size = n, replace = TRUE) else ystar <- rbinom(n, N, sm$estimate) shsm <- shapesmooth(x, ystar, N, h, ngrid, type) if (shsm == "non-monotonic") p <- p + 1 if (shsm == "missing") cat("Warning: shape not identifiable.\n") if (display != "none") { if (shsm == "non-monotonic") clr <- "red" else clr <- "grey" if (type == "continuous") sm.regression(x, ystar, h, ngrid=ngrid, col = clr, add = TRUE) else { a <- sm.binomial(x, ystar, N, h, ngrid=ngrid, display = "none") lines(a$eval.points, a$estimate, col = clr, lty = opt$lty) } } } p <- p / nboot if (opt$verbose > 0) cat("Test of monotonicity: p =", round(p, 3), "\n") results <- list(p = p, hcrit = h) if (type == "continuous") results$h <- h0 invisible(results) } #------------------------------------------------------------------------ shapesmooth <- function(x, y, N = rep(1, length(y)), h, ngrid, type) { # Identifies the shape of a nonparametric regression function if (type == "continuous") sm <- sm.regression(x, y, h, ngrid = ngrid, display = "none") else sm <- sm.binomial(x, y, N, h, ngrid = ngrid, display = "none") d <- diff(sm$estimate) nplus <- length(d[d > 0]) nminus <- length(d[d < 0]) nzero <- length(d[d == 0]) nsm <- length(d) shapeind <- "missing" if (nplus == nsm) shapeind <- "increasing" if (nminus == nsm) shapeind <- "decreasing" if (nzero == nsm) shapeind <- "flat" if (nplus > 0 & nminus > 0) shapeind <- "non-monotonic" shapeind } sm/R/glm.r0000744000176200001440000005264512266061256012057 0ustar liggesusers"sm.binomial" <- function (x, y, N = rep(1, length(y)), h, ...) { x.name <- deparse(substitute(x)) y.name <- deparse(substitute(y)) opt <- sm.options(list(...)) if (any(is.na(c(x, y, N)))) { xy <- cbind(x, y, N) ok <- as.logical(apply(!is.na(xy), 1, prod)) xy <- xy[ok, ] x <- as.vector(xy[, 1]) y <- as.vector(xy[, 2]) N <- as.vector(xy[, 3]) if(opt$verbose>0) cat("warning: missing data are removed\n") } n <- length(y) replace.na(opt, display, "line") replace.na(opt, ngrid, 25) replace.na(opt, ylim, c(0, 1)) replace.na(opt, col, "black") replace.na(opt, nbins, round((n > 100) * 8 * log(n))) display <- opt$display if (length(x) != n) stop("x and y have different length") if (length(N) != n) stop("N and y have different length") y <- as.integer(y) if (min(diff(x)) < 0) { y <- y[order(x)] x <- sort(x) } replace.na(opt, eval.points, seq(min(x), max(x), length = opt$ngrid)) replace.na(opt, nbins, round((nobs > 100) * 8 * log(n)/ndim)) if (all(N == 1)) yplot <- jitter(y, amount = 0) else yplot <- y/N if (display != "none" & opt$add == FALSE) { replace.na(opt, xlab, x.name) replace.na(opt, ylab, paste("Pr{", y.name, "}", sep = "")) plot(x, yplot, ylim = opt$ylim, xlab = opt$xlab, ylab = opt$ylab, col = 1, type = "n") abline(0, 0, col = 1, lty = 3) abline(1, 0, col = 1, lty = 3) } if (display != "none") points(x, yplot, pch = opt$pch, col = opt$col) rawdata <- list(x = x, y = y, N = N, nbins = opt$nbins, nobs = n, ndim = 1) if (opt$nbins > 0) { bins <- binning(x, y, nbins = opt$nbins) binsN <- binning(x, N, nbins = opt$nbins) x <- bins$x y <- round(bins$sums) N <- round(binsN$sums) nx <- length(y) } result <- sm.glm(x, cbind(y, N - y), family = binomial(), h = h, eval.points = opt$eval.points, start = log((y + 0.5)/(N - y + 1)), options=opt) result$call <- match.call() if (display != "none") { lines(result$eval.points, result$estimate, col = opt$col) if (display == "se") { lines(result$eval.points, result$lower, lty = 3, col = opt$col) lines(result$eval.points, result$upper, lty = 3, col = opt$col) } } result$data <- list(x = x, y = y, N = N, nbins = opt$nbins) invisible(result) } "sm.binomial.bootstrap" <- function (x, y, N = rep(1, length(x)), h, degree = 1, fixed.disp = FALSE, ...) { rbetabinom <- function(n, size, prob, disp) { if (disp > 1 & min(size) > 2 & min(size) > disp) { psi <- (disp - 1)/(size - 1) alpha <- prob * (1/psi - 1) beta <- (1 - prob) * (1/psi - 1) p <- rbeta(n, alpha, beta) y <- rbinom(n, size, p) } else y <- rbinom(n, size, prob) return(y) } family<- binomial() opt <- sm.options(list(...)) verbose <- opt$verbose nboot <- opt$nboot D <- function (mu, y, wt) sum(family$dev.resids(y, mu, wt)) n <- length(x) sm <- sm.binomial(x, y, N, h, xlab = deparse(substitute(x)), ylab = paste("Pr{", deparse(substitute(y)), "}", sep = ""), ...) X <- cbind(1, poly(x, degree)) colnames(X) <- seq(len=ncol(X)) glm.model <- glm.fit(X, cbind(y, N - y), family = family) glm.fitted <- fitted(glm.model) glm.resid <- residuals(glm.model) lines(x, glm.fitted, lty = 2, col = 2) p.boot <- 0 sm.orig <- sm.binomial(x, y, N, h, eval.points = x, display = "none") sm.fitted <- sm.orig$estimate disp.orig <- D(sm.fitted, y/N, N)/(n - degree - 1) if (fixed.disp) disp <- 1 else disp <- disp.orig ts.orig <- (D(glm.fitted, y/N, N) - D(sm.fitted, y/N, N))/disp if(verbose>0) { cat("Dispersion parameter = ", disp.orig, "\n") cat("Test statistic = ", ts.orig, "\n") } yboot <- rep(NA, n) if(verbose>1) cat("Running to ",nboot,": ") for (i in 1:nboot) { yboot <- rbetabinom(n, N, glm.fitted, disp) if(verbose>1) cat("Sample:", i, " ") sm.fit <- sm.glm(x, cbind(yboot, N - yboot), family = family, h, eval.points = x, start = log((yboot + 0.5)/(N - yboot + 0.5))) sm.fitted <- sm.fit$estimate ts.boot <- (D(glm.fitted, yboot/N, N) - D(sm.fitted, yboot/N, N))/disp if (ts.boot > ts.orig) p.boot <- p.boot + 1 lines(x, sm.fitted, lty = 2, col = 4) } if(verbose>1) cat("\n") lines(sm$eval.points, sm$estimate) p.boot <- p.boot/(nboot + 1) if(verbose>0) cat("Observed significance = ", p.boot, "\n") invisible(list(call = match.call(), significance = p.boot, test.statistic = ts.orig, dispersion = disp.orig)) } "sm.poisson" <- function (x, y, h, ...) { x.name <- deparse(substitute(x)) y.name <- deparse(substitute(y)) opt <- sm.options(list(...)) verbose <- opt$verbose if (any(is.na(c(x, y)))) { xy <- cbind(x, y) ok <- as.logical(apply(!is.na(xy), 1, prod)) xy <- xy[ok, ] y <- as.vector(xy[, ncol(xy)]) x <- xy[, -ncol(xy), drop = TRUE] if(opt$verbose>0) cat("warning: missing data are removed\n") } y <- as.integer(y) n <- length(y) replace.na(opt, display, "line") replace.na(opt, ngrid, 25) replace.na(opt, ylim, c(0, 1)) replace.na(opt, pch, 1) replace.na(opt, col, 2) replace.na(opt, nbins, round((n > 100) * 8 * log(n))) display <- opt$display if (min(diff(x)) < 0) { y <- y[order(x)] x <- sort(x) } if (!(opt$display %in% "none") & opt$add %in% FALSE) { replace.na(opt, xlab, x.name) replace.na(opt, ylab, y.name) plot(x, y, xlab = opt$xlab, ylab = opt$ylab, col = 1, type = "n") } if (display != "none") points(x, y, pch = opt$pch, col = opt$col) replace.na(opt, eval.points, seq(min(x), max(x), length = opt$ngrid)) rawdata <- list(x = x, y = y, nbins = opt$nbins, nobs = n, ndim = 1) if (opt$nbins > 0) { bins <- binning(x, y, nbins = opt$nbins) x <- bins$x y <- round(bins$sums) nx <- length(y) freq <- bins$x.freq } else freq <- rep(1, n) result <- sm.glm(x, y, family = poisson(), h = h, eval.points = opt$eval.points, start = log(pmax(0.167, y)), offset = log(freq), options=opt) result$call <- match.call() if (display != "none") { lines(result$eval.points, result$estimate, col = opt$col) if (display == "se") { lines(result$eval.points, result$lower, lty = 3, col = opt$col) lines(result$eval.points, result$upper, lty = 3, col = opt$col) } } result$data <- list(x = x, y = y, weights = freq, nbins = opt$nbins) invisible(result) } "sm.poisson.bootstrap" <- function (x, y, h, degree = 1, fixed.disp = FALSE, intercept = TRUE, ...) { rNegBin <- function(n, mean, disp) { if (disp > 1) { p <- 1/disp r <- mean/(disp - 1) theta <- (rgamma(n, r) * (1 - p))/p y <- rpois(n, theta) } else y <- rpois(n, mean) return(y) } family<- poisson() opt <- sm.options(list(...)) verbose <- opt$verbose nboot <- opt$nboot D <- function(mu, y, w, residuals = FALSE) sum(family$dev.resids(y, mu, w)) x.name <- deparse(substitute(x)) y.name <- deparse(substitute(y)) y <- as.integer(y) y <- y[order(x)] x <- sort(x) sm <- sm.poisson(x, y, h, xlab = x.name, ylab = y.name, col = 3, ...) if (intercept) X <- cbind(1, poly(x, degree)) else X <- outer(x, 1:degree, "^") colnames(X) <- seq(len=ncol(X)) glm.model <- glm.fit(X, y, family = family) glm.fitted <- fitted(glm.model) lines(x, glm.fitted, col = 5) p.boot <- 0 sm.orig <- sm.poisson(x, y, h, eval.points = x, display = "none", ...) sm.fitted <- sm.orig$estimate disp.orig <- D(sm.fitted, y, 1)/(length(y) - ncol(X)) if (fixed.disp) disp <- 1 else disp <- disp.orig ts.orig <- (D(glm.fitted, y, 1) - D(sm.fitted, y, 1))/disp if(verbose>0){ cat("Dipersion parameter = ", disp.orig, "\n") cat("Test statistic = ", ts.orig, "\n") } if(verbose>1) cat("Running to ",nboot,": ") for (i in 1:nboot) { if(verbose>1) cat(i, " ") yboot <- rNegBin(length(glm.fitted), glm.fitted, disp) sm <- sm.poisson(x, yboot, h, eval.points = x, display = "none") sm.fitted <- sm$estimate ts.boot <- (D(glm.fitted, yboot, 1) - D(sm.fitted, yboot, 1))/disp if (ts.boot > ts.orig) p.boot <- p.boot + 1 lines(x, sm.fitted, lty = 2, col = 6) } if(verbose>1) cat("\n") lines(sm$eval.points, sm$estimate, col = 3) lines(x, glm.fitted, col = 5) p.boot <- p.boot/(nboot + 1) if(verbose>0) cat("Observed significance = ", p.boot, "\n") invisible(list(call = match.call(), test.statistic = ts.orig, significance = p.boot, disp = disp.orig)) } "sm.glm" <- function (x, y, family, h, eval.points, start, offset, options=list()) { opt <- sm.options(options) n <- length(x) verbose<- as.integer(opt$verbose) X <- cbind(rep(1, n + 1), c(x, 0)) ## in R, avoid zero weight if (isMatrix(y)) Y <- rbind(y, rep(1, ncol(y))) else Y <- c(y, 0) start <- c(start, 0) neval <- length(eval.points) if (missing(offset)) offset <- rep(0, n) W <- matrix(rep(eval.points, rep(n, neval)), ncol = n, byrow = TRUE) W <- W - matrix(rep(X[1:n, 2], neval), ncol = n, byrow = TRUE) W <- exp(-0.5 * (W/h)^2) if(verbose>1) cat("Cycles per point: ") est <- LP <- st.err <- dev <- var.eta <- rep(NA, neval) for (k in 1:neval) { X[n + 1, 2] <- eval.points[k] colnames(X) <- 1:2 ## weight 0 does not work in R fit <- glm.fit(X, Y, weights = c(W[k, ], 1e-8), family = family, etastart = start, offset = c(offset, 0)) start <- fit$linear.predictors LP[k] <- start[n + 1] dev[k] <- fit$deviance if(verbose>1) cat(fit$iter, " ") s <- W[k, ] mu <- fit$fitted.values[1:n] Wk <- diag(s * fit$weights[1:n]) XXinv <- solve(t(X[1:n, ]) %*% Wk %*% X[1:n, ]) Li <- XXinv %*% t(X[1:n, ]) %*% diag(s) var.Bi <- Li %*% diag(fit$weights[1:n]) %*% t(Li) var.eta[k] <- t(X[n + 1, ]) %*% var.Bi %*% as.vector(X[n + 1, ]) } if(verbose>1) cat("\n") st.err <- sqrt(var.eta) est <- family$linkinv(LP) result <- list(call = match.call(), eval.points = eval.points, estimate = est, lower = family$linkinv(LP - 2 * st.err), upper = family$linkinv(LP + 2 * st.err), linear.predictor = LP, se = st.err, deviance = dev) invisible(result) } "sm.autoregression" <- function (x, h = hnorm(x), d = 1, maxlag = d, lags, se = FALSE, ask = TRUE) { sm.autoregression.1d <- function(x, h, x.name, lags, se = FALSE, ask = FALSE) { n <- length(x) if (any(diff(lags)) < 0) stop("lags must be in increasing order") x2.name <- paste(x.name, "(t)", sep = "") xlow <- min(x) - diff(range(x))/20 xhi <- max(x) + diff(range(x))/20 lags <- sort(lags) for (m in lags) { x1 <- x[(m + 1):n] x0 <- x[1:(n - m)] r <- sm.regression.eval.1d(x0, x1, h = h, model = "none", options = list(hmult = 1)) x1.name <- paste(x.name, "(t-", as.character(m), ")", sep = "") plot(x0, x1, xlim = c(xlow, xhi), ylim = c(xlow, xhi), xlab = x1.name, ylab = x2.name) lines(r$eval.points, r$estimate) if (se) { rho1 <- acf(x0, lag.max = 1, plot = FALSE)$acf[2] lines(r$eval.points, r$estimate + 2 * r$se/sqrt(1 - rho1), lty = 3) lines(r$eval.points, r$estimate - 2 * r$se/sqrt(1 - rho1), lty = 3) } title(paste("Regression of ", x.name, " on past data", sep = "")) if (ask & (m < lags[length(lags)])) pause() } invisible(r) } sm.autoregression.2d <- function(x, h, x.name, lags, ask = ask, ngrid = 20, display = "none") { if (dim(lags)[2] != 2) stop("dim(lags)[2] must be 2") evpt <- seq(quantile(x, 0.1), quantile(x, 0.9), length = ngrid) n <- length(x) nplot <- dim(lags)[1] for (ip in 1:nplot) { m1 <- min(lags[ip, ]) m2 <- max(lags[ip, ]) x0 <- x[1:(n - m2)] x1 <- x[(m2 - m1 + 1):(n - m1)] x2 <- x[(m2 + 1):n] r <- sm.regression.eval.2d(cbind(x0, x1), x2, h = c(h, h), model = "none", eval.points = cbind(evpt, evpt), weights = rep(1, n - m2), options = list(hmult = 1, h.weights = rep(1, n - m2), poly.index = 1)) persp(evpt, evpt, r) head <- paste("Regression of ", x.name, " on past data (lags: ", as.character(m1), ", ", as.character(m2), ")", sep = "") title(head) if (ask & (ip < nplot)) pause() } invisible(r) } x.name <- deparse(substitute(x)) if (missing(lags)) { if (d == 1) lags <- (1:maxlag) else lags <- cbind(1:(maxlag - 1), 2:maxlag) } else if (isMatrix(lags)) d <- 2 x <- as.vector(x) if (d == 1) r <- sm.autoregression.1d(x, h, x.name, lags, se = se, ask = ask) else r <- sm.autoregression.2d(x, h, x.name, lags, ask = ask) invisible(r) } "sm.regression.autocor" <- function (x = 1:n, y, h.first, minh, maxh, method = "direct", ...) { GCV <- function(h, x, y, R, sqrt.R) { W <- sm.weight(x, x, h, options = list(hmult = 1)) r <- (y - W %*% as.matrix(y)) rss <- sum(r^2) Trace <- sum(diag(W)) gcv.0 <- rss/(1 - Trace/length(x))^2 Trace <- sum(diag(W %*% R)) gcv.r <- rss/(1 - Trace/length(x))^2 rw <- backsolve(sqrt.R, r) Trace <- sum(diag(W)) gcv.ri <- sum(rw^2)/(1 - Trace/length(x))^2 c(gcv.0, gcv.r, gcv.ri) } opt <- sm.options(list(...)) verbose <- as.integer(opt$verbose) replace.na(opt, display, "plot") replace.na(opt, ngrid, 15) ngrid <- opt$ngrid n <- length(y) if (length(x) != n) stop("x and y must have equal length\n") if (missing(minh) & missing(x)) minh <- 0.5 if (missing(maxh) & missing(x)) maxh <- 10 w <- sm.weight(x, x, h = h.first, options = list(hmult = 1)) ym <- as.vector(w %*% y) r <- (y - ym) autocov <- rep(0, n) for (k in 0:2) { u <- r[1:(n - k)] * r[(k + 1):n] autocov[k + 1] <- sum(u)/n } var <- autocov[1] rho1 <- autocov[2]/var rho2 <- autocov[3]/var a1 <- rho1 * (1 - rho2)/(1 - rho1^2) a2 <- (rho2 - rho1^2)/(1 - rho1^2) if(verbose>0) cat("AR[1:2] coeff: ", c(a1, a2), "\n") for (k in 3:(n - 1)) autocov[k + 1] <- a1 * autocov[k] + a2 * autocov[k - 1] autocorr <- autocov/var R <- diag(n) R <- outer(1:n, 1:n, function(i, j, r) r[abs(i - j) + 1], r = autocorr) sqrt.R <- chol(R) hvector <- seq(minh, maxh, length = ngrid) min.gcv <- Inf h.opt <- 0 result <- matrix(0, ngrid, 3, dimnames = list(NULL, c("no.cor", "direct", "indirect"))) if(verbose>1) cat(paste("Search for h (runs up to ", as.character(ngrid), "): ", sep = "", collapse = NULL)) for (i in 1:ngrid) { h <- hvector[i] result[i, ] <- GCV(h, x, y, R, sqrt.R) cat(" ") cat(i) } if(verbose>1) cat("\n") if (!(opt$display %in% "none")) { maxlag <- min(30, n - 1) acf <- array(autocorr[1:(maxlag + 1)], dim = c(maxlag + 1, 1, 1)) lag <- array(0:maxlag, dim = c(maxlag + 1, 1, 1)) # acf.plot(list(acf = acf, lag = lag, type = "correlation", # series = "residuals from preliminary smoothing", n.used = n)) plot(lag, acf, sub="residuals from preliminary smoothing", type="h") pause() plot(c(hvector[1], hvector[ngrid]), c(min(result), max(result)), type = "n", xlab = "h", ylab = "Generalised cross-validation") title(paste("GCV criterion, method:", method, collapse = NULL)) lines(hvector, result[, method], col = 2) pause() } h1 <- hvector[order(result[, method])[1]] if(verbose>0) cat("Suggested value of h: ", h1, "\n") sm1 <- sm.regression.eval.1d(x, y, h = h1, model = "none", options = list(hmult = 1)) if (missing(x)) x.name <- "time" else x.name <- deparse(substitute(x)) if (opt$display != "none") { plot(x, y, xlab = x.name, ylab = deparse(substitute(y)), ...) lines(sm1$eval.points, sm1$estimate, col = 2) } sm1$aux <- list(h.first = h.first, first.sm = ym, acf = autocorr, raw.residuals = r) invisible(sm1) } "sm.rm" <- function (Time, y, minh = 0.1, maxh = 2, optimize = FALSE, rice.display = FALSE, ...) { rice <- function(h, nSubj, Time, ym, var, r, poly.index = 1) { nTime <- length(Time) w <- sm.weight(Time, Time, h, options = list(poly.index = poly.index)) fitted <- w %*% ym rss <- sum((ym - fitted)^2) Trace <- sum(diag(w %*% r)) criterion <- sqrt(rss/nTime - (var/nSubj) * (1 - 2 * Trace/nTime)) criterion } if (!isMatrix(y)) stop("y must be a matrix") opt <- sm.options(list(...)) verbose <- as.integer(opt$verbose) replace.na(opt, ngrid, 20) ngrid <- opt$ngrid nSubj <- dim(y)[1] nTime <- dim(y)[2] if (missing(Time)) Time <- 1:nTime ym <- apply(y, 2, mean) z <- y - matrix(ym, nrow = nSubj, ncol = nTime, byrow = TRUE) autocov <- rep(0, nTime) for (k in 0:(nTime - 1)) { u <- z[, 1:(nTime - k)] * z[, (k + 1):nTime] autocov[k + 1] <- sum(u)/(nSubj * nTime) } var <- autocov[1] autocorr <- autocov/var if(verbose>0) { cat("Autocovariances & autocorrelations:\n") print(matrix(cbind(autocov, autocorr), ncol = 2, dimnames = list(0:(nTime - 1), c("auto-cov", "auto-corr")))) } r <- diag(nTime) for (k in 1:nTime) { for (j in 1:nTime) r[k, j] <- autocorr[abs(k - j) + 1] } hvector <- seq(minh, maxh, length = ngrid) min.obj <- Inf h.opt <- 0 if(verbose>0) { cat(" Rice's criterion:\n") cat(" h indept. depend.\n") } result <- matrix(0, ngrid, 2, dimnames = list(NULL, c("indept", "depend"))) for (i in 1:ngrid) { h <- hvector[i] obj.0 <- rice(h, nSubj, Time, ym, var, diag(nTime), opt$poly.index) obj.r <- rice(h, nSubj, Time, ym, var, r, opt$poly.index) result[i, 1] <- obj.0 result[i, 2] <- obj.r if (obj.r < min.obj) { min.obj <- obj.r h.opt <- h } if(verbose>0) print(c(h, obj.0, obj.r)) } if (rice.display) { plot(c(hvector[1], hvector[ngrid]), c(min(result), max(result)), type = "n", xlab = "h", ylab = "sqrt(rice criterion)") title(main = "Modified Rice criterion for selecting h", sub = paste("dashed line: assume independence,", " continuous: allow for correlation", collapse = NULL)) lines(hvector, result[, 1], lty = 3) lines(hvector, result[, 2], lty = 1) pause() } if (optimize) { if(verbose>0) cat("Search for optimum h using optim...\n") optimum <- optim(par = h.opt, fn = rice, method = "L-BFGS", lower = 0, nSubj = nSubj, Time = Time, ym = ym, var = var, r = r) print(optimum$par) h.opt <- optimum$par } if(verbose>0) cat("h: ", h.opt, "\n") if (opt$display %in% "se") display1 <- "line" else display1 <- opt$display sm <- sm.regression(Time, ym, h = h.opt, hmult = 1, display = display1, ylab = paste(deparse(substitute(y)), "(mean values)", collapse = NULL), add = opt$add) if (opt$display %in% "se") { W <- sm.weight(Time, sm$eval.points, h = h.opt, options = list()) V <- (var/nSubj) * r se <- sqrt(diag(W %*% V %*% t(W))) lines(sm$eval.points, sm$estimate + 2 * se, lty = 3) lines(sm$eval.points, sm$estimate - 2 * se, lty = 3) } sm$aux <- list(mean = ym, var = var, autocorr = autocorr, h = h.opt) invisible(sm) } "sm.ts.pdf" <- function (x, h = hnorm(x), lags, maxlag = 1, ask = TRUE) { if (missing(lags)) lags <- (1:maxlag) else maxlag <- max(lags) if (any(diff(lags) < 0)) stop("lags must be in increasing order") x.name <- deparse(substitute(x)) x <- as.vector(x) n <- length(x) marginal <- sm.density(x, ylab = "Marginal density", xlab = x.name) if (ask) pause() for (m in lags) { x1 <- x[(m + 1):n] x0 <- x[1:(n - m)] biv <- sm.density(cbind(x0, x1), h = rep(h, 2), xlab = paste(x.name, "(t-", as.character(m), ")", sep = ""), ylab = paste(x.name, "(t)", sep = "")) biv$lag <- m title(paste("Density of lagged data of ", x.name, " (lag=", as.character(m), ")", sep = "")) if (ask & (m < maxlag)) pause() } invisible(list(marginal = marginal, bivariate = biv)) } sm/R/regression.r0000744000176200001440000012315013272435152013444 0ustar liggesusers "sm.regression" <- function(x, y, h, design.mat = NA, model = "none", weights = NA, group = NA, ... ) { if(!all(is.na(group))) return(sm.ancova(x, y, group, h, model, weights=weights,...)) x.name <- deparse(substitute(x)) if (isMatrix(x)) x.names <- dimnames(x)[[2]] y.name <- deparse(substitute(y)) opt <- sm.options(list(...)) data <- sm.check.data(x = x, y = y, weights = weights, group = group, ...) x <- data$x y <- data$y weights <- data$weights group <- data$group nobs <- data$nobs ndim <- data$ndim opt <- data$options replace.na(opt, nbins, round((nobs > 500) * 8 * log(nobs) / ndim)) rawdata <- list(x = x, y = y, nbins = opt$nbins, nobs = nobs, ndim = ndim) if (!((model %in% "none") | (model %in% "no effect") | (model %in% "no.effect") | (model %in% "linear"))) stop("invalid setting for model argument.", call. = FALSE) if (model != "none") replace.na(opt, test, TRUE) if(missing(h)) h <- h.select(x = x, y = y, weights = weights, ...) else {if(length(h) != ndim) stop("length(h) does not match size of x")} if(opt$nbins > 0) { if (!all(weights == 1) & opt$verbose > 0) cat("Warning: weights overwritten by binning\n") if (!all(is.na(opt$h.weights))) stop("use of h.weights is incompatible with binning - set nbins=0") bins <- binning(x, y, nbins = opt$nbins) x <- bins$x y <- bins$means weights <- bins$x.freq rawdata$devs <- bins$devs nx <- length(y) } else nx <- nobs replace.na(opt, h.weights, rep(1,nx)) if (opt$panel && !requireNamespace("rpanel", quietly = TRUE)) { opt$panel <- FALSE cat("The rpanel package is not available.\n") } if (ndim == 1) { replace.na(opt, xlab, x.name) replace.na(opt, ylab, y.name) replace.na(opt, ngrid, 50) opt$period <- opt$period[1] if (opt$pch == ".") replace.na(opt, cex, 1) else replace.na(opt, cex, 2/log(rawdata$nobs)) if (!opt$panel) est <- sm.regression.1d(x, y, h, design.mat, model, weights, rawdata, options = opt) else { rp.smooth1(x, y, h, design.mat, model, weights, rawdata, opt) } } else { replace.na(opt, ngrid, 20) dimn <- x.names # dimnames(x)[[2]] name.comp<-if(!is.null(dimn) & !all(dimn=="")) dimn else {if(!is.null(attributes(x)$names)) attributes(x)$names else outer(x.name,c("[1]","[2]"),paste,sep="")} replace.na(opt, xlab, name.comp[1]) replace.na(opt, ylab, name.comp[2]) replace.na(opt, zlab, y.name) if (all(is.na(opt$period))) opt$period <- rep(NA, 2) if (!(length(opt$period) == 2)) stop("the length of period should match the number of covariates.") if (opt$panel) rp.smooth2(x, y, h, model, weights, rawdata, opt) else est <- sm.regression.2d(x, y, h, model, weights, rawdata, options = opt) } if (opt$panel) invisible() else { est$data <- list(x = x, y = y, opt$nbins, freq = weights) est$call <- match.call() invisible(est) } } "sm.regression.1d" <- function (x, y, h, design.mat = NA, model = "none", weights = rep(1, length(x)), rawdata, options = list()) { opt <- sm.options(options) replace.na(opt, ngrid, 50) replace.na(opt, xlim, range(rawdata$x)) replace.na(opt, ylim, range(rawdata$y)) replace.na(opt, display, "line") replace.na(opt, col, "black") replace.na(opt, col.band, "cyan") replace.na(opt, col.points, "black") replace.na(opt, se, FALSE) hmult <- opt$hmult if (model == "none") { opt$band <- FALSE opt$test <- FALSE } else replace.na(opt, band, TRUE) band <- opt$band if (opt$add | opt$display %in% "none") opt$panel <- FALSE r <- list(x = NA, y = NA, model.y = NA, se = NA, sigma = NA, h = h * hmult, hweights = opt$h.weights, weights = weights) if (!opt$add & !(opt$display %in% "none")) plot(rawdata$x, rawdata$y, xlab = opt$xlab, ylab = opt$ylab, xlim = opt$xlim, ylim = opt$ylim, type = "n") if (!(opt$display %in% "none")) { opt1 <- opt opt1$test <- FALSE r <- smplot.regression(x, y, design.mat, h, r, model, weights, rawdata, options = opt1) } if (opt$test) rtest <- sm.regression.test(x, y, design.mat, h, model, weights, rawdata, options = opt) if (!(any(is.na(opt$eval.points)))) r <- sm.regression.eval.1d(x, y, design.mat, h, model, weights, rawdata, options = opt) else if ((opt$display %in% "none") & (model == "none")) { opt$eval.points <- seq(min(x), max(x), length = opt$ngrid) r <- sm.regression.eval.1d(x, y, design.mat, h, model, weights, rawdata, options = opt) } if (opt$test) r <- list(eval.points = r$eval.points, estimate = r$estimate, model.y = r$model.y, se = r$se, sigma = r$sigma, h = r$h, hweights = r$hweights, weights = weights, model = rtest$model, p = rtest$p, q.squared=rtest$q.squared) r } "smplot.regression" <- function (x, y, design.mat, h, r, model, weights, rawdata = list(), options = list(), ...) { opt <- sm.options(options) rnew <- sm.regression.eval.1d(x, y, design.mat, h, model, weights = weights, rawdata = rawdata, options = opt) if (!any(is.na(r$x))) { if (opt$band) { upper <- r$model.y + 2 * r$se upper <- pmin(pmax(upper, par()$usr[3]), par()$usr[4]) lower <- r$model.y - 2 * r$se lower <- pmin(pmax(lower, par()$usr[3]), par()$usr[4]) polygon(c(r$eval.points, rev(r$eval.points)), c(lower, rev(upper)), col = 0, border = 0) } if (opt$se | (opt$display %in% "se")) { upper <- r$estimate + 2 * r$se upper <- pmin(pmax(upper, par()$usr[3]), par()$usr[4]) lower <- r$estimate - 2 * r$se lower <- pmin(pmax(lower, par()$usr[3]), par()$usr[4]) lines(r$eval.points, upper, lty = 3, col = 0) lines(r$eval.points, lower, lty = 3, col = 0) } lines(r$eval.points, r$estimate, col = 0) } if (opt$band) { upper <- rnew$model.y + 2 * rnew$se upper <- pmin(pmax(upper, par()$usr[3]), par()$usr[4]) lower <- rnew$model.y - 2 * rnew$se lower <- pmin(pmax(lower, par()$usr[3]), par()$usr[4]) polygon(c(rnew$eval.points, rev(rnew$eval.points)), c(lower, rev(upper)), col = opt$col.band, border = 0) } lines(rnew$eval.points, rnew$estimate, lty = opt$lty, col = opt$col, lwd = opt$lwd) if ((model == "none") & (opt$se | (opt$display %in% "se"))) { upper <- rnew$estimate + 2 * rnew$se upper <- pmin(pmax(upper, par()$usr[3]), par()$usr[4]) lower <- rnew$estimate - 2 * rnew$se lower <- pmin(pmax(lower, par()$usr[3]), par()$usr[4]) lines(rnew$eval.points, upper, lty = 3, col = opt$col) lines(rnew$eval.points, lower, lty = 3, col = opt$col) } if (!opt$add) points(rawdata$x, rawdata$y, col = opt$col.points, pch = opt$pch, cex = opt$cex) box(col = 1, lty = 1) rnew } "sm.regression.2d" <- function (x, y, h, model = "none", weights = rep(1, length(y)), rawdata, options = list()) { opt <- sm.options(options) # Identify the setting of opt$col and other things follow. if (!(model %in% "none")) { if (is.na(opt$col)) { if (!is.na(opt$se)) { if (opt$se) opt$col <- "se" } else if (!is.na(opt$band)) { if (opt$band) opt$col <- "se" } else opt$col <- "se" } } else { if (is.na(opt$col)) { if (!is.na(opt$se)) { if (opt$se) opt$col <- "se" } } } if (is.na(opt$col)) opt$col <- "green" if (opt$col == "se") opt$se <- TRUE surf.ids <- rep(NA, 2) if (!is.na(opt$band) && opt$band) opt$col <- "se" if (!is.na(opt$col) && opt$col == "se" && is.na(opt$se)) opt$se <- TRUE replace.na(opt, h.weights, rep(1, length(y))) replace.na(opt, display, "persp") replace.na(opt, band, FALSE) replace.na(opt, col, "green") replace.na(opt, se, FALSE) replace.na(opt, ngrid, 20) if (any(is.na(opt$eval.points))) { replace.na(opt, xlim, range(x[, 1])) if (opt$display %in% "rgl") { replace.na(opt, zlim, range(x[, 2])) replace.na(opt, eval.points, cbind(seq(opt$xlim[1], opt$xlim[2], length = opt$ngrid), seq(opt$zlim[1], opt$zlim[2], length = opt$ngrid))) } else { replace.na(opt, ylim, range(x[, 2])) replace.na(opt, eval.points, cbind(seq(opt$xlim[1], opt$xlim[2], length = opt$ngrid), seq(opt$ylim[1], opt$ylim[2], length = opt$ngrid))) } } else { replace.na(opt, xlim, range(opt$eval.points[, 1])) if (opt$display %in% "rgl") replace.na(opt, zlim, range(opt$eval.points[, 2])) else replace.na(opt, ylim, range(opt$eval.points[, 2])) if (opt$eval.grid & (any(diff(opt$eval.points[,1]) < 0) | any(diff(opt$eval.points[,2]) < 0))) stop(paste("eval.points are not suitable for grid evaluation", "(eval.grid = TRUE).")) } # sigma <- sm.sigma(rawdata$x, rawdata$y, nbins = opt$nbins)$estimate sigma <- sm.sigma(x, y, rawdata, weights = weights, nbins = 0)$estimate if (!opt$eval.grid) { w <- sm.weight2(x, opt$eval.points, h, weights = weights, options = opt) est <- as.vector(w %*% y) model.y <- est if (opt$se) se <- diag(w %*% t(w)) * sigma } else { est <- sm.regression.eval.2d(x, y, h, model, opt$eval.points, opt$hull, weights, options = opt) x1grid <- opt$eval.points[,1] x2grid <- opt$eval.points[,2] ngrid <- length(x1grid) evpts <- cbind(rep(x1grid, ngrid), rep(x2grid, each = ngrid)) model.y <- est est.col <- est n <- length(y) if (opt$se) { S <- sm.weight2(x, evpts, h = h, weights = weights, options = opt) mask <- est / est if (model == "none") { se <- matrix(diag(S %*% t(S)) * sigma, ncol = ngrid) * mask } else if (model == "no effect") { X <- matrix(rep(1, n), ncol = 1) Z <- matrix(rep(1, ngrid^2), ncol = 1) } else if (model == "linear") { X <- cbind(rep(1, n), x[,1] - mean(x[,1]), x[,2] - mean(x[,2])) Z <- cbind(rep(1, ngrid * ngrid), evpts[,1] - mean(x[,1]), evpts[,2] - mean(x[,2])) } if (model %in% c("no effect", "linear")) { X <- Z %*% solve(t(X) %*% diag(weights) %*% X) %*% t(X) %*% diag(weights) model.y <- matrix(as.vector(X %*% y), ncol = ngrid) S <- S - X } if (model == "isotropic") { # est <- S %*% dd # S <- sm.weight2(cbind(hh, ang), cbind(hh, ang), sp, weights = wts) X <- sm.weight(x[, 1], evpts[, 1], h[1], weights = weights) S <- S - X se <- matrix(sqrt(diag(S %*% opt$covmat %*% t(S))), ncol = ngrid) * mask model.y <- matrix(as.vector(X %*% y), ncol = ngrid) * mask } else { se <- matrix(sqrt(diag(S %*% t(S))), ncol = ngrid) * sigma * mask } sdiff <- (est - model.y) / se if (opt$display %in% "persp") { se <- array(c(se[-ngrid, -ngrid], se[ -1, -ngrid], se[-ngrid, -1], se[ -1, -1]), dim = c(ngrid - 1, ngrid - 1, 4)) se <- apply(se, 1:2, function(x) if (length(which(is.na(x))) > 1) NA else mean(x, na.rm = TRUE)) se <- matrix(c(se), nrow = ngrid - 1, ncol = ngrid - 1) sdiff <- array(c(sdiff[-ngrid, -ngrid], sdiff[ -1, -ngrid], sdiff[-ngrid, -1], sdiff[ -1, -1]), dim = c(ngrid - 1, ngrid - 1, 4)) sdiff <- apply(sdiff, 1:2, function(x) if (length(which(is.na(x))) > 1) NA else mean(x, na.rm = TRUE)) sdiff <- matrix(c(sdiff), nrow = ngrid - 1, ncol = ngrid - 1) } } else se <- NA if (opt$col == "height") { if (opt$display %in% "persp") { est.col <- array(c(est.col[-ngrid, -ngrid], est.col[ -1, -ngrid], est.col[-ngrid, -1], est.col[ -1, -1]), dim = c(ngrid - 1, ngrid - 1, 4)) est.col <- apply(est.col, 1:2, function(x) if (length(which(is.na(x))) > 1) NA else mean(x, na.rm = TRUE)) } opt$col <- opt$col.palette[cut(c(est.col), length(opt$col.palette), labels = FALSE)] } else if (opt$col == "se") { if (model == "none") { opt$col <- opt$col.palette[cut(c(se), length(opt$col.palette), labels = FALSE)] } else { if (length(opt$col.palette) != length(opt$se.breaks) + 1) opt$col.palette <- rev(rainbow(length(opt$se.breaks) + 1, start = 0/6, end = 4/6)) opt$se.breaks <- c(min(sdiff, na.rm = TRUE) - 1, sort(opt$se.breaks), max(sdiff, na.rm = TRUE) + 1) opt$col <- opt$col.palette[cut(c(sdiff), opt$se.breaks, labels = FALSE)] } } if (length(opt$col) > 1) { if (opt$display %in% "rgl") opt$col <- matrix(opt$col, ncol = ngrid) else if (opt$display %in% "rgl") opt$col <- matrix(opt$col, ncol = ngrid - 1) } if (opt$display %in% "rgl") { if (opt$col.mesh == "height") opt$col.mesh <- opt$col.palette[cut(c(est), length(opt$col.palette), labels = FALSE)] else if ((opt$col.mesh == "se") & (model == "none")) opt$col.mesh <- opt$col.palette[cut(c(se), length(opt$col.palette), labels = FALSE)] if (length(opt$col.mesh) > 1) opt$col.mesh <- matrix(opt$col.mesh, ncol = ngrid) } if (opt$display %in% "image") { replace.na(opt, zlim, range(est, na.rm = TRUE)) image(x1grid, x2grid, est, col = opt$col.palette, xlab = opt$xlab, ylab = opt$ylab, xlim = opt$xlim, ylim = opt$ylim, zlim = opt$zlim, add = opt$add) } else if (opt$display %in% "slice") contour(x1grid, x2grid, est, xlab = opt$xlab, ylab = opt$ylab, xlim = opt$xlim, ylim = opt$ylim, lty = opt$lty, col = opt$col, add = opt$add) else if (opt$display %in% "persp") { replace.na(opt, zlim, range(est, na.rm = TRUE)) if (length(opt$col) == 1) { if (opt$col == 1) opt$col <- "green" opt$col <- matrix(opt$col, nrow = ngrid, ncol = ngrid) } persp(x1grid, x2grid, est, xlab = opt$xlab, ylab = opt$ylab, zlab = opt$zlab, xlim = opt$xlim, ylim = opt$ylim, zlim = opt$zlim, theta = opt$theta, phi = opt$phi, ticktype = "detailed", col = c(opt$col), d = 4) } else if ((opt$display %in% "rgl") && (requireNamespace("rgl", quietly = TRUE) & requireNamespace("rpanel", quietly = TRUE))) { replace.na(opt, ylim, range(y, est, na.rm = TRUE)) if (!opt$add) opt$scaling <- rpanel::rp.plot3d(rawdata$x[, 1], rawdata$y, rawdata$x[, 2], xlab = opt$xlab, ylab = opt$zlab, zlab = opt$ylab, xlim = opt$xlim, ylim = opt$ylim, zlim = opt$zlim, size = opt$size, col = opt$col.points) surf.ids <- sm.surface3d(cbind(x1grid, x2grid), est, opt$scaling, col = opt$col, col.mesh = opt$col.mesh, alpha = opt$alpha, alpha.mesh = opt$alpha.mesh, lit = opt$lit) } } r <- list(eval.points = opt$eval.points, estimate = est, model.y = model.y, sigma = sigma, h = h * opt$hmult, hweights = opt$h.weights, weights = weights, scaling = opt$scaling, surf.ids = surf.ids) if (opt$se) { r$se <- se r$sdiff <- sdiff } if (model != "none" & opt$test) { rtest <- sm.regression.test(x, y, design.mat = NA, h, model, weights, rawdata, opt) r$model <- rtest$model r$p <- rtest$p r$q.squared <- rtest$q.squared } r } "sm.surface3d" <- function(eval.points, surf, scaling, col = "green", col.mesh = "black", alpha = 0.7, alpha.mesh = 1, lit = TRUE, ...) { # This function adds a surface to the current rgl plot. if (!is.function(scaling)) stop("a scaling must be specified.") if (all(is.na(col))) col <- "green" if ((length(col) == 1) && (col == 1)) col <- "green" ep <- eval.points if (is.matrix(ep) && ncol(ep) == 2) { ep1 <- ep[ , 1] ep2 <- ep[ , 2] } else if (is.list(ep) && length(ep) == 2) { ep1 <- ep[[1]] ep2 <- ep[[2]] } else stop("the form of eval.points in sm.surface3d is invalid.") ngrid1 <- length(ep1) ngrid2 <- length(ep2) col <- matrix(c(col), nrow = ngrid1, ncol = ngrid2) col.mesh <- matrix(c(col.mesh), nrow = ngrid1, ncol = ngrid2) xg1 <- rep(ep1[-ngrid1], ngrid2 - 1) xg2 <- rep(ep1[ -1], ngrid2 - 1) xg3 <- rep(ep1[ -1], ngrid2 - 1) xg4 <- rep(ep1[-ngrid1], ngrid2 - 1) zg1 <- rep(ep2[-ngrid2], each = ngrid1 - 1) zg2 <- rep(ep2[-ngrid2], each = ngrid1 - 1) zg3 <- rep(ep2[ -1], each = ngrid1 - 1) zg4 <- rep(ep2[ -1], each = ngrid1 - 1) yg1 <- c(surf[-ngrid1, -ngrid2]) yg2 <- c(surf[ -1, -ngrid2]) yg3 <- c(surf[ -1, -1]) yg4 <- c(surf[-ngrid1, -1]) col1 <- c(col[-ngrid1, -ngrid2]) col2 <- c(col[ -1, -ngrid2]) col3 <- c(col[ -1, -1]) col4 <- c(col[-ngrid1, -1]) ind1 <- !is.na(yg1 + yg2 + yg3) ind2 <- !is.na(yg1 + yg3 + yg4) xg <- c(c(rbind( xg1, xg2, xg3)[, ind1]), c(rbind( xg1, xg3, xg4)[, ind2])) yg <- c(c(rbind( yg1, yg2, yg3)[, ind1]), c(rbind( yg1, yg3, yg4)[, ind2])) zg <- c(c(rbind( zg1, zg2, zg3)[, ind1]), c(rbind( zg1, zg3, zg4)[, ind2])) colg <- c(c(rbind(col1, col2, col3)[, ind1]), c(rbind(col1, col3, col4)[, ind2])) ind3 <- is.na(yg3) & !is.na(yg1 + yg2 + yg4) xg <- c( xg, c(rbind( xg1, xg2, xg4)[, ind3])) yg <- c( yg, c(rbind( yg1, yg2, yg4)[, ind3])) zg <- c( zg, c(rbind( zg1, zg2, zg4)[, ind3])) colg <- c(colg, c(rbind(col1, col2, col4)[, ind3])) ind4 <- is.na(yg1) & !is.na(yg2 + yg3 + yg4) xg <- c( xg, c(rbind( xg2, xg3, xg4)[, ind4])) yg <- c( yg, c(rbind( yg2, yg3, yg4)[, ind4])) zg <- c( zg, c(rbind( zg2, zg3, zg4)[, ind4])) colg <- c(colg, c(rbind(col2, col3, col4)[, ind4])) a <- scaling(xg, yg, zg) id1 <- rgl::triangles3d(a$x, a$y, a$z, col = colg, alpha = alpha, lit = lit,...) xg1 <- rep(ep1[-ngrid1], ngrid2) xg2 <- rep(ep1[ -1], ngrid2) xg3 <- rep(ep1 , each = ngrid2 - 1) xg4 <- rep(ep1 , each = ngrid2 - 1) zg1 <- rep(ep2 , each = ngrid1 - 1) zg2 <- rep(ep2 , each = ngrid1 - 1) zg3 <- rep(ep2[-ngrid2], ngrid1) zg4 <- rep(ep2[ -1], ngrid1) yg1 <- c(surf[-ngrid1, ]) yg2 <- c(surf[ -1, ]) yg3 <- c(t(surf[ , -ngrid2])) yg4 <- c(t(surf[ , -1])) col1 <- c(col.mesh[-ngrid1, ]) col2 <- c(col.mesh[ -1, ]) col3 <- c(t(col.mesh[ , -ngrid2])) col4 <- c(t(col.mesh[ , -1])) ind1 <- !is.na(yg1 + yg2) ind2 <- !is.na(yg3 + yg4) xg <- c(c(rbind( xg1, xg2)[, ind1]), c(rbind( xg3, xg4)[, ind2])) yg <- c(c(rbind( yg1, yg2)[, ind1]), c(rbind( yg3, yg4)[, ind2])) zg <- c(c(rbind( zg1, zg2)[, ind1]), c(rbind( zg3, zg4)[, ind2])) colg <- c(c(rbind(col1, col2)[, ind1]), c(rbind(col3, col4)[, ind2])) a <- scaling(xg, yg, zg) id2 <- rgl::segments3d(a$x, a$y, a$z, col = colg, alpha = alpha.mesh, lit = lit, ...) invisible(c(id1, id2)) } "sm.regression.eval.1d" <- function (x, y, design.mat, h, model = "none", weights = rep(1, length(x)), rawdata, options = list()) { opt <- sm.options(options) replace.na(opt, band, FALSE) replace.na(opt, test, FALSE) replace.na(opt, ngrid, 50) replace.na(opt, eval.points, seq(min(x), max(x), length = opt$ngrid)) if (missing(rawdata)) rawdata <- list(x = x, y = y, nbins = 0) band <- opt$band test <- opt$test ngrid <- opt$ngrid h.weights <- opt$h.weights eval.points <- opt$eval.points w <- sm.weight(x, eval.points, h, weights = weights, options = opt) est <- as.vector(w %*% y) sig <- sm.sigma(x, y, rawdata = rawdata, weights = weights)$estimate n <- length(x) ne <- length(eval.points) if (model == "none") { model.y <- est se <- as.vector(sig * sqrt(((w^2) %*% (1/weights)))) } else if ((model == "no.effect") | (model == "no effect")) { if (is.na(as.vector(design.mat)[1])) { X <- matrix(rep(1, n), ncol = 1) model.y <- rep(wmean(y, weights), ne) } else { X <- design.mat model.y <- rep(0, ne) } X <- diag(n) - X %*% solve(t(X) %*% diag(weights) %*% X) %*% t(X) %*% diag(weights) se <- sig * sqrt(diag(w %*% X %*% diag(1/weights) %*% t(w))) } else if (model == "linear") { e <- cbind(rep(1, ne), eval.points - mean(x)) l <- cbind(rep(1, n), x - mean(x)) l <- e %*% solve(t(l) %*% diag(weights) %*% l) %*% t(l) %*% diag(weights) model.y <- as.vector(l %*% y) se <- as.vector(sig * sqrt(((w - l)^2) %*% (1/weights))) } list(eval.points = eval.points, estimate = est, model.y = model.y, se = se, sigma = sig, h = h * opt$hmult, hweights = h.weights, weights = weights) } "sm.regression.eval.2d" <- function (x, y, h, model, eval.points, hull = TRUE, weights, options = list()) { opt <- sm.options(options) hmult <- opt$hmult h.weights <- opt$h.weights n <- nrow(x) ngrid <- nrow(eval.points) wd1 <- matrix(rep(eval.points[, 1], n), ncol = n) wd1 <- wd1 - matrix(rep(x[, 1], ngrid), ncol = n, byrow = TRUE) wd2 <- matrix(rep(eval.points[, 2], n), ncol = n) wd2 <- wd2 - matrix(rep(x[, 2], ngrid), ncol = n, byrow = TRUE) wy <- matrix(rep(h.weights, ngrid), ncol = n, byrow = TRUE) if (!is.na(opt$period[1])) w1 <- exp(cos(2 * pi * wd1 / opt$period[1]) / (h[1] * hmult * wy)) else w1 <- exp(-0.5 * (wd1 / (h[1] * hmult * wy))^2) w1 <- w1 * matrix(rep(weights, ngrid), ncol = n, byrow = TRUE) if (!is.na(opt$period[2])) w2 <- exp(cos(2 * pi * wd2 / opt$period[2]) / (h[2] * hmult * wy)) else w2 <- exp(-0.5 * (wd2 / (h[2] * hmult * wy))^2) wy <- matrix(rep(y, ngrid), ncol = n, byrow = TRUE) if ((opt$poly.index == 0) | (sum(is.na(opt$period)) == 0)) est <- w1 %*% t(w2 * wy)/(w1 %*% t(w2)) else if ((opt$poly.index == 1) & (length(opt$period) == 2) & (sum(is.na(opt$period)) == 1)) { x1grid <- opt$eval.points[,1] x2grid <- opt$eval.points[,2] ngrid <- length(x1grid) evpts <- cbind(rep(x1grid, ngrid), rep(x2grid, each = ngrid)) w <- sm.weight2(x, evpts, h, weights = weights, options = opt) est <- matrix(c(w %*% y), ncol = ngrid) } else { a11 <- w1 %*% t(w2) a12 <- (w1 * wd1) %*% t(w2) a13 <- w1 %*% t(w2 * wd2) a22 <- (w1 * wd1^2) %*% t(w2) a23 <- (w1 * wd1) %*% t(w2 * wd2) a33 <- w1 %*% t(w2 * wd2^2) d <- a22 * a33 - a23^2 b1 <- 1/(a11 - ((a12 * a33 - a13 * a23) * a12 + (a13 * a22 - a12 * a23) * a13)/d) b2 <- (a13 * a23 - a12 * a33) * b1/d b3 <- (a12 * a23 - a13 * a22) * b1/d c1 <- w1 %*% t(w2 * wy) c2 <- (w1 * wd1) %*% t(w2 * wy) c3 <- w1 %*% t(w2 * wy * wd2) est <- b1 * c1 + b2 * c2 + b3 * c3 } if (hull) { hull.points <- x[order(x[, 1], x[, 2]), ] dh <- diff(hull.points) hull.points <- hull.points[c(TRUE, !((dh[, 1] == 0) & (dh[, 2] == 0))), ] hull.points <- hull.points[chull(hull.points), ] nh <- nrow(hull.points) gstep <- matrix(rep(eval.points[2, ] - eval.points[1, ], nh), ncol = 2, byrow = TRUE) hp.start <- matrix(rep(eval.points[1, ], nh), ncol = 2, byrow = TRUE) hull.points <- hp.start + gstep * round((hull.points - hp.start)/gstep) hull.points <- hull.points[chull(hull.points), ] grid.points <- cbind(rep(eval.points[, 1], ngrid), rep(eval.points[, 2], rep(ngrid, ngrid))) D <- diff(rbind(hull.points, hull.points[1, ])) temp <- D[, 1] D[, 1] <- D[, 2] D[, 2] <- (-temp) C <- as.vector((hull.points * D) %*% rep(1, 2)) C <- matrix(rep(C, ngrid^2), nrow = ngrid^2, byrow = TRUE) D <- t(D) wy <- ((grid.points %*% D) >= C) wy <- apply(wy, 1, all) wy[wy] <- 1 wy[!wy] <- NA wy <- matrix(wy, ncol = ngrid) } else { w1 <- (w1 > exp(-2)) w2 <- (w2 > exp(-2)) wy <- w1 %*% t(w2) wy[wy > 0] <- 1 wy[wy == 0] <- NA } est <- est * wy invisible(est) } "sm.regression.test" <- function (x, y, design.mat = NA, h, model = "no.effect", weights = rep(1, length(y)), rawdata, options = list()) { opt <- sm.options(options) if (length(dim(x)) > 0) { ndim <- 2 n <- dim(x)[1] W <- sm.weight2(x, x, h, weights = weights, options = opt) S <- cbind(rep(1, n), x[, 1] - mean(x[, 1]), x[, 2] - mean(x[, 2])) } else { ndim <- 1 n <- length(x) W <- sm.weight(x, x, h, weights = weights, options = opt) S <- cbind(rep(1, n), x - mean(x)) } if ((model == "no.effect") | (model == "no effect")) { if (is.na(as.vector(design.mat)[1])) S <- matrix(rep(1, n), ncol = 1) else S <- design.mat } if ((model == "linear") | (model == "no.effect") | (model == "no effect")) { S <- diag(n) - S %*% solve(t(S) %*% diag(weights) %*% S) %*% t(S) %*% diag(weights) W <- diag(n) - W W <- t(W) %*% diag(weights) %*% W e <- as.vector(S %*% y) r0 <- sum(weights * e^2) + sum(rawdata$devs) r1 <- as.numeric(t(e) %*% W %*% e) + sum(rawdata$devs) ts <- (r0 - r1)/r1 p <- p.quad.moment(diag(weights) - (1 + ts) * W, S %*% diag(1/weights), ts, sum(weights) - length(weights)) q.squared <- (r0-r1)/(r0 + sum(rawdata$devs)) } if(opt$verbose > 0) cat(paste("Test of", model,"model: significance = ",round(p,3),"\n")) list(model = model, p = p, h = h * opt$hmult, hweights = opt$h.weights, q.squared=q.squared) } "p.quad.moment" <- function (A, Sigma, tobs, ndevs) { B <- A %*% Sigma k1 <- sum(diag(B)) - tobs * ndevs C <- B %*% B k2 <- 2 * sum(diag(C)) + 2 * tobs^2 * ndevs k3 <- 8 * sum(diag(C %*% B)) - 8 * tobs^3 * ndevs aa <- abs(k3/(4 * k2)) bb <- (8 * k2^3)/k3^2 cc <- k1 - aa * bb 1 - pchisq(-cc/aa, bb) } "p.quad.moment.old" <- function(A, Sigma, cnst) { B <- A %*% Sigma k1 <- sum(diag(B)) C <- B %*% B k2 <- 2 * sum(diag(C)) k3 <- 8 * sum(diag(C %*% B)) aa <- abs(k3/(4 * k2)) bb <- (8 * k2^3)/k3^2 cc <- k1 - aa * bb # print(paste("Degrees of freedom = ",bb)) # print(paste("Chisq = ",((cnst-cc)/aa-bb)/sqrt(2*bb))) 1 - pchisq((cnst - cc)/aa, bb) } "sm.sigma" <- function (x, y, rawdata = NA, weights = rep(1, length(y)), diff.ord = 2, ci = FALSE, model = "none", h = NA, ...) { opt <- sm.options(list(...)) if (!is.list(rawdata)) rawdata <- list(devs = 0) data <- sm.check.data(x = x, y = y, weights = weights) x <- data$x y <- data$y weights <- data$weights n <- data$nobs ndim <- data$ndim replace.na(opt, nbins, round((n > 500) * 8 * log(n) / ndim)) if(opt$nbins > 0) { if (!all(weights == 1) & opt$verbose > 0) cat("Warning: weights overwritten by binning\n") if (!all(is.na(opt$h.weights))) stop("use of h.weights is incompatible with binning - set nbins=0") bins <- binning(x, y, nbins = opt$nbins) x <- bins$x y <- bins$means weights <- bins$x.freq rawdata$devs <- bins$devs n <- length(y) } if (ndim == 2) return(sm.sigma2(x, y, rawdata = rawdata, weights = weights, ci = ci, model = model, h = h, options = opt)) if (diff.ord == 1) { yd <- diff(y[order(x)]) ww <- 1/weights[order(x)] wd <- ww[2:n] + ww[1:(n - 1)] ssq <- sum(yd^2/wd) + sum(rawdata$devs) sig <- sqrt(ssq / (sum(weights) - 1)) } else { yy <- y[order(x)] xx <- sort(x) xx1 <- diff(xx) xx2 <- diff(xx, lag = 2) a <- xx1[-1]/xx2 b <- xx1[-(n - 1)]/xx2 a[xx2 == 0] <- 0.5 b[xx2 == 0] <- 0.5 ww <- weights[order(x)] cc <- a^2/ww[1:(n - 2)] + b^2/ww[3:n] + 1/ww[2:(n - 1)] eps <- yy[1:(n - 2)] * a + yy[3:n] * b - yy[2:(n - 1)] ssq <- sum(eps^2/cc) + sum(rawdata$devs) sig <- sqrt(ssq / (sum(ww) - 2)) } invisible(list(estimate = sig)) } "sm.sigma2" <- function(x, y, rawdata = list(devs = 0), weights = rep(1, length(y)), stand = "local", cross = FALSE, ci = FALSE, simple = FALSE, model = "none", h = NA, strip = FALSE, display = "none", options = list()) { opt <- sm.options(options) n <- length(y) x1 <- x[, 1] x2 <- x[, 2] if (any(is.na(x1 + x2 + y))) stop("Missing data not allowed in sm.sigma2") if (strip) { ch <- chull(x1, x2) x1 <- x1[-ch] x2 <- x2[-ch] y <- y[-ch] } X <- cbind(x1, x2) # Repeated values can cause difficulties with zero nearest neighbour # distances, so use the unique values. if (all(weights == rep(1, length(y))) & (nrow(unique(X)) < nrow(X))) { X <- paste(as.character(X[,1]), as.character(X[,2]), sep = ",") weights <- table(X) rawdata$devs <- tapply(y, factor(X), function(x) sum((x - mean(x))^2)) y <- tapply(y, factor(X), mean) X <- sort(unique(X)) X <- paste(X, collapse = ",") X <- paste("c(", X, ")", sep = "") X <- eval(parse(text = X)) X <- matrix(X, ncol = 2, byrow = TRUE) } # if (simple) { # S <- sm.weight2.nn(cbind(x1, x2), cross = cross) # } # else { nx <- nrow(X) d <- matrix(rep(X[,1], nx), ncol = nx) D <- (d - t(d))^2 d <- matrix(rep(X[,2], nx), ncol = nx) D <- sqrt(D / var(X[,1]) + ((d - t(d))^2) / var(X[,2])) nn <- function(x) {sort(x)[5]} hw <- apply(D, 1, nn) / 2 hh <- c(sqrt(var(X[,1])), sqrt(var(X[,2]))) S <- sm.weight2(X, X, hh, cross = cross, weights = weights, options = list(h.weights = hw, hw.eval = TRUE)) # } A <- (diag(nx) - S) if (stand=="local") { A <- t(A) %*% diag(1/diag(A %*% t(A))) %*% A adf <- n } else { A <- t(A) %*% A adf <- sum(diag(A)) } sigmahat <- as.numeric(((t(y) %*% A %*% y) + sum(rawdata$devs)) / sum(weights)) if (sigmahat <= 0) { if (opt$verbose > 0) warning(" estimated standard deviation is 0") sigmahat <- 0 } sigmahat <- sqrt(sigmahat) # sigmahat <- as.numeric(sqrt((t(y) %*% A %*% y) / adf)) result <- list(estimate = sigmahat, qmat = A / adf) if (model == "constant") { if (any(is.na(h))) stop("Smoothing parameter missing") P <- sqrt(diag(1/diag(A %*% t(A)))) %*% A pseudo.res <- P %*% y svcomp <- sqrt(abs(pseudo.res)) S <- sm.weight2(X, X, h, options = list()) S <- diag(n) - S S <- t(S) %*% S L <- matrix(1/n, ncol = n, nrow=n) r0 <- as.numeric(t(svcomp) %*% (diag(n) - L) %*% svcomp) r1 <- as.numeric(t(svcomp) %*% S %*% svcomp) ts <- (r0 - r1)/r1 P <- (P %*% t(P))^2 diag(P) <- 0 P <- 5.545063 * ((1-P) * hyperg(P) - 1) diag(P) <- 1 p <- p.quad.moment(diag(n) - L - (1 + ts) * S, P, ts, 0) # cat(paste("Test of constant variance: significance = ", round(p, 3), # "\n")) if (!(display == "none")) { surface <- sm.regression(X, svcomp, h, display = "none") contour(surface$eval.points[,1], surface$eval.points[,2], surface$estimate) } result$pseudo.residuals <- pseudo.res result$p <- p } # Confidence interval ie <- NA if (ci) { B <- A / adf k1 <- sum(diag(B)) C <- B %*% B k2 <- 2 * sum(diag(C)) k3 <- 8 * sum(diag(C %*% B)) aa <- abs(k3 / (4 * k2)) bb <- (8 * k2^3) / k3^2 cc <- k1 - aa * bb q <- qchisq(c(0.025, 0.975), bb) ie <- rev(sigmahat/sqrt(cc + q * aa)) result$ci <- ie } invisible(result) } "hyperg" <- function(z) { a <- 0.75 b <- 0.75 cc <- 0.5 hg <- gamma(a) * gamma(b) / gamma(cc) hgold <- 0.5 n <- 0 lfac <- 0 while (max((hg - hgold)/hgold) > 0.001) { n <- n + 1 lfac <- lfac + log(n) hgold <- hg hg <- hg + exp(n * log(z) - lfac + lgamma(a + n) + lgamma(b + n) - lgamma(cc + n)) } hg <- hg * gamma(cc) / (gamma(a) * gamma(b)) hg } "sm.sigma2.compare" <- function(x1, y1, x2, y2) { data <- sm.check.data(x1, y1) x1 <- data$x y1 <- data$y n1 <- data$nobs ndim1 <- data$ndim data <- sm.check.data(x2, y2) x2 <- data$x y2 <- data$y n2 <- data$nobs ndim2 <- data$ndim if (!(ndim1 == 2 & ndim2 == 2)) stop("x1 and x2 should be two-column matrices.") sig <- sm.sigma2(x1, y1, options = list(nbins = 0)) est1 <- sig$estimate A1 <- sig$qmat sig <- sm.sigma2(x2, y2, options = list(nbins = 0)) est2 <- sig$estimate A2 <- sig$qmat Fobs <- est1^2 / est2^2 Fobs <- max(Fobs, 1/Fobs) Al <- rbind(A1, matrix(0, nrow=n2, ncol=n1)) Ar <- rbind(matrix(0, nrow=n1, ncol=n2), -Fobs * A2) A <- cbind(Al, Ar) p <- 2 * p.quad.moment(A, diag(n1 + n2), 0, 0) # cat(paste("Test of equality of variances: p =", round(p, 3), "\n")) invisible(p) } "sm.weight" <- function (x, eval.points, h, cross = FALSE, weights = rep(1, length(x)), options = list()) { if (!exists(".sm.Options")) stop("cannot find .sm.Options") opt <- sm.options(options) replace.na(opt, hmult, 1) replace.na(opt, h.weights, rep(1, length(x))) replace.na(opt, poly.index, 1) poly.index <- opt$poly.index h.weights <- opt$h.weights hmult <- opt$hmult period <- opt$period[1] n <- length(x) ne <- length(eval.points) wd <- matrix(rep(eval.points, rep(n, ne)), ncol = n, byrow = TRUE) wd <- wd - matrix(rep(x, ne), ncol = n, byrow = TRUE) w <- matrix(rep(h.weights, ne), ncol = n, byrow = TRUE) if (!is.na(opt$period)) w <- exp(cos(2 * pi * wd / period) / (h * hmult * w)) else w <- exp(-0.5 * (wd / (h * hmult * w))^2) w <- w * matrix(rep(weights, ne), ncol = n, byrow = TRUE) if (cross) diag(w) <- 0 if ((poly.index == 0) | (!is.na(period))) { den <- w %*% rep(1, n) w <- w / matrix(rep(den, n), ncol = n) } else { s0 <- w %*% rep(1, n) s1 <- (w * wd) %*% rep(1, n) s2 <- (w * wd^2) %*% rep(1, n) w <- w * (matrix(rep(s2, n), ncol = n) - wd * matrix(rep(s1, n), ncol = n)) w <- w / (matrix(rep(s2, n), ncol = n) * matrix(rep(s0, n), ncol = n) - matrix(rep(s1, n), ncol = n)^2) } } "sm.weight2" <- function (x, eval.points, h, cross = FALSE, weights = rep(1, nrow(x)), options = list()) { opt <- sm.options(options) if (all(is.na(opt$period))) opt$period <- rep(NA, 2) replace.na(opt, hmult, 1) replace.na(opt, h.weights, rep(1, nrow(x))) replace.na(opt, poly.index, 1) poly.index <- opt$poly.index h.weights <- opt$h.weights hmult <- opt$hmult n <- nrow(x) ne <- nrow(eval.points) wd1 <- matrix(rep(eval.points[, 1], rep(n, ne)), ncol = n, byrow = TRUE) wd1 <- wd1 - matrix(rep(x[, 1], ne), ncol = n, byrow = TRUE) if (("hw.eval" %in% names(opt)) & (opt$hw.eval = TRUE)) hw <- matrix(rep(h.weights, n), ncol = n) else hw <- matrix(rep(h.weights, ne), ncol = n, byrow = TRUE) if (!is.na(opt$period[1])) w <- exp(cos(2 * pi * wd1 / opt$period[1]) / (h[1] * hmult * hw)) else w <- exp(-0.5 * (wd1 / (h[1] * hmult * hw))^2) wd2 <- matrix(rep(eval.points[, 2], rep(n, ne)), ncol = n, byrow = TRUE) wd2 <- wd2 - matrix(rep(x[, 2], ne), ncol = n, byrow = TRUE) if (!is.na(opt$period[2])) w <- w * exp(cos(2 * pi * wd2 / opt$period[2]) / (h[2] * hmult * hw)) else w <- w * exp(-0.5 * (wd2 / (h[2] * hmult * hw))^2) w <- w * matrix(rep(weights, ne), ncol = n, byrow = TRUE) if (cross) diag(w) <- 0 if ((opt$poly.index == 0) | (sum(is.na(opt$period)) == 0)) { den <- w %*% rep(1, n) w <- w/matrix(rep(den, n), ncol = n) } else if ((opt$poly.index == 1) & (sum(is.na(opt$period)) == 1)) { if (is.na(opt$period[2])) wd1 <- wd2 s0 <- w %*% rep(1, n) s1 <- (w * wd1) %*% rep(1, n) s2 <- (w * wd1^2) %*% rep(1, n) w <- w * (matrix(rep(s2, n), ncol = n) - wd1 * matrix(rep(s1, n), ncol = n)) w <- w / (matrix(rep(s2, n), ncol = n) * matrix(rep(s0, n), ncol = n) - matrix(rep(s1, n), ncol = n)^2) } else { a11 <- w %*% rep(1, n) a12 <- (w * wd1) %*% rep(1, n) a13 <- (w * wd2) %*% rep(1, n) a22 <- (w * wd1^2) %*% rep(1, n) a23 <- (w * wd1 * wd2) %*% rep(1, n) a33 <- (w * wd2^2) %*% rep(1, n) d <- a22 * a33 - a23^2 b1 <- 1/(a11 - ((a12 * a33 - a13 * a23) * a12 + (a13 * a22 - a12 * a23) * a13)/d) b2 <- (a13 * a23 - a12 * a33) * b1/d b3 <- (a12 * a23 - a13 * a22) * b1/d wt <- matrix(rep(b1, n), ncol = n) wt <- wt + matrix(rep(b2, n), ncol = n) * wd1 wt <- wt + matrix(rep(b3, n), ncol = n) * wd2 w <- wt * w } w } "sm.sigweight" <- function(x, weights) { if (is.vector(x)) { n <- length(x) xx <- sort(x) xx1 <- diff(xx) xx2 <- diff(xx, lag = 2) a <- xx1[-1]/xx2 b <- xx1[-(n-1)]/xx2 a[xx2==0] <- 0.5 b[xx2==0] <- 0.5 c <- sqrt(a^2/weights[1:(n-2)] + b^2/weights[3:n] + 1/weights[2:(n-1)]) A <- cbind(rep(0,n-2), diag(-1/c), rep(0,n-2)) + cbind(diag(a/c), rep(0,n-2), rep(0,n-2)) + cbind(rep(0,n-2), rep(0,n-2), diag(b/c)) A <- rbind(rep(0,n), A, rep(0,n)) A <- t(A) %*% A } if (is.matrix(x)) { x1 <- x[,1] x2 <- x[,2] n <- length(x1) X <- cbind(x1, x2) d <- matrix(rep(x1,n),ncol=n) D <- (d-t(d))^2 d <- matrix(rep(x2,n),ncol=n) D <- sqrt(D / var(x1) + ((d-t(d))^2) / var(x2)) nn <- function(x) {sort(x)[5]} hw <- apply(D, 1, nn)/2 h <- c(sqrt(var(x1)), sqrt(var(x2))) S <- sm.weight2(X, X, h, cross=T, weights=weights, options=list(h.weights=hw)) A <- (diag(n)-S) A <- t(A) %*% diag(1/diag(A %*% t(A))) %*% A # A <- A / sum(weights) } A } "sig.trace" <- function (expn, hvec, ...) { opt <- sm.options(list(...)) replace.na(opt, display, "line") expn.char <- paste(deparse(substitute(expn)), collapse = "") lead.char <- substring(expn.char, 1, nchar(expn.char) - 1) nvec <- length(hvec) pvec <- vector("numeric", length = nvec) for (i in 1:nvec) { extn.char <- paste(lead.char, ", h = ", as.character(hvec[i]), ")") result <- eval(parse(text = extn.char)) pvec[i] <- result$p } if (!(opt$display == "none")) { plot(hvec, pvec, type = "l", ylim = c(0, max(pvec)), xlab = "Smoothing parameter, h", ylab = "p-value") if (max(pvec) >= 0.05) lines(range(hvec), c(0.05, 0.05), lty = 2) } invisible(list(h = hvec, p = pvec)) } sm/R/variogram.r0000744000176200001440000011211713272635232013255 0ustar liggesusers"sm.variogram" <- function(x, y, h, df.se = "automatic", max.dist = NA, original.scale = TRUE, varmat = FALSE, ...) { type <- "binned" bin.type <- "log" type.se <- "smooth-monotonic-original" if ("geodata" %in% class(x)) { y <- x$data x <- x$coords } opt <- sm.options(list(...)) data <- sm.check.data(x = x, y = y, ...) x <- data$x y <- data$y n <- data$nobs ndim <- data$ndim opt <- data$options # rawdata <- list(x = x, y = y, nbins = opt$nbins, nobs = n, ndim = ndim) model <- opt$model replace.na(opt, band, (model != "none")) if (model == "isotropic") { replace.na(opt, ngrid, 20) replace.na(opt, display, "image") } if (model == "stationary") { replace.na(opt, ngrid, 12) } else { replace.na(opt, ngrid, 100) replace.na(opt, display, "means") } if (model == "stationary") replace.na(opt, df, 20) else if (model == "isotropic") replace.na(opt, df, 12) else replace.na(opt, df, 6) replace.na(opt, band, (model != "none")) replace.na(opt, test, (model != "none")) if (is.null(opt$weights.penalty)) opt$weights.penalty <- NA replace.na(opt, se, TRUE) replace.na(opt, col, "black") # replace.na(opt, weights.penalty, FALSE) opt$weight.penalty <- FALSE if (model == "isotropic") replace.na(opt, nbins, 10) if (model == "stationary") replace.na(opt, nbins, 6) if (ndim == 1) { x <- matrix(x, ncol = 1) replace.na(opt, nbins, 100) if (opt$nbins == 0) opt$nbins <- 100 } else { replace.na(opt, nbins, ceiling((n * (n - 1) / 2)^(1/3))) if (opt$nbins == 0) opt$nbins <- ceiling((n * (n - 1) / 2)^(1/3)) } x1mat <- matrix(rep(x[, 1], n), ncol = n, byrow = TRUE) if (ndim == 2) { x2mat <- matrix(rep(x[, 2], n), ncol = n) hmat <- sqrt((t(x1mat) - x1mat)^2 + (t(x2mat) - x2mat)^2) } else hmat <- abs(t(x1mat) - x1mat) dmat <- matrix(rep(y, n), ncol = n) dmat <- t(dmat) - dmat dmat0 <- dmat^2 dmat <- sqrt(abs(dmat)) imat <- matrix(rep(1:n, n), ncol = n, byrow = TRUE) ind <- as.vector(t(imat) - imat) hall <- (as.vector(hmat))[ind > 0] dall0 <- (as.vector(dmat0))[ind > 0] dall <- (as.vector(dmat))[ind > 0] i1 <- (as.vector(imat))[ind > 0] i2 <- (as.vector(t(imat)))[ind > 0] ipair <- cbind(i1, i2) # if (!is.na(max.dist)) { # ind <- (hall <= max.dist) # hall <- hall[ind] # dall <- dall[ind] # ipair <- ipair[ind, ] # } results <- list(distance = hall, sqrtdiff = dall, ipair = ipair) #------------------------------------------------------------ # Bin the differences #------------------------------------------------------------ if (!(model %in% c("isotropic", "stationary"))) { if (bin.type == "regular") { bins <- binning(hall, dall, nbins = opt$nbins) hh <- bins$x dd <- bins$means wts <- bins$x.freq breaks <- bins$breaks empse <- sqrt(bins$devs / (wts - 1)) / sqrt(wts) empse[wts == 1] <- 0 igp <- as.vector(cut(hall, breaks, labels = FALSE)) ibin <- match(igp, sort(unique(igp))) } else if (bin.type == "balanced") { test.pts <- sort(unique(signif(results$distance, 7))) test.pts <- test.pts[-length(test.pts)] + diff(test.pts) / 2 test.pts <- c(test.pts, max(results$distance) + 1) breaks <- -1 for (i in 1:length(test.pts)) { ind <- ((results$distance > max(breaks)) & (results$distance <= test.pts[i])) if (sum(ind) >= length(results$distance) / opt$nbins) breaks <- c(breaks, test.pts[i]) } nbrks <- length(breaks) breaks[nbrks] <- max(breaks[nbrks], max(results$distance)) igp <- as.numeric(cut(results$distance, breaks, labels = FALSE)) ibin <- match(igp, sort(unique(igp))) breaks[1] <- 0 dd <- tapply(dall, ibin, mean) # hh <- breaks[-1] - diff(breaks) / 2 hh <- tapply(results$distance, ibin, mean) wts <- table(ibin) } else if (bin.type == "unique") { hh <- sort(unique(signif(hall, 6))) ibin <- match(signif(hall, 6), hh) wts <- table(ibin) dd <- tapply(dall, ibin, mean) } else if (bin.type == "log") { # This doesn't handle 0 distances. They should be added as a separate bin. breaks <- -1 ind <- (hall < 2 * .Machine$double.eps) nzero <- length(which(ind)) if (nzero > 4) breaks <- c(breaks, 2 * .Machine$double.eps) else ind <- rep(FALSE, length(hall)) breaks <- c(breaks, exp(min(log(hall[!ind])) + (1:opt$nbins) * diff(range(log(hall[!ind]))) / opt$nbins)) nbrks <- length(breaks) breaks[nbrks] <- breaks[nbrks] + 1 igp <- as.numeric(cut(results$distance, breaks), labels = FALSE) ibin <- match(igp, sort(unique(igp))) dd0 <- as.vector(tapply(dall0, ibin, mean)) dd <- as.vector(tapply(dall, ibin, mean)) hh <- as.vector(tapply(hall, ibin, mean)) wts <- as.vector(table(ibin)) breaks[nbrks] <- breaks[nbrks] - 1 breaks[1] <- 0 } results$distance.mean <- hh results$sqrtdiff.mean <- dd results$sqdiff.mean <- dd0 results$weights <- wts results$ibin <- ibin results$breaks <- breaks results$nbins <- length(hh) nbins <- length(results$sqrtdiff.mean) if (!is.numeric(df.se)) df.se <- round(0.8 * nbins) #------------------------------------------------------------ # Construct the estimate #------------------------------------------------------------ if (type == "binned") { ev <- hh gamma.hat <- dd } else { if (missing(h)) h <- h.select(hh, dd, weights = wts, nbins = 0, df = df.se, method = opt$method) replace.na(opt, eval.points, seq(min(hall), max(hall), length = opt$ngrid)) ev <- opt$eval.points W <- sm.weight(hh, ev, h, weights = wts, options = opt) gamma.hat <- as.vector(W %*% dd) } #------------------------------------------------------------ # Find the standard errors of the estimated values #------------------------------------------------------------ if (opt$se & (model == "none")) { if (is.na(max.dist)) max.dist <- max(hh) + 1 # if (type.se == "true") # gamma.hat.V <- 1 - cov.spatial(results$distance.mean, cov.pars = cov.pars, kappa = kappa) # # True gamma, evaluated at the observations # # gamma.hat <- 1 - cov.spatial(results$distance, cov.pars = c(1, phi)) if (type.se == "binned") gamma.hat.V <- (dd / 0.977741)^4 if (type.se == "cressie") gamma.hat.V <- 0.5 * dd^4 / (0.457 + 0.494 / wts) if (type.se == "smooth-monotonic-original") { sm.model <- ps.normal(hh, 0.5 * dd0, df = df.se, weights = wts, eval.points = hh, increasing = TRUE, display = "none") gamma.hat.V <- sm.model$estimate # results$gamma.hat.V <- gamma.hat.V } if (type.se == "smooth-original") { sm.model <- ps.normal(hh, 0.5 * dd0, df = df.se, weights = wts, eval.points = hh, increasing = FALSE, display = "none") gamma.hat.V <- sm.model$estimate # results$gamma.hat.V <- gamma.hat.V } if (type.se %in% c("smooth", "smooth-monotonic", "smooth-w", "smooth-monotonic-w")) { # ind <- (hh <= max.dist) # gamma.hat.V <- rep(0, length(hh)) # gamma.hat.V[ind] <- sm.regression(hh, dd, weights = wts, eval.points = hh[ind], # display = "none")$estimate # gamma.hat.V[!ind] <- gamma.hat.V[hh == max(hh[ind])] inc <- (type.se %in% c("smooth-monotonic", "smooth-monotonic-w")) wp <- (type.se %in% c("smooth-w", "smooth-monotonic-w")) sm.model <- ps.normal(hh, dd, df = df.se, weights = wts, eval.points = hh, increasing = inc, kappa = 1e8, weights.penalty = wp, display = "none") gamma.hat.V <- sm.model$estimate # results$gamma.hat.V <- gamma.hat.V gamma.hat.V <- (gamma.hat.V / 0.977741)^4 } if (type.se %in% c("monotonic", "monotonic-original")) { B <- diag(nbins) D1 <- diff(diag(nbins), diff = 1) ddx <- if (type.se == "monotonic") dd else dd0 beta <- ddx delta <- 1 while (delta > 1e-5) { v <- as.numeric(diff(beta) <= 0) B1 <- solve(diag(wts) + 10000 * t(D1) %*% diag(v) %*% D1) beta.old <- beta beta <- as.vector(B1 %*% diag(wts) %*% ddx) delta <- sum((beta - beta.old)^2) / sum(beta.old^2) } gamma.hat.V <- beta # results$gamma.hat.V <- gamma.hat.V if (type.se == "monotonic") gamma.hat.V <- (gamma.hat.V / 0.977741)^4 } # if (type.se == "matern") { # vgm.emp <- variog(coords = x, data = y, estimator.type = "modulus", breaks = breaks, # messages = FALSE) # gamma.hat.V <- variofit(vgm.emp, ini = c(var(y), 0.2), fix.nugget = TRUE, fix.kappa = TRUE, # max.dist = max.dist, messages = FALSE) # results$cov.pars <- gamma.hat.V$cov.pars # results$kappa <- gamma.hat.V$kappa # # plot(vgm.emp) # # lines(gamma.hat) # gamma.hat.V <- gamma.hat.V$cov.pars[1] - # cov.spatial(results$distance.mean, cov.pars = gamma.hat.V$cov.pars, # kappa = gamma.hat.V$kappa) # } # Smoothing - small df and tilted to small distances # h <- h.select(hh, dd, weights = wts, df = 4) # hw <- exp(hh^2) / mean(exp(hh^2)) # gamma.hat <- sm.regression(hh, dd, df = 4, weights = wts, h.weights = hw, # eval.points = hh, display = "none")$estimate # gamma.hat <- (gamma.hat / 0.977741)^4 gamma.hat.V <- pmax(gamma.hat.V, 0) if (type == "binned") { se <- rep(0, nbins) # LAST MODIFICATION # DIAG.COV.BIN.FUN # for (i in 1:nbins) { # # ib <- sort(unique(results$ibin))[i] # se[i] <- sqrt(cov.bin.fun(i, i, results, gamma.hat.V)) # } result <- as.vector(matrix(1.0, nrow=length(gamma.hat.V), ncol = 1)) rho.n <- 50 output <- .Fortran("diag_cov_bin_fun", as.integer(length(gamma.hat.V)), as.integer(nrow(results$ipair)), as.integer(rho.n), as.integer(results$ibin), matrix(as.integer(results$ipair), ncol = 2), as.double(gamma.hat.V), res = as.double(result)) se <- sqrt(output$res) } if (type != "binned" | varmat) { V <- matrix(0, nrow = nbins, ncol = nbins) # LAST MODIFICATION # FULL.COV.BIN.FUN # for (i in 1:nbins) { # # if (opt$verbose > 0) cat(i, "") # for (j in i:nbins){ # # ib <- sort(unique(results$ibin))[i] # # jb <- sort(unique(results$ibin))[j] # V[i, j] <- cov.bin.fun(i, j, results, gamma.hat.V) # if (j > i) V[j, i] <- V[i, j] # } # } # V <- full.cov.bin.fun(results,gamma.hat.V) result <- matrix(1.0, nrow=length(gamma.hat.V), ncol=length(gamma.hat.V)) rho.n <- 50 output <- .Fortran("full_cov_bin_fun", as.integer(length(gamma.hat.V)), as.integer(nrow(results$ipair)), as.integer(rho.n), as.integer(results$ibin), matrix(as.integer(results$ipair), ncol = 2), as.double(gamma.hat.V), res=as.double(result)) V <- matrix(data=output$res, nrow=length(gamma.hat.V), ncol=length(gamma.hat.V), byrow= TRUE) # if (opt$verbose > 0) cat("\n") # save(V, file = "V.dmp") # load("V.dmp") if (type != "binned") se <- sqrt(diag(W %*% V %*% t(W))) } } } #------------------------------------------------------------ # Test of independence #------------------------------------------------------------ if (model == "independent") { vv <- 0.1724 cv <- 0.03144 Sigma <- table(c(igp, igp), c(i1, i2)) Sigma <- Sigma %*% t(Sigma) Sigma <- cv * (Sigma - diag(2 * wts)) Sigma <- Sigma / outer(wts, wts) Sigma <- diag(vv / wts) + Sigma if (opt$test | opt$band) { h <- h.select(hh, hh, weights = wts, df = opt$df) W <- sm.weight(hh, hh, h, weights = wts, options = opt) est <- W %*% dd r0 <- sum(wts * (dd - mean(dall))^2) r1 <- sum(wts * (dd - est)^2) tobs <- (r0 - r1) / r1 nb <- length(hh) A <- matrix(rep(wts / sum(wts), nb), ncol = nb, byrow = TRUE) A <- t(diag(nb) - A) %*% diag(wts) %*% (diag(nb) - A) A <- A - (1 + tobs) * t(diag(nb) - W) %*% diag(wts) %*% (diag(nb) - W) pval <- p.quad.moment(A, Sigma, 0, 0) if (opt$verbose > 0) cat("Test of spatial independence: p = ",round(pval, 3), "\n") results$h <- h results$p <- pval } } #------------------------------------------------------------ # Plots #------------------------------------------------------------ if ((opt$display != "none") & !(model %in% c("isotropic", "stationary"))) { fn <- if (original.scale) function(x) (x / 0.977741)^4 else I if (opt$display %in% c("bins", "means")) { xx <- hh yy <- fn(dd) } else { xx <- hall yy <- if (original.scale) dall^4 else dall } if (!opt$add) { replace.na(opt, xlab, "Distance") replace.na(opt, ylab, if (original.scale) " Squared difference" else "Square-root abs. difference") replace.na(opt, xlim, range(xx)) r <- yy if (model == "independent") { replace.na(opt, eval.points, seq(min(hall), max(hall), length = opt$ngrid)) ev <- opt$eval.points W <- sm.weight(hh, ev, h, weights = wts, options = opt) est <- c(W %*% dd) r <- c(r, fn(est)) if (opt$band | opt$se) { sigmahat <- sqrt(var(y)) nmeans <- length(wts) V <- matrix(rep(wts / sum(wts), length(ev)), ncol = nmeans, byrow = TRUE) se.band <- sigmahat * sqrt(diag((W - V) %*% Sigma %*% t(W - V))) r <- c(r, fn(mean(dall) + 2 * se.band), fn(mean(dall) - 2 * se.band)) } } if (model == "none" & opt$se) r <- c(r, fn(gamma.hat - 2 * se), fn(gamma.hat + 2 * se)) replace.na(opt, ylim, range(r)) xlm <- opt$xlim if (!is.na(max.dist)) xlm[2] <- max.dist plot(xx, yy, xlab = opt$xlab, ylab = opt$ylab, xlim = xlm, ylim = opt$ylim, type = "n") } if (model == "independent" & opt$band) polygon(c(ev, rev(ev)), fn(c(mean(dall) + 2 * se.band, rev(mean(dall) - 2 * se.band))), border = FALSE, col = opt$col.band) points(xx, yy, col = opt$col.points, pch = opt$pch) if (model == "none" & opt$se) segments(hh, fn(dd - 2 * se), hh, fn(dd + 2 * se), col = opt$col.points) if (model == "independent") lines(ev, fn(est), col = opt$col, lty = opt$lty) # if (type.se == "smooth") { # lines(ev, gamma.hat, col = opt$col, lty = opt$lty) # if (opt$se) { # lines(ev, gamma.hat + 2 * se, lty = 2, col = opt$col) # lines(ev, gamma.hat - 2 * se, lty = 2, col = opt$col) # } # } } #------------------------------------------------------------ # Test of isotropy #------------------------------------------------------------ if (model == "isotropic") { imat <- matrix(rep(1:n, n), ncol = n, byrow = TRUE) ind <- as.vector(t(imat) - imat) amat <- atan2(t(x2mat) - x2mat, t(x1mat) - x1mat) amat[amat < 0] <- amat[amat < 0] + pi angles <- (as.vector(amat))[ind > 0] # Remember to handle the case of 0 distances. centres1 <- seq(0, pi, length = opt$nbins + 1) centres1 <- centres1[-1] - diff(centres1) / 2 centres2 <- c(0, exp(min(log(hall)) + (1:opt$nbins) * diff(range(log(hall))) / opt$nbins)) centres2 <- centres2[-1] - diff(centres2) / 2 centres <- as.matrix(expand.grid(centres1, centres2)) # bins <- binning(cbind(angles, hall), dall, nbins = opt$nbins) identify.grid <- function(x, centres) { d <- (x[1] - centres[, 1])^2 + (x[2] - centres[, 2])^2 ind.pt <- which(d == min(d)) gpt <- centres[ind.pt, ] if (length(ind.pt) > 1) ind.pt <- ind.pt[gpt[, 1] == min(gpt[, 1])] if (length(ind.pt) > 1) ind.pt <- ind.pt[gpt[, 2] == min(gpt[, 2])] ind.pt } ibin <- apply(cbind(angles, hall), 1, identify.grid, centres) ibin <- match(ibin, unique(ibin)) dd <- as.vector(tapply(dall, ibin, mean)) dd0 <- as.vector(tapply(dall0, ibin, mean)) hh <- as.vector(tapply(hall, ibin, mean)) ang <- as.vector(tapply(angles, ibin, mean)) wts <- as.vector(table(ibin)) nbins <- length(unique(ibin)) # sm.regression(cbind(hh, ang), dd, df = 12, weights = wts, nbins = 0, display = "rgl", # col.points = "red", alpha = 0.7, size = 2, period = c(NA, pi)) h <- h.select(cbind(hh, ang), dd, weights = wts, df = opt$df, nbins = 0, period = c(NA, pi)) if (!is.numeric(df.se)) df.se <- round(0.8 * opt$nbins) results$distance.mean <- hh results$sqrtdiff.mean <- dd results$angles <- angles results$angles.mean <- ang results$weights <- wts results$ibin <- ibin results$h <- h if (is.na(max.dist)) max.dist <- max(hh) + 1 ind <- (hh <= max.dist) gamma.hat.V <- rep(0, length(hh)) if (type.se == "binned") gg <- dd[ind] else if (type.se == "smooth") gg <- sm.regression(hh, dd, weights = wts, eval.points = hh[ind], display = "none", nbins = 0)$estimate else if (type.se == "smooth-monotonic") gg <- ps.normal(hh, dd, df = df.se, weights = wts, eval.points = hh[ind], increasing = TRUE, weights.penalty = FALSE, display = "none")$estimate else if (type.se == "smooth-monotonic-original") gg <- ps.normal(hh, 0.5 * dd0, df = df.se, weights = wts, negative = FALSE, increasing = TRUE, eval.points = hh[ind], display = "none")$estimate gamma.hat.V[ind] <- pmax(gg, 0) gamma.hat.V[!ind] <- gamma.hat.V[hh == max(hh[ind])] # results$gamma.hat.V <- gamma.hat.V if (type.se != "smooth-monotonic-original") gamma.hat.V <- (gamma.hat.V / 0.977741)^4 # plot(hh, dd) # plot(hh, 0.5 * dd0) # ps.normal(hh, 0.5 * dd0, df = df.se, weights = wts, negative = FALSE, increasing = TRUE) # print(cbind(hh, gamma.hat.V)) # stop() V <- matrix(0, nrow = nbins, ncol = nbins) # LAST MODIFICATION # FULL.COV.BIN.FUN # if (opt$verbose > 0) cat(nbins, ": ") # for (i in 1:nbins) { # if (opt$verbose > 0) cat(i, "") # for (j in i:nbins){ # # ib <- sort(unique(results$ibin))[i] # # jb <- sort(unique(results$ibin))[j] # V[i, j] <- cov.bin.fun(i, j, results, gamma.hat.V) # if (j > i) V[j, i] <- V[i, j] # } # } result <- matrix(1.0, nrow=length(gamma.hat.V), ncol=length(gamma.hat.V)) rho.n <- 50 output <- .Fortran("full_cov_bin_fun", as.integer(length(gamma.hat.V)), as.integer(nrow(results$ipair)), as.integer(rho.n), as.integer(results$ibin), matrix(as.integer(results$ipair), ncol = 2), as.double(gamma.hat.V), res=as.double(result)) V <- matrix(data=output$res, nrow=length(gamma.hat.V), ncol=length(gamma.hat.V), byrow= TRUE) # if (opt$verbose > 0) cat("\n") opt$period <- c(NA, pi) if (opt$test | (opt$display != "none")) { mdl1 <- sm(dd ~ s(cbind(hh, ang), df = opt$df, period = opt$period), weights = wts, display = "none") df0 <- ceiling(sqrt(opt$df)) mdl0 <- sm(dd ~ s(hh, df = df0), weights = wts, display = "none") # mdl0 <- sm(dd ~ s(hh, df = opt$df), weights = wts, display = "none") # mdl0 <- sm(dd ~ s(hh, df = opt$df / 2), weights = wts, display = "none") # mdl0 <- sm(dd ~ s(hh, df = opt$df / 3), weights = wts, display = "none") # mdl0 <- sm(dd ~ s(hh, df = 4), weights = wts, display = "none") # mdl0 <- sm(dd ~ s(hh, lambda = mdl$lambda[[1]][1] * (mdl$nseg[[1]][1] + 3)), # weights = wts, display = "none") } if (opt$test) { # save(model, V, wts, dd, hh, ang, h, opt, file = "temp.dmp") S1 <- mdl1$B %*% mdl1$B1 %*% t(mdl1$B * wts) S0 <- mdl0$B %*% mdl0$B1 %*% t(mdl0$B * wts) # est1 <- S0 %*% dd # S1 <- S0 - S1 # V1 <- solve(V) # # V1 <- solve(S1 %*% V %*% t(S1)) # ds <- S1 %*% dd # tobs <- c(t(ds) %*% V1 %*% ds) # pval1 <- p.quad.moment.adjusted(t(S1) %*% V1 %*% S1, V, tobs) # # S0 <- sm.weight(hh, hh, h[1], weights = wts) # S1 <- sm.weight2(cbind(hh, ang), cbind(hh, ang), h, weights = wts, options = opt) # cat("traces:", round(sum(diag(S0))), round(sum(diag(S1))), "\n") # est0 <- S0 %*% dd # plot(range(hh), range(est1, est0), type = "n") # points(hh, est0) # points(hh, est1, col = "green") # sm.regression(cbind(hh, ang), dd, h, weights = wts, options = opt, display = "image") # S0 <- t(diag(nbins) - S0) %*% V1 %*% (diag(nbins) - S0) # S1 <- t(diag(nbins) - S1) %*% V1 %*% (diag(nbins) - S1) # S0 <- t(diag(nbins) - S0) %*% (diag(nbins) - S0) # S1 <- t(diag(nbins) - S1) %*% (diag(nbins) - S1) # r0 <- c(dd %*% S0 %*% dd) # r1 <- c(dd %*% S1 %*% dd) # tobs <- (r0 - r1) / r1 # S0 <- S0 - (1 + tobs) * S1 # pval <- p.quad.moment(S0, V, 0, 0) S1 <- S0 - S1 V1 <- solve(V) # V1 <- solve(S1 %*% V %*% t(S1)) ds <- S1 %*% dd tobs <- c(t(ds) %*% V1 %*% ds) pval <- p.quad.moment.adjusted(t(S1) %*% V1 %*% S1, V, tobs) # cat(round(pval, 3), round(pval1, 3), "\n") # mdl <- sm(dd ~ s(hh, df = 4) * s(ang, df = 4, period = pi), # weights = wts, display = "none") # # save(model, V, wts, file = "temp.dmp") # ind <- c(mdl$b.ind[[2]], mdl$b.ind[[3]]) # tobs <- sum(mdl$alpha[ind]^2) # I.i <- rep(0, ncol(mdl$B)) # I.i[ind] <- 1 # A <- mdl$B1 %*% t(mdl$B * wts) # pval <- p.quad.moment.adjusted(t(A) %*% diag(I.i) %*% A, V, tobs) if (opt$verbose > 0) cat("Test of isotropy: p = ", round(pval, 3), "\n") results$h <- h results$p <- pval # results$df0 <- df0 } opt$covmat <- V opt$nbins <- 0 opt$alpha.mesh <- 0.7 opt$test <- FALSE op <- opt replace.na(op, xlab, "Distance") replace.na(op, zlab, "Square-root difference") replace.na(op, ylab, "Angle") op$display <- "none" u <- list(length = 2) for (j in 1:2) u[[j]] <- seq(mdl1$xrange[[1]][j, 1], mdl1$xrange[[1]][j, 2], length = opt$ngrid) U <- as.matrix(expand.grid(u)) mask <- sm.mask(cbind(hh, ang), cbind(u[[1]], u[[2]]), mask.method = opt$mask.method) B1 <- ps.matrices(U, mdl1$xrange[[1]], 2, nseg = mdl1$nseg[[1]], period = mdl1$period[[1]])$B B1 <- cbind(1, B1) S1 <- B1 %*% mdl1$B1 %*% t(mdl1$B * wts) est1 <- matrix(S1 %*% dd, nrow = opt$ngrid) * mask B0 <- ps.matrices(as.matrix(U[ , 1]), mdl0$xrange[[1]], 1, nseg = mdl0$nseg[[1]])$B B0 <- cbind(1, B0) S0 <- B0 %*% mdl0$B1 %*% t(mdl0$B * wts) est0 <- matrix(S0 %*% dd, nrow = opt$ngrid) * mask stde <- sqrt(diag((S1 - S0) %*% V %*% t(S1 - S0))) sdiff <- (est1 - est0) / matrix(stde, ncol = opt$ngrid) ev <- u gamma.hat <- est1 results$eval.points <- u results$estimate <- est1 results$sdiff <- sdiff # surf <- sm.regression.2d(cbind(hh, ang), dd, h, model = "isotropic", weights = wts, # rawdata = list(x = cbind(hh, ang), y = dd), options = op) # ngrid <- nrow(surf$eval.points) # ev <- rep(surf$eval.points[, 1], ngrid) # gamma.hat <- surf$estimate # X <- sm.weight(hh, ev, h[1], weights = wts) # model.y <- matrix(as.vector(X %*% dd), ncol = opt$ngrid) * surf$estimate / surf$estimate if (opt$display == "rgl") { # This code needs to be updated # sm.surface3d(surf$eval.points, model.y, surf$scaling, col.mesh = "grey", # alpha = 0.5, alpha.mesh = 0) } else if (opt$display == "image") { if (!requireNamespace("akima", quietly = TRUE)) stop("this option requires the akima package.") a <- U a <- rbind(a, cbind(a[ , 1], a[ , 2] + pi)) a1 <- a[ , 1] * cos(a[ , 2]) a2 <- a[ , 1] * sin(a[ , 2]) b <- rep(c(est1), 2) sdiff <- rep(c(sdiff), 2) ind <- !is.na(b) & !duplicated(cbind(a1, a2)) inte <- akima::interp(a1[ind], a2[ind], b[ind]) ints <- akima::interp(a1[ind], a2[ind], sdiff[ind]) cts <- contourLines(ints) lvls <- rep(0, length(cts)) for (i in 1:length(cts)) lvls[i] <- cts[[i]]$level lvls <- lvls[lvls <= -2] results$levels <- lvls filled.contour(inte, color.palette = topo.colors, plot.axes = { axis(1) axis(2) # op <- opt # op$display <- "none" # surf <- sm.regression.2d(cbind(hh, ang), dd, h, model = "isotropic", weights = wts, # rawdata = list(x = cbind(hh, ang), y = dd), options = op) if (length(lvls) > 0) contour(ints, levels = lvls, add = TRUE, col = "red") # a <- as.matrix(expand.grid(surf$eval.points[ , 1], surf$eval.points[ , 2])) # a <- rbind(a, cbind(a[ , 1], a[ , 2] + pi)) # a1 <- a[ , 1] * cos(a[ , 2]) # a2 <- a[ , 1] * sin(a[ , 2]) # b <- rep(c(surf$estimate), 2) # ind <- !is.na(b) # #image(interp(a1[ind], a2[ind], b[ind])) # #print(contourplot(interp(a1[ind], a2[ind], b[ind])$z)) # filled.contour(interp(a1[ind], a2[ind], b[ind]), color.palette = topo.colors, # plot.axes = { # axis(1) # axis(2) # op <- opt # op$display <- "none" # surf <- sm.regression.2d(cbind(hh, ang), dd, h, model = "isotropic", weights = wts, # rawdata = list(x = cbind(hh, ang), y = dd), options = op) # sdiff <- rep(c(surf$sdiff), 2) # cts <- contourLines(interp(a1[ind], a2[ind], sdiff[ind])) # lvls <- rep(0, length(cts)) # for (i in 1:length(cts)) lvls[i] <- cts[[i]]$level # lvls <- lvls[lvls < 0] # contour(interp(a1[ind], a2[ind], sdiff[ind]), levels = lvls, add = TRUE) } ) } } #------------------------------------------------------------ # Test of stationarity #------------------------------------------------------------ if (model == "stationary") { imat <- matrix(rep(1:n, n), ncol = n, byrow = TRUE) ind <- as.vector(t(imat) - imat) av1 <- (t(x1mat) + x1mat) / 2 av2 <- (t(x2mat) + x2mat) / 2 av1 <- (as.vector(av1))[ind > 0] av2 <- (as.vector(av2))[ind > 0] centres1 <- seq(min(av1), max(av1), length = opt$nbins + 1) centres2 <- seq(min(av2), max(av2), length = opt$nbins + 1) centres3 <- c(0, exp(min(log(hall)) + (1:opt$nbins) * diff(range(log(hall))) / opt$nbins)) centres1 <- centres1[-1] - diff(centres1) / 2 centres2 <- centres2[-1] - diff(centres2) / 2 centres3 <- centres3[-1] - diff(centres3) / 2 centres <- as.matrix(expand.grid(centres1, centres2, centres3)) identify.grid <- function(x, centres) { d <- (x[1] - centres[, 1])^2 + (x[2] - centres[, 2])^2 + (x[3] - centres[, 3])^2 ind.pt <- which(d == min(d)) gpt <- centres[ind.pt, ] if (length(ind.pt) > 1) ind.pt <- ind.pt[gpt[, 1] == min(gpt[, 1])] if (length(ind.pt) > 1) ind.pt <- ind.pt[gpt[, 2] == min(gpt[, 2])] if (length(ind.pt) > 1) ind.pt <- ind.pt[gpt[, 3] == min(gpt[, 3])] ind.pt } ibin <- apply(cbind(av1, av2, hall), 1, identify.grid, centres) ibin <- match(ibin, unique(ibin)) dd <- as.vector(tapply(dall, ibin, mean)) dd0 <- as.vector(tapply(dall0, ibin, mean)) hh <- as.vector(tapply(hall, ibin, mean)) a1 <- as.vector(tapply(av1, ibin, mean)) a2 <- as.vector(tapply(av2, ibin, mean)) wts <- as.vector(table(ibin)) nbins <- length(unique(ibin)) # h <- h.select(cbind(hh, ang), dd, weights = wts, df = opt$df, nbins = 0, period = c(NA, pi)) if (!is.numeric(df.se)) df.se <- round(0.8 * opt$nbins) results$distance.mean <- hh results$sqrtdiff.mean <- dd # results$av1 <- av1 # results$av2 <- av2 # results$a1 <- a1 # results$a2 <- a2 results$weights <- wts results$ibin <- ibin xx <- cbind(x = a1, y = a2, Distance = hh) if (is.na(max.dist)) max.dist <- max(hh) + 1 ind <- (hh <= max.dist) gamma.hat.V <- rep(0, length(hh)) if (type.se == "binned") gg <- dd[ind] else if (type.se == "smooth") gg <- sm.regression(hh, dd, weights = wts, eval.points = hh[ind], display = "none", nbins = 0)$estimate else if (type.se == "smooth-monotonic") gg <- ps.normal(hh, dd, df = df.se, weights = wts, eval.points = hh, increasing = TRUE, weights.penalty = FALSE, display = "none")$estimate else if (type.se == "smooth-monotonic-original") gg <- ps.normal(hh, 0.5 * dd0, df = df.se, weights = wts, negative = FALSE, increasing = TRUE, eval.points = hh[ind], display = "none")$estimate gamma.hat.V[ind] <- pmax(gg, 0) gamma.hat.V[!ind] <- gamma.hat.V[hh == max(hh[ind])] # results$gamma.hat.V <- gamma.hat.V if (type.se != "smooth-monotonic-original") gamma.hat.V <- (gamma.hat.V / 0.977741)^4 V <- matrix(0, nrow = nbins, ncol = nbins) # if (opt$verbose > 0) cat(nbins, ": ") # LAST MODIFICATION # FULL.COV.BIN.FUN # for (i in 1:nbins) { # if (opt$verbose > 0) cat(i, "") # for (j in i:nbins){ # V[i, j] <- cov.bin.fun(i, j, results, gamma.hat.V) # if (j > i) V[j, i] <- V[i, j] # } # } result <- matrix(1.0, nrow=length(gamma.hat.V), ncol=length(gamma.hat.V)) rho.n <- 50 output <- .Fortran("full_cov_bin_fun", as.integer(length(gamma.hat.V)), as.integer(nrow(results$ipair)), as.integer(rho.n), as.integer(results$ibin), matrix(as.integer(results$ipair), ncol = 2), as.double(gamma.hat.V), res=as.double(result)) V <- matrix(data=output$res, nrow=length(gamma.hat.V), ncol=length(gamma.hat.V), byrow= TRUE) # if (opt$verbose > 0) cat("\n") model1 <- sm(dd ~ s(xx, df = opt$df), weights = wts, display = "none") if (opt$test) { df0 <- ceiling(opt$df^(1/3)) # df0 <- ceiling(opt$df / 3) # df0 <- ceiling(opt$df / 2) model0 <- sm(dd ~ s(hh, df = df0), weights = wts, display = "none") # mdl0 <- sm(dd ~ s(hh, lambda = mdl$lambda[[1]][1] * (mdl$nseg[[1]][1] + 3)^2), # weights = wts, display = "none") # model0 <- sm(dd ~ s(hh, df = 3), weights = wts, display = "none") S0 <- model0$B %*% model0$B1 %*% t(model0$B * wts) S1 <- model1$B %*% model1$B1 %*% t(model1$B * wts) V1 <- solve(V) S0 <- t(S0 - S1) %*% V1 %*% (S0 - S1) tobs <- c(dd %*% S0 %*% dd) pval <- p.quad.moment.adjusted(S0, V, tobs) if (opt$verbose > 0) cat("Test of stationarity: p = ", round(pval, 3), "\n") results$p <- pval # results$df0 <- df0 } u <- list(length = 3) for (j in 1:3) u[[j]] <- seq(model1$xrange[[1]][j, 1], model1$xrange[[1]][j, 2], length = opt$ngrid) U <- as.matrix(expand.grid(u)) B1 <- ps.matrices(U, model1$xrange[[1]], 3, nseg = model1$nseg[[1]], period = model1$period[[1]])$B B1 <- cbind(1, B1) S1 <- B1 %*% model1$B1 %*% t(model1$B * wts) est1 <- S1 %*% dd B0 <- ps.matrices(as.matrix(U[ , 3]), model0$xrange[[1]], 1, nseg = model0$nseg[[1]])$B B0 <- cbind(1, B0) S0 <- B0 %*% model0$B1 %*% t(model0$B * wts) est0 <- S0 %*% dd stde <- diag((S1 - S0) %*% V %*% t(S1 - S0)) stde[stde < 0] <- NA stde <- sqrt(stde) model1$sdiff <- array((est1 - est0) / stde, dim = rep(opt$ngrid, 3)) # ev <- u # gamma.hat <- est1 opt$covmat <- V # Add V into the estimated surface. # Return the estimate from the fitted surface. # plot(model1) # replace.na(opt, xlab, "Distance") # replace.na(opt, zlab, "Square-root difference") # replace.na(opt, ylab, "Angle") gamma.hat <- model1$fitted ev <- xx # results$model <- model1 names(u) <- c("x1", "x2", "distance") results$eval.points <- u results$estimate <- array(est1, dim = rep(opt$ngrid, 3)) results$sdiff <- model1$sdiff } #------------------------------------------------------------ # Return values #------------------------------------------------------------ # results$eval.points <- ev # results$estimate <- gamma.hat # results$gamma.hat.V <- gamma.hat.V results$df <- opt$df if (opt$se & model == "none") results$se <- se if ((model == "independent") & opt$band) results$se.band <- se.band if (varmat | model %in% c("isotropic", "stationary")) results$V <- V invisible(results) } p.quad.moment.adjusted <- function (A, Sigma, tobs) { B <- A %*% Sigma k1 <- sum(diag(B)) - tobs C <- B %*% B k2 <- 2 * sum(diag(C)) k3 <- 8 * sum(diag(C %*% B)) aa <- abs(k3/(4 * k2)) bb <- (8 * k2^3)/k3^2 cc <- k1 - aa * bb 1 - pchisq(-cc/aa, bb) } # hg <- function(rho) { # a <- 3/4 # b <- 3/4 # cc <- 1/2 # fn <- gamma(a) * gamma(b) / gamma(cc) # facn <- 1 # n <- 1 # fnold <- 0.1 # while (abs(fn - fnold) / fnold > 0.0001 ) { # facn <- facn * n # fnold <- fn # fn <- fn + gamma(a + n) * gamma(b + n) * rho^n / (gamma(cc + n) * facn) # n <- n + 1 # } # fn * gamma(cc) / (gamma(a) * gamma(b)) # } # cor.sqrtabs <- function(rho) { # # library(Davies) # # gamma(0.75)^2 * ((1 - rho^2) * hypergeo(0.75, 0.75, 0.5, rho^2) - 1) / (sqrt(pi) - gamma(0.75)^2) # gamma(0.75)^2 * ((1 - rho^2) * hg(rho^2) - 1) / (sqrt(pi) - gamma(0.75)^2) # } sm/R/hselect.r0000744000176200001440000003555312424420702012715 0ustar liggesusers"h.select" <- function(x, y = NA, weights = NA, group = NA, ...) { data <- sm.check.data(x, y, weights = weights, group = group, ...) x <- data$x y <- data$y weights <- data$weights group <- data$group nobs <- data$nobs ndim <- data$ndim density <- data$density opt <- data$options if (all(!is.na(group))) { group.fac <- factor(group) h.all <- matrix(0, ncol = ndim, nrow = 0) for (igroup in 1:length(levels(group.fac))) { level.i <- levels(group.fac)[igroup] if (ndim == 1) h.igroup <- h.select(x[group.fac == level.i], y[group.fac == level.i], weights[group.fac == level.i], ...) else h.igroup <- h.select(x[group.fac == level.i,], y[group.fac == level.i], weights[group.fac == level.i], ...) h.all <- rbind(h.all, h.igroup) } h.gmean <- apply(h.all, 2, FUN = function(x) exp(mean(log(x)))) return(as.vector(h.gmean)) } if (ndim == 1) replace.na(opt, df, 6) else if (ndim == 2) replace.na(opt, df, 12) if ((!density) & opt$df <= 2) stop("df must be > 2") if (density) replace.na(opt, method, "normal") else replace.na(opt, method, "df") if ((ndim == 3) & !(density & opt$method == "normal")) stop("bandwidth selection not available for 3 dimensions.") method <- opt$method df <- opt$df structure.2d <- opt$structure.2d if (method == "df" & ndim == 2 & structure.2d == "different") stop("df method is not appropriate for different bandwidths") replace.na(opt, nbins, round((nobs > 100) * 8 * log(nobs) / ndim)) if (opt$nbins > 0 & ndim < 3) { if (!all(weights == 1) & opt$verbose > 0) cat("Warning: weights overwritten by binning\n") data <- binning(x, y, nbins = opt$nbins) } else data <- list(x = x, means = y, x.freq = rep(1,nobs), devs = rep(0,nobs)) h.weights <- opt$h.weights if (opt$verbose > 0 & !all(is.na(h.weights)) & opt$nbins > 0) { h.weights <- rep(1, length(data$x.freq)) cat("h.weights cannot be used with binning") } if (all(is.na(h.weights))) h.weights <- rep(1, length(data$x.freq)) data$h.weights <- h.weights sd <- sqrt(diag(as.matrix(var(x)))) if (ndim==1) start <- sd / 2 else start <- switch(structure.2d, common = mean(sd / 2), scaled = 0.5, separate = sd / 2) data$sd <- sd if (density & method == "normal") return(hnorm(x)) else if (density & method == "sj") { if (ndim > 1) stop("Sheather-Jones method requires 1-d data") if (!all(weights == 1) & opt$verbose > 0) cat("Warning: weights are not used in the sj method\n") return(hsj(x)) } else { if (density) crit.type <- "dens" else crit.type <- "reg" fname <- paste(method, ".crit", ".", crit.type, sep = "") if (structure.2d == "separate") { result <- optim(par = log(start), fn = get(fname), control = list(reltol = 1e-6), data = data, structure.2d = structure.2d, opt = opt) h.result <- exp(result$par) } else { result <- optimise(f = get(fname), interval = log(c(start / 8, start * 4)), data = data, structure.2d = structure.2d, opt = opt) h.result <- exp(result$minimum) } } if (ndim == 2) h.result <- switch(structure.2d, common = rep(h.result,2), scaled = h.result * sd, h.result) return(h.result) } "cv" <- function (x, h, ...) { opt <- sm.options(list(...)) if (!isMatrix(x)) { n <- length(x) replace.na(opt, h.weights, rep(1, n)) hcvff <- sum(dnorm(0, mean = 0, sd = sqrt(2) * h * opt$h.weights))/(n * (n - 1)) W <- matrix(rep(x, rep(n, n)), ncol = n, byrow = TRUE) W <- W - matrix(rep(x, n), ncol = n, byrow = TRUE) W1 <- matrix(rep(opt$h.weights^2, n), ncol = n, byrow = TRUE) W2 <- exp(-0.5 * (W/(h * sqrt(W1 + t(W1))))^2)/(sqrt(2 * pi) * h * sqrt(W1 + t(W1))) hcvff <- hcvff + (sum(W2) - sum(diag(W2))) * (n - 2)/(n * (n - 1)^2) W2 <- exp(-0.5 * (W/(h * sqrt(W1)))^2)/(sqrt(2 * pi) * h * sqrt(W1)) hcvff <- hcvff - (sum(W2) - sum(diag(W2))) * 2/(n * (n - 1)) } if (isMatrix(x)) { x1 <- x[, 1] x2 <- x[, 2] h1 <- h * sqrt(var(x1)) h2 <- h * sqrt(var(x2)) n <- length(x1) replace.na(opt, h.weights, rep(1, n)) hcvff <- sum(dnorm(0, mean = 0, sd = sqrt(2) * h1 * opt$h.weights) * dnorm(0, mean = 0, sd = sqrt(2) * h2 * opt$h.weights))/(n * (n - 1)) W <- matrix(rep(x1, rep(n, n)), ncol = n, byrow = TRUE) W <- W - matrix(rep(x1, n), ncol = n, byrow = TRUE) W1 <- matrix(rep(opt$h.weights^2, n), ncol = n, byrow = TRUE) W2 <- exp(-0.5 * (W/(h1 * sqrt(W1 + t(W1))))^2)/(sqrt(2 * pi) * h1 * sqrt(W1 + t(W1))) W <- matrix(rep(x2, rep(n, n)), ncol = n, byrow = TRUE) W <- W - matrix(rep(x2, n), ncol = n, byrow = TRUE) W2 <- W2 * exp(-0.5 * (W/(h2 * sqrt(W1 + t(W1))))^2)/(sqrt(2 * pi) * h2 * sqrt(W1 + t(W1))) hcvff <- hcvff + (sum(W2) - sum(diag(W2))) * (n - 2)/(n * (n - 1)^2) W2 <- exp(-0.5 * (W/(h2 * sqrt(W1)))^2)/(sqrt(2 * pi) * h2 * sqrt(W1)) W <- matrix(rep(x1, rep(n, n)), ncol = n, byrow = TRUE) W <- W - matrix(rep(x1, n), ncol = n, byrow = TRUE) W2 <- W2 * exp(-0.5 * (W/(h1 * sqrt(W1)))^2)/(sqrt(2 * pi) * h1 * sqrt(W1)) hcvff <- hcvff - (sum(W2) - sum(diag(W2))) * 2/(n * (n - 1)) } hcvff } "hcv" <- function (x, y = NA, hstart = NA, hend = NA, ...) { opt <- sm.options(list(...)) replace.na(opt, ngrid, 8) replace.na(opt, display, "none") if (length(dim(x)) > 0) { ndim <- 2 n <- length(x[, 1]) } else { ndim <- 1 n <- length(x) } replace.na(opt, h.weights, rep(1, n)) ngrid <- opt$ngrid display <- opt$display h.weights <- opt$h.weights if (is.na(hstart)) { if (ndim == 1) hstart <- hnorm(x)/10 else if (any(is.na(y))) hstart <- hnorm(x[, 1]/sqrt(var(x[, 1])))/10 else hstart <- hnorm(x[, 1]/sqrt(var(x[, 1])))/4 } if (is.na(hend)) { if (ndim == 1) hend <- hnorm(x) * 2 else hend <- hnorm(x[, 1]/sqrt(var(x[, 1]))) * 2 } cvgrid <- vector("numeric", length = ngrid) hgrid <- log(hstart) + (log(hend) - log(hstart)) * (0:(ngrid - 1)) / (ngrid - 1) if (any(is.na(y))) { for (i in 1:ngrid) cvgrid[i] <- cv(x, exp(hgrid[i]), h.weights = h.weights) } else { if (ndim == 1) for (i in 1:ngrid) { cvgrid[i] <- sum((y - sm.weight(x, x, h = exp(hgrid[i]), cross = TRUE, options = list(h.weights = h.weights)) %*% y)^2) } if (ndim == 2) for (i in 1:ngrid) { cvgrid[i] <- sum((y - sm.weight2(x, x, exp(hgrid[i] * c(sqrt(var(x[, 1])), sqrt(var(x[, 2])))), cross = TRUE, options = list(h.weights = h.weights)) %*% y)^2) } } if (any(is.na(cvgrid))) { cat("\n") cat("hcv: some computations failed.", "\n") cat("Try readjusting hstart and hend.", "\n") cat("hstart: ", hstart, "\n") cat("hend : ", hend, "\n") cat("\n") print(cbind(h = exp(hgrid), cv = cvgrid)) stop() } ind <- (1:ngrid)[cvgrid == min(cvgrid)] if (!(display == "none")) { if (!opt$add) { if (display == "log") plot(hgrid, cvgrid, type = "l", xlab = "Log h", ylab = "CV") else plot(exp(hgrid), cvgrid, type = "l", xlab = "h", ylab = "CV") } else { if (display == "log") lines(hgrid, cvgrid) else lines(exp(hgrid), cvgrid) } } if (ind == 1 | ind == ngrid) { cat("\n") cat("hcv: boundary of search area reached.", "\n") cat("Try readjusting hstart and hend.", "\n") cat("hstart: ", hstart, "\n") cat("hend : ", hend, "\n") cat("\n") print(cbind(h = exp(hgrid), cv = cvgrid)) stop() } v0 <- cvgrid[ind - 1] v1 <- cvgrid[ind] v2 <- cvgrid[ind + 1] l0 <- hgrid[ind - 1] l1 <- hgrid[ind] l2 <- hgrid[ind + 1] aa <- (v1 - v0 - (l1 - l0) * (v1 - v2)/(l1 - l2))/(l1^2 - l0^2 - (l1^2 - l2^2) * (l1 - l0)/(l1 - l2)) bb <- (v1 - v2 - aa * (l1^2 - l2^2))/(l1 - l2) cc <- v0 - aa * l0^2 - bb * l0 h <- exp(-bb/(2 * aa)) if (ndim == 1) result <- h else result <- c(h * sqrt(var(x[, 1])), h * sqrt(var(x[, 2]))) result } "hnorm" <- function (x, weights = NA) { if (isMatrix(x)) { if (all(is.na(weights))) weights <- rep(1, nrow(x)) ndim <- ncol(x) n <- sum(weights) sd <- sqrt(apply(x, 2, wvar, w = weights)) if (ndim == 2) hh <- sd * (1/n)^(1/6) else if (ndim == 3) hh <- sd * (4/(5 * n))^(1/7) if (ndim > 3) stop("data with >3 dimensions are not allowed.") hh } else { if (all(is.na(weights))) weights <- rep(1, length(x)) sd <- sqrt(wvar(x, weights)) sd * (4/(3 * sum(weights)))^(1/5) } } "hsj" <- function (x) { h0 <- hnorm(x) v0 <- sj(x, h0) if (v0 > 0) hstep <- 1.1 else hstep <- 0.9 h1 <- h0 * hstep v1 <- sj(x, h1) while (v1 * v0 > 0) { h0 <- h1 v0 <- v1 h1 <- h0 * hstep v1 <- sj(x, h1) } h0 + (h1 - h0) * abs(v0)/(abs(v0) + abs(v1)) } "sj" <- function (x, h) { phi6 <- function(x) (x^6 - 15 * x^4 + 45 * x^2 - 15) * dnorm(x) phi4 <- function(x) (x^4 - 6 * x^2 + 3) * dnorm(x) n <- length(x) lambda <- quantile(x, 0.75) - quantile(x, 0.25) a <- 0.92 * lambda * n^(-1/7) b <- 0.912 * lambda * n^(-1/9) W <- matrix(rep(x, rep(n, n)), ncol = n, byrow = TRUE) W <- W - matrix(rep(x, n), ncol = n, byrow = TRUE) W1 <- matrix(phi6(W/b), ncol = n) tdb <- as.numeric(rep(1, n) %*% W1 %*% rep(1, n)) tdb <- -tdb/(n * (n - 1) * b^7) W1 <- matrix(phi4(W/a), ncol = n) sda <- as.numeric(rep(1, n) %*% W1 %*% rep(1, n)) sda <- sda/(n * (n - 1) * a^5) alpha2 <- 1.357 * (abs(sda/tdb))^(1/7) * h^(5/7) W1 <- matrix(phi4(W/alpha2), ncol = n) sdalpha2 <- as.numeric(rep(1, n) %*% W1 %*% rep(1, n)) sdalpha2 <- sdalpha2/(n * (n - 1) * alpha2^5) result <- (dnorm(0, sd = sqrt(2))/(n * abs(sdalpha2)))^0.2 - h attributes(result)$names <- NULL as.double(result) } "df.crit.reg" <- function(log.h, data, structure.2d, opt) { x <- data$x freq <- data$x.freq h <- exp(log.h) if (is.vector(x)) S <- sm.weight(x, x, h, weights = freq, options = opt) if (is.matrix(x)) { h <- switch(structure.2d, scaled = h * data$sd, common = rep(h, 2), h) S <- sm.weight2(x, x, h, weights = freq, options = opt) } (sum(diag(S)) - opt$df)^2 } "cv.crit.reg" <- function(log.h, data, structure.2d, opt) { x <- data$x y <- data$means freq <- data$x.freq h <- exp(log.h) if (is.vector(x)) S <- sm.weight(x, x, h, cross = T, weights = freq, options = opt) if (is.matrix(x)) { h <- switch(structure.2d, scaled = h * data$sd, common = rep(h, 2), h) S <- sm.weight2(x, x, h, cross = T, weights = freq, options = opt) } n <- length(y) cv <- sum(freq * ((diag(n) - S) %*% y)^2 + data$devs) / sum(freq) if(opt$verbose > 1) cat("h, CV: ", h, cv, "\n") if(is.na(cv)) cv <- 1e10 cv } "aicc.crit.reg" <- function(log.h, data, structure.2d, opt) { x <- data$x y <- data$means freq <- data$x.freq h <- exp(log.h) if (is.vector(x)) S <- sm.weight(x, x, h, weights=freq, options=opt) if (is.matrix(x)) { h <- switch(structure.2d, scaled = h * data$sd, common = rep(h, 2), h) S <- sm.weight2(x, x, h, weights=freq, options=opt) } tr.S <- sum(freq * diag(S)) nobs <- sum(freq) n <- length(y) sig.sq <- sum(freq * ((diag(n) - S) %*% y)^2 + data$devs) / nobs penalty <- 1 + 2 * (tr.S + 1) / (nobs - tr.S - 2) aicc <- log(sig.sq) + penalty if(opt$verbose > 1) cat("h, AIC.c: ", h, aicc,"\n") if(is.na(aicc)) aicc <- 1e10 aicc } "cv.crit.dens" <- function(log.h, data, structure.2d, opt) { h <- exp(log.h) x <- data$x freq <- data$x.freq n <- length(freq) h.weights <- data$h.weights if (!is.matrix(x)) { hcvff <- sum(freq * dnorm(0, 0, sqrt(2)*h*h.weights))/(n*(n-1)) W <- matrix(rep(x, n), ncol = n) W <- W - t(W) W1 <- matrix(rep(h.weights^2, n), ncol = n, byrow = TRUE) W2 <- exp(-.5 * (W/(h*sqrt(W1+t(W1))))^2) / (sqrt(2*pi)*h*sqrt(W1+t(W1))) W2 <- W2 * matrix(rep(freq,n), ncol=n) * matrix(rep(freq,n), ncol=n, byrow = TRUE) hcvff <- hcvff + (sum(W2) - sum(diag(W2)))*(n-2)/(n*(n-1)^2) W2 <- exp(-.5 * (W/(h*sqrt(W1)))^2) / (sqrt(2*pi)*h*sqrt(W1)) W2 <- W2 * matrix(rep(freq,n),ncol=n) * matrix(rep(freq,n),ncol=n, byrow = TRUE) hcvff <- hcvff - (sum(W2) - sum(diag(W2)))*2/(n*(n-1)) } if (is.matrix(x)) { h <- switch(structure.2d, scaled = h * data$sd, common = rep(h, 2), h) x1 <- x[,1] x2 <- x[,2] h1 <- h[1] h2 <- h[2] hcvff <- sum(freq * dnorm(0, 0, sqrt(2) * h1 * h.weights) * dnorm(0, 0, sqrt(2) * h2 * h.weights))/(n*(n-1)) W <- matrix(rep(x1, n), ncol = n) W <- W - t(W) W1 <- matrix(rep(h.weights^2, n), ncol = n, byrow = TRUE) W2 <- exp(-.5 * (W/(h1 * sqrt(W1+t(W1))))^2) / (sqrt(2 * pi) * h1 * sqrt(W1+t(W1))) W <- matrix(rep(x2, n), ncol = n) W <- W - t(W) W2 <- W2 * exp(-.5 * (W/(h2 * sqrt(W1+t(W1))))^2) / (sqrt(2 * pi) * h2 * sqrt(W1+t(W1))) W2 <- W2 * matrix(rep(freq,n), ncol=n) * matrix(rep(freq,n), ncol=n, byrow = TRUE) hcvff <- hcvff + (sum(W2) - sum(diag(W2)))*(n-2)/(n*(n-1)^2) W2 <- exp(-.5 * (W/(h2 * sqrt(W1)))^2) / (sqrt(2 *pi) * h2 * sqrt(W1)) W <- matrix(rep(x1, n), ncol = n) W <- W - t(W) W2 <- W2 * exp(-.5 * (W/(h1 * sqrt(W1)))^2) / (sqrt(2 * pi) * h1 * sqrt(W1)) W2 <- W2 * matrix(rep(freq,n), ncol=n) * matrix(rep(freq,n), ncol=n, byrow = TRUE) hcvff <- hcvff - (sum(W2) - sum(diag(W2))) * 2 / (n*(n-1)) } hcvff } sm/R/rpanel.r0000744000176200001440000004511013273416244012546 0ustar liggesusersplot.smooth1 <- function(panel) { if (panel$method == "manual") panel$h <- panel$h.manual panel$opt$se <- panel$se panel$opt$test <- panel$test if (panel$model == "none") panel$opt$test <- FALSE with(panel, { result <- sm.regression.1d(x, y, h, design.mat, model, weights, rawdata, opt) df.h <- approx(hvec, dfvec, h, rule = 2)$y df.text <- paste("df =", as.character(round(df.h, 1))) h.text <- paste(" h =", as.character(signif(h, 3))) if ("p" %in% names(result)) p.text <- paste(" p =", round(result$p, 3)) else p.text <- "" title(paste(df.text, h.text, p.text)) }) panel } set.bandwidth <- function(panel) { if (panel$method != "manual") { panel$h <- h.select(panel$x, panel$y, panel$weights, method = panel$method) panel$h <- panel$h[1] } if (is.matrix(panel$x)) ndim <- 2 else ndim <- 1 if (panel$opt$panel.plot) { if (ndim == 1) rpanel::rp.do(panel, replot.smooth1) else rpanel::rp.do(panel, replot.smooth2) } else { if (ndim == 1) rpanel::rp.do(panel, plot.smooth1) else rpanel::rp.do(panel, plot.smooth2) } panel } replot.smooth1 <- function(panel) { rpanel::rp.tkrreplot(panel, plot) panel } rp.smooth1 <- function(x, y, h, design.mat, model, weights, rawdata, opt) { opt <- sm.options(opt) replace.na(opt, se, FALSE) replace.na(opt, test, FALSE) replace.na(opt, panel.plot, TRUE) opt$verbose <- 0 nvec <- 20 hvec <- rep(0, nvec) hvec[1] <- h.select(x, y, weights = weights, method = "df", df = 2.1, nbins = 0) hvec[nvec] <- h.select(x, y, weights = weights, method = "df", df = 20, nbins = 0) hvec <- exp(seq(log(hvec[1]), log(hvec[nvec]), length = nvec)) dfvec <- seq(2.1, 20, length = nvec) for (i in 2:(nvec - 1)) dfvec[i] <- sum(diag(sm.weight(x, x, hvec[i], weights = weights))) # for (i in 1:nvec) # hvec[i] <- h.select(x, y, weights = weights, method = "df", df = dfvec[i], nbins = 0) if (opt$panel.plot & !requireNamespace("tkrplot", quietly = TRUE)) opt$panel.plot <- FALSE smooth.panel <- rpanel::rp.control("Nonparametric regression - 1 covariate", x = x, y = y, h = h, design.mat = design.mat, model = model, weights = weights, rawdata = rawdata, opt = opt, hvec = hvec, dfvec = dfvec, h.manual = h, method = "manual", se = opt$se, test = opt$test) if (opt$panel.plot) { rpanel::rp.tkrplot(smooth.panel, plot, plot.smooth1, pos = "right", hscale = opt$hscale, vscale = opt$vscale) plotfun <- replot.smooth1 } else plotfun <- plot.smooth1 rpanel::rp.radiogroup(smooth.panel, method, c("aicc", "cv", "manual"), title = "Choice of bandwidth", action = set.bandwidth) rpanel::rp.slider(smooth.panel, h.manual, hvec[1], hvec[nvec], plotfun, "df", log = TRUE) rpanel::rp.checkbox(smooth.panel, se, plotfun, title = "Standard errors") rpanel::rp.radiogroup(smooth.panel, model, c("none", "no effect", "linear"), title = "Reference model", action = plotfun) rpanel::rp.checkbox(smooth.panel, test, plotfun, title = "Test") rpanel::rp.do(smooth.panel, plotfun) invisible(smooth.panel) } plot.smooth2 <- function(panel) { if (panel$method != panel$method.old) { if (panel$method != "manual") { panel$h <- h.select(panel$x, panel$y, panel$weights, method = panel$method) panel$h <- panel$h[1] } panel$method.old <- panel$method } if (panel$method == "manual") panel$h <- panel$h.manual if (panel$structure.2d == "common") h2 <- rep(panel$h, 2) else h2 <- c(panel$h, panel$h * sqrt(wvar(panel$x[,2], panel$weights) / wvar(panel$x[,1], panel$weights))) panel$opt$display <- panel$display if (panel$display == "image") { opt1 <- panel$opt opt1$display <- "slice" opt1$add <- TRUE } if (panel$display != "rgl") panel$surf.ids <- rep(NA, 2) panel$opt$theta <- panel$theta panel$opt$phi <- panel$phi panel$opt$se <- panel$se panel$opt$test <- panel$test if (panel$model == "none") panel$opt$test <- FALSE if (panel$display == "rgl") { if (panel$display.old == "rgl") panel$opt$add <- TRUE else panel$opt$add <- FALSE } result <- sm.regression.2d(panel$x, panel$y, h2, panel$model, panel$weights, panel$rawdata, panel$opt) if (panel$display == "rgl") { if (!is.na(sum(panel$surf.ids))) rgl::rgl.pop(id = panel$surf.ids) panel$surf.ids <- result$surf.ids } if (panel$display == "rgl" & !panel$opt$add) panel$opt$scaling <- result$scaling with(panel, { if (display == "image") sm.regression.2d(x, y, h2, model, weights, rawdata, opt1) if (!(display == "rgl")) { df.h <- approx(hvec, dfvec, h, rule = 2)$y df.text <- paste("df =", as.character(round(df.h, 1))) h.text <- paste(" h = (", as.character(signif(h2[1], 3)),",", as.character(signif(h2[2], 3)), ")") if ("p" %in% names(result)) p.text <- paste(" p =", round(result$p, 3)) else p.text <- "" title(paste(df.text, h.text, p.text)) } else if ("p" %in% names(result)) cat("Test (", panel$model, "): p = ", round(result$p, 3), "\n", sep = "") }) panel$display.old <- panel$display panel } replot.smooth2 <- function(panel) { rpanel::rp.tkrreplot(panel, smplot) panel } rp.smooth2 <- function(x, y, h, model, weights, rawdata, opt) { opt <- sm.options(opt) replace.na(opt, se, FALSE) replace.na(opt, test, FALSE) if (is.na(opt$display)) display.set <- FALSE else display.set <- TRUE replace.na(opt, display, "persp") if (!display.set | (display.set & opt$display == "rgl")) opt$panel.plot <- FALSE else replace.na(opt, panel.plot, TRUE) if (opt$structure.2d == "different") stop("structure.2d cannot be set to different when panel = TRUE.") opt$verbose <- 0 nvec <- 20 hvec <- rep(0, nvec) hvec[1] <- h.select(x, y, weights = weights, method = "df", df = 2.1, structure.2d = opt$structure.2d, nbins = 0)[1] hvec[nvec] <- h.select(x, y, weights = weights, method = "df", df = 30, structure.2d = opt$structure.2d, nbins = 0)[1] hvec <- exp(seq(log(hvec[1]), log(hvec[nvec]), length = nvec)) dfvec <- seq(2.1, 30, length = nvec) for (i in 2:(nvec - 1)) { if (opt$structure.2d == "common") h2 <- rep(hvec[i], 2) else h2 <- c(hvec[i], hvec[i] * sqrt(wvar(x[,2], weights) / wvar(x[,1], weights))) dfvec[i] <- sum(diag(sm.weight2(x, x, h2, weights = weights))) } # for (i in 1:nvec) # hvec[i] <- h.select(x, y, weights = weights, method = "df", df = dfvec[i], nbins = 0)[1] if (opt$panel.plot & !requireNamespace("tkrplot", quietly = TRUE)) opt$panel.plot <- FALSE smooth.panel <- rpanel::rp.control("Nonparametric regression - 2 covariates", x = x, y = y, h = h[1], structure.2d = opt$structure.2d, model = model, weights = weights, rawdata = rawdata, opt = opt, hvec = hvec, dfvec = dfvec, h.manual = h[1], display = opt$display, display.old = "none", surf.ids = rep(NA, 2), theta = opt$theta, phi = opt$phi, method = "manual", method.old = "manual", se = opt$se, test = opt$test) if (opt$panel.plot) { rpanel::rp.tkrplot(smooth.panel, smplot, plot.smooth2, pos = "right", hscale = opt$hscale, vscale = opt$vscale) plotfun <- replot.smooth2 } else plotfun <- plot.smooth2 rpanel::rp.radiogroup(smooth.panel, method, c("aicc", "cv", "manual"), title = "Choice of bandwidth", action = plotfun) rpanel::rp.slider(smooth.panel, h.manual, hvec[1], hvec[nvec], plotfun, "df", log = TRUE) rpanel::rp.checkbox(smooth.panel, se, plotfun, title = "Standard errors") rpanel::rp.radiogroup(smooth.panel, model, c("none", "no effect", "linear"), title = "Reference model", action = plotfun) rpanel::rp.checkbox(smooth.panel, test, plotfun, title = "Test") if (!display.set) { display.options <- c("persp", "image") if (requireNamespace("rgl", quietly = TRUE)) display.options <- c(display.options, "rgl") rpanel::rp.radiogroup(smooth.panel, display, display.options, title = "Display", action = plotfun) } if (opt$display == "persp") { rpanel::rp.slider(smooth.panel, theta, -180, 180, plotfun, "persp angle 1") rpanel::rp.slider(smooth.panel, phi, 0, 90, plotfun, "persp angle 2") } invisible(smooth.panel) } # Density estimation plot.density1 <- function(panel) { if (panel$method == "manual") panel$h <- panel$h.manual panel$opt$se <- panel$se if (panel$se & panel$model == "normal") panel$opt$band <- TRUE else panel$opt$band <- FALSE with(panel, { result <- sm.density.1d(x, h, model, weights, rawdata, opt) h.text <- paste(" h =", as.character(signif(h, 3))) title(h.text) }) panel } set.bandwidth.d <- function(panel) { if (panel$method != "manual") { panel$h <- h.select(panel$x, NA, panel$weights, method = panel$method) panel$h <- panel$h[1] } if (is.matrix(panel$x)) ndim <- ncol(panel$x) else ndim <- 1 if (panel$opt$panel.plot) { if (ndim == 1) rpanel::rp.do(panel, replot.density1) else if (ndim == 2) rpanel::rp.do(panel, replot.density2) else rpanel::rp.do(panel, replot.density3) } else { if (ndim == 1) rpanel::rp.do(panel, plot.density1) else if (ndim == 2) rpanel::rp.do(panel, plot.density2) else rpanel::rp.do(panel, plot.density3) } panel } replot.density1 <- function(panel) { rpanel::rp.tkrreplot(panel, plot) panel } rp.density1 <- function(x, h, model, weights, rawdata, opt) { opt <- sm.options(opt) replace.na(opt, display, "lines") replace.na(opt, se, FALSE) replace.na(opt, panel.plot, TRUE) opt$verbose <- 0 if (opt$panel.plot & !requireNamespace("tkrplot", quietly = TRUE)) opt$panel <- FALSE smooth.panel <- rpanel::rp.control("Density estimation - 1 variable", x = x, h = h, model = model, weights = weights, rawdata = rawdata, opt = opt, h.manual = h, method = "manual", se = opt$se) if (opt$panel.plot) { rpanel::rp.tkrplot(smooth.panel, plot, plot.density1, pos = "right", hscale = opt$hscale, vscale = opt$vscale) plotfun <- replot.density1 } else plotfun <- plot.density1 rpanel::rp.radiogroup(smooth.panel, method, c("normal", "sj", "cv", "manual"), title = "Choice of bandwidth", action = set.bandwidth.d) rpanel::rp.slider(smooth.panel, h.manual, h / 10, h * 10, plotfun, "h", log = TRUE) rpanel::rp.checkbox(smooth.panel, se, plotfun, title = "Standard errors") rpanel::rp.radiogroup(smooth.panel, model, c("none", "normal"), title = "Reference model", action = plotfun) rpanel::rp.do(smooth.panel, plotfun) invisible(smooth.panel) } plot.density2 <- function(panel) { if (panel$method != panel$method.old) { if (panel$method != "manual") { panel$h <- h.select(panel$x, NA, panel$weights, method = panel$method) panel$h <- panel$h[1] } panel$method.old <- panel$method } if (panel$method == "manual") panel$h <- panel$h.manual if (panel$structure.2d == "common") h2 <- rep(panel$h, 2) else h2 <- c(panel$h, panel$h * sqrt(wvar(panel$x[,2], panel$weights) / wvar(panel$x[,1], panel$weights))) panel$opt$display <- panel$display if (panel$display == "image") { opt1 <- panel$opt opt1$display <- "slice" opt1$add <- TRUE } if (panel$display != "rgl") panel$surf.ids <- rep(NA, 2) panel$opt$theta <- panel$theta panel$opt$phi <- panel$phi panel$opt$se <- panel$se panel$opt$test <- panel$test if (panel$model == "none") panel$opt$test <- FALSE if (panel$display == "rgl") { if (panel$display.old == "rgl") panel$opt$add <- TRUE else panel$opt$add <- FALSE } result <- sm.density.2d(panel$x, h2, panel$weights, panel$rawdata, panel$opt) if (panel$display == "rgl") { if (!is.na(sum(panel$surf.ids))) rgl::rgl.pop(id = panel$surf.ids) panel$surf.ids <- result$surf.ids } if (panel$display == "rgl" & !panel$opt$add) panel$opt$scaling <- result$scaling with(panel, { if (display == "image") sm.density.2d(x, h2, weights, rawdata, opt1) if (!(display == "rgl")) { h.text <- paste(" h = (", as.character(signif(h2[1], 3)),",", as.character(signif(h2[2], 3)), ")") title(h.text) } }) panel$display.old <- panel$display panel } replot.density2 <- function(panel) { rpanel::rp.tkrreplot(panel, smplot) panel } rp.density2 <- function(x, h, model, weights, rawdata, opt) { opt <- sm.options(opt) replace.na(opt, se, FALSE) replace.na(opt, test, FALSE) if (is.na(opt$display)) display.set <- FALSE else display.set <- TRUE replace.na(opt, display, "persp") if (!display.set | (display.set & opt$display == "rgl")) opt$panel.plot <- FALSE else replace.na(opt, panel.plot, TRUE) opt$verbose <- 0 if (opt$panel.plot & !requireNamespace("tkrplot", quietly = TRUE)) opt$panel <- FALSE smooth.panel <- rpanel::rp.control("Density estimation - 2 variables", x = x, h = h[1], structure.2d = opt$structure.2d, model = model, weights = weights, rawdata = rawdata, opt = opt, h.manual = h[1], display = opt$display, display.old = "none", theta = opt$theta, phi = opt$phi, surf.ids = rep(NA, 2), method = "manual", method.old = "manual", se = opt$se, test = opt$test) if (opt$panel.plot) { rpanel::rp.tkrplot(smooth.panel, smplot, plot.density2, pos = "right", hscale = opt$hscale, vscale = opt$vscale) plotfun <- replot.density2 } else plotfun <- plot.density2 rpanel::rp.radiogroup(smooth.panel, method, c("normal", "cv", "manual"), title = "Choice of bandwidth", action = plotfun) rpanel::rp.slider(smooth.panel, h.manual, h[1] / 10, h[1] * 10, plotfun, "h", log = TRUE) # rpanel::rp.checkbox(smooth.panel, se, plotfun, title = "Standard errors") # rpanel::rp.radiogroup(smooth.panel, model, c("none", "normal"), # title = "Reference model", action = plotfun) if (!display.set) { display.options <- c("persp", "image") if (requireNamespace("rgl", quietly = TRUE)) display.options <- c(display.options, "rgl") rpanel::rp.radiogroup(smooth.panel, display, display.options, title = "Display", action = plotfun) } if (opt$display == "persp") { rpanel::rp.slider(smooth.panel, theta, -180, 180, plotfun, "persp angle 1") rpanel::rp.slider(smooth.panel, phi, 0, 90, plotfun, "persp angle 2") } invisible(smooth.panel) } plot.density3 <- function(panel) { if (panel$method != panel$method.old) { if (panel$method != "manual") { panel$h <- h.select(panel$x, panel$y, panel$weights, method = panel$method) panel$h <- panel$h[1] } panel$method.old <- panel$method } if (panel$method == "manual") panel$h <- panel$h.manual if (panel$structure.2d == "common") h3 <- rep(panel$h, 3) else h3 <- c(panel$h, panel$h * sqrt(wvar(panel$x[,2], panel$weights) / wvar(panel$x[,1], panel$weights)), panel$h * sqrt(wvar(panel$x[,3], panel$weights) / wvar(panel$x[,1], panel$weights))) panel$opt$display <- panel$display if (panel$display.old == "rgl") panel$opt$add <- TRUE else panel$opt$add <- FALSE result <- sm.density.3d(panel$x, h3, panel$weights, panel$rawdata, panel$opt) if (panel$display == "rgl" & !panel$opt$add) panel$opt$scaling <- result$scaling if (!all(is.na(panel$surf.ids))) rgl::pop3d(id = panel$surf.ids) panel$surf.ids <- result$surf.ids panel$display.old <- panel$display panel } replot.density3 <- function(panel) { rpanel::rp.tkrreplot(panel, smplot) panel } rp.density3 <- function(x, h, model, weights, rawdata, opt) { opt <- sm.options(opt) replace.na(opt, se, FALSE) replace.na(opt, test, FALSE) if (is.na(opt$display)) display.set <- FALSE else display.set <- TRUE replace.na(opt, display, "rgl") opt$panel.plot <- FALSE opt$verbose <- 0 smooth.panel <- rpanel::rp.control("Density estimation - 3 variables", x = x, h = h[1], structure.2d = opt$structure.2d, model = model, weights = weights, rawdata = rawdata, opt = opt, h.manual = h[1], display = opt$display, display.old = "none", theta = opt$theta, phi = opt$phi, surf.ids = NA, method = "manual", method.old = "manual", se = opt$se, test = opt$test) if (opt$panel.plot) { rpanel::rp.tkrplot(smooth.panel, smplot, plot.density2, pos = "right", hscale = opt$hscale, vscale = opt$vscale) plotfun <- replot.density3 } else plotfun <- plot.density3 rpanel::rp.radiogroup(smooth.panel, method, c("normal", "manual"), title = "Choice of bandwidth", action = plotfun) rpanel::rp.slider(smooth.panel, h.manual, h[1] / 3, h[1] * 3, plotfun, "h", log = TRUE) invisible(smooth.panel) } sm/R/zzz.R0000744000176200001440000000400713353154777012073 0ustar liggesusers".sm.Options" <- list(hmult = 1, h.weights = NA, period = NA, add = FALSE, band = NA, props = c(75, 50, 25), nbins = NA, positive = FALSE, delta = NA, display = NA, hscale = 1, vscale = 1, xlab = NA, ylab = NA, zlab = NA, xlim = NA, ylim = NA, zlim = NA, yht = NA, model = "none", reference = "none", panel = FALSE, panel.plot = NA, ngrid = NA, eval.points = NA, rugplot = TRUE, col = NA, col.band = "cyan", col.mesh = "black", col.points = "black", col.palette = topo.colors(12), col.palette.fn = topo.colors, superimpose = NA, se = NA, se.breaks = c(-3, -2, 2, 3), lty = 1, lwd = 1, pch = 1, cex = NA, theta = -30, phi = 40, size = 2, scaling = NULL, alpha = 0.7, alpha.mesh = 1, lit = FALSE, poly.index = 1, diff.ord = 2, test = NA, hull = TRUE, verbose = 1, df = NA, method = NA, structure.2d = "scaled", nboot = 100, describe = TRUE, show.script = TRUE, eval.grid = TRUE, mask.method = "hull", partial.residuals = TRUE, nlevels = 20) .onAttach <- function(library, pkg) { ## we can't do this in .onLoad unlockBinding(".sm.Options", asNamespace("sm")) packageStartupMessage("Package 'sm', version 2.2-5.6: type help(sm) for summary information") invisible() } isMatrix <- function(x) length(dim(x)) == 2 isInteger <- function(x) all(x == round(x)) sm.script <- function(name, path) { if (missing(path)) path <- system.file("scripts", package = "sm") else path <- as.character(substitute(path)) if (missing(name)) { file.show(file.path(path, "index.doc")) } else { name <- as.character(substitute(name)) if(length(name) == 3 && name[1] == "<-") name <- paste(name[2:3], collapse="_") file <- file.path(path, paste(name, ".q", sep = "")) if(sm.options()$show.script) file.show(file, title=name, header=paste('script: ',name)) source(file) } invisible() } sm/R/sphere.r0000744000176200001440000003174713272320163012557 0ustar liggesusers "sm.sphere" <- function (lat, long, kappa = 20, hidden = FALSE, sphim = FALSE, addpoints = FALSE, ...) { opt <- sm.options(list(...)) replace.na(opt, ngrid, 32) ngrid <- opt$ngrid panel <- opt$panel phi <- opt$phi theta <- opt$theta kap <- kappa invis <- plot2d(lat, long, theta, phi) sphdraw(theta, phi) if (!opt$panel) { if (hidden) hidplot(invis, theta, phi) if (sphim) sphimage(lat, long, kap, theta, phi, ngrid) if (sphim & addpoints) addplot(lat, long, theta, phi) } else { items <- c("Set theta and phi", " - increase theta", " - decrease theta", " - increase phi", " - decrease phi", "Add hidden points", "Add density estimate", " - increase s.p.", " - decrease s.p.", " - add data points", "Exit") ind <- menu(items, graphics = TRUE, title = "Sphere") while (items[ind] != "Exit") { if (items[ind] == "Set theta and phi") { a <- change(theta, phi) theta <- a$theta phi <- a$phi invis <- plot2d(lat, long, theta, phi) sphdraw(theta, phi) } else if (items[ind] == " - increase theta") { theta <- inctheta(theta, 30) invis <- plot2d(lat, long, theta, phi) sphdraw(theta, phi) } else if (items[ind] == " - decrease theta") { theta <- inctheta(theta, -30) invis <- plot2d(lat, long, theta, phi) sphdraw(theta, phi) } else if (items[ind] == " - increase phi") { phi <- incphi(phi, 30) invis <- plot2d(lat, long, theta, phi) sphdraw(theta, phi) } else if (items[ind] == " - decrease phi") { phi <- incphi(phi, -30) invis <- plot2d(lat, long, theta, phi) sphdraw(theta, phi) } else if (items[ind] == "Add hidden points") { hidplot(invis, theta, phi) } else if (items[ind] == "Add density estimate") { sphimage(lat, long, kap, theta, phi, ngrid) } else if (items[ind] == " - increase s.p.") { kap <- kap * 2 sphimage(lat, long, kap, theta, phi, ngrid) } else if (items[ind] == " - decrease s.p.") { kap <- kap/2 sphimage(lat, long, kap, theta, phi, ngrid) } else if (items[ind] == " - add data points") { par(pch = "*") addplot(lat, long, theta, phi) } else if (items[ind] == "Add 2nd data set") { par(pch = "x") addplot(lat2, long2, theta, phi) } ind <- menu(items, graphics = TRUE, title = "Sphere") } } par(pty = "m") invisible(list(theta = theta, phi = phi, kappa = kap)) } "sphdraw" <- function (theta, phi) { a1 <- 0 a2 <- 30 a3 <- 60 a4 <- 90 a5 <- 120 a6 <- 150 b1 <- (-90) b2 <- (-60) b3 <- (-30) b4 <- 0 b5 <- 30 b6 <- 60 b7 <- 90 latlines(b1, theta, phi) latlines(b2, theta, phi) latlines(b3, theta, phi) latlines.e(b4, theta, phi) latlines(b5, theta, phi) latlines(b6, theta, phi) latlines(b7, theta, phi) longlines.e(a1, theta, phi) longlines(a2, theta, phi) longlines(a3, theta, phi) longlines(a4, theta, phi) longlines(a5, theta, phi) longlines(a6, theta, phi) circle(1) } "sphimage" <- function (latitude, longitude, kap, theta, phi, ngrid = 32) { values <- seq(-1 + 1/ngrid, 1 - 1/ngrid, length = ngrid) xgrid <- rep(values, rep(ngrid, ngrid)) ygrid <- rep(values, ngrid) dvec <- rep(0, ngrid^2) xlong <- longitude * pi/180 xlat <- latitude * pi/180 n <- length(longitude) radtheta <- theta * pi/180 radphi <- phi * pi/180 xgrid[xgrid^2 + ygrid^2 >= 1] <- NA ygrid[xgrid^2 + ygrid^2 >= 1] <- NA za <- -xgrid * sin(radtheta) - ygrid * cos(radtheta) * sin(radphi) zb <- cos(radphi) * cos(radtheta) * sqrt(1 - xgrid^2 - ygrid^2) z <- za + zb if ((theta == 90) | (theta == 270)) x <- -ygrid * sin(radtheta) * sin(radphi) + cos(radphi) * sqrt(1 - ygrid^2 - z^2) else x <- (xgrid + z * sin(radtheta))/cos(radtheta) if (phi == 90) y <- sqrt(1 - x^2 - z^2) else if (phi == -90) y <- -sqrt(1 - x^2 - z^2) else y <- (ygrid + (x * sin(radtheta) + z * cos(radtheta)) * sin(radphi))/cos(radphi) xyzok <- (((x/sqrt(x^2 + z^2)) * (sqrt(1 - y^2)) * sin(radtheta) * cos(radphi)) + (y * sin(radphi)) - ((-z/sqrt(x^2 + z^2)) * (sqrt(1 - y^2)) * cos(radphi) * cos(radtheta))) other <- !is.na(xyzok) & xyzok < 0 z[other] <- (za - zb)[other] x[other] <- ((xgrid + (z * sin(radtheta)))/cos(radtheta))[other] y[other] <- ((ygrid + ((x * sin(radtheta)) + (z * cos(radtheta))) * sin(radphi))/cos(radphi))[other] xj <- cos(xlong) * cos(xlat) yj <- sin(xlat) zj <- -sin(xlong) * cos(xlat) dvec <- exp(kap * cbind(x, y, z) %*% rbind(xj, yj, zj)) %*% rep(1/n, n) dvec[is.na(xgrid)] <- 0 dvec <- dvec/max(dvec) fmat <- matrix(dvec, ngrid, ngrid, byrow = TRUE) x <- seq(-1 + 1/ngrid, 1 - 1/ngrid, length = ngrid) y <- x image(x, y, fmat, add = TRUE) angle <- seq(0, pi/2, length = 50) xx <- cos(angle) yy <- sin(angle) polygon(c(xx, 0, 1, 1), c(yy, 1, 1, 0), col = "white", border = "white") angle <- seq(pi/2, pi, length = 50) xx <- cos(angle) yy <- sin(angle) polygon(c(xx, -1, -1, 0), c(yy, 0, 1, 1), col = "white", border = "white") angle <- seq(pi, 3 * pi/2, length = 50) xx <- cos(angle) yy <- sin(angle) polygon(c(xx, 0, -1, -1), c(yy, -1, -1, 0), col = "white", border = "white") angle <- seq(3 * pi/2, 2 * pi, length = 50) xx <- cos(angle) yy <- sin(angle) polygon(c(xx, 1, 1, 0), c(yy, 0, -1, -1), col = "white", border = "white") sphdraw(theta, phi) } "addplot" <- function (d, f, theta, phi) { a <- (f * pi)/180 b <- (d * pi)/180 radtheta <- (theta * pi)/180 radphi <- (phi * pi)/180 xyzcheck <- ((cos(a) * cos(b) * sin(radtheta) * cos(radphi)) + (sin(b) * sin(radphi)) - (sin(a) * cos(b) * cos(radphi) * cos(radtheta))) llong <- a[xyzcheck >= 0] llat <- b[xyzcheck >= 0] if (length(llat) == 0) { return() } X <- (cos(llong) * cos(llat) * cos(radtheta)) + (sin(llong) * cos(llat) * sin(radtheta)) Y <- (sin(llat) * cos(radphi)) + ((cos(llat) * sin(radphi)) * ((sin(llong) * cos(radtheta)) - (cos(llong) * sin(radtheta)))) par(pty = "s") points(X, Y) } "change" <- function (th, ph) { cat("Theta =", th, "\n") cat("Phi =", ph, "\n") scan(n = 1) cat("Change theta to ? \n") theta <- scan(n = 1) if (theta >= 360) theta <- theta - 360 cat("\n", "Change phi to ? \n") phi <- scan(n = 1) if (phi > 90) phi <- 90 if (phi < -90) phi <- -90 cat("Theta =", theta, "\n") cat("Phi =", phi, "\n") list(theta = theta, phi = phi) } "circle" <- function (r) { angle <- seq(0, 7, by = 0.1) x <- r * cos(angle) y <- r * sin(angle) par(lty = 1) lines(x, y) } "hidplot" <- function (invis, theta, phi) { invislong <- invis$invislong invislat <- invis$invislat par(pch = "O") a <- (invislong * pi)/180 b <- (invislat * pi)/180 radtheta <- (theta * pi)/180 radphi <- (phi * pi)/180 if (length(invislat) == 0) { points(0, 0, type = "n") return() } X <- (cos(invislong) * cos(invislat) * cos(radtheta)) + (sin(invislong) * cos(invislat) * sin(radtheta)) Y <- (sin(invislat) * cos(radphi)) + ((cos(invislat) * sin(radphi)) * ((sin(invislong) * cos(radtheta)) - (cos(invislong) * sin(radtheta)))) points(X, Y) } "incphi" <- function (ph, inc) { phi <- ph + inc if (phi > 90) phi <- 90 if (phi < -90) phi <- -90 cat("Phi =", phi, "\n") phi } "inctheta" <- function (th, inc) { theta <- th + inc if (theta >= 360) theta <- theta - 360 theta } "latlines" <- function (beta, theta, phi) { if (beta < (phi - 90) | beta > (phi + 90)) return() par(pch = ".") radtheta <- (theta * pi)/180 radbeta <- (beta * pi)/180 radphi <- (phi * pi)/180 alpha <- seq(0, (2 * pi), by = 0.05) xyzcheck <- ((cos(alpha) * cos(radbeta) * sin(radtheta) * cos(radphi)) + (sin(radbeta) * sin(radphi)) - (sin(alpha) * cos(radbeta) * cos(radphi) * cos(radtheta))) alphaplot <- alpha[xyzcheck >= 0] X <- (cos(alphaplot) * cos(radbeta) * cos(radtheta)) + (sin(alphaplot) * cos(radbeta) * sin(radtheta)) Y <- (sin(radbeta) * cos(radphi)) + (((sin(alphaplot) * cos(radtheta)) - (cos(alphaplot) * sin(radtheta))) * cos(radbeta) * sin(radphi)) points(X, Y) } "latlines.e" <- function (beta, theta, phi) { if (beta < (phi - 90) | beta > (phi + 90)) return() par(lty = 2) par(pch = ".") radtheta <- (theta * pi)/180 radbeta <- (beta * pi)/180 radphi <- (phi * pi)/180 alpha <- seq(0, (2 * pi), by = 0.005) xyzcheck <- ((cos(alpha) * cos(radbeta) * sin(radtheta) * cos(radphi)) + (sin(radbeta) * sin(radphi)) - (sin(alpha) * cos(radbeta) * cos(radphi) * cos(radtheta))) alphaplot <- alpha[xyzcheck >= 0] X <- (cos(alphaplot) * cos(radbeta) * cos(radtheta)) + (sin(alphaplot) * cos(radbeta) * sin(radtheta)) Y <- (sin(radbeta) * cos(radphi)) + (((sin(alphaplot) * cos(radtheta)) - (cos(alphaplot) * sin(radtheta))) * cos(radbeta) * sin(radphi)) points(X, Y) } "longlines" <- function (alpha, theta, phi) { par(pch = ".") radtheta <- (theta * pi)/180 radalpha <- (alpha * pi)/180 radphi <- (phi * pi)/180 beta <- seq(0, (2 * pi), by = 0.05) xyzcheck <- ((cos(radalpha) * cos(beta) * sin(radtheta) * cos(radphi)) + (sin(beta) * sin(radphi)) - (sin(radalpha) * cos(beta) * cos(radphi) * cos(radtheta))) betaplot <- beta[xyzcheck >= 0] X <- (cos(radalpha) * cos(betaplot) * cos(radtheta)) + (sin(radalpha) * cos(betaplot) * sin(radtheta)) Y <- (sin(betaplot) * cos(radphi)) + (((sin(radalpha) * cos(radtheta)) - (cos(radalpha) * sin(radtheta))) * cos(betaplot) * sin(radphi)) points(X, Y) } "longlines.e" <- function (alpha, theta, phi) { par(lty = 2) par(pch = ".") radtheta <- (theta * pi)/180 radalpha <- (alpha * pi)/180 radphi <- (phi * pi)/180 beta <- seq(0, (2 * pi), by = 0.005) xyzcheck <- ((cos(radalpha) * cos(beta) * sin(radtheta) * cos(radphi)) + (sin(beta) * sin(radphi)) - (sin(radalpha) * cos(beta) * cos(radphi) * cos(radtheta))) betaplot <- beta[xyzcheck >= 0] X <- (cos(radalpha) * cos(betaplot) * cos(radtheta)) + (sin(radalpha) * cos(betaplot) * sin(radtheta)) Y <- (sin(betaplot) * cos(radphi)) + (((sin(radalpha) * cos(radtheta)) - (cos(radalpha) * sin(radtheta))) * cos(betaplot) * sin(radphi)) points(X, Y) } "plot2" <- function (latitude2, longitude2, theta, phi) { par(pch = "x") a <- (longitude2 * pi)/180 b <- (latitude2 * pi)/180 radtheta <- (theta * pi)/180 radphi <- (phi * pi)/180 xyzcheck <- ((cos(a) * cos(b) * sin(radtheta) * cos(radphi)) + (sin(b) * sin(radphi)) - (sin(a) * cos(b) * cos(radphi) * cos(radtheta))) long2 <- a[xyzcheck >= 0] lat2 <- b[xyzcheck >= 0] if (length(lat2) == 0) { points(0, 0, type = "n") text(0.6, -1.2, labels = "Data set:") return() } X <- (cos(long2) * cos(lat2) * cos(radtheta)) + (sin(long2) * cos(lat2) * sin(radtheta)) Y <- (sin(lat2) * cos(radphi)) + ((cos(lat2) * sin(radphi)) * ((sin(long2) * cos(radtheta)) - (cos(long2) * sin(radtheta)))) points(X, Y) } "plot2d" <- function (d, f, theta, phi) { par(pch = "*") a <- (f * pi)/180 b <- (d * pi)/180 radtheta <- (theta * pi)/180 radphi <- (phi * pi)/180 xyzcheck <- ((cos(a) * cos(b) * sin(radtheta) * cos(radphi)) + (sin(b) * sin(radphi)) - (sin(a) * cos(b) * cos(radphi) * cos(radtheta))) llong <- a[xyzcheck >= 0] llat <- b[xyzcheck >= 0] invislong <- a[xyzcheck < 0] invislat <- b[xyzcheck < 0] if (length(llat) == 0) { par(pty = "s") plot(0, 0, type = "n", axes = FALSE, xlab = "", ylab = "", xlim = c(-1, 1), ylim = c(-1, 1)) list(invislong = invislong, invislat = invislat) return() } X <- (cos(llong) * cos(llat) * cos(radtheta)) + (sin(llong) * cos(llat) * sin(radtheta)) Y <- (sin(llat) * cos(radphi)) + ((cos(llat) * sin(radphi)) * ((sin(llong) * cos(radtheta)) - (cos(llong) * sin(radtheta)))) par(pty = "s") plot(X, Y, axes = FALSE, xlab = "", ylab = "", xlim = c(-1, 1), ylim = c(-1, 1)) list(invislong = invislong, invislat = invislat) } sm/R/discontinuity.r0000744000176200001440000003333112266061256014174 0ustar liggesusers sm.discontinuity <- function(x, y, h, hd, ...) { # A test for the presence of one or more discontinuities x.name <- deparse(substitute(x)) if (isMatrix(x)) x.names <- dimnames(x)[[2]] y.name <- deparse(substitute(y)) opt <- sm.options(list(...)) data <- sm.check.data(x = x, y = y, ...) x <- data$x y <- data$y n <- data$nobs ndim <- data$ndim opt <- data$options if (ndim > 2) x <- x[, 1:2] replace.na(opt, display, "lines") replace.na(opt, se, TRUE) replace.na(opt, band, TRUE) replace.na(opt, test, TRUE) replace.na(opt, col, "black") replace.na(opt, df, 5) if (ndim == 1) { replace.na(opt, ngrid, 100) replace.na(opt, xlab, x.name) replace.na(opt, ylab, y.name) replace.na(opt, xlim, range(x)) replace.na(opt, ylim, range(y)) if (length(opt$lty) == 1) opt$lty <- c(opt$lty, opt$lty + 1) } else { replace.na(opt, ngrid, 21) dimn <- x.names name.comp<-if(!is.null(dimn) & !all(dimn == "")) dimn else {if (!is.null(attributes(x)$names)) attributes(x)$names else outer(x.name, c("[1]", "[2]"), paste, sep = "")} replace.na(opt, xlab, name.comp[1]) replace.na(opt, ylab, name.comp[2]) replace.na(opt, xlim, range(x[, 1])) replace.na(opt, ylim, range(x[, 2])) } if(missing(h)) h <- h.select(x, y, ...) doublesmooth <- TRUE if (missing(hd)) { if (ndim == 1) { hd <- h * sqrt(0.25) h <- h * sqrt(0.75) } else { hd <- h * sqrt(0.5) h <- h * sqrt(0.5) } } else if (all(hd == rep(0, ndim))) doublesmooth <- FALSE if (ndim == 1) result <- sm.discontinuity.1d(x, y, h, hd, doublesmooth, opt) else result <- sm.discontinuity.2d(x, y, h, hd, doublesmooth, opt) result$h <- h if (doublesmooth) result$hd <- hd invisible(result) } sm.discontinuity.1d <- function(x, y, h, hd, doublesmooth, opt) { y <- y[order(x)] x <- sort(x) n <- length(x) # Define z to be the mid-points of distinct x values. # Restrict z so that there are at least 5 observations, # over more than one design point, on each size of # every value. z <- x[c(1, diff(x)) > 0] nz <- length(z) z <- (z[1:(nz-1)] + z[2:nz]) / 2 nz <- length(z) flag <- rep(T, nz) for (i in 1:nz) { left <- x[x < z[i]] right <- x[x > z[i]] flag[i] <- (length(left) > 5 & length(right) > 5 & length(diff(left)[diff(left) > 0]) > 1 & length(diff(right)[diff(right) > 0]) > 1) } z <- z[flag] nz <- length(z) ghat.left <- vector("numeric", length = nz) ghat.right <- vector("numeric", length = nz) wd <- matrix(rep(z, rep(n, nz)), ncol = n, byrow = T) wd <- wd - matrix(rep(x, nz), ncol = n, byrow = T) w <- exp(-.5 * (wd / h)^2) wl <- w * (sign(wd) + 1) / 2 s0 <- wl %*% rep(1, n) s1 <- (wl * wd) %*% rep(1, n) s2 <- (wl * wd^2 ) %*% rep(1, n) wl <- wl * (matrix(rep(s2, n), ncol = n) - wd * matrix(rep(s1, n), ncol = n)) wl <- wl / (matrix(rep(s2, n), ncol = n) * matrix(rep(s0, n), ncol = n) - matrix(rep(s1, n), ncol = n)^2) ghat.left <- wl %*% y wr <- w * (1 - sign(wd)) / 2 s0 <- wr %*% rep(1, n) s1 <- (wr * wd) %*% rep(1, n) s2 <- (wr * wd^2 ) %*% rep(1, n) wr <- wr * (matrix(rep(s2, n), ncol = n) - wd * matrix(rep(s1, n), ncol = n)) wr <- wr / (matrix(rep(s2, n), ncol = n) * matrix(rep(s0, n), ncol = n) - matrix(rep(s1, n), ncol = n)^2) ghat.right <- wr %*% y A <- sm.sigweight(x, rep(1, length(x))) / (n - 2) w <- wl - wr if (doublesmooth) { ws <- sm.weight(z, z, hd) w <- ws %*% w ghat.left <- as.vector(ws %*% as.vector(ghat.left)) ghat.right <- as.vector(ws %*% as.vector(ghat.right)) } shat <- sqrt(as.vector(t(as.matrix(y)) %*% A %*% as.matrix(y))) s.e. <- as.vector(shat * sqrt((w^2) %*% rep(1, n))) ts <- sum(((ghat.left - ghat.right) / s.e.) ^2 ) A <- t(w) %*% diag((shat / s.e.)^2) %*% w - A * ts p <- p.quad.moment(A, diag(n), 0, 0) if (opt$display != "none") { if (!opt$add) plot(x, y, xlab = opt$xlab, ylab = opt$ylab, xlim = opt$xlim, ylim = opt$ylim, type = "n") av <- (ghat.left + ghat.right) / 2 if (opt$band & opt$se) polygon(c(z, rev(z)), c(av + s.e., rev(av - s.e.)), col = opt$col.band, border = FALSE) lines(z, ghat.left, lty = opt$lty[1]) lines(z, ghat.right, lty = opt$lty[2]) points(x, y, col = opt$col.points, pch = opt$pch) } if (opt$verbose > 0) cat("Test of continuity: significance = ", round(p, 3), "\n") st.diff <- (ghat.left - ghat.right)/ s.e. diffmat <- cbind(z, round(st.diff, 2))[abs(st.diff) > 2.5,] # The following line forces a matrix when there is only one row in diffmat. if (!is.matrix(diffmat)) diffmat <- matrix(diffmat, ncol = 2) if ((opt$verbose > 0) & (nrow(diffmat) > 0)) { cat("location st.diff\n") for (i in 1:nrow(diffmat)) cat(diffmat[i, ], "\n") } invisible(list(p = p, sigma = shat, eval.points = z, st.diff = st.diff, diffmat = diffmat)) } sm.discontinuity.2d <- function(x, y, h, hd, doublesmooth, opt, nangles = 4, trim = 1/6, hull = FALSE) { # Discontinuity detection with two covariates n <- nrow(x) del1 <- diff(range(x[,1])) * trim del2 <- diff(range(x[,2])) * trim x1grid <- seq(min(x[,1]) + del1, max(x[,1]) - del1, length = opt$ngrid) x2grid <- seq(min(x[,2]) + del2, max(x[,2]) - del2, length = opt$ngrid) ev.points <- cbind(x1grid, x2grid) replace.na(opt, eval.points, ev.points) eval.points <- opt$eval.points ngrid <- nrow(eval.points) weights <- rep(1, n) wd1 <- matrix(rep(eval.points[, 1], n), ncol = n) wd1 <- wd1 - matrix(rep(x[, 1], ngrid), ncol = n, byrow = TRUE) wd2 <- matrix(rep(eval.points[, 2], n), ncol = n) wd2 <- wd2 - matrix(rep(x[, 2], ngrid), ncol = n, byrow = TRUE) w1 <- exp(-0.5 * (wd1 / h[1])^2) w1 <- w1 * matrix(rep(weights, ngrid), ncol = n, byrow = TRUE) w2 <- exp(-0.5 * (wd2 / h[2])^2) wy <- matrix(rep(y, ngrid), ncol = n, byrow=TRUE) a11 <- w1 %*% t(w2) a12 <- (w1 * wd1) %*% t(w2) a13 <- w1 %*% t(w2 * wd2) a22 <- (w1 * wd1^2) %*% t(w2) a23 <- (w1 * wd1) %*% t(w2 * wd2) a33 <- w1 %*% t(w2 * wd2^2) c1 <- w1 %*% t(w2 * wy) c2 <- (w1 * wd1) %*% t(w2 * wy) c3 <- w1 %*% t(w2 * wy * wd2) beta1 <- sm.regression.invert(a22,a12,a23,a11,a13,a33,c2,c1,c3) beta2 <- sm.regression.invert(a33,a23,a13,a22,a12,a11,c3,c2,c1) wmask <- matrix(1, nrow = ngrid, ncol = ngrid) if (hull) { hull.points <- x[order(x[,1], x[,2]),] dh <- diff(hull.points) hull.points <- hull.points[c(TRUE, !((dh[,1] == 0) & (dh[,2] == 0))),] hull.points <- hull.points[chull(hull.points), ] nh <- nrow(hull.points) gstep <- matrix(rep(eval.points[2, ] - eval.points[1,], nh), ncol = 2, byrow = TRUE) hp.start <- matrix(rep(eval.points[1, ], nh), ncol = 2, byrow = TRUE) hull.points <- hp.start + gstep * round((hull.points - hp.start) / gstep) hull.points <- hull.points[chull(hull.points), ] grid.points <- cbind(rep(eval.points[, 1], ngrid), rep(eval.points[, 2], rep(ngrid, ngrid))) D <- diff(rbind(hull.points, hull.points[1, ])) temp <- D[, 1] D[,1] <- D[, 2] D[,2] <- -temp C <- as.vector((hull.points * D) %*% rep(1, 2)) C <- matrix(rep(C, ngrid^2), nrow = ngrid^2, byrow = TRUE) D <- t(D) wmask <- ((grid.points %*% D) >= C) wmask <- apply(wmask, 1, all) wmask[wmask] <- 1 wmask[!wmask] <- NA wmask <- matrix(wmask, ncol = ngrid) } w1 <- w1[rep(1:ngrid, ngrid), ] w2 <- w2[rep(1:ngrid, each = ngrid), ] ind.select <- function(i, w1, w2, selection) { iset1 <- selection[i, ] iset1 <- iset1[!is.na(iset1)] iset2 <- !selection[i, ] iset2 <- iset2[!is.na(iset2)] (length(iset1) > 4) && (length(iset2) > 4) sum((w1[i, iset1] > exp(-2)) & (w2[i, iset1] > exp(-2)), na.rm = TRUE) > 4 && sum((w1[i, iset2] > exp(-2)) & (w2[i, iset2] > exp(-2)), na.rm = TRUE) > 4 } beta1 <- beta1 * wmask beta2 <- beta2 * wmask var.angle <- atan2(beta2, beta1) + pi / 2 var.angle <- as.vector(var.angle) sig2 <- sm.sigma(x, y) A <- sig2$qmat shat <- sig2$estimate ts <- 0 B <- matrix(0, nrow = n, ncol = n) for (ang in ((1:nangles) * pi / nangles)) { angle <- var.angle angle <- rep(ang, ngrid^2) * angle / angle ev.points <- matrix(0, nrow=ngrid^2, ncol = 2) ev.points[, 1] <- rep(eval.points[, 1], ngrid) ev.points[, 2] <- rep(eval.points[, 2], rep(ngrid, ngrid)) selection <- matrix(rep(cos(angle), n), ncol = n) * (matrix(rep(x[, 2], ngrid^2), ncol = n, byrow = TRUE) - matrix(rep(ev.points[, 2], n), ncol = n)) selection <- selection - matrix(rep(sin(angle), n), ncol = n) * (matrix(rep(x[, 1], ngrid^2), ncol = n, byrow = TRUE) - matrix(rep(ev.points[, 1], n), ncol = n)) selection <- (selection > 0) ind <- sapply(1:nrow(selection), ind.select, w1 = w1, w2 = w2, selection = selection) ev.points <- ev.points[ind, ] selection <- selection[ind, ] selection[selection > 0] <- 1 selection[selection <= 0] <- -1 wl <- sm.discon.weight2(x, ev.points, h, (1 + selection) / 2) wr <- sm.discon.weight2(x, ev.points, h, (1 - selection) / 2) w <- wl - wr if (doublesmooth) w <- sm.weight2(ev.points, ev.points, hd) %*% w dhat <- as.vector(w %*% y) s.e. <- as.vector(shat * sqrt((w^2) %*% rep(1,n))) ts <- ts + sum((dhat / s.e.) ^2 ) B <- B + t(w) %*% diag((shat/s.e.)^2) %*% w } C <- B - A * ts p <- p.quad.moment(C, diag(n), 0, 0) # Calculations for the reference band angle <- var.angle ev.points <- as.matrix(expand.grid(eval.points[, 1], eval.points[, 2])) selection <- matrix(rep(cos(angle), n), ncol = n) * (matrix(rep(x[, 2], ngrid^2), ncol = n, byrow = TRUE) -matrix(rep(ev.points[, 2], n), ncol = n)) selection <- selection - matrix(rep(sin(angle), n), ncol = n) * (matrix(rep(x[, 1], ngrid^2), ncol = n, byrow = TRUE) -matrix(rep(ev.points[, 1], n), ncol = n)) selection <- (selection > 0) ind <- sapply(1:nrow(selection), ind.select, w1 = w1, w2 = w2, selection = selection) ev.points <- ev.points[ind, ] selection <- selection[ind, ] selection[selection > 0] <- 1 selection[selection <= 0] <- -1 wl <- sm.discon.weight2(x, ev.points, h, (1 + selection) / 2) wr <- sm.discon.weight2(x, ev.points, h, (1 - selection) / 2) w <- wl - wr if (doublesmooth) w <- sm.weight2(ev.points, ev.points, hd) %*% w dhat <- as.vector(w %*% y) s.e. <- as.vector(shat * sqrt((w^2) %*% rep(1, n))) std <- rep(NA, ngrid * ngrid) std[ind] <- dhat / s.e. std <- matrix(abs(std), ncol = ngrid) results <- list(p = p, sigma = shat, eval.points = eval.points, st.diff = std, angle = matrix(angle, ncol = ngrid)) if (opt$display != "none") { if (!opt$add) plot(x[, 1], x[, 2], xlab = opt$xlab, ylab = opt$ylab, xlim = opt$xlim, ylim = opt$ylim, pch = opt$pch, col = opt$col.points) mx <- max(std, na.rm = TRUE) if (mx > 2.5) contour(eval.points[, 1], eval.points[, 2], std, levels = seq(2.5, mx, by = 0.5), lty = opt$lty, col = opt$col, add = TRUE) } if (opt$verbose) cat(paste("Test of continuity: significance = ", round(p, 3)), "\n") invisible(results) } #------------------------------------------------------------- sm.regression.invert <- function(a11,a12,a13,a22,a23,a33,c1,c2,c3) { # Creates local linear intercept or slopes with two covariates d <- a22 * a33 - a23^2 b1 <- 1 / (a11 - ((a12*a33 - a13*a23)*a12 + (a13*a22 - a12*a23)*a13)/d) b2 <- (a13*a23 - a12*a33) * b1 / d b3 <- (a12*a23 - a13*a22) * b1 / d est <- b1 * c1 + b2 * c2 + b3 * c3 invisible(est) } #------------------------------------------------------- sm.discon.weight2 <- function(x, eval.points, h, selection, weights = rep(1, nrow(x))) { # Amended version of sm.weight2 which uses different points # at each grid position n <- nrow(x) ne <- nrow(eval.points) wd1 <- matrix(rep(eval.points[,1], rep(n, ne)), ncol = n, byrow = TRUE) wd1 <- wd1 - matrix(rep(x[,1], ne), ncol = n, byrow = TRUE) w <- exp(-.5 * (wd1 / h[1])^2) wd2 <- matrix(rep(eval.points[,2], rep(n, ne)), ncol = n, byrow = TRUE) wd2 <- wd2 - matrix(rep(x[,2], ne), ncol = n, byrow = TRUE) w <- w * exp(-.5 * (wd2 / h[2])^2) w <- w * matrix(rep(weights, ne), ncol = n, byrow = TRUE) w <- w * selection a11 <- w %*% rep(1, n) a12 <- (w * wd1 ) %*% rep(1, n) a13 <- (w * wd2 ) %*% rep(1, n) a22 <- (w * wd1^2 ) %*% rep(1, n) a23 <- (w * wd1 * wd2) %*% rep(1, n) a33 <- (w * wd2^2 ) %*% rep(1, n) d <- a22 * a33 - a23^2 b1 <- 1 / (a11 - ((a12*a33 - a13*a23)*a12 + (a13*a22 - a12*a23)*a13)/d) b2 <- (a13*a23 - a12*a33) * b1 / d b3 <- (a12*a23 - a13*a22) * b1 / d wt <- matrix(rep(b1, n), ncol = n) wt <- wt + matrix(rep(b2, n), ncol = n) * wd1 wt <- wt + matrix(rep(b3, n), ncol = n) * wd2 w <- wt * w invisible(w) } sm/MD50000644000176200001440000003202613353200333011177 0ustar liggesusers8007cdb9490e8bbd674ecb1375fe4310 *ChangeLog 8712fbbc6a2ffb34102c752f11397d39 *DESCRIPTION e3bf56e1fa88815637553f98aebb7d85 *NAMESPACE 0d85843ac88c93837937e68313895635 *R/ancova.r 6d20741dc909a03015b5a88ce3a23082 *R/density.r 59752d6033d4ce39bc12ccd221f0d05f *R/discontinuity.r bd6cf90c8fbbbead5ec16e493ce2188b *R/glm.r d6a4da1114823667624e6967b12141bd *R/hselect.r 47d13ec514fc7c3b62af3da26c331e28 *R/monotonicity.r 021cd32c51e8d6950130b6bd36306da1 *R/pca.r 467f10cc62682cd119a2568954f4c1d0 *R/ps-normal.r 3d3d6b417daa2f5c7b1a1ec9b0912673 *R/regression.r 5f430339b0ab9ff420bc5b973412ad3f *R/rpanel.r 8f5fa4d6453fa0af1f899955c1e3828e *R/sm.r 89f5a57fa2b73a9311181be3ef5fd580 *R/sphere.r f044ed7d790dd89af28c8ef9abf83457 *R/survival.r 620c083e3b62157b1bd0fe1e4b64684b *R/utilities.r 44a24863b13eea14afb3c1f1bdff539d *R/variogram.r 6b353498b9e0bd5c8806fd93c91a360d *R/zzz.R 2adb64c8e856f6367c806993979144ac *data/aircraft.rda ca1386a986a51ab9cb8abb4363fb2673 *data/airpc.rda 5eea8b36e9cd414522e9a6a44b91e920 *data/birth.rda fa3c9cc74a526400149860931256830f *data/bissell.rda c8654bbf391faabebeb4bd42f1da48a8 *data/bonions.rda f092745160461299f40bdf22a9d2517a *data/britpts.rda a711b597c01b8fc0f16e727b0c51da00 *data/citrate.rda cd5afaa15649a88ee31b2cfffebedb97 *data/coalash.rda 56e642fe3f1704f579daf5ded4b47118 *data/dogs.rda 72dbe71a11191af4d4319d07cb90eeb0 *data/follicle.rda 0a4394287ff1a533185d030297544ce2 *data/geys3d.rda 98b422bbac933b73998d775982c594a2 *data/geyser.tab.gz 15de7a46319ec1554e24287173a47cfb *data/lcancer.rda 9936554a9782c5c507917d76fc427d2c *data/mackerel.rda 2b4573cf5a89636bb31400f291ebc507 *data/magrem.rda dda8dccc0c32b9c6952c62d29674baf5 *data/mildew.rda 5905e8e05f3fa4220788d1d4d23aa3a3 *data/mosses.rda e2fefa18a75eb61d141925f90c49b067 *data/muscle.rda 531a3c7b6858fb91d3f15e0cf229ff84 *data/nile.rda c15aa2d4f55f1c45cf1e24c60fe556fd *data/poles.rda 859c50e252c9a393acb1a8186e04a5db *data/radioc.rda 94c35655c50d227fbe871aa99c5b7114 *data/smacker.rda 85f5ce93f1c1a937e617df2ab12f1a69 *data/stanford.rda 2491f375b8f262637ef4ad1f42bbce64 *data/tephra.rda 049cdba20257d6bff4ce375646ce37f6 *data/trawl.rda 1a6178af4e9deadbd2d9f5fa28b61199 *data/trout.rda 7807e25afbb20fef5ceff89726633202 *data/wonions.rda fe3a402bdd4c15c9425c176d8c1507a7 *data/worm.rda 2b2dfc48065b0b94d06eb34f4912d99e *inst/CITATION 18810669f13b87348459e611d31ab760 *inst/COPYING fcb45a6f6bb640defe536940520e44cb *inst/history.txt 7dd9e52ca8850d71091c13cf5eb1f2ab *inst/scripts/air_band.q d0df9787fb96c98ddd80d51147ee971a *inst/scripts/air_boot.q 348cefaaae0c33cc313c9c6f3896ab68 *inst/scripts/air_cont.q c7a19cfaf442545bf00afdf38871c6e5 *inst/scripts/air_dens.q 28337d2677f7b7b49de3f927bcfe3f67 *inst/scripts/air_hcv.q 1349f342cbcf2af9faabe766e74e236a *inst/scripts/air_imag.q 7210855be31a0d462d5fd6e9c8d0ff5e *inst/scripts/air_ind.q 033356ead729a47aef914982a55c6ee0 *inst/scripts/air_inds.q 539d859b129dc603d05739ccbd2515f9 *inst/scripts/air_scat.q 89c16fa5ae2e32cb96fc84dbea70b1f3 *inst/scripts/bin_use.q 3248a5db9f59bb801119e9549d9ee3f1 *inst/scripts/birth1.q 99d85bae71b0db70a8a00c95a6c83910 *inst/scripts/birth2.q 8c6d54967810f8b9866604c4becb2be9 *inst/scripts/bissell1.q e8a331392f0138c0c568627e8bff21e9 *inst/scripts/bissell2.q 0076cc0e61e3d1b06fd159628c2f7c78 *inst/scripts/bissell3.q 43dc65caf724f870d589f416c6573759 *inst/scripts/citrate.q 77edac994c2c42a4e1b6d76e35917de9 *inst/scripts/dogs.q 0b1125dcf1c1437eb7cd796274d5d4c4 *inst/scripts/edfgrad.q 9228c623ddc924760bb05bcf60bea8ed *inst/scripts/follicle.q 507846420fd6b037b9af23de599f0de4 *inst/scripts/geys3d.q 4340c5b13cabafbbcfd387b65f191af9 *inst/scripts/geys_ts.q 4605a49b22f991ca18f4aa8ced7e24df *inst/scripts/index.doc f9442596ceb524450ca86e53c53f83db *inst/scripts/lc_comp.q 64c4f54c71ddb5b446df2a03ba6aa49c *inst/scripts/lc_dens.q 48cc55a839061b2a148e3d6191a8c347 *inst/scripts/lc_rr.q c474370921792bf4970db31f2fb93c75 *inst/scripts/lynx.q 8327cb79fb49b85807202c3e808e6920 *inst/scripts/mackgam.q 7b9abc7ba6a3dd6c699b7ff9c3fb124d *inst/scripts/mackmap.q e853a55aaae9342b4fd144504703b5c0 *inst/scripts/mackplot.q 0e32e5d98e5f8232aad8ce3f23868a7f *inst/scripts/mag_dens.q 1845990ddf585f9971ac3904e4455d79 *inst/scripts/mag_scat.q fa705eaa0c7f833348c490db77553cb1 *inst/scripts/mildew.q bfce43e55bcefacca39bf3f2ab0f6bc7 *inst/scripts/muscle.q 66d7e0884546c4be5708f0c5f04638f2 *inst/scripts/noeff.q 33159158b6de68455455790cb13d2071 *inst/scripts/nyc.q 56f74a2f33cfb23dcda5d20e1ad968a2 *inst/scripts/onionbnd.q 6b0a1ff9985d87899b7fc12dfec07021 *inst/scripts/onionplt.q c8be56a962c462b3f729927f0f661865 *inst/scripts/rc_alter.q 19d5764f52027bf437b81732d3841670 *inst/scripts/rc_boot.q 781462107fb543f9ef1ff84f02451680 *inst/scripts/rc_plot.q 5d5fffa367759fa920649eafbf0009dd *inst/scripts/rc_vband.q f07694b1b37a8440f3c0862780beceb2 *inst/scripts/sin_cv.q 76fa50841448670e9b39c096fea978ea *inst/scripts/sin_prop.q eea58bf98f1bc11589c4945cad3907e8 *inst/scripts/smackgam.q 795fca2c0e0d6de433121d87f51bfa2b *inst/scripts/smackplt.q 4f837461c26924b7e5d472259cb389fc *inst/scripts/sp_alter.q 8d6719db5522bbfcd54d6b0747e38912 *inst/scripts/sp_build.q 1011f99d5924c231ba35706f5a205f6c *inst/scripts/sp_comp.q d979b575cfcfe3a50f41c4d4a048077d *inst/scripts/sp_comp2.q 53b9910edcde8ddbefa305a983dc824d *inst/scripts/sp_hist.q cfb7782d51d39ddcd214eb6d03d8ba58 *inst/scripts/sp_test1.q 3dc79b998b9bce10760ad77749d3c9a9 *inst/scripts/sp_test2.q 57414be927639b576b4b692891f34131 *inst/scripts/speed.q c34da8a488340c48ba0347717f31fdc1 *inst/scripts/speedvar.q 5679ada8228efaac2f125ff7aa4e580c *inst/scripts/stananim.q ab01577872c8458a8c0298e66056ca18 *inst/scripts/stanplot.q 553433c85e1cea34da6995dd9eba93b2 *inst/scripts/te_band.q 0c771a97b60fe7ae06a304c781e7e232 *inst/scripts/te_hcvsj.q 0b1696de039df71b94b59b74583248cf *inst/scripts/te_norm.q b5a9c2152359445bfb5f678883ea2707 *inst/scripts/te_var.q ec05523aad577c847760e0f772efb647 *inst/scripts/trees.q b500d29095580ce605e22acf57e48551 *inst/scripts/trout1.q c0106d95dbe0d272143c13873a451834 *inst/scripts/trout2.q 90b5872cb0ece4ab24e44cb89782f5f3 *inst/scripts/trw_lf.q 147ef1d4b426dfe96662baf3fea1b4cf *inst/scripts/trw_lfsg.q 37db27d01bbda8299336937b91219904 *inst/scripts/trw_nebd.q f9b8875fcb638dcf0a05e86d8bf78dd4 *inst/scripts/trw_nesg.q 14614447cf2ee94b6367d3423ea7b524 *inst/scripts/trwlband.q 4da9e3e06856bb10ba0318b81594e702 *inst/scripts/trwlboot.q 75f644e40dc12e2c14f791f1c318f75b *inst/scripts/trwlcmp2.q b0f6b6754514c90ac81ebbca546719d1 *inst/scripts/trwlcomp.q e71fff503cb29f9a8a2a9944a1922fdc *inst/scripts/trwlgam1.q 6b64a474fc2c3889d481f86e7ff56225 *inst/scripts/trwlgam2.q 0858e50304faae7c12f1a557059eafc0 *inst/scripts/trwlgam3.q 25c908a8bd4f833970df6cf91eae7d70 *inst/scripts/trwlplot.q 8cde8e66d1113552b5274633ee4c8a1a *inst/scripts/wormcomp.q 08bebaede915cadbb17cd69f1345a331 *inst/smdata/aircraft.dat 02152fc37f66bc9dd48f63889590381d *inst/smdata/aircraft.doc 13d239a94bf6da5df4ff54fbe0359dee *inst/smdata/airpc.dat 32327a729da7134d89cf6fbf781710c4 *inst/smdata/airpc.doc 56b06a288299e56cda07ad083d124cd6 *inst/smdata/birth.dat f3f57304cefdbb205779c358d6491325 *inst/smdata/birth.doc d52d7761870605c7bdac468ce9c342fe *inst/smdata/bissell.dat a04a9dc6d507d66d96555d45e61949ba *inst/smdata/bissell.doc 62b2b3def3e24cacdf5ce515645bba57 *inst/smdata/bonions.dat 2bdc0ebf7e0929b857af8005ff818a6b *inst/smdata/bonions.doc ddd1739bd7289c149a7c0114868c9779 *inst/smdata/britpts.dat 12806bc80845733d9c59e498e5e250a9 *inst/smdata/citrate.dat cea78897898eaa070103d32176f9f0d2 *inst/smdata/citrate.doc 3df2bec3813bc536866faf898a450b53 *inst/smdata/coalash.dat 1a9f7fd22f6ec71e1d166208bc726326 *inst/smdata/coalash.doc 6a7b39bde9713fd1494ff13fe0b2bcbd *inst/smdata/dogs.dat 1412890d13bef999c870743a2dae4923 *inst/smdata/dogs.doc 624fd6012f6c179ea9d5b6b4e48c3488 *inst/smdata/follicle.dat e174addc72b5a53c4139a2c2a004afc0 *inst/smdata/follicle.doc 0c56d7ff1b5c3fcbcf6068a6b54deff0 *inst/smdata/geys3d.dat 2be540ca3302f39b4fbb994843b98eea *inst/smdata/geys3d.doc 8296a75f1f3be495ecf0f95f1a577a58 *inst/smdata/lcancer.dat 46b34a4afbc6e59c4f961e0a1b43702a *inst/smdata/lcancer.doc 13feb89d91fd17afec5fa6b22d927ae5 *inst/smdata/mackerel.dat cda93ef88c67a798a2eb212c371aff47 *inst/smdata/mackerel.doc 155324832ce11d23fe0171269bff08bf *inst/smdata/magrem.dat b719c66637d17bf4155a2df90f7cf0dc *inst/smdata/magrem.doc 764a55a4ef5ff3162db1760f4283fcbe *inst/smdata/mildew.dat 955a7446d2ee5481288f610c7e171de3 *inst/smdata/mildew.doc 2aaf67213df554f5484353515ce1e9d4 *inst/smdata/muscle.dat 19ebebbd36a71fec3ac0b527c1bb8602 *inst/smdata/muscle.doc a8bab94814e57ca90797983831b40953 *inst/smdata/nile.dat 1b31fa461a4ab2bc80baa25ff837f7ce *inst/smdata/nile.doc 55758427b97124c2978f23434af030c6 *inst/smdata/phosphat.doc 91d13f41da42c2b52fc9897451d51575 *inst/smdata/poles.dat 1368852e3b9db37b38b757a4990deea6 *inst/smdata/poles.doc c8a8c4bf25d1e90d1e1f63db0575d72b *inst/smdata/propsim.dat fdbdbd987639b162d6bcc77621fc021e *inst/smdata/radioc.dat d2dd7948a071d2a5adda30b332be201f *inst/smdata/radioc.doc 17034371fd36b9afd781d55935446cc6 *inst/smdata/smacker.dat 2feed15792f2df6e509f17849a692c96 *inst/smdata/smacker.doc 556081c233d4dd43266842ec5111cedd *inst/smdata/stanford.dat 388dd8910cd8412dfc1b15b28f2a1bd2 *inst/smdata/stanford.doc 9325124987b6afef93c272ad7f1e97f7 *inst/smdata/tephra.dat d72e99c29c96401b948f7df1e6cbdfb3 *inst/smdata/tephra.doc 18176677f8f4e62f109ce2b1fc3f8528 *inst/smdata/trawl.dat 83d1d71f1451c09a56771e75f352b69d *inst/smdata/trawl.doc 64187062713e0b2f23059c829c7ac2eb *inst/smdata/trees.dat 262b407e1fbe8f3de043fb5b50b48c3e *inst/smdata/trees.doc 80aa37833e17b8394446cf12b84dc521 *inst/smdata/trout.dat c3b19e816596ee16c23c318fb0f98705 *inst/smdata/trout.doc 27d4164fb5cfc700efe69ce52428d856 *inst/smdata/wonions.dat f604338a9c19b9226abef0a36fe4de5c *inst/smdata/wonions.doc ca0a880cdc3ec8a1be3e56bda868067d *inst/smdata/worm.dat 2a7ac54f2df1052e7148230caf077dae *inst/smdata/worm.doc f4fef9d7be4ce33b993a7632730dbd5b *man/aircraft.Rd 8bb4ecd274aec34fc00147ee7cf662e6 *man/airpc.Rd 4eabf0dfef68f32552c1ac39dfd9d202 *man/binning.Rd 5daceaa4d7fbf38fdef3c8c39b743410 *man/birth.Rd 7b1e6832e096ad9f272236b0ff0cfa50 *man/bissell.Rd 7f760eca25c349ab283d76ce280b90c5 *man/bonions.Rd c6c75990c2bd203f22b077bc70bf6999 *man/britpts.Rd f2da31bfcb3421bd2554cbd8074dd5df *man/citrate.Rd 2a1ae78f9f98e1457148bf1524906e2c *man/coalash.Rd 51c13f8316527bc4c5fdd6b434b4e0dd *man/dogs.Rd ca739eb6ca469c79fa32667baa707855 *man/follicle.Rd de6488c1a8893d24851a78429b667e91 *man/geys3d.Rd 90f03a4ade6262599c647db0d96fdb28 *man/geyser.Rd 276bac00330a54dbd8d5524d27397b6e *man/h.select.Rd 7c967a8ae03bca27b01acbcdd94056dd *man/hcv.Rd e98dc3792bbbcd5963edd6e2f2e4f6be *man/hnorm.Rd 23176bcedb90f5f7856a80e4c50d54e7 *man/hsj.Rd 58e0b3baf939d445bba3e173cfc2074d *man/lcancer.Rd 37ccf53cf64b16add1e565627bba654c *man/mackerel.Rd 2daee41d46d6e96c9dc6358438274ec3 *man/magrem.Rd 68c6ca5c1b2e99fbb224655843d7713e *man/mildew.Rd b36979df29cdfb5cb5ccf44e5cb8ead6 *man/mosses.Rd 236594570f93c79fe810987d97e7f62c *man/muscle.Rd b96bf1e3dd2d27350a9e76fea41ba384 *man/nile.Rd a25d44e722b5090b2253a77047e56eef *man/nise.Rd 254ee16a830edb8fa046c39aff409cdf *man/nmise.Rd 9b9135fe2a73a7345e638828c1088ab7 *man/nnbr.Rd e4a8e7ff546c089fc20ac4e873e8cb79 *man/pause.Rd f548a0d6082f28ca3a1a7f875a62fc9c *man/poles.Rd f29af6c7875a9127124fecd2e10f207a *man/provide.data.Rd 413f89facdbac027678a4ba18489ccd0 *man/radioc.Rd 4a4994a4365bc098acefcb9daef8616d *man/sig.trace.Rd 479235458a5a73dd5b9c8e51d8b511d7 *man/sm-internal.Rd 33cf673d4d2891d22dac9a416ebe51ca *man/sm.Rd fceea0a9c201a04e77f8bb3cfa136ed2 *man/sm.ancova.Rd 0884708db3536487363f1353eee584f3 *man/sm.autoregression.Rd 6ebe6595a79c5bb77f612c518e4461a6 *man/sm.binomial.Rd 0697eb7b8e86266b5ad7b34497424660 *man/sm.binomial.bootstrap.Rd 54e29fd661171dd70a6db6904a720391 *man/sm.density.Rd 53625b308cebdac7925cb6a2a4bcb236 *man/sm.density.compare.Rd 027565f80247255fd871dce27c72eebd *man/sm.discontinuity.Rd 250add6d8ea3fc7eee0bd9a65b2a2887 *man/sm.monotonicity.Rd e96213e60a0cc12f688c32b83a8f3bbf *man/sm.options.Rd b1d9170308189bf85465e900fbe902e6 *man/sm.pca.Rd f2312409129da7f30166c914077a9d2b *man/sm.poisson.Rd ee34960956fc6ee42aa3a6424e3a2329 *man/sm.poisson.bootstrap.Rd bf947ff12b81f2ac61d32c1628ae1325 *man/sm.regression.Rd bae9697d0ce71d91680037ec1d518a67 *man/sm.regression.autocor.Rd a7cf745c7cd1d66d372c2a5b9e51739c *man/sm.rm.Rd 0186bfb9ccbb37f33357f8087fd524d8 *man/sm.script.Rd addd459f820b0b0ad4862836c26f1f9a *man/sm.sigma.Rd b3dff66a7f4eed91ffc6d77318084934 *man/sm.sigma2.compare.Rd 9a4f5e1491f10e5adf959ff7874d0481 *man/sm.sphere.Rd 373490e998db0275938347986ac3562c *man/sm.surface3d.Rd d3fcd9d0f8c41c4df35ea713df6d1f7e *man/sm.survival.Rd 1833cb9cf84af92273d3908aeac9ea57 *man/sm.ts.pdf.Rd c64ad9c6a3c17f7cd241df74137556e0 *man/sm.variogram.Rd e5ac1b66b93b409763d75b3184592ce1 *man/smacker.Rd c626c5d4ef6d8ca6637d97bcb05e28fd *man/stanford.Rd 99b9b4003e3ffa74cd30ea3590a058fe *man/tephra.Rd d166a4cdfb4a2bcba62f76a5448860af *man/trawl.Rd e393c1bd3f1e80c58118fe50a5367678 *man/trout.Rd 65756addb168b267ceafb6947b09e79f *man/wonions.Rd 4916c191ca3263b6378ee435546407db *man/worm.Rd 217525f61e9c82de29e25d02cbbeb946 *po/R-sm.pot 39a4fe66c4d5aa85bf33045a531303f0 *src/fgamma.c da637b674a3cd766285736efbcda30e6 *src/init.c 690253986a63ece124a070a8b5b37412 *src/variogram.f90 sm/DESCRIPTION0000744000176200001440000000160013353200333012370 0ustar liggesusersPackage: sm Type: Package Title: Smoothing Methods for Nonparametric Regression and Density Estimation Version: 2.2-5.6 Date: 2018-09-27 Author: Adrian Bowman and Adelchi Azzalini. Ported to R by B. D. Ripley up to version 2.0, version 2.1 by Adrian Bowman and Adelchi Azzalini, version 2.2 by Adrian Bowman. Maintainer: Adrian Bowman Depends: R (>= 3.1.0) Suggests: rgl, misc3d, akima, gam, tkrplot, rpanel (>= 1.1-4), tcltk Description: This is software linked to the book 'Applied Smoothing Techniques for Data Analysis - The Kernel Approach with S-Plus Illustrations' Oxford University Press. License: GPL (>= 2) LazyData: TRUE URL: http://www.stats.gla.ac.uk/~adrian/sm NeedsCompilation: yes Packaged: 2018-09-27 13:26:42 UTC; adrianbowman Repository: CRAN Date/Publication: 2018-09-27 16:10:03 UTC sm/ChangeLog0000744000176200001440000000742013353154667012464 0ustar liggesusersVersion 2.2-5.6 2018-09-27 Minor bug fixes. Version 2.2-5.5 2018-05-06 Minor bug fixes. Version 2.2-5.4 2014-01-16 Addition of sm.pca function. Extension of sm.variogram function. Other minor bug fixes. Version 2.2-5.3 2013-05-11 Addition of lwd parameter to sm.regression. All datasets given their own help files. Minor corrections to help files and sm.options. Version 2.2-4 2010-02-26 sm.ancova returns the boundaries of the reference band. Minor corrections to sm.discontinuity, pause and help files. Version 2.2-3 2008-09-24 Minor corrections to citation(), density estimation in 2d and 3d when rpanel is used and sm.discontinuity. Periodic covariates allowed. Other small bug fixes. Version 2.2-2 2007-10-09 Removal of \non_function from geyser.Rd. Version 2.2-1 2007-09-22 Minor corrections to .onAttach and sm.options. Version 2.2-0 2007-09-12 Version 2.2 released. Version 2.1-0 2005-09-01 Version 2.1 released. Adrian Bowman takes over as maintainer. Version 2.0-14 2005-02-07 Improve messages, support translations Version 2.0-13 2004-11-11 Update sm.density.compare to pre-2.1 after bug report from Deepayan Sarkar. Scripts trwlgam[13] now work. Use "console" pager on Windows. Version 2.0-12 2004-09-04 sphimage used a[ind] <- b[ind] with NAs in ind. Added NAMESPACE. No longer use .sm.home, but system.file. Use package gam in scripts: trwlgam2 mackgam smackgam now work. Version 2.0-11 2004-08-04 One .Rd error, data -> smdata, remake INDEX Version 2.0-10 2004-07-29 Remove references to packages modreg and sm. Make provide_data more careful about where (as 'trees' duplicates a base dataset). Version 2.0-9 2003-12-18 Set seed for running scripts. Version 2.0-8 2003-09-12 Avoid 'nlevels' as var name. Version 2.0-7 2003-07-18 Documentation improvements. Version 2.0-6 2003-06-03 Avoid generating lty=NA, use PACKAGE=. 2.0-5 was unreleased. Version 2.0-4 2001/10/10 tree.q did not work in R, minor improvements to documentation. Version 2.0-3 2001/08/08 QA changes, e.g. T -> TRUE in scripts. Version 2.0-2 2001/06/12 Many help-file improvements. Version 2.0-1 2000/12/08 Version 2 of sm, sm.rm(optimize=TRUE) works. Version 1.0-3 1999/08/15 Moved .sm.home to package:sm, made ts examples work. Version 1.0-2 1999/04/02 Modified for 0.64, using R's chull, jitter, inst/* mechanism, data/00Index, file.* functions. Version 1.0-1 1999/02/20: I renamed plot.density (which causes a name clash, and is not a plot method) to smplot.density. All the example scripts work except those depending on gam: trwlgam1 trwlgam2 mackgam trwlgam3 smackgam (and the gam in mgcv does not work with these). R discrepancies: =============== is.matrix is false for data frames: I used isMatrix in zzz.R instead. Colours are (mainly) named in the R version. In polygon() border gives the colour, not a logical for plotting. points() does not use the current cex and pch in R. Labels formed by deparse(substitute(x)) need to evaluated before x is altered. persp() has fewer arguments, and the default viewpoint did not seem a good choice for these plots, so I altered it. glm.fit() has different arguments, and the X matrix must have column names. Further, weight-0 points do not get the linear predictor set. is.na(x) fails in R if x is NULL. Some functions used `break' where `return()' was meant: this does not work in R. The uses of unix() and assign() needed revising. detach() named objects seemed to fail, so I used pos= instead. BDR 99/02/20 sm/man/0000755000176200001440000000000013353155222011445 5ustar liggesuserssm/man/sm.sigma.Rd0000744000176200001440000000552012266061252013456 0ustar liggesusers\name{sm.sigma} \alias{sm.sigma} \title{Estimation of the error standard deviation in nonparametric regression.} \description{This function estimates the error standard deviation in nonparametric regression with one or two covariates.} \usage{sm.sigma(x, y, rawdata = NA, weights = rep(1, length(y)), diff.ord = 2, ci = FALSE, model = "none", h = NA, \dots) } \arguments{ \item{x}{a vector or two-column matrix of covariate values.} \item{y}{a vector of responses.} \item{rawdata}{a list containing the output from a binning operation. This argument is used by \code{sm.regression} and it need not be set for direct calls of the function.} \item{weights}{a list of frequencies associated with binned data. This argument is used by \code{sm.regression} and it need not be set for direct calls of the function.} \item{diff.ord}{an integer value which determines first (1) or second (2) differencing in the estimation of sigma.} \item{ci}{a logical value which controls whether a confidence interval is produced.} \item{model}{a character variable. If this is set to \code{"constant"} then a test of constant variance over the covariates is performed (only in the case of two covariates)} \item{h}{a vector of length two defining a smoothing parameter to be used in the test of constant variance.} \item{\dots}{other optional parameters are passed to the \code{sm.options} function, through a mechanism which limits their effect only to this call of the function; the only one relevant for this function is \code{nbins}.} } \value{a list containing the estimate and, in the two covariate case, a matrix which can be used by the function \code{sm.sigma2.compare}, pseudo-residuals and, if appropriate, a confidence interval and a p-value for the test of constant variance.} \section{Side Effects}{none.} \details{see the reference below.} \references{Bock, M., Bowman, A.W.\ \& Ismail, B. (2007). Estimation and inference for error variance in bivariate nonparametric regression. \emph{Statistics \& Computing}, to appear.} \seealso{\code{\link{sm.sigma2.compare}}} \examples{ \dontrun{ with(airquality, { x <- cbind(Wind, Temp) y <- Ozone^(1/3) group <- (Solar.R < 200) sig1 <- sm.sigma(x[ group, ], y[ group], ci = TRUE) sig2 <- sm.sigma(x[!group, ], y[!group], ci = TRUE) print(c(sig1$estimate, sig1$ci)) print(c(sig2$estimate, sig2$ci)) print(sm.sigma(x[ group, ], y[ group], model = "constant", h = c(3, 5))$p) print(sm.sigma(x[!group, ], y[!group], model = "constant", h = c(3, 5))$p) print(sm.sigma2.compare(x[group, ], y[group], x[!group, ], y[!group])) }) }} \keyword{nonparametric} \keyword{smooth} sm/man/sm.poisson.bootstrap.Rd0000744000176200001440000000435312266061251016066 0ustar liggesusers\name{sm.poisson.bootstrap} \alias{sm.poisson.bootstrap} \title{ Bootstrap goodness-of-fit test for a Poisson regression model } \description{ This function is associated with \code{sm.poisson} for the underlying fitting procedure. It performs a Pseudo-Likelihood Ratio Test for the goodness-of-fit of a standard parametric Poisson regression of specified \code{degree} in the covariate \code{x}. } \usage{ sm.poisson.bootstrap(x, y, h, degree = 1, fixed.disp = FALSE, intercept = TRUE, ...) } \arguments{ \item{x}{ vector of the covariate values } \item{y}{ vector of the response values; they must be nonnegative integers. } \item{h}{ the smoothing parameter; it must be positive. } \item{degree}{ specifies the degree of the fitted polynomial in \code{x} on the logit scale (default=1). } \item{fixed.disp}{if \code{TRUE}, the dispersion parameter is kept at value 1 across the simulated samples, otherwise the dispersion parameter estimated from the sample is used to generate samples with that dispersion parameter (default=\code{FALSE}). } \item{intercept}{\code{TRUE} (default) if an intercept is to be included in the fitted model.} \item{\dots}{ additional parameters passed to \code{\link{sm.poisson}}. }} \value{ a list containing the observed value of the Pseudo-Likelihood Ratio Test statistic, its observed p-value as estimated via the bootstrap method, and the vector of estimated dispersion parameters when this value is not forced to be 1. } \section{Side Effects}{ Graphical output representing the bootstrap samples is produced on the current graphical device. The estimated dispersion parameter, the value of the test statistic and the observed significance level are printed. } \details{ see Section 5.4 of the reference below. } \references{ Bowman, A.W. and Azzalini, A. (1997). \emph{Applied Smoothing Techniques for Data Analysis:} \emph{the Kernel Approach with S-Plus Illustrations.} Oxford University Press, Oxford. } \seealso{ \code{\link{sm.poisson}}, \code{\link{sm.binomial.bootstrap}} } \examples{ ## takes a while: extend sm.script(muscle) with(muscle, { TypeI <- TypeI.P + TypeI.R + TypeI.B sm.poisson.bootstrap(log(TypeI), TypeII, h = 0.5) }) } \keyword{nonparametric} \keyword{smooth} \keyword{htest} \keyword{models} sm/man/hnorm.Rd0000744000176200001440000000312012266061242013054 0ustar liggesusers\name{hnorm} \alias{hnorm} \title{ Normal optimal choice of smoothing parameter in density estimation } \description{ This functions evaluates the smoothing parameter which is asymptotically optimal for estimating a density function when the underlying distribution is Normal. Data in one, two or three dimensions can be handled. } \usage{ hnorm(x, weights) } \arguments{ \item{x}{ a vector, or matrix with two or three columns, containing the data. } \item{weights}{ an optional vector of integer values which allows the kernel functions over the observations to take different weights when they are averaged to produce a density estimate. This is useful, in particular, for censored data and to construct an estimate from binned data. }} \value{ the value of the asymptotically optimal smoothing parameter for Normal case. } \details{ See Section 2.4.2 of the reference below. } \note{As from version 2.1 of the package, a similar effect can be obtained with the new function \code{h.select}, via \code{h.select(x, method="normal", weights=weights)} or simply \code{h.select(x)}. Users are encouraged to adopt this route, since \code{hnorm} might be not accessible directly in future releases of the package. } \references{ Bowman, A.W. and Azzalini, A. (1997). \emph{Applied Smoothing Techniques for Data Analysis: } \emph{the Kernel Approach with S-Plus Illustrations.} Oxford University Press, Oxford. } \seealso{ \code{\link{h.select}}, \code{\link{hcv}}, \code{\link{hsj}} } \examples{ x <- rnorm(50) hnorm(x) } \keyword{nonparametric} \keyword{smooth} % Converted by Sd2Rd version 1.15. sm/man/geys3d.Rd0000744000176200001440000000157012266061241013135 0ustar liggesusers\name{geys3d} \alias{geys3d} \title{Duration and the time between eruptions for the Old Faithful Geyser} \description{ These data document the duration of eruptions, and the time between eruptions, for the Old Faithful Geyser in Yellowstone National Park. The variables are: \tabular{ll}{ \code{Waiting} \tab the waiting time before each eruption (minutes) \cr \code{Next.waiting} \tab the waiting time following each eruption (minutes) \cr \code{Duration} \tab the length of an eruption ( minutes) } The data were collected by by the Park Geologist, R.A.Hutchinson. An earlier set of data is reported in Weisberg (1990), Applied Linear Regression, Wiley, New York. The later set, used here, was reported by Azzalini & Bowman (1990), "A look at some data on the Old Faithful Geyser", Applied Statistics 39, 357-65. } \keyword{smooth} \keyword{regression} sm/man/lcancer.Rd0000744000176200001440000000154312266061242013347 0ustar liggesusers\name{lcancer} \alias{lcancer} \title{Spatial positions of cases of laryngeal cancer} \description{ These data record the spatial positions of cases of laryngeal cancer in the North-West of England between 1974 and 1983, together with the positions of a number of lung cancer patients who were used as controls. The data have been adjusted to preserve anonymity. The variables are: \tabular{ll}{ \code{Easting} \tab a west-east grid reference \cr \code{Northing} \tab a north-south grid reference \cr \code{Cancer} \tab an indicator of laryngeal (1) or lung (2) cancer } Source: Bailey & Gatrell (1995). Interactive Spatial Data Analysis. Longman Scientific and Technical, Harlow. A more extensive set of data is analysed in Kelsall & Diggle, kernel estimation of relative risk, Bernoulli 1, 3-16. } \keyword{smooth} \keyword{regression} sm/man/sm.rm.Rd0000744000176200001440000000745612266061252013006 0ustar liggesusers\name{sm.rm} \alias{sm.rm} \title{ Nonparametric analysis of repeated measurements data } \description{ This function estimates nonparametrically the mean profile from a matrix \code{y} which is assumed to contain repeated measurements (i.e. longitudinal data) from a set of individuals. } \usage{ sm.rm(Time, y, minh = 0.1, maxh = 2, optimize = FALSE, rice.display = FALSE, \dots) } \arguments{ \item{y}{ matrix containing the values of the response variable, with rows associated to individuals and columns associated to observation times. } \item{Time}{ a vector containing the observation times of the response variable, assumed to be the same for all individuals of matrix \code{y}. If \code{Time} is not given, this is assumed to be \code{1:ncol(y)}. } \item{minh}{ the mimimum value of the interval where the optimal value of the smoothing parameter is seached according to the modified Rice criterion. See reference below for details. } \item{maxh}{ the maximum value of the above interval. } \item{optimize}{ Logical value, default is \code{optimize=FALSE}. If \code{optimize=TRUE}, then a full optimization is performed after searching the interval \code{(minh,maxh)} using the optimizer \code{optim}. } \item{rice.display}{ If this set to \code{TRUE} (default is \code{FALSE}), a plot is produced of the curve representing the modified Rice criterion for bandwidth selection. See reference below for details. } \item{\dots}{ other optional parameters are passed to the \code{sm.options} function, through a mechanism which limits their effect only to this call of the function; those relevant for this function are the following: \itemize{ \item{add}{ logical value, default is \code{add=FALSE}. If \code{add=TRUE} and display is not set to \code{"none"}, then graphical output added to the existing plot, rather than starting a new one. } \item{display}{ character value controlling the amount of graphical output of the estimated regression curve. It has the same meaning as in \code{sm.regression}. Default value is \code{display="lines"}. } \item{ngrid}{ the number of divisions of the above interval to be considered. Default: \code{ngrid=20}. } \item{poly.index}{ overall degree of locally-fitted polynomial, as used by \code{sm.regression}. Default: \code{ngrid=1}. }}}} \value{ a list containing the returned value produced by \code{sm.regression} when smoothing the mean response value at each given observation time, with an extra component \code{$aux} added to the list. This additional component is a list itself containing the mean value at each observation time, the residual variance of the residuals from the estimated regression curve, the autocorrelation function of the residuals, and the value \code{h} of the chosen smoothing parameter. } \section{Side Effects}{ if the parameter display is not set to \code{"none"}, a plot of the estimated regression curve is produced; other aspects are controlled by the optional parameters (\code{\dots}). If \code{rice.display=TRUE}, a plot of the modified Rice criterion is shown. } \details{ see Section 7.4 of the reference below. } \references{ Bowman, A.W. and Azzalini, A. (1997). \emph{Applied Smoothing Techniques for Data Analysis: } \emph{the Kernel Approach with S-Plus Illustrations.} Oxford University Press, Oxford. } \seealso{ \code{\link{sm.regression}}, \code{\link{sm.regression.autocor}}, \code{\link{optim}} } \examples{ sm.rm(y=as.matrix(citrate), display.rice=TRUE) # with(dogs, { Time <- seq(1,13,by=2) gr1 <- as.matrix(dogs[dogs$Group==1,2:8]) plot(c(1,13), c(3,6),xlab="time", ylab="potassium", type="n") sm1 <- sm.rm(Time, gr1, display="se", add=TRUE) }) } \keyword{nonparametric} \keyword{smooth} % Converted by Sd2Rd version 1.15. sm/man/mosses.Rd0000744000176200001440000001061412266061243013251 0ustar liggesusers\name{mosses} \alias{mosses} \title{Heavy metals in mosses in Galicia.} \description{Mosses are used as a means of measuring levels of heavy metal concentrations in the atmosphere, since most of the nutrient uptake of the mosses is from the air. This technique for large-scale monitoring of long-range transport processes has been used in Galicia, in North-West Spain, over the last decade, as described by Fernandez et al. (2005). In 2006, in both March and September, measurements of different metals were collected at 148 points lying almost in a regular grid over the region with 15 km spacing in north-south and east-west directions. According to the ecologists' expertise, the period between the two samples, passing from a humid to a dry season, is enough time to guarantee the independence of the observed processes. The dataset consists of a list with six components \tabular{ll}{ \code{loc.m} \tab a two-column matrix containing grid locations of the March monitoring sites \cr \code{loc.s} \tab a two-column matrix containing grid locations of the September monitoring sites \cr \code{Co.m} \tab cobalt concentration (log scale) in March \cr \code{Co.s} \tab cobalt concentration (log scale) in September \cr \code{Hg.m} \tab mercury concentration (log scale) in March \cr \code{Hg.s} \tab mercury concentration (log scale) in September \cr} Source: The data were kindly made available by the Ecotoxicology and Vegetal Ecophysiology research group in the University of Santiago de Compostela. } \references{Fernandez, J., Real, C., Couto, J., Aboal, J., Carballeira, A. (2005). The effect of sampling design on extensive biomonitoring surveys of air pollution. Science of the Total Environment, 337, 11-21.} \examples{ \dontrun{ # Comparison of Co in March and September with(mosses, { nbins <- 12 vgm.m <- sm.variogram(loc.m, Co.m, nbins = nbins, original.scale = TRUE, ylim = c(0, 1.5)) vgm.s <- sm.variogram(loc.s, Co.s, nbins = nbins, original.scale = TRUE, add = TRUE, col.points = "blue") trns <- function(x) (x / 0.977741)^4 del <- 1000 plot(vgm.m$distance.mean, trns(vgm.m$sqrtdiff.mean), type = "b", ylim = c(0, 1.5), xlab = "Distance", ylab = "Semi-variogram") points(vgm.s$distance.mean - del, trns(vgm.s$sqrtdiff.mean), type = "b", col = "blue", pch = 2, lty = 2) plot(vgm.m$distance.mean, trns(vgm.m$sqrtdiff.mean), type = "b", ylim = c(0, 1.5), xlab = "Distance", ylab = "Semi-variogram") points(vgm.s$distance.mean - del, trns(vgm.s$sqrtdiff.mean), type = "b", col = "blue", pch = 2, lty = 2) segments(vgm.m$distance.mean, trns(vgm.m$sqrtdiff.mean - 2 * vgm.m$se), vgm.m$distance.mean, trns(vgm.m$sqrtdiff.mean + 2 * vgm.m$se)) segments(vgm.s$distance.mean - del, trns(vgm.s$sqrtdiff.mean - 2 * vgm.s$se), vgm.s$distance.mean - del, trns(vgm.s$sqrtdiff.mean + 2 * vgm.s$se), col = "blue", lty = 2) mn <- (vgm.m$sqrtdiff.mean + vgm.s$sqrtdiff.mean) / 2 se <- sqrt(vgm.m$se^2 + vgm.s$se^2) plot(vgm.m$distance.mean, trns(vgm.m$sqrtdiff.mean), type = "n", ylim = c(0, 1.5), xlab = "Distance", ylab = "Semi-variogram") polygon(c(vgm.m$distance.mean, rev(vgm.m$distance.mean)), c(trns(mn - se), rev(trns(mn + se))), border = NA, col = "lightblue") points(vgm.m$distance.mean, trns(vgm.m$sqrtdiff.mean)) points(vgm.s$distance.mean, trns(vgm.s$sqrtdiff.mean), col = "blue", pch = 2) vgm1 <- sm.variogram(loc.m, Co.m, nbins = nbins, varmat = TRUE, display = "none") vgm2 <- sm.variogram(loc.s, Co.s, nbins = nbins, varmat = TRUE, display = "none") nbin <- length(vgm1$distance.mean) vdiff <- vgm1$sqrtdiff.mean - vgm2$sqrtdiff.mean tstat <- c(vdiff \%*\% solve(vgm1$V + vgm2$V) \%*\% vdiff) pval <- 1 - pchisq(tstat, nbin) print(pval) }) # Assessing isotropy for Hg in March with(mosses, { sm.variogram(loc.m, Hg.m, model = "isotropic") }) # Assessing stationarity for Hg in September with(mosses, { vgm.sty <- sm.variogram(loc.s, Hg.s, model = "stationary") i <- 1 image(vgm.sty$eval.points[[1]], vgm.sty$eval.points[[2]], vgm.sty$estimate[ , , i], col = topo.colors(20)) contour(vgm.sty$eval.points[[1]], vgm.sty$eval.points[[2]], vgm.sty$sdiff[ , , i], col = "red", add = TRUE) }) } } \keyword{smooth} \keyword{regression} sm/man/h.select.Rd0000744000176200001440000000626112266061241013446 0ustar liggesusers\name{h.select} \alias{h.select} \title{ Selection of the smoothing parameter } \description{ This function selects a smoothing parameter for density estimation in one or two dimensions and for nonparametric regression with one or two covariates. Several methods of selection are available. } \usage{ h.select(x, y = NA, weights = NA, group = NA, ...) } \arguments{ \item{x}{ a vector, or two-column matrix. } \item{y}{ a vector of reponses, in regression case. } \item{weights}{ a vector of integers representing frequencies of individual observations. Use of this parameter is incompatible with \code{binning}; hence \code{nbins} must then be set to \code{0} or left at its default value \code{NA}. } \item{group}{ a vector of groups indicators (numeric or character values) or a factor } \item{\dots}{ other optional parameters are passed to the \code{sm.options} function, through a mechanism which limits their effect only to this call of the function. There are three which are relevant for this function, namely \code{method}, which specifies the method of smoothing parameter selection, \code{df}, which specifies the approximate degrees of freedom associated with the selected smoothing parameter, and \code{structure.2d} which determines the form of the smoothing parameters in the two-dimensional case. A full description of these arguments are given in the documentation of \code{\link{sm.options}}. }} \value{ the value of the selected smoothing parameter. } \section{Side Effects}{ none } \details{ see the two references below for discussion of the methods of smoothing parameter selection. If the sample size is large, binning will be employed. In the case of \code{method = "cv"} the answer will therefore be different from that obtained through the function \code{hcv} where binning is not used. When the \code{group} argument is set, the chosen method of smoothing parameter selection is applied to each group and the value returned is the geometric mean of these. This is intended for use in \code{\link{sm.density.compare}} and \code{\link{sm.ancova}}, where the same smoothing parameter is used for all groups so that the principal bias terms cancel when the estimates are compared. } \references{ Bowman, A.W. and Azzalini, A. (1997). \emph{Applied Smoothing Techniques for Data Analysis:} \emph{the Kernel Approach with S-Plus Illustrations.} Oxford University Press, Oxford. Hurvich, C.M., Simonoff, J.S. and Tsai, C.-L. (1998). Smoothing parameter selection in nonparametric regression using an improved Akaike information criterion. \emph{J. R. Statistic. Soc., Series B}, 60, 271-293. } \seealso{ \code{\link{sm}}, \code{\link{hcv}}, \code{\link{hsj}}, \code{\link{hnorm}} } \examples{ x <- rnorm(50) h.select(x) h.select(x, method = "sj") x <- matrix(rnorm(100), ncol = 2) h.select(x) sm.density(x, method = "cv") x <- rnorm(50) y <- x^2 + rnorm(50) h.select(x, y) sm.regression(x, y, method = "aicc") x <- matrix(rnorm(100), ncol = 2) y <- x[,1]^2 + x[,2]^2 + rnorm(50) h.select(x, y, method = "cv", structure.2d = "common") sm.regression(x, y, df = 8) } \keyword{nonparametric} \keyword{regression} \keyword{smooth} sm/man/sm.regression.Rd0000744000176200001440000002033512266061251014536 0ustar liggesusers\name{sm.regression} \alias{sm.regression} \title{Nonparametric regression with one or two covariates.} \description{ This function creates a nonparametric regression estimate from data consisting of a single response variable and one or two covariates. In two dimensions a perspective, image (\code{image}), contour (\code{slice}) or \code{rgl} plot of the estimated regression surface is produced. A number of other features of the construction of the estimate, and of its display, can be controlled. If the \code{rpanel} package is available, an interactive panel can be activated to control various features of the plot. } \usage{ sm.regression(x, y, h, design.mat = NA, model = "none", weights = NA, group = NA, \dots) } \arguments{ \item{x}{a vector, or two-column matrix, of covariate values.} \item{y}{a vector of reponses.} \item{h}{a vector of length 1 or 2 giving the smoothing parameter. A normal kernel function is used and \code{h} is its standard deviation.} \item{design.mat}{the design matrix used to produce \code{y} when these are assumed to be the residuals from a linear model.} \item{model}{a character variable which defines a reference model. The values \code{"none"}, \code{"no effect"} and \code{"linear"} and are possible.} \item{weights}{a vector which allows the kernel functions associated with the observations to take different weights. This is useful, in particular, when different observations have different precisions. The normal usage of this parameter is to associate observations with frequencies; if the \code{weights} are not integers, they are converted to integers, but in this case the standard errors and tests which are computed cannot be considered. This argument applies only to the case of one covariate. Use of this parameter is incompatible with \code{binning}; hence \code{nbins} must then be set to 0 or left at its default value \code{NA}.} \item{group}{a vector of groups indicators (numeric or character values) or a factor} \item{\dots}{other optional parameters are passed to the \code{sm.options} function, through a mechanism which limits their effect only to this call of the function; those relevant for this function are the following: \code{display}, \code{hmult}, \code{h.weights}, \code{poly.index}, \code{band}, \code{add}, \code{ngrid}, \code{eval.points}, \code{se}, \code{se.breaks}, \code{period}, \code{xlab}, \code{ylab}, \code{zlab}, \code{hull}, \code{panel}, \code{panel.plot}, \code{lty}, \code{col}, \code{col.band}, \code{col.mesh}, \code{col.points}, \code{col.palette}; see the documentation of \code{\link{sm.options}} for their description.} } \value{a list containing the values of the estimate at the evaluation points, the smoothing parameter and the smoothing parameter weights. If a reference model has been specified and \code{test} set to \code{TRUE}, then the p-value of the test is also returned. When there is only one covariate, the weights associated with different obserations, an estimate of the error standard deviation and the standard error of the estimate are also returned. If a reference model has been specified, this standard error refers to the comparison between the estimate and the reference model, and the values defining the reference model are also returned. If an \code{rgl} display is used, then the indices of the surface and lines used to create the display are returned. } \section{Side Effects}{ a plot on the current graphical device is produced, unless the option \code{display="none"} is set. } \details{ When \code{display} is set to \code{"persp"} or \code{"rgl"}, a number of graphical options are available. By setting the \code{col} parameter to \code{"height"} or \code{"se"}, the surface will be painted by colours to reinforce the perception of height or indicate the relative sizes of the standard errors respectively. When \code{model} is not \code{"none"}, the colour coding refers to the number of standard errors which separate the smooth regression surface and the nominated model at each position. The parameter \code{"se.breaks"}, whose default value is \code{c(-3, -2, 3, 3)} can then be used to set the colour ranges. In this case, \code{col.palette} must be set to a list of colours whose length is one greater than the length of the cut-points in \code{"se.breaks"}. If this is not the case, the default colour palette \code{rev(rainbow(length(opt$se.breaks) + 1, start = 0/6, end = 4/6))}. If the argument \code{col} is not set then surface painting will be determined by the setting of \code{se}. If neither is set then colour painting will be activated by default if \code{model != "none"}. (In this latter case, the argument \code{band}, retained from earlier versions for compatibility, will also be examined.) When \code{display} is set to \code{"rgl"}, some additional parameters can be used to control details of the plot. Transparency can be set by \code{alpha}, which lies between \code{0} and \code{1}. When \code{alpha} is set to a vector of length two, the first component refers to the surface panels and the second to the surface mesh. Setting a component of \code{alpha} to \code{0} will remove the corresponding feature from the plot. \code{col.mesh}, whose valid values match those of \code{col}, controls the colour of the surface mesh. The logical parameter \code{lit} has the same meaning as in the \code{rgl} package; see \code{material3d}. When \code{panel} is set to \code{"TRUE"}, an interactive control panel is created if the \code{rpanel} package is available. If a covariate is on a cyclical scale, this can be incorporated by setting the \code{period} argument to a vector (of length 1 or 2) whose components give the values of the periods, or NA if the covariate is not periodic. See Chapters 3, 4 and 5 of the first reference below for the details of the construction of the estimate and its standard error. The second reference gives further details and examples of surface painting. } \references{ Bowman, A.W. and Azzalini, A. (1997). \emph{Applied Smoothing Techniques for Data Analysis:} \emph{the Kernel Approach with S-Plus Illustrations.} Oxford University Press, Oxford. Bowman, A.W. (2006). Comparing nonparametric surfaces. \emph{Statistical Modelling}, 6, 279-299. } \seealso{ \code{\link{hcv}}, \code{\link{sm}}, \code{\link{sm.ancova}}, \code{\link{sm.binomial}}, \code{\link{sm.poisson}}, \code{\link{sm.regression.autocor}}, \code{\link{sm.survival}}, \code{\link{sm.options}}, \code{\link{sm.surface3d}} } \examples{ with(trawl, { Zone92 <- (Year == 0 & Zone == 1) Position <- cbind(Longitude - 143, Latitude) dimnames(Position)[[2]][1] <- "Longitude - 143" par(mfrow = c(2, 2)) sm.regression(Longitude, Score1, method = "aicc", col = "red", model = "linear") sm.regression(Position[Zone92, ], Score1[Zone92], display = "image", theta = 120) sm.regression(Position[Zone92, ], Score1[Zone92], df = 12, col = "se", theta = 120) sm.regression(Position[Zone92, ], Score1[Zone92], df = 12, col = "se", model = "linear", theta = 120) par(mfrow = c(1, 1)) }) # sm.regression(Position[Zone92, 2:1], Score1[Zone92], display = "rgl", df = 12) # sm.regression(Position[Zone92, 2:1], Score1[Zone92], display = "rgl", df = 12, # alpha = c(0.9, 1), col = "se", model = "linear") # sm.regression(Position[Zone92, 1], Score1[Zone92], panel = TRUE) # sm.regression(Position[Zone92, ], Score1[Zone92], panel = TRUE) # sm.regression(Position[Zone92, ], Score1[Zone92], panel = TRUE, display = "rgl") } \keyword{nonparametric} \keyword{regression} \keyword{smooth} % Converted by Sd2Rd version 1.15. sm/man/sm.autoregression.Rd0000744000176200001440000000352312266061245015432 0ustar liggesusers\name{sm.autoregression} \alias{sm.autoregression} \title{ Nonparametric estimation of the autoregression function } \description{ This function estimates nonparametrically the autoregression function (conditional mean given the past values) of a time series \code{x}, assumed to be stationary. } \usage{ sm.autoregression(x, h = hnorm(x), d = 1, maxlag = d, lags, se = FALSE, ask = TRUE) } \arguments{ \item{x}{ vector containing the time series values. } \item{h}{ the bandwidth used for kernel smoothing. } \item{d}{ number of past observations used for conditioning; it must be 1 (default value) or 2. } \item{maxlag}{ maximum of the lagged values to be considered (default value is \code{d}). } \item{lags}{ if \code{d==1}, this is a vector containing the lags considered for conditioning; if \code{d==2}, this is a matrix with two columns, whose rows contains pair of values considered for conditioning. } \item{se}{ if \code{se==T}, pointwise confidence bands are computed of approximate level 95\%. } \item{ask}{ if \code{ask==TRUE}, the program pauses after each plot until is pressed. } } \value{ a list with the outcome of the final estimation (corresponding to the last value or pairs of values of lags), as returned by \code{sm.regression}. } \section{Side Effects}{ graphical output is producved on the current device. } \details{ see Section 7.3 of the reference below. } \references{ Bowman, A.W. and Azzalini, A. (1997). \emph{Applied Smoothing Techniques for Data Analysis: } \emph{the Kernel Approach with S-Plus Illustrations.} Oxford University Press, Oxford. } \seealso{ \code{\link{sm.regression}}, \code{\link{sm.ts.pdf}} } \examples{ sm.autoregression(log(lynx), maxlag=3, se=TRUE) sm.autoregression(log(lynx), lags=cbind(2:3,4:5)) } \keyword{nonparametric} \keyword{smooth} \keyword{ts} % Converted by Sd2Rd version 1.15. sm/man/sm-internal.Rd0000744000176200001440000000722512266061245014177 0ustar liggesusers\name{sm-internal} \alias{addplot} \alias{aicc.crit.reg} % \alias{ask} % \alias{attach.frame} \alias{britmap} \alias{change} \alias{circle} \alias{cv} \alias{cv.crit.dens} \alias{cv.crit.reg} \alias{df.crit.reg} \alias{hidplot} \alias{incphi} \alias{inctheta} \alias{normdens.band} \alias{np.contour.plot.3d.} \alias{p.quad.moment} \alias{plot2} \alias{plot2d} \alias{replace.na} \alias{sj} \alias{sm.density.1d} \alias{sm.density.2d} \alias{sm.density.3d} \alias{sm.density.eval.1d} \alias{sm.density.eval.2d} \alias{sm.density.positive.1d} \alias{sm.density.positive.2d} \alias{sm.density.positive.grid} \alias{sm.glm} \alias{sm.imageplot} \alias{sm.persplot} \alias{sm.rglplot} \alias{sm.regression.1d} \alias{sm.regression.2d} \alias{sm.regression.eval.1d} \alias{sm.regression.eval.2d} \alias{sm.regression.test} \alias{sm.sigweight} \alias{sm.sliceplot} \alias{sm.weight} \alias{sm.weight2} \alias{smplot.density} \alias{smplot.regression} \alias{wmean} \alias{wvar} \alias{isInteger} \alias{isMatrix} \title{Internal sm functions} \description{ Internal \code{sm} functions } \usage{ addplot(d, f, theta, phi) britmap() change(th, ph) circle(r) cv(x, h, ...) hidplot(invis, theta, phi) incphi(ph, inc) inctheta(th, inc) isInteger(x) isMatrix(x) normdens.band(x, h, weights = rep(1, length(x)), options = list()) p.quad.moment(A, Sigma, tobs, ndevs) smplot.regression(x, y, design.mat, h, r, model, weights, rawdata = list(), options = list(), ...) plot2(latitude2, longitude2, theta, phi) plot2d(d, f, theta, phi) replace.na(List, comp, value) sj(x, h) sm.check.data(x, y = NA, weights = NA, group = NA, ...) sm.density.1d(x, h = hnorm(x, weights), model = "none", weights, rawdata = list(x = x), options = list()) sm.density.2d(X, h = hnorm(X, weights), weights = rep(1, length(x)), rawdata = list(), options = list()) sm.density.3d(x, h = hnorm(x, weights), weights = rep(1, length(x)), rawdata = list(), options = list()) sm.density.eval.1d(x, h, weights = rep(1, n), options = list()) sm.density.eval.2d(x, y, h, xnew, ynew, eval.type = "points", weights = rep(1, n), options = list()) sm.density.positive.1d(x, h, weights, options = list()) sm.density.positive.2d(X, h = c(hnorm(log(X[, 1] + delta[1]), weights), hnorm(log(X[,2] + delta[2]), weights)), eval.type = "points", weights = rep(1, nrow(X)), options = list()) sm.density.positive.grid(X, h = c(hnorm(log(X[, 1] + delta[1])), hnorm(log(X[, 2] + delta[2]))), weights=NA, options=list()) sm.glm(x, y, family, h, eval.points, start, offset, options=list()) sm.imageplot(x, y, h, weights, rawdata, options = list()) sm.persplot(x, y, h = hnorm(cbind(x, y), weights), weights, rawdata = list(), options = list()) sm.regression.1d(x, y, h, design.mat = NA, model = "none", weights = rep(1, length(x)), rawdata, options = list()) sm.regression.2d(x, y, h, model = "none", weights = rep(1, length(y)), rawdata, options = list()) sm.regression.eval.1d(x, y, design.mat, h, model = "none", weights = rep(1, length(x)), rawdata, options = list()) sm.regression.eval.2d (x, y, h, model, eval.points, hull = TRUE, weights, options = list()) sm.regression.test(x, y, design.mat = NA, h, model = "no.effect", weights = rep(1,length(y)), rawdata, options = list()) sm.sigweight(x, weights) sm.sliceplot(x, y, h, weights, rawdata = list(), options = list()) sm.weight(x, eval.points, h, cross = FALSE, weights = rep(1, length(x)), options) sm.weight2(x, eval.points, h, cross = FALSE, weights = rep(1, nrow(x)), options = list()) smplot.density(x, h, weights = rep(1, length(x)), rawdata = list(x = x), options = list()) wmean(x, w) wvar(x, w) } \details{ These are not to be called by the user. } \keyword{internal} sm/man/bissell.Rd0000744000176200001440000000066712266061240013401 0ustar liggesusers\name{bissell} \alias{bissell} \title{Flaws in cloth} \description{ These data refer to the length and the observed number of flaws in rolls of cloth. The variables are: \tabular{ll}{ \code{Length} \tab length of each roll (m) \cr \code{Flaws} \tab number of flaws detected } Source: Bissell (1972). A negative binomial model with varying element sizes. Biometrika 59, 435-41. } \keyword{smooth} \keyword{regression} sm/man/airpc.Rd0000744000176200001440000000156312266061237013044 0ustar liggesusers\name{airpc} \alias{airpc} \title{These data list the first two principal component scores from the aircraft data, which record six characteristics of aircraft designs throughout the twentieth century} \description{ These data list the first two principal component scores from the aircraft data, which record six characteristics of aircraft designs throughout the twentieth century. The variables are: \tabular{ll}{ \code{Comp.1:} \tab first principal component score \cr \code{Comp.2:} \tab second principal component score \cr \code{Yr:} \tab year of first manufacture \cr \code{Period:} \tab a code to indicate one of three broad time periods } The data were collected by P. Saviotti and are described in detail in Saviotti (1996), "Technological Evolution, Variety and Economy", Edward Elgar: Cheltenham. } \keyword{smooth} \keyword{regression} sm/man/sm.density.Rd0000744000176200001440000001040412266061247014036 0ustar liggesusers\name{sm.density} \alias{sm.density} \title{ Nonparametric density estimation in one, two or three dimensions. } \description{ This function creates a density estimate from data in one, two or three dimensions. In two dimensions a variety of graphical displays can be selected, and in three dimensions a contour surface can be plotted. A number of other features of the construction of the estimate, and of its display, can be controlled. If the \code{rpanel} package is available, an interactive panel can be activated to control various features of the plot. If the \code{rgl} package is also available, rotatable plots are available for the two- and three-dimensional cases. (For three-dimensional data, the \code{misc3d} package is also required.) } \usage{ sm.density(x, h, model = "none", weights = NA, group=NA, \dots) } \arguments{ \item{x}{a vector, or a matrix with two or three columns, containing the data. } \item{h}{a vector of length one, two or three, defining the smoothing parameter. A normal kernel function is used and \code{h} is its standard deviation. If this parameter is omitted, a normal optimal smoothing parameter is used. } \item{model}{This argument applies only with one-dimensional data. Its default value is \code{"none"}. If it is set to \code{"Normal"} (or indeed any value other than \code{"none"}) then a reference band, indicating where a density estimate is likely to lie when the data are normally distributed, will be superimposed on any plot. } \item{weights}{a vector of integers representing frequencies of individual observations. Use of this parameter is incompatible with binning; hence \code{nbins} must then be set to 0 or left at its default value \code{NA}. } \item{group}{ a vector of groups indicators (numeric or character values) or a factor. } \item{\dots}{ other optional parameters are passed to the \code{sm.options} function, through a mechanism which limits their effect only to this call of the function. Those specifically relevant for this function are the following: \code{hmult}, \code{h.weights}, \code{band}, \code{add}, \code{lty}, \code{display}, \code{props}, \code{xlab}, \code{ylab}, \code{zlab}, \code{xlim}, \code{ylim}, \code{yht}, \code{nbins}, \code{ngrid}, \code{eval.points}, \code{panel}, \code{positive}, \code{delta}, \code{theta}, \code{phi}; see the documentation of \code{\link{sm.options}} for their description. }} \value{ a list containing the values of the density estimate at the evaluation points, the smoothing parameter, the smoothing parameter weights and the kernel weights. For one- and two-dimensional data, the standard error of the estimate (on the square root scale, where the standard error is approximately constant) and the upper and lower ends of a variability band are also supplied. Less information is supplied when the smoothing parameter weights or kernel weights are not all 1, or when \code{positive} is set to \code{TRUE}. } \section{Side Effects}{ a plot is produced, unless the option \code{display="none"} is set. } \details{ see Chapters 1, 2 and 6 of the reference below. In the three-dimensional case, the contours of the density estimate are constructed by the \code{contour3d} function in the \code{misc3d} package of Feng & Tierney. } \references{ Bowman, A.W. and Azzalini, A. (1997). \emph{Applied Smoothing Techniques for Data Analysis: } \emph{the Kernel Approach with S-Plus Illustrations.} Oxford University Press, Oxford. } \seealso{ \code{\link{h.select}}, \code{\link{hnorm}}, \code{\link{hsj}}, \code{\link{hcv}}, \code{\link{nise}}, \code{\link{nmise}}, \code{\link{sm}}, \code{\link{sm.sphere}}, \code{\link{sm.regression}}, \code{\link{sm.options}} } \examples{ # A one-dimensional example y <- rnorm(50) sm.density(y, model = "Normal") # sm.density(y, panel = TRUE) # A two-dimensional example y <- cbind(rnorm(50), rnorm(50)) sm.density(y, display = "image") # sm.density(y, panel = TRUE) # A three-dimensional example # y <- cbind(rnorm(50), rnorm(50), rnorm(50)) # sm.density(y) } \keyword{nonparametric} \keyword{smooth} % Converted by Sd2Rd version 1.15. sm/man/magrem.Rd0000744000176200001440000000113112266061242013201 0ustar liggesusers\name{magrem} \alias{magrem} \title{Magnetic remanence} \description{ These data record measurements of magnetic remanence in specimens of Precambrian volcanics. The variables are: \tabular{ll}{ \code{maglong} \tab directional component on a longitude scale \cr \code{maglat} \tab directional component on a latitude scale } Schmidt & Embleton (1985) J.Geophys.Res. 90 (B4), 2967-2984. The data are also listed in Fisher, Lewis & Embleton (1987), Statistical Analysis of Spherical Data, Cambridge University Press, Cambridge, dataset B6. } \keyword{smooth} \keyword{regression} sm/man/sm.variogram.Rd0000744000176200001440000002144313272427250014351 0ustar liggesusers\name{sm.variogram} \alias{sm.variogram} \title{ Confidence intervals and tests based on smoothing an empirical variogram. } \description{ This function constructs an empirical variogram, using the robust form of construction based on square-root absolute value differences of the data. Flexible regression is used to assess a variety of questions about the structure of the data used to construct the variogram, including independence, isotropy and stationarity. Confidence bands for the underlying variogram, and reference bands for the independence, isotropy and stationarity models, can also be constructed under the assumption that the errors in the data are approximately normally distributed. } \usage{ sm.variogram(x, y, h, df.se = "automatic", max.dist = NA, original.scale = TRUE, varmat = FALSE, \ldots) } \arguments{ \item{x}{ a vector or two-column matrix of spatial location values. } \item{y}{ a vector of responses observed at the spatial locations. } \item{h}{ a smoothing parameter to be used on the distance scale. A normal kernel function is used and \code{h} is its standard deviation. However, if this argument is omitted \code{h} will be selected by an approximate degrees of freedom criterion, controlled by the \code{df} parameter. See \code{sm.options} for details. } \item{df.se}{ the degrees of freedom used when smoothing the empirical variogram to estimate standard errors. The default value of "automatic" selects the degrees of smoothing described in the Bowman and Crujeiras (2013) reference below. } \item{max.dist}{ this can be used to constrain the distances used in constructing the variogram. The default is to use all distances. } \item{original.scale}{ a logical value which determines whether the plots are constructed on the original variogram scale (the default) or on the square-root absolute value scale on which the calculations are performed. } \item{varmat}{ a logical value which determines whether the variance matrix of the estimated variogram is returned. } \item{\dots}{ other optional parameters are passed to the \code{sm.options} function, through a mechanism which limits their effect only to this call of the function. An important parameter here is \code{model} which, for \code{sm.variogram}, can be set to \code{"none"}, \code{"independent"}, \code{"isotropic"} or \code{"stationary"}. Other relevant parameters are \code{add}, \code{eval.points}, \code{ngrid}, \code{se}, \code{xlab}, \code{ylab}, \code{xlim}, \code{ylim}, \code{lty}; see the documentation of \code{\link{sm.options}} for their description. See the details section below for a discussion of the \code{display} and \code{se} parameters in this setting. }} \value{ A list with the following components: \item{\code{sqrtdiff}, \code{distance}}{the raw differences and distances} \item{\code{sqrtdiff.mean}, \code{distance.mean}}{the binned differences and distances} \item{\code{weights}}{the frequencies of the bins} \item{\code{estimate}}{the values of the estimate at the evaluation points} \item{\code{eval.points}}{the evaluation points} \item{\code{h}}{the value of the smoothing parameter used} \item{\code{ibin}}{an indicator of the bin in which the distance between each pair of observations was placed} \item{\code{ipair}}{the indices of the original observations used to construct each pair} The suitability of a particular model can be assessed by setting the \code{model} argument, in which case the following components may also be returned, determined by the arguments passed in \ldots or the settings in \code{sm.options}. \item{\code{p}}{the p-value of the test} \item{\code{se}}{the standard errors of the binned values (if the argument \code{se} was set to \code{TRUE})} \item{\code{se.band}}{when an independence model is examined, this gives the standard error of the difference between the smooth estimate and the mean of all the data points, if a reference band has been requested} \item{\code{V}}{the variance matrix of the binned variogram. When \code{model} is set to \code{"isotropic"} or \code{"stationary"}, the variance matrix is computed under those assumptions.} \item{\code{sdiff}}{the standardised difference between the estiamte of the variogram and the reference model, evaluated at \code{eval.points}} \item{\code{levels}}{the levels of standarised difference at which contours are drawn in the case of \code{model = "isotropy"}.} } \section{Side Effects}{ a plot on the current graphical device is produced, unless the option \code{display="none"} is set. } \details{ The reference below describes the statistical methods used in the function. Note that, apart from the simple case of the indpendence model, the calculations required are extensive and so the function can be slow. The \code{display} argument has a special meaning for this function. Its default value is \code{"binned"}, which plots the binned version of the empirical variogram. As usual, the value \code{"none"} will suppress the graphical display. Any other value will lead to a plot of the individual differences between all observations. This will lead to a very large number of plotted points, unless the dataset is small. } \references{ Diblasi, A. and Bowman, A.W. (2001). On the use of the variogram for checking independence in a Gaussian spatial process. \emph{Biometrics}, 57, 211-218. Bowman, A.W. and Crujeiras, R.M. (2013). Inference for variograms. \emph{Computational Statistics and Data Analysis}, 66, 19-31. } \seealso{ \code{\link{sm.regression}}, \code{\link{sm.options}} } \examples{ \dontrun{ with(coalash, { Position <- cbind(East, North) sm.options(list(df = 6, se = TRUE)) par(mfrow=c(2,2)) sm.variogram(Position, Percent, original.scale = FALSE, se = FALSE) sm.variogram(Position, Percent, original.scale = FALSE) sm.variogram(Position, Percent, original.scale = FALSE, model = "independent") sm.variogram(East, Percent, original.scale = FALSE, model = "independent") par(mfrow=c(1,1)) }) # Comparison of Co in March and September with(mosses, { nbins <- 12 vgm.m <- sm.variogram(loc.m, Co.m, nbins = nbins, original.scale = TRUE, ylim = c(0, 1.5)) vgm.s <- sm.variogram(loc.s, Co.s, nbins = nbins, original.scale = TRUE, add = TRUE, col.points = "blue") trns <- function(x) (x / 0.977741)^4 del <- 1000 plot(vgm.m$distance.mean, trns(vgm.m$sqrtdiff.mean), type = "b", ylim = c(0, 1.5), xlab = "Distance", ylab = "Semi-variogram") points(vgm.s$distance.mean - del, trns(vgm.s$sqrtdiff.mean), type = "b", col = "blue", pch = 2, lty = 2) plot(vgm.m$distance.mean, trns(vgm.m$sqrtdiff.mean), type = "b", ylim = c(0, 1.5), xlab = "Distance", ylab = "Semi-variogram") points(vgm.s$distance.mean - del, trns(vgm.s$sqrtdiff.mean), type = "b", col = "blue", pch = 2, lty = 2) segments(vgm.m$distance.mean, trns(vgm.m$sqrtdiff.mean - 2 * vgm.m$se), vgm.m$distance.mean, trns(vgm.m$sqrtdiff.mean + 2 * vgm.m$se)) segments(vgm.s$distance.mean - del, trns(vgm.s$sqrtdiff.mean - 2 * vgm.s$se), vgm.s$distance.mean - del, trns(vgm.s$sqrtdiff.mean + 2 * vgm.s$se), col = "blue", lty = 2) mn <- (vgm.m$sqrtdiff.mean + vgm.s$sqrtdiff.mean) / 2 se <- sqrt(vgm.m$se^2 + vgm.s$se^2) plot(vgm.m$distance.mean, trns(vgm.m$sqrtdiff.mean), type = "n", ylim = c(0, 1.5), xlab = "Distance", ylab = "Semi-variogram") polygon(c(vgm.m$distance.mean, rev(vgm.m$distance.mean)), c(trns(mn - se), rev(trns(mn + se))), border = NA, col = "lightblue") points(vgm.m$distance.mean, trns(vgm.m$sqrtdiff.mean)) points(vgm.s$distance.mean, trns(vgm.s$sqrtdiff.mean), col = "blue", pch = 2) vgm1 <- sm.variogram(loc.m, Co.m, nbins = nbins, varmat = TRUE, display = "none") vgm2 <- sm.variogram(loc.s, Co.s, nbins = nbins, varmat = TRUE, display = "none") nbin <- length(vgm1$distance.mean) vdiff <- vgm1$sqrtdiff.mean - vgm2$sqrtdiff.mean tstat <- c(vdiff \%*\% solve(vgm1$V + vgm2$V) \%*\% vdiff) pval <- 1 - pchisq(tstat, nbin) print(pval) }) # Assessing isotropy for Hg in March with(mosses, { sm.variogram(loc.m, Hg.m, model = "isotropic") }) # Assessing stationarity for Hg in September with(mosses, { vgm.sty <- sm.variogram(loc.s, Hg.s, model = "stationary") i <- 1 image(vgm.sty$eval.points[[1]], vgm.sty$eval.points[[2]], vgm.sty$estimate[ , , i], col = topo.colors(20)) contour(vgm.sty$eval.points[[1]], vgm.sty$eval.points[[2]], vgm.sty$sdiff[ , , i], col = "red", add = TRUE) }) } } \keyword{smooth} \keyword{regression} \keyword{spatial} sm/man/worm.Rd0000744000176200001440000000117112266061254012724 0ustar liggesusers\name{worm} \alias{worm} \title{Human parasitic worm infections} \description{ These data record the occurence of a human parasitic worm infection in residents of a rural community in China. The variables are: \tabular{ll}{ \code{Age} \tab age of the resident \cr \code{Infection} \tab presence (1) or absence (0) of infection \cr \code{Sex} \tab male (1) or female (2) } The background to the data, and an analysis, are described by Weidong et al. (1996), Ascaris, people and pigs in a rural community of Jiangxi province, China, Parasitology 113, 545-57. } \keyword{smooth} \keyword{regression} sm/man/dogs.Rd0000744000176200001440000000145112266061241012671 0ustar liggesusers\name{dogs} \alias{dogs} \title{Coronary sinus potassium in dogs} \description{ Measurements of coronary sinus potassium (mil equivalent per litre) were made at (1,3,5,7,9,11,13) minutes after coronary occlusion in a number of different dogs. There are four treatment groups (group 1 is the control). The paper by Grizzle and Allen provides a full description of the treatments. A few subjects develop ventricular fibrillation (see paper for details). The variables are: \tabular{ll}{ \code{Group} \tab a treatment group indicator \cr \code{P1, P3, P5, P7, P9, P11, P13} \tab measurements at indicated times } J.E.Grizzle & D.M.Allen (1969). Analysis of growth and dose response curves. Biometrics vol.25, p.357-381 } \keyword{smooth} \keyword{regression} sm/man/citrate.Rd0000744000176200001440000000171412266061240013371 0ustar liggesusers\name{citrate} \alias{citrate} \title{The relationship between plasma citrate and carbohydrate metabolites} \description{ These data were collected in an experiment to study the relationship between possible daily rhythms of plasma citrate and daily rhythms of carbohydrate metabolites during feeding with a citrate-poor diet. During the experiment, plasma citrate concentrations were determined for each of 10 subjects at 14 successive time points during the day. The measurements covered the period 8a.m. to 9p.m. at hourly intervals. Meals were given at 8a.m., noon and 5p.m. The variables are denoted by \code{C08}, ..., \code{C21} and refer to plasma citrate measurements at the indiated hours. Anderson,A.H., Jensen,E.B. & Schou,G.(1981). Two-way analysis of variance with correlated errors. Int.Stat.Rev. 49,153-67. The data were taken from a report by T.T.Nielsen, N.S.Sorensen and E.B.Jensen. } \keyword{smooth} \keyword{regression} sm/man/sm.pca.Rd0000744000176200001440000001661112266061250013122 0ustar liggesusers\name{sm.pca} \alias{sm.pca} \title{ Smooth principal components analysis } \description{ This function calculates principal components in a manner which changes smoothly with a covariate. The smooth eigenvalues and eigenvector loadings can be plotted. A permutation test of equality of the components, both eigenvalues and eigenvectors, can be carried out. } \usage{ sm.pca(x, Y, h, cor = TRUE, nperm = 100, pc = 1, ...) } \arguments{ \item{x}{ either a vector of covariate values or a list object which is the output of a previous call to \code{sm.pca}. In the latter case, previously computed information is used to create plots and tests and the arguments \code{Y}, \code{h}, \code{cor} and \code{nperm} are not required. } \item{Y}{ a matrix of responses whose rows correspond to the caovariate values. } \item{h}{ the smoothing parameter which controls the smoothness of estimation with respect to the covariate \code{x}. } \item{cor}{ a logical value indicating whether the correlation, rather than covariance, matrix should be used. } \item{nperm}{ the number of permutations used in the permutation test and graphical reference band. } \item{pc}{ an integar value indicating the component to be plotted against the covariate. } \item{\dots}{ other optional parameters are passed to the \code{sm.options} function, through a mechanism which limits their effect only to this call of the function. Those relevant for this function are the following: \code{display} (here set to \code{"eigevalues"} or \code{"eigenvectors"}) \code{ngrid}, \code{xlab}; see the documentation of \code{\link{sm.options}} for their description. } } \value{ a list with the following components: \describe{ \item{xgrid}{a vector of values on the covariate scale at which the smooth estimates are constructed.} \item{evals}{a matrix whose columns give the smooth eigenvalues for each component at the covariate values.} \item{evecs}{a three-dimensional array whose third dimension corresponds to the covariate values and whose second dimension indexes the smooth components.} \item{mhat}{a matrix whose columns give the estimated smooth means for each dimension of \code{Y} at the covariate values.} \item{var.explained}{a matrix whose rows give the proportions of variance exaplined by each component at each covariate value.} \item{xlab}{the label attached to the x-axis.} \item{h}{the smoothing parameter used.} \item{x}{the covariate values, after removal of missing cases.} \item{Y}{the matrix of response values, after removal of missing cases.} \item{cor}{a logical indicator of whether the correlation, rather than covariance, matrix is used in the construction of the eigenvalues and eigenvectors.} } When a test or reference band is computed, the list has the additional components: \describe{ \item{nperm}{the number of permutations used.} \item{evals.perm}{the eigenvalues computed from the permuted data.} \item{evecs.perm}{the eigenvectors computed from the permuted data.} } When display contains \code{"eigenvalues"} or \code{"eigenvectors"}, the list has the additional components: \describe{ \item{p.values}{the p-value for a test of constant eigenvalue for the component identified by \code{pc}.} \item{p.vectors}{the p-value for a test of constant eigenvectors for the component identified by \code{pc}.} } When display contains \code{"eigenvalues"}, the list has the additional component: \describe{ \item{band}{a matrix whose two columns contain the boundaries of a reference band which indicates where the smooth eigenvalue curve should like if the hypothesis of no change in the eigenvalues with the ovariate is correct.} } When display contains \code{"eigenvectors"}, the list has the additional components: \describe{ \item{xgrid.plot}{a vector of values used for plotting the smooth eigenvectors.} \item{evecs.plot}{a matrix whose rows contain the smooth eigenvectors at each value of \code{xgrid.plot}.} \item{evecs.plot}{a matrix whose columns contain the colours for the line segments in each smooth eigenvector component.} } } \section{Side Effects}{ a plot on the current graphical device is produced, unless \code{display="none"} } \details{ Several further arguments may be set and these are passed to \code{sm.options}. Reelevant arguments for this function are \code{display} (\code{"eigenvalues"}, \code{"eigenvectors"}), \code{ngrid} and \code{df}. See \code{link{sm.options}} for further details. The smoothing is performed by the local constant kernel method and the smoothing parameter corresponds to the standard deviation of a normal kernel function. If \code{h} is left unspecified then it is selected to correspond to the degrees of freedom set by the parameter \code{df}. The reference band for a constant eigenvalue is constructed from the upper and lower pointwise 2.5 percentiles of the smooth eigenvalue curves from the data with permuted covariate values. The p-value compares the observed value of the difference between the smoothed and constant eigenvalues, summed over the covariate grid in \code{eval.points}, with the values generated from the permuted data. In the eigenvector case, a reference band is computed from the percentiles of the curves from the permuted data, for each of the loadings. In order to plot all the loadings curves simultaneously, the locations where each curve lies inside its respective reference band are indicated by pale colour. The p-value compares the observed value of \code{1 - sum(e*e0)^2}, where \code{e} and \code{e0} are the eigenvectors under the smooth and constant scenarios (summed over the covariate grid), with the values generated from the permuted data. This test statistic differs from the one described in the Miller and Bowman (2012) reference below. It has been used as it conveniently handles the arbitrary sign of principal components. When some components explain similar proportions of variance, the eigenvalues and eigenvectors can easily interchange, causing apparent sharp changes in the eigenvalue and eigenvector curves. It is difficult to track the components to avoid this. } \references{ Miller, C. and Bowman, A.W. (2012). Smooth principal components for investigating changes in covarinces over time. \emph{Applied Statistics} \bold{61}, 693--714. } \seealso{ \code{\link{sm.regression}}, \code{\link{sm.options}} } \examples{ \dontrun{ Y <- log(as.matrix(aircraft[ , -(1:2)])) year <- aircraft$Yr h <- h.select(year, Y[ , 1], method = "df", df = 4) spca <- sm.pca(year, Y, h, display = "none") sm.pca(year, Y, h, display = "eigenvalues") sm.pca(year, Y, h, display = "eigenvectors", ylim = c(-1, 1)) # The following code shows how the plots can be redrawn from the returned object spca <- sm.pca(year, Y, h, display = "eigenvalues") spca <- sm.pca(year, Y, h, display = "eigenvectors", ylim = c(-1, 1)) with(spca, { ylim <- range(evals[ , 1], band) plot(xgrid, evals[ , 1], type = "n", ylab = "Variance", ylim = ylim) polygon(c(xgrid, rev(xgrid)), c(band[ , 1], rev(band[ , 2])), col = "lightgreen", border = NA) lines(xgrid, evals[ , 1], col = "red") }) with(spca, { pc <- 1 plot(range(xgrid.plot), range(evecs.plot), type = "n", xlab = "x", ylab = "PC loadings") for (i in 1:ncol(Y)) segments(xgrid.plot[-length(xgrid.plot)], evecs.plot[-nrow(evecs.plot), i], xgrid.plot[-1], evecs.plot[-1, i], col = col.plot[ , i], lty = i) }) } } \keyword{nonparametric} \keyword{smooth} % Converted by Sd2Rd version 1.15. sm/man/sm.binomial.bootstrap.Rd0000744000176200001440000000431612266061246016171 0ustar liggesusers\name{sm.binomial.bootstrap} \alias{sm.binomial.bootstrap} \title{ Bootstrap goodness-of-fit test for a logistic regression model. } \description{ This function is associated with \code{sm.binomial} for the underlying fitting procedure. It performs a Pseudo-Likelihood Ratio Test for the goodness-of-fit of a standard parametric logistic regression of specified \code{degree} in the covariate \code{x}. } \usage{ sm.binomial.bootstrap(x, y, N = rep(1, length(x)), h, degree = 1, fixed.disp=FALSE, ...) } \arguments{ \item{x}{ vector of the covariate values } \item{y}{ vector of the response values; they must be nonnegative integers. } \item{h}{ the smoothing parameter; it must be positive. } \item{N}{ a vector containing the binomial denominators. If missing, it is assumed to contain all 1's. } \item{degree}{ specifies the degree of the fitted polynomial in \code{x} on the logit scale (default=1).} \item{fixed.disp}{if \code{TRUE}, the dispersion parameter is kept at value 1 across the simulated samples, otherwise the dispersion parameter estimated from the sample is used to generate samples with that dispersion parameter (default=\code{FALSE}). } \item{\dots}{ additional parameters passed to \code{\link{sm.binomial}}. }} \value{ a list containing the observed value of the Pseudo-Likelihood Ratio Test statistic, its observed p-value as estimated via the bootstrap method, and the vector of estimated dispersion parameters when this value is not forced to be 1. } \section{Side Effects}{ Graphical output representing the bootstrap samples is produced on the current graphical device. The estimated dispersion parameter, the value of the test statistic and the observed significance level are printed. } \details{ see Section 5.4 of the reference below. } \references{ Bowman, A.W. and Azzalini, A. (1997). \emph{Applied Smoothing Techniques for Data Analysis: } \emph{the Kernel Approach with S-Plus Illustrations.} Oxford University Press, Oxford. } \seealso{ \code{\link{sm.binomial}}, \code{\link{sm.poisson.bootstrap}} } \examples{ \dontrun{sm.binomial.bootstrap(concentration, dead, N, 0.5, nboot=50)} } \keyword{nonparametric} \keyword{smooth} \keyword{htest} \keyword{models} % Converted by Sd2Rd version 1.15. sm/man/provide.data.Rd0000744000176200001440000000422212266061244014317 0ustar liggesusers\name{provide.data} \alias{provide.data} \title{ Making data available as data.frame } \description{ This function is no longer available in the sm package. It should be replaced by the use of \code{attach}, if necessary. Each dataset now also has its own help file. It was a utility function, widely used in the scripts accompanying the book described below. The function provided access to the dataset identified by \code{name}. For flexibility, the datasets were provided in ASCII form, with the name of each variable listed in the first row of the file. This function reads the files and makes the data available as a data frame. } \usage{ provide.data(data, path, options = list()) } \arguments{ \item{data}{ name of the data to be loaded and attached as \code{data.frame} } \item{path}{ the path where the data and its documentation should be searched for, The default value is an appropriate sub-directory of the \code{sm} package. } \item{options}{ A list of options passed to \code{\link{sm.options}}. The one used is \code{describe}, a logical flag. If \code{describe=TRUE} (default), a documentation file of the data is searched and printed, if available. }} \value{ none } \section{Side Effects}{ messages are printed on the command window, describing progress of the operation. If \code{describe=TRUE} and a documentation file exists, this is printed on the command windows or another windows, depending on the type of platform where the program is executed. } \details{ the data file is assumed to be called \code{data}.dat and the documentation file describing the data (if present) is assumed to be called \code{data}.doc. If the \code{data.frame} is already attached, it is re-attached in the second position of the \code{search} list. To set \code{describe=FALSE} for the rest of the current session, use \code{sm.options(describe=FALSE)} The function can easily be adapted to play a similar role for other packages. } \author{ Bowman, A.W. and Azzalini, A. } \seealso{ \code{\link{data.frame}}, \code{\link{attach}}, \code{\link{sm}}, \code{\link{sm.options}} } \examples{ provide.data(birth) } \keyword{utilities} % Converted by Sd2Rd version 1.15. sm/man/wonions.Rd0000744000176200001440000000131512266061254013434 0ustar liggesusers\name{wonions} \alias{wonions} \title{Yield-density relationship for White Imperial Spanish onion plants} \description{ These data were colllected in a study of the relationship between the yield of White Imperial Spanish onion plants and the density of planting. The variables are: \tabular{ll}{ \code{Density} \tab density of planting (plants/m^2) \cr \code{Yield} \tab yield (g/plant) \cr \code{Locality} \tab a code to indicate Purnong Landing (1) or Virginia (2) } The data were collected by I.S.Rogers (South Australian Dept. of Agriculture & Fisheries). They are listed in Ratkowsky (1983), Nonlinear Regression Modeling. Dekker, New York. } \keyword{smooth} \keyword{regression} sm/man/pause.Rd0000744000176200001440000000054112266061244013054 0ustar liggesusers\name{pause} \alias{pause} \title{ Pause before continuing execution } \description{ If a program produces several plots on the same window, insertion of \code{pause()} between two plots suspends execution until the key is pressed, to allow inspection of the current plot. } \usage{ pause() } \keyword{misc} % Converted by Sd2Rd version 1.15. sm/man/sm.survival.Rd0000744000176200001440000000510212266061253014226 0ustar liggesusers\name{sm.survival} \alias{sm.survival} \title{ Nonparametric regression with survival data. } \description{ This function creates a smooth, nonparametric estimate of the quantile of the distribution of survival data as a function of a single covariate. A weighted product-limit estimate of the survivor function is obtained by smoothing across the covariate scale. A small amount of smoothing is then also applied across the survival time scale in order to achieve a smooth estimate of the quantile. } \usage{ sm.survival(x, y, status, h , hv = 0.05, p = 0.5, status.code = 1, \dots) } \arguments{ \item{x}{ a vector of covariate values. } \item{y}{ a vector of survival times. } \item{status}{ an indicator of a complete survival time or a censored value. The value of \code{status.code} defines a complete survival time. } \item{h}{ the smoothing parameter applied to the covariate scale. A normal kernel function is used and \code{h} is its standard deviation. } \item{hv}{ a smoothing parameter applied to the weighted to the product-limit estimate derived from the smoothing procedure in the covariate scale. This ensures that a smooth estimate is obtained. } \item{p}{ the quantile to be estimated at each covariate value. } \item{status.code}{ the value of \code{status} which defines a complete survival time. } \item{\dots}{ other optional parameters are passed to the \code{sm.options} function, through a mechanism which limits their effect only to this call of the function; those relevant for this function are \code{add}, \code{eval.points}, \code{ngrid}, \code{display}, \code{xlab}, \code{ylab}, \code{lty}; see the documentation of \code{\link{sm.options}} for their description. }} \value{ a list containing the values of the estimate at the evaluation points and the values of the smoothing parameters for the covariate and survival time scales. } \section{Side Effects}{ a plot on the current graphical device is produced, unless the option \code{display="none"} is set. } \details{ see Section 3.5 of the reference below. } \references{ Bowman, A.W. and Azzalini, A. (1997). \emph{Applied Smoothing Techniques for Data Analysis:} \emph{the Kernel Approach with S-Plus Illustrations.} Oxford University Press, Oxford. } \seealso{ \code{\link{sm.regression}}, \code{\link{sm.options}} } \examples{ x <- runif(50, 0, 10) y <- rexp(50, 2) z <- rexp(50, 1) status <- rep(1, 50) status[z