diff --git a/Toolboxes/PlottingFunctions/LICENSE b/Toolboxes/PlottingFunctions/LICENSE new file mode 100755 index 0000000000000000000000000000000000000000..8cdb8451d9b90c1d4000c6f22eb86471a4568be6 --- /dev/null +++ b/Toolboxes/PlottingFunctions/LICENSE @@ -0,0 +1,340 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 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 Lesser 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. + + {description} + Copyright (C) {year} {fullname} + + 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., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 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) year 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. + + {signature of Ty Coon}, 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 Lesser General +Public License instead of this License. + diff --git a/Toolboxes/PlottingFunctions/README.md b/Toolboxes/PlottingFunctions/README.md new file mode 100755 index 0000000000000000000000000000000000000000..cbe49166e2d75fe7d96f54ce8e9a17237cb3abc4 --- /dev/null +++ b/Toolboxes/PlottingFunctions/README.md @@ -0,0 +1,64 @@ +# notBoxPlot +

+ +

+ + +notBoxPlot is a MATLAB data visualisation function. + +Whilst box plots have their place, it's sometimes nicer to see all the data, rather than hiding them with summary statistics such as the inter-quartile range. This function (with a tongue in cheek name) addresses this problem. The use of the mean instead of the median and the SEM and SD instead of quartiles and whiskers are deliberate. +Jittered raw data are plotted for each group. Also shown are the mean, and 95% confidence intervals for the mean. This plotting style is designed to be used alongside parametric tests such as ANOVA and the t-test. Comparing the jittered data to the error bars provides a visual indication of whether the normality assumptions of the statistical tests are being violated. Furthermore, it allows one to eyeball the data to look for significant differences between means (non-overlapping confidence intervals indicate a significant difference at the chosen p-value, which here is 5%). Also see: http://jcb.rupress.org/cgi/content/abstract/177/1/7 Finally, 1 SD is also shown. Note that if data are not normally distributed then these statistics will be less meaningful. + +The function has several examples and there are various visualization possibilities in addition to those shown in the above screenshot. For instance, the coloured areas can be replaced by lines. + +Although it's worked well for situations I've needed it, I will be happy to modify the function if users come up against problems. + +## Features +- Directly plot LinearModel objects from `fitlm` [NEW] +- Easily mix a variety of plot styles on one figure +- Easy post-hoc modification of plot parameters via returned function handles +- Statistics (mean, SD, etc) optionally returned +- Optional plotting of median in addition to mean +- Option to plot either a 95% confidence interval for the mean or a 95% t-interval + +## FAQ +Q: "How can I modify the plot to look like..." +
+A: Most modifications can be done using the function handles. See the function help and the example function, NBP_example + + +## Included functions +- notBoxPlot.m - generates plots as shown in screenshot +- NBP.SEM_calc.m - calculate standard error of the mean. Provided as a separate function file so that it can be used for other purposes. +- NBP.tInterval_calc.m - calculate a t-interval. For small sample sizes, the t-interval is larger than the SEM. Provided as a separate function file so that it can be used for other purposes. +- NBP.example - makes a nice example plot + +## Installation +Add the ``code`` directory to your MATLAB path. Some operations (such as t-interval calculation) depend on the Stats Toolbox. + + +## Changelog + + +**v1.31 (28-11-17)** + +* Bugfix to SEM and t-interval calc functions that caused errors to be pooled when fed a matrix rather than a vector +* Jitter is no "violin-like" so it scales with point density in Y. Looks neater. + + +**v1.3 (11-03-17)** + +* Remove legacy calls +* Allow passing of a table, which automatically labels the axes +* Pass a LinearModel, which automatically labels the axes and uses the model errors +* Examples are now in separate files and doc text is neater +* User can now optionally do `notBoxPlot(y,'jitter',0.5)` instead of `notBoxPlot(y,[],'jitter',0.5)` + + +**v1.2 (28-08-16)** + +* Add median to plots +* Select SEM or t-interval from command line +* Return stats as second output +* Move to parameter/value pairs by default and warn user if they aren't doing this. +* Add unit tests. diff --git a/Toolboxes/PlottingFunctions/Violin.m b/Toolboxes/PlottingFunctions/Violin.m new file mode 100644 index 0000000000000000000000000000000000000000..1ba59fd99357c9074e000611c069b2b8e04d1700 --- /dev/null +++ b/Toolboxes/PlottingFunctions/Violin.m @@ -0,0 +1,311 @@ +classdef Violin < handle + % Violin creates violin plots for some data + % A violin plot is an easy to read substitute for a box plot + % that replaces the box shape with a kernel density estimate of + % the data, and optionally overlays the data points itself. + % + % Additional constructor parameters include the width of the + % plot, the bandwidth of the kernel density estimation, and the + % X-axis position of the violin plot. + % + % Use violinplot for a + % boxplot-like wrapper for + % interactive plotting. + % + % See for more information on Violin Plots: + % J. L. Hintze and R. D. Nelson, "Violin plots: a box + % plot-density trace synergism," The American Statistician, vol. + % 52, no. 2, pp. 181-184, 1998. + % + % Violin Properties: + % ViolinColor - Fill color of the violin area and data points. + % Defaults to the next default color cycle. + % ViolinAlpha - Transparency of the ciolin area and data points. + % Defaults to 0.3. + % EdgeColor - Color of the violin area outline. + % Defaults to [0.5 0.5 0.5] + % BoxColor - Color of the box, whiskers, and the outlines of + % the median point and the notch indicators. + % Defaults to [0.5 0.5 0.5] + % MedianColor - Fill color of the median and notch indicators. + % Defaults to [1 1 1] + % ShowData - Whether to show data points. + % Defaults to true + % ShowNotches - Whether to show notch indicators. + % Defaults to false + % ShowMean - Whether to show mean indicator. + % Defaults to false + % + % Violin Children: + % ScatterPlot - scatter plot of the data points + % ViolinPlot - fill plot of the kernel density estimate + % BoxPlot - fill plot of the box between the quartiles + % WhiskerPlot - line plot between the whisker ends + % MedianPlot - scatter plot of the median (one point) + % NotchPlots - scatter plots for the notch indicators + % MeanPlot - line plot at mean value + + % Copyright (c) 2016, Bastian Bechtold + % This code is released under the terms of the BSD 3-clause license + + properties + ScatterPlot % scatter plot of the data points + ViolinPlot % fill plot of the kernel density estimate + BoxPlot % fill plot of the box between the quartiles + WhiskerPlot % line plot between the whisker ends + MedianPlot % scatter plot of the median (one point) + NotchPlots % scatter plots for the notch indicators + MeanPlot % line plot of the mean (horizontal line) + end + + properties (Dependent=true) + ViolinColor % fill color of the violin area and data points + ViolinAlpha % transparency of the violin area and data points + EdgeColor % color of the violin area outline + BoxColor % color of box, whiskers, and median/notch edges + MedianColor % fill color of median and notches + ShowData % whether to show data points + ShowNotches % whether to show notch indicators + ShowMean % whether to show mean indicator + end + + methods + function obj = Violin(data, pos, varargin) + %Violin plots a violin plot of some data at pos + % VIOLIN(DATA, POS) plots a violin at x-position POS for + % a vector of DATA points. + % + % VIOLIN(..., 'PARAM1', val1, 'PARAM2', val2, ...) + % specifies optional name/value pairs: + % 'Width' Width of the violin in axis space. + % Defaults to 0.3 + % 'Bandwidth' Bandwidth of the kernel density + % estimate. Should be between 10% and + % 40% of the data range. + % 'ViolinColor' Fill color of the violin area and + % data points. Defaults to the next + % default color cycle. + % 'ViolinAlpha' Transparency of the violin area and + % data points. Defaults to 0.3. + % 'EdgeColor' Color of the violin area outline. + % Defaults to [0.5 0.5 0.5] + % 'BoxColor' Color of the box, whiskers, and the + % outlines of the median point and the + % notch indicators. Defaults to + % [0.5 0.5 0.5] + % 'MedianColor' Fill color of the median and notch + % indicators. Defaults to [1 1 1] + % 'ShowData' Whether to show data points. + % Defaults to true + % 'ShowNotches' Whether to show notch indicators. + % Defaults to false + % 'ShowMean' Whether to show mean indicator. + % Defaults to false + + args = obj.checkInputs(data, pos, varargin{:}); + data = data(not(isnan(data))); + if numel(data) == 1 + obj.MedianPlot = scatter(pos, data, 'filled'); + obj.MedianColor = args.MedianColor; + obj.MedianPlot.MarkerEdgeColor = args.EdgeColor; + return + end + + hold('on'); + + % calculate kernel density estimation for the violin + [density, value] = ksdensity(data, 'bandwidth', args.Bandwidth); + density = density(value >= min(data) & value <= max(data)); + value = value(value >= min(data) & value <= max(data)); + value(1) = min(data); + value(end) = max(data); + + % all data is identical + if min(data) == max(data) + density = 1; + end + + if isempty(args.Width) + width = 0.3/max(density); + else + width = args.Width/max(density); + end + + % plot the data points within the violin area + if length(density) > 1 + jitterstrength = interp1(value, density*width, data); + else % all data is identical: + jitterstrength = density*width; + end + jitter = 2*(rand(size(data))-0.5); + obj.ScatterPlot = ... + scatter(pos + jitter.*jitterstrength, data, 'filled'); + + % plot the data mean + meanValue = mean(value); + if length(density) > 1 + meanDensity = interp1(value, density, meanValue); + else % all data is identical: + meanDensity = density; + end + obj.MeanPlot = plot([pos-meanDensity*width pos+meanDensity*width], ... + [meanValue meanValue]); + obj.MeanPlot.LineWidth = 0.75; + + % plot the violin + obj.ViolinPlot = ... % plot color will be overwritten later + fill([pos+density*width pos-density(end:-1:1)*width], ... + [value value(end:-1:1)], [1 1 1]); + + % plot the mini-boxplot within the violin + quartiles = quantile(data, [0.25, 0.5, 0.75]); + obj.BoxPlot = ... % plot color will be overwritten later + fill([pos-0.01 pos+0.01 pos+0.01 pos-0.01], ... + [quartiles(1) quartiles(1) quartiles(3) quartiles(3)], ... + [1 1 1]); + IQR = quartiles(3) - quartiles(1); + lowhisker = quartiles(1) - 1.5*IQR; + lowhisker = max(lowhisker, min(data(data > lowhisker))); + hiwhisker = quartiles(3) + 1.5*IQR; + hiwhisker = min(hiwhisker, max(data(data < hiwhisker))); + if ~isempty(lowhisker) && ~isempty(hiwhisker) + obj.WhiskerPlot = plot([pos pos], [lowhisker hiwhisker]); + end + obj.MedianPlot = scatter(pos, quartiles(2), [], [1 1 1], 'filled'); + + obj.NotchPlots = ... + scatter(pos, quartiles(2)-1.57*IQR/sqrt(length(data)), ... + [], [1 1 1], 'filled', '^'); + obj.NotchPlots(2) = ... + scatter(pos, quartiles(2)+1.57*IQR/sqrt(length(data)), ... + [], [1 1 1], 'filled', 'v'); + + obj.EdgeColor = args.EdgeColor; + obj.BoxColor = args.BoxColor; + obj.MedianColor = args.MedianColor; + if not(isempty(args.ViolinColor)) + obj.ViolinColor = args.ViolinColor; + else + obj.ViolinColor = obj.ScatterPlot.CData; + end + obj.ViolinAlpha = args.ViolinAlpha; + obj.ShowData = args.ShowData; + obj.ShowNotches = args.ShowNotches; + obj.ShowMean = args.ShowMean; + end + + function set.EdgeColor(obj, color) + obj.ViolinPlot.EdgeColor = color; + end + + function color = get.EdgeColor(obj) + color = obj.ViolinPlot.EdgeColor; + end + + function set.MedianColor(obj, color) + obj.MedianPlot.MarkerFaceColor = color; + if not(isempty(obj.NotchPlots)) + obj.NotchPlots(1).MarkerFaceColor = color; + obj.NotchPlots(2).MarkerFaceColor = color; + end + end + + function color = get.MedianColor(obj) + color = obj.MedianPlot.MarkerFaceColor; + end + + function set.BoxColor(obj, color) + obj.BoxPlot.FaceColor = color; + obj.BoxPlot.EdgeColor = color; + obj.WhiskerPlot.Color = color; + obj.MedianPlot.MarkerEdgeColor = color; + obj.NotchPlots(1).MarkerEdgeColor = color; + obj.NotchPlots(2).MarkerEdgeColor = color; + end + + function color = get.BoxColor(obj) + color = obj.BoxPlot.FaceColor; + end + + function set.ViolinColor(obj, color) + obj.ViolinPlot.FaceColor = color; + obj.ScatterPlot.MarkerFaceColor = color; + obj.MeanPlot.Color = color; + end + + function color = get.ViolinColor(obj) + color = obj.ViolinPlot.FaceColor; + end + + function set.ViolinAlpha(obj, alpha) + obj.ScatterPlot.MarkerFaceAlpha = alpha; + obj.ViolinPlot.FaceAlpha = alpha; + end + + function alpha = get.ViolinAlpha(obj) + alpha = obj.ViolinPlot.FaceAlpha; + end + + function set.ShowData(obj, yesno) + if yesno + obj.ScatterPlot.Visible = 'on'; + else + obj.ScatterPlot.Visible = 'off'; + end + end + + function yesno = get.ShowData(obj) + yesno = logical(strcmp(obj.NotchPlots(1).Visible, 'on')); + end + + function set.ShowNotches(obj, yesno) + if yesno + obj.NotchPlots(1).Visible = 'on'; + obj.NotchPlots(2).Visible = 'on'; + else + obj.NotchPlots(1).Visible = 'off'; + obj.NotchPlots(2).Visible = 'off'; + end + end + + function yesno = get.ShowNotches(obj) + yesno = logical(strcmp(obj.ScatterPlot.Visible, 'on')); + end + + function set.ShowMean(obj, yesno) + if yesno + obj.MeanPlot.Visible = 'on'; + else + obj.MeanPlot.Visible = 'off'; + end + end + + function yesno = get.ShowMean(obj) + yesno = logical(strcmp(obj.MeanPlot.Visible, 'on')); + end + end + + methods (Access=private) + function results = checkInputs(obj, data, pos, varargin) + isscalarnumber = @(x) (isnumeric(x) & isscalar(x)); + p = inputParser(); + p.addRequired('Data', @isnumeric); + p.addRequired('Pos', isscalarnumber); + p.addParameter('Width', [], isscalarnumber); + p.addParameter('Bandwidth', [], isscalarnumber); + iscolor = @(x) (isnumeric(x) & length(x) == 3); + p.addParameter('ViolinColor', [], iscolor); + p.addParameter('BoxColor', [0.5 0.5 0.5], iscolor); + p.addParameter('EdgeColor', [0.5 0.5 0.5], iscolor); + p.addParameter('MedianColor', [1 1 1], iscolor); + p.addParameter('ViolinAlpha', 0.3, isscalarnumber); + isscalarlogical = @(x) (islogical(x) & isscalar(x)); + p.addParameter('ShowData', true, isscalarlogical); + p.addParameter('ShowNotches', false, isscalarlogical); + p.addParameter('ShowMean', false, isscalarlogical); + + p.parse(data, pos, varargin{:}); + results = p.Results; + end + end +end diff --git a/Toolboxes/PlottingFunctions/code/+NBP/SEM_calc.m b/Toolboxes/PlottingFunctions/code/+NBP/SEM_calc.m new file mode 100755 index 0000000000000000000000000000000000000000..b5269bfcaad4ab02b9f92ef4a5804aa3210e2072 --- /dev/null +++ b/Toolboxes/PlottingFunctions/code/+NBP/SEM_calc.m @@ -0,0 +1,59 @@ +function sem=SEM_calc(vect, CI) +% SEM_calc - standard error of the mean, confidence interval +% +% function sem = NBP.SEM_calc(vect, CI) +% +% Purpose +% Calculate the standard error the mean to a given confidence +% interval (CI). Note that nans do not contribute to the +% calculation of the sample size and are ignored for the SD +% calculation. Output of this function has been checked against +% known working code written in R. +% +% Inputs +% - vect: A vector upon which the SEM will be calculated. Note that +% if vect is a matrix then we calculate one SEM for each +% column. +% +% - CI [optional]: a p value for a different 2-tailed interval. e.g. 0.01 +% This is a 2-tailed interval. +% +% Outputs +% sem - the standard error of the mean. So to plot the interval it's mu-sem +% to mu+sem. +% +% Example - plot a 1% interval [rather than the default %5] +% r=randn(1,30); +% S=SEM_calc(r,0.01); +% hist(r) +% hold on +% plot(mean(r), mean(ylim),'r*') +% plot([mean(r)-S,mean(r)+S], [mean(ylim),mean(ylim)],'r-') +% hold off +% +% +% Rob Campbell +% +% +% Also see - tInterval_Calc, norminv + +narginchk(1,2) + +if isvector(vect) + vect=vect(:); +end + +% Define an anonymous function to take over from norminv, which is in the Stats ToolBox +myNormInv = @(x) -sqrt(2)*erfcinv(2*x); + +if nargin==1 + stdCI = 1.96 ; +elseif nargin==2 + CI = CI/2 ; %Convert to 2-tail + stdCI = abs(myNormInv(CI)); % This is the same as doing: abs(norminv(CI,0,1)) +end + +for ii=1:size(vect,2) + f = find(~isnan(vect(:,ii))); + sem(ii) = ( std(vect(f,ii)) ./ sqrt(length(f)) ) * stdCI ; +end diff --git a/Toolboxes/PlottingFunctions/code/+NBP/jitterExamples.m b/Toolboxes/PlottingFunctions/code/+NBP/jitterExamples.m new file mode 100755 index 0000000000000000000000000000000000000000..5e4fa40cef6835f24da38d12f8fdd71759ea90cb --- /dev/null +++ b/Toolboxes/PlottingFunctions/code/+NBP/jitterExamples.m @@ -0,0 +1,34 @@ +function jitterExamples + +% +% % Jitter examples +% % default jitter is 0.3 +% +% clf +% +% R = randn(40,5); +% +% subplot(3,1,1) +% notBoxPlot(R,'jitter',0.15) +% +% subplot(3,1,2) +% notBoxPlot(R,'jitter',0.3); % The default +% +% subplot(3,1,3) +% notBoxPlot(R,'jitter',0.6); + + +help(['NBP.',mfilename]) + +clf + +R = randn(40,5); + +subplot(3,1,1) +notBoxPlot(R,'jitter',0.15) + +subplot(3,1,2) +notBoxPlot(R,'jitter',0.3); % The default + +subplot(3,1,3) +notBoxPlot(R,'jitter',0.6); diff --git a/Toolboxes/PlottingFunctions/code/+NBP/lineExamples.m b/Toolboxes/PlottingFunctions/code/+NBP/lineExamples.m new file mode 100755 index 0000000000000000000000000000000000000000..ca7bc580e5821489847055e07f7bad750b858105 --- /dev/null +++ b/Toolboxes/PlottingFunctions/code/+NBP/lineExamples.m @@ -0,0 +1,33 @@ +function lineExamples + +% % Mixing lines and areas and using different number of points +% % in each group [note that the way notBoxPlot sets the x axis +% % limits can cause problems when combining plots this way] +% +% clf +% +% subplot(1,2,1) +% h=notBoxPlot(randn(10,1)+4,5,'style','line'); +% set(h.data,'color','m') +% h=notBoxPlot(randn(50,10)); +% set(h(5).data,'color','m') +% +% subplot(1,2,2) +% notBoxPlot(randn(25,1),1,'style','sdline') +% notBoxPlot(randn(50,1),2) % more points +% xlim([0,3]) + +help(['NBP.',mfilename]) + +clf + +subplot(1,2,1) +h=notBoxPlot(randn(10,1)+4,5,'style','line'); +set(h.data,'color','m') +h=notBoxPlot(randn(50,10)); +set(h(5).data,'color','m') + +subplot(1,2,2) +notBoxPlot(randn(25,1),1,'style','sdline') +notBoxPlot(randn(50,1),2) % more points +xlim([0,3]) diff --git a/Toolboxes/PlottingFunctions/code/+NBP/linearModelExamples.m b/Toolboxes/PlottingFunctions/code/+NBP/linearModelExamples.m new file mode 100755 index 0000000000000000000000000000000000000000..96268d7a6bbc61f5e3c09c0da71ebe13549aa884 --- /dev/null +++ b/Toolboxes/PlottingFunctions/code/+NBP/linearModelExamples.m @@ -0,0 +1,105 @@ +function linearModelExamples + +% % Linear model call format +% +% +% % Build data +% rng(555), +% n=10; +% R=rand(n,5); +% R(:,3)=R(:,3)+1; +% +% X=repmat(1:5,size(R,1),1); +% lemmings=R(:); +% group=X(:); +% +% clf +% +% % We can call notBoxPlot with just X and Y +% subplot(2,2,1) +% notBoxPlot(lemmings,group,'jitter',0.75) +% grid on, box on +% ylim([-0.5,2.2]) +% title('two vectors') +% +% % We can create a table and get the same plot plus the variable names on the axes +% subplot(2,2,2) +% T = table(lemmings,group); +% notBoxPlot(T,'jitter',0.75) +% grid on, box on +% ylim([-0.5,2.2]) +% title('table') +% +% % We can fit a linear model do the data and plot this +% subplot(2,2,3) +% group = categorical(group); +% T = table(lemmings,group); +% M = fitlm(T,'lemmings ~ group'); +% notBoxPlot(M,'jitter',0.75) +% grid on, box on +% ylim([-0.5,2.2]) +% title('model') +% +% % Increase variance of one group +% subplot(2,2,4) +% lemmings(end-n+1:end) = lemmings(end-n+1:end)*1.75; +% T = table(lemmings,group); +% M = fitlm(T,'lemmings ~ group'); +% notBoxPlot(M,'jitter',0.75) +% grid on, box on +% ylim([-0.5,2.2]) +% title('increased variance in group 5') + +help(['NBP.',mfilename]) + + + + +% Build data +rng(555), +n=10; +R=rand(n,5); +R(:,3)=R(:,3)+1; + +X=repmat(1:5,size(R,1),1); +lemmings=R(:); +group=X(:); + + +clf + +% We can call notBoxPlot with just X and Y +subplot(2,2,1) +notBoxPlot(lemmings,group,'jitter',0.75) +grid on, box on +ylim([-0.5,2.2]) +title('two vectors') + +% We can create a table and get the same plot plus the variable names on the axes +subplot(2,2,2) +T = table(lemmings,group); +notBoxPlot(T,'jitter',0.75) +grid on, box on +ylim([-0.5,2.2]) +title('table') + +% We can fit a linear model do the data and plot this +subplot(2,2,3) +group = categorical(group); +T = table(lemmings,group); +M = fitlm(T,'lemmings ~ group'); +notBoxPlot(M,'jitter',0.75) +grid on, box on +ylim([-0.5,2.2]) +title('model') + + +% Increase variance of one group +subplot(2,2,4) +lemmings(end-n+1:end) = lemmings(end-n+1:end)*1.75; +T = table(lemmings,group); +M = fitlm(T,'lemmings ~ group'); +notBoxPlot(M,'jitter',0.75) +grid on, box on +ylim([-0.5,2.2]) +title('increased variance in group 5') diff --git a/Toolboxes/PlottingFunctions/code/+NBP/showCase.m b/Toolboxes/PlottingFunctions/code/+NBP/showCase.m new file mode 100755 index 0000000000000000000000000000000000000000..785acfb102b1108f865e9629f612d288c8fd8951 --- /dev/null +++ b/Toolboxes/PlottingFunctions/code/+NBP/showCase.m @@ -0,0 +1,132 @@ +function showCase +% Example showing a variety of effects possible with notBoxPlot +% +% function NBP.showCase +% +% +% Purpose +% Showcase notBoxPlot +% +% +% No inputs or outputs +% +% +% Rob Campbell + + + +W=which(['NBP.',mfilename]); +fprintf('Running example located at %s\n',W) + +hFig=figure(1984); + +set(hFig,... + 'Name','notBoxPlot example',... + 'PaperPosition',[0,0,32,27]) %Just to make save to disk consistent) +clf + +W=0.45; %image width + +% Top/left plot +axes('position',[0.05,0.53,W,W]) +r=randn(40,5); +for ii=1:5 + r(:,ii)=r(:,ii)+ii*0.3; +end +notBoxPlot(r,[],'jitter',0.5); +box on +grid on + + + +% Top/right plot +axes('position',[0.53,0.53,W,W]) +r=randn(20,20); + +IND=zeros(1,20); +IND(1:4:size(r,2))=1; +r(:,find(IND))=0.75*r(:,1:4:end)+1.75; + +H=notBoxPlot(r,[],'jitter',0.6); +d=[H.data]; + +%Highlight the plots with higher means +set(d(find(IND)),'markerfacecolor',[0.4,1,0.4],'color',[0,0.4,0]) + +%higher means as green +set([H(find(IND)).data],'MarkerSize',4,... + 'markerFaceColor',[1,1,1]*0.25,... + 'markerEdgeColor', 'none') +set([H(find(IND)).semPtch],... + 'FaceColor',[0,0.75,0],... + 'EdgeColor','none') +set([H(find(IND)).sdPtch],... + 'FaceColor',[0.6,1,0.6],... + 'EdgeColor','none') +set([H(find(IND)).mu],... + 'Color',[0,0.4,0]) + +set(gca,'XTick',[]) + + +% Color lower means gray +set([H(find(~IND)).data],'MarkerSize',4,... + 'markerFaceColor',[1,1,1]*0.5,... + 'markerEdgeColor', 'none') +set([H(find(~IND)).semPtch],... + 'FaceColor',[1,1,1]*0.25,... + 'EdgeColor','none') +set([H(find(~IND)).sdPtch],... + 'FaceColor',[1,1,1]*0.75,... + 'EdgeColor','none') +set([H(find(~IND)).mu],... + 'Color','b') + +box on + + + +axes('position',[0.05,0.05,W,W]) +x=[1,2,3,3]; +y=randn(20,length(x)); +y(:,end)=0.5*y(:,end)+4; +y(:,end-1)=y(:,end-1)-1; +y(1:8,end-1:end)=nan; %Decrease sample size in the last two plots + +H=notBoxPlot(y,x,'jitter',0.6,'style','sdline'); +set(H(end).data,'Marker','^',... + 'MarkerSize',5) +set([H.sd],'LineWidth',4) +box on +grid on + + + +axes('position',[0.53,0.05,W,W]) +H=notBoxPlot(randn(10,1)+7,2,'style','line'); +set(H.data,'color','b','Marker','.') + +r=randn(20,10); +for ii=1:10 + r(:,ii)=r(:,ii)+ii*0.65; +end + +H=notBoxPlot(r,[],'jitter',0.5); +set([H.data],... + 'MarkerFaceColor',[1,1,1]*0.35,... + 'markerEdgeColor',[1,1,1]*0.35,... + 'MarkerSize',3) + +set([H.mu],'color','w') +J=jet(length(H)); +for ii=1:length(H) + set(H(ii).sdPtch,'FaceColor',J(ii,:),... + 'EdgeColor','none') + + set(H(ii).semPtch,'FaceColor',J(ii,:)*0.3,... + 'EdgeColor','none') + +end +box on +set(gca,'TickDir','Out') + diff --git a/Toolboxes/PlottingFunctions/code/+NBP/simpleExamples.m b/Toolboxes/PlottingFunctions/code/+NBP/simpleExamples.m new file mode 100755 index 0000000000000000000000000000000000000000..8b0485c43661acbcb1d319b9b81ba6937c258206 --- /dev/null +++ b/Toolboxes/PlottingFunctions/code/+NBP/simpleExamples.m @@ -0,0 +1,44 @@ +function simpleExamples +% +% clf +% +% subplot(2,2,1) +% notBoxPlot(randn(20,5)); +% +% subplot(2,2,2) +% notBoxPlot(randn(20,5),[1:4,7]); +% +% subplot(2,2,3) +% h=notBoxPlot(randn(10,20)); +% d=[h.data]; +% set(d(1:4:end),'markerfacecolor',[0.4,1,0.4],'color',[0,0.4,0]) +% +% subplot(2,2,4) +% x=[1,2,3,4,5,5]; +% y=randn(20,length(x)); +% y(:,end)=y(:,end)+3; +% y(:,end-1)=y(:,end-1)-1; +% notBoxPlot(y,x); + +help(['NBP.',mfilename]) + +clf + +subplot(2,2,1) +notBoxPlot(randn(20,5)); + +subplot(2,2,2) +notBoxPlot(randn(20,5),[1:4,7]); + +subplot(2,2,3) +h=notBoxPlot(randn(10,20)); +d=[h.data]; +set(d(1:4:end),'markerfacecolor',[0.4,1,0.4],'color',[0,0.4,0]) + + +subplot(2,2,4) +x=[1,2,3,4,5,5]; +y=randn(20,length(x)); +y(:,end)=y(:,end)+3; +y(:,end-1)=y(:,end-1)-1; +notBoxPlot(y,x); diff --git a/Toolboxes/PlottingFunctions/code/+NBP/statsOptionsExample.m b/Toolboxes/PlottingFunctions/code/+NBP/statsOptionsExample.m new file mode 100755 index 0000000000000000000000000000000000000000..26b8f961c3384c7d96de00deca135a3c94653ec8 --- /dev/null +++ b/Toolboxes/PlottingFunctions/code/+NBP/statsOptionsExample.m @@ -0,0 +1,45 @@ +function statsOptionsExamples + +% +% % Examples of different statistics options +% +% % The 95% SEM vs the 95% t-interval +% clf +% y=randn(8,3); +% subplot(2,2,1) +% notBoxPlot(y) +% title('95% SEM (n=8)') +% +% subplot(2,2,2) +% notBoxPlot(y,'interval','tInterval') +% title('95% t-interval (n=8)') +% +% % Adding medians +% subplot(2,2,:3:4) +% n=[5,10,20,40]; +% for ii=1:4 +% rng(555), notBoxPlot(rand(1,n(ii)),ii,'markMedian',true) +% end +% title('median vs mean') + + +help(['NBP.',mfilename]) + +% The 95% SEM vs the 95% t-interval +clf +y=randn(8,3); +subplot(2,2,1) +notBoxPlot(y) +title('95% SEM (n=8)') + +subplot(2,2,2) +notBoxPlot(y,'interval','tInterval') +title('95% t-interval (n=8)') + +% Adding medians +subplot(2,2,3:4) +n=[5,10,20,40]; +for ii=1:4 + rng(555), notBoxPlot(rand(1,n(ii)),ii,'markMedian',true) +end +title('median vs mean') \ No newline at end of file diff --git a/Toolboxes/PlottingFunctions/code/+NBP/tInterval_calc.m b/Toolboxes/PlottingFunctions/code/+NBP/tInterval_calc.m new file mode 100755 index 0000000000000000000000000000000000000000..f53979c0be3c1838d1d01dc475edcc6d7c8e822c --- /dev/null +++ b/Toolboxes/PlottingFunctions/code/+NBP/tInterval_calc.m @@ -0,0 +1,60 @@ +function tint=tInterval_Calc(vect, CI) +% tInterval_Calc - confidence interval based on the t-distribution +% +% function tint = NBP.tInterval_Calc(vect, CI) +% +% +% Purpose +% Calculate the t-interval about the mean to a given confidence +% level (CI). Note that nans do not contribute to the calculation +% of the sample size and are ignored for the SD calculation. Output +% of this function has been checked against known working code +% written in R. +% +% +% Inputs +% - vect: Calculates the two-tailed 95% t confidence limits for the mean. +% +% - CI [optional]: a p value for a different 2-tailed interval. e.g. 0.01 +% +% Example - plot a 1% interval [rather than the default %5] +% r=randn(1,30); +% T=tInterval_calc(r,0.01); +% hist(r) +% hold on +% plot(mean(r), mean(ylim),'r*') +% plot([mean(r)-T,mean(r)+T], [mean(ylim),mean(ylim)],'r-') +% hold off +% +% +% +% Rob Campbell - 12/03/08 +% +% +% Also see - SEM_calc, tinv + +narginchk(1,2) + +if isvector(vect) + vect=vect(:); +end + + +if nargin==1 + CI = 0.025; %If no second argument, work out a 2-tailed 5% t-interval + stdCI=tinv(1-CI, length(vect)-1); +elseif nargin==2 + CI = CI/2 ; %Convert to 2-tail + stdCI=tinv(1-CI, length(vect)-1); %Based on the t distribution +end + +if stdCI==0 + error('Can''t find confidence iterval for 0 standard deviations!') +end + + +for ii=1:size(vect,2) + f = find(~isnan(vect(:,ii))); + tint(ii) = ( std(vect(f,ii)) ./ sqrt(length(f)) ) * stdCI ; +end + diff --git a/Toolboxes/PlottingFunctions/code/+NBP/tableExamples.m b/Toolboxes/PlottingFunctions/code/+NBP/tableExamples.m new file mode 100755 index 0000000000000000000000000000000000000000..725c1804dc9c05fc92a7c6c62f8baf4623b1f5e8 --- /dev/null +++ b/Toolboxes/PlottingFunctions/code/+NBP/tableExamples.m @@ -0,0 +1,32 @@ +function tableExamples + +% % Table call format +% +% clf +% +% albert=[1,1,1,3,2,1,3,3,3,2,2,3,3]'; +% victoria=[7,8,6,1,5,7,2,1,3,4,5,2,4]'; +% M = table(victoria,albert); %place data in first column and groups in the second +% +% subplot(1,2,1) +% notBoxPlot(M) +% +% subplot(1,2,2) +% notBoxPlot(M,'jitter',0.5) + + +help(['NBP.',mfilename]) + + +clf + +albert=[1,1,1,3,2,1,3,3,3,2,2,3,3]'; +victoria=[7,8,6,1,5,7,2,1,3,4,5,2,4]'; + +M = table(victoria,albert); %place data in first column and groups in the second + +subplot(1,2,1) +notBoxPlot(M) + +subplot(1,2,2) +notBoxPlot(M,'jitter',0.75) \ No newline at end of file diff --git a/Toolboxes/PlottingFunctions/code/.gitignore b/Toolboxes/PlottingFunctions/code/.gitignore new file mode 100755 index 0000000000000000000000000000000000000000..5509140f2ce4ffc5aa4c77e35093e5744c301b90 --- /dev/null +++ b/Toolboxes/PlottingFunctions/code/.gitignore @@ -0,0 +1 @@ +*.DS_Store diff --git a/Toolboxes/PlottingFunctions/code/notBoxPlot.m b/Toolboxes/PlottingFunctions/code/notBoxPlot.m new file mode 100755 index 0000000000000000000000000000000000000000..9942705ce25c2f9a5e563a284550c9cd7f26692f --- /dev/null +++ b/Toolboxes/PlottingFunctions/code/notBoxPlot.m @@ -0,0 +1,489 @@ +function varargout=notBoxPlot(y,x,varargin) +% notBoxPlot - Doesn't plot box plots! +% +% function notBoxPlot(y,x,'Param1',val1,'Param2',val2,...) +% +% +% Purpose +% An alternative to a box plot, where the focus is on showing raw +% data. Plots columns of y as different groups located at points +% along the x axis defined by the optional vector x. Points are +% layed over a 1.96 SEM (95% confidence interval) in red and a 1 SD +% in blue. The user has the option of plotting the SEM and SD as a +% line rather than area. Raw data are jittered along x for clarity. This +% function is suited to displaying data which are normally distributed. +% Since, for instance, the SEM is meaningless if the data are bimodally +% distributed. +% +% +% Inputs +% y - A vector, matrix, or table of the data to plot. +% * vector and no x is provided: all data are grouped at one x position. +% * matrix and no x is provided: each column is plotted in a different x position. +% * vector with x grouping variable provided: data grouped according to x +% * a Table is treated such that the first column is y and the second x. +% * a LinearModel produced by fitlm +% +% x - [optional], the x axis points at which y columns should be +% plotted. This allows more than one set of y values to appear +% at one x location. Such instances are coloured differently. +% Contrast the first two panels in Example 1 to see how this input behaves. +% x need not be provided if y is a table. +% +% Note that if x and y are both vectors of the same length this function +% behaves like boxplot (see Example 5). +% +% +% Parameter/Value pairs +% 'jitter' - how much to jitter the data for visualization +% (optional). The width of the boxes are automatically +% scaled to the jitter magnitude. If jitter is empty or +% missing then a default value of 0.3 is used. +% +% 'style' - a string defining plot style of the data. +% 'patch' [default] - plots 95% SEM (by default, see below) and SD as a +% box using patch objects. +% 'line' - create a plot where the SD and 95% SEM (see below) are +% constructed from lines. +% 'sdline' - a hybrid of the above, in which only the SD is +% replaced with a line. +% +% 'interval' - 'SEM' [default] Plots a 95% confidence interval for the mean +% - 'tInterval' Plots a 95% t-interval for the mean +% - If a LinearModel from fitlm is provided, interval is always +% the tInterval and the confidence interval comes from the model. +% +% 'markMedian' - false [default] if true the median value is highlighted +% The median is highlighted as a dotted line or an open square +% (if "line" style was used). +% +% +% Outputs (all area optional) +% H - structure of handles for plot objects. +% stats - the values of the mean, SD, etc, used for the plots +% +% +% +% - - - - - - - - - - - - - - - - - - - - +% Examples (run clf between examples): +% +% 1 - Basic usage: +% >> notBoxPlot([7,8,6,1,5,7,2,1,3,4,5,2,4]) +% >> notBoxPlot([7,8,6,1,5,7,2,1,3,4,5,2,4], [1,1,1,3,2,1,3,3,3,2,2,3,3]) +% >> notBoxPlot(rand(1,100)) +% >> notBoxPlot(randn(20,5)) +% >> notBoxPlot(randn(20,5),[1:4,7]); +% >> notBoxPlot(MY_TABLE) +% +% For more run: +% NBP.simpleExamples +% NBP.tableExamples +% +% 2 - Changing plot style +% >> notBoxPlot(randn(20,5),[],'interval','tinterval'); +% >> notBoxPlot(randn(20,5),'style','line'); %also valid: no need for x +% >> notBoxPlot(MY_TABLE,'jitter',0.5) +% +% For more run: +% NBP.lineExamples +% NBP.jitterExamples +% NBP.showCase +% +% 3 - Showing different statistics +% >> notBoxPlot(randn(8,3),'interval','tInterval') +% >> notBoxPlot(randn(8,3),'markMedian',true) +% +% For more run: +% NBP.statsOptionsExamples +% +% 4 - Overlaying different notBoxPlots on one axis +% >> clf +% >> hold on +% >> for ii=1:8; notBoxPlot(rand(1,ii*10),ii), end +% +% +% Rob Campbell - August 2016 +% +% Also see: boxplot + + + + +% Check input arguments +if nargin==0 + help(mfilename) + return +end + +% Check if Y is of a suitable class +if ~isnumeric(y) && ~istable(y) && ~isa(y,'LinearModel') + fprintf('Variable y is a %s. This is not an allowed input type. see help %s\n',... + class(y), mfilename) + return +end + +% Parse the different call types +modelCIs=[]; +tableOrModelCall=false; + +switch lower(class(y)) + +case 'table' + tableOrModelCall=true; + if nargin>1 %so user doesn't need to specify a blank variable for x + if ~isempty(x) + varargin=[x,varargin]; + end + end + thisTable=y; + varNames=thisTable.Properties.VariableNames; + if length(varNames) ~= 2 + fprintf('% s can only handle tables with two variables\n',mfilename) + return + end + y = thisTable.(varNames{1}); + x = thisTable.(varNames{2}); + +case 'linearmodel' + tableOrModelCall=true; + if nargin>1 %so user doesn't need to specify a blank variable for x + if ~isempty(x) + varargin=[x,varargin]; + end + end + + thisModel=y; + + if length(thisModel.PredictorNames) >1 + fprintf('% s can only handle linear models with one predictor\n',mfilename) + return + end + y = thisModel.Variables.(thisModel.ResponseName); + x = thisModel.Variables.(thisModel.PredictorNames{1}); + + %Check that x is of a suitable type + if isnumeric(x) + fprintf('The model predictor variable should not be continuous\n') + return + end + if iscell(x) + fprintf('Coercing predictor variable from a cell array to a categorical variable\n') + x=categorical(x); + end + + varNames = {thisModel.ResponseName,thisModel.PredictorNames{1}}; %for the axis labels + + % Set the SD bar to have 1.96 standard deviations + varargin = [varargin,'numSDs',1.96]; + + % Get the the confidence intervals from the model + modelCIs = coefCI(thisModel,0.05); + +otherwise %Otherwise Y is a vector or a matrix + + if isvector(y) + y=y(:); + end + + % Handle case where user doesn't supply X, but there are user-supplied param/val pairs. e.g. + % notBoxPlot(rand(20,5),'jitter',0.5) + if nargin>2 && ischar(x) + varargin=[x,varargin]; + x=[]; + end + + % Generate an monotonically increasing X variable if the user didn't supply anything + % for the grouping variable + if nargin<2 || isempty(x) + x=1:size(y,2); + end + +end %switch class(y) + + +%If x is logical then the function fails. So let's make sure it's a double +x=double(x); + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Parse input arguments +params = inputParser; +params.CaseSensitive = false; + +%User-visible options +params.addParameter('jitter', 0.3, @(x) isnumeric(x) && isscalar(x)); +params.addParameter('style','patch', @(x) ischar(x) && any(strncmpi(x,{'patch','line','sdline'},4)) ); +params.addParameter('interval','SEM', @(x) ischar(x) && any(strncmpi(x,{'sem','tinterval'},4)) ); +params.addParameter('markMedian', false, @(x) islogical(x)); + +%Options hidden from the user +params.addParameter('numSDs',1, @(x) isnumeric(x) && isscalar(x) && x>=0) +params.addParameter('manualCI',[], @(x) (isnumeric(x) && isscalar(x)) || isempty(x) ) + +params.parse(varargin{:}); + +%Extract values from the inputParser +jitter = params.Results.jitter; +style = params.Results.style; +interval = params.Results.interval; +markMedian = params.Results.markMedian; + +%The multiplier for the SD patch. e.g. for 1.96 SDs this value should be 1.96 +numSDs = params.Results.numSDs; +manualCI = params.Results.manualCI; %Is used by the recursive call to over-ride the CI when y is a LinearModel + +%Set interval function +switch lower(interval) + case 'sem' + intervalFun = @NBP.SEM_calc; + case 'tinterval' + intervalFun = @NBP.tInterval_calc; + otherwise + error('Interval %s is unknown',interval) +end + +if jitter==0 && strcmp(style,'patch') + warning('A zero value for jitter means no patch object visible') +end + + +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +% We now loop through the unique x values, plotting each notBox in turn +% using recursive calls to notBoxPlot. +if isvector(y) && isvector(x) && length(x)>1 + x=x(:); + + if length(x)~=length(y) + error('length(x) should equal length(y)') + end + + u=unique(x); + for ii=1:length(u) + f = find(x==u(ii)); + + %If a model was used, we use the 95% t-intervals it produces + if ~isempty(modelCIs) + thisCI = range(modelCIs(ii,:))/2; %the interval is symmetric and we need just this. + else + thisCI =[]; + end + + h(ii)=notBoxPlot(y(f),u(ii),varargin{:},'manualCI',thisCI); %recursive call + end + + + %Make plot look pretty + if length(u)>1 + xlim([min(u)-1,max(u)+1]) + set(gca,'XTick',u) + end + + if nargout==1 + varargout{1}=h; + end + + %If we had a table we can label the axes + if tableOrModelCall + ylabel(varNames{1}) + xlabel(varNames{2}) + end + + return % User's call to notBoxPlot never goes beyond here +end +% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + +if length(x) ~= size(y,2) + error('length of x doesn''t match the number of columns in y') +end + + + + +% We're going to render points with the same x value in different +% colors so we loop through all unique x values and do the plotting +% with nested functions. Avoid clearing the axes in order to give +% the user more flexibility in combining plot elements. +hold on +[uX,a,b]=unique(x); + +H=[]; +stats=[]; +for ii=1:length(uX) + f=b==ii; + [hTemp,statsTemp]=myPlotter(x(f),y(:,f)); + H = [H,hTemp]; + stats = [stats,statsTemp]; +end + +hold off + +%Tidy up plot: make it look pretty +if length(x)>1 + set(gca,'XTick',unique(x)) + xlim([min(x)-1,max(x)+1]) +end + + +%handle the output arguments +if nargout>0 + varargout{1}=H; +end + +if nargout>1 + varargout{2}=stats; +end + + + + +%Nested functions follow + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +function [h,statsOut]=myPlotter(X,Y) + %This is a nested function that shares the caller's namespace + + if isempty(manualCI) + SEM=intervalFun(Y); %A function handle to a supplied external function + else + SEM=manualCI; + end + + % NaNs do not contribute to the sample size + if ~any(isnan(Y(:))) + % So we definitely have no problems with older MATLAB releases or non-stats toolbox installs + SD=std(Y)*numSDs; + mu=mean(Y); + if markMedian + med = median(Y); + end + elseif ~verLessThan('matlab','9.0') %from this version onwards we use the omitnan flag + SD=std(Y,'omitnan')*numSDs; + mu=mean(Y,'omitnan'); + if markMedian + med = median(Y,'omitnan'); + end + elseif which('nanmean') %Otherwise proceed if stats toolbox is there + SD=nanstd(Y)*numSDs; + mu=nanmean(Y); + if markMedian + med = nanmedian(Y); + end + else %raise error + error('You have NaNs in your data set but are running older than R2016a or you have no stats toolbox.') + end + + %The plot colors to use for multiple sets of points on the same x + %location + cols=hsv(length(X)+1)*0.5; + cols(1,:)=0; + jitScale=jitter*0.55; %To scale the patch by the width of the jitter + + for k=1:length(X) + + thisY=Y(:,k); + thisY=thisY(~isnan(thisY)); + thisX=repmat(X(k),1,length(thisY)); + + %Assemble stats for optional command line output + statsOut(k).mu = mu(k); + statsOut(k).interval = SEM(k); + statsOut(k).sd = SD(k); + + %Add the SD as a patch if the user asked for this + if strcmp(style,'patch') + h(k).sdPtch=patchMaker(SD(k),[0.6,0.6,1]); + end + + %Build patch surfaces for SEM, the means, and optionally the medians + if strcmp(style,'patch') || strcmp(style,'sdline') + h(k).semPtch=patchMaker(SEM(k),[1,0.6,0.6]); + h(k).mu=plot([X(k)-jitScale,X(k)+jitScale],[mu(k),mu(k)],'-r',... + 'linewidth',2); + if markMedian + statsOut(k).median = med(k); + h(k).med=plot([X(k)-jitScale,X(k)+jitScale],[med(k),med(k)],':r',... + 'linewidth',2); + end + end + + % Generate scatter in X + thisX=violaPoints(thisX,thisY); + C=cols(k,:); + + h(k).data=plot(thisX, thisY, 'o', 'color', C,... + 'markerfacecolor', C+(1-C)*0.65); + end %for k=1:length(X) + + + %Plot SD as a line + if strcmp(style,'line') || strcmp(style,'sdline') + for k=1:length(X) + h(k).sd=plot([X(k),X(k)],[mu(k)-SD(k),mu(k)+SD(k)],... + '-','color',[0.2,0.2,1],'linewidth',2); + set(h(k).sd,'ZData',[1,1]*-1) + end + end + + + %Plot mean and SEM as a line, the means, and optionally the medians + if strcmp(style,'line') + for k=1:length(X) + + h(k).mu=plot(X(k),mu(k),'o','color','r',... + 'markerfacecolor','r',... + 'markersize',10); + + h(k).sem=plot([X(k),X(k)],[mu(k)-SEM(k),mu(k)+SEM(k)],'-r',... + 'linewidth',2); + if markMedian + h(k).med=plot(X(k),med(k),'s','color',[0.8,0,0],... + 'markerfacecolor','none',... + 'lineWidth',2,... + 'markersize',12); + end + + h(k).xAxisLocation=x(k); + end + end % if strcmp(style,'line') + + for thisInterval=1:length(h) + h(thisInterval).interval=interval; + end + + + + function ptch=patchMaker(thisInterval,tColor) + %This nested function builds a patch for the SD or SEM + l=mu(k)-thisInterval; + u=mu(k)+thisInterval; + ptch=patch([X(k)-jitScale, X(k)+jitScale, X(k)+jitScale, X(k)-jitScale],... + [l,l,u,u], 0); + set(ptch,'edgecolor',tColor*0.8,'facecolor',tColor) + end %function patchMaker + + + function X=violaPoints(X,Y) + % Variable jitter according to how many points occupy each range of values. + [counts,~,bins] = histcounts(Y,10); + inds = find(counts~=0); + counts = counts(inds); + + Xr = X; + for jj=1:length(inds) + tWidth = jitter * (1-exp(-0.1 * (counts(jj)-1))); + xpoints = linspace(-tWidth*0.8, tWidth*0.8, counts(jj)); + Xr(bins==inds(jj)) = xpoints; + end + X = X+Xr; + end % function violaPoints + + +end % function myPlotter + + + + +end %function notBoxPlot diff --git a/Toolboxes/PlottingFunctions/tests/core_tests.m b/Toolboxes/PlottingFunctions/tests/core_tests.m new file mode 100755 index 0000000000000000000000000000000000000000..0472b58d080a7ea68932e0f6a4e9c6af0815b717 --- /dev/null +++ b/Toolboxes/PlottingFunctions/tests/core_tests.m @@ -0,0 +1,75 @@ +classdef core_tests < matlab.unittest.TestCase + % Unit tests for notBoxPlot + + properties + + end %properties + + + methods (Test) + + + function checkInputParameters(testCase) + %Check that no gross errors are produced for all param/val pairs not already tested above + y=rand(10,3); + x=[1,2,2]; %To place to boxes on the same x location and one on its own + + clf + H=notBoxPlot(y,x,'jitter',0.6,'style','sdline'); + + clf + notBoxPlot(y,[],'style','patch','interval','SEM'); + + clf + notBoxPlot(y,x,'interval','tInterval'); + + clf + h=notBoxPlot(y,x,'interval','tInterval','markMedian',false); + testCase.verifyFalse(isfield(h,'med')) + + clf + h=notBoxPlot(y,x,'interval','tInterval','markMedian',true); + testCase.verifyTrue(isfield(h,'med')) + + clf + h=notBoxPlot(y,x,'style','line','markMedian',false); + testCase.verifyFalse(isfield(h,'med')) + + clf + h=notBoxPlot(y,x,'style','line','markMedian',true); + testCase.verifyTrue(isfield(h,'med')) + + %With NaNs + clf + y(1,1)=nan; + H=notBoxPlot(y,x,'jitter',0.6,'style','sdline'); + + %Check that the showCase example runs + NBP.showCase + + close(gcf) + end + + + function checkOutputs(testCase) + %Check output args + y=rand(10,3); + x=[1,2,2]; %To place to boxes on the same x location and one on its own + + clf + [H,stats]=notBoxPlot(y,x,'jitter',0.6,'style','sdline'); + testCase.verifyTrue(isstruct(H)) + testCase.verifyTrue(isstruct(stats)) + testCase.verifyTrue(length(H)==length(stats)) + + clf + [H,stats]=notBoxPlot(y,x,'jitter',0.6,'markMedian',true); + + testCase.verifyTrue(isfield(stats,'median')) + + + close(gcf) + end + end %methods (Test) + +end %classdef core_tests < matlab.unittest.TestCase \ No newline at end of file diff --git a/Toolboxes/PlottingFunctions/tests/readme.txt b/Toolboxes/PlottingFunctions/tests/readme.txt new file mode 100755 index 0000000000000000000000000000000000000000..a874b6cee7651ff3b4c4cb9b62a228e2a6347fc1 --- /dev/null +++ b/Toolboxes/PlottingFunctions/tests/readme.txt @@ -0,0 +1,10 @@ +This directory contains code for unit testing notBoxPlot +You do not need to add this directory to your path. + +To run the unit tests: + +>> runtests + +or + +>> table(runtests) diff --git a/Toolboxes/PlottingFunctions/tnueeg_line_with_shaded_errorbar.m b/Toolboxes/PlottingFunctions/tnueeg_line_with_shaded_errorbar.m new file mode 100644 index 0000000000000000000000000000000000000000..1a3ce75661536a27692c334ffc211faa2de53cda --- /dev/null +++ b/Toolboxes/PlottingFunctions/tnueeg_line_with_shaded_errorbar.m @@ -0,0 +1,164 @@ +function varargout = tnueeg_line_with_shaded_errorbar(x, y, errBar,... +lineProps, transparent) +%TNUEEG_LINE_WITH_SHADED_ERRORBAR(x,y,errBar,lineProps,transparent) +% Makes a 2-d line plot with a pretty shaded error bar made +% using patch. Error bar color is chosen automatically. +% IN: x - vector of x values [optional, can be left empty] +% y - vector of y values or a matrix of n observations by m +% cases where m has length(x); +% errBar - if a vector we draw symmetric errorbars. If it has a size +% of [2,length(x)] then we draw asymmetric error bars with +% row 1 being the upper bar and row 2 being the lower bar +% (with respect to y). ** alternatively ** errBar can be a +% cellArray of two function handles. The first defines which +% statistic the line should be and the second defines the +% error bar. +% lineProps - [optional,'-k' by default] defines the properties of +% the data line. e.g.: +% 'or-', or {'-or','markerfacecolor',[1,0.2,0.2]} +% transparent - [optional, 0 by default] if ==1 the shaded error +% bar is made transparent, which forces the renderer +% to be openGl. However, if this is saved as .eps the +% resulting file will contain a raster not a vector +% image. +% OUT: H - a structure of handles to the generated plot objects. +% +% Examples +% y=randn(30,80); x=1:size(y,2); +% tnueeg_line_with_shaded_errorbar(x,mean(y,1),std(y),'g'); +% +% tnueeg_line_with_shaded_errorbar(x,y,{@median,@std},{'r-o','markerfacecolor','r'}); + +% +% tnueeg_line_with_shaded_errorbar([],y,{@median,@std},{'r-o','markerfacecolor','r'}); + +% +% Overlay two transparent lines +% y=randn(30,80)*10; x=(1:size(y,2))-40; +% tnueeg_line_with_shaded_errorbar(x,y,{@mean,@std},'-r',1); +% hold on +% y=ones(30,1)*x; y=y+0.06*y.^2+randn(size(y))*10; +% tnueeg_line_with_shaded_errorbar(x,y,{@mean,@std},'-b',1); +% hold off +% +% +% written by Rob Campbell - November 2009 +% modified by Lilian Weber July 2017 +% NOTE for modifications L.W.: remove edges, modify comments + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Error checking +error(nargchk(3,5,nargin)) + + +%Process y using function handles if needed to make the error bar +%dynamically +if iscell(errBar) + fun1=errBar{1}; + fun2=errBar{2}; + errBar=fun2(y); + y=fun1(y); +else + y=y(:)'; +end + +if isempty(x) + x=1:length(y); +else + x=x(:)'; +end + + +%Make upper and lower error bars if only one was specified +if length(errBar)==length(errBar(:)) + errBar=repmat(errBar(:)',2,1); +else + s=size(errBar); + f=find(s==2); + if isempty(f), error('errBar has the wrong size'), end + if f==2, errBar=errBar'; end +end + +if length(x) ~= length(errBar) + error('length(x) must equal length(errBar)') +end + +%Set default options +defaultProps={'-k'}; +if nargin<4, lineProps=defaultProps; end +if isempty(lineProps), lineProps=defaultProps; end +if ~iscell(lineProps), lineProps={lineProps}; end + +if nargin<5, transparent=0; end + + + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Plot to get the parameters of the line +H.mainLine=plot(x,y,lineProps{:}); + + +% Work out the color of the shaded region and associated lines +% Using alpha requires the render to be openGL and so you can't +% save a vector image. On the other hand, you need alpha if you're +% overlaying lines. There we have the option of choosing alpha or a +% de-saturated solid colour for the patch surface . + +col=get(H.mainLine,'color'); +edgeColor=col+(1-col)*0.55; +patchSaturation=0.15; %How de-saturated or transparent to make patch +if transparent + faceAlpha=patchSaturation; + patchColor=col; + set(gcf,'renderer','openGL') +else + faceAlpha=1; + patchColor=col+(1-col)*(1-patchSaturation); + set(gcf,'renderer','painters') +end + + +%Calculate the error bars +uE=y+errBar(1,:); % was errBar(1,:); %was y+errBar(1,:); +lE=y-errBar(2,:); % was errBar(2,:); %was y-errBar(2,:); + + +%Add the patch error bar +holdStatus=ishold; +if ~holdStatus, hold on, end + + +%Make the patch +yP=[lE,fliplr(uE)]; +xP=[x,fliplr(x)]; + +%remove nans otherwise patch won't work +xP(isnan(yP))=[]; +yP(isnan(yP))=[]; + + +H.patch=patch(xP,yP,1,'facecolor',patchColor,... + 'edgecolor','none',... + 'facealpha',faceAlpha); + + +%Make pretty edges around the patch. +%{ +H.edge(1)=plot(x,lE,'-','color',edgeColor); +H.edge(2)=plot(x,uE,'-','color',edgeColor); +%} + +%Now replace the line (this avoids having to bugger about with z coordinates) +delete(H.mainLine) +H.mainLine=plot(x,y,lineProps{:}); + + +if ~holdStatus, hold off, end + + +if nargout==1 + varargout{1}=H; +end +end diff --git a/Toolboxes/PlottingFunctions/violinplot.m b/Toolboxes/PlottingFunctions/violinplot.m new file mode 100644 index 0000000000000000000000000000000000000000..131ae6bd12d47097173979773c88815493b6c466 --- /dev/null +++ b/Toolboxes/PlottingFunctions/violinplot.m @@ -0,0 +1,103 @@ +function violins = violinplot(data, cats, varargin) +%Violinplots plots violin plots of some data and categories +% VIOLINPLOT(DATA) plots a violin of a double vector DATA +% +% VIOLINPLOT(DATAMATRIX) plots violins for each column in +% DATAMATRIX. +% +% VIOLINPLOT(TABLE), VIOLINPLOT(STRUCT), VIOLINPLOT(DATASET) +% plots violins for each column in TABLE, each field in STRUCT, and +% each variable in DATASET. The violins are labeled according to +% the table/dataset variable name or the struct field name. +% +% VIOLINPLOT(DATAMATRIX, CATEGORYNAMES) plots violins for each +% column in DATAMATRIX and labels them according to the names in the +% cell-of-strings CATEGORYNAMES. +% +% VIOLINPLOT(DATA, CATEGORIES) where double vector DATA and vector +% CATEGORIES are of equal length; plots violins for each category in +% DATA. +% +% violins = VIOLINPLOT(...) returns an object array of +% Violin objects. +% +% VIOLINPLOT(..., 'PARAM1', val1, 'PARAM2', val2, ...) +% specifies optional name/value pairs for all violins: +% 'Width' Width of the violin in axis space. +% Defaults to 0.3 +% 'Bandwidth' Bandwidth of the kernel density estimate. +% Should be between 10% and 40% of the data range. +% 'ViolinColor' Fill color of the violin area and data points. +% Defaults to the next default color cycle. +% 'ViolinAlpha' Transparency of the violin area and data points. +% Defaults to 0.3. +% 'EdgeColor' Color of the violin area outline. +% Defaults to [0.5 0.5 0.5] +% 'BoxColor' Color of the box, whiskers, and the outlines of +% the median point and the notch indicators. +% Defaults to [0.5 0.5 0.5] +% 'MedianColor' Fill color of the median and notch indicators. +% Defaults to [1 1 1] +% 'ShowData' Whether to show data points. +% Defaults to true +% 'ShowNotches' Whether to show notch indicators. +% Defaults to false +% 'ShowMean' Whether to show mean indicator +% Defaults to false + +% Copyright (c) 2016, Bastian Bechtold +% This code is released under the terms of the BSD 3-clause license + + hascategories = exist('cats') && not(isempty(cats)); + + % tabular data + if isa(data, 'dataset') || isstruct(data) || istable(data) + if isa(data, 'dataset') + colnames = data.Properties.VarNames; + elseif istable(data) + colnames = data.Properties.VariableNames; + elseif isstruct(data) + colnames = fieldnames(data); + end + catnames = {}; + for n=1:length(colnames) + if isnumeric(data.(colnames{n})) + catnames = [catnames colnames{n}]; + end + end + for n=1:length(catnames) + thisData = data.(catnames{n}); + violins(n) = Violin(thisData, n, varargin{:}); + end + set(gca, 'xtick', 1:length(catnames), 'xticklabels', catnames); + + % 1D data, one category for each data point + elseif hascategories && numel(data) == numel(cats) + cats = categorical(cats); + catnames = categories(cats); + for n=1:length(catnames) + thisCat = catnames{n}; + thisData = data(cats == thisCat); + violins(n) = Violin(thisData, n, varargin{:}); + end + set(gca, 'xtick', 1:length(catnames), 'xticklabels', catnames); + + % 1D data, no categories + elseif not(hascategories) && isvector(data) + violins = Violin(data, 1, varargin{:}); + set(gca, 'xtick', 1); + + % 2D data with or without categories + elseif ismatrix(data) + for n=1:size(data, 2) + thisData = data(:, n); + violins(n) = Violin(thisData, n, varargin{:}); + end + set(gca, 'xtick', 1:size(data, 2)); + if hascategories && length(cats) == size(data, 2) + set(gca, 'xticklabels', cats); + end + + end + +end diff --git a/Toolboxes/rm_anova2.m b/Toolboxes/rm_anova2.m new file mode 100644 index 0000000000000000000000000000000000000000..fda44589fde67fa316ef6e5bd51b7caea0f3d8f5 --- /dev/null +++ b/Toolboxes/rm_anova2.m @@ -0,0 +1,145 @@ +function stats = rm_anova2(Y,S,F1,F2,FACTNAMES) +% +% function stats = rm_anova2(Y,S,F1,F2,FACTNAMES) +% +% Two-factor, within-subject repeated measures ANOVA. +% For designs with two within-subject factors. +% +% Parameters: +% Y dependent variable (numeric) in a column vector +% S grouping variable for SUBJECT +% F1 grouping variable for factor #1 +% F2 grouping variable for factor #2 +% FACTNAMES a cell array w/ two char arrays: {'factor1', 'factor2'} +% +% Y should be a 1-d column vector with all of your data (numeric). +% The grouping variables should also be 1-d numeric, each with same +% length as Y. Each entry in each of the grouping vectors indicates the +% level # (or subject #) of the corresponding entry in Y. +% +% Returns: +% stats is a cell array with the usual ANOVA table: +% Source / ss / df / ms / F / p +% +% Notes: +% Program does not do any input validation, so it is up to you to make +% sure that you have passed in the parameters in the correct form: +% +% Y, S, F1, and F2 must be numeric vectors all of the same length. +% +% There must be at least one value in Y for each possible combination +% of S, F1, and F2 (i.e. there must be at least one measurement per +% subject per condition). +% +% If there is more than one measurement per subject X condition, then +% the program will take the mean of those measurements. +% +% Aaron Schurger (2005.02.04) +% Derived from Keppel & Wickens (2004) "Design and Analysis" ch. 18 +% + +% +% Revision history... +% +% 11 December 2009 (Aaron Schurger) +% +% Fixed error under "bracket terms" +% was: expY = sum(Y.^2); +% now: expY = sum(sum(sum(MEANS.^2))); +% + +stats = cell(4,5); + +F1_lvls = unique(F1); +F2_lvls = unique(F2); +Subjs = unique(S); + +a = length(F1_lvls); % # of levels in factor 1 +b = length(F2_lvls); % # of levels in factor 2 +n = length(Subjs); % # of subjects + +INDS = cell(a,b,n); % this will hold arrays of indices +CELLS = cell(a,b,n); % this will hold the data for each subject X condition +MEANS = zeros(a,b,n); % this will hold the means for each subj X condition + +% Calculate means for each subject X condition. +% Keep data in CELLS, because in future we may want to allow options for +% how to compute the means (e.g. leaving out outliers > 3stdev, etc...). +for i=1:a % F1 + for j=1:b % F2 + for k=1:n % Subjs + INDS{i,j,k} = find(F1==F1_lvls(i) & F2==F2_lvls(j) & S==Subjs(k)); + CELLS{i,j,k} = Y(INDS{i,j,k}); + MEANS(i,j,k) = mean(CELLS{i,j,k}); + end + end +end + +% make tables (see table 18.1, p. 402) +AB = reshape(sum(MEANS,3),a,b); % across subjects +AS = reshape(sum(MEANS,2),a,n); % across factor 2 +BS = reshape(sum(MEANS,1),b,n); % across factor 1 + +A = sum(AB,2); % sum across columns, so result is ax1 column vector +B = sum(AB,1); % sum across rows, so result is 1xb row vector +S = sum(AS,1); % sum across columns, so result is 1xs row vector +T = sum(sum(A)); % could sum either A or B or S, choice is arbitrary + +% degrees of freedom +dfA = a-1; +dfB = b-1; +dfAB = (a-1)*(b-1); +dfS = n-1; +dfAS = (a-1)*(n-1); +dfBS = (b-1)*(n-1); +dfABS = (a-1)*(b-1)*(n-1); + +% bracket terms (expected value) +expA = sum(A.^2)./(b*n); +expB = sum(B.^2)./(a*n); +expAB = sum(sum(AB.^2))./n; +expS = sum(S.^2)./(a*b); +expAS = sum(sum(AS.^2))./b; +expBS = sum(sum(BS.^2))./a; +expY = sum(sum(sum(MEANS.^2))); %sum(Y.^2); +expT = T^2 / (a*b*n); + +% sums of squares +ssA = expA - expT; +ssB = expB - expT; +ssAB = expAB - expA - expB + expT; +ssS = expS - expT; +ssAS = expAS - expA - expS + expT; +ssBS = expBS - expB - expS + expT; +ssABS = expY - expAB - expAS - expBS + expA + expB + expS - expT; +ssTot = expY - expT; + +% mean squares +msA = ssA / dfA; +msB = ssB / dfB; +msAB = ssAB / dfAB; +msS = ssS / dfS; +msAS = ssAS / dfAS; +msBS = ssBS / dfBS; +msABS = ssABS / dfABS; + +% f statistic +fA = msA / msAS; +fB = msB / msBS; +fAB = msAB / msABS; + +% p values +pA = 1-fcdf(fA,dfA,dfAS); +pB = 1-fcdf(fB,dfB,dfBS); +pAB = 1-fcdf(fAB,dfAB,dfABS); + +% return values +stats = {'Source','SS','df','MS','F','p';... + FACTNAMES{1}, ssA, dfA, msA, fA, pA;... + FACTNAMES{2}, ssB, dfB, msB, fB, pB;... + [FACTNAMES{1} ' x ' FACTNAMES{2}], ssAB, dfAB, msAB, fAB, pAB;... + [FACTNAMES{1} ' x Subj'], ssAS, dfAS, msAS, [], [];... + [FACTNAMES{2} ' x Subj'], ssBS, dfBS, msBS, [], [];... + [FACTNAMES{1} ' x ' FACTNAMES{2} ' x Subj'], ssABS, dfABS, msABS, [], []}; + + return \ No newline at end of file diff --git a/Toolboxes/spm12/@file_array/Contents.m b/Toolboxes/spm12/@file_array/Contents.m new file mode 100644 index 0000000000000000000000000000000000000000..a4b1db518141bfe86937cf8a3068bac2111773cb --- /dev/null +++ b/Toolboxes/spm12/@file_array/Contents.m @@ -0,0 +1,48 @@ +% File Array Object +% +% file_array - create a file_array +% horzcat - horizontal concatenation +% vertcat - vertical concatenation +% size - size of array +% length - length of longest dimension +% subsref - subscripted reference +% end - last index in an indexing expression +% resize - resize (but only of simple file_array structures) +% +% other operations are unlikely to work. +% +% Example usage. +% +% % Create a file array object by mapping test_le.img +% % to a 256x256x100 array, of datatype float32, stored +% % in a little-endian way starting at byte 0. +% fa0 = file_array('test_le.img',[256 256 100], 'FLOAT32-LE',0) +% +% % Creating an object from test_be.img, but skipping +% % the first plane of data. Data stored as big-endian +% fa1 = file_array('test_be.img',[256 256 99], 'FLOAT32-BE',4*256*256) +% +% % Reshape procedure +% fa2 = reshape(fa1,[128 2 256 99]) +% +% % Concatenation +% fa3 = [[fa0 fa0]; [fa0 fa0]] +% fa4 = cat(3,fa0,fa1) +% +% % Note that reshape will not work on the above +% % concatenated objects +% +% % Accessing values from the objects +% img = fa1(:,:,40); +% pixval = fa4(50,50,:); +% small = fa1(1:2:end,1:2:end,40); +% +% % Determining dimensions +% size(fa4) +% size(fa2) +% length(fa0) +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: Contents.m 7147 2017-08-03 14:07:01Z spm $ diff --git a/Toolboxes/spm12/@file_array/cat.m b/Toolboxes/spm12/@file_array/cat.m new file mode 100644 index 0000000000000000000000000000000000000000..b6cf9b833ea47f8197f862d755e2ffd49df8c204 --- /dev/null +++ b/Toolboxes/spm12/@file_array/cat.m @@ -0,0 +1,40 @@ +function o = cat(dr,varargin) +% Concatenate file_array objects. The result is a non-simple object +% that can no longer be reshaped. +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: cat.m 7147 2017-08-03 14:07:01Z spm $ + + +if dr>32 || dr<0, error('Unknown command option.'); end +dr = max(round(dr),1); +d = ones(nargin-1,16); +tmp = {}; +dpos = 0; +for i=1:nargin-1 + vi = varargin{i}; + if strcmp(class(vi),'file_array') + sz = size(vi); + d(i,1:length(sz)) = sz; + svi = struct(vi); + svi = svi(:); + for j=1:length(svi(:)) + if length(svi(j).pos)1 + fprintf(' %s object: ', class(obj)); + sz = size(obj); + if length(sz)>4 + fprintf('%d-D\n',length(sz)); + else + for i=1:(length(sz)-1) + fprintf('%d-by-',sz(i)); + end + fprintf('%d\n',sz(end)); + end +else + disp(mystruct(obj)) +end + + +%========================================================================== +% function t = mystruct(obj) +%========================================================================== +function t = mystruct(obj) +fn = fieldnames(obj); +for i=1:length(fn) + t.(fn{i}) = subsref(obj,struct('type','.','subs',fn{i})); +end diff --git a/Toolboxes/spm12/@file_array/display.m b/Toolboxes/spm12/@file_array/display.m new file mode 100644 index 0000000000000000000000000000000000000000..fe39869b40426df3a4e392cd9d360f474816edc4 --- /dev/null +++ b/Toolboxes/spm12/@file_array/display.m @@ -0,0 +1,14 @@ +function display(obj) +% Display a file_array object +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: display.m 7147 2017-08-03 14:07:01Z spm $ + + +disp(' '); +disp([inputname(1),' = ']) +disp(' '); +disp(obj) +disp(' ') diff --git a/Toolboxes/spm12/@file_array/double.m b/Toolboxes/spm12/@file_array/double.m new file mode 100644 index 0000000000000000000000000000000000000000..3c001938bd20f4538ce8cad63785b87f2e100469 --- /dev/null +++ b/Toolboxes/spm12/@file_array/double.m @@ -0,0 +1,12 @@ +function out = double(fa) +% Convert to double precision +% FORMAT double(fa) +% fa - a file_array +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: double.m 7147 2017-08-03 14:07:01Z spm $ + + +out = double(numeric(fa)); diff --git a/Toolboxes/spm12/@file_array/end.m b/Toolboxes/spm12/@file_array/end.m new file mode 100644 index 0000000000000000000000000000000000000000..1e76b19224a8b6e1316d254b9a753a32c19b704e --- /dev/null +++ b/Toolboxes/spm12/@file_array/end.m @@ -0,0 +1,18 @@ +function en = end(a,k,n) +% Overloaded end function for file_array objects. +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: end.m 7147 2017-08-03 14:07:01Z spm $ + + +dim = size(a); +if k>length(dim) + en = 1; +else + if n=1, a = fname(a,varargin{1}); end +if nargin>=2, a = dim(a,varargin{2}); end +if nargin>=3, a = dtype(a,varargin{3}); end +if nargin>=4, a = offset(a,varargin{4}); end +if nargin>=5, a = scl_slope(a,varargin{5}); end +if nargin>=6, a = scl_inter(a,varargin{6}); end +if nargin>=7, a = permission(a,varargin{7}); end + +a.pos = ones(size(a.dim)); +a = file_array(a); diff --git a/Toolboxes/spm12/@file_array/horzcat.m b/Toolboxes/spm12/@file_array/horzcat.m new file mode 100644 index 0000000000000000000000000000000000000000..ae4975154113633c2a7eb771459d7b2ad1b6f1a6 --- /dev/null +++ b/Toolboxes/spm12/@file_array/horzcat.m @@ -0,0 +1,10 @@ +function o = horzcat(varargin) +% Horizontal concatenation of file_array objects +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: horzcat.m 7147 2017-08-03 14:07:01Z spm $ + + +o = cat(2,varargin{:}); diff --git a/Toolboxes/spm12/@file_array/initialise.m b/Toolboxes/spm12/@file_array/initialise.m new file mode 100644 index 0000000000000000000000000000000000000000..377989bec8a06e5d2212e9e9140268a0356c860e --- /dev/null +++ b/Toolboxes/spm12/@file_array/initialise.m @@ -0,0 +1,33 @@ +function initialise(fa) +% Initialise file on disk +% +% This creates a file on disk with the appropriate size by explicitly +% writing data to prevent a sparse file. +%__________________________________________________________________________ +% Copyright (C) 2013-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: initialise.m 7147 2017-08-03 14:07:01Z spm $ + + +% first approach +% fa = subsasgn(fa, substruct('()',num2cell(size(fa))), 0); + +% second approach +% fa = subsasgn(fa, substruct('()',repmat({':'},1,ndims(fa))), 0); + +% third approach (problem if n > intmax('int32')) +% bs = 2^20; +% n = prod(size(fa)); %#ok +% fa = reshape(fa,n,1); +% for i=1:ceil(n/bs) +% ii = ((((i-1)*bs)+1):min((i*bs),n))'; +% fa = subsasgn(fa,struct('type','()','subs',{{ii}}),zeros(numel(ii),1)); +% end + +d = datatypes; +dt = find(cat(1,d.code)==fa.dtype); +if isempty(dt), error('Unknown datatype.'); end +d = d(dt); +nbytes = d.nelem * d.size * prod(size(fa)); %#ok +init(fa.fname, nbytes, struct('offset',fa.offset)); diff --git a/Toolboxes/spm12/@file_array/isnan.m b/Toolboxes/spm12/@file_array/isnan.m new file mode 100644 index 0000000000000000000000000000000000000000..6fde9ef76a3c1469531ff910b13a361f67ccddf4 --- /dev/null +++ b/Toolboxes/spm12/@file_array/isnan.m @@ -0,0 +1,21 @@ +function out = isnan(fa) +% Convert to numeric form +% FORMAT isnan(fa) +% fa - a file_array +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: isnan.m 7147 2017-08-03 14:07:01Z spm $ + + +bs = 10240; +m = size(fa); +fa = reshape(fa,prod(m),1); +n = prod(m); +out = false(m); +for i=1:ceil(n/bs) + ii = ((((i-1)*bs)+1):min((i*bs),n))'; + tmp = subsref(fa,struct('type','()','subs',{{ii}})); + out(ii) = isnan(tmp); +end diff --git a/Toolboxes/spm12/@file_array/length.m b/Toolboxes/spm12/@file_array/length.m new file mode 100644 index 0000000000000000000000000000000000000000..88bbe71a84e882b23a9be2592ee4a42eef6419c9 --- /dev/null +++ b/Toolboxes/spm12/@file_array/length.m @@ -0,0 +1,10 @@ +function l = length(x) +% Overloaded length function for file_array objects +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: length.m 7147 2017-08-03 14:07:01Z spm $ + + +l = max(size(x)); diff --git a/Toolboxes/spm12/@file_array/loadobj.m b/Toolboxes/spm12/@file_array/loadobj.m new file mode 100644 index 0000000000000000000000000000000000000000..9d2e8e829c98e5ad6d79307d50739fd00ff1cc5e --- /dev/null +++ b/Toolboxes/spm12/@file_array/loadobj.m @@ -0,0 +1,15 @@ +function b = loadobj(a) +% loadobj for file_array class +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: loadobj.m 7147 2017-08-03 14:07:01Z spm $ + + +if isa(a,'file_array') + b = a; +else + a = permission(a, 'rw'); + b = file_array(a); +end diff --git a/Toolboxes/spm12/@file_array/ndims.m b/Toolboxes/spm12/@file_array/ndims.m new file mode 100644 index 0000000000000000000000000000000000000000..674ea6ba8cbd804ae0660655919b71c3da71741b --- /dev/null +++ b/Toolboxes/spm12/@file_array/ndims.m @@ -0,0 +1,11 @@ +function out = ndims(fa) +% Number of dimensions +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: ndims.m 7147 2017-08-03 14:07:01Z spm $ + + +out = size(fa); +out = length(out); diff --git a/Toolboxes/spm12/@file_array/numel.m b/Toolboxes/spm12/@file_array/numel.m new file mode 100644 index 0000000000000000000000000000000000000000..8b6c1d10fd8010b38b6d5062cf415ccc40173498 --- /dev/null +++ b/Toolboxes/spm12/@file_array/numel.m @@ -0,0 +1,14 @@ +function t = numel(obj) +% Number of simple file arrays involved. +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: numel.m 7147 2017-08-03 14:07:01Z spm $ + + +% Should be this, but it causes problems when accessing +% obj as a structure. +%t = prod(size(obj)); + +t = numel(struct(obj)); diff --git a/Toolboxes/spm12/@file_array/numeric.m b/Toolboxes/spm12/@file_array/numeric.m new file mode 100644 index 0000000000000000000000000000000000000000..01b7bd60419ce6fa6dd309d2aaa3d3032a24b9b4 --- /dev/null +++ b/Toolboxes/spm12/@file_array/numeric.m @@ -0,0 +1,13 @@ +function out = numeric(fa) +% Convert to numeric form +% FORMAT numeric(fa) +% fa - a file_array +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: numeric.m 7147 2017-08-03 14:07:01Z spm $ + + +[vo{1:ndims(fa)}] = deal(':'); +out = subsref(fa,struct('type','()','subs',{vo})); diff --git a/Toolboxes/spm12/@file_array/permute.m b/Toolboxes/spm12/@file_array/permute.m new file mode 100644 index 0000000000000000000000000000000000000000..2a34b0649e097263b33aaf353c969dd24c139fc4 --- /dev/null +++ b/Toolboxes/spm12/@file_array/permute.m @@ -0,0 +1,10 @@ +function varargout = permute(varargin) +% file_array objects can not be permuted +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: permute.m 7147 2017-08-03 14:07:01Z spm $ + + +error('file_array objects can not be permuted.'); diff --git a/Toolboxes/spm12/@file_array/private/Makefile b/Toolboxes/spm12/@file_array/private/Makefile new file mode 100644 index 0000000000000000000000000000000000000000..d8889f1827d369f8e86838c3fd885f4183e27100 --- /dev/null +++ b/Toolboxes/spm12/@file_array/private/Makefile @@ -0,0 +1,31 @@ +#!/usr/bin/env make -f +# @file_array Makefile called by {SPM}/src/Makefile +# +# Copyright (C) 2013 Wellcome Trust Centre for Neuroimaging +# +# $Id: Makefile 5459 2013-05-01 17:51:59Z guillaume $ + +include ../../src/Makefile.var + +SPMMEX = file2mat.$(SUF) mat2file.$(SUF) init.$(SUF) + +all: $(SPMMEX) + @: + +clean: + @: +ifeq (mex,$(SUF)) + $(DEL) $(subst .$(SUF),.o,$(SPMMEX)) +endif + +distclean: clean + $(DEL) $(SPMMEX) + +install: + @: + +tarball: all + $(TAR) cf spm_mex.tar $(SPMMEX) + +%.$(SUF) : %.c + $(MEX) $< $(MEXEND) diff --git a/Toolboxes/spm12/@file_array/private/datatypes.m b/Toolboxes/spm12/@file_array/private/datatypes.m new file mode 100644 index 0000000000000000000000000000000000000000..0a7554104435d967fea73b520a50f2793613d460 --- /dev/null +++ b/Toolboxes/spm12/@file_array/private/datatypes.m @@ -0,0 +1,56 @@ +function dt = datatypes +% Dictionary of datatypes +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: datatypes.m 7147 2017-08-03 14:07:01Z spm $ + + +persistent dtype +if isempty(dtype) + t = true; + f = false; + table = {... + 0 ,'UNKNOWN' ,'uint8' ,@uint8 ,1,1 ,t,t,f + 1 ,'BINARY' ,'uint1' ,@logical,1,1/8,t,t,f + 256 ,'INT8' ,'int8' ,@int8 ,1,1 ,t,f,t + 2 ,'UINT8' ,'uint8' ,@uint8 ,1,1 ,t,t,t + 4 ,'INT16' ,'int16' ,@int16 ,1,2 ,t,f,t + 512 ,'UINT16' ,'uint16' ,@uint16 ,1,2 ,t,t,t + 8 ,'INT32' ,'int32' ,@int32 ,1,4 ,t,f,t + 768 ,'UINT32' ,'uint32' ,@uint32 ,1,4 ,t,t,t + 1024,'INT64' ,'int64' ,@int64 ,1,8 ,t,f,f + 1280,'UINT64' ,'uint64' ,@uint64 ,1,8 ,t,t,f + 16 ,'FLOAT32' ,'float32' ,@single ,1,4 ,f,f,t + 64 ,'FLOAT64' ,'double' ,@double ,1,8 ,f,f,t + 1536,'FLOAT128' ,'float128',@error ,1,16 ,f,f,f + 32 ,'COMPLEX64' ,'float32' ,@single ,2,4 ,f,f,f + 1792,'COMPLEX128','double' ,@double ,2,8 ,f,f,f + 2048,'COMPLEX256','float128',@error ,2,16 ,f,f,f + 128 ,'RGB24' ,'uint8' ,@uint8 ,3,1 ,t,t,f}; + dtype = struct(... + 'code' ,table(:,1),... + 'label' ,table(:,2),... + 'prec' ,table(:,3),... + 'conv' ,table(:,4),... + 'nelem' ,table(:,5),... + 'size' ,table(:,6),... + 'isint' ,table(:,7),... + 'unsigned' ,table(:,8),... + 'min',-Inf,'max',Inf',... + 'supported',table(:,9)); + for i=1:length(dtype) + if dtype(i).isint + if dtype(i).unsigned + dtype(i).min = 0; + dtype(i).max = 2^(8*dtype(i).size)-1; + else + dtype(i).min = -2^(8*dtype(i).size-1); + dtype(i).max = 2^(8*dtype(i).size-1)-1; + end + end + end +end + +dt = dtype; diff --git a/Toolboxes/spm12/@file_array/private/dim.m b/Toolboxes/spm12/@file_array/private/dim.m new file mode 100644 index 0000000000000000000000000000000000000000..94f220301218593d07cb0b5b4f92d3882b55c254 --- /dev/null +++ b/Toolboxes/spm12/@file_array/private/dim.m @@ -0,0 +1,42 @@ +function varargout = dim(varargin) +% file_array's dimension property +% For getting the value +% dat = dim(obj) +% +% For setting the value +% obj = dim(obj,dat) +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: dim.m 7147 2017-08-03 14:07:01Z spm $ + + +if nargin==2 + varargout{1} = asgn(varargin{:}); +elseif nargin==1 + varargout{1} = ref(varargin{:}); +else + error('Wrong number of arguments.'); +end + + +%========================================================================== +% function dat = ref(obj) +%========================================================================== +function dat = ref(obj) +dat = obj.dim; + + +%========================================================================== +% function obj = asgn(obj,dat) +%========================================================================== +function obj = asgn(obj,dat) +if isnumeric(dat) && all(dat>=0) && all(rem(dat,1)==0) + dat = [double(dat(:)') 1 1]; + lim = max([2 find(dat~=1)]); + dat = dat(1:lim); + obj.dim = dat; +else + error('"dim" must be a vector of positive integers.'); +end diff --git a/Toolboxes/spm12/@file_array/private/dtype.m b/Toolboxes/spm12/@file_array/private/dtype.m new file mode 100644 index 0000000000000000000000000000000000000000..7cd9a17c5adec1f7bb72d800d6917ad9c2e713cc --- /dev/null +++ b/Toolboxes/spm12/@file_array/private/dtype.m @@ -0,0 +1,90 @@ +function varargout = dtype(varargin) +% file_array's dtype property +% FORMAT varargout = dtype(varargin) +% For getting the value +% dat = dtype(obj) +% +% For setting the value +% obj = dtype(obj,dat) +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: dtype.m 7147 2017-08-03 14:07:01Z spm $ + + +if nargin==2 + varargout{1} = asgn(varargin{:}); +elseif nargin==1 + varargout{1} = ref(varargin{:}); +else + error('Wrong number of arguments.'); +end + + +%========================================================================== +% function t = ref(obj) +%========================================================================== +function t = ref(obj) +d = datatypes; +mch = find(cat(1,d.code)==obj.dtype); +if isempty(mch), t = 'UNKNOWN'; else t = d(mch).label; end +if obj.be, t = [t '-BE']; else t = [t '-LE']; end + + +%========================================================================== +% function obj = asgn(obj,dat) +%========================================================================== +function obj = asgn(obj,dat) +d = datatypes; +if isnumeric(dat) + if numel(dat)>=1 + mch = find(cat(1,d.code)==dat(1)); + if isempty(mch) || mch==0 + fprintf('Invalid datatype (%d).', dat(1)); + disp('First part of datatype should be of one of the following'); + disp(sortrows([num2str(cat(1,d.code)) ... + repmat(' ',numel(d),2) strvcat(d.label)])); + %error(['Invalid datatype (' num2str(dat(1)) ').']); + return; + end + obj.dtype = double(dat(1)); + end + if numel(dat)>=2 + obj.be = double(dat(2)~=0); + end + if numel(dat)>2 + error('Too many elements in numeric datatype.'); + end +elseif ischar(dat) + dat1 = lower(dat); + sep = find(dat1=='-' | dat1=='/'); + sep = sep(sep~=1); + if ~isempty(sep) + c1 = dat1(1:(sep(1)-1)); + c2 = dat1((sep(1)+1):end); + else + c1 = dat1; + c2 = ''; + end + mch = find(strcmpi(c1,lower({d.label}))); + if isempty(mch) + disp('First part of datatype should be of one of the following'); + disp(sortrows([num2str(cat(1,d.code)) ... + repmat(' ',numel(d),2) strvcat(d.label)])); + %error(['Invalid datatype (' c1 ').']); + return; + else + obj.dtype = double(d(mch(1)).code); + end + if any(c2=='b') + if any(c2=='l') + error('Cannot be both big and little endian.'); + end + obj.be = 1; + elseif any(c2=='l') + obj.be = 0; + end +else + error('Invalid datatype.'); +end diff --git a/Toolboxes/spm12/@file_array/private/file2mat.c b/Toolboxes/spm12/@file_array/private/file2mat.c new file mode 100644 index 0000000000000000000000000000000000000000..f964859dbef84100e2fb9d10468c8b42765820c9 --- /dev/null +++ b/Toolboxes/spm12/@file_array/private/file2mat.c @@ -0,0 +1,657 @@ +/* + * $Id: file2mat.c 6988 2017-01-16 12:38:29Z guillaume $ + * John Ashburner + */ + +/* +Memory mapping is used by this module. For more information on this, see: +http://www.mathworks.com/company/newsletters/digest/mar04/memory_map.html +*/ + +#define _FILE_OFFSET_BITS 64 + +#include +#include +#include +#include +#include +#include +#include +#include "mex.h" + +#ifdef SPM_WIN32 +#include +#include +#include +HANDLE hFile, hMapping; +typedef char *caddr_t; +#if defined _FILE_OFFSET_BITS && _FILE_OFFSET_BITS == 64 +#define stat _stati64 +#define fstat _fstati64 +#define open _open +#define close _close +#if defined _MSC_VER +#define size_t __int64 +#else +#define size_t unsigned long long +#endif +#endif +#else +#include +#include +#include +#define size_t unsigned long long +#endif + +/* +http://en.wikipedia.org/wiki/Page_(computing)#Determining_the_page_size_in_a_program +http://msdn.microsoft.com/en-us/library/aa366763(VS.85).aspx +*/ +int page_size() +{ +int size = 0; + +#if defined (_WIN32) || defined (_WIN64) + SYSTEM_INFO info; + GetSystemInfo (&info); + size = (int)info.dwAllocationGranularity; +#else + size = sysconf(_SC_PAGESIZE); +#endif + +return size; +} + + +#define MXDIMS 256 + +static long long icumprod[MXDIMS], ocumprod[MXDIMS]; + +static void get_1_sat(mwSize ndim, mwSize idim[], unsigned long long *iptr[], unsigned char idat[], + mwSize odim[], unsigned char odat[], unsigned long long indi, unsigned long long indo) +{ + mwIndex i; + if (ndim == 0) + { + for(i=0; i>3]>>(tmp&7))&1; + } + } + else + { + for(i=0; iaddr) + { +#ifdef SPM_WIN32 + sts = UnmapViewOfFile((LPVOID)(map->addr)); + if (sts == 0) + werror("Memory Map (UnmapViewOfFile)",GetLastError()); +#else + sts = munmap(map->addr, map->len); + if (sts == -1) + werror("Memory Map (munmap)",errno); +#endif + map->addr = NULL; + } +} + +const double *getpr(const mxArray *ptr, const char nam[], int len, int *n) +{ + char s[128]; + mxArray *arr; + + arr = mxGetField(ptr,0,nam); + if (arr == (mxArray *)0) + { + (void)sprintf(s,"'%s' field is missing.", nam); + mexErrMsgTxt(s); + } + if (!mxIsNumeric(arr) && !mxIsLogical(arr)) + { + (void)sprintf(s,"'%s' field is non-numeric.", nam); + mexErrMsgTxt(s); + } + if (!mxIsDouble(arr)) + { + (void)sprintf(s,"'%s' field is not double precision.", nam); + mexErrMsgTxt(s); + } + if (len>=0) + { + *n = mxGetM(arr)*mxGetN(arr); + if (*n != len) + { + (void)sprintf(s,"'%s' field should have %d elements (has %d).", nam, len, *n); + mexErrMsgTxt(s); + } + } + else + { + *n = mxGetM(arr)*mxGetN(arr); + if (*n > -len) + { + (void)sprintf(s,"'%s' field should have a maximum of %d elements (has %d).", nam, -len, *n); + mexErrMsgTxt(s); + } + } + return (double *)mxGetData(arr); +} + +void do_map_file(const mxArray *ptr, MTYPE *map) +{ + int n; + int i, dtype; +#ifdef SPM_WIN32 + ULONGLONG offset = 0; +#else + off_t offset = 0; +#endif + const double *pr; + mxArray *arr; + size_t siz; + if (!mxIsStruct(ptr)) mexErrMsgTxt("Not a structure."); + + dtype = (int)(getpr(ptr, "dtype", 1, &n)[0]); + for(i=0; idtype = &table[i]; + break; + } + } + if (map->dtype == NULL) mexErrMsgTxt("Unrecognised 'dtype' value."); + pr = getpr(ptr, "dim", -MXDIMS, &n); + map->ndim = n; + siz = 1; + for(i=0; indim; i++) + { + map->dim[i] = (mwSize)fabs(pr[i]); + siz = siz*map->dim[i]; + } + + /* Avoid overflow if possible */ + if (map->dtype->bytes % 8) + siz = (map->dtype->bytes*siz+7)/8; + else + siz = siz*(map->dtype->bytes/8); + + /* On 32bit platforms, cannot map more than 2^31-1 bytes */ + if ((sizeof(map->data) == 4) && (siz > 2147483647ULL)) + mexErrMsgTxt("The total number of bytes mapped is too large."); + + pr = getpr(ptr, "be",1, &n); +#ifdef SPM_BIGENDIAN + map->swap = (int)pr[0]==0; +#else + map->swap = (int)pr[0]!=0; +#endif + pr = getpr(ptr, "offset",1, &n); +#ifdef SPM_WIN32 + map->off = (ULONGLONG)pr[0]; +#else + map->off = (off_t)pr[0]; +#endif + if (map->off < 0) map->off = 0; + + arr = mxGetField(ptr,0,"fname"); + if (arr == (mxArray *)0) mexErrMsgTxt("Cant find fname."); + if (mxIsChar(arr)) + { + char *buf = NULL; + int fd; + struct stat stbuf; + if ((buf = mxArrayToString(arr)) == NULL) + { + mxFree(buf); + mexErrMsgTxt("Cant get filename."); + } + if ((fd = open(buf, O_RDONLY)) == -1) + { + mxFree(buf); + mexErrMsgTxt("Cant open file."); + } + if (fstat(fd, &stbuf) == -1) + { + (void)close(fd); + mxFree(buf); + mexErrMsgTxt("Cant get file size."); + } + if (stbuf.st_size < siz + map->off) + { + (void)close(fd); + mxFree(buf); + mexErrMsgTxt("File is smaller than the dimensions say it should be."); + } + offset = map->off % page_size(); + map->len = siz + (size_t)offset; + map->off = map->off - offset; +#ifdef SPM_WIN32 + (void)close(fd); + + /* http://msdn.microsoft.com/library/default.asp? + url=/library/en-us/fileio/base/createfile.asp */ + hFile = CreateFile( + buf, + GENERIC_READ, + FILE_SHARE_READ, + NULL, + OPEN_EXISTING, + FILE_ATTRIBUTE_NORMAL | FILE_FLAG_RANDOM_ACCESS, + NULL); + mxFree(buf); + if (hFile == NULL) + werror("Memory Map (CreateFile)",GetLastError()); + + /* http://msdn.microsoft.com/library/default.asp? + url=/library/en-us/fileio/base/createfilemapping.asp */ + hMapping = CreateFileMapping( + hFile, + NULL, + PAGE_READONLY, + 0, + 0, + NULL); + (void)CloseHandle(hFile); + if (hMapping == NULL) + werror("Memory Map (CreateFileMapping)",GetLastError()); + + /* http://msdn.microsoft.com/library/default.asp? + url=/library/en-us/fileio/base/mapviewoffile.asp */ + map->addr = (caddr_t)MapViewOfFile( + hMapping, + FILE_MAP_READ, + (DWORD)(map->off >> 32), + (DWORD)(map->off), + map->len); + (void)CloseHandle(hMapping); + if (map->addr == NULL) + werror("Memory Map (MapViewOfFile)",GetLastError()); +#else + map->addr = mmap( + (caddr_t)0, + map->len, + PROT_READ, + MAP_SHARED, + fd, + map->off); + (void)close(fd); + mxFree(buf); + if (map->addr == (void *)-1) + werror("Memory Map (mmap)",errno); +#endif + } + map->data = (void *)((caddr_t)map->addr + offset); +} + +void mexFunction(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) +{ + MTYPE map; + void *idat; + int i; + mwSize odim[MXDIMS], *idim, ndim; + unsigned long long *iptr[MXDIMS]; + unsigned long long one[1]; + one[0] = 1; + + if (nrhs<2 || nlhs>1) mexErrMsgTxt("Incorrect usage."); + + do_map_file(prhs[0], &map); + + ndim = map.ndim; + idim = map.dim; + idat = map.data; + + if (ndim >= MXDIMS) mexErrMsgTxt("Too many dimensions."); + + /* if (nrhs > ndim+1) mexErrMsgTxt("Index exceeds matrix dimensions (1)."); */ + + for(i=0;i((ichannels; + ocumprod[0] = 1; + for(i=0; ibytes==1 && i==1) + icumprod[i+1] = ((icumprod[i+1]+7)/8)*8; + } + + if (map.dtype->channels == 1) + { + plhs[0] = mxCreateNumericArray(ndim,odim,map.dtype->clss,mxREAL); +#ifdef SPM_WIN32 + /* https://msdn.microsoft.com/en-us/library/windows/desktop/aa366801.aspx */ + __try + { +#endif + map.dtype->func(ndim-1, idim, iptr, idat, odim, mxGetData(plhs[0])); +#ifdef SPM_WIN32 + } + __except(GetExceptionCode()==EXCEPTION_IN_PAGE_ERROR ? + EXCEPTION_EXECUTE_HANDLER : EXCEPTION_CONTINUE_SEARCH) + { + mexErrMsgTxt("An exception occured while accessing the data."); + } +#endif + if (map.swap) + map.dtype->swap(ocumprod[ndim],mxGetData(plhs[0])); + } + else if (map.dtype->channels == 2) + { + plhs[0] = mxCreateNumericArray(ndim,odim,map.dtype->clss,mxCOMPLEX); + (map.dtype->func)(ndim-1, idim, iptr, idat, odim, mxGetData(plhs[0]),mxGetImagData(plhs[0])); + if (map.swap) + { + map.dtype->swap(ocumprod[ndim],mxGetData(plhs[0])); + map.dtype->swap(ocumprod[ndim],mxGetImagData(plhs[0])); + } + } + + do_unmap_file(&map); +} diff --git a/Toolboxes/spm12/@file_array/private/file2mat.m b/Toolboxes/spm12/@file_array/private/file2mat.m new file mode 100644 index 0000000000000000000000000000000000000000..0273090d374e68bdad6af2084cf373c5e3f61dc3 --- /dev/null +++ b/Toolboxes/spm12/@file_array/private/file2mat.m @@ -0,0 +1,16 @@ +function val = file2mat(a,varargin) +% Function for reading from file_array objects +% FORMAT val = file2mat(a,ind1,ind2,ind3,...) +% a - file_array object +% indx - indices for dimension x (int64) +% val - the read values +% +% This function is normally called by file_array/subsref. +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% John Ashburner +% $Id: file2mat.m 7147 2017-08-03 14:07:01Z spm $ + +%-This is merely the help file for the compiled routine +error('file2mat.c not compiled - see Makefile'); diff --git a/Toolboxes/spm12/@file_array/private/file2mat.mexa64 b/Toolboxes/spm12/@file_array/private/file2mat.mexa64 new file mode 100644 index 0000000000000000000000000000000000000000..4b278b314b66fb4a1b42065be0d2eeb8c465ae8c Binary files /dev/null and b/Toolboxes/spm12/@file_array/private/file2mat.mexa64 differ diff --git a/Toolboxes/spm12/@file_array/private/file2mat.mexmaci64 b/Toolboxes/spm12/@file_array/private/file2mat.mexmaci64 new file mode 100644 index 0000000000000000000000000000000000000000..525b9ad47fd25e01a5021f0200f7066e7a820c45 Binary files /dev/null and b/Toolboxes/spm12/@file_array/private/file2mat.mexmaci64 differ diff --git a/Toolboxes/spm12/@file_array/private/file2mat.mexw32 b/Toolboxes/spm12/@file_array/private/file2mat.mexw32 new file mode 100644 index 0000000000000000000000000000000000000000..1ea74fbcefd58d4a70b9dff28df0eb6e00eb8527 Binary files /dev/null and b/Toolboxes/spm12/@file_array/private/file2mat.mexw32 differ diff --git a/Toolboxes/spm12/@file_array/private/file2mat.mexw64 b/Toolboxes/spm12/@file_array/private/file2mat.mexw64 new file mode 100644 index 0000000000000000000000000000000000000000..de4f6fbf014df5f720a4559932f0c6b3646a75ea Binary files /dev/null and b/Toolboxes/spm12/@file_array/private/file2mat.mexw64 differ diff --git a/Toolboxes/spm12/@file_array/private/fname.m b/Toolboxes/spm12/@file_array/private/fname.m new file mode 100644 index 0000000000000000000000000000000000000000..bbdd79efaf372a0348f1865fc71d5033bb6a33ed --- /dev/null +++ b/Toolboxes/spm12/@file_array/private/fname.m @@ -0,0 +1,40 @@ +function varargout = fname(varargin) +% file_array's fname property +% For getting the value +% dat = fname(obj) +% +% For setting the value +% obj = fname(obj,dat) +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: fname.m 7147 2017-08-03 14:07:01Z spm $ + + + +if nargin==2 + varargout{1} = asgn(varargin{:}); +elseif nargin==1 + varargout{1} = ref(varargin{:}); +else + error('Wrong number of arguments.'); +end + + +%========================================================================== +% function dat = ref(obj) +%========================================================================== +function dat = ref(obj) +dat = obj.fname; + + +%========================================================================== +% function obj = asgn(obj,dat) +%========================================================================== +function obj = asgn(obj,dat) +if ischar(dat) + obj.fname = deblank(dat(:)'); +else + error('"fname" must be a character string.'); +end \ No newline at end of file diff --git a/Toolboxes/spm12/@file_array/private/init.c b/Toolboxes/spm12/@file_array/private/init.c new file mode 100644 index 0000000000000000000000000000000000000000..86ac6d2a5bcfd290c1c2fb92e89ed2975f061763 --- /dev/null +++ b/Toolboxes/spm12/@file_array/private/init.c @@ -0,0 +1,175 @@ +/* + * $Id: init.c 6428 2015-05-06 14:09:04Z guillaume $ + * Guillaume Flandin + */ + +#ifndef MATLAB_MEX_FILE +# undef _LARGEFILE64_SOURCE +# define _LARGEFILE64_SOURCE +# include +# include +# if defined(__APPLE__) +# define structStat struct stat +# define getFileFstat fstat +# define getFilePos fgetpos +# define setFilePos fsetpos +# define fpos_T fpos_t +# else +# define structStat struct stat64 +# define getFileFstat fstat64 +# define getFilePos fgetpos64 +# define setFilePos fsetpos64 +# define fpos_T fpos64_t +# endif +#else +# include "io64.h" +#endif +#include "mex.h" +#ifdef SPM_WIN32 +# include +# define snprintf _snprintf +# define ftruncate _chsize_s +#else +# include +# include +#endif + + +void mexFunction(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) +{ + char *filename = NULL; + FILE *fp = NULL; + double tmp; + int64_T length = 0; + int64_T offset = 0; + int wipe = 0; + int trunc = 1; + + if (nrhs < 2) + { + mexErrMsgTxt("Not enough input arguments."); + } + if (nrhs > 3) + { + mexErrMsgTxt("Too many input arguments."); + } + + filename = mxArrayToString(prhs[0]); + + tmp = mxGetScalar(prhs[1]); + length = (tmp < 0) ? 0 : (int64_T)tmp; + + if (nrhs == 3) + { + mxArray *field = NULL; + if (!mxIsStruct(prhs[2])) + { + mexErrMsgTxt("Third input argument must be a struct."); + } + field = mxGetField(prhs[2], 0, "offset"); + if (field != NULL) + { + tmp = mxGetScalar(field); + offset = (tmp < 0) ? 0 : (int64_T)tmp; + } + field = mxGetField(prhs[2], 0, "wipe"); + if (field != NULL) + { + wipe = mxGetScalar(field) > 0; + } + field = mxGetField(prhs[2], 0, "truncate"); + if (field != NULL) + { + trunc = mxGetScalar(field) > 0; + } + } + + fp = fopen(filename, "ab"); + if (fp == (FILE *)0) + { + char msg[512]; + (void)snprintf(msg,sizeof(msg),"Can't open file for writing:\n\t%s\nCheck for write permission or whether the directory exists.", filename); + mxFree(filename); + mexErrMsgTxt(msg); + } + else + { + static char zeros[512]; + int64_T fsize = 0; + int64_T diff = 0; + int64_T position = 0; + structStat statbuf; + + if (getFileFstat(fileno(fp), &statbuf) != 0) + { + char msg[512]; + (void)snprintf(msg,sizeof(msg),"Error when reading size of file:\n\t%s", filename); + mxFree(filename); + mexErrMsgTxt(msg); + } + fsize = statbuf.st_size; + setFilePos(fp, (fpos_T*) &fsize); + getFilePos(fp, (fpos_T*) &position); + /* mexPrintf("Pos: %" FMT64 "d bytes.\n", position); */ + + if ((wipe) && (position > offset)) + { + /* mexPrintf("Wipe!\n"); */ + fclose(fp); + fp = fopen(filename, "r+b"); + if (fp == (FILE *)0) + { + char msg[512]; + (void)snprintf(msg,sizeof(msg),"Can't open file for writing:\n\t%s", filename); + mxFree(filename); + mexErrMsgTxt(msg); + } + setFilePos(fp, (fpos_T*) &offset); + getFilePos(fp, (fpos_T*) &position); + diff = length; + } + else + { + diff = length + offset - position; + } + /* mexPrintf("Diff: %" FMT64 "d bytes.\n", diff); */ + + if ((fsize > length + offset) && trunc) + { + /* mexPrintf("Truncate!\n"); */ + if (ftruncate(fileno(fp),length+offset) != 0) + { + /* mexPrintf("Truncate error: %s.\n",strerror(errno)); */ + char msg[512]; + (void)snprintf(msg,sizeof(msg),"Error when truncating file:\n\t%s", filename); + mxFree(filename); + mexErrMsgTxt(msg); + } + } + while (diff >= (int64_T)sizeof(zeros)) + { + if (fwrite(zeros, sizeof(zeros), 1, fp) != 1) + { + char msg[512]; + (void)snprintf(msg,sizeof(msg),"Error while writing to file:\n\t%s", filename); + mxFree(filename); + mexErrMsgTxt(msg); + } + diff -= (int64_T)sizeof(zeros); + } + + if (diff > 0) + { + if (fwrite(zeros, diff, 1, fp) != 1) + { + char msg[512]; + (void)snprintf(msg,sizeof(msg),"Error while writing to file:\n\t%s", filename); + mxFree(filename); + mexErrMsgTxt(msg); + } + } + } + + mxFree(filename); + fclose(fp); +} diff --git a/Toolboxes/spm12/@file_array/private/init.m b/Toolboxes/spm12/@file_array/private/init.m new file mode 100644 index 0000000000000000000000000000000000000000..dc6752c28c0eaefb320237065d19cbfc424cdd3d --- /dev/null +++ b/Toolboxes/spm12/@file_array/private/init.m @@ -0,0 +1,19 @@ +function init(fname, nbytes, opts) +% Initialise binary file on disk +% FORMAT init(fname, nbytes[, opts]) +% fname - filename +% nbytes - data size {bytes} +% opts - optional structure with fields: +% .offset - file offset {bytes} [default: 0] +% .wipe - overwrite exisiting values with 0 [default: false] +% .truncate - truncate file if larger than requested size [default: true] +% +% This function is normally called by file_array/initialise +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% Guillaume Flandin +% $Id: init.m 7147 2017-08-03 14:07:01Z spm $ + +%-This is merely the help file for the compiled routine +error('init.c not compiled - see Makefile'); diff --git a/Toolboxes/spm12/@file_array/private/init.mexa64 b/Toolboxes/spm12/@file_array/private/init.mexa64 new file mode 100644 index 0000000000000000000000000000000000000000..119863ce6692fe7e1bdd7663b171436f6dab807c Binary files /dev/null and b/Toolboxes/spm12/@file_array/private/init.mexa64 differ diff --git a/Toolboxes/spm12/@file_array/private/init.mexmaci64 b/Toolboxes/spm12/@file_array/private/init.mexmaci64 new file mode 100644 index 0000000000000000000000000000000000000000..9afeaf28e9ad1cb0ec42ee1c9cd67589a6a3a6b5 Binary files /dev/null and b/Toolboxes/spm12/@file_array/private/init.mexmaci64 differ diff --git a/Toolboxes/spm12/@file_array/private/init.mexw32 b/Toolboxes/spm12/@file_array/private/init.mexw32 new file mode 100644 index 0000000000000000000000000000000000000000..abde5e911d507f27f1315a1400cdb45744be4832 Binary files /dev/null and b/Toolboxes/spm12/@file_array/private/init.mexw32 differ diff --git a/Toolboxes/spm12/@file_array/private/init.mexw64 b/Toolboxes/spm12/@file_array/private/init.mexw64 new file mode 100644 index 0000000000000000000000000000000000000000..17301452f415831e282b31580c700963c0594523 Binary files /dev/null and b/Toolboxes/spm12/@file_array/private/init.mexw64 differ diff --git a/Toolboxes/spm12/@file_array/private/mat2file.c b/Toolboxes/spm12/@file_array/private/mat2file.c new file mode 100644 index 0000000000000000000000000000000000000000..3465d6bd476f5e4f5721d98d948313abff1b9b65 --- /dev/null +++ b/Toolboxes/spm12/@file_array/private/mat2file.c @@ -0,0 +1,385 @@ +/* + * $Id: mat2file.c 7038 2017-03-15 12:43:51Z guillaume $ + * John Ashburner + */ + +#define _LARGEFILE_SOURCE +#define _LARGEFILE64_SOURCE +#define _FILE_OFFSET_BITS 64 + +#include +#include +#include +#include +#include +#include "mex.h" +#ifdef SPM_WIN32 +#include +#include +#include +#if defined _FILE_OFFSET_BITS && _FILE_OFFSET_BITS == 64 +#if defined _MSC_VER +#define off_t __int64 +#define fseeko _fseeki64 +#else +#define off_t off64_t +#define fseeko fseeko64 +#endif +#endif +#define snprintf _snprintf +#endif + +#define MXDIMS 256 + +typedef struct dtype { + int code; + void (*swap)(); + mxClassID clss; + int bits; + int channels; +} Dtype; + +#define copy swap8 + +void swap8(int n, unsigned char id[], unsigned char od[]) +{ + unsigned char *de; + for(de=id+n; idbits/8; + len = 0; + poff = -999999; + ocumprod[0] = nbytes*map.dtype->channels; + icumprod[0] = nbytes*1; + for(i=0; iswap; + else + swap = copy; + + put_bytes(map.ndim-1, map.fp, ptr, idim, (unsigned char *)idat, map.off, 0,swap); + + swap(len,dptr,wbuf); + if (fwrite(wbuf,1,len,map.fp) != len) + { + /* Problem */ + (void)fclose(map.fp); + (void)mexErrMsgTxt("Problem writing last piece of data (could be a disk space or quota issue)."); + } +} + +const double *getpr(const mxArray *ptr, const char nam[], int len, int *n) +{ + char s[256]; + mxArray *arr; + + arr = mxGetField(ptr,0,nam); + if (arr == (mxArray *)0) + { + (void)sprintf(s,"'%s' field is missing.", nam); + mexErrMsgTxt(s); + } + if (!mxIsNumeric(arr)) + { + (void)sprintf(s,"'%s' field is non-numeric.", nam); + mexErrMsgTxt(s); + } + if (!mxIsDouble(arr)) + { + (void)sprintf(s,"'%s' field is not double precision.", nam); + mexErrMsgTxt(s); + } + if (len>=0) + { + *n = mxGetM(arr)*mxGetN(arr); + if (*n != len) + { + (void)sprintf(s,"'%s' field should have %d elements (has %d).", nam, len, *n); + mexErrMsgTxt(s); + } + } + else + { + *n = mxGetNumberOfElements(arr); + if (*n > -len) + { + (void)sprintf(s,"'%s' field should have a maximum of %d elements (has %d).", nam, -len, *n); + mexErrMsgTxt(s); + } + } + return (double *)mxGetData(arr); +} + + +void open_file(const mxArray *ptr, FTYPE *map) +{ + int n; + int i, dtype; + const double *pr; + mxArray *arr; + + if (!mxIsStruct(ptr)) mexErrMsgTxt("Not a structure."); + + dtype = (int)(getpr(ptr, "dtype", 1, &n)[0]); + map->dtype = NULL; + for(i=0; idtype = &table[i]; + break; + } + } + if (map->dtype == NULL) mexErrMsgTxt("Unrecognised 'dtype' value."); + if (map->dtype->bits % 8) mexErrMsgTxt("Can not yet write logical data."); + if (map->dtype->channels != 1) mexErrMsgTxt("Can not yet write complex data."); + pr = getpr(ptr, "dim", -MXDIMS, &n); + map->ndim = n; + for(i=0; indim; i++) + { + map->dim[i] = (int)fabs(pr[i]); + } + pr = getpr(ptr, "be",1, &n); +#ifdef SPM_BIGENDIAN + map->swap = (int)pr[0]==0; +#else + map->swap = (int)pr[0]!=0; +#endif + pr = getpr(ptr, "offset",1, &n); + map->off = (off_t)pr[0]; + /* if (map->off < 0) map->off = 0; Unsigned, so not necessary */ + + arr = mxGetField(ptr,0,"fname"); + if (arr == (mxArray *)0) mexErrMsgTxt("Cannot find 'fname' field."); + + if (mxIsChar(arr)) + { + char *buf = NULL; + if ((buf = mxArrayToString(arr)) == NULL) + { + mxFree(buf); + mexErrMsgTxt("Cannot get 'fname'."); + } + map->fp = fopen(buf,"rb+"); + if (map->fp == (FILE *)0) + { + map->fp = fopen(buf,"wb"); + if (map->fp == (FILE *)0) + { + char s[512]; + (void)snprintf(s,sizeof(s),"Can't open file for writing:\n\t%s\nCheck for write permission or whether the directory exists.", buf); + mxFree(buf); + mexErrMsgTxt(s); + } + } + + mxFree(buf); + } + else + mexErrMsgTxt("Wrong type of 'fname' field."); +} + + +void close_file(FTYPE map) +{ + (void)fclose(map.fp); +} + +void mexFunction(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) +{ + FTYPE map; + void *idat; + int i; + int *ptr[MXDIMS], *odim, ndim, idim[MXDIMS]; + int one[1]; + const mxArray *curr; + one[0] = 1; + + if (nrhs < 3) + mexErrMsgTxt("Not enough input arguments."); + if (nlhs > 0) + mexErrMsgTxt("Too many output arguments."); + + /* First input argument: file_array structure */ + open_file(prhs[0], &map); + + ndim = map.ndim; + odim = map.dim; + + if (ndim >= MXDIMS) + { + close_file(map); + mexErrMsgTxt("Too many dimensions."); + } + + /* Second input argument: data */ + if (mxGetClassID(prhs[1]) != map.dtype->clss) + { + close_file(map); + mexErrMsgTxt("Incompatible class types."); + } + idat = mxGetData(prhs[1]); + + /* Other input arguments: subscript vectors */ + for(i=0;i ((i=0 && rem(dat,1)==0 + obj.offset = double(dat); +else + error('"offset" must be a positive integer.'); +end diff --git a/Toolboxes/spm12/@file_array/private/permission.m b/Toolboxes/spm12/@file_array/private/permission.m new file mode 100644 index 0000000000000000000000000000000000000000..d3bcbf3b924e57cee113f3a1d6f3d0d93b751b41 --- /dev/null +++ b/Toolboxes/spm12/@file_array/private/permission.m @@ -0,0 +1,46 @@ +function varargout = permission(varargin) +% file_array's permission property +% For getting the value +% dat = permission(obj) +% +% For setting the value +% obj = permission(obj,dat) +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: permission.m 7147 2017-08-03 14:07:01Z spm $ + + +if nargin==2 + varargout{1} = asgn(varargin{:}); +elseif nargin==1 + varargout{1} = ref(varargin{:}); +else + error('Wrong number of arguments.'); +end + + +%========================================================================== +% function dat = ref(obj) +%========================================================================== +function dat = ref(obj) +dat = obj.permission; + + +%========================================================================== +% function obj = asgn(obj,dat) +%========================================================================== +function obj = asgn(obj,dat) +if ischar(dat) + tmp = lower(deblank(dat(:)')); + switch tmp + case 'ro' + case 'rw' + otherwise + error('Permission must be either "ro" or "rw".'); + end + obj.permission = tmp; +else + error('"permission" must be a character string.'); +end diff --git a/Toolboxes/spm12/@file_array/private/resize_scales.m b/Toolboxes/spm12/@file_array/private/resize_scales.m new file mode 100644 index 0000000000000000000000000000000000000000..153f0d0c717873b6c29d1b6baad44f6e729e1074 --- /dev/null +++ b/Toolboxes/spm12/@file_array/private/resize_scales.m @@ -0,0 +1,24 @@ +function s1 = resize_scales(s0,dim,args) +% Resize scalefactors +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: resize_scales.m 7147 2017-08-03 14:07:01Z spm $ + + +dim = [dim ones(1,max(numel(args)-numel(dim),0))]; +args1 = cell(1,numel(args)); +for i=1:numel(args) + if max(args{i})>dim(i) || min(args{i})<1 + error('Index exceeds matrix dimensions (1).'); + end + + if size(s0,i)==1 + args1{i} = ones(size(args{i})); + else + args1{i} = args{i}; + end +end + +s1 = s0(args1{:}); diff --git a/Toolboxes/spm12/@file_array/private/scl_inter.m b/Toolboxes/spm12/@file_array/private/scl_inter.m new file mode 100644 index 0000000000000000000000000000000000000000..9490fd94da985af0c7d26857a84de16afa45b6e1 --- /dev/null +++ b/Toolboxes/spm12/@file_array/private/scl_inter.m @@ -0,0 +1,39 @@ +function varargout = scl_inter(varargin) +% file_array's scl_inter property +% For getting the value +% dat = scl_inter(obj) +% +% For setting the value +% obj = scl_inter(obj,dat) +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: scl_inter.m 7147 2017-08-03 14:07:01Z spm $ + + +if nargin==2 + varargout{1} = asgn(varargin{:}); +elseif nargin==1 + varargout{1} = ref(varargin{:}); +else + error('Wrong number of arguments.'); +end + + +%========================================================================== +% function dat = ref(obj) +%========================================================================== +function dat = ref(obj) +dat = obj.scl_inter; + + +%========================================================================== +% function obj = asgn(obj,dat) +%========================================================================== +function obj = asgn(obj,dat) +if isnumeric(dat) % && numel(dat)<=1, + obj.scl_inter = double(dat); +else + error('"scl_inter" must be numeric.'); +end \ No newline at end of file diff --git a/Toolboxes/spm12/@file_array/private/scl_slope.m b/Toolboxes/spm12/@file_array/private/scl_slope.m new file mode 100644 index 0000000000000000000000000000000000000000..a9bfcae999a594dcc5e38c860d7d8007aaa9f95e --- /dev/null +++ b/Toolboxes/spm12/@file_array/private/scl_slope.m @@ -0,0 +1,40 @@ +function varargout = scl_slope(varargin) +% file_array's scl_slope property +% For getting the value +% dat = scl_slope(obj) +% +% For setting the value +% obj = scl_slope(obj,dat) +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: scl_slope.m 7147 2017-08-03 14:07:01Z spm $ + + + +if nargin==2 + varargout{1} = asgn(varargin{:}); +elseif nargin==1 + varargout{1} = ref(varargin{:}); +else + error('Wrong number of arguments.'); +end + + +%========================================================================== +% function dat = ref(obj) +%========================================================================== +function dat = ref(obj) +dat = obj.scl_slope; + + +%========================================================================== +% function obj = asgn(obj,dat) +%========================================================================== +function obj = asgn(obj,dat) +if isnumeric(dat) % && numel(dat)<=1, + obj.scl_slope = double(dat); +else + error('"scl_slope" must be numeric.'); +end diff --git a/Toolboxes/spm12/@file_array/reshape.m b/Toolboxes/spm12/@file_array/reshape.m new file mode 100644 index 0000000000000000000000000000000000000000..0b0db8372ab74b15bd5b1d6d5ed31a305c9981cf --- /dev/null +++ b/Toolboxes/spm12/@file_array/reshape.m @@ -0,0 +1,20 @@ +function a = reshape(b,varargin) +% Overloaded reshape function for file_array objects +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: reshape.m 7147 2017-08-03 14:07:01Z spm $ + + +if length(struct(b))~=1, error('Can only reshape simple file_array objects.'); end + +args = []; +for i=1:length(varargin) + args = [args varargin{i}(:)']; +end +if prod(args)~=prod(b.dim) + error('To RESHAPE the number of elements must not change.'); +end +a = b; +a.dim = args; diff --git a/Toolboxes/spm12/@file_array/size.m b/Toolboxes/spm12/@file_array/size.m new file mode 100644 index 0000000000000000000000000000000000000000..5b1c74732081cd98133127786d91021cd4b9762f --- /dev/null +++ b/Toolboxes/spm12/@file_array/size.m @@ -0,0 +1,43 @@ +function d = size(a,varargin) +% Method 'size' for file_array objects +%__________________________________________________________________________ +% Copyright (C) 2005-2017-2012 Wellcome Trust Centre for Neuroimaging + +% +% $Id: size.m 7147 2017-08-03 14:07:01Z spm $ + + +sa = struct(a); +nd = 0; +for i=1:numel(sa) + nd = max(nd,numel(sa(i).dim)); + nd = max(nd,max(find(sa(i).pos==1))); +end +nd = nd+1; + +dim = ones(length(sa),nd); +pos = ones(length(sa),nd); + +for i=1:length(sa) + sz = sa(i).dim; + dim(i,1:length(sz)) = sz; + ps = sa(i).pos; + pos(i,1:length(ps)) = ps; +end + +tmp = pos==1; +d = zeros(1,nd); +for i=1:nd + ind = all(tmp(:,[1:(i-1) (i+1):nd]),2); + d(i) = sum(dim(ind,i)); +end +lim = max(max(find(d~=1)),2); +d = d(1:lim); + +if nargin > 1 + if varargin{1} <= length(d) + d = d(varargin{1}); + else + d = 1; + end +end diff --git a/Toolboxes/spm12/@file_array/subsasgn.m b/Toolboxes/spm12/@file_array/subsasgn.m new file mode 100644 index 0000000000000000000000000000000000000000..35befb83ee33ea6ffbc3b741af9ba3a8321da07d --- /dev/null +++ b/Toolboxes/spm12/@file_array/subsasgn.m @@ -0,0 +1,192 @@ +function obj = subsasgn(obj,subs,dat) +% Overloaded subsasgn function for file_array objects +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: subsasgn.m 7147 2017-08-03 14:07:01Z spm $ + + +if isempty(subs), return; end + +%-Subscript types '.' or '{}' +%========================================================================== +if ~strcmp(subs(1).type,'()') + if strcmp(subs(1).type,'.') + %error('Attempt to reference field of non-structure array.'); + if numel(struct(obj))~=1 + error('Can only change the fields of simple file_array objects.'); + end + switch(subs(1).subs) + case 'fname', obj = asgn(obj,@fname, subs(2:end),dat); %fname(obj,dat); + case 'dtype', obj = asgn(obj,@dtype, subs(2:end),dat); %dtype(obj,dat); + case 'offset', obj = asgn(obj,@offset, subs(2:end),dat); %offset(obj,dat); + case 'dim', obj = asgn(obj,@dim, subs(2:end),dat); %obj = dim(obj,dat); + case 'scl_slope', obj = asgn(obj,@scl_slope, subs(2:end),dat); %scl_slope(obj,dat); + case 'scl_inter', obj = asgn(obj,@scl_inter, subs(2:end),dat); %scl_inter(obj,dat); + case 'permission', obj = asgn(obj,@permission,subs(2:end),dat); %permission(obj,dat); + otherwise, error(['Reference to non-existent field "' subs.subs '".']); + end + return; + end + if strcmp(subs(1).type,'{}') + error('Cell contents reference from a non-cell array object.'); + end +end + +%-Subscript type '()' +%========================================================================== +if numel(subs)~=1, error('Expression too complicated.'); end + +dm = size(obj); +sobj = struct(obj); + +if length(subs.subs) < length(dm) + l = length(subs.subs); + dm = [dm(1:(l-1)) prod(dm(l:end))]; + if numel(sobj) ~= 1 + error('Can only reshape simple file_array objects.'); + end + if numel(sobj.scl_slope)>1 || numel(sobj.scl_inter)>1 + error('Can not reshape file_array objects with multiple slopes and intercepts.'); + end +end + +%-Index vectors +%-------------------------------------------------------------------------- +dm = [dm ones(1,16)]; +di = ones(1,16); +args = cell(1,length(subs.subs)); +for i=1:length(subs.subs) + if ischar(subs.subs{i}) + if ~strcmp(subs.subs{i},':') + error('Invalid subscript value.'); + end + args{i} = int32(1:dm(i)); + else + args{i} = int32(subs.subs{i}); + end + di(i) = length(args{i}); +end + +%-Check read/write permissions +%-------------------------------------------------------------------------- +for j=1:length(sobj) + if strcmp(sobj(j).permission,'ro') + error('Array is read-only.'); + end +end + +%-Perform the assignment +%-------------------------------------------------------------------------- +if length(sobj)==1 + sobj.dim = dm; + if numel(dat)~=1 + subfun(sobj,double(dat),args{:}); + else + dat = repmat(double(dat),di); + subfun(sobj,dat,args{:}); + end +else + for j=1:length(sobj) + ps = [sobj(j).pos ones(1,length(args))]; + dm = [sobj(j).dim ones(1,length(args))]; + siz = ones(1,16); + for i=1:length(args) + msk = args{i}>=ps(i) & args{i}<(ps(i)+dm(i)); + args2{i} = find(msk); + args3{i} = int32(double(args{i}(msk))-ps(i)+1); + siz(i) = numel(args2{i}); + end + if numel(dat)~=1 + dat1 = double(subsref(dat,struct('type','()','subs',{args2}))); + else + dat1 = double(dat) + zeros(siz); + end + subfun(sobj(j),dat1,args3{:}); + end +end + + +%========================================================================== +% function sobj = subfun(sobj,dat,varargin) +%========================================================================== +function sobj = subfun(sobj,dat,varargin) +va = varargin; + +%-Get datatype +%-------------------------------------------------------------------------- +dt = datatypes; +ind = find(cat(1,dt.code)==sobj.dtype); +if isempty(ind), error('Unknown datatype'); end +if dt(ind).isint, dat(~isfinite(dat)) = 0; end + +%-Apply DC offset +%-------------------------------------------------------------------------- +if ~isempty(sobj.scl_inter) + inter = sobj.scl_inter; + if numel(inter) > 1 + inter = resize_scales(inter,sobj.dim,varargin); + end + dat = double(dat) - inter; +end + +%-Apply scalefactor +%-------------------------------------------------------------------------- +if ~isempty(sobj.scl_slope) + slope = sobj.scl_slope; + if numel(slope) > 1 + slope = resize_scales(slope,sobj.dim,varargin); + dat = double(dat) ./ slope; + else + dat = double(dat) / slope; + end +end + +%-Convert data into output datatype +%-------------------------------------------------------------------------- +if dt(ind).isint + % Avoid "Warning: Out of range value converted to intmin() or intmax()." + dat = max(dat,dt(ind).min); + dat = min(dat,dt(ind).max); + + dat = round(dat); +end + +%ws = warning('off'); % Avoid warning messages in R14 SP3 +dat = feval(dt(ind).conv,dat); +%warning(ws); + +%-Write data to file +%-------------------------------------------------------------------------- +nelem = dt(ind).nelem; +if nelem==1 + mat2file(sobj,dat,va{:}); + + %if sobj.be, swap = @(x) swapbytes(x); else swap = @(x) x; end + %m = memmapfile(sobj.fname, 'Format', {dt(ind).prec, sobj.dim,'dat'}, ... + % 'Offset', sobj.offset, 'Writable', true); + %m.Data.dat = subsasgn(m.Data.dat, substruct('()',va), swap(dat)); +elseif nelem==2 + sobj1 = sobj; + sobj1.dim = [2 sobj.dim]; + sobj1.dtype = dt(find(strcmp(dt(ind).prec,{dt.prec}) & (cat(2,dt.nelem)==1))).code; + dat = reshape(dat,[1 size(dat)]); + dat = [real(dat) ; imag(dat)]; + mat2file(sobj1,dat,int32([1 2]),va{:}); +else + error('Inappropriate number of elements per voxel.'); +end + + +%========================================================================== +% function obj = asgn(obj,fun,subs,dat) +%========================================================================== +function obj = asgn(obj,fun,subs,dat) +if ~isempty(subs) + tmp = feval(fun,obj); + tmp = subsasgn(tmp,subs,dat); + obj = feval(fun,obj,tmp); +else + obj = feval(fun,obj,dat); +end diff --git a/Toolboxes/spm12/@file_array/subsref.m b/Toolboxes/spm12/@file_array/subsref.m new file mode 100644 index 0000000000000000000000000000000000000000..46a39245cd9c24100ad63be39ee685b4a633e1e9 --- /dev/null +++ b/Toolboxes/spm12/@file_array/subsref.m @@ -0,0 +1,183 @@ +function varargout=subsref(obj,subs) +% SUBSREF Subscripted reference +% An overloaded function... +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: subsref.m 7209 2017-11-10 15:33:10Z guillaume $ + + +if isempty(subs), return; end + +switch subs(1).type + case '{}' + error('Cell contents reference from a non-cell array object.'); + case '.' + varargout = access_fields(obj,subs); + return; +end + +if numel(subs)~=1, error('Expression too complicated'); end + +dim = [size(obj) ones(1,16)]; +nd = find(dim>1,1,'last')-1; +sobj = struct(obj); + +if ~numel(subs.subs) + [subs.subs{1:nd+1}] = deal(':'); +elseif length(subs.subs) < nd + l = length(subs.subs); + dim = [dim(1:(l-1)) prod(dim(l:end))]; + if numel(sobj) ~= 1 + error('Can only reshape simple file_array objects.'); + else + if numel(sobj.scl_slope)>1 || numel(sobj.scl_inter)>1 + error('Can not reshape file_array objects with multiple slopes and intercepts.'); + end + sobj.dim = dim; + end +end + +di = ones(16,1); +args = cell(1,length(subs.subs)); +for i=1:length(subs.subs) + if ischar(subs.subs{i}) + if ~strcmp(subs.subs{i},':'), error('This shouldn''t happen....'); end + if length(subs.subs) == 1 + args{i} = 1:prod(dim); + k = 0; + for j=1:length(sobj) + sobj(j).dim = [prod(sobj(j).dim) 1]; + sobj(j).pos = [k+1 1]; + k = k + sobj(j).dim(1); + end + else + args{i} = 1:dim(i); + end + else + args{i} = subs.subs{i}; + end + di(i) = length(args{i}); +end + +if length(sobj)==1 + t = subfun(sobj,args{:}); +else + %dt = datatypes; + %dt = dt([dt.code]==sobj(1).dtype); % assuming identical datatypes + %t = zeros(di',func2str(dt.conv)); + t = zeros(di','double'); + for j=1:length(sobj) + ps = [sobj(j).pos ones(1,length(args))]; + dm = [sobj(j).dim ones(1,length(args))]; + for i=1:length(args) + msk = find(args{i}>=ps(i) & args{i}<(ps(i)+dm(i))); + args2{i} = msk; + args3{i} = double(args{i}(msk))-ps(i)+1; + end + + t = subsasgn(t,struct('type','()','subs',{args2}),subfun(sobj(j),args3{:})); + end +end +varargout = {t}; + + +%========================================================================== +% function t = subfun(sobj,varargin) +%========================================================================== +function t = subfun(sobj,varargin) + +%sobj.dim = [sobj.dim ones(1,16)]; +try + args = cell(size(varargin)); + for i=1:length(varargin) + args{i} = int64(varargin{i}); + end + t = file2mat(sobj,args{:}); +catch + t = multifile2mat(sobj,varargin{:}); +end +if ~isempty(sobj.scl_slope) || ~isempty(sobj.scl_inter) + slope = 1; + inter = 0; + if ~isempty(sobj.scl_slope), slope = sobj.scl_slope; end + if ~isempty(sobj.scl_inter), inter = sobj.scl_inter; end + if numel(slope)>1 + slope = resize_scales(slope,sobj.dim,varargin); + t = double(t).*slope; + else + t = double(t)*slope; + end + if numel(inter)>1 + inter = resize_scales(inter,sobj.dim,varargin); + end + t = t + inter; +end + + +%========================================================================== +% function c = access_fields(obj,subs) +%========================================================================== +function c = access_fields(obj,subs) + +sobj = struct(obj); +c = cell(1,numel(sobj)); +for i=1:numel(sobj) + %obj = class(sobj(i),'file_array'); + obj = sobj(i); + switch(subs(1).subs) + case 'fname', t = fname(obj); + case 'dtype', t = dtype(obj); + case 'offset', t = offset(obj); + case 'dim', t = dim(obj); + case 'scl_slope', t = scl_slope(obj); + case 'scl_inter', t = scl_inter(obj); + case 'permission', t = permission(obj); + otherwise + error(['Reference to non-existent field "' subs(1).subs '".']); + end + if numel(subs)>1 + t = subsref(t,subs(2:end)); + end + c{i} = t; +end + + +%========================================================================== +% function val = multifile2mat(sobj,varargin) +%========================================================================== +function val = multifile2mat(sobj,varargin) + +% Convert subscripts into linear index +[indx2{1:length(varargin)}] = ndgrid(varargin{:},1); +if numel(sobj.dim) == 1, sobj.dim = [sobj.dim 1]; end +ind = sub2ind(sobj.dim,indx2{:}); + +% Work out the partition +dt = datatypes; +dt = dt([dt.code]==sobj.dtype); +sz = dt.size; +try + mem = spm('Memory'); % in bytes, has to be a multiple of 16 (max([dt.size])) +catch + mem = 200 * 1024 * 1024; +end +s = ceil(prod(sobj.dim) * sz / mem); + +% Assign indices to partitions +[x,y] = ind2sub([mem/sz s],ind(:)); +c = histc(y,1:s); +cc = [0 reshape(cumsum(c),1,[])]; + +% Read data in relevant partitions +obj = sobj; +val = zeros(length(x),1,func2str(dt.conv)); +for i=reshape(find(c),1,[]) + obj.offset = sobj.offset + mem*(i-1); + obj.dim = [1 min(mem/sz, prod(sobj.dim)-(i-1)*mem/sz)]; + val(cc(i)+1:cc(i+1)) = file2mat(obj,int64(1),int64(x(y==i))); +end +r = cellfun('length',varargin); +if numel(r) == 1, r = [r 1]; end +val = reshape(val,r); diff --git a/Toolboxes/spm12/@file_array/transpose.m b/Toolboxes/spm12/@file_array/transpose.m new file mode 100644 index 0000000000000000000000000000000000000000..893197f2c605afeebfcf2764436354294d48980c --- /dev/null +++ b/Toolboxes/spm12/@file_array/transpose.m @@ -0,0 +1,10 @@ +function varargout = transpose(varargin) +% file_array objects can not be transposed +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: transpose.m 7147 2017-08-03 14:07:01Z spm $ + + +error('file_array objects can not be transposed.'); diff --git a/Toolboxes/spm12/@file_array/vertcat.m b/Toolboxes/spm12/@file_array/vertcat.m new file mode 100644 index 0000000000000000000000000000000000000000..ff2824db73d994a1c1eae3e23f80225ef24175bf --- /dev/null +++ b/Toolboxes/spm12/@file_array/vertcat.m @@ -0,0 +1,10 @@ +function o = vertcat(varargin) +% Vertical concatenation of file_array objects. +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: vertcat.m 7147 2017-08-03 14:07:01Z spm $ + + +o = cat(1,varargin{:}); diff --git a/Toolboxes/spm12/@gifti/Contents.m b/Toolboxes/spm12/@gifti/Contents.m new file mode 100644 index 0000000000000000000000000000000000000000..d13b3f30762f3798a69ccadcef74250594bcc495 --- /dev/null +++ b/Toolboxes/spm12/@gifti/Contents.m @@ -0,0 +1,39 @@ +% GIfTI Class for MATLAB +% +% Geometry format under the Neuroimaging Informatics Technology Initiative +% (NIfTI): +% http://www.nitrc.org/projects/gifti/ +% http://nifti.nimh.nih.gov/ +% +% This MATLAB class is part of SPM: +% http://www.fil.ion.ucl.ac.uk/spm/ +% +% It relies on external libraries: +% Base64, by Peter J. Acklam: +% http://home.online.no/~pjacklam/ +% miniz, by Rich Geldreich: +% http://code.google.com/p/miniz/ +% XMLTree, by Guillaume Flandin: +% http://www.artefact.tk/software/matlab/xml/ +%__________________________________________________________________________ +% Copyright (C) 2008-2015 Wellcome Trust Centre for Neuroimaging + +% Guillaume Flandin +% $Id: Contents.m 6404 2015-04-13 14:29:53Z guillaume $ + +% GIfTI file format for MATLAB (The Mathworks, Inc.). +% Copyright (C) 2008-2015 Wellcome Trust Centre for Neuroimaging +% +% 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 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, 59 Temple Pl. - Suite 330, Boston, MA 02111-1307, USA. \ No newline at end of file diff --git a/Toolboxes/spm12/@gifti/display.m b/Toolboxes/spm12/@gifti/display.m new file mode 100644 index 0000000000000000000000000000000000000000..ce56cd0e78e45ac726f7057a9a72641b771da558 --- /dev/null +++ b/Toolboxes/spm12/@gifti/display.m @@ -0,0 +1,25 @@ +function display(this) +% Display method for GIfTI objects +% FORMAT display(this) +% this - GIfTI object +%__________________________________________________________________________ +% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging + +% Guillaume Flandin +% $Id: display.m 4182 2011-02-01 12:29:09Z guillaume $ + +display_name = inputname(1); +if isempty(display_name) + display_name = 'ans'; +end + +if length(this) == 1 && ~isempty(this.data) + eval([display_name ' = struct(this);']); + eval(['display(' display_name ');']); +else + disp(' ') + disp([display_name ' =']); + disp(' '); + eval([display_name ' = this;']); + eval(['disp(' display_name ');']); +end \ No newline at end of file diff --git a/Toolboxes/spm12/@gifti/export.m b/Toolboxes/spm12/@gifti/export.m new file mode 100644 index 0000000000000000000000000000000000000000..961e7b777e967e90cd356eca34fd700e4ce1cf0a --- /dev/null +++ b/Toolboxes/spm12/@gifti/export.m @@ -0,0 +1,53 @@ +function s = export(this,target) +% Export a GIfTI object into specific MATLAB struct +% FORMAT s = export(this,target) +% this - GIfTI object +% target - string describing target output [default: MATLAB] +% s - a structure containing public fields of the object +%__________________________________________________________________________ +% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging + +% Guillaume Flandin +% $Id: export.m 6401 2015-04-09 17:21:33Z guillaume $ + +if numel(this) > 1, warning('Only handle scalar objects yet.'); end + +if nargin <= 1, target = 'MATLAB'; end + +switch lower(target) + case 'matlab' + s = struct(this); + + case 'patch' + if isfield(this,'vertices') + s.vertices = double(subsref(this, substruct('.', 'vertices'))); + end + if isfield(this,'faces') + s.faces = subsref(this, substruct('.', 'faces')); + end + if isfield(this,'cdata') + s.facevertexcdata = double(subsref(this, substruct('.', 'cdata'))); + end + try, s; catch, s = struct([]); end + + case {'fieldtrip', 'ft'} + s = struct('tri',[], 'pnt',[]); + if isfield(this,'vertices') + s.pnt = double(subsref(this, substruct('.', 'vertices'))); + end + if isfield(this,'faces') + s.tri = double(subsref(this, substruct('.', 'faces'))); + end + + case {'spm'} + s = struct('face',[], 'vert',[]); + if isfield(this,'vertices') + s.vert = double(subsref(this, substruct('.', 'vertices'))); + end + if isfield(this,'faces') + s.face = uint32(subsref(this, substruct('.', 'faces'))); + end + + otherwise + error('Unknown target ''%s''.', target); +end diff --git a/Toolboxes/spm12/@gifti/fieldnames.m b/Toolboxes/spm12/@gifti/fieldnames.m new file mode 100644 index 0000000000000000000000000000000000000000..b2cc94e2be14345f1f81a5104bf5db330524ef61 --- /dev/null +++ b/Toolboxes/spm12/@gifti/fieldnames.m @@ -0,0 +1,16 @@ +function names = fieldnames(this) +% Fieldnames method for GIfTI objects +% FORMAT names = fieldnames(this) +% this - GIfTI object +% names - field names +%__________________________________________________________________________ +% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging + +% Guillaume Flandin +% $Id: fieldnames.m 6507 2015-07-24 16:48:02Z guillaume $ + +if numel(this) > 1, warning('Only handle scalar objects yet.'); end + +pfn = {'vertices','faces','normals','cdata','mat','labels','indices'}; + +names = unique(pfn(isintent(this,pfn))); diff --git a/Toolboxes/spm12/@gifti/gifti.m b/Toolboxes/spm12/@gifti/gifti.m new file mode 100644 index 0000000000000000000000000000000000000000..2dcf6135ee776991986c9f9efe4ddfa4af379f6c --- /dev/null +++ b/Toolboxes/spm12/@gifti/gifti.m @@ -0,0 +1,129 @@ +function this = gifti(varargin) +% GIfTI Geometry file format class +% Geometry format under the Neuroimaging Informatics Technology Initiative +% (NIfTI): +% http://www.nitrc.org/projects/gifti/ +% http://nifti.nimh.nih.gov/ +%__________________________________________________________________________ +% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging + +% Guillaume Flandin +% $Id: gifti.m 7037 2017-03-15 11:45:13Z guillaume $ + +switch nargin + + case 0 + this = giftistruct; + this = class(this,'gifti'); + + case 1 + if isa(varargin{1},'gifti') + this = varargin{1}; + + elseif isstruct(varargin{1}) + f = {'faces', 'face', 'tri' 'vertices', 'vert', 'pnt', 'cdata', 'indices'}; + ff = {'faces', 'faces', 'faces', 'vertices', 'vertices', 'vertices', 'cdata', 'indices'}; + [c, ia] = intersect(f,fieldnames(varargin{1})); + if ~isempty(c) + this = gifti; + for i=1:length(c) + this = subsasgn(this,... + struct('type','.','subs',ff{ia(i)}),... + varargin{1}.(c{i})); + end + elseif isempty(setxor(fieldnames(varargin{1}),... + {'metadata','label','data'})) + this = class(varargin{1},'gifti'); + else + error('[GIFTI] Invalid structure.'); + end + + elseif ishandle(varargin{1}) + this = struct('vertices',get(varargin{1},'Vertices'), ... + 'faces', get(varargin{1},'Faces')); + if ~isempty(get(varargin{1},'FaceVertexCData')); + this.cdata = get(varargin{1},'FaceVertexCData'); + end + this = gifti(this); + + elseif isnumeric(varargin{1}) + this = gifti; + this = subsasgn(this,... + struct('type','.','subs','cdata'),... + varargin{1}); + + elseif iscell(varargin{1}) && numel(varargin{1}) == 1 && ... + isnumeric(varargin{1}{1}) + this = gifti; + for i=1:size(varargin{1}{1},2) + this.data{i}.metadata = struct([]); + this.data{i}.space = []; + this.data{i}.attributes.Intent = 'NIFTI_INTENT_NONE'; + this.data{i}.attributes.DataType = 'NIFTI_TYPE_FLOAT32'; + this.data{i}.attributes.Dim = size(varargin{1}{1},1); + this.data{i}.data = single(varargin{1}{1}(:,i)); + end + + elseif ischar(varargin{1}) + if size(varargin{1},1)>1 + this = gifti(cellstr(varargin{1})); + return; + end + [p,n,e] = fileparts(varargin{1}); + if strcmpi(e,'.mat') + try + this = gifti(load(varargin{1})); + catch + error('[GIFTI] Loading of file %s failed.', varargin{1}); + end + elseif strcmpi(e,'.asc') || strcmpi(e,'.srf') + this = read_freesurfer_file(varargin{1}); + this = gifti(this); + elseif strcmpi(e,'.vtk') + this = mvtk_read(varargin{1}); + this = gifti(this); + elseif strcmpi(e,'.obj') + this = obj_read(varargin{1}); + this = gifti(this); + else + this = read_gifti_file(varargin{1},giftistruct); + this = class(this,'gifti'); + end + + elseif iscellstr(varargin{1}) + fnames = varargin{1}; + this(numel(fnames)) = giftistruct; + this = class(this,'gifti'); + for i=1:numel(fnames) + this(i) = gifti(fnames{i}); + end + + else + error('[GIFTI] Invalid object construction.'); + end + + otherwise + error('[GIFTI] Invalid object construction.'); +end + +%========================================================================== +function s = giftistruct +s = struct(... + 'metadata', ... + struct(... + 'name', {}, ... + 'value', {} ... + ), ... + 'label', ... + struct(... + 'name', {}, ... + 'index', {} ... + ), ... + 'data', ... + struct(... + 'attributes', {}, ... + 'metadata', struct('name',{}, 'value',{}), ... + 'space', {}, ... + 'data', {} ... + ) ... + ); diff --git a/Toolboxes/spm12/@gifti/isfield.m b/Toolboxes/spm12/@gifti/isfield.m new file mode 100644 index 0000000000000000000000000000000000000000..275578be83072c76b285473849d7dbd43a5ec915 --- /dev/null +++ b/Toolboxes/spm12/@gifti/isfield.m @@ -0,0 +1,13 @@ +function tf = isfield(this,field) +% Isfield method for GIfTI objects +% FORMAT tf = isfield(this,field) +% this - GIfTI object +% field - string of cell array +% tf - logical array +%__________________________________________________________________________ +% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging + +% Guillaume Flandin +% $Id: isfield.m 6507 2015-07-24 16:48:02Z guillaume $ + +tf = ismember(field, fieldnames(this)); diff --git a/Toolboxes/spm12/@gifti/plot.m b/Toolboxes/spm12/@gifti/plot.m new file mode 100644 index 0000000000000000000000000000000000000000..76ae4e5eb32dd8249775d2b5f0c5a115ce39b013 --- /dev/null +++ b/Toolboxes/spm12/@gifti/plot.m @@ -0,0 +1,67 @@ +function varargout = plot(varargin) +% plot method for GIfTI objects +%__________________________________________________________________________ +% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging + +% Guillaume Flandin +% $Id: plot.m 5888 2014-02-19 19:54:12Z guillaume $ + +% if ishandle(varargin{1}) +% h = figure(varargin{1}); +% else +% h = figure; +% %axis equal; +% %axis off; +% %camlight; +% %camlight(-80,-10); +% %lighting phong; +% end +% cameramenu; + + +cdata = []; +ax = []; +if nargin == 1 + this = varargin{1}; + h = gcf; +else + if ishandle(varargin{1}) + ax = varargin{1}; + h = figure(get(ax,'parent')); + this = varargin{2}; + else + this = varargin{1}; + h = gcf; + cdata = subsref(varargin{2},struct('type','.','subs','cdata')); + end + if nargin > 2 + indc = varargin{3}; + else + indc = 1; + end +end + +if isempty(ax), ax = axes('Parent',h); end +axis(ax,'equal'); +axis(ax,'off'); +hp = patch(struct(... + 'vertices', subsref(this,struct('type','.','subs','vertices')),... + 'faces', subsref(this,struct('type','.','subs','faces'))),... + 'FaceColor', 'b',... + 'EdgeColor', 'none',... + 'Parent',ax); + +if ~isempty(cdata) + set(hp,'FaceVertexCData',cdata(:,indc), 'FaceColor','interp') +end + +axes(ax); +camlight; +camlight(-80,-10); +lighting phong; +axes(ax); +cameramenu; + +if nargout + varargout{1} = hp; +end diff --git a/Toolboxes/spm12/@gifti/private/Makefile b/Toolboxes/spm12/@gifti/private/Makefile new file mode 100644 index 0000000000000000000000000000000000000000..9e7489708f93fb29829fa825b38714098dfc2bb1 --- /dev/null +++ b/Toolboxes/spm12/@gifti/private/Makefile @@ -0,0 +1,38 @@ +#!/usr/bin/env make -f +# GIfTI Makefile called by {SPM}/src/Makefile +# +# Copyright (C) 2015 Wellcome Trust Centre for Neuroimaging +# +# $Id: Makefile 6704 2016-01-29 17:23:13Z guillaume $ + +include ../../src/Makefile.var + +SPMMEX = zstream.$(SUF) + +ifeq (mex,$(SUF)) + export CFLAGS = $(shell $(MEX) -p CFLAGS) -std=c99 +else + ifeq (windows,$(PLATFORM)) + MEXOPTS += CFLAGS=\"$$CFLAGS -std=c99\" + else + MEXOPTS += CFLAGS='$$CFLAGS -std=c99' + endif +endif + +all: $(SPMMEX) + @: + +clean: + @: + +distclean: clean + $(DEL) $(SPMMEX) + +install: + @: + +tarball: all + $(TAR) cf spm_mex.tar $(SPMMEX) + +%.$(SUF) : %.c + $(MEX) $< $(MEXEND) diff --git a/Toolboxes/spm12/@gifti/private/base64decode.m b/Toolboxes/spm12/@gifti/private/base64decode.m new file mode 100644 index 0000000000000000000000000000000000000000..8b7a15485f975ad95b8506f0547c6f10de2f9d61 --- /dev/null +++ b/Toolboxes/spm12/@gifti/private/base64decode.m @@ -0,0 +1,81 @@ +function y = base64decode(x) +%BASE64DECODE Perform base64 decoding on a string. +% +% BASE64DECODE(STR) decodes the given base64 string STR. +% +% Any character not part of the 65-character base64 subset set is silently +% ignored. +% +% This function is used to decode strings from the Base64 encoding specified +% in RFC 2045 - MIME (Multipurpose Internet Mail Extensions). The Base64 +% encoding is designed to represent arbitrary sequences of octets in a form +% that need not be humanly readable. A 65-character subset ([A-Za-z0-9+/=]) +% of US-ASCII is used, enabling 6 bits to be represented per printable +% character. +% +% See also BASE64ENCODE. + +% Author: Peter J. Acklam +% Time-stamp: 2004-09-20 08:20:50 +0200 +% E-mail: pjacklam@online.no +% URL: http://home.online.no/~pjacklam + +% Modified by Guillaume Flandin, May 2008 + + +% Perform the following mapping +%-------------------------------------------------------------------------- +% A-Z -> 0 - 25 a-z -> 26 - 51 0-9 -> 52 - 61 +% + -> 62 / -> 63 = -> 64 +% anything else -> NaN + +base64chars = NaN(1,256); +base64chars('ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=') = 0:64; +x = base64chars(x); + +% Remove/ignore any characters not in the base64 characters list or '=' +%-------------------------------------------------------------------------- + +x = x(~isnan(x)); + +% Replace any incoming padding ('=' -> 64) with a zero pad +%-------------------------------------------------------------------------- + +if x(end-1) == 64, p = 2; x(end-1:end) = 0; +elseif x(end) == 64, p = 1; x(end) = 0; +else p = 0; +end + +% Allocate decoded data array +%-------------------------------------------------------------------------- + +n = length(x) / 4; % number of groups +x = reshape(uint8(x), 4, n); % input data +y = zeros(3, n, 'uint8'); % decoded data + +% Rearrange every 4 bytes into 3 bytes +%-------------------------------------------------------------------------- +% 00aaaaaa 00bbbbbb 00cccccc 00dddddd +% +% to form +% +% aaaaaabb bbbbcccc ccdddddd + +y(1,:) = bitshift(x(1,:), 2); % 6 highest bits of y(1,:) +y(1,:) = bitor(y(1,:), bitshift(x(2,:), -4)); % 2 lowest bits of y(1,:) + +y(2,:) = bitshift(x(2,:), 4); % 4 highest bits of y(2,:) +y(2,:) = bitor(y(2,:), bitshift(x(3,:), -2)); % 4 lowest bits of y(2,:) + +y(3,:) = bitshift(x(3,:), 6); % 2 highest bits of y(3,:) +y(3,:) = bitor(y(3,:), x(4,:)); % 6 lowest bits of y(3,:) + +% Remove any zero pad that was added to make this a multiple of 24 bits +%-------------------------------------------------------------------------- + +if p, y(end-p+1:end) = []; end + +% Reshape to a row vector +%-------------------------------------------------------------------------- + +y = reshape(y, 1, []); diff --git a/Toolboxes/spm12/@gifti/private/base64encode.m b/Toolboxes/spm12/@gifti/private/base64encode.m new file mode 100644 index 0000000000000000000000000000000000000000..0a316df6ebeb4a5ec90cbe5661400a4f15e0fa72 --- /dev/null +++ b/Toolboxes/spm12/@gifti/private/base64encode.m @@ -0,0 +1,157 @@ +function y = base64encode(x, eol) +%BASE64ENCODE Perform base64 encoding on a string. +% +% BASE64ENCODE(STR, EOL) encode the given string STR. EOL is the line ending +% sequence to use; it is optional and defaults to '\n' (ASCII decimal 10). +% The returned encoded string is broken into lines of no more than 76 +% characters each, and each line will end with EOL unless it is empty. Let +% EOL be empty if you do not want the encoded string broken into lines. +% +% STR and EOL don't have to be strings (i.e., char arrays). The only +% requirement is that they are vectors containing values in the range 0-255. +% +% This function may be used to encode strings into the Base64 encoding +% specified in RFC 2045 - MIME (Multipurpose Internet Mail Extensions). The +% Base64 encoding is designed to represent arbitrary sequences of octets in a +% form that need not be humanly readable. A 65-character subset +% ([A-Za-z0-9+/=]) of US-ASCII is used, enabling 6 bits to be represented per +% printable character. +% +% Examples +% -------- +% +% If you want to encode a large file, you should encode it in chunks that are +% a multiple of 57 bytes. This ensures that the base64 lines line up and +% that you do not end up with padding in the middle. 57 bytes of data fills +% one complete base64 line (76 == 57*4/3): +% +% If ifid and ofid are two file identifiers opened for reading and writing, +% respectively, then you can base64 encode the data with +% +% while ~feof(ifid) +% fwrite(ofid, base64encode(fread(ifid, 60*57))); +% end +% +% or, if you have enough memory, +% +% fwrite(ofid, base64encode(fread(ifid))); +% +% See also BASE64DECODE. + +% Author: Peter J. Acklam +% Time-stamp: 2004-02-03 21:36:56 +0100 +% E-mail: pjacklam@online.no +% URL: http://home.online.no/~pjacklam + + + % make sure we have the EOL value + if nargin < 2 + eol = ''; %sprintf('\n'); + else + if sum(size(eol) > 1) > 1 + error('EOL must be a vector.'); + end + if any(eol(:) > 255) + error('EOL can not contain values larger than 255.'); + end + end + + if sum(size(x) > 1) > 1 + error('STR must be a vector.'); + end + + x = uint8(x); + eol = uint8(eol); + + ndbytes = length(x); % number of decoded bytes + nchunks = ceil(ndbytes / 3); % number of chunks/groups + nebytes = 4 * nchunks; % number of encoded bytes + + % add padding if necessary, to make the length of x a multiple of 3 + if rem(ndbytes, 3) + x(end+1 : 3*nchunks) = 0; + end + + x = reshape(x, [3, nchunks]); % reshape the data + y = repmat(uint8(0), 4, nchunks); % for the encoded data + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + % Split up every 3 bytes into 4 pieces + % + % aaaaaabb bbbbcccc ccdddddd + % + % to form + % + % 00aaaaaa 00bbbbbb 00cccccc 00dddddd + % + y(1,:) = bitshift(x(1,:), -2); % 6 highest bits of x(1,:) + + y(2,:) = bitshift(bitand(x(1,:), 3), 4); % 2 lowest bits of x(1,:) + y(2,:) = bitor(y(2,:), bitshift(x(2,:), -4)); % 4 highest bits of x(2,:) + + y(3,:) = bitshift(bitand(x(2,:), 15), 2); % 4 lowest bits of x(2,:) + y(3,:) = bitor(y(3,:), bitshift(x(3,:), -6)); % 2 highest bits of x(3,:) + + y(4,:) = bitand(x(3,:), 63); % 6 lowest bits of x(3,:) + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + % Now perform the following mapping + % + % 0 - 25 -> A-Z + % 26 - 51 -> a-z + % 52 - 61 -> 0-9 + % 62 -> + + % 63 -> / + % + % We could use a mapping vector like + % + % ['A':'Z', 'a':'z', '0':'9', '+/'] + % + % but that would require an index vector of class double. + % + z = repmat(uint8(0), size(y)); + i = y <= 25; z(i) = 'A' + double(y(i)); + i = 26 <= y & y <= 51; z(i) = 'a' - 26 + double(y(i)); + i = 52 <= y & y <= 61; z(i) = '0' - 52 + double(y(i)); + i = y == 62; z(i) = '+'; + i = y == 63; z(i) = '/'; + y = z; + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + % Add padding if necessary. + % + npbytes = 3 * nchunks - ndbytes; % number of padding bytes + if npbytes + y(end-npbytes+1 : end) = '='; % '=' is used for padding + end + + if isempty(eol) + + % reshape to a row vector + y = reshape(y, [1, nebytes]); + + else + + nlines = ceil(nebytes / 76); % number of lines + neolbytes = length(eol); % number of bytes in eol string + + % pad data so it becomes a multiple of 76 elements + y(nebytes + 1 : 76 * nlines) = 0; + y = reshape(y, 76, nlines); + + % insert eol strings + eol = eol(:); + y(end + 1 : end + neolbytes, :) = eol(:, ones(1, nlines)); + + % remove padding, but keep the last eol string + m = nebytes + neolbytes * (nlines - 1); + n = (76+neolbytes)*nlines - neolbytes; + y(m+1 : n) = ''; + + % extract and reshape to row vector + y = reshape(y, 1, m+neolbytes); + + end + + % output is a character array + y = char(y); diff --git a/Toolboxes/spm12/@gifti/private/getdict.m b/Toolboxes/spm12/@gifti/private/getdict.m new file mode 100644 index 0000000000000000000000000000000000000000..3d457b13dba715ed1b276e8eea3e6804d82ee5d3 --- /dev/null +++ b/Toolboxes/spm12/@gifti/private/getdict.m @@ -0,0 +1,26 @@ +function d = getdict +% Dictionary of GIfTI/NIfTI stuff +%__________________________________________________________________________ +% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging + +% Guillaume Flandin +% $Id: getdict.m 4505 2011-09-30 11:45:58Z guillaume $ + +persistent dict; +if ~isempty(dict) + d = dict; + return; +end + +table = {... + 'NIFTI_TYPE_UINT8', 'uint8', '%d', @uint8, 'uint8' + 'NIFTI_TYPE_INT32', 'int32', '%d', @int32, 'int32' + 'NIFTI_TYPE_FLOAT32', 'float32', '%f', @single, 'single' + 'NIFTI_TYPE_FLOAT64', 'float64', '%f', @double, 'double'}; + +for i=1:size(table,1) + dict.(table{i,1}) = cell2struct({table{i,2:end}},... + {'class', 'format', 'conv', 'cast'}, 2); +end + +d = dict; \ No newline at end of file diff --git a/Toolboxes/spm12/@gifti/private/isintent.m b/Toolboxes/spm12/@gifti/private/isintent.m new file mode 100644 index 0000000000000000000000000000000000000000..dfe3c3f8f4e09a345ca54fcfc0d86e425163e7ff --- /dev/null +++ b/Toolboxes/spm12/@gifti/private/isintent.m @@ -0,0 +1,116 @@ +function [a, b] = isintent(this,intent) +% Correspondance between fieldnames and NIfTI intent codes +% FORMAT ind = isintent(this,intent) +% this - GIfTI object +% intent - fieldnames +% a - indices of found intent(s) +% b - indices of dataarrays of found intent(s) +%__________________________________________________________________________ +% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging + +% Guillaume Flandin +% $Id: isintent.m 6345 2015-02-20 12:25:50Z guillaume $ + +a = []; +b = []; +if ischar(intent), intent = cellstr(intent); end +for i=1:length(this(1).data) + switch this(1).data{i}.attributes.Intent(14:end) + case 'POINTSET' + [tf, loc] = ismember('vertices',intent); + if tf + a(end+1) = loc; + b(end+1) = i; + end + [tf, loc] = ismember('mat',intent); + if tf + a(end+1) = loc; + b(end+1) = i; + end + case 'TRIANGLE' + [tf, loc] = ismember('faces',intent); + if tf + a(end+1) = loc; + b(end+1) = i; + end + case 'VECTOR' + [tf, loc] = ismember('normals',intent); + if tf + a(end+1) = loc; + b(end+1) = i; + end + case 'NODE_INDEX' + [tf, loc] = ismember('indices',intent); + if tf + a(end+1) = loc; + b(end+1) = i; + end + case cdata + [tf, loc] = ismember('cdata',intent); + if tf + a(end+1) = loc; + b(end+1) = i; + end + if strcmp(this(1).data{i}.attributes.Intent(14:end),'LABEL') + [tf, loc] = ismember('labels',intent); + if tf + a(end+1) = loc; + b(end+1) = i; + end + end + otherwise + fprintf('Intent %s is ignored.\n',this.data{i}.attributes.Intent); + end +end +%[d,i] = unique(a); +%if length(d) < length(a) +% warning('Several fields match intent type. Using first.'); +% a = a(i); +% b = b(i); +%end + +function c = cdata + +c = { +'NONE' +'CORREL' +'TTEST' +'FTEST' +'ZSCORE' +'CHISQ' +'BETA' +'BINOM' +'GAMMA' +'POISSON' +'NORMAL' +'FTEST_NONC' +'CHISQ_NONC' +'LOGISTIC' +'LAPLACE' +'UNIFORM' +'TTEST_NONC' +'WEIBULL' +'CHI' +'INVGAUSS' +'EXTVAL' +'PVAL' +'LOGPVAL' +'LOG10PVAL' +'ESTIMATE' +'LABEL' +'NEURONAMES' +'GENMATRIX' +'SYMMATRIX' +'DISPVECT' +'QUATERNION' +'DIMLESS' +'TIME_SERIES' +'RGB_VECTOR' +'RGBA_VECTOR' +'SHAPE' +'CONNECTIVITY_DENSE' +'CONNECTIVITY_DENSE_TIME' +'CONNECTIVITY_PARCELLATED' +'CONNECTIVITY_PARCELLATED_TIME' +'CONNECTIVITY_CONNECTIVITY_TRAJECTORY' +}; diff --git a/Toolboxes/spm12/@gifti/private/miniz.c b/Toolboxes/spm12/@gifti/private/miniz.c new file mode 100644 index 0000000000000000000000000000000000000000..ae4058cce1037f4271799879a263db7daf5735e3 --- /dev/null +++ b/Toolboxes/spm12/@gifti/private/miniz.c @@ -0,0 +1,4916 @@ +/* miniz.c v1.15 - public domain deflate/inflate, zlib-subset, ZIP reading/writing/appending, PNG writing + See "unlicense" statement at the end of this file. + Rich Geldreich , last updated Oct. 13, 2013 + Implements RFC 1950: http://www.ietf.org/rfc/rfc1950.txt and RFC 1951: http://www.ietf.org/rfc/rfc1951.txt + + Most API's defined in miniz.c are optional. For example, to disable the archive related functions just define + MINIZ_NO_ARCHIVE_APIS, or to get rid of all stdio usage define MINIZ_NO_STDIO (see the list below for more macros). + + * Change History + 10/13/13 v1.15 r4 - Interim bugfix release while I work on the next major release with Zip64 support (almost there!): + - Critical fix for the MZ_ZIP_FLAG_DO_NOT_SORT_CENTRAL_DIRECTORY bug (thanks kahmyong.moon@hp.com) which could cause locate files to not find files. This bug + would only have occured in earlier versions if you explicitly used this flag, OR if you used mz_zip_extract_archive_file_to_heap() or mz_zip_add_mem_to_archive_file_in_place() + (which used this flag). If you can't switch to v1.15 but want to fix this bug, just remove the uses of this flag from both helper funcs (and of course don't use the flag). + - Bugfix in mz_zip_reader_extract_to_mem_no_alloc() from kymoon when pUser_read_buf is not NULL and compressed size is > uncompressed size + - Fixing mz_zip_reader_extract_*() funcs so they don't try to extract compressed data from directory entries, to account for weird zipfiles which contain zero-size compressed data on dir entries. + Hopefully this fix won't cause any issues on weird zip archives, because it assumes the low 16-bits of zip external attributes are DOS attributes (which I believe they always are in practice). + - Fixing mz_zip_reader_is_file_a_directory() so it doesn't check the internal attributes, just the filename and external attributes + - mz_zip_reader_init_file() - missing MZ_FCLOSE() call if the seek failed + - Added cmake support for Linux builds which builds all the examples, tested with clang v3.3 and gcc v4.6. + - Clang fix for tdefl_write_image_to_png_file_in_memory() from toffaletti + - Merged MZ_FORCEINLINE fix from hdeanclark + - Fix include before config #ifdef, thanks emil.brink + - Added tdefl_write_image_to_png_file_in_memory_ex(): supports Y flipping (super useful for OpenGL apps), and explicit control over the compression level (so you can + set it to 1 for real-time compression). + - Merged in some compiler fixes from paulharris's github repro. + - Retested this build under Windows (VS 2010, including static analysis), tcc 0.9.26, gcc v4.6 and clang v3.3. + - Added example6.c, which dumps an image of the mandelbrot set to a PNG file. + - Modified example2 to help test the MZ_ZIP_FLAG_DO_NOT_SORT_CENTRAL_DIRECTORY flag more. + - In r3: Bugfix to mz_zip_writer_add_file() found during merge: Fix possible src file fclose() leak if alignment bytes+local header file write faiiled + - In r4: Minor bugfix to mz_zip_writer_add_from_zip_reader(): Was pushing the wrong central dir header offset, appears harmless in this release, but it became a problem in the zip64 branch + 5/20/12 v1.14 - MinGW32/64 GCC 4.6.1 compiler fixes: added MZ_FORCEINLINE, #include (thanks fermtect). + 5/19/12 v1.13 - From jason@cornsyrup.org and kelwert@mtu.edu - Fix mz_crc32() so it doesn't compute the wrong CRC-32's when mz_ulong is 64-bit. + - Temporarily/locally slammed in "typedef unsigned long mz_ulong" and re-ran a randomized regression test on ~500k files. + - Eliminated a bunch of warnings when compiling with GCC 32-bit/64. + - Ran all examples, miniz.c, and tinfl.c through MSVC 2008's /analyze (static analysis) option and fixed all warnings (except for the silly + "Use of the comma-operator in a tested expression.." analysis warning, which I purposely use to work around a MSVC compiler warning). + - Created 32-bit and 64-bit Codeblocks projects/workspace. Built and tested Linux executables. The codeblocks workspace is compatible with Linux+Win32/x64. + - Added miniz_tester solution/project, which is a useful little app derived from LZHAM's tester app that I use as part of the regression test. + - Ran miniz.c and tinfl.c through another series of regression testing on ~500,000 files and archives. + - Modified example5.c so it purposely disables a bunch of high-level functionality (MINIZ_NO_STDIO, etc.). (Thanks to corysama for the MINIZ_NO_STDIO bug report.) + - Fix ftell() usage in examples so they exit with an error on files which are too large (a limitation of the examples, not miniz itself). + 4/12/12 v1.12 - More comments, added low-level example5.c, fixed a couple minor level_and_flags issues in the archive API's. + level_and_flags can now be set to MZ_DEFAULT_COMPRESSION. Thanks to Bruce Dawson for the feedback/bug report. + 5/28/11 v1.11 - Added statement from unlicense.org + 5/27/11 v1.10 - Substantial compressor optimizations: + - Level 1 is now ~4x faster than before. The L1 compressor's throughput now varies between 70-110MB/sec. on a + - Core i7 (actual throughput varies depending on the type of data, and x64 vs. x86). + - Improved baseline L2-L9 compression perf. Also, greatly improved compression perf. issues on some file types. + - Refactored the compression code for better readability and maintainability. + - Added level 10 compression level (L10 has slightly better ratio than level 9, but could have a potentially large + drop in throughput on some files). + 5/15/11 v1.09 - Initial stable release. + + * Low-level Deflate/Inflate implementation notes: + + Compression: Use the "tdefl" API's. The compressor supports raw, static, and dynamic blocks, lazy or + greedy parsing, match length filtering, RLE-only, and Huffman-only streams. It performs and compresses + approximately as well as zlib. + + Decompression: Use the "tinfl" API's. The entire decompressor is implemented as a single function + coroutine: see tinfl_decompress(). It supports decompression into a 32KB (or larger power of 2) wrapping buffer, or into a memory + block large enough to hold the entire file. + + The low-level tdefl/tinfl API's do not make any use of dynamic memory allocation. + + * zlib-style API notes: + + miniz.c implements a fairly large subset of zlib. There's enough functionality present for it to be a drop-in + zlib replacement in many apps: + The z_stream struct, optional memory allocation callbacks + deflateInit/deflateInit2/deflate/deflateReset/deflateEnd/deflateBound + inflateInit/inflateInit2/inflate/inflateEnd + compress, compress2, compressBound, uncompress + CRC-32, Adler-32 - Using modern, minimal code size, CPU cache friendly routines. + Supports raw deflate streams or standard zlib streams with adler-32 checking. + + Limitations: + The callback API's are not implemented yet. No support for gzip headers or zlib static dictionaries. + I've tried to closely emulate zlib's various flavors of stream flushing and return status codes, but + there are no guarantees that miniz.c pulls this off perfectly. + + * PNG writing: See the tdefl_write_image_to_png_file_in_memory() function, originally written by + Alex Evans. Supports 1-4 bytes/pixel images. + + * ZIP archive API notes: + + The ZIP archive API's where designed with simplicity and efficiency in mind, with just enough abstraction to + get the job done with minimal fuss. There are simple API's to retrieve file information, read files from + existing archives, create new archives, append new files to existing archives, or clone archive data from + one archive to another. It supports archives located in memory or the heap, on disk (using stdio.h), + or you can specify custom file read/write callbacks. + + - Archive reading: Just call this function to read a single file from a disk archive: + + void *mz_zip_extract_archive_file_to_heap(const char *pZip_filename, const char *pArchive_name, + size_t *pSize, mz_uint zip_flags); + + For more complex cases, use the "mz_zip_reader" functions. Upon opening an archive, the entire central + directory is located and read as-is into memory, and subsequent file access only occurs when reading individual files. + + - Archives file scanning: The simple way is to use this function to scan a loaded archive for a specific file: + + int mz_zip_reader_locate_file(mz_zip_archive *pZip, const char *pName, const char *pComment, mz_uint flags); + + The locate operation can optionally check file comments too, which (as one example) can be used to identify + multiple versions of the same file in an archive. This function uses a simple linear search through the central + directory, so it's not very fast. + + Alternately, you can iterate through all the files in an archive (using mz_zip_reader_get_num_files()) and + retrieve detailed info on each file by calling mz_zip_reader_file_stat(). + + - Archive creation: Use the "mz_zip_writer" functions. The ZIP writer immediately writes compressed file data + to disk and builds an exact image of the central directory in memory. The central directory image is written + all at once at the end of the archive file when the archive is finalized. + + The archive writer can optionally align each file's local header and file data to any power of 2 alignment, + which can be useful when the archive will be read from optical media. Also, the writer supports placing + arbitrary data blobs at the very beginning of ZIP archives. Archives written using either feature are still + readable by any ZIP tool. + + - Archive appending: The simple way to add a single file to an archive is to call this function: + + mz_bool mz_zip_add_mem_to_archive_file_in_place(const char *pZip_filename, const char *pArchive_name, + const void *pBuf, size_t buf_size, const void *pComment, mz_uint16 comment_size, mz_uint level_and_flags); + + The archive will be created if it doesn't already exist, otherwise it'll be appended to. + Note the appending is done in-place and is not an atomic operation, so if something goes wrong + during the operation it's possible the archive could be left without a central directory (although the local + file headers and file data will be fine, so the archive will be recoverable). + + For more complex archive modification scenarios: + 1. The safest way is to use a mz_zip_reader to read the existing archive, cloning only those bits you want to + preserve into a new archive using using the mz_zip_writer_add_from_zip_reader() function (which compiles the + compressed file data as-is). When you're done, delete the old archive and rename the newly written archive, and + you're done. This is safe but requires a bunch of temporary disk space or heap memory. + + 2. Or, you can convert an mz_zip_reader in-place to an mz_zip_writer using mz_zip_writer_init_from_reader(), + append new files as needed, then finalize the archive which will write an updated central directory to the + original archive. (This is basically what mz_zip_add_mem_to_archive_file_in_place() does.) There's a + possibility that the archive's central directory could be lost with this method if anything goes wrong, though. + + - ZIP archive support limitations: + No zip64 or spanning support. Extraction functions can only handle unencrypted, stored or deflated files. + Requires streams capable of seeking. + + * This is a header file library, like stb_image.c. To get only a header file, either cut and paste the + below header, or create miniz.h, #define MINIZ_HEADER_FILE_ONLY, and then include miniz.c from it. + + * Important: For best perf. be sure to customize the below macros for your target platform: + #define MINIZ_USE_UNALIGNED_LOADS_AND_STORES 1 + #define MINIZ_LITTLE_ENDIAN 1 + #define MINIZ_HAS_64BIT_REGISTERS 1 + + * On platforms using glibc, Be sure to "#define _LARGEFILE64_SOURCE 1" before including miniz.c to ensure miniz + uses the 64-bit variants: fopen64(), stat64(), etc. Otherwise you won't be able to process large files + (i.e. 32-bit stat() fails for me on files > 0x7FFFFFFF bytes). +*/ + +#ifndef MINIZ_HEADER_INCLUDED +#define MINIZ_HEADER_INCLUDED + +#include + +// Defines to completely disable specific portions of miniz.c: +// If all macros here are defined the only functionality remaining will be CRC-32, adler-32, tinfl, and tdefl. + +// Define MINIZ_NO_STDIO to disable all usage and any functions which rely on stdio for file I/O. +//#define MINIZ_NO_STDIO + +// If MINIZ_NO_TIME is specified then the ZIP archive functions will not be able to get the current time, or +// get/set file times, and the C run-time funcs that get/set times won't be called. +// The current downside is the times written to your archives will be from 1979. +//#define MINIZ_NO_TIME + +// Define MINIZ_NO_ARCHIVE_APIS to disable all ZIP archive API's. +//#define MINIZ_NO_ARCHIVE_APIS + +// Define MINIZ_NO_ARCHIVE_APIS to disable all writing related ZIP archive API's. +//#define MINIZ_NO_ARCHIVE_WRITING_APIS + +// Define MINIZ_NO_ZLIB_APIS to remove all ZLIB-style compression/decompression API's. +//#define MINIZ_NO_ZLIB_APIS + +// Define MINIZ_NO_ZLIB_COMPATIBLE_NAME to disable zlib names, to prevent conflicts against stock zlib. +//#define MINIZ_NO_ZLIB_COMPATIBLE_NAMES + +// Define MINIZ_NO_MALLOC to disable all calls to malloc, free, and realloc. +// Note if MINIZ_NO_MALLOC is defined then the user must always provide custom user alloc/free/realloc +// callbacks to the zlib and archive API's, and a few stand-alone helper API's which don't provide custom user +// functions (such as tdefl_compress_mem_to_heap() and tinfl_decompress_mem_to_heap()) won't work. +//#define MINIZ_NO_MALLOC + +#if defined(__TINYC__) && (defined(__linux) || defined(__linux__)) + // TODO: Work around "error: include file 'sys\utime.h' when compiling with tcc on Linux + #define MINIZ_NO_TIME +#endif + +#if !defined(MINIZ_NO_TIME) && !defined(MINIZ_NO_ARCHIVE_APIS) + #include +#endif + +#if defined(_M_IX86) || defined(_M_X64) || defined(__i386__) || defined(__i386) || defined(__i486__) || defined(__i486) || defined(i386) || defined(__ia64__) || defined(__x86_64__) +// MINIZ_X86_OR_X64_CPU is only used to help set the below macros. +#define MINIZ_X86_OR_X64_CPU 1 +#endif + +#if (__BYTE_ORDER__==__ORDER_LITTLE_ENDIAN__) || MINIZ_X86_OR_X64_CPU +// Set MINIZ_LITTLE_ENDIAN to 1 if the processor is little endian. +#define MINIZ_LITTLE_ENDIAN 1 +#endif + +#if MINIZ_X86_OR_X64_CPU +// Set MINIZ_USE_UNALIGNED_LOADS_AND_STORES to 1 on CPU's that permit efficient integer loads and stores from unaligned addresses. +#define MINIZ_USE_UNALIGNED_LOADS_AND_STORES 1 +#endif + +#if defined(_M_X64) || defined(_WIN64) || defined(__MINGW64__) || defined(_LP64) || defined(__LP64__) || defined(__ia64__) || defined(__x86_64__) +// Set MINIZ_HAS_64BIT_REGISTERS to 1 if operations on 64-bit integers are reasonably fast (and don't involve compiler generated calls to helper functions). +#define MINIZ_HAS_64BIT_REGISTERS 1 +#endif + +#ifdef __cplusplus +extern "C" { +#endif + +// ------------------- zlib-style API Definitions. + +// For more compatibility with zlib, miniz.c uses unsigned long for some parameters/struct members. Beware: mz_ulong can be either 32 or 64-bits! +typedef unsigned long mz_ulong; + +// mz_free() internally uses the MZ_FREE() macro (which by default calls free() unless you've modified the MZ_MALLOC macro) to release a block allocated from the heap. +void mz_free(void *p); + +#define MZ_ADLER32_INIT (1) +// mz_adler32() returns the initial adler-32 value to use when called with ptr==NULL. +mz_ulong mz_adler32(mz_ulong adler, const unsigned char *ptr, size_t buf_len); + +#define MZ_CRC32_INIT (0) +// mz_crc32() returns the initial CRC-32 value to use when called with ptr==NULL. +mz_ulong mz_crc32(mz_ulong crc, const unsigned char *ptr, size_t buf_len); + +// Compression strategies. +enum { MZ_DEFAULT_STRATEGY = 0, MZ_FILTERED = 1, MZ_HUFFMAN_ONLY = 2, MZ_RLE = 3, MZ_FIXED = 4 }; + +// Method +#define MZ_DEFLATED 8 + +#ifndef MINIZ_NO_ZLIB_APIS + +// Heap allocation callbacks. +// Note that mz_alloc_func parameter types purpsosely differ from zlib's: items/size is size_t, not unsigned long. +typedef void *(*mz_alloc_func)(void *opaque, size_t items, size_t size); +typedef void (*mz_free_func)(void *opaque, void *address); +typedef void *(*mz_realloc_func)(void *opaque, void *address, size_t items, size_t size); + +#define MZ_VERSION "9.1.15" +#define MZ_VERNUM 0x91F0 +#define MZ_VER_MAJOR 9 +#define MZ_VER_MINOR 1 +#define MZ_VER_REVISION 15 +#define MZ_VER_SUBREVISION 0 + +// Flush values. For typical usage you only need MZ_NO_FLUSH and MZ_FINISH. The other values are for advanced use (refer to the zlib docs). +enum { MZ_NO_FLUSH = 0, MZ_PARTIAL_FLUSH = 1, MZ_SYNC_FLUSH = 2, MZ_FULL_FLUSH = 3, MZ_FINISH = 4, MZ_BLOCK = 5 }; + +// Return status codes. MZ_PARAM_ERROR is non-standard. +enum { MZ_OK = 0, MZ_STREAM_END = 1, MZ_NEED_DICT = 2, MZ_ERRNO = -1, MZ_STREAM_ERROR = -2, MZ_DATA_ERROR = -3, MZ_MEM_ERROR = -4, MZ_BUF_ERROR = -5, MZ_VERSION_ERROR = -6, MZ_PARAM_ERROR = -10000 }; + +// Compression levels: 0-9 are the standard zlib-style levels, 10 is best possible compression (not zlib compatible, and may be very slow), MZ_DEFAULT_COMPRESSION=MZ_DEFAULT_LEVEL. +enum { MZ_NO_COMPRESSION = 0, MZ_BEST_SPEED = 1, MZ_BEST_COMPRESSION = 9, MZ_UBER_COMPRESSION = 10, MZ_DEFAULT_LEVEL = 6, MZ_DEFAULT_COMPRESSION = -1 }; + +// Window bits +#define MZ_DEFAULT_WINDOW_BITS 15 + +struct mz_internal_state; + +// Compression/decompression stream struct. +typedef struct mz_stream_s +{ + const unsigned char *next_in; // pointer to next byte to read + unsigned int avail_in; // number of bytes available at next_in + mz_ulong total_in; // total number of bytes consumed so far + + unsigned char *next_out; // pointer to next byte to write + unsigned int avail_out; // number of bytes that can be written to next_out + mz_ulong total_out; // total number of bytes produced so far + + char *msg; // error msg (unused) + struct mz_internal_state *state; // internal state, allocated by zalloc/zfree + + mz_alloc_func zalloc; // optional heap allocation function (defaults to malloc) + mz_free_func zfree; // optional heap free function (defaults to free) + void *opaque; // heap alloc function user pointer + + int data_type; // data_type (unused) + mz_ulong adler; // adler32 of the source or uncompressed data + mz_ulong reserved; // not used +} mz_stream; + +typedef mz_stream *mz_streamp; + +// Returns the version string of miniz.c. +const char *mz_version(void); + +// mz_deflateInit() initializes a compressor with default options: +// Parameters: +// pStream must point to an initialized mz_stream struct. +// level must be between [MZ_NO_COMPRESSION, MZ_BEST_COMPRESSION]. +// level 1 enables a specially optimized compression function that's been optimized purely for performance, not ratio. +// (This special func. is currently only enabled when MINIZ_USE_UNALIGNED_LOADS_AND_STORES and MINIZ_LITTLE_ENDIAN are defined.) +// Return values: +// MZ_OK on success. +// MZ_STREAM_ERROR if the stream is bogus. +// MZ_PARAM_ERROR if the input parameters are bogus. +// MZ_MEM_ERROR on out of memory. +int mz_deflateInit(mz_streamp pStream, int level); + +// mz_deflateInit2() is like mz_deflate(), except with more control: +// Additional parameters: +// method must be MZ_DEFLATED +// window_bits must be MZ_DEFAULT_WINDOW_BITS (to wrap the deflate stream with zlib header/adler-32 footer) or -MZ_DEFAULT_WINDOW_BITS (raw deflate/no header or footer) +// mem_level must be between [1, 9] (it's checked but ignored by miniz.c) +int mz_deflateInit2(mz_streamp pStream, int level, int method, int window_bits, int mem_level, int strategy); + +// Quickly resets a compressor without having to reallocate anything. Same as calling mz_deflateEnd() followed by mz_deflateInit()/mz_deflateInit2(). +int mz_deflateReset(mz_streamp pStream); + +// mz_deflate() compresses the input to output, consuming as much of the input and producing as much output as possible. +// Parameters: +// pStream is the stream to read from and write to. You must initialize/update the next_in, avail_in, next_out, and avail_out members. +// flush may be MZ_NO_FLUSH, MZ_PARTIAL_FLUSH/MZ_SYNC_FLUSH, MZ_FULL_FLUSH, or MZ_FINISH. +// Return values: +// MZ_OK on success (when flushing, or if more input is needed but not available, and/or there's more output to be written but the output buffer is full). +// MZ_STREAM_END if all input has been consumed and all output bytes have been written. Don't call mz_deflate() on the stream anymore. +// MZ_STREAM_ERROR if the stream is bogus. +// MZ_PARAM_ERROR if one of the parameters is invalid. +// MZ_BUF_ERROR if no forward progress is possible because the input and/or output buffers are empty. (Fill up the input buffer or free up some output space and try again.) +int mz_deflate(mz_streamp pStream, int flush); + +// mz_deflateEnd() deinitializes a compressor: +// Return values: +// MZ_OK on success. +// MZ_STREAM_ERROR if the stream is bogus. +int mz_deflateEnd(mz_streamp pStream); + +// mz_deflateBound() returns a (very) conservative upper bound on the amount of data that could be generated by deflate(), assuming flush is set to only MZ_NO_FLUSH or MZ_FINISH. +mz_ulong mz_deflateBound(mz_streamp pStream, mz_ulong source_len); + +// Single-call compression functions mz_compress() and mz_compress2(): +// Returns MZ_OK on success, or one of the error codes from mz_deflate() on failure. +int mz_compress(unsigned char *pDest, mz_ulong *pDest_len, const unsigned char *pSource, mz_ulong source_len); +int mz_compress2(unsigned char *pDest, mz_ulong *pDest_len, const unsigned char *pSource, mz_ulong source_len, int level); + +// mz_compressBound() returns a (very) conservative upper bound on the amount of data that could be generated by calling mz_compress(). +mz_ulong mz_compressBound(mz_ulong source_len); + +// Initializes a decompressor. +int mz_inflateInit(mz_streamp pStream); + +// mz_inflateInit2() is like mz_inflateInit() with an additional option that controls the window size and whether or not the stream has been wrapped with a zlib header/footer: +// window_bits must be MZ_DEFAULT_WINDOW_BITS (to parse zlib header/footer) or -MZ_DEFAULT_WINDOW_BITS (raw deflate). +int mz_inflateInit2(mz_streamp pStream, int window_bits); + +// Decompresses the input stream to the output, consuming only as much of the input as needed, and writing as much to the output as possible. +// Parameters: +// pStream is the stream to read from and write to. You must initialize/update the next_in, avail_in, next_out, and avail_out members. +// flush may be MZ_NO_FLUSH, MZ_SYNC_FLUSH, or MZ_FINISH. +// On the first call, if flush is MZ_FINISH it's assumed the input and output buffers are both sized large enough to decompress the entire stream in a single call (this is slightly faster). +// MZ_FINISH implies that there are no more source bytes available beside what's already in the input buffer, and that the output buffer is large enough to hold the rest of the decompressed data. +// Return values: +// MZ_OK on success. Either more input is needed but not available, and/or there's more output to be written but the output buffer is full. +// MZ_STREAM_END if all needed input has been consumed and all output bytes have been written. For zlib streams, the adler-32 of the decompressed data has also been verified. +// MZ_STREAM_ERROR if the stream is bogus. +// MZ_DATA_ERROR if the deflate stream is invalid. +// MZ_PARAM_ERROR if one of the parameters is invalid. +// MZ_BUF_ERROR if no forward progress is possible because the input buffer is empty but the inflater needs more input to continue, or if the output buffer is not large enough. Call mz_inflate() again +// with more input data, or with more room in the output buffer (except when using single call decompression, described above). +int mz_inflate(mz_streamp pStream, int flush); + +// Deinitializes a decompressor. +int mz_inflateEnd(mz_streamp pStream); + +// Single-call decompression. +// Returns MZ_OK on success, or one of the error codes from mz_inflate() on failure. +int mz_uncompress(unsigned char *pDest, mz_ulong *pDest_len, const unsigned char *pSource, mz_ulong source_len); + +// Returns a string description of the specified error code, or NULL if the error code is invalid. +const char *mz_error(int err); + +// Redefine zlib-compatible names to miniz equivalents, so miniz.c can be used as a drop-in replacement for the subset of zlib that miniz.c supports. +// Define MINIZ_NO_ZLIB_COMPATIBLE_NAMES to disable zlib-compatibility if you use zlib in the same project. +#ifndef MINIZ_NO_ZLIB_COMPATIBLE_NAMES + typedef unsigned char Byte; + typedef unsigned int uInt; + typedef mz_ulong uLong; + typedef Byte Bytef; + typedef uInt uIntf; + typedef char charf; + typedef int intf; + typedef void *voidpf; + typedef uLong uLongf; + typedef void *voidp; + typedef void *const voidpc; + #define Z_NULL 0 + #define Z_NO_FLUSH MZ_NO_FLUSH + #define Z_PARTIAL_FLUSH MZ_PARTIAL_FLUSH + #define Z_SYNC_FLUSH MZ_SYNC_FLUSH + #define Z_FULL_FLUSH MZ_FULL_FLUSH + #define Z_FINISH MZ_FINISH + #define Z_BLOCK MZ_BLOCK + #define Z_OK MZ_OK + #define Z_STREAM_END MZ_STREAM_END + #define Z_NEED_DICT MZ_NEED_DICT + #define Z_ERRNO MZ_ERRNO + #define Z_STREAM_ERROR MZ_STREAM_ERROR + #define Z_DATA_ERROR MZ_DATA_ERROR + #define Z_MEM_ERROR MZ_MEM_ERROR + #define Z_BUF_ERROR MZ_BUF_ERROR + #define Z_VERSION_ERROR MZ_VERSION_ERROR + #define Z_PARAM_ERROR MZ_PARAM_ERROR + #define Z_NO_COMPRESSION MZ_NO_COMPRESSION + #define Z_BEST_SPEED MZ_BEST_SPEED + #define Z_BEST_COMPRESSION MZ_BEST_COMPRESSION + #define Z_DEFAULT_COMPRESSION MZ_DEFAULT_COMPRESSION + #define Z_DEFAULT_STRATEGY MZ_DEFAULT_STRATEGY + #define Z_FILTERED MZ_FILTERED + #define Z_HUFFMAN_ONLY MZ_HUFFMAN_ONLY + #define Z_RLE MZ_RLE + #define Z_FIXED MZ_FIXED + #define Z_DEFLATED MZ_DEFLATED + #define Z_DEFAULT_WINDOW_BITS MZ_DEFAULT_WINDOW_BITS + #define alloc_func mz_alloc_func + #define free_func mz_free_func + #define internal_state mz_internal_state + #define z_stream mz_stream + #define deflateInit mz_deflateInit + #define deflateInit2 mz_deflateInit2 + #define deflateReset mz_deflateReset + #define deflate mz_deflate + #define deflateEnd mz_deflateEnd + #define deflateBound mz_deflateBound + #define compress mz_compress + #define compress2 mz_compress2 + #define compressBound mz_compressBound + #define inflateInit mz_inflateInit + #define inflateInit2 mz_inflateInit2 + #define inflate mz_inflate + #define inflateEnd mz_inflateEnd + #define uncompress mz_uncompress + #define crc32 mz_crc32 + #define adler32 mz_adler32 + #define MAX_WBITS 15 + #define MAX_MEM_LEVEL 9 + #define zError mz_error + #define ZLIB_VERSION MZ_VERSION + #define ZLIB_VERNUM MZ_VERNUM + #define ZLIB_VER_MAJOR MZ_VER_MAJOR + #define ZLIB_VER_MINOR MZ_VER_MINOR + #define ZLIB_VER_REVISION MZ_VER_REVISION + #define ZLIB_VER_SUBREVISION MZ_VER_SUBREVISION + #define zlibVersion mz_version + #define zlib_version mz_version() +#endif // #ifndef MINIZ_NO_ZLIB_COMPATIBLE_NAMES + +#endif // MINIZ_NO_ZLIB_APIS + +// ------------------- Types and macros + +typedef unsigned char mz_uint8; +typedef signed short mz_int16; +typedef unsigned short mz_uint16; +typedef unsigned int mz_uint32; +typedef unsigned int mz_uint; +typedef long long mz_int64; +typedef unsigned long long mz_uint64; +typedef int mz_bool; + +#define MZ_FALSE (0) +#define MZ_TRUE (1) + +// An attempt to work around MSVC's spammy "warning C4127: conditional expression is constant" message. +#ifdef _MSC_VER + #define MZ_MACRO_END while (0, 0) +#else + #define MZ_MACRO_END while (0) +#endif + +// ------------------- ZIP archive reading/writing + +#ifndef MINIZ_NO_ARCHIVE_APIS + +enum +{ + MZ_ZIP_MAX_IO_BUF_SIZE = 64*1024, + MZ_ZIP_MAX_ARCHIVE_FILENAME_SIZE = 260, + MZ_ZIP_MAX_ARCHIVE_FILE_COMMENT_SIZE = 256 +}; + +typedef struct +{ + mz_uint32 m_file_index; + mz_uint32 m_central_dir_ofs; + mz_uint16 m_version_made_by; + mz_uint16 m_version_needed; + mz_uint16 m_bit_flag; + mz_uint16 m_method; +#ifndef MINIZ_NO_TIME + time_t m_time; +#endif + mz_uint32 m_crc32; + mz_uint64 m_comp_size; + mz_uint64 m_uncomp_size; + mz_uint16 m_internal_attr; + mz_uint32 m_external_attr; + mz_uint64 m_local_header_ofs; + mz_uint32 m_comment_size; + char m_filename[MZ_ZIP_MAX_ARCHIVE_FILENAME_SIZE]; + char m_comment[MZ_ZIP_MAX_ARCHIVE_FILE_COMMENT_SIZE]; +} mz_zip_archive_file_stat; + +typedef size_t (*mz_file_read_func)(void *pOpaque, mz_uint64 file_ofs, void *pBuf, size_t n); +typedef size_t (*mz_file_write_func)(void *pOpaque, mz_uint64 file_ofs, const void *pBuf, size_t n); + +struct mz_zip_internal_state_tag; +typedef struct mz_zip_internal_state_tag mz_zip_internal_state; + +typedef enum +{ + MZ_ZIP_MODE_INVALID = 0, + MZ_ZIP_MODE_READING = 1, + MZ_ZIP_MODE_WRITING = 2, + MZ_ZIP_MODE_WRITING_HAS_BEEN_FINALIZED = 3 +} mz_zip_mode; + +typedef struct mz_zip_archive_tag +{ + mz_uint64 m_archive_size; + mz_uint64 m_central_directory_file_ofs; + mz_uint m_total_files; + mz_zip_mode m_zip_mode; + + mz_uint m_file_offset_alignment; + + mz_alloc_func m_pAlloc; + mz_free_func m_pFree; + mz_realloc_func m_pRealloc; + void *m_pAlloc_opaque; + + mz_file_read_func m_pRead; + mz_file_write_func m_pWrite; + void *m_pIO_opaque; + + mz_zip_internal_state *m_pState; + +} mz_zip_archive; + +typedef enum +{ + MZ_ZIP_FLAG_CASE_SENSITIVE = 0x0100, + MZ_ZIP_FLAG_IGNORE_PATH = 0x0200, + MZ_ZIP_FLAG_COMPRESSED_DATA = 0x0400, + MZ_ZIP_FLAG_DO_NOT_SORT_CENTRAL_DIRECTORY = 0x0800 +} mz_zip_flags; + +// ZIP archive reading + +// Inits a ZIP archive reader. +// These functions read and validate the archive's central directory. +mz_bool mz_zip_reader_init(mz_zip_archive *pZip, mz_uint64 size, mz_uint32 flags); +mz_bool mz_zip_reader_init_mem(mz_zip_archive *pZip, const void *pMem, size_t size, mz_uint32 flags); + +#ifndef MINIZ_NO_STDIO +mz_bool mz_zip_reader_init_file(mz_zip_archive *pZip, const char *pFilename, mz_uint32 flags); +#endif + +// Returns the total number of files in the archive. +mz_uint mz_zip_reader_get_num_files(mz_zip_archive *pZip); + +// Returns detailed information about an archive file entry. +mz_bool mz_zip_reader_file_stat(mz_zip_archive *pZip, mz_uint file_index, mz_zip_archive_file_stat *pStat); + +// Determines if an archive file entry is a directory entry. +mz_bool mz_zip_reader_is_file_a_directory(mz_zip_archive *pZip, mz_uint file_index); +mz_bool mz_zip_reader_is_file_encrypted(mz_zip_archive *pZip, mz_uint file_index); + +// Retrieves the filename of an archive file entry. +// Returns the number of bytes written to pFilename, or if filename_buf_size is 0 this function returns the number of bytes needed to fully store the filename. +mz_uint mz_zip_reader_get_filename(mz_zip_archive *pZip, mz_uint file_index, char *pFilename, mz_uint filename_buf_size); + +// Attempts to locates a file in the archive's central directory. +// Valid flags: MZ_ZIP_FLAG_CASE_SENSITIVE, MZ_ZIP_FLAG_IGNORE_PATH +// Returns -1 if the file cannot be found. +int mz_zip_reader_locate_file(mz_zip_archive *pZip, const char *pName, const char *pComment, mz_uint flags); + +// Extracts a archive file to a memory buffer using no memory allocation. +mz_bool mz_zip_reader_extract_to_mem_no_alloc(mz_zip_archive *pZip, mz_uint file_index, void *pBuf, size_t buf_size, mz_uint flags, void *pUser_read_buf, size_t user_read_buf_size); +mz_bool mz_zip_reader_extract_file_to_mem_no_alloc(mz_zip_archive *pZip, const char *pFilename, void *pBuf, size_t buf_size, mz_uint flags, void *pUser_read_buf, size_t user_read_buf_size); + +// Extracts a archive file to a memory buffer. +mz_bool mz_zip_reader_extract_to_mem(mz_zip_archive *pZip, mz_uint file_index, void *pBuf, size_t buf_size, mz_uint flags); +mz_bool mz_zip_reader_extract_file_to_mem(mz_zip_archive *pZip, const char *pFilename, void *pBuf, size_t buf_size, mz_uint flags); + +// Extracts a archive file to a dynamically allocated heap buffer. +void *mz_zip_reader_extract_to_heap(mz_zip_archive *pZip, mz_uint file_index, size_t *pSize, mz_uint flags); +void *mz_zip_reader_extract_file_to_heap(mz_zip_archive *pZip, const char *pFilename, size_t *pSize, mz_uint flags); + +// Extracts a archive file using a callback function to output the file's data. +mz_bool mz_zip_reader_extract_to_callback(mz_zip_archive *pZip, mz_uint file_index, mz_file_write_func pCallback, void *pOpaque, mz_uint flags); +mz_bool mz_zip_reader_extract_file_to_callback(mz_zip_archive *pZip, const char *pFilename, mz_file_write_func pCallback, void *pOpaque, mz_uint flags); + +#ifndef MINIZ_NO_STDIO +// Extracts a archive file to a disk file and sets its last accessed and modified times. +// This function only extracts files, not archive directory records. +mz_bool mz_zip_reader_extract_to_file(mz_zip_archive *pZip, mz_uint file_index, const char *pDst_filename, mz_uint flags); +mz_bool mz_zip_reader_extract_file_to_file(mz_zip_archive *pZip, const char *pArchive_filename, const char *pDst_filename, mz_uint flags); +#endif + +// Ends archive reading, freeing all allocations, and closing the input archive file if mz_zip_reader_init_file() was used. +mz_bool mz_zip_reader_end(mz_zip_archive *pZip); + +// ZIP archive writing + +#ifndef MINIZ_NO_ARCHIVE_WRITING_APIS + +// Inits a ZIP archive writer. +mz_bool mz_zip_writer_init(mz_zip_archive *pZip, mz_uint64 existing_size); +mz_bool mz_zip_writer_init_heap(mz_zip_archive *pZip, size_t size_to_reserve_at_beginning, size_t initial_allocation_size); + +#ifndef MINIZ_NO_STDIO +mz_bool mz_zip_writer_init_file(mz_zip_archive *pZip, const char *pFilename, mz_uint64 size_to_reserve_at_beginning); +#endif + +// Converts a ZIP archive reader object into a writer object, to allow efficient in-place file appends to occur on an existing archive. +// For archives opened using mz_zip_reader_init_file, pFilename must be the archive's filename so it can be reopened for writing. If the file can't be reopened, mz_zip_reader_end() will be called. +// For archives opened using mz_zip_reader_init_mem, the memory block must be growable using the realloc callback (which defaults to realloc unless you've overridden it). +// Finally, for archives opened using mz_zip_reader_init, the mz_zip_archive's user provided m_pWrite function cannot be NULL. +// Note: In-place archive modification is not recommended unless you know what you're doing, because if execution stops or something goes wrong before +// the archive is finalized the file's central directory will be hosed. +mz_bool mz_zip_writer_init_from_reader(mz_zip_archive *pZip, const char *pFilename); + +// Adds the contents of a memory buffer to an archive. These functions record the current local time into the archive. +// To add a directory entry, call this method with an archive name ending in a forwardslash with empty buffer. +// level_and_flags - compression level (0-10, see MZ_BEST_SPEED, MZ_BEST_COMPRESSION, etc.) logically OR'd with zero or more mz_zip_flags, or just set to MZ_DEFAULT_COMPRESSION. +mz_bool mz_zip_writer_add_mem(mz_zip_archive *pZip, const char *pArchive_name, const void *pBuf, size_t buf_size, mz_uint level_and_flags); +mz_bool mz_zip_writer_add_mem_ex(mz_zip_archive *pZip, const char *pArchive_name, const void *pBuf, size_t buf_size, const void *pComment, mz_uint16 comment_size, mz_uint level_and_flags, mz_uint64 uncomp_size, mz_uint32 uncomp_crc32); + +#ifndef MINIZ_NO_STDIO +// Adds the contents of a disk file to an archive. This function also records the disk file's modified time into the archive. +// level_and_flags - compression level (0-10, see MZ_BEST_SPEED, MZ_BEST_COMPRESSION, etc.) logically OR'd with zero or more mz_zip_flags, or just set to MZ_DEFAULT_COMPRESSION. +mz_bool mz_zip_writer_add_file(mz_zip_archive *pZip, const char *pArchive_name, const char *pSrc_filename, const void *pComment, mz_uint16 comment_size, mz_uint level_and_flags); +#endif + +// Adds a file to an archive by fully cloning the data from another archive. +// This function fully clones the source file's compressed data (no recompression), along with its full filename, extra data, and comment fields. +mz_bool mz_zip_writer_add_from_zip_reader(mz_zip_archive *pZip, mz_zip_archive *pSource_zip, mz_uint file_index); + +// Finalizes the archive by writing the central directory records followed by the end of central directory record. +// After an archive is finalized, the only valid call on the mz_zip_archive struct is mz_zip_writer_end(). +// An archive must be manually finalized by calling this function for it to be valid. +mz_bool mz_zip_writer_finalize_archive(mz_zip_archive *pZip); +mz_bool mz_zip_writer_finalize_heap_archive(mz_zip_archive *pZip, void **pBuf, size_t *pSize); + +// Ends archive writing, freeing all allocations, and closing the output file if mz_zip_writer_init_file() was used. +// Note for the archive to be valid, it must have been finalized before ending. +mz_bool mz_zip_writer_end(mz_zip_archive *pZip); + +// Misc. high-level helper functions: + +// mz_zip_add_mem_to_archive_file_in_place() efficiently (but not atomically) appends a memory blob to a ZIP archive. +// level_and_flags - compression level (0-10, see MZ_BEST_SPEED, MZ_BEST_COMPRESSION, etc.) logically OR'd with zero or more mz_zip_flags, or just set to MZ_DEFAULT_COMPRESSION. +mz_bool mz_zip_add_mem_to_archive_file_in_place(const char *pZip_filename, const char *pArchive_name, const void *pBuf, size_t buf_size, const void *pComment, mz_uint16 comment_size, mz_uint level_and_flags); + +// Reads a single file from an archive into a heap block. +// Returns NULL on failure. +void *mz_zip_extract_archive_file_to_heap(const char *pZip_filename, const char *pArchive_name, size_t *pSize, mz_uint zip_flags); + +#endif // #ifndef MINIZ_NO_ARCHIVE_WRITING_APIS + +#endif // #ifndef MINIZ_NO_ARCHIVE_APIS + +// ------------------- Low-level Decompression API Definitions + +// Decompression flags used by tinfl_decompress(). +// TINFL_FLAG_PARSE_ZLIB_HEADER: If set, the input has a valid zlib header and ends with an adler32 checksum (it's a valid zlib stream). Otherwise, the input is a raw deflate stream. +// TINFL_FLAG_HAS_MORE_INPUT: If set, there are more input bytes available beyond the end of the supplied input buffer. If clear, the input buffer contains all remaining input. +// TINFL_FLAG_USING_NON_WRAPPING_OUTPUT_BUF: If set, the output buffer is large enough to hold the entire decompressed stream. If clear, the output buffer is at least the size of the dictionary (typically 32KB). +// TINFL_FLAG_COMPUTE_ADLER32: Force adler-32 checksum computation of the decompressed bytes. +enum +{ + TINFL_FLAG_PARSE_ZLIB_HEADER = 1, + TINFL_FLAG_HAS_MORE_INPUT = 2, + TINFL_FLAG_USING_NON_WRAPPING_OUTPUT_BUF = 4, + TINFL_FLAG_COMPUTE_ADLER32 = 8 +}; + +// High level decompression functions: +// tinfl_decompress_mem_to_heap() decompresses a block in memory to a heap block allocated via malloc(). +// On entry: +// pSrc_buf, src_buf_len: Pointer and size of the Deflate or zlib source data to decompress. +// On return: +// Function returns a pointer to the decompressed data, or NULL on failure. +// *pOut_len will be set to the decompressed data's size, which could be larger than src_buf_len on uncompressible data. +// The caller must call mz_free() on the returned block when it's no longer needed. +void *tinfl_decompress_mem_to_heap(const void *pSrc_buf, size_t src_buf_len, size_t *pOut_len, int flags); + +// tinfl_decompress_mem_to_mem() decompresses a block in memory to another block in memory. +// Returns TINFL_DECOMPRESS_MEM_TO_MEM_FAILED on failure, or the number of bytes written on success. +#define TINFL_DECOMPRESS_MEM_TO_MEM_FAILED ((size_t)(-1)) +size_t tinfl_decompress_mem_to_mem(void *pOut_buf, size_t out_buf_len, const void *pSrc_buf, size_t src_buf_len, int flags); + +// tinfl_decompress_mem_to_callback() decompresses a block in memory to an internal 32KB buffer, and a user provided callback function will be called to flush the buffer. +// Returns 1 on success or 0 on failure. +typedef int (*tinfl_put_buf_func_ptr)(const void* pBuf, int len, void *pUser); +int tinfl_decompress_mem_to_callback(const void *pIn_buf, size_t *pIn_buf_size, tinfl_put_buf_func_ptr pPut_buf_func, void *pPut_buf_user, int flags); + +struct tinfl_decompressor_tag; typedef struct tinfl_decompressor_tag tinfl_decompressor; + +// Max size of LZ dictionary. +#define TINFL_LZ_DICT_SIZE 32768 + +// Return status. +typedef enum +{ + TINFL_STATUS_BAD_PARAM = -3, + TINFL_STATUS_ADLER32_MISMATCH = -2, + TINFL_STATUS_FAILED = -1, + TINFL_STATUS_DONE = 0, + TINFL_STATUS_NEEDS_MORE_INPUT = 1, + TINFL_STATUS_HAS_MORE_OUTPUT = 2 +} tinfl_status; + +// Initializes the decompressor to its initial state. +#define tinfl_init(r) do { (r)->m_state = 0; } MZ_MACRO_END +#define tinfl_get_adler32(r) (r)->m_check_adler32 + +// Main low-level decompressor coroutine function. This is the only function actually needed for decompression. All the other functions are just high-level helpers for improved usability. +// This is a universal API, i.e. it can be used as a building block to build any desired higher level decompression API. In the limit case, it can be called once per every byte input or output. +tinfl_status tinfl_decompress(tinfl_decompressor *r, const mz_uint8 *pIn_buf_next, size_t *pIn_buf_size, mz_uint8 *pOut_buf_start, mz_uint8 *pOut_buf_next, size_t *pOut_buf_size, const mz_uint32 decomp_flags); + +// Internal/private bits follow. +enum +{ + TINFL_MAX_HUFF_TABLES = 3, TINFL_MAX_HUFF_SYMBOLS_0 = 288, TINFL_MAX_HUFF_SYMBOLS_1 = 32, TINFL_MAX_HUFF_SYMBOLS_2 = 19, + TINFL_FAST_LOOKUP_BITS = 10, TINFL_FAST_LOOKUP_SIZE = 1 << TINFL_FAST_LOOKUP_BITS +}; + +typedef struct +{ + mz_uint8 m_code_size[TINFL_MAX_HUFF_SYMBOLS_0]; + mz_int16 m_look_up[TINFL_FAST_LOOKUP_SIZE], m_tree[TINFL_MAX_HUFF_SYMBOLS_0 * 2]; +} tinfl_huff_table; + +#if MINIZ_HAS_64BIT_REGISTERS + #define TINFL_USE_64BIT_BITBUF 1 +#endif + +#if TINFL_USE_64BIT_BITBUF + typedef mz_uint64 tinfl_bit_buf_t; + #define TINFL_BITBUF_SIZE (64) +#else + typedef mz_uint32 tinfl_bit_buf_t; + #define TINFL_BITBUF_SIZE (32) +#endif + +struct tinfl_decompressor_tag +{ + mz_uint32 m_state, m_num_bits, m_zhdr0, m_zhdr1, m_z_adler32, m_final, m_type, m_check_adler32, m_dist, m_counter, m_num_extra, m_table_sizes[TINFL_MAX_HUFF_TABLES]; + tinfl_bit_buf_t m_bit_buf; + size_t m_dist_from_out_buf_start; + tinfl_huff_table m_tables[TINFL_MAX_HUFF_TABLES]; + mz_uint8 m_raw_header[4], m_len_codes[TINFL_MAX_HUFF_SYMBOLS_0 + TINFL_MAX_HUFF_SYMBOLS_1 + 137]; +}; + +// ------------------- Low-level Compression API Definitions + +// Set TDEFL_LESS_MEMORY to 1 to use less memory (compression will be slightly slower, and raw/dynamic blocks will be output more frequently). +#define TDEFL_LESS_MEMORY 0 + +// tdefl_init() compression flags logically OR'd together (low 12 bits contain the max. number of probes per dictionary search): +// TDEFL_DEFAULT_MAX_PROBES: The compressor defaults to 128 dictionary probes per dictionary search. 0=Huffman only, 1=Huffman+LZ (fastest/crap compression), 4095=Huffman+LZ (slowest/best compression). +enum +{ + TDEFL_HUFFMAN_ONLY = 0, TDEFL_DEFAULT_MAX_PROBES = 128, TDEFL_MAX_PROBES_MASK = 0xFFF +}; + +// TDEFL_WRITE_ZLIB_HEADER: If set, the compressor outputs a zlib header before the deflate data, and the Adler-32 of the source data at the end. Otherwise, you'll get raw deflate data. +// TDEFL_COMPUTE_ADLER32: Always compute the adler-32 of the input data (even when not writing zlib headers). +// TDEFL_GREEDY_PARSING_FLAG: Set to use faster greedy parsing, instead of more efficient lazy parsing. +// TDEFL_NONDETERMINISTIC_PARSING_FLAG: Enable to decrease the compressor's initialization time to the minimum, but the output may vary from run to run given the same input (depending on the contents of memory). +// TDEFL_RLE_MATCHES: Only look for RLE matches (matches with a distance of 1) +// TDEFL_FILTER_MATCHES: Discards matches <= 5 chars if enabled. +// TDEFL_FORCE_ALL_STATIC_BLOCKS: Disable usage of optimized Huffman tables. +// TDEFL_FORCE_ALL_RAW_BLOCKS: Only use raw (uncompressed) deflate blocks. +// The low 12 bits are reserved to control the max # of hash probes per dictionary lookup (see TDEFL_MAX_PROBES_MASK). +enum +{ + TDEFL_WRITE_ZLIB_HEADER = 0x01000, + TDEFL_COMPUTE_ADLER32 = 0x02000, + TDEFL_GREEDY_PARSING_FLAG = 0x04000, + TDEFL_NONDETERMINISTIC_PARSING_FLAG = 0x08000, + TDEFL_RLE_MATCHES = 0x10000, + TDEFL_FILTER_MATCHES = 0x20000, + TDEFL_FORCE_ALL_STATIC_BLOCKS = 0x40000, + TDEFL_FORCE_ALL_RAW_BLOCKS = 0x80000 +}; + +// High level compression functions: +// tdefl_compress_mem_to_heap() compresses a block in memory to a heap block allocated via malloc(). +// On entry: +// pSrc_buf, src_buf_len: Pointer and size of source block to compress. +// flags: The max match finder probes (default is 128) logically OR'd against the above flags. Higher probes are slower but improve compression. +// On return: +// Function returns a pointer to the compressed data, or NULL on failure. +// *pOut_len will be set to the compressed data's size, which could be larger than src_buf_len on uncompressible data. +// The caller must free() the returned block when it's no longer needed. +void *tdefl_compress_mem_to_heap(const void *pSrc_buf, size_t src_buf_len, size_t *pOut_len, int flags); + +// tdefl_compress_mem_to_mem() compresses a block in memory to another block in memory. +// Returns 0 on failure. +size_t tdefl_compress_mem_to_mem(void *pOut_buf, size_t out_buf_len, const void *pSrc_buf, size_t src_buf_len, int flags); + +// Compresses an image to a compressed PNG file in memory. +// On entry: +// pImage, w, h, and num_chans describe the image to compress. num_chans may be 1, 2, 3, or 4. +// The image pitch in bytes per scanline will be w*num_chans. The leftmost pixel on the top scanline is stored first in memory. +// level may range from [0,10], use MZ_NO_COMPRESSION, MZ_BEST_SPEED, MZ_BEST_COMPRESSION, etc. or a decent default is MZ_DEFAULT_LEVEL +// If flip is true, the image will be flipped on the Y axis (useful for OpenGL apps). +// On return: +// Function returns a pointer to the compressed data, or NULL on failure. +// *pLen_out will be set to the size of the PNG image file. +// The caller must mz_free() the returned heap block (which will typically be larger than *pLen_out) when it's no longer needed. +void *tdefl_write_image_to_png_file_in_memory_ex(const void *pImage, int w, int h, int num_chans, size_t *pLen_out, mz_uint level, mz_bool flip); +void *tdefl_write_image_to_png_file_in_memory(const void *pImage, int w, int h, int num_chans, size_t *pLen_out); + +// Output stream interface. The compressor uses this interface to write compressed data. It'll typically be called TDEFL_OUT_BUF_SIZE at a time. +typedef mz_bool (*tdefl_put_buf_func_ptr)(const void* pBuf, int len, void *pUser); + +// tdefl_compress_mem_to_output() compresses a block to an output stream. The above helpers use this function internally. +mz_bool tdefl_compress_mem_to_output(const void *pBuf, size_t buf_len, tdefl_put_buf_func_ptr pPut_buf_func, void *pPut_buf_user, int flags); + +enum { TDEFL_MAX_HUFF_TABLES = 3, TDEFL_MAX_HUFF_SYMBOLS_0 = 288, TDEFL_MAX_HUFF_SYMBOLS_1 = 32, TDEFL_MAX_HUFF_SYMBOLS_2 = 19, TDEFL_LZ_DICT_SIZE = 32768, TDEFL_LZ_DICT_SIZE_MASK = TDEFL_LZ_DICT_SIZE - 1, TDEFL_MIN_MATCH_LEN = 3, TDEFL_MAX_MATCH_LEN = 258 }; + +// TDEFL_OUT_BUF_SIZE MUST be large enough to hold a single entire compressed output block (using static/fixed Huffman codes). +#if TDEFL_LESS_MEMORY +enum { TDEFL_LZ_CODE_BUF_SIZE = 24 * 1024, TDEFL_OUT_BUF_SIZE = (TDEFL_LZ_CODE_BUF_SIZE * 13 ) / 10, TDEFL_MAX_HUFF_SYMBOLS = 288, TDEFL_LZ_HASH_BITS = 12, TDEFL_LEVEL1_HASH_SIZE_MASK = 4095, TDEFL_LZ_HASH_SHIFT = (TDEFL_LZ_HASH_BITS + 2) / 3, TDEFL_LZ_HASH_SIZE = 1 << TDEFL_LZ_HASH_BITS }; +#else +enum { TDEFL_LZ_CODE_BUF_SIZE = 64 * 1024, TDEFL_OUT_BUF_SIZE = (TDEFL_LZ_CODE_BUF_SIZE * 13 ) / 10, TDEFL_MAX_HUFF_SYMBOLS = 288, TDEFL_LZ_HASH_BITS = 15, TDEFL_LEVEL1_HASH_SIZE_MASK = 4095, TDEFL_LZ_HASH_SHIFT = (TDEFL_LZ_HASH_BITS + 2) / 3, TDEFL_LZ_HASH_SIZE = 1 << TDEFL_LZ_HASH_BITS }; +#endif + +// The low-level tdefl functions below may be used directly if the above helper functions aren't flexible enough. The low-level functions don't make any heap allocations, unlike the above helper functions. +typedef enum +{ + TDEFL_STATUS_BAD_PARAM = -2, + TDEFL_STATUS_PUT_BUF_FAILED = -1, + TDEFL_STATUS_OKAY = 0, + TDEFL_STATUS_DONE = 1, +} tdefl_status; + +// Must map to MZ_NO_FLUSH, MZ_SYNC_FLUSH, etc. enums +typedef enum +{ + TDEFL_NO_FLUSH = 0, + TDEFL_SYNC_FLUSH = 2, + TDEFL_FULL_FLUSH = 3, + TDEFL_FINISH = 4 +} tdefl_flush; + +// tdefl's compression state structure. +typedef struct +{ + tdefl_put_buf_func_ptr m_pPut_buf_func; + void *m_pPut_buf_user; + mz_uint m_flags, m_max_probes[2]; + int m_greedy_parsing; + mz_uint m_adler32, m_lookahead_pos, m_lookahead_size, m_dict_size; + mz_uint8 *m_pLZ_code_buf, *m_pLZ_flags, *m_pOutput_buf, *m_pOutput_buf_end; + mz_uint m_num_flags_left, m_total_lz_bytes, m_lz_code_buf_dict_pos, m_bits_in, m_bit_buffer; + mz_uint m_saved_match_dist, m_saved_match_len, m_saved_lit, m_output_flush_ofs, m_output_flush_remaining, m_finished, m_block_index, m_wants_to_finish; + tdefl_status m_prev_return_status; + const void *m_pIn_buf; + void *m_pOut_buf; + size_t *m_pIn_buf_size, *m_pOut_buf_size; + tdefl_flush m_flush; + const mz_uint8 *m_pSrc; + size_t m_src_buf_left, m_out_buf_ofs; + mz_uint8 m_dict[TDEFL_LZ_DICT_SIZE + TDEFL_MAX_MATCH_LEN - 1]; + mz_uint16 m_huff_count[TDEFL_MAX_HUFF_TABLES][TDEFL_MAX_HUFF_SYMBOLS]; + mz_uint16 m_huff_codes[TDEFL_MAX_HUFF_TABLES][TDEFL_MAX_HUFF_SYMBOLS]; + mz_uint8 m_huff_code_sizes[TDEFL_MAX_HUFF_TABLES][TDEFL_MAX_HUFF_SYMBOLS]; + mz_uint8 m_lz_code_buf[TDEFL_LZ_CODE_BUF_SIZE]; + mz_uint16 m_next[TDEFL_LZ_DICT_SIZE]; + mz_uint16 m_hash[TDEFL_LZ_HASH_SIZE]; + mz_uint8 m_output_buf[TDEFL_OUT_BUF_SIZE]; +} tdefl_compressor; + +// Initializes the compressor. +// There is no corresponding deinit() function because the tdefl API's do not dynamically allocate memory. +// pBut_buf_func: If NULL, output data will be supplied to the specified callback. In this case, the user should call the tdefl_compress_buffer() API for compression. +// If pBut_buf_func is NULL the user should always call the tdefl_compress() API. +// flags: See the above enums (TDEFL_HUFFMAN_ONLY, TDEFL_WRITE_ZLIB_HEADER, etc.) +tdefl_status tdefl_init(tdefl_compressor *d, tdefl_put_buf_func_ptr pPut_buf_func, void *pPut_buf_user, int flags); + +// Compresses a block of data, consuming as much of the specified input buffer as possible, and writing as much compressed data to the specified output buffer as possible. +tdefl_status tdefl_compress(tdefl_compressor *d, const void *pIn_buf, size_t *pIn_buf_size, void *pOut_buf, size_t *pOut_buf_size, tdefl_flush flush); + +// tdefl_compress_buffer() is only usable when the tdefl_init() is called with a non-NULL tdefl_put_buf_func_ptr. +// tdefl_compress_buffer() always consumes the entire input buffer. +tdefl_status tdefl_compress_buffer(tdefl_compressor *d, const void *pIn_buf, size_t in_buf_size, tdefl_flush flush); + +tdefl_status tdefl_get_prev_return_status(tdefl_compressor *d); +mz_uint32 tdefl_get_adler32(tdefl_compressor *d); + +// Can't use tdefl_create_comp_flags_from_zip_params if MINIZ_NO_ZLIB_APIS isn't defined, because it uses some of its macros. +#ifndef MINIZ_NO_ZLIB_APIS +// Create tdefl_compress() flags given zlib-style compression parameters. +// level may range from [0,10] (where 10 is absolute max compression, but may be much slower on some files) +// window_bits may be -15 (raw deflate) or 15 (zlib) +// strategy may be either MZ_DEFAULT_STRATEGY, MZ_FILTERED, MZ_HUFFMAN_ONLY, MZ_RLE, or MZ_FIXED +mz_uint tdefl_create_comp_flags_from_zip_params(int level, int window_bits, int strategy); +#endif // #ifndef MINIZ_NO_ZLIB_APIS + +#ifdef __cplusplus +} +#endif + +#endif // MINIZ_HEADER_INCLUDED + +// ------------------- End of Header: Implementation follows. (If you only want the header, define MINIZ_HEADER_FILE_ONLY.) + +#ifndef MINIZ_HEADER_FILE_ONLY + +typedef unsigned char mz_validate_uint16[sizeof(mz_uint16)==2 ? 1 : -1]; +typedef unsigned char mz_validate_uint32[sizeof(mz_uint32)==4 ? 1 : -1]; +typedef unsigned char mz_validate_uint64[sizeof(mz_uint64)==8 ? 1 : -1]; + +#include +#include + +#define MZ_ASSERT(x) assert(x) + +#ifdef MINIZ_NO_MALLOC + #define MZ_MALLOC(x) NULL + #define MZ_FREE(x) (void)x, ((void)0) + #define MZ_REALLOC(p, x) NULL +#else + #define MZ_MALLOC(x) malloc(x) + #define MZ_FREE(x) free(x) + #define MZ_REALLOC(p, x) realloc(p, x) +#endif + +#define MZ_MAX(a,b) (((a)>(b))?(a):(b)) +#define MZ_MIN(a,b) (((a)<(b))?(a):(b)) +#define MZ_CLEAR_OBJ(obj) memset(&(obj), 0, sizeof(obj)) + +#if MINIZ_USE_UNALIGNED_LOADS_AND_STORES && MINIZ_LITTLE_ENDIAN + #define MZ_READ_LE16(p) *((const mz_uint16 *)(p)) + #define MZ_READ_LE32(p) *((const mz_uint32 *)(p)) +#else + #define MZ_READ_LE16(p) ((mz_uint32)(((const mz_uint8 *)(p))[0]) | ((mz_uint32)(((const mz_uint8 *)(p))[1]) << 8U)) + #define MZ_READ_LE32(p) ((mz_uint32)(((const mz_uint8 *)(p))[0]) | ((mz_uint32)(((const mz_uint8 *)(p))[1]) << 8U) | ((mz_uint32)(((const mz_uint8 *)(p))[2]) << 16U) | ((mz_uint32)(((const mz_uint8 *)(p))[3]) << 24U)) +#endif + +#ifdef _MSC_VER + #define MZ_FORCEINLINE __forceinline +#elif defined(__GNUC__) + #define MZ_FORCEINLINE inline __attribute__((__always_inline__)) +#else + #define MZ_FORCEINLINE inline +#endif + +#ifdef __cplusplus + extern "C" { +#endif + +// ------------------- zlib-style API's + +mz_ulong mz_adler32(mz_ulong adler, const unsigned char *ptr, size_t buf_len) +{ + mz_uint32 i, s1 = (mz_uint32)(adler & 0xffff), s2 = (mz_uint32)(adler >> 16); size_t block_len = buf_len % 5552; + if (!ptr) return MZ_ADLER32_INIT; + while (buf_len) { + for (i = 0; i + 7 < block_len; i += 8, ptr += 8) { + s1 += ptr[0], s2 += s1; s1 += ptr[1], s2 += s1; s1 += ptr[2], s2 += s1; s1 += ptr[3], s2 += s1; + s1 += ptr[4], s2 += s1; s1 += ptr[5], s2 += s1; s1 += ptr[6], s2 += s1; s1 += ptr[7], s2 += s1; + } + for ( ; i < block_len; ++i) s1 += *ptr++, s2 += s1; + s1 %= 65521U, s2 %= 65521U; buf_len -= block_len; block_len = 5552; + } + return (s2 << 16) + s1; +} + +// Karl Malbrain's compact CRC-32. See "A compact CCITT crc16 and crc32 C implementation that balances processor cache usage against speed": http://www.geocities.com/malbrain/ +mz_ulong mz_crc32(mz_ulong crc, const mz_uint8 *ptr, size_t buf_len) +{ + static const mz_uint32 s_crc32[16] = { 0, 0x1db71064, 0x3b6e20c8, 0x26d930ac, 0x76dc4190, 0x6b6b51f4, 0x4db26158, 0x5005713c, + 0xedb88320, 0xf00f9344, 0xd6d6a3e8, 0xcb61b38c, 0x9b64c2b0, 0x86d3d2d4, 0xa00ae278, 0xbdbdf21c }; + mz_uint32 crcu32 = (mz_uint32)crc; + if (!ptr) return MZ_CRC32_INIT; + crcu32 = ~crcu32; while (buf_len--) { mz_uint8 b = *ptr++; crcu32 = (crcu32 >> 4) ^ s_crc32[(crcu32 & 0xF) ^ (b & 0xF)]; crcu32 = (crcu32 >> 4) ^ s_crc32[(crcu32 & 0xF) ^ (b >> 4)]; } + return ~crcu32; +} + +void mz_free(void *p) +{ + MZ_FREE(p); +} + +#ifndef MINIZ_NO_ZLIB_APIS + +static void *def_alloc_func(void *opaque, size_t items, size_t size) { (void)opaque, (void)items, (void)size; return MZ_MALLOC(items * size); } +static void def_free_func(void *opaque, void *address) { (void)opaque, (void)address; MZ_FREE(address); } +static void *def_realloc_func(void *opaque, void *address, size_t items, size_t size) { (void)opaque, (void)address, (void)items, (void)size; return MZ_REALLOC(address, items * size); } + +const char *mz_version(void) +{ + return MZ_VERSION; +} + +int mz_deflateInit(mz_streamp pStream, int level) +{ + return mz_deflateInit2(pStream, level, MZ_DEFLATED, MZ_DEFAULT_WINDOW_BITS, 9, MZ_DEFAULT_STRATEGY); +} + +int mz_deflateInit2(mz_streamp pStream, int level, int method, int window_bits, int mem_level, int strategy) +{ + tdefl_compressor *pComp; + mz_uint comp_flags = TDEFL_COMPUTE_ADLER32 | tdefl_create_comp_flags_from_zip_params(level, window_bits, strategy); + + if (!pStream) return MZ_STREAM_ERROR; + if ((method != MZ_DEFLATED) || ((mem_level < 1) || (mem_level > 9)) || ((window_bits != MZ_DEFAULT_WINDOW_BITS) && (-window_bits != MZ_DEFAULT_WINDOW_BITS))) return MZ_PARAM_ERROR; + + pStream->data_type = 0; + pStream->adler = MZ_ADLER32_INIT; + pStream->msg = NULL; + pStream->reserved = 0; + pStream->total_in = 0; + pStream->total_out = 0; + if (!pStream->zalloc) pStream->zalloc = def_alloc_func; + if (!pStream->zfree) pStream->zfree = def_free_func; + + pComp = (tdefl_compressor *)pStream->zalloc(pStream->opaque, 1, sizeof(tdefl_compressor)); + if (!pComp) + return MZ_MEM_ERROR; + + pStream->state = (struct mz_internal_state *)pComp; + + if (tdefl_init(pComp, NULL, NULL, comp_flags) != TDEFL_STATUS_OKAY) + { + mz_deflateEnd(pStream); + return MZ_PARAM_ERROR; + } + + return MZ_OK; +} + +int mz_deflateReset(mz_streamp pStream) +{ + if ((!pStream) || (!pStream->state) || (!pStream->zalloc) || (!pStream->zfree)) return MZ_STREAM_ERROR; + pStream->total_in = pStream->total_out = 0; + tdefl_init((tdefl_compressor*)pStream->state, NULL, NULL, ((tdefl_compressor*)pStream->state)->m_flags); + return MZ_OK; +} + +int mz_deflate(mz_streamp pStream, int flush) +{ + size_t in_bytes, out_bytes; + mz_ulong orig_total_in, orig_total_out; + int mz_status = MZ_OK; + + if ((!pStream) || (!pStream->state) || (flush < 0) || (flush > MZ_FINISH) || (!pStream->next_out)) return MZ_STREAM_ERROR; + if (!pStream->avail_out) return MZ_BUF_ERROR; + + if (flush == MZ_PARTIAL_FLUSH) flush = MZ_SYNC_FLUSH; + + if (((tdefl_compressor*)pStream->state)->m_prev_return_status == TDEFL_STATUS_DONE) + return (flush == MZ_FINISH) ? MZ_STREAM_END : MZ_BUF_ERROR; + + orig_total_in = pStream->total_in; orig_total_out = pStream->total_out; + for ( ; ; ) + { + tdefl_status defl_status; + in_bytes = pStream->avail_in; out_bytes = pStream->avail_out; + + defl_status = tdefl_compress((tdefl_compressor*)pStream->state, pStream->next_in, &in_bytes, pStream->next_out, &out_bytes, (tdefl_flush)flush); + pStream->next_in += (mz_uint)in_bytes; pStream->avail_in -= (mz_uint)in_bytes; + pStream->total_in += (mz_uint)in_bytes; pStream->adler = tdefl_get_adler32((tdefl_compressor*)pStream->state); + + pStream->next_out += (mz_uint)out_bytes; pStream->avail_out -= (mz_uint)out_bytes; + pStream->total_out += (mz_uint)out_bytes; + + if (defl_status < 0) + { + mz_status = MZ_STREAM_ERROR; + break; + } + else if (defl_status == TDEFL_STATUS_DONE) + { + mz_status = MZ_STREAM_END; + break; + } + else if (!pStream->avail_out) + break; + else if ((!pStream->avail_in) && (flush != MZ_FINISH)) + { + if ((flush) || (pStream->total_in != orig_total_in) || (pStream->total_out != orig_total_out)) + break; + return MZ_BUF_ERROR; // Can't make forward progress without some input. + } + } + return mz_status; +} + +int mz_deflateEnd(mz_streamp pStream) +{ + if (!pStream) return MZ_STREAM_ERROR; + if (pStream->state) + { + pStream->zfree(pStream->opaque, pStream->state); + pStream->state = NULL; + } + return MZ_OK; +} + +mz_ulong mz_deflateBound(mz_streamp pStream, mz_ulong source_len) +{ + (void)pStream; + // This is really over conservative. (And lame, but it's actually pretty tricky to compute a true upper bound given the way tdefl's blocking works.) + return MZ_MAX(128 + (source_len * 110) / 100, 128 + source_len + ((source_len / (31 * 1024)) + 1) * 5); +} + +int mz_compress2(unsigned char *pDest, mz_ulong *pDest_len, const unsigned char *pSource, mz_ulong source_len, int level) +{ + int status; + mz_stream stream; + memset(&stream, 0, sizeof(stream)); + + // In case mz_ulong is 64-bits (argh I hate longs). + if ((source_len | *pDest_len) > 0xFFFFFFFFU) return MZ_PARAM_ERROR; + + stream.next_in = pSource; + stream.avail_in = (mz_uint32)source_len; + stream.next_out = pDest; + stream.avail_out = (mz_uint32)*pDest_len; + + status = mz_deflateInit(&stream, level); + if (status != MZ_OK) return status; + + status = mz_deflate(&stream, MZ_FINISH); + if (status != MZ_STREAM_END) + { + mz_deflateEnd(&stream); + return (status == MZ_OK) ? MZ_BUF_ERROR : status; + } + + *pDest_len = stream.total_out; + return mz_deflateEnd(&stream); +} + +int mz_compress(unsigned char *pDest, mz_ulong *pDest_len, const unsigned char *pSource, mz_ulong source_len) +{ + return mz_compress2(pDest, pDest_len, pSource, source_len, MZ_DEFAULT_COMPRESSION); +} + +mz_ulong mz_compressBound(mz_ulong source_len) +{ + return mz_deflateBound(NULL, source_len); +} + +typedef struct +{ + tinfl_decompressor m_decomp; + mz_uint m_dict_ofs, m_dict_avail, m_first_call, m_has_flushed; int m_window_bits; + mz_uint8 m_dict[TINFL_LZ_DICT_SIZE]; + tinfl_status m_last_status; +} inflate_state; + +int mz_inflateInit2(mz_streamp pStream, int window_bits) +{ + inflate_state *pDecomp; + if (!pStream) return MZ_STREAM_ERROR; + if ((window_bits != MZ_DEFAULT_WINDOW_BITS) && (-window_bits != MZ_DEFAULT_WINDOW_BITS)) return MZ_PARAM_ERROR; + + pStream->data_type = 0; + pStream->adler = 0; + pStream->msg = NULL; + pStream->total_in = 0; + pStream->total_out = 0; + pStream->reserved = 0; + if (!pStream->zalloc) pStream->zalloc = def_alloc_func; + if (!pStream->zfree) pStream->zfree = def_free_func; + + pDecomp = (inflate_state*)pStream->zalloc(pStream->opaque, 1, sizeof(inflate_state)); + if (!pDecomp) return MZ_MEM_ERROR; + + pStream->state = (struct mz_internal_state *)pDecomp; + + tinfl_init(&pDecomp->m_decomp); + pDecomp->m_dict_ofs = 0; + pDecomp->m_dict_avail = 0; + pDecomp->m_last_status = TINFL_STATUS_NEEDS_MORE_INPUT; + pDecomp->m_first_call = 1; + pDecomp->m_has_flushed = 0; + pDecomp->m_window_bits = window_bits; + + return MZ_OK; +} + +int mz_inflateInit(mz_streamp pStream) +{ + return mz_inflateInit2(pStream, MZ_DEFAULT_WINDOW_BITS); +} + +int mz_inflate(mz_streamp pStream, int flush) +{ + inflate_state* pState; + mz_uint n, first_call, decomp_flags = TINFL_FLAG_COMPUTE_ADLER32; + size_t in_bytes, out_bytes, orig_avail_in; + tinfl_status status; + + if ((!pStream) || (!pStream->state)) return MZ_STREAM_ERROR; + if (flush == MZ_PARTIAL_FLUSH) flush = MZ_SYNC_FLUSH; + if ((flush) && (flush != MZ_SYNC_FLUSH) && (flush != MZ_FINISH)) return MZ_STREAM_ERROR; + + pState = (inflate_state*)pStream->state; + if (pState->m_window_bits > 0) decomp_flags |= TINFL_FLAG_PARSE_ZLIB_HEADER; + orig_avail_in = pStream->avail_in; + + first_call = pState->m_first_call; pState->m_first_call = 0; + if (pState->m_last_status < 0) return MZ_DATA_ERROR; + + if (pState->m_has_flushed && (flush != MZ_FINISH)) return MZ_STREAM_ERROR; + pState->m_has_flushed |= (flush == MZ_FINISH); + + if ((flush == MZ_FINISH) && (first_call)) + { + // MZ_FINISH on the first call implies that the input and output buffers are large enough to hold the entire compressed/decompressed file. + decomp_flags |= TINFL_FLAG_USING_NON_WRAPPING_OUTPUT_BUF; + in_bytes = pStream->avail_in; out_bytes = pStream->avail_out; + status = tinfl_decompress(&pState->m_decomp, pStream->next_in, &in_bytes, pStream->next_out, pStream->next_out, &out_bytes, decomp_flags); + pState->m_last_status = status; + pStream->next_in += (mz_uint)in_bytes; pStream->avail_in -= (mz_uint)in_bytes; pStream->total_in += (mz_uint)in_bytes; + pStream->adler = tinfl_get_adler32(&pState->m_decomp); + pStream->next_out += (mz_uint)out_bytes; pStream->avail_out -= (mz_uint)out_bytes; pStream->total_out += (mz_uint)out_bytes; + + if (status < 0) + return MZ_DATA_ERROR; + else if (status != TINFL_STATUS_DONE) + { + pState->m_last_status = TINFL_STATUS_FAILED; + return MZ_BUF_ERROR; + } + return MZ_STREAM_END; + } + // flush != MZ_FINISH then we must assume there's more input. + if (flush != MZ_FINISH) decomp_flags |= TINFL_FLAG_HAS_MORE_INPUT; + + if (pState->m_dict_avail) + { + n = MZ_MIN(pState->m_dict_avail, pStream->avail_out); + memcpy(pStream->next_out, pState->m_dict + pState->m_dict_ofs, n); + pStream->next_out += n; pStream->avail_out -= n; pStream->total_out += n; + pState->m_dict_avail -= n; pState->m_dict_ofs = (pState->m_dict_ofs + n) & (TINFL_LZ_DICT_SIZE - 1); + return ((pState->m_last_status == TINFL_STATUS_DONE) && (!pState->m_dict_avail)) ? MZ_STREAM_END : MZ_OK; + } + + for ( ; ; ) + { + in_bytes = pStream->avail_in; + out_bytes = TINFL_LZ_DICT_SIZE - pState->m_dict_ofs; + + status = tinfl_decompress(&pState->m_decomp, pStream->next_in, &in_bytes, pState->m_dict, pState->m_dict + pState->m_dict_ofs, &out_bytes, decomp_flags); + pState->m_last_status = status; + + pStream->next_in += (mz_uint)in_bytes; pStream->avail_in -= (mz_uint)in_bytes; + pStream->total_in += (mz_uint)in_bytes; pStream->adler = tinfl_get_adler32(&pState->m_decomp); + + pState->m_dict_avail = (mz_uint)out_bytes; + + n = MZ_MIN(pState->m_dict_avail, pStream->avail_out); + memcpy(pStream->next_out, pState->m_dict + pState->m_dict_ofs, n); + pStream->next_out += n; pStream->avail_out -= n; pStream->total_out += n; + pState->m_dict_avail -= n; pState->m_dict_ofs = (pState->m_dict_ofs + n) & (TINFL_LZ_DICT_SIZE - 1); + + if (status < 0) + return MZ_DATA_ERROR; // Stream is corrupted (there could be some uncompressed data left in the output dictionary - oh well). + else if ((status == TINFL_STATUS_NEEDS_MORE_INPUT) && (!orig_avail_in)) + return MZ_BUF_ERROR; // Signal caller that we can't make forward progress without supplying more input or by setting flush to MZ_FINISH. + else if (flush == MZ_FINISH) + { + // The output buffer MUST be large to hold the remaining uncompressed data when flush==MZ_FINISH. + if (status == TINFL_STATUS_DONE) + return pState->m_dict_avail ? MZ_BUF_ERROR : MZ_STREAM_END; + // status here must be TINFL_STATUS_HAS_MORE_OUTPUT, which means there's at least 1 more byte on the way. If there's no more room left in the output buffer then something is wrong. + else if (!pStream->avail_out) + return MZ_BUF_ERROR; + } + else if ((status == TINFL_STATUS_DONE) || (!pStream->avail_in) || (!pStream->avail_out) || (pState->m_dict_avail)) + break; + } + + return ((status == TINFL_STATUS_DONE) && (!pState->m_dict_avail)) ? MZ_STREAM_END : MZ_OK; +} + +int mz_inflateEnd(mz_streamp pStream) +{ + if (!pStream) + return MZ_STREAM_ERROR; + if (pStream->state) + { + pStream->zfree(pStream->opaque, pStream->state); + pStream->state = NULL; + } + return MZ_OK; +} + +int mz_uncompress(unsigned char *pDest, mz_ulong *pDest_len, const unsigned char *pSource, mz_ulong source_len) +{ + mz_stream stream; + int status; + memset(&stream, 0, sizeof(stream)); + + // In case mz_ulong is 64-bits (argh I hate longs). + if ((source_len | *pDest_len) > 0xFFFFFFFFU) return MZ_PARAM_ERROR; + + stream.next_in = pSource; + stream.avail_in = (mz_uint32)source_len; + stream.next_out = pDest; + stream.avail_out = (mz_uint32)*pDest_len; + + status = mz_inflateInit(&stream); + if (status != MZ_OK) + return status; + + status = mz_inflate(&stream, MZ_FINISH); + if (status != MZ_STREAM_END) + { + mz_inflateEnd(&stream); + return ((status == MZ_BUF_ERROR) && (!stream.avail_in)) ? MZ_DATA_ERROR : status; + } + *pDest_len = stream.total_out; + + return mz_inflateEnd(&stream); +} + +const char *mz_error(int err) +{ + static struct { int m_err; const char *m_pDesc; } s_error_descs[] = + { + { MZ_OK, "" }, { MZ_STREAM_END, "stream end" }, { MZ_NEED_DICT, "need dictionary" }, { MZ_ERRNO, "file error" }, { MZ_STREAM_ERROR, "stream error" }, + { MZ_DATA_ERROR, "data error" }, { MZ_MEM_ERROR, "out of memory" }, { MZ_BUF_ERROR, "buf error" }, { MZ_VERSION_ERROR, "version error" }, { MZ_PARAM_ERROR, "parameter error" } + }; + mz_uint i; for (i = 0; i < sizeof(s_error_descs) / sizeof(s_error_descs[0]); ++i) if (s_error_descs[i].m_err == err) return s_error_descs[i].m_pDesc; + return NULL; +} + +#endif //MINIZ_NO_ZLIB_APIS + +// ------------------- Low-level Decompression (completely independent from all compression API's) + +#define TINFL_MEMCPY(d, s, l) memcpy(d, s, l) +#define TINFL_MEMSET(p, c, l) memset(p, c, l) + +#define TINFL_CR_BEGIN switch(r->m_state) { case 0: +#define TINFL_CR_RETURN(state_index, result) do { status = result; r->m_state = state_index; goto common_exit; case state_index:; } MZ_MACRO_END +#define TINFL_CR_RETURN_FOREVER(state_index, result) do { for ( ; ; ) { TINFL_CR_RETURN(state_index, result); } } MZ_MACRO_END +#define TINFL_CR_FINISH } + +// TODO: If the caller has indicated that there's no more input, and we attempt to read beyond the input buf, then something is wrong with the input because the inflator never +// reads ahead more than it needs to. Currently TINFL_GET_BYTE() pads the end of the stream with 0's in this scenario. +#define TINFL_GET_BYTE(state_index, c) do { \ + if (pIn_buf_cur >= pIn_buf_end) { \ + for ( ; ; ) { \ + if (decomp_flags & TINFL_FLAG_HAS_MORE_INPUT) { \ + TINFL_CR_RETURN(state_index, TINFL_STATUS_NEEDS_MORE_INPUT); \ + if (pIn_buf_cur < pIn_buf_end) { \ + c = *pIn_buf_cur++; \ + break; \ + } \ + } else { \ + c = 0; \ + break; \ + } \ + } \ + } else c = *pIn_buf_cur++; } MZ_MACRO_END + +#define TINFL_NEED_BITS(state_index, n) do { mz_uint c; TINFL_GET_BYTE(state_index, c); bit_buf |= (((tinfl_bit_buf_t)c) << num_bits); num_bits += 8; } while (num_bits < (mz_uint)(n)) +#define TINFL_SKIP_BITS(state_index, n) do { if (num_bits < (mz_uint)(n)) { TINFL_NEED_BITS(state_index, n); } bit_buf >>= (n); num_bits -= (n); } MZ_MACRO_END +#define TINFL_GET_BITS(state_index, b, n) do { if (num_bits < (mz_uint)(n)) { TINFL_NEED_BITS(state_index, n); } b = bit_buf & ((1 << (n)) - 1); bit_buf >>= (n); num_bits -= (n); } MZ_MACRO_END + +// TINFL_HUFF_BITBUF_FILL() is only used rarely, when the number of bytes remaining in the input buffer falls below 2. +// It reads just enough bytes from the input stream that are needed to decode the next Huffman code (and absolutely no more). It works by trying to fully decode a +// Huffman code by using whatever bits are currently present in the bit buffer. If this fails, it reads another byte, and tries again until it succeeds or until the +// bit buffer contains >=15 bits (deflate's max. Huffman code size). +#define TINFL_HUFF_BITBUF_FILL(state_index, pHuff) \ + do { \ + temp = (pHuff)->m_look_up[bit_buf & (TINFL_FAST_LOOKUP_SIZE - 1)]; \ + if (temp >= 0) { \ + code_len = temp >> 9; \ + if ((code_len) && (num_bits >= code_len)) \ + break; \ + } else if (num_bits > TINFL_FAST_LOOKUP_BITS) { \ + code_len = TINFL_FAST_LOOKUP_BITS; \ + do { \ + temp = (pHuff)->m_tree[~temp + ((bit_buf >> code_len++) & 1)]; \ + } while ((temp < 0) && (num_bits >= (code_len + 1))); if (temp >= 0) break; \ + } TINFL_GET_BYTE(state_index, c); bit_buf |= (((tinfl_bit_buf_t)c) << num_bits); num_bits += 8; \ + } while (num_bits < 15); + +// TINFL_HUFF_DECODE() decodes the next Huffman coded symbol. It's more complex than you would initially expect because the zlib API expects the decompressor to never read +// beyond the final byte of the deflate stream. (In other words, when this macro wants to read another byte from the input, it REALLY needs another byte in order to fully +// decode the next Huffman code.) Handling this properly is particularly important on raw deflate (non-zlib) streams, which aren't followed by a byte aligned adler-32. +// The slow path is only executed at the very end of the input buffer. +#define TINFL_HUFF_DECODE(state_index, sym, pHuff) do { \ + int temp; mz_uint code_len, c; \ + if (num_bits < 15) { \ + if ((pIn_buf_end - pIn_buf_cur) < 2) { \ + TINFL_HUFF_BITBUF_FILL(state_index, pHuff); \ + } else { \ + bit_buf |= (((tinfl_bit_buf_t)pIn_buf_cur[0]) << num_bits) | (((tinfl_bit_buf_t)pIn_buf_cur[1]) << (num_bits + 8)); pIn_buf_cur += 2; num_bits += 16; \ + } \ + } \ + if ((temp = (pHuff)->m_look_up[bit_buf & (TINFL_FAST_LOOKUP_SIZE - 1)]) >= 0) \ + code_len = temp >> 9, temp &= 511; \ + else { \ + code_len = TINFL_FAST_LOOKUP_BITS; do { temp = (pHuff)->m_tree[~temp + ((bit_buf >> code_len++) & 1)]; } while (temp < 0); \ + } sym = temp; bit_buf >>= code_len; num_bits -= code_len; } MZ_MACRO_END + +tinfl_status tinfl_decompress(tinfl_decompressor *r, const mz_uint8 *pIn_buf_next, size_t *pIn_buf_size, mz_uint8 *pOut_buf_start, mz_uint8 *pOut_buf_next, size_t *pOut_buf_size, const mz_uint32 decomp_flags) +{ + static const int s_length_base[31] = { 3,4,5,6,7,8,9,10,11,13, 15,17,19,23,27,31,35,43,51,59, 67,83,99,115,131,163,195,227,258,0,0 }; + static const int s_length_extra[31]= { 0,0,0,0,0,0,0,0,1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,0,0,0 }; + static const int s_dist_base[32] = { 1,2,3,4,5,7,9,13,17,25,33,49,65,97,129,193, 257,385,513,769,1025,1537,2049,3073,4097,6145,8193,12289,16385,24577,0,0}; + static const int s_dist_extra[32] = { 0,0,0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10,11,11,12,12,13,13}; + static const mz_uint8 s_length_dezigzag[19] = { 16,17,18,0,8,7,9,6,10,5,11,4,12,3,13,2,14,1,15 }; + static const int s_min_table_sizes[3] = { 257, 1, 4 }; + + tinfl_status status = TINFL_STATUS_FAILED; mz_uint32 num_bits, dist, counter, num_extra; tinfl_bit_buf_t bit_buf; + const mz_uint8 *pIn_buf_cur = pIn_buf_next, *const pIn_buf_end = pIn_buf_next + *pIn_buf_size; + mz_uint8 *pOut_buf_cur = pOut_buf_next, *const pOut_buf_end = pOut_buf_next + *pOut_buf_size; + size_t out_buf_size_mask = (decomp_flags & TINFL_FLAG_USING_NON_WRAPPING_OUTPUT_BUF) ? (size_t)-1 : ((pOut_buf_next - pOut_buf_start) + *pOut_buf_size) - 1, dist_from_out_buf_start; + + // Ensure the output buffer's size is a power of 2, unless the output buffer is large enough to hold the entire output file (in which case it doesn't matter). + if (((out_buf_size_mask + 1) & out_buf_size_mask) || (pOut_buf_next < pOut_buf_start)) { *pIn_buf_size = *pOut_buf_size = 0; return TINFL_STATUS_BAD_PARAM; } + + num_bits = r->m_num_bits; bit_buf = r->m_bit_buf; dist = r->m_dist; counter = r->m_counter; num_extra = r->m_num_extra; dist_from_out_buf_start = r->m_dist_from_out_buf_start; + TINFL_CR_BEGIN + + bit_buf = num_bits = dist = counter = num_extra = r->m_zhdr0 = r->m_zhdr1 = 0; r->m_z_adler32 = r->m_check_adler32 = 1; + if (decomp_flags & TINFL_FLAG_PARSE_ZLIB_HEADER) + { + TINFL_GET_BYTE(1, r->m_zhdr0); TINFL_GET_BYTE(2, r->m_zhdr1); + counter = (((r->m_zhdr0 * 256 + r->m_zhdr1) % 31 != 0) || (r->m_zhdr1 & 32) || ((r->m_zhdr0 & 15) != 8)); + if (!(decomp_flags & TINFL_FLAG_USING_NON_WRAPPING_OUTPUT_BUF)) counter |= (((1U << (8U + (r->m_zhdr0 >> 4))) > 32768U) || ((out_buf_size_mask + 1) < (size_t)(1U << (8U + (r->m_zhdr0 >> 4))))); + if (counter) { TINFL_CR_RETURN_FOREVER(36, TINFL_STATUS_FAILED); } + } + + do + { + TINFL_GET_BITS(3, r->m_final, 3); r->m_type = r->m_final >> 1; + if (r->m_type == 0) + { + TINFL_SKIP_BITS(5, num_bits & 7); + for (counter = 0; counter < 4; ++counter) { if (num_bits) TINFL_GET_BITS(6, r->m_raw_header[counter], 8); else TINFL_GET_BYTE(7, r->m_raw_header[counter]); } + if ((counter = (r->m_raw_header[0] | (r->m_raw_header[1] << 8))) != (mz_uint)(0xFFFF ^ (r->m_raw_header[2] | (r->m_raw_header[3] << 8)))) { TINFL_CR_RETURN_FOREVER(39, TINFL_STATUS_FAILED); } + while ((counter) && (num_bits)) + { + TINFL_GET_BITS(51, dist, 8); + while (pOut_buf_cur >= pOut_buf_end) { TINFL_CR_RETURN(52, TINFL_STATUS_HAS_MORE_OUTPUT); } + *pOut_buf_cur++ = (mz_uint8)dist; + counter--; + } + while (counter) + { + size_t n; while (pOut_buf_cur >= pOut_buf_end) { TINFL_CR_RETURN(9, TINFL_STATUS_HAS_MORE_OUTPUT); } + while (pIn_buf_cur >= pIn_buf_end) + { + if (decomp_flags & TINFL_FLAG_HAS_MORE_INPUT) + { + TINFL_CR_RETURN(38, TINFL_STATUS_NEEDS_MORE_INPUT); + } + else + { + TINFL_CR_RETURN_FOREVER(40, TINFL_STATUS_FAILED); + } + } + n = MZ_MIN(MZ_MIN((size_t)(pOut_buf_end - pOut_buf_cur), (size_t)(pIn_buf_end - pIn_buf_cur)), counter); + TINFL_MEMCPY(pOut_buf_cur, pIn_buf_cur, n); pIn_buf_cur += n; pOut_buf_cur += n; counter -= (mz_uint)n; + } + } + else if (r->m_type == 3) + { + TINFL_CR_RETURN_FOREVER(10, TINFL_STATUS_FAILED); + } + else + { + if (r->m_type == 1) + { + mz_uint8 *p = r->m_tables[0].m_code_size; mz_uint i; + r->m_table_sizes[0] = 288; r->m_table_sizes[1] = 32; TINFL_MEMSET(r->m_tables[1].m_code_size, 5, 32); + for ( i = 0; i <= 143; ++i) *p++ = 8; for ( ; i <= 255; ++i) *p++ = 9; for ( ; i <= 279; ++i) *p++ = 7; for ( ; i <= 287; ++i) *p++ = 8; + } + else + { + for (counter = 0; counter < 3; counter++) { TINFL_GET_BITS(11, r->m_table_sizes[counter], "\05\05\04"[counter]); r->m_table_sizes[counter] += s_min_table_sizes[counter]; } + MZ_CLEAR_OBJ(r->m_tables[2].m_code_size); for (counter = 0; counter < r->m_table_sizes[2]; counter++) { mz_uint s; TINFL_GET_BITS(14, s, 3); r->m_tables[2].m_code_size[s_length_dezigzag[counter]] = (mz_uint8)s; } + r->m_table_sizes[2] = 19; + } + for ( ; (int)r->m_type >= 0; r->m_type--) + { + int tree_next, tree_cur; tinfl_huff_table *pTable; + mz_uint i, j, used_syms, total, sym_index, next_code[17], total_syms[16]; pTable = &r->m_tables[r->m_type]; MZ_CLEAR_OBJ(total_syms); MZ_CLEAR_OBJ(pTable->m_look_up); MZ_CLEAR_OBJ(pTable->m_tree); + for (i = 0; i < r->m_table_sizes[r->m_type]; ++i) total_syms[pTable->m_code_size[i]]++; + used_syms = 0, total = 0; next_code[0] = next_code[1] = 0; + for (i = 1; i <= 15; ++i) { used_syms += total_syms[i]; next_code[i + 1] = (total = ((total + total_syms[i]) << 1)); } + if ((65536 != total) && (used_syms > 1)) + { + TINFL_CR_RETURN_FOREVER(35, TINFL_STATUS_FAILED); + } + for (tree_next = -1, sym_index = 0; sym_index < r->m_table_sizes[r->m_type]; ++sym_index) + { + mz_uint rev_code = 0, l, cur_code, code_size = pTable->m_code_size[sym_index]; if (!code_size) continue; + cur_code = next_code[code_size]++; for (l = code_size; l > 0; l--, cur_code >>= 1) rev_code = (rev_code << 1) | (cur_code & 1); + if (code_size <= TINFL_FAST_LOOKUP_BITS) { mz_int16 k = (mz_int16)((code_size << 9) | sym_index); while (rev_code < TINFL_FAST_LOOKUP_SIZE) { pTable->m_look_up[rev_code] = k; rev_code += (1 << code_size); } continue; } + if (0 == (tree_cur = pTable->m_look_up[rev_code & (TINFL_FAST_LOOKUP_SIZE - 1)])) { pTable->m_look_up[rev_code & (TINFL_FAST_LOOKUP_SIZE - 1)] = (mz_int16)tree_next; tree_cur = tree_next; tree_next -= 2; } + rev_code >>= (TINFL_FAST_LOOKUP_BITS - 1); + for (j = code_size; j > (TINFL_FAST_LOOKUP_BITS + 1); j--) + { + tree_cur -= ((rev_code >>= 1) & 1); + if (!pTable->m_tree[-tree_cur - 1]) { pTable->m_tree[-tree_cur - 1] = (mz_int16)tree_next; tree_cur = tree_next; tree_next -= 2; } else tree_cur = pTable->m_tree[-tree_cur - 1]; + } + tree_cur -= ((rev_code >>= 1) & 1); pTable->m_tree[-tree_cur - 1] = (mz_int16)sym_index; + } + if (r->m_type == 2) + { + for (counter = 0; counter < (r->m_table_sizes[0] + r->m_table_sizes[1]); ) + { + mz_uint s; TINFL_HUFF_DECODE(16, dist, &r->m_tables[2]); if (dist < 16) { r->m_len_codes[counter++] = (mz_uint8)dist; continue; } + if ((dist == 16) && (!counter)) + { + TINFL_CR_RETURN_FOREVER(17, TINFL_STATUS_FAILED); + } + num_extra = "\02\03\07"[dist - 16]; TINFL_GET_BITS(18, s, num_extra); s += "\03\03\013"[dist - 16]; + TINFL_MEMSET(r->m_len_codes + counter, (dist == 16) ? r->m_len_codes[counter - 1] : 0, s); counter += s; + } + if ((r->m_table_sizes[0] + r->m_table_sizes[1]) != counter) + { + TINFL_CR_RETURN_FOREVER(21, TINFL_STATUS_FAILED); + } + TINFL_MEMCPY(r->m_tables[0].m_code_size, r->m_len_codes, r->m_table_sizes[0]); TINFL_MEMCPY(r->m_tables[1].m_code_size, r->m_len_codes + r->m_table_sizes[0], r->m_table_sizes[1]); + } + } + for ( ; ; ) + { + mz_uint8 *pSrc; + for ( ; ; ) + { + if (((pIn_buf_end - pIn_buf_cur) < 4) || ((pOut_buf_end - pOut_buf_cur) < 2)) + { + TINFL_HUFF_DECODE(23, counter, &r->m_tables[0]); + if (counter >= 256) + break; + while (pOut_buf_cur >= pOut_buf_end) { TINFL_CR_RETURN(24, TINFL_STATUS_HAS_MORE_OUTPUT); } + *pOut_buf_cur++ = (mz_uint8)counter; + } + else + { + int sym2; mz_uint code_len; +#if TINFL_USE_64BIT_BITBUF + if (num_bits < 30) { bit_buf |= (((tinfl_bit_buf_t)MZ_READ_LE32(pIn_buf_cur)) << num_bits); pIn_buf_cur += 4; num_bits += 32; } +#else + if (num_bits < 15) { bit_buf |= (((tinfl_bit_buf_t)MZ_READ_LE16(pIn_buf_cur)) << num_bits); pIn_buf_cur += 2; num_bits += 16; } +#endif + if ((sym2 = r->m_tables[0].m_look_up[bit_buf & (TINFL_FAST_LOOKUP_SIZE - 1)]) >= 0) + code_len = sym2 >> 9; + else + { + code_len = TINFL_FAST_LOOKUP_BITS; do { sym2 = r->m_tables[0].m_tree[~sym2 + ((bit_buf >> code_len++) & 1)]; } while (sym2 < 0); + } + counter = sym2; bit_buf >>= code_len; num_bits -= code_len; + if (counter & 256) + break; + +#if !TINFL_USE_64BIT_BITBUF + if (num_bits < 15) { bit_buf |= (((tinfl_bit_buf_t)MZ_READ_LE16(pIn_buf_cur)) << num_bits); pIn_buf_cur += 2; num_bits += 16; } +#endif + if ((sym2 = r->m_tables[0].m_look_up[bit_buf & (TINFL_FAST_LOOKUP_SIZE - 1)]) >= 0) + code_len = sym2 >> 9; + else + { + code_len = TINFL_FAST_LOOKUP_BITS; do { sym2 = r->m_tables[0].m_tree[~sym2 + ((bit_buf >> code_len++) & 1)]; } while (sym2 < 0); + } + bit_buf >>= code_len; num_bits -= code_len; + + pOut_buf_cur[0] = (mz_uint8)counter; + if (sym2 & 256) + { + pOut_buf_cur++; + counter = sym2; + break; + } + pOut_buf_cur[1] = (mz_uint8)sym2; + pOut_buf_cur += 2; + } + } + if ((counter &= 511) == 256) break; + + num_extra = s_length_extra[counter - 257]; counter = s_length_base[counter - 257]; + if (num_extra) { mz_uint extra_bits; TINFL_GET_BITS(25, extra_bits, num_extra); counter += extra_bits; } + + TINFL_HUFF_DECODE(26, dist, &r->m_tables[1]); + num_extra = s_dist_extra[dist]; dist = s_dist_base[dist]; + if (num_extra) { mz_uint extra_bits; TINFL_GET_BITS(27, extra_bits, num_extra); dist += extra_bits; } + + dist_from_out_buf_start = pOut_buf_cur - pOut_buf_start; + if ((dist > dist_from_out_buf_start) && (decomp_flags & TINFL_FLAG_USING_NON_WRAPPING_OUTPUT_BUF)) + { + TINFL_CR_RETURN_FOREVER(37, TINFL_STATUS_FAILED); + } + + pSrc = pOut_buf_start + ((dist_from_out_buf_start - dist) & out_buf_size_mask); + + if ((MZ_MAX(pOut_buf_cur, pSrc) + counter) > pOut_buf_end) + { + while (counter--) + { + while (pOut_buf_cur >= pOut_buf_end) { TINFL_CR_RETURN(53, TINFL_STATUS_HAS_MORE_OUTPUT); } + *pOut_buf_cur++ = pOut_buf_start[(dist_from_out_buf_start++ - dist) & out_buf_size_mask]; + } + continue; + } +#if MINIZ_USE_UNALIGNED_LOADS_AND_STORES + else if ((counter >= 9) && (counter <= dist)) + { + const mz_uint8 *pSrc_end = pSrc + (counter & ~7); + do + { + ((mz_uint32 *)pOut_buf_cur)[0] = ((const mz_uint32 *)pSrc)[0]; + ((mz_uint32 *)pOut_buf_cur)[1] = ((const mz_uint32 *)pSrc)[1]; + pOut_buf_cur += 8; + } while ((pSrc += 8) < pSrc_end); + if ((counter &= 7) < 3) + { + if (counter) + { + pOut_buf_cur[0] = pSrc[0]; + if (counter > 1) + pOut_buf_cur[1] = pSrc[1]; + pOut_buf_cur += counter; + } + continue; + } + } +#endif + do + { + pOut_buf_cur[0] = pSrc[0]; + pOut_buf_cur[1] = pSrc[1]; + pOut_buf_cur[2] = pSrc[2]; + pOut_buf_cur += 3; pSrc += 3; + } while ((int)(counter -= 3) > 2); + if ((int)counter > 0) + { + pOut_buf_cur[0] = pSrc[0]; + if ((int)counter > 1) + pOut_buf_cur[1] = pSrc[1]; + pOut_buf_cur += counter; + } + } + } + } while (!(r->m_final & 1)); + if (decomp_flags & TINFL_FLAG_PARSE_ZLIB_HEADER) + { + TINFL_SKIP_BITS(32, num_bits & 7); for (counter = 0; counter < 4; ++counter) { mz_uint s; if (num_bits) TINFL_GET_BITS(41, s, 8); else TINFL_GET_BYTE(42, s); r->m_z_adler32 = (r->m_z_adler32 << 8) | s; } + } + TINFL_CR_RETURN_FOREVER(34, TINFL_STATUS_DONE); + TINFL_CR_FINISH + +common_exit: + r->m_num_bits = num_bits; r->m_bit_buf = bit_buf; r->m_dist = dist; r->m_counter = counter; r->m_num_extra = num_extra; r->m_dist_from_out_buf_start = dist_from_out_buf_start; + *pIn_buf_size = pIn_buf_cur - pIn_buf_next; *pOut_buf_size = pOut_buf_cur - pOut_buf_next; + if ((decomp_flags & (TINFL_FLAG_PARSE_ZLIB_HEADER | TINFL_FLAG_COMPUTE_ADLER32)) && (status >= 0)) + { + const mz_uint8 *ptr = pOut_buf_next; size_t buf_len = *pOut_buf_size; + mz_uint32 i, s1 = r->m_check_adler32 & 0xffff, s2 = r->m_check_adler32 >> 16; size_t block_len = buf_len % 5552; + while (buf_len) + { + for (i = 0; i + 7 < block_len; i += 8, ptr += 8) + { + s1 += ptr[0], s2 += s1; s1 += ptr[1], s2 += s1; s1 += ptr[2], s2 += s1; s1 += ptr[3], s2 += s1; + s1 += ptr[4], s2 += s1; s1 += ptr[5], s2 += s1; s1 += ptr[6], s2 += s1; s1 += ptr[7], s2 += s1; + } + for ( ; i < block_len; ++i) s1 += *ptr++, s2 += s1; + s1 %= 65521U, s2 %= 65521U; buf_len -= block_len; block_len = 5552; + } + r->m_check_adler32 = (s2 << 16) + s1; if ((status == TINFL_STATUS_DONE) && (decomp_flags & TINFL_FLAG_PARSE_ZLIB_HEADER) && (r->m_check_adler32 != r->m_z_adler32)) status = TINFL_STATUS_ADLER32_MISMATCH; + } + return status; +} + +// Higher level helper functions. +void *tinfl_decompress_mem_to_heap(const void *pSrc_buf, size_t src_buf_len, size_t *pOut_len, int flags) +{ + tinfl_decompressor decomp; void *pBuf = NULL, *pNew_buf; size_t src_buf_ofs = 0, out_buf_capacity = 0; + *pOut_len = 0; + tinfl_init(&decomp); + for ( ; ; ) + { + size_t src_buf_size = src_buf_len - src_buf_ofs, dst_buf_size = out_buf_capacity - *pOut_len, new_out_buf_capacity; + tinfl_status status = tinfl_decompress(&decomp, (const mz_uint8*)pSrc_buf + src_buf_ofs, &src_buf_size, (mz_uint8*)pBuf, pBuf ? (mz_uint8*)pBuf + *pOut_len : NULL, &dst_buf_size, + (flags & ~TINFL_FLAG_HAS_MORE_INPUT) | TINFL_FLAG_USING_NON_WRAPPING_OUTPUT_BUF); + if ((status < 0) || (status == TINFL_STATUS_NEEDS_MORE_INPUT)) + { + MZ_FREE(pBuf); *pOut_len = 0; return NULL; + } + src_buf_ofs += src_buf_size; + *pOut_len += dst_buf_size; + if (status == TINFL_STATUS_DONE) break; + new_out_buf_capacity = out_buf_capacity * 2; if (new_out_buf_capacity < 128) new_out_buf_capacity = 128; + pNew_buf = MZ_REALLOC(pBuf, new_out_buf_capacity); + if (!pNew_buf) + { + MZ_FREE(pBuf); *pOut_len = 0; return NULL; + } + pBuf = pNew_buf; out_buf_capacity = new_out_buf_capacity; + } + return pBuf; +} + +size_t tinfl_decompress_mem_to_mem(void *pOut_buf, size_t out_buf_len, const void *pSrc_buf, size_t src_buf_len, int flags) +{ + tinfl_decompressor decomp; tinfl_status status; tinfl_init(&decomp); + status = tinfl_decompress(&decomp, (const mz_uint8*)pSrc_buf, &src_buf_len, (mz_uint8*)pOut_buf, (mz_uint8*)pOut_buf, &out_buf_len, (flags & ~TINFL_FLAG_HAS_MORE_INPUT) | TINFL_FLAG_USING_NON_WRAPPING_OUTPUT_BUF); + return (status != TINFL_STATUS_DONE) ? TINFL_DECOMPRESS_MEM_TO_MEM_FAILED : out_buf_len; +} + +int tinfl_decompress_mem_to_callback(const void *pIn_buf, size_t *pIn_buf_size, tinfl_put_buf_func_ptr pPut_buf_func, void *pPut_buf_user, int flags) +{ + int result = 0; + tinfl_decompressor decomp; + mz_uint8 *pDict = (mz_uint8*)MZ_MALLOC(TINFL_LZ_DICT_SIZE); size_t in_buf_ofs = 0, dict_ofs = 0; + if (!pDict) + return TINFL_STATUS_FAILED; + tinfl_init(&decomp); + for ( ; ; ) + { + size_t in_buf_size = *pIn_buf_size - in_buf_ofs, dst_buf_size = TINFL_LZ_DICT_SIZE - dict_ofs; + tinfl_status status = tinfl_decompress(&decomp, (const mz_uint8*)pIn_buf + in_buf_ofs, &in_buf_size, pDict, pDict + dict_ofs, &dst_buf_size, + (flags & ~(TINFL_FLAG_HAS_MORE_INPUT | TINFL_FLAG_USING_NON_WRAPPING_OUTPUT_BUF))); + in_buf_ofs += in_buf_size; + if ((dst_buf_size) && (!(*pPut_buf_func)(pDict + dict_ofs, (int)dst_buf_size, pPut_buf_user))) + break; + if (status != TINFL_STATUS_HAS_MORE_OUTPUT) + { + result = (status == TINFL_STATUS_DONE); + break; + } + dict_ofs = (dict_ofs + dst_buf_size) & (TINFL_LZ_DICT_SIZE - 1); + } + MZ_FREE(pDict); + *pIn_buf_size = in_buf_ofs; + return result; +} + +// ------------------- Low-level Compression (independent from all decompression API's) + +// Purposely making these tables static for faster init and thread safety. +static const mz_uint16 s_tdefl_len_sym[256] = { + 257,258,259,260,261,262,263,264,265,265,266,266,267,267,268,268,269,269,269,269,270,270,270,270,271,271,271,271,272,272,272,272, + 273,273,273,273,273,273,273,273,274,274,274,274,274,274,274,274,275,275,275,275,275,275,275,275,276,276,276,276,276,276,276,276, + 277,277,277,277,277,277,277,277,277,277,277,277,277,277,277,277,278,278,278,278,278,278,278,278,278,278,278,278,278,278,278,278, + 279,279,279,279,279,279,279,279,279,279,279,279,279,279,279,279,280,280,280,280,280,280,280,280,280,280,280,280,280,280,280,280, + 281,281,281,281,281,281,281,281,281,281,281,281,281,281,281,281,281,281,281,281,281,281,281,281,281,281,281,281,281,281,281,281, + 282,282,282,282,282,282,282,282,282,282,282,282,282,282,282,282,282,282,282,282,282,282,282,282,282,282,282,282,282,282,282,282, + 283,283,283,283,283,283,283,283,283,283,283,283,283,283,283,283,283,283,283,283,283,283,283,283,283,283,283,283,283,283,283,283, + 284,284,284,284,284,284,284,284,284,284,284,284,284,284,284,284,284,284,284,284,284,284,284,284,284,284,284,284,284,284,284,285 }; + +static const mz_uint8 s_tdefl_len_extra[256] = { + 0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, + 4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4, + 5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5, + 5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,0 }; + +static const mz_uint8 s_tdefl_small_dist_sym[512] = { + 0,1,2,3,4,4,5,5,6,6,6,6,7,7,7,7,8,8,8,8,8,8,8,8,9,9,9,9,9,9,9,9,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,11,11,11,11,11,11, + 11,11,11,11,11,11,11,11,11,11,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,13, + 13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,14,14,14,14,14,14,14,14,14,14,14,14, + 14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14,14, + 14,14,14,14,14,14,14,14,14,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15, + 15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,16,16,16,16,16,16,16,16,16,16,16,16,16, + 16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16, + 16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16, + 16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,17,17,17,17,17,17,17,17,17,17,17,17,17,17, + 17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17, + 17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17, + 17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17 }; + +static const mz_uint8 s_tdefl_small_dist_extra[512] = { + 0,0,0,0,1,1,1,1,2,2,2,2,2,2,2,2,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5, + 5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6, + 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6, + 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, + 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, + 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, + 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, + 7,7,7,7,7,7,7,7 }; + +static const mz_uint8 s_tdefl_large_dist_sym[128] = { + 0,0,18,19,20,20,21,21,22,22,22,22,23,23,23,23,24,24,24,24,24,24,24,24,25,25,25,25,25,25,25,25,26,26,26,26,26,26,26,26,26,26,26,26, + 26,26,26,26,27,27,27,27,27,27,27,27,27,27,27,27,27,27,27,27,28,28,28,28,28,28,28,28,28,28,28,28,28,28,28,28,28,28,28,28,28,28,28,28, + 28,28,28,28,28,28,28,28,29,29,29,29,29,29,29,29,29,29,29,29,29,29,29,29,29,29,29,29,29,29,29,29,29,29,29,29,29,29,29,29 }; + +static const mz_uint8 s_tdefl_large_dist_extra[128] = { + 0,0,8,8,9,9,9,9,10,10,10,10,10,10,10,10,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12, + 12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13, + 13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13 }; + +// Radix sorts tdefl_sym_freq[] array by 16-bit key m_key. Returns ptr to sorted values. +typedef struct { mz_uint16 m_key, m_sym_index; } tdefl_sym_freq; +static tdefl_sym_freq* tdefl_radix_sort_syms(mz_uint num_syms, tdefl_sym_freq* pSyms0, tdefl_sym_freq* pSyms1) +{ + mz_uint32 total_passes = 2, pass_shift, pass, i, hist[256 * 2]; tdefl_sym_freq* pCur_syms = pSyms0, *pNew_syms = pSyms1; MZ_CLEAR_OBJ(hist); + for (i = 0; i < num_syms; i++) { mz_uint freq = pSyms0[i].m_key; hist[freq & 0xFF]++; hist[256 + ((freq >> 8) & 0xFF)]++; } + while ((total_passes > 1) && (num_syms == hist[(total_passes - 1) * 256])) total_passes--; + for (pass_shift = 0, pass = 0; pass < total_passes; pass++, pass_shift += 8) + { + const mz_uint32* pHist = &hist[pass << 8]; + mz_uint offsets[256], cur_ofs = 0; + for (i = 0; i < 256; i++) { offsets[i] = cur_ofs; cur_ofs += pHist[i]; } + for (i = 0; i < num_syms; i++) pNew_syms[offsets[(pCur_syms[i].m_key >> pass_shift) & 0xFF]++] = pCur_syms[i]; + { tdefl_sym_freq* t = pCur_syms; pCur_syms = pNew_syms; pNew_syms = t; } + } + return pCur_syms; +} + +// tdefl_calculate_minimum_redundancy() originally written by: Alistair Moffat, alistair@cs.mu.oz.au, Jyrki Katajainen, jyrki@diku.dk, November 1996. +static void tdefl_calculate_minimum_redundancy(tdefl_sym_freq *A, int n) +{ + int root, leaf, next, avbl, used, dpth; + if (n==0) return; else if (n==1) { A[0].m_key = 1; return; } + A[0].m_key += A[1].m_key; root = 0; leaf = 2; + for (next=1; next < n-1; next++) + { + if (leaf>=n || A[root].m_key=n || (root=0; next--) A[next].m_key = A[A[next].m_key].m_key+1; + avbl = 1; used = dpth = 0; root = n-2; next = n-1; + while (avbl>0) + { + while (root>=0 && (int)A[root].m_key==dpth) { used++; root--; } + while (avbl>used) { A[next--].m_key = (mz_uint16)(dpth); avbl--; } + avbl = 2*used; dpth++; used = 0; + } +} + +// Limits canonical Huffman code table's max code size. +enum { TDEFL_MAX_SUPPORTED_HUFF_CODESIZE = 32 }; +static void tdefl_huffman_enforce_max_code_size(int *pNum_codes, int code_list_len, int max_code_size) +{ + int i; mz_uint32 total = 0; if (code_list_len <= 1) return; + for (i = max_code_size + 1; i <= TDEFL_MAX_SUPPORTED_HUFF_CODESIZE; i++) pNum_codes[max_code_size] += pNum_codes[i]; + for (i = max_code_size; i > 0; i--) total += (((mz_uint32)pNum_codes[i]) << (max_code_size - i)); + while (total != (1UL << max_code_size)) + { + pNum_codes[max_code_size]--; + for (i = max_code_size - 1; i > 0; i--) if (pNum_codes[i]) { pNum_codes[i]--; pNum_codes[i + 1] += 2; break; } + total--; + } +} + +static void tdefl_optimize_huffman_table(tdefl_compressor *d, int table_num, int table_len, int code_size_limit, int static_table) +{ + int i, j, l, num_codes[1 + TDEFL_MAX_SUPPORTED_HUFF_CODESIZE]; mz_uint next_code[TDEFL_MAX_SUPPORTED_HUFF_CODESIZE + 1]; MZ_CLEAR_OBJ(num_codes); + if (static_table) + { + for (i = 0; i < table_len; i++) num_codes[d->m_huff_code_sizes[table_num][i]]++; + } + else + { + tdefl_sym_freq syms0[TDEFL_MAX_HUFF_SYMBOLS], syms1[TDEFL_MAX_HUFF_SYMBOLS], *pSyms; + int num_used_syms = 0; + const mz_uint16 *pSym_count = &d->m_huff_count[table_num][0]; + for (i = 0; i < table_len; i++) if (pSym_count[i]) { syms0[num_used_syms].m_key = (mz_uint16)pSym_count[i]; syms0[num_used_syms++].m_sym_index = (mz_uint16)i; } + + pSyms = tdefl_radix_sort_syms(num_used_syms, syms0, syms1); tdefl_calculate_minimum_redundancy(pSyms, num_used_syms); + + for (i = 0; i < num_used_syms; i++) num_codes[pSyms[i].m_key]++; + + tdefl_huffman_enforce_max_code_size(num_codes, num_used_syms, code_size_limit); + + MZ_CLEAR_OBJ(d->m_huff_code_sizes[table_num]); MZ_CLEAR_OBJ(d->m_huff_codes[table_num]); + for (i = 1, j = num_used_syms; i <= code_size_limit; i++) + for (l = num_codes[i]; l > 0; l--) d->m_huff_code_sizes[table_num][pSyms[--j].m_sym_index] = (mz_uint8)(i); + } + + next_code[1] = 0; for (j = 0, i = 2; i <= code_size_limit; i++) next_code[i] = j = ((j + num_codes[i - 1]) << 1); + + for (i = 0; i < table_len; i++) + { + mz_uint rev_code = 0, code, code_size; if ((code_size = d->m_huff_code_sizes[table_num][i]) == 0) continue; + code = next_code[code_size]++; for (l = code_size; l > 0; l--, code >>= 1) rev_code = (rev_code << 1) | (code & 1); + d->m_huff_codes[table_num][i] = (mz_uint16)rev_code; + } +} + +#define TDEFL_PUT_BITS(b, l) do { \ + mz_uint bits = b; mz_uint len = l; MZ_ASSERT(bits <= ((1U << len) - 1U)); \ + d->m_bit_buffer |= (bits << d->m_bits_in); d->m_bits_in += len; \ + while (d->m_bits_in >= 8) { \ + if (d->m_pOutput_buf < d->m_pOutput_buf_end) \ + *d->m_pOutput_buf++ = (mz_uint8)(d->m_bit_buffer); \ + d->m_bit_buffer >>= 8; \ + d->m_bits_in -= 8; \ + } \ +} MZ_MACRO_END + +#define TDEFL_RLE_PREV_CODE_SIZE() { if (rle_repeat_count) { \ + if (rle_repeat_count < 3) { \ + d->m_huff_count[2][prev_code_size] = (mz_uint16)(d->m_huff_count[2][prev_code_size] + rle_repeat_count); \ + while (rle_repeat_count--) packed_code_sizes[num_packed_code_sizes++] = prev_code_size; \ + } else { \ + d->m_huff_count[2][16] = (mz_uint16)(d->m_huff_count[2][16] + 1); packed_code_sizes[num_packed_code_sizes++] = 16; packed_code_sizes[num_packed_code_sizes++] = (mz_uint8)(rle_repeat_count - 3); \ +} rle_repeat_count = 0; } } + +#define TDEFL_RLE_ZERO_CODE_SIZE() { if (rle_z_count) { \ + if (rle_z_count < 3) { \ + d->m_huff_count[2][0] = (mz_uint16)(d->m_huff_count[2][0] + rle_z_count); while (rle_z_count--) packed_code_sizes[num_packed_code_sizes++] = 0; \ + } else if (rle_z_count <= 10) { \ + d->m_huff_count[2][17] = (mz_uint16)(d->m_huff_count[2][17] + 1); packed_code_sizes[num_packed_code_sizes++] = 17; packed_code_sizes[num_packed_code_sizes++] = (mz_uint8)(rle_z_count - 3); \ + } else { \ + d->m_huff_count[2][18] = (mz_uint16)(d->m_huff_count[2][18] + 1); packed_code_sizes[num_packed_code_sizes++] = 18; packed_code_sizes[num_packed_code_sizes++] = (mz_uint8)(rle_z_count - 11); \ +} rle_z_count = 0; } } + +static mz_uint8 s_tdefl_packed_code_size_syms_swizzle[] = { 16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15 }; + +static void tdefl_start_dynamic_block(tdefl_compressor *d) +{ + int num_lit_codes, num_dist_codes, num_bit_lengths; mz_uint i, total_code_sizes_to_pack, num_packed_code_sizes, rle_z_count, rle_repeat_count, packed_code_sizes_index; + mz_uint8 code_sizes_to_pack[TDEFL_MAX_HUFF_SYMBOLS_0 + TDEFL_MAX_HUFF_SYMBOLS_1], packed_code_sizes[TDEFL_MAX_HUFF_SYMBOLS_0 + TDEFL_MAX_HUFF_SYMBOLS_1], prev_code_size = 0xFF; + + d->m_huff_count[0][256] = 1; + + tdefl_optimize_huffman_table(d, 0, TDEFL_MAX_HUFF_SYMBOLS_0, 15, MZ_FALSE); + tdefl_optimize_huffman_table(d, 1, TDEFL_MAX_HUFF_SYMBOLS_1, 15, MZ_FALSE); + + for (num_lit_codes = 286; num_lit_codes > 257; num_lit_codes--) if (d->m_huff_code_sizes[0][num_lit_codes - 1]) break; + for (num_dist_codes = 30; num_dist_codes > 1; num_dist_codes--) if (d->m_huff_code_sizes[1][num_dist_codes - 1]) break; + + memcpy(code_sizes_to_pack, &d->m_huff_code_sizes[0][0], num_lit_codes); + memcpy(code_sizes_to_pack + num_lit_codes, &d->m_huff_code_sizes[1][0], num_dist_codes); + total_code_sizes_to_pack = num_lit_codes + num_dist_codes; num_packed_code_sizes = 0; rle_z_count = 0; rle_repeat_count = 0; + + memset(&d->m_huff_count[2][0], 0, sizeof(d->m_huff_count[2][0]) * TDEFL_MAX_HUFF_SYMBOLS_2); + for (i = 0; i < total_code_sizes_to_pack; i++) + { + mz_uint8 code_size = code_sizes_to_pack[i]; + if (!code_size) + { + TDEFL_RLE_PREV_CODE_SIZE(); + if (++rle_z_count == 138) { TDEFL_RLE_ZERO_CODE_SIZE(); } + } + else + { + TDEFL_RLE_ZERO_CODE_SIZE(); + if (code_size != prev_code_size) + { + TDEFL_RLE_PREV_CODE_SIZE(); + d->m_huff_count[2][code_size] = (mz_uint16)(d->m_huff_count[2][code_size] + 1); packed_code_sizes[num_packed_code_sizes++] = code_size; + } + else if (++rle_repeat_count == 6) + { + TDEFL_RLE_PREV_CODE_SIZE(); + } + } + prev_code_size = code_size; + } + if (rle_repeat_count) { TDEFL_RLE_PREV_CODE_SIZE(); } else { TDEFL_RLE_ZERO_CODE_SIZE(); } + + tdefl_optimize_huffman_table(d, 2, TDEFL_MAX_HUFF_SYMBOLS_2, 7, MZ_FALSE); + + TDEFL_PUT_BITS(2, 2); + + TDEFL_PUT_BITS(num_lit_codes - 257, 5); + TDEFL_PUT_BITS(num_dist_codes - 1, 5); + + for (num_bit_lengths = 18; num_bit_lengths >= 0; num_bit_lengths--) if (d->m_huff_code_sizes[2][s_tdefl_packed_code_size_syms_swizzle[num_bit_lengths]]) break; + num_bit_lengths = MZ_MAX(4, (num_bit_lengths + 1)); TDEFL_PUT_BITS(num_bit_lengths - 4, 4); + for (i = 0; (int)i < num_bit_lengths; i++) TDEFL_PUT_BITS(d->m_huff_code_sizes[2][s_tdefl_packed_code_size_syms_swizzle[i]], 3); + + for (packed_code_sizes_index = 0; packed_code_sizes_index < num_packed_code_sizes; ) + { + mz_uint code = packed_code_sizes[packed_code_sizes_index++]; MZ_ASSERT(code < TDEFL_MAX_HUFF_SYMBOLS_2); + TDEFL_PUT_BITS(d->m_huff_codes[2][code], d->m_huff_code_sizes[2][code]); + if (code >= 16) TDEFL_PUT_BITS(packed_code_sizes[packed_code_sizes_index++], "\02\03\07"[code - 16]); + } +} + +static void tdefl_start_static_block(tdefl_compressor *d) +{ + mz_uint i; + mz_uint8 *p = &d->m_huff_code_sizes[0][0]; + + for (i = 0; i <= 143; ++i) *p++ = 8; + for ( ; i <= 255; ++i) *p++ = 9; + for ( ; i <= 279; ++i) *p++ = 7; + for ( ; i <= 287; ++i) *p++ = 8; + + memset(d->m_huff_code_sizes[1], 5, 32); + + tdefl_optimize_huffman_table(d, 0, 288, 15, MZ_TRUE); + tdefl_optimize_huffman_table(d, 1, 32, 15, MZ_TRUE); + + TDEFL_PUT_BITS(1, 2); +} + +static const mz_uint mz_bitmasks[17] = { 0x0000, 0x0001, 0x0003, 0x0007, 0x000F, 0x001F, 0x003F, 0x007F, 0x00FF, 0x01FF, 0x03FF, 0x07FF, 0x0FFF, 0x1FFF, 0x3FFF, 0x7FFF, 0xFFFF }; + +#if MINIZ_USE_UNALIGNED_LOADS_AND_STORES && MINIZ_LITTLE_ENDIAN && MINIZ_HAS_64BIT_REGISTERS +static mz_bool tdefl_compress_lz_codes(tdefl_compressor *d) +{ + mz_uint flags; + mz_uint8 *pLZ_codes; + mz_uint8 *pOutput_buf = d->m_pOutput_buf; + mz_uint8 *pLZ_code_buf_end = d->m_pLZ_code_buf; + mz_uint64 bit_buffer = d->m_bit_buffer; + mz_uint bits_in = d->m_bits_in; + +#define TDEFL_PUT_BITS_FAST(b, l) { bit_buffer |= (((mz_uint64)(b)) << bits_in); bits_in += (l); } + + flags = 1; + for (pLZ_codes = d->m_lz_code_buf; pLZ_codes < pLZ_code_buf_end; flags >>= 1) + { + if (flags == 1) + flags = *pLZ_codes++ | 0x100; + + if (flags & 1) + { + mz_uint s0, s1, n0, n1, sym, num_extra_bits; + mz_uint match_len = pLZ_codes[0], match_dist = *(const mz_uint16 *)(pLZ_codes + 1); pLZ_codes += 3; + + MZ_ASSERT(d->m_huff_code_sizes[0][s_tdefl_len_sym[match_len]]); + TDEFL_PUT_BITS_FAST(d->m_huff_codes[0][s_tdefl_len_sym[match_len]], d->m_huff_code_sizes[0][s_tdefl_len_sym[match_len]]); + TDEFL_PUT_BITS_FAST(match_len & mz_bitmasks[s_tdefl_len_extra[match_len]], s_tdefl_len_extra[match_len]); + + // This sequence coaxes MSVC into using cmov's vs. jmp's. + s0 = s_tdefl_small_dist_sym[match_dist & 511]; + n0 = s_tdefl_small_dist_extra[match_dist & 511]; + s1 = s_tdefl_large_dist_sym[match_dist >> 8]; + n1 = s_tdefl_large_dist_extra[match_dist >> 8]; + sym = (match_dist < 512) ? s0 : s1; + num_extra_bits = (match_dist < 512) ? n0 : n1; + + MZ_ASSERT(d->m_huff_code_sizes[1][sym]); + TDEFL_PUT_BITS_FAST(d->m_huff_codes[1][sym], d->m_huff_code_sizes[1][sym]); + TDEFL_PUT_BITS_FAST(match_dist & mz_bitmasks[num_extra_bits], num_extra_bits); + } + else + { + mz_uint lit = *pLZ_codes++; + MZ_ASSERT(d->m_huff_code_sizes[0][lit]); + TDEFL_PUT_BITS_FAST(d->m_huff_codes[0][lit], d->m_huff_code_sizes[0][lit]); + + if (((flags & 2) == 0) && (pLZ_codes < pLZ_code_buf_end)) + { + flags >>= 1; + lit = *pLZ_codes++; + MZ_ASSERT(d->m_huff_code_sizes[0][lit]); + TDEFL_PUT_BITS_FAST(d->m_huff_codes[0][lit], d->m_huff_code_sizes[0][lit]); + + if (((flags & 2) == 0) && (pLZ_codes < pLZ_code_buf_end)) + { + flags >>= 1; + lit = *pLZ_codes++; + MZ_ASSERT(d->m_huff_code_sizes[0][lit]); + TDEFL_PUT_BITS_FAST(d->m_huff_codes[0][lit], d->m_huff_code_sizes[0][lit]); + } + } + } + + if (pOutput_buf >= d->m_pOutput_buf_end) + return MZ_FALSE; + + *(mz_uint64*)pOutput_buf = bit_buffer; + pOutput_buf += (bits_in >> 3); + bit_buffer >>= (bits_in & ~7); + bits_in &= 7; + } + +#undef TDEFL_PUT_BITS_FAST + + d->m_pOutput_buf = pOutput_buf; + d->m_bits_in = 0; + d->m_bit_buffer = 0; + + while (bits_in) + { + mz_uint32 n = MZ_MIN(bits_in, 16); + TDEFL_PUT_BITS((mz_uint)bit_buffer & mz_bitmasks[n], n); + bit_buffer >>= n; + bits_in -= n; + } + + TDEFL_PUT_BITS(d->m_huff_codes[0][256], d->m_huff_code_sizes[0][256]); + + return (d->m_pOutput_buf < d->m_pOutput_buf_end); +} +#else +static mz_bool tdefl_compress_lz_codes(tdefl_compressor *d) +{ + mz_uint flags; + mz_uint8 *pLZ_codes; + + flags = 1; + for (pLZ_codes = d->m_lz_code_buf; pLZ_codes < d->m_pLZ_code_buf; flags >>= 1) + { + if (flags == 1) + flags = *pLZ_codes++ | 0x100; + if (flags & 1) + { + mz_uint sym, num_extra_bits; + mz_uint match_len = pLZ_codes[0], match_dist = (pLZ_codes[1] | (pLZ_codes[2] << 8)); pLZ_codes += 3; + + MZ_ASSERT(d->m_huff_code_sizes[0][s_tdefl_len_sym[match_len]]); + TDEFL_PUT_BITS(d->m_huff_codes[0][s_tdefl_len_sym[match_len]], d->m_huff_code_sizes[0][s_tdefl_len_sym[match_len]]); + TDEFL_PUT_BITS(match_len & mz_bitmasks[s_tdefl_len_extra[match_len]], s_tdefl_len_extra[match_len]); + + if (match_dist < 512) + { + sym = s_tdefl_small_dist_sym[match_dist]; num_extra_bits = s_tdefl_small_dist_extra[match_dist]; + } + else + { + sym = s_tdefl_large_dist_sym[match_dist >> 8]; num_extra_bits = s_tdefl_large_dist_extra[match_dist >> 8]; + } + MZ_ASSERT(d->m_huff_code_sizes[1][sym]); + TDEFL_PUT_BITS(d->m_huff_codes[1][sym], d->m_huff_code_sizes[1][sym]); + TDEFL_PUT_BITS(match_dist & mz_bitmasks[num_extra_bits], num_extra_bits); + } + else + { + mz_uint lit = *pLZ_codes++; + MZ_ASSERT(d->m_huff_code_sizes[0][lit]); + TDEFL_PUT_BITS(d->m_huff_codes[0][lit], d->m_huff_code_sizes[0][lit]); + } + } + + TDEFL_PUT_BITS(d->m_huff_codes[0][256], d->m_huff_code_sizes[0][256]); + + return (d->m_pOutput_buf < d->m_pOutput_buf_end); +} +#endif // MINIZ_USE_UNALIGNED_LOADS_AND_STORES && MINIZ_LITTLE_ENDIAN && MINIZ_HAS_64BIT_REGISTERS + +static mz_bool tdefl_compress_block(tdefl_compressor *d, mz_bool static_block) +{ + if (static_block) + tdefl_start_static_block(d); + else + tdefl_start_dynamic_block(d); + return tdefl_compress_lz_codes(d); +} + +static int tdefl_flush_block(tdefl_compressor *d, int flush) +{ + mz_uint saved_bit_buf, saved_bits_in; + mz_uint8 *pSaved_output_buf; + mz_bool comp_block_succeeded = MZ_FALSE; + int n, use_raw_block = ((d->m_flags & TDEFL_FORCE_ALL_RAW_BLOCKS) != 0) && (d->m_lookahead_pos - d->m_lz_code_buf_dict_pos) <= d->m_dict_size; + mz_uint8 *pOutput_buf_start = ((d->m_pPut_buf_func == NULL) && ((*d->m_pOut_buf_size - d->m_out_buf_ofs) >= TDEFL_OUT_BUF_SIZE)) ? ((mz_uint8 *)d->m_pOut_buf + d->m_out_buf_ofs) : d->m_output_buf; + + d->m_pOutput_buf = pOutput_buf_start; + d->m_pOutput_buf_end = d->m_pOutput_buf + TDEFL_OUT_BUF_SIZE - 16; + + MZ_ASSERT(!d->m_output_flush_remaining); + d->m_output_flush_ofs = 0; + d->m_output_flush_remaining = 0; + + *d->m_pLZ_flags = (mz_uint8)(*d->m_pLZ_flags >> d->m_num_flags_left); + d->m_pLZ_code_buf -= (d->m_num_flags_left == 8); + + if ((d->m_flags & TDEFL_WRITE_ZLIB_HEADER) && (!d->m_block_index)) + { + TDEFL_PUT_BITS(0x78, 8); TDEFL_PUT_BITS(0x01, 8); + } + + TDEFL_PUT_BITS(flush == TDEFL_FINISH, 1); + + pSaved_output_buf = d->m_pOutput_buf; saved_bit_buf = d->m_bit_buffer; saved_bits_in = d->m_bits_in; + + if (!use_raw_block) + comp_block_succeeded = tdefl_compress_block(d, (d->m_flags & TDEFL_FORCE_ALL_STATIC_BLOCKS) || (d->m_total_lz_bytes < 48)); + + // If the block gets expanded, forget the current contents of the output buffer and send a raw block instead. + if ( ((use_raw_block) || ((d->m_total_lz_bytes) && ((d->m_pOutput_buf - pSaved_output_buf + 1U) >= d->m_total_lz_bytes))) && + ((d->m_lookahead_pos - d->m_lz_code_buf_dict_pos) <= d->m_dict_size) ) + { + mz_uint i; d->m_pOutput_buf = pSaved_output_buf; d->m_bit_buffer = saved_bit_buf, d->m_bits_in = saved_bits_in; + TDEFL_PUT_BITS(0, 2); + if (d->m_bits_in) { TDEFL_PUT_BITS(0, 8 - d->m_bits_in); } + for (i = 2; i; --i, d->m_total_lz_bytes ^= 0xFFFF) + { + TDEFL_PUT_BITS(d->m_total_lz_bytes & 0xFFFF, 16); + } + for (i = 0; i < d->m_total_lz_bytes; ++i) + { + TDEFL_PUT_BITS(d->m_dict[(d->m_lz_code_buf_dict_pos + i) & TDEFL_LZ_DICT_SIZE_MASK], 8); + } + } + // Check for the extremely unlikely (if not impossible) case of the compressed block not fitting into the output buffer when using dynamic codes. + else if (!comp_block_succeeded) + { + d->m_pOutput_buf = pSaved_output_buf; d->m_bit_buffer = saved_bit_buf, d->m_bits_in = saved_bits_in; + tdefl_compress_block(d, MZ_TRUE); + } + + if (flush) + { + if (flush == TDEFL_FINISH) + { + if (d->m_bits_in) { TDEFL_PUT_BITS(0, 8 - d->m_bits_in); } + if (d->m_flags & TDEFL_WRITE_ZLIB_HEADER) { mz_uint i, a = d->m_adler32; for (i = 0; i < 4; i++) { TDEFL_PUT_BITS((a >> 24) & 0xFF, 8); a <<= 8; } } + } + else + { + mz_uint i, z = 0; TDEFL_PUT_BITS(0, 3); if (d->m_bits_in) { TDEFL_PUT_BITS(0, 8 - d->m_bits_in); } for (i = 2; i; --i, z ^= 0xFFFF) { TDEFL_PUT_BITS(z & 0xFFFF, 16); } + } + } + + MZ_ASSERT(d->m_pOutput_buf < d->m_pOutput_buf_end); + + memset(&d->m_huff_count[0][0], 0, sizeof(d->m_huff_count[0][0]) * TDEFL_MAX_HUFF_SYMBOLS_0); + memset(&d->m_huff_count[1][0], 0, sizeof(d->m_huff_count[1][0]) * TDEFL_MAX_HUFF_SYMBOLS_1); + + d->m_pLZ_code_buf = d->m_lz_code_buf + 1; d->m_pLZ_flags = d->m_lz_code_buf; d->m_num_flags_left = 8; d->m_lz_code_buf_dict_pos += d->m_total_lz_bytes; d->m_total_lz_bytes = 0; d->m_block_index++; + + if ((n = (int)(d->m_pOutput_buf - pOutput_buf_start)) != 0) + { + if (d->m_pPut_buf_func) + { + *d->m_pIn_buf_size = d->m_pSrc - (const mz_uint8 *)d->m_pIn_buf; + if (!(*d->m_pPut_buf_func)(d->m_output_buf, n, d->m_pPut_buf_user)) + return (d->m_prev_return_status = TDEFL_STATUS_PUT_BUF_FAILED); + } + else if (pOutput_buf_start == d->m_output_buf) + { + int bytes_to_copy = (int)MZ_MIN((size_t)n, (size_t)(*d->m_pOut_buf_size - d->m_out_buf_ofs)); + memcpy((mz_uint8 *)d->m_pOut_buf + d->m_out_buf_ofs, d->m_output_buf, bytes_to_copy); + d->m_out_buf_ofs += bytes_to_copy; + if ((n -= bytes_to_copy) != 0) + { + d->m_output_flush_ofs = bytes_to_copy; + d->m_output_flush_remaining = n; + } + } + else + { + d->m_out_buf_ofs += n; + } + } + + return d->m_output_flush_remaining; +} + +#if MINIZ_USE_UNALIGNED_LOADS_AND_STORES +#define TDEFL_READ_UNALIGNED_WORD(p) *(const mz_uint16*)(p) +static MZ_FORCEINLINE void tdefl_find_match(tdefl_compressor *d, mz_uint lookahead_pos, mz_uint max_dist, mz_uint max_match_len, mz_uint *pMatch_dist, mz_uint *pMatch_len) +{ + mz_uint dist, pos = lookahead_pos & TDEFL_LZ_DICT_SIZE_MASK, match_len = *pMatch_len, probe_pos = pos, next_probe_pos, probe_len; + mz_uint num_probes_left = d->m_max_probes[match_len >= 32]; + const mz_uint16 *s = (const mz_uint16*)(d->m_dict + pos), *p, *q; + mz_uint16 c01 = TDEFL_READ_UNALIGNED_WORD(&d->m_dict[pos + match_len - 1]), s01 = TDEFL_READ_UNALIGNED_WORD(s); + MZ_ASSERT(max_match_len <= TDEFL_MAX_MATCH_LEN); if (max_match_len <= match_len) return; + for ( ; ; ) + { + for ( ; ; ) + { + if (--num_probes_left == 0) return; + #define TDEFL_PROBE \ + next_probe_pos = d->m_next[probe_pos]; \ + if ((!next_probe_pos) || ((dist = (mz_uint16)(lookahead_pos - next_probe_pos)) > max_dist)) return; \ + probe_pos = next_probe_pos & TDEFL_LZ_DICT_SIZE_MASK; \ + if (TDEFL_READ_UNALIGNED_WORD(&d->m_dict[probe_pos + match_len - 1]) == c01) break; + TDEFL_PROBE; TDEFL_PROBE; TDEFL_PROBE; + } + if (!dist) break; q = (const mz_uint16*)(d->m_dict + probe_pos); if (TDEFL_READ_UNALIGNED_WORD(q) != s01) continue; p = s; probe_len = 32; + do { } while ( (TDEFL_READ_UNALIGNED_WORD(++p) == TDEFL_READ_UNALIGNED_WORD(++q)) && (TDEFL_READ_UNALIGNED_WORD(++p) == TDEFL_READ_UNALIGNED_WORD(++q)) && + (TDEFL_READ_UNALIGNED_WORD(++p) == TDEFL_READ_UNALIGNED_WORD(++q)) && (TDEFL_READ_UNALIGNED_WORD(++p) == TDEFL_READ_UNALIGNED_WORD(++q)) && (--probe_len > 0) ); + if (!probe_len) + { + *pMatch_dist = dist; *pMatch_len = MZ_MIN(max_match_len, TDEFL_MAX_MATCH_LEN); break; + } + else if ((probe_len = ((mz_uint)(p - s) * 2) + (mz_uint)(*(const mz_uint8*)p == *(const mz_uint8*)q)) > match_len) + { + *pMatch_dist = dist; if ((*pMatch_len = match_len = MZ_MIN(max_match_len, probe_len)) == max_match_len) break; + c01 = TDEFL_READ_UNALIGNED_WORD(&d->m_dict[pos + match_len - 1]); + } + } +} +#else +static MZ_FORCEINLINE void tdefl_find_match(tdefl_compressor *d, mz_uint lookahead_pos, mz_uint max_dist, mz_uint max_match_len, mz_uint *pMatch_dist, mz_uint *pMatch_len) +{ + mz_uint dist, pos = lookahead_pos & TDEFL_LZ_DICT_SIZE_MASK, match_len = *pMatch_len, probe_pos = pos, next_probe_pos, probe_len; + mz_uint num_probes_left = d->m_max_probes[match_len >= 32]; + const mz_uint8 *s = d->m_dict + pos, *p, *q; + mz_uint8 c0 = d->m_dict[pos + match_len], c1 = d->m_dict[pos + match_len - 1]; + MZ_ASSERT(max_match_len <= TDEFL_MAX_MATCH_LEN); if (max_match_len <= match_len) return; + for ( ; ; ) + { + for ( ; ; ) + { + if (--num_probes_left == 0) return; + #define TDEFL_PROBE \ + next_probe_pos = d->m_next[probe_pos]; \ + if ((!next_probe_pos) || ((dist = (mz_uint16)(lookahead_pos - next_probe_pos)) > max_dist)) return; \ + probe_pos = next_probe_pos & TDEFL_LZ_DICT_SIZE_MASK; \ + if ((d->m_dict[probe_pos + match_len] == c0) && (d->m_dict[probe_pos + match_len - 1] == c1)) break; + TDEFL_PROBE; TDEFL_PROBE; TDEFL_PROBE; + } + if (!dist) break; p = s; q = d->m_dict + probe_pos; for (probe_len = 0; probe_len < max_match_len; probe_len++) if (*p++ != *q++) break; + if (probe_len > match_len) + { + *pMatch_dist = dist; if ((*pMatch_len = match_len = probe_len) == max_match_len) return; + c0 = d->m_dict[pos + match_len]; c1 = d->m_dict[pos + match_len - 1]; + } + } +} +#endif // #if MINIZ_USE_UNALIGNED_LOADS_AND_STORES + +#if MINIZ_USE_UNALIGNED_LOADS_AND_STORES && MINIZ_LITTLE_ENDIAN +static mz_bool tdefl_compress_fast(tdefl_compressor *d) +{ + // Faster, minimally featured LZRW1-style match+parse loop with better register utilization. Intended for applications where raw throughput is valued more highly than ratio. + mz_uint lookahead_pos = d->m_lookahead_pos, lookahead_size = d->m_lookahead_size, dict_size = d->m_dict_size, total_lz_bytes = d->m_total_lz_bytes, num_flags_left = d->m_num_flags_left; + mz_uint8 *pLZ_code_buf = d->m_pLZ_code_buf, *pLZ_flags = d->m_pLZ_flags; + mz_uint cur_pos = lookahead_pos & TDEFL_LZ_DICT_SIZE_MASK; + + while ((d->m_src_buf_left) || ((d->m_flush) && (lookahead_size))) + { + const mz_uint TDEFL_COMP_FAST_LOOKAHEAD_SIZE = 4096; + mz_uint dst_pos = (lookahead_pos + lookahead_size) & TDEFL_LZ_DICT_SIZE_MASK; + mz_uint num_bytes_to_process = (mz_uint)MZ_MIN(d->m_src_buf_left, TDEFL_COMP_FAST_LOOKAHEAD_SIZE - lookahead_size); + d->m_src_buf_left -= num_bytes_to_process; + lookahead_size += num_bytes_to_process; + + while (num_bytes_to_process) + { + mz_uint32 n = MZ_MIN(TDEFL_LZ_DICT_SIZE - dst_pos, num_bytes_to_process); + memcpy(d->m_dict + dst_pos, d->m_pSrc, n); + if (dst_pos < (TDEFL_MAX_MATCH_LEN - 1)) + memcpy(d->m_dict + TDEFL_LZ_DICT_SIZE + dst_pos, d->m_pSrc, MZ_MIN(n, (TDEFL_MAX_MATCH_LEN - 1) - dst_pos)); + d->m_pSrc += n; + dst_pos = (dst_pos + n) & TDEFL_LZ_DICT_SIZE_MASK; + num_bytes_to_process -= n; + } + + dict_size = MZ_MIN(TDEFL_LZ_DICT_SIZE - lookahead_size, dict_size); + if ((!d->m_flush) && (lookahead_size < TDEFL_COMP_FAST_LOOKAHEAD_SIZE)) break; + + while (lookahead_size >= 4) + { + mz_uint cur_match_dist, cur_match_len = 1; + mz_uint8 *pCur_dict = d->m_dict + cur_pos; + mz_uint first_trigram = (*(const mz_uint32 *)pCur_dict) & 0xFFFFFF; + mz_uint hash = (first_trigram ^ (first_trigram >> (24 - (TDEFL_LZ_HASH_BITS - 8)))) & TDEFL_LEVEL1_HASH_SIZE_MASK; + mz_uint probe_pos = d->m_hash[hash]; + d->m_hash[hash] = (mz_uint16)lookahead_pos; + + if (((cur_match_dist = (mz_uint16)(lookahead_pos - probe_pos)) <= dict_size) && ((*(const mz_uint32 *)(d->m_dict + (probe_pos &= TDEFL_LZ_DICT_SIZE_MASK)) & 0xFFFFFF) == first_trigram)) + { + const mz_uint16 *p = (const mz_uint16 *)pCur_dict; + const mz_uint16 *q = (const mz_uint16 *)(d->m_dict + probe_pos); + mz_uint32 probe_len = 32; + do { } while ( (TDEFL_READ_UNALIGNED_WORD(++p) == TDEFL_READ_UNALIGNED_WORD(++q)) && (TDEFL_READ_UNALIGNED_WORD(++p) == TDEFL_READ_UNALIGNED_WORD(++q)) && + (TDEFL_READ_UNALIGNED_WORD(++p) == TDEFL_READ_UNALIGNED_WORD(++q)) && (TDEFL_READ_UNALIGNED_WORD(++p) == TDEFL_READ_UNALIGNED_WORD(++q)) && (--probe_len > 0) ); + cur_match_len = ((mz_uint)(p - (const mz_uint16 *)pCur_dict) * 2) + (mz_uint)(*(const mz_uint8 *)p == *(const mz_uint8 *)q); + if (!probe_len) + cur_match_len = cur_match_dist ? TDEFL_MAX_MATCH_LEN : 0; + + if ((cur_match_len < TDEFL_MIN_MATCH_LEN) || ((cur_match_len == TDEFL_MIN_MATCH_LEN) && (cur_match_dist >= 8U*1024U))) + { + cur_match_len = 1; + *pLZ_code_buf++ = (mz_uint8)first_trigram; + *pLZ_flags = (mz_uint8)(*pLZ_flags >> 1); + d->m_huff_count[0][(mz_uint8)first_trigram]++; + } + else + { + mz_uint32 s0, s1; + cur_match_len = MZ_MIN(cur_match_len, lookahead_size); + + MZ_ASSERT((cur_match_len >= TDEFL_MIN_MATCH_LEN) && (cur_match_dist >= 1) && (cur_match_dist <= TDEFL_LZ_DICT_SIZE)); + + cur_match_dist--; + + pLZ_code_buf[0] = (mz_uint8)(cur_match_len - TDEFL_MIN_MATCH_LEN); + *(mz_uint16 *)(&pLZ_code_buf[1]) = (mz_uint16)cur_match_dist; + pLZ_code_buf += 3; + *pLZ_flags = (mz_uint8)((*pLZ_flags >> 1) | 0x80); + + s0 = s_tdefl_small_dist_sym[cur_match_dist & 511]; + s1 = s_tdefl_large_dist_sym[cur_match_dist >> 8]; + d->m_huff_count[1][(cur_match_dist < 512) ? s0 : s1]++; + + d->m_huff_count[0][s_tdefl_len_sym[cur_match_len - TDEFL_MIN_MATCH_LEN]]++; + } + } + else + { + *pLZ_code_buf++ = (mz_uint8)first_trigram; + *pLZ_flags = (mz_uint8)(*pLZ_flags >> 1); + d->m_huff_count[0][(mz_uint8)first_trigram]++; + } + + if (--num_flags_left == 0) { num_flags_left = 8; pLZ_flags = pLZ_code_buf++; } + + total_lz_bytes += cur_match_len; + lookahead_pos += cur_match_len; + dict_size = MZ_MIN(dict_size + cur_match_len, TDEFL_LZ_DICT_SIZE); + cur_pos = (cur_pos + cur_match_len) & TDEFL_LZ_DICT_SIZE_MASK; + MZ_ASSERT(lookahead_size >= cur_match_len); + lookahead_size -= cur_match_len; + + if (pLZ_code_buf > &d->m_lz_code_buf[TDEFL_LZ_CODE_BUF_SIZE - 8]) + { + int n; + d->m_lookahead_pos = lookahead_pos; d->m_lookahead_size = lookahead_size; d->m_dict_size = dict_size; + d->m_total_lz_bytes = total_lz_bytes; d->m_pLZ_code_buf = pLZ_code_buf; d->m_pLZ_flags = pLZ_flags; d->m_num_flags_left = num_flags_left; + if ((n = tdefl_flush_block(d, 0)) != 0) + return (n < 0) ? MZ_FALSE : MZ_TRUE; + total_lz_bytes = d->m_total_lz_bytes; pLZ_code_buf = d->m_pLZ_code_buf; pLZ_flags = d->m_pLZ_flags; num_flags_left = d->m_num_flags_left; + } + } + + while (lookahead_size) + { + mz_uint8 lit = d->m_dict[cur_pos]; + + total_lz_bytes++; + *pLZ_code_buf++ = lit; + *pLZ_flags = (mz_uint8)(*pLZ_flags >> 1); + if (--num_flags_left == 0) { num_flags_left = 8; pLZ_flags = pLZ_code_buf++; } + + d->m_huff_count[0][lit]++; + + lookahead_pos++; + dict_size = MZ_MIN(dict_size + 1, TDEFL_LZ_DICT_SIZE); + cur_pos = (cur_pos + 1) & TDEFL_LZ_DICT_SIZE_MASK; + lookahead_size--; + + if (pLZ_code_buf > &d->m_lz_code_buf[TDEFL_LZ_CODE_BUF_SIZE - 8]) + { + int n; + d->m_lookahead_pos = lookahead_pos; d->m_lookahead_size = lookahead_size; d->m_dict_size = dict_size; + d->m_total_lz_bytes = total_lz_bytes; d->m_pLZ_code_buf = pLZ_code_buf; d->m_pLZ_flags = pLZ_flags; d->m_num_flags_left = num_flags_left; + if ((n = tdefl_flush_block(d, 0)) != 0) + return (n < 0) ? MZ_FALSE : MZ_TRUE; + total_lz_bytes = d->m_total_lz_bytes; pLZ_code_buf = d->m_pLZ_code_buf; pLZ_flags = d->m_pLZ_flags; num_flags_left = d->m_num_flags_left; + } + } + } + + d->m_lookahead_pos = lookahead_pos; d->m_lookahead_size = lookahead_size; d->m_dict_size = dict_size; + d->m_total_lz_bytes = total_lz_bytes; d->m_pLZ_code_buf = pLZ_code_buf; d->m_pLZ_flags = pLZ_flags; d->m_num_flags_left = num_flags_left; + return MZ_TRUE; +} +#endif // MINIZ_USE_UNALIGNED_LOADS_AND_STORES && MINIZ_LITTLE_ENDIAN + +static MZ_FORCEINLINE void tdefl_record_literal(tdefl_compressor *d, mz_uint8 lit) +{ + d->m_total_lz_bytes++; + *d->m_pLZ_code_buf++ = lit; + *d->m_pLZ_flags = (mz_uint8)(*d->m_pLZ_flags >> 1); if (--d->m_num_flags_left == 0) { d->m_num_flags_left = 8; d->m_pLZ_flags = d->m_pLZ_code_buf++; } + d->m_huff_count[0][lit]++; +} + +static MZ_FORCEINLINE void tdefl_record_match(tdefl_compressor *d, mz_uint match_len, mz_uint match_dist) +{ + mz_uint32 s0, s1; + + MZ_ASSERT((match_len >= TDEFL_MIN_MATCH_LEN) && (match_dist >= 1) && (match_dist <= TDEFL_LZ_DICT_SIZE)); + + d->m_total_lz_bytes += match_len; + + d->m_pLZ_code_buf[0] = (mz_uint8)(match_len - TDEFL_MIN_MATCH_LEN); + + match_dist -= 1; + d->m_pLZ_code_buf[1] = (mz_uint8)(match_dist & 0xFF); + d->m_pLZ_code_buf[2] = (mz_uint8)(match_dist >> 8); d->m_pLZ_code_buf += 3; + + *d->m_pLZ_flags = (mz_uint8)((*d->m_pLZ_flags >> 1) | 0x80); if (--d->m_num_flags_left == 0) { d->m_num_flags_left = 8; d->m_pLZ_flags = d->m_pLZ_code_buf++; } + + s0 = s_tdefl_small_dist_sym[match_dist & 511]; s1 = s_tdefl_large_dist_sym[(match_dist >> 8) & 127]; + d->m_huff_count[1][(match_dist < 512) ? s0 : s1]++; + + if (match_len >= TDEFL_MIN_MATCH_LEN) d->m_huff_count[0][s_tdefl_len_sym[match_len - TDEFL_MIN_MATCH_LEN]]++; +} + +static mz_bool tdefl_compress_normal(tdefl_compressor *d) +{ + const mz_uint8 *pSrc = d->m_pSrc; size_t src_buf_left = d->m_src_buf_left; + tdefl_flush flush = d->m_flush; + + while ((src_buf_left) || ((flush) && (d->m_lookahead_size))) + { + mz_uint len_to_move, cur_match_dist, cur_match_len, cur_pos; + // Update dictionary and hash chains. Keeps the lookahead size equal to TDEFL_MAX_MATCH_LEN. + if ((d->m_lookahead_size + d->m_dict_size) >= (TDEFL_MIN_MATCH_LEN - 1)) + { + mz_uint dst_pos = (d->m_lookahead_pos + d->m_lookahead_size) & TDEFL_LZ_DICT_SIZE_MASK, ins_pos = d->m_lookahead_pos + d->m_lookahead_size - 2; + mz_uint hash = (d->m_dict[ins_pos & TDEFL_LZ_DICT_SIZE_MASK] << TDEFL_LZ_HASH_SHIFT) ^ d->m_dict[(ins_pos + 1) & TDEFL_LZ_DICT_SIZE_MASK]; + mz_uint num_bytes_to_process = (mz_uint)MZ_MIN(src_buf_left, TDEFL_MAX_MATCH_LEN - d->m_lookahead_size); + const mz_uint8 *pSrc_end = pSrc + num_bytes_to_process; + src_buf_left -= num_bytes_to_process; + d->m_lookahead_size += num_bytes_to_process; + while (pSrc != pSrc_end) + { + mz_uint8 c = *pSrc++; d->m_dict[dst_pos] = c; if (dst_pos < (TDEFL_MAX_MATCH_LEN - 1)) d->m_dict[TDEFL_LZ_DICT_SIZE + dst_pos] = c; + hash = ((hash << TDEFL_LZ_HASH_SHIFT) ^ c) & (TDEFL_LZ_HASH_SIZE - 1); + d->m_next[ins_pos & TDEFL_LZ_DICT_SIZE_MASK] = d->m_hash[hash]; d->m_hash[hash] = (mz_uint16)(ins_pos); + dst_pos = (dst_pos + 1) & TDEFL_LZ_DICT_SIZE_MASK; ins_pos++; + } + } + else + { + while ((src_buf_left) && (d->m_lookahead_size < TDEFL_MAX_MATCH_LEN)) + { + mz_uint8 c = *pSrc++; + mz_uint dst_pos = (d->m_lookahead_pos + d->m_lookahead_size) & TDEFL_LZ_DICT_SIZE_MASK; + src_buf_left--; + d->m_dict[dst_pos] = c; + if (dst_pos < (TDEFL_MAX_MATCH_LEN - 1)) + d->m_dict[TDEFL_LZ_DICT_SIZE + dst_pos] = c; + if ((++d->m_lookahead_size + d->m_dict_size) >= TDEFL_MIN_MATCH_LEN) + { + mz_uint ins_pos = d->m_lookahead_pos + (d->m_lookahead_size - 1) - 2; + mz_uint hash = ((d->m_dict[ins_pos & TDEFL_LZ_DICT_SIZE_MASK] << (TDEFL_LZ_HASH_SHIFT * 2)) ^ (d->m_dict[(ins_pos + 1) & TDEFL_LZ_DICT_SIZE_MASK] << TDEFL_LZ_HASH_SHIFT) ^ c) & (TDEFL_LZ_HASH_SIZE - 1); + d->m_next[ins_pos & TDEFL_LZ_DICT_SIZE_MASK] = d->m_hash[hash]; d->m_hash[hash] = (mz_uint16)(ins_pos); + } + } + } + d->m_dict_size = MZ_MIN(TDEFL_LZ_DICT_SIZE - d->m_lookahead_size, d->m_dict_size); + if ((!flush) && (d->m_lookahead_size < TDEFL_MAX_MATCH_LEN)) + break; + + // Simple lazy/greedy parsing state machine. + len_to_move = 1; cur_match_dist = 0; cur_match_len = d->m_saved_match_len ? d->m_saved_match_len : (TDEFL_MIN_MATCH_LEN - 1); cur_pos = d->m_lookahead_pos & TDEFL_LZ_DICT_SIZE_MASK; + if (d->m_flags & (TDEFL_RLE_MATCHES | TDEFL_FORCE_ALL_RAW_BLOCKS)) + { + if ((d->m_dict_size) && (!(d->m_flags & TDEFL_FORCE_ALL_RAW_BLOCKS))) + { + mz_uint8 c = d->m_dict[(cur_pos - 1) & TDEFL_LZ_DICT_SIZE_MASK]; + cur_match_len = 0; while (cur_match_len < d->m_lookahead_size) { if (d->m_dict[cur_pos + cur_match_len] != c) break; cur_match_len++; } + if (cur_match_len < TDEFL_MIN_MATCH_LEN) cur_match_len = 0; else cur_match_dist = 1; + } + } + else + { + tdefl_find_match(d, d->m_lookahead_pos, d->m_dict_size, d->m_lookahead_size, &cur_match_dist, &cur_match_len); + } + if (((cur_match_len == TDEFL_MIN_MATCH_LEN) && (cur_match_dist >= 8U*1024U)) || (cur_pos == cur_match_dist) || ((d->m_flags & TDEFL_FILTER_MATCHES) && (cur_match_len <= 5))) + { + cur_match_dist = cur_match_len = 0; + } + if (d->m_saved_match_len) + { + if (cur_match_len > d->m_saved_match_len) + { + tdefl_record_literal(d, (mz_uint8)d->m_saved_lit); + if (cur_match_len >= 128) + { + tdefl_record_match(d, cur_match_len, cur_match_dist); + d->m_saved_match_len = 0; len_to_move = cur_match_len; + } + else + { + d->m_saved_lit = d->m_dict[cur_pos]; d->m_saved_match_dist = cur_match_dist; d->m_saved_match_len = cur_match_len; + } + } + else + { + tdefl_record_match(d, d->m_saved_match_len, d->m_saved_match_dist); + len_to_move = d->m_saved_match_len - 1; d->m_saved_match_len = 0; + } + } + else if (!cur_match_dist) + tdefl_record_literal(d, d->m_dict[MZ_MIN(cur_pos, sizeof(d->m_dict) - 1)]); + else if ((d->m_greedy_parsing) || (d->m_flags & TDEFL_RLE_MATCHES) || (cur_match_len >= 128)) + { + tdefl_record_match(d, cur_match_len, cur_match_dist); + len_to_move = cur_match_len; + } + else + { + d->m_saved_lit = d->m_dict[MZ_MIN(cur_pos, sizeof(d->m_dict) - 1)]; d->m_saved_match_dist = cur_match_dist; d->m_saved_match_len = cur_match_len; + } + // Move the lookahead forward by len_to_move bytes. + d->m_lookahead_pos += len_to_move; + MZ_ASSERT(d->m_lookahead_size >= len_to_move); + d->m_lookahead_size -= len_to_move; + d->m_dict_size = MZ_MIN(d->m_dict_size + len_to_move, TDEFL_LZ_DICT_SIZE); + // Check if it's time to flush the current LZ codes to the internal output buffer. + if ( (d->m_pLZ_code_buf > &d->m_lz_code_buf[TDEFL_LZ_CODE_BUF_SIZE - 8]) || + ( (d->m_total_lz_bytes > 31*1024) && (((((mz_uint)(d->m_pLZ_code_buf - d->m_lz_code_buf) * 115) >> 7) >= d->m_total_lz_bytes) || (d->m_flags & TDEFL_FORCE_ALL_RAW_BLOCKS))) ) + { + int n; + d->m_pSrc = pSrc; d->m_src_buf_left = src_buf_left; + if ((n = tdefl_flush_block(d, 0)) != 0) + return (n < 0) ? MZ_FALSE : MZ_TRUE; + } + } + + d->m_pSrc = pSrc; d->m_src_buf_left = src_buf_left; + return MZ_TRUE; +} + +static tdefl_status tdefl_flush_output_buffer(tdefl_compressor *d) +{ + if (d->m_pIn_buf_size) + { + *d->m_pIn_buf_size = d->m_pSrc - (const mz_uint8 *)d->m_pIn_buf; + } + + if (d->m_pOut_buf_size) + { + size_t n = MZ_MIN(*d->m_pOut_buf_size - d->m_out_buf_ofs, d->m_output_flush_remaining); + memcpy((mz_uint8 *)d->m_pOut_buf + d->m_out_buf_ofs, d->m_output_buf + d->m_output_flush_ofs, n); + d->m_output_flush_ofs += (mz_uint)n; + d->m_output_flush_remaining -= (mz_uint)n; + d->m_out_buf_ofs += n; + + *d->m_pOut_buf_size = d->m_out_buf_ofs; + } + + return (d->m_finished && !d->m_output_flush_remaining) ? TDEFL_STATUS_DONE : TDEFL_STATUS_OKAY; +} + +tdefl_status tdefl_compress(tdefl_compressor *d, const void *pIn_buf, size_t *pIn_buf_size, void *pOut_buf, size_t *pOut_buf_size, tdefl_flush flush) +{ + if (!d) + { + if (pIn_buf_size) *pIn_buf_size = 0; + if (pOut_buf_size) *pOut_buf_size = 0; + return TDEFL_STATUS_BAD_PARAM; + } + + d->m_pIn_buf = pIn_buf; d->m_pIn_buf_size = pIn_buf_size; + d->m_pOut_buf = pOut_buf; d->m_pOut_buf_size = pOut_buf_size; + d->m_pSrc = (const mz_uint8 *)(pIn_buf); d->m_src_buf_left = pIn_buf_size ? *pIn_buf_size : 0; + d->m_out_buf_ofs = 0; + d->m_flush = flush; + + if ( ((d->m_pPut_buf_func != NULL) == ((pOut_buf != NULL) || (pOut_buf_size != NULL))) || (d->m_prev_return_status != TDEFL_STATUS_OKAY) || + (d->m_wants_to_finish && (flush != TDEFL_FINISH)) || (pIn_buf_size && *pIn_buf_size && !pIn_buf) || (pOut_buf_size && *pOut_buf_size && !pOut_buf) ) + { + if (pIn_buf_size) *pIn_buf_size = 0; + if (pOut_buf_size) *pOut_buf_size = 0; + return (d->m_prev_return_status = TDEFL_STATUS_BAD_PARAM); + } + d->m_wants_to_finish |= (flush == TDEFL_FINISH); + + if ((d->m_output_flush_remaining) || (d->m_finished)) + return (d->m_prev_return_status = tdefl_flush_output_buffer(d)); + +#if MINIZ_USE_UNALIGNED_LOADS_AND_STORES && MINIZ_LITTLE_ENDIAN + if (((d->m_flags & TDEFL_MAX_PROBES_MASK) == 1) && + ((d->m_flags & TDEFL_GREEDY_PARSING_FLAG) != 0) && + ((d->m_flags & (TDEFL_FILTER_MATCHES | TDEFL_FORCE_ALL_RAW_BLOCKS | TDEFL_RLE_MATCHES)) == 0)) + { + if (!tdefl_compress_fast(d)) + return d->m_prev_return_status; + } + else +#endif // #if MINIZ_USE_UNALIGNED_LOADS_AND_STORES && MINIZ_LITTLE_ENDIAN + { + if (!tdefl_compress_normal(d)) + return d->m_prev_return_status; + } + + if ((d->m_flags & (TDEFL_WRITE_ZLIB_HEADER | TDEFL_COMPUTE_ADLER32)) && (pIn_buf)) + d->m_adler32 = (mz_uint32)mz_adler32(d->m_adler32, (const mz_uint8 *)pIn_buf, d->m_pSrc - (const mz_uint8 *)pIn_buf); + + if ((flush) && (!d->m_lookahead_size) && (!d->m_src_buf_left) && (!d->m_output_flush_remaining)) + { + if (tdefl_flush_block(d, flush) < 0) + return d->m_prev_return_status; + d->m_finished = (flush == TDEFL_FINISH); + if (flush == TDEFL_FULL_FLUSH) { MZ_CLEAR_OBJ(d->m_hash); MZ_CLEAR_OBJ(d->m_next); d->m_dict_size = 0; } + } + + return (d->m_prev_return_status = tdefl_flush_output_buffer(d)); +} + +tdefl_status tdefl_compress_buffer(tdefl_compressor *d, const void *pIn_buf, size_t in_buf_size, tdefl_flush flush) +{ + MZ_ASSERT(d->m_pPut_buf_func); return tdefl_compress(d, pIn_buf, &in_buf_size, NULL, NULL, flush); +} + +tdefl_status tdefl_init(tdefl_compressor *d, tdefl_put_buf_func_ptr pPut_buf_func, void *pPut_buf_user, int flags) +{ + d->m_pPut_buf_func = pPut_buf_func; d->m_pPut_buf_user = pPut_buf_user; + d->m_flags = (mz_uint)(flags); d->m_max_probes[0] = 1 + ((flags & 0xFFF) + 2) / 3; d->m_greedy_parsing = (flags & TDEFL_GREEDY_PARSING_FLAG) != 0; + d->m_max_probes[1] = 1 + (((flags & 0xFFF) >> 2) + 2) / 3; + if (!(flags & TDEFL_NONDETERMINISTIC_PARSING_FLAG)) MZ_CLEAR_OBJ(d->m_hash); + d->m_lookahead_pos = d->m_lookahead_size = d->m_dict_size = d->m_total_lz_bytes = d->m_lz_code_buf_dict_pos = d->m_bits_in = 0; + d->m_output_flush_ofs = d->m_output_flush_remaining = d->m_finished = d->m_block_index = d->m_bit_buffer = d->m_wants_to_finish = 0; + d->m_pLZ_code_buf = d->m_lz_code_buf + 1; d->m_pLZ_flags = d->m_lz_code_buf; d->m_num_flags_left = 8; + d->m_pOutput_buf = d->m_output_buf; d->m_pOutput_buf_end = d->m_output_buf; d->m_prev_return_status = TDEFL_STATUS_OKAY; + d->m_saved_match_dist = d->m_saved_match_len = d->m_saved_lit = 0; d->m_adler32 = 1; + d->m_pIn_buf = NULL; d->m_pOut_buf = NULL; + d->m_pIn_buf_size = NULL; d->m_pOut_buf_size = NULL; + d->m_flush = TDEFL_NO_FLUSH; d->m_pSrc = NULL; d->m_src_buf_left = 0; d->m_out_buf_ofs = 0; + memset(&d->m_huff_count[0][0], 0, sizeof(d->m_huff_count[0][0]) * TDEFL_MAX_HUFF_SYMBOLS_0); + memset(&d->m_huff_count[1][0], 0, sizeof(d->m_huff_count[1][0]) * TDEFL_MAX_HUFF_SYMBOLS_1); + return TDEFL_STATUS_OKAY; +} + +tdefl_status tdefl_get_prev_return_status(tdefl_compressor *d) +{ + return d->m_prev_return_status; +} + +mz_uint32 tdefl_get_adler32(tdefl_compressor *d) +{ + return d->m_adler32; +} + +mz_bool tdefl_compress_mem_to_output(const void *pBuf, size_t buf_len, tdefl_put_buf_func_ptr pPut_buf_func, void *pPut_buf_user, int flags) +{ + tdefl_compressor *pComp; mz_bool succeeded; if (((buf_len) && (!pBuf)) || (!pPut_buf_func)) return MZ_FALSE; + pComp = (tdefl_compressor*)MZ_MALLOC(sizeof(tdefl_compressor)); if (!pComp) return MZ_FALSE; + succeeded = (tdefl_init(pComp, pPut_buf_func, pPut_buf_user, flags) == TDEFL_STATUS_OKAY); + succeeded = succeeded && (tdefl_compress_buffer(pComp, pBuf, buf_len, TDEFL_FINISH) == TDEFL_STATUS_DONE); + MZ_FREE(pComp); return succeeded; +} + +typedef struct +{ + size_t m_size, m_capacity; + mz_uint8 *m_pBuf; + mz_bool m_expandable; +} tdefl_output_buffer; + +static mz_bool tdefl_output_buffer_putter(const void *pBuf, int len, void *pUser) +{ + tdefl_output_buffer *p = (tdefl_output_buffer *)pUser; + size_t new_size = p->m_size + len; + if (new_size > p->m_capacity) + { + size_t new_capacity = p->m_capacity; mz_uint8 *pNew_buf; if (!p->m_expandable) return MZ_FALSE; + do { new_capacity = MZ_MAX(128U, new_capacity << 1U); } while (new_size > new_capacity); + pNew_buf = (mz_uint8*)MZ_REALLOC(p->m_pBuf, new_capacity); if (!pNew_buf) return MZ_FALSE; + p->m_pBuf = pNew_buf; p->m_capacity = new_capacity; + } + memcpy((mz_uint8*)p->m_pBuf + p->m_size, pBuf, len); p->m_size = new_size; + return MZ_TRUE; +} + +void *tdefl_compress_mem_to_heap(const void *pSrc_buf, size_t src_buf_len, size_t *pOut_len, int flags) +{ + tdefl_output_buffer out_buf; MZ_CLEAR_OBJ(out_buf); + if (!pOut_len) return MZ_FALSE; else *pOut_len = 0; + out_buf.m_expandable = MZ_TRUE; + if (!tdefl_compress_mem_to_output(pSrc_buf, src_buf_len, tdefl_output_buffer_putter, &out_buf, flags)) return NULL; + *pOut_len = out_buf.m_size; return out_buf.m_pBuf; +} + +size_t tdefl_compress_mem_to_mem(void *pOut_buf, size_t out_buf_len, const void *pSrc_buf, size_t src_buf_len, int flags) +{ + tdefl_output_buffer out_buf; MZ_CLEAR_OBJ(out_buf); + if (!pOut_buf) return 0; + out_buf.m_pBuf = (mz_uint8*)pOut_buf; out_buf.m_capacity = out_buf_len; + if (!tdefl_compress_mem_to_output(pSrc_buf, src_buf_len, tdefl_output_buffer_putter, &out_buf, flags)) return 0; + return out_buf.m_size; +} + +#ifndef MINIZ_NO_ZLIB_APIS +static const mz_uint s_tdefl_num_probes[11] = { 0, 1, 6, 32, 16, 32, 128, 256, 512, 768, 1500 }; + +// level may actually range from [0,10] (10 is a "hidden" max level, where we want a bit more compression and it's fine if throughput to fall off a cliff on some files). +mz_uint tdefl_create_comp_flags_from_zip_params(int level, int window_bits, int strategy) +{ + mz_uint comp_flags = s_tdefl_num_probes[(level >= 0) ? MZ_MIN(10, level) : MZ_DEFAULT_LEVEL] | ((level <= 3) ? TDEFL_GREEDY_PARSING_FLAG : 0); + if (window_bits > 0) comp_flags |= TDEFL_WRITE_ZLIB_HEADER; + + if (!level) comp_flags |= TDEFL_FORCE_ALL_RAW_BLOCKS; + else if (strategy == MZ_FILTERED) comp_flags |= TDEFL_FILTER_MATCHES; + else if (strategy == MZ_HUFFMAN_ONLY) comp_flags &= ~TDEFL_MAX_PROBES_MASK; + else if (strategy == MZ_FIXED) comp_flags |= TDEFL_FORCE_ALL_STATIC_BLOCKS; + else if (strategy == MZ_RLE) comp_flags |= TDEFL_RLE_MATCHES; + + return comp_flags; +} +#endif //MINIZ_NO_ZLIB_APIS + +#ifdef _MSC_VER +#pragma warning (push) +#pragma warning (disable:4204) // nonstandard extension used : non-constant aggregate initializer (also supported by GNU C and C99, so no big deal) +#endif + +// Simple PNG writer function by Alex Evans, 2011. Released into the public domain: https://gist.github.com/908299, more context at +// http://altdevblogaday.org/2011/04/06/a-smaller-jpg-encoder/. +// This is actually a modification of Alex's original code so PNG files generated by this function pass pngcheck. +void *tdefl_write_image_to_png_file_in_memory_ex(const void *pImage, int w, int h, int num_chans, size_t *pLen_out, mz_uint level, mz_bool flip) +{ + // Using a local copy of this array here in case MINIZ_NO_ZLIB_APIS was defined. + static const mz_uint s_tdefl_png_num_probes[11] = { 0, 1, 6, 32, 16, 32, 128, 256, 512, 768, 1500 }; + tdefl_compressor *pComp = (tdefl_compressor *)MZ_MALLOC(sizeof(tdefl_compressor)); tdefl_output_buffer out_buf; int i, bpl = w * num_chans, y, z; mz_uint32 c; *pLen_out = 0; + if (!pComp) return NULL; + MZ_CLEAR_OBJ(out_buf); out_buf.m_expandable = MZ_TRUE; out_buf.m_capacity = 57+MZ_MAX(64, (1+bpl)*h); if (NULL == (out_buf.m_pBuf = (mz_uint8*)MZ_MALLOC(out_buf.m_capacity))) { MZ_FREE(pComp); return NULL; } + // write dummy header + for (z = 41; z; --z) tdefl_output_buffer_putter(&z, 1, &out_buf); + // compress image data + tdefl_init(pComp, tdefl_output_buffer_putter, &out_buf, s_tdefl_png_num_probes[MZ_MIN(10, level)] | TDEFL_WRITE_ZLIB_HEADER); + for (y = 0; y < h; ++y) { tdefl_compress_buffer(pComp, &z, 1, TDEFL_NO_FLUSH); tdefl_compress_buffer(pComp, (mz_uint8*)pImage + (flip ? (h - 1 - y) : y) * bpl, bpl, TDEFL_NO_FLUSH); } + if (tdefl_compress_buffer(pComp, NULL, 0, TDEFL_FINISH) != TDEFL_STATUS_DONE) { MZ_FREE(pComp); MZ_FREE(out_buf.m_pBuf); return NULL; } + // write real header + *pLen_out = out_buf.m_size-41; + { + static const mz_uint8 chans[] = {0x00, 0x00, 0x04, 0x02, 0x06}; + mz_uint8 pnghdr[41]={0x89,0x50,0x4e,0x47,0x0d,0x0a,0x1a,0x0a,0x00,0x00,0x00,0x0d,0x49,0x48,0x44,0x52, + 0,0,(mz_uint8)(w>>8),(mz_uint8)w,0,0,(mz_uint8)(h>>8),(mz_uint8)h,8,chans[num_chans],0,0,0,0,0,0,0, + (mz_uint8)(*pLen_out>>24),(mz_uint8)(*pLen_out>>16),(mz_uint8)(*pLen_out>>8),(mz_uint8)*pLen_out,0x49,0x44,0x41,0x54}; + c=(mz_uint32)mz_crc32(MZ_CRC32_INIT,pnghdr+12,17); for (i=0; i<4; ++i, c<<=8) ((mz_uint8*)(pnghdr+29))[i]=(mz_uint8)(c>>24); + memcpy(out_buf.m_pBuf, pnghdr, 41); + } + // write footer (IDAT CRC-32, followed by IEND chunk) + if (!tdefl_output_buffer_putter("\0\0\0\0\0\0\0\0\x49\x45\x4e\x44\xae\x42\x60\x82", 16, &out_buf)) { *pLen_out = 0; MZ_FREE(pComp); MZ_FREE(out_buf.m_pBuf); return NULL; } + c = (mz_uint32)mz_crc32(MZ_CRC32_INIT,out_buf.m_pBuf+41-4, *pLen_out+4); for (i=0; i<4; ++i, c<<=8) (out_buf.m_pBuf+out_buf.m_size-16)[i] = (mz_uint8)(c >> 24); + // compute final size of file, grab compressed data buffer and return + *pLen_out += 57; MZ_FREE(pComp); return out_buf.m_pBuf; +} +void *tdefl_write_image_to_png_file_in_memory(const void *pImage, int w, int h, int num_chans, size_t *pLen_out) +{ + // Level 6 corresponds to TDEFL_DEFAULT_MAX_PROBES or MZ_DEFAULT_LEVEL (but we can't depend on MZ_DEFAULT_LEVEL being available in case the zlib API's where #defined out) + return tdefl_write_image_to_png_file_in_memory_ex(pImage, w, h, num_chans, pLen_out, 6, MZ_FALSE); +} + +#ifdef _MSC_VER +#pragma warning (pop) +#endif + +// ------------------- .ZIP archive reading + +#ifndef MINIZ_NO_ARCHIVE_APIS + +#ifdef MINIZ_NO_STDIO + #define MZ_FILE void * +#else + #include + #include + + #if defined(_MSC_VER) || defined(__MINGW64__) + static FILE *mz_fopen(const char *pFilename, const char *pMode) + { + FILE* pFile = NULL; + fopen_s(&pFile, pFilename, pMode); + return pFile; + } + static FILE *mz_freopen(const char *pPath, const char *pMode, FILE *pStream) + { + FILE* pFile = NULL; + if (freopen_s(&pFile, pPath, pMode, pStream)) + return NULL; + return pFile; + } + #ifndef MINIZ_NO_TIME + #include + #endif + #define MZ_FILE FILE + #define MZ_FOPEN mz_fopen + #define MZ_FCLOSE fclose + #define MZ_FREAD fread + #define MZ_FWRITE fwrite + #define MZ_FTELL64 _ftelli64 + #define MZ_FSEEK64 _fseeki64 + #define MZ_FILE_STAT_STRUCT _stat + #define MZ_FILE_STAT _stat + #define MZ_FFLUSH fflush + #define MZ_FREOPEN mz_freopen + #define MZ_DELETE_FILE remove + #elif defined(__MINGW32__) + #ifndef MINIZ_NO_TIME + #include + #endif + #define MZ_FILE FILE + #define MZ_FOPEN(f, m) fopen(f, m) + #define MZ_FCLOSE fclose + #define MZ_FREAD fread + #define MZ_FWRITE fwrite + #define MZ_FTELL64 ftello64 + #define MZ_FSEEK64 fseeko64 + #define MZ_FILE_STAT_STRUCT _stat + #define MZ_FILE_STAT _stat + #define MZ_FFLUSH fflush + #define MZ_FREOPEN(f, m, s) freopen(f, m, s) + #define MZ_DELETE_FILE remove + #elif defined(__TINYC__) + #ifndef MINIZ_NO_TIME + #include + #endif + #define MZ_FILE FILE + #define MZ_FOPEN(f, m) fopen(f, m) + #define MZ_FCLOSE fclose + #define MZ_FREAD fread + #define MZ_FWRITE fwrite + #define MZ_FTELL64 ftell + #define MZ_FSEEK64 fseek + #define MZ_FILE_STAT_STRUCT stat + #define MZ_FILE_STAT stat + #define MZ_FFLUSH fflush + #define MZ_FREOPEN(f, m, s) freopen(f, m, s) + #define MZ_DELETE_FILE remove + #elif defined(__GNUC__) && _LARGEFILE64_SOURCE + #ifndef MINIZ_NO_TIME + #include + #endif + #define MZ_FILE FILE + #define MZ_FOPEN(f, m) fopen64(f, m) + #define MZ_FCLOSE fclose + #define MZ_FREAD fread + #define MZ_FWRITE fwrite + #define MZ_FTELL64 ftello64 + #define MZ_FSEEK64 fseeko64 + #define MZ_FILE_STAT_STRUCT stat64 + #define MZ_FILE_STAT stat64 + #define MZ_FFLUSH fflush + #define MZ_FREOPEN(p, m, s) freopen64(p, m, s) + #define MZ_DELETE_FILE remove + #else + #ifndef MINIZ_NO_TIME + #include + #endif + #define MZ_FILE FILE + #define MZ_FOPEN(f, m) fopen(f, m) + #define MZ_FCLOSE fclose + #define MZ_FREAD fread + #define MZ_FWRITE fwrite + #define MZ_FTELL64 ftello + #define MZ_FSEEK64 fseeko + #define MZ_FILE_STAT_STRUCT stat + #define MZ_FILE_STAT stat + #define MZ_FFLUSH fflush + #define MZ_FREOPEN(f, m, s) freopen(f, m, s) + #define MZ_DELETE_FILE remove + #endif // #ifdef _MSC_VER +#endif // #ifdef MINIZ_NO_STDIO + +#define MZ_TOLOWER(c) ((((c) >= 'A') && ((c) <= 'Z')) ? ((c) - 'A' + 'a') : (c)) + +// Various ZIP archive enums. To completely avoid cross platform compiler alignment and platform endian issues, miniz.c doesn't use structs for any of this stuff. +enum +{ + // ZIP archive identifiers and record sizes + MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIG = 0x06054b50, MZ_ZIP_CENTRAL_DIR_HEADER_SIG = 0x02014b50, MZ_ZIP_LOCAL_DIR_HEADER_SIG = 0x04034b50, + MZ_ZIP_LOCAL_DIR_HEADER_SIZE = 30, MZ_ZIP_CENTRAL_DIR_HEADER_SIZE = 46, MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIZE = 22, + // Central directory header record offsets + MZ_ZIP_CDH_SIG_OFS = 0, MZ_ZIP_CDH_VERSION_MADE_BY_OFS = 4, MZ_ZIP_CDH_VERSION_NEEDED_OFS = 6, MZ_ZIP_CDH_BIT_FLAG_OFS = 8, + MZ_ZIP_CDH_METHOD_OFS = 10, MZ_ZIP_CDH_FILE_TIME_OFS = 12, MZ_ZIP_CDH_FILE_DATE_OFS = 14, MZ_ZIP_CDH_CRC32_OFS = 16, + MZ_ZIP_CDH_COMPRESSED_SIZE_OFS = 20, MZ_ZIP_CDH_DECOMPRESSED_SIZE_OFS = 24, MZ_ZIP_CDH_FILENAME_LEN_OFS = 28, MZ_ZIP_CDH_EXTRA_LEN_OFS = 30, + MZ_ZIP_CDH_COMMENT_LEN_OFS = 32, MZ_ZIP_CDH_DISK_START_OFS = 34, MZ_ZIP_CDH_INTERNAL_ATTR_OFS = 36, MZ_ZIP_CDH_EXTERNAL_ATTR_OFS = 38, MZ_ZIP_CDH_LOCAL_HEADER_OFS = 42, + // Local directory header offsets + MZ_ZIP_LDH_SIG_OFS = 0, MZ_ZIP_LDH_VERSION_NEEDED_OFS = 4, MZ_ZIP_LDH_BIT_FLAG_OFS = 6, MZ_ZIP_LDH_METHOD_OFS = 8, MZ_ZIP_LDH_FILE_TIME_OFS = 10, + MZ_ZIP_LDH_FILE_DATE_OFS = 12, MZ_ZIP_LDH_CRC32_OFS = 14, MZ_ZIP_LDH_COMPRESSED_SIZE_OFS = 18, MZ_ZIP_LDH_DECOMPRESSED_SIZE_OFS = 22, + MZ_ZIP_LDH_FILENAME_LEN_OFS = 26, MZ_ZIP_LDH_EXTRA_LEN_OFS = 28, + // End of central directory offsets + MZ_ZIP_ECDH_SIG_OFS = 0, MZ_ZIP_ECDH_NUM_THIS_DISK_OFS = 4, MZ_ZIP_ECDH_NUM_DISK_CDIR_OFS = 6, MZ_ZIP_ECDH_CDIR_NUM_ENTRIES_ON_DISK_OFS = 8, + MZ_ZIP_ECDH_CDIR_TOTAL_ENTRIES_OFS = 10, MZ_ZIP_ECDH_CDIR_SIZE_OFS = 12, MZ_ZIP_ECDH_CDIR_OFS_OFS = 16, MZ_ZIP_ECDH_COMMENT_SIZE_OFS = 20, +}; + +typedef struct +{ + void *m_p; + size_t m_size, m_capacity; + mz_uint m_element_size; +} mz_zip_array; + +struct mz_zip_internal_state_tag +{ + mz_zip_array m_central_dir; + mz_zip_array m_central_dir_offsets; + mz_zip_array m_sorted_central_dir_offsets; + MZ_FILE *m_pFile; + void *m_pMem; + size_t m_mem_size; + size_t m_mem_capacity; +}; + +#define MZ_ZIP_ARRAY_SET_ELEMENT_SIZE(array_ptr, element_size) (array_ptr)->m_element_size = element_size +#define MZ_ZIP_ARRAY_ELEMENT(array_ptr, element_type, index) ((element_type *)((array_ptr)->m_p))[index] + +static MZ_FORCEINLINE void mz_zip_array_clear(mz_zip_archive *pZip, mz_zip_array *pArray) +{ + pZip->m_pFree(pZip->m_pAlloc_opaque, pArray->m_p); + memset(pArray, 0, sizeof(mz_zip_array)); +} + +static mz_bool mz_zip_array_ensure_capacity(mz_zip_archive *pZip, mz_zip_array *pArray, size_t min_new_capacity, mz_uint growing) +{ + void *pNew_p; size_t new_capacity = min_new_capacity; MZ_ASSERT(pArray->m_element_size); if (pArray->m_capacity >= min_new_capacity) return MZ_TRUE; + if (growing) { new_capacity = MZ_MAX(1, pArray->m_capacity); while (new_capacity < min_new_capacity) new_capacity *= 2; } + if (NULL == (pNew_p = pZip->m_pRealloc(pZip->m_pAlloc_opaque, pArray->m_p, pArray->m_element_size, new_capacity))) return MZ_FALSE; + pArray->m_p = pNew_p; pArray->m_capacity = new_capacity; + return MZ_TRUE; +} + +static MZ_FORCEINLINE mz_bool mz_zip_array_reserve(mz_zip_archive *pZip, mz_zip_array *pArray, size_t new_capacity, mz_uint growing) +{ + if (new_capacity > pArray->m_capacity) { if (!mz_zip_array_ensure_capacity(pZip, pArray, new_capacity, growing)) return MZ_FALSE; } + return MZ_TRUE; +} + +static MZ_FORCEINLINE mz_bool mz_zip_array_resize(mz_zip_archive *pZip, mz_zip_array *pArray, size_t new_size, mz_uint growing) +{ + if (new_size > pArray->m_capacity) { if (!mz_zip_array_ensure_capacity(pZip, pArray, new_size, growing)) return MZ_FALSE; } + pArray->m_size = new_size; + return MZ_TRUE; +} + +static MZ_FORCEINLINE mz_bool mz_zip_array_ensure_room(mz_zip_archive *pZip, mz_zip_array *pArray, size_t n) +{ + return mz_zip_array_reserve(pZip, pArray, pArray->m_size + n, MZ_TRUE); +} + +static MZ_FORCEINLINE mz_bool mz_zip_array_push_back(mz_zip_archive *pZip, mz_zip_array *pArray, const void *pElements, size_t n) +{ + size_t orig_size = pArray->m_size; if (!mz_zip_array_resize(pZip, pArray, orig_size + n, MZ_TRUE)) return MZ_FALSE; + memcpy((mz_uint8*)pArray->m_p + orig_size * pArray->m_element_size, pElements, n * pArray->m_element_size); + return MZ_TRUE; +} + +#ifndef MINIZ_NO_TIME +static time_t mz_zip_dos_to_time_t(int dos_time, int dos_date) +{ + struct tm tm; + memset(&tm, 0, sizeof(tm)); tm.tm_isdst = -1; + tm.tm_year = ((dos_date >> 9) & 127) + 1980 - 1900; tm.tm_mon = ((dos_date >> 5) & 15) - 1; tm.tm_mday = dos_date & 31; + tm.tm_hour = (dos_time >> 11) & 31; tm.tm_min = (dos_time >> 5) & 63; tm.tm_sec = (dos_time << 1) & 62; + return mktime(&tm); +} + +static void mz_zip_time_to_dos_time(time_t time, mz_uint16 *pDOS_time, mz_uint16 *pDOS_date) +{ +#ifdef _MSC_VER + struct tm tm_struct; + struct tm *tm = &tm_struct; + errno_t err = localtime_s(tm, &time); + if (err) + { + *pDOS_date = 0; *pDOS_time = 0; + return; + } +#else + struct tm *tm = localtime(&time); +#endif + *pDOS_time = (mz_uint16)(((tm->tm_hour) << 11) + ((tm->tm_min) << 5) + ((tm->tm_sec) >> 1)); + *pDOS_date = (mz_uint16)(((tm->tm_year + 1900 - 1980) << 9) + ((tm->tm_mon + 1) << 5) + tm->tm_mday); +} +#endif + +#ifndef MINIZ_NO_STDIO +static mz_bool mz_zip_get_file_modified_time(const char *pFilename, mz_uint16 *pDOS_time, mz_uint16 *pDOS_date) +{ +#ifdef MINIZ_NO_TIME + (void)pFilename; *pDOS_date = *pDOS_time = 0; +#else + struct MZ_FILE_STAT_STRUCT file_stat; + // On Linux with x86 glibc, this call will fail on large files (>= 0x80000000 bytes) unless you compiled with _LARGEFILE64_SOURCE. Argh. + if (MZ_FILE_STAT(pFilename, &file_stat) != 0) + return MZ_FALSE; + mz_zip_time_to_dos_time(file_stat.st_mtime, pDOS_time, pDOS_date); +#endif // #ifdef MINIZ_NO_TIME + return MZ_TRUE; +} + +#ifndef MINIZ_NO_TIME +static mz_bool mz_zip_set_file_times(const char *pFilename, time_t access_time, time_t modified_time) +{ + struct utimbuf t; t.actime = access_time; t.modtime = modified_time; + return !utime(pFilename, &t); +} +#endif // #ifndef MINIZ_NO_TIME +#endif // #ifndef MINIZ_NO_STDIO + +static mz_bool mz_zip_reader_init_internal(mz_zip_archive *pZip, mz_uint32 flags) +{ + (void)flags; + if ((!pZip) || (pZip->m_pState) || (pZip->m_zip_mode != MZ_ZIP_MODE_INVALID)) + return MZ_FALSE; + + if (!pZip->m_pAlloc) pZip->m_pAlloc = def_alloc_func; + if (!pZip->m_pFree) pZip->m_pFree = def_free_func; + if (!pZip->m_pRealloc) pZip->m_pRealloc = def_realloc_func; + + pZip->m_zip_mode = MZ_ZIP_MODE_READING; + pZip->m_archive_size = 0; + pZip->m_central_directory_file_ofs = 0; + pZip->m_total_files = 0; + + if (NULL == (pZip->m_pState = (mz_zip_internal_state *)pZip->m_pAlloc(pZip->m_pAlloc_opaque, 1, sizeof(mz_zip_internal_state)))) + return MZ_FALSE; + memset(pZip->m_pState, 0, sizeof(mz_zip_internal_state)); + MZ_ZIP_ARRAY_SET_ELEMENT_SIZE(&pZip->m_pState->m_central_dir, sizeof(mz_uint8)); + MZ_ZIP_ARRAY_SET_ELEMENT_SIZE(&pZip->m_pState->m_central_dir_offsets, sizeof(mz_uint32)); + MZ_ZIP_ARRAY_SET_ELEMENT_SIZE(&pZip->m_pState->m_sorted_central_dir_offsets, sizeof(mz_uint32)); + return MZ_TRUE; +} + +static MZ_FORCEINLINE mz_bool mz_zip_reader_filename_less(const mz_zip_array *pCentral_dir_array, const mz_zip_array *pCentral_dir_offsets, mz_uint l_index, mz_uint r_index) +{ + const mz_uint8 *pL = &MZ_ZIP_ARRAY_ELEMENT(pCentral_dir_array, mz_uint8, MZ_ZIP_ARRAY_ELEMENT(pCentral_dir_offsets, mz_uint32, l_index)), *pE; + const mz_uint8 *pR = &MZ_ZIP_ARRAY_ELEMENT(pCentral_dir_array, mz_uint8, MZ_ZIP_ARRAY_ELEMENT(pCentral_dir_offsets, mz_uint32, r_index)); + mz_uint l_len = MZ_READ_LE16(pL + MZ_ZIP_CDH_FILENAME_LEN_OFS), r_len = MZ_READ_LE16(pR + MZ_ZIP_CDH_FILENAME_LEN_OFS); + mz_uint8 l = 0, r = 0; + pL += MZ_ZIP_CENTRAL_DIR_HEADER_SIZE; pR += MZ_ZIP_CENTRAL_DIR_HEADER_SIZE; + pE = pL + MZ_MIN(l_len, r_len); + while (pL < pE) + { + if ((l = MZ_TOLOWER(*pL)) != (r = MZ_TOLOWER(*pR))) + break; + pL++; pR++; + } + return (pL == pE) ? (l_len < r_len) : (l < r); +} + +#define MZ_SWAP_UINT32(a, b) do { mz_uint32 t = a; a = b; b = t; } MZ_MACRO_END + +// Heap sort of lowercased filenames, used to help accelerate plain central directory searches by mz_zip_reader_locate_file(). (Could also use qsort(), but it could allocate memory.) +static void mz_zip_reader_sort_central_dir_offsets_by_filename(mz_zip_archive *pZip) +{ + mz_zip_internal_state *pState = pZip->m_pState; + const mz_zip_array *pCentral_dir_offsets = &pState->m_central_dir_offsets; + const mz_zip_array *pCentral_dir = &pState->m_central_dir; + mz_uint32 *pIndices = &MZ_ZIP_ARRAY_ELEMENT(&pState->m_sorted_central_dir_offsets, mz_uint32, 0); + const int size = pZip->m_total_files; + int start = (size - 2) >> 1, end; + while (start >= 0) + { + int child, root = start; + for ( ; ; ) + { + if ((child = (root << 1) + 1) >= size) + break; + child += (((child + 1) < size) && (mz_zip_reader_filename_less(pCentral_dir, pCentral_dir_offsets, pIndices[child], pIndices[child + 1]))); + if (!mz_zip_reader_filename_less(pCentral_dir, pCentral_dir_offsets, pIndices[root], pIndices[child])) + break; + MZ_SWAP_UINT32(pIndices[root], pIndices[child]); root = child; + } + start--; + } + + end = size - 1; + while (end > 0) + { + int child, root = 0; + MZ_SWAP_UINT32(pIndices[end], pIndices[0]); + for ( ; ; ) + { + if ((child = (root << 1) + 1) >= end) + break; + child += (((child + 1) < end) && mz_zip_reader_filename_less(pCentral_dir, pCentral_dir_offsets, pIndices[child], pIndices[child + 1])); + if (!mz_zip_reader_filename_less(pCentral_dir, pCentral_dir_offsets, pIndices[root], pIndices[child])) + break; + MZ_SWAP_UINT32(pIndices[root], pIndices[child]); root = child; + } + end--; + } +} + +static mz_bool mz_zip_reader_read_central_dir(mz_zip_archive *pZip, mz_uint32 flags) +{ + mz_uint cdir_size, num_this_disk, cdir_disk_index; + mz_uint64 cdir_ofs; + mz_int64 cur_file_ofs; + const mz_uint8 *p; + mz_uint32 buf_u32[4096 / sizeof(mz_uint32)]; mz_uint8 *pBuf = (mz_uint8 *)buf_u32; + mz_bool sort_central_dir = ((flags & MZ_ZIP_FLAG_DO_NOT_SORT_CENTRAL_DIRECTORY) == 0); + // Basic sanity checks - reject files which are too small, and check the first 4 bytes of the file to make sure a local header is there. + if (pZip->m_archive_size < MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIZE) + return MZ_FALSE; + // Find the end of central directory record by scanning the file from the end towards the beginning. + cur_file_ofs = MZ_MAX((mz_int64)pZip->m_archive_size - (mz_int64)sizeof(buf_u32), 0); + for ( ; ; ) + { + int i, n = (int)MZ_MIN(sizeof(buf_u32), pZip->m_archive_size - cur_file_ofs); + if (pZip->m_pRead(pZip->m_pIO_opaque, cur_file_ofs, pBuf, n) != (mz_uint)n) + return MZ_FALSE; + for (i = n - 4; i >= 0; --i) + if (MZ_READ_LE32(pBuf + i) == MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIG) + break; + if (i >= 0) + { + cur_file_ofs += i; + break; + } + if ((!cur_file_ofs) || ((pZip->m_archive_size - cur_file_ofs) >= (0xFFFF + MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIZE))) + return MZ_FALSE; + cur_file_ofs = MZ_MAX(cur_file_ofs - (sizeof(buf_u32) - 3), 0); + } + // Read and verify the end of central directory record. + if (pZip->m_pRead(pZip->m_pIO_opaque, cur_file_ofs, pBuf, MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIZE) != MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIZE) + return MZ_FALSE; + if ((MZ_READ_LE32(pBuf + MZ_ZIP_ECDH_SIG_OFS) != MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIG) || + ((pZip->m_total_files = MZ_READ_LE16(pBuf + MZ_ZIP_ECDH_CDIR_TOTAL_ENTRIES_OFS)) != MZ_READ_LE16(pBuf + MZ_ZIP_ECDH_CDIR_NUM_ENTRIES_ON_DISK_OFS))) + return MZ_FALSE; + + num_this_disk = MZ_READ_LE16(pBuf + MZ_ZIP_ECDH_NUM_THIS_DISK_OFS); + cdir_disk_index = MZ_READ_LE16(pBuf + MZ_ZIP_ECDH_NUM_DISK_CDIR_OFS); + if (((num_this_disk | cdir_disk_index) != 0) && ((num_this_disk != 1) || (cdir_disk_index != 1))) + return MZ_FALSE; + + if ((cdir_size = MZ_READ_LE32(pBuf + MZ_ZIP_ECDH_CDIR_SIZE_OFS)) < pZip->m_total_files * MZ_ZIP_CENTRAL_DIR_HEADER_SIZE) + return MZ_FALSE; + + cdir_ofs = MZ_READ_LE32(pBuf + MZ_ZIP_ECDH_CDIR_OFS_OFS); + if ((cdir_ofs + (mz_uint64)cdir_size) > pZip->m_archive_size) + return MZ_FALSE; + + pZip->m_central_directory_file_ofs = cdir_ofs; + + if (pZip->m_total_files) + { + mz_uint i, n; + + // Read the entire central directory into a heap block, and allocate another heap block to hold the unsorted central dir file record offsets, and another to hold the sorted indices. + if ((!mz_zip_array_resize(pZip, &pZip->m_pState->m_central_dir, cdir_size, MZ_FALSE)) || + (!mz_zip_array_resize(pZip, &pZip->m_pState->m_central_dir_offsets, pZip->m_total_files, MZ_FALSE))) + return MZ_FALSE; + + if (sort_central_dir) + { + if (!mz_zip_array_resize(pZip, &pZip->m_pState->m_sorted_central_dir_offsets, pZip->m_total_files, MZ_FALSE)) + return MZ_FALSE; + } + + if (pZip->m_pRead(pZip->m_pIO_opaque, cdir_ofs, pZip->m_pState->m_central_dir.m_p, cdir_size) != cdir_size) + return MZ_FALSE; + + // Now create an index into the central directory file records, do some basic sanity checking on each record, and check for zip64 entries (which are not yet supported). + p = (const mz_uint8 *)pZip->m_pState->m_central_dir.m_p; + for (n = cdir_size, i = 0; i < pZip->m_total_files; ++i) + { + mz_uint total_header_size, comp_size, decomp_size, disk_index; + if ((n < MZ_ZIP_CENTRAL_DIR_HEADER_SIZE) || (MZ_READ_LE32(p) != MZ_ZIP_CENTRAL_DIR_HEADER_SIG)) + return MZ_FALSE; + MZ_ZIP_ARRAY_ELEMENT(&pZip->m_pState->m_central_dir_offsets, mz_uint32, i) = (mz_uint32)(p - (const mz_uint8 *)pZip->m_pState->m_central_dir.m_p); + if (sort_central_dir) + MZ_ZIP_ARRAY_ELEMENT(&pZip->m_pState->m_sorted_central_dir_offsets, mz_uint32, i) = i; + comp_size = MZ_READ_LE32(p + MZ_ZIP_CDH_COMPRESSED_SIZE_OFS); + decomp_size = MZ_READ_LE32(p + MZ_ZIP_CDH_DECOMPRESSED_SIZE_OFS); + if (((!MZ_READ_LE32(p + MZ_ZIP_CDH_METHOD_OFS)) && (decomp_size != comp_size)) || (decomp_size && !comp_size) || (decomp_size == 0xFFFFFFFF) || (comp_size == 0xFFFFFFFF)) + return MZ_FALSE; + disk_index = MZ_READ_LE16(p + MZ_ZIP_CDH_DISK_START_OFS); + if ((disk_index != num_this_disk) && (disk_index != 1)) + return MZ_FALSE; + if (((mz_uint64)MZ_READ_LE32(p + MZ_ZIP_CDH_LOCAL_HEADER_OFS) + MZ_ZIP_LOCAL_DIR_HEADER_SIZE + comp_size) > pZip->m_archive_size) + return MZ_FALSE; + if ((total_header_size = MZ_ZIP_CENTRAL_DIR_HEADER_SIZE + MZ_READ_LE16(p + MZ_ZIP_CDH_FILENAME_LEN_OFS) + MZ_READ_LE16(p + MZ_ZIP_CDH_EXTRA_LEN_OFS) + MZ_READ_LE16(p + MZ_ZIP_CDH_COMMENT_LEN_OFS)) > n) + return MZ_FALSE; + n -= total_header_size; p += total_header_size; + } + } + + if (sort_central_dir) + mz_zip_reader_sort_central_dir_offsets_by_filename(pZip); + + return MZ_TRUE; +} + +mz_bool mz_zip_reader_init(mz_zip_archive *pZip, mz_uint64 size, mz_uint32 flags) +{ + if ((!pZip) || (!pZip->m_pRead)) + return MZ_FALSE; + if (!mz_zip_reader_init_internal(pZip, flags)) + return MZ_FALSE; + pZip->m_archive_size = size; + if (!mz_zip_reader_read_central_dir(pZip, flags)) + { + mz_zip_reader_end(pZip); + return MZ_FALSE; + } + return MZ_TRUE; +} + +static size_t mz_zip_mem_read_func(void *pOpaque, mz_uint64 file_ofs, void *pBuf, size_t n) +{ + mz_zip_archive *pZip = (mz_zip_archive *)pOpaque; + size_t s = (file_ofs >= pZip->m_archive_size) ? 0 : (size_t)MZ_MIN(pZip->m_archive_size - file_ofs, n); + memcpy(pBuf, (const mz_uint8 *)pZip->m_pState->m_pMem + file_ofs, s); + return s; +} + +mz_bool mz_zip_reader_init_mem(mz_zip_archive *pZip, const void *pMem, size_t size, mz_uint32 flags) +{ + if (!mz_zip_reader_init_internal(pZip, flags)) + return MZ_FALSE; + pZip->m_archive_size = size; + pZip->m_pRead = mz_zip_mem_read_func; + pZip->m_pIO_opaque = pZip; +#ifdef __cplusplus + pZip->m_pState->m_pMem = const_cast(pMem); +#else + pZip->m_pState->m_pMem = (void *)pMem; +#endif + pZip->m_pState->m_mem_size = size; + if (!mz_zip_reader_read_central_dir(pZip, flags)) + { + mz_zip_reader_end(pZip); + return MZ_FALSE; + } + return MZ_TRUE; +} + +#ifndef MINIZ_NO_STDIO +static size_t mz_zip_file_read_func(void *pOpaque, mz_uint64 file_ofs, void *pBuf, size_t n) +{ + mz_zip_archive *pZip = (mz_zip_archive *)pOpaque; + mz_int64 cur_ofs = MZ_FTELL64(pZip->m_pState->m_pFile); + if (((mz_int64)file_ofs < 0) || (((cur_ofs != (mz_int64)file_ofs)) && (MZ_FSEEK64(pZip->m_pState->m_pFile, (mz_int64)file_ofs, SEEK_SET)))) + return 0; + return MZ_FREAD(pBuf, 1, n, pZip->m_pState->m_pFile); +} + +mz_bool mz_zip_reader_init_file(mz_zip_archive *pZip, const char *pFilename, mz_uint32 flags) +{ + mz_uint64 file_size; + MZ_FILE *pFile = MZ_FOPEN(pFilename, "rb"); + if (!pFile) + return MZ_FALSE; + if (MZ_FSEEK64(pFile, 0, SEEK_END)) + { + MZ_FCLOSE(pFile); + return MZ_FALSE; + } + file_size = MZ_FTELL64(pFile); + if (!mz_zip_reader_init_internal(pZip, flags)) + { + MZ_FCLOSE(pFile); + return MZ_FALSE; + } + pZip->m_pRead = mz_zip_file_read_func; + pZip->m_pIO_opaque = pZip; + pZip->m_pState->m_pFile = pFile; + pZip->m_archive_size = file_size; + if (!mz_zip_reader_read_central_dir(pZip, flags)) + { + mz_zip_reader_end(pZip); + return MZ_FALSE; + } + return MZ_TRUE; +} +#endif // #ifndef MINIZ_NO_STDIO + +mz_uint mz_zip_reader_get_num_files(mz_zip_archive *pZip) +{ + return pZip ? pZip->m_total_files : 0; +} + +static MZ_FORCEINLINE const mz_uint8 *mz_zip_reader_get_cdh(mz_zip_archive *pZip, mz_uint file_index) +{ + if ((!pZip) || (!pZip->m_pState) || (file_index >= pZip->m_total_files) || (pZip->m_zip_mode != MZ_ZIP_MODE_READING)) + return NULL; + return &MZ_ZIP_ARRAY_ELEMENT(&pZip->m_pState->m_central_dir, mz_uint8, MZ_ZIP_ARRAY_ELEMENT(&pZip->m_pState->m_central_dir_offsets, mz_uint32, file_index)); +} + +mz_bool mz_zip_reader_is_file_encrypted(mz_zip_archive *pZip, mz_uint file_index) +{ + mz_uint m_bit_flag; + const mz_uint8 *p = mz_zip_reader_get_cdh(pZip, file_index); + if (!p) + return MZ_FALSE; + m_bit_flag = MZ_READ_LE16(p + MZ_ZIP_CDH_BIT_FLAG_OFS); + return (m_bit_flag & 1); +} + +mz_bool mz_zip_reader_is_file_a_directory(mz_zip_archive *pZip, mz_uint file_index) +{ + mz_uint filename_len, external_attr; + const mz_uint8 *p = mz_zip_reader_get_cdh(pZip, file_index); + if (!p) + return MZ_FALSE; + + // First see if the filename ends with a '/' character. + filename_len = MZ_READ_LE16(p + MZ_ZIP_CDH_FILENAME_LEN_OFS); + if (filename_len) + { + if (*(p + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE + filename_len - 1) == '/') + return MZ_TRUE; + } + + // Bugfix: This code was also checking if the internal attribute was non-zero, which wasn't correct. + // Most/all zip writers (hopefully) set DOS file/directory attributes in the low 16-bits, so check for the DOS directory flag and ignore the source OS ID in the created by field. + // FIXME: Remove this check? Is it necessary - we already check the filename. + external_attr = MZ_READ_LE32(p + MZ_ZIP_CDH_EXTERNAL_ATTR_OFS); + if ((external_attr & 0x10) != 0) + return MZ_TRUE; + + return MZ_FALSE; +} + +mz_bool mz_zip_reader_file_stat(mz_zip_archive *pZip, mz_uint file_index, mz_zip_archive_file_stat *pStat) +{ + mz_uint n; + const mz_uint8 *p = mz_zip_reader_get_cdh(pZip, file_index); + if ((!p) || (!pStat)) + return MZ_FALSE; + + // Unpack the central directory record. + pStat->m_file_index = file_index; + pStat->m_central_dir_ofs = MZ_ZIP_ARRAY_ELEMENT(&pZip->m_pState->m_central_dir_offsets, mz_uint32, file_index); + pStat->m_version_made_by = MZ_READ_LE16(p + MZ_ZIP_CDH_VERSION_MADE_BY_OFS); + pStat->m_version_needed = MZ_READ_LE16(p + MZ_ZIP_CDH_VERSION_NEEDED_OFS); + pStat->m_bit_flag = MZ_READ_LE16(p + MZ_ZIP_CDH_BIT_FLAG_OFS); + pStat->m_method = MZ_READ_LE16(p + MZ_ZIP_CDH_METHOD_OFS); +#ifndef MINIZ_NO_TIME + pStat->m_time = mz_zip_dos_to_time_t(MZ_READ_LE16(p + MZ_ZIP_CDH_FILE_TIME_OFS), MZ_READ_LE16(p + MZ_ZIP_CDH_FILE_DATE_OFS)); +#endif + pStat->m_crc32 = MZ_READ_LE32(p + MZ_ZIP_CDH_CRC32_OFS); + pStat->m_comp_size = MZ_READ_LE32(p + MZ_ZIP_CDH_COMPRESSED_SIZE_OFS); + pStat->m_uncomp_size = MZ_READ_LE32(p + MZ_ZIP_CDH_DECOMPRESSED_SIZE_OFS); + pStat->m_internal_attr = MZ_READ_LE16(p + MZ_ZIP_CDH_INTERNAL_ATTR_OFS); + pStat->m_external_attr = MZ_READ_LE32(p + MZ_ZIP_CDH_EXTERNAL_ATTR_OFS); + pStat->m_local_header_ofs = MZ_READ_LE32(p + MZ_ZIP_CDH_LOCAL_HEADER_OFS); + + // Copy as much of the filename and comment as possible. + n = MZ_READ_LE16(p + MZ_ZIP_CDH_FILENAME_LEN_OFS); n = MZ_MIN(n, MZ_ZIP_MAX_ARCHIVE_FILENAME_SIZE - 1); + memcpy(pStat->m_filename, p + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE, n); pStat->m_filename[n] = '\0'; + + n = MZ_READ_LE16(p + MZ_ZIP_CDH_COMMENT_LEN_OFS); n = MZ_MIN(n, MZ_ZIP_MAX_ARCHIVE_FILE_COMMENT_SIZE - 1); + pStat->m_comment_size = n; + memcpy(pStat->m_comment, p + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE + MZ_READ_LE16(p + MZ_ZIP_CDH_FILENAME_LEN_OFS) + MZ_READ_LE16(p + MZ_ZIP_CDH_EXTRA_LEN_OFS), n); pStat->m_comment[n] = '\0'; + + return MZ_TRUE; +} + +mz_uint mz_zip_reader_get_filename(mz_zip_archive *pZip, mz_uint file_index, char *pFilename, mz_uint filename_buf_size) +{ + mz_uint n; + const mz_uint8 *p = mz_zip_reader_get_cdh(pZip, file_index); + if (!p) { if (filename_buf_size) pFilename[0] = '\0'; return 0; } + n = MZ_READ_LE16(p + MZ_ZIP_CDH_FILENAME_LEN_OFS); + if (filename_buf_size) + { + n = MZ_MIN(n, filename_buf_size - 1); + memcpy(pFilename, p + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE, n); + pFilename[n] = '\0'; + } + return n + 1; +} + +static MZ_FORCEINLINE mz_bool mz_zip_reader_string_equal(const char *pA, const char *pB, mz_uint len, mz_uint flags) +{ + mz_uint i; + if (flags & MZ_ZIP_FLAG_CASE_SENSITIVE) + return 0 == memcmp(pA, pB, len); + for (i = 0; i < len; ++i) + if (MZ_TOLOWER(pA[i]) != MZ_TOLOWER(pB[i])) + return MZ_FALSE; + return MZ_TRUE; +} + +static MZ_FORCEINLINE int mz_zip_reader_filename_compare(const mz_zip_array *pCentral_dir_array, const mz_zip_array *pCentral_dir_offsets, mz_uint l_index, const char *pR, mz_uint r_len) +{ + const mz_uint8 *pL = &MZ_ZIP_ARRAY_ELEMENT(pCentral_dir_array, mz_uint8, MZ_ZIP_ARRAY_ELEMENT(pCentral_dir_offsets, mz_uint32, l_index)), *pE; + mz_uint l_len = MZ_READ_LE16(pL + MZ_ZIP_CDH_FILENAME_LEN_OFS); + mz_uint8 l = 0, r = 0; + pL += MZ_ZIP_CENTRAL_DIR_HEADER_SIZE; + pE = pL + MZ_MIN(l_len, r_len); + while (pL < pE) + { + if ((l = MZ_TOLOWER(*pL)) != (r = MZ_TOLOWER(*pR))) + break; + pL++; pR++; + } + return (pL == pE) ? (int)(l_len - r_len) : (l - r); +} + +static int mz_zip_reader_locate_file_binary_search(mz_zip_archive *pZip, const char *pFilename) +{ + mz_zip_internal_state *pState = pZip->m_pState; + const mz_zip_array *pCentral_dir_offsets = &pState->m_central_dir_offsets; + const mz_zip_array *pCentral_dir = &pState->m_central_dir; + mz_uint32 *pIndices = &MZ_ZIP_ARRAY_ELEMENT(&pState->m_sorted_central_dir_offsets, mz_uint32, 0); + const int size = pZip->m_total_files; + const mz_uint filename_len = (mz_uint)strlen(pFilename); + int l = 0, h = size - 1; + while (l <= h) + { + int m = (l + h) >> 1, file_index = pIndices[m], comp = mz_zip_reader_filename_compare(pCentral_dir, pCentral_dir_offsets, file_index, pFilename, filename_len); + if (!comp) + return file_index; + else if (comp < 0) + l = m + 1; + else + h = m - 1; + } + return -1; +} + +int mz_zip_reader_locate_file(mz_zip_archive *pZip, const char *pName, const char *pComment, mz_uint flags) +{ + mz_uint file_index; size_t name_len, comment_len; + if ((!pZip) || (!pZip->m_pState) || (!pName) || (pZip->m_zip_mode != MZ_ZIP_MODE_READING)) + return -1; + if (((flags & (MZ_ZIP_FLAG_IGNORE_PATH | MZ_ZIP_FLAG_CASE_SENSITIVE)) == 0) && (!pComment) && (pZip->m_pState->m_sorted_central_dir_offsets.m_size)) + return mz_zip_reader_locate_file_binary_search(pZip, pName); + name_len = strlen(pName); if (name_len > 0xFFFF) return -1; + comment_len = pComment ? strlen(pComment) : 0; if (comment_len > 0xFFFF) return -1; + for (file_index = 0; file_index < pZip->m_total_files; file_index++) + { + const mz_uint8 *pHeader = &MZ_ZIP_ARRAY_ELEMENT(&pZip->m_pState->m_central_dir, mz_uint8, MZ_ZIP_ARRAY_ELEMENT(&pZip->m_pState->m_central_dir_offsets, mz_uint32, file_index)); + mz_uint filename_len = MZ_READ_LE16(pHeader + MZ_ZIP_CDH_FILENAME_LEN_OFS); + const char *pFilename = (const char *)pHeader + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE; + if (filename_len < name_len) + continue; + if (comment_len) + { + mz_uint file_extra_len = MZ_READ_LE16(pHeader + MZ_ZIP_CDH_EXTRA_LEN_OFS), file_comment_len = MZ_READ_LE16(pHeader + MZ_ZIP_CDH_COMMENT_LEN_OFS); + const char *pFile_comment = pFilename + filename_len + file_extra_len; + if ((file_comment_len != comment_len) || (!mz_zip_reader_string_equal(pComment, pFile_comment, file_comment_len, flags))) + continue; + } + if ((flags & MZ_ZIP_FLAG_IGNORE_PATH) && (filename_len)) + { + int ofs = filename_len - 1; + do + { + if ((pFilename[ofs] == '/') || (pFilename[ofs] == '\\') || (pFilename[ofs] == ':')) + break; + } while (--ofs >= 0); + ofs++; + pFilename += ofs; filename_len -= ofs; + } + if ((filename_len == name_len) && (mz_zip_reader_string_equal(pName, pFilename, filename_len, flags))) + return file_index; + } + return -1; +} + +mz_bool mz_zip_reader_extract_to_mem_no_alloc(mz_zip_archive *pZip, mz_uint file_index, void *pBuf, size_t buf_size, mz_uint flags, void *pUser_read_buf, size_t user_read_buf_size) +{ + int status = TINFL_STATUS_DONE; + mz_uint64 needed_size, cur_file_ofs, comp_remaining, out_buf_ofs = 0, read_buf_size, read_buf_ofs = 0, read_buf_avail; + mz_zip_archive_file_stat file_stat; + void *pRead_buf; + mz_uint32 local_header_u32[(MZ_ZIP_LOCAL_DIR_HEADER_SIZE + sizeof(mz_uint32) - 1) / sizeof(mz_uint32)]; mz_uint8 *pLocal_header = (mz_uint8 *)local_header_u32; + tinfl_decompressor inflator; + + if ((buf_size) && (!pBuf)) + return MZ_FALSE; + + if (!mz_zip_reader_file_stat(pZip, file_index, &file_stat)) + return MZ_FALSE; + + // Empty file, or a directory (but not always a directory - I've seen odd zips with directories that have compressed data which inflates to 0 bytes) + if (!file_stat.m_comp_size) + return MZ_TRUE; + + // Entry is a subdirectory (I've seen old zips with dir entries which have compressed deflate data which inflates to 0 bytes, but these entries claim to uncompress to 512 bytes in the headers). + // I'm torn how to handle this case - should it fail instead? + if (mz_zip_reader_is_file_a_directory(pZip, file_index)) + return MZ_TRUE; + + // Encryption and patch files are not supported. + if (file_stat.m_bit_flag & (1 | 32)) + return MZ_FALSE; + + // This function only supports stored and deflate. + if ((!(flags & MZ_ZIP_FLAG_COMPRESSED_DATA)) && (file_stat.m_method != 0) && (file_stat.m_method != MZ_DEFLATED)) + return MZ_FALSE; + + // Ensure supplied output buffer is large enough. + needed_size = (flags & MZ_ZIP_FLAG_COMPRESSED_DATA) ? file_stat.m_comp_size : file_stat.m_uncomp_size; + if (buf_size < needed_size) + return MZ_FALSE; + + // Read and parse the local directory entry. + cur_file_ofs = file_stat.m_local_header_ofs; + if (pZip->m_pRead(pZip->m_pIO_opaque, cur_file_ofs, pLocal_header, MZ_ZIP_LOCAL_DIR_HEADER_SIZE) != MZ_ZIP_LOCAL_DIR_HEADER_SIZE) + return MZ_FALSE; + if (MZ_READ_LE32(pLocal_header) != MZ_ZIP_LOCAL_DIR_HEADER_SIG) + return MZ_FALSE; + + cur_file_ofs += MZ_ZIP_LOCAL_DIR_HEADER_SIZE + MZ_READ_LE16(pLocal_header + MZ_ZIP_LDH_FILENAME_LEN_OFS) + MZ_READ_LE16(pLocal_header + MZ_ZIP_LDH_EXTRA_LEN_OFS); + if ((cur_file_ofs + file_stat.m_comp_size) > pZip->m_archive_size) + return MZ_FALSE; + + if ((flags & MZ_ZIP_FLAG_COMPRESSED_DATA) || (!file_stat.m_method)) + { + // The file is stored or the caller has requested the compressed data. + if (pZip->m_pRead(pZip->m_pIO_opaque, cur_file_ofs, pBuf, (size_t)needed_size) != needed_size) + return MZ_FALSE; + return ((flags & MZ_ZIP_FLAG_COMPRESSED_DATA) != 0) || (mz_crc32(MZ_CRC32_INIT, (const mz_uint8 *)pBuf, (size_t)file_stat.m_uncomp_size) == file_stat.m_crc32); + } + + // Decompress the file either directly from memory or from a file input buffer. + tinfl_init(&inflator); + + if (pZip->m_pState->m_pMem) + { + // Read directly from the archive in memory. + pRead_buf = (mz_uint8 *)pZip->m_pState->m_pMem + cur_file_ofs; + read_buf_size = read_buf_avail = file_stat.m_comp_size; + comp_remaining = 0; + } + else if (pUser_read_buf) + { + // Use a user provided read buffer. + if (!user_read_buf_size) + return MZ_FALSE; + pRead_buf = (mz_uint8 *)pUser_read_buf; + read_buf_size = user_read_buf_size; + read_buf_avail = 0; + comp_remaining = file_stat.m_comp_size; + } + else + { + // Temporarily allocate a read buffer. + read_buf_size = MZ_MIN(file_stat.m_comp_size, MZ_ZIP_MAX_IO_BUF_SIZE); +#ifdef _MSC_VER + if (((0, sizeof(size_t) == sizeof(mz_uint32))) && (read_buf_size > 0x7FFFFFFF)) +#else + if (((sizeof(size_t) == sizeof(mz_uint32))) && (read_buf_size > 0x7FFFFFFF)) +#endif + return MZ_FALSE; + if (NULL == (pRead_buf = pZip->m_pAlloc(pZip->m_pAlloc_opaque, 1, (size_t)read_buf_size))) + return MZ_FALSE; + read_buf_avail = 0; + comp_remaining = file_stat.m_comp_size; + } + + do + { + size_t in_buf_size, out_buf_size = (size_t)(file_stat.m_uncomp_size - out_buf_ofs); + if ((!read_buf_avail) && (!pZip->m_pState->m_pMem)) + { + read_buf_avail = MZ_MIN(read_buf_size, comp_remaining); + if (pZip->m_pRead(pZip->m_pIO_opaque, cur_file_ofs, pRead_buf, (size_t)read_buf_avail) != read_buf_avail) + { + status = TINFL_STATUS_FAILED; + break; + } + cur_file_ofs += read_buf_avail; + comp_remaining -= read_buf_avail; + read_buf_ofs = 0; + } + in_buf_size = (size_t)read_buf_avail; + status = tinfl_decompress(&inflator, (mz_uint8 *)pRead_buf + read_buf_ofs, &in_buf_size, (mz_uint8 *)pBuf, (mz_uint8 *)pBuf + out_buf_ofs, &out_buf_size, TINFL_FLAG_USING_NON_WRAPPING_OUTPUT_BUF | (comp_remaining ? TINFL_FLAG_HAS_MORE_INPUT : 0)); + read_buf_avail -= in_buf_size; + read_buf_ofs += in_buf_size; + out_buf_ofs += out_buf_size; + } while (status == TINFL_STATUS_NEEDS_MORE_INPUT); + + if (status == TINFL_STATUS_DONE) + { + // Make sure the entire file was decompressed, and check its CRC. + if ((out_buf_ofs != file_stat.m_uncomp_size) || (mz_crc32(MZ_CRC32_INIT, (const mz_uint8 *)pBuf, (size_t)file_stat.m_uncomp_size) != file_stat.m_crc32)) + status = TINFL_STATUS_FAILED; + } + + if ((!pZip->m_pState->m_pMem) && (!pUser_read_buf)) + pZip->m_pFree(pZip->m_pAlloc_opaque, pRead_buf); + + return status == TINFL_STATUS_DONE; +} + +mz_bool mz_zip_reader_extract_file_to_mem_no_alloc(mz_zip_archive *pZip, const char *pFilename, void *pBuf, size_t buf_size, mz_uint flags, void *pUser_read_buf, size_t user_read_buf_size) +{ + int file_index = mz_zip_reader_locate_file(pZip, pFilename, NULL, flags); + if (file_index < 0) + return MZ_FALSE; + return mz_zip_reader_extract_to_mem_no_alloc(pZip, file_index, pBuf, buf_size, flags, pUser_read_buf, user_read_buf_size); +} + +mz_bool mz_zip_reader_extract_to_mem(mz_zip_archive *pZip, mz_uint file_index, void *pBuf, size_t buf_size, mz_uint flags) +{ + return mz_zip_reader_extract_to_mem_no_alloc(pZip, file_index, pBuf, buf_size, flags, NULL, 0); +} + +mz_bool mz_zip_reader_extract_file_to_mem(mz_zip_archive *pZip, const char *pFilename, void *pBuf, size_t buf_size, mz_uint flags) +{ + return mz_zip_reader_extract_file_to_mem_no_alloc(pZip, pFilename, pBuf, buf_size, flags, NULL, 0); +} + +void *mz_zip_reader_extract_to_heap(mz_zip_archive *pZip, mz_uint file_index, size_t *pSize, mz_uint flags) +{ + mz_uint64 comp_size, uncomp_size, alloc_size; + const mz_uint8 *p = mz_zip_reader_get_cdh(pZip, file_index); + void *pBuf; + + if (pSize) + *pSize = 0; + if (!p) + return NULL; + + comp_size = MZ_READ_LE32(p + MZ_ZIP_CDH_COMPRESSED_SIZE_OFS); + uncomp_size = MZ_READ_LE32(p + MZ_ZIP_CDH_DECOMPRESSED_SIZE_OFS); + + alloc_size = (flags & MZ_ZIP_FLAG_COMPRESSED_DATA) ? comp_size : uncomp_size; +#ifdef _MSC_VER + if (((0, sizeof(size_t) == sizeof(mz_uint32))) && (alloc_size > 0x7FFFFFFF)) +#else + if (((sizeof(size_t) == sizeof(mz_uint32))) && (alloc_size > 0x7FFFFFFF)) +#endif + return NULL; + if (NULL == (pBuf = pZip->m_pAlloc(pZip->m_pAlloc_opaque, 1, (size_t)alloc_size))) + return NULL; + + if (!mz_zip_reader_extract_to_mem(pZip, file_index, pBuf, (size_t)alloc_size, flags)) + { + pZip->m_pFree(pZip->m_pAlloc_opaque, pBuf); + return NULL; + } + + if (pSize) *pSize = (size_t)alloc_size; + return pBuf; +} + +void *mz_zip_reader_extract_file_to_heap(mz_zip_archive *pZip, const char *pFilename, size_t *pSize, mz_uint flags) +{ + int file_index = mz_zip_reader_locate_file(pZip, pFilename, NULL, flags); + if (file_index < 0) + { + if (pSize) *pSize = 0; + return MZ_FALSE; + } + return mz_zip_reader_extract_to_heap(pZip, file_index, pSize, flags); +} + +mz_bool mz_zip_reader_extract_to_callback(mz_zip_archive *pZip, mz_uint file_index, mz_file_write_func pCallback, void *pOpaque, mz_uint flags) +{ + int status = TINFL_STATUS_DONE; mz_uint file_crc32 = MZ_CRC32_INIT; + mz_uint64 read_buf_size, read_buf_ofs = 0, read_buf_avail, comp_remaining, out_buf_ofs = 0, cur_file_ofs; + mz_zip_archive_file_stat file_stat; + void *pRead_buf = NULL; void *pWrite_buf = NULL; + mz_uint32 local_header_u32[(MZ_ZIP_LOCAL_DIR_HEADER_SIZE + sizeof(mz_uint32) - 1) / sizeof(mz_uint32)]; mz_uint8 *pLocal_header = (mz_uint8 *)local_header_u32; + + if (!mz_zip_reader_file_stat(pZip, file_index, &file_stat)) + return MZ_FALSE; + + // Empty file, or a directory (but not always a directory - I've seen odd zips with directories that have compressed data which inflates to 0 bytes) + if (!file_stat.m_comp_size) + return MZ_TRUE; + + // Entry is a subdirectory (I've seen old zips with dir entries which have compressed deflate data which inflates to 0 bytes, but these entries claim to uncompress to 512 bytes in the headers). + // I'm torn how to handle this case - should it fail instead? + if (mz_zip_reader_is_file_a_directory(pZip, file_index)) + return MZ_TRUE; + + // Encryption and patch files are not supported. + if (file_stat.m_bit_flag & (1 | 32)) + return MZ_FALSE; + + // This function only supports stored and deflate. + if ((!(flags & MZ_ZIP_FLAG_COMPRESSED_DATA)) && (file_stat.m_method != 0) && (file_stat.m_method != MZ_DEFLATED)) + return MZ_FALSE; + + // Read and parse the local directory entry. + cur_file_ofs = file_stat.m_local_header_ofs; + if (pZip->m_pRead(pZip->m_pIO_opaque, cur_file_ofs, pLocal_header, MZ_ZIP_LOCAL_DIR_HEADER_SIZE) != MZ_ZIP_LOCAL_DIR_HEADER_SIZE) + return MZ_FALSE; + if (MZ_READ_LE32(pLocal_header) != MZ_ZIP_LOCAL_DIR_HEADER_SIG) + return MZ_FALSE; + + cur_file_ofs += MZ_ZIP_LOCAL_DIR_HEADER_SIZE + MZ_READ_LE16(pLocal_header + MZ_ZIP_LDH_FILENAME_LEN_OFS) + MZ_READ_LE16(pLocal_header + MZ_ZIP_LDH_EXTRA_LEN_OFS); + if ((cur_file_ofs + file_stat.m_comp_size) > pZip->m_archive_size) + return MZ_FALSE; + + // Decompress the file either directly from memory or from a file input buffer. + if (pZip->m_pState->m_pMem) + { + pRead_buf = (mz_uint8 *)pZip->m_pState->m_pMem + cur_file_ofs; + read_buf_size = read_buf_avail = file_stat.m_comp_size; + comp_remaining = 0; + } + else + { + read_buf_size = MZ_MIN(file_stat.m_comp_size, MZ_ZIP_MAX_IO_BUF_SIZE); + if (NULL == (pRead_buf = pZip->m_pAlloc(pZip->m_pAlloc_opaque, 1, (size_t)read_buf_size))) + return MZ_FALSE; + read_buf_avail = 0; + comp_remaining = file_stat.m_comp_size; + } + + if ((flags & MZ_ZIP_FLAG_COMPRESSED_DATA) || (!file_stat.m_method)) + { + // The file is stored or the caller has requested the compressed data. + if (pZip->m_pState->m_pMem) + { +#ifdef _MSC_VER + if (((0, sizeof(size_t) == sizeof(mz_uint32))) && (file_stat.m_comp_size > 0xFFFFFFFF)) +#else + if (((sizeof(size_t) == sizeof(mz_uint32))) && (file_stat.m_comp_size > 0xFFFFFFFF)) +#endif + return MZ_FALSE; + if (pCallback(pOpaque, out_buf_ofs, pRead_buf, (size_t)file_stat.m_comp_size) != file_stat.m_comp_size) + status = TINFL_STATUS_FAILED; + else if (!(flags & MZ_ZIP_FLAG_COMPRESSED_DATA)) + file_crc32 = (mz_uint32)mz_crc32(file_crc32, (const mz_uint8 *)pRead_buf, (size_t)file_stat.m_comp_size); + cur_file_ofs += file_stat.m_comp_size; + out_buf_ofs += file_stat.m_comp_size; + comp_remaining = 0; + } + else + { + while (comp_remaining) + { + read_buf_avail = MZ_MIN(read_buf_size, comp_remaining); + if (pZip->m_pRead(pZip->m_pIO_opaque, cur_file_ofs, pRead_buf, (size_t)read_buf_avail) != read_buf_avail) + { + status = TINFL_STATUS_FAILED; + break; + } + + if (!(flags & MZ_ZIP_FLAG_COMPRESSED_DATA)) + file_crc32 = (mz_uint32)mz_crc32(file_crc32, (const mz_uint8 *)pRead_buf, (size_t)read_buf_avail); + + if (pCallback(pOpaque, out_buf_ofs, pRead_buf, (size_t)read_buf_avail) != read_buf_avail) + { + status = TINFL_STATUS_FAILED; + break; + } + cur_file_ofs += read_buf_avail; + out_buf_ofs += read_buf_avail; + comp_remaining -= read_buf_avail; + } + } + } + else + { + tinfl_decompressor inflator; + tinfl_init(&inflator); + + if (NULL == (pWrite_buf = pZip->m_pAlloc(pZip->m_pAlloc_opaque, 1, TINFL_LZ_DICT_SIZE))) + status = TINFL_STATUS_FAILED; + else + { + do + { + mz_uint8 *pWrite_buf_cur = (mz_uint8 *)pWrite_buf + (out_buf_ofs & (TINFL_LZ_DICT_SIZE - 1)); + size_t in_buf_size, out_buf_size = TINFL_LZ_DICT_SIZE - (out_buf_ofs & (TINFL_LZ_DICT_SIZE - 1)); + if ((!read_buf_avail) && (!pZip->m_pState->m_pMem)) + { + read_buf_avail = MZ_MIN(read_buf_size, comp_remaining); + if (pZip->m_pRead(pZip->m_pIO_opaque, cur_file_ofs, pRead_buf, (size_t)read_buf_avail) != read_buf_avail) + { + status = TINFL_STATUS_FAILED; + break; + } + cur_file_ofs += read_buf_avail; + comp_remaining -= read_buf_avail; + read_buf_ofs = 0; + } + + in_buf_size = (size_t)read_buf_avail; + status = tinfl_decompress(&inflator, (const mz_uint8 *)pRead_buf + read_buf_ofs, &in_buf_size, (mz_uint8 *)pWrite_buf, pWrite_buf_cur, &out_buf_size, comp_remaining ? TINFL_FLAG_HAS_MORE_INPUT : 0); + read_buf_avail -= in_buf_size; + read_buf_ofs += in_buf_size; + + if (out_buf_size) + { + if (pCallback(pOpaque, out_buf_ofs, pWrite_buf_cur, out_buf_size) != out_buf_size) + { + status = TINFL_STATUS_FAILED; + break; + } + file_crc32 = (mz_uint32)mz_crc32(file_crc32, pWrite_buf_cur, out_buf_size); + if ((out_buf_ofs += out_buf_size) > file_stat.m_uncomp_size) + { + status = TINFL_STATUS_FAILED; + break; + } + } + } while ((status == TINFL_STATUS_NEEDS_MORE_INPUT) || (status == TINFL_STATUS_HAS_MORE_OUTPUT)); + } + } + + if ((status == TINFL_STATUS_DONE) && (!(flags & MZ_ZIP_FLAG_COMPRESSED_DATA))) + { + // Make sure the entire file was decompressed, and check its CRC. + if ((out_buf_ofs != file_stat.m_uncomp_size) || (file_crc32 != file_stat.m_crc32)) + status = TINFL_STATUS_FAILED; + } + + if (!pZip->m_pState->m_pMem) + pZip->m_pFree(pZip->m_pAlloc_opaque, pRead_buf); + if (pWrite_buf) + pZip->m_pFree(pZip->m_pAlloc_opaque, pWrite_buf); + + return status == TINFL_STATUS_DONE; +} + +mz_bool mz_zip_reader_extract_file_to_callback(mz_zip_archive *pZip, const char *pFilename, mz_file_write_func pCallback, void *pOpaque, mz_uint flags) +{ + int file_index = mz_zip_reader_locate_file(pZip, pFilename, NULL, flags); + if (file_index < 0) + return MZ_FALSE; + return mz_zip_reader_extract_to_callback(pZip, file_index, pCallback, pOpaque, flags); +} + +#ifndef MINIZ_NO_STDIO +static size_t mz_zip_file_write_callback(void *pOpaque, mz_uint64 ofs, const void *pBuf, size_t n) +{ + (void)ofs; return MZ_FWRITE(pBuf, 1, n, (MZ_FILE*)pOpaque); +} + +mz_bool mz_zip_reader_extract_to_file(mz_zip_archive *pZip, mz_uint file_index, const char *pDst_filename, mz_uint flags) +{ + mz_bool status; + mz_zip_archive_file_stat file_stat; + MZ_FILE *pFile; + if (!mz_zip_reader_file_stat(pZip, file_index, &file_stat)) + return MZ_FALSE; + pFile = MZ_FOPEN(pDst_filename, "wb"); + if (!pFile) + return MZ_FALSE; + status = mz_zip_reader_extract_to_callback(pZip, file_index, mz_zip_file_write_callback, pFile, flags); + if (MZ_FCLOSE(pFile) == EOF) + return MZ_FALSE; +#ifndef MINIZ_NO_TIME + if (status) + mz_zip_set_file_times(pDst_filename, file_stat.m_time, file_stat.m_time); +#endif + return status; +} +#endif // #ifndef MINIZ_NO_STDIO + +mz_bool mz_zip_reader_end(mz_zip_archive *pZip) +{ + if ((!pZip) || (!pZip->m_pState) || (!pZip->m_pAlloc) || (!pZip->m_pFree) || (pZip->m_zip_mode != MZ_ZIP_MODE_READING)) + return MZ_FALSE; + + if (pZip->m_pState) + { + mz_zip_internal_state *pState = pZip->m_pState; pZip->m_pState = NULL; + mz_zip_array_clear(pZip, &pState->m_central_dir); + mz_zip_array_clear(pZip, &pState->m_central_dir_offsets); + mz_zip_array_clear(pZip, &pState->m_sorted_central_dir_offsets); + +#ifndef MINIZ_NO_STDIO + if (pState->m_pFile) + { + MZ_FCLOSE(pState->m_pFile); + pState->m_pFile = NULL; + } +#endif // #ifndef MINIZ_NO_STDIO + + pZip->m_pFree(pZip->m_pAlloc_opaque, pState); + } + pZip->m_zip_mode = MZ_ZIP_MODE_INVALID; + + return MZ_TRUE; +} + +#ifndef MINIZ_NO_STDIO +mz_bool mz_zip_reader_extract_file_to_file(mz_zip_archive *pZip, const char *pArchive_filename, const char *pDst_filename, mz_uint flags) +{ + int file_index = mz_zip_reader_locate_file(pZip, pArchive_filename, NULL, flags); + if (file_index < 0) + return MZ_FALSE; + return mz_zip_reader_extract_to_file(pZip, file_index, pDst_filename, flags); +} +#endif + +// ------------------- .ZIP archive writing + +#ifndef MINIZ_NO_ARCHIVE_WRITING_APIS + +static void mz_write_le16(mz_uint8 *p, mz_uint16 v) { p[0] = (mz_uint8)v; p[1] = (mz_uint8)(v >> 8); } +static void mz_write_le32(mz_uint8 *p, mz_uint32 v) { p[0] = (mz_uint8)v; p[1] = (mz_uint8)(v >> 8); p[2] = (mz_uint8)(v >> 16); p[3] = (mz_uint8)(v >> 24); } +#define MZ_WRITE_LE16(p, v) mz_write_le16((mz_uint8 *)(p), (mz_uint16)(v)) +#define MZ_WRITE_LE32(p, v) mz_write_le32((mz_uint8 *)(p), (mz_uint32)(v)) + +mz_bool mz_zip_writer_init(mz_zip_archive *pZip, mz_uint64 existing_size) +{ + if ((!pZip) || (pZip->m_pState) || (!pZip->m_pWrite) || (pZip->m_zip_mode != MZ_ZIP_MODE_INVALID)) + return MZ_FALSE; + + if (pZip->m_file_offset_alignment) + { + // Ensure user specified file offset alignment is a power of 2. + if (pZip->m_file_offset_alignment & (pZip->m_file_offset_alignment - 1)) + return MZ_FALSE; + } + + if (!pZip->m_pAlloc) pZip->m_pAlloc = def_alloc_func; + if (!pZip->m_pFree) pZip->m_pFree = def_free_func; + if (!pZip->m_pRealloc) pZip->m_pRealloc = def_realloc_func; + + pZip->m_zip_mode = MZ_ZIP_MODE_WRITING; + pZip->m_archive_size = existing_size; + pZip->m_central_directory_file_ofs = 0; + pZip->m_total_files = 0; + + if (NULL == (pZip->m_pState = (mz_zip_internal_state *)pZip->m_pAlloc(pZip->m_pAlloc_opaque, 1, sizeof(mz_zip_internal_state)))) + return MZ_FALSE; + memset(pZip->m_pState, 0, sizeof(mz_zip_internal_state)); + MZ_ZIP_ARRAY_SET_ELEMENT_SIZE(&pZip->m_pState->m_central_dir, sizeof(mz_uint8)); + MZ_ZIP_ARRAY_SET_ELEMENT_SIZE(&pZip->m_pState->m_central_dir_offsets, sizeof(mz_uint32)); + MZ_ZIP_ARRAY_SET_ELEMENT_SIZE(&pZip->m_pState->m_sorted_central_dir_offsets, sizeof(mz_uint32)); + return MZ_TRUE; +} + +static size_t mz_zip_heap_write_func(void *pOpaque, mz_uint64 file_ofs, const void *pBuf, size_t n) +{ + mz_zip_archive *pZip = (mz_zip_archive *)pOpaque; + mz_zip_internal_state *pState = pZip->m_pState; + mz_uint64 new_size = MZ_MAX(file_ofs + n, pState->m_mem_size); +#ifdef _MSC_VER + if ((!n) || ((0, sizeof(size_t) == sizeof(mz_uint32)) && (new_size > 0x7FFFFFFF))) +#else + if ((!n) || ((sizeof(size_t) == sizeof(mz_uint32)) && (new_size > 0x7FFFFFFF))) +#endif + return 0; + if (new_size > pState->m_mem_capacity) + { + void *pNew_block; + size_t new_capacity = MZ_MAX(64, pState->m_mem_capacity); while (new_capacity < new_size) new_capacity *= 2; + if (NULL == (pNew_block = pZip->m_pRealloc(pZip->m_pAlloc_opaque, pState->m_pMem, 1, new_capacity))) + return 0; + pState->m_pMem = pNew_block; pState->m_mem_capacity = new_capacity; + } + memcpy((mz_uint8 *)pState->m_pMem + file_ofs, pBuf, n); + pState->m_mem_size = (size_t)new_size; + return n; +} + +mz_bool mz_zip_writer_init_heap(mz_zip_archive *pZip, size_t size_to_reserve_at_beginning, size_t initial_allocation_size) +{ + pZip->m_pWrite = mz_zip_heap_write_func; + pZip->m_pIO_opaque = pZip; + if (!mz_zip_writer_init(pZip, size_to_reserve_at_beginning)) + return MZ_FALSE; + if (0 != (initial_allocation_size = MZ_MAX(initial_allocation_size, size_to_reserve_at_beginning))) + { + if (NULL == (pZip->m_pState->m_pMem = pZip->m_pAlloc(pZip->m_pAlloc_opaque, 1, initial_allocation_size))) + { + mz_zip_writer_end(pZip); + return MZ_FALSE; + } + pZip->m_pState->m_mem_capacity = initial_allocation_size; + } + return MZ_TRUE; +} + +#ifndef MINIZ_NO_STDIO +static size_t mz_zip_file_write_func(void *pOpaque, mz_uint64 file_ofs, const void *pBuf, size_t n) +{ + mz_zip_archive *pZip = (mz_zip_archive *)pOpaque; + mz_int64 cur_ofs = MZ_FTELL64(pZip->m_pState->m_pFile); + if (((mz_int64)file_ofs < 0) || (((cur_ofs != (mz_int64)file_ofs)) && (MZ_FSEEK64(pZip->m_pState->m_pFile, (mz_int64)file_ofs, SEEK_SET)))) + return 0; + return MZ_FWRITE(pBuf, 1, n, pZip->m_pState->m_pFile); +} + +mz_bool mz_zip_writer_init_file(mz_zip_archive *pZip, const char *pFilename, mz_uint64 size_to_reserve_at_beginning) +{ + MZ_FILE *pFile; + pZip->m_pWrite = mz_zip_file_write_func; + pZip->m_pIO_opaque = pZip; + if (!mz_zip_writer_init(pZip, size_to_reserve_at_beginning)) + return MZ_FALSE; + if (NULL == (pFile = MZ_FOPEN(pFilename, "wb"))) + { + mz_zip_writer_end(pZip); + return MZ_FALSE; + } + pZip->m_pState->m_pFile = pFile; + if (size_to_reserve_at_beginning) + { + mz_uint64 cur_ofs = 0; char buf[4096]; MZ_CLEAR_OBJ(buf); + do + { + size_t n = (size_t)MZ_MIN(sizeof(buf), size_to_reserve_at_beginning); + if (pZip->m_pWrite(pZip->m_pIO_opaque, cur_ofs, buf, n) != n) + { + mz_zip_writer_end(pZip); + return MZ_FALSE; + } + cur_ofs += n; size_to_reserve_at_beginning -= n; + } while (size_to_reserve_at_beginning); + } + return MZ_TRUE; +} +#endif // #ifndef MINIZ_NO_STDIO + +mz_bool mz_zip_writer_init_from_reader(mz_zip_archive *pZip, const char *pFilename) +{ + mz_zip_internal_state *pState; + if ((!pZip) || (!pZip->m_pState) || (pZip->m_zip_mode != MZ_ZIP_MODE_READING)) + return MZ_FALSE; + // No sense in trying to write to an archive that's already at the support max size + if ((pZip->m_total_files == 0xFFFF) || ((pZip->m_archive_size + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE + MZ_ZIP_LOCAL_DIR_HEADER_SIZE) > 0xFFFFFFFF)) + return MZ_FALSE; + + pState = pZip->m_pState; + + if (pState->m_pFile) + { +#ifdef MINIZ_NO_STDIO + pFilename; return MZ_FALSE; +#else + // Archive is being read from stdio - try to reopen as writable. + if (pZip->m_pIO_opaque != pZip) + return MZ_FALSE; + if (!pFilename) + return MZ_FALSE; + pZip->m_pWrite = mz_zip_file_write_func; + if (NULL == (pState->m_pFile = MZ_FREOPEN(pFilename, "r+b", pState->m_pFile))) + { + // The mz_zip_archive is now in a bogus state because pState->m_pFile is NULL, so just close it. + mz_zip_reader_end(pZip); + return MZ_FALSE; + } +#endif // #ifdef MINIZ_NO_STDIO + } + else if (pState->m_pMem) + { + // Archive lives in a memory block. Assume it's from the heap that we can resize using the realloc callback. + if (pZip->m_pIO_opaque != pZip) + return MZ_FALSE; + pState->m_mem_capacity = pState->m_mem_size; + pZip->m_pWrite = mz_zip_heap_write_func; + } + // Archive is being read via a user provided read function - make sure the user has specified a write function too. + else if (!pZip->m_pWrite) + return MZ_FALSE; + + // Start writing new files at the archive's current central directory location. + pZip->m_archive_size = pZip->m_central_directory_file_ofs; + pZip->m_zip_mode = MZ_ZIP_MODE_WRITING; + pZip->m_central_directory_file_ofs = 0; + + return MZ_TRUE; +} + +mz_bool mz_zip_writer_add_mem(mz_zip_archive *pZip, const char *pArchive_name, const void *pBuf, size_t buf_size, mz_uint level_and_flags) +{ + return mz_zip_writer_add_mem_ex(pZip, pArchive_name, pBuf, buf_size, NULL, 0, level_and_flags, 0, 0); +} + +typedef struct +{ + mz_zip_archive *m_pZip; + mz_uint64 m_cur_archive_file_ofs; + mz_uint64 m_comp_size; +} mz_zip_writer_add_state; + +static mz_bool mz_zip_writer_add_put_buf_callback(const void* pBuf, int len, void *pUser) +{ + mz_zip_writer_add_state *pState = (mz_zip_writer_add_state *)pUser; + if ((int)pState->m_pZip->m_pWrite(pState->m_pZip->m_pIO_opaque, pState->m_cur_archive_file_ofs, pBuf, len) != len) + return MZ_FALSE; + pState->m_cur_archive_file_ofs += len; + pState->m_comp_size += len; + return MZ_TRUE; +} + +static mz_bool mz_zip_writer_create_local_dir_header(mz_zip_archive *pZip, mz_uint8 *pDst, mz_uint16 filename_size, mz_uint16 extra_size, mz_uint64 uncomp_size, mz_uint64 comp_size, mz_uint32 uncomp_crc32, mz_uint16 method, mz_uint16 bit_flags, mz_uint16 dos_time, mz_uint16 dos_date) +{ + (void)pZip; + memset(pDst, 0, MZ_ZIP_LOCAL_DIR_HEADER_SIZE); + MZ_WRITE_LE32(pDst + MZ_ZIP_LDH_SIG_OFS, MZ_ZIP_LOCAL_DIR_HEADER_SIG); + MZ_WRITE_LE16(pDst + MZ_ZIP_LDH_VERSION_NEEDED_OFS, method ? 20 : 0); + MZ_WRITE_LE16(pDst + MZ_ZIP_LDH_BIT_FLAG_OFS, bit_flags); + MZ_WRITE_LE16(pDst + MZ_ZIP_LDH_METHOD_OFS, method); + MZ_WRITE_LE16(pDst + MZ_ZIP_LDH_FILE_TIME_OFS, dos_time); + MZ_WRITE_LE16(pDst + MZ_ZIP_LDH_FILE_DATE_OFS, dos_date); + MZ_WRITE_LE32(pDst + MZ_ZIP_LDH_CRC32_OFS, uncomp_crc32); + MZ_WRITE_LE32(pDst + MZ_ZIP_LDH_COMPRESSED_SIZE_OFS, comp_size); + MZ_WRITE_LE32(pDst + MZ_ZIP_LDH_DECOMPRESSED_SIZE_OFS, uncomp_size); + MZ_WRITE_LE16(pDst + MZ_ZIP_LDH_FILENAME_LEN_OFS, filename_size); + MZ_WRITE_LE16(pDst + MZ_ZIP_LDH_EXTRA_LEN_OFS, extra_size); + return MZ_TRUE; +} + +static mz_bool mz_zip_writer_create_central_dir_header(mz_zip_archive *pZip, mz_uint8 *pDst, mz_uint16 filename_size, mz_uint16 extra_size, mz_uint16 comment_size, mz_uint64 uncomp_size, mz_uint64 comp_size, mz_uint32 uncomp_crc32, mz_uint16 method, mz_uint16 bit_flags, mz_uint16 dos_time, mz_uint16 dos_date, mz_uint64 local_header_ofs, mz_uint32 ext_attributes) +{ + (void)pZip; + memset(pDst, 0, MZ_ZIP_CENTRAL_DIR_HEADER_SIZE); + MZ_WRITE_LE32(pDst + MZ_ZIP_CDH_SIG_OFS, MZ_ZIP_CENTRAL_DIR_HEADER_SIG); + MZ_WRITE_LE16(pDst + MZ_ZIP_CDH_VERSION_NEEDED_OFS, method ? 20 : 0); + MZ_WRITE_LE16(pDst + MZ_ZIP_CDH_BIT_FLAG_OFS, bit_flags); + MZ_WRITE_LE16(pDst + MZ_ZIP_CDH_METHOD_OFS, method); + MZ_WRITE_LE16(pDst + MZ_ZIP_CDH_FILE_TIME_OFS, dos_time); + MZ_WRITE_LE16(pDst + MZ_ZIP_CDH_FILE_DATE_OFS, dos_date); + MZ_WRITE_LE32(pDst + MZ_ZIP_CDH_CRC32_OFS, uncomp_crc32); + MZ_WRITE_LE32(pDst + MZ_ZIP_CDH_COMPRESSED_SIZE_OFS, comp_size); + MZ_WRITE_LE32(pDst + MZ_ZIP_CDH_DECOMPRESSED_SIZE_OFS, uncomp_size); + MZ_WRITE_LE16(pDst + MZ_ZIP_CDH_FILENAME_LEN_OFS, filename_size); + MZ_WRITE_LE16(pDst + MZ_ZIP_CDH_EXTRA_LEN_OFS, extra_size); + MZ_WRITE_LE16(pDst + MZ_ZIP_CDH_COMMENT_LEN_OFS, comment_size); + MZ_WRITE_LE32(pDst + MZ_ZIP_CDH_EXTERNAL_ATTR_OFS, ext_attributes); + MZ_WRITE_LE32(pDst + MZ_ZIP_CDH_LOCAL_HEADER_OFS, local_header_ofs); + return MZ_TRUE; +} + +static mz_bool mz_zip_writer_add_to_central_dir(mz_zip_archive *pZip, const char *pFilename, mz_uint16 filename_size, const void *pExtra, mz_uint16 extra_size, const void *pComment, mz_uint16 comment_size, mz_uint64 uncomp_size, mz_uint64 comp_size, mz_uint32 uncomp_crc32, mz_uint16 method, mz_uint16 bit_flags, mz_uint16 dos_time, mz_uint16 dos_date, mz_uint64 local_header_ofs, mz_uint32 ext_attributes) +{ + mz_zip_internal_state *pState = pZip->m_pState; + mz_uint32 central_dir_ofs = (mz_uint32)pState->m_central_dir.m_size; + size_t orig_central_dir_size = pState->m_central_dir.m_size; + mz_uint8 central_dir_header[MZ_ZIP_CENTRAL_DIR_HEADER_SIZE]; + + // No zip64 support yet + if ((local_header_ofs > 0xFFFFFFFF) || (((mz_uint64)pState->m_central_dir.m_size + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE + filename_size + extra_size + comment_size) > 0xFFFFFFFF)) + return MZ_FALSE; + + if (!mz_zip_writer_create_central_dir_header(pZip, central_dir_header, filename_size, extra_size, comment_size, uncomp_size, comp_size, uncomp_crc32, method, bit_flags, dos_time, dos_date, local_header_ofs, ext_attributes)) + return MZ_FALSE; + + if ((!mz_zip_array_push_back(pZip, &pState->m_central_dir, central_dir_header, MZ_ZIP_CENTRAL_DIR_HEADER_SIZE)) || + (!mz_zip_array_push_back(pZip, &pState->m_central_dir, pFilename, filename_size)) || + (!mz_zip_array_push_back(pZip, &pState->m_central_dir, pExtra, extra_size)) || + (!mz_zip_array_push_back(pZip, &pState->m_central_dir, pComment, comment_size)) || + (!mz_zip_array_push_back(pZip, &pState->m_central_dir_offsets, ¢ral_dir_ofs, 1))) + { + // Try to push the central directory array back into its original state. + mz_zip_array_resize(pZip, &pState->m_central_dir, orig_central_dir_size, MZ_FALSE); + return MZ_FALSE; + } + + return MZ_TRUE; +} + +static mz_bool mz_zip_writer_validate_archive_name(const char *pArchive_name) +{ + // Basic ZIP archive filename validity checks: Valid filenames cannot start with a forward slash, cannot contain a drive letter, and cannot use DOS-style backward slashes. + if (*pArchive_name == '/') + return MZ_FALSE; + while (*pArchive_name) + { + if ((*pArchive_name == '\\') || (*pArchive_name == ':')) + return MZ_FALSE; + pArchive_name++; + } + return MZ_TRUE; +} + +static mz_uint mz_zip_writer_compute_padding_needed_for_file_alignment(mz_zip_archive *pZip) +{ + mz_uint32 n; + if (!pZip->m_file_offset_alignment) + return 0; + n = (mz_uint32)(pZip->m_archive_size & (pZip->m_file_offset_alignment - 1)); + return (pZip->m_file_offset_alignment - n) & (pZip->m_file_offset_alignment - 1); +} + +static mz_bool mz_zip_writer_write_zeros(mz_zip_archive *pZip, mz_uint64 cur_file_ofs, mz_uint32 n) +{ + char buf[4096]; + memset(buf, 0, MZ_MIN(sizeof(buf), n)); + while (n) + { + mz_uint32 s = MZ_MIN(sizeof(buf), n); + if (pZip->m_pWrite(pZip->m_pIO_opaque, cur_file_ofs, buf, s) != s) + return MZ_FALSE; + cur_file_ofs += s; n -= s; + } + return MZ_TRUE; +} + +mz_bool mz_zip_writer_add_mem_ex(mz_zip_archive *pZip, const char *pArchive_name, const void *pBuf, size_t buf_size, const void *pComment, mz_uint16 comment_size, mz_uint level_and_flags, mz_uint64 uncomp_size, mz_uint32 uncomp_crc32) +{ + mz_uint16 method = 0, dos_time = 0, dos_date = 0; + mz_uint level, ext_attributes = 0, num_alignment_padding_bytes; + mz_uint64 local_dir_header_ofs = pZip->m_archive_size, cur_archive_file_ofs = pZip->m_archive_size, comp_size = 0; + size_t archive_name_size; + mz_uint8 local_dir_header[MZ_ZIP_LOCAL_DIR_HEADER_SIZE]; + tdefl_compressor *pComp = NULL; + mz_bool store_data_uncompressed; + mz_zip_internal_state *pState; + + if ((int)level_and_flags < 0) + level_and_flags = MZ_DEFAULT_LEVEL; + level = level_and_flags & 0xF; + store_data_uncompressed = ((!level) || (level_and_flags & MZ_ZIP_FLAG_COMPRESSED_DATA)); + + if ((!pZip) || (!pZip->m_pState) || (pZip->m_zip_mode != MZ_ZIP_MODE_WRITING) || ((buf_size) && (!pBuf)) || (!pArchive_name) || ((comment_size) && (!pComment)) || (pZip->m_total_files == 0xFFFF) || (level > MZ_UBER_COMPRESSION)) + return MZ_FALSE; + + pState = pZip->m_pState; + + if ((!(level_and_flags & MZ_ZIP_FLAG_COMPRESSED_DATA)) && (uncomp_size)) + return MZ_FALSE; + // No zip64 support yet + if ((buf_size > 0xFFFFFFFF) || (uncomp_size > 0xFFFFFFFF)) + return MZ_FALSE; + if (!mz_zip_writer_validate_archive_name(pArchive_name)) + return MZ_FALSE; + +#ifndef MINIZ_NO_TIME + { + time_t cur_time; time(&cur_time); + mz_zip_time_to_dos_time(cur_time, &dos_time, &dos_date); + } +#endif // #ifndef MINIZ_NO_TIME + + archive_name_size = strlen(pArchive_name); + if (archive_name_size > 0xFFFF) + return MZ_FALSE; + + num_alignment_padding_bytes = mz_zip_writer_compute_padding_needed_for_file_alignment(pZip); + + // no zip64 support yet + if ((pZip->m_total_files == 0xFFFF) || ((pZip->m_archive_size + num_alignment_padding_bytes + MZ_ZIP_LOCAL_DIR_HEADER_SIZE + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE + comment_size + archive_name_size) > 0xFFFFFFFF)) + return MZ_FALSE; + + if ((archive_name_size) && (pArchive_name[archive_name_size - 1] == '/')) + { + // Set DOS Subdirectory attribute bit. + ext_attributes |= 0x10; + // Subdirectories cannot contain data. + if ((buf_size) || (uncomp_size)) + return MZ_FALSE; + } + + // Try to do any allocations before writing to the archive, so if an allocation fails the file remains unmodified. (A good idea if we're doing an in-place modification.) + if ((!mz_zip_array_ensure_room(pZip, &pState->m_central_dir, MZ_ZIP_CENTRAL_DIR_HEADER_SIZE + archive_name_size + comment_size)) || (!mz_zip_array_ensure_room(pZip, &pState->m_central_dir_offsets, 1))) + return MZ_FALSE; + + if ((!store_data_uncompressed) && (buf_size)) + { + if (NULL == (pComp = (tdefl_compressor *)pZip->m_pAlloc(pZip->m_pAlloc_opaque, 1, sizeof(tdefl_compressor)))) + return MZ_FALSE; + } + + if (!mz_zip_writer_write_zeros(pZip, cur_archive_file_ofs, num_alignment_padding_bytes + sizeof(local_dir_header))) + { + pZip->m_pFree(pZip->m_pAlloc_opaque, pComp); + return MZ_FALSE; + } + local_dir_header_ofs += num_alignment_padding_bytes; + if (pZip->m_file_offset_alignment) { MZ_ASSERT((local_dir_header_ofs & (pZip->m_file_offset_alignment - 1)) == 0); } + cur_archive_file_ofs += num_alignment_padding_bytes + sizeof(local_dir_header); + + MZ_CLEAR_OBJ(local_dir_header); + if (pZip->m_pWrite(pZip->m_pIO_opaque, cur_archive_file_ofs, pArchive_name, archive_name_size) != archive_name_size) + { + pZip->m_pFree(pZip->m_pAlloc_opaque, pComp); + return MZ_FALSE; + } + cur_archive_file_ofs += archive_name_size; + + if (!(level_and_flags & MZ_ZIP_FLAG_COMPRESSED_DATA)) + { + uncomp_crc32 = (mz_uint32)mz_crc32(MZ_CRC32_INIT, (const mz_uint8*)pBuf, buf_size); + uncomp_size = buf_size; + if (uncomp_size <= 3) + { + level = 0; + store_data_uncompressed = MZ_TRUE; + } + } + + if (store_data_uncompressed) + { + if (pZip->m_pWrite(pZip->m_pIO_opaque, cur_archive_file_ofs, pBuf, buf_size) != buf_size) + { + pZip->m_pFree(pZip->m_pAlloc_opaque, pComp); + return MZ_FALSE; + } + + cur_archive_file_ofs += buf_size; + comp_size = buf_size; + + if (level_and_flags & MZ_ZIP_FLAG_COMPRESSED_DATA) + method = MZ_DEFLATED; + } + else if (buf_size) + { + mz_zip_writer_add_state state; + + state.m_pZip = pZip; + state.m_cur_archive_file_ofs = cur_archive_file_ofs; + state.m_comp_size = 0; + + if ((tdefl_init(pComp, mz_zip_writer_add_put_buf_callback, &state, tdefl_create_comp_flags_from_zip_params(level, -15, MZ_DEFAULT_STRATEGY)) != TDEFL_STATUS_OKAY) || + (tdefl_compress_buffer(pComp, pBuf, buf_size, TDEFL_FINISH) != TDEFL_STATUS_DONE)) + { + pZip->m_pFree(pZip->m_pAlloc_opaque, pComp); + return MZ_FALSE; + } + + comp_size = state.m_comp_size; + cur_archive_file_ofs = state.m_cur_archive_file_ofs; + + method = MZ_DEFLATED; + } + + pZip->m_pFree(pZip->m_pAlloc_opaque, pComp); + pComp = NULL; + + // no zip64 support yet + if ((comp_size > 0xFFFFFFFF) || (cur_archive_file_ofs > 0xFFFFFFFF)) + return MZ_FALSE; + + if (!mz_zip_writer_create_local_dir_header(pZip, local_dir_header, (mz_uint16)archive_name_size, 0, uncomp_size, comp_size, uncomp_crc32, method, 0, dos_time, dos_date)) + return MZ_FALSE; + + if (pZip->m_pWrite(pZip->m_pIO_opaque, local_dir_header_ofs, local_dir_header, sizeof(local_dir_header)) != sizeof(local_dir_header)) + return MZ_FALSE; + + if (!mz_zip_writer_add_to_central_dir(pZip, pArchive_name, (mz_uint16)archive_name_size, NULL, 0, pComment, comment_size, uncomp_size, comp_size, uncomp_crc32, method, 0, dos_time, dos_date, local_dir_header_ofs, ext_attributes)) + return MZ_FALSE; + + pZip->m_total_files++; + pZip->m_archive_size = cur_archive_file_ofs; + + return MZ_TRUE; +} + +#ifndef MINIZ_NO_STDIO +mz_bool mz_zip_writer_add_file(mz_zip_archive *pZip, const char *pArchive_name, const char *pSrc_filename, const void *pComment, mz_uint16 comment_size, mz_uint level_and_flags) +{ + mz_uint uncomp_crc32 = MZ_CRC32_INIT, level, num_alignment_padding_bytes; + mz_uint16 method = 0, dos_time = 0, dos_date = 0, ext_attributes = 0; + mz_uint64 local_dir_header_ofs = pZip->m_archive_size, cur_archive_file_ofs = pZip->m_archive_size, uncomp_size = 0, comp_size = 0; + size_t archive_name_size; + mz_uint8 local_dir_header[MZ_ZIP_LOCAL_DIR_HEADER_SIZE]; + MZ_FILE *pSrc_file = NULL; + + if ((int)level_and_flags < 0) + level_and_flags = MZ_DEFAULT_LEVEL; + level = level_and_flags & 0xF; + + if ((!pZip) || (!pZip->m_pState) || (pZip->m_zip_mode != MZ_ZIP_MODE_WRITING) || (!pArchive_name) || ((comment_size) && (!pComment)) || (level > MZ_UBER_COMPRESSION)) + return MZ_FALSE; + if (level_and_flags & MZ_ZIP_FLAG_COMPRESSED_DATA) + return MZ_FALSE; + if (!mz_zip_writer_validate_archive_name(pArchive_name)) + return MZ_FALSE; + + archive_name_size = strlen(pArchive_name); + if (archive_name_size > 0xFFFF) + return MZ_FALSE; + + num_alignment_padding_bytes = mz_zip_writer_compute_padding_needed_for_file_alignment(pZip); + + // no zip64 support yet + if ((pZip->m_total_files == 0xFFFF) || ((pZip->m_archive_size + num_alignment_padding_bytes + MZ_ZIP_LOCAL_DIR_HEADER_SIZE + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE + comment_size + archive_name_size) > 0xFFFFFFFF)) + return MZ_FALSE; + + if (!mz_zip_get_file_modified_time(pSrc_filename, &dos_time, &dos_date)) + return MZ_FALSE; + + pSrc_file = MZ_FOPEN(pSrc_filename, "rb"); + if (!pSrc_file) + return MZ_FALSE; + MZ_FSEEK64(pSrc_file, 0, SEEK_END); + uncomp_size = MZ_FTELL64(pSrc_file); + MZ_FSEEK64(pSrc_file, 0, SEEK_SET); + + if (uncomp_size > 0xFFFFFFFF) + { + // No zip64 support yet + MZ_FCLOSE(pSrc_file); + return MZ_FALSE; + } + if (uncomp_size <= 3) + level = 0; + + if (!mz_zip_writer_write_zeros(pZip, cur_archive_file_ofs, num_alignment_padding_bytes + sizeof(local_dir_header))) + { + MZ_FCLOSE(pSrc_file); + return MZ_FALSE; + } + local_dir_header_ofs += num_alignment_padding_bytes; + if (pZip->m_file_offset_alignment) { MZ_ASSERT((local_dir_header_ofs & (pZip->m_file_offset_alignment - 1)) == 0); } + cur_archive_file_ofs += num_alignment_padding_bytes + sizeof(local_dir_header); + + MZ_CLEAR_OBJ(local_dir_header); + if (pZip->m_pWrite(pZip->m_pIO_opaque, cur_archive_file_ofs, pArchive_name, archive_name_size) != archive_name_size) + { + MZ_FCLOSE(pSrc_file); + return MZ_FALSE; + } + cur_archive_file_ofs += archive_name_size; + + if (uncomp_size) + { + mz_uint64 uncomp_remaining = uncomp_size; + void *pRead_buf = pZip->m_pAlloc(pZip->m_pAlloc_opaque, 1, MZ_ZIP_MAX_IO_BUF_SIZE); + if (!pRead_buf) + { + MZ_FCLOSE(pSrc_file); + return MZ_FALSE; + } + + if (!level) + { + while (uncomp_remaining) + { + mz_uint n = (mz_uint)MZ_MIN(MZ_ZIP_MAX_IO_BUF_SIZE, uncomp_remaining); + if ((MZ_FREAD(pRead_buf, 1, n, pSrc_file) != n) || (pZip->m_pWrite(pZip->m_pIO_opaque, cur_archive_file_ofs, pRead_buf, n) != n)) + { + pZip->m_pFree(pZip->m_pAlloc_opaque, pRead_buf); + MZ_FCLOSE(pSrc_file); + return MZ_FALSE; + } + uncomp_crc32 = (mz_uint32)mz_crc32(uncomp_crc32, (const mz_uint8 *)pRead_buf, n); + uncomp_remaining -= n; + cur_archive_file_ofs += n; + } + comp_size = uncomp_size; + } + else + { + mz_bool result = MZ_FALSE; + mz_zip_writer_add_state state; + tdefl_compressor *pComp = (tdefl_compressor *)pZip->m_pAlloc(pZip->m_pAlloc_opaque, 1, sizeof(tdefl_compressor)); + if (!pComp) + { + pZip->m_pFree(pZip->m_pAlloc_opaque, pRead_buf); + MZ_FCLOSE(pSrc_file); + return MZ_FALSE; + } + + state.m_pZip = pZip; + state.m_cur_archive_file_ofs = cur_archive_file_ofs; + state.m_comp_size = 0; + + if (tdefl_init(pComp, mz_zip_writer_add_put_buf_callback, &state, tdefl_create_comp_flags_from_zip_params(level, -15, MZ_DEFAULT_STRATEGY)) != TDEFL_STATUS_OKAY) + { + pZip->m_pFree(pZip->m_pAlloc_opaque, pComp); + pZip->m_pFree(pZip->m_pAlloc_opaque, pRead_buf); + MZ_FCLOSE(pSrc_file); + return MZ_FALSE; + } + + for ( ; ; ) + { + size_t in_buf_size = (mz_uint32)MZ_MIN(uncomp_remaining, MZ_ZIP_MAX_IO_BUF_SIZE); + tdefl_status status; + + if (MZ_FREAD(pRead_buf, 1, in_buf_size, pSrc_file) != in_buf_size) + break; + + uncomp_crc32 = (mz_uint32)mz_crc32(uncomp_crc32, (const mz_uint8 *)pRead_buf, in_buf_size); + uncomp_remaining -= in_buf_size; + + status = tdefl_compress_buffer(pComp, pRead_buf, in_buf_size, uncomp_remaining ? TDEFL_NO_FLUSH : TDEFL_FINISH); + if (status == TDEFL_STATUS_DONE) + { + result = MZ_TRUE; + break; + } + else if (status != TDEFL_STATUS_OKAY) + break; + } + + pZip->m_pFree(pZip->m_pAlloc_opaque, pComp); + + if (!result) + { + pZip->m_pFree(pZip->m_pAlloc_opaque, pRead_buf); + MZ_FCLOSE(pSrc_file); + return MZ_FALSE; + } + + comp_size = state.m_comp_size; + cur_archive_file_ofs = state.m_cur_archive_file_ofs; + + method = MZ_DEFLATED; + } + + pZip->m_pFree(pZip->m_pAlloc_opaque, pRead_buf); + } + + MZ_FCLOSE(pSrc_file); pSrc_file = NULL; + + // no zip64 support yet + if ((comp_size > 0xFFFFFFFF) || (cur_archive_file_ofs > 0xFFFFFFFF)) + return MZ_FALSE; + + if (!mz_zip_writer_create_local_dir_header(pZip, local_dir_header, (mz_uint16)archive_name_size, 0, uncomp_size, comp_size, uncomp_crc32, method, 0, dos_time, dos_date)) + return MZ_FALSE; + + if (pZip->m_pWrite(pZip->m_pIO_opaque, local_dir_header_ofs, local_dir_header, sizeof(local_dir_header)) != sizeof(local_dir_header)) + return MZ_FALSE; + + if (!mz_zip_writer_add_to_central_dir(pZip, pArchive_name, (mz_uint16)archive_name_size, NULL, 0, pComment, comment_size, uncomp_size, comp_size, uncomp_crc32, method, 0, dos_time, dos_date, local_dir_header_ofs, ext_attributes)) + return MZ_FALSE; + + pZip->m_total_files++; + pZip->m_archive_size = cur_archive_file_ofs; + + return MZ_TRUE; +} +#endif // #ifndef MINIZ_NO_STDIO + +mz_bool mz_zip_writer_add_from_zip_reader(mz_zip_archive *pZip, mz_zip_archive *pSource_zip, mz_uint file_index) +{ + mz_uint n, bit_flags, num_alignment_padding_bytes; + mz_uint64 comp_bytes_remaining, local_dir_header_ofs; + mz_uint64 cur_src_file_ofs, cur_dst_file_ofs; + mz_uint32 local_header_u32[(MZ_ZIP_LOCAL_DIR_HEADER_SIZE + sizeof(mz_uint32) - 1) / sizeof(mz_uint32)]; mz_uint8 *pLocal_header = (mz_uint8 *)local_header_u32; + mz_uint8 central_header[MZ_ZIP_CENTRAL_DIR_HEADER_SIZE]; + size_t orig_central_dir_size; + mz_zip_internal_state *pState; + void *pBuf; const mz_uint8 *pSrc_central_header; + + if ((!pZip) || (!pZip->m_pState) || (pZip->m_zip_mode != MZ_ZIP_MODE_WRITING)) + return MZ_FALSE; + if (NULL == (pSrc_central_header = mz_zip_reader_get_cdh(pSource_zip, file_index))) + return MZ_FALSE; + pState = pZip->m_pState; + + num_alignment_padding_bytes = mz_zip_writer_compute_padding_needed_for_file_alignment(pZip); + + // no zip64 support yet + if ((pZip->m_total_files == 0xFFFF) || ((pZip->m_archive_size + num_alignment_padding_bytes + MZ_ZIP_LOCAL_DIR_HEADER_SIZE + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE) > 0xFFFFFFFF)) + return MZ_FALSE; + + cur_src_file_ofs = MZ_READ_LE32(pSrc_central_header + MZ_ZIP_CDH_LOCAL_HEADER_OFS); + cur_dst_file_ofs = pZip->m_archive_size; + + if (pSource_zip->m_pRead(pSource_zip->m_pIO_opaque, cur_src_file_ofs, pLocal_header, MZ_ZIP_LOCAL_DIR_HEADER_SIZE) != MZ_ZIP_LOCAL_DIR_HEADER_SIZE) + return MZ_FALSE; + if (MZ_READ_LE32(pLocal_header) != MZ_ZIP_LOCAL_DIR_HEADER_SIG) + return MZ_FALSE; + cur_src_file_ofs += MZ_ZIP_LOCAL_DIR_HEADER_SIZE; + + if (!mz_zip_writer_write_zeros(pZip, cur_dst_file_ofs, num_alignment_padding_bytes)) + return MZ_FALSE; + cur_dst_file_ofs += num_alignment_padding_bytes; + local_dir_header_ofs = cur_dst_file_ofs; + if (pZip->m_file_offset_alignment) { MZ_ASSERT((local_dir_header_ofs & (pZip->m_file_offset_alignment - 1)) == 0); } + + if (pZip->m_pWrite(pZip->m_pIO_opaque, cur_dst_file_ofs, pLocal_header, MZ_ZIP_LOCAL_DIR_HEADER_SIZE) != MZ_ZIP_LOCAL_DIR_HEADER_SIZE) + return MZ_FALSE; + cur_dst_file_ofs += MZ_ZIP_LOCAL_DIR_HEADER_SIZE; + + n = MZ_READ_LE16(pLocal_header + MZ_ZIP_LDH_FILENAME_LEN_OFS) + MZ_READ_LE16(pLocal_header + MZ_ZIP_LDH_EXTRA_LEN_OFS); + comp_bytes_remaining = n + MZ_READ_LE32(pSrc_central_header + MZ_ZIP_CDH_COMPRESSED_SIZE_OFS); + + if (NULL == (pBuf = pZip->m_pAlloc(pZip->m_pAlloc_opaque, 1, (size_t)MZ_MAX(sizeof(mz_uint32) * 4, MZ_MIN(MZ_ZIP_MAX_IO_BUF_SIZE, comp_bytes_remaining))))) + return MZ_FALSE; + + while (comp_bytes_remaining) + { + n = (mz_uint)MZ_MIN(MZ_ZIP_MAX_IO_BUF_SIZE, comp_bytes_remaining); + if (pSource_zip->m_pRead(pSource_zip->m_pIO_opaque, cur_src_file_ofs, pBuf, n) != n) + { + pZip->m_pFree(pZip->m_pAlloc_opaque, pBuf); + return MZ_FALSE; + } + cur_src_file_ofs += n; + + if (pZip->m_pWrite(pZip->m_pIO_opaque, cur_dst_file_ofs, pBuf, n) != n) + { + pZip->m_pFree(pZip->m_pAlloc_opaque, pBuf); + return MZ_FALSE; + } + cur_dst_file_ofs += n; + + comp_bytes_remaining -= n; + } + + bit_flags = MZ_READ_LE16(pLocal_header + MZ_ZIP_LDH_BIT_FLAG_OFS); + if (bit_flags & 8) + { + // Copy data descriptor + if (pSource_zip->m_pRead(pSource_zip->m_pIO_opaque, cur_src_file_ofs, pBuf, sizeof(mz_uint32) * 4) != sizeof(mz_uint32) * 4) + { + pZip->m_pFree(pZip->m_pAlloc_opaque, pBuf); + return MZ_FALSE; + } + + n = sizeof(mz_uint32) * ((MZ_READ_LE32(pBuf) == 0x08074b50) ? 4 : 3); + if (pZip->m_pWrite(pZip->m_pIO_opaque, cur_dst_file_ofs, pBuf, n) != n) + { + pZip->m_pFree(pZip->m_pAlloc_opaque, pBuf); + return MZ_FALSE; + } + + cur_src_file_ofs += n; + cur_dst_file_ofs += n; + } + pZip->m_pFree(pZip->m_pAlloc_opaque, pBuf); + + // no zip64 support yet + if (cur_dst_file_ofs > 0xFFFFFFFF) + return MZ_FALSE; + + orig_central_dir_size = pState->m_central_dir.m_size; + + memcpy(central_header, pSrc_central_header, MZ_ZIP_CENTRAL_DIR_HEADER_SIZE); + MZ_WRITE_LE32(central_header + MZ_ZIP_CDH_LOCAL_HEADER_OFS, local_dir_header_ofs); + if (!mz_zip_array_push_back(pZip, &pState->m_central_dir, central_header, MZ_ZIP_CENTRAL_DIR_HEADER_SIZE)) + return MZ_FALSE; + + n = MZ_READ_LE16(pSrc_central_header + MZ_ZIP_CDH_FILENAME_LEN_OFS) + MZ_READ_LE16(pSrc_central_header + MZ_ZIP_CDH_EXTRA_LEN_OFS) + MZ_READ_LE16(pSrc_central_header + MZ_ZIP_CDH_COMMENT_LEN_OFS); + if (!mz_zip_array_push_back(pZip, &pState->m_central_dir, pSrc_central_header + MZ_ZIP_CENTRAL_DIR_HEADER_SIZE, n)) + { + mz_zip_array_resize(pZip, &pState->m_central_dir, orig_central_dir_size, MZ_FALSE); + return MZ_FALSE; + } + + if (pState->m_central_dir.m_size > 0xFFFFFFFF) + return MZ_FALSE; + n = (mz_uint32)orig_central_dir_size; + if (!mz_zip_array_push_back(pZip, &pState->m_central_dir_offsets, &n, 1)) + { + mz_zip_array_resize(pZip, &pState->m_central_dir, orig_central_dir_size, MZ_FALSE); + return MZ_FALSE; + } + + pZip->m_total_files++; + pZip->m_archive_size = cur_dst_file_ofs; + + return MZ_TRUE; +} + +mz_bool mz_zip_writer_finalize_archive(mz_zip_archive *pZip) +{ + mz_zip_internal_state *pState; + mz_uint64 central_dir_ofs, central_dir_size; + mz_uint8 hdr[MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIZE]; + + if ((!pZip) || (!pZip->m_pState) || (pZip->m_zip_mode != MZ_ZIP_MODE_WRITING)) + return MZ_FALSE; + + pState = pZip->m_pState; + + // no zip64 support yet + if ((pZip->m_total_files > 0xFFFF) || ((pZip->m_archive_size + pState->m_central_dir.m_size + MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIZE) > 0xFFFFFFFF)) + return MZ_FALSE; + + central_dir_ofs = 0; + central_dir_size = 0; + if (pZip->m_total_files) + { + // Write central directory + central_dir_ofs = pZip->m_archive_size; + central_dir_size = pState->m_central_dir.m_size; + pZip->m_central_directory_file_ofs = central_dir_ofs; + if (pZip->m_pWrite(pZip->m_pIO_opaque, central_dir_ofs, pState->m_central_dir.m_p, (size_t)central_dir_size) != central_dir_size) + return MZ_FALSE; + pZip->m_archive_size += central_dir_size; + } + + // Write end of central directory record + MZ_CLEAR_OBJ(hdr); + MZ_WRITE_LE32(hdr + MZ_ZIP_ECDH_SIG_OFS, MZ_ZIP_END_OF_CENTRAL_DIR_HEADER_SIG); + MZ_WRITE_LE16(hdr + MZ_ZIP_ECDH_CDIR_NUM_ENTRIES_ON_DISK_OFS, pZip->m_total_files); + MZ_WRITE_LE16(hdr + MZ_ZIP_ECDH_CDIR_TOTAL_ENTRIES_OFS, pZip->m_total_files); + MZ_WRITE_LE32(hdr + MZ_ZIP_ECDH_CDIR_SIZE_OFS, central_dir_size); + MZ_WRITE_LE32(hdr + MZ_ZIP_ECDH_CDIR_OFS_OFS, central_dir_ofs); + + if (pZip->m_pWrite(pZip->m_pIO_opaque, pZip->m_archive_size, hdr, sizeof(hdr)) != sizeof(hdr)) + return MZ_FALSE; +#ifndef MINIZ_NO_STDIO + if ((pState->m_pFile) && (MZ_FFLUSH(pState->m_pFile) == EOF)) + return MZ_FALSE; +#endif // #ifndef MINIZ_NO_STDIO + + pZip->m_archive_size += sizeof(hdr); + + pZip->m_zip_mode = MZ_ZIP_MODE_WRITING_HAS_BEEN_FINALIZED; + return MZ_TRUE; +} + +mz_bool mz_zip_writer_finalize_heap_archive(mz_zip_archive *pZip, void **pBuf, size_t *pSize) +{ + if ((!pZip) || (!pZip->m_pState) || (!pBuf) || (!pSize)) + return MZ_FALSE; + if (pZip->m_pWrite != mz_zip_heap_write_func) + return MZ_FALSE; + if (!mz_zip_writer_finalize_archive(pZip)) + return MZ_FALSE; + + *pBuf = pZip->m_pState->m_pMem; + *pSize = pZip->m_pState->m_mem_size; + pZip->m_pState->m_pMem = NULL; + pZip->m_pState->m_mem_size = pZip->m_pState->m_mem_capacity = 0; + return MZ_TRUE; +} + +mz_bool mz_zip_writer_end(mz_zip_archive *pZip) +{ + mz_zip_internal_state *pState; + mz_bool status = MZ_TRUE; + if ((!pZip) || (!pZip->m_pState) || (!pZip->m_pAlloc) || (!pZip->m_pFree) || ((pZip->m_zip_mode != MZ_ZIP_MODE_WRITING) && (pZip->m_zip_mode != MZ_ZIP_MODE_WRITING_HAS_BEEN_FINALIZED))) + return MZ_FALSE; + + pState = pZip->m_pState; + pZip->m_pState = NULL; + mz_zip_array_clear(pZip, &pState->m_central_dir); + mz_zip_array_clear(pZip, &pState->m_central_dir_offsets); + mz_zip_array_clear(pZip, &pState->m_sorted_central_dir_offsets); + +#ifndef MINIZ_NO_STDIO + if (pState->m_pFile) + { + MZ_FCLOSE(pState->m_pFile); + pState->m_pFile = NULL; + } +#endif // #ifndef MINIZ_NO_STDIO + + if ((pZip->m_pWrite == mz_zip_heap_write_func) && (pState->m_pMem)) + { + pZip->m_pFree(pZip->m_pAlloc_opaque, pState->m_pMem); + pState->m_pMem = NULL; + } + + pZip->m_pFree(pZip->m_pAlloc_opaque, pState); + pZip->m_zip_mode = MZ_ZIP_MODE_INVALID; + return status; +} + +#ifndef MINIZ_NO_STDIO +mz_bool mz_zip_add_mem_to_archive_file_in_place(const char *pZip_filename, const char *pArchive_name, const void *pBuf, size_t buf_size, const void *pComment, mz_uint16 comment_size, mz_uint level_and_flags) +{ + mz_bool status, created_new_archive = MZ_FALSE; + mz_zip_archive zip_archive; + struct MZ_FILE_STAT_STRUCT file_stat; + MZ_CLEAR_OBJ(zip_archive); + if ((int)level_and_flags < 0) + level_and_flags = MZ_DEFAULT_LEVEL; + if ((!pZip_filename) || (!pArchive_name) || ((buf_size) && (!pBuf)) || ((comment_size) && (!pComment)) || ((level_and_flags & 0xF) > MZ_UBER_COMPRESSION)) + return MZ_FALSE; + if (!mz_zip_writer_validate_archive_name(pArchive_name)) + return MZ_FALSE; + if (MZ_FILE_STAT(pZip_filename, &file_stat) != 0) + { + // Create a new archive. + if (!mz_zip_writer_init_file(&zip_archive, pZip_filename, 0)) + return MZ_FALSE; + created_new_archive = MZ_TRUE; + } + else + { + // Append to an existing archive. + if (!mz_zip_reader_init_file(&zip_archive, pZip_filename, level_and_flags | MZ_ZIP_FLAG_DO_NOT_SORT_CENTRAL_DIRECTORY)) + return MZ_FALSE; + if (!mz_zip_writer_init_from_reader(&zip_archive, pZip_filename)) + { + mz_zip_reader_end(&zip_archive); + return MZ_FALSE; + } + } + status = mz_zip_writer_add_mem_ex(&zip_archive, pArchive_name, pBuf, buf_size, pComment, comment_size, level_and_flags, 0, 0); + // Always finalize, even if adding failed for some reason, so we have a valid central directory. (This may not always succeed, but we can try.) + if (!mz_zip_writer_finalize_archive(&zip_archive)) + status = MZ_FALSE; + if (!mz_zip_writer_end(&zip_archive)) + status = MZ_FALSE; + if ((!status) && (created_new_archive)) + { + // It's a new archive and something went wrong, so just delete it. + int ignoredStatus = MZ_DELETE_FILE(pZip_filename); + (void)ignoredStatus; + } + return status; +} + +void *mz_zip_extract_archive_file_to_heap(const char *pZip_filename, const char *pArchive_name, size_t *pSize, mz_uint flags) +{ + int file_index; + mz_zip_archive zip_archive; + void *p = NULL; + + if (pSize) + *pSize = 0; + + if ((!pZip_filename) || (!pArchive_name)) + return NULL; + + MZ_CLEAR_OBJ(zip_archive); + if (!mz_zip_reader_init_file(&zip_archive, pZip_filename, flags | MZ_ZIP_FLAG_DO_NOT_SORT_CENTRAL_DIRECTORY)) + return NULL; + + if ((file_index = mz_zip_reader_locate_file(&zip_archive, pArchive_name, NULL, flags)) >= 0) + p = mz_zip_reader_extract_to_heap(&zip_archive, file_index, pSize, flags); + + mz_zip_reader_end(&zip_archive); + return p; +} + +#endif // #ifndef MINIZ_NO_STDIO + +#endif // #ifndef MINIZ_NO_ARCHIVE_WRITING_APIS + +#endif // #ifndef MINIZ_NO_ARCHIVE_APIS + +#ifdef __cplusplus +} +#endif + +#endif // MINIZ_HEADER_FILE_ONLY + +/* + This is free and unencumbered software released into the public domain. + + Anyone is free to copy, modify, publish, use, compile, sell, or + distribute this software, either in source code form or as a compiled + binary, for any purpose, commercial or non-commercial, and by any + means. + + In jurisdictions that recognize copyright laws, the author or authors + of this software dedicate any and all copyright interest in the + software to the public domain. We make this dedication for the benefit + of the public at large and to the detriment of our heirs and + successors. We intend this dedication to be an overt act of + relinquishment in perpetuity of all present and future rights to this + software under copyright law. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, + EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF + MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. + IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR + OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, + ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR + OTHER DEALINGS IN THE SOFTWARE. + + For more information, please refer to +*/ diff --git a/Toolboxes/spm12/@gifti/private/mvtk_read.m b/Toolboxes/spm12/@gifti/private/mvtk_read.m new file mode 100644 index 0000000000000000000000000000000000000000..a614e1b4f65e59b617a9e90849c56707243c812d --- /dev/null +++ b/Toolboxes/spm12/@gifti/private/mvtk_read.m @@ -0,0 +1,165 @@ +function M = mvtk_read(filename) +% Read VTK formatted data from disk +% FORMAT M = mvtk_read(filename) +% +% filename - VTK-formatted file name +% M - data structure +%__________________________________________________________________________ +% +% VTK File Formats Specifications: +% http://www.vtk.org/VTK/img/file-formats.pdf +% +% Requirements: zstream, base64decode +%__________________________________________________________________________ +% Copyright (C) 2015 Wellcome Trust Centre for Neuroimaging + +% Guillaume Flandin +% $Id: mvtk_read.m 6601 2015-11-19 13:55:32Z guillaume $ + + +[pth,name,ext] = fileparts(filename); +switch ext + case '.vtk' + M = mvtk_read_legacy(filename); + case {'.vti','.vtp','.vtr','.vts','.vtu'} + % Serial vtkImageData (structured) + % Serial vtkPolyData (unstructured) + % Serial vtkRectilinearGrid (structured) + % Serial vtkStructuredGrid (structured) + % Serial vtkUnstructuredGrid (unstructured) + M = mvtk_read_xml(filename); + otherwise + error('Unknown file format.'); +end + +%========================================================================== +% function M = mvtk_read_legacy(filename) +%========================================================================== +function M = mvtk_read_legacy(filename) + +fid = fopen(filename,'rt'); +if fid == -1 + error('Cannot open %s.',filename); +end + +%- Part 1: file version and identifier +% # vtk DataFile Version 2.0 +l = fgetl(fid); +if ~ischar(l), error('VTK file incomplete.'); end +if ~strncmpi(l,'# vtk DataFile Version',22) + error('This is not a VTK formatted file.'); +end + +%- Part 2: header +l = fgetl(fid); +if ~ischar(l), error('VTK file incomplete.'); end + +%- Part 3: file format +format = fgetl(fid); +if ~ismember(format,{'ASCII','BINARY'}) + error('Unknown file format.'); +end + +%- Part 4: dataset structure +data_attributes = false; +l = fgetl(fid); +if ~ischar(l), error('VTK file incomplete.'); end +[D,l] = strtok(l); +if ~strcmp(D,'DATASET'), error('Invalid VTK file.'); end +F = strtok(l(2:end)); +switch F + case 'STRUCTURED_POINTS' + warning('Unsupported dataset format.'); + l = fgetl(fid); + DIM = sscanf(l,'DIMENSIONS %d %d %d'); + l = fgetl(fid); + ORIGIN = sscanf(l,'ORIGIN %f %f %f'); + l = fgetl(fid); + SPACING = sscanf(l,'SPACING %f %f %f'); + case 'STRUCTURED_GRID' + warning('Unsupported dataset format.'); + l = fgetl(fid); + DIM = sscanf(l,'DIMENSIONS %d %d %d'); + l = fgetl(fid); + % assume float and n = prod(DIM) + PTS = textscan(fid,'%f %f %f\n',prod(DIM),'CollectOutput',true); + PTS = PTS{1}; + case 'RECTILINEAR_GRID' + warning('Unsupported dataset format.'); + l = fgetl(fid); + DIM = sscanf(l,'DIMENSIONS %d %d %d'); + l = fgetl(fid); + XCOORDS = textscan(fid,'%f',DIM(1),'CollectOutput',true); + XCOORDS = XCOORDS{1}; + l = fgetl(fid); + YCOORDS = textscan(fid,'%f',DIM(2),'CollectOutput',true); + YCOORDS = YCOORDS{1}; + l = fgetl(fid); + ZCOORDS = textscan(fid,'%f',DIM(3),'CollectOutput',true); + ZCOORDS = ZCOORDS{1}; + case 'POLYDATA' + while true + l = fgetl(fid); + if ~ischar(l), break; end + [D,l] = strtok(l); + switch D + case 'POINTS' + [N,l] = strtok(l(2:end)); % l still contains dataType + N = str2double(N); + M.vertices = textscan(fid,'%f %f %f\n',N,'CollectOutput',true); + M.vertices = M.vertices{1}; + case 'POLYGONS' + [N,l] = strtok(l(2:end)); + N = str2double(N); + S = strtok(l); + S = str2double(S); + if 4*N ~= S, error('Unsupported dataset format.'); end + M.faces = textscan(fid,'3 %d %d %d\n',N,'CollectOutput',true); + M.faces = M.faces{1} + 1; + case {'VERTICES','LINES','TRIANGLE_STRIPS'} + error('Unsupported data type.'); + case {'POINT_DATA','CELL_DATA'} + data_attributes = true; + [N,l] = strtok(l(2:end)); + N = str2double(N); + break; + otherwise + error('Invalid VTK file.'); + end + end + case {'UNSTRUCTURED_GRID','FIELD'} + error('Unsupported data type.'); + otherwise + error('Invalid VTK file.'); +end + +%- Part 5: dataset attributes (POINT_DATA and CELL_DATA) +if data_attributes + %l = fgetl(fid); % {POINT_DATA,CELL_DATA} N + l = fgetl(fid); % SCALARS dataName dataType numComp + [P,l] = strtok(l); + [S,l] = strtok(l(2:end)); + [S,l] = strtok(l(2:end)); + S = strtok(l(2:end)); S = str2double(S); + l = fgetl(fid); % LOOKUP_TABLE default + fmt = repmat('%f ',1,S); + fmt = [fmt(1:end-1) '\n']; + M.cdata = textscan(fid,fmt,N,'CollectOutput',true); + M.cdata = M.cdata{1}; +end + +fclose(fid); + +%========================================================================== +% function M = mvtk_read_xml(filename) +%========================================================================== +function M = mvtk_read_xml(filename) + +try + X = xmltree(filename); +catch + error('Cannot parse file %s.',filename); +end + +warning('Unsupported file format.'); +M = struct([]); diff --git a/Toolboxes/spm12/@gifti/private/mvtk_write.m b/Toolboxes/spm12/@gifti/private/mvtk_write.m new file mode 100644 index 0000000000000000000000000000000000000000..e4e7bf30a62630245bebe9efd4af4d3ac7bf1fb7 --- /dev/null +++ b/Toolboxes/spm12/@gifti/private/mvtk_write.m @@ -0,0 +1,569 @@ +function mvtk_write(M,filename,format) +% Write geometric data on disk using VTK file format (legacy/XML,ascii/binary) +% FORMAT mvtk_write(M,filename,format) +% +% M - data structure +% filename - output filename [Default: 'untitled'] +% format - VTK file format: legacy, legacy-ascii, legacy-binary, xml, +% xml-ascii, xml-binary [Default: 'legacy-ascii'] +%__________________________________________________________________________ +% +% VTK File Formats Specifications: +% http://www.vtk.org/VTK/img/file-formats.pdf +% +% Requirements: zstream, base64encode +%__________________________________________________________________________ +% Copyright (C) 2015 Wellcome Trust Centre for Neuroimaging + +% Guillaume Flandin +% $Id: mvtk_write.m 6601 2015-11-19 13:55:32Z guillaume $ + + +%-Input parameters +%-------------------------------------------------------------------------- +if nargin < 2 || isempty(filename), filename = 'untitled'; end +if nargin < 3 || isempty(format) + [pth,name,ext] = fileparts(filename); + switch ext + case '' + format = 'legacy-ascii'; % default + ext = '.vtk'; + filename = fullfile(pth,[name ext]); + case '.vtk' + format = 'legacy-ascii'; + case 'vtp' + format = 'xml-ascii'; + case {'.vti','.vtr','.vts','.vtu'} + format = 'xml-ascii'; + warning('Only partially handled.'); + otherwise + error('Unknown file extension.'); + end +else + switch lower(format) + case {'legacy','legacy-ascii','legacy-binary'} + ext = '.vtk'; + case {'xml','xml-ascii','xml-binary','xml-appended'} + ext = '.vtp'; + otherwise + error('Unknown file format.'); + end +end + +%-Filename +%-------------------------------------------------------------------------- +[pth,name,e] = fileparts(filename); +if ~strcmpi(e,ext) + warning('Changing file extension from %s to %s.',e,ext); +end +filename = fullfile(pth,[name ext]); + +%-Convert input structure if necessary +%-------------------------------------------------------------------------- + +%-Three scalars per item interpreted as color +% if isfield(M,'cdata') && size(M.cdata,2) == 3 +% M.color = M.cdata; +% M = rmfield(M,'cdata'); +% end + +%-Compute normals +if ~isfield(M,'normals') + M.normals = compute_normals(M); +end + +%-Write file +%-------------------------------------------------------------------------- +switch lower(format) + case {'legacy','legacy-ascii'} + mvtk_write_legacy(M,filename,'ASCII'); + case {'legacy-binary'} + mvtk_write_legacy(M,filename,'BINARY'); + case {'xml','xml-ascii'} + mvtk_write_xml(M,filename,'ASCII'); + case {'xml-binary'} + mvtk_write_xml(M,filename,'BINARY'); + case {'xml-appended'} + mvtk_write_xml(M,filename,'APPENDED'); + otherwise + error('Unknown file format.'); +end + + +%========================================================================== +% function fid = mvtk_write_legacy(s,filename,format) +%========================================================================== +function fid = mvtk_write_legacy(s,filename,format) + +%-Open file +%-------------------------------------------------------------------------- +if nargin == 2, format = 'ASCII'; else format = upper(format); end +switch format + case 'ASCII' + fopen_opts = {'wt'}; + write_data = @(fid,fmt,prec,dat) fprintf(fid,fmt,dat); + case 'BINARY' + fopen_opts = {'wb','ieee-be'}; + write_data = @(fid,fmt,prec,dat) [fwrite(fid,dat,prec);fprintf(fid,'\n');]; + otherwise + error('Unknown file format.'); +end +fid = fopen(filename,fopen_opts{:}); +if fid == -1 + error('Unable to write file %s: permission denied.',filename); +end + +%-Legacy VTK file format +%========================================================================== + +%- Part 1: file version and identifier +%-------------------------------------------------------------------------- +fprintf(fid,'# vtk DataFile Version 2.0\n'); + +%- Part 2: header +%-------------------------------------------------------------------------- +hdr = 'Saved using mVTK'; +fprintf(fid,'%s\n',hdr(1:min(length(hdr),256))); + +%- Part 3: data type (either ASCII or BINARY) +%-------------------------------------------------------------------------- +fprintf(fid,'%s\n',format); + +%- Part 4: dataset structure: geometry/topology +%-------------------------------------------------------------------------- +% One of: STRUCTURED_POINTS, STRUCTURED_GRID, UNSTRUCTURED_GRID, POLYDATA, +% RECTILINEAR_GRID, FIELD +if isfield(s,'vertices') && isfield(s,'faces') + type = 'POLYDATA'; +elseif isfield(s,'vertices') + type = 'UNSTRUCTURED_GRID'; +elseif isfield(s,'spacing') + type = 'STRUCTURED_POINTS'; +%elseif isfield(s,'mat') +% type = 'STRUCTURED_GRID'; +else + error('Unknown dataset structure.'); +end +fprintf(fid,'DATASET %s\n',type); +if isfield(s,'vertices') + fprintf(fid,'POINTS %d %s\n',size(s.vertices,1),'float'); + write_data(fid,'%f %f %f\n','float32',s.vertices'); +end +if isfield(s,'faces') + nFaces = size(s.faces,1); + nConn = size(s.faces,2); + fprintf(fid,'POLYGONS %d %d\n',nFaces,nFaces*(nConn+1)); + dat = uint32([repmat(nConn,1,nFaces); (s.faces'-1)]); + fmt = repmat('%d ',1,size(dat,1)); fmt(end) = ''; + write_data(fid,[fmt '\n'],'uint32',dat); +end +if isfield(s,'spacing') + fprintf(fid,'DIMENSIONS %d %d %d\n',size(s.cdata)); + fprintf(fid,'ORIGIN %f %f %f\n',s.origin); + fprintf(fid,'SPACING %f %f %f\n',s.spacing); + s.cdata = s.cdata(:); +end +% if isfield(s,'mat') +% dim = size(s.cdata); +% fprintf(fid,'DIMENSIONS %d %d %d\n',dim); +% fprintf(fid,'POINTS %d %s\n',prod(dim),'float'); +% [R,C,P] = ndgrid(1:dim(1),1:dim(2),1:dim(3)); +% RCP = [R(:)';C(:)';P(:)']; +% clear R C P +% RCP(4,:) = 1; +% XYZmm = s.mat(1:3,:)*RCP; +% write_data(fid,'%f %f %f\n','float32',XYZmm); +% s.cdata = s.cdata(:); +% end +fprintf(fid,'\n'); + +%- Part 5: dataset attributes (POINT_DATA and CELL_DATA) +%-------------------------------------------------------------------------- +point_data_hdr = false; + +%-SCALARS (and LOOKUP_TABLE) +if isfield(s,'cdata') && ~isempty(s.cdata) + if ~point_data_hdr + fprintf(fid,'POINT_DATA %d\n',size(s.cdata,1)); + point_data_hdr = true; + end + if ~isfield(s,'lut') + lut_name = 'default'; + else + lut_name = 'my_lut'; + if size(s.lut,2) == 3 + s.lut = [s.lut ones(size(s.lut,1),1)]; % alpha + end + end + dataName = 'cdata'; + fprintf(fid,'SCALARS %s %s %d\n',dataName,'float',size(s.cdata,2)); + fprintf(fid,'LOOKUP_TABLE %s\n',lut_name); + fmt = repmat('%f ',1,size(s.cdata,2)); fmt(end) = ''; + write_data(fid,[fmt '\n'],'float32',s.cdata'); + if ~strcmp(lut_name,'default') + fprintf(fid,'LOOKUP_TABLE %s %d\n',lut_name,size(s.lut,1)); + if strcmp(format,'ASCII') + % float values between (0,1) + write_data(fid,'%f %f %f %f\n','float32',s.lut'); % rescale + else + % four unsigned char values per table entry + write_data(fid,'','uint8',uint8(s.lut')); % rescale + end + end +end + +%-COLOR_SCALARS +if isfield(s,'color') && ~isempty(s.color) + if ~point_data_hdr + fprintf(fid,'POINT_DATA %d\n',size(s.color,1)); + point_data_hdr = true; + end + dataName = 'color'; + fprintf(fid,'COLOR_SCALARS %s %d\n',dataName,size(s.color,2)); + if strcmp(format,'ASCII') + % nValues float values between (0.1) + fmt = repmat('%f ',1,size(s.color,2)); fmt(end) = ''; + write_data(fid,[fmt '\n'],'float32',s.color'); % rescale + else + % nValues unsigned char values per scalar value + write_data(fid,'','uint8',uint8(s.color')); % rescale + end +end + +%-VECTORS +if isfield(s,'vectors') && ~isempty(s.vectors) + if ~point_data_hdr + fprintf(fid,'POINT_DATA %d\n',size(s.vectors,1)); + point_data_hdr = true; + end + dataName = 'vectors'; + fprintf(fid,'VECTORS %s %s\n',dataName,'float'); + write_data(fid,'%f %f %f\n','float32',s.vectors'); +end + +%-NORMALS +if isfield(s,'normals') && ~isempty(s.normals) + if ~point_data_hdr + fprintf(fid,'POINT_DATA %d\n',size(s.vertices,1)); + point_data_hdr = true; + end + dataName = 'normals'; + fprintf(fid,'NORMALS %s %s\n',dataName,'float'); + write_data(fid,'%f %f %f\n','float32',-s.normals'); +end + +%-TENSORS +if isfield(s,'tensors') && ~isempty(s.tensors) + if ~point_data_hdr + fprintf(fid,'POINT_DATA %d\n',size(s.tensors,1)); + point_data_hdr = true; + end + dataName = 'tensors'; + fprintf(fid,'TENSORS %s %s\n',dataName,'float'); + write_data(fid,repmat('%f %f %f\n',1,3),'float32',s.tensors'); +end + +%-Close file +%-------------------------------------------------------------------------- +fclose(fid); + + +%========================================================================== +% function fid = mvtk_write_xml(s,filename,format) +%========================================================================== +function fid = mvtk_write_xml(s,filename,format) + +%-Open file +%-------------------------------------------------------------------------- +if nargin == 2, format = 'ascii'; else format = lower(format); end +clear store_appended_data +switch format + case 'ascii' + fopen_opts = {'wt'}; + write_data = @(fmt,dat) deal(NaN,sprintf(fmt,dat)); + case 'binary' + fopen_opts = {'wb','ieee-le'}; + write_data = @(fmt,dat) deal(NaN,[... + base64encode(typecast(uint32(numel(dat)*numel(typecast(dat(1),'uint8'))),'uint8')) ... + base64encode(typecast(dat(:),'uint8'))]); + case 'appended' + fopen_opts = {'wt'}; + store_appended_data('start'); + store_appended_data('base64'); % format: raw, [base64] + store_appended_data('zlib'); % compression: none, [zlib] + write_data = @(fmt,dat) deal(store_appended_data(fmt,dat),''); + otherwise + error('Unknown format.'); +end +fid = fopen(filename,fopen_opts{:}); +if fid == -1 + error('Unable to write file %s: permission denied.',filename); +end + +%-XML VTK file format +%========================================================================== +o = @(x) blanks(x*3); + +%-XML prolog +%-------------------------------------------------------------------------- +fprintf(fid,'\n'); + +%-VTKFile +%-------------------------------------------------------------------------- +VTKFile = struct; +VTKFile.type = 'PolyData'; +VTKFile.version = '0.1'; +VTKFile.byte_order = 'LittleEndian'; +VTKFile.header_type = 'UInt32'; +if strcmp(store_appended_data('compression'),'zlib') + VTKFile.compressor = 'vtkZLibDataCompressor'; +end +fprintf(fid,'\n'); + +%-PolyData +%-------------------------------------------------------------------------- +fprintf(fid,'%s\n',o(1)); +Piece = struct; +Piece.NumberOfPoints = sprintf('%d',size(s.vertices,1)); +Piece.NumberOfVerts = sprintf('%d',0); +Piece.NumberOfLines = sprintf('%d',0); +Piece.NumberOfStrips = sprintf('%d',0); +Piece.NumberOfPolys = sprintf('%d',size(s.faces,1)); +fprintf(fid,'%s\n'); + +%-PointData +%-------------------------------------------------------------------------- +PointData = struct; +if isfield(s,'cdata') && ~isempty(s.cdata) + PointData.Scalars = 'scalars'; +end +if isfield(s,'normals') && ~isempty(s.normals) + PointData.Normals = 'normals'; +end +fprintf(fid,'%s\n'); + +%-Scalars +if isfield(s,'cdata') && ~isempty(s.cdata) + [offset,dat] = write_data('%f ',single(s.cdata')); + DataArray = struct; + DataArray.type = 'Float32'; + DataArray.Name = 'scalars'; + DataArray.NumberOfComponents = sprintf('%d',size(s.cdata,2)); + DataArray.format = format; + if ~isnan(offset), DataArray.offset = sprintf('%d',offset); end + fprintf(fid,'%s%s\n',dat); +end + +%-Normals +if isfield(s,'normals') && ~isempty(s.normals) + [offset,dat] = write_data('%f ',single(-s.normals')); + DataArray = struct; + DataArray.type = 'Float32'; + DataArray.Name = 'normals'; + DataArray.NumberOfComponents = sprintf('%d',3); + DataArray.format = format; + if ~isnan(offset), DataArray.offset = sprintf('%d',offset); end + fprintf(fid,'%s%s\n',dat); +end + +fprintf(fid,'%s\n',o(3)); + +%-CellData +%-------------------------------------------------------------------------- +fprintf(fid,'%s\n',o(3)); + +%-Points +%-------------------------------------------------------------------------- +fprintf(fid,'%s\n',o(3)); +if isfield(s,'vertices') + [offset,dat] = write_data('%f ',single(s.vertices')); + DataArray = struct; + DataArray.type = 'Float32'; + DataArray.Name = 'Vertices'; + DataArray.NumberOfComponents = sprintf('%d',3); + DataArray.format = format; + if ~isnan(offset), DataArray.offset = sprintf('%d',offset); end + fprintf(fid,'%s%s\n',dat); +end +fprintf(fid,'%s\n',o(3)); + +%-Verts +%-------------------------------------------------------------------------- +fprintf(fid,'%s\n',o(3)); + +%-Lines +%-------------------------------------------------------------------------- +fprintf(fid,'%s\n',o(3)); + +%-Strips +%-------------------------------------------------------------------------- +fprintf(fid,'%s\n',o(3)); + +%-Polys +%-------------------------------------------------------------------------- +fprintf(fid,'%s\n',o(3)); +if isfield(s,'faces') + [offset,dat] = write_data('%d ',uint32(s.faces'-1)); + DataArray = struct; + DataArray.type = 'UInt32'; + DataArray.Name = 'connectivity'; + DataArray.format = format; + if ~isnan(offset), DataArray.offset = sprintf('%d',offset); end + fprintf(fid,'%s%s\n',dat); + + [offset,dat] = write_data('%d ',uint32(3:3:3*size(s.faces,1))); + DataArray = struct; + DataArray.type = 'UInt32'; + DataArray.Name = 'offsets'; + DataArray.format = format; + if ~isnan(offset), DataArray.offset = sprintf('%d',offset); end + fprintf(fid,'%s%s\n',dat); +end +fprintf(fid,'%s\n',o(3)); + +fprintf(fid,'%s\n',o(2)); +fprintf(fid,'%s\n',o(1)); + +%-AppendedData +%-------------------------------------------------------------------------- +if strcmp(format,'appended') + dat = store_appended_data('retrieve'); + store_appended_data('stop'); + AppendedData = struct; + AppendedData.encoding = store_appended_data('encoding'); + fprintf(fid,'%s\n%s_',o(2)); + fwrite(fid,dat); + fprintf(fid,'\n%s\n',o(1)); +end + +fprintf(fid,'\n'); + +%-Close file +%-------------------------------------------------------------------------- +fclose(fid); + + +%========================================================================== +% function varargout = store_appended_data(fmt,dat) +%========================================================================== +function varargout = store_appended_data(fmt,dat) + +persistent fid encoding compression + +if isempty(encoding), encoding = 'raw'; end +if isempty(compression), compression = 'none'; end +if ~nargin, fmt = 'start'; end +if nargin < 2 + varargout = {}; + switch lower(fmt) + case 'start' + filename = tempname; + fid = fopen(filename,'w+b'); + if fid == -1 + error('Cannot open temporary file.'); + end + case 'stop' + filename = fopen(fid); + fclose(fid); + delete(filename); + fid = -1; + case 'retrieve' + frewind(fid); + varargout = {fread(fid)}; + case 'encoding' + varargout = {encoding}; + case 'compression' + varargout = {compression}; + case {'raw','base64'} + encoding = fmt; + case {'none','zlib'} + compression = fmt; + otherwise + error('Unknown action.'); + end + return; +end + +varargout = {ftell(fid)}; +N = uint32(numel(dat)*numel(typecast(dat(1),'uint8'))); +switch encoding + case 'raw' + switch compression + case 'none' + dat = typecast(dat(:),'uint8'); + hdr = N; + case 'zlib' + dat = zstream('C',typecast(dat(:),'uint8')); + hdr = uint32([1 N N numel(dat)]); + otherwise + error('Unknown compression.'); + end + fwrite(fid,hdr,'uint32'); + fwrite(fid,dat,class(dat)); + case 'base64' + switch compression + case 'none' + dat = typecast(dat(:),'uint8'); + hdr = N; + case 'zlib' + dat = zstream('C',typecast(dat(:),'uint8')); + hdr = uint32([1 N N numel(dat)]); + otherwise + error('Unknown compression.'); + end + fwrite(fid,base64encode(typecast(hdr,'uint8'))); + fwrite(fid,base64encode(dat)); + otherwise + error('Unknown encoding.'); +end + + +%========================================================================== +% function N = compute_normals(S) +%========================================================================== +function N = compute_normals(S) +try + t = triangulation(double(S.faces),double(S.vertices)); + N = -double(t.vertexNormal); + normN = sqrt(sum(N.^2,2)); + normN(normN < eps) = 1; + N = N ./ repmat(normN,1,3); +catch + N = []; +end diff --git a/Toolboxes/spm12/@gifti/private/obj_read.m b/Toolboxes/spm12/@gifti/private/obj_read.m new file mode 100644 index 0000000000000000000000000000000000000000..5d303321f7647e2d2272e4a20986a97fd60d9fe2 --- /dev/null +++ b/Toolboxes/spm12/@gifti/private/obj_read.m @@ -0,0 +1,85 @@ +function M = obj_read(filename) +% Read Wavefront OBJ-formatted data from disk +% FORMAT M = obj_read(filename) +% +% filename - OBJ-formatted file name +% M - data structure +%__________________________________________________________________________ +% +% Wavefront OBJ Format Specification: +% https://en.wikipedia.org/wiki/Wavefront_.obj_file +%__________________________________________________________________________ +% Copyright (C) 2017 Wellcome Trust Centre for Neuroimaging + +% Guillaume Flandin +% $Id: obj_read.m 7004 2017-02-03 10:57:17Z guillaume $ + + +fid = fopen(filename,'rt'); +if fid == -1 + error('Cannot open %s.',filename); +end + +M = struct('vertices',[],'faces',[]); + +while true + l = fgetl(fid); + if ~ischar(l), break; end + if numel(l) < 1 || isempty(strtrim(l)) || l(1) == '#', continue; end + switch l(1) + case 'v' + switch l(2) + case 't' + % texture coordinates, in (u, v [,w]) coordinates + t = sscanf(l(2:end),'%f %f %f'); + case 'n' + % vertex normals in (x,y,z) form + n = sscanf(l(2:end),'%f %f %f'); + case 'p' + % Parameter space vertices in (u [,v] [,w]) form + p = sscanf(l(2:end),'%f %f %f'); + otherwise + v = sscanf(l(2:end),'%f %f %f'); + if numel(v) > 3, v = v(1:3); end + M.vertices(size(M.vertices,1)+1,:) = v; + end + case 'f' + f = sscanf(l(2:end),'%d %d %d'); + if numel(f) ~= 3 + f = sscanf(l(2:end),'%d/%d %d/d %d/%d'); + if numel(f) ~= 6 + f = sscanf(l(2:end),'%d//%d %d//d %d//%d'); + if numel(f) ~= 6 + f = sscanf(l(2:end),'%d/%d/%d %d/%d/%d %d/%d/%d'); + if numel(f) == 9 + f = f([1 4 7]); + else + fprintf('Not a triangle.\n'); + continue; + end + else + f = f([1 3 5]); + end + else + f = f([1 3 5]); + end + end + i = find(f<0); + if isempty(i), f(i) = size(M.vertices,1) + f(i); end + M.faces(size(M.faces,1)+1,:) = f; + case 'o' + fprintf('Ignoring named objects.\n'); + case 'g' + fprintf('Ignoring polygon groups.\n'); + case 's' + fprintf('Ignoring smooth shading.\n'); + otherwise + if ~isempty(strmatch('mtllib',l)) || ~isempty(strmatch('usemtl',l)) + fprintf('Ignoring materials.\n'); + else + fprintf('Ignoring line starting with %c.\n',l(1)); + end + end +end + +fclose(fid); diff --git a/Toolboxes/spm12/@gifti/private/read_freesurfer_file.m b/Toolboxes/spm12/@gifti/private/read_freesurfer_file.m new file mode 100644 index 0000000000000000000000000000000000000000..00f39d3d94eb8b0e2c759b5090d8e0c5f804930a --- /dev/null +++ b/Toolboxes/spm12/@gifti/private/read_freesurfer_file.m @@ -0,0 +1,25 @@ +function this = read_freesurfer_file(filename) +% Low level reader of FreeSurfer files (ASCII triangle surface file) +% FORMAT this = read_freesurfer_file(filename) +% filename - FreeSurfer file +% +% See http://wideman-one.com/gw/brain/fs/surfacefileformats.htm +%__________________________________________________________________________ +% Copyright (C) 2013 Wellcome Trust Centre for Neuroimaging + +% Guillaume Flandin +% $Id: read_freesurfer_file.m 5322 2013-03-13 15:04:14Z guillaume $ + + +fid = fopen(filename,'rt'); +if fid == -1, error('Cannot open "%s".',filename); end + +fgetl(fid); % #!ascii +N = fscanf(fid,'%d',2); +this.vertices = fscanf(fid,'%f %f %f %d',[4 N(1)])'; +this.faces = fscanf(fid,'%d %d %d %d',[4 N(2)])'; + +fclose(fid); + +this.vertices = this.vertices(:,1:3); +this.faces = this.faces(:,1:3) + 1; diff --git a/Toolboxes/spm12/@gifti/private/read_gifti_file.m b/Toolboxes/spm12/@gifti/private/read_gifti_file.m new file mode 100644 index 0000000000000000000000000000000000000000..b11d30d414ead0b1e766e2d180ef9090bddab8cc --- /dev/null +++ b/Toolboxes/spm12/@gifti/private/read_gifti_file.m @@ -0,0 +1,206 @@ +function this = read_gifti_file(filename, this) +% Low level reader of GIfTI 1.0 files +% FORMAT this = read_gifti_file(filename, this) +% filename - XML GIfTI filename +% this - structure with fields 'metaData', 'label' and 'data'. +%__________________________________________________________________________ +% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging + +% Guillaume Flandin +% $Id: read_gifti_file.m 6895 2016-10-03 11:08:49Z guillaume $ + +% Import XML-based GIfTI file +%-------------------------------------------------------------------------- +try + t = xmltree(filename); +catch + error('[GIFTI] Loading of XML file %s failed.', filename); +end + +% Root element of a GIFTI file +%-------------------------------------------------------------------------- +if ~strcmp(get(t,root(t),'name'),'GIFTI') + error('[GIFTI] %s is not a GIFTI 1.0 file.', filename); +end +attr = cell2mat(attributes(t,'get',root(t))); +attr = cell2struct({attr.val},strrep({attr.key},':','___'),2); +if ~all(ismember({'Version','NumberOfDataArrays'},fieldnames(attr))) + error('[GIFTI] Missing mandatory attributes for GIFTI root element.'); +end +if str2double(attr.Version) ~= 1 + warning('[GIFTI] Unknown specification version of GIFTI file (%s).',attr.Version); +end +nbData = str2double(attr.NumberOfDataArrays); + +% Read children elements +%-------------------------------------------------------------------------- +uid = children(t,root(t)); +for i=1:length(uid) + switch get(t,uid(i),'name') + case 'MetaData' + this.metadata = gifti_MetaData(t,uid(i)); + case 'LabelTable' + this.label = gifti_LabelTable(t,uid(i)); + case 'DataArray' + this.data{end+1} = gifti_DataArray(t,uid(i),filename); + otherwise + warning('[GIFTI] Unknown element "%s": ignored.',get(t,uid(i),'name')); + end +end + +if nbData ~= length(this.data) + warning('[GIFTI] Mismatch between expected and effective number of datasets.'); +end + +%========================================================================== +function s = gifti_MetaData(t,uid) +s = struct('name',{}, 'value',{}); +c = children(t,uid); +for i=1:length(c) + for j=children(t,c(i)) + s(i).(lower(get(t,j,'name'))) = get(t,children(t,j),'value'); + end +end + +%========================================================================== +function s = gifti_LabelTable(t,uid) +s = struct('name',{}, 'key',[], 'rgba',[]); +c = children(t,uid); +for i=1:length(c) + a = attributes(t,'get',c(i)); + s(1).rgba(i,1:4) = NaN; + for j=1:numel(a) + switch lower(a{j}.key) + case {'key','index'} + s(1).key(i) = str2double(a{j}.val); + case 'red' + s(1).rgba(i,1) = str2double(a{j}.val); + case 'green' + s(1).rgba(i,2) = str2double(a{j}.val); + case 'blue' + s(1).rgba(i,3) = str2double(a{j}.val); + case 'alpha' + s(1).rgba(i,4) = str2double(a{j}.val); + otherwise + end + end + s(1).name{i} = get(t,children(t,c(i)),'value'); +end + +%========================================================================== +function s = gifti_DataArray(t,uid,filename) +s = struct(... + 'attributes', {}, ... + 'data', {}, ... + 'metadata', struct([]), ... + 'space', {} ... + ); + +attr = cell2mat(attributes(t,'get',uid)); +s(1).attributes = cell2struct({attr.val},{attr.key},2); +s(1).attributes.Dim = []; +for i=1:str2double(s(1).attributes.Dimensionality) + f = sprintf('Dim%d',i-1); + s(1).attributes.Dim(i) = str2double(s(1).attributes.(f)); + s(1).attributes = rmfield(s(1).attributes,f); +end +s(1).attributes = rmfield(s(1).attributes,'Dimensionality'); +if isfield(s(1).attributes,'ExternalFileName') && ... + ~isempty(s(1).attributes.ExternalFileName) + s(1).attributes.ExternalFileName = fullfile(fileparts(filename),... + s(1).attributes.ExternalFileName); +end + +c = children(t,uid); +for i=1:length(c) + switch get(t,c(i),'name') + case 'MetaData' + s(1).metadata = gifti_MetaData(t,c(i)); + case 'CoordinateSystemTransformMatrix' + s(1).space(end+1) = gifti_Space(t,c(i)); + case 'Data' + s(1).data = gifti_Data(t,c(i),s(1).attributes); + otherwise + error('[GIFTI] Unknown DataArray element "%s".',get(t,c(i),'name')); + end +end + +if strcmp(s.attributes.Intent,'NIFTI_INTENT_POINTSET') + if isempty(s.space) + warning('Missing "CoordinateSystemTransformMatrix": assuming I.'); + s.space = struct(... + 'DataSpace','NIFTI_XFORM_UNKNOWN',... + 'TransformedSpace','NIFTI_XFORM_UNKNOWN',... + 'MatrixData',eye(4)); + end +end + +%========================================================================== +function s = gifti_Space(t,uid) +s = struct('DataSpace','', 'TransformedSpace','', 'MatrixData',[]); +for i=children(t,uid) + s.(get(t,i,'name')) = get(t,children(t,i),'value'); +end +s.MatrixData = reshape(str2num(s.MatrixData),4,4)'; + +%========================================================================== +function d = gifti_Data(t,uid,s) +tp = getdict; +try + tp = tp.(s.DataType); +catch + error('[GIFTI] Unknown DataType.'); +end + +[unused,unused,mach] = fopen(1); +sb = @(x) x; +try + if (strcmp(s.Endian,'LittleEndian') && ~isempty(strmatch('ieee-be',mach))) ... + || (strcmp(s.Endian,'BigEndian') && ~isempty(strmatch('ieee-le',mach))) + sb = @swapbyte; + end +catch + % Byte Order can be absent if encoding is ASCII, assume native otherwise +end + +switch s.Encoding + case 'ASCII' + d = feval(tp.conv,sscanf(get(t,children(t,uid),'value'),tp.format)); + + case 'Base64Binary' + d = typecast(sb(base64decode(get(t,children(t,uid),'value'))), tp.cast); + + case 'GZipBase64Binary' + d = typecast(zstream('D',sb(base64decode(get(t,children(t,uid),'value')))), tp.cast); + + case 'ExternalFileBinary' + [p,f,e] = fileparts(s.ExternalFileName); + if isempty(p) + s.ExternalFileName = fullfile(pwd,[f e]); + end + if false + fid = fopen(s.ExternalFileName,'r'); + if fid == -1 + error('[GIFTI] Unable to read binary file %s.',s.ExternalFileName); + end + fseek(fid,str2double(s.ExternalFileOffset),0); + d = sb(fread(fid,prod(s.Dim),['*' tp.class])); + fclose(fid); + else + d = file_array(s.ExternalFileName, s.Dim, tp.class, ... + str2double(s.ExternalFileOffset),1,0,'rw'); + end + + otherwise + error('[GIFTI] Unknown data encoding: %s.',s.Encoding); +end + +if length(s.Dim) == 1, s.Dim(end+1) = 1; end +switch s.ArrayIndexingOrder + case 'RowMajorOrder' + d = permute(reshape(d,fliplr(s.Dim)),length(s.Dim):-1:1); + case 'ColumnMajorOrder' + d = reshape(d,s.Dim); + otherwise + error('[GIFTI] Unknown array indexing order.'); +end diff --git a/Toolboxes/spm12/@gifti/private/zstream.c b/Toolboxes/spm12/@gifti/private/zstream.c new file mode 100644 index 0000000000000000000000000000000000000000..d8cfd2800875f2b3b84c77887b6352ce2cd22fcf --- /dev/null +++ b/Toolboxes/spm12/@gifti/private/zstream.c @@ -0,0 +1,77 @@ +/* + * $Id: zstream.c 6417 2015-04-21 16:03:44Z guillaume $ + * Guillaume Flandin + */ + +/* mex -O CFLAGS='$CFLAGS -std=c99' -largeArrayDims zstream.c */ + +/* setenv CFLAGS "`mkoctfile -p CFLAGS` -std=c99" */ +/* mkoctfile --mex zstream.c */ + +/* miniz: http://code.google.com/p/miniz/ */ +#define MINIZ_NO_STDIO +#define MINIZ_NO_ARCHIVE_APIS +#define MINIZ_NO_TIME +#define MINIZ_NO_ZLIB_APIS +#include "miniz.c" + +#include "mex.h" + +/* --- GATEWAY FUNCTION --- */ +void mexFunction(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) +{ + +char *action; +unsigned char *IN = NULL, *OUT = NULL; +size_t INlen, OUTlen; + +/* Check for proper number of arguments */ +if (nrhs < 2) + mexErrMsgTxt("Not enough input arguments."); +else if (nrhs > 2) + mexErrMsgTxt("Too many input arguments."); +else if (nlhs > 1) + mexErrMsgTxt("Too many output arguments."); + +/* The input ACTION must be a string */ +if (!mxIsChar(prhs[0])) + mexErrMsgTxt("Input ACTION must be a string."); +action = mxArrayToString(prhs[0]); + +/* The input IN must be a real uint8 array */ +if (!mxIsUint8(prhs[1]) || mxIsComplex(prhs[1])) + mexErrMsgTxt("Input IN must be a real uint8 array."); + +INlen = mxGetNumberOfElements(prhs[1]); +IN = mxGetData(prhs[1]); + +if (!strcmp(action,"D")) { + + /* Decompress data */ + OUT = tinfl_decompress_mem_to_heap(IN, INlen, &OUTlen, TINFL_FLAG_PARSE_ZLIB_HEADER); + + if (OUT == NULL) + mexErrMsgTxt("Error when decompressing data."); +} +else if (!strcmp(action,"C")) { + /* Compress data */ + OUT = tdefl_compress_mem_to_heap(IN, INlen, &OUTlen, TDEFL_WRITE_ZLIB_HEADER); + + if (OUT == NULL) + mexErrMsgTxt("Error when compressing data."); +} +else { + mexErrMsgTxt("Unknown ACTION type."); +} + +/* */ +plhs[0] = mxCreateNumericMatrix(OUTlen,1,mxUINT8_CLASS,mxREAL); +if (plhs[0] == NULL) + mexErrMsgTxt("Error when creating output variable."); + +memcpy(mxGetData(plhs[0]), OUT, OUTlen); + +mxFree(action); +mz_free(OUT); + +} diff --git a/Toolboxes/spm12/@gifti/private/zstream.m b/Toolboxes/spm12/@gifti/private/zstream.m new file mode 100644 index 0000000000000000000000000000000000000000..2da8c43cc40698cb2a04ec77e8ba955df16427c3 --- /dev/null +++ b/Toolboxes/spm12/@gifti/private/zstream.m @@ -0,0 +1,49 @@ +function Z = zstream(action,D) +% Compress/decompress stream of bytes using Deflate/Inflate +% FORMAT Z = zstream('C',D) +% D - data stream to compress (converted to uint8 if needed) +% Z - compressed data stream (uint8 vector) +% FORMAT D = zstream('D',Z) +% Z - data stream to decompress (uint8 vector) +% D - decompressed data stream (uint8 vector) +%__________________________________________________________________________ +% +% This C-MEX file relies on: +% * miniz, by Rich Geldreich +% http://code.google.com/p/miniz/ +% Fallback Java implementation is adapted from: +% * dzip/dunzip, by Michael Kleder +% http://www.mathworks.com/matlabcentral/fileexchange/8899 +%__________________________________________________________________________ +% Copyright (C) 2015 Wellcome Trust Centre for Neuroimaging + +% Guillaume Flandin +% $Id: zstream.m 6417 2015-04-21 16:03:44Z guillaume $ + + +if exist('OCTAVE_VERSION','builtin') + error('zstream.c not compiled - see Makefile'); +end + +switch upper(action) + case 'C' + D = typecast(D(:),'uint8'); + f = java.io.ByteArrayOutputStream(); + g = java.util.zip.DeflaterOutputStream(f); + g.write(D); + g.close; + Z = typecast(f.toByteArray,'uint8'); + f.close; + + case 'D' + import com.mathworks.mlwidgets.io.InterruptibleStreamCopier + a = java.io.ByteArrayInputStream(D); + b = java.util.zip.InflaterInputStream(a); + isc = InterruptibleStreamCopier.getInterruptibleStreamCopier; + c = java.io.ByteArrayOutputStream; + isc.copyStream(b,c); + Z = c.toByteArray; + + otherwise + error('Unknown action "%s".',action); +end diff --git a/Toolboxes/spm12/@gifti/private/zstream.mexa64 b/Toolboxes/spm12/@gifti/private/zstream.mexa64 new file mode 100644 index 0000000000000000000000000000000000000000..fa41125b680f03abe5e03cd3bcdb1d8ca16ea4a2 Binary files /dev/null and b/Toolboxes/spm12/@gifti/private/zstream.mexa64 differ diff --git a/Toolboxes/spm12/@gifti/private/zstream.mexmaci64 b/Toolboxes/spm12/@gifti/private/zstream.mexmaci64 new file mode 100644 index 0000000000000000000000000000000000000000..9324133a71d7aa0600b40e8639bfbe4f85e8a354 Binary files /dev/null and b/Toolboxes/spm12/@gifti/private/zstream.mexmaci64 differ diff --git a/Toolboxes/spm12/@gifti/private/zstream.mexw32 b/Toolboxes/spm12/@gifti/private/zstream.mexw32 new file mode 100644 index 0000000000000000000000000000000000000000..8153a1d404d31a0786f5cd0d2747458e6c42de75 Binary files /dev/null and b/Toolboxes/spm12/@gifti/private/zstream.mexw32 differ diff --git a/Toolboxes/spm12/@gifti/private/zstream.mexw64 b/Toolboxes/spm12/@gifti/private/zstream.mexw64 new file mode 100644 index 0000000000000000000000000000000000000000..cd58fb3b914e8c95da2143d94f6c8b6edbf764bf Binary files /dev/null and b/Toolboxes/spm12/@gifti/private/zstream.mexw64 differ diff --git a/Toolboxes/spm12/@gifti/save.m b/Toolboxes/spm12/@gifti/save.m new file mode 100644 index 0000000000000000000000000000000000000000..a7fd695201c024d170d5eb2a087230105ea7df48 --- /dev/null +++ b/Toolboxes/spm12/@gifti/save.m @@ -0,0 +1,253 @@ +function save(this,filename,encoding) +% Save GIfTI object in a GIfTI format file +% FORMAT save(this,filename,encoding) +% this - GIfTI object +% filename - name of GIfTI file to be created [Default: 'untitled.gii'] +% encoding - optional argument to specify encoding format, among +% ASCII, Base64Binary, GZipBase64Binary, ExternalFileBinary. +% [Default: 'GZipBase64Binary'] +%__________________________________________________________________________ +% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging + +% Guillaume Flandin +% $Id: save.m 6516 2015-08-07 17:28:33Z guillaume $ + + +% Check filename +%-------------------------------------------------------------------------- +ext = '.gii'; +if nargin == 1 + filename = 'untitled'; +end +[p,f,e] = fileparts(filename); +if ~ismember(lower(e),{ext}) + e = ext; +end +filename = fullfile(p,[f e]); + +% Open file for writing +%-------------------------------------------------------------------------- +fid = fopen(filename,'wt'); +if fid == -1 + error('Unable to write file %s: permission denied.',filename); +end + +% Write file +%-------------------------------------------------------------------------- +if nargin < 3, encoding = 'GZipBase64Binary'; end +switch encoding + case {'ASCII','Base64Binary','GZipBase64Binary','ExternalFileBinary'} + otherwise + error('Unknown encoding.'); +end +fid = save_gii(fid,this,encoding); + +% Close file +%-------------------------------------------------------------------------- +fclose(fid); + + +%========================================================================== +% function fid = save_gii(fid,this,encoding) +%========================================================================== +function fid = save_gii(fid,this,encoding) + +% Defaults for DataArray's attributes +%-------------------------------------------------------------------------- +[unused,unused,mach] = fopen(fid); +if strncmp('ieee-be',mach,7) + def.Endian = 'BigEndian'; +elseif strncmp('ieee-le',mach,7) + def.Endian = 'LittleEndian'; +else + error('[GIFTI] Unknown byte order "%s".',mach); +end +def.Encoding = encoding; +def.Intent = 'NIFTI_INTENT_NONE'; +def.DataType = 'NIFTI_TYPE_FLOAT32'; +def.ExternalFileName = ''; +def.ExternalFileOffset = ''; +def.offset = 0; + +% Edit object DataArray attributes +%-------------------------------------------------------------------------- +for i=1:length(this.data) + % Revert the dimension storage + d = this.data{i}.attributes.Dim; + if numel(d) > 1 && d(end) == 1 + d = d(1:end-1); + end + this.data{i}.attributes = rmfield(this.data{i}.attributes,'Dim'); + this.data{i}.attributes.Dimensionality = num2str(length(d)); + for j=1:length(d) + this.data{i}.attributes.(sprintf('Dim%d',j-1)) = num2str(d(j)); + end + % Enforce some conventions + this.data{i}.attributes.ArrayIndexingOrder = 'ColumnMajorOrder'; + if ~isfield(this.data{i}.attributes,'DataType') || ... + isempty(this.data{i}.attributes.DataType) + warning('DataType set to default: %s', def.DataType); + this.data{i}.attributes.DataType = def.DataType; + end + if ~isfield(this.data{i}.attributes,'Intent') || ... + isempty(this.data{i}.attributes.Intent) + warning('Intent code set to default: %s', def.Intent); + this.data{i}.attributes.Intent = def.Intent; + end + this.data{i}.attributes.Encoding = def.Encoding; + this.data{i}.attributes.Endian = def.Endian; + this.data{i}.attributes.ExternalFileName = def.ExternalFileName; + this.data{i}.attributes.ExternalFileOffset = def.ExternalFileOffset; + switch this.data{i}.attributes.Encoding + case {'ASCII', 'Base64Binary','GZipBase64Binary' } + case 'ExternalFileBinary' + extfilename = this.data{i}.attributes.ExternalFileName; + if isempty(extfilename) + [p,f] = fileparts(fopen(fid)); + extfilename = [f '.dat']; + end + [p,f,e] = fileparts(extfilename); + this.data{i}.attributes.ExternalFileName = fullfile(fileparts(fopen(fid)),[f e]); + this.data{i}.attributes.ExternalFileOffset = num2str(def.offset); + otherwise + error('[GIFTI] Unknown data encoding: %s.',this.data{i}.attributes.Encoding); + end +end + +% Prolog +%-------------------------------------------------------------------------- +fprintf(fid,'\n'); +fprintf(fid,'\n'); +fprintf(fid,'\n',numel(this.data)); + +o = @(x) blanks(x*3); + +% MetaData +%-------------------------------------------------------------------------- +fprintf(fid,'%s\n'); +else + fprintf(fid,'>\n'); + for i=1:length(this.metadata) + fprintf(fid,'%s\n',o(2)); + fprintf(fid,'%s\n',o(3),... + this.metadata(i).name); + fprintf(fid,'%s\n',o(3),... + this.metadata(i).value); + fprintf(fid,'%s\n',o(2)); + end + fprintf(fid,'%s\n',o(1)); +end + +% LabelTable +%-------------------------------------------------------------------------- +fprintf(fid,'%s\n'); +else + fprintf(fid,'>\n'); + for i=1:length(this.label.name) + if ~all(isnan(this.label.rgba(i,:))) + label_rgba = sprintf(' Red="%f" Green="%f" Blue="%f" Alpha="%f"',... + this.label.rgba(i,:)); + else + label_rgba = ''; + end + fprintf(fid,'%s\n',o(2),... + this.label.key(i), label_rgba, this.label.name{i}); + end + fprintf(fid,'%s\n',o(1)); +end + +% DataArray +%-------------------------------------------------------------------------- +for i=1:length(this.data) + fprintf(fid,'%s\n'); + + % MetaData + %---------------------------------------------------------------------- + fprintf(fid,'%s\n',o(2)); + for j=1:length(this.data{i}.metadata) + fprintf(fid,'%s\n',o(3)); + fprintf(fid,'%s\n',o(4),... + this.data{i}.metadata(j).name); + fprintf(fid,'%s\n',o(4),... + this.data{i}.metadata(j).value); + fprintf(fid,'%s\n',o(3)); + end + fprintf(fid,'%s\n',o(2)); + + % CoordinateSystemTransformMatrix + %---------------------------------------------------------------------- + for j=1:length(this.data{i}.space) + fprintf(fid,'%s\n',o(2)); + fprintf(fid,'%s\n',o(3),... + this.data{i}.space(j).DataSpace); + fprintf(fid,'%s\n',o(3),... + this.data{i}.space(j).TransformedSpace); + fprintf(fid,'%s%s\n',o(3),... + sprintf('%f ',this.data{i}.space(j).MatrixData')); + fprintf(fid,'%s\n',o(2)); + end + + % Data (saved using MATLAB's ColumnMajorOrder) + %---------------------------------------------------------------------- + fprintf(fid,'%s',o(2)); + tp = getdict; + try + tp = tp.(this.data{i}.attributes.DataType); + catch + error('[GIFTI] Unknown DataType.'); + end + switch this.data{i}.attributes.Encoding + case 'ASCII' + fprintf(fid, [tp.format ' '], this.data{i}.data); + case 'Base64Binary' + fprintf(fid,base64encode(typecast(this.data{i}.data(:),'uint8'))); + % uses native machine format + case 'GZipBase64Binary' + fprintf(fid,base64encode(zstream('C',typecast(this.data{i}.data(:),'uint8')))); + % uses native machine format + case 'ExternalFileBinary' + extfilename = this.data{i}.attributes.ExternalFileName; + dat = this.data{i}.data; + if isa(dat,'file_array') + dat = subsref(dat,substruct('()',repmat({':'},1,numel(dat.dim)))); + end + if ~def.offset + fide = fopen(extfilename,'w'); % uses native machine format + else + fide = fopen(extfilename,'a'); % uses native machine format + end + if fide == -1 + error('Unable to write file %s: permission denied.',extfilename); + end + fseek(fide,0,1); + fwrite(fide,dat,tp.class); + def.offset = ftell(fide); + fclose(fide); + otherwise + error('[GIFTI] Unknown data encoding.'); + end + fprintf(fid,'\n'); + fprintf(fid,'%s\n',o(1)); +end + +fprintf(fid,'\n'); diff --git a/Toolboxes/spm12/@gifti/saveas.m b/Toolboxes/spm12/@gifti/saveas.m new file mode 100644 index 0000000000000000000000000000000000000000..3f81a3815b999efa433c8383df78bfd366fcfe3f --- /dev/null +++ b/Toolboxes/spm12/@gifti/saveas.m @@ -0,0 +1,394 @@ +function saveas(this,filename,format) +% Save GIfTI object in external file format +% FORMAT saveas(this,filename,format) +% this - GIfTI object +% filename - name of file to be created [Default: 'untitled.vtk'] +% format - optional argument to specify encoding format, among +% VTK (.vtk,.vtp), Collada (.dae), IDTF (.idtf). [Default: VTK] +%__________________________________________________________________________ +% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging + +% Guillaume Flandin +% $Id: saveas.m 7004 2017-02-03 10:57:17Z guillaume $ + + +% Check filename and file format +%-------------------------------------------------------------------------- +ext = '.vtk'; +if nargin == 1 + filename = ['untitled' ext]; +else + if nargin == 3 && strcmpi(format,'collada') + ext = '.dae'; + end + if nargin == 3 && strcmpi(format,'idtf') + ext = '.idtf'; + end + if nargin == 3 && strncmpi(format,'vtk',3) + format = lower(format(5:end)); + ext = '.vtk'; + end + if nargin == 3 && strncmpi(format,'obj',3) + format = lower(format(5:end)); + ext = '.obj'; + end + [p,f,e] = fileparts(filename); + if strcmpi(e,'.gii') + warning('Use save instead of saveas.'); + save(this,filename); + return; + end + if ~ismember(lower(e),{ext}) + warning('Changing file extension from %s to %s.',e,ext); + e = ext; + end + filename = fullfile(p,[f e]); +end + +% Write file +%-------------------------------------------------------------------------- +s = struct(this); + +switch ext + case '.dae' + save_dae(s,filename); + case '.idtf' + save_idtf(s,filename); + case {'.vtk','.vtp'} + if nargin < 3, format = 'legacy-ascii'; end + mvtk_write(s,filename,format); + case '.obj' + save_obj(s,filename); + otherwise + error('Unknown file format.'); +end + + +%========================================================================== +% function save_dae(s,filename) +%========================================================================== +function save_dae(s,filename) + +o = @(x) blanks(x*3); + +% Split the mesh into connected components +%-------------------------------------------------------------------------- +try + C = spm_mesh_label(s.faces); + d = []; + for i=1:numel(unique(C)) + d(i).faces = s.faces(C==i,:); + u = unique(d(i).faces); + d(i).vertices = s.vertices(u,:); + a = 1:max(d(i).faces(:)); + a(u) = 1:size(d(i).vertices,1); + %a = sparse(1,double(u),1:1:size(d(i).vertices,1)); + d(i).faces = a(d(i).faces); + end + s = d; +end + +% Open file for writing +%-------------------------------------------------------------------------- +fid = fopen(filename,'wt'); +if fid == -1 + error('Unable to write file %s: permission denied.',filename); +end + +% Prolog & root of the Collada XML file +%-------------------------------------------------------------------------- +fprintf(fid,'\n'); +fprintf(fid,'\n'); + +% Assets +%-------------------------------------------------------------------------- +fprintf(fid,'%s\n',o(1)); +fprintf(fid,'%s\n',o(2)); +fprintf(fid,'%s%s\n',o(3),... + 'http://www.fil.ion.ucl.ac.uk/spm/'); +fprintf(fid,'%s%s\n',o(3),'SPM'); +fprintf(fid,'%s\n',o(2)); +fprintf(fid,'%s%s\n',o(2),datestr(now,'yyyy-mm-ddTHH:MM:SSZ')); +fprintf(fid,'%s%s\n',o(2),datestr(now,'yyyy-mm-ddTHH:MM:SSZ')); +fprintf(fid,'%s\n',o(2)); +fprintf(fid,'%sZ_UP\n',o(2)); +fprintf(fid,'%s\n',o(1)); + +% Image, Materials, Effects +%-------------------------------------------------------------------------- +%fprintf(fid,'%s\n',o(1)); + +fprintf(fid,'%s\n',o(1)); +for i=1:numel(s) + fprintf(fid,'%s\n',o(2),i,i); + fprintf(fid,'%s\n',o(3),i); + fprintf(fid,'%s\n',o(2)); +end +fprintf(fid,'%s\n',o(1)); + +fprintf(fid,'%s\n',o(1)); +for i=1:numel(s) + fprintf(fid,'%s\n',o(2),i,i); + fprintf(fid,'%s\n',o(3)); + fprintf(fid,'%s\n',o(4)); + fprintf(fid,'%s\n',o(5)); + fprintf(fid,'%s\n',o(6)); + fprintf(fid,'%s%f %f %f %d\n',o(7),[0 0 0 1]); + fprintf(fid,'%s\n',o(6)); + fprintf(fid,'%s\n',o(6)); + fprintf(fid,'%s%f %f %f %d\n',o(7),[0 0 0 1]); + fprintf(fid,'%s\n',o(6)); + fprintf(fid,'%s\n',o(6)); + fprintf(fid,'%s%f %f %f %d\n',o(7),[0.5 0.5 0.5 1]); + fprintf(fid,'%s\n',o(6)); + fprintf(fid,'%s\n',o(6)); + fprintf(fid,'%s%d %d %d %d\n',o(7),[1 1 1 1]); + fprintf(fid,'%s\n',o(6)); + fprintf(fid,'%s\n',o(6)); + fprintf(fid,'%s%f\n',o(7),0); + fprintf(fid,'%s\n',o(6)); + fprintf(fid,'%s\n',o(5)); + fprintf(fid,'%s\n',o(4)); + fprintf(fid,'%s\n',o(3)); + fprintf(fid,'%s\n',o(2)); +end +fprintf(fid,'%s\n',o(1)); + +% Geometry +%-------------------------------------------------------------------------- +fprintf(fid,'%s\n',o(1)); +for i=1:numel(s) + fprintf(fid,'%s\n',o(2),i,i); + fprintf(fid,'%s\n',o(3)); + fprintf(fid,'%s\n',o(4),i); + fprintf(fid,'%s',o(5),i,numel(s(i).vertices)); + fprintf(fid,'%f ',reshape(s(i).vertices',1,[])); + fprintf(fid,'\n'); + fprintf(fid,'%s\n',o(5)); + fprintf(fid,'%s\n',o(6),size(s(i).vertices,1),i); + fprintf(fid,'%s\n',o(7)); + fprintf(fid,'%s\n',o(7)); + fprintf(fid,'%s\n',o(7)); + fprintf(fid,'%s\n',o(6)); + fprintf(fid,'%s\n',o(5)); + fprintf(fid,'%s\n',o(4)); + fprintf(fid,'%s\n',o(4),i); + fprintf(fid,'%s\n',o(5),i); + fprintf(fid,'%s\n',o(4)); + fprintf(fid,'%s\n',o(4),i,size(s(i).faces,1)); + fprintf(fid,'%s\n',o(5),i); + fprintf(fid,'%s

',o(5)); + fprintf(fid,'%d ',reshape(s(i).faces',1,[])-1); + fprintf(fid,'

\n'); + fprintf(fid,'%s\n',o(4)); + fprintf(fid,'%s\n',o(3)); + fprintf(fid,'%s\n',o(2)); +end +fprintf(fid,'%s\n',o(1)); + +% Scene +%-------------------------------------------------------------------------- +fprintf(fid,'%s\n',o(1)); +fprintf(fid,'%s\n',o(2)); +for i=1:numel(s) + fprintf(fid,'%s\n',o(3),i); + fprintf(fid,'%s\n',o(4),i); + fprintf(fid,'%s\n',o(5)); + fprintf(fid,'%s\n',o(6)); + fprintf(fid,'%s\n',o(7),i,i); + fprintf(fid,'%s\n',o(6)); + fprintf(fid,'%s\n',o(5)); + fprintf(fid,'%s\n',o(4)); + fprintf(fid,'%s\n',o(3)); +end +fprintf(fid,'%s\n',o(2)); +fprintf(fid,'%s\n',o(1)); +fprintf(fid,'%s\n',o(1)); +fprintf(fid,'%s\n',o(2)); +fprintf(fid,'%s\n',o(1)); + +% End of XML +%-------------------------------------------------------------------------- +fprintf(fid,'\n'); + +% Close file +%-------------------------------------------------------------------------- +fclose(fid); + + +%========================================================================== +% function save_idtf(s,filename) +%========================================================================== +function save_idtf(s,filename) + +o = @(x) blanks(x*3); + +% Compute normals +%-------------------------------------------------------------------------- +if ~isfield(s,'normals') + try + s.normals = spm_mesh_normals(... + struct('vertices',s.vertices,'faces',s.faces),true); + catch + s.normals = []; + end +end + +% Split the mesh into connected components +%-------------------------------------------------------------------------- +try + C = spm_mesh_label(s.faces); + d = []; + try + if size(s.cdata,2) == 1 && (any(s.cdata>1) || any(s.cdata<0)) + mi = min(s.cdata); ma = max(s.cdata); + s.cdata = (s.cdata-mi)/ (ma-mi); + else + end + end + for i=1:numel(unique(C)) + d(i).faces = s.faces(C==i,:); + u = unique(d(i).faces); + d(i).vertices = s.vertices(u,:); + d(i).normals = s.normals(u,:); + a = 1:max(d(i).faces(:)); + a(u) = 1:size(d(i).vertices,1); + %a = sparse(1,double(u),1:1:size(d(i).vertices,1)); + d(i).faces = a(d(i).faces); + d(i).mat = s.mat; + try + d(i).cdata = s.cdata(u,:); + if size(d(i).cdata,2) == 1 + d(i).cdata = repmat(d(i).cdata,1,3); + end + end + end + s = d; +end + +% Open file for writing +%-------------------------------------------------------------------------- +fid = fopen(filename,'wt'); +if fid == -1 + error('Unable to write file %s: permission denied.',filename); +end + +% FILE_HEADER +%-------------------------------------------------------------------------- +fprintf(fid,'FILE_FORMAT "IDTF"\n'); +fprintf(fid,'FORMAT_VERSION 100\n\n'); + +% NODES +%-------------------------------------------------------------------------- +for i=1:numel(s) + fprintf(fid,'NODE "MODEL" {\n'); + fprintf(fid,'%sNODE_NAME "%s"\n',o(1),sprintf('Mesh%04d',i)); + fprintf(fid,'%sPARENT_LIST {\n',o(1)); + fprintf(fid,'%sPARENT_COUNT %d\n',o(2),1); + fprintf(fid,'%sPARENT %d {\n',o(2),0); + fprintf(fid,'%sPARENT_NAME "%s"\n',o(3),''); + fprintf(fid,'%sPARENT_TM {\n',o(3)); + I = s(i).mat; % eye(4); + for j=1:size(I,2) + fprintf(fid,'%s',o(4)); fprintf(fid,'%f ',I(:,j)'); fprintf(fid,'\n'); + end + fprintf(fid,'%s}\n',o(3)); + fprintf(fid,'%s}\n',o(2)); + fprintf(fid,'%s}\n',o(1)); + fprintf(fid,'%sRESOURCE_NAME "%s"\n',o(1),sprintf('Mesh%04d',i)); + %fprintf(fid,'%sMODEL_VISIBILITY "BOTH"\n',o(1)); + fprintf(fid,'}\n\n'); +end + +% NODE_RESOURCES +%-------------------------------------------------------------------------- +for i=1:numel(s) + fprintf(fid,'RESOURCE_LIST "MODEL" {\n'); + fprintf(fid,'%sRESOURCE_COUNT %d\n',o(1),1); + fprintf(fid,'%sRESOURCE %d {\n',o(1),0); + fprintf(fid,'%sRESOURCE_NAME "%s"\n',o(2),sprintf('Mesh%04d',i)); + fprintf(fid,'%sMODEL_TYPE "MESH"\n',o(2)); + fprintf(fid,'%sMESH {\n',o(2)); + fprintf(fid,'%sFACE_COUNT %d\n',o(3),size(s(i).faces,1)); + fprintf(fid,'%sMODEL_POSITION_COUNT %d\n',o(3),size(s(i).vertices,1)); + fprintf(fid,'%sMODEL_NORMAL_COUNT %d\n',o(3),size(s(i).normals,1)); + if ~isfield(s(i),'cdata') || isempty(s(i).cdata) + c = 0; + else + c = size(s(i).cdata,1); + end + fprintf(fid,'%sMODEL_DIFFUSE_COLOR_COUNT %d\n',o(3),c); + fprintf(fid,'%sMODEL_SPECULAR_COLOR_COUNT %d\n',o(3),0); + fprintf(fid,'%sMODEL_TEXTURE_COORD_COUNT %d\n',o(3),0); + fprintf(fid,'%sMODEL_BONE_COUNT %d\n',o(3),0); + fprintf(fid,'%sMODEL_SHADING_COUNT %d\n',o(3),1); + fprintf(fid,'%sMODEL_SHADING_DESCRIPTION_LIST {\n',o(3)); + fprintf(fid,'%sSHADING_DESCRIPTION %d {\n',o(4),0); + fprintf(fid,'%sTEXTURE_LAYER_COUNT %d\n',o(5),0); + fprintf(fid,'%sSHADER_ID %d\n',o(5),0); + fprintf(fid,'%s}\n',o(4)); + fprintf(fid,'%s}\n',o(3)); + + fprintf(fid,'%sMESH_FACE_POSITION_LIST {\n',o(3)); + fprintf(fid,'%d %d %d\n',s(i).faces'-1); + fprintf(fid,'%s}\n',o(3)); + + fprintf(fid,'%sMESH_FACE_NORMAL_LIST {\n',o(3)); + fprintf(fid,'%d %d %d\n',s(i).faces'-1); + fprintf(fid,'%s}\n',o(3)); + + fprintf(fid,'%sMESH_FACE_SHADING_LIST {\n',o(3)); + fprintf(fid,'%d\n',zeros(size(s(i).faces,1),1)); + fprintf(fid,'%s}\n',o(3)); + + if c + fprintf(fid,'%sMESH_FACE_DIFFUSE_COLOR_LIST {\n',o(3)); + fprintf(fid,'%d %d %d\n',s(i).faces'-1); + fprintf(fid,'%s}\n',o(3)); + end + + fprintf(fid,'%sMODEL_POSITION_LIST {\n',o(3)); + fprintf(fid,'%f %f %f\n',s(i).vertices'); + fprintf(fid,'%s}\n',o(3)); + + fprintf(fid,'%sMODEL_NORMAL_LIST {\n',o(3)); + fprintf(fid,'%f %f %f\n',s(i).normals'); + fprintf(fid,'%s}\n',o(3)); + + if c + fprintf(fid,'%sMODEL_DIFFUSE_COLOR_LIST {\n',o(3)); + fprintf(fid,'%f %f %f\n',s(i).cdata'); + fprintf(fid,'%s}\n',o(3)); + end + + fprintf(fid,'%s}\n',o(2)); + fprintf(fid,'%s}\n',o(1)); + fprintf(fid,'}\n'); +end + +% Close file +%-------------------------------------------------------------------------- +fclose(fid); + + +%========================================================================== +% function save_obj(s,filename) +%========================================================================== +function save_obj(s,filename) + +% Open file for writing +%-------------------------------------------------------------------------- +fid = fopen(filename,'wt'); +if fid == -1 + error('Unable to write file %s: permission denied.',filename); +end + +% Vertices & faces +%-------------------------------------------------------------------------- +fprintf(fid,'# Wavefront OBJ file saved by %s\n',spm('Version')); +fprintf(fid,'v %f %f %f\n',s.vertices'); +fprintf(fid,'f %d %d %d\n',s.faces'); + +% Close file +%-------------------------------------------------------------------------- +fclose(fid); diff --git a/Toolboxes/spm12/@gifti/struct.m b/Toolboxes/spm12/@gifti/struct.m new file mode 100644 index 0000000000000000000000000000000000000000..98f97c934c40a560de59877e94030b07729c2ad8 --- /dev/null +++ b/Toolboxes/spm12/@gifti/struct.m @@ -0,0 +1,18 @@ +function s = struct(this) +% Struct method for GIfTI objects +% FORMAT s = struct(this) +% this - GIfTI object +% s - a structure containing public fields of the object +%__________________________________________________________________________ +% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging + +% Guillaume Flandin +% $Id: struct.m 6507 2015-07-24 16:48:02Z guillaume $ + +names = fieldnames(this); +values = cell(length(names), length(this(:))); + +for i=1:length(names) + [values{i,:}] = subsref(this(:), substruct('.',names{i})); +end +s = reshape(cell2struct(values,names,1),size(this)); diff --git a/Toolboxes/spm12/@gifti/subsasgn.m b/Toolboxes/spm12/@gifti/subsasgn.m new file mode 100644 index 0000000000000000000000000000000000000000..3b3f769510b6260b877532b27077bd06e922248e --- /dev/null +++ b/Toolboxes/spm12/@gifti/subsasgn.m @@ -0,0 +1,139 @@ +function this = subsasgn(this, subs, A) +% Subscript assignment for GIfTI objects +%__________________________________________________________________________ +% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging + +% Guillaume Flandin +% $Id: subsasgn.m 6513 2015-08-05 17:52:13Z guillaume $ + +switch subs(1).type + case '.' + if ~ismember(subs(1).subs, ... + {'vertices' 'faces' 'normals' 'cdata','mat','indices','private'}) + error('Reference to non-existent field ''%s''.',subs(1).subs); + end + % TODO % handle cases when length(subs) > 1 + [i,n] = isintent(this,subs(1).subs); + if isempty(i) && ~strcmp(subs(1).subs,'private') + n = length(this.data) + 1; + if n==1, this.data = {}; end + % TODO % Initialise data field appropriately + this.data{n}.metadata = struct([]); + this.data{n}.space = []; + this.data{n}.attributes.Dim = size(A); + % TODO % set DataType according to intent type + this.data{n}.data = []; + switch subs(1).subs + case {'vertices','mat'} + in = 'NIFTI_INTENT_POINTSET'; + dt = 'NIFTI_TYPE_FLOAT32'; + this.data{n}.space.DataSpace = 'NIFTI_XFORM_UNKNOWN'; + this.data{n}.space.TransformedSpace = 'NIFTI_XFORM_UNKNOWN'; + this.data{n}.space.MatrixData = eye(4); + case 'faces' + in = 'NIFTI_INTENT_TRIANGLE'; + dt = 'NIFTI_TYPE_INT32'; + case 'indices' + in = 'NIFTI_INTENT_NODE_INDEX'; + dt = 'NIFTI_TYPE_INT32'; + case 'normals' + in = 'NIFTI_INTENT_VECTOR'; + dt = 'NIFTI_TYPE_FLOAT32'; + case 'cdata' + in = 'NIFTI_INTENT_NONE'; + dt = 'NIFTI_TYPE_FLOAT32'; + otherwise + error('This should not happen.'); + end + this.data{n}.attributes.Intent = in; + this.data{n}.attributes.DataType = dt; + end + + switch subs(1).subs + %- .private + %-------------------------------------------------------------- + case 'private' + this = builtin('subsasgn',this,subs(2:end),A); + + % .mat + %-------------------------------------------------------------- + case 'mat' + if length(subs) > 1 + this.data{n}.space(1).MatrixData = builtin('subsasgn',... + this.data{n}.space(1).MatrixData,subs(2:end),A); + else + if ~isequal(size(A),[4 4]) + error('Invalid Coordinate System Transform Matrix.'); + end + this.data{n}.space(1).MatrixData = A; + end + + %- .faces + %-------------------------------------------------------------- + case 'faces' + if length(subs) > 1 + this.data{n}.data = int32(builtin('subsasgn',this.data{n}.data,subs(2:end),A-1)); + else + this.data{n}.data = int32(A - 1); + this.data{n}.attributes.Dim = size(A); + end + + %- .indices + %-------------------------------------------------------------- + case 'indices' + if n ~= 1 + this.data = this.data([n setdiff(1:numel(this.data),n)]); + n = 1; + end + if length(subs) > 1 + this.data{n}.data = int32(builtin('subsasgn',this.data{n}.data,subs(2:end),A-1)); + else + A = A(:); + this.data{n}.data = int32(A - 1); + this.data{n}.attributes.Dim = size(A); + end + + %- .vertices, .normals, .cdata + %-------------------------------------------------------------- + otherwise + if length(subs) > 1 + if numel(n) == 1 + this.data{n}.data = single(builtin('subsasgn',this.data{n}.data,subs(2:end),A)); + this.data{n}.attributes.Dim = size(this.data{n}.data); + else + if numel(subs(2).subs) == 1 + error('Linear indexing not supported: use multiple subscripts.'); + end + idx = subs(2).subs{2}; + if isequal(idx,':'), idx = 1:numel(this.data); end + for k=1:numel(idx) + s = subs(2); + s.subs{2} = 1; + if numel(A) == 1 + this.data{idx(k)}.data = single(builtin('subsasgn',this.data{idx(k)}.data,s,A)); + else + this.data{idx(k)}.data = single(builtin('subsasgn',this.data{idx(k)}.data,s,A(:,k))); + end + this.data{idx(k)}.attributes.Dim = size(this.data{idx(k)}.data); + end + end + else + if numel(n) == 1 + if isa(A,'file_array') + this.data{n}.data = A; + this.data{n}.attributes.Dim = A.dim; + else + this.data{n}.data = single(A); + this.data{n}.attributes.Dim = size(A); + end + else + error('Syntax not implemented.'); + end + end + end + + case '()' + case '{}' + otherwise + error('This should not happen.'); +end diff --git a/Toolboxes/spm12/@gifti/subsref.m b/Toolboxes/spm12/@gifti/subsref.m new file mode 100644 index 0000000000000000000000000000000000000000..0c7c0823610287d0c4770995627b5918f4a91048 --- /dev/null +++ b/Toolboxes/spm12/@gifti/subsref.m @@ -0,0 +1,60 @@ +function varargout = subsref(this,subs) +% Subscript referencing for GIfTI objects +%__________________________________________________________________________ +% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging + +% Guillaume Flandin +% $Id: subsref.m 6345 2015-02-20 12:25:50Z guillaume $ + +if length(this) > 1 && ~strcmp(subs(1).type,'()') + warning('Not implemented.'); + for i=1:numel(this) + varargout{i} = subsref(this(i),subs); + end + return; +end + +switch subs(1).type + case '.' + [i,j] = isintent(this,subs(1).subs); + if isempty(i) + if strcmp(subs(1).subs,'private') + varargout{1} = builtin('struct',this); + else + error('Reference to non-existent field ''%s''.',subs(1).subs); + end + else + if strcmp(subs(1).subs,'mat') + varargout{1} = this.data{j}.space.MatrixData; + elseif strcmp(subs(1).subs,'labels') + varargout{1} = this.label; + else + if length(j) == 1 + varargout{1} = this.data{j}.data; + else + a = [this.data{j}]; + try + varargout{1} = [a.data]; + catch + error('Data arrays are of different sizes.'); + end + end + end + end + if strcmp(subs(1).subs,'faces') || strcmp(subs(1).subs,'indices') + varargout{1} = varargout{1} + 1; % indices start at 1 + end + if length(subs) > 1 + varargout{1} = subsref(varargout{1},subs(2:end)); + end + case '{}' + error('Cell contents reference from a non-cell array object.'); + case '()' + if length(subs) == 1 + varargout{1} = builtin('subsref',this,subs(1)); + else + varargout{1} = subsref(builtin('subsref',this,subs(1)),subs(2:end)); + end + otherwise + error('This should not happen.'); +end \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/Contents.m b/Toolboxes/spm12/@meeg/Contents.m new file mode 100644 index 0000000000000000000000000000000000000000..9e6767c8f8901aaf090447642d0ae1c678b74ca0 --- /dev/null +++ b/Toolboxes/spm12/@meeg/Contents.m @@ -0,0 +1,9 @@ +% MEEG Object +% +% Functionalities of the MEEG object are described in the SPM manual, +% Chapter 13, Section 7. +% _________________________________________________________________________ +% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: Contents.m 2696 2009-02-05 20:29:48Z guillaume $ \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/badchannels.m b/Toolboxes/spm12/@meeg/badchannels.m new file mode 100644 index 0000000000000000000000000000000000000000..d0453569eb1b0ef2ea960a32b54e75fc5cbea174 --- /dev/null +++ b/Toolboxes/spm12/@meeg/badchannels.m @@ -0,0 +1,49 @@ +function res = badchannels(this, varargin) +% Method for getting/setting bad channels +% FORMAT res = badchannels(this) +% _______________________________________________________________________ +% Copyright (C) 2008-2012 Wellcome Trust Centre for Neuroimaging + +% Stefan Kiebel +% $Id: badchannels.m 5933 2014-03-28 13:22:28Z vladimir $ + +if length(varargin) == 2 && isnumeric(varargin{1}) + % make sure that the two inputs for set are the same length + if ~(length(varargin{2}) == 1 || (length(varargin{1}) == length(varargin{2}))) + error('Use either same vector length or scalar for value'); + end +end + +if numel(varargin) >= 1 && (isnumeric(varargin{1}) && ~isempty(varargin{1})) + if ~(all(varargin{1} >= 1) && all(varargin{1} <= nchannels(this))) + error('Channel number out of range.'); + end +end + +if numel(varargin) >= 2 && (isnumeric(varargin{1}) && ~isempty(varargin{1})) + ubad = unique(varargin{2}); + if isempty(ubad) || ~all(ismember(ubad, [0 1])) + error('Illegal bad flags (should be 0 or 1)'); + end +end + +if this.montage.Mind == 0 + res = getset(this, 'channels', 'bad', varargin{:}); +elseif numel(varargin) >= 2 + this.montage.M(this.montage.Mind) = getset(this.montage.M(this.montage.Mind), 'channels', 'bad', varargin{:}); + res = this; +else + res = getset(this.montage.M(this.montage.Mind), 'channels', 'bad', varargin{:}); +end + +% Return channel indices if called without arguments and [0, 1] if called +if numel(varargin) <= 1 % get + if iscell(res) + res = [res{:}]; + end + res = logical(res); + if isempty(varargin) + res = find(res); + end +end + diff --git a/Toolboxes/spm12/@meeg/badsamples.m b/Toolboxes/spm12/@meeg/badsamples.m new file mode 100644 index 0000000000000000000000000000000000000000..e913fc7b72cf4a77f062d5da2ea75cc31a5f2e9d --- /dev/null +++ b/Toolboxes/spm12/@meeg/badsamples.m @@ -0,0 +1,48 @@ +function res = badsamples(this, chanind, sampind, trialind) +% Returns an array of 0/1 marking bad data based on artefact events and bad flags +% FORMAT res = badsamples(this, chanind, sampind, trialind) +% _______________________________________________________________________ +% Copyright (C) 2013 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: badsamples.m 7199 2017-11-01 16:42:12Z vladimir $ + +if ischar(chanind) && isequal(chanind, ':') + chanind = 1:nchannels(this); +end + +if ischar(sampind) && isequal(sampind, ':') + sampind = 1:nsamples(this); +end + +if ischar(trialind) && isequal(trialind, ':') + trialind = 1:ntrials(this); +end + +if ~isequal(type(this), 'continuous') && ~any(trialonset(this)) + error('Trial onset information is not available. Cannot map artefact events to samples.'); +end + +res = false(length(chanind), nsamples(this), length(trialind)); +for i = 1:length(trialind) + + ev = events(this, trialind(i)); + if iscell(ev) + ev = ev{1}; + end + + if ~isempty(ev) + ev = ev(intersect(strmatch('artefact', {ev.type}),... + find(cellfun(@ischar, {ev.value})))); + for k = 1:numel(ev) + [dum, chan] = intersect(chanind, selectchannels(this, ev(k).value)); + samples = find((trialonset(this, trialind(i))+time(this))>=ev(k).time & ... + (trialonset(this, trialind(i))+time(this))<=(ev(k).time+ev(k).duration)); + res(chan, samples, i) = true; + end + end +end + +res = res(:, sampind, :); +res(badchannels(this, chanind), :, :) = true; +res(:, :, badtrials(this, trialind)) = true; diff --git a/Toolboxes/spm12/@meeg/badtrials.m b/Toolboxes/spm12/@meeg/badtrials.m new file mode 100644 index 0000000000000000000000000000000000000000..88406b1e1aea3fdfae4bc19b5133740c5069e7a3 --- /dev/null +++ b/Toolboxes/spm12/@meeg/badtrials.m @@ -0,0 +1,37 @@ +function res = badtrials(this, varargin) +% Method for getting/setting bad trials +% FORMAT res = badtrials(this) +% _______________________________________________________________________ +% Copyright (C) 2011-2012 Wellcome Trust Centre for Neuroimaging + +% Christophe Phillips +% $Id: badtrials.m 5592 2013-07-24 16:25:55Z vladimir $ + + +if length(varargin) == 2 && ~isempty(varargin{1}) + % make sure that the two inputs for set are the same length + if ~(length(varargin{2}) == 1 || (length(varargin{1}) == length(varargin{2}))) + error('Use either same vector length or scalar for value'); + end +end + +if numel(varargin) >= 2 + ubad = unique(varargin{2}); + if isempty(ubad) || ~all(ismember(ubad, [0 1])) + error('Illegal bad flags (should be 0 or 1)'); + end +end + +res = getset(this, 'trials', 'bad', varargin{:}); + + +% Return trial indices if called without arguments and [0, 1] if called +if numel(varargin) <= 1 % get + if iscell(res) + res = [res{:}]; + end + res = logical(res); + if isempty(varargin) + res = find(res); + end +end diff --git a/Toolboxes/spm12/@meeg/blank.m b/Toolboxes/spm12/@meeg/blank.m new file mode 100644 index 0000000000000000000000000000000000000000..f5092bde6ca205163e522d1c01644e6bee3434ef --- /dev/null +++ b/Toolboxes/spm12/@meeg/blank.m @@ -0,0 +1,40 @@ +function this = blank(this, fnamedat) +% Creates a blank datafile matching in the header in dimensions +% Will not erase existing datafile it it's there +% FORMAT this = blank(this) +% Will create the datafile using fname and path +% FORMAT this = blank(this, fnamedat) +% Will create the datafile using the provided name and path +% _________________________________________________________________________ +% Copyright (C) 2011-2012 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: blank.m 5648 2013-09-23 12:40:40Z vladimir $ + +if nargin == 1 + [p, f] = fileparts(fullfile(this)); + fnamedat = fullfile(p, [f '.dat']); +else + [p, f, x] = fileparts(fnamedat); + if isempty(p) + p = path(this); + end + if isempty(x) + x = '.dat'; + end + fnamedat = fullfile(p, [f x]); +end + +if exist(fnamedat, 'file') + error('Data file exists. Use rmdata to delete.') +end + +if isempty(this) + error('All header dimensions should be >0'); +end + +this.data = file_array(fnamedat, size(this), 'float32-le'); + +initialise(this.data); + +this = check(this); diff --git a/Toolboxes/spm12/@meeg/chanlabels.m b/Toolboxes/spm12/@meeg/chanlabels.m new file mode 100644 index 0000000000000000000000000000000000000000..563347fd370f7cf15a965cda3bb67498438f2ba0 --- /dev/null +++ b/Toolboxes/spm12/@meeg/chanlabels.m @@ -0,0 +1,63 @@ +function res = chanlabels(this, varargin) +% Method for getting/setting the channel labels +% FORMAT res = chanlabels(this, ind, label) +% _______________________________________________________________________ +% Copyright (C) 2008-2012 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: chanlabels.m 5933 2014-03-28 13:22:28Z vladimir $ + +if this.montage.Mind == 0 + if nargin == 3 + ind = varargin{1}; + label = varargin{2}; + + if iscell(label) && length(label)>1 + if isnumeric(ind) && length(ind)~=length(label) + error('Indices and values do not match'); + end + + if length(label)>1 + for i = 1:length(label) + for j = (i+1):length(label) + if strcmp(label{i}, label{j}) + error('All labels must be different'); + end + end + end + end + + end + end + + res = getset(this, 'channels', 'label', varargin{:}); +else +% case with an online montage applied + if nargin == 3 + ind = varargin{1}; + label = varargin{2}; + + if iscell(label) && length(label)>1 + if isnumeric(ind) && length(ind)~=length(label) + error('Indices and values do not match'); + end + + if length(label)>1 + for i = 1:length(label) + for j = (i+1):length(label) + if strcmp(label{i}, label{j}) + error('All labels must be different'); + end + end + end + end + + end + + this.montage.M(this.montage.Mind) = getset(this.montage.M(this.montage.Mind), 'channels', 'label', varargin{:}); + res = this; + else + res = getset(this.montage.M(this.montage.Mind), 'channels', 'label', varargin{:}); + end + +end \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/chantype.m b/Toolboxes/spm12/@meeg/chantype.m new file mode 100644 index 0000000000000000000000000000000000000000..486c1c69bf8b0243bb55e51ca3aa0483513b5d97 --- /dev/null +++ b/Toolboxes/spm12/@meeg/chantype.m @@ -0,0 +1,24 @@ +function res = chantype(this, varargin) +% Method for setting/getting channel types +% FORMAT chantype(this, ind, type) +% ind - channel index +% type - type (string: 'EEG', 'MEG', 'LFP' etc.) +% +% FORMAT chantype(this, ind), chantype(this) +% Sets channel types to default using Fieldtrip channelselection +% _______________________________________________________________________ +% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: chantype.m 5933 2014-03-28 13:22:28Z vladimir $ + +if this.montage.Mind==0 + res = getset(this, 'channels', 'type', varargin{:}); +else + if nargin == 3 + this.montage.M(this.montage.Mind) = getset(this.montage.M(this.montage.Mind), 'channels', 'type', varargin{:}); + res = this; + else + res = getset(this.montage.M(this.montage.Mind), 'channels', 'type', varargin{:}); + end +end diff --git a/Toolboxes/spm12/@meeg/check.m b/Toolboxes/spm12/@meeg/check.m new file mode 100644 index 0000000000000000000000000000000000000000..96d72b66bf7eb4c695bbcbc0a0e74d0d7ae40322 --- /dev/null +++ b/Toolboxes/spm12/@meeg/check.m @@ -0,0 +1,160 @@ +function [this, ok] = check(this, option) +% Method that performs integrity checks of the meeg object +% and its readiness for particular purposes. +% FORMAT this = check(this, option) +% IN +% option - 'basic' (default) - just check the essential fields +% '3d' - check if suitable for source reconstruction +% 'dcm' - check if suitable for DCM +% +% OUT +% ok - 1 - OK, 0- failed +% _______________________________________________________________________ +% Copyright (C) 2008-2012 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: check.m 6542 2015-09-09 11:48:34Z karl $ + +if nargin == 1 + option = 'basic'; +end + +ok = 1; + +this = meeg(struct(this)); + +if isequal(option, 'basic') + return; +end + +if ~isequal(transformtype(this), 'time') + ok = 0; + disp('Source reconstruction and DCM only work for time domain data'); + return; +end + +if this.montage.Mind~=0 + disp('Virtual montage is applied. Make sure this is what you want.') +end + +eegind = indchantype(this, 'EEG'); +megind = indchantype(this, {'MEG'}); +planarind = indchantype(this, {'MEGPLANAR'}); +lfpind = indchantype(this, 'LFP'); + +if ~isempty([eegind(:); megind(:); planarind(:)]) + if ~isempty(eegind) + if ~isfield(this.sensors, 'eeg') || isempty(this.sensors.eeg) + ok = 0; + disp('EEG sensor locations are not specified'); + else + if ~isempty(setdiff(chanlabels(this, eegind), this.sensors.eeg.label)) + ok = 0; + disp('Not all EEG channel locations are specified'); + end + end + + if ~isempty(strmatch('unknown', units(this, eegind))) + this = units(this, eegind, 'uV'); + + warning_flexible('EEG channel units are missing. Assuming uV, source scaling might be wrong'); + end + end + + if ~isempty([megind(:); planarind(:)]) + if ~isfield(this.sensors, 'meg') || isempty(this.sensors.meg) + ok = 0; + disp('MEG sensor locations are not specified'); + else + if ~isempty(setdiff({this.channels(megind).label}, this.sensors.meg.label)) + disp('Not all MEG sensor locations are specified'); + end + end + + if ~isempty(strmatch('unknown', units(this, megind))) + this = units(this, megind, 'fT'); + + warning_flexible('MEG channel units are missing. Assuming fT, source scaling might be wrong'); + end + + if ~isempty(strmatch('unknown', units(this, planarind))) + this = units(this, planarind, 'fT/mm'); + + warning_flexible('MEGPLANAR channel units are missing. Assuming fT/mm, source scaling might be wrong'); + end + end + + if isempty(this.fiducials) + ok = 0; + disp('No fiducials are defined'); + end + + if ~isfield(this.fiducials, 'pnt') || isempty(this.fiducials.pnt) + if ~isempty(eegind) + % Copy EEG sensors to fiducials. + this.fiducials.pnt = this.sensors.eeg.elecpos; + else + this.fiducials.pnt = sparse(0, 3); + end + end + + if ~isfield(this.fiducials, 'fid') || ... + ~all(isfield(this.fiducials.fid, {'pnt', 'label'})) ||... + (length(this.fiducials.fid.label) ~= size(this.fiducials.fid.pnt, 1)) || ... + length(this.fiducials.fid.label) < 3 + ok = 0; + disp('At least 3 fiducials with labels are required'); + end + + nzlbl = {'fidnz', 'nz', 'nas', 'nasion', 'spmnas'}; + lelbl = {'fidle', 'fidt9', 'lpa', 'lear', 'earl', 'le', 'l', 't9', 'spmlpa'}; + relbl = {'fidre', 'fidt10', 'rpa', 'rear', 'earr', 're', 'r', 't10', 'spmrpa'}; + + [sel1, nzind] = match_str(nzlbl, lower(this.fiducials.fid.label)); + if isempty(nzind) + disp('Could not find the nasion fiducial'); + else + nzind = nzind(1); + end + + [sel1, leind] = match_str(lelbl, lower(this.fiducials.fid.label)); + if isempty(leind) + disp('Could not find the left fiducial'); + else + leind = leind(1); + end + + [sel1, reind] = match_str(relbl, lower(this.fiducials.fid.label)); + if isempty(reind) + disp('Could not find the right fiducial'); + else + reind = reind(1); + end + + restind = setdiff(1:length(this.fiducials.fid.label), [nzind(:)', leind(:)', reind(:)']); + + this.fiducials.fid.label = this.fiducials.fid.label([nzind(:)', leind(:)', reind(:)', restind(:)']); + this.fiducials.fid.pnt = this.fiducials.fid.pnt([nzind(:)', leind(:)', reind(:)', restind(:)'], :); + +end + +if isequal(option, '3d') + if ~ismember(modality(this), {'EEG', 'MEG', 'Multimodal'}) + ok = 0; + disp('Unsupported modality for 3D source reconstruction'); + end +end + +if isequal(option, 'dcm') + if strcmp(option, 'dcm') + if ~ismember(modality(this, 0), {'EEG', 'MEG', 'MEGPLANAR', 'Multimodal', 'LFP','ILAM'}) + ok = 0; + disp('Unsupported modality for DCM'); + end + end + + if ~isempty(lfpind) && ~isempty([eegind, megind]) + ok = 0; + disp('DCM does not allow mixing scalp and LFP channels in the same dataset'); + end +end \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/clone.m b/Toolboxes/spm12/@meeg/clone.m new file mode 100644 index 0000000000000000000000000000000000000000..3e2ca06166cbea09992797f4570ee5b472dea6d4 --- /dev/null +++ b/Toolboxes/spm12/@meeg/clone.m @@ -0,0 +1,111 @@ +function new = clone(this, fnamedat, dim, reset) +% Creates a copy of the object with a new, empty data file, +% possibly changing dimensions +% FORMAT new = clone(this, fnamedat, dim, reset) +% reset - 0 (default) do not reset channel or trial info unless dimensions +% change, 1 - reset channels only, 2 - trials only, 3 both +% Note that when fnamedat comes with a path, the cloned meeg object uses +% it. Otherwise, its path is by definition that of the meeg object to be +% cloned. +% _________________________________________________________________________ +% Copyright (C) 2008-2012 Wellcome Trust Centre for Neuroimaging + +% Stefan Kiebel, Vladimir Litvak +% $Id: clone.m 6829 2016-07-07 10:16:46Z vladimir $ + +if nargin < 4 + reset = 0; +end + +if nargin < 3 + dim = size(this); +end + +% if number of channels is modified, throw away montages +if dim(1) ~= nchannels(this) + this = montage(this,'remove',1:montage(this,'getnumber')); + disp('Changing the number of channels, so discarding online montages.'); +end + +new = montage(this, 'switch', 0); +new = unlink(new); + +% check file path first +[pth, fname] = fileparts(fnamedat); +if isempty(pth) + pth = this.path; +end + +newFileName = [fullfile(pth, fname),'.dat']; + +% copy the file_array +d = this.data; % +d.fname = newFileName; +dim_o = d.dim; + +% This takes care of an issue specific to int data files which are not +% officially supported in SPM8/12. +if dim(1)>dim_o(1) && length(d.scl_slope)>1 + % adding channel to montage and scl_slope defined for old montage + % -> need to increase scl_slope + v_slope = mode(d.scl_slope); + if length(v_slope)>1 + warning(['Trying to guess the scaling factor for new channels.',... + ' This might be not exact.']); + end + d.scl_slope = [d.scl_slope' ones(1,dim(1)-dim_o(1))*v_slope]'; +end +d.dim = dim; + +% physically initialise file +initialise(d); +if length(dim) == 3 + nsampl = dim(2); + ntrial = dim(3); + new = transformtype(new, 'time'); +elseif length(dim) == 4 + nsampl = dim(3); + ntrial = dim(4); + + if ~strncmpi(transformtype(new), 'TF',2) + new = transformtype(new, 'TF'); + end + + % This assumes that the frequency axis will be set correctly after + % cloning and is neccesary to avoid an inconsistent state + new.transform.frequencies = 1:dim(2); +else + error('Dimensions different from 3 or 4 are not supported.'); +end + +% change filenames +new.fname = [fname,'.mat']; +new.path = pth; + +% ensure consistency +if (dim(1) ~= nchannels(this)) || ismember(reset, [1 3]) + new.channels = []; + for i = 1:dim(1) + new.channels(i).label = ['Ch' num2str(i)]; + end +end + +if ntrial ~= ntrials(this) || ismember(reset, [2 3]) + new.trials = repmat(struct('label', 'Undefined'), 1, ntrial); +end + +if (nsampl ~= nsamples(this)) + new.Nsamples = nsampl; +end + +new = check(new); + +% link into new meeg object +new = link(new, d.fname, d.dtype, d.scl_slope, d.offset); + +if strncmpi(transformtype(new),'TF',2) && strncmpi(transformtype(this),'TF',2) ... + && (nfrequencies(new) == nfrequencies(this)) + new = frequencies(new, ':', frequencies(this)); +end + +save(new); \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/conditions.m b/Toolboxes/spm12/@meeg/conditions.m new file mode 100644 index 0000000000000000000000000000000000000000..fa07b643c2c24a9bee1d6f18109756e50549cafa --- /dev/null +++ b/Toolboxes/spm12/@meeg/conditions.m @@ -0,0 +1,14 @@ +function res = conditions(this, varargin) +% Method for getting condition labels, over trials +% FORMAT res = conditions(this, ind, conditionlabels) +% _______________________________________________________________________ +% Copyright (C) 2008-2012 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: conditions.m 5025 2012-10-31 14:44:13Z vladimir $ + +res = getset(this, 'trials', 'label', varargin{:}); + +if nargin == 1 && ~iscell(res) + res = {res}; +end diff --git a/Toolboxes/spm12/@meeg/condlist.m b/Toolboxes/spm12/@meeg/condlist.m new file mode 100644 index 0000000000000000000000000000000000000000..48d72850e6f6a466a14afc4ed4a0ae19cb7313b7 --- /dev/null +++ b/Toolboxes/spm12/@meeg/condlist.m @@ -0,0 +1,53 @@ +function res = condlist(this, newcondlist) +% Method for getting a list of unique condition labels sorted according to +% the trial order in the file +% FORMAT res = condlist(this) +% _______________________________________________________________________ +% Copyright (C) 2008-2012 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: condlist.m 5472 2013-05-08 00:24:36Z vladimir $ + +res = getset(this, 'trials', 'label'); + +if isempty(res) + if nargin == 1 + res = {}; + else + res = this; + end + return; +end + + +if ~iscell(res) + res = {res}; +end + + +[res, ind] = unique(res); + + +if nargin == 1 + + [junk, ind] = sort(ind); + + res = res(ind); + + if numel(res)>1 && ~isempty(this.condlist) + [sel1, sel2] = match_str(this.condlist, res); + res = res([sel2(:)' setdiff(1:numel(res), sel2)]); + end +else + if iscell(newcondlist) && ~isempty(intersect(newcondlist, res)) + [junk, ind] = unique(newcondlist, 'first'); + newcondlist = newcondlist(sort(ind)); + + this.condlist = newcondlist(ismember(newcondlist, res)); + else + error('Expecting a cell array with condition labels as input.'); + end + res = this; +end + + diff --git a/Toolboxes/spm12/@meeg/coor2D.m b/Toolboxes/spm12/@meeg/coor2D.m new file mode 100644 index 0000000000000000000000000000000000000000..6cc11a864067d9fb0446e51a6d54f107f8f0cddd --- /dev/null +++ b/Toolboxes/spm12/@meeg/coor2D.m @@ -0,0 +1,159 @@ +function [res, plotind] = coor2D(this, ind, val, mindist) +% returns x and y coordinates of channels in 2D plane +% FORMAT coor2D(this) +% _______________________________________________________________________ +% Copyright (C) 2008-2012 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak, Laurence Hunt +% $Id: coor2D.m 5933 2014-03-28 13:22:28Z vladimir $ + + +megind = indchantype(this, {'MEG', 'MEGPLANAR', 'MEGCOMB'}); +eegind = indchantype(this, {'EEG'}); +otherind = setdiff(1:nchannels(this), [megind eegind]); + +if nargin==1 || isempty(ind) + if nargin<3 || (size(val, 2) 3 && ~isempty(mindist) + xy = shiftxy(xy,mindist); + end + + res = xy; +else + if this.montage.Mind==0 + this = getset(this, 'channels', 'X_plot2D', ind, val(1, :)); + this = getset(this, 'channels', 'Y_plot2D', ind, val(2, :)); + else + this.montage.M(this.montage.Mind) = getset(this.montage.M(this.montage.Mind), 'channels', 'X_plot2D', ind, val(1, :)); + this.montage.M(this.montage.Mind) = getset(this.montage.M(this.montage.Mind), 'channels', 'Y_plot2D', ind, val(2, :)); + end + res = this; +end + + +function xy = grid(n) + +ncol = ceil(sqrt(n)); +x = 0:(1/(ncol+1)):1; +x = 0.9*x+0.05; +x = x(2:(end-1)); +y = fliplr(x); +[X, Y] = meshgrid(x, y); +xy = [X(1:n); Y(1:n)]; + + +function xy = shiftxy(xy,mindist) + +x = xy(1,:); +y = xy(2,:); + +l=1; +i=1; %filler +mindist = mindist/0.999; % limits the number of loops +while (~isempty(i) && l<50) + xdiff = repmat(x,length(x),1) - repmat(x',1,length(x)); + ydiff = repmat(y,length(y),1) - repmat(y',1,length(y)); + xydist= sqrt(xdiff.^2 + ydiff.^2); %euclidean distance between all sensor pairs + + [i,j] = find(xydistj + + for m = 1:length(i); + if (xydist(i(m),j(m)) == 0) + diffvec = [mindist./sqrt(2) mindist./sqrt(2)]; + else + xydiff = [xdiff(i(m),j(m)) ydiff(i(m),j(m))]; + diffvec = xydiff.*mindist./xydist(i(m),j(m)) - xydiff; + end + x(i(m)) = x(i(m)) - diffvec(1)/2; + y(i(m)) = y(i(m)) - diffvec(2)/2; + x(j(m)) = x(j(m)) + diffvec(1)/2; + y(j(m)) = y(j(m)) + diffvec(2)/2; + end + l = l+1; +end + +xy = [x; y]; diff --git a/Toolboxes/spm12/@meeg/copy.m b/Toolboxes/spm12/@meeg/copy.m new file mode 100644 index 0000000000000000000000000000000000000000..4dfe016d732325ba95455b4dfd648f8668eeadca --- /dev/null +++ b/Toolboxes/spm12/@meeg/copy.m @@ -0,0 +1,43 @@ +function res = copy(this, newname) +% Method for copying a dataset +% FORMAT res = copy(this, fname) +% +% fname can be +% - path\filename -> data copied and renamed +% - path -> data copied only +%__________________________________________________________________________ +% Copyright (C) 2012 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: copy.m 5025 2012-10-31 14:44:13Z vladimir $ + +[p, f] = fileparts(newname); + +if ~isempty(p) + if ~exist(p,'dir'), mkdir(p); end; +else + p = path(this); +end + +if isempty(f) + f = fname(this); +else + f = [f '.mat']; +end + +if strcmpi(fullfile(this), fullfile(p, f)) + res = this; + return; +end + +%-Copy dataset (.mat and .dat) +%-------------------------------------------------------------------------- +new = clone(this, fullfile(p, f)); +[r, msg] = copyfile(fnamedat(this), ... + fnamedat(new), 'f'); +if ~r + error(msg); + res = []; +else + res = new; +end diff --git a/Toolboxes/spm12/@meeg/delete.m b/Toolboxes/spm12/@meeg/delete.m new file mode 100644 index 0000000000000000000000000000000000000000..12a4b885d92346a59bb82bbfbe29e86ba2a8a0d5 --- /dev/null +++ b/Toolboxes/spm12/@meeg/delete.m @@ -0,0 +1,15 @@ +function this = delete(this) +% Delete files of an M/EEG dataset from disk and return unlinked object +% FORMAT this = delete(this) +%__________________________________________________________________________ +% Copyright (C) 2008-2014 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: delete.m 6293 2014-12-23 18:15:57Z guillaume $ + + +if islinked(this) + spm_unlink(fnamedat(this)); +end +this = unlink(this); +spm_unlink(fullfile(this)); diff --git a/Toolboxes/spm12/@meeg/display.m b/Toolboxes/spm12/@meeg/display.m new file mode 100644 index 0000000000000000000000000000000000000000..4db9970ab5fde5e68071eb25f73da291ec1eea0b --- /dev/null +++ b/Toolboxes/spm12/@meeg/display.m @@ -0,0 +1,56 @@ +function str = display(this) +% Method for displaying information about an meeg object +% FORMAT display(this) +% _______________________________________________________________________ +% Copyright (C) 2008-2012 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: display.m 5025 2012-10-31 14:44:13Z vladimir $ + +str = ['SPM M/EEG data object\n'... + 'Type: ' type(this) '\n'... + 'Transform: ' transformtype(this) '\n'... + num2str(nconditions(this)), ' conditions\n'... + num2str(nchannels(this)), ' channels\n' + ]; + +if strncmpi(transformtype(this),'TF',2) + str = [str num2str(nfrequencies(this)), ' frequencies\n']; +end + +str = [str ... + num2str(nsamples(this)), ' samples/trial\n'... + num2str(ntrials(this)), ' trials\n'... + 'Sampling frequency: ' num2str(fsample(this)) ' Hz\n'... + 'Loaded from file %s\n\n' + ]; + +if numel(this.montage.M)>0 + idx = montage(this,'getindex'); + str = [str ... + num2str(montage(this,'getnumber')),' online montage(s) setup\n'... + 'Current montage applied (0=none): ',num2str(idx),'']; + if idx + str = [str ... + ' ,named: "',montage(this,'getname'),'"\n\n']; + else + str = [str '\n\n']; + end +end + +if islinked(this) + if strncmpi(transformtype(this),'TF',2) + str = [str 'Use the syntax D(channels, frequencies, samples, trials) to access the data\n']; + else + str = [str 'Use the syntax D(channels, samples, trials) to access the data\n']; + end +else + str = [str, 'There is no data linked to this header object\n']; +end + +str = [str 'Type "methods(''meeg'')" for the list of methods performing other operations with the object\n'... + 'Type "help meeg/method_name" to get help about methods\n']; + +str = sprintf(str, fullfile(this.path, this.fname)); + +disp(str); \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/events.m b/Toolboxes/spm12/@meeg/events.m new file mode 100644 index 0000000000000000000000000000000000000000..9c2c1f90b7a2adb72b2d4a313cbf9ae1afa506cd --- /dev/null +++ b/Toolboxes/spm12/@meeg/events.m @@ -0,0 +1,55 @@ +function res = events(this, varargin) +% Method for getting/setting events per trial +% FORMAT res = events(this, ind, event) +% ind = indices of trials +% _______________________________________________________________________ +% Copyright (C) 2008-2013 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: events.m 5613 2013-08-15 11:56:07Z vladimir $ + +if nargin == 2 + res = getset(this, 'trials', 'events', varargin{:}); +elseif nargin == 3 && ischar(varargin{2}) + ev = getset(this, 'trials', 'events', varargin{1}); + onsets = trialonset(this, varargin{1}); + if ~iscell(ev) + ev = {ev}; + strct = 1; + else + strct = 0; + end + + for j = 1:numel(ev) + event = ev{j}; + if ~isempty(event) + for i = 1:numel(event) + event(i).time = event(i).time - onsets(j); + + if isequal(varargin{2}, 'samples') + if onsets(j) == 0 + event(i).sample = event(i).time*this.Fsample; + else + event(i).sample = event(i).time*this.Fsample+1; + end + + event(i).duration = ceil(event(i).duration*this.Fsample); + + event(i).sample = max(round(event(i).sample), 1); + end + end + if isequal(varargin{2}, 'samples') + event = rmfield(event, 'time'); + end + end + ev{j} = event; + end + + if strct + res = ev{1}; + else + res = ev; + end +else + res = getset(this, 'trials', 'events', varargin{:}); +end \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/fiducials.m b/Toolboxes/spm12/@meeg/fiducials.m new file mode 100644 index 0000000000000000000000000000000000000000..322c971a1bd5773478374fe18b26fb65c4087782 --- /dev/null +++ b/Toolboxes/spm12/@meeg/fiducials.m @@ -0,0 +1,16 @@ +function res = fiducials(this, newfiducials) +% Method for getting/setting the fiducials field +% FORMAT res = fiducials(this, fiducials) +% _______________________________________________________________________ +% Copyright (C) 2008-2012 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: fiducials.m 6622 2015-12-03 11:54:13Z vladimir $ + +switch nargin + case 1 + res = this.fiducials; + case 2 + this.fiducials = ft_struct2double(fixpnt(newfiducials)); + res = this; +end diff --git a/Toolboxes/spm12/@meeg/fieldnames.m b/Toolboxes/spm12/@meeg/fieldnames.m new file mode 100644 index 0000000000000000000000000000000000000000..9b34a898f6309adf355cc8df3e73704cc5759e58 --- /dev/null +++ b/Toolboxes/spm12/@meeg/fieldnames.m @@ -0,0 +1,12 @@ +function res = fieldnames(this, varargin) +% Returns names of the fields in .other +% FORMAT res = fieldnames(this) +% +% An overloaded function... +% _______________________________________________________________________ +% Copyright (C) 2008-2012 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: fieldnames.m 5025 2012-10-31 14:44:13Z vladimir $ + +res = fieldnames(this.other, varargin{:}); \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/fname.m b/Toolboxes/spm12/@meeg/fname.m new file mode 100644 index 0000000000000000000000000000000000000000..12859015f8f30ad586960101e995a129d45f0650 --- /dev/null +++ b/Toolboxes/spm12/@meeg/fname.m @@ -0,0 +1,15 @@ +function res = fname(this, newname) +% Method for getting/setting file name +% FORMAT res = fname(this, name) +% _______________________________________________________________________ +% Copyright (C) 2008-2011 Wellcome Trust Centre for Neuroimaging + +% Stefan Kiebel +% $Id: fname.m 5025 2012-10-31 14:44:13Z vladimir $ + +if nargin == 1 + res = this.fname; +else + this.fname = [spm_file(newname, 'basename') '.mat']; + res = this; +end diff --git a/Toolboxes/spm12/@meeg/fnamedat.m b/Toolboxes/spm12/@meeg/fnamedat.m new file mode 100644 index 0000000000000000000000000000000000000000..e3a1aeb7bfb988c4923b851cfae24aae6cfb6d7b --- /dev/null +++ b/Toolboxes/spm12/@meeg/fnamedat.m @@ -0,0 +1,15 @@ +function res = fnamedat(this) +% Method for getting the name of the data file +% FORMAT res = fnamedat(this) +% _______________________________________________________________________ +% Copyright (C) 2008-2012 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: fnamedat.m 5025 2012-10-31 14:44:13Z vladimir $ + + +if islinked(this) + res = this.data.fname; +else + res = []; +end \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/frequencies.m b/Toolboxes/spm12/@meeg/frequencies.m new file mode 100644 index 0000000000000000000000000000000000000000..e2eb6f7bc55b28a81af07679358b01289a75b5ca --- /dev/null +++ b/Toolboxes/spm12/@meeg/frequencies.m @@ -0,0 +1,46 @@ +function res = frequencies(this, ind, f) +% Method for getting/setting frequencies of TF data +% FORMAT res = frequencies(this, ind, values) +% _________________________________________________________________________ +% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging + +% Stefan Kiebel +% $Id: frequencies.m 5079 2012-11-25 18:38:18Z vladimir $ + +if nargin >1 + if ~isnumeric(ind) + ind = 1:nfrequencies(this); + end +end + +if nargin < 3 + if strncmpi(transformtype(this), 'TF',2) + res = this.transform.frequencies; + else + res = []; + return + end + if exist('ind', 'var') == 1 + res = res(ind); + end +else + if ~strncmpi(transformtype(this), 'TF',2) + error('Frequencies can only be assigned to a TF dataset'); + end + + if any(f) <= 0 || any(~isnumeric(f)) + error('Frequencies must be positive numbers'); + end + + if length(ind)~=length(f) || max(ind)>size(this, 2) + error('Wrong frequency axis or indices'); + end + + if length(ind) == size(this.data, 2) + this.transform.frequencies = f; + else + this.transform.frequencies(ind) = f; + end + + res = this; +end diff --git a/Toolboxes/spm12/@meeg/fsample.m b/Toolboxes/spm12/@meeg/fsample.m new file mode 100644 index 0000000000000000000000000000000000000000..3635a224162943098589512e70ed2b2d5e2cb60b --- /dev/null +++ b/Toolboxes/spm12/@meeg/fsample.m @@ -0,0 +1,15 @@ +function res = fsample(this, value) +% Method for getting and setting the sampling rate +% FORMAT res = fsample(this) +% _______________________________________________________________________ +% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: fsample.m 3200 2009-06-12 17:29:40Z vladimir $ + +if nargin == 1 + res = this.Fsample; +else + this.Fsample = value; + res = this; +end \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/ftraw.m b/Toolboxes/spm12/@meeg/ftraw.m new file mode 100644 index 0000000000000000000000000000000000000000..011dc6062707287835651c3f21b0306970887cd4 --- /dev/null +++ b/Toolboxes/spm12/@meeg/ftraw.m @@ -0,0 +1,73 @@ +function raw = ftraw(this, chanind, timeind, trialind) +% Method for converting meeg object to Fieldtrip raw struct +% FORMAT raw = ftraw(this, chanind, timeind, trialind) +% _______________________________________________________________________ +% Copyright (C) 2008-2012 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: ftraw.m 6158 2014-09-09 12:23:49Z vladimir $ + +if ~islinked(this) + error('There is no data linked to the object'); +end + +if ~isequal(transformtype(this), 'time') + raw = fttimelock(this, chanind, timeind, trialind); + return; +end + +% chanind == 0 is accepted for backward compatibility +if nargin < 2 || ~isnumeric(chanind) || isequal(chanind, 0) + chanind = 1:nchannels(this); +end + +if nargin < 3 || ~isnumeric(timeind) + timeind = 1:nsamples(this); +end + +if nargin < 4 || ~isnumeric(trialind) + trialind = 1:ntrials(this); +end + +raw = []; + +raw.label = chanlabels(this, chanind)'; + +raw.trial = cell(1, length(trialind)); + +for i = 1:length(trialind) + raw.trial{i} = subsref(this, substruct('()', {chanind, timeind, trialind(i)})); +end + +raw.time = repmat({time(this, timeind)}, 1, length(trialind)); + +clist = condlist(this); + +condlabels = conditions(this, trialind); + +raw.trialinfo = 0*trialind; +for k = 1:numel(clist) + fprintf('mapping condition label "%s" to condition code %d\n', clist{k}, k); + sel = strcmp(clist{k}, condlabels); + raw.trialinfo(sel) = k; +end + +if ~isempty(sensors(this, 'MEG')) + raw.grad = sensors(this, 'MEG'); +end + +if ~isempty(sensors(this, 'EEG')) + raw.elec = sensors(this, 'EEG'); +end + +if isfield(this.other, 'origheader') + raw.hdr = this.other.origheader; +end + +onsets = trialonset(this, trialind); + +if all(onsets>0) + onsets = round(onsets(:)*fsample(this)); + raw.sampleinfo = [onsets+timeind(1) onsets+timeind(end)]-1; +end + diff --git a/Toolboxes/spm12/@meeg/fttimelock.m b/Toolboxes/spm12/@meeg/fttimelock.m new file mode 100644 index 0000000000000000000000000000000000000000..06120694185acf7f1225bf0b96d28f9c3e275073 --- /dev/null +++ b/Toolboxes/spm12/@meeg/fttimelock.m @@ -0,0 +1,99 @@ +function timelock = fttimelock(this, chanind, timeind, trialind, freqind) +% Method for converting meeg object to Fieldtrip timelock/freq struct +% FORMAT timelock = fttimelock(this, chanind, timeind, trialind, freqind) +% +% The method support both time and TF data and outputs different variants +% of timelock or freq FT struct depending on the dataset type and requested +% data dimensions. +% _______________________________________________________________________ +% Copyright (C) 2008-2012 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: fttimelock.m 6158 2014-09-09 12:23:49Z vladimir $ + +if ~islinked(this) + error('There is no data linked to the object'); +end + +if nargin < 2 || ~isnumeric(chanind) + chanind = 1:nchannels(this); +end + +if nargin < 3 || ~isnumeric(timeind) + timeind = 1:nsamples(this); +end + +if nargin < 4 || ~isnumeric(trialind) + trialind = 1:ntrials(this); +end + +if strncmpi(transformtype(this),'TF',2) && ... + (nargin < 5 || isempty(freqind)) + freqind = 1:nfrequencies(this); +end + +timelock = []; +timelock.label = chanlabels(this, chanind)'; + +if isequal(transformtype(this), 'time') + if isequal(type(this), 'continuous') + error('For continuous data use ftraw method'); + end + + if isequal(type(this), 'single') || length(trialind)>1 + timelock.dimord = 'rpt_chan_time'; + timelock.trial = permute(subsref(this, substruct('()', {chanind, timeind, trialind})), [3 1 2]); + else + timelock.dimord = 'chan_time'; + timelock.avg = spm_squeeze(subsref(this, substruct('()', {chanind, timeind, trialind})), 3); + end + + timelock.time = time(this, timeind); + +elseif strncmpi(transformtype(this),'TF',2) + if length(timeind)>1 + if isequal(type(this), 'single') || length(trialind)>1 + timelock.dimord = 'rpt_chan_freq_time'; + timelock.powspctrm = permute(subsref(this, substruct('()', {chanind, freqind, timeind, trialind})), [4 1 2 3]); + else + timelock.dimord = 'chan_freq_time'; + timelock.powspctrm = spm_squeeze(subsref(this, substruct('()', {chanind, freqind, timeind, trialind})), 3); + end + + timelock.time = time(this, timeind); + else + if isequal(type(this), 'single') || length(trialind)>1 + timelock.dimord = 'rpt_chan_freq'; + timelock.powspctrm = spm_squeeze(permute(subsref(this, substruct('()', {chanind, freqind, timeind, trialind})), [4 1 2 3]), 4); + else + timelock.dimord = 'chan_freq'; + timelock.powspctrm = spm_squeeze(subsref(this, substruct('()', {chanind, freqind, timeind, trialind})), [3 4]); + end + end + + timelock.freq = frequencies(this, freqind); +else + error('Unknown transform type.'); +end + +if length(trialind)>1 + + clist = condlist(this); + condlabels = conditions(this, trialind); + timelock.trialinfo = 0*trialind; + + for k = 1:numel(clist) + fprintf('mapping condition label "%s" to condition code %d\n', clist{k}, k); + sel = strcmp(clist{k}, condlabels); + timelock.trialinfo(sel) = k; + end + +end + +if ~isempty(sensors(this, 'MEG')) + timelock.grad = sensors(this, 'MEG'); +end + +if ~isempty(sensors(this, 'EEG')) + timelock.elec = sensors(this, 'EEG'); +end diff --git a/Toolboxes/spm12/@meeg/fullfile.m b/Toolboxes/spm12/@meeg/fullfile.m new file mode 100644 index 0000000000000000000000000000000000000000..b88d7291150951724ed438dfa96d243bd5c630b6 --- /dev/null +++ b/Toolboxes/spm12/@meeg/fullfile.m @@ -0,0 +1,11 @@ +function p = fullfile(this) +% Returns full path to the meeg mat file +% FORMAT p = fullfile(this) +% _______________________________________________________________________ +% Copyright (C) 2008-2011 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: fullfile.m 5025 2012-10-31 14:44:13Z vladimir $ + + +p = fullfile(path(this), fname(this)); \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/getfield.m b/Toolboxes/spm12/@meeg/getfield.m new file mode 100644 index 0000000000000000000000000000000000000000..06b34771246b917169b67a13de6754238a9455f2 --- /dev/null +++ b/Toolboxes/spm12/@meeg/getfield.m @@ -0,0 +1,12 @@ +function res = getfield(this, varargin) +% Returns fields in .other +% FORMAT res = getfield(this, varargin) +% +% An overloaded function... +% _______________________________________________________________________ +% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: getfield.m 3228 2009-06-26 17:43:19Z vladimir $ + +res = getfield(this.other, varargin{:}); \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/history.m b/Toolboxes/spm12/@meeg/history.m new file mode 100644 index 0000000000000000000000000000000000000000..6b8ef0476933e4b2165d561782dbba1787fd2a59 --- /dev/null +++ b/Toolboxes/spm12/@meeg/history.m @@ -0,0 +1,46 @@ +function res = history(this, varargin) +% Method for getting or adding to the history of function calls of some +% M/EEG data +% FORMAT res = history(this, varargin) +% _______________________________________________________________________ +% Copyright (C) 2008-2016 Wellcome Trust Centre for Neuroimaging + +% Stefan Kiebel +% $Id: history.m 6883 2016-09-19 13:42:05Z vladimir $ + + +if isempty(varargin) + res = this.history; +else + % add another history item + if length(varargin) > 2 % To enable reset + nh = 0; + this.history = []; + else + nh = length(this.history); + end + + if ischar(varargin{1}) + this.history(nh+1).fun = varargin{1}; + + if isstruct(varargin{2}) && isfield(varargin{2}, 'D') + if isa(varargin{2}.D, 'meeg') + varargin{2}.D = fullfile(varargin{2}.D); + elseif isa(varargin{2}.D, 'cell') + for i = 1:numel(varargin{2}.D) + if isa(varargin{2}.D{i}, 'meeg') + varargin{2}.D{i} = fullfile(varargin{2}.D{i}); + end + end + end + end + + this.history(nh+1).args = varargin{2}; + + [dum, this.history(nh+1).ver] = spm('ver'); + elseif isstruct(varargin{1}) + this.history = varargin{1}; + end + + res = this; +end \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/indchannel.m b/Toolboxes/spm12/@meeg/indchannel.m new file mode 100644 index 0000000000000000000000000000000000000000..172c1b203aa75bfb70f55d539491886ada32ddf5 --- /dev/null +++ b/Toolboxes/spm12/@meeg/indchannel.m @@ -0,0 +1,18 @@ +function res = indchannel(this, label) +% Method for getting channel indices based on channel labels +% FORMAT res = indchannel(this, label) +% this - MEEG object +% label - string or cell array of labels +% +% res - vector of channel indices matching labels +%__________________________________________________________________________ +% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: indchannel.m 3254 2009-07-07 15:18:54Z vladimir $ + +if ischar(label) + label = {label}; +end + +[junk, res] = match_str(label, chanlabels(this)); \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/indchantype.m b/Toolboxes/spm12/@meeg/indchantype.m new file mode 100644 index 0000000000000000000000000000000000000000..898a3be816e3baaeaa6da122110ef89acbe3f2a4 --- /dev/null +++ b/Toolboxes/spm12/@meeg/indchantype.m @@ -0,0 +1,69 @@ +function ind = indchantype(this, types, flag) +% Method for getting channel indices based on labels and/or types +% FORMAT ind = indchantype(this, types) +% this - MEEG object +% channels - string or cell array of strings may include +% ('ALL', 'EEG', 'MEG', 'ECG', 'EOG' etc.) +% flag - 'GOOD' or 'BAD' to include only good or bad channels +% respectively (all are selected by default) +% +% ind - vector of channel indices matching labels +%__________________________________________________________________________ +% Copyright (C) 2012 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: indchantype.m 6446 2015-05-22 14:10:56Z vladimir $ + +if ischar(types) + types = {types}; +end + +types = upper(types); +types = types(:)'; + +if ismember('ALL', types) + ind = 1:nchannels(this); +else + if ismember('FILTERED', types) + types = [types, 'MEEG', 'REF', 'EOG', 'ECG', 'EMG', 'LFP', 'PHYS', 'ILAM', 'SRC']; + types = setdiff(types, 'MEGCOMB'); + end + + if ismember('EOG', types) + types = [types, 'VEOG', 'HEOG']; + end + + if ismember('ECG', types) + types = [types, 'EKG']; + end + + if ismember('REF', types) + types = [types, 'REFMAG', 'REFGRAD', 'REFPLANAR']; + end + + if ismember('MEG', types) + types = [types, 'MEGMAG', 'MEGGRAD']; + end + + if ismember('MEGANY', types) + types = [types, 'MEG', 'MEGMAG', 'MEGGRAD', 'MEGPLANAR']; + end + + if ismember('MEEG', types) + types = [types, 'EEG', 'MEG', 'MEGMAG', 'MEGCOMB', 'MEGGRAD', 'MEGPLANAR']; + end + + ind = find(ismember(upper(chantype(this)), types)); +end + +if nargin > 2 + if strcmpi(flag, 'GOOD') + ind = setdiff(ind, badchannels(this)); + elseif strcmpi(flag, 'BAD') + ind = intersect(ind, badchannels(this)); + end +end + +ind = sort(unique(ind)); + +ind = ind(:)'; % must be row to allow to use it as loop indices \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/indfrequency.m b/Toolboxes/spm12/@meeg/indfrequency.m new file mode 100644 index 0000000000000000000000000000000000000000..455a7941aa4f43d1cc6fa79f848bcb062b0a45f7 --- /dev/null +++ b/Toolboxes/spm12/@meeg/indfrequency.m @@ -0,0 +1,35 @@ +function res = indfrequency(this, f) +% Method for getting the index closest to given frequency +% FORMAT res = indfrequency(this, f) +% this - MEEG object +% f - vector of frequencies (in Hz) +% +% res - vector of sample indices matching indices +%__________________________________________________________________________ +% Copyright (C) 2008-2012 Wellcome Trust Centre for Neuroimaging + +% Stefan Kiebel +% $Id: indfrequency.m 5212 2013-01-26 13:16:36Z vladimir $ + +if ~strncmpi(transformtype(this), 'TF',2) + error('Only TF datasets are supported'); +end + +res = NaN(1,length(f)); +fdiff = mean(diff(frequencies(this))); +if nsamples(this) > 0 + F = frequencies(this); + for i = 1:length(f) + if f(i) == -Inf + res(i) = 1; + elseif f(i) == Inf + res(i) = length(F); + else + [m, res(i)] = min(abs(F-f(i))); + if m > fdiff + warning('Could not find an index matching the requested frequency %d Hz', f(i)); + res(i) = NaN; + end + end + end +end diff --git a/Toolboxes/spm12/@meeg/indsample.m b/Toolboxes/spm12/@meeg/indsample.m new file mode 100644 index 0000000000000000000000000000000000000000..b0103b65850e2971b9eacd4562d83ffd2f452b1e --- /dev/null +++ b/Toolboxes/spm12/@meeg/indsample.m @@ -0,0 +1,32 @@ +function res = indsample(this, t) +% Method for getting the sample closest to some time point +% FORMAT res = indsample(this, t) +% this - MEEG object +% t - vector of time points in seconds +% +% res - vector of sample indices matching time points +%__________________________________________________________________________ +% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging + +% Stefan Kiebel +% $Id: indsample.m 3742 2010-03-02 15:15:43Z vladimir $ + +res = NaN(1,length(t)); +if this.Nsamples > 0 + T = time(this); + for i = 1:length(t) + if isfinite(t(i)) + [m,res(i)] = min(abs(T-t(i))); + if m > (1/this.Fsample) + warning('Could not find an index matching the requested time %d sec', t(i)); + res(i) = NaN; + end + elseif ~isnan(t(i)) % This allows to specify the time window as [-Inf Inf] + if t(i) < 0 + res(i) = 1; + else + res(i) = this.Nsamples; + end + end + end +end diff --git a/Toolboxes/spm12/@meeg/indtrial.m b/Toolboxes/spm12/@meeg/indtrial.m new file mode 100644 index 0000000000000000000000000000000000000000..e4971842f08bb52dc3875a12f46b51d3978e1c6b --- /dev/null +++ b/Toolboxes/spm12/@meeg/indtrial.m @@ -0,0 +1,33 @@ +function res = indtrial(this, label, flag) +% Method for getting trial indices based on condition labels +% FORMAT res = indtrial(this, label) +% this - MEEG object +% label - string or cell array of labels, 'GOOD' and 'BAD' +% can be added to list of labels to select only +% good or bad trials respectively +% flag - 'GOOD' or 'BAD' to include only good or bad trials +% respectively (all are selected by default) +% +% res - vector of trial indices matching condition labels +%__________________________________________________________________________ +% Copyright (C) 2008-2012 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: indtrial.m 6998 2017-01-31 16:48:27Z vladimir $ + +if ischar(label) + label = {label}; +end + +[dum, res] = match_str(label, conditions(this)); + +if nargin > 2 + if strcmpi(flag, 'GOOD') + [dum, ind] = setdiff(res, badtrials(this)); + elseif strcmpi(flag, 'BAD') + [dum, ind] = intersect(res, badtrials(this)); + end + res = res(sort(ind)); +end + +res = res(:)'; \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/isempty.m b/Toolboxes/spm12/@meeg/isempty.m new file mode 100644 index 0000000000000000000000000000000000000000..977da3594196747bfeb4da89887b46d2f0f08bd2 --- /dev/null +++ b/Toolboxes/spm12/@meeg/isempty.m @@ -0,0 +1,10 @@ +function out = isempty(this) +% True if the object is empty +% FORMAT out = isempty(this) +% _________________________________________________________________________ +% Copyright (C) 2012 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: isempty.m 5025 2012-10-31 14:44:13Z vladimir $ + +out = all(size(this)==0); diff --git a/Toolboxes/spm12/@meeg/isequal.m b/Toolboxes/spm12/@meeg/isequal.m new file mode 100644 index 0000000000000000000000000000000000000000..37405e8d2c363e3e8f8d2adb91f2116a6907edc1 --- /dev/null +++ b/Toolboxes/spm12/@meeg/isequal.m @@ -0,0 +1,10 @@ +function res = isequal(this, that) +% Method to check if 2 MEEG objects are the same +% FORMAT res = isequal(this, that) +% _______________________________________________________________________ +% Copyright (C) 2011 Wellcome Trust Centre for Neuroimaging + +% Christophe Phillips +% $Id: isequal.m 5025 2012-10-31 14:44:13Z vladimir $ + +res = isequal(struct(this), struct(that)); \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/isfield.m b/Toolboxes/spm12/@meeg/isfield.m new file mode 100644 index 0000000000000000000000000000000000000000..66a3fa632b60cef869ec9077d35b4d7c127fd0a6 --- /dev/null +++ b/Toolboxes/spm12/@meeg/isfield.m @@ -0,0 +1,13 @@ +function res = isfield(this, varargin) +% Returns true if the string fieldname is the name of a field in the +% substructure 'other' in the meeg object 'this'. +% FORMAT res = isfield(this,fieldname) +% +% An overloaded function... +% _______________________________________________________________________ +% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging + +% Christophe Phillips +% $Id: isfield.m 2720 2009-02-09 19:50:46Z vladimir $ + +res = isfield(this.other, varargin{:}); \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/islinked.m b/Toolboxes/spm12/@meeg/islinked.m new file mode 100644 index 0000000000000000000000000000000000000000..505b72a051aa369ecde0efc27f770535282a296a --- /dev/null +++ b/Toolboxes/spm12/@meeg/islinked.m @@ -0,0 +1,10 @@ +function out = islinked(this) +% True if the object is linked to data file +% FORMAT out = islinked(this) +% _________________________________________________________________________ +% Copyright (C) 2011 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: islinked.m 5167 2013-01-02 15:24:52Z vladimir $ + +out = isa(this.data, 'file_array'); diff --git a/Toolboxes/spm12/@meeg/link.m b/Toolboxes/spm12/@meeg/link.m new file mode 100644 index 0000000000000000000000000000000000000000..b068faaac8d6cfc79674ad472b52036e1bcb376d --- /dev/null +++ b/Toolboxes/spm12/@meeg/link.m @@ -0,0 +1,67 @@ +function this = link(this, fnamedat, dtype, slope, offset) +% Links the object to data file (only if exists) +% FORMAT this = link(this) +% Will try to find the datafile based on fname and path +% FORMAT this = link(this, fnamedat) +% Will find the datafile using the provided name and path +% FORMAT this = link(this, fnamedat, dtype, slope, offset) +% Additional parameters for non-float data files +% _________________________________________________________________________ +% Copyright (C) 2011 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: link.m 6437 2015-05-14 12:27:21Z vladimir $ + +if isempty(this) + error('All header dimensions should be >0'); +end + +if nargin == 1 || isempty(fnamedat) + [p, f] = fileparts(fullfile(this)); + fnamedat = fullfile(p, [f '.dat']); +else + [p, f, x] = fileparts(fnamedat); + if isempty(p) + p = path(this); + end + if isempty(x) + x = '.dat'; + end + fnamedat = fullfile(p, [f x]); +end + +% This is to re-use existing settings for non-floats. Use unlink to clear +% these settings. +if (nargin < 3) && isa(this.data, 'file_array') && ~isequal(lower(this.data.dtype), 'float32-le') + dtype = this.data.dtype; + offset = this.data.offset; + slope = this.data.scl_slope; +else + if nargin < 3, dtype = 'float32-le'; end + if nargin < 4, slope = 1; end + if nargin < 5, offset = 0; end +end + +if ~exist(fnamedat, 'file') + error('Data file not found'); +end + +% Size determination here should worked for unlinked objects and be insensitive +% to online montages. +if ~strncmpi(transformtype(this), 'TF', 2) + siz = [length(this.channels), nsamples(this), ntrials(this)]; +else + siz = [length(this.channels), nfrequencies(this), nsamples(this), ntrials(this)]; +end + +this.data = file_array(fnamedat, siz, dtype, offset, slope); + +siz = num2cell(size(this)); + +try + this.data(siz{:}); +catch + error('Dimensions mismatch. Could not link to the data file'); +end + +this = check(this); diff --git a/Toolboxes/spm12/@meeg/meeg.m b/Toolboxes/spm12/@meeg/meeg.m new file mode 100644 index 0000000000000000000000000000000000000000..225ac873730328eea242a1af3968cfbcc06dc606 --- /dev/null +++ b/Toolboxes/spm12/@meeg/meeg.m @@ -0,0 +1,147 @@ +function D = meeg(varargin) +% Function for creating meeg objects. +% FORMAT +% D = meeg; +% returns an empty object +% D = meeg(D); +% converts a D struct to object or does nothing if already +% object +% D = meeg(nchannels, nsamples, ntrials) +% return a time dataset with default settings +% D = meeg(nchannels, nfrequencies, nsamples, ntrials) +% return TF time dataset with default settings +% +% SPM MEEG format consists of a header object optionally linked to +% binary data file. The object is usually saved in the header mat file +% +% The header file will contain a struct called D. All +% information other than data is contained in this struct and access to the +% data is via methods of the object. Also, arbitrary data can be stored +% inside the object if their field names do not conflict with existing +% methods' names. +% +% The following is a description of the internal implementation of meeg. +% +% Fields of meeg: +% .type - type of data in the file: 'continuous', 'single', 'evoked' +% .Fsample - sampling rate +% +% .data - file_array object linking to the data or empty if unlinked +% +% +% .Nsamples - length of the trial (whole data if the file is continuous). +% .timeOnset - the peri-stimulus time of the first sample in the trial (in sec) +% +% .fname, .path - strings added by spm_eeg_load to keep track of where a +% header struct was loaded from. +% +% .trials - this describes the segments of the epoched file and is also a +% structure array. +% +% Subfields of .trials +% +% .label - user-specified string for the condition +% .onset - time of the first sample in seconds in terms of the +% original file +% .bad - 0 or 1 flag to allow rejection of trials. +% .repl - for epochs that are averages - number of replications used +% for the average. +% .tag - the user can put any data here that will be attached to +% the respective trial. This is useful e.g. to make sure the +% relation between regressors and data is not broken when +% removing bad trials or merging files. +% .events - this is a structure array describing events related to +% each trial. +% +% Subfields of .events +% +% .type - string (e.g. 'front panel trigger') +% .value - number or string, can be empty (e.g. 'Trig 1'). +% .time - in seconds in terms of the original file +% .duration - in seconds +% +% .channels - This is a structure array which is a field of meeg. +% length(channels) should equal size(.data.y, 1) and the order +% must correspond to the order of channels in the data. +% +% Subfields of .channels +% +% .label - channel label which is always a string +% .type - a string, possible values - 'MEG', 'EEG', 'VEOG', 'HEOG', +% 'EMG' ,'LFP' etc. +% .units - units of the data in the channel. +% .bad - 0 or 1 flag to mark channels as bad. +% .X_plot2D, .Y_plot2D - positions on 2D plane (formerly in ctf). NaN +% for channels that should not be plotted. +% +% .sensors +% +% +% Subfields of .sensors (optional) +% .meg - struct with sensor positions for MEG (subfields: .pnt .ori .tra .label) +% .eeg - struct with sensor positions for MEG (subfields: .pnt .tra .label) +% +% .fiducials - headshape and fiducials for coregistration with sMRI +% +% Subfiels of .fiducials (optional) +% .pnt - headshape points +% .fid.pnt - fiducial points +% .fid.label - fiducial labels +% +% .transform - additional information for transfomed (most commonly time-frequency) data +% Subfields of .transform +% .ID - 'time', 'TF', or 'TFphase' +% .frequencies (optional) +% +% .history - structure array describing commands that modified the file. +% +% Subfields of .history: +% +% .function - string, the function name +% .arguments - cell array, the function arguments +% .time - when function call was made +% +% .other - structure used to store other information bits, not fitting the +% object structure at the moment, +% for example: +% .inv - structure array corresponding to the forw/inv problem in MEEG. +% .val - index of the 'inv' solution currently used. +% +% .condlist - cell array of unique condition labels defining the proper +% condition order +% +% .montage - structure used to store info on on-line montage used +% .M contains transformation matrix of the montage and names of +% original and new channels (+ new channels definition) +% .Mind indicates which montage to use +%__________________________________________________________________________ +% Copyright (C) 2005-2011 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: meeg.m 6525 2015-08-20 10:03:16Z vladimir $ + +switch nargin + case 0 + D = struct('Nsamples', 0); + case 1 + D = varargin{1}; + case 2 + error('Illegal number of arguments'); + case 3 + D = struct('Nsamples', varargin{2}, ... + 'channels', struct('bad', num2cell(zeros(1, varargin{1}))), ... + 'trials', struct('bad', num2cell(zeros(1, varargin{3})))); + case 4 + D = struct('Nsamples', varargin{3}, ... + 'channels', struct('bad', num2cell(zeros(1, varargin{1}))), ... + 'trials', struct('bad', num2cell(zeros(1, varargin{4})))); + D.transform.ID = 'TF'; + D.transform.frequencies = 1:varargin{2}; +end + +if ~isa(D, 'meeg') + D = class(checkmeeg(D), 'meeg'); +end + + + diff --git a/Toolboxes/spm12/@meeg/modality.m b/Toolboxes/spm12/@meeg/modality.m new file mode 100644 index 0000000000000000000000000000000000000000..99e3fd298681a258f826d06e5fac577df77714c7 --- /dev/null +++ b/Toolboxes/spm12/@meeg/modality.m @@ -0,0 +1,61 @@ +function [res, list] = modality(this, scalp, planar) +% Returns data modality +% FORMAT [res, list] = modality(this, scalp) +% +% scalp - 1 (default) only look at scalp modalities +% 0 look at all modalities +% planar - 1 distinguish between MEG planar and other MEG +% 0 (default) do not distinguish +% If more than one modality is found the function returns 'Multimodal' +% in res and a cell array of modalities in list. +% _______________________________________________________________________ +% Copyright (C) 2008-2012 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: modality.m 6542 2015-09-09 11:48:34Z karl $ + +if nargin == 1 + scalp = 1; +end +if nargin < 3 + planar = 0; +end + +list = {}; + +if ~isempty(indchantype(this, {'MEG', 'MEGPLANAR', 'MEGCOMB'})) + if planar + if ~isempty(indchantype(this, 'MEGPLANAR')) + list = [list {'MEGPLANAR'}]; + end + if ~isempty(indchantype(this, 'MEG')) + list = [list {'MEG'}]; + end + if ~isempty(indchantype(this, 'MEGCOMB')) + list = [list {'MEGCOMB'}]; + end + else + list = [list {'MEG'}]; + end +end + +if ~isempty(indchantype(this, 'EEG')) + list = [list {'EEG'}]; +end + +if ~isempty(indchantype(this, 'LFP')) && ~scalp + list = [list {'LFP'}]; +end + +if ~isempty(indchantype(this, 'ILAM')) && ~scalp + list = [list {'ILAM'}]; +end + +switch numel(list) + case 0 + res = 'Other'; + case 1 + res = list{1}; + otherwise + res = 'Multimodal'; +end \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/montage.m b/Toolboxes/spm12/@meeg/montage.m new file mode 100644 index 0000000000000000000000000000000000000000..cb529b1a03082bc6f519ac198575893015eebd66 --- /dev/null +++ b/Toolboxes/spm12/@meeg/montage.m @@ -0,0 +1,284 @@ +function [res] = montage(this,action,varargin) +% Method for specifying an online montage, or setting one to use +% FORMAT +% res = montage(this, 'add', montage) +% Adding a montage to the meeg object, see format here under +% +% res = montage(this, 'action', idx) +% Setting, checking, getting or removing a montage in the object, +% depending on the action string and index idx of montage. +% Actions: +% - add -> adding a montage to the object +% - switch -> switch between montage, 0 being no applied montage +% (switch to 0 by default if no index passed) +% - remove -> removing montage, one at a time or any list. +% - getnumber -> returning the number of montage(s) available +% - getindex -> return current montage index +% - getname -> returning a list of montage name (by default the current +% one if no list is passed) +% - getmontage -> returning the current or any other montage structure, +% depending on list provided (current one by default if +% no list passed). +% _______________________________________________________________________ +% Copyright (C) 2011-2017 Wellcome Trust Centre for Neuroimaging + +% Remy Lehembre & Christophe Phillips +% Cyclotron Research Centre, University of Liege, Belgium +% $Id: montage.m 7111 2017-06-16 09:01:09Z guillaume $ + +% Montage definition in the object structure by simply adding a 'montage' +% field in the object structure: +% D.montage.M(1:k) +% .Mind - 0 => no montage applied +% \ 1...N => use any of the N specified montage +% where M is a structure with +% - name [optional] +% - tra M*N montage matrix +% - labelnew M*1 cell array of labels +% - labelorg N*1 cell array of labels +% - channels [optional] same format as the main 'channels' field in the +% meeg object +% * label +% * bad +% * type +% * x_plot2D +% * y_plot2D +% * units +% +% Note: If no channels information is passed, then we'll try to guess what +% to put in. It's easy for simple channel selection and re-referencing but +% not possible for more general cases. + +switch lower(action) + + case 'add' + % adding a montage to the object + % structure is passed, add montage + mont = varargin{1}; + %check that all info are consistent + if size(mont.tra,1)~=length(mont.labelnew) || ... + size(mont.tra,2)~=length(mont.labelorg) + error('Montage Matrix inconsistent with original or new number of electrodes.') + end + if size(mont.labelorg,1)~=size(mont.tra,2) + mont.labelorg = mont.labelorg'; + end + if size(mont.labelnew,1)~=size(mont.tra,1) + mont.labelnew = mont.labelnew'; + end + + % Check if there are already some montages, if not initialize + % => set "ind" as the i^th montage + this = struct(this); + if ~isfield(this,'montage') + this.montage = []; + this.montage.M = []; + ind = 1; + else + if isfield(this.montage,'M') + ind = length(this.montage.M)+1; + else + this.montage = []; + this.montage.M = []; + ind = 1; + end + end + + % write montage info to fields M and Mind of montage + if isfield(mont,'name') && ~isempty(mont.name) + this.montage.M(ind).name = mont.name; + else + this.montage.M(ind).name = ['montage #',num2str(ind)]; + end + this.montage.M(ind).tra = mont.tra; + this.montage.M(ind).labelnew = mont.labelnew; + this.montage.M(ind).labelorg = mont.labelorg; + this.montage.Mind = ind; + + % fill channel information + if isfield(mont,'channels') + % use channel information provided + % NO check performed here !!! + this.montage.M(ind).channels = mont.channels; + else + % try to derive it from object channel info + disp('No new channels information : setting channels info automatically.') + this = set_channels(this,mont); + end + res = meeg(this); + + case 'switch' + % switching between different montages + if nargin==2 + idx = 0; % by default, no montage applied. + else + idx = varargin{1}; + end + + if ischar(idx) && ~isempty(this.montage.M) + idx = strmatch(idx, {this.montage.M.name}); + if isempty(idx), idx = -1; end + end + + if idx>numel(this.montage.M) || idx<0 + error('Specified montage index is erroneous.') + else + this.montage.Mind = idx; + end + res = meeg(this); + + case {'remove', 'clear'} + if strcmpi(action, 'clear') + idx = 1:numel(this.montage.M); + else + % removing one or more montages + if nargin==2 + idx = this.montage.Mind; % by default, removing current montage. + else + idx = varargin{1}; + end + end + + if ~isempty(idx) + if any(idx>numel(this.montage.M) | idx<0) + error('Specified montage index is erroneous.') + else + this.montage.M(idx) = []; + if any(idx==this.montage.Mind) + % removing current montage -> no montage applied + this.montage.Mind = 0; + elseif any(idx < this.montage.Mind) + % removing another montage, keep current (adjusted) index + this.montage.Mind = this.montage.Mind - ... + sum(idx < this.montage.Mind) ; + end + end + end + res = meeg(this); + + case 'getnumber' + % getting the total numbr of available montages + res = numel(this.montage.M); + + case 'getindex' + % getting the index of the current montage selected + res = this.montage.Mind; + + case 'getname' + % getting the name of current or any other montage(s) + if nargin==2 + idx = this.montage.Mind; % by default, current montage. + else + idx = varargin{1}; + end + + if ~isnumeric(idx) + idx = 1:numel(this.montage.M); + end + + if any(idx>numel(this.montage.M)) || any(idx<0) + error('Specified montage index is erroneous.') + elseif isequal(idx, 0) || isempty(this.montage.M) + res = 'none'; + else + res = {this.montage.M(idx).name}; + if numel(res) == 1 + res = char(res); + end + end + + case 'getmontage' + % getting the current montage structure or any other one + if nargin==2 + idx = this.montage.Mind; % by default, current montage. + else + idx = varargin{1}; + end + if idx>numel(this.montage.M) || idx<0 + error('Specified montage index is erroneous.') + elseif idx==0 + res = []; + else + res = this.montage.M(idx); + end + otherwise + % nothing planned for this case... + error('Wrong use of the ''montage'' method.') +end + + +%========================================================================== +function S = set_channels(S,mont) + +% provided montage does not necessarily apply to all channels +% this adjusts it to include also the unused channels +mont_orig = []; +mont_orig.labelorg = {S.channels(:).label}; +mont_orig.labelnew = mont_orig.labelorg; +mont_orig.tra = eye(numel(mont_orig.labelnew)); +mont = ft_apply_montage(mont_orig, mont); + +% set channels "default" value, try to guess values from main channels +% definition in the object. + +% Use new channel labels and set bad=0 +idx = S.montage.Mind; +for ii=1:length(mont.labelnew) + S.montage.M(idx).channels(ii).label = mont.labelnew{ii}; + S.montage.M(idx).channels(ii).bad = 0; +end + +% Set new electrodes as bad if they include a bad channel +res = [S.channels.bad]; +res = find(res); + +newbads = find(any(mont.tra(:, res),2)); +for ii=1:length(newbads) + S.montage.M(idx).channels(newbads(ii)).bad = 1; +end + +% set channel info: type, units +l_EEG = []; +for ii=1:length(S.montage.M(idx).channels) + l_chan_org = find(mont.tra(ii,:)); + % 'type' + type_ii = unique({S.channels(l_chan_org).type}); + if numel(type_ii)==1 + S.montage.M(idx).channels(ii).type = type_ii{1}; + else + % mixing different types of channels + S.montage.M(idx).channels(ii).type = 'Other'; + end + l_EEG = [l_EEG ii]; % list EEG channels + + % 'units' + units_ii = unique({S.channels(l_chan_org).units}); + if numel(units_ii)==1 + S.montage.M(idx).channels(ii).units = units_ii{1}; + else + % mixing different units of channels + S.montage.M(idx).channels(ii).units = 'unknown'; + end +end + +% Deal with "new" channel positions: +% - when there is one channel with weight >0, assume it's a simple channel +% selection or re-referencing +% => use the info from channel with weight>0 +% - otherwise reset channel position to [] + +for ii=1:length(S.montage.M(idx).channels) + tra_ii = mont.tra(ii,:); + + if sum(tra_ii>0)==1 + % 1 channel extracted or re-ref -> keep coord of (+) channel + S.montage.M(idx).channels(ii).X_plot2D = ... + S.channels(tra_ii>0).X_plot2D; + S.montage.M(idx).channels(ii).Y_plot2D = ... + S.channels(tra_ii>0).Y_plot2D; + else + % more than 1 channel with >0 weight, don't know what to do... + S.montage.M(idx).channels(ii).X_plot2D = []; + S.montage.M(idx).channels(ii).Y_plot2D = []; + end +end diff --git a/Toolboxes/spm12/@meeg/move.m b/Toolboxes/spm12/@meeg/move.m new file mode 100644 index 0000000000000000000000000000000000000000..f172378325601885c07de32546a22c6812050fa0 --- /dev/null +++ b/Toolboxes/spm12/@meeg/move.m @@ -0,0 +1,16 @@ +function res = move(this, fname) +% Method for moving or changing name of data file +% FORMAT res = move(this, fname) +% +% fname can be +% - path\filename -> data moved and renamed +% - path -> data moved only +% - filename -> data renamed only +%__________________________________________________________________________ +% Copyright (C) 2011-2012 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: move.m 5025 2012-10-31 14:44:13Z vladimir $ + +res = copy(this, fname); +delete(this); diff --git a/Toolboxes/spm12/@meeg/nchannels.m b/Toolboxes/spm12/@meeg/nchannels.m new file mode 100644 index 0000000000000000000000000000000000000000..02fef43bf79759fbec2294458efa84512333d915 --- /dev/null +++ b/Toolboxes/spm12/@meeg/nchannels.m @@ -0,0 +1,14 @@ +function res = nchannels(this) +% returns number of channels +% FORMAT res = nchannels(this) +% _______________________________________________________________________ +% Copyright (C) 2008-2012 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: nchannels.m 5025 2012-10-31 14:44:13Z vladimir $ + +if this.montage.Mind==0 + res = length(this.channels); +else + res = length(this.montage.M(this.montage.Mind).channels); +end \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/nconditions.m b/Toolboxes/spm12/@meeg/nconditions.m new file mode 100644 index 0000000000000000000000000000000000000000..e64e2c9c7ee2459ae5924ee4bf0cad0de1f7952d --- /dev/null +++ b/Toolboxes/spm12/@meeg/nconditions.m @@ -0,0 +1,10 @@ +function res = nconditions(this) +% Method for getting the number of unique conditions in the file +% FORMAT res = nconditions(obj) +% _______________________________________________________________________ +% Copyright (C) 2008-2012 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: nconditions.m 5025 2012-10-31 14:44:13Z vladimir $ + +res = numel(condlist(this)); diff --git a/Toolboxes/spm12/@meeg/nfrequencies.m b/Toolboxes/spm12/@meeg/nfrequencies.m new file mode 100644 index 0000000000000000000000000000000000000000..3688a7161b4c5ad222670cad466b1e0a47b99724 --- /dev/null +++ b/Toolboxes/spm12/@meeg/nfrequencies.m @@ -0,0 +1,14 @@ +function res = nfrequencies(this) +% Method for getting the number of frequencies for TF data +% FORMAT res = nsamples(this) +% _______________________________________________________________________ +% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging + +% Stefan Kiebel +% $Id: nfrequencies.m 2846 2009-03-10 17:38:32Z guillaume $ + +if ~strncmp(transformtype(this), 'TF',2) + res = []; +else + res = length(this.transform.frequencies); +end \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/nsamples.m b/Toolboxes/spm12/@meeg/nsamples.m new file mode 100644 index 0000000000000000000000000000000000000000..9feda519a17155a74d487ca8719ec9292bfb2639 --- /dev/null +++ b/Toolboxes/spm12/@meeg/nsamples.m @@ -0,0 +1,10 @@ +function res = nsamples(this) +% Method for getting the number of samples per trial +% FORMAT res = nsamples(this) +% _______________________________________________________________________ +% Copyright (C) 2008-2012 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: nsamples.m 5025 2012-10-31 14:44:13Z vladimir $ + +res = this.Nsamples; \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/ntrials.m b/Toolboxes/spm12/@meeg/ntrials.m new file mode 100644 index 0000000000000000000000000000000000000000..6053c43f242dd1512d6fc3286c1558b38d418db2 --- /dev/null +++ b/Toolboxes/spm12/@meeg/ntrials.m @@ -0,0 +1,10 @@ +function res = ntrials(this) +% Method for getting the number of trials in the file +% FORMAT res = ntrials(this) +% _______________________________________________________________________ +% Copyright (C) 2008-2012 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: ntrials.m 5025 2012-10-31 14:44:13Z vladimir $ + +res = length(this.trials); \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/path.m b/Toolboxes/spm12/@meeg/path.m new file mode 100644 index 0000000000000000000000000000000000000000..a8fcdd8b5f3c9cba88c0f975a85906cfe9d5e802 --- /dev/null +++ b/Toolboxes/spm12/@meeg/path.m @@ -0,0 +1,16 @@ +function res = path(this, newpath) +% Method for getting/setting path +% FORMAT res = path(this, newpath) +% _______________________________________________________________________ +% Copyright (C) 2008-2015 Wellcome Trust Centre for Neuroimaging + +% Stefan Kiebel +% $Id: path.m 6318 2015-01-27 10:36:34Z vladimir $ + +if nargin == 1 + res = this.path; +else + this.path = newpath; + res = this; +end + diff --git a/Toolboxes/spm12/@meeg/private/checkmeeg.m b/Toolboxes/spm12/@meeg/private/checkmeeg.m new file mode 100644 index 0000000000000000000000000000000000000000..a9a3134f96b67f434cb67ddf160712392d802cd3 --- /dev/null +++ b/Toolboxes/spm12/@meeg/private/checkmeeg.m @@ -0,0 +1,447 @@ +function this = checkmeeg(this) +% Check the internal structure of meeg objects +% FORMAT this = checkmeeg(this) +% this - the struct to check (is returned modified if necessary) +% _________________________________________________________________________ +% Copyright (C) 2008-2014 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: checkmeeg.m 6817 2016-06-20 17:10:50Z vladimir $ + + +%-Initialise data dimensions +%-------------------------------------------------------------------------- +if ~isfield(this, 'Nsamples') + this.Nsamples = 0; +end +Nsamples = this.Nsamples; + +if ~isfield(this, 'channels') + this.channels = struct([]); +end +Nchannels = length(this.channels); + +if ~isfield(this, 'trials') + this.trials = struct([]); +end +Ntrials = length(this.trials); + +if ~isfield(this, 'transform') + this.transform.ID = 'time'; +end + +isTF = strncmp(this.transform.ID, 'TF', 2); + +if isTF + if ~isfield(this.transform, 'frequencies') + error('Frequency axis must be defined for spectral dataset.'); + end + Nfrequencies = length(this.transform.frequencies); +else + this.transform = struct('ID', 'time'); + Nfrequencies = 0; +end + +if isTF + expected_size = [Nchannels Nfrequencies Nsamples]; +else + expected_size = [Nchannels Nsamples]; +end + +if Ntrials > 1 + expected_size = [expected_size Ntrials]; +end + +is_empty = ~all(expected_size); + + +%-Link to the data file if necessary +%-------------------------------------------------------------------------- +if ~isfield(this, 'path') || ~exist(this.path, 'dir') + this.path = pwd; +end + +if ~isfield(this, 'data') + this.data = []; +end + +% Conversion from SPM8 format +if isfield(this.data, 'y') + this.data = this.data.y; +end + +is_linked = 0; +if isa(this.data, 'file_array') + fname = this.data.fname; + if ~ispc, fname = strrep(fname, '\', filesep); end + + [p, f, x] = fileparts(fname); + + % this.path takes precedence over the path in file_array to support + % both the case when the dataset is copied (more common) and the + % case when header saved in a mat file is used to link to a + % datafile saved somewhere else + fname = fullfile(this.path, [f x]); + if ~exist(fname, 'file') + fname = fullfile(p, [f x]); + if ~exist(fname, 'file') + error('Could not find the data file at either:\n %s\nor\n %s',... + fullfile(this.path, [f x]),fname); + end + end + + this.data.fname = fname; + try + % Try reading data, i.e. check if it's a "good" filearray + this.data(1, 1, 1); + catch + if ~is_empty + scl_slope = this.data.scl_slope; + offset = this.data.offset; + this.data = file_array(fname, expected_size, this.data.dtype); + + if size(this.data, 1) == length(scl_slope) + this.data.scl_slope = scl_slope; + end + this.data.offset = offset; + end + end + + try % once more + this.data(1, 1, 1); + is_linked = 1; + catch + warning_flexible('SPM:checkmeeg', 'Failed to link to the data file. Unlinking.'); + this.data = []; + is_linked = 0; + end +end + +actual_size = size(this.data); +actual_size = [actual_size ones(1, isTF + 3 - length(actual_size))]; + +if ~isfield(this, 'Fsample') + this.Fsample = 0.01; +end + +if ~isfield(this, 'timeOnset') + this.timeOnset = 0; +elseif isempty(this.timeOnset) + if ~is_empty + this.timeOnset = 1/this.Fsample; + else + this.timeOnset = 0; + end +end + +%-Check channel description +%-------------------------------------------------------------------------- +if ~isfield(this, 'channels') + this.channels = struct([]); +end + +if is_linked && ~isempty(this.channels) && (numel(this.channels) ~= actual_size(1)) + error('Channel description does not match the data.'); +end + +if is_linked + Nchannels = actual_size(1); +else + Nchannels = numel(this.channels); +end + +if Nchannels > 0 + if ~isfield(this.channels, 'label') + for i = 1:Nchannels + this.channels(i).label = ['Ch' num2str(i)]; + end + end + + if ~isfield(this.channels, 'bad') + [this.channels.bad] = deal(0); + else + [this.channels(cellfun('isempty', {this.channels.bad})).bad] = deal(0); + end + + for i = 1:Nchannels + this.channels(i).bad = double(~~this.channels(i).bad); + end + + if ~isfield(this.channels, 'type') + [this.channels.type] = deal('Other'); + end + + if ~isfield(this.channels, 'X_plot2D') + [this.channels.X_plot2D] = deal([]); + [this.channels.Y_plot2D] = deal([]); + end + + if ~isfield(this.channels, 'units') + [this.channels.units] = deal('unknown'); + else + [this.channels(cellfun('isempty', {this.channels.units})).units] = deal('unknown'); + end + + for i = 1:Nchannels + if ~(length(this.channels(i).X_plot2D)==1 && isfinite(this.channels(i).X_plot2D)) + this.channels(i).X_plot2D = []; + end + + if ~(length(this.channels(i).Y_plot2D)==1 && isfinite(this.channels(i).Y_plot2D)) + this.channels(i).Y_plot2D = []; + end + end +end + +%-Check trial description +%-------------------------------------------------------------------------- +if ~isfield(this, 'trials') + this.trials = struct([]); +end + +if is_linked && ~isempty(this.trials) && (numel(this.trials) ~= actual_size(end)) + error('Trial description does not match the data.'); +end + +if is_linked + Ntrials = actual_size(end); +else + Ntrials = numel(this.trials); +end + +if Ntrials > 0 + if ~isfield(this.trials, 'label') + [this.trials.label] = deal('Undefined'); + elseif any(cellfun('isempty', {this.trials(:).label})) + warning_flexible('SPM:checkmeeg', 'Some trial labels empty, assigning default.'); + [this.trials(cellfun('isempty', {this.trials(:).label})).label] = deal('Undefined'); + end + if ~isfield(this.trials, 'bad') + [this.trials.bad] = deal(0); + end + + if ~isfield(this.trials, 'tag') + [this.trials.tag] = deal([]); + end + + if ~isfield(this.trials, 'events') + [this.trials.events] = deal([]); + end + + for i = 1:Ntrials + + label = this.trials(i).label; + + if iscell(label) && numel(label) == 1 + label = label{1}; + end + + if isnumeric(label) + label = num2str(label); + end + + if isa(label, 'char') + this.trials(i).label = deblank(label); + else + this.trials(i).label = 'Unknown'; + warning_flexible('SPM:checkmeeg', 'Some trial labels were not strings, changing back to ''Unknown''.'); + end + + if length(this.trials(i).bad)>1 || ~(this.trials(i).bad == 0 || this.trials(i).bad == 1) + warning_flexible('SPM:checkmeeg', ['Illegal value for bad flag in trial ' num2str(i) ', resetting to zero.']); + this.trials(i).bad = 0; + end + + event = this.trials(i).events; + + if ~isempty(event) && ~(numel(event) == 1 && isequal(event.type, 'no events')) + % make sure that all required elements are present + if ~isfield(event, 'type'), error('type field not defined for each event.'); end + if ~isfield(event, 'time'), error('time field not defined for each event.'); end + if ~isfield(event, 'value'), [event.value] = deal([]); end + if ~isfield(event, 'offset'), [event.offset] = deal(0); end + if ~isfield(event, 'duration'), [event.duration] = deal([]); end + + + % make sure that all numeric values are double + for j = 1:length(event) + if isnumeric(event(j).value) + event(j).value = double(event(j).value); + end + event(j).time = double(event(j).time); + event(j).offset = double(event(j).offset); + event(j).duration = double(event(j).duration); + end + + if ~isempty(event) + % sort the events on the sample on which they occur + % this has the side effect that events without time are discarded + [junk, indx] = sort([event.time]); + event = event(indx); + end + else + event = []; + end + + this.trials(i).events = event; + end + + if Ntrials == 1 + this.trials.onset = this.timeOnset; + end + + if ~isfield(this.trials, 'onset') + [this.trials.onset] = deal(0); + else + [this.trials(cellfun('isempty', {this.trials.onset})).onset] = deal(0); + end + if ~isfield(this.trials, 'repl') + [this.trials.repl] = deal(1); + end +end + +%-Check frequency axis +%-------------------------------------------------------------------------- +if isTF + if is_linked && (length(this.transform.frequencies) ~= actual_size(2)) + error('Frequency axis does not match the data.'); + end + + df = diff(this.transform.frequencies); + % To avoid small numerical errors + if length(unique(df)) > 1 && (max(diff(df))/mean(df))<0.1 + this.transform.frequencies = (0:(Nfrequencies-1))*round(100*mean(df))/100+... + round(100*this.transform.frequencies(1))/100; + end +end + + +%-Check data type +%-------------------------------------------------------------------------- +if ~isfield(this, 'type') ||... + (strcmp(this.type, 'continuous') && Ntrials>1) ||... + (strcmp(this.type, 'evoked') && (numel(unique({this.trials.label})) ~= Ntrials)) + disp('Data type is missing or incorrect, assigning default.'); + % rule of thumb - 10 sec + if Nsamples == 0 + this.type = 'continuous'; + elseif Ntrials==1 && (Nsamples/this.Fsample) > 10 + this.type = 'continuous'; + elseif numel(unique({this.trials.label})) == Ntrials + this.type = 'evoked'; + else + this.type = 'single'; + end +end + +%-Check file name +%-------------------------------------------------------------------------- +if ~isfield(this, 'fname') + if is_linked + this.fname = [f '.mat']; + else + this.fname = 'spm_meeg.mat'; + end +end + + +%-Check sensor description +%-------------------------------------------------------------------------- +if ~isfield(this, 'sensors') + this.sensors = struct([]); +else + if isfield(this.sensors, 'eeg') + if isempty(this.sensors.eeg) + this.sensors = rmfield(this.sensors, 'eeg'); + else + try + % This can be removed in the future + if ~isempty(strmatch('uV', this.sensors.eeg.chanunit)) + this.sensors.eeg = rmfield(this.sensors.eeg, 'chanunit'); + end + end + this.sensors.eeg = ft_datatype_sens(this.sensors.eeg, 'amplitude', 'V', 'distance', 'mm'); + end + end + if isfield(this.sensors, 'meg') + if isempty(this.sensors.meg) + this.sensors = rmfield(this.sensors, 'meg'); + else + try + % This can be removed in the future + if ~isempty(strmatch('fT', this.sensors.meg.chanunit)) + this.sensors.meg = rmfield(this.sensors.meg, 'chanunit'); + end + end + this.sensors.meg = ft_datatype_sens(this.sensors.meg, 'amplitude', 'T', 'distance', 'mm'); + end + end +end + +%-Check other fields +%-------------------------------------------------------------------------- +if ~isfield(this, 'fiducials') + this.fiducials = struct([]); +else + this.fiducials = ft_struct2double(fixpnt(this.fiducials)); +end + +if ~isfield(this, 'artifacts') + this.artifacts = struct([]); +end + +if ~isfield(this, 'other') + this.other = struct([]); +end + +if ~isfield(this, 'condlist') + if isfield(this.other, 'condlist') + this.condlist = this.other.condlist; + this.other = rmfield(this.other, 'condlist'); + else + this.condlist = {}; + end +end + +if ~isempty(this.condlist) + [junk, ind] = unique(this.condlist, 'first'); + this.condlist = this.condlist(sort(ind)); +end + +if ~isfield(this, 'history') + this.history = struct([]); +end + +if ~isfield(this, 'montage') || ~isfield(this.montage,'M') + this.montage = struct('M',[],'Mind',0); +else + if this.montage.Mind > numel(this.montage.M) || ... + this.montage.Mind < 0 + % check montage index, if not good -> 0 + this.montage.Mind = 0; + end +end + +%-Check field order +%-------------------------------------------------------------------------- +fieldnames_order = { + 'type' + 'Nsamples' + 'Fsample' + 'timeOnset' + 'trials' + 'channels' + 'data' + 'fname' + 'path' + 'sensors' + 'fiducials' + 'transform' + 'condlist' + 'montage' + 'history' + 'other'}; + +[sel1, sel2] = match_str(fieldnames_order, fieldnames(this)); +tempcell = struct2cell(this); +this = cell2struct(tempcell(sel2), fieldnames_order, 1); diff --git a/Toolboxes/spm12/@meeg/private/fixpnt.m b/Toolboxes/spm12/@meeg/private/fixpnt.m new file mode 100644 index 0000000000000000000000000000000000000000..d91eabaa446eee43144ea160baefa2c4a6c0c384 --- /dev/null +++ b/Toolboxes/spm12/@meeg/private/fixpnt.m @@ -0,0 +1,42 @@ +function data = fixpnt(data, recurse) + +% helper function to replace pos by pnt + +% $Id: fixpnt.m 6682 2016-01-15 15:52:00Z vladimir $ + +if nargin==1 + recurse = 1; +end + +if ~isa(data, 'struct') + return; +end + +if numel(data)>1 + % loop over all individual elements + clear tmp + for i=1:numel(data) + % this is to prevent an "Subscripted assignment between dissimilar structures" error + tmp(i) = fixpnt(data(i)); + end + data = tmp; + clear tmp + return +end + +% replace pos by pnt +if isfield(data, 'pos') + data.pnt = data.pos; + data = rmfield(data, 'pos'); +end + +if recurse<3 + % recurse into substructures, not too deep + fn = fieldnames(data); + fn = setdiff(fn, {'cfg'}); % don't recurse into the cfg structure + for i=1:length(fn) + if isstruct(data.(fn{i})) + data.(fn{i}) = fixpnt(data.(fn{i}), recurse+1); + end + end +end diff --git a/Toolboxes/spm12/@meeg/private/getset.m b/Toolboxes/spm12/@meeg/private/getset.m new file mode 100644 index 0000000000000000000000000000000000000000..ef49040faeb3c8237737427220f0b6eeae8f6747 --- /dev/null +++ b/Toolboxes/spm12/@meeg/private/getset.m @@ -0,0 +1,66 @@ +function res = getset(this, parent, fieldname, ind, values) +% Generic method for getting and setting multiple fields of meeg struct +% FORMAT res = getset(this, parent, fieldname, ind, values) +% _______________________________________________________________________ +% Copyright (C) 2008-2012 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: getset.m 6535 2015-08-25 11:45:26Z vladimir $ + +this = struct(this); + +if nargin == 3 || ~isnumeric(ind) + try + ind = 1:numel(getfield(this, parent)); + catch + res = []; + return; + end +end + +% Get +if nargin <= 4 + res = cell(1, length(ind)); + for i = 1:length(ind) + res{i} = getfield(this, parent, {ind(i)}, fieldname); + end + + if isempty(res) || (all(cellfun('isclass', res, 'double') & (cellfun(@numel, res) == 1))) + res = [res{:}]; + end + + if iscell(res) && (numel(res) == 1) && (numel(getfield(this, parent)) == 1) &&... + strcmp(parent, 'trials') && strcmp(this.type, 'continuous') + res = res{1}; + end + + return +end + +% Set +if nargin == 5 + % This might fail in some pathological cases, but not in what it's + % supposed to be used for. + if (isnumeric(values) || islogical(values)) && (length(values) == length(ind)) + values = num2cell(values); + end + + if iscell(values) && ~(numel(values)==1 || numel(values) == length(ind)) + error('Illegal assignment: cannot match values and indices.'); + end + + for i = 1:length(ind) + if iscell(values) + this = setfield(this, parent, {ind(i)}, fieldname, values{i}); + else + this = setfield(this, parent, {ind(i)}, fieldname, values); + end + end + % getset is sometimes used on subfields of meeg then checkmeeg should + % not be used + if all(isfield(this, {'type', 'Nsamples', 'Fsample', 'timeOnset'})) + res = meeg(this); + else + res = this; + end +end \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/private/match_str.m b/Toolboxes/spm12/@meeg/private/match_str.m new file mode 100644 index 0000000000000000000000000000000000000000..d32ac7ab3ca64e70db3c36c6ed1a484c0d541cd4 --- /dev/null +++ b/Toolboxes/spm12/@meeg/private/match_str.m @@ -0,0 +1,76 @@ +function [sel1, sel2] = match_str(a, b) + +% MATCH_STR looks for matching labels in two listst of strings +% and returns the indices into both the 1st and 2nd list of the matches. +% They will be ordered according to the first input argument. +% +% [sel1, sel2] = match_str(strlist1, strlist2) +% +% The strings can be stored as a char matrix or as an vertical array of +% cells, the matching is done for each row. + +% Copyright (C) 2000, Robert Oostenveld +% +% $Log: match_str.m,v $ +% Revision 1.6 2006/11/06 21:11:45 roboos +% also deal with empty [] input +% +% Revision 1.5 2004/11/10 17:11:40 roboos +% reverted to original implementation and reimplemented the speed up +% from scratch. The previous two revisions both were incompatible +% with the original implementation. +% +% Revision 1.4 2004/11/09 15:28:57 roboos +% fixed incompatibility that was introduced by previous speed increase: +% the original version gave back double occurences, and other fieldtrip +% functions (sourceanalysis) rely on this. The previously commited +% version only gave back one occurence of each hit, this is fixed by jansch +% in this version +% +% Revision 1.3 2004/10/22 15:59:41 roboos +% large speed increase by replacing 2 nested for loops by a standard matlab function (intersect) +% +% Revision 1.2 2003/03/17 10:37:28 roberto +% improved general help comments and added copyrights + +% ensure that both are cell-arrays +if isempty(a) + a = {}; +elseif ~iscell(a) + a = cellstr(a); +end +if isempty(b) + b = {}; +elseif ~iscell(b) + b = cellstr(b); +end + +% ensure that both are column vectors +a = a(:); +b = b(:); + +% regardless of what optimizations are implemented, the code should remain +% functionally compatible to the original, which is +% for i=1:length(a) +% for j=1:length(b) +% if strcmp(a(i),b(j)) +% sel1 = [sel1; i]; +% sel2 = [sel2; j]; +% end +% end +% end + +% replace all unique strings by a unique number and use the fact that +% numeric comparisons are much faster than string comparisons +[dum1, dum2, c] = unique([a; b]); +a = c(1:length(a)); +b = c((length(a)+1):end); + +sel1 = []; +sel2 = []; +for i=1:length(a) + % s = find(strcmp(a(i), b)); % for string comparison + s = find(a(i)==b); % for numeric comparison + sel1 = [sel1; repmat(i, size(s))]; + sel2 = [sel2; s]; +end diff --git a/Toolboxes/spm12/@meeg/private/warning_flexible.m b/Toolboxes/spm12/@meeg/private/warning_flexible.m new file mode 100644 index 0000000000000000000000000000000000000000..fa6d030874c83c3a78ef8a200d7e80622f6fc14b --- /dev/null +++ b/Toolboxes/spm12/@meeg/private/warning_flexible.m @@ -0,0 +1,12 @@ +function warning_flexible(varargin) +% Function allowing to have better control over the warnings +% that might not be necessary at some point +% _______________________________________________________________________ +% Copyright (C) 2012 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: warning_flexible.m 5467 2013-05-05 20:03:50Z vladimir $ + +warning off backtrace +warning(varargin{:}); +warning on backtrace \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/reload.m b/Toolboxes/spm12/@meeg/reload.m new file mode 100644 index 0000000000000000000000000000000000000000..a30032f84a224bf90af79003f940c28e5657c1b6 --- /dev/null +++ b/Toolboxes/spm12/@meeg/reload.m @@ -0,0 +1,12 @@ +function this = reload(this) +% Reload the file from disk +% FORMAT this = reload(this) +% +% Useful to update the object e.g. after running a batch. +%__________________________________________________________________________ +% Copyright (C) 2013 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: reload.m 5385 2013-04-03 16:24:05Z vladimir $ + +this = meeg(getfield(load(fullfile(this)), 'D')); diff --git a/Toolboxes/spm12/@meeg/repl.m b/Toolboxes/spm12/@meeg/repl.m new file mode 100644 index 0000000000000000000000000000000000000000..dba5c92c573001144ca3b44297b100456166798a --- /dev/null +++ b/Toolboxes/spm12/@meeg/repl.m @@ -0,0 +1,10 @@ +function res = repl(this, varargin) +% Method for getting replication counts, over trials +% FORMAT res = repl(this, index, nrepl) +% _______________________________________________________________________ +% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: repl.m 2729 2009-02-11 10:37:25Z vladimir $ + +res = getset(this, 'trials', 'repl', varargin{:}); \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/rmdata.m b/Toolboxes/spm12/@meeg/rmdata.m new file mode 100644 index 0000000000000000000000000000000000000000..d705fb7902b1c4b5c87d7de8e97631ae946bc635 --- /dev/null +++ b/Toolboxes/spm12/@meeg/rmdata.m @@ -0,0 +1,16 @@ +function this = rmdata(this) +% Deletes the data file and unlinks the header +% FORMAT this = rmdata(this) +% _________________________________________________________________________ +% Copyright (C) 2011-2012 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: rmdata.m 6976 2016-12-22 11:04:45Z vladimir $ + +if islinked(this) + try + delete(fnamedat(this)); + end +end + +this = unlink(this); diff --git a/Toolboxes/spm12/@meeg/rmfield.m b/Toolboxes/spm12/@meeg/rmfield.m new file mode 100644 index 0000000000000000000000000000000000000000..ba114ed43d5330894777116f9f15c6551619a3e6 --- /dev/null +++ b/Toolboxes/spm12/@meeg/rmfield.m @@ -0,0 +1,10 @@ +function this = rmfield(this, fields) +% Method for removing an object field +% FORMAT this = rmfield(this, fields) +% _______________________________________________________________________ +% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: rmfield.m 2883 2009-03-16 11:58:48Z vladimir $ + + this.other = rmfield(this.other, fields); diff --git a/Toolboxes/spm12/@meeg/save.m b/Toolboxes/spm12/@meeg/save.m new file mode 100644 index 0000000000000000000000000000000000000000..7a222c76d9b1e35d08238af46d6d431987b93aff --- /dev/null +++ b/Toolboxes/spm12/@meeg/save.m @@ -0,0 +1,13 @@ +function this = save(this) +% Save an meeg object into a file +% FORMAT this = save(this) +% +% Converts an meeg object to struct and saves it. +%__________________________________________________________________________ +% Copyright (C) 2008-2012 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: save.m 5078 2012-11-25 15:08:05Z vladimir $ + +D = struct(this); +save(fullfile(this), 'D', spm_get_defaults('mat.format')); diff --git a/Toolboxes/spm12/@meeg/sconfounds.m b/Toolboxes/spm12/@meeg/sconfounds.m new file mode 100644 index 0000000000000000000000000000000000000000..95fba5200d53ffa488cf114e28ca5484d6d697b9 --- /dev/null +++ b/Toolboxes/spm12/@meeg/sconfounds.m @@ -0,0 +1,57 @@ +function res = sconfounds(this, newsconfounds, append) +% Method for getting/setting spatial confounds +% FORMAT res = sconfounds(this, newsconfounds) +% _______________________________________________________________________ +% Copyright (C) 2015 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: sconfounds.m 6437 2015-05-14 12:27:21Z vladimir $ + +if nargin >= 2 + meegind = indchantype(this, 'MEEG'); + + [sel1, sel2] = match_str(chanlabels(this, meegind), newsconfounds.label); + + sel1 = meegind(sel1); + + if length(sel1) 0 + sens = res; + montage = this.montage.M(this.montage.Mind); + if ~isempty(intersect(sens.label, montage.labelorg)) + sensmontage = montage; + [sel1, sel2] = spm_match_str(sens.label, sensmontage.labelorg); + sensmontage.labelorg = sensmontage.labelorg(sel2); + sensmontage.tra = sensmontage.tra(:, sel2); + selempty = find(all(sensmontage.tra == 0, 2)); + sensmontage.tra(selempty, :) = []; + sensmontage.labelnew(selempty) = []; + + if isfield(sensmontage, 'chantypeorg') + sensmontage.chantypeorg = sensmontage.chantypeorg(sel2); + end + if isfield(sensmontage, 'chanunitorg') + sensmontage.chanunitorg = sensmontage.chanunitorg(sel2); + end + if isfield(sensmontage, 'chantypenew') + sensmontage.chantypenew(selempty) = []; + end + if isfield(sensmontage, 'chanunitnew') + sensmontage.chanunitnew(selempty) = []; + end + + chanunitorig = sens.chanunit(sel1); + chantypeorig = sens.chantype(sel1); + labelorg = sens.label; + + keepunused = 'no'; % not sure if this is good for all cases + + sens = ft_apply_montage(sens, sensmontage, 'keepunused', keepunused); + + if strcmpi(type, 'MEG') + if isfield(sens, 'balance') && ~isequal(sens.balance.current, 'none') + balance = ft_apply_montage(getfield(sens.balance, sens.balance.current), sensmontage, 'keepunused', keepunused); + else + balance = sensmontage; + end + + sens.balance.custom = balance; + sens.balance.current = 'custom'; + end + + + % If all the original channels contributing to a new channel have + % the same units, transfer them to the new channel. This might be + % wrong if the montage itself changes the units by scaling the data. + if isfield(sens, 'chanunit') + chanunit = sens.chanunit; + else + chanunit = repmat({'unknown'}, numel(sens.label), 1); + end + + if isfield(sens, 'chantype') + chantype = sens.chantype; + else + chantype = repmat({'unknown'}, numel(sens.label), 1); + end + + for j = 1:numel(sens.label) + k = strmatch(sens.label{j}, sensmontage.labelnew, 'exact'); + if ~isempty(k) + if isequal(chanunit{j}, 'unknown') + unit = unique(chanunitorig(~~abs(sensmontage.tra(k, :)))); + if numel(unit)==1 + chanunit(j) = unit; + elseif strcmpi(type, 'MEG') + chanunit{j} = 'T'; + else + chanunit{j} = 'V'; + end + end + + if isequal(chantype{j}, 'unknown') + ctype = unique(chantypeorig(~~abs(sensmontage.tra(k, :)))); + if numel(ctype)==1 + chantype(j) = ctype; + elseif strcmpi(type, 'MEG') + chantype{j} = 'megmag'; + else + chantype{j} = 'eeg'; + end + end + else %channel was not in the montage, but just copied + k = strmatch(sens.label{j}, labelorg, 'exact'); + if isequal(chanunit{j}, 'unknown') + chanunit(j) = chanunitorig(k); + end + if isequal(chantype{j}, 'unknown') + chantype(j) = chantypeorig(k); + end + end + end + + sens.chanunit = chanunit; + sens.chantype = chantype; + end + + if strcmpi(type, 'MEG') + res = ft_datatype_sens(sens, 'amplitude', 'T', 'distance', 'mm'); + else + res = ft_datatype_sens(sens, 'amplitude', 'V', 'distance', 'mm'); + end +end diff --git a/Toolboxes/spm12/@meeg/size.m b/Toolboxes/spm12/@meeg/size.m new file mode 100644 index 0000000000000000000000000000000000000000..81017b4236a689cb4ae8014eebf1b5f79110c28f --- /dev/null +++ b/Toolboxes/spm12/@meeg/size.m @@ -0,0 +1,19 @@ +function res = size(this, dim) +% returns the dimensions of the data matrix +% FORMAT res = size(this, dim)) +% _______________________________________________________________________ +% Copyright (C) 2008-2012 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: size.m 5078 2012-11-25 15:08:05Z vladimir $ + + +if ~strncmpi(transformtype(this), 'TF', 2) + res = [nchannels(this), nsamples(this), ntrials(this)]; +else + res = [nchannels(this), nfrequencies(this), nsamples(this), ntrials(this)]; +end + +if nargin > 1 + res = res(dim); +end \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/subsasgn.m b/Toolboxes/spm12/@meeg/subsasgn.m new file mode 100644 index 0000000000000000000000000000000000000000..2af582ef840f9a9292efa9031e170462d4cefa49 --- /dev/null +++ b/Toolboxes/spm12/@meeg/subsasgn.m @@ -0,0 +1,36 @@ +function this = subsasgn(this,subs,dat) +% Overloaded subsasgn function for meeg objects. +% _________________________________________________________________________________ +% Copyright (C) 2008-2011 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: subsasgn.m 5025 2012-10-31 14:44:13Z vladimir $ + +if isempty(subs) + return; +end; + +if strcmp(subs(1).type, '.') + if ismethod(this, subs(1).subs) + error('meeg method names cannot be used for custom fields'); + else + if isempty(this.other) + this.other = struct(subs(1).subs, []); + this.other = builtin('subsasgn', this.other, subs, dat); + else + this.other = builtin('subsasgn', this.other, subs, dat); + end + end +elseif strcmp(subs(1).type, '()') + if ~islinked(this), error('The object is not linked to data file'); end + if numel(subs)~= 1, error('Expression too complicated'); end + if this.montage.Mind>0 + error('Attempt to assign to a meeg object with online montage applied.'); + end; + this.data = subsasgn(this.data, subs, dat); +else + error('Unsupported assignment type for meeg.'); +end + + + diff --git a/Toolboxes/spm12/@meeg/subsref.m b/Toolboxes/spm12/@meeg/subsref.m new file mode 100644 index 0000000000000000000000000000000000000000..fc1227dcba5a278e1354cfb1a7ca8ef0c1521adb --- /dev/null +++ b/Toolboxes/spm12/@meeg/subsref.m @@ -0,0 +1,136 @@ +function varargout=subsref(this,subs) +% SUBSREF Subscripted reference +% An overloaded function... +% _________________________________________________________________________ +% Copyright (C) 2008-2013 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak, Stefan Kiebel +% $Id: subsref.m 6600 2015-11-12 13:07:41Z christophe $ + +if isempty(subs) + return; +end + +if this.Nsamples == 0 + error('Attempt to reference a field of an empty meeg object.'); +end + +switch subs(1).type + case '()' + if ~islinked(this), error('The object is not linked to data file'); end + if numel(subs)~= 1, error('Expression too complicated'); end + + if this.montage.Mind==0 + varargout = {double(subsref(this.data, subs))}; + else + Mem_max = 200*2^20; % Limit memory usage to about 200Mb + vect_fl = 0; dat3D = 0; + dim = size(this); + if numel(dim)>2 && dim(3)>1 + % assume at most 3D data + dat3D = 1; + end + if ischar(subs.subs{1}) + % need to handle the case of a ':' argument + if ~strcmp(subs.subs{1},':'), + error('This shouldn''t happen....'); + end + if length(subs.subs) == 1 + chanidx = 1:dim(1); + subs.subs{2} = ':'; + if dat3D, subs.subs{3} = ':'; end + vect_fl = 1; + else + chanidx = 1:dim(1); + end + else + chanidx = subs.subs{1}; + end + + % check if correct channel index + if any(chanidx > nchannels(this)) + error('channel index higher than number of channels in current montage') + end + % get corresponding rows of 'tra' matrix + traidx = this.montage.M(this.montage.Mind).tra(chanidx,:); + % change subs to use only the necessary channels from data + lchan_o = find(any(traidx,1)); + subs.subs{1} = lchan_o; + + % need to handle the case of ':' arguments + if ischar(subs.subs{2}) + if ~strcmp(subs.subs{2},':'), error('This shouldn''t happen....'); end + subs.subs{2} = 1:dim(2); + Ntb = dim(2); + else + Ntb = length(subs.subs{2}); + end + if dat3D && ischar(subs.subs{3}) + if ~strcmp(subs.subs{3},':'), error('This shouldn''t happen....'); end + subs.subs{3} = 1:dim(3); + end + Mem_load = 8*Ntb*length(lchan_o); + if Mem_load<=Mem_max % small chunk loaded + if dat3D + subs_c = subs; + for ii=1:numel(subs.subs{3}) + subs_c.subs{3} = subs.subs{3}(ii); + varargout{1}(:,:,ii) = ... + traidx(:,lchan_o)*double(subsref(this.data, subs_c)); + end + else + varargout = {traidx(:,lchan_o)*double(subsref(this.data, subs))}; + end + else % otherwise split data reading into chunks + Ntb_chunk = round(Mem_max/length(lchan_o)/8); + Nchunk = ceil(Ntb/Ntb_chunk); + varargout{1} = zeros(length(chanidx),Ntb); + for ii=1:Nchunk + subs_ch = subs; + if ii 2) && isequal(subs(2).type, '()') + varargout{1} = builtin('subsref', ... + feval(subs(1).subs, this, subs(2).subs{:}), subs(3:end)); + else + varargout{1} = builtin('subsref', feval(subs(1).subs, this), subs(2:end)); + end + elseif isfield(this.other, subs(1).subs) + field = getfield(this.other, subs(1).subs); + if numel(subs)==1 + varargout = {field}; + else + varargout{1} = builtin('subsref', field, subs(2:end)); + end + else + error('Reference to non-existent or private meeg method or field.'); + end + otherwise + error('Unfamiliar referencing type'); +end diff --git a/Toolboxes/spm12/@meeg/time.m b/Toolboxes/spm12/@meeg/time.m new file mode 100644 index 0000000000000000000000000000000000000000..54d9c835d07d000660fbfcb52556bcf8d07269d2 --- /dev/null +++ b/Toolboxes/spm12/@meeg/time.m @@ -0,0 +1,24 @@ +function res = time(this, ind, format) +% Method for getting the time axis +% FORMAT res = time(this, ind, format) +% _______________________________________________________________________ +% Copyright (C) 2008-2012 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak, Stefan Kiebel +% $Id: time.m 5025 2012-10-31 14:44:13Z vladimir $ + +if this.Nsamples>0 + res = (0:(this.Nsamples-1))./this.Fsample + this.timeOnset; +else + res = []; +end + +if nargin>1 && ~isempty(ind) + res = res(ind); +end + +if nargin > 2 + if strcmp(format, 'ms') + res = res*1000; + end +end \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/timeonset.m b/Toolboxes/spm12/@meeg/timeonset.m new file mode 100644 index 0000000000000000000000000000000000000000..910aced8d0b8562e5c489ab026fc9f35935abe1e --- /dev/null +++ b/Toolboxes/spm12/@meeg/timeonset.m @@ -0,0 +1,16 @@ +function res = timeonset(this, newonset) +% Method for reading and setting the time onset +% FORMAT res = timeonset(this) +% res = timeonset(this, newonset) +% _______________________________________________________________________ +% Copyright (C) 2008-2012 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: timeonset.m 5025 2012-10-31 14:44:13Z vladimir $ + +if nargin == 1 + res = this.timeOnset; +else + this.timeOnset = newonset; + res = this; +end \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/transformtype.m b/Toolboxes/spm12/@meeg/transformtype.m new file mode 100644 index 0000000000000000000000000000000000000000..afa9ead41248fde4fa2e27f4a8cbf943506777b5 --- /dev/null +++ b/Toolboxes/spm12/@meeg/transformtype.m @@ -0,0 +1,19 @@ +function res = transformtype(this, newtype) +% Method for getting/setting type of transform +% FORMAT res = transformtype(this, name) +% _______________________________________________________________________ +% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging + +% Stefan Kiebel +% $Id: transformtype.m 3350 2009-09-03 13:19:20Z vladimir $ + +if nargin == 1 + res = this.transform.ID; +else + if strncmpi(this, 'TF', 2) && length(size(this))~=4 + error('TF transformtype can only be assigned to 4D dataset'); + end + + this.transform.ID = newtype; + res = this; +end diff --git a/Toolboxes/spm12/@meeg/trialonset.m b/Toolboxes/spm12/@meeg/trialonset.m new file mode 100644 index 0000000000000000000000000000000000000000..c692e31e2749dcc5f31ef009577a61edc87be6ff --- /dev/null +++ b/Toolboxes/spm12/@meeg/trialonset.m @@ -0,0 +1,11 @@ +function res = trialonset(this, varargin) +% Method for getting/setting trial onset times +% FORMAT res = trialonset(this, ind, onset) +% ind = indices of trials +% _______________________________________________________________________ +% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: trialonset.m 1373 2008-04-11 14:24:03Z spm $ + +res = getset(this, 'trials', 'onset', varargin{:}); diff --git a/Toolboxes/spm12/@meeg/trialtag.m b/Toolboxes/spm12/@meeg/trialtag.m new file mode 100644 index 0000000000000000000000000000000000000000..e5b0a47654f50d10fb6a18b59bb15b59dd8ba9d5 --- /dev/null +++ b/Toolboxes/spm12/@meeg/trialtag.m @@ -0,0 +1,15 @@ +function res = trialtag(this, varargin) +% Method for getting/setting trial tag +% FORMAT res = trialtag(this, ind, tag) +% ind = indices of trials +% The user can put any data here that will be attached to +% the respective trial. This is useful e.g. to make sure the +% relation between regressors and data is not broken when +% removing bad trials or merging files. +% _______________________________________________________________________ +% Copyright (C) 2015 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: trialtag.m 6618 2015-12-01 16:25:38Z spm $ + +res = getset(this, 'trials', 'tag', varargin{:}); diff --git a/Toolboxes/spm12/@meeg/type.m b/Toolboxes/spm12/@meeg/type.m new file mode 100644 index 0000000000000000000000000000000000000000..4ec2a4f8e7b4e0634babe3a907545b9b599a9b83 --- /dev/null +++ b/Toolboxes/spm12/@meeg/type.m @@ -0,0 +1,27 @@ +function res = type(this, value) +% Method for and getting/setting EEG file type +% FORMAT res = type(this, value) +% _______________________________________________________________________ +% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: type.m 1267 2008-03-28 12:12:14Z vladimir $ + +if nargin == 1 + res = this.type; +else + switch value + case 'continuous' + if ntrials(this)>1 + error('Continuous file can only have one trial'); + end + case 'single' + case 'evoked' % Add additional checks here + case 'grandmean' + otherwise + error('Unrecognized type'); + end + + this.type = value; + res = this; +end \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/units.m b/Toolboxes/spm12/@meeg/units.m new file mode 100644 index 0000000000000000000000000000000000000000..536b9837c0ed05c9df89b4e051effc1cc66820cd --- /dev/null +++ b/Toolboxes/spm12/@meeg/units.m @@ -0,0 +1,19 @@ +function res = units(this, varargin) +% Method for setting/getting all units, over channels +% FORMAT res = units(this, ind) +% _______________________________________________________________________ +% Copyright (C) 2008-2012 Wellcome Trust Centre for Neuroimaging + +% Stefan Kiebel +% $Id: units.m 5933 2014-03-28 13:22:28Z vladimir $ + +if this.montage.Mind == 0 + res = getset(this, 'channels', 'units', varargin{:}); +else + if nargin == 3 + this.montage.M(this.montage.Mind) = getset(this.montage.M(this.montage.Mind), 'channels', 'units', varargin{:}); + res = this; + else + res = getset(this.montage.M(this.montage.Mind), 'channels', 'units', varargin{:}); + end +end \ No newline at end of file diff --git a/Toolboxes/spm12/@meeg/unlink.m b/Toolboxes/spm12/@meeg/unlink.m new file mode 100644 index 0000000000000000000000000000000000000000..2af556b5ec6acfa13c941a1035f59680187634f1 --- /dev/null +++ b/Toolboxes/spm12/@meeg/unlink.m @@ -0,0 +1,11 @@ +function this = unlink(this) +% Unlinks the object from the data file +% FORMAT this = unlink(this) +% _________________________________________________________________________ +% Copyright (C) 2011 Wellcome Trust Centre for Neuroimaging + +% Vladimir Litvak +% $Id: unlink.m 5025 2012-10-31 14:44:13Z vladimir $ + +this.data = []; +this = check(this); \ No newline at end of file diff --git a/Toolboxes/spm12/@nifti/Contents.m b/Toolboxes/spm12/@nifti/Contents.m new file mode 100644 index 0000000000000000000000000000000000000000..f237c265339189910cdaeb73b1f724892b3c8430 --- /dev/null +++ b/Toolboxes/spm12/@nifti/Contents.m @@ -0,0 +1,81 @@ +% NIFTI Object +% +% create - Create a NIFTI-1 file +% disp - Disp a NIFTI-1 object +% display - Display a NIFTI-1 object +% fieldnames - Fieldnames of a NIFTI-1 object +% nifti - Create a NIFTI-1 object +% subsasgn - Subscript assignment +% subsref - Subscript referencing +% +% other operations are unlikely to work. +% +% Example usage. +% +% % Example of creating a simulated .nii file. +% dat = file_array; +% dat.fname = 'junk.nii'; +% dat.dim = [64 64 32]; +% dat.dtype = 'FLOAT64-BE'; +% dat.offset = ceil(348/8)*8; +% +% % alternatively: +% % dat = file_array( 'junk.nii',dim,dtype,off,scale,inter) +% +% disp(dat) +% +% % Create an empty NIFTI structure +% N = nifti; +% +% fieldnames(N) % Dump fieldnames +% +% % Creating all the NIFTI header stuff +% N.dat = dat; +% N.mat = [2 0 0 -110 ; 0 2 0 -110; 0 0 -2 92; 0 0 0 1]; +% N.mat_intent = 'xxx'; % dump possibilities +% N.mat_intent = 'Scanner'; +% N.mat0 = N.mat; +% N.mat0_intent = 'Aligned'; +% +% N.diminfo.slice = 3; +% N.diminfo.phase = 2; +% N.diminfo.frequency = 2; +% N.diminfo.slice_time.code='xxx'; % dump possibilities +% N.diminfo.slice_time.code = 'sequential_increasing'; +% N.diminfo.slice_time.start = 1; +% N.diminfo.slice_time.end = 32; +% N.diminfo.slice_time.duration = 3/32; +% +% N.intent.code='xxx' ; % dump possibilities +% N.intent.code='FTEST'; % or N.intent.code=4; +% N.intent.param = [4 8]; +% +% N.timing.toffset = 28800; +% N.timing.tspace=3; +% N.descrip = 'This is a NIFTI-1 file'; +% N.aux_file='aux-file-name.txt'; +% N.cal = [0 1]; +% +% create(N); % Writes hdr info +% +% dat(:,:,:)=0; % Write out the data as all zeros +% +% [i,j,k] = ndgrid(1:64,1:64,1:32); +% dat(find((i-32).^2+(j-32).^2+(k*2-32).^2 < 30^2))=1; % Write some ones in the file +% dat(find((i-32).^2+(j-32).^2+(k*2-32).^2 < 15^2))=2; +% +% +% % displaying a slice +% imagesc(dat(:,:,12));colorbar +% +% % get a handle to 'junk.nii'; +% M=nifti('junk.nii'); +% +% imagesc(M.dat(:,:,12)); +% +% _______________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: Contents.m 7147 2017-08-03 14:07:01Z spm $ + diff --git a/Toolboxes/spm12/@nifti/create.m b/Toolboxes/spm12/@nifti/create.m new file mode 100644 index 0000000000000000000000000000000000000000..7c5242d97768fb1be47beafbf40b702334d1245b --- /dev/null +++ b/Toolboxes/spm12/@nifti/create.m @@ -0,0 +1,44 @@ +function create(obj,wrt) +% Create a NIFTI-1 file +% FORMAT create(obj) +% Write out the header information for the nifti object +% +% FORMAT create(obj,wrt) +% Also write out an empty image volume if wrt==1 +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: create.m 7147 2017-08-03 14:07:01Z spm $ + + +for i=1:numel(obj) + + o = obj(i); + + if ~isa(o.dat,'file_array'), error('Data must be a file_array.'); end + + fname = o.dat.fname; + if isempty(fname), error('No filename to write to.'); end + + %-Write NIFTI header + sts = write_hdr_raw(fname, o.hdr, o.dat.dtype(end-1)=='B'); + if ~sts, error('Unable to write header for "%s".',fname); end + + %-Write extra information + write_extras(fname,o.extras); + + %-Create an empty image file if necessary + if nargin>1 && any(wrt==1) + [pth,nam] = fileparts(fname); + if any(strcmp(o.hdr.magic(1:3),{'n+1','n+2'})) + ext = '.nii'; + else + ext = '.img'; + end + o.dat.fname = fullfile(pth,[nam ext]); + + initialise(o.dat); + end + +end diff --git a/Toolboxes/spm12/@nifti/disp.m b/Toolboxes/spm12/@nifti/disp.m new file mode 100644 index 0000000000000000000000000000000000000000..1bc73f06a8b0b1d8efa1be236465af2102bca588 --- /dev/null +++ b/Toolboxes/spm12/@nifti/disp.m @@ -0,0 +1,22 @@ +function disp(obj) +% Disp a NIFTI-1 object +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: disp.m 7147 2017-08-03 14:07:01Z spm $ + + +sz = size(obj); +fprintf('NIFTI object: '); +if length(sz)>4 + fprintf('%d-D\n',length(sz)); +else + for i=1:(length(sz)-1) + fprintf('%d-by-',sz(i)); + end + fprintf('%d\n',sz(end)); +end +if prod(sz)==1 + disp(structn(obj)) +end diff --git a/Toolboxes/spm12/@nifti/display.m b/Toolboxes/spm12/@nifti/display.m new file mode 100644 index 0000000000000000000000000000000000000000..3eb160eb7713c591aea65f78a5619c93693e554a --- /dev/null +++ b/Toolboxes/spm12/@nifti/display.m @@ -0,0 +1,14 @@ +function display(obj) +% Display a NIFTI-1 object +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: display.m 7147 2017-08-03 14:07:01Z spm $ + + +disp(' '); +disp([inputname(1),' = ']) +disp(' '); +disp(obj) +disp(' ') diff --git a/Toolboxes/spm12/@nifti/fieldnames.m b/Toolboxes/spm12/@nifti/fieldnames.m new file mode 100644 index 0000000000000000000000000000000000000000..0c0d7aa34ad5f3c09754986a060a1a698095d362 --- /dev/null +++ b/Toolboxes/spm12/@nifti/fieldnames.m @@ -0,0 +1,26 @@ +function t = fieldnames(obj) +% Fieldnames of a NIFTI-1 object +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: fieldnames.m 7147 2017-08-03 14:07:01Z spm $ + + +if isfield(obj.hdr,'magic') + t = {... + 'dat' + 'mat' + 'mat_intent' + 'mat0' + 'mat0_intent' + 'intent' + 'diminfo' + 'timing' + 'descrip' + 'cal' + 'aux_file' + }; +else + error('This should not happen.'); +end diff --git a/Toolboxes/spm12/@nifti/nifti.m b/Toolboxes/spm12/@nifti/nifti.m new file mode 100644 index 0000000000000000000000000000000000000000..5df72a01487ac0df07aa5fe73f2f2cfa1ccb355f --- /dev/null +++ b/Toolboxes/spm12/@nifti/nifti.m @@ -0,0 +1,90 @@ +function h = nifti(varargin) +% Create a NIFTI-1 object +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: nifti.m 7147 2017-08-03 14:07:01Z spm $ + + +switch nargin +case 0 + hdr = empty_hdr; + h = struct('hdr',hdr,'dat',[],'extras',struct); + h = class(h,'nifti'); + +case 1 + if isa(varargin{1},'nifti') + h = varargin{1}; + + elseif ischar(varargin{1}) + if size(varargin{1},1)>1 + h = nifti(cellstr(varargin{1})); + return; + end + fname = deblank(varargin{1}); + vol = read_hdr(fname); + extras = read_extras(fname); + + if ~isfield(vol.hdr,'magic') + vol.hdr = mayo2nifti1(vol.hdr); + + % For SPM99 compatibility + if isfield(extras,'M') && ~isfield(extras,'mat') + extras.mat = extras.M; + if spm_flip_analyze_images + extras.mat = diag([-1 1 1 1])*extras.mat; + end + end + + % Over-ride sform if a .mat file exists + if isfield(extras,'mat') && size(extras.mat,3)>=1 + mat = extras.mat(:,:,1); + mat1 = mat*[eye(4,3) [1 1 1 1]']; + vol.hdr.srow_x = mat1(1,:); + vol.hdr.srow_y = mat1(2,:); + vol.hdr.srow_z = mat1(3,:); + vol.hdr.sform_code = 2; + vol.hdr.qform_code = 2; + vol.hdr = encode_qform0(mat,vol.hdr); + end + end + + if isfield(extras,'M'), extras = rmfield(extras,'M'); end + if isfield(extras,'mat') && size(extras.mat,3)<=1 + extras = rmfield(extras,'mat'); + end + + dim = double(vol.hdr.dim); + dim = dim(2:(dim(1)+1)); + dt = double(vol.hdr.datatype); + offs = max(double(vol.hdr.vox_offset),0); + + if ~vol.hdr.scl_slope && ~vol.hdr.scl_inter + vol.hdr.scl_slope = 1; + end + slope = double(vol.hdr.scl_slope); + inter = double(vol.hdr.scl_inter); + + dat = file_array(vol.iname,dim,[dt,vol.be],offs,slope,inter); + h = struct('hdr',vol.hdr,'dat',dat,'extras',extras); + h = class(h,'nifti'); + + elseif isstruct(varargin{1}) + h = class(varargin{1},'nifti'); + + elseif iscell(varargin{1}) + fnames = varargin{1}; + h(numel(fnames)) = struct('hdr',[],'dat',[],'extras',struct); + h = class(h,'nifti'); + for i=1:numel(fnames) + h(i) = nifti(fnames{i}); + end + + else + error('Don''t know what to do yet.'); + end + +otherwise + error('Don''t know what to do yet.'); +end diff --git a/Toolboxes/spm12/@nifti/private/M2Q.m b/Toolboxes/spm12/@nifti/private/M2Q.m new file mode 100644 index 0000000000000000000000000000000000000000..17df5689828ba2cb55c4e9ff98aa3732f91c58da --- /dev/null +++ b/Toolboxes/spm12/@nifti/private/M2Q.m @@ -0,0 +1,31 @@ +function Q = M2Q(M) +% Convert from rotation matrix to quaternion form +% See: http://skal.planet-d.net/demo/matrixfaq.htm +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: M2Q.m 7147 2017-08-03 14:07:01Z spm $ + + +d = diag(M(1:3,1:3)); +t = sum(d) + 1; +if t>0.5 + s = sqrt(t)*2; + Q = [(M(3,2)-M(2,3))/s (M(1,3)-M(3,1))/s (M(2,1)-M(1,2))/s 0.25*s]'; +else + t = find(d==max(d)); + t = t(1); + switch(t) + case 1 + s = 2*sqrt(1 + M(1,1) - M(2,2) - M(3,3)); + Q = [0.25*s (M(1,2)+M(2,1))/s (M(3,1)+M(1,3))/s (M(3,2)-M(2,3))/s]'; + case 2 + s = 2*sqrt(1 + M(2,2) - M(1,1) - M(3,3)); + Q = [(M(1,2)+M(2,1))/s 0.25*s (M(2,3)+M(3,2))/s (M(1,3)-M(3,1))/s ]'; + case 3 + s = 2*sqrt(1 + M(3,3) - M(1,1) - M(2,2)); + Q = [(M(3,1)+M(1,3))/s (M(2,3)+M(3,2))/s 0.25*s (M(2,1)-M(1,2))/s]'; + end +end +if Q(4)<0, Q = -Q; end % w must be +ve diff --git a/Toolboxes/spm12/@nifti/private/Q2M.m b/Toolboxes/spm12/@nifti/private/Q2M.m new file mode 100644 index 0000000000000000000000000000000000000000..679663bb54a30cee92fa24104a8af88593eba921 --- /dev/null +++ b/Toolboxes/spm12/@nifti/private/Q2M.m @@ -0,0 +1,29 @@ +function M = Q2M(Q) +% Generate a rotation matrix from a quaternion xi+yj+zk+w, +% where Q = [x y z], and w = 1-x^2-y^2-z^2. +% See: http://skal.planet-d.net/demo/matrixfaq.htm +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: Q2M.m 7147 2017-08-03 14:07:01Z spm $ + + +Q = Q(1:3); % Assume rigid body +w = sqrt(1 - sum(Q.^2)); +x = Q(1); y = Q(2); z = Q(3); +if w<1e-7 + w = 1/sqrt(x*x+y*y+z*z); + x = x*w; + y = y*w; + z = z*w; + w = 0; +end +xx = x*x; yy = y*y; zz = z*z; ww = w*w; +xy = x*y; xz = x*z; xw = x*w; +yz = y*z; yw = y*w; zw = z*w; +M = [... +(xx-yy-zz+ww) 2*(xy-zw) 2*(xz+yw) 0 + 2*(xy+zw) (-xx+yy-zz+ww) 2*(yz-xw) 0 + 2*(xz-yw) 2*(yz+xw) (-xx-yy+zz+ww) 0 + 0 0 0 1]; diff --git a/Toolboxes/spm12/@nifti/private/decode_qform0.m b/Toolboxes/spm12/@nifti/private/decode_qform0.m new file mode 100644 index 0000000000000000000000000000000000000000..dc65ce72df282d813cf4956f53b96993d6b0cad1 --- /dev/null +++ b/Toolboxes/spm12/@nifti/private/decode_qform0.m @@ -0,0 +1,59 @@ +function M = decode_qform0(hdr) +% Decode qform info from NIFTI-1 headers. +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: decode_qform0.m 7147 2017-08-03 14:07:01Z spm $ + + +dim = double(hdr.dim); +pixdim = double(hdr.pixdim); +if ~isfield(hdr,'magic') || hdr.qform_code <= 0 + flp = spm_flip_analyze_images; + %disp('------------------------------------------------------'); + %disp('The images are in a form whereby it is not possible to'); + %disp('tell the left and right sides of the brain apart.'); + %if flp, + % disp('They are assumed to be stored left-handed.'); + %else + % disp('They are assumed to be stored right-handed.'); + %end; + %disp('------------------------------------------------------'); + + %R = eye(4); + n = min(dim(1),3); + vox = [pixdim(2:(n+1)) ones(1,3-n)]; + + if ~isfield(hdr,'origin') || ~any(hdr.origin(1:3)) + origin = (dim(2:4)+1)/2; + else + origin = double(hdr.origin(1:3)); + end + off = -vox.*origin; + M = [vox(1) 0 0 off(1) ; 0 vox(2) 0 off(2) ; 0 0 vox(3) off(3) ; 0 0 0 1]; + + % Stuff for default orientations + if flp, M = diag([-1 1 1 1])*M; end +else + + % Rotations from quaternions + R = Q2M(double([hdr.quatern_b hdr.quatern_c hdr.quatern_d])); + + % Translations + T = [eye(4,3) double([hdr.qoffset_x hdr.qoffset_y hdr.qoffset_z 1]')]; + + % Zooms. Note that flips are derived from the first + % element of pixdim, which is normally unused. + n = min(dim(1),3); + Z = [pixdim(2:(n+1)) ones(1,4-n)]; + Z(Z<0) = 1; + if pixdim(1)<0, Z(3) = -Z(3); end + Z = diag(Z); + + M = T*R*Z; + + % Convert from first voxel at [1,1,1] + % to first voxel at [0,0,0] + M = M * [eye(4,3) [-1 -1 -1 1]']; +end diff --git a/Toolboxes/spm12/@nifti/private/empty_hdr.m b/Toolboxes/spm12/@nifti/private/empty_hdr.m new file mode 100644 index 0000000000000000000000000000000000000000..1e6103ef3af0ed347871b534687df96b62bb66cc --- /dev/null +++ b/Toolboxes/spm12/@nifti/private/empty_hdr.m @@ -0,0 +1,15 @@ +function hdr = empty_hdr(fmt) +% Create an empty NIFTI header +% FORMAT hdr = empty_hdr +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: empty_hdr.m 7147 2017-08-03 14:07:01Z spm $ + + +if ~nargin, fmt = 'nifti1'; end +org = niftistruc(fmt); +for i=1:length(org) + hdr.(org(i).label) = feval(org(i).dtype.conv,org(i).def); +end diff --git a/Toolboxes/spm12/@nifti/private/encode_qform0.m b/Toolboxes/spm12/@nifti/private/encode_qform0.m new file mode 100644 index 0000000000000000000000000000000000000000..ccc7daa8eede42da72707f92889c6dc509c31689 --- /dev/null +++ b/Toolboxes/spm12/@nifti/private/encode_qform0.m @@ -0,0 +1,43 @@ +function hdr = encode_qform0(M,hdr) +% Encode an affine transform into qform +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: encode_qform0.m 7147 2017-08-03 14:07:01Z spm $ + + +% Convert from first voxel at [1,1,1] to first voxel at [0,0,0] +M = M * [eye(4,3) [1 1 1 1]']; + +% Translations +hdr.qoffset_x = M(1,4); +hdr.qoffset_y = M(2,4); +hdr.qoffset_z = M(3,4); + +% Rotations and zooms +R = M(1:3,1:3); +vx = sqrt(sum(M(1:3,1:3).^2)); +vx(vx==0) = 1; +R = R * diag(1./vx); + +% Ensure that R is O(3) +[U,S,V] = svd(R); +R = U*V'; +if any(abs(diag(S)-1)>1e-3), warning('QFORM0 representation has been rounded.'); end + +% Ensure that R is SO(3) +if det(R)>0 + hdr.pixdim(1:4) = [ 1 vx]; +else + R = R*diag([1 1 -1]); + hdr.pixdim(1:4) = [-1 vx]; +end + +% Convert to quaternions +Q = M2Q(R); +hdr.quatern_b = Q(1); +hdr.quatern_c = Q(2); +hdr.quatern_d = Q(3); + +if hdr.qform_code == 0, hdr.qform_code = 2; end diff --git a/Toolboxes/spm12/@nifti/private/findindict.m b/Toolboxes/spm12/@nifti/private/findindict.m new file mode 100644 index 0000000000000000000000000000000000000000..3d0d3a09f7c7241f45460ca4a35253d52f660f68 --- /dev/null +++ b/Toolboxes/spm12/@nifti/private/findindict.m @@ -0,0 +1,39 @@ +function entry = findindict(c,dcode) +% Look up an entry in the dictionary +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: findindict.m 7147 2017-08-03 14:07:01Z spm $ + + +entry = []; +d = getdict; +d = d.(dcode); +if ischar(c) + for i=1:length(d) + if strcmpi(d(i).label,c) + entry = d(i); + break; + end + end +elseif isnumeric(c) && numel(c)==1 + for i=1:length(d) + if d(i).code==c + entry = d(i); + break; + end + end +else + error('Inappropriate code for ''%s''.',dcode); +end + +if isempty(entry) + fprintf('\nWarning: Code ''%s'' is not an option for ''%s''.\n',... + num2str(c),dcode); + %fprintf('\nThis is not an option. Try one of these:\n'); + %for i=1:length(d) + % fprintf('%5d) %s\n', d(i).code, d(i).label); + %end + %fprintf('\nNO CHANGES MADE\n'); +end diff --git a/Toolboxes/spm12/@nifti/private/getdict.m b/Toolboxes/spm12/@nifti/private/getdict.m new file mode 100644 index 0000000000000000000000000000000000000000..2a68965078cea4e7af292a836cbeaffa826ed933 --- /dev/null +++ b/Toolboxes/spm12/@nifti/private/getdict.m @@ -0,0 +1,163 @@ +function d = getdict +% Dictionary of NIFTI stuff +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: getdict.m 7147 2017-08-03 14:07:01Z spm $ + + +persistent dict; +if ~isempty(dict) + d = dict; + return; +end + +% Datatype +t = true; +f = false; +table = {... + 0 ,'UNKNOWN' ,'uint8' ,@uint8 ,1,1 ,t,t,f + 1 ,'BINARY' ,'uint1' ,@logical,1,1/8,t,t,f + 256 ,'INT8' ,'int8' ,@int8 ,1,1 ,t,f,t + 2 ,'UINT8' ,'uint8' ,@uint8 ,1,1 ,t,t,t + 4 ,'INT16' ,'int16' ,@int16 ,1,2 ,t,f,t + 512 ,'UINT16' ,'uint16' ,@uint16 ,1,2 ,t,t,t + 8 ,'INT32' ,'int32' ,@int32 ,1,4 ,t,f,t + 768 ,'UINT32' ,'uint32' ,@uint32 ,1,4 ,t,t,t + 1024,'INT64' ,'int64' ,@int64 ,1,8 ,t,f,f + 1280,'UINT64' ,'uint64' ,@uint64 ,1,8 ,t,t,f + 16 ,'FLOAT32' ,'float32' ,@single ,1,4 ,f,f,t + 64 ,'FLOAT64' ,'double' ,@double ,1,8 ,f,f,t + 1536,'FLOAT128' ,'float128',@crash ,1,16 ,f,f,f + 32 ,'COMPLEX64' ,'float32' ,@single ,2,4 ,f,f,f + 1792,'COMPLEX128','double' ,@double ,2,8 ,f,f,f + 2048,'COMPLEX256','float128',@crash ,2,16 ,f,f,f + 128 ,'RGB24' ,'uint8' ,@uint8 ,3,1 ,t,t,f}; + +dtype = struct(... + 'code' ,table(:,1),... + 'label' ,table(:,2),... + 'prec' ,table(:,3),... + 'conv' ,table(:,4),... + 'nelem' ,table(:,5),... + 'size' ,table(:,6),... + 'isint' ,table(:,7),... + 'unsigned' ,table(:,8),... + 'min',-Inf,'max',Inf',... + 'supported',table(:,9)); +for i=1:length(dtype) + if dtype(i).isint + if dtype(i).unsigned + dtype(i).min = 0; + dtype(i).max = 2^(8*dtype(i).size)-1; + else + dtype(i).min = -2^(8*dtype(i).size-1); + dtype(i).max = 2^(8*dtype(i).size-1)-1; + end + end +end +% Intent +table = {... + 0 ,'NONE' ,'None',{} + 2 ,'CORREL' ,'Correlation statistic',{'DOF'} + 3 ,'TTEST' ,'T-statistic',{'DOF'} + 4 ,'FTEST' ,'F-statistic',{'numerator DOF','denominator DOF'} + 5 ,'ZSCORE' ,'Z-score',{} + 6 ,'CHISQ' ,'Chi-squared distribution',{'DOF'} + 7 ,'BETA' ,'Beta distribution',{'a','b'} + 8 ,'BINOM' ,'Binomial distribution',... + {'number of trials','probability per trial'} + 9 ,'GAMMA' ,'Gamma distribution',{'shape','scale'} + 10 ,'POISSON' ,'Poisson distribution',{'mean'} + 11 ,'NORMAL' ,'Normal distribution',{'mean','standard deviation'} + 12 ,'FTEST_NONC' ,'F-statistic noncentral',... + {'numerator DOF','denominator DOF','numerator noncentrality parameter'} + 13 ,'CHISQ_NONC' ,'Chi-squared noncentral',{'DOF','noncentrality parameter'} + 14 ,'LOGISTIC' ,'Logistic distribution',{'location','scale'} + 15 ,'LAPLACE' ,'Laplace distribution',{'location','scale'} + 16 ,'UNIFORM' ,'Uniform distribition',{'lower end','upper end'} + 17 ,'TTEST_NONC' ,'T-statistic noncentral',{'DOF','noncentrality parameter'} + 18 ,'WEIBULL' ,'Weibull distribution',{'location','scale','power'} + 19 ,'CHI' ,'Chi distribution',{'DOF'} + 20 ,'INVGAUSS' ,'Inverse Gaussian distribution',{'mu','lambda'} + 21 ,'EXTVAL' ,'Extreme Value distribution',{'location','scale'} + 22 ,'PVAL' ,'P-value',{} + 23 ,'LOGPVAL' ,'Log P-value',{} + 24 ,'LOG10PVAL' ,'Log_10 P-value',{} + 1001,'ESTIMATE' ,'Estimate',{} + 1002,'LABEL' ,'Label index',{} + 1003,'NEURONAME' ,'NeuroNames index',{} + 1004,'GENMATRIX' ,'General matrix',{'M','N'} + 1005,'SYMMATRIX' ,'Symmetric matrix',{} + 1006,'DISPVECT' ,'Displacement vector',{} + 1007,'VECTOR' ,'Vector',{} + 1008,'POINTSET' ,'Pointset',{} + 1009,'TRIANGLE' ,'Triangle',{} + 1010,'QUATERNION' ,'Quaternion',{} + 1011,'DIMLESS' ,'Dimensionless',{} + 2001,'TIME_SERIES' ,'Time series',{} + 2002,'NODE_INDEX' ,'Node index',{} + 2003,'RGB_VECTOR' ,'RGB triplet',{} + 2004,'RGBA_VECTOR' ,'RGBA vector',{} + 2005,'SHAPE' ,'Shape',{} + 3001,'CONNECTIVITY_DENSE' ,'Dense connectivity',{} + 3002,'CONNECTIVITY_DENSE_TIME' ,'Dense time series',{} + 3003,'CONNECTIVITY_PARCELLATED' ,'Parcellated connectivity',{} + 3004,'CONNECTIVITY_PARCELLATED_TIME' ,'Parcellated time series',{} + 3005,'CONNECTIVITY_CONNECTIVITY_TRAJECTORY','Trajectory connectivity',{} +}; +intent = struct('code',table(:,1),'label',table(:,2),... + 'fullname',table(:,3),'param',table(:,4)); + +% Units +table = {... + 0, 1,'UNKNOWN' + 1,1000,'m' + 2, 1,'mm' + 3,1e-3,'um' + 8, 1,'s' + 16,1e-3,'ms' + 24,1e-6,'us' + 32, 1,'Hz' + 40, 1,'ppm' + 48, 1,'rads'}; +units = struct('code',table(:,1),'label',table(:,3),'rescale',table(:,2)); + +% Reference space +% code = {0,1,2,3,4}; +table = {... + 0,'UNKNOWN' + 1,'Scanner Anat' + 2,'Aligned Anat' + 3,'Talairach' + 4,'MNI_152'}; +anat = struct('code',table(:,1),'label',table(:,2)); + +% Slice Ordering +table = {... + 0,'UNKNOWN' + 1,'sequential_increasing' + 2,'sequential_decreasing' + 3,'alternating_increasing' + 4,'alternating_decreasing'}; +sliceorder = struct('code',table(:,1),'label',table(:,2)); + +% Q/S Form Interpretation +table = {... + 0,'UNKNOWN' + 1,'Scanner' + 2,'Aligned' + 3,'Talairach' + 4,'MNI152'}; +xform = struct('code',table(:,1),'label',table(:,2)); + +dict = struct('dtype',dtype,'intent',intent,'units',units,... + 'space',anat,'sliceorder',sliceorder,'xform',xform); + +d = dict; +return; + + +function varargout = crash(varargin) +error('There is a NIFTI data format problem (an invalid datatype).'); diff --git a/Toolboxes/spm12/@nifti/private/mayo2nifti1.m b/Toolboxes/spm12/@nifti/private/mayo2nifti1.m new file mode 100644 index 0000000000000000000000000000000000000000..929f7c5486fa886bbc599b0749433b64bda81518 --- /dev/null +++ b/Toolboxes/spm12/@nifti/private/mayo2nifti1.m @@ -0,0 +1,69 @@ +function hdr = mayo2nifti1(ohdr,mat) +% Convert from an ANALYZE to a NIFTI-1 header +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: mayo2nifti1.m 7147 2017-08-03 14:07:01Z spm $ + + +if isfield(ohdr,'magic') + hdr = ohdr; + return; +end +hdr = empty_hdr; +hdr.dim = ohdr.dim; +if hdr.dim(1)<1 + tmp = [find(~hdr.dim(2:end))-1, 7]; + hdr.dim(1) = tmp(1); +end +hdr.datatype = ohdr.datatype; +hdr.bitpix = ohdr.bitpix; +hdr.pixdim = ohdr.pixdim; +hdr.vox_offset = ohdr.vox_offset; +hdr.scl_slope = ohdr.roi_scale; +hdr.scl_inter = ohdr.funused1; +hdr.descrip = ohdr.descrip; +hdr.aux_file = ohdr.aux_file; +hdr.glmax = ohdr.glmax; +hdr.glmin = ohdr.glmin; +hdr.cal_max = ohdr.cal_max; +hdr.cal_min = ohdr.cal_min; +hdr.magic = 'ni1'; + +switch hdr.datatype + case 130, hdr.datatype = 256; % int8 + case 132, hdr.datatype = 512; % uint16 + case 136, hdr.datatype = 768; % uint32 +end + +if nargin<2 + % No mat, so create the equivalent from the hdr... + if any(ohdr.origin(1:3)), origin = double(ohdr.origin(1:3)); + else origin = (double(ohdr.dim(2:4))+1)/2; end + vox = double(ohdr.pixdim(2:4)); + if vox(1)<0 + % Assume FSL orientation + flp = 0; + else + % Assume SPM or proper Analyze + flp = spm_flip_analyze_images; + end + if all(vox == 0), vox = [1 1 1]; end + off = -vox.*origin; + mat = [vox(1) 0 0 off(1) ; 0 vox(2) 0 off(2) ; 0 0 vox(3) off(3) ; 0 0 0 1]; + if flp + %disp(['Assuming that image is stored left-handed']); + mat = diag([-1 1 1 1])*mat; + else + %disp(['Assuming that image is stored right-handed']); + end +end + +hdr = encode_qform0(mat,hdr); +mat = mat*[eye(4,3) [1 1 1 1]']; +hdr.srow_x = mat(1,:); +hdr.srow_y = mat(2,:); +hdr.srow_z = mat(3,:); +hdr.qform_code = 2; +hdr.sform_code = 2; diff --git a/Toolboxes/spm12/@nifti/private/mayostruc.m b/Toolboxes/spm12/@nifti/private/mayostruc.m new file mode 100644 index 0000000000000000000000000000000000000000..68adc7ed64e65cadf143f28f8fc9149526fd5fcd --- /dev/null +++ b/Toolboxes/spm12/@nifti/private/mayostruc.m @@ -0,0 +1,78 @@ +function o = mayostruc +% Create a data structure describing Analyze headers +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: mayostruc.m 7147 2017-08-03 14:07:01Z spm $ + + +persistent org; +if ~isempty(org) + o = org; + return; +end +t = struct('conv',{ @char, @int16, @int32, @single },... + 'prec',{'uint8','int16','int32','single'},... + 'size',{ 1, 2, 4, 4}); +c = t(1); +s = t(2); +i = t(3); +f = t(4); +table = {... + i, 1,'sizeof_hdr',348 + c,10,'data_type',[] + c,18,'db_name',[] + i, 1,'extents',[] + s, 1,'session_error',[] + c, 1,'regular','r' + c, 1,'hkey_un0',[] + s, 8,'dim',[3 1 1 1 1 1 1 1 1] + c, 4,'vox_units',[] + c, 8,'cal_units',[] + s, 1,'unused1',[] + s, 1,'datatype',[] + s, 1,'bitpix',[] + s, 1,'dim_un0',[] + f, 8,'pixdim',[] + f, 1,'vox_offset',0 + f, 1,'roi_scale',1 + f, 1,'funused1',0 + f, 1,'funused2',[] + f, 1,'cal_max',[] + f, 1,'cal_min',[] + i, 1,'compressed',[] + i, 1,'verified',[] + i, 1,'glmax',[] + i, 1,'glmin',[] + c,80,'descrip','Analyze Image' + c,24,'aux_file','' + c, 1,'orient',[] +% c,10,'originator',[] + s, 5,'origin',[] % SPM version + c,10,'generated',[] + c,10,'scannum',[] + c,10,'patient_id',[] + c,10,'exp_date',[] + c,10,'exp_time',[] + c, 3,'hist_un0',[] + i, 1,'views',[] + i, 1,'vols_added',[] + i, 1,'start_field',[] + i, 1,'field_skip',[] + i, 1,'omax',[] + i, 1,'omin',[] + i, 1,'smax',[] + i, 1,'smin',[]}; +org = struct('label',table(:,3),'dtype',table(:,1),'len',table(:,2),... + 'offset',0,'def',table(:,4)); +os = 0; +for j=1:length(org) + os = os + org(j).dtype.size*ceil(os/org(j).dtype.size); + fun = org(j).dtype.conv; + def = [org(j).def zeros(1,org(j).len-length(org(j).def))]; + org(j).def = feval(fun,def); + org(j).offset = os; + os = os + org(j).len*org(j).dtype.size; +end +o = org; diff --git a/Toolboxes/spm12/@nifti/private/nifti1.h b/Toolboxes/spm12/@nifti/private/nifti1.h new file mode 100644 index 0000000000000000000000000000000000000000..98fed70c3c8484692cd2d547276cb9da16f4f5c3 --- /dev/null +++ b/Toolboxes/spm12/@nifti/private/nifti1.h @@ -0,0 +1,1222 @@ +#ifndef _NIFTI_HEADER_ +#define _NIFTI_HEADER_ + +/***************************************************************************** + ** This file defines the "NIFTI-1" header format. ** + ** It is derived from 2 meetings at the NIH (31 Mar 2003 and ** + ** 02 Sep 2003) of the Data Format Working Group (DFWG), ** + ** chartered by the NIfTI (Neuroimaging Informatics Technology ** + ** Initiative) at the National Institutes of Health (NIH). ** + **--------------------------------------------------------------** + ** Neither the National Institutes of Health (NIH), the DFWG, ** + ** nor any of the members or employees of these institutions ** + ** imply any warranty of usefulness of this material for any ** + ** purpose, and do not assume any liability for damages, ** + ** incidental or otherwise, caused by any use of this document. ** + ** If these conditions are not acceptable, do not use this! ** + **--------------------------------------------------------------** + ** Author: Robert W Cox (NIMH, Bethesda) ** + ** Advisors: John Ashburner (FIL, London), ** + ** Stephen Smith (FMRIB, Oxford), ** + ** Mark Jenkinson (FMRIB, Oxford) ** +******************************************************************************/ + +/*---------------------------------------------------------------------------*/ +/* Note that the ANALYZE 7.5 file header (dbh.h) is + (c) Copyright 1986-1995 + Biomedical Imaging Resource + Mayo Foundation + Incorporation of components of dbh.h are by permission of the + Mayo Foundation. + + Changes from the ANALYZE 7.5 file header in this file are released to the + public domain, including the functional comments and any amusing asides. +-----------------------------------------------------------------------------*/ + +/*---------------------------------------------------------------------------*/ +/*! INTRODUCTION TO NIFTI-1: + ------------------------ + The twin (and somewhat conflicting) goals of this modified ANALYZE 7.5 + format are: + (a) To add information to the header that will be useful for functional + neuroimaging data analysis and display. These additions include: + - More basic data types. + - Two affine transformations to specify voxel coordinates. + - "Intent" codes and parameters to describe the meaning of the data. + - Affine scaling of the stored data values to their "true" values. + - Optional storage of the header and image data in one file (.nii). + (b) To maintain compatibility with non-NIFTI-aware ANALYZE 7.5 compatible + software (i.e., such a program should be able to do something useful + with a NIFTI-1 dataset -- at least, with one stored in a traditional + .img/.hdr file pair). + + Most of the unused fields in the ANALYZE 7.5 header have been taken, + and some of the lesser-used fields have been co-opted for other purposes. + Notably, most of the data_history substructure has been co-opted for + other purposes, since the ANALYZE 7.5 format describes this substructure + as "not required". + + NIFTI-1 FLAG (MAGIC STRINGS): + ---------------------------- + To flag such a struct as being conformant to the NIFTI-1 spec, the last 4 + bytes of the header must be either the C String "ni1" or "n+1"; + in hexadecimal, the 4 bytes + 6E 69 31 00 or 6E 2B 31 00 + (in any future version of this format, the '1' will be upgraded to '2', + etc.). Normally, such a "magic number" or flag goes at the start of the + file, but trying to avoid clobbering widely-used ANALYZE 7.5 fields led to + putting this marker last. However, recall that "the last shall be first" + (Matthew 20:16). + + If a NIFTI-aware program reads a header file that is NOT marked with a + NIFTI magic string, then it should treat the header as an ANALYZE 7.5 + structure. + + NIFTI-1 FILE STORAGE: + -------------------- + "ni1" means that the image data is stored in the ".img" file corresponding + to the header file (starting at file offset 0). + + "n+1" means that the image data is stored in the same file as the header + information. We recommend that the combined header+data filename suffix + be ".nii". When the dataset is stored in one file, the first byte of image + data is stored at byte location (int)vox_offset in this combined file. + + GRACE UNDER FIRE: + ---------------- + Most NIFTI-aware programs will only be able to handle a subset of the full + range of datasets possible with this format. All NIFTI-aware programs + should take care to check if an input dataset conforms to the program's + needs and expectations (e.g., check datatype, intent_code, etc.). If the + input dataset can't be handled by the program, the program should fail + gracefully (e.g., print a useful warning; not crash). + + SAMPLE CODES: + ------------ + The associated files nifti1_io.h and nifti1_io.c provide a sample + implementation in C of a set of functions to read, write, and manipulate + NIFTI-1 files. The file nifti1_test.c is a sample program that uses + the nifti1_io.c functions. +-----------------------------------------------------------------------------*/ + +/*---------------------------------------------------------------------------*/ +/* HEADER STRUCT DECLARATION: + ------------------------- + In the comments below for each field, only NIFTI-1 specific requirements + or changes from the ANALYZE 7.5 format are described. For convenience, + the 348 byte header is described as a single struct, rather than as the + ANALYZE 7.5 group of 3 substructs. + + Further comments about the interpretation of various elements of this + header are after the data type definition itself. Fields that are + marked as ++UNUSED++ have no particular interpretation in this standard. + (Also see the UNUSED FIELDS comment section, far below.) + + The presumption below is that the various C types have particular sizes: + sizeof(int) = sizeof(float) = 4 ; sizeof(short) = 2 +-----------------------------------------------------------------------------*/ + +/*=================*/ +#ifdef __cplusplus +extern "C" { +#endif +/*=================*/ + /*************************/ /************************/ +struct nifti_1_header { /* NIFTI-1 usage */ /* ANALYZE 7.5 field(s) */ + /*************************/ /************************/ + + /*--- was header_key substruct ---*/ + int sizeof_hdr; /*!< MUST be 348 */ /* int sizeof_hdr; */ + char data_type[10]; /*!< ++UNUSED++ */ /* char data_type[10]; */ + char db_name[18]; /*!< ++UNUSED++ */ /* char db_name[18]; */ + int extents; /*!< ++UNUSED++ */ /* int extents; */ + short session_error; /*!< ++UNUSED++ */ /* short session_error; */ + char regular; /*!< ++UNUSED++ */ /* char regular; */ + char dim_info; /*!< MRI slice ordering. */ /* char hkey_un0; */ + + /*--- was image_dimension substruct ---*/ + short dim[8]; /*!< Data array dimensions.*/ /* short dim[8]; */ + float intent_p1 ; /*!< 1st intent parameter. */ /* short unused8; */ + /* short unused9; */ + float intent_p2 ; /*!< 2nd intent parameter. */ /* short unused10; */ + /* short unused11; */ + float intent_p3 ; /*!< 3rd intent parameter. */ /* short unused12; */ + /* short unused13; */ + short intent_code ; /*!< NIFTI_INTENT_* code. */ /* short unused14; */ + short datatype; /*!< Defines data type! */ /* short datatype; */ + short bitpix; /*!< Number bits/voxel. */ /* short bitpix; */ + short slice_start; /*!< First slice index. */ /* short dim_un0; */ + float pixdim[8]; /*!< Grid spacings. */ /* float pixdim[8]; */ + float vox_offset; /*!< Offset into .nii file */ /* float vox_offset; */ + float scl_slope ; /*!< Data scaling: slope. */ /* float funused1; */ + float scl_inter ; /*!< Data scaling: offset. */ /* float funused2; */ + short slice_end; /*!< Last slice index. */ /* float funused3; */ + char slice_code ; /*!< Slice timing order. */ + char xyzt_units ; /*!< Units of pixdim[1..4] */ + float cal_max; /*!< Max display intensity */ /* float cal_max; */ + float cal_min; /*!< Min display intensity */ /* float cal_min; */ + float slice_duration;/*!< Time for 1 slice. */ /* float compressed; */ + float toffset; /*!< Time axis shift. */ /* float verified; */ + int glmax; /*!< ++UNUSED++ */ /* int glmax; */ + int glmin; /*!< ++UNUSED++ */ /* int glmin; */ + + /*--- was data_history substruct ---*/ + char descrip[80]; /*!< any text you like. */ /* char descrip[80]; */ + char aux_file[24]; /*!< auxiliary filename. */ /* char aux_file[24]; */ + + short qform_code ; /*!< NIFTI_XFORM_* code. */ /*-- all ANALYZE 7.5 ---*/ + short sform_code ; /*!< NIFTI_XFORM_* code. */ /* fields below here */ + /* are replaced */ + float quatern_b ; /*!< Quaternion b param. */ + float quatern_c ; /*!< Quaternion c param. */ + float quatern_d ; /*!< Quaternion d param. */ + float qoffset_x ; /*!< Quaternion x shift. */ + float qoffset_y ; /*!< Quaternion y shift. */ + float qoffset_z ; /*!< Quaternion z shift. */ + + float srow_x[4] ; /*!< 1st row affine transform. */ + float srow_y[4] ; /*!< 2nd row affine transform. */ + float srow_z[4] ; /*!< 3rd row affine transform. */ + + char intent_name[16];/*!< 'name' or meaning of data. */ + + char magic[4] ; /*!< MUST be "ni1\0" or "n+1\0". */ + +} ; /**** 348 bytes total ****/ + +typedef struct nifti_1_header nifti_1_header ; + +/*---------------------------------------------------------------------------*/ +/* DATA DIMENSIONALITY (as in ANALYZE 7.5): + --------------------------------------- + dim[0] = number of dimensions; + - if dim[0] is outside range 1..7, then the header information + needs to be byte swapped appropriately + - ANALYZE supports dim[0] up to 7, but NIFTI-1 reserves + dimensions 1,2,3 for space (x,y,z), 4 for time (t), and + 5,6,7 for anything else needed. + + dim[i] = length of dimension #i, for i=1..dim[0] (must be positive) + - also see the discussion of intent_code, far below + + pixdim[i] = voxel width along dimension #i, i=1..dim[0] (positive) + - cf. ORIENTATION section below for use of pixdim[0] + - the units of pixdim can be specified with the xyzt_units + field (also described far below). + + Number of bits per voxel value is in bitpix, which MUST correspond with + the datatype field. The total number of bytes in the image data is + dim[1] * ... * dim[dim[0]] * bitpix / 8 + + In NIFTI-1 files, dimensions 1,2,3 are for space, dimension 4 is for time, + and dimension 5 is for storing multiple values at each spatiotemporal + voxel. Some examples: + - A typical whole-brain FMRI experiment's time series: + - dim[0] = 4 + - dim[1] = 64 pixdim[1] = 3.75 xyzt_units = NIFTI_UNITS_MM + - dim[2] = 64 pixdim[2] = 3.75 | NIFTI_UNITS_SEC + - dim[3] = 20 pixdim[3] = 5.0 + - dim[4] = 120 pixdim[4] = 2.0 + - A typical T1-weighted anatomical volume: + - dim[0] = 3 + - dim[1] = 256 pixdim[1] = 1.0 xyzt_units = NIFTI_UNITS_MM + - dim[2] = 256 pixdim[2] = 1.0 + - dim[3] = 128 pixdim[3] = 1.1 + - A single slice EPI time series: + - dim[0] = 4 + - dim[1] = 64 pixdim[1] = 3.75 xyzt_units = NIFTI_UNITS_MM + - dim[2] = 64 pixdim[2] = 3.75 | NIFTI_UNITS_SEC + - dim[3] = 1 pixdim[3] = 5.0 + - dim[4] = 1200 pixdim[4] = 0.2 + - A 3-vector stored at each point in a 3D volume: + - dim[0] = 5 + - dim[1] = 256 pixdim[1] = 1.0 xyzt_units = NIFTI_UNITS_MM + - dim[2] = 256 pixdim[2] = 1.0 + - dim[3] = 128 pixdim[3] = 1.1 + - dim[4] = 1 pixdim[4] = 0.0 + - dim[5] = 3 intent_code = NIFTI_INTENT_VECTOR + - A single time series with a 3x3 matrix at each point: + - dim[0] = 5 + - dim[1] = 1 xyzt_units = NIFTI_UNITS_SEC + - dim[2] = 1 + - dim[3] = 1 + - dim[4] = 1200 pixdim[4] = 0.2 + - dim[5] = 9 intent_code = NIFTI_INTENT_GENMATRIX + - intent_p1 = intent_p2 = 3.0 (indicates matrix dimensions) +-----------------------------------------------------------------------------*/ + +/*---------------------------------------------------------------------------*/ +/* DATA STORAGE: + ------------ + If the magic field is "n+1", then the voxel data is stored in the + same file as the header. In this case, the voxel data starts at offset + (int)vox_offset into the header file. Thus, vox_offset=348.0 means that + the data starts immediately after the NIFTI-1 header. If vox_offset is + greater than 348, the NIFTI-1 format does not say anything about the + contents of the dataset file between the end of the header and the + start of the data. + + FILES: + ----- + If the magic field is "ni1", then the voxel data is stored in the + associated ".img" file, starting at offset 0 (i.e., vox_offset is not + used in this case, and should be set to 0.0). + + When storing NIFTI-1 datasets in pairs of files, it is customary to name + the files in the pattern "name.hdr" and "name.img", as in ANALYZE 7.5. + When storing in a single file ("n+1"), the file name should be in + the form "name.nii" (the ".nft" and ".nif" suffixes are already taken; + cf. http://www.icdatamaster.com/n.html ). + + BYTE ORDERING: + ------------- + The byte order of the data arrays is presumed to be the same as the byte + order of the header (which is determined by examining dim[0]). + + Floating point types are presumed to be stored in IEEE-754 format. +-----------------------------------------------------------------------------*/ + +/*---------------------------------------------------------------------------*/ +/* DATA SCALING: + ------------ + If the scl_slope field is nonzero, then each voxel value in the dataset + should be scaled as + y = scl_slope * x + scl_inter + where x = voxel value stored + y = "true" voxel value + Normally, we would expect this scaling to be used to store "true" floating + values in a smaller integer datatype, but that is not required. That is, + it is legal to use scaling even if the datatype is a float type (crazy, + perhaps, but legal). + - However, the scaling is to be ignored if datatype is DT_RGB24. + - If datatype is a complex type, then the scaling is to be + applied to both the real and imaginary parts. + + The cal_min and cal_max fields (if nonzero) are used for mapping (possibly + scaled) dataset values to display colors: + - Minimum display intensity (black) corresponds to dataset value cal_min. + - Maximum display intensity (white) corresponds to dataset value cal_max. + - Dataset values below cal_min should display as black also, and values + above cal_max as white. + - Colors "black" and "white", of course, may refer to any scalar display + scheme (e.g., a color lookup table specified via aux_file). + - cal_min and cal_max only make sense when applied to scalar-valued + datasets (i.e., dim[0] < 5 or dim[5] = 1). +-----------------------------------------------------------------------------*/ + +/*---------------------------------------------------------------------------*/ +/* TYPE OF DATA (acceptable values for datatype field): + --------------------------------------------------- + Values of datatype smaller than 256 are ANALYZE 7.5 compatible. + Larger values are NIFTI-1 additions. These are all multiples of 256, so + that no bits below position 8 are set in datatype. But there is no need + to use only powers-of-2, as the original ANALYZE 7.5 datatype codes do. + + The additional codes are intended to include a complete list of basic + scalar types, including signed and unsigned integers from 8 to 64 bits, + floats from 32 to 128 bits, and complex (float pairs) from 64 to 256 bits. + + Note that most programs will support only a few of these datatypes! + A NIFTI-1 program should fail gracefully (e.g., print a warning message) + when it encounters a dataset with a type it doesn't like. +-----------------------------------------------------------------------------*/ + +#undef DT_UNKNOWN /* defined in dirent.h on some Unix systems */ + + /*--- the original ANALYZE 7.5 type codes ---*/ +#define DT_NONE 0 +#define DT_UNKNOWN 0 /* what it says, dude */ +#define DT_BINARY 1 /* binary (1 bit/voxel) */ +#define DT_UNSIGNED_CHAR 2 /* unsigned char (8 bits/voxel) */ +#define DT_SIGNED_SHORT 4 /* signed short (16 bits/voxel) */ +#define DT_SIGNED_INT 8 /* signed int (32 bits/voxel) */ +#define DT_FLOAT 16 /* float (32 bits/voxel) */ +#define DT_COMPLEX 32 /* complex (64 bits/voxel) */ +#define DT_DOUBLE 64 /* double (64 bits/voxel) */ +#define DT_RGB 128 /* RGB triple (24 bits/voxel) */ +#define DT_ALL 255 /* not very useful (?) */ + + /*----- another set of names for the same ---*/ +#define DT_UINT8 2 +#define DT_INT16 4 +#define DT_INT32 8 +#define DT_FLOAT32 16 +#define DT_COMPLEX64 32 +#define DT_FLOAT64 64 +#define DT_RGB24 128 + + /*------------------- new codes for NIFTI ---*/ +#define DT_INT8 256 /* signed char (8 bits) */ +#define DT_UINT16 512 /* unsigned short (16 bits) */ +#define DT_UINT32 768 /* unsigned int (32 bits) */ +#define DT_INT64 1024 /* long long (64 bits) */ +#define DT_UINT64 1280 /* unsigned long long (64 bits) */ +#define DT_FLOAT128 1536 /* long double (128 bits) */ +#define DT_COMPLEX128 1792 /* double pair (128 bits) */ +#define DT_COMPLEX256 2048 /* long double pair (256 bits) */ + + /*------- aliases for all the above codes ---*/ + + /*! unsigned char. */ +#define NIFTI_TYPE_UINT8 2 + /*! signed short. */ +#define NIFTI_TYPE_INT16 4 + /*! signed int. */ +#define NIFTI_TYPE_INT32 8 + /*! 32 bit float. */ +#define NIFTI_TYPE_FLOAT32 16 + /*! 64 bit complex = 2 32 bit floats. */ +#define NIFTI_TYPE_COMPLEX64 32 + /*! 64 bit float = double. */ +#define NIFTI_TYPE_FLOAT64 64 + /*! 3 8 bit bytes. */ +#define NIFTI_TYPE_RGB24 128 + /*! signed char. */ +#define NIFTI_TYPE_INT8 256 + /*! unsigned short. */ +#define NIFTI_TYPE_UINT16 512 + /*! unsigned int. */ +#define NIFTI_TYPE_UINT32 768 + /*! signed long long. */ +#define NIFTI_TYPE_INT64 1024 + /*! unsigned long long. */ +#define NIFTI_TYPE_UINT64 1280 + /*! 128 bit float = long double. */ +#define NIFTI_TYPE_FLOAT128 1536 + /*! 128 bit complex = 2 64 bit floats. */ +#define NIFTI_TYPE_COMPLEX128 1792 + /*! 256 bit complex = 2 128 bit floats */ +#define NIFTI_TYPE_COMPLEX256 2048 + + /*-------- sample typedefs for complicated types ---*/ +#if 0 +typedef struct { float r,i; } complex_float ; +typedef struct { double r,i; } complex_double ; +typedef struct { long double r,i; } complex_longdouble ; +typedef struct { unsigned char r,g,b; } rgb_byte ; +#endif + +/*---------------------------------------------------------------------------*/ +/* INTERPRETATION OF VOXEL DATA: + ---------------------------- + The intent_code field can be used to indicate that the voxel data has + some particular meaning. In particular, a large number of codes is + given to indicate that the the voxel data should be interpreted as + being drawn from a given probability distribution. + + VECTOR-VALUED DATASETS: + ---------------------- + The 5th dimension of the dataset, if present (i.e., dim[0]=5 and + dim[5] > 1), contains multiple values (e.g., a vector) to be stored + at each spatiotemporal location. For example, the header values + - dim[0] = 5 + - dim[1] = 64 + - dim[2] = 64 + - dim[3] = 20 + - dim[4] = 1 (indicates no time axis) + - dim[5] = 3 + - datatype = DT_FLOAT + - intent_code = NIFTI_INTENT_VECTOR + mean that this dataset should be interpreted as a 3D volume (64x64x20), + with a 3-vector of floats defined at each point in the 3D grid. + + A program reading a dataset with a 5th dimension may want to reformat + the image data to store each voxels' set of values together in a struct + or array. This programming detail, however, is beyond the scope of the + NIFTI-1 file specification! Uses of dimensions 6 and 7 are also not + specified here. + + STATISTICAL PARAMETRIC DATASETS (i.e., SPMs): + -------------------------------------------- + Values of intent_code from NIFTI_FIRST_STATCODE to NIFTI_LAST_STATCODE + (inclusive) indicate that the numbers in the dataset should be interpreted + as being drawn from a given distribution. Most such distributions have + auxiliary parameters (e.g., NIFTI_INTENT_TTEST has 1 DOF parameter). + + If the dataset DOES NOT have a 5th dimension, then the auxiliary parameters + are the same for each voxel, and are given in header fields intent_p1, + intent_p2, and intent_p3. + + If the dataset DOES have a 5th dimension, then the auxiliary parameters + are different for each voxel. For example, the header values + - dim[0] = 5 + - dim[1] = 128 + - dim[2] = 128 + - dim[3] = 1 (indicates a single slice) + - dim[4] = 1 (indicates no time axis) + - dim[5] = 2 + - datatype = DT_FLOAT + - intent_code = NIFTI_INTENT_TTEST + mean that this is a 2D dataset (128x128) of t-statistics, with the + t-statistic being in the first "plane" of data and the degrees-of-freedom + parameter being in the second "plane" of data. + + If the dataset 5th dimension is used to store the voxel-wise statistical + parameters, then dim[5] must be 1 plus the number of parameters required + by that distribution (e.g., intent_code=NIFTI_INTENT_TTEST implies dim[5] + must be 2, as in the example just above). + + Note: intent_code values 2..10 are compatible with AFNI 1.5x (which is + why there is no code with value=1, which is obsolescent in AFNI). + + OTHER INTENTIONS: + ---------------- + The purpose of the intent_* fields is to help interpret the values + stored in the dataset. Some non-statistical values for intent_code + and conventions are provided for storing other complex data types. + + The intent_name field provides space for a 15 character (plus 0 byte) + 'name' string for the type of data stored. Examples: + - intent_code = NIFTI_INTENT_ESTIMATE; intent_name = "T1"; + could be used to signify that the voxel values are estimates of the + NMR parameter T1. + - intent_code = NIFTI_INTENT_TTEST; intent_name = "House"; + could be used to signify that the voxel values are t-statistics + for the significance of 'activation' response to a House stimulus. + - intent_code = NIFTI_INTENT_DISPVECT; intent_name = "ToMNI152"; + could be used to signify that the voxel values are a displacement + vector that transforms each voxel (x,y,z) location to the + corresponding location in the MNI152 standard brain. + - intent_code = NIFTI_INTENT_SYMMATRIX; intent_name = "DTI"; + could be used to signify that the voxel values comprise a diffusion + tensor image. + + If no data name is implied or needed, intent_name[0] should be set to 0. +-----------------------------------------------------------------------------*/ + + /*! default: no intention is indicated in the header. */ + +#define NIFTI_INTENT_NONE 0 + + /*-------- These codes are for probability distributions ---------------*/ + /* Most distributions have a number of parameters, + below denoted by p1, p2, and p3, and stored in + - intent_p1, intent_p2, intent_p3 if dataset doesn't have 5th dimension + - image data array if dataset does have 5th dimension + + Functions to compute with many of the distributions below can be found + in the CDF library from U Texas. + + Formulas for and discussions of these distributions can be found in the + following books: + + [U] Univariate Discrete Distributions, + NL Johnson, S Kotz, AW Kemp. + + [C1] Continuous Univariate Distributions, vol. 1, + NL Johnson, S Kotz, N Balakrishnan. + + [C2] Continuous Univariate Distributions, vol. 2, + NL Johnson, S Kotz, N Balakrishnan. */ + /*----------------------------------------------------------------------*/ + + /*! [C2, chap 32] Correlation coefficient R (1 param): + p1 = degrees of freedom + R/sqrt(1-R*R) is t-distributed with p1 DOF. */ + +#define NIFTI_INTENT_CORREL 2 + + /*! [C2, chap 28] Student t statistic (1 param): p1 = DOF. */ + +#define NIFTI_INTENT_TTEST 3 + + /*! [C2, chap 27] Fisher F statistic (2 params): + p1 = numerator DOF, p2 = denominator DOF. */ + +#define NIFTI_INTENT_FTEST 4 + + /*! [C1, chap 13] Standard normal (0 params): Density = N(0,1). */ + +#define NIFTI_INTENT_ZSCORE 5 + + /*! [C1, chap 18] Chi-squared (1 param): p1 = DOF. + Density(x) proportional to exp(-x/2) * x^(p1/2-1). */ + +#define NIFTI_INTENT_CHISQ 6 + + /*! [C2, chap 25] Beta distribution (2 params): p1=a, p2=b. + Density(x) proportional to x^(a-1) * (1-x)^(b-1). */ + +#define NIFTI_INTENT_BETA 7 + + /*! [U, chap 3] Binomial distribution (2 params): + p1 = number of trials, p2 = probability per trial. + Prob(x) = (p1 choose x) * p2^x * (1-p2)^(p1-x), for x=0,1,...,p1. */ + +#define NIFTI_INTENT_BINOM 8 + + /*! [C1, chap 17] Gamma distribution (2 params): + p1 = shape, p2 = scale. + Density(x) proportional to x^(p1-1) * exp(-p2*x). */ + +#define NIFTI_INTENT_GAMMA 9 + + /*! [U, chap 4] Poisson distribution (1 param): p1 = mean. + Prob(x) = exp(-p1) * p1^x / x! , for x=0,1,2,.... */ + +#define NIFTI_INTENT_POISSON 10 + + /*! [C1, chap 13] Normal distribution (2 params): + p1 = mean, p2 = standard deviation. */ + +#define NIFTI_INTENT_NORMAL 11 + + /*! [C2, chap 30] Noncentral F statistic (3 params): + p1 = numerator DOF, p2 = denominator DOF, + p3 = numerator noncentrality parameter. */ + +#define NIFTI_INTENT_FTEST_NONC 12 + + /*! [C2, chap 29] Noncentral chi-squared statistic (2 params): + p1 = DOF, p2 = noncentrality parameter. */ + +#define NIFTI_INTENT_CHISQ_NONC 13 + + /*! [C2, chap 23] Logistic distribution (2 params): + p1 = location, p2 = scale. + Density(x) proportional to sech^2((x-p1)/(2*p2)). */ + +#define NIFTI_INTENT_LOGISTIC 14 + + /*! [C2, chap 24] Laplace distribution (2 params): + p1 = location, p2 = scale. + Density(x) proportional to exp(-abs(x-p1)/p2). */ + +#define NIFTI_INTENT_LAPLACE 15 + + /*! [C2, chap 26] Uniform distribution: p1 = lower end, p2 = upper end. */ + +#define NIFTI_INTENT_UNIFORM 16 + + /*! [C2, chap 31] Noncentral t statistic (2 params): + p1 = DOF, p2 = noncentrality parameter. */ + +#define NIFTI_INTENT_TTEST_NONC 17 + + /*! [C1, chap 21] Weibull distribution (3 params): + p1 = location, p2 = scale, p3 = power. + Density(x) proportional to + ((x-p1)/p2)^(p3-1) * exp(-((x-p1)/p2)^p3) for x > p1. */ + +#define NIFTI_INTENT_WEIBULL 18 + + /*! [C1, chap 18] Chi distribution (1 param): p1 = DOF. + Density(x) proportional to x^(p1-1) * exp(-x^2/2) for x > 0. + p1 = 1 = 'half normal' distribution + p1 = 2 = Rayleigh distribution + p1 = 3 = Maxwell-Boltzmann distribution. */ + +#define NIFTI_INTENT_CHI 19 + + /*! [C1, chap 15] Inverse Gaussian (2 params): + p1 = mu, p2 = lambda + Density(x) proportional to + exp(-p2*(x-p1)^2/(2*p1^2*x)) / x^3 for x > 0. */ + +#define NIFTI_INTENT_INVGAUSS 20 + + /*! [C2, chap 22] Extreme value type I (2 params): + p1 = location, p2 = scale + cdf(x) = exp(-exp(-(x-p1)/p2)). */ + +#define NIFTI_INTENT_EXTVAL 21 + + /*! Data is a 'p-value' (no params). */ + +#define NIFTI_INTENT_PVAL 22 + + /*! Smallest intent_code that indicates a statistic. */ + +#define NIFTI_FIRST_STATCODE 2 + + /*! Largest intent_code that indicates a statistic. */ + +#define NIFTI_LAST_STATCODE 22 + + /*---------- these values for intent_code aren't for statistics ----------*/ + + /*! To signify that the value at each voxel is an estimate + of some parameter, set intent_code = NIFTI_INTENT_ESTIMATE. + The name of the parameter may be stored in intent_name. */ + +#define NIFTI_INTENT_ESTIMATE 1001 + + /*! To signify that the value at each voxel is an index into + some set of labels, set intent_code = NIFTI_INTENT_LABEL. + The filename with the labels may stored in aux_file. */ + +#define NIFTI_INTENT_LABEL 1002 + + /*! To signify that the value at each voxel is an index into the + NeuroNames labels set, set intent_code = NIFTI_INTENT_NEURONAME. */ + +#define NIFTI_INTENT_NEURONAME 1003 + + /*! To store an M x N matrix at each voxel: + - dataset must have a 5th dimension (dim[0]=5 and dim[5]>1) + - intent_code must be NIFTI_INTENT_GENMATRIX + - dim[5] must be M*N + - intent_p1 must be M (in float format) + - intent_p2 must be N (ditto) + - the matrix values A[i][[j] are stored in row-order: + - A[0][0] A[0][1] ... A[0][N-1] + - A[1][0] A[1][1] ... A[1][N-1] + - etc., until + - A[M-1][0] A[M-1][1] ... A[M-1][N-1] */ + +#define NIFTI_INTENT_GENMATRIX 1004 + + /*! To store an NxN symmetric matrix at each voxel: + - dataset must have a 5th dimension + - intent_code must be NIFTI_INTENT_SYMMATRIX + - dim[5] must be N*(N+1)/2 + - intent_p1 must be N (in float format) + - the matrix values A[i][[j] are stored in row-order: + - A[0][0] + - A[1][0] A[1][1] + - A[2][0] A[2][1] A[2][2] + - etc.: row-by-row */ + +#define NIFTI_INTENT_SYMMATRIX 1005 + + /*! To signify that the vector value at each voxel is to be taken + as a displacement field or vector: + - dataset must have a 5th dimension + - intent_code must be NIFTI_INTENT_DISPVECT + - dim[5] must be the dimensionality of the displacment + vector (e.g., 3 for spatial displacement, 2 for in-plane) */ + +#define NIFTI_INTENT_DISPVECT 1006 /* specifically for displacements */ +#define NIFTI_INTENT_VECTOR 1007 /* for any other type of vector */ + + /*! To signify that the vector value at each voxel is really a + spatial coordinate (e.g., the vertices or nodes of a surface mesh): + - dataset must have a 5th dimension + - intent_code must be NIFTI_INTENT_POINTSET + - dim[0] = 5 + - dim[1] = number of points + - dim[2] = dim[3] = dim[4] = 1 + - dim[5] must be the dimensionality of space (e.g., 3 => 3D space). + - intent_name may describe the object these points come from + (e.g., "pial", "gray/white" , "EEG", "MEG"). */ + +#define NIFTI_INTENT_POINTSET 1008 + + /*! To signify that the vector value at each voxel is really a triple + of indexes (e.g., forming a triangle) from a pointset dataset: + - dataset must have a 5th dimension + - intent_code must be NIFTI_INTENT_TRIANGLE + - dim[0] = 5 + - dim[1] = number of triangles + - dim[2] = dim[3] = dim[4] = 1 + - dim[5] = 3 + - datatype should be an integer type (preferably DT_INT32) + - the data values are indexes (0,1,...) into a pointset dataset. */ + +#define NIFTI_INTENT_TRIANGLE 1009 + + /*! To signify that the vector value at each voxel is a quaternion: + - dataset must have a 5th dimension + - intent_code must be NIFTI_INTENT_QUATERNION + - dim[0] = 5 + - dim[5] = 4 + - datatype should be a floating point type */ + +#define NIFTI_INTENT_QUATERNION 1010 + +/*---------------------------------------------------------------------------*/ +/* 3D IMAGE (VOLUME) ORIENTATION AND LOCATION IN SPACE: + --------------------------------------------------- + There are 3 different methods by which continuous coordinates can + attached to voxels. The discussion below emphasizes 3D volumes, and + the continuous coordinates are referred to as (x,y,z). The voxel + index coordinates (i.e., the array indexes) are referred to as (i,j,k), + with valid ranges: + i = 0 .. dim[1]-1 + j = 0 .. dim[2]-1 (if dim[0] >= 2) + k = 0 .. dim[3]-1 (if dim[0] >= 3) + The (x,y,z) coordinates refer to the CENTER of a voxel. In methods + 2 and 3, the (x,y,z) axes refer to a subject-based coordinate system, + with + +x = Right +y = Anterior +z = Superior. + This is a right-handed coordinate system. However, the exact direction + these axes point with respect to the subject depends on qform_code + (Method 2) and sform_code (Method 3). + + N.B.: The i index varies most rapidly, j index next, k index slowest. + Thus, voxel (i,j,k) is stored starting at location + (i + j*dim[1] + k*dim[1]*dim[2]) * (bitpix/8) + into the dataset array. + + N.B.: The ANALYZE 7.5 coordinate system is + +x = Left +y = Anterior +z = Superior + which is a left-handed coordinate system. This backwardness is + too difficult to tolerate, so this NIFTI-1 standard specifies the + coordinate order which is most common in functional neuroimaging. + + N.B.: The 3 methods below all give the locations of the voxel centers + in the (x,y,z) coordinate system. In many cases, programs will wish + to display image data on some other grid. In such a case, the program + will need to convert its desired (x,y,z) values into (i,j,k) values + in order to extract (or interpolate) the image data. This operation + would be done with the inverse transformation to those described below. + + N.B.: Method 2 uses a factor 'qfac' which is either -1 or 1; qfac is + stored in the otherwise unused pixdim[0]. If pixdim[0]=0.0 (which + should not occur), we take qfac=1. Of course, pixdim[0] is only used + when reading a NIFTI-1 header, not when reading an ANALYZE 7.5 header. + + N.B.: The units of (x,y,z) can be specified using the xyzt_units field. + + METHOD 1 (the "old" way, used only when qform_code = 0): + ------------------------------------------------------- + The coordinate mapping from (i,j,k) to (x,y,z) is the ANALYZE + 7.5 way. This is a simple scaling relationship: + + x = pixdim[1] * i + y = pixdim[2] * j + z = pixdim[3] * k + + No particular spatial orientation is attached to these (x,y,z) + coordinates. (NIFTI-1 does not have the ANALYZE 7.5 orient field, + which is not general and is often not set properly.) This method + is not recommended, and is present mainly for compatibility with + ANALYZE 7.5 files. + + METHOD 2 (used when qform_code > 0, which should be the "normal case): + --------------------------------------------------------------------- + The (x,y,z) coordinates are given by the pixdim[] scales, a rotation + matrix, and a shift. This method is intended to represent + "scanner-anatomical" coordinates, which are often embedded in the + image header (e.g., DICOM fields (0020,0032), (0020,0037), (0028,0030), + and (0018,0050)), and represent the nominal orientation and location of + the data. This method can also be used to represent "aligned" + coordinates, which would typically result from some post-acquisition + alignment of the volume to a standard orientation (e.g., the same + subject on another day, or a rigid rotation to true anatomical + orientation from the tilted position of the subject in the scanner). + The formula for (x,y,z) in terms of header parameters and (i,j,k) is: + + [ x ] [ R11 R12 R13 ] [ pixdim[1] * i ] [ qoffset_x ] + [ y ] = [ R21 R22 R23 ] [ pixdim[2] * j ] + [ qoffset_y ] + [ z ] [ R31 R32 R33 ] [ qfac * pixdim[3] * k ] [ qoffset_z ] + + The qoffset_* shifts are in the NIFTI-1 header. Note that the center + of the (i,j,k)=(0,0,0) voxel (first value in the dataset array) is + just (x,y,z)=(qoffset_x,qoffset_y,qoffset_z). + + The rotation matrix R is calculated from the quatern_* parameters. + This calculation is described below. + + The scaling factor qfac is either 1 or -1. The rotation matrix R + defined by the quaternion parameters is "proper" (has determinant 1). + This may not fit the needs of the data; for example, if the image + grid is + i increases from Left-to-Right + j increases from Anterior-to-Posterior + k increases from Inferior-to-Superior + Then (i,j,k) is a left-handed triple. In this example, if qfac=1, + the R matrix would have to be + + [ 1 0 0 ] + [ 0 -1 0 ] which is "improper" (determinant = -1). + [ 0 0 1 ] + + If we set qfac=-1, then the R matrix would be + + [ 1 0 0 ] + [ 0 -1 0 ] which is proper. + [ 0 0 -1 ] + + This R matrix is represented by quaternion [a,b,c,d] = [0,1,0,0] + (which encodes a 180 degree rotation about the x-axis). + + METHOD 3 (used when sform_code > 0): + ----------------------------------- + The (x,y,z) coordinates are given by a general affine transformation + of the (i,j,k) indexes: + + x = srow_x[0] * i + srow_x[1] * j + srow_x[2] * k + srow_x[3] + y = srow_y[0] * i + srow_y[1] * j + srow_y[2] * k + srow_y[3] + z = srow_z[0] * i + srow_z[1] * j + srow_z[2] * k + srow_z[3] + + The srow_* vectors are in the NIFTI_1 header. Note that no use is + made of pixdim[] in this method. + + WHY 3 METHODS? + -------------- + Method 1 is provided only for backwards compatibility. The intention + is that Method 2 (qform_code > 0) represents the nominal voxel locations + as reported by the scanner, or as rotated to some fiducial orientation and + location. Method 3, if present (sform_code > 0), is to be used to give + the location of the voxels in some standard space. The sform_code + indicates which standard space is present. Both methods 2 and 3 can be + present, and be useful in different contexts (method 2 for displaying the + data on its original grid; method 3 for displaying it on a standard grid). + + In this scheme, a dataset would originally be set up so that the + Method 2 coordinates represent what the scanner reported. Later, + a registration to some standard space can be computed and inserted + in the header. Image display software can use either transform, + depending on its purposes and needs. + + In Method 2, the origin of coordinates would generally be whatever + the scanner origin is; for example, in MRI, (0,0,0) is the center + of the gradient coil. + + In Method 3, the origin of coordinates would depend on the value + of sform_code; for example, for the Talairach coordinate system, + (0,0,0) corresponds to the Anterior Commissure. + + QUATERNION REPRESENTATION OF ROTATION MATRIX (METHOD 2) + ------------------------------------------------------- + The orientation of the (x,y,z) axes relative to the (i,j,k) axes + in 3D space is specified using a unit quaternion [a,b,c,d], where + a*a+b*b+c*c+d*d=1. The (b,c,d) values are all that is needed, since + we require that a = sqrt(1.0-b*b+c*c+d*d) be nonnegative. The (b,c,d) + values are stored in the (quatern_b,quatern_c,quatern_d) fields. + + The quaternion representation is chosen for its compactness in + representing rotations. The (proper) 3x3 rotation matrix that + corresponds to [a,b,c,d] is + + [ a*a+b*b-c*c-d*d 2*b*c-2*a*d 2*b*d+2*a*c ] + R = [ 2*b*c+2*a*d a*a+c*c-b*b-d*d 2*c*d-2*a*b ] + [ 2*b*d-2*a*c 2*c*d+2*a*b a*a+d*d-c*c-b*b ] + + [ R11 R12 R13 ] + = [ R21 R22 R23 ] + [ R31 R32 R33 ] + + If (p,q,r) is a unit 3-vector, then rotation of angle h about that + direction is represented by the quaternion + + [a,b,c,d] = [cos(h/2), p*sin(h/2), q*sin(h/2), r*sin(h/2)]. + + Requiring a >= 0 is equivalent to requiring -Pi <= h <= Pi. (Note that + [-a,-b,-c,-d] represents the same rotation as [a,b,c,d]; there are 2 + quaternions that can be used to represent a given rotation matrix R.) + To rotate a 3-vector (x,y,z) using quaternions, we compute the + quaternion product + + [0,x',y',z'] = [a,b,c,d] * [0,x,y,z] * [a,-b,-c,-d] + + which is equivalent to the matrix-vector multiply + + [ x' ] [ x ] + [ y' ] = R [ y ] (equivalence depends on a*a+b*b+c*c+d*d=1) + [ z' ] [ z ] + + Multiplication of 2 quaternions is defined by the following: + + [a,b,c,d] = a*1 + b*I + c*J + d*K + where + I*I = J*J = K*K = -1 (I,J,K are square roots of -1) + I*J = K J*K = I K*I = J + J*I = -K K*J = -I I*K = -J (not commutative!) + For example + [a,b,0,0] * [0,0,0,1] = [0,-b,0,a] + since this expands to + (a+b*I)*(K) = (a*K+b*I*K) = (a*K-b*J). + + The above formula shows how to go from quaternion (b,c,d) to + rotation matrix and direction cosines. Conversely, given R, + we can compute the fields for the NIFTI-1 header by + + a = 0.5 * sqrt(1+R11+R22+R33) (not stored) + b = 0.25 * (R32-R23) / a => quatern_b + c = 0.25 * (R13-R31) / a => quatern_c + d = 0.25 * (R21-R12) / a => quatern_d + + If a=0 (a 180 degree rotation), alternative formulas are needed. + See the nifti1_io.c function mat44_to_quatern() for an implementation + of the various cases in converting R to [a,b,c,d]. + + Note that R-transpose (= R-inverse) would lead to the quaternion + [a,-b,-c,-d]. + + The choice to specify the qoffset_x (etc.) values in the final + coordinate system is partly to make it easy to convert DICOM images to + this format. The DICOM attribute "Image Position (Patient)" (0020,0032) + stores the (Xd,Yd,Zd) coordinates of the center of the first voxel. + Here, (Xd,Yd,Zd) refer to DICOM coordinates, and Xd=-x, Yd=-y, Zd=z, + where (x,y,z) refers to the NIFTI coordinate system discussed above. + (i.e., DICOM +Xd is Left, +Yd is Posterior, +Zd is Superior, + whereas +x is Right, +y is Anterior , +z is Superior. ) + Thus, if the (0020,0032) DICOM attribute is extracted into (px,py,pz), then + qoffset_x = -px qoffset_y = -py qoffset_z = pz + is a reasonable setting when qform_code=NIFTI_XFORM_SCANNER_ANAT. + + That is, DICOM's coordinate system is 180 degrees rotated about the z-axis + from the neuroscience/NIFTI coordinate system. To transform between DICOM + and NIFTI, you just have to negate the x- and y-coordinates. + + The DICOM attribute (0020,0037) "Image Orientation (Patient)" gives the + orientation of the x- and y-axes of the image data in terms of 2 3-vectors. + The first vector is a unit vector along the x-axis, and the second is + along the y-axis. If the (0020,0037) attribute is extracted into the + value (xa,xb,xc,ya,yb,yc), then the first two columns of the R matrix + would be + [ -xa -ya ] + [ -xb -yb ] + [ xc yc ] + The negations are because DICOM's x- and y-axes are reversed relative + to NIFTI's. The third column of the R matrix gives the direction of + displacement (relative to the subject) along the slice-wise direction. + This orientation is not encoded in the DICOM standard in a simple way; + DICOM is mostly concerned with 2D images. The third column of R will be + either the cross-product of the first 2 columns or its negative. It is + possible to infer the sign of the 3rd column by examining the coordinates + in DICOM attribute (0020,0032) "Image Position (Patient)" for successive + slices. However, this method occasionally fails for reasons that I + (RW Cox) do not understand. +-----------------------------------------------------------------------------*/ + + /* [qs]form_code value: */ /* x,y,z coordinate system refers to: */ + /*-----------------------*/ /*---------------------------------------*/ + + /*! Arbitrary coordinates (Method 1). */ + +#define NIFTI_XFORM_UNKNOWN 0 + + /*! Scanner-based anatomical coordinates */ + +#define NIFTI_XFORM_SCANNER_ANAT 1 + + /*! Coordinates aligned to another file's, + or to anatomical "truth". */ + +#define NIFTI_XFORM_ALIGNED_ANAT 2 + + /*! Coordinates aligned to Talairach- + Tournoux Atlas; (0,0,0)=AC, etc. */ + +#define NIFTI_XFORM_TALAIRACH 3 + + /*! MNI 152 normalized coordinates. */ + +#define NIFTI_XFORM_MNI_152 4 + +/*---------------------------------------------------------------------------*/ +/* UNITS OF SPATIAL AND TEMPORAL DIMENSIONS: + ---------------------------------------- + The codes below can be used in xyzt_units to indicate the units of pixdim. + As noted earlier, dimensions 1,2,3 are for x,y,z; dimension 4 is for + time (t). + - If dim[4]=1 or dim[0] < 4, there is no time axis. + - A single time series (no space) would be specified with + - dim[0] = 4 (for scalar data) or dim[0] = 5 (for vector data) + - dim[1] = dim[2] = dim[3] = 1 + - dim[4] = number of time points + - pixdim[4] = time step + - xyzt_units indicates units of pixdim[4] + - dim[5] = number of values stored at each time point + + Bits 0..2 of xyzt_units specify the units of pixdim[1..3] + (e.g., spatial units are values 1..7). + Bits 3..5 of xyzt_units specify the units of pixdim[4] + (e.g., temporal units are multiples of 8). + + This compression of 2 distinct concepts into 1 byte is due to the + limited space available in the 348 byte ANALYZE 7.5 header. The + macros XYZT_TO_SPACE and XYZT_TO_TIME can be used to mask off the + undesired bits from the xyzt_units fields, leaving "pure" space + and time codes. Inversely, the macro SPACE_TIME_TO_XYZT can be + used to assemble a space code (0,1,2,...,7) with a time code + (0,8,16,32,...,56) into the combined value for xyzt_units. + + Note that codes are provided to indicate the "time" axis units are + actually frequency in Hertz (_HZ) or in part-per-million (_PPM). + + The toffset field can be used to indicate a nonzero start point for + the time axis. That is, time point #m is at t=toffset+m*pixdim[4] + for m=0..dim[4]-1. +-----------------------------------------------------------------------------*/ + + /*! NIFTI code for unspecified units. */ +#define NIFTI_UNITS_UNKNOWN 0 + + /** Space codes are multiples of 1. **/ + /*! NIFTI code for meters. */ +#define NIFTI_UNITS_METER 1 + /*! NIFTI code for millimeters. */ +#define NIFTI_UNITS_MM 2 + /*! NIFTI code for micrometers. */ +#define NIFTI_UNITS_MICRON 3 + + /** Time codes are multiples of 8. **/ + /*! NIFTI code for seconds. */ +#define NIFTI_UNITS_SEC 8 + /*! NIFTI code for milliseconds. */ +#define NIFTI_UNITS_MSEC 16 + /*! NIFTI code for microseconds. */ +#define NIFTI_UNITS_USEC 24 + + /*** These units are for spectral data: ***/ + /*! NIFTI code for Hertz. */ +#define NIFTI_UNITS_HZ 32 + /*! NIFTI code for ppm. */ +#define NIFTI_UNITS_PPM 40 + +#undef XYZT_TO_SPACE +#undef XYZT_TO_TIME +#define XYZT_TO_SPACE(xyzt) ( (xyzt) & 0x07 ) +#define XYZT_TO_TIME(xyzt) ( (xyzt) & 0x38 ) + +#undef SPACE_TIME_TO_XYZT +#define SPACE_TIME_TO_XYZT(ss,tt) ( (((char)(ss)) & 0x07) \ + | (((char)(tt)) & 0x38) ) + +/*---------------------------------------------------------------------------*/ +/* MRI-SPECIFIC SPATIAL AND TEMPORAL INFORMATION: + --------------------------------------------- + A few fields are provided to store some extra information + that is sometimes important when storing the image data + from an FMRI time series experiment. (After processing such + data into statistical images, these fields are not likely + to be useful.) + + { freq_dim } = These fields encode which spatial dimension (1,2, or 3) + { phase_dim } = corresponds to which acquisition dimension for MRI data. + { slice_dim } = + Examples: + Rectangular scan multi-slice EPI: + freq_dim = 1 phase_dim = 2 slice_dim = 3 (or some permutation) + Spiral scan multi-slice EPI: + freq_dim = phase_dim = 0 slice_dim = 3 + since the concepts of frequency- and phase-encoding directions + don't apply to spiral scan + + slice_duration = If this is positive, AND if slice_dim is nonzero, + indicates the amount of time used to acquire 1 slice. + slice_duration*dim[slice_dim] can be less than pixdim[4] + with a clustered acquisition method, for example. + + slice_code = If this is nonzero, AND if slice_dim is nonzero, AND + if slice_duration is positive, indicates the timing + pattern of the slice acquisition. The following codes + are defined: + NIFTI_SLICE_SEQ_INC + NIFTI_SLICE_SEQ_DEC + NIFTI_SLICE_ALT_INC + NIFTI_SLICE_ALT_DEC + { slice_start } = Indicates the start and end of the slice acquisition + { slice_end } = pattern, when slice_code is nonzero. These values + are present to allow for the possible addition of + "padded" slices at either end of the volume, which + don't fit into the slice timing pattern. If there + are no padding slices, then slice_start=0 and + slice_end=dim[slice_dim]-1 are the correct values. + For these values to be meaningful, slice_start must + be non-negative and slice_end must be greater than + slice_start. + + The following table indicates the slice timing pattern, relative to + time=0 for the first slice acquired, for some sample cases. Here, + dim[slice_dim]=7 (there are 7 slices, labeled 0..6), slice_duration=0.1, + and slice_start=1, slice_end=5 (1 padded slice on each end). + + slice + index SEQ_INC SEQ_DEC ALT_INC ALT_DEC + 6 -- n/a n/a n/a n/a n/a = not applicable + 5 -- 0.4 0.0 0.2 0.0 (slice time offset + 4 -- 0.3 0.1 0.4 0.3 doesn't apply to + 3 -- 0.2 0.2 0.1 0.1 slices outside range + 2 -- 0.1 0.3 0.3 0.4 slice_start..slice_end) + 1 -- 0.0 0.4 0.0 0.2 + 0 -- n/a n/a n/a n/a + + The fields freq_dim, phase_dim, slice_dim are all squished into the single + byte field dim_info (2 bits each, since the values for each field are + limited to the range 0..3). This unpleasantness is due to lack of space + in the 348 byte allowance. + + The macros DIM_INFO_TO_FREQ_DIM, DIM_INFO_TO_PHASE_DIM, and + DIM_INFO_TO_SLICE_DIM can be used to extract these values from the + dim_info byte. + + The macro FPS_INTO_DIM_INFO can be used to put these 3 values + into the dim_info byte. +-----------------------------------------------------------------------------*/ + +#undef DIM_INFO_TO_FREQ_DIM +#undef DIM_INFO_TO_PHASE_DIM +#undef DIM_INFO_TO_SLICE_DIM + +#define DIM_INFO_TO_FREQ_DIM(di) ( ((di) ) & 0x03 ) +#define DIM_INFO_TO_PHASE_DIM(di) ( ((di) >> 2) & 0x03 ) +#define DIM_INFO_TO_SLICE_DIM(di) ( ((di) >> 4) & 0x03 ) + +#undef FPS_INTO_DIM_INFO +#define FPS_INTO_DIM_INFO(fd,pd,sd) ( ( ( ((char)(fd)) & 0x03) ) | \ + ( ( ((char)(pd)) & 0x03) << 2 ) | \ + ( ( ((char)(sd)) & 0x03) << 4 ) ) + +#define NIFTI_SLICE_SEQ_INC 1 +#define NIFTI_SLICE_SEQ_DEC 2 +#define NIFTI_SLICE_ALT_INC 3 +#define NIFTI_SLICE_ALT_DEC 4 + +/*---------------------------------------------------------------------------*/ +/* UNUSED FIELDS: + ------------- + Some of the ANALYZE 7.5 fields marked as ++UNUSED++ may need to be set + to particular values for compatibility with other programs. The issue + of interoperability of ANALYZE 7.5 files is a murky one -- not all + programs require exactly the same set of fields. (Unobscuring this + murkiness is a principal motivation behind NIFTI-1.) + + Some of the fields that may need to be set for other (non-NIFTI aware) + software to be happy are: + + extents dbh.h says this should be 16384 + regular dbh.h says this should be the character 'r' + glmin, } dbh.h says these values should be the min and max voxel + glmax } values for the entire dataset + + It is best to initialize ALL fields in the NIFTI-1 header to 0 + (e.g., with calloc()), then fill in what is needed. +-----------------------------------------------------------------------------*/ + +/*---------------------------------------------------------------------------*/ +/* MISCELLANEOUS C MACROS +-----------------------------------------------------------------------------*/ + +/*.................*/ +/*! Given a nifti_1_header struct, check if it has a good magic number. + Returns NIFTI version number (1..9) if magic is good, 0 if it is not. */ + +#define NIFTI_VERSION(h) \ + ( ( (h).magic[0]=='n' && (h).magic[3]=='\0' && \ + ( (h).magic[1]=='i' || (h).magic[1]=='+' ) && \ + ( (h).magic[2]>='1' && (h).magic[2]<='9' ) ) \ + ? (h).magic[2]-'0' : 0 ) + +/*.................*/ +/*! Check if a nifti_1_header struct says if the data is stored in the + same file or in a separate file. Returns 1 if the data is in the same + file as the header, 0 if it is not. */ + +#define NIFTI_ONEFILE(h) ( (h).magic[1] == '+' ) + +/*.................*/ +/*! Check if a nifti_1_header struct needs to be byte swapped. + Returns 1 if it needs to be swapped, 0 if it does not. */ + +#define NIFTI_NEEDS_SWAP(h) ( (h).dim[0] < 0 || (h).dim[0] > 7 ) + +/*.................*/ +/*! Check if a nifti_1_header struct contains a 5th (vector) dimension. + Returns size of 5th dimension if > 1, returns 0 otherwise. */ + +#define NIFTI_5TH_DIM(h) ( ((h).dim[0]>4 && (h).dim[5]>1) ? (h).dim[5] : 0 ) + +/*****************************************************************************/ + +/*=================*/ +#ifdef __cplusplus +} +#endif +/*=================*/ + +#endif /* _NIFTI_HEADER_ */ diff --git a/Toolboxes/spm12/@nifti/private/nifti1struc.m b/Toolboxes/spm12/@nifti/private/nifti1struc.m new file mode 100644 index 0000000000000000000000000000000000000000..3ff0184b6d3e0c34a5dd24d0265f0824c344d1e0 --- /dev/null +++ b/Toolboxes/spm12/@nifti/private/nifti1struc.m @@ -0,0 +1,81 @@ +function o = nifti1struc +% Create a data structure describing NIFTI-1 headers +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: nifti1struc.m 7147 2017-08-03 14:07:01Z spm $ + + +persistent org; +if ~isempty(org) + o = org; + return; +end +t = struct('conv',{ @char , @uint8 , @int16 , @int32 , @single },... + 'prec',{'uint8', 'uint8', 'int16', 'int32', 'single'},... + 'size',{ 1, 1, 2, 4, 4 }); +c = t(1); +b = t(2); +s = t(3); +i = t(4); +f = t(5); + +table = {... + i, 1, 'sizeof_hdr', 348 + c, 10, 'data_type', '' + c, 18, 'db_name', '' + i, 1, 'extents', [] + s, 1, 'session_error', [] + c, 1, 'regular', 'r' + b, 1, 'dim_info', [] + s, 8, 'dim', [3 0 0 0 1 1 1 1] + f, 1, 'intent_p1', 0 + f, 1, 'intent_p2', 0 + f, 1, 'intent_p3', 0 + s, 1, 'intent_code', 0 + s, 1, 'datatype', 2 + s, 1, 'bitpix', 8 + s, 1, 'slice_start', [] + f, 8, 'pixdim', [0 1 1 1] + f, 1, 'vox_offset', 0 + f, 1, 'scl_slope', 1 + f, 1, 'scl_inter', 0 + s, 1, 'slice_end', [] + b, 1, 'slice_code', [] + b, 1, 'xyzt_units', 10 + f, 1, 'cal_max', [] + f, 1, 'cal_min', [] + f, 1, 'slice_duration', [] + f, 1, 'toffset', [] + i, 1, 'glmax', [] + i, 1, 'glmin', [] + c, 80, 'descrip', 'NIFTI-1 Image' + c, 24, 'aux_file', '' + s, 1, 'qform_code', 0 + s, 1, 'sform_code', 0 + f, 1, 'quatern_b', 0 + f, 1, 'quatern_c', 0 + f, 1, 'quatern_d', 0 + f, 1, 'qoffset_x', 0 + f, 1, 'qoffset_y', 0 + f, 1, 'qoffset_z', 0 + f, 4, 'srow_x', [1 0 0 0] + f, 4, 'srow_y', [0 1 0 0] + f, 4, 'srow_z', [0 0 1 0] + c, 16, 'intent_name', '' + c, 4, 'magic', 'ni1'}; + +org = struct('label',table(:,3),'dtype',table(:,1),'len',table(:,2),... + 'offset',0,'def',table(:,4)); +os = 0; +for j=1:length(org) + os = org(j).dtype.size*ceil(os/org(j).dtype.size); + fun = org(j).dtype.conv; + if ischar(org(j).def), z = char(0); else z = 0; end + def = [org(j).def repmat(z,1,org(j).len-length(org(j).def))]; + org(j).def = feval(fun,def); + org(j).offset = os; + os = os + org(j).len*org(j).dtype.size; +end +o = org; diff --git a/Toolboxes/spm12/@nifti/private/nifti2struc.m b/Toolboxes/spm12/@nifti/private/nifti2struc.m new file mode 100644 index 0000000000000000000000000000000000000000..9a6aa417c8e6536867babbcd5b397460d277bbad --- /dev/null +++ b/Toolboxes/spm12/@nifti/private/nifti2struc.m @@ -0,0 +1,79 @@ +function o = nifti2struc +% Create a data structure describing NIFTI-2 headers +%__________________________________________________________________________ +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: nifti2struc.m 7147 2017-08-03 14:07:01Z spm $ + + +persistent org; +if ~isempty(org) + o = org; + return; +end +t = struct(... + 'conv',{@char , @uint8 , @int16 , @int32 , @int64 , @single , @double },... + 'prec',{'uint8', 'uint8', 'int16', 'int32', 'int64', 'single', 'double'},... + 'size',{ 1 , 1 , 2 , 4 , 8 , 4 , 8 }); +c = t(1); +b = t(2); +s = t(3); +i = t(4); +l = t(5); +f = t(6); +d = t(7); + +table = {... + i, 1, 'sizeof_hdr', 540 + c, 8, 'magic', ['ni2' char(0) sprintf('\r\n\032\n')] + s, 1, 'datatype', 2 + s, 1, 'bitpix', 8 + l, 8, 'dim', [3 0 0 0 1 1 1 1] + d, 1, 'intent_p1', 0 + d, 1, 'intent_p2', 0 + d, 1, 'intent_p3', 0 + d, 8, 'pixdim', [0 1 1 1] + l, 1, 'vox_offset', 0 + d, 1, 'scl_slope', 1 + d, 1, 'scl_inter', 0 + d, 1, 'cal_max', [] + d, 1, 'cal_min', [] + d, 1, 'slice_duration', [] + d, 1, 'toffset', [] + l, 1, 'slice_start', [] + l, 1, 'slice_end', [] + c, 80, 'descrip', 'NIFTI-2 Image' + c, 24, 'aux_file', '' + i, 1, 'qform_code', 0 + i, 1, 'sform_code', 0 + d, 1, 'quatern_b', 0 + d, 1, 'quatern_c', 0 + d, 1, 'quatern_d', 0 + d, 1, 'qoffset_x', 0 + d, 1, 'qoffset_y', 0 + d, 1, 'qoffset_z', 0 + d, 4, 'srow_x', [1 0 0 0] + d, 4, 'srow_y', [0 1 0 0] + d, 4, 'srow_z', [0 0 1 0] + i, 1, 'slice_code', [] + i, 1, 'xyzt_units', 10 + i, 1, 'intent_code', 0 + c, 16, 'intent_name', '' + b, 1, 'dim_info', [] + c, 15, 'unused_str', ''}; + + +org = struct('label',table(:,3),'dtype',table(:,1),'len',table(:,2),... + 'offset',0,'def',table(:,4)); +os = 0; +for j=1:length(org) + os = org(j).dtype.size*ceil(os/org(j).dtype.size); + fun = org(j).dtype.conv; + if ischar(org(j).def), z = char(0); else z = 0; end + def = [org(j).def repmat(z,1,org(j).len-length(org(j).def))]; + org(j).def = feval(fun,def); + org(j).offset = os; + os = os + org(j).len*org(j).dtype.size; +end +o = org; diff --git a/Toolboxes/spm12/@nifti/private/nifti_stats.c b/Toolboxes/spm12/@nifti/private/nifti_stats.c new file mode 100644 index 0000000000000000000000000000000000000000..a099c18a36c61298093beed717bff051d739a72b --- /dev/null +++ b/Toolboxes/spm12/@nifti/private/nifti_stats.c @@ -0,0 +1,11277 @@ +#ifndef lint +static char sccsid[] = "%W% R.W. Cox %E%"; +#endif + /************************************************************************/ + /** Functions to compute cumulative distributions and their inverses **/ + /** for the NIfTI-1 statistical types. Much of this code is taken **/ + /** from other sources. In particular, the cdflib functions by **/ + /** Brown and Lovato make up the bulk of this file. That code **/ + /** was placed in the public domain. The code by K. Krishnamoorthy **/ + /** is also released for unrestricted use. Finally, the other parts **/ + /** of this file (by RW Cox) are released to the public domain. **/ + /** **/ + /** Most of this file comprises a set of "static" functions, to be **/ + /** called by the user-level functions at the very end of the file. **/ + /** At the end of the file is a simple main program to drive these **/ + /** functions. **/ + /** **/ + /** To find the user-level functions, search forward for the string **/ + /** "nifti_", which will be at about line 11000. **/ + /************************************************************************/ + /*****==============================================================*****/ + /***** Neither the National Institutes of Health (NIH), the DFWG, *****/ + /***** nor any of the members or employees of these institutions *****/ + /***** imply any warranty of usefulness of this material for any *****/ + /***** purpose, and do not assume any liability for damages, *****/ + /***** incidental or otherwise, caused by any use of this document. *****/ + /***** If these conditions are not acceptable, do not use this! *****/ + /*****==============================================================*****/ + /************************************************************************/ + + /*....................................................................... + To compile with gcc, for example: + + gcc -O3 -ffast-math -o nifti_stats nifti_stats.c -lm + ........................................................................*/ + +#include "nifti1.h" /* for the NIFTI_INTENT_* constants */ +#include +#include +#include + + /************************************************************************/ + /************ Include all the cdflib functions here and now *************/ + /************ [about 9900 lines of code below here] *************/ + /************************************************************************/ + +/** Prototypes for cdflib functions **/ + +static double algdiv(double*,double*); +static double alngam(double*); +static double alnrel(double*); +static double apser(double*,double*,double*,double*); +static double basym(double*,double*,double*,double*); +static double bcorr(double*,double*); +static double betaln(double*,double*); +static double bfrac(double*,double*,double*,double*,double*,double*); +static void bgrat(double*,double*,double*,double*,double*,double*,int*i); +static double bpser(double*,double*,double*,double*); +static void bratio(double*,double*,double*,double*,double*,double*,int*); +static double brcmp1(int*,double*,double*,double*,double*); +static double brcomp(double*,double*,double*,double*); +static double bup(double*,double*,double*,double*,int*,double*); +static void cdfbet(int*,double*,double*,double*,double*,double*,double*, + int*,double*); +static void cdfbin(int*,double*,double*,double*,double*,double*,double*, + int*,double*); +static void cdfchi(int*,double*,double*,double*,double*,int*,double*); +static void cdfchn(int*,double*,double*,double*,double*,double*,int*,double*); +static void cdff(int*,double*,double*,double*,double*,double*,int*,double*); +static void cdffnc(int*,double*,double*,double*,double*,double*,double*, + int*s,double*); +static void cdfgam(int*,double*,double*,double*,double*,double*,int*,double*); +static void cdfnbn(int*,double*,double*,double*,double*,double*,double*, + int*,double*); +static void cdfnor(int*,double*,double*,double*,double*,double*,int*,double*); +static void cdfpoi(int*,double*,double*,double*,double*,int*,double*); +static void cdft(int*,double*,double*,double*,double*,int*,double*); +static void cumbet(double*,double*,double*,double*,double*,double*); +static void cumbin(double*,double*,double*,double*,double*,double*); +static void cumchi(double*,double*,double*,double*); +static void cumchn(double*,double*,double*,double*,double*); +static void cumf(double*,double*,double*,double*,double*); +static void cumfnc(double*,double*,double*,double*,double*,double*); +static void cumgam(double*,double*,double*,double*); +static void cumnbn(double*,double*,double*,double*,double*,double*); +static void cumnor(double*,double*,double*); +static void cumpoi(double*,double*,double*,double*); +static void cumt(double*,double*,double*,double*); +static double dbetrm(double*,double*); +static double devlpl(double [],int*,double*); +static double dexpm1(double*); +static double dinvnr(double *p,double *q); +static void E0000(int,int*,double*,double*,unsigned long*, + unsigned long*,double*,double*,double*, + double*,double*,double*,double*); +static void dinvr(int*,double*,double*,unsigned long*,unsigned long*); +static void dstinv(double*,double*,double*,double*,double*,double*, + double*); +static double dlanor(double*); +static double dln1mx(double*); +static double dln1px(double*); +static double dlnbet(double*,double*); +static double dlngam(double*); +static double dstrem(double*); +static double dt1(double*,double*,double*); +static void E0001(int,int*,double*,double*,double*,double*, + unsigned long*,unsigned long*,double*,double*, + double*,double*); +static void dzror(int*,double*,double*,double*,double *, + unsigned long*,unsigned long*); +static void dstzr(double *zxlo,double *zxhi,double *zabstl,double *zreltl); +static double erf1(double*); +static double erfc1(int*,double*); +static double esum(int*,double*); +static double exparg(int*); +static double fpser(double*,double*,double*,double*); +static double gam1(double*); +static void gaminv(double*,double*,double*,double*,double*,int*); +static double gamln(double*); +static double gamln1(double*); +static double Xgamm(double*); +static void grat1(double*,double*,double*,double*,double*,double*); +static void gratio(double*,double*,double*,double*,int*); +static double gsumln(double*,double*); +static double psi(double*); +static double rcomp(double*,double*); +static double rexp(double*); +static double rlog(double*); +static double rlog1(double*); +static double spmpar(int*); +static double stvaln(double*); +static double fifdint(double); +static double fifdmax1(double,double); +static double fifdmin1(double,double); +static double fifdsign(double,double); +static long fifidint(double); +static long fifmod(long,long); +static void ftnstop(char*); +static int ipmpar(int*); + +/***=====================================================================***/ +static double algdiv(double *a,double *b) +/* +----------------------------------------------------------------------- + + COMPUTATION OF LN(GAMMA(B)/GAMMA(A+B)) WHEN B .GE. 8 + + -------- + + IN THIS ALGORITHM, DEL(X) IS THE FUNCTION DEFINED BY + LN(GAMMA(X)) = (X - 0.5)*LN(X) - X + 0.5*LN(2*PI) + DEL(X). + +----------------------------------------------------------------------- +*/ +{ +static double c0 = .833333333333333e-01; +static double c1 = -.277777777760991e-02; +static double c2 = .793650666825390e-03; +static double c3 = -.595202931351870e-03; +static double c4 = .837308034031215e-03; +static double c5 = -.165322962780713e-02; +static double algdiv,c,d,h,s11,s3,s5,s7,s9,t,u,v,w,x,x2,T1; +/* + .. + .. Executable Statements .. +*/ + if(*a <= *b) goto S10; + h = *b/ *a; + c = 1.0e0/(1.0e0+h); + x = h/(1.0e0+h); + d = *a+(*b-0.5e0); + goto S20; +S10: + h = *a/ *b; + c = h/(1.0e0+h); + x = 1.0e0/(1.0e0+h); + d = *b+(*a-0.5e0); +S20: +/* + SET SN = (1 - X**N)/(1 - X) +*/ + x2 = x*x; + s3 = 1.0e0+(x+x2); + s5 = 1.0e0+(x+x2*s3); + s7 = 1.0e0+(x+x2*s5); + s9 = 1.0e0+(x+x2*s7); + s11 = 1.0e0+(x+x2*s9); +/* + SET W = DEL(B) - DEL(A + B) +*/ + t = pow(1.0e0/ *b,2.0); + w = ((((c5*s11*t+c4*s9)*t+c3*s7)*t+c2*s5)*t+c1*s3)*t+c0; + w *= (c/ *b); +/* + COMBINE THE RESULTS +*/ + T1 = *a/ *b; + u = d*alnrel(&T1); + v = *a*(log(*b)-1.0e0); + if(u <= v) goto S30; + algdiv = w-v-u; + return algdiv; +S30: + algdiv = w-u-v; + return algdiv; +} /* END */ + +/***=====================================================================***/ +static double alngam(double *x) +/* +********************************************************************** + + double alngam(double *x) + double precision LN of the GAMma function + + + Function + + + Returns the natural logarithm of GAMMA(X). + + + Arguments + + + X --> value at which scaled log gamma is to be returned + X is DOUBLE PRECISION + + + Method + + + If X .le. 6.0, then use recursion to get X below 3 + then apply rational approximation number 5236 of + Hart et al, Computer Approximations, John Wiley and + Sons, NY, 1968. + + If X .gt. 6.0, then use recursion to get X to at least 12 and + then use formula 5423 of the same source. + +********************************************************************** +*/ +{ +#define hln2pi 0.91893853320467274178e0 +static double coef[5] = { + 0.83333333333333023564e-1,-0.27777777768818808e-2,0.79365006754279e-3, + -0.594997310889e-3,0.8065880899e-3 +}; +static double scoefd[4] = { + 0.62003838007126989331e2,0.9822521104713994894e1,-0.8906016659497461257e1, + 0.1000000000000000000e1 +}; +static double scoefn[9] = { + 0.62003838007127258804e2,0.36036772530024836321e2,0.20782472531792126786e2, + 0.6338067999387272343e1,0.215994312846059073e1,0.3980671310203570498e0, + 0.1093115956710439502e0,0.92381945590275995e-2,0.29737866448101651e-2 +}; +static int K1 = 9; +static int K3 = 4; +static int K5 = 5; +static double alngam,offset,prod,xx; +static int i,n; +static double T2,T4,T6; +/* + .. + .. Executable Statements .. +*/ + if(!(*x <= 6.0e0)) goto S70; + prod = 1.0e0; + xx = *x; + if(!(*x > 3.0e0)) goto S30; +S10: + if(!(xx > 3.0e0)) goto S20; + xx -= 1.0e0; + prod *= xx; + goto S10; +S30: +S20: + if(!(*x < 2.0e0)) goto S60; +S40: + if(!(xx < 2.0e0)) goto S50; + prod /= xx; + xx += 1.0e0; + goto S40; +S60: +S50: + T2 = xx-2.0e0; + T4 = xx-2.0e0; + alngam = devlpl(scoefn,&K1,&T2)/devlpl(scoefd,&K3,&T4); +/* + COMPUTE RATIONAL APPROXIMATION TO GAMMA(X) +*/ + alngam *= prod; + alngam = log(alngam); + goto S110; +S70: + offset = hln2pi; +/* + IF NECESSARY MAKE X AT LEAST 12 AND CARRY CORRECTION IN OFFSET +*/ + n = fifidint(12.0e0-*x); + if(!(n > 0)) goto S90; + prod = 1.0e0; + for(i=1; i<=n; i++) prod *= (*x+(double)(i-1)); + offset -= log(prod); + xx = *x+(double)n; + goto S100; +S90: + xx = *x; +S100: +/* + COMPUTE POWER SERIES +*/ + T6 = 1.0e0/pow(xx,2.0); + alngam = devlpl(coef,&K5,&T6)/xx; + alngam += (offset+(xx-0.5e0)*log(xx)-xx); +S110: + return alngam; +#undef hln2pi +} /* END */ + +/***=====================================================================***/ +static double alnrel(double *a) +/* +----------------------------------------------------------------------- + EVALUATION OF THE FUNCTION LN(1 + A) +----------------------------------------------------------------------- +*/ +{ +static double p1 = -.129418923021993e+01; +static double p2 = .405303492862024e+00; +static double p3 = -.178874546012214e-01; +static double q1 = -.162752256355323e+01; +static double q2 = .747811014037616e+00; +static double q3 = -.845104217945565e-01; +static double alnrel,t,t2,w,x; +/* + .. + .. Executable Statements .. +*/ + if(fabs(*a) > 0.375e0) goto S10; + t = *a/(*a+2.0e0); + t2 = t*t; + w = (((p3*t2+p2)*t2+p1)*t2+1.0e0)/(((q3*t2+q2)*t2+q1)*t2+1.0e0); + alnrel = 2.0e0*t*w; + return alnrel; +S10: + x = 1.e0+*a; + alnrel = log(x); + return alnrel; +} /* END */ + +/***=====================================================================***/ +static double apser(double *a,double *b,double *x,double *eps) +/* +----------------------------------------------------------------------- + APSER YIELDS THE INCOMPLETE BETA RATIO I(SUB(1-X))(B,A) FOR + A .LE. MIN(EPS,EPS*B), B*X .LE. 1, AND X .LE. 0.5. USED WHEN + A IS VERY SMALL. USE ONLY IF ABOVE INEQUALITIES ARE SATISFIED. +----------------------------------------------------------------------- +*/ +{ +static double g = .577215664901533e0; +static double apser,aj,bx,c,j,s,t,tol; +/* + .. + .. Executable Statements .. +*/ + bx = *b**x; + t = *x-bx; + if(*b**eps > 2.e-2) goto S10; + c = log(*x)+psi(b)+g+t; + goto S20; +S10: + c = log(bx)+g+t; +S20: + tol = 5.0e0**eps*fabs(c); + j = 1.0e0; + s = 0.0e0; +S30: + j += 1.0e0; + t *= (*x-bx/j); + aj = t/j; + s += aj; + if(fabs(aj) > tol) goto S30; + apser = -(*a*(c+s)); + return apser; +} /* END */ + +/***=====================================================================***/ +static double basym(double *a,double *b,double *lambda,double *eps) +/* +----------------------------------------------------------------------- + ASYMPTOTIC EXPANSION FOR IX(A,B) FOR LARGE A AND B. + LAMBDA = (A + B)*Y - B AND EPS IS THE TOLERANCE USED. + IT IS ASSUMED THAT LAMBDA IS NONNEGATIVE AND THAT + A AND B ARE GREATER THAN OR EQUAL TO 15. +----------------------------------------------------------------------- +*/ +{ +static double e0 = 1.12837916709551e0; +static double e1 = .353553390593274e0; +static int num = 20; +/* +------------------------ + ****** NUM IS THE MAXIMUM VALUE THAT N CAN TAKE IN THE DO LOOP + ENDING AT STATEMENT 50. IT IS REQUIRED THAT NUM BE EVEN. + THE ARRAYS A0, B0, C, D HAVE DIMENSION NUM + 1. +------------------------ + E0 = 2/SQRT(PI) + E1 = 2**(-3/2) +------------------------ +*/ +static int K3 = 1; +static double basym,bsum,dsum,f,h,h2,hn,j0,j1,r,r0,r1,s,sum,t,t0,t1,u,w,w0,z,z0, + z2,zn,znm1; +static int i,im1,imj,j,m,mm1,mmj,n,np1; +static double a0[21],b0[21],c[21],d[21],T1,T2; +/* + .. + .. Executable Statements .. +*/ + basym = 0.0e0; + if(*a >= *b) goto S10; + h = *a/ *b; + r0 = 1.0e0/(1.0e0+h); + r1 = (*b-*a)/ *b; + w0 = 1.0e0/sqrt(*a*(1.0e0+h)); + goto S20; +S10: + h = *b/ *a; + r0 = 1.0e0/(1.0e0+h); + r1 = (*b-*a)/ *a; + w0 = 1.0e0/sqrt(*b*(1.0e0+h)); +S20: + T1 = -(*lambda/ *a); + T2 = *lambda/ *b; + f = *a*rlog1(&T1)+*b*rlog1(&T2); + t = exp(-f); + if(t == 0.0e0) return basym; + z0 = sqrt(f); + z = 0.5e0*(z0/e1); + z2 = f+f; + a0[0] = 2.0e0/3.0e0*r1; + c[0] = -(0.5e0*a0[0]); + d[0] = -c[0]; + j0 = 0.5e0/e0*erfc1(&K3,&z0); + j1 = e1; + sum = j0+d[0]*w0*j1; + s = 1.0e0; + h2 = h*h; + hn = 1.0e0; + w = w0; + znm1 = z; + zn = z2; + for(n=2; n<=num; n+=2) { + hn = h2*hn; + a0[n-1] = 2.0e0*r0*(1.0e0+h*hn)/((double)n+2.0e0); + np1 = n+1; + s += hn; + a0[np1-1] = 2.0e0*r1*s/((double)n+3.0e0); + for(i=n; i<=np1; i++) { + r = -(0.5e0*((double)i+1.0e0)); + b0[0] = r*a0[0]; + for(m=2; m<=i; m++) { + bsum = 0.0e0; + mm1 = m-1; + for(j=1; j<=mm1; j++) { + mmj = m-j; + bsum += (((double)j*r-(double)mmj)*a0[j-1]*b0[mmj-1]); + } + b0[m-1] = r*a0[m-1]+bsum/(double)m; + } + c[i-1] = b0[i-1]/((double)i+1.0e0); + dsum = 0.0e0; + im1 = i-1; + for(j=1; j<=im1; j++) { + imj = i-j; + dsum += (d[imj-1]*c[j-1]); + } + d[i-1] = -(dsum+c[i-1]); + } + j0 = e1*znm1+((double)n-1.0e0)*j0; + j1 = e1*zn+(double)n*j1; + znm1 = z2*znm1; + zn = z2*zn; + w = w0*w; + t0 = d[n-1]*w*j0; + w = w0*w; + t1 = d[np1-1]*w*j1; + sum += (t0+t1); + if(fabs(t0)+fabs(t1) <= *eps*sum) goto S80; + } +S80: + u = exp(-bcorr(a,b)); + basym = e0*t*u*sum; + return basym; +} /* END */ + +/***=====================================================================***/ +static double bcorr(double *a0,double *b0) +/* +----------------------------------------------------------------------- + + EVALUATION OF DEL(A0) + DEL(B0) - DEL(A0 + B0) WHERE + LN(GAMMA(A)) = (A - 0.5)*LN(A) - A + 0.5*LN(2*PI) + DEL(A). + IT IS ASSUMED THAT A0 .GE. 8 AND B0 .GE. 8. + +----------------------------------------------------------------------- +*/ +{ +static double c0 = .833333333333333e-01; +static double c1 = -.277777777760991e-02; +static double c2 = .793650666825390e-03; +static double c3 = -.595202931351870e-03; +static double c4 = .837308034031215e-03; +static double c5 = -.165322962780713e-02; +static double bcorr,a,b,c,h,s11,s3,s5,s7,s9,t,w,x,x2; +/* + .. + .. Executable Statements .. +*/ + a = fifdmin1(*a0,*b0); + b = fifdmax1(*a0,*b0); + h = a/b; + c = h/(1.0e0+h); + x = 1.0e0/(1.0e0+h); + x2 = x*x; +/* + SET SN = (1 - X**N)/(1 - X) +*/ + s3 = 1.0e0+(x+x2); + s5 = 1.0e0+(x+x2*s3); + s7 = 1.0e0+(x+x2*s5); + s9 = 1.0e0+(x+x2*s7); + s11 = 1.0e0+(x+x2*s9); +/* + SET W = DEL(B) - DEL(A + B) +*/ + t = pow(1.0e0/b,2.0); + w = ((((c5*s11*t+c4*s9)*t+c3*s7)*t+c2*s5)*t+c1*s3)*t+c0; + w *= (c/b); +/* + COMPUTE DEL(A) + W +*/ + t = pow(1.0e0/a,2.0); + bcorr = (((((c5*t+c4)*t+c3)*t+c2)*t+c1)*t+c0)/a+w; + return bcorr; +} /* END */ + +/***=====================================================================***/ +static double betaln(double *a0,double *b0) +/* +----------------------------------------------------------------------- + EVALUATION OF THE LOGARITHM OF THE BETA FUNCTION +----------------------------------------------------------------------- + E = 0.5*LN(2*PI) +-------------------------- +*/ +{ +static double e = .918938533204673e0; +static double betaln,a,b,c,h,u,v,w,z; +static int i,n; +static double T1; +/* + .. + .. Executable Statements .. +*/ + a = fifdmin1(*a0,*b0); + b = fifdmax1(*a0,*b0); + if(a >= 8.0e0) goto S100; + if(a >= 1.0e0) goto S20; +/* +----------------------------------------------------------------------- + PROCEDURE WHEN A .LT. 1 +----------------------------------------------------------------------- +*/ + if(b >= 8.0e0) goto S10; + T1 = a+b; + betaln = gamln(&a)+(gamln(&b)-gamln(&T1)); + return betaln; +S10: + betaln = gamln(&a)+algdiv(&a,&b); + return betaln; +S20: +/* +----------------------------------------------------------------------- + PROCEDURE WHEN 1 .LE. A .LT. 8 +----------------------------------------------------------------------- +*/ + if(a > 2.0e0) goto S40; + if(b > 2.0e0) goto S30; + betaln = gamln(&a)+gamln(&b)-gsumln(&a,&b); + return betaln; +S30: + w = 0.0e0; + if(b < 8.0e0) goto S60; + betaln = gamln(&a)+algdiv(&a,&b); + return betaln; +S40: +/* + REDUCTION OF A WHEN B .LE. 1000 +*/ + if(b > 1000.0e0) goto S80; + n = a-1.0e0; + w = 1.0e0; + for(i=1; i<=n; i++) { + a -= 1.0e0; + h = a/b; + w *= (h/(1.0e0+h)); + } + w = log(w); + if(b < 8.0e0) goto S60; + betaln = w+gamln(&a)+algdiv(&a,&b); + return betaln; +S60: +/* + REDUCTION OF B WHEN B .LT. 8 +*/ + n = b-1.0e0; + z = 1.0e0; + for(i=1; i<=n; i++) { + b -= 1.0e0; + z *= (b/(a+b)); + } + betaln = w+log(z)+(gamln(&a)+(gamln(&b)-gsumln(&a,&b))); + return betaln; +S80: +/* + REDUCTION OF A WHEN B .GT. 1000 +*/ + n = a-1.0e0; + w = 1.0e0; + for(i=1; i<=n; i++) { + a -= 1.0e0; + w *= (a/(1.0e0+a/b)); + } + betaln = log(w)-(double)n*log(b)+(gamln(&a)+algdiv(&a,&b)); + return betaln; +S100: +/* +----------------------------------------------------------------------- + PROCEDURE WHEN A .GE. 8 +----------------------------------------------------------------------- +*/ + w = bcorr(&a,&b); + h = a/b; + c = h/(1.0e0+h); + u = -((a-0.5e0)*log(c)); + v = b*alnrel(&h); + if(u <= v) goto S110; + betaln = -(0.5e0*log(b))+e+w-v-u; + return betaln; +S110: + betaln = -(0.5e0*log(b))+e+w-u-v; + return betaln; +} /* END */ + +/***=====================================================================***/ +static double bfrac(double *a,double *b,double *x,double *y,double *lambda, + double *eps) +/* +----------------------------------------------------------------------- + CONTINUED FRACTION EXPANSION FOR IX(A,B) WHEN A,B .GT. 1. + IT IS ASSUMED THAT LAMBDA = (A + B)*Y - B. +----------------------------------------------------------------------- +*/ +{ +static double bfrac,alpha,an,anp1,beta,bn,bnp1,c,c0,c1,e,n,p,r,r0,s,t,w,yp1; +/* + .. + .. Executable Statements .. +*/ + bfrac = brcomp(a,b,x,y); + if(bfrac == 0.0e0) return bfrac; + c = 1.0e0+*lambda; + c0 = *b/ *a; + c1 = 1.0e0+1.0e0/ *a; + yp1 = *y+1.0e0; + n = 0.0e0; + p = 1.0e0; + s = *a+1.0e0; + an = 0.0e0; + bn = anp1 = 1.0e0; + bnp1 = c/c1; + r = c1/c; +S10: +/* + CONTINUED FRACTION CALCULATION +*/ + n += 1.0e0; + t = n/ *a; + w = n*(*b-n)**x; + e = *a/s; + alpha = p*(p+c0)*e*e*(w**x); + e = (1.0e0+t)/(c1+t+t); + beta = n+w/s+e*(c+n*yp1); + p = 1.0e0+t; + s += 2.0e0; +/* + UPDATE AN, BN, ANP1, AND BNP1 +*/ + t = alpha*an+beta*anp1; + an = anp1; + anp1 = t; + t = alpha*bn+beta*bnp1; + bn = bnp1; + bnp1 = t; + r0 = r; + r = anp1/bnp1; + if(fabs(r-r0) <= *eps*r) goto S20; +/* + RESCALE AN, BN, ANP1, AND BNP1 +*/ + an /= bnp1; + bn /= bnp1; + anp1 = r; + bnp1 = 1.0e0; + goto S10; +S20: +/* + TERMINATION +*/ + bfrac *= r; + return bfrac; +} /* END */ + +/***=====================================================================***/ +static void bgrat(double *a,double *b,double *x,double *y,double *w, + double *eps,int *ierr) +/* +----------------------------------------------------------------------- + ASYMPTOTIC EXPANSION FOR IX(A,B) WHEN A IS LARGER THAN B. + THE RESULT OF THE EXPANSION IS ADDED TO W. IT IS ASSUMED + THAT A .GE. 15 AND B .LE. 1. EPS IS THE TOLERANCE USED. + IERR IS A VARIABLE THAT REPORTS THE STATUS OF THE RESULTS. +----------------------------------------------------------------------- +*/ +{ +static double bm1,bp2n,cn,coef,dj,j,l,lnx,n2,nu,p,q,r,s,sum,t,t2,u,v,z; +static int i,n,nm1; +static double c[30],d[30],T1; +/* + .. + .. Executable Statements .. +*/ + bm1 = *b-0.5e0-0.5e0; + nu = *a+0.5e0*bm1; + if(*y > 0.375e0) goto S10; + T1 = -*y; + lnx = alnrel(&T1); + goto S20; +S10: + lnx = log(*x); +S20: + z = -(nu*lnx); + if(*b*z == 0.0e0) goto S70; +/* + COMPUTATION OF THE EXPANSION + SET R = EXP(-Z)*Z**B/GAMMA(B) +*/ + r = *b*(1.0e0+gam1(b))*exp(*b*log(z)); + r *= (exp(*a*lnx)*exp(0.5e0*bm1*lnx)); + u = algdiv(b,a)+*b*log(nu); + u = r*exp(-u); + if(u == 0.0e0) goto S70; + grat1(b,&z,&r,&p,&q,eps); + v = 0.25e0*pow(1.0e0/nu,2.0); + t2 = 0.25e0*lnx*lnx; + l = *w/u; + j = q/r; + sum = j; + t = cn = 1.0e0; + n2 = 0.0e0; + for(n=1; n<=30; n++) { + bp2n = *b+n2; + j = (bp2n*(bp2n+1.0e0)*j+(z+bp2n+1.0e0)*t)*v; + n2 += 2.0e0; + t *= t2; + cn /= (n2*(n2+1.0e0)); + c[n-1] = cn; + s = 0.0e0; + if(n == 1) goto S40; + nm1 = n-1; + coef = *b-(double)n; + for(i=1; i<=nm1; i++) { + s += (coef*c[i-1]*d[n-i-1]); + coef += *b; + } +S40: + d[n-1] = bm1*cn+s/(double)n; + dj = d[n-1]*j; + sum += dj; + if(sum <= 0.0e0) goto S70; + if(fabs(dj) <= *eps*(sum+l)) goto S60; + } +S60: +/* + ADD THE RESULTS TO W +*/ + *ierr = 0; + *w += (u*sum); + return; +S70: +/* + THE EXPANSION CANNOT BE COMPUTED +*/ + *ierr = 1; + return; +} /* END */ + +/***=====================================================================***/ +static double bpser(double *a,double *b,double *x,double *eps) +/* +----------------------------------------------------------------------- + POWER SERIES EXPANSION FOR EVALUATING IX(A,B) WHEN B .LE. 1 + OR B*X .LE. 0.7. EPS IS THE TOLERANCE USED. +----------------------------------------------------------------------- +*/ +{ +static double bpser,a0,apb,b0,c,n,sum,t,tol,u,w,z; +static int i,m; +/* + .. + .. Executable Statements .. +*/ + bpser = 0.0e0; + if(*x == 0.0e0) return bpser; +/* +----------------------------------------------------------------------- + COMPUTE THE FACTOR X**A/(A*BETA(A,B)) +----------------------------------------------------------------------- +*/ + a0 = fifdmin1(*a,*b); + if(a0 < 1.0e0) goto S10; + z = *a*log(*x)-betaln(a,b); + bpser = exp(z)/ *a; + goto S100; +S10: + b0 = fifdmax1(*a,*b); + if(b0 >= 8.0e0) goto S90; + if(b0 > 1.0e0) goto S40; +/* + PROCEDURE FOR A0 .LT. 1 AND B0 .LE. 1 +*/ + bpser = pow(*x,*a); + if(bpser == 0.0e0) return bpser; + apb = *a+*b; + if(apb > 1.0e0) goto S20; + z = 1.0e0+gam1(&apb); + goto S30; +S20: + u = *a+*b-1.e0; + z = (1.0e0+gam1(&u))/apb; +S30: + c = (1.0e0+gam1(a))*(1.0e0+gam1(b))/z; + bpser *= (c*(*b/apb)); + goto S100; +S40: +/* + PROCEDURE FOR A0 .LT. 1 AND 1 .LT. B0 .LT. 8 +*/ + u = gamln1(&a0); + m = b0-1.0e0; + if(m < 1) goto S60; + c = 1.0e0; + for(i=1; i<=m; i++) { + b0 -= 1.0e0; + c *= (b0/(a0+b0)); + } + u = log(c)+u; +S60: + z = *a*log(*x)-u; + b0 -= 1.0e0; + apb = a0+b0; + if(apb > 1.0e0) goto S70; + t = 1.0e0+gam1(&apb); + goto S80; +S70: + u = a0+b0-1.e0; + t = (1.0e0+gam1(&u))/apb; +S80: + bpser = exp(z)*(a0/ *a)*(1.0e0+gam1(&b0))/t; + goto S100; +S90: +/* + PROCEDURE FOR A0 .LT. 1 AND B0 .GE. 8 +*/ + u = gamln1(&a0)+algdiv(&a0,&b0); + z = *a*log(*x)-u; + bpser = a0/ *a*exp(z); +S100: + if(bpser == 0.0e0 || *a <= 0.1e0**eps) return bpser; +/* +----------------------------------------------------------------------- + COMPUTE THE SERIES +----------------------------------------------------------------------- +*/ + sum = n = 0.0e0; + c = 1.0e0; + tol = *eps/ *a; +S110: + n += 1.0e0; + c *= ((0.5e0+(0.5e0-*b/n))**x); + w = c/(*a+n); + sum += w; + if(fabs(w) > tol) goto S110; + bpser *= (1.0e0+*a*sum); + return bpser; +} /* END */ + +/***=====================================================================***/ +static void bratio(double *a,double *b,double *x,double *y,double *w, + double *w1,int *ierr) +/* +----------------------------------------------------------------------- + + EVALUATION OF THE INCOMPLETE BETA FUNCTION IX(A,B) + + -------------------- + + IT IS ASSUMED THAT A AND B ARE NONNEGATIVE, AND THAT X .LE. 1 + AND Y = 1 - X. BRATIO ASSIGNS W AND W1 THE VALUES + + W = IX(A,B) + W1 = 1 - IX(A,B) + + IERR IS A VARIABLE THAT REPORTS THE STATUS OF THE RESULTS. + IF NO INPUT ERRORS ARE DETECTED THEN IERR IS SET TO 0 AND + W AND W1 ARE COMPUTED. OTHERWISE, IF AN ERROR IS DETECTED, + THEN W AND W1 ARE ASSIGNED THE VALUE 0 AND IERR IS SET TO + ONE OF THE FOLLOWING VALUES ... + + IERR = 1 IF A OR B IS NEGATIVE + IERR = 2 IF A = B = 0 + IERR = 3 IF X .LT. 0 OR X .GT. 1 + IERR = 4 IF Y .LT. 0 OR Y .GT. 1 + IERR = 5 IF X + Y .NE. 1 + IERR = 6 IF X = A = 0 + IERR = 7 IF Y = B = 0 + +-------------------- + WRITTEN BY ALFRED H. MORRIS, JR. + NAVAL SURFACE WARFARE CENTER + DAHLGREN, VIRGINIA + REVISED ... NOV 1991 +----------------------------------------------------------------------- +*/ +{ +static int K1 = 1; +static double a0,b0,eps,lambda,t,x0,y0,z; +static int ierr1,ind,n; +static double T2,T3,T4,T5; +/* + .. + .. Executable Statements .. +*/ +/* + ****** EPS IS A MACHINE DEPENDENT CONSTANT. EPS IS THE SMALLEST + FLOATING POINT NUMBER FOR WHICH 1.0 + EPS .GT. 1.0 +*/ + eps = spmpar(&K1); + *w = *w1 = 0.0e0; + if(*a < 0.0e0 || *b < 0.0e0) goto S270; + if(*a == 0.0e0 && *b == 0.0e0) goto S280; + if(*x < 0.0e0 || *x > 1.0e0) goto S290; + if(*y < 0.0e0 || *y > 1.0e0) goto S300; + z = *x+*y-0.5e0-0.5e0; + if(fabs(z) > 3.0e0*eps) goto S310; + *ierr = 0; + if(*x == 0.0e0) goto S210; + if(*y == 0.0e0) goto S230; + if(*a == 0.0e0) goto S240; + if(*b == 0.0e0) goto S220; + eps = fifdmax1(eps,1.e-15); + if(fifdmax1(*a,*b) < 1.e-3*eps) goto S260; + ind = 0; + a0 = *a; + b0 = *b; + x0 = *x; + y0 = *y; + if(fifdmin1(a0,b0) > 1.0e0) goto S40; +/* + PROCEDURE FOR A0 .LE. 1 OR B0 .LE. 1 +*/ + if(*x <= 0.5e0) goto S10; + ind = 1; + a0 = *b; + b0 = *a; + x0 = *y; + y0 = *x; +S10: + if(b0 < fifdmin1(eps,eps*a0)) goto S90; + if(a0 < fifdmin1(eps,eps*b0) && b0*x0 <= 1.0e0) goto S100; + if(fifdmax1(a0,b0) > 1.0e0) goto S20; + if(a0 >= fifdmin1(0.2e0,b0)) goto S110; + if(pow(x0,a0) <= 0.9e0) goto S110; + if(x0 >= 0.3e0) goto S120; + n = 20; + goto S140; +S20: + if(b0 <= 1.0e0) goto S110; + if(x0 >= 0.3e0) goto S120; + if(x0 >= 0.1e0) goto S30; + if(pow(x0*b0,a0) <= 0.7e0) goto S110; +S30: + if(b0 > 15.0e0) goto S150; + n = 20; + goto S140; +S40: +/* + PROCEDURE FOR A0 .GT. 1 AND B0 .GT. 1 +*/ + if(*a > *b) goto S50; + lambda = *a-(*a+*b)**x; + goto S60; +S50: + lambda = (*a+*b)**y-*b; +S60: + if(lambda >= 0.0e0) goto S70; + ind = 1; + a0 = *b; + b0 = *a; + x0 = *y; + y0 = *x; + lambda = fabs(lambda); +S70: + if(b0 < 40.0e0 && b0*x0 <= 0.7e0) goto S110; + if(b0 < 40.0e0) goto S160; + if(a0 > b0) goto S80; + if(a0 <= 100.0e0) goto S130; + if(lambda > 0.03e0*a0) goto S130; + goto S200; +S80: + if(b0 <= 100.0e0) goto S130; + if(lambda > 0.03e0*b0) goto S130; + goto S200; +S90: +/* + EVALUATION OF THE APPROPRIATE ALGORITHM +*/ + *w = fpser(&a0,&b0,&x0,&eps); + *w1 = 0.5e0+(0.5e0-*w); + goto S250; +S100: + *w1 = apser(&a0,&b0,&x0,&eps); + *w = 0.5e0+(0.5e0-*w1); + goto S250; +S110: + *w = bpser(&a0,&b0,&x0,&eps); + *w1 = 0.5e0+(0.5e0-*w); + goto S250; +S120: + *w1 = bpser(&b0,&a0,&y0,&eps); + *w = 0.5e0+(0.5e0-*w1); + goto S250; +S130: + T2 = 15.0e0*eps; + *w = bfrac(&a0,&b0,&x0,&y0,&lambda,&T2); + *w1 = 0.5e0+(0.5e0-*w); + goto S250; +S140: + *w1 = bup(&b0,&a0,&y0,&x0,&n,&eps); + b0 += (double)n; +S150: + T3 = 15.0e0*eps; + bgrat(&b0,&a0,&y0,&x0,w1,&T3,&ierr1); + *w = 0.5e0+(0.5e0-*w1); + goto S250; +S160: + n = b0; + b0 -= (double)n; + if(b0 != 0.0e0) goto S170; + n -= 1; + b0 = 1.0e0; +S170: + *w = bup(&b0,&a0,&y0,&x0,&n,&eps); + if(x0 > 0.7e0) goto S180; + *w += bpser(&a0,&b0,&x0,&eps); + *w1 = 0.5e0+(0.5e0-*w); + goto S250; +S180: + if(a0 > 15.0e0) goto S190; + n = 20; + *w += bup(&a0,&b0,&x0,&y0,&n,&eps); + a0 += (double)n; +S190: + T4 = 15.0e0*eps; + bgrat(&a0,&b0,&x0,&y0,w,&T4,&ierr1); + *w1 = 0.5e0+(0.5e0-*w); + goto S250; +S200: + T5 = 100.0e0*eps; + *w = basym(&a0,&b0,&lambda,&T5); + *w1 = 0.5e0+(0.5e0-*w); + goto S250; +S210: +/* + TERMINATION OF THE PROCEDURE +*/ + if(*a == 0.0e0) goto S320; +S220: + *w = 0.0e0; + *w1 = 1.0e0; + return; +S230: + if(*b == 0.0e0) goto S330; +S240: + *w = 1.0e0; + *w1 = 0.0e0; + return; +S250: + if(ind == 0) return; + t = *w; + *w = *w1; + *w1 = t; + return; +S260: +/* + PROCEDURE FOR A AND B .LT. 1.E-3*EPS +*/ + *w = *b/(*a+*b); + *w1 = *a/(*a+*b); + return; +S270: +/* + ERROR RETURN +*/ + *ierr = 1; + return; +S280: + *ierr = 2; + return; +S290: + *ierr = 3; + return; +S300: + *ierr = 4; + return; +S310: + *ierr = 5; + return; +S320: + *ierr = 6; + return; +S330: + *ierr = 7; + return; +} /* END */ + +/***=====================================================================***/ +static double brcmp1(int *mu,double *a,double *b,double *x,double *y) +/* +----------------------------------------------------------------------- + EVALUATION OF EXP(MU) * (X**A*Y**B/BETA(A,B)) +----------------------------------------------------------------------- +*/ +{ +static double Const = .398942280401433e0; +static double brcmp1,a0,apb,b0,c,e,h,lambda,lnx,lny,t,u,v,x0,y0,z; +static int i,n; +/* +----------------- + CONST = 1/SQRT(2*PI) +----------------- +*/ +static double T1,T2,T3,T4; +/* + .. + .. Executable Statements .. +*/ + a0 = fifdmin1(*a,*b); + if(a0 >= 8.0e0) goto S130; + if(*x > 0.375e0) goto S10; + lnx = log(*x); + T1 = -*x; + lny = alnrel(&T1); + goto S30; +S10: + if(*y > 0.375e0) goto S20; + T2 = -*y; + lnx = alnrel(&T2); + lny = log(*y); + goto S30; +S20: + lnx = log(*x); + lny = log(*y); +S30: + z = *a*lnx+*b*lny; + if(a0 < 1.0e0) goto S40; + z -= betaln(a,b); + brcmp1 = esum(mu,&z); + return brcmp1; +S40: +/* +----------------------------------------------------------------------- + PROCEDURE FOR A .LT. 1 OR B .LT. 1 +----------------------------------------------------------------------- +*/ + b0 = fifdmax1(*a,*b); + if(b0 >= 8.0e0) goto S120; + if(b0 > 1.0e0) goto S70; +/* + ALGORITHM FOR B0 .LE. 1 +*/ + brcmp1 = esum(mu,&z); + if(brcmp1 == 0.0e0) return brcmp1; + apb = *a+*b; + if(apb > 1.0e0) goto S50; + z = 1.0e0+gam1(&apb); + goto S60; +S50: + u = *a+*b-1.e0; + z = (1.0e0+gam1(&u))/apb; +S60: + c = (1.0e0+gam1(a))*(1.0e0+gam1(b))/z; + brcmp1 = brcmp1*(a0*c)/(1.0e0+a0/b0); + return brcmp1; +S70: +/* + ALGORITHM FOR 1 .LT. B0 .LT. 8 +*/ + u = gamln1(&a0); + n = b0-1.0e0; + if(n < 1) goto S90; + c = 1.0e0; + for(i=1; i<=n; i++) { + b0 -= 1.0e0; + c *= (b0/(a0+b0)); + } + u = log(c)+u; +S90: + z -= u; + b0 -= 1.0e0; + apb = a0+b0; + if(apb > 1.0e0) goto S100; + t = 1.0e0+gam1(&apb); + goto S110; +S100: + u = a0+b0-1.e0; + t = (1.0e0+gam1(&u))/apb; +S110: + brcmp1 = a0*esum(mu,&z)*(1.0e0+gam1(&b0))/t; + return brcmp1; +S120: +/* + ALGORITHM FOR B0 .GE. 8 +*/ + u = gamln1(&a0)+algdiv(&a0,&b0); + T3 = z-u; + brcmp1 = a0*esum(mu,&T3); + return brcmp1; +S130: +/* +----------------------------------------------------------------------- + PROCEDURE FOR A .GE. 8 AND B .GE. 8 +----------------------------------------------------------------------- +*/ + if(*a > *b) goto S140; + h = *a/ *b; + x0 = h/(1.0e0+h); + y0 = 1.0e0/(1.0e0+h); + lambda = *a-(*a+*b)**x; + goto S150; +S140: + h = *b/ *a; + x0 = 1.0e0/(1.0e0+h); + y0 = h/(1.0e0+h); + lambda = (*a+*b)**y-*b; +S150: + e = -(lambda/ *a); + if(fabs(e) > 0.6e0) goto S160; + u = rlog1(&e); + goto S170; +S160: + u = e-log(*x/x0); +S170: + e = lambda/ *b; + if(fabs(e) > 0.6e0) goto S180; + v = rlog1(&e); + goto S190; +S180: + v = e-log(*y/y0); +S190: + T4 = -(*a*u+*b*v); + z = esum(mu,&T4); + brcmp1 = Const*sqrt(*b*x0)*z*exp(-bcorr(a,b)); + return brcmp1; +} /* END */ + +/***=====================================================================***/ +static double brcomp(double *a,double *b,double *x,double *y) +/* +----------------------------------------------------------------------- + EVALUATION OF X**A*Y**B/BETA(A,B) +----------------------------------------------------------------------- +*/ +{ +static double Const = .398942280401433e0; +static double brcomp,a0,apb,b0,c,e,h,lambda,lnx,lny,t,u,v,x0,y0,z; +static int i,n; +/* +----------------- + CONST = 1/SQRT(2*PI) +----------------- +*/ +static double T1,T2; +/* + .. + .. Executable Statements .. +*/ + brcomp = 0.0e0; + if(*x == 0.0e0 || *y == 0.0e0) return brcomp; + a0 = fifdmin1(*a,*b); + if(a0 >= 8.0e0) goto S130; + if(*x > 0.375e0) goto S10; + lnx = log(*x); + T1 = -*x; + lny = alnrel(&T1); + goto S30; +S10: + if(*y > 0.375e0) goto S20; + T2 = -*y; + lnx = alnrel(&T2); + lny = log(*y); + goto S30; +S20: + lnx = log(*x); + lny = log(*y); +S30: + z = *a*lnx+*b*lny; + if(a0 < 1.0e0) goto S40; + z -= betaln(a,b); + brcomp = exp(z); + return brcomp; +S40: +/* +----------------------------------------------------------------------- + PROCEDURE FOR A .LT. 1 OR B .LT. 1 +----------------------------------------------------------------------- +*/ + b0 = fifdmax1(*a,*b); + if(b0 >= 8.0e0) goto S120; + if(b0 > 1.0e0) goto S70; +/* + ALGORITHM FOR B0 .LE. 1 +*/ + brcomp = exp(z); + if(brcomp == 0.0e0) return brcomp; + apb = *a+*b; + if(apb > 1.0e0) goto S50; + z = 1.0e0+gam1(&apb); + goto S60; +S50: + u = *a+*b-1.e0; + z = (1.0e0+gam1(&u))/apb; +S60: + c = (1.0e0+gam1(a))*(1.0e0+gam1(b))/z; + brcomp = brcomp*(a0*c)/(1.0e0+a0/b0); + return brcomp; +S70: +/* + ALGORITHM FOR 1 .LT. B0 .LT. 8 +*/ + u = gamln1(&a0); + n = b0-1.0e0; + if(n < 1) goto S90; + c = 1.0e0; + for(i=1; i<=n; i++) { + b0 -= 1.0e0; + c *= (b0/(a0+b0)); + } + u = log(c)+u; +S90: + z -= u; + b0 -= 1.0e0; + apb = a0+b0; + if(apb > 1.0e0) goto S100; + t = 1.0e0+gam1(&apb); + goto S110; +S100: + u = a0+b0-1.e0; + t = (1.0e0+gam1(&u))/apb; +S110: + brcomp = a0*exp(z)*(1.0e0+gam1(&b0))/t; + return brcomp; +S120: +/* + ALGORITHM FOR B0 .GE. 8 +*/ + u = gamln1(&a0)+algdiv(&a0,&b0); + brcomp = a0*exp(z-u); + return brcomp; +S130: +/* +----------------------------------------------------------------------- + PROCEDURE FOR A .GE. 8 AND B .GE. 8 +----------------------------------------------------------------------- +*/ + if(*a > *b) goto S140; + h = *a/ *b; + x0 = h/(1.0e0+h); + y0 = 1.0e0/(1.0e0+h); + lambda = *a-(*a+*b)**x; + goto S150; +S140: + h = *b/ *a; + x0 = 1.0e0/(1.0e0+h); + y0 = h/(1.0e0+h); + lambda = (*a+*b)**y-*b; +S150: + e = -(lambda/ *a); + if(fabs(e) > 0.6e0) goto S160; + u = rlog1(&e); + goto S170; +S160: + u = e-log(*x/x0); +S170: + e = lambda/ *b; + if(fabs(e) > 0.6e0) goto S180; + v = rlog1(&e); + goto S190; +S180: + v = e-log(*y/y0); +S190: + z = exp(-(*a*u+*b*v)); + brcomp = Const*sqrt(*b*x0)*z*exp(-bcorr(a,b)); + return brcomp; +} /* END */ + +/***=====================================================================***/ +static double bup(double *a,double *b,double *x,double *y,int *n,double *eps) +/* +----------------------------------------------------------------------- + EVALUATION OF IX(A,B) - IX(A+N,B) WHERE N IS A POSITIVE INTEGER. + EPS IS THE TOLERANCE USED. +----------------------------------------------------------------------- +*/ +{ +static int K1 = 1; +static int K2 = 0; +static double bup,ap1,apb,d,l,r,t,w; +static int i,k,kp1,mu,nm1; +/* + .. + .. Executable Statements .. +*/ +/* + OBTAIN THE SCALING FACTOR EXP(-MU) AND + EXP(MU)*(X**A*Y**B/BETA(A,B))/A +*/ + apb = *a+*b; + ap1 = *a+1.0e0; + mu = 0; + d = 1.0e0; + if(*n == 1 || *a < 1.0e0) goto S10; + if(apb < 1.1e0*ap1) goto S10; + mu = fabs(exparg(&K1)); + k = exparg(&K2); + if(k < mu) mu = k; + t = mu; + d = exp(-t); +S10: + bup = brcmp1(&mu,a,b,x,y)/ *a; + if(*n == 1 || bup == 0.0e0) return bup; + nm1 = *n-1; + w = d; +/* + LET K BE THE INDEX OF THE MAXIMUM TERM +*/ + k = 0; + if(*b <= 1.0e0) goto S50; + if(*y > 1.e-4) goto S20; + k = nm1; + goto S30; +S20: + r = (*b-1.0e0)**x/ *y-*a; + if(r < 1.0e0) goto S50; + k = t = nm1; + if(r < t) k = r; +S30: +/* + ADD THE INCREASING TERMS OF THE SERIES +*/ + for(i=1; i<=k; i++) { + l = i-1; + d = (apb+l)/(ap1+l)**x*d; + w += d; + } + if(k == nm1) goto S70; +S50: +/* + ADD THE REMAINING TERMS OF THE SERIES +*/ + kp1 = k+1; + for(i=kp1; i<=nm1; i++) { + l = i-1; + d = (apb+l)/(ap1+l)**x*d; + w += d; + if(d <= *eps*w) goto S70; + } +S70: +/* + TERMINATE THE PROCEDURE +*/ + bup *= w; + return bup; +} /* END */ + +/***=====================================================================***/ +static void cdfbet(int *which,double *p,double *q,double *x,double *y, + double *a,double *b,int *status,double *bound) +/********************************************************************** + + void cdfbet(int *which,double *p,double *q,double *x,double *y, + double *a,double *b,int *status,double *bound) + + Cumulative Distribution Function + BETa Distribution + + + Function + + + Calculates any one parameter of the beta distribution given + values for the others. + + + Arguments + + + WHICH --> Integer indicating which of the next four argument + values is to be calculated from the others. + Legal range: 1..4 + iwhich = 1 : Calculate P and Q from X,Y,A and B + iwhich = 2 : Calculate X and Y from P,Q,A and B + iwhich = 3 : Calculate A from P,Q,X,Y and B + iwhich = 4 : Calculate B from P,Q,X,Y and A + + P <--> The integral from 0 to X of the chi-square + distribution. + Input range: [0, 1]. + + Q <--> 1-P. + Input range: [0, 1]. + P + Q = 1.0. + + X <--> Upper limit of integration of beta density. + Input range: [0,1]. + Search range: [0,1] + + Y <--> 1-X. + Input range: [0,1]. + Search range: [0,1] + X + Y = 1.0. + + A <--> The first parameter of the beta density. + Input range: (0, +infinity). + Search range: [1D-300,1D300] + + B <--> The second parameter of the beta density. + Input range: (0, +infinity). + Search range: [1D-300,1D300] + + STATUS <-- 0 if calculation completed correctly + -I if input parameter number I is out of range + 1 if answer appears to be lower than lowest + search bound + 2 if answer appears to be higher than greatest + search bound + 3 if P + Q .ne. 1 + 4 if X + Y .ne. 1 + + BOUND <-- Undefined if STATUS is 0 + + Bound exceeded by parameter number I if STATUS + is negative. + + Lower search bound if STATUS is 1. + + Upper search bound if STATUS is 2. + + + Method + + + Cumulative distribution function (P) is calculated directly by + code associated with the following reference. + + DiDinato, A. R. and Morris, A. H. Algorithm 708: Significant + Digit Computation of the Incomplete Beta Function Ratios. ACM + Trans. Math. Softw. 18 (1993), 360-373. + + Computation of other parameters involve a seach for a value that + produces the desired value of P. The search relies on the + monotinicity of P with the other parameter. + + + Note + + + The beta density is proportional to + t^(A-1) * (1-t)^(B-1) + +**********************************************************************/ +{ +#define tol (1.0e-8) +#define atol (1.0e-50) +#define zero (1.0e-300) +#define inf 1.0e300 +#define one 1.0e0 +static int K1 = 1; +static double K2 = 0.0e0; +static double K3 = 1.0e0; +static double K8 = 0.5e0; +static double K9 = 5.0e0; +static double fx,xhi,xlo,cum,ccum,xy,pq; +static unsigned long qhi,qleft,qporq; +static double T4,T5,T6,T7,T10,T11,T12,T13,T14,T15; +/* + .. + .. Executable Statements .. +*/ +/* + Check arguments +*/ + if(!(*which < 1 || *which > 4)) goto S30; + if(!(*which < 1)) goto S10; + *bound = 1.0e0; + goto S20; +S10: + *bound = 4.0e0; +S20: + *status = -1; + return; +S30: + if(*which == 1) goto S70; +/* + P +*/ + if(!(*p < 0.0e0 || *p > 1.0e0)) goto S60; + if(!(*p < 0.0e0)) goto S40; + *bound = 0.0e0; + goto S50; +S40: + *bound = 1.0e0; +S50: + *status = -2; + return; +S70: +S60: + if(*which == 1) goto S110; +/* + Q +*/ + if(!(*q < 0.0e0 || *q > 1.0e0)) goto S100; + if(!(*q < 0.0e0)) goto S80; + *bound = 0.0e0; + goto S90; +S80: + *bound = 1.0e0; +S90: + *status = -3; + return; +S110: +S100: + if(*which == 2) goto S150; +/* + X +*/ + if(!(*x < 0.0e0 || *x > 1.0e0)) goto S140; + if(!(*x < 0.0e0)) goto S120; + *bound = 0.0e0; + goto S130; +S120: + *bound = 1.0e0; +S130: + *status = -4; + return; +S150: +S140: + if(*which == 2) goto S190; +/* + Y +*/ + if(!(*y < 0.0e0 || *y > 1.0e0)) goto S180; + if(!(*y < 0.0e0)) goto S160; + *bound = 0.0e0; + goto S170; +S160: + *bound = 1.0e0; +S170: + *status = -5; + return; +S190: +S180: + if(*which == 3) goto S210; +/* + A +*/ + if(!(*a <= 0.0e0)) goto S200; + *bound = 0.0e0; + *status = -6; + return; +S210: +S200: + if(*which == 4) goto S230; +/* + B +*/ + if(!(*b <= 0.0e0)) goto S220; + *bound = 0.0e0; + *status = -7; + return; +S230: +S220: + if(*which == 1) goto S270; +/* + P + Q +*/ + pq = *p+*q; + if(!(fabs(pq-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S260; + if(!(pq < 0.0e0)) goto S240; + *bound = 0.0e0; + goto S250; +S240: + *bound = 1.0e0; +S250: + *status = 3; + return; +S270: +S260: + if(*which == 2) goto S310; +/* + X + Y +*/ + xy = *x+*y; + if(!(fabs(xy-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S300; + if(!(xy < 0.0e0)) goto S280; + *bound = 0.0e0; + goto S290; +S280: + *bound = 1.0e0; +S290: + *status = 4; + return; +S310: +S300: + if(!(*which == 1)) qporq = *p <= *q; +/* + Select the minimum of P or Q + Calculate ANSWERS +*/ + if(1 == *which) { +/* + Calculating P and Q +*/ + cumbet(x,y,a,b,p,q); + *status = 0; + } + else if(2 == *which) { +/* + Calculating X and Y +*/ + T4 = atol; + T5 = tol; + dstzr(&K2,&K3,&T4,&T5); + if(!qporq) goto S340; + *status = 0; + dzror(status,x,&fx,&xlo,&xhi,&qleft,&qhi); + *y = one-*x; +S320: + if(!(*status == 1)) goto S330; + cumbet(x,y,a,b,&cum,&ccum); + fx = cum-*p; + dzror(status,x,&fx,&xlo,&xhi,&qleft,&qhi); + *y = one-*x; + goto S320; +S330: + goto S370; +S340: + *status = 0; + dzror(status,y,&fx,&xlo,&xhi,&qleft,&qhi); + *x = one-*y; +S350: + if(!(*status == 1)) goto S360; + cumbet(x,y,a,b,&cum,&ccum); + fx = ccum-*q; + dzror(status,y,&fx,&xlo,&xhi,&qleft,&qhi); + *x = one-*y; + goto S350; +S370: +S360: + if(!(*status == -1)) goto S400; + if(!qleft) goto S380; + *status = 1; + *bound = 0.0e0; + goto S390; +S380: + *status = 2; + *bound = 1.0e0; +S400: +S390: + ; + } + else if(3 == *which) { +/* + Computing A +*/ + *a = 5.0e0; + T6 = zero; + T7 = inf; + T10 = atol; + T11 = tol; + dstinv(&T6,&T7,&K8,&K8,&K9,&T10,&T11); + *status = 0; + dinvr(status,a,&fx,&qleft,&qhi); +S410: + if(!(*status == 1)) goto S440; + cumbet(x,y,a,b,&cum,&ccum); + if(!qporq) goto S420; + fx = cum-*p; + goto S430; +S420: + fx = ccum-*q; +S430: + dinvr(status,a,&fx,&qleft,&qhi); + goto S410; +S440: + if(!(*status == -1)) goto S470; + if(!qleft) goto S450; + *status = 1; + *bound = zero; + goto S460; +S450: + *status = 2; + *bound = inf; +S470: +S460: + ; + } + else if(4 == *which) { +/* + Computing B +*/ + *b = 5.0e0; + T12 = zero; + T13 = inf; + T14 = atol; + T15 = tol; + dstinv(&T12,&T13,&K8,&K8,&K9,&T14,&T15); + *status = 0; + dinvr(status,b,&fx,&qleft,&qhi); +S480: + if(!(*status == 1)) goto S510; + cumbet(x,y,a,b,&cum,&ccum); + if(!qporq) goto S490; + fx = cum-*p; + goto S500; +S490: + fx = ccum-*q; +S500: + dinvr(status,b,&fx,&qleft,&qhi); + goto S480; +S510: + if(!(*status == -1)) goto S540; + if(!qleft) goto S520; + *status = 1; + *bound = zero; + goto S530; +S520: + *status = 2; + *bound = inf; +S530: + ; + } +S540: + return; +#undef tol +#undef atol +#undef zero +#undef inf +#undef one +} /* END */ + +/***=====================================================================***/ +static void cdfbin(int *which,double *p,double *q,double *s,double *xn, + double *pr,double *ompr,int *status,double *bound) +/********************************************************************** + + void cdfbin(int *which,double *p,double *q,double *s,double *xn, + double *pr,double *ompr,int *status,double *bound) + + Cumulative Distribution Function + BINomial distribution + + + Function + + + Calculates any one parameter of the binomial + distribution given values for the others. + + + Arguments + + + WHICH --> Integer indicating which of the next four argument + values is to be calculated from the others. + Legal range: 1..4 + iwhich = 1 : Calculate P and Q from S,XN,PR and OMPR + iwhich = 2 : Calculate S from P,Q,XN,PR and OMPR + iwhich = 3 : Calculate XN from P,Q,S,PR and OMPR + iwhich = 4 : Calculate PR and OMPR from P,Q,S and XN + + P <--> The cumulation from 0 to S of the binomial distribution. + (Probablility of S or fewer successes in XN trials each + with probability of success PR.) + Input range: [0,1]. + + Q <--> 1-P. + Input range: [0, 1]. + P + Q = 1.0. + + S <--> The number of successes observed. + Input range: [0, XN] + Search range: [0, XN] + + XN <--> The number of binomial trials. + Input range: (0, +infinity). + Search range: [1E-300, 1E300] + + PR <--> The probability of success in each binomial trial. + Input range: [0,1]. + Search range: [0,1] + + OMPR <--> 1-PR + Input range: [0,1]. + Search range: [0,1] + PR + OMPR = 1.0 + + STATUS <-- 0 if calculation completed correctly + -I if input parameter number I is out of range + 1 if answer appears to be lower than lowest + search bound + 2 if answer appears to be higher than greatest + search bound + 3 if P + Q .ne. 1 + 4 if PR + OMPR .ne. 1 + + BOUND <-- Undefined if STATUS is 0 + + Bound exceeded by parameter number I if STATUS + is negative. + + Lower search bound if STATUS is 1. + + Upper search bound if STATUS is 2. + + + Method + + + Formula 26.5.24 of Abramowitz and Stegun, Handbook of + Mathematical Functions (1966) is used to reduce the binomial + distribution to the cumulative incomplete beta distribution. + + Computation of other parameters involve a seach for a value that + produces the desired value of P. The search relies on the + monotinicity of P with the other parameter. + + +**********************************************************************/ +{ +#define atol (1.0e-50) +#define tol (1.0e-8) +#define zero (1.0e-300) +#define inf 1.0e300 +#define one 1.0e0 +static int K1 = 1; +static double K2 = 0.0e0; +static double K3 = 0.5e0; +static double K4 = 5.0e0; +static double K11 = 1.0e0; +static double fx,xhi,xlo,cum,ccum,pq,prompr; +static unsigned long qhi,qleft,qporq; +static double T5,T6,T7,T8,T9,T10,T12,T13; +/* + .. + .. Executable Statements .. +*/ +/* + Check arguments +*/ + if(!(*which < 1 && *which > 4)) goto S30; + if(!(*which < 1)) goto S10; + *bound = 1.0e0; + goto S20; +S10: + *bound = 4.0e0; +S20: + *status = -1; + return; +S30: + if(*which == 1) goto S70; +/* + P +*/ + if(!(*p < 0.0e0 || *p > 1.0e0)) goto S60; + if(!(*p < 0.0e0)) goto S40; + *bound = 0.0e0; + goto S50; +S40: + *bound = 1.0e0; +S50: + *status = -2; + return; +S70: +S60: + if(*which == 1) goto S110; +/* + Q +*/ + if(!(*q < 0.0e0 || *q > 1.0e0)) goto S100; + if(!(*q < 0.0e0)) goto S80; + *bound = 0.0e0; + goto S90; +S80: + *bound = 1.0e0; +S90: + *status = -3; + return; +S110: +S100: + if(*which == 3) goto S130; +/* + XN +*/ + if(!(*xn <= 0.0e0)) goto S120; + *bound = 0.0e0; + *status = -5; + return; +S130: +S120: + if(*which == 2) goto S170; +/* + S +*/ + if(!(*s < 0.0e0 || *which != 3 && *s > *xn)) goto S160; + if(!(*s < 0.0e0)) goto S140; + *bound = 0.0e0; + goto S150; +S140: + *bound = *xn; +S150: + *status = -4; + return; +S170: +S160: + if(*which == 4) goto S210; +/* + PR +*/ + if(!(*pr < 0.0e0 || *pr > 1.0e0)) goto S200; + if(!(*pr < 0.0e0)) goto S180; + *bound = 0.0e0; + goto S190; +S180: + *bound = 1.0e0; +S190: + *status = -6; + return; +S210: +S200: + if(*which == 4) goto S250; +/* + OMPR +*/ + if(!(*ompr < 0.0e0 || *ompr > 1.0e0)) goto S240; + if(!(*ompr < 0.0e0)) goto S220; + *bound = 0.0e0; + goto S230; +S220: + *bound = 1.0e0; +S230: + *status = -7; + return; +S250: +S240: + if(*which == 1) goto S290; +/* + P + Q +*/ + pq = *p+*q; + if(!(fabs(pq-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S280; + if(!(pq < 0.0e0)) goto S260; + *bound = 0.0e0; + goto S270; +S260: + *bound = 1.0e0; +S270: + *status = 3; + return; +S290: +S280: + if(*which == 4) goto S330; +/* + PR + OMPR +*/ + prompr = *pr+*ompr; + if(!(fabs(prompr-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S320; + if(!(prompr < 0.0e0)) goto S300; + *bound = 0.0e0; + goto S310; +S300: + *bound = 1.0e0; +S310: + *status = 4; + return; +S330: +S320: + if(!(*which == 1)) qporq = *p <= *q; +/* + Select the minimum of P or Q + Calculate ANSWERS +*/ + if(1 == *which) { +/* + Calculating P +*/ + cumbin(s,xn,pr,ompr,p,q); + *status = 0; + } + else if(2 == *which) { +/* + Calculating S +*/ + *s = 5.0e0; + T5 = atol; + T6 = tol; + dstinv(&K2,xn,&K3,&K3,&K4,&T5,&T6); + *status = 0; + dinvr(status,s,&fx,&qleft,&qhi); +S340: + if(!(*status == 1)) goto S370; + cumbin(s,xn,pr,ompr,&cum,&ccum); + if(!qporq) goto S350; + fx = cum-*p; + goto S360; +S350: + fx = ccum-*q; +S360: + dinvr(status,s,&fx,&qleft,&qhi); + goto S340; +S370: + if(!(*status == -1)) goto S400; + if(!qleft) goto S380; + *status = 1; + *bound = 0.0e0; + goto S390; +S380: + *status = 2; + *bound = *xn; +S400: +S390: + ; + } + else if(3 == *which) { +/* + Calculating XN +*/ + *xn = 5.0e0; + T7 = zero; + T8 = inf; + T9 = atol; + T10 = tol; + dstinv(&T7,&T8,&K3,&K3,&K4,&T9,&T10); + *status = 0; + dinvr(status,xn,&fx,&qleft,&qhi); +S410: + if(!(*status == 1)) goto S440; + cumbin(s,xn,pr,ompr,&cum,&ccum); + if(!qporq) goto S420; + fx = cum-*p; + goto S430; +S420: + fx = ccum-*q; +S430: + dinvr(status,xn,&fx,&qleft,&qhi); + goto S410; +S440: + if(!(*status == -1)) goto S470; + if(!qleft) goto S450; + *status = 1; + *bound = zero; + goto S460; +S450: + *status = 2; + *bound = inf; +S470: +S460: + ; + } + else if(4 == *which) { +/* + Calculating PR and OMPR +*/ + T12 = atol; + T13 = tol; + dstzr(&K2,&K11,&T12,&T13); + if(!qporq) goto S500; + *status = 0; + dzror(status,pr,&fx,&xlo,&xhi,&qleft,&qhi); + *ompr = one-*pr; +S480: + if(!(*status == 1)) goto S490; + cumbin(s,xn,pr,ompr,&cum,&ccum); + fx = cum-*p; + dzror(status,pr,&fx,&xlo,&xhi,&qleft,&qhi); + *ompr = one-*pr; + goto S480; +S490: + goto S530; +S500: + *status = 0; + dzror(status,ompr,&fx,&xlo,&xhi,&qleft,&qhi); + *pr = one-*ompr; +S510: + if(!(*status == 1)) goto S520; + cumbin(s,xn,pr,ompr,&cum,&ccum); + fx = ccum-*q; + dzror(status,ompr,&fx,&xlo,&xhi,&qleft,&qhi); + *pr = one-*ompr; + goto S510; +S530: +S520: + if(!(*status == -1)) goto S560; + if(!qleft) goto S540; + *status = 1; + *bound = 0.0e0; + goto S550; +S540: + *status = 2; + *bound = 1.0e0; +S550: + ; + } +S560: + return; +#undef atol +#undef tol +#undef zero +#undef inf +#undef one +} /* END */ + +/***=====================================================================***/ +static void cdfchi(int *which,double *p,double *q,double *x,double *df, + int *status,double *bound) +/********************************************************************** + + void cdfchi(int *which,double *p,double *q,double *x,double *df, + int *status,double *bound) + + Cumulative Distribution Function + CHI-Square distribution + + + Function + + + Calculates any one parameter of the chi-square + distribution given values for the others. + + + Arguments + + + WHICH --> Integer indicating which of the next three argument + values is to be calculated from the others. + Legal range: 1..3 + iwhich = 1 : Calculate P and Q from X and DF + iwhich = 2 : Calculate X from P,Q and DF + iwhich = 3 : Calculate DF from P,Q and X + + P <--> The integral from 0 to X of the chi-square + distribution. + Input range: [0, 1]. + + Q <--> 1-P. + Input range: (0, 1]. + P + Q = 1.0. + + X <--> Upper limit of integration of the non-central + chi-square distribution. + Input range: [0, +infinity). + Search range: [0,1E300] + + DF <--> Degrees of freedom of the + chi-square distribution. + Input range: (0, +infinity). + Search range: [ 1E-300, 1E300] + + STATUS <-- 0 if calculation completed correctly + -I if input parameter number I is out of range + 1 if answer appears to be lower than lowest + search bound + 2 if answer appears to be higher than greatest + search bound + 3 if P + Q .ne. 1 + 10 indicates error returned from cumgam. See + references in cdfgam + + BOUND <-- Undefined if STATUS is 0 + + Bound exceeded by parameter number I if STATUS + is negative. + + Lower search bound if STATUS is 1. + + Upper search bound if STATUS is 2. + + + Method + + + Formula 26.4.19 of Abramowitz and Stegun, Handbook of + Mathematical Functions (1966) is used to reduce the chisqure + distribution to the incomplete distribution. + + Computation of other parameters involve a seach for a value that + produces the desired value of P. The search relies on the + monotinicity of P with the other parameter. + +**********************************************************************/ +{ +#define tol (1.0e-8) +#define atol (1.0e-50) +#define zero (1.0e-300) +#define inf 1.0e300 +static int K1 = 1; +static double K2 = 0.0e0; +static double K4 = 0.5e0; +static double K5 = 5.0e0; +static double fx,cum,ccum,pq,porq; +static unsigned long qhi,qleft,qporq; +static double T3,T6,T7,T8,T9,T10,T11; +/* + .. + .. Executable Statements .. +*/ +/* + Check arguments +*/ + if(!(*which < 1 || *which > 3)) goto S30; + if(!(*which < 1)) goto S10; + *bound = 1.0e0; + goto S20; +S10: + *bound = 3.0e0; +S20: + *status = -1; + return; +S30: + if(*which == 1) goto S70; +/* + P +*/ + if(!(*p < 0.0e0 || *p > 1.0e0)) goto S60; + if(!(*p < 0.0e0)) goto S40; + *bound = 0.0e0; + goto S50; +S40: + *bound = 1.0e0; +S50: + *status = -2; + return; +S70: +S60: + if(*which == 1) goto S110; +/* + Q +*/ + if(!(*q <= 0.0e0 || *q > 1.0e0)) goto S100; + if(!(*q <= 0.0e0)) goto S80; + *bound = 0.0e0; + goto S90; +S80: + *bound = 1.0e0; +S90: + *status = -3; + return; +S110: +S100: + if(*which == 2) goto S130; +/* + X +*/ + if(!(*x < 0.0e0)) goto S120; + *bound = 0.0e0; + *status = -4; + return; +S130: +S120: + if(*which == 3) goto S150; +/* + DF +*/ + if(!(*df <= 0.0e0)) goto S140; + *bound = 0.0e0; + *status = -5; + return; +S150: +S140: + if(*which == 1) goto S190; +/* + P + Q +*/ + pq = *p+*q; + if(!(fabs(pq-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S180; + if(!(pq < 0.0e0)) goto S160; + *bound = 0.0e0; + goto S170; +S160: + *bound = 1.0e0; +S170: + *status = 3; + return; +S190: +S180: + if(*which == 1) goto S220; +/* + Select the minimum of P or Q +*/ + qporq = *p <= *q; + if(!qporq) goto S200; + porq = *p; + goto S210; +S200: + porq = *q; +S220: +S210: +/* + Calculate ANSWERS +*/ + if(1 == *which) { +/* + Calculating P and Q +*/ + *status = 0; + cumchi(x,df,p,q); + if(porq > 1.5e0) { + *status = 10; + return; + } + } + else if(2 == *which) { +/* + Calculating X +*/ + *x = 5.0e0; + T3 = inf; + T6 = atol; + T7 = tol; + dstinv(&K2,&T3,&K4,&K4,&K5,&T6,&T7); + *status = 0; + dinvr(status,x,&fx,&qleft,&qhi); +S230: + if(!(*status == 1)) goto S270; + cumchi(x,df,&cum,&ccum); + if(!qporq) goto S240; + fx = cum-*p; + goto S250; +S240: + fx = ccum-*q; +S250: + if(!(fx+porq > 1.5e0)) goto S260; + *status = 10; + return; +S260: + dinvr(status,x,&fx,&qleft,&qhi); + goto S230; +S270: + if(!(*status == -1)) goto S300; + if(!qleft) goto S280; + *status = 1; + *bound = 0.0e0; + goto S290; +S280: + *status = 2; + *bound = inf; +S300: +S290: + ; + } + else if(3 == *which) { +/* + Calculating DF +*/ + *df = 5.0e0; + T8 = zero; + T9 = inf; + T10 = atol; + T11 = tol; + dstinv(&T8,&T9,&K4,&K4,&K5,&T10,&T11); + *status = 0; + dinvr(status,df,&fx,&qleft,&qhi); +S310: + if(!(*status == 1)) goto S350; + cumchi(x,df,&cum,&ccum); + if(!qporq) goto S320; + fx = cum-*p; + goto S330; +S320: + fx = ccum-*q; +S330: + if(!(fx+porq > 1.5e0)) goto S340; + *status = 10; + return; +S340: + dinvr(status,df,&fx,&qleft,&qhi); + goto S310; +S350: + if(!(*status == -1)) goto S380; + if(!qleft) goto S360; + *status = 1; + *bound = zero; + goto S370; +S360: + *status = 2; + *bound = inf; +S370: + ; + } +S380: + return; +#undef tol +#undef atol +#undef zero +#undef inf +} /* END */ + +/***=====================================================================***/ +static void cdfchn(int *which,double *p,double *q,double *x,double *df, + double *pnonc,int *status,double *bound) +/********************************************************************** + + void cdfchn(int *which,double *p,double *q,double *x,double *df, + double *pnonc,int *status,double *bound) + + Cumulative Distribution Function + Non-central Chi-Square + + + Function + + + Calculates any one parameter of the non-central chi-square + distribution given values for the others. + + + Arguments + + + WHICH --> Integer indicating which of the next three argument + values is to be calculated from the others. + Input range: 1..4 + iwhich = 1 : Calculate P and Q from X and DF + iwhich = 2 : Calculate X from P,DF and PNONC + iwhich = 3 : Calculate DF from P,X and PNONC + iwhich = 3 : Calculate PNONC from P,X and DF + + P <--> The integral from 0 to X of the non-central chi-square + distribution. + Input range: [0, 1-1E-16). + + Q <--> 1-P. + Q is not used by this subroutine and is only included + for similarity with other cdf* routines. + + X <--> Upper limit of integration of the non-central + chi-square distribution. + Input range: [0, +infinity). + Search range: [0,1E300] + + DF <--> Degrees of freedom of the non-central + chi-square distribution. + Input range: (0, +infinity). + Search range: [ 1E-300, 1E300] + + PNONC <--> Non-centrality parameter of the non-central + chi-square distribution. + Input range: [0, +infinity). + Search range: [0,1E4] + + STATUS <-- 0 if calculation completed correctly + -I if input parameter number I is out of range + 1 if answer appears to be lower than lowest + search bound + 2 if answer appears to be higher than greatest + search bound + + BOUND <-- Undefined if STATUS is 0 + + Bound exceeded by parameter number I if STATUS + is negative. + + Lower search bound if STATUS is 1. + + Upper search bound if STATUS is 2. + + + Method + + + Formula 26.4.25 of Abramowitz and Stegun, Handbook of + Mathematical Functions (1966) is used to compute the cumulative + distribution function. + + Computation of other parameters involve a seach for a value that + produces the desired value of P. The search relies on the + monotinicity of P with the other parameter. + + + WARNING + + The computation time required for this routine is proportional + to the noncentrality parameter (PNONC). Very large values of + this parameter can consume immense computer resources. This is + why the search range is bounded by 10,000. + +**********************************************************************/ +{ +#define tent4 1.0e4 +#define tol (1.0e-8) +#define atol (1.0e-50) +#define zero (1.0e-300) +#define one (1.0e0-1.0e-16) +#define inf 1.0e300 +static double K1 = 0.0e0; +static double K3 = 0.5e0; +static double K4 = 5.0e0; +static double fx,cum,ccum; +static unsigned long qhi,qleft; +static double T2,T5,T6,T7,T8,T9,T10,T11,T12,T13; +/* + .. + .. Executable Statements .. +*/ +/* + Check arguments +*/ + if(!(*which < 1 || *which > 4)) goto S30; + if(!(*which < 1)) goto S10; + *bound = 1.0e0; + goto S20; +S10: + *bound = 4.0e0; +S20: + *status = -1; + return; +S30: + if(*which == 1) goto S70; +/* + P +*/ + if(!(*p < 0.0e0 || *p > one)) goto S60; + if(!(*p < 0.0e0)) goto S40; + *bound = 0.0e0; + goto S50; +S40: + *bound = one; +S50: + *status = -2; + return; +S70: +S60: + if(*which == 2) goto S90; +/* + X +*/ + if(!(*x < 0.0e0)) goto S80; + *bound = 0.0e0; + *status = -4; + return; +S90: +S80: + if(*which == 3) goto S110; +/* + DF +*/ + if(!(*df <= 0.0e0)) goto S100; + *bound = 0.0e0; + *status = -5; + return; +S110: +S100: + if(*which == 4) goto S130; +/* + PNONC +*/ + if(!(*pnonc < 0.0e0)) goto S120; + *bound = 0.0e0; + *status = -6; + return; +S130: +S120: +/* + Calculate ANSWERS +*/ + if(1 == *which) { +/* + Calculating P and Q +*/ + cumchn(x,df,pnonc,p,q); + *status = 0; + } + else if(2 == *which) { +/* + Calculating X +*/ + *x = 5.0e0; + T2 = inf; + T5 = atol; + T6 = tol; + dstinv(&K1,&T2,&K3,&K3,&K4,&T5,&T6); + *status = 0; + dinvr(status,x,&fx,&qleft,&qhi); +S140: + if(!(*status == 1)) goto S150; + cumchn(x,df,pnonc,&cum,&ccum); + fx = cum-*p; + dinvr(status,x,&fx,&qleft,&qhi); + goto S140; +S150: + if(!(*status == -1)) goto S180; + if(!qleft) goto S160; + *status = 1; + *bound = 0.0e0; + goto S170; +S160: + *status = 2; + *bound = inf; +S180: +S170: + ; + } + else if(3 == *which) { +/* + Calculating DF +*/ + *df = 5.0e0; + T7 = zero; + T8 = inf; + T9 = atol; + T10 = tol; + dstinv(&T7,&T8,&K3,&K3,&K4,&T9,&T10); + *status = 0; + dinvr(status,df,&fx,&qleft,&qhi); +S190: + if(!(*status == 1)) goto S200; + cumchn(x,df,pnonc,&cum,&ccum); + fx = cum-*p; + dinvr(status,df,&fx,&qleft,&qhi); + goto S190; +S200: + if(!(*status == -1)) goto S230; + if(!qleft) goto S210; + *status = 1; + *bound = zero; + goto S220; +S210: + *status = 2; + *bound = inf; +S230: +S220: + ; + } + else if(4 == *which) { +/* + Calculating PNONC +*/ + *pnonc = 5.0e0; + T11 = tent4; + T12 = atol; + T13 = tol; + dstinv(&K1,&T11,&K3,&K3,&K4,&T12,&T13); + *status = 0; + dinvr(status,pnonc,&fx,&qleft,&qhi); +S240: + if(!(*status == 1)) goto S250; + cumchn(x,df,pnonc,&cum,&ccum); + fx = cum-*p; + dinvr(status,pnonc,&fx,&qleft,&qhi); + goto S240; +S250: + if(!(*status == -1)) goto S280; + if(!qleft) goto S260; + *status = 1; + *bound = zero; + goto S270; +S260: + *status = 2; + *bound = tent4; +S270: + ; + } +S280: + return; +#undef tent4 +#undef tol +#undef atol +#undef zero +#undef one +#undef inf +} /* END */ + +/***=====================================================================***/ +static void cdff(int *which,double *p,double *q,double *f,double *dfn, + double *dfd,int *status,double *bound) +/********************************************************************** + + void cdff(int *which,double *p,double *q,double *f,double *dfn, + double *dfd,int *status,double *bound) + + Cumulative Distribution Function + F distribution + + + Function + + + Calculates any one parameter of the F distribution + given values for the others. + + + Arguments + + + WHICH --> Integer indicating which of the next four argument + values is to be calculated from the others. + Legal range: 1..4 + iwhich = 1 : Calculate P and Q from F,DFN and DFD + iwhich = 2 : Calculate F from P,Q,DFN and DFD + iwhich = 3 : Calculate DFN from P,Q,F and DFD + iwhich = 4 : Calculate DFD from P,Q,F and DFN + + P <--> The integral from 0 to F of the f-density. + Input range: [0,1]. + + Q <--> 1-P. + Input range: (0, 1]. + P + Q = 1.0. + + F <--> Upper limit of integration of the f-density. + Input range: [0, +infinity). + Search range: [0,1E300] + + DFN < --> Degrees of freedom of the numerator sum of squares. + Input range: (0, +infinity). + Search range: [ 1E-300, 1E300] + + DFD < --> Degrees of freedom of the denominator sum of squares. + Input range: (0, +infinity). + Search range: [ 1E-300, 1E300] + + STATUS <-- 0 if calculation completed correctly + -I if input parameter number I is out of range + 1 if answer appears to be lower than lowest + search bound + 2 if answer appears to be higher than greatest + search bound + 3 if P + Q .ne. 1 + + BOUND <-- Undefined if STATUS is 0 + + Bound exceeded by parameter number I if STATUS + is negative. + + Lower search bound if STATUS is 1. + + Upper search bound if STATUS is 2. + + + Method + + + Formula 26.6.2 of Abramowitz and Stegun, Handbook of + Mathematical Functions (1966) is used to reduce the computation + of the cumulative distribution function for the F variate to + that of an incomplete beta. + + Computation of other parameters involve a seach for a value that + produces the desired value of P. The search relies on the + monotinicity of P with the other parameter. + + WARNING + + The value of the cumulative F distribution is not necessarily + monotone in either degrees of freedom. There thus may be two + values that provide a given CDF value. This routine assumes + monotonicity and will find an arbitrary one of the two values. + +**********************************************************************/ +{ +#define tol (1.0e-8) +#define atol (1.0e-50) +#define zero (1.0e-300) +#define inf 1.0e300 +static int K1 = 1; +static double K2 = 0.0e0; +static double K4 = 0.5e0; +static double K5 = 5.0e0; +static double pq,fx,cum,ccum; +static unsigned long qhi,qleft,qporq; +static double T3,T6,T7,T8,T9,T10,T11,T12,T13,T14,T15; +/* + .. + .. Executable Statements .. +*/ +/* + Check arguments +*/ + if(!(*which < 1 || *which > 4)) goto S30; + if(!(*which < 1)) goto S10; + *bound = 1.0e0; + goto S20; +S10: + *bound = 4.0e0; +S20: + *status = -1; + return; +S30: + if(*which == 1) goto S70; +/* + P +*/ + if(!(*p < 0.0e0 || *p > 1.0e0)) goto S60; + if(!(*p < 0.0e0)) goto S40; + *bound = 0.0e0; + goto S50; +S40: + *bound = 1.0e0; +S50: + *status = -2; + return; +S70: +S60: + if(*which == 1) goto S110; +/* + Q +*/ + if(!(*q <= 0.0e0 || *q > 1.0e0)) goto S100; + if(!(*q <= 0.0e0)) goto S80; + *bound = 0.0e0; + goto S90; +S80: + *bound = 1.0e0; +S90: + *status = -3; + return; +S110: +S100: + if(*which == 2) goto S130; +/* + F +*/ + if(!(*f < 0.0e0)) goto S120; + *bound = 0.0e0; + *status = -4; + return; +S130: +S120: + if(*which == 3) goto S150; +/* + DFN +*/ + if(!(*dfn <= 0.0e0)) goto S140; + *bound = 0.0e0; + *status = -5; + return; +S150: +S140: + if(*which == 4) goto S170; +/* + DFD +*/ + if(!(*dfd <= 0.0e0)) goto S160; + *bound = 0.0e0; + *status = -6; + return; +S170: +S160: + if(*which == 1) goto S210; +/* + P + Q +*/ + pq = *p+*q; + if(!(fabs(pq-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S200; + if(!(pq < 0.0e0)) goto S180; + *bound = 0.0e0; + goto S190; +S180: + *bound = 1.0e0; +S190: + *status = 3; + return; +S210: +S200: + if(!(*which == 1)) qporq = *p <= *q; +/* + Select the minimum of P or Q + Calculate ANSWERS +*/ + if(1 == *which) { +/* + Calculating P +*/ + cumf(f,dfn,dfd,p,q); + *status = 0; + } + else if(2 == *which) { +/* + Calculating F +*/ + *f = 5.0e0; + T3 = inf; + T6 = atol; + T7 = tol; + dstinv(&K2,&T3,&K4,&K4,&K5,&T6,&T7); + *status = 0; + dinvr(status,f,&fx,&qleft,&qhi); +S220: + if(!(*status == 1)) goto S250; + cumf(f,dfn,dfd,&cum,&ccum); + if(!qporq) goto S230; + fx = cum-*p; + goto S240; +S230: + fx = ccum-*q; +S240: + dinvr(status,f,&fx,&qleft,&qhi); + goto S220; +S250: + if(!(*status == -1)) goto S280; + if(!qleft) goto S260; + *status = 1; + *bound = 0.0e0; + goto S270; +S260: + *status = 2; + *bound = inf; +S280: +S270: + ; + } + else if(3 == *which) { +/* + Calculating DFN +*/ + *dfn = 5.0e0; + T8 = zero; + T9 = inf; + T10 = atol; + T11 = tol; + dstinv(&T8,&T9,&K4,&K4,&K5,&T10,&T11); + *status = 0; + dinvr(status,dfn,&fx,&qleft,&qhi); +S290: + if(!(*status == 1)) goto S320; + cumf(f,dfn,dfd,&cum,&ccum); + if(!qporq) goto S300; + fx = cum-*p; + goto S310; +S300: + fx = ccum-*q; +S310: + dinvr(status,dfn,&fx,&qleft,&qhi); + goto S290; +S320: + if(!(*status == -1)) goto S350; + if(!qleft) goto S330; + *status = 1; + *bound = zero; + goto S340; +S330: + *status = 2; + *bound = inf; +S350: +S340: + ; + } + else if(4 == *which) { +/* + Calculating DFD +*/ + *dfd = 5.0e0; + T12 = zero; + T13 = inf; + T14 = atol; + T15 = tol; + dstinv(&T12,&T13,&K4,&K4,&K5,&T14,&T15); + *status = 0; + dinvr(status,dfd,&fx,&qleft,&qhi); +S360: + if(!(*status == 1)) goto S390; + cumf(f,dfn,dfd,&cum,&ccum); + if(!qporq) goto S370; + fx = cum-*p; + goto S380; +S370: + fx = ccum-*q; +S380: + dinvr(status,dfd,&fx,&qleft,&qhi); + goto S360; +S390: + if(!(*status == -1)) goto S420; + if(!qleft) goto S400; + *status = 1; + *bound = zero; + goto S410; +S400: + *status = 2; + *bound = inf; +S410: + ; + } +S420: + return; +#undef tol +#undef atol +#undef zero +#undef inf +} /* END */ + +/***=====================================================================***/ +static void cdffnc(int *which,double *p,double *q,double *f,double *dfn, + double *dfd,double *phonc,int *status,double *bound) +/********************************************************************** + + void cdffnc(int *which,double *p,double *q,double *f,double *dfn, + double *dfd,double *phonc,int *status,double *bound) + + Cumulative Distribution Function + Non-central F distribution + + + Function + + + Calculates any one parameter of the Non-central F + distribution given values for the others. + + + Arguments + + + WHICH --> Integer indicating which of the next five argument + values is to be calculated from the others. + Legal range: 1..5 + iwhich = 1 : Calculate P and Q from F,DFN,DFD and PNONC + iwhich = 2 : Calculate F from P,Q,DFN,DFD and PNONC + iwhich = 3 : Calculate DFN from P,Q,F,DFD and PNONC + iwhich = 4 : Calculate DFD from P,Q,F,DFN and PNONC + iwhich = 5 : Calculate PNONC from P,Q,F,DFN and DFD + + P <--> The integral from 0 to F of the non-central f-density. + Input range: [0,1-1E-16). + + Q <--> 1-P. + Q is not used by this subroutine and is only included + for similarity with other cdf* routines. + + F <--> Upper limit of integration of the non-central f-density. + Input range: [0, +infinity). + Search range: [0,1E300] + + DFN < --> Degrees of freedom of the numerator sum of squares. + Input range: (0, +infinity). + Search range: [ 1E-300, 1E300] + + DFD < --> Degrees of freedom of the denominator sum of squares. + Must be in range: (0, +infinity). + Input range: (0, +infinity). + Search range: [ 1E-300, 1E300] + + PNONC <-> The non-centrality parameter + Input range: [0,infinity) + Search range: [0,1E4] + + STATUS <-- 0 if calculation completed correctly + -I if input parameter number I is out of range + 1 if answer appears to be lower than lowest + search bound + 2 if answer appears to be higher than greatest + search bound + 3 if P + Q .ne. 1 + + BOUND <-- Undefined if STATUS is 0 + + Bound exceeded by parameter number I if STATUS + is negative. + + Lower search bound if STATUS is 1. + + Upper search bound if STATUS is 2. + + + Method + + + Formula 26.6.20 of Abramowitz and Stegun, Handbook of + Mathematical Functions (1966) is used to compute the cumulative + distribution function. + + Computation of other parameters involve a seach for a value that + produces the desired value of P. The search relies on the + monotinicity of P with the other parameter. + + WARNING + + The computation time required for this routine is proportional + to the noncentrality parameter (PNONC). Very large values of + this parameter can consume immense computer resources. This is + why the search range is bounded by 10,000. + + WARNING + + The value of the cumulative noncentral F distribution is not + necessarily monotone in either degrees of freedom. There thus + may be two values that provide a given CDF value. This routine + assumes monotonicity and will find an arbitrary one of the two + values. + +**********************************************************************/ +{ +#define tent4 1.0e4 +#define tol (1.0e-8) +#define atol (1.0e-50) +#define zero (1.0e-300) +#define one (1.0e0-1.0e-16) +#define inf 1.0e300 +static double K1 = 0.0e0; +static double K3 = 0.5e0; +static double K4 = 5.0e0; +static double fx,cum,ccum; +static unsigned long qhi,qleft; +static double T2,T5,T6,T7,T8,T9,T10,T11,T12,T13,T14,T15,T16,T17; +/* + .. + .. Executable Statements .. +*/ +/* + Check arguments +*/ + if(!(*which < 1 || *which > 5)) goto S30; + if(!(*which < 1)) goto S10; + *bound = 1.0e0; + goto S20; +S10: + *bound = 5.0e0; +S20: + *status = -1; + return; +S30: + if(*which == 1) goto S70; +/* + P +*/ + if(!(*p < 0.0e0 || *p > one)) goto S60; + if(!(*p < 0.0e0)) goto S40; + *bound = 0.0e0; + goto S50; +S40: + *bound = one; +S50: + *status = -2; + return; +S70: +S60: + if(*which == 2) goto S90; +/* + F +*/ + if(!(*f < 0.0e0)) goto S80; + *bound = 0.0e0; + *status = -4; + return; +S90: +S80: + if(*which == 3) goto S110; +/* + DFN +*/ + if(!(*dfn <= 0.0e0)) goto S100; + *bound = 0.0e0; + *status = -5; + return; +S110: +S100: + if(*which == 4) goto S130; +/* + DFD +*/ + if(!(*dfd <= 0.0e0)) goto S120; + *bound = 0.0e0; + *status = -6; + return; +S130: +S120: + if(*which == 5) goto S150; +/* + PHONC +*/ + if(!(*phonc < 0.0e0)) goto S140; + *bound = 0.0e0; + *status = -7; + return; +S150: +S140: +/* + Calculate ANSWERS +*/ + if(1 == *which) { +/* + Calculating P +*/ + cumfnc(f,dfn,dfd,phonc,p,q); + *status = 0; + } + else if(2 == *which) { +/* + Calculating F +*/ + *f = 5.0e0; + T2 = inf; + T5 = atol; + T6 = tol; + dstinv(&K1,&T2,&K3,&K3,&K4,&T5,&T6); + *status = 0; + dinvr(status,f,&fx,&qleft,&qhi); +S160: + if(!(*status == 1)) goto S170; + cumfnc(f,dfn,dfd,phonc,&cum,&ccum); + fx = cum-*p; + dinvr(status,f,&fx,&qleft,&qhi); + goto S160; +S170: + if(!(*status == -1)) goto S200; + if(!qleft) goto S180; + *status = 1; + *bound = 0.0e0; + goto S190; +S180: + *status = 2; + *bound = inf; +S200: +S190: + ; + } + else if(3 == *which) { +/* + Calculating DFN +*/ + *dfn = 5.0e0; + T7 = zero; + T8 = inf; + T9 = atol; + T10 = tol; + dstinv(&T7,&T8,&K3,&K3,&K4,&T9,&T10); + *status = 0; + dinvr(status,dfn,&fx,&qleft,&qhi); +S210: + if(!(*status == 1)) goto S220; + cumfnc(f,dfn,dfd,phonc,&cum,&ccum); + fx = cum-*p; + dinvr(status,dfn,&fx,&qleft,&qhi); + goto S210; +S220: + if(!(*status == -1)) goto S250; + if(!qleft) goto S230; + *status = 1; + *bound = zero; + goto S240; +S230: + *status = 2; + *bound = inf; +S250: +S240: + ; + } + else if(4 == *which) { +/* + Calculating DFD +*/ + *dfd = 5.0e0; + T11 = zero; + T12 = inf; + T13 = atol; + T14 = tol; + dstinv(&T11,&T12,&K3,&K3,&K4,&T13,&T14); + *status = 0; + dinvr(status,dfd,&fx,&qleft,&qhi); +S260: + if(!(*status == 1)) goto S270; + cumfnc(f,dfn,dfd,phonc,&cum,&ccum); + fx = cum-*p; + dinvr(status,dfd,&fx,&qleft,&qhi); + goto S260; +S270: + if(!(*status == -1)) goto S300; + if(!qleft) goto S280; + *status = 1; + *bound = zero; + goto S290; +S280: + *status = 2; + *bound = inf; +S300: +S290: + ; + } + else if(5 == *which) { +/* + Calculating PHONC +*/ + *phonc = 5.0e0; + T15 = tent4; + T16 = atol; + T17 = tol; + dstinv(&K1,&T15,&K3,&K3,&K4,&T16,&T17); + *status = 0; + dinvr(status,phonc,&fx,&qleft,&qhi); +S310: + if(!(*status == 1)) goto S320; + cumfnc(f,dfn,dfd,phonc,&cum,&ccum); + fx = cum-*p; + dinvr(status,phonc,&fx,&qleft,&qhi); + goto S310; +S320: + if(!(*status == -1)) goto S350; + if(!qleft) goto S330; + *status = 1; + *bound = 0.0e0; + goto S340; +S330: + *status = 2; + *bound = tent4; +S340: + ; + } +S350: + return; +#undef tent4 +#undef tol +#undef atol +#undef zero +#undef one +#undef inf +} /* END */ + +/***=====================================================================***/ +static void cdfgam(int *which,double *p,double *q,double *x,double *shape, + double *scale,int *status,double *bound) +/********************************************************************** + + void cdfgam(int *which,double *p,double *q,double *x,double *shape, + double *scale,int *status,double *bound) + + Cumulative Distribution Function + GAMma Distribution + + + Function + + + Calculates any one parameter of the gamma + distribution given values for the others. + + + Arguments + + + WHICH --> Integer indicating which of the next four argument + values is to be calculated from the others. + Legal range: 1..4 + iwhich = 1 : Calculate P and Q from X,SHAPE and SCALE + iwhich = 2 : Calculate X from P,Q,SHAPE and SCALE + iwhich = 3 : Calculate SHAPE from P,Q,X and SCALE + iwhich = 4 : Calculate SCALE from P,Q,X and SHAPE + + P <--> The integral from 0 to X of the gamma density. + Input range: [0,1]. + + Q <--> 1-P. + Input range: (0, 1]. + P + Q = 1.0. + + X <--> The upper limit of integration of the gamma density. + Input range: [0, +infinity). + Search range: [0,1E300] + + SHAPE <--> The shape parameter of the gamma density. + Input range: (0, +infinity). + Search range: [1E-300,1E300] + + SCALE <--> The scale parameter of the gamma density. + Input range: (0, +infinity). + Search range: (1E-300,1E300] + + STATUS <-- 0 if calculation completed correctly + -I if input parameter number I is out of range + 1 if answer appears to be lower than lowest + search bound + 2 if answer appears to be higher than greatest + search bound + 3 if P + Q .ne. 1 + 10 if the gamma or inverse gamma routine cannot + compute the answer. Usually happens only for + X and SHAPE very large (gt 1E10 or more) + + BOUND <-- Undefined if STATUS is 0 + + Bound exceeded by parameter number I if STATUS + is negative. + + Lower search bound if STATUS is 1. + + Upper search bound if STATUS is 2. + + + Method + + + Cumulative distribution function (P) is calculated directly by + the code associated with: + + DiDinato, A. R. and Morris, A. H. Computation of the incomplete + gamma function ratios and their inverse. ACM Trans. Math. + Softw. 12 (1986), 377-393. + + Computation of other parameters involve a seach for a value that + produces the desired value of P. The search relies on the + monotinicity of P with the other parameter. + + + Note + + + + The gamma density is proportional to + T**(SHAPE - 1) * EXP(- SCALE * T) + +**********************************************************************/ +{ +#define tol (1.0e-8) +#define atol (1.0e-50) +#define zero (1.0e-300) +#define inf 1.0e300 +static int K1 = 1; +static double K5 = 0.5e0; +static double K6 = 5.0e0; +static double xx,fx,xscale,cum,ccum,pq,porq; +static int ierr; +static unsigned long qhi,qleft,qporq; +static double T2,T3,T4,T7,T8,T9; +/* + .. + .. Executable Statements .. +*/ +/* + Check arguments +*/ + if(!(*which < 1 || *which > 4)) goto S30; + if(!(*which < 1)) goto S10; + *bound = 1.0e0; + goto S20; +S10: + *bound = 4.0e0; +S20: + *status = -1; + return; +S30: + if(*which == 1) goto S70; +/* + P +*/ + if(!(*p < 0.0e0 || *p > 1.0e0)) goto S60; + if(!(*p < 0.0e0)) goto S40; + *bound = 0.0e0; + goto S50; +S40: + *bound = 1.0e0; +S50: + *status = -2; + return; +S70: +S60: + if(*which == 1) goto S110; +/* + Q +*/ + if(!(*q <= 0.0e0 || *q > 1.0e0)) goto S100; + if(!(*q <= 0.0e0)) goto S80; + *bound = 0.0e0; + goto S90; +S80: + *bound = 1.0e0; +S90: + *status = -3; + return; +S110: +S100: + if(*which == 2) goto S130; +/* + X +*/ + if(!(*x < 0.0e0)) goto S120; + *bound = 0.0e0; + *status = -4; + return; +S130: +S120: + if(*which == 3) goto S150; +/* + SHAPE +*/ + if(!(*shape <= 0.0e0)) goto S140; + *bound = 0.0e0; + *status = -5; + return; +S150: +S140: + if(*which == 4) goto S170; +/* + SCALE +*/ + if(!(*scale <= 0.0e0)) goto S160; + *bound = 0.0e0; + *status = -6; + return; +S170: +S160: + if(*which == 1) goto S210; +/* + P + Q +*/ + pq = *p+*q; + if(!(fabs(pq-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S200; + if(!(pq < 0.0e0)) goto S180; + *bound = 0.0e0; + goto S190; +S180: + *bound = 1.0e0; +S190: + *status = 3; + return; +S210: +S200: + if(*which == 1) goto S240; +/* + Select the minimum of P or Q +*/ + qporq = *p <= *q; + if(!qporq) goto S220; + porq = *p; + goto S230; +S220: + porq = *q; +S240: +S230: +/* + Calculate ANSWERS +*/ + if(1 == *which) { +/* + Calculating P +*/ + *status = 0; + xscale = *x**scale; + cumgam(&xscale,shape,p,q); + if(porq > 1.5e0) *status = 10; + } + else if(2 == *which) { +/* + Computing X +*/ + T2 = -1.0e0; + gaminv(shape,&xx,&T2,p,q,&ierr); + if(ierr < 0.0e0) { + *status = 10; + return; + } + else { + *x = xx/ *scale; + *status = 0; + } + } + else if(3 == *which) { +/* + Computing SHAPE +*/ + *shape = 5.0e0; + xscale = *x**scale; + T3 = zero; + T4 = inf; + T7 = atol; + T8 = tol; + dstinv(&T3,&T4,&K5,&K5,&K6,&T7,&T8); + *status = 0; + dinvr(status,shape,&fx,&qleft,&qhi); +S250: + if(!(*status == 1)) goto S290; + cumgam(&xscale,shape,&cum,&ccum); + if(!qporq) goto S260; + fx = cum-*p; + goto S270; +S260: + fx = ccum-*q; +S270: + if(!(qporq && cum > 1.5e0 || !qporq && ccum > 1.5e0)) goto S280; + *status = 10; + return; +S280: + dinvr(status,shape,&fx,&qleft,&qhi); + goto S250; +S290: + if(!(*status == -1)) goto S320; + if(!qleft) goto S300; + *status = 1; + *bound = zero; + goto S310; +S300: + *status = 2; + *bound = inf; +S320: +S310: + ; + } + else if(4 == *which) { +/* + Computing SCALE +*/ + T9 = -1.0e0; + gaminv(shape,&xx,&T9,p,q,&ierr); + if(ierr < 0.0e0) { + *status = 10; + return; + } + else { + *scale = xx/ *x; + *status = 0; + } + } + return; +#undef tol +#undef atol +#undef zero +#undef inf +} /* END */ + +/***=====================================================================***/ +static void cdfnbn(int *which,double *p,double *q,double *s,double *xn, + double *pr,double *ompr,int *status,double *bound) +/********************************************************************** + + void cdfnbn(int *which,double *p,double *q,double *s,double *xn, + double *pr,double *ompr,int *status,double *bound) + + Cumulative Distribution Function + Negative BiNomial distribution + + + Function + + + Calculates any one parameter of the negative binomial + distribution given values for the others. + + The cumulative negative binomial distribution returns the + probability that there will be F or fewer failures before the + XNth success in binomial trials each of which has probability of + success PR. + + The individual term of the negative binomial is the probability of + S failures before XN successes and is + Choose( S, XN+S-1 ) * PR^(XN) * (1-PR)^S + + + Arguments + + + WHICH --> Integer indicating which of the next four argument + values is to be calculated from the others. + Legal range: 1..4 + iwhich = 1 : Calculate P and Q from S,XN,PR and OMPR + iwhich = 2 : Calculate S from P,Q,XN,PR and OMPR + iwhich = 3 : Calculate XN from P,Q,S,PR and OMPR + iwhich = 4 : Calculate PR and OMPR from P,Q,S and XN + + P <--> The cumulation from 0 to S of the negative + binomial distribution. + Input range: [0,1]. + + Q <--> 1-P. + Input range: (0, 1]. + P + Q = 1.0. + + S <--> The upper limit of cumulation of the binomial distribution. + There are F or fewer failures before the XNth success. + Input range: [0, +infinity). + Search range: [0, 1E300] + + XN <--> The number of successes. + Input range: [0, +infinity). + Search range: [0, 1E300] + + PR <--> The probability of success in each binomial trial. + Input range: [0,1]. + Search range: [0,1]. + + OMPR <--> 1-PR + Input range: [0,1]. + Search range: [0,1] + PR + OMPR = 1.0 + + STATUS <-- 0 if calculation completed correctly + -I if input parameter number I is out of range + 1 if answer appears to be lower than lowest + search bound + 2 if answer appears to be higher than greatest + search bound + 3 if P + Q .ne. 1 + 4 if PR + OMPR .ne. 1 + + BOUND <-- Undefined if STATUS is 0 + + Bound exceeded by parameter number I if STATUS + is negative. + + Lower search bound if STATUS is 1. + + Upper search bound if STATUS is 2. + + + Method + + + Formula 26.5.26 of Abramowitz and Stegun, Handbook of + Mathematical Functions (1966) is used to reduce calculation of + the cumulative distribution function to that of an incomplete + beta. + + Computation of other parameters involve a seach for a value that + produces the desired value of P. The search relies on the + monotinicity of P with the other parameter. + +**********************************************************************/ +{ +#define tol (1.0e-8) +#define atol (1.0e-50) +#define inf 1.0e300 +#define one 1.0e0 +static int K1 = 1; +static double K2 = 0.0e0; +static double K4 = 0.5e0; +static double K5 = 5.0e0; +static double K11 = 1.0e0; +static double fx,xhi,xlo,pq,prompr,cum,ccum; +static unsigned long qhi,qleft,qporq; +static double T3,T6,T7,T8,T9,T10,T12,T13; +/* + .. + .. Executable Statements .. +*/ +/* + Check arguments +*/ + if(!(*which < 1 || *which > 4)) goto S30; + if(!(*which < 1)) goto S10; + *bound = 1.0e0; + goto S20; +S10: + *bound = 4.0e0; +S20: + *status = -1; + return; +S30: + if(*which == 1) goto S70; +/* + P +*/ + if(!(*p < 0.0e0 || *p > 1.0e0)) goto S60; + if(!(*p < 0.0e0)) goto S40; + *bound = 0.0e0; + goto S50; +S40: + *bound = 1.0e0; +S50: + *status = -2; + return; +S70: +S60: + if(*which == 1) goto S110; +/* + Q +*/ + if(!(*q <= 0.0e0 || *q > 1.0e0)) goto S100; + if(!(*q <= 0.0e0)) goto S80; + *bound = 0.0e0; + goto S90; +S80: + *bound = 1.0e0; +S90: + *status = -3; + return; +S110: +S100: + if(*which == 2) goto S130; +/* + S +*/ + if(!(*s < 0.0e0)) goto S120; + *bound = 0.0e0; + *status = -4; + return; +S130: +S120: + if(*which == 3) goto S150; +/* + XN +*/ + if(!(*xn < 0.0e0)) goto S140; + *bound = 0.0e0; + *status = -5; + return; +S150: +S140: + if(*which == 4) goto S190; +/* + PR +*/ + if(!(*pr < 0.0e0 || *pr > 1.0e0)) goto S180; + if(!(*pr < 0.0e0)) goto S160; + *bound = 0.0e0; + goto S170; +S160: + *bound = 1.0e0; +S170: + *status = -6; + return; +S190: +S180: + if(*which == 4) goto S230; +/* + OMPR +*/ + if(!(*ompr < 0.0e0 || *ompr > 1.0e0)) goto S220; + if(!(*ompr < 0.0e0)) goto S200; + *bound = 0.0e0; + goto S210; +S200: + *bound = 1.0e0; +S210: + *status = -7; + return; +S230: +S220: + if(*which == 1) goto S270; +/* + P + Q +*/ + pq = *p+*q; + if(!(fabs(pq-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S260; + if(!(pq < 0.0e0)) goto S240; + *bound = 0.0e0; + goto S250; +S240: + *bound = 1.0e0; +S250: + *status = 3; + return; +S270: +S260: + if(*which == 4) goto S310; +/* + PR + OMPR +*/ + prompr = *pr+*ompr; + if(!(fabs(prompr-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S300; + if(!(prompr < 0.0e0)) goto S280; + *bound = 0.0e0; + goto S290; +S280: + *bound = 1.0e0; +S290: + *status = 4; + return; +S310: +S300: + if(!(*which == 1)) qporq = *p <= *q; +/* + Select the minimum of P or Q + Calculate ANSWERS +*/ + if(1 == *which) { +/* + Calculating P +*/ + cumnbn(s,xn,pr,ompr,p,q); + *status = 0; + } + else if(2 == *which) { +/* + Calculating S +*/ + *s = 5.0e0; + T3 = inf; + T6 = atol; + T7 = tol; + dstinv(&K2,&T3,&K4,&K4,&K5,&T6,&T7); + *status = 0; + dinvr(status,s,&fx,&qleft,&qhi); +S320: + if(!(*status == 1)) goto S350; + cumnbn(s,xn,pr,ompr,&cum,&ccum); + if(!qporq) goto S330; + fx = cum-*p; + goto S340; +S330: + fx = ccum-*q; +S340: + dinvr(status,s,&fx,&qleft,&qhi); + goto S320; +S350: + if(!(*status == -1)) goto S380; + if(!qleft) goto S360; + *status = 1; + *bound = 0.0e0; + goto S370; +S360: + *status = 2; + *bound = inf; +S380: +S370: + ; + } + else if(3 == *which) { +/* + Calculating XN +*/ + *xn = 5.0e0; + T8 = inf; + T9 = atol; + T10 = tol; + dstinv(&K2,&T8,&K4,&K4,&K5,&T9,&T10); + *status = 0; + dinvr(status,xn,&fx,&qleft,&qhi); +S390: + if(!(*status == 1)) goto S420; + cumnbn(s,xn,pr,ompr,&cum,&ccum); + if(!qporq) goto S400; + fx = cum-*p; + goto S410; +S400: + fx = ccum-*q; +S410: + dinvr(status,xn,&fx,&qleft,&qhi); + goto S390; +S420: + if(!(*status == -1)) goto S450; + if(!qleft) goto S430; + *status = 1; + *bound = 0.0e0; + goto S440; +S430: + *status = 2; + *bound = inf; +S450: +S440: + ; + } + else if(4 == *which) { +/* + Calculating PR and OMPR +*/ + T12 = atol; + T13 = tol; + dstzr(&K2,&K11,&T12,&T13); + if(!qporq) goto S480; + *status = 0; + dzror(status,pr,&fx,&xlo,&xhi,&qleft,&qhi); + *ompr = one-*pr; +S460: + if(!(*status == 1)) goto S470; + cumnbn(s,xn,pr,ompr,&cum,&ccum); + fx = cum-*p; + dzror(status,pr,&fx,&xlo,&xhi,&qleft,&qhi); + *ompr = one-*pr; + goto S460; +S470: + goto S510; +S480: + *status = 0; + dzror(status,ompr,&fx,&xlo,&xhi,&qleft,&qhi); + *pr = one-*ompr; +S490: + if(!(*status == 1)) goto S500; + cumnbn(s,xn,pr,ompr,&cum,&ccum); + fx = ccum-*q; + dzror(status,ompr,&fx,&xlo,&xhi,&qleft,&qhi); + *pr = one-*ompr; + goto S490; +S510: +S500: + if(!(*status == -1)) goto S540; + if(!qleft) goto S520; + *status = 1; + *bound = 0.0e0; + goto S530; +S520: + *status = 2; + *bound = 1.0e0; +S530: + ; + } +S540: + return; +#undef tol +#undef atol +#undef inf +#undef one +} /* END */ + +/***=====================================================================***/ +static void cdfnor(int *which,double *p,double *q,double *x,double *mean, + double *sd,int *status,double *bound) +/********************************************************************** + + void cdfnor(int *which,double *p,double *q,double *x,double *mean, + double *sd,int *status,double *bound) + + Cumulative Distribution Function + NORmal distribution + + + Function + + + Calculates any one parameter of the normal + distribution given values for the others. + + + Arguments + + + WHICH --> Integer indicating which of the next parameter + values is to be calculated using values of the others. + Legal range: 1..4 + iwhich = 1 : Calculate P and Q from X,MEAN and SD + iwhich = 2 : Calculate X from P,Q,MEAN and SD + iwhich = 3 : Calculate MEAN from P,Q,X and SD + iwhich = 4 : Calculate SD from P,Q,X and MEAN + + P <--> The integral from -infinity to X of the normal density. + Input range: (0,1]. + + Q <--> 1-P. + Input range: (0, 1]. + P + Q = 1.0. + + X < --> Upper limit of integration of the normal-density. + Input range: ( -infinity, +infinity) + + MEAN <--> The mean of the normal density. + Input range: (-infinity, +infinity) + + SD <--> Standard Deviation of the normal density. + Input range: (0, +infinity). + + STATUS <-- 0 if calculation completed correctly + -I if input parameter number I is out of range + 1 if answer appears to be lower than lowest + search bound + 2 if answer appears to be higher than greatest + search bound + 3 if P + Q .ne. 1 + + BOUND <-- Undefined if STATUS is 0 + + Bound exceeded by parameter number I if STATUS + is negative. + + Lower search bound if STATUS is 1. + + Upper search bound if STATUS is 2. + + + Method + + + + + A slightly modified version of ANORM from + + Cody, W.D. (1993). "ALGORITHM 715: SPECFUN - A Portabel FORTRAN + Package of Special Function Routines and Test Drivers" + acm Transactions on Mathematical Software. 19, 22-32. + + is used to calulate the cumulative standard normal distribution. + + The rational functions from pages 90-95 of Kennedy and Gentle, + Statistical Computing, Marcel Dekker, NY, 1980 are used as + starting values to Newton's Iterations which compute the inverse + standard normal. Therefore no searches are necessary for any + parameter. + + For X < -15, the asymptotic expansion for the normal is used as + the starting value in finding the inverse standard normal. + This is formula 26.2.12 of Abramowitz and Stegun. + + + Note + + + The normal density is proportional to + exp( - 0.5 * (( X - MEAN)/SD)**2) + +**********************************************************************/ +{ +static int K1 = 1; +static double z,pq; +/* + .. + .. Executable Statements .. +*/ +/* + Check arguments +*/ + *status = 0; + if(!(*which < 1 || *which > 4)) goto S30; + if(!(*which < 1)) goto S10; + *bound = 1.0e0; + goto S20; +S10: + *bound = 4.0e0; +S20: + *status = -1; + return; +S30: + if(*which == 1) goto S70; +/* + P +*/ + if(!(*p <= 0.0e0 || *p > 1.0e0)) goto S60; + if(!(*p <= 0.0e0)) goto S40; + *bound = 0.0e0; + goto S50; +S40: + *bound = 1.0e0; +S50: + *status = -2; + return; +S70: +S60: + if(*which == 1) goto S110; +/* + Q +*/ + if(!(*q <= 0.0e0 || *q > 1.0e0)) goto S100; + if(!(*q <= 0.0e0)) goto S80; + *bound = 0.0e0; + goto S90; +S80: + *bound = 1.0e0; +S90: + *status = -3; + return; +S110: +S100: + if(*which == 1) goto S150; +/* + P + Q +*/ + pq = *p+*q; + if(!(fabs(pq-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S140; + if(!(pq < 0.0e0)) goto S120; + *bound = 0.0e0; + goto S130; +S120: + *bound = 1.0e0; +S130: + *status = 3; + return; +S150: +S140: + if(*which == 4) goto S170; +/* + SD +*/ + if(!(*sd <= 0.0e0)) goto S160; + *bound = 0.0e0; + *status = -6; + return; +S170: +S160: +/* + Calculate ANSWERS +*/ + if(1 == *which) { +/* + Computing P +*/ + z = (*x-*mean)/ *sd; + cumnor(&z,p,q); + } + else if(2 == *which) { +/* + Computing X +*/ + z = dinvnr(p,q); + *x = *sd*z+*mean; + } + else if(3 == *which) { +/* + Computing the MEAN +*/ + z = dinvnr(p,q); + *mean = *x-*sd*z; + } + else if(4 == *which) { +/* + Computing SD +*/ + z = dinvnr(p,q); + *sd = (*x-*mean)/z; + } + return; +} /* END */ + +/***=====================================================================***/ +static void cdfpoi(int *which,double *p,double *q,double *s,double *xlam, + int *status,double *bound) +/********************************************************************** + + void cdfpoi(int *which,double *p,double *q,double *s,double *xlam, + int *status,double *bound) + + Cumulative Distribution Function + POIsson distribution + + + Function + + + Calculates any one parameter of the Poisson + distribution given values for the others. + + + Arguments + + + WHICH --> Integer indicating which argument + value is to be calculated from the others. + Legal range: 1..3 + iwhich = 1 : Calculate P and Q from S and XLAM + iwhich = 2 : Calculate A from P,Q and XLAM + iwhich = 3 : Calculate XLAM from P,Q and S + + P <--> The cumulation from 0 to S of the poisson density. + Input range: [0,1]. + + Q <--> 1-P. + Input range: (0, 1]. + P + Q = 1.0. + + S <--> Upper limit of cumulation of the Poisson. + Input range: [0, +infinity). + Search range: [0,1E300] + + XLAM <--> Mean of the Poisson distribution. + Input range: [0, +infinity). + Search range: [0,1E300] + + STATUS <-- 0 if calculation completed correctly + -I if input parameter number I is out of range + 1 if answer appears to be lower than lowest + search bound + 2 if answer appears to be higher than greatest + search bound + 3 if P + Q .ne. 1 + + BOUND <-- Undefined if STATUS is 0 + + Bound exceeded by parameter number I if STATUS + is negative. + + Lower search bound if STATUS is 1. + + Upper search bound if STATUS is 2. + + + Method + + + Formula 26.4.21 of Abramowitz and Stegun, Handbook of + Mathematical Functions (1966) is used to reduce the computation + of the cumulative distribution function to that of computing a + chi-square, hence an incomplete gamma function. + + Cumulative distribution function (P) is calculated directly. + Computation of other parameters involve a seach for a value that + produces the desired value of P. The search relies on the + monotinicity of P with the other parameter. + +**********************************************************************/ +{ +#define tol (1.0e-8) +#define atol (1.0e-50) +#define inf 1.0e300 +static int K1 = 1; +static double K2 = 0.0e0; +static double K4 = 0.5e0; +static double K5 = 5.0e0; +static double fx,cum,ccum,pq; +static unsigned long qhi,qleft,qporq; +static double T3,T6,T7,T8,T9,T10; +/* + .. + .. Executable Statements .. +*/ +/* + Check arguments +*/ + if(!(*which < 1 || *which > 3)) goto S30; + if(!(*which < 1)) goto S10; + *bound = 1.0e0; + goto S20; +S10: + *bound = 3.0e0; +S20: + *status = -1; + return; +S30: + if(*which == 1) goto S70; +/* + P +*/ + if(!(*p < 0.0e0 || *p > 1.0e0)) goto S60; + if(!(*p < 0.0e0)) goto S40; + *bound = 0.0e0; + goto S50; +S40: + *bound = 1.0e0; +S50: + *status = -2; + return; +S70: +S60: + if(*which == 1) goto S110; +/* + Q +*/ + if(!(*q <= 0.0e0 || *q > 1.0e0)) goto S100; + if(!(*q <= 0.0e0)) goto S80; + *bound = 0.0e0; + goto S90; +S80: + *bound = 1.0e0; +S90: + *status = -3; + return; +S110: +S100: + if(*which == 2) goto S130; +/* + S +*/ + if(!(*s < 0.0e0)) goto S120; + *bound = 0.0e0; + *status = -4; + return; +S130: +S120: + if(*which == 3) goto S150; +/* + XLAM +*/ + if(!(*xlam < 0.0e0)) goto S140; + *bound = 0.0e0; + *status = -5; + return; +S150: +S140: + if(*which == 1) goto S190; +/* + P + Q +*/ + pq = *p+*q; + if(!(fabs(pq-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S180; + if(!(pq < 0.0e0)) goto S160; + *bound = 0.0e0; + goto S170; +S160: + *bound = 1.0e0; +S170: + *status = 3; + return; +S190: +S180: + if(!(*which == 1)) qporq = *p <= *q; +/* + Select the minimum of P or Q + Calculate ANSWERS +*/ + if(1 == *which) { +/* + Calculating P +*/ + cumpoi(s,xlam,p,q); + *status = 0; + } + else if(2 == *which) { +/* + Calculating S +*/ + *s = 5.0e0; + T3 = inf; + T6 = atol; + T7 = tol; + dstinv(&K2,&T3,&K4,&K4,&K5,&T6,&T7); + *status = 0; + dinvr(status,s,&fx,&qleft,&qhi); +S200: + if(!(*status == 1)) goto S230; + cumpoi(s,xlam,&cum,&ccum); + if(!qporq) goto S210; + fx = cum-*p; + goto S220; +S210: + fx = ccum-*q; +S220: + dinvr(status,s,&fx,&qleft,&qhi); + goto S200; +S230: + if(!(*status == -1)) goto S260; + if(!qleft) goto S240; + *status = 1; + *bound = 0.0e0; + goto S250; +S240: + *status = 2; + *bound = inf; +S260: +S250: + ; + } + else if(3 == *which) { +/* + Calculating XLAM +*/ + *xlam = 5.0e0; + T8 = inf; + T9 = atol; + T10 = tol; + dstinv(&K2,&T8,&K4,&K4,&K5,&T9,&T10); + *status = 0; + dinvr(status,xlam,&fx,&qleft,&qhi); +S270: + if(!(*status == 1)) goto S300; + cumpoi(s,xlam,&cum,&ccum); + if(!qporq) goto S280; + fx = cum-*p; + goto S290; +S280: + fx = ccum-*q; +S290: + dinvr(status,xlam,&fx,&qleft,&qhi); + goto S270; +S300: + if(!(*status == -1)) goto S330; + if(!qleft) goto S310; + *status = 1; + *bound = 0.0e0; + goto S320; +S310: + *status = 2; + *bound = inf; +S320: + ; + } +S330: + return; +#undef tol +#undef atol +#undef inf +} /* END */ + +/***=====================================================================***/ +static void cdft(int *which,double *p,double *q,double *t,double *df, + int *status,double *bound) +/********************************************************************** + + void cdft(int *which,double *p,double *q,double *t,double *df, + int *status,double *bound) + + Cumulative Distribution Function + T distribution + + + Function + + + Calculates any one parameter of the t distribution given + values for the others. + + + Arguments + + + WHICH --> Integer indicating which argument + values is to be calculated from the others. + Legal range: 1..3 + iwhich = 1 : Calculate P and Q from T and DF + iwhich = 2 : Calculate T from P,Q and DF + iwhich = 3 : Calculate DF from P,Q and T + + P <--> The integral from -infinity to t of the t-density. + Input range: (0,1]. + + Q <--> 1-P. + Input range: (0, 1]. + P + Q = 1.0. + + T <--> Upper limit of integration of the t-density. + Input range: ( -infinity, +infinity). + Search range: [ -1E300, 1E300 ] + + DF <--> Degrees of freedom of the t-distribution. + Input range: (0 , +infinity). + Search range: [1e-300, 1E10] + + STATUS <-- 0 if calculation completed correctly + -I if input parameter number I is out of range + 1 if answer appears to be lower than lowest + search bound + 2 if answer appears to be higher than greatest + search bound + 3 if P + Q .ne. 1 + + BOUND <-- Undefined if STATUS is 0 + + Bound exceeded by parameter number I if STATUS + is negative. + + Lower search bound if STATUS is 1. + + Upper search bound if STATUS is 2. + + + Method + + + Formula 26.5.27 of Abramowitz and Stegun, Handbook of + Mathematical Functions (1966) is used to reduce the computation + of the cumulative distribution function to that of an incomplete + beta. + + Computation of other parameters involve a seach for a value that + produces the desired value of P. The search relies on the + monotinicity of P with the other parameter. + +**********************************************************************/ +{ +#define tol (1.0e-8) +#define atol (1.0e-50) +#define zero (1.0e-300) +#define inf 1.0e300 +#define maxdf 1.0e10 +static int K1 = 1; +static double K4 = 0.5e0; +static double K5 = 5.0e0; +static double fx,cum,ccum,pq; +static unsigned long qhi,qleft,qporq; +static double T2,T3,T6,T7,T8,T9,T10,T11; +/* + .. + .. Executable Statements .. +*/ +/* + Check arguments +*/ + if(!(*which < 1 || *which > 3)) goto S30; + if(!(*which < 1)) goto S10; + *bound = 1.0e0; + goto S20; +S10: + *bound = 3.0e0; +S20: + *status = -1; + return; +S30: + if(*which == 1) goto S70; +/* + P +*/ + if(!(*p <= 0.0e0 || *p > 1.0e0)) goto S60; + if(!(*p <= 0.0e0)) goto S40; + *bound = 0.0e0; + goto S50; +S40: + *bound = 1.0e0; +S50: + *status = -2; + return; +S70: +S60: + if(*which == 1) goto S110; +/* + Q +*/ + if(!(*q <= 0.0e0 || *q > 1.0e0)) goto S100; + if(!(*q <= 0.0e0)) goto S80; + *bound = 0.0e0; + goto S90; +S80: + *bound = 1.0e0; +S90: + *status = -3; + return; +S110: +S100: + if(*which == 3) goto S130; +/* + DF +*/ + if(!(*df <= 0.0e0)) goto S120; + *bound = 0.0e0; + *status = -5; + return; +S130: +S120: + if(*which == 1) goto S170; +/* + P + Q +*/ + pq = *p+*q; + if(!(fabs(pq-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S160; + if(!(pq < 0.0e0)) goto S140; + *bound = 0.0e0; + goto S150; +S140: + *bound = 1.0e0; +S150: + *status = 3; + return; +S170: +S160: + if(!(*which == 1)) qporq = *p <= *q; +/* + Select the minimum of P or Q + Calculate ANSWERS +*/ + if(1 == *which) { +/* + Computing P and Q +*/ + cumt(t,df,p,q); + *status = 0; + } + else if(2 == *which) { +/* + Computing T + .. Get initial approximation for T +*/ + *t = dt1(p,q,df); + T2 = -inf; + T3 = inf; + T6 = atol; + T7 = tol; + dstinv(&T2,&T3,&K4,&K4,&K5,&T6,&T7); + *status = 0; + dinvr(status,t,&fx,&qleft,&qhi); +S180: + if(!(*status == 1)) goto S210; + cumt(t,df,&cum,&ccum); + if(!qporq) goto S190; + fx = cum-*p; + goto S200; +S190: + fx = ccum-*q; +S200: + dinvr(status,t,&fx,&qleft,&qhi); + goto S180; +S210: + if(!(*status == -1)) goto S240; + if(!qleft) goto S220; + *status = 1; + *bound = -inf; + goto S230; +S220: + *status = 2; + *bound = inf; +S240: +S230: + ; + } + else if(3 == *which) { +/* + Computing DF +*/ + *df = 5.0e0; + T8 = zero; + T9 = maxdf; + T10 = atol; + T11 = tol; + dstinv(&T8,&T9,&K4,&K4,&K5,&T10,&T11); + *status = 0; + dinvr(status,df,&fx,&qleft,&qhi); +S250: + if(!(*status == 1)) goto S280; + cumt(t,df,&cum,&ccum); + if(!qporq) goto S260; + fx = cum-*p; + goto S270; +S260: + fx = ccum-*q; +S270: + dinvr(status,df,&fx,&qleft,&qhi); + goto S250; +S280: + if(!(*status == -1)) goto S310; + if(!qleft) goto S290; + *status = 1; + *bound = zero; + goto S300; +S290: + *status = 2; + *bound = maxdf; +S300: + ; + } +S310: + return; +#undef tol +#undef atol +#undef zero +#undef inf +#undef maxdf +} /* END */ + +/***=====================================================================***/ +static void cumbet(double *x,double *y,double *a,double *b,double *cum, + double *ccum) +/* +********************************************************************** + + void cumbet(double *x,double *y,double *a,double *b,double *cum, + double *ccum) + + Double precision cUMulative incomplete BETa distribution + + + Function + + + Calculates the cdf to X of the incomplete beta distribution + with parameters a and b. This is the integral from 0 to x + of (1/B(a,b))*f(t)) where f(t) = t**(a-1) * (1-t)**(b-1) + + + Arguments + + + X --> Upper limit of integration. + X is DOUBLE PRECISION + + Y --> 1 - X. + Y is DOUBLE PRECISION + + A --> First parameter of the beta distribution. + A is DOUBLE PRECISION + + B --> Second parameter of the beta distribution. + B is DOUBLE PRECISION + + CUM <-- Cumulative incomplete beta distribution. + CUM is DOUBLE PRECISION + + CCUM <-- Compliment of Cumulative incomplete beta distribution. + CCUM is DOUBLE PRECISION + + + Method + + + Calls the routine BRATIO. + + References + + Didonato, Armido R. and Morris, Alfred H. Jr. (1992) Algorithim + 708 Significant Digit Computation of the Incomplete Beta Function + Ratios. ACM ToMS, Vol.18, No. 3, Sept. 1992, 360-373. + +********************************************************************** +*/ +{ +static int ierr; +/* + .. + .. Executable Statements .. +*/ + if(!(*x <= 0.0e0)) goto S10; + *cum = 0.0e0; + *ccum = 1.0e0; + return; +S10: + if(!(*y <= 0.0e0)) goto S20; + *cum = 1.0e0; + *ccum = 0.0e0; + return; +S20: + bratio(a,b,x,y,cum,ccum,&ierr); +/* + Call bratio routine +*/ + return; +} /* END */ + +/***=====================================================================***/ +static void cumbin(double *s,double *xn,double *pr,double *ompr, + double *cum,double *ccum) +/* +********************************************************************** + + void cumbin(double *s,double *xn,double *pr,double *ompr, + double *cum,double *ccum) + + CUmulative BINomial distribution + + + Function + + + Returns the probability of 0 to S successes in XN binomial + trials, each of which has a probability of success, PBIN. + + + Arguments + + + S --> The upper limit of cumulation of the binomial distribution. + S is DOUBLE PRECISION + + XN --> The number of binomial trials. + XN is DOUBLE PRECISIO + + PBIN --> The probability of success in each binomial trial. + PBIN is DOUBLE PRECIS + + OMPR --> 1 - PBIN + OMPR is DOUBLE PRECIS + + CUM <-- Cumulative binomial distribution. + CUM is DOUBLE PRECISI + + CCUM <-- Compliment of Cumulative binomial distribution. + CCUM is DOUBLE PRECIS + + + Method + + + Formula 26.5.24 of Abramowitz and Stegun, Handbook of + Mathematical Functions (1966) is used to reduce the binomial + distribution to the cumulative beta distribution. + +********************************************************************** +*/ +{ +static double T1,T2; +/* + .. + .. Executable Statements .. +*/ + if(!(*s < *xn)) goto S10; + T1 = *s+1.0e0; + T2 = *xn-*s; + cumbet(pr,ompr,&T1,&T2,ccum,cum); + goto S20; +S10: + *cum = 1.0e0; + *ccum = 0.0e0; +S20: + return; +} /* END */ + +/***=====================================================================***/ +static void cumchi(double *x,double *df,double *cum,double *ccum) +/* +********************************************************************** + + void cumchi(double *x,double *df,double *cum,double *ccum) + CUMulative of the CHi-square distribution + + + Function + + + Calculates the cumulative chi-square distribution. + + + Arguments + + + X --> Upper limit of integration of the + chi-square distribution. + X is DOUBLE PRECISION + + DF --> Degrees of freedom of the + chi-square distribution. + DF is DOUBLE PRECISION + + CUM <-- Cumulative chi-square distribution. + CUM is DOUBLE PRECISIO + + CCUM <-- Compliment of Cumulative chi-square distribution. + CCUM is DOUBLE PRECISI + + + Method + + + Calls incomplete gamma function (CUMGAM) + +********************************************************************** +*/ +{ +static double a,xx; +/* + .. + .. Executable Statements .. +*/ + a = *df*0.5e0; + xx = *x*0.5e0; + cumgam(&xx,&a,cum,ccum); + return; +} /* END */ + +/***=====================================================================***/ +static void cumchn(double *x,double *df,double *pnonc,double *cum, + double *ccum) +/* +********************************************************************** + + void cumchn(double *x,double *df,double *pnonc,double *cum, + double *ccum) + + CUMulative of the Non-central CHi-square distribution + + + Function + + + Calculates the cumulative non-central chi-square + distribution, i.e., the probability that a random variable + which follows the non-central chi-square distribution, with + non-centrality parameter PNONC and continuous degrees of + freedom DF, is less than or equal to X. + + + Arguments + + + X --> Upper limit of integration of the non-central + chi-square distribution. + X is DOUBLE PRECISION + + DF --> Degrees of freedom of the non-central + chi-square distribution. + DF is DOUBLE PRECISION + + PNONC --> Non-centrality parameter of the non-central + chi-square distribution. + PNONC is DOUBLE PRECIS + + CUM <-- Cumulative non-central chi-square distribution. + CUM is DOUBLE PRECISIO + + CCUM <-- Compliment of Cumulative non-central chi-square distribut + CCUM is DOUBLE PRECISI + + + Method + + + Uses formula 26.4.25 of Abramowitz and Stegun, Handbook of + Mathematical Functions, US NBS (1966) to calculate the + non-central chi-square. + + + Variables + + + EPS --- Convergence criterion. The sum stops when a + term is less than EPS*SUM. + EPS is DOUBLE PRECISIO + + NTIRED --- Maximum number of terms to be evaluated + in each sum. + NTIRED is INTEGER + + QCONV --- .TRUE. if convergence achieved - + i.e., program did not stop on NTIRED criterion. + QCONV is LOGICAL + + CCUM <-- Compliment of Cumulative non-central + chi-square distribution. + CCUM is DOUBLE PRECISI + +********************************************************************** +*/ +{ +#define dg(i) (*df+2.0e0*(double)(i)) +#define qsmall(xx) (int)(sum < 1.0e-20 || (xx) < eps*sum) +#define qtired(i) (int)((i) > ntired) +static double eps = 1.0e-5; +static int ntired = 1000; +static double adj,centaj,centwt,chid2,dfd2,lcntaj,lcntwt,lfact,pcent,pterm,sum, + sumadj,term,wt,xnonc; +static int i,icent,iterb,iterf; +static double T1,T2,T3; +/* + .. + .. Executable Statements .. +*/ + if(!(*x <= 0.0e0)) goto S10; + *cum = 0.0e0; + *ccum = 1.0e0; + return; +S10: + if(!(*pnonc <= 1.0e-10)) goto S20; +/* + When non-centrality parameter is (essentially) zero, + use cumulative chi-square distribution +*/ + cumchi(x,df,cum,ccum); + return; +S20: + xnonc = *pnonc/2.0e0; +/* +********************************************************************** + The following code calcualtes the weight, chi-square, and + adjustment term for the central term in the infinite series. + The central term is the one in which the poisson weight is + greatest. The adjustment term is the amount that must + be subtracted from the chi-square to move up two degrees + of freedom. +********************************************************************** +*/ + icent = fifidint(xnonc); + if(icent == 0) icent = 1; + chid2 = *x/2.0e0; +/* + Calculate central weight term +*/ + T1 = (double)(icent+1); + lfact = alngam(&T1); + lcntwt = -xnonc+(double)icent*log(xnonc)-lfact; + centwt = exp(lcntwt); +/* + Calculate central chi-square +*/ + T2 = dg(icent); + cumchi(x,&T2,&pcent,ccum); +/* + Calculate central adjustment term +*/ + dfd2 = dg(icent)/2.0e0; + T3 = 1.0e0+dfd2; + lfact = alngam(&T3); + lcntaj = dfd2*log(chid2)-chid2-lfact; + centaj = exp(lcntaj); + sum = centwt*pcent; +/* +********************************************************************** + Sum backwards from the central term towards zero. + Quit whenever either + (1) the zero term is reached, or + (2) the term gets small relative to the sum, or + (3) More than NTIRED terms are totaled. +********************************************************************** +*/ + iterb = 0; + sumadj = 0.0e0; + adj = centaj; + wt = centwt; + i = icent; + goto S40; +S30: + if(qtired(iterb) || qsmall(term) || i == 0) goto S50; +S40: + dfd2 = dg(i)/2.0e0; +/* + Adjust chi-square for two fewer degrees of freedom. + The adjusted value ends up in PTERM. +*/ + adj = adj*dfd2/chid2; + sumadj += adj; + pterm = pcent+sumadj; +/* + Adjust poisson weight for J decreased by one +*/ + wt *= ((double)i/xnonc); + term = wt*pterm; + sum += term; + i -= 1; + iterb += 1; + goto S30; +S50: + iterf = 0; +/* +********************************************************************** + Now sum forward from the central term towards infinity. + Quit when either + (1) the term gets small relative to the sum, or + (2) More than NTIRED terms are totaled. +********************************************************************** +*/ + sumadj = adj = centaj; + wt = centwt; + i = icent; + goto S70; +S60: + if(qtired(iterf) || qsmall(term)) goto S80; +S70: +/* + Update weights for next higher J +*/ + wt *= (xnonc/(double)(i+1)); +/* + Calculate PTERM and add term to sum +*/ + pterm = pcent-sumadj; + term = wt*pterm; + sum += term; +/* + Update adjustment term for DF for next iteration +*/ + i += 1; + dfd2 = dg(i)/2.0e0; + adj = adj*chid2/dfd2; + sumadj += adj; + iterf += 1; + goto S60; +S80: + *cum = sum; + *ccum = 0.5e0+(0.5e0-*cum); + return; +#undef dg +#undef qsmall +#undef qtired +} /* END */ + +/***=====================================================================***/ +static void cumf(double *f,double *dfn,double *dfd,double *cum,double *ccum) +/* +********************************************************************** + + void cumf(double *f,double *dfn,double *dfd,double *cum,double *ccum) + CUMulative F distribution + + + Function + + + Computes the integral from 0 to F of the f-density with DFN + and DFD degrees of freedom. + + + Arguments + + + F --> Upper limit of integration of the f-density. + F is DOUBLE PRECISION + + DFN --> Degrees of freedom of the numerator sum of squares. + DFN is DOUBLE PRECISI + + DFD --> Degrees of freedom of the denominator sum of squares. + DFD is DOUBLE PRECISI + + CUM <-- Cumulative f distribution. + CUM is DOUBLE PRECISI + + CCUM <-- Compliment of Cumulative f distribution. + CCUM is DOUBLE PRECIS + + + Method + + + Formula 26.5.28 of Abramowitz and Stegun is used to reduce + the cumulative F to a cumulative beta distribution. + + + Note + + + If F is less than or equal to 0, 0 is returned. + +********************************************************************** +*/ +{ +#define half 0.5e0 +#define done 1.0e0 +static double dsum,prod,xx,yy; +static int ierr; +static double T1,T2; +/* + .. + .. Executable Statements .. +*/ + if(!(*f <= 0.0e0)) goto S10; + *cum = 0.0e0; + *ccum = 1.0e0; + return; +S10: + prod = *dfn**f; +/* + XX is such that the incomplete beta with parameters + DFD/2 and DFN/2 evaluated at XX is 1 - CUM or CCUM + YY is 1 - XX + Calculate the smaller of XX and YY accurately +*/ + dsum = *dfd+prod; + xx = *dfd/dsum; + if(xx > half) { + yy = prod/dsum; + xx = done-yy; + } + else yy = done-xx; + T1 = *dfd*half; + T2 = *dfn*half; + bratio(&T1,&T2,&xx,&yy,ccum,cum,&ierr); + return; +#undef half +#undef done +} /* END */ + +/***=====================================================================***/ +static void cumfnc(double *f,double *dfn,double *dfd,double *pnonc, + double *cum,double *ccum) +/* +********************************************************************** + + F -NON- -C-ENTRAL F DISTRIBUTION + + + + Function + + + COMPUTES NONCENTRAL F DISTRIBUTION WITH DFN AND DFD + DEGREES OF FREEDOM AND NONCENTRALITY PARAMETER PNONC + + + Arguments + + + X --> UPPER LIMIT OF INTEGRATION OF NONCENTRAL F IN EQUATION + + DFN --> DEGREES OF FREEDOM OF NUMERATOR + + DFD --> DEGREES OF FREEDOM OF DENOMINATOR + + PNONC --> NONCENTRALITY PARAMETER. + + CUM <-- CUMULATIVE NONCENTRAL F DISTRIBUTION + + CCUM <-- COMPLIMENT OF CUMMULATIVE + + + Method + + + USES FORMULA 26.6.20 OF REFERENCE FOR INFINITE SERIES. + SERIES IS CALCULATED BACKWARD AND FORWARD FROM J = LAMBDA/2 + (THIS IS THE TERM WITH THE LARGEST POISSON WEIGHT) UNTIL + THE CONVERGENCE CRITERION IS MET. + + FOR SPEED, THE INCOMPLETE BETA FUNCTIONS ARE EVALUATED + BY FORMULA 26.5.16. + + + REFERENCE + + + HANDBOOD OF MATHEMATICAL FUNCTIONS + EDITED BY MILTON ABRAMOWITZ AND IRENE A. STEGUN + NATIONAL BUREAU OF STANDARDS APPLIED MATEMATICS SERIES - 55 + MARCH 1965 + P 947, EQUATIONS 26.6.17, 26.6.18 + + + Note + + + THE SUM CONTINUES UNTIL A SUCCEEDING TERM IS LESS THAN EPS + TIMES THE SUM (OR THE SUM IS LESS THAN 1.0E-20). EPS IS + SET TO 1.0E-4 IN A DATA STATEMENT WHICH CAN BE CHANGED. + +********************************************************************** +*/ +{ +#define qsmall(x) (int)(sum < 1.0e-20 || (x) < eps*sum) +#define half 0.5e0 +#define done 1.0e0 +static double eps = 1.0e-4; +static double dsum,dummy,prod,xx,yy,adn,aup,b,betdn,betup,centwt,dnterm,sum, + upterm,xmult,xnonc; +static int i,icent,ierr; +static double T1,T2,T3,T4,T5,T6; +/* + .. + .. Executable Statements .. +*/ + if(!(*f <= 0.0e0)) goto S10; + *cum = 0.0e0; + *ccum = 1.0e0; + return; +S10: + if(!(*pnonc < 1.0e-10)) goto S20; +/* + Handle case in which the non-centrality parameter is + (essentially) zero. +*/ + cumf(f,dfn,dfd,cum,ccum); + return; +S20: + xnonc = *pnonc/2.0e0; +/* + Calculate the central term of the poisson weighting factor. +*/ + icent = xnonc; + if(icent == 0) icent = 1; +/* + Compute central weight term +*/ + T1 = (double)(icent+1); + centwt = exp(-xnonc+(double)icent*log(xnonc)-alngam(&T1)); +/* + Compute central incomplete beta term + Assure that minimum of arg to beta and 1 - arg is computed + accurately. +*/ + prod = *dfn**f; + dsum = *dfd+prod; + yy = *dfd/dsum; + if(yy > half) { + xx = prod/dsum; + yy = done-xx; + } + else xx = done-yy; + T2 = *dfn*half+(double)icent; + T3 = *dfd*half; + bratio(&T2,&T3,&xx,&yy,&betdn,&dummy,&ierr); + adn = *dfn/2.0e0+(double)icent; + aup = adn; + b = *dfd/2.0e0; + betup = betdn; + sum = centwt*betdn; +/* + Now sum terms backward from icent until convergence or all done +*/ + xmult = centwt; + i = icent; + T4 = adn+b; + T5 = adn+1.0e0; + dnterm = exp(alngam(&T4)-alngam(&T5)-alngam(&b)+adn*log(xx)+b*log(yy)); +S30: + if(qsmall(xmult*betdn) || i <= 0) goto S40; + xmult *= ((double)i/xnonc); + i -= 1; + adn -= 1.0; + dnterm = (adn+1.0)/((adn+b)*xx)*dnterm; + betdn += dnterm; + sum += (xmult*betdn); + goto S30; +S40: + i = icent+1; +/* + Now sum forwards until convergence +*/ + xmult = centwt; + if(aup-1.0+b == 0) upterm = exp(-alngam(&aup)-alngam(&b)+(aup-1.0)*log(xx)+ + b*log(yy)); + else { + T6 = aup-1.0+b; + upterm = exp(alngam(&T6)-alngam(&aup)-alngam(&b)+(aup-1.0)*log(xx)+b* + log(yy)); + } + goto S60; +S50: + if(qsmall(xmult*betup)) goto S70; +S60: + xmult *= (xnonc/(double)i); + i += 1; + aup += 1.0; + upterm = (aup+b-2.0e0)*xx/(aup-1.0)*upterm; + betup -= upterm; + sum += (xmult*betup); + goto S50; +S70: + *cum = sum; + *ccum = 0.5e0+(0.5e0-*cum); + return; +#undef qsmall +#undef half +#undef done +} /* END */ + +/***=====================================================================***/ +static void cumgam(double *x,double *a,double *cum,double *ccum) +/* +********************************************************************** + + void cumgam(double *x,double *a,double *cum,double *ccum) + Double precision cUMulative incomplete GAMma distribution + + + Function + + + Computes the cumulative of the incomplete gamma + distribution, i.e., the integral from 0 to X of + (1/GAM(A))*EXP(-T)*T**(A-1) DT + where GAM(A) is the complete gamma function of A, i.e., + GAM(A) = integral from 0 to infinity of + EXP(-T)*T**(A-1) DT + + + Arguments + + + X --> The upper limit of integration of the incomplete gamma. + X is DOUBLE PRECISION + + A --> The shape parameter of the incomplete gamma. + A is DOUBLE PRECISION + + CUM <-- Cumulative incomplete gamma distribution. + CUM is DOUBLE PRECISION + + CCUM <-- Compliment of Cumulative incomplete gamma distribution. + CCUM is DOUBLE PRECISIO + + + Method + + + Calls the routine GRATIO. + +********************************************************************** +*/ +{ +static int K1 = 0; +/* + .. + .. Executable Statements .. +*/ + if(!(*x <= 0.0e0)) goto S10; + *cum = 0.0e0; + *ccum = 1.0e0; + return; +S10: + gratio(a,x,cum,ccum,&K1); +/* + Call gratio routine +*/ + return; +} /* END */ + +/***=====================================================================***/ +static void cumnbn(double *s,double *xn,double *pr,double *ompr, + double *cum,double *ccum) +/* +********************************************************************** + + void cumnbn(double *s,double *xn,double *pr,double *ompr, + double *cum,double *ccum) + + CUmulative Negative BINomial distribution + + + Function + + + Returns the probability that it there will be S or fewer failures + before there are XN successes, with each binomial trial having + a probability of success PR. + + Prob(# failures = S | XN successes, PR) = + ( XN + S - 1 ) + ( ) * PR^XN * (1-PR)^S + ( S ) + + + Arguments + + + S --> The number of failures + S is DOUBLE PRECISION + + XN --> The number of successes + XN is DOUBLE PRECISIO + + PR --> The probability of success in each binomial trial. + PR is DOUBLE PRECISIO + + OMPR --> 1 - PR + OMPR is DOUBLE PRECIS + + CUM <-- Cumulative negative binomial distribution. + CUM is DOUBLE PRECISI + + CCUM <-- Compliment of Cumulative negative binomial distribution. + CCUM is DOUBLE PRECIS + + + Method + + + Formula 26.5.26 of Abramowitz and Stegun, Handbook of + Mathematical Functions (1966) is used to reduce the negative + binomial distribution to the cumulative beta distribution. + +********************************************************************** +*/ +{ +static double T1; +/* + .. + .. Executable Statements .. +*/ + T1 = *s+1.e0; + cumbet(pr,ompr,xn,&T1,cum,ccum); + return; +} /* END */ + +/***=====================================================================***/ +static void cumnor(double *arg,double *result,double *ccum) +/* +********************************************************************** + + void cumnor(double *arg,double *result,double *ccum) + + + Function + + + Computes the cumulative of the normal distribution, i.e., + the integral from -infinity to x of + (1/sqrt(2*pi)) exp(-u*u/2) du + + X --> Upper limit of integration. + X is DOUBLE PRECISION + + RESULT <-- Cumulative normal distribution. + RESULT is DOUBLE PRECISION + + CCUM <-- Compliment of Cumulative normal distribution. + CCUM is DOUBLE PRECISION + + Renaming of function ANORM from: + + Cody, W.D. (1993). "ALGORITHM 715: SPECFUN - A Portabel FORTRAN + Package of Special Function Routines and Test Drivers" + acm Transactions on Mathematical Software. 19, 22-32. + + with slight modifications to return ccum and to deal with + machine constants. + +********************************************************************** + Original Comments: +------------------------------------------------------------------ + + This function evaluates the normal distribution function: + + / x + 1 | -t*t/2 + P(x) = ----------- | e dt + sqrt(2 pi) | + /-oo + + The main computation evaluates near-minimax approximations + derived from those in "Rational Chebyshev approximations for + the error function" by W. J. Cody, Math. Comp., 1969, 631-637. + This transportable program uses rational functions that + theoretically approximate the normal distribution function to + at least 18 significant decimal digits. The accuracy achieved + depends on the arithmetic system, the compiler, the intrinsic + functions, and proper selection of the machine-dependent + constants. + +******************************************************************* +******************************************************************* + + Explanation of machine-dependent constants. + + MIN = smallest machine representable number. + + EPS = argument below which anorm(x) may be represented by + 0.5 and above which x*x will not underflow. + A conservative value is the largest machine number X + such that 1.0 + X = 1.0 to machine precision. +******************************************************************* +******************************************************************* + + Error returns + + The program returns ANORM = 0 for ARG .LE. XLOW. + + + Intrinsic functions required are: + + ABS, AINT, EXP + + + Author: W. J. Cody + Mathematics and Computer Science Division + Argonne National Laboratory + Argonne, IL 60439 + + Latest modification: March 15, 1992 + +------------------------------------------------------------------ +*/ +{ +static double a[5] = { + 2.2352520354606839287e00,1.6102823106855587881e02,1.0676894854603709582e03, + 1.8154981253343561249e04,6.5682337918207449113e-2 +}; +static double b[4] = { + 4.7202581904688241870e01,9.7609855173777669322e02,1.0260932208618978205e04, + 4.5507789335026729956e04 +}; +static double c[9] = { + 3.9894151208813466764e-1,8.8831497943883759412e00,9.3506656132177855979e01, + 5.9727027639480026226e02,2.4945375852903726711e03,6.8481904505362823326e03, + 1.1602651437647350124e04,9.8427148383839780218e03,1.0765576773720192317e-8 +}; +static double d[8] = { + 2.2266688044328115691e01,2.3538790178262499861e02,1.5193775994075548050e03, + 6.4855582982667607550e03,1.8615571640885098091e04,3.4900952721145977266e04, + 3.8912003286093271411e04,1.9685429676859990727e04 +}; +static double half = 0.5e0; +static double p[6] = { + 2.1589853405795699e-1,1.274011611602473639e-1,2.2235277870649807e-2, + 1.421619193227893466e-3,2.9112874951168792e-5,2.307344176494017303e-2 +}; +static double one = 1.0e0; +static double q[5] = { + 1.28426009614491121e00,4.68238212480865118e-1,6.59881378689285515e-2, + 3.78239633202758244e-3,7.29751555083966205e-5 +}; +static double sixten = 1.60e0; +static double sqrpi = 3.9894228040143267794e-1; +static double thrsh = 0.66291e0; +static double root32 = 5.656854248e0; +static double zero = 0.0e0; +static int K1 = 1; +static int K2 = 2; +static int i; +static double del,eps,temp,x,xden,xnum,y,xsq,min; +/* +------------------------------------------------------------------ + Machine dependent constants +------------------------------------------------------------------ +*/ + eps = spmpar(&K1)*0.5e0; + min = spmpar(&K2); + x = *arg; + y = fabs(x); + if(y <= thrsh) { +/* +------------------------------------------------------------------ + Evaluate anorm for |X| <= 0.66291 +------------------------------------------------------------------ +*/ + xsq = zero; + if(y > eps) xsq = x*x; + xnum = a[4]*xsq; + xden = xsq; + for(i=0; i<3; i++) { + xnum = (xnum+a[i])*xsq; + xden = (xden+b[i])*xsq; + } + *result = x*(xnum+a[3])/(xden+b[3]); + temp = *result; + *result = half+temp; + *ccum = half-temp; + } +/* +------------------------------------------------------------------ + Evaluate anorm for 0.66291 <= |X| <= sqrt(32) +------------------------------------------------------------------ +*/ + else if(y <= root32) { + xnum = c[8]*y; + xden = y; + for(i=0; i<7; i++) { + xnum = (xnum+c[i])*y; + xden = (xden+d[i])*y; + } + *result = (xnum+c[7])/(xden+d[7]); + xsq = fifdint(y*sixten)/sixten; + del = (y-xsq)*(y+xsq); + *result = exp(-(xsq*xsq*half))*exp(-(del*half))**result; + *ccum = one-*result; + if(x > zero) { + temp = *result; + *result = *ccum; + *ccum = temp; + } + } +/* +------------------------------------------------------------------ + Evaluate anorm for |X| > sqrt(32) +------------------------------------------------------------------ +*/ + else { + *result = zero; + xsq = one/(x*x); + xnum = p[5]*xsq; + xden = xsq; + for(i=0; i<4; i++) { + xnum = (xnum+p[i])*xsq; + xden = (xden+q[i])*xsq; + } + *result = xsq*(xnum+p[4])/(xden+q[4]); + *result = (sqrpi-*result)/y; + xsq = fifdint(x*sixten)/sixten; + del = (x-xsq)*(x+xsq); + *result = exp(-(xsq*xsq*half))*exp(-(del*half))**result; + *ccum = one-*result; + if(x > zero) { + temp = *result; + *result = *ccum; + *ccum = temp; + } + } + if(*result < min) *result = 0.0e0; +/* +------------------------------------------------------------------ + Fix up for negative argument, erf, etc. +------------------------------------------------------------------ +----------Last card of ANORM ---------- +*/ + if(*ccum < min) *ccum = 0.0e0; +} /* END */ + +/***=====================================================================***/ +static void cumpoi(double *s,double *xlam,double *cum,double *ccum) +/* +********************************************************************** + + void cumpoi(double *s,double *xlam,double *cum,double *ccum) + CUMulative POIsson distribution + + + Function + + + Returns the probability of S or fewer events in a Poisson + distribution with mean XLAM. + + + Arguments + + + S --> Upper limit of cumulation of the Poisson. + S is DOUBLE PRECISION + + XLAM --> Mean of the Poisson distribution. + XLAM is DOUBLE PRECIS + + CUM <-- Cumulative poisson distribution. + CUM is DOUBLE PRECISION + + CCUM <-- Compliment of Cumulative poisson distribution. + CCUM is DOUBLE PRECIS + + + Method + + + Uses formula 26.4.21 of Abramowitz and Stegun, Handbook of + Mathematical Functions to reduce the cumulative Poisson to + the cumulative chi-square distribution. + +********************************************************************** +*/ +{ +static double chi,df; +/* + .. + .. Executable Statements .. +*/ + df = 2.0e0*(*s+1.0e0); + chi = 2.0e0**xlam; + cumchi(&chi,&df,ccum,cum); + return; +} /* END */ + +/***=====================================================================***/ +static void cumt(double *t,double *df,double *cum,double *ccum) +/* +********************************************************************** + + void cumt(double *t,double *df,double *cum,double *ccum) + CUMulative T-distribution + + + Function + + + Computes the integral from -infinity to T of the t-density. + + + Arguments + + + T --> Upper limit of integration of the t-density. + T is DOUBLE PRECISION + + DF --> Degrees of freedom of the t-distribution. + DF is DOUBLE PRECISIO + + CUM <-- Cumulative t-distribution. + CCUM is DOUBLE PRECIS + + CCUM <-- Compliment of Cumulative t-distribution. + CCUM is DOUBLE PRECIS + + + Method + + + Formula 26.5.27 of Abramowitz and Stegun, Handbook of + Mathematical Functions is used to reduce the t-distribution + to an incomplete beta. + +********************************************************************** +*/ +{ +static double K2 = 0.5e0; +static double xx,a,oma,tt,yy,dfptt,T1; +/* + .. + .. Executable Statements .. +*/ + tt = *t**t; + dfptt = *df+tt; + xx = *df/dfptt; + yy = tt/dfptt; + T1 = 0.5e0**df; + cumbet(&xx,&yy,&T1,&K2,&a,&oma); + if(!(*t <= 0.0e0)) goto S10; + *cum = 0.5e0*a; + *ccum = oma+*cum; + goto S20; +S10: + *ccum = 0.5e0*a; + *cum = oma+*ccum; +S20: + return; +} /* END */ + +/***=====================================================================***/ +static double dbetrm(double *a,double *b) +/* +********************************************************************** + + double dbetrm(double *a,double *b) + Double Precision Sterling Remainder for Complete + Beta Function + + + Function + + + Log(Beta(A,B)) = Lgamma(A) + Lgamma(B) - Lgamma(A+B) + where Lgamma is the log of the (complete) gamma function + + Let ZZ be approximation obtained if each log gamma is approximated + by Sterling's formula, i.e., + Sterling(Z) = LOG( SQRT( 2*PI ) ) + ( Z-0.5 ) * LOG( Z ) - Z + + Returns Log(Beta(A,B)) - ZZ + + + Arguments + + + A --> One argument of the Beta + DOUBLE PRECISION A + + B --> The other argument of the Beta + DOUBLE PRECISION B + +********************************************************************** +*/ +{ +static double dbetrm,T1,T2,T3; +/* + .. + .. Executable Statements .. +*/ +/* + Try to sum from smallest to largest +*/ + T1 = *a+*b; + dbetrm = -dstrem(&T1); + T2 = fifdmax1(*a,*b); + dbetrm += dstrem(&T2); + T3 = fifdmin1(*a,*b); + dbetrm += dstrem(&T3); + return dbetrm; +} /* END */ + +/***=====================================================================***/ +static double devlpl(double a[],int *n,double *x) +/* +********************************************************************** + + double devlpl(double a[],int *n,double *x) + Double precision EVALuate a PoLynomial at X + + + Function + + + returns + A(1) + A(2)*X + ... + A(N)*X**(N-1) + + + Arguments + + + A --> Array of coefficients of the polynomial. + A is DOUBLE PRECISION(N) + + N --> Length of A, also degree of polynomial - 1. + N is INTEGER + + X --> Point at which the polynomial is to be evaluated. + X is DOUBLE PRECISION + +********************************************************************** +*/ +{ +static double devlpl,term; +static int i; +/* + .. + .. Executable Statements .. +*/ + term = a[*n-1]; + for(i= *n-1-1; i>=0; i--) term = a[i]+term**x; + devlpl = term; + return devlpl; +} /* END */ + +/***=====================================================================***/ +static double dexpm1(double *x) +/* +********************************************************************** + + double dexpm1(double *x) + Evaluation of the function EXP(X) - 1 + + + Arguments + + + X --> Argument at which exp(x)-1 desired + DOUBLE PRECISION X + + + Method + + + Renaming of function rexp from code of: + + DiDinato, A. R. and Morris, A. H. Algorithm 708: Significant + Digit Computation of the Incomplete Beta Function Ratios. ACM + Trans. Math. Softw. 18 (1993), 360-373. + +********************************************************************** +*/ +{ +static double p1 = .914041914819518e-09; +static double p2 = .238082361044469e-01; +static double q1 = -.499999999085958e+00; +static double q2 = .107141568980644e+00; +static double q3 = -.119041179760821e-01; +static double q4 = .595130811860248e-03; +static double dexpm1,w; +/* + .. + .. Executable Statements .. +*/ + if(fabs(*x) > 0.15e0) goto S10; + dexpm1 = *x*(((p2**x+p1)**x+1.0e0)/((((q4**x+q3)**x+q2)**x+q1)**x+1.0e0)); + return dexpm1; +S10: + w = exp(*x); + if(*x > 0.0e0) goto S20; + dexpm1 = w-0.5e0-0.5e0; + return dexpm1; +S20: + dexpm1 = w*(0.5e0+(0.5e0-1.0e0/w)); + return dexpm1; +} /* END */ + +/***=====================================================================***/ +static double dinvnr(double *p,double *q) +/* +********************************************************************** + + double dinvnr(double *p,double *q) + Double precision NoRmal distribution INVerse + + + Function + + + Returns X such that CUMNOR(X) = P, i.e., the integral from - + infinity to X of (1/SQRT(2*PI)) EXP(-U*U/2) dU is P + + + Arguments + + + P --> The probability whose normal deviate is sought. + P is DOUBLE PRECISION + + Q --> 1-P + P is DOUBLE PRECISION + + + Method + + + The rational function on page 95 of Kennedy and Gentle, + Statistical Computing, Marcel Dekker, NY , 1980 is used as a start + value for the Newton method of finding roots. + + + Note + + + If P or Q .lt. machine EPS returns +/- DINVNR(EPS) + +********************************************************************** +*/ +{ +#define maxit 100 +#define eps (1.0e-13) +#define r2pi 0.3989422804014326e0 +#define nhalf (-0.5e0) +#define dennor(x) (r2pi*exp(nhalf*(x)*(x))) +static double dinvnr,strtx,xcur,cum,ccum,pp,dx; +static int i; +static unsigned long qporq; +/* + .. + .. Executable Statements .. +*/ +/* + FIND MINIMUM OF P AND Q +*/ + qporq = *p <= *q; + if(!qporq) goto S10; + pp = *p; + goto S20; +S10: + pp = *q; +S20: +/* + INITIALIZATION STEP +*/ + strtx = stvaln(&pp); + xcur = strtx; +/* + NEWTON INTERATIONS +*/ + for(i=1; i<=maxit; i++) { + cumnor(&xcur,&cum,&ccum); + dx = (cum-pp)/dennor(xcur); + xcur -= dx; + if(fabs(dx/xcur) < eps) goto S40; + } + dinvnr = strtx; +/* + IF WE GET HERE, NEWTON HAS FAILED +*/ + if(!qporq) dinvnr = -dinvnr; + return dinvnr; +S40: +/* + IF WE GET HERE, NEWTON HAS SUCCEDED +*/ + dinvnr = xcur; + if(!qporq) dinvnr = -dinvnr; + return dinvnr; +#undef maxit +#undef eps +#undef r2pi +#undef nhalf +#undef dennor +} /* END */ + +/***=====================================================================***/ +static void E0000(int IENTRY,int *status,double *x,double *fx, + unsigned long *qleft,unsigned long *qhi,double *zabsst, + double *zabsto,double *zbig,double *zrelst, + double *zrelto,double *zsmall,double *zstpmu) +{ +#define qxmon(zx,zy,zz) (int)((zx) <= (zy) && (zy) <= (zz)) +static double absstp,abstol,big,fbig,fsmall,relstp,reltol,small,step,stpmul,xhi, + xlb,xlo,xsave,xub,yy; +static int i99999; +static unsigned long qbdd,qcond,qdum1,qdum2,qincr,qlim,qok,qup; + switch(IENTRY){case 0: goto DINVR; case 1: goto DSTINV;} +DINVR: + if(*status > 0) goto S310; + qcond = !qxmon(small,*x,big); + if(qcond){ ftnstop("SMALL,X,BIG nonmonotone in E0000"); *status=-1; return;} + xsave = *x; +/* + See that SMALL and BIG bound the zero and set QINCR +*/ + *x = small; +/* + GET-FUNCTION-VALUE +*/ + i99999 = 1; + goto S300; +S10: + fsmall = *fx; + *x = big; +/* + GET-FUNCTION-VALUE +*/ + i99999 = 2; + goto S300; +S20: + fbig = *fx; + qincr = fbig > fsmall; + if(!qincr) goto S50; + if(fsmall <= 0.0e0) goto S30; + *status = -1; + *qleft = *qhi = 1; + return; +S30: + if(fbig >= 0.0e0) goto S40; + *status = -1; + *qleft = *qhi = 0; + return; +S40: + goto S80; +S50: + if(fsmall >= 0.0e0) goto S60; + *status = -1; + *qleft = 1; + *qhi = 0; + return; +S60: + if(fbig <= 0.0e0) goto S70; + *status = -1; + *qleft = 0; + *qhi = 1; + return; +S80: +S70: + *x = xsave; + step = fifdmax1(absstp,relstp*fabs(*x)); +/* + YY = F(X) - Y + GET-FUNCTION-VALUE +*/ + i99999 = 3; + goto S300; +S90: + yy = *fx; + if(!(yy == 0.0e0)) goto S100; + *status = 0; + qok = 1; + return; +S100: + qup = qincr && yy < 0.0e0 || !qincr && yy > 0.0e0; +/* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + HANDLE CASE IN WHICH WE MUST STEP HIGHER +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +*/ + if(!qup) goto S170; + xlb = xsave; + xub = fifdmin1(xlb+step,big); + goto S120; +S110: + if(qcond) goto S150; +S120: +/* + YY = F(XUB) - Y +*/ + *x = xub; +/* + GET-FUNCTION-VALUE +*/ + i99999 = 4; + goto S300; +S130: + yy = *fx; + qbdd = qincr && yy >= 0.0e0 || !qincr && yy <= 0.0e0; + qlim = xub >= big; + qcond = qbdd || qlim; + if(qcond) goto S140; + step = stpmul*step; + xlb = xub; + xub = fifdmin1(xlb+step,big); +S140: + goto S110; +S150: + if(!(qlim && !qbdd)) goto S160; + *status = -1; + *qleft = 0; + *qhi = !qincr; + *x = big; + return; +S160: + goto S240; +S170: +/* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + HANDLE CASE IN WHICH WE MUST STEP LOWER +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +*/ + xub = xsave; + xlb = fifdmax1(xub-step,small); + goto S190; +S180: + if(qcond) goto S220; +S190: +/* + YY = F(XLB) - Y +*/ + *x = xlb; +/* + GET-FUNCTION-VALUE +*/ + i99999 = 5; + goto S300; +S200: + yy = *fx; + qbdd = qincr && yy <= 0.0e0 || !qincr && yy >= 0.0e0; + qlim = xlb <= small; + qcond = qbdd || qlim; + if(qcond) goto S210; + step = stpmul*step; + xub = xlb; + xlb = fifdmax1(xub-step,small); +S210: + goto S180; +S220: + if(!(qlim && !qbdd)) goto S230; + *status = -1; + *qleft = 1; + *qhi = qincr; + *x = small; + return; +S240: +S230: + dstzr(&xlb,&xub,&abstol,&reltol); +/* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + IF WE REACH HERE, XLB AND XUB BOUND THE ZERO OF F. +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +*/ + *status = 0; + goto S260; +S250: + if(!(*status == 1)) goto S290; +S260: + dzror(status,x,fx,&xlo,&xhi,&qdum1,&qdum2); + if(!(*status == 1)) goto S280; +/* + GET-FUNCTION-VALUE +*/ + i99999 = 6; + goto S300; +S280: +S270: + goto S250; +S290: + *x = xlo; + *status = 0; + return; +DSTINV: + small = *zsmall; + big = *zbig; + absstp = *zabsst; + relstp = *zrelst; + stpmul = *zstpmu; + abstol = *zabsto; + reltol = *zrelto; + return; +S300: +/* + TO GET-FUNCTION-VALUE +*/ + *status = 1; + return; +S310: + switch((int)i99999){case 1: goto S10;case 2: goto S20;case 3: goto S90;case + 4: goto S130;case 5: goto S200;case 6: goto S270;default: break;} +#undef qxmon +} /* END */ + +/***=====================================================================***/ +static void dinvr(int *status,double *x,double *fx, + unsigned long *qleft,unsigned long *qhi) +/* +********************************************************************** + + void dinvr(int *status,double *x,double *fx, + unsigned long *qleft,unsigned long *qhi) + + Double precision + bounds the zero of the function and invokes zror + Reverse Communication + + + Function + + + Bounds the function and invokes ZROR to perform the zero + finding. STINVR must have been called before this routine + in order to set its parameters. + + + Arguments + + + STATUS <--> At the beginning of a zero finding problem, STATUS + should be set to 0 and INVR invoked. (The value + of parameters other than X will be ignored on this cal + + When INVR needs the function evaluated, it will set + STATUS to 1 and return. The value of the function + should be set in FX and INVR again called without + changing any of its other parameters. + + When INVR has finished without error, it will return + with STATUS 0. In that case X is approximately a root + of F(X). + + If INVR cannot bound the function, it returns status + -1 and sets QLEFT and QHI. + INTEGER STATUS + + X <-- The value of X at which F(X) is to be evaluated. + DOUBLE PRECISION X + + FX --> The value of F(X) calculated when INVR returns with + STATUS = 1. + DOUBLE PRECISION FX + + QLEFT <-- Defined only if QMFINV returns .FALSE. In that + case it is .TRUE. If the stepping search terminated + unsucessfully at SMALL. If it is .FALSE. the search + terminated unsucessfully at BIG. + QLEFT is LOGICAL + + QHI <-- Defined only if QMFINV returns .FALSE. In that + case it is .TRUE. if F(X) .GT. Y at the termination + of the search and .FALSE. if F(X) .LT. Y at the + termination of the search. + QHI is LOGICAL + +********************************************************************** +*/ +{ + E0000(0,status,x,fx,qleft,qhi,NULL,NULL,NULL,NULL,NULL,NULL,NULL); +} /* END */ + +/***=====================================================================***/ +static void dstinv(double *zsmall,double *zbig,double *zabsst, + double *zrelst,double *zstpmu,double *zabsto, + double *zrelto) +/* +********************************************************************** + void dstinv(double *zsmall,double *zbig,double *zabsst, + double *zrelst,double *zstpmu,double *zabsto, + double *zrelto) + + Double Precision - SeT INverse finder - Reverse Communication + Function + Concise Description - Given a monotone function F finds X + such that F(X) = Y. Uses Reverse communication -- see invr. + This routine sets quantities needed by INVR. + More Precise Description of INVR - + F must be a monotone function, the results of QMFINV are + otherwise undefined. QINCR must be .TRUE. if F is non- + decreasing and .FALSE. if F is non-increasing. + QMFINV will return .TRUE. if and only if F(SMALL) and + F(BIG) bracket Y, i. e., + QINCR is .TRUE. and F(SMALL).LE.Y.LE.F(BIG) or + QINCR is .FALSE. and F(BIG).LE.Y.LE.F(SMALL) + if QMFINV returns .TRUE., then the X returned satisfies + the following condition. let + TOL(X) = MAX(ABSTOL,RELTOL*ABS(X)) + then if QINCR is .TRUE., + F(X-TOL(X)) .LE. Y .LE. F(X+TOL(X)) + and if QINCR is .FALSE. + F(X-TOL(X)) .GE. Y .GE. F(X+TOL(X)) + Arguments + SMALL --> The left endpoint of the interval to be + searched for a solution. + SMALL is DOUBLE PRECISION + BIG --> The right endpoint of the interval to be + searched for a solution. + BIG is DOUBLE PRECISION + ABSSTP, RELSTP --> The initial step size in the search + is MAX(ABSSTP,RELSTP*ABS(X)). See algorithm. + ABSSTP is DOUBLE PRECISION + RELSTP is DOUBLE PRECISION + STPMUL --> When a step doesn't bound the zero, the step + size is multiplied by STPMUL and another step + taken. A popular value is 2.0 + DOUBLE PRECISION STPMUL + ABSTOL, RELTOL --> Two numbers that determine the accuracy + of the solution. See function for a precise definition. + ABSTOL is DOUBLE PRECISION + RELTOL is DOUBLE PRECISION + Method + Compares F(X) with Y for the input value of X then uses QINCR + to determine whether to step left or right to bound the + desired x. the initial step size is + MAX(ABSSTP,RELSTP*ABS(S)) for the input value of X. + Iteratively steps right or left until it bounds X. + At each step which doesn't bound X, the step size is doubled. + The routine is careful never to step beyond SMALL or BIG. If + it hasn't bounded X at SMALL or BIG, QMFINV returns .FALSE. + after setting QLEFT and QHI. + If X is successfully bounded then Algorithm R of the paper + 'Two Efficient Algorithms with Guaranteed Convergence for + Finding a Zero of a Function' by J. C. P. Bus and + T. J. Dekker in ACM Transactions on Mathematical + Software, Volume 1, No. 4 page 330 (DEC. '75) is employed + to find the zero of the function F(X)-Y. This is routine + QRZERO. +********************************************************************** +*/ +{ + E0000(1,NULL,NULL,NULL,NULL,NULL,zabsst,zabsto,zbig,zrelst,zrelto,zsmall, + zstpmu); +} /* END */ + +/***=====================================================================***/ +static double dlanor(double *x) +/* +********************************************************************** + + double dlanor(double *x) + Double precision Logarith of the Asymptotic Normal + + + Function + + + Computes the logarithm of the cumulative normal distribution + from abs( x ) to infinity for abs( x ) >= 5. + + + Arguments + + + X --> Value at which cumulative normal to be evaluated + DOUBLE PRECISION X + + + Method + + + 23 term expansion of formula 26.2.12 of Abramowitz and Stegun. + The relative error at X = 5 is about 0.5E-5. + + + Note + + + ABS(X) must be >= 5 else there is an error stop. + +********************************************************************** +*/ +{ +#define dlsqpi 0.91893853320467274177e0 +static double coef[12] = { + -1.0e0,3.0e0,-15.0e0,105.0e0,-945.0e0,10395.0e0,-135135.0e0,2027025.0e0, + -34459425.0e0,654729075.0e0,-13749310575.e0,316234143225.0e0 +}; +static int K1 = 12; +static double dlanor,approx,correc,xx,xx2,T2; +/* + .. + .. Executable Statements .. +*/ + xx = fabs(*x); + if(xx < 5.0e0){ ftnstop("Argument too small in DLANOR"); return 66.6; } + approx = -dlsqpi-0.5e0*xx*xx-log(xx); + xx2 = xx*xx; + T2 = 1.0e0/xx2; + correc = devlpl(coef,&K1,&T2)/xx2; + correc = dln1px(&correc); + dlanor = approx+correc; + return dlanor; +#undef dlsqpi +} /* END */ + +/***=====================================================================***/ +static double dln1mx(double *x) +/* +********************************************************************** + + double dln1mx(double *x) + Double precision LN(1-X) + + + Function + + + Returns ln(1-x) for small x (good accuracy if x .le. 0.1). + Note that the obvious code of + LOG(1.0-X) + won't work for small X because 1.0-X loses accuracy + + + Arguments + + + X --> Value for which ln(1-x) is desired. + X is DOUBLE PRECISION + + + Method + + + If X > 0.1, the obvious code above is used ELSE + The Taylor series for 1-x is expanded to 20 terms. + +********************************************************************** +*/ +{ +static double dln1mx,T1; +/* + .. + .. Executable Statements .. +*/ + T1 = -*x; + dln1mx = dln1px(&T1); + return dln1mx; +} /* END */ + +/***=====================================================================***/ +static double dln1px(double *a) +/* +********************************************************************** + + double dln1px(double *a) + Double precision LN(1+X) + + + Function + + + Returns ln(1+x) + Note that the obvious code of + LOG(1.0+X) + won't work for small X because 1.0+X loses accuracy + + + Arguments + + + X --> Value for which ln(1-x) is desired. + X is DOUBLE PRECISION + + + Method + + + Renames ALNREL from: + DiDinato, A. R. and Morris, A. H. Algorithm 708: Significant + Digit Computation of the Incomplete Beta Function Ratios. ACM + Trans. Math. Softw. 18 (1993), 360-373. + +********************************************************************** +----------------------------------------------------------------------- + EVALUATION OF THE FUNCTION LN(1 + A) +----------------------------------------------------------------------- +*/ +{ +static double p1 = -.129418923021993e+01; +static double p2 = .405303492862024e+00; +static double p3 = -.178874546012214e-01; +static double q1 = -.162752256355323e+01; +static double q2 = .747811014037616e+00; +static double q3 = -.845104217945565e-01; +static double dln1px,t,t2,w,x; +/* + .. + .. Executable Statements .. +*/ + if(fabs(*a) > 0.375e0) goto S10; + t = *a/(*a+2.0e0); + t2 = t*t; + w = (((p3*t2+p2)*t2+p1)*t2+1.0e0)/(((q3*t2+q2)*t2+q1)*t2+1.0e0); + dln1px = 2.0e0*t*w; + return dln1px; +S10: + x = 1.e0+*a; + dln1px = log(x); + return dln1px; +} /* END */ + +/***=====================================================================***/ +static double dlnbet(double *a0,double *b0) +/* +********************************************************************** + + double dlnbet(a0,b0) + Double precision LN of the complete BETa + + + Function + + + Returns the natural log of the complete beta function, + i.e., + + ln( Gamma(a)*Gamma(b) / Gamma(a+b) + + + Arguments + + + A,B --> The (symmetric) arguments to the complete beta + DOUBLE PRECISION A, B + + + Method + + + Renames BETALN from: + DiDinato, A. R. and Morris, A. H. Algorithm 708: Significant + Digit Computation of the Incomplete Beta Function Ratios. ACM + Trans. Math. Softw. 18 (1993), 360-373. + +********************************************************************** +----------------------------------------------------------------------- + EVALUATION OF THE LOGARITHM OF THE BETA FUNCTION +----------------------------------------------------------------------- + E = 0.5*LN(2*PI) +-------------------------- +*/ +{ +static double e = .918938533204673e0; +static double dlnbet,a,b,c,h,u,v,w,z; +static int i,n; +static double T1; +/* + .. + .. Executable Statements .. +*/ + a = fifdmin1(*a0,*b0); + b = fifdmax1(*a0,*b0); + if(a >= 8.0e0) goto S100; + if(a >= 1.0e0) goto S20; +/* +----------------------------------------------------------------------- + PROCEDURE WHEN A .LT. 1 +----------------------------------------------------------------------- +*/ + if(b >= 8.0e0) goto S10; + T1 = a+b; + dlnbet = gamln(&a)+(gamln(&b)-gamln(&T1)); + return dlnbet; +S10: + dlnbet = gamln(&a)+algdiv(&a,&b); + return dlnbet; +S20: +/* +----------------------------------------------------------------------- + PROCEDURE WHEN 1 .LE. A .LT. 8 +----------------------------------------------------------------------- +*/ + if(a > 2.0e0) goto S40; + if(b > 2.0e0) goto S30; + dlnbet = gamln(&a)+gamln(&b)-gsumln(&a,&b); + return dlnbet; +S30: + w = 0.0e0; + if(b < 8.0e0) goto S60; + dlnbet = gamln(&a)+algdiv(&a,&b); + return dlnbet; +S40: +/* + REDUCTION OF A WHEN B .LE. 1000 +*/ + if(b > 1000.0e0) goto S80; + n = a-1.0e0; + w = 1.0e0; + for(i=1; i<=n; i++) { + a -= 1.0e0; + h = a/b; + w *= (h/(1.0e0+h)); + } + w = log(w); + if(b < 8.0e0) goto S60; + dlnbet = w+gamln(&a)+algdiv(&a,&b); + return dlnbet; +S60: +/* + REDUCTION OF B WHEN B .LT. 8 +*/ + n = b-1.0e0; + z = 1.0e0; + for(i=1; i<=n; i++) { + b -= 1.0e0; + z *= (b/(a+b)); + } + dlnbet = w+log(z)+(gamln(&a)+(gamln(&b)-gsumln(&a,&b))); + return dlnbet; +S80: +/* + REDUCTION OF A WHEN B .GT. 1000 +*/ + n = a-1.0e0; + w = 1.0e0; + for(i=1; i<=n; i++) { + a -= 1.0e0; + w *= (a/(1.0e0+a/b)); + } + dlnbet = log(w)-(double)n*log(b)+(gamln(&a)+algdiv(&a,&b)); + return dlnbet; +S100: +/* +----------------------------------------------------------------------- + PROCEDURE WHEN A .GE. 8 +----------------------------------------------------------------------- +*/ + w = bcorr(&a,&b); + h = a/b; + c = h/(1.0e0+h); + u = -((a-0.5e0)*log(c)); + v = b*alnrel(&h); + if(u <= v) goto S110; + dlnbet = -(0.5e0*log(b))+e+w-v-u; + return dlnbet; +S110: + dlnbet = -(0.5e0*log(b))+e+w-u-v; + return dlnbet; +} /* END */ + +/***=====================================================================***/ +static double dlngam(double *a) +/* +********************************************************************** + + double dlngam(double *a) + Double precision LN of the GAMma function + + + Function + + + Returns the natural logarithm of GAMMA(X). + + + Arguments + + + X --> value at which scaled log gamma is to be returned + X is DOUBLE PRECISION + + + Method + + + Renames GAMLN from: + DiDinato, A. R. and Morris, A. H. Algorithm 708: Significant + Digit Computation of the Incomplete Beta Function Ratios. ACM + Trans. Math. Softw. 18 (1993), 360-373. + +********************************************************************** +----------------------------------------------------------------------- + EVALUATION OF LN(GAMMA(A)) FOR POSITIVE A +----------------------------------------------------------------------- + WRITTEN BY ALFRED H. MORRIS + NAVAL SURFACE WARFARE CENTER + DAHLGREN, VIRGINIA +-------------------------- + D = 0.5*(LN(2*PI) - 1) +-------------------------- +*/ +{ +static double c0 = .833333333333333e-01; +static double c1 = -.277777777760991e-02; +static double c2 = .793650666825390e-03; +static double c3 = -.595202931351870e-03; +static double c4 = .837308034031215e-03; +static double c5 = -.165322962780713e-02; +static double d = .418938533204673e0; +static double dlngam,t,w; +static int i,n; +static double T1; +/* + .. + .. Executable Statements .. +*/ + if(*a > 0.8e0) goto S10; + dlngam = gamln1(a)-log(*a); + return dlngam; +S10: + if(*a > 2.25e0) goto S20; + t = *a-0.5e0-0.5e0; + dlngam = gamln1(&t); + return dlngam; +S20: + if(*a >= 10.0e0) goto S40; + n = *a-1.25e0; + t = *a; + w = 1.0e0; + for(i=1; i<=n; i++) { + t -= 1.0e0; + w = t*w; + } + T1 = t-1.0e0; + dlngam = gamln1(&T1)+log(w); + return dlngam; +S40: + t = pow(1.0e0/ *a,2.0); + w = (((((c5*t+c4)*t+c3)*t+c2)*t+c1)*t+c0)/ *a; + dlngam = d+w+(*a-0.5e0)*(log(*a)-1.0e0); + return dlngam; +} /* END */ + +/***=====================================================================***/ +static double dstrem(double *z) +{ +/* +********************************************************************** + double dstrem(double *z) + Double precision Sterling Remainder + Function + Returns Log(Gamma(Z)) - Sterling(Z) where Sterling(Z) is + Sterling's Approximation to Log(Gamma(Z)) + Sterling(Z) = LOG( SQRT( 2*PI ) ) + ( Z-0.5 ) * LOG( Z ) - Z + Arguments + Z --> Value at which Sterling remainder calculated + Must be positive. + DOUBLE PRECISION Z + Method + If Z >= 6 uses 9 terms of series in Bernoulli numbers + (Values calculated using Maple) + Otherwise computes difference explicitly +********************************************************************** +*/ +#define hln2pi 0.91893853320467274178e0 +#define ncoef 10 +static double coef[ncoef] = { + 0.0e0,0.0833333333333333333333333333333e0, + -0.00277777777777777777777777777778e0,0.000793650793650793650793650793651e0, + -0.000595238095238095238095238095238e0, + 0.000841750841750841750841750841751e0,-0.00191752691752691752691752691753e0, + 0.00641025641025641025641025641026e0,-0.0295506535947712418300653594771e0, + 0.179644372368830573164938490016e0 +}; +static int K1 = 10; +static double dstrem,sterl,T2; +/* + .. + .. Executable Statements .. +*/ +/* + For information, here are the next 11 coefficients of the + remainder term in Sterling's formula + -1.39243221690590111642743221691 + 13.4028640441683919944789510007 + -156.848284626002017306365132452 + 2193.10333333333333333333333333 + -36108.7712537249893571732652192 + 691472.268851313067108395250776 + -0.152382215394074161922833649589D8 + 0.382900751391414141414141414141D9 + -0.108822660357843910890151491655D11 + 0.347320283765002252252252252252D12 + -0.123696021422692744542517103493D14 +*/ + if(*z <= 0.0e0){ ftnstop("nonpositive argument in DSTREM"); return 66.6; } + if(!(*z > 6.0e0)) goto S10; + T2 = 1.0e0/pow(*z,2.0); + dstrem = devlpl(coef,&K1,&T2)**z; + goto S20; +S10: + sterl = hln2pi+(*z-0.5e0)*log(*z)-*z; + dstrem = dlngam(z)-sterl; +S20: + return dstrem; +#undef hln2pi +#undef ncoef +} /* END */ + +/***=====================================================================***/ +static double dt1(double *p,double *q,double *df) +/* +********************************************************************** + + double dt1(double *p,double *q,double *df) + Double precision Initalize Approximation to + INVerse of the cumulative T distribution + + + Function + + + Returns the inverse of the T distribution function, i.e., + the integral from 0 to INVT of the T density is P. This is an + initial approximation + + + Arguments + + + P --> The p-value whose inverse from the T distribution is + desired. + P is DOUBLE PRECISION + + Q --> 1-P. + Q is DOUBLE PRECISION + + DF --> Degrees of freedom of the T distribution. + DF is DOUBLE PRECISION + +********************************************************************** +*/ +{ +static double coef[4][5] = { + 1.0e0,1.0e0,0.0e0,0.0e0,0.0e0,3.0e0,16.0e0,5.0e0,0.0e0,0.0e0,-15.0e0,17.0e0, + 19.0e0,3.0e0,0.0e0,-945.0e0,-1920.0e0,1482.0e0,776.0e0,79.0e0 +}; +static double denom[4] = { + 4.0e0,96.0e0,384.0e0,92160.0e0 +}; +static int ideg[4] = { + 2,3,4,5 +}; +static double dt1,denpow,sum,term,x,xp,xx; +static int i; +/* + .. + .. Executable Statements .. +*/ + x = fabs(dinvnr(p,q)); + xx = x*x; + sum = x; + denpow = 1.0e0; + for(i=0; i<4; i++) { + term = devlpl(&coef[i][0],&ideg[i],&xx)*x; + denpow *= *df; + sum += (term/(denpow*denom[i])); + } + if(!(*p >= 0.5e0)) goto S20; + xp = sum; + goto S30; +S20: + xp = -sum; +S30: + dt1 = xp; + return dt1; +} /* END */ + +/***=====================================================================***/ +static void E0001(int IENTRY,int *status,double *x,double *fx, + double *xlo,double *xhi,unsigned long *qleft, + unsigned long *qhi,double *zabstl,double *zreltl, + double *zxhi,double *zxlo) +{ +#define ftol(zx) (0.5e0*fifdmax1(abstol,reltol*fabs((zx)))) +static double a,abstol,b,c,d,fa,fb,fc,fd,fda,fdb,m,mb,p,q,reltol,tol,w,xxhi,xxlo; +static int ext,i99999; +static unsigned long first,qrzero; + switch(IENTRY){case 0: goto DZROR; case 1: goto DSTZR;} +DZROR: + if(*status > 0) goto S280; + *xlo = xxlo; + *xhi = xxhi; + b = *x = *xlo; +/* + GET-FUNCTION-VALUE +*/ + i99999 = 1; + goto S270; +S10: + fb = *fx; + *xlo = *xhi; + a = *x = *xlo; +/* + GET-FUNCTION-VALUE +*/ + i99999 = 2; + goto S270; +S20: +/* + Check that F(ZXLO) < 0 < F(ZXHI) or + F(ZXLO) > 0 > F(ZXHI) +*/ + if(!(fb < 0.0e0)) goto S40; + if(!(*fx < 0.0e0)) goto S30; + *status = -1; + *qleft = *fx < fb; + *qhi = 0; + return; +S40: +S30: + if(!(fb > 0.0e0)) goto S60; + if(!(*fx > 0.0e0)) goto S50; + *status = -1; + *qleft = *fx > fb; + *qhi = 1; + return; +S60: +S50: + fa = *fx; + first = 1; +S70: + c = a; + fc = fa; + ext = 0; +S80: + if(!(fabs(fc) < fabs(fb))) goto S100; + if(!(c != a)) goto S90; + d = a; + fd = fa; +S90: + a = b; + fa = fb; + *xlo = c; + b = *xlo; + fb = fc; + c = a; + fc = fa; +S100: + tol = ftol(*xlo); + m = (c+b)*.5e0; + mb = m-b; + if(!(fabs(mb) > tol)) goto S240; + if(!(ext > 3)) goto S110; + w = mb; + goto S190; +S110: + tol = fifdsign(tol,mb); + p = (b-a)*fb; + if(!first) goto S120; + q = fa-fb; + first = 0; + goto S130; +S120: + fdb = (fd-fb)/(d-b); + fda = (fd-fa)/(d-a); + p = fda*p; + q = fdb*fa-fda*fb; +S130: + if(!(p < 0.0e0)) goto S140; + p = -p; + q = -q; +S140: + if(ext == 3) p *= 2.0e0; + if(!(p*1.0e0 == 0.0e0 || p <= q*tol)) goto S150; + w = tol; + goto S180; +S150: + if(!(p < mb*q)) goto S160; + w = p/q; + goto S170; +S160: + w = mb; +S190: +S180: +S170: + d = a; + fd = fa; + a = b; + fa = fb; + b += w; + *xlo = b; + *x = *xlo; +/* + GET-FUNCTION-VALUE +*/ + i99999 = 3; + goto S270; +S200: + fb = *fx; + if(!(fc*fb >= 0.0e0)) goto S210; + goto S70; +S210: + if(!(w == mb)) goto S220; + ext = 0; + goto S230; +S220: + ext += 1; +S230: + goto S80; +S240: + *xhi = c; + qrzero = fc >= 0.0e0 && fb <= 0.0e0 || fc < 0.0e0 && fb >= 0.0e0; + if(!qrzero) goto S250; + *status = 0; + goto S260; +S250: + *status = -1; +S260: + return; +DSTZR: + xxlo = *zxlo; + xxhi = *zxhi; + abstol = *zabstl; + reltol = *zreltl; + return; +S270: +/* + TO GET-FUNCTION-VALUE +*/ + *status = 1; + return; +S280: + switch((int)i99999){case 1: goto S10;case 2: goto S20;case 3: goto S200; + default: break;} +#undef ftol +} /* END */ + +/***=====================================================================***/ +static void dzror(int *status,double *x,double *fx,double *xlo, + double *xhi,unsigned long *qleft,unsigned long *qhi) +/* +********************************************************************** + + void dzror(int *status,double *x,double *fx,double *xlo, + double *xhi,unsigned long *qleft,unsigned long *qhi) + + Double precision ZeRo of a function -- Reverse Communication + + + Function + + + Performs the zero finding. STZROR must have been called before + this routine in order to set its parameters. + + + Arguments + + + STATUS <--> At the beginning of a zero finding problem, STATUS + should be set to 0 and ZROR invoked. (The value + of other parameters will be ignored on this call.) + + When ZROR needs the function evaluated, it will set + STATUS to 1 and return. The value of the function + should be set in FX and ZROR again called without + changing any of its other parameters. + + When ZROR has finished without error, it will return + with STATUS 0. In that case (XLO,XHI) bound the answe + + If ZROR finds an error (which implies that F(XLO)-Y an + F(XHI)-Y have the same sign, it returns STATUS -1. In + this case, XLO and XHI are undefined. + INTEGER STATUS + + X <-- The value of X at which F(X) is to be evaluated. + DOUBLE PRECISION X + + FX --> The value of F(X) calculated when ZROR returns with + STATUS = 1. + DOUBLE PRECISION FX + + XLO <-- When ZROR returns with STATUS = 0, XLO bounds the + inverval in X containing the solution below. + DOUBLE PRECISION XLO + + XHI <-- When ZROR returns with STATUS = 0, XHI bounds the + inverval in X containing the solution above. + DOUBLE PRECISION XHI + + QLEFT <-- .TRUE. if the stepping search terminated unsucessfully + at XLO. If it is .FALSE. the search terminated + unsucessfully at XHI. + QLEFT is LOGICAL + + QHI <-- .TRUE. if F(X) .GT. Y at the termination of the + search and .FALSE. if F(X) .LT. Y at the + termination of the search. + QHI is LOGICAL + +********************************************************************** +*/ +{ + E0001(0,status,x,fx,xlo,xhi,qleft,qhi,NULL,NULL,NULL,NULL); +} /* END */ + +/***=====================================================================***/ +static void dstzr(double *zxlo,double *zxhi,double *zabstl,double *zreltl) +/* +********************************************************************** + void dstzr(double *zxlo,double *zxhi,double *zabstl,double *zreltl) + Double precision SeT ZeRo finder - Reverse communication version + Function + Sets quantities needed by ZROR. The function of ZROR + and the quantities set is given here. + Concise Description - Given a function F + find XLO such that F(XLO) = 0. + More Precise Description - + Input condition. F is a double precision function of a single + double precision argument and XLO and XHI are such that + F(XLO)*F(XHI) .LE. 0.0 + If the input condition is met, QRZERO returns .TRUE. + and output values of XLO and XHI satisfy the following + F(XLO)*F(XHI) .LE. 0. + ABS(F(XLO) .LE. ABS(F(XHI) + ABS(XLO-XHI) .LE. TOL(X) + where + TOL(X) = MAX(ABSTOL,RELTOL*ABS(X)) + If this algorithm does not find XLO and XHI satisfying + these conditions then QRZERO returns .FALSE. This + implies that the input condition was not met. + Arguments + XLO --> The left endpoint of the interval to be + searched for a solution. + XLO is DOUBLE PRECISION + XHI --> The right endpoint of the interval to be + for a solution. + XHI is DOUBLE PRECISION + ABSTOL, RELTOL --> Two numbers that determine the accuracy + of the solution. See function for a + precise definition. + ABSTOL is DOUBLE PRECISION + RELTOL is DOUBLE PRECISION + Method + Algorithm R of the paper 'Two Efficient Algorithms with + Guaranteed Convergence for Finding a Zero of a Function' + by J. C. P. Bus and T. J. Dekker in ACM Transactions on + Mathematical Software, Volume 1, no. 4 page 330 + (Dec. '75) is employed to find the zero of F(X)-Y. +********************************************************************** +*/ +{ + E0001(1,NULL,NULL,NULL,NULL,NULL,NULL,NULL,zabstl,zreltl,zxhi,zxlo); +} /* END */ + +/***=====================================================================***/ +static double erf1(double *x) +/* +----------------------------------------------------------------------- + EVALUATION OF THE REAL ERROR FUNCTION +----------------------------------------------------------------------- +*/ +{ +static double c = .564189583547756e0; +static double a[5] = { + .771058495001320e-04,-.133733772997339e-02,.323076579225834e-01, + .479137145607681e-01,.128379167095513e+00 +}; +static double b[3] = { + .301048631703895e-02,.538971687740286e-01,.375795757275549e+00 +}; +static double p[8] = { + -1.36864857382717e-07,5.64195517478974e-01,7.21175825088309e+00, + 4.31622272220567e+01,1.52989285046940e+02,3.39320816734344e+02, + 4.51918953711873e+02,3.00459261020162e+02 +}; +static double q[8] = { + 1.00000000000000e+00,1.27827273196294e+01,7.70001529352295e+01, + 2.77585444743988e+02,6.38980264465631e+02,9.31354094850610e+02, + 7.90950925327898e+02,3.00459260956983e+02 +}; +static double r[5] = { + 2.10144126479064e+00,2.62370141675169e+01,2.13688200555087e+01, + 4.65807828718470e+00,2.82094791773523e-01 +}; +static double s[4] = { + 9.41537750555460e+01,1.87114811799590e+02,9.90191814623914e+01, + 1.80124575948747e+01 +}; +static double erf1,ax,bot,t,top,x2; +/* + .. + .. Executable Statements .. +*/ + ax = fabs(*x); + if(ax > 0.5e0) goto S10; + t = *x**x; + top = (((a[0]*t+a[1])*t+a[2])*t+a[3])*t+a[4]+1.0e0; + bot = ((b[0]*t+b[1])*t+b[2])*t+1.0e0; + erf1 = *x*(top/bot); + return erf1; +S10: + if(ax > 4.0e0) goto S20; + top = ((((((p[0]*ax+p[1])*ax+p[2])*ax+p[3])*ax+p[4])*ax+p[5])*ax+p[6])*ax+p[ + 7]; + bot = ((((((q[0]*ax+q[1])*ax+q[2])*ax+q[3])*ax+q[4])*ax+q[5])*ax+q[6])*ax+q[ + 7]; + erf1 = 0.5e0+(0.5e0-exp(-(*x**x))*top/bot); + if(*x < 0.0e0) erf1 = -erf1; + return erf1; +S20: + if(ax >= 5.8e0) goto S30; + x2 = *x**x; + t = 1.0e0/x2; + top = (((r[0]*t+r[1])*t+r[2])*t+r[3])*t+r[4]; + bot = (((s[0]*t+s[1])*t+s[2])*t+s[3])*t+1.0e0; + erf1 = (c-top/(x2*bot))/ax; + erf1 = 0.5e0+(0.5e0-exp(-x2)*erf1); + if(*x < 0.0e0) erf1 = -erf1; + return erf1; +S30: + erf1 = fifdsign(1.0e0,*x); + return erf1; +} /* END */ + +/***=====================================================================***/ +static double erfc1(int *ind,double *x) +/* +----------------------------------------------------------------------- + EVALUATION OF THE COMPLEMENTARY ERROR FUNCTION + + ERFC1(IND,X) = ERFC(X) IF IND = 0 + ERFC1(IND,X) = EXP(X*X)*ERFC(X) OTHERWISE +----------------------------------------------------------------------- +*/ +{ +static double c = .564189583547756e0; +static double a[5] = { + .771058495001320e-04,-.133733772997339e-02,.323076579225834e-01, + .479137145607681e-01,.128379167095513e+00 +}; +static double b[3] = { + .301048631703895e-02,.538971687740286e-01,.375795757275549e+00 +}; +static double p[8] = { + -1.36864857382717e-07,5.64195517478974e-01,7.21175825088309e+00, + 4.31622272220567e+01,1.52989285046940e+02,3.39320816734344e+02, + 4.51918953711873e+02,3.00459261020162e+02 +}; +static double q[8] = { + 1.00000000000000e+00,1.27827273196294e+01,7.70001529352295e+01, + 2.77585444743988e+02,6.38980264465631e+02,9.31354094850610e+02, + 7.90950925327898e+02,3.00459260956983e+02 +}; +static double r[5] = { + 2.10144126479064e+00,2.62370141675169e+01,2.13688200555087e+01, + 4.65807828718470e+00,2.82094791773523e-01 +}; +static double s[4] = { + 9.41537750555460e+01,1.87114811799590e+02,9.90191814623914e+01, + 1.80124575948747e+01 +}; +static int K1 = 1; +static double erfc1,ax,bot,e,t,top,w; +/* + .. + .. Executable Statements .. +*/ +/* + ABS(X) .LE. 0.5 +*/ + ax = fabs(*x); + if(ax > 0.5e0) goto S10; + t = *x**x; + top = (((a[0]*t+a[1])*t+a[2])*t+a[3])*t+a[4]+1.0e0; + bot = ((b[0]*t+b[1])*t+b[2])*t+1.0e0; + erfc1 = 0.5e0+(0.5e0-*x*(top/bot)); + if(*ind != 0) erfc1 = exp(t)*erfc1; + return erfc1; +S10: +/* + 0.5 .LT. ABS(X) .LE. 4 +*/ + if(ax > 4.0e0) goto S20; + top = ((((((p[0]*ax+p[1])*ax+p[2])*ax+p[3])*ax+p[4])*ax+p[5])*ax+p[6])*ax+p[ + 7]; + bot = ((((((q[0]*ax+q[1])*ax+q[2])*ax+q[3])*ax+q[4])*ax+q[5])*ax+q[6])*ax+q[ + 7]; + erfc1 = top/bot; + goto S40; +S20: +/* + ABS(X) .GT. 4 +*/ + if(*x <= -5.6e0) goto S60; + if(*ind != 0) goto S30; + if(*x > 100.0e0) goto S70; + if(*x**x > -exparg(&K1)) goto S70; +S30: + t = pow(1.0e0/ *x,2.0); + top = (((r[0]*t+r[1])*t+r[2])*t+r[3])*t+r[4]; + bot = (((s[0]*t+s[1])*t+s[2])*t+s[3])*t+1.0e0; + erfc1 = (c-t*top/bot)/ax; +S40: +/* + FINAL ASSEMBLY +*/ + if(*ind == 0) goto S50; + if(*x < 0.0e0) erfc1 = 2.0e0*exp(*x**x)-erfc1; + return erfc1; +S50: + w = *x**x; + t = w; + e = w-t; + erfc1 = (0.5e0+(0.5e0-e))*exp(-t)*erfc1; + if(*x < 0.0e0) erfc1 = 2.0e0-erfc1; + return erfc1; +S60: +/* + LIMIT VALUE FOR LARGE NEGATIVE X +*/ + erfc1 = 2.0e0; + if(*ind != 0) erfc1 = 2.0e0*exp(*x**x); + return erfc1; +S70: +/* + LIMIT VALUE FOR LARGE POSITIVE X + WHEN IND = 0 +*/ + erfc1 = 0.0e0; + return erfc1; +} /* END */ + +/***=====================================================================***/ +static double esum(int *mu,double *x) +/* +----------------------------------------------------------------------- + EVALUATION OF EXP(MU + X) +----------------------------------------------------------------------- +*/ +{ +static double esum,w; +/* + .. + .. Executable Statements .. +*/ + if(*x > 0.0e0) goto S10; + if(*mu < 0) goto S20; + w = (double)*mu+*x; + if(w > 0.0e0) goto S20; + esum = exp(w); + return esum; +S10: + if(*mu > 0) goto S20; + w = (double)*mu+*x; + if(w < 0.0e0) goto S20; + esum = exp(w); + return esum; +S20: + w = *mu; + esum = exp(w)*exp(*x); + return esum; +} /* END */ + +/***=====================================================================***/ +static double exparg(int *l) +/* +-------------------------------------------------------------------- + IF L = 0 THEN EXPARG(L) = THE LARGEST POSITIVE W FOR WHICH + EXP(W) CAN BE COMPUTED. + + IF L IS NONZERO THEN EXPARG(L) = THE LARGEST NEGATIVE W FOR + WHICH THE COMPUTED VALUE OF EXP(W) IS NONZERO. + + NOTE... ONLY AN APPROXIMATE VALUE FOR EXPARG(L) IS NEEDED. +-------------------------------------------------------------------- +*/ +{ +static int K1 = 4; +static int K2 = 9; +static int K3 = 10; +static double exparg,lnb; +static int b,m; +/* + .. + .. Executable Statements .. +*/ + b = ipmpar(&K1); + if(b != 2) goto S10; + lnb = .69314718055995e0; + goto S40; +S10: + if(b != 8) goto S20; + lnb = 2.0794415416798e0; + goto S40; +S20: + if(b != 16) goto S30; + lnb = 2.7725887222398e0; + goto S40; +S30: + lnb = log((double)b); +S40: + if(*l == 0) goto S50; + m = ipmpar(&K2)-1; + exparg = 0.99999e0*((double)m*lnb); + return exparg; +S50: + m = ipmpar(&K3); + exparg = 0.99999e0*((double)m*lnb); + return exparg; +} /* END */ + +/***=====================================================================***/ +static double fpser(double *a,double *b,double *x,double *eps) +/* +----------------------------------------------------------------------- + + EVALUATION OF I (A,B) + X + + FOR B .LT. MIN(EPS,EPS*A) AND X .LE. 0.5. + +----------------------------------------------------------------------- + + SET FPSER = X**A +*/ +{ +static int K1 = 1; +static double fpser,an,c,s,t,tol; +/* + .. + .. Executable Statements .. +*/ + fpser = 1.0e0; + if(*a <= 1.e-3**eps) goto S10; + fpser = 0.0e0; + t = *a*log(*x); + if(t < exparg(&K1)) return fpser; + fpser = exp(t); +S10: +/* + NOTE THAT 1/B(A,B) = B +*/ + fpser = *b/ *a*fpser; + tol = *eps/ *a; + an = *a+1.0e0; + t = *x; + s = t/an; +S20: + an += 1.0e0; + t = *x*t; + c = t/an; + s += c; + if(fabs(c) > tol) goto S20; + fpser *= (1.0e0+*a*s); + return fpser; +} /* END */ + +/***=====================================================================***/ +static double gam1(double *a) +/* + ------------------------------------------------------------------ + COMPUTATION OF 1/GAMMA(A+1) - 1 FOR -0.5 .LE. A .LE. 1.5 + ------------------------------------------------------------------ +*/ +{ +static double s1 = .273076135303957e+00; +static double s2 = .559398236957378e-01; +static double p[7] = { + .577215664901533e+00,-.409078193005776e+00,-.230975380857675e+00, + .597275330452234e-01,.766968181649490e-02,-.514889771323592e-02, + .589597428611429e-03 +}; +static double q[5] = { + .100000000000000e+01,.427569613095214e+00,.158451672430138e+00, + .261132021441447e-01,.423244297896961e-02 +}; +static double r[9] = { + -.422784335098468e+00,-.771330383816272e+00,-.244757765222226e+00, + .118378989872749e+00,.930357293360349e-03,-.118290993445146e-01, + .223047661158249e-02,.266505979058923e-03,-.132674909766242e-03 +}; +static double gam1,bot,d,t,top,w,T1; +/* + .. + .. Executable Statements .. +*/ + t = *a; + d = *a-0.5e0; + if(d > 0.0e0) t = d-0.5e0; + T1 = t; + if(T1 < 0) goto S40; + else if(T1 == 0) goto S10; + else goto S20; +S10: + gam1 = 0.0e0; + return gam1; +S20: + top = (((((p[6]*t+p[5])*t+p[4])*t+p[3])*t+p[2])*t+p[1])*t+p[0]; + bot = (((q[4]*t+q[3])*t+q[2])*t+q[1])*t+1.0e0; + w = top/bot; + if(d > 0.0e0) goto S30; + gam1 = *a*w; + return gam1; +S30: + gam1 = t/ *a*(w-0.5e0-0.5e0); + return gam1; +S40: + top = (((((((r[8]*t+r[7])*t+r[6])*t+r[5])*t+r[4])*t+r[3])*t+r[2])*t+r[1])*t+ + r[0]; + bot = (s2*t+s1)*t+1.0e0; + w = top/bot; + if(d > 0.0e0) goto S50; + gam1 = *a*(w+0.5e0+0.5e0); + return gam1; +S50: + gam1 = t*w/ *a; + return gam1; +} /* END */ + +/***=====================================================================***/ +static void gaminv(double *a,double *x,double *x0,double *p,double *q, + int *ierr) +/* + ---------------------------------------------------------------------- + INVERSE INCOMPLETE GAMMA RATIO FUNCTION + + GIVEN POSITIVE A, AND NONEGATIVE P AND Q WHERE P + Q = 1. + THEN X IS COMPUTED WHERE P(A,X) = P AND Q(A,X) = Q. SCHRODER + ITERATION IS EMPLOYED. THE ROUTINE ATTEMPTS TO COMPUTE X + TO 10 SIGNIFICANT DIGITS IF THIS IS POSSIBLE FOR THE + PARTICULAR COMPUTER ARITHMETIC BEING USED. + + ------------ + + X IS A VARIABLE. IF P = 0 THEN X IS ASSIGNED THE VALUE 0, + AND IF Q = 0 THEN X IS SET TO THE LARGEST FLOATING POINT + NUMBER AVAILABLE. OTHERWISE, GAMINV ATTEMPTS TO OBTAIN + A SOLUTION FOR P(A,X) = P AND Q(A,X) = Q. IF THE ROUTINE + IS SUCCESSFUL THEN THE SOLUTION IS STORED IN X. + + X0 IS AN OPTIONAL INITIAL APPROXIMATION FOR X. IF THE USER + DOES NOT WISH TO SUPPLY AN INITIAL APPROXIMATION, THEN SET + X0 .LE. 0. + + IERR IS A VARIABLE THAT REPORTS THE STATUS OF THE RESULTS. + WHEN THE ROUTINE TERMINATES, IERR HAS ONE OF THE FOLLOWING + VALUES ... + + IERR = 0 THE SOLUTION WAS OBTAINED. ITERATION WAS + NOT USED. + IERR.GT.0 THE SOLUTION WAS OBTAINED. IERR ITERATIONS + WERE PERFORMED. + IERR = -2 (INPUT ERROR) A .LE. 0 + IERR = -3 NO SOLUTION WAS OBTAINED. THE RATIO Q/A + IS TOO LARGE. + IERR = -4 (INPUT ERROR) P + Q .NE. 1 + IERR = -6 20 ITERATIONS WERE PERFORMED. THE MOST + RECENT VALUE OBTAINED FOR X IS GIVEN. + THIS CANNOT OCCUR IF X0 .LE. 0. + IERR = -7 ITERATION FAILED. NO VALUE IS GIVEN FOR X. + THIS MAY OCCUR WHEN X IS APPROXIMATELY 0. + IERR = -8 A VALUE FOR X HAS BEEN OBTAINED, BUT THE + ROUTINE IS NOT CERTAIN OF ITS ACCURACY. + ITERATION CANNOT BE PERFORMED IN THIS + CASE. IF X0 .LE. 0, THIS CAN OCCUR ONLY + WHEN P OR Q IS APPROXIMATELY 0. IF X0 IS + POSITIVE THEN THIS CAN OCCUR WHEN A IS + EXCEEDINGLY CLOSE TO X AND A IS EXTREMELY + LARGE (SAY A .GE. 1.E20). + ---------------------------------------------------------------------- + WRITTEN BY ALFRED H. MORRIS, JR. + NAVAL SURFACE WEAPONS CENTER + DAHLGREN, VIRGINIA + ------------------- +*/ +{ +static double a0 = 3.31125922108741e0; +static double a1 = 11.6616720288968e0; +static double a2 = 4.28342155967104e0; +static double a3 = .213623493715853e0; +static double b1 = 6.61053765625462e0; +static double b2 = 6.40691597760039e0; +static double b3 = 1.27364489782223e0; +static double b4 = .036117081018842e0; +static double c = .577215664901533e0; +static double ln10 = 2.302585e0; +static double tol = 1.e-5; +static double amin[2] = { + 500.0e0,100.0e0 +}; +static double bmin[2] = { + 1.e-28,1.e-13 +}; +static double dmin[2] = { + 1.e-06,1.e-04 +}; +static double emin[2] = { + 2.e-03,6.e-03 +}; +static double eps0[2] = { + 1.e-10,1.e-08 +}; +static int K1 = 1; +static int K2 = 2; +static int K3 = 3; +static int K8 = 0; +static double am1,amax,ap1,ap2,ap3,apn,b,c1,c2,c3,c4,c5,d,e,e2,eps,g,h,pn,qg,qn, + r,rta,s,s2,sum,t,u,w,xmax,xmin,xn,y,z; +static int iop; +static double T4,T5,T6,T7,T9; +/* + .. + .. Executable Statements .. +*/ +/* + ****** E, XMIN, AND XMAX ARE MACHINE DEPENDENT CONSTANTS. + E IS THE SMALLEST NUMBER FOR WHICH 1.0 + E .GT. 1.0. + XMIN IS THE SMALLEST POSITIVE NUMBER AND XMAX IS THE + LARGEST POSITIVE NUMBER. +*/ + e = spmpar(&K1); + xmin = spmpar(&K2); + xmax = spmpar(&K3); + *x = 0.0e0; + if(*a <= 0.0e0) goto S300; + t = *p+*q-1.e0; + if(fabs(t) > e) goto S320; + *ierr = 0; + if(*p == 0.0e0) return; + if(*q == 0.0e0) goto S270; + if(*a == 1.0e0) goto S280; + e2 = 2.0e0*e; + amax = 0.4e-10/(e*e); + iop = 1; + if(e > 1.e-10) iop = 2; + eps = eps0[iop-1]; + xn = *x0; + if(*x0 > 0.0e0) goto S160; +/* + SELECTION OF THE INITIAL APPROXIMATION XN OF X + WHEN A .LT. 1 +*/ + if(*a > 1.0e0) goto S80; + T4 = *a+1.0e0; + g = Xgamm(&T4); + qg = *q*g; + if(qg == 0.0e0) goto S360; + b = qg/ *a; + if(qg > 0.6e0**a) goto S40; + if(*a >= 0.30e0 || b < 0.35e0) goto S10; + t = exp(-(b+c)); + u = t*exp(t); + xn = t*exp(u); + goto S160; +S10: + if(b >= 0.45e0) goto S40; + if(b == 0.0e0) goto S360; + y = -log(b); + s = 0.5e0+(0.5e0-*a); + z = log(y); + t = y-s*z; + if(b < 0.15e0) goto S20; + xn = y-s*log(t)-log(1.0e0+s/(t+1.0e0)); + goto S220; +S20: + if(b <= 0.01e0) goto S30; + u = ((t+2.0e0*(3.0e0-*a))*t+(2.0e0-*a)*(3.0e0-*a))/((t+(5.0e0-*a))*t+2.0e0); + xn = y-s*log(t)-log(u); + goto S220; +S30: + c1 = -(s*z); + c2 = -(s*(1.0e0+c1)); + c3 = s*((0.5e0*c1+(2.0e0-*a))*c1+(2.5e0-1.5e0**a)); + c4 = -(s*(((c1/3.0e0+(2.5e0-1.5e0**a))*c1+((*a-6.0e0)**a+7.0e0))*c1+( + (11.0e0**a-46.0)**a+47.0e0)/6.0e0)); + c5 = -(s*((((-(c1/4.0e0)+(11.0e0**a-17.0e0)/6.0e0)*c1+((-(3.0e0**a)+13.0e0)* + *a-13.0e0))*c1+0.5e0*(((2.0e0**a-25.0e0)**a+72.0e0)**a-61.0e0))*c1+(( + (25.0e0**a-195.0e0)**a+477.0e0)**a-379.0e0)/12.0e0)); + xn = (((c5/y+c4)/y+c3)/y+c2)/y+c1+y; + if(*a > 1.0e0) goto S220; + if(b > bmin[iop-1]) goto S220; + *x = xn; + return; +S40: + if(b**q > 1.e-8) goto S50; + xn = exp(-(*q/ *a+c)); + goto S70; +S50: + if(*p <= 0.9e0) goto S60; + T5 = -*q; + xn = exp((alnrel(&T5)+gamln1(a))/ *a); + goto S70; +S60: + xn = exp(log(*p*g)/ *a); +S70: + if(xn == 0.0e0) goto S310; + t = 0.5e0+(0.5e0-xn/(*a+1.0e0)); + xn /= t; + goto S160; +S80: +/* + SELECTION OF THE INITIAL APPROXIMATION XN OF X + WHEN A .GT. 1 +*/ + if(*q <= 0.5e0) goto S90; + w = log(*p); + goto S100; +S90: + w = log(*q); +S100: + t = sqrt(-(2.0e0*w)); + s = t-(((a3*t+a2)*t+a1)*t+a0)/((((b4*t+b3)*t+b2)*t+b1)*t+1.0e0); + if(*q > 0.5e0) s = -s; + rta = sqrt(*a); + s2 = s*s; + xn = *a+s*rta+(s2-1.0e0)/3.0e0+s*(s2-7.0e0)/(36.0e0*rta)-((3.0e0*s2+7.0e0)* + s2-16.0e0)/(810.0e0**a)+s*((9.0e0*s2+256.0e0)*s2-433.0e0)/(38880.0e0**a* + rta); + xn = fifdmax1(xn,0.0e0); + if(*a < amin[iop-1]) goto S110; + *x = xn; + d = 0.5e0+(0.5e0-*x/ *a); + if(fabs(d) <= dmin[iop-1]) return; +S110: + if(*p <= 0.5e0) goto S130; + if(xn < 3.0e0**a) goto S220; + y = -(w+gamln(a)); + d = fifdmax1(2.0e0,*a*(*a-1.0e0)); + if(y < ln10*d) goto S120; + s = 1.0e0-*a; + z = log(y); + goto S30; +S120: + t = *a-1.0e0; + T6 = -(t/(xn+1.0e0)); + xn = y+t*log(xn)-alnrel(&T6); + T7 = -(t/(xn+1.0e0)); + xn = y+t*log(xn)-alnrel(&T7); + goto S220; +S130: + ap1 = *a+1.0e0; + if(xn > 0.70e0*ap1) goto S170; + w += gamln(&ap1); + if(xn > 0.15e0*ap1) goto S140; + ap2 = *a+2.0e0; + ap3 = *a+3.0e0; + *x = exp((w+*x)/ *a); + *x = exp((w+*x-log(1.0e0+*x/ap1*(1.0e0+*x/ap2)))/ *a); + *x = exp((w+*x-log(1.0e0+*x/ap1*(1.0e0+*x/ap2)))/ *a); + *x = exp((w+*x-log(1.0e0+*x/ap1*(1.0e0+*x/ap2*(1.0e0+*x/ap3))))/ *a); + xn = *x; + if(xn > 1.e-2*ap1) goto S140; + if(xn <= emin[iop-1]*ap1) return; + goto S170; +S140: + apn = ap1; + t = xn/apn; + sum = 1.0e0+t; +S150: + apn += 1.0e0; + t *= (xn/apn); + sum += t; + if(t > 1.e-4) goto S150; + t = w-log(sum); + xn = exp((xn+t)/ *a); + xn *= (1.0e0-(*a*log(xn)-xn-t)/(*a-xn)); + goto S170; +S160: +/* + SCHRODER ITERATION USING P +*/ + if(*p > 0.5e0) goto S220; +S170: + if(*p <= 1.e10*xmin) goto S350; + am1 = *a-0.5e0-0.5e0; +S180: + if(*a <= amax) goto S190; + d = 0.5e0+(0.5e0-xn/ *a); + if(fabs(d) <= e2) goto S350; +S190: + if(*ierr >= 20) goto S330; + *ierr += 1; + gratio(a,&xn,&pn,&qn,&K8); + if(pn == 0.0e0 || qn == 0.0e0) goto S350; + r = rcomp(a,&xn); + if(r == 0.0e0) goto S350; + t = (pn-*p)/r; + w = 0.5e0*(am1-xn); + if(fabs(t) <= 0.1e0 && fabs(w*t) <= 0.1e0) goto S200; + *x = xn*(1.0e0-t); + if(*x <= 0.0e0) goto S340; + d = fabs(t); + goto S210; +S200: + h = t*(1.0e0+w*t); + *x = xn*(1.0e0-h); + if(*x <= 0.0e0) goto S340; + if(fabs(w) >= 1.0e0 && fabs(w)*t*t <= eps) return; + d = fabs(h); +S210: + xn = *x; + if(d > tol) goto S180; + if(d <= eps) return; + if(fabs(*p-pn) <= tol**p) return; + goto S180; +S220: +/* + SCHRODER ITERATION USING Q +*/ + if(*q <= 1.e10*xmin) goto S350; + am1 = *a-0.5e0-0.5e0; +S230: + if(*a <= amax) goto S240; + d = 0.5e0+(0.5e0-xn/ *a); + if(fabs(d) <= e2) goto S350; +S240: + if(*ierr >= 20) goto S330; + *ierr += 1; + gratio(a,&xn,&pn,&qn,&K8); + if(pn == 0.0e0 || qn == 0.0e0) goto S350; + r = rcomp(a,&xn); + if(r == 0.0e0) goto S350; + t = (*q-qn)/r; + w = 0.5e0*(am1-xn); + if(fabs(t) <= 0.1e0 && fabs(w*t) <= 0.1e0) goto S250; + *x = xn*(1.0e0-t); + if(*x <= 0.0e0) goto S340; + d = fabs(t); + goto S260; +S250: + h = t*(1.0e0+w*t); + *x = xn*(1.0e0-h); + if(*x <= 0.0e0) goto S340; + if(fabs(w) >= 1.0e0 && fabs(w)*t*t <= eps) return; + d = fabs(h); +S260: + xn = *x; + if(d > tol) goto S230; + if(d <= eps) return; + if(fabs(*q-qn) <= tol**q) return; + goto S230; +S270: +/* + SPECIAL CASES +*/ + *x = xmax; + return; +S280: + if(*q < 0.9e0) goto S290; + T9 = -*p; + *x = -alnrel(&T9); + return; +S290: + *x = -log(*q); + return; +S300: +/* + ERROR RETURN +*/ + *ierr = -2; + return; +S310: + *ierr = -3; + return; +S320: + *ierr = -4; + return; +S330: + *ierr = -6; + return; +S340: + *ierr = -7; + return; +S350: + *x = xn; + *ierr = -8; + return; +S360: + *x = xmax; + *ierr = -8; + return; +} /* END */ + +/***=====================================================================***/ +static double gamln(double *a) +/* +----------------------------------------------------------------------- + EVALUATION OF LN(GAMMA(A)) FOR POSITIVE A +----------------------------------------------------------------------- + WRITTEN BY ALFRED H. MORRIS + NAVAL SURFACE WARFARE CENTER + DAHLGREN, VIRGINIA +-------------------------- + D = 0.5*(LN(2*PI) - 1) +-------------------------- +*/ +{ +static double c0 = .833333333333333e-01; +static double c1 = -.277777777760991e-02; +static double c2 = .793650666825390e-03; +static double c3 = -.595202931351870e-03; +static double c4 = .837308034031215e-03; +static double c5 = -.165322962780713e-02; +static double d = .418938533204673e0; +static double gamln,t,w; +static int i,n; +static double T1; +/* + .. + .. Executable Statements .. +*/ + if(*a > 0.8e0) goto S10; + gamln = gamln1(a)-log(*a); + return gamln; +S10: + if(*a > 2.25e0) goto S20; + t = *a-0.5e0-0.5e0; + gamln = gamln1(&t); + return gamln; +S20: + if(*a >= 10.0e0) goto S40; + n = *a-1.25e0; + t = *a; + w = 1.0e0; + for(i=1; i<=n; i++) { + t -= 1.0e0; + w = t*w; + } + T1 = t-1.0e0; + gamln = gamln1(&T1)+log(w); + return gamln; +S40: + t = pow(1.0e0/ *a,2.0); + w = (((((c5*t+c4)*t+c3)*t+c2)*t+c1)*t+c0)/ *a; + gamln = d+w+(*a-0.5e0)*(log(*a)-1.0e0); + return gamln; +} /* END */ + +/***=====================================================================***/ +static double gamln1(double *a) +/* +----------------------------------------------------------------------- + EVALUATION OF LN(GAMMA(1 + A)) FOR -0.2 .LE. A .LE. 1.25 +----------------------------------------------------------------------- +*/ +{ +static double p0 = .577215664901533e+00; +static double p1 = .844203922187225e+00; +static double p2 = -.168860593646662e+00; +static double p3 = -.780427615533591e+00; +static double p4 = -.402055799310489e+00; +static double p5 = -.673562214325671e-01; +static double p6 = -.271935708322958e-02; +static double q1 = .288743195473681e+01; +static double q2 = .312755088914843e+01; +static double q3 = .156875193295039e+01; +static double q4 = .361951990101499e+00; +static double q5 = .325038868253937e-01; +static double q6 = .667465618796164e-03; +static double r0 = .422784335098467e+00; +static double r1 = .848044614534529e+00; +static double r2 = .565221050691933e+00; +static double r3 = .156513060486551e+00; +static double r4 = .170502484022650e-01; +static double r5 = .497958207639485e-03; +static double s1 = .124313399877507e+01; +static double s2 = .548042109832463e+00; +static double s3 = .101552187439830e+00; +static double s4 = .713309612391000e-02; +static double s5 = .116165475989616e-03; +static double gamln1,w,x; +/* + .. + .. Executable Statements .. +*/ + if(*a >= 0.6e0) goto S10; + w = ((((((p6**a+p5)**a+p4)**a+p3)**a+p2)**a+p1)**a+p0)/((((((q6**a+q5)**a+ + q4)**a+q3)**a+q2)**a+q1)**a+1.0e0); + gamln1 = -(*a*w); + return gamln1; +S10: + x = *a-0.5e0-0.5e0; + w = (((((r5*x+r4)*x+r3)*x+r2)*x+r1)*x+r0)/(((((s5*x+s4)*x+s3)*x+s2)*x+s1)*x + +1.0e0); + gamln1 = x*w; + return gamln1; +} /* END */ + +/***=====================================================================***/ +static double Xgamm(double *a) +/* +----------------------------------------------------------------------- + + EVALUATION OF THE GAMMA FUNCTION FOR REAL ARGUMENTS + + ----------- + + GAMMA(A) IS ASSIGNED THE VALUE 0 WHEN THE GAMMA FUNCTION CANNOT + BE COMPUTED. + +----------------------------------------------------------------------- + WRITTEN BY ALFRED H. MORRIS, JR. + NAVAL SURFACE WEAPONS CENTER + DAHLGREN, VIRGINIA +----------------------------------------------------------------------- +*/ +{ +static double d = .41893853320467274178e0; +static double pi = 3.1415926535898e0; +static double r1 = .820756370353826e-03; +static double r2 = -.595156336428591e-03; +static double r3 = .793650663183693e-03; +static double r4 = -.277777777770481e-02; +static double r5 = .833333333333333e-01; +static double p[7] = { + .539637273585445e-03,.261939260042690e-02,.204493667594920e-01, + .730981088720487e-01,.279648642639792e+00,.553413866010467e+00,1.0e0 +}; +static double q[7] = { + -.832979206704073e-03,.470059485860584e-02,.225211131035340e-01, + -.170458969313360e+00,-.567902761974940e-01,.113062953091122e+01,1.0e0 +}; +static int K2 = 3; +static int K3 = 0; +static double Xgamm,bot,g,lnx,s,t,top,w,x,z; +static int i,j,m,n,T1; +/* + .. + .. Executable Statements .. +*/ + Xgamm = 0.0e0; + x = *a; + if(fabs(*a) >= 15.0e0) goto S110; +/* +----------------------------------------------------------------------- + EVALUATION OF GAMMA(A) FOR ABS(A) .LT. 15 +----------------------------------------------------------------------- +*/ + t = 1.0e0; + m = fifidint(*a)-1; +/* + LET T BE THE PRODUCT OF A-J WHEN A .GE. 2 +*/ + T1 = m; + if(T1 < 0) goto S40; + else if(T1 == 0) goto S30; + else goto S10; +S10: + for(j=1; j<=m; j++) { + x -= 1.0e0; + t = x*t; + } +S30: + x -= 1.0e0; + goto S80; +S40: +/* + LET T BE THE PRODUCT OF A+J WHEN A .LT. 1 +*/ + t = *a; + if(*a > 0.0e0) goto S70; + m = -m-1; + if(m == 0) goto S60; + for(j=1; j<=m; j++) { + x += 1.0e0; + t = x*t; + } +S60: + x += (0.5e0+0.5e0); + t = x*t; + if(t == 0.0e0) return Xgamm; +S70: +/* + THE FOLLOWING CODE CHECKS IF 1/T CAN OVERFLOW. THIS + CODE MAY BE OMITTED IF DESIRED. +*/ + if(fabs(t) >= 1.e-30) goto S80; + if(fabs(t)*spmpar(&K2) <= 1.0001e0) return Xgamm; + Xgamm = 1.0e0/t; + return Xgamm; +S80: +/* + COMPUTE GAMMA(1 + X) FOR 0 .LE. X .LT. 1 +*/ + top = p[0]; + bot = q[0]; + for(i=1; i<7; i++) { + top = p[i]+x*top; + bot = q[i]+x*bot; + } + Xgamm = top/bot; +/* + TERMINATION +*/ + if(*a < 1.0e0) goto S100; + Xgamm *= t; + return Xgamm; +S100: + Xgamm /= t; + return Xgamm; +S110: +/* +----------------------------------------------------------------------- + EVALUATION OF GAMMA(A) FOR ABS(A) .GE. 15 +----------------------------------------------------------------------- +*/ + if(fabs(*a) >= 1.e3) return Xgamm; + if(*a > 0.0e0) goto S120; + x = -*a; + n = x; + t = x-(double)n; + if(t > 0.9e0) t = 1.0e0-t; + s = sin(pi*t)/pi; + if(fifmod(n,2) == 0) s = -s; + if(s == 0.0e0) return Xgamm; +S120: +/* + COMPUTE THE MODIFIED ASYMPTOTIC SUM +*/ + t = 1.0e0/(x*x); + g = ((((r1*t+r2)*t+r3)*t+r4)*t+r5)/x; +/* + ONE MAY REPLACE THE NEXT STATEMENT WITH LNX = ALOG(X) + BUT LESS ACCURACY WILL NORMALLY BE OBTAINED. +*/ + lnx = log(x); +/* + FINAL ASSEMBLY +*/ + z = x; + g = d+g+(z-0.5e0)*(lnx-1.e0); + w = g; + t = g-w; + if(w > 0.99999e0*exparg(&K3)) return Xgamm; + Xgamm = exp(w)*(1.0e0+t); + if(*a < 0.0e0) Xgamm = 1.0e0/(Xgamm*s)/x; + return Xgamm; +} /* END */ + +/***=====================================================================***/ +static void grat1(double *a,double *x,double *r,double *p,double *q, + double *eps) +{ +static int K2 = 0; +static double a2n,a2nm1,am0,an,an0,b2n,b2nm1,c,cma,g,h,j,l,sum,t,tol,w,z,T1,T3; +/* + .. + .. Executable Statements .. +*/ +/* +----------------------------------------------------------------------- + EVALUATION OF THE INCOMPLETE GAMMA RATIO FUNCTIONS + P(A,X) AND Q(A,X) + IT IS ASSUMED THAT A .LE. 1. EPS IS THE TOLERANCE TO BE USED. + THE INPUT ARGUMENT R HAS THE VALUE E**(-X)*X**A/GAMMA(A). +----------------------------------------------------------------------- +*/ + if(*a**x == 0.0e0) goto S120; + if(*a == 0.5e0) goto S100; + if(*x < 1.1e0) goto S10; + goto S60; +S10: +/* + TAYLOR SERIES FOR P(A,X)/X**A +*/ + an = 3.0e0; + c = *x; + sum = *x/(*a+3.0e0); + tol = 0.1e0**eps/(*a+1.0e0); +S20: + an += 1.0e0; + c = -(c*(*x/an)); + t = c/(*a+an); + sum += t; + if(fabs(t) > tol) goto S20; + j = *a**x*((sum/6.0e0-0.5e0/(*a+2.0e0))**x+1.0e0/(*a+1.0e0)); + z = *a*log(*x); + h = gam1(a); + g = 1.0e0+h; + if(*x < 0.25e0) goto S30; + if(*a < *x/2.59e0) goto S50; + goto S40; +S30: + if(z > -.13394e0) goto S50; +S40: + w = exp(z); + *p = w*g*(0.5e0+(0.5e0-j)); + *q = 0.5e0+(0.5e0-*p); + return; +S50: + l = rexp(&z); + w = 0.5e0+(0.5e0+l); + *q = (w*j-l)*g-h; + if(*q < 0.0e0) goto S90; + *p = 0.5e0+(0.5e0-*q); + return; +S60: +/* + CONTINUED FRACTION EXPANSION +*/ + a2nm1 = a2n = 1.0e0; + b2nm1 = *x; + b2n = *x+(1.0e0-*a); + c = 1.0e0; +S70: + a2nm1 = *x*a2n+c*a2nm1; + b2nm1 = *x*b2n+c*b2nm1; + am0 = a2nm1/b2nm1; + c += 1.0e0; + cma = c-*a; + a2n = a2nm1+cma*a2n; + b2n = b2nm1+cma*b2n; + an0 = a2n/b2n; + if(fabs(an0-am0) >= *eps*an0) goto S70; + *q = *r*an0; + *p = 0.5e0+(0.5e0-*q); + return; +S80: +/* + SPECIAL CASES +*/ + *p = 0.0e0; + *q = 1.0e0; + return; +S90: + *p = 1.0e0; + *q = 0.0e0; + return; +S100: + if(*x >= 0.25e0) goto S110; + T1 = sqrt(*x); + *p = erf1(&T1); + *q = 0.5e0+(0.5e0-*p); + return; +S110: + T3 = sqrt(*x); + *q = erfc1(&K2,&T3); + *p = 0.5e0+(0.5e0-*q); + return; +S120: + if(*x <= *a) goto S80; + goto S90; +} /* END */ + +/***=====================================================================***/ +static void gratio(double *a,double *x,double *ans,double *qans,int *ind) +/* + ---------------------------------------------------------------------- + EVALUATION OF THE INCOMPLETE GAMMA RATIO FUNCTIONS + P(A,X) AND Q(A,X) + + ---------- + + IT IS ASSUMED THAT A AND X ARE NONNEGATIVE, WHERE A AND X + ARE NOT BOTH 0. + + ANS AND QANS ARE VARIABLES. GRATIO ASSIGNS ANS THE VALUE + P(A,X) AND QANS THE VALUE Q(A,X). IND MAY BE ANY INTEGER. + IF IND = 0 THEN THE USER IS REQUESTING AS MUCH ACCURACY AS + POSSIBLE (UP TO 14 SIGNIFICANT DIGITS). OTHERWISE, IF + IND = 1 THEN ACCURACY IS REQUESTED TO WITHIN 1 UNIT OF THE + 6-TH SIGNIFICANT DIGIT, AND IF IND .NE. 0,1 THEN ACCURACY + IS REQUESTED TO WITHIN 1 UNIT OF THE 3RD SIGNIFICANT DIGIT. + + ERROR RETURN ... + ANS IS ASSIGNED THE VALUE 2 WHEN A OR X IS NEGATIVE, + WHEN A*X = 0, OR WHEN P(A,X) AND Q(A,X) ARE INDETERMINANT. + P(A,X) AND Q(A,X) ARE COMPUTATIONALLY INDETERMINANT WHEN + X IS EXCEEDINGLY CLOSE TO A AND A IS EXTREMELY LARGE. + ---------------------------------------------------------------------- + WRITTEN BY ALFRED H. MORRIS, JR. + NAVAL SURFACE WEAPONS CENTER + DAHLGREN, VIRGINIA + -------------------- +*/ +{ +static double alog10 = 2.30258509299405e0; +static double d10 = -.185185185185185e-02; +static double d20 = .413359788359788e-02; +static double d30 = .649434156378601e-03; +static double d40 = -.861888290916712e-03; +static double d50 = -.336798553366358e-03; +static double d60 = .531307936463992e-03; +static double d70 = .344367606892378e-03; +static double rt2pin = .398942280401433e0; +static double rtpi = 1.77245385090552e0; +static double third = .333333333333333e0; +static double acc0[3] = { + 5.e-15,5.e-7,5.e-4 +}; +static double big[3] = { + 20.0e0,14.0e0,10.0e0 +}; +static double d0[13] = { + .833333333333333e-01,-.148148148148148e-01,.115740740740741e-02, + .352733686067019e-03,-.178755144032922e-03,.391926317852244e-04, + -.218544851067999e-05,-.185406221071516e-05,.829671134095309e-06, + -.176659527368261e-06,.670785354340150e-08,.102618097842403e-07, + -.438203601845335e-08 +}; +static double d1[12] = { + -.347222222222222e-02,.264550264550265e-02,-.990226337448560e-03, + .205761316872428e-03,-.401877572016461e-06,-.180985503344900e-04, + .764916091608111e-05,-.161209008945634e-05,.464712780280743e-08, + .137863344691572e-06,-.575254560351770e-07,.119516285997781e-07 +}; +static double d2[10] = { + -.268132716049383e-02,.771604938271605e-03,.200938786008230e-05, + -.107366532263652e-03,.529234488291201e-04,-.127606351886187e-04, + .342357873409614e-07,.137219573090629e-05,-.629899213838006e-06, + .142806142060642e-06 +}; +static double d3[8] = { + .229472093621399e-03,-.469189494395256e-03,.267720632062839e-03, + -.756180167188398e-04,-.239650511386730e-06,.110826541153473e-04, + -.567495282699160e-05,.142309007324359e-05 +}; +static double d4[6] = { + .784039221720067e-03,-.299072480303190e-03,-.146384525788434e-05, + .664149821546512e-04,-.396836504717943e-04,.113757269706784e-04 +}; +static double d5[4] = { + -.697281375836586e-04,.277275324495939e-03,-.199325705161888e-03, + .679778047793721e-04 +}; +static double d6[2] = { + -.592166437353694e-03,.270878209671804e-03 +}; +static double e00[3] = { + .25e-3,.25e-1,.14e0 +}; +static double x00[3] = { + 31.0e0,17.0e0,9.7e0 +}; +static int K1 = 1; +static int K2 = 0; +static double a2n,a2nm1,acc,am0,amn,an,an0,apn,b2n,b2nm1,c,c0,c1,c2,c3,c4,c5,c6, + cma,e,e0,g,h,j,l,r,rta,rtx,s,sum,t,t1,tol,twoa,u,w,x0,y,z; +static int i,iop,m,max,n; +static double wk[20],T3; +static int T4,T5; +static double T6,T7; +/* + .. + .. Executable Statements .. +*/ +/* + -------------------- + ****** E IS A MACHINE DEPENDENT CONSTANT. E IS THE SMALLEST + FLOATING POINT NUMBER FOR WHICH 1.0 + E .GT. 1.0 . +*/ + e = spmpar(&K1); + if(*a < 0.0e0 || *x < 0.0e0) goto S430; + if(*a == 0.0e0 && *x == 0.0e0) goto S430; + if(*a**x == 0.0e0) goto S420; + iop = *ind+1; + if(iop != 1 && iop != 2) iop = 3; + acc = fifdmax1(acc0[iop-1],e); + e0 = e00[iop-1]; + x0 = x00[iop-1]; +/* + SELECT THE APPROPRIATE ALGORITHM +*/ + if(*a >= 1.0e0) goto S10; + if(*a == 0.5e0) goto S390; + if(*x < 1.1e0) goto S160; + t1 = *a*log(*x)-*x; + u = *a*exp(t1); + if(u == 0.0e0) goto S380; + r = u*(1.0e0+gam1(a)); + goto S250; +S10: + if(*a >= big[iop-1]) goto S30; + if(*a > *x || *x >= x0) goto S20; + twoa = *a+*a; + m = fifidint(twoa); + if(twoa != (double)m) goto S20; + i = m/2; + if(*a == (double)i) goto S210; + goto S220; +S20: + t1 = *a*log(*x)-*x; + r = exp(t1)/Xgamm(a); + goto S40; +S30: + l = *x/ *a; + if(l == 0.0e0) goto S370; + s = 0.5e0+(0.5e0-l); + z = rlog(&l); + if(z >= 700.0e0/ *a) goto S410; + y = *a*z; + rta = sqrt(*a); + if(fabs(s) <= e0/rta) goto S330; + if(fabs(s) <= 0.4e0) goto S270; + t = pow(1.0e0/ *a,2.0); + t1 = (((0.75e0*t-1.0e0)*t+3.5e0)*t-105.0e0)/(*a*1260.0e0); + t1 -= y; + r = rt2pin*rta*exp(t1); +S40: + if(r == 0.0e0) goto S420; + if(*x <= fifdmax1(*a,alog10)) goto S50; + if(*x < x0) goto S250; + goto S100; +S50: +/* + TAYLOR SERIES FOR P/R +*/ + apn = *a+1.0e0; + t = *x/apn; + wk[0] = t; + for(n=2; n<=20; n++) { + apn += 1.0e0; + t *= (*x/apn); + if(t <= 1.e-3) goto S70; + wk[n-1] = t; + } + n = 20; +S70: + sum = t; + tol = 0.5e0*acc; +S80: + apn += 1.0e0; + t *= (*x/apn); + sum += t; + if(t > tol) goto S80; + max = n-1; + for(m=1; m<=max; m++) { + n -= 1; + sum += wk[n-1]; + } + *ans = r/ *a*(1.0e0+sum); + *qans = 0.5e0+(0.5e0-*ans); + return; +S100: +/* + ASYMPTOTIC EXPANSION +*/ + amn = *a-1.0e0; + t = amn/ *x; + wk[0] = t; + for(n=2; n<=20; n++) { + amn -= 1.0e0; + t *= (amn/ *x); + if(fabs(t) <= 1.e-3) goto S120; + wk[n-1] = t; + } + n = 20; +S120: + sum = t; +S130: + if(fabs(t) <= acc) goto S140; + amn -= 1.0e0; + t *= (amn/ *x); + sum += t; + goto S130; +S140: + max = n-1; + for(m=1; m<=max; m++) { + n -= 1; + sum += wk[n-1]; + } + *qans = r/ *x*(1.0e0+sum); + *ans = 0.5e0+(0.5e0-*qans); + return; +S160: +/* + TAYLOR SERIES FOR P(A,X)/X**A +*/ + an = 3.0e0; + c = *x; + sum = *x/(*a+3.0e0); + tol = 3.0e0*acc/(*a+1.0e0); +S170: + an += 1.0e0; + c = -(c*(*x/an)); + t = c/(*a+an); + sum += t; + if(fabs(t) > tol) goto S170; + j = *a**x*((sum/6.0e0-0.5e0/(*a+2.0e0))**x+1.0e0/(*a+1.0e0)); + z = *a*log(*x); + h = gam1(a); + g = 1.0e0+h; + if(*x < 0.25e0) goto S180; + if(*a < *x/2.59e0) goto S200; + goto S190; +S180: + if(z > -.13394e0) goto S200; +S190: + w = exp(z); + *ans = w*g*(0.5e0+(0.5e0-j)); + *qans = 0.5e0+(0.5e0-*ans); + return; +S200: + l = rexp(&z); + w = 0.5e0+(0.5e0+l); + *qans = (w*j-l)*g-h; + if(*qans < 0.0e0) goto S380; + *ans = 0.5e0+(0.5e0-*qans); + return; +S210: +/* + FINITE SUMS FOR Q WHEN A .GE. 1 + AND 2*A IS AN INTEGER +*/ + sum = exp(-*x); + t = sum; + n = 1; + c = 0.0e0; + goto S230; +S220: + rtx = sqrt(*x); + sum = erfc1(&K2,&rtx); + t = exp(-*x)/(rtpi*rtx); + n = 0; + c = -0.5e0; +S230: + if(n == i) goto S240; + n += 1; + c += 1.0e0; + t = *x*t/c; + sum += t; + goto S230; +S240: + *qans = sum; + *ans = 0.5e0+(0.5e0-*qans); + return; +S250: +/* + CONTINUED FRACTION EXPANSION +*/ + tol = fifdmax1(5.0e0*e,acc); + a2nm1 = a2n = 1.0e0; + b2nm1 = *x; + b2n = *x+(1.0e0-*a); + c = 1.0e0; +S260: + a2nm1 = *x*a2n+c*a2nm1; + b2nm1 = *x*b2n+c*b2nm1; + am0 = a2nm1/b2nm1; + c += 1.0e0; + cma = c-*a; + a2n = a2nm1+cma*a2n; + b2n = b2nm1+cma*b2n; + an0 = a2n/b2n; + if(fabs(an0-am0) >= tol*an0) goto S260; + *qans = r*an0; + *ans = 0.5e0+(0.5e0-*qans); + return; +S270: +/* + GENERAL TEMME EXPANSION +*/ + if(fabs(s) <= 2.0e0*e && *a*e*e > 3.28e-3) goto S430; + c = exp(-y); + T3 = sqrt(y); + w = 0.5e0*erfc1(&K1,&T3); + u = 1.0e0/ *a; + z = sqrt(z+z); + if(l < 1.0e0) z = -z; + T4 = iop-2; + if(T4 < 0) goto S280; + else if(T4 == 0) goto S290; + else goto S300; +S280: + if(fabs(s) <= 1.e-3) goto S340; + c0 = ((((((((((((d0[12]*z+d0[11])*z+d0[10])*z+d0[9])*z+d0[8])*z+d0[7])*z+d0[ + 6])*z+d0[5])*z+d0[4])*z+d0[3])*z+d0[2])*z+d0[1])*z+d0[0])*z-third; + c1 = (((((((((((d1[11]*z+d1[10])*z+d1[9])*z+d1[8])*z+d1[7])*z+d1[6])*z+d1[5] + )*z+d1[4])*z+d1[3])*z+d1[2])*z+d1[1])*z+d1[0])*z+d10; + c2 = (((((((((d2[9]*z+d2[8])*z+d2[7])*z+d2[6])*z+d2[5])*z+d2[4])*z+d2[3])*z+ + d2[2])*z+d2[1])*z+d2[0])*z+d20; + c3 = (((((((d3[7]*z+d3[6])*z+d3[5])*z+d3[4])*z+d3[3])*z+d3[2])*z+d3[1])*z+ + d3[0])*z+d30; + c4 = (((((d4[5]*z+d4[4])*z+d4[3])*z+d4[2])*z+d4[1])*z+d4[0])*z+d40; + c5 = (((d5[3]*z+d5[2])*z+d5[1])*z+d5[0])*z+d50; + c6 = (d6[1]*z+d6[0])*z+d60; + t = ((((((d70*u+c6)*u+c5)*u+c4)*u+c3)*u+c2)*u+c1)*u+c0; + goto S310; +S290: + c0 = (((((d0[5]*z+d0[4])*z+d0[3])*z+d0[2])*z+d0[1])*z+d0[0])*z-third; + c1 = (((d1[3]*z+d1[2])*z+d1[1])*z+d1[0])*z+d10; + c2 = d2[0]*z+d20; + t = (c2*u+c1)*u+c0; + goto S310; +S300: + t = ((d0[2]*z+d0[1])*z+d0[0])*z-third; +S310: + if(l < 1.0e0) goto S320; + *qans = c*(w+rt2pin*t/rta); + *ans = 0.5e0+(0.5e0-*qans); + return; +S320: + *ans = c*(w-rt2pin*t/rta); + *qans = 0.5e0+(0.5e0-*ans); + return; +S330: +/* + TEMME EXPANSION FOR L = 1 +*/ + if(*a*e*e > 3.28e-3) goto S430; + c = 0.5e0+(0.5e0-y); + w = (0.5e0-sqrt(y)*(0.5e0+(0.5e0-y/3.0e0))/rtpi)/c; + u = 1.0e0/ *a; + z = sqrt(z+z); + if(l < 1.0e0) z = -z; + T5 = iop-2; + if(T5 < 0) goto S340; + else if(T5 == 0) goto S350; + else goto S360; +S340: + c0 = ((((((d0[6]*z+d0[5])*z+d0[4])*z+d0[3])*z+d0[2])*z+d0[1])*z+d0[0])*z- + third; + c1 = (((((d1[5]*z+d1[4])*z+d1[3])*z+d1[2])*z+d1[1])*z+d1[0])*z+d10; + c2 = ((((d2[4]*z+d2[3])*z+d2[2])*z+d2[1])*z+d2[0])*z+d20; + c3 = (((d3[3]*z+d3[2])*z+d3[1])*z+d3[0])*z+d30; + c4 = (d4[1]*z+d4[0])*z+d40; + c5 = (d5[1]*z+d5[0])*z+d50; + c6 = d6[0]*z+d60; + t = ((((((d70*u+c6)*u+c5)*u+c4)*u+c3)*u+c2)*u+c1)*u+c0; + goto S310; +S350: + c0 = (d0[1]*z+d0[0])*z-third; + c1 = d1[0]*z+d10; + t = (d20*u+c1)*u+c0; + goto S310; +S360: + t = d0[0]*z-third; + goto S310; +S370: +/* + SPECIAL CASES +*/ + *ans = 0.0e0; + *qans = 1.0e0; + return; +S380: + *ans = 1.0e0; + *qans = 0.0e0; + return; +S390: + if(*x >= 0.25e0) goto S400; + T6 = sqrt(*x); + *ans = erf1(&T6); + *qans = 0.5e0+(0.5e0-*ans); + return; +S400: + T7 = sqrt(*x); + *qans = erfc1(&K2,&T7); + *ans = 0.5e0+(0.5e0-*qans); + return; +S410: + if(fabs(s) <= 2.0e0*e) goto S430; +S420: + if(*x <= *a) goto S370; + goto S380; +S430: +/* + ERROR RETURN +*/ + *ans = 2.0e0; + return; +} /* END */ + +/***=====================================================================***/ +static double gsumln(double *a,double *b) +/* +----------------------------------------------------------------------- + EVALUATION OF THE FUNCTION LN(GAMMA(A + B)) + FOR 1 .LE. A .LE. 2 AND 1 .LE. B .LE. 2 +----------------------------------------------------------------------- +*/ +{ +static double gsumln,x,T1,T2; +/* + .. + .. Executable Statements .. +*/ + x = *a+*b-2.e0; + if(x > 0.25e0) goto S10; + T1 = 1.0e0+x; + gsumln = gamln1(&T1); + return gsumln; +S10: + if(x > 1.25e0) goto S20; + gsumln = gamln1(&x)+alnrel(&x); + return gsumln; +S20: + T2 = x-1.0e0; + gsumln = gamln1(&T2)+log(x*(1.0e0+x)); + return gsumln; +} /* END */ + +/***=====================================================================***/ +static double psi(double *xx) +/* +--------------------------------------------------------------------- + + EVALUATION OF THE DIGAMMA FUNCTION + + ----------- + + PSI(XX) IS ASSIGNED THE VALUE 0 WHEN THE DIGAMMA FUNCTION CANNOT + BE COMPUTED. + + THE MAIN COMPUTATION INVOLVES EVALUATION OF RATIONAL CHEBYSHEV + APPROXIMATIONS PUBLISHED IN MATH. COMP. 27, 123-127(1973) BY + CODY, STRECOK AND THACHER. + +--------------------------------------------------------------------- + PSI WAS WRITTEN AT ARGONNE NATIONAL LABORATORY FOR THE FUNPACK + PACKAGE OF SPECIAL FUNCTION SUBROUTINES. PSI WAS MODIFIED BY + A.H. MORRIS (NSWC). +--------------------------------------------------------------------- +*/ +{ +static double dx0 = 1.461632144968362341262659542325721325e0; +static double piov4 = .785398163397448e0; +static double p1[7] = { + .895385022981970e-02,.477762828042627e+01,.142441585084029e+03, + .118645200713425e+04,.363351846806499e+04,.413810161269013e+04, + .130560269827897e+04 +}; +static double p2[4] = { + -.212940445131011e+01,-.701677227766759e+01,-.448616543918019e+01, + -.648157123766197e+00 +}; +static double q1[6] = { + .448452573429826e+02,.520752771467162e+03,.221000799247830e+04, + .364127349079381e+04,.190831076596300e+04,.691091682714533e-05 +}; +static double q2[4] = { + .322703493791143e+02,.892920700481861e+02,.546117738103215e+02, + .777788548522962e+01 +}; +static int K1 = 3; +static int K2 = 1; +static double psi,aug,den,sgn,upper,w,x,xmax1,xmx0,xsmall,z; +static int i,m,n,nq; +/* + .. + .. Executable Statements .. +*/ +/* +--------------------------------------------------------------------- + MACHINE DEPENDENT CONSTANTS ... + XMAX1 = THE SMALLEST POSITIVE FLOATING POINT CONSTANT + WITH ENTIRELY INTEGER REPRESENTATION. ALSO USED + AS NEGATIVE OF LOWER BOUND ON ACCEPTABLE NEGATIVE + ARGUMENTS AND AS THE POSITIVE ARGUMENT BEYOND WHICH + PSI MAY BE REPRESENTED AS ALOG(X). + XSMALL = ABSOLUTE ARGUMENT BELOW WHICH PI*COTAN(PI*X) + MAY BE REPRESENTED BY 1/X. +--------------------------------------------------------------------- +*/ + xmax1 = ipmpar(&K1); + xmax1 = fifdmin1(xmax1,1.0e0/spmpar(&K2)); + xsmall = 1.e-9; + x = *xx; + aug = 0.0e0; + if(x >= 0.5e0) goto S50; +/* +--------------------------------------------------------------------- + X .LT. 0.5, USE REFLECTION FORMULA + PSI(1-X) = PSI(X) + PI * COTAN(PI*X) +--------------------------------------------------------------------- +*/ + if(fabs(x) > xsmall) goto S10; + if(x == 0.0e0) goto S100; +/* +--------------------------------------------------------------------- + 0 .LT. ABS(X) .LE. XSMALL. USE 1/X AS A SUBSTITUTE + FOR PI*COTAN(PI*X) +--------------------------------------------------------------------- +*/ + aug = -(1.0e0/x); + goto S40; +S10: +/* +--------------------------------------------------------------------- + REDUCTION OF ARGUMENT FOR COTAN +--------------------------------------------------------------------- +*/ + w = -x; + sgn = piov4; + if(w > 0.0e0) goto S20; + w = -w; + sgn = -sgn; +S20: +/* +--------------------------------------------------------------------- + MAKE AN ERROR EXIT IF X .LE. -XMAX1 +--------------------------------------------------------------------- +*/ + if(w >= xmax1) goto S100; + nq = fifidint(w); + w -= (double)nq; + nq = fifidint(w*4.0e0); + w = 4.0e0*(w-(double)nq*.25e0); +/* +--------------------------------------------------------------------- + W IS NOW RELATED TO THE FRACTIONAL PART OF 4.0 * X. + ADJUST ARGUMENT TO CORRESPOND TO VALUES IN FIRST + QUADRANT AND DETERMINE SIGN +--------------------------------------------------------------------- +*/ + n = nq/2; + if(n+n != nq) w = 1.0e0-w; + z = piov4*w; + m = n/2; + if(m+m != n) sgn = -sgn; +/* +--------------------------------------------------------------------- + DETERMINE FINAL VALUE FOR -PI*COTAN(PI*X) +--------------------------------------------------------------------- +*/ + n = (nq+1)/2; + m = n/2; + m += m; + if(m != n) goto S30; +/* +--------------------------------------------------------------------- + CHECK FOR SINGULARITY +--------------------------------------------------------------------- +*/ + if(z == 0.0e0) goto S100; +/* +--------------------------------------------------------------------- + USE COS/SIN AS A SUBSTITUTE FOR COTAN, AND + SIN/COS AS A SUBSTITUTE FOR TAN +--------------------------------------------------------------------- +*/ + aug = sgn*(cos(z)/sin(z)*4.0e0); + goto S40; +S30: + aug = sgn*(sin(z)/cos(z)*4.0e0); +S40: + x = 1.0e0-x; +S50: + if(x > 3.0e0) goto S70; +/* +--------------------------------------------------------------------- + 0.5 .LE. X .LE. 3.0 +--------------------------------------------------------------------- +*/ + den = x; + upper = p1[0]*x; + for(i=1; i<=5; i++) { + den = (den+q1[i-1])*x; + upper = (upper+p1[i+1-1])*x; + } + den = (upper+p1[6])/(den+q1[5]); + xmx0 = x-dx0; + psi = den*xmx0+aug; + return psi; +S70: +/* +--------------------------------------------------------------------- + IF X .GE. XMAX1, PSI = LN(X) +--------------------------------------------------------------------- +*/ + if(x >= xmax1) goto S90; +/* +--------------------------------------------------------------------- + 3.0 .LT. X .LT. XMAX1 +--------------------------------------------------------------------- +*/ + w = 1.0e0/(x*x); + den = w; + upper = p2[0]*w; + for(i=1; i<=3; i++) { + den = (den+q2[i-1])*w; + upper = (upper+p2[i+1-1])*w; + } + aug = upper/(den+q2[3])-0.5e0/x+aug; +S90: + psi = aug+log(x); + return psi; +S100: +/* +--------------------------------------------------------------------- + ERROR RETURN +--------------------------------------------------------------------- +*/ + psi = 0.0e0; + return psi; +} /* END */ + +/***=====================================================================***/ +static double rcomp(double *a,double *x) +/* + ------------------- + EVALUATION OF EXP(-X)*X**A/GAMMA(A) + ------------------- + RT2PIN = 1/SQRT(2*PI) + ------------------- +*/ +{ +static double rt2pin = .398942280401433e0; +static double rcomp,t,t1,u; +/* + .. + .. Executable Statements .. +*/ + rcomp = 0.0e0; + if(*a >= 20.0e0) goto S20; + t = *a*log(*x)-*x; + if(*a >= 1.0e0) goto S10; + rcomp = *a*exp(t)*(1.0e0+gam1(a)); + return rcomp; +S10: + rcomp = exp(t)/Xgamm(a); + return rcomp; +S20: + u = *x/ *a; + if(u == 0.0e0) return rcomp; + t = pow(1.0e0/ *a,2.0); + t1 = (((0.75e0*t-1.0e0)*t+3.5e0)*t-105.0e0)/(*a*1260.0e0); + t1 -= (*a*rlog(&u)); + rcomp = rt2pin*sqrt(*a)*exp(t1); + return rcomp; +} /* END */ + +/***=====================================================================***/ +static double rexp(double *x) +/* +----------------------------------------------------------------------- + EVALUATION OF THE FUNCTION EXP(X) - 1 +----------------------------------------------------------------------- +*/ +{ +static double p1 = .914041914819518e-09; +static double p2 = .238082361044469e-01; +static double q1 = -.499999999085958e+00; +static double q2 = .107141568980644e+00; +static double q3 = -.119041179760821e-01; +static double q4 = .595130811860248e-03; +static double rexp,w; +/* + .. + .. Executable Statements .. +*/ + if(fabs(*x) > 0.15e0) goto S10; + rexp = *x*(((p2**x+p1)**x+1.0e0)/((((q4**x+q3)**x+q2)**x+q1)**x+1.0e0)); + return rexp; +S10: + w = exp(*x); + if(*x > 0.0e0) goto S20; + rexp = w-0.5e0-0.5e0; + return rexp; +S20: + rexp = w*(0.5e0+(0.5e0-1.0e0/w)); + return rexp; +} /* END */ + +/***=====================================================================***/ +static double rlog(double *x) +/* + ------------------- + COMPUTATION OF X - 1 - LN(X) + ------------------- +*/ +{ +static double a = .566749439387324e-01; +static double b = .456512608815524e-01; +static double p0 = .333333333333333e+00; +static double p1 = -.224696413112536e+00; +static double p2 = .620886815375787e-02; +static double q1 = -.127408923933623e+01; +static double q2 = .354508718369557e+00; +static double rlog,r,t,u,w,w1; +/* + .. + .. Executable Statements .. +*/ + if(*x < 0.61e0 || *x > 1.57e0) goto S40; + if(*x < 0.82e0) goto S10; + if(*x > 1.18e0) goto S20; +/* + ARGUMENT REDUCTION +*/ + u = *x-0.5e0-0.5e0; + w1 = 0.0e0; + goto S30; +S10: + u = *x-0.7e0; + u /= 0.7e0; + w1 = a-u*0.3e0; + goto S30; +S20: + u = 0.75e0**x-1.e0; + w1 = b+u/3.0e0; +S30: +/* + SERIES EXPANSION +*/ + r = u/(u+2.0e0); + t = r*r; + w = ((p2*t+p1)*t+p0)/((q2*t+q1)*t+1.0e0); + rlog = 2.0e0*t*(1.0e0/(1.0e0-r)-r*w)+w1; + return rlog; +S40: + r = *x-0.5e0-0.5e0; + rlog = r-log(*x); + return rlog; +} /* END */ + +/***=====================================================================***/ +static double rlog1(double *x) +/* +----------------------------------------------------------------------- + EVALUATION OF THE FUNCTION X - LN(1 + X) +----------------------------------------------------------------------- +*/ +{ +static double a = .566749439387324e-01; +static double b = .456512608815524e-01; +static double p0 = .333333333333333e+00; +static double p1 = -.224696413112536e+00; +static double p2 = .620886815375787e-02; +static double q1 = -.127408923933623e+01; +static double q2 = .354508718369557e+00; +static double rlog1,h,r,t,w,w1; +/* + .. + .. Executable Statements .. +*/ + if(*x < -0.39e0 || *x > 0.57e0) goto S40; + if(*x < -0.18e0) goto S10; + if(*x > 0.18e0) goto S20; +/* + ARGUMENT REDUCTION +*/ + h = *x; + w1 = 0.0e0; + goto S30; +S10: + h = *x+0.3e0; + h /= 0.7e0; + w1 = a-h*0.3e0; + goto S30; +S20: + h = 0.75e0**x-0.25e0; + w1 = b+h/3.0e0; +S30: +/* + SERIES EXPANSION +*/ + r = h/(h+2.0e0); + t = r*r; + w = ((p2*t+p1)*t+p0)/((q2*t+q1)*t+1.0e0); + rlog1 = 2.0e0*t*(1.0e0/(1.0e0-r)-r*w)+w1; + return rlog1; +S40: + w = *x+0.5e0+0.5e0; + rlog1 = *x-log(w); + return rlog1; +} /* END */ + +/***=====================================================================***/ +static double spmpar(int *i) +/* +----------------------------------------------------------------------- + + SPMPAR PROVIDES THE SINGLE PRECISION MACHINE CONSTANTS FOR + THE COMPUTER BEING USED. IT IS ASSUMED THAT THE ARGUMENT + I IS AN INTEGER HAVING ONE OF THE VALUES 1, 2, OR 3. IF THE + SINGLE PRECISION ARITHMETIC BEING USED HAS M BASE B DIGITS AND + ITS SMALLEST AND LARGEST EXPONENTS ARE EMIN AND EMAX, THEN + + SPMPAR(1) = B**(1 - M), THE MACHINE PRECISION, + + SPMPAR(2) = B**(EMIN - 1), THE SMALLEST MAGNITUDE, + + SPMPAR(3) = B**EMAX*(1 - B**(-M)), THE LARGEST MAGNITUDE. + +----------------------------------------------------------------------- + WRITTEN BY + ALFRED H. MORRIS, JR. + NAVAL SURFACE WARFARE CENTER + DAHLGREN VIRGINIA +----------------------------------------------------------------------- +----------------------------------------------------------------------- + MODIFIED BY BARRY W. BROWN TO RETURN DOUBLE PRECISION MACHINE + CONSTANTS FOR THE COMPUTER BEING USED. THIS MODIFICATION WAS + MADE AS PART OF CONVERTING BRATIO TO DOUBLE PRECISION +----------------------------------------------------------------------- +*/ +{ +static int K1 = 4; +static int K2 = 8; +static int K3 = 9; +static int K4 = 10; +static double spmpar,b,binv,bm1,one,w,z; +static int emax,emin,ibeta,m; +/* + .. + .. Executable Statements .. +*/ + if(*i > 1) goto S10; + b = ipmpar(&K1); + m = ipmpar(&K2); + spmpar = pow(b,(double)(1-m)); + return spmpar; +S10: + if(*i > 2) goto S20; + b = ipmpar(&K1); + emin = ipmpar(&K3); + one = 1.0; + binv = one/b; + w = pow(b,(double)(emin+2)); + spmpar = w*binv*binv*binv; + return spmpar; +S20: + ibeta = ipmpar(&K1); + m = ipmpar(&K2); + emax = ipmpar(&K4); + b = ibeta; + bm1 = ibeta-1; + one = 1.0; + z = pow(b,(double)(m-1)); + w = ((z-one)*b+bm1)/(b*z); + z = pow(b,(double)(emax-2)); + spmpar = w*z*b*b; + return spmpar; +} /* END */ + +/***=====================================================================***/ +static double stvaln(double *p) +/* +********************************************************************** + + double stvaln(double *p) + STarting VALue for Neton-Raphon + calculation of Normal distribution Inverse + + + Function + + + Returns X such that CUMNOR(X) = P, i.e., the integral from - + infinity to X of (1/SQRT(2*PI)) EXP(-U*U/2) dU is P + + + Arguments + + + P --> The probability whose normal deviate is sought. + P is DOUBLE PRECISION + + + Method + + + The rational function on page 95 of Kennedy and Gentle, + Statistical Computing, Marcel Dekker, NY , 1980. + +********************************************************************** +*/ +{ +static double xden[5] = { + 0.993484626060e-1,0.588581570495e0,0.531103462366e0,0.103537752850e0, + 0.38560700634e-2 +}; +static double xnum[5] = { + -0.322232431088e0,-1.000000000000e0,-0.342242088547e0,-0.204231210245e-1, + -0.453642210148e-4 +}; +static int K1 = 5; +static double stvaln,sign,y,z; +/* + .. + .. Executable Statements .. +*/ + if(!(*p <= 0.5e0)) goto S10; + sign = -1.0e0; + z = *p; + goto S20; +S10: + sign = 1.0e0; + z = 1.0e0-*p; +S20: + y = sqrt(-(2.0e0*log(z))); + stvaln = y+devlpl(xnum,&K1,&y)/devlpl(xden,&K1,&y); + stvaln = sign*stvaln; + return stvaln; +} /* END */ + +/***=====================================================================***/ +static double fifdint(double a) +/************************************************************************ +FIFDINT: +Truncates a double precision number to an integer and returns the +value in a double. +************************************************************************/ +/* a - number to be truncated */ +{ + return (double) ((int) a); +} /* END */ + +/***=====================================================================***/ +static double fifdmax1(double a,double b) +/************************************************************************ +FIFDMAX1: +returns the maximum of two numbers a and b +************************************************************************/ +/* a - first number */ +/* b - second number */ +{ + if (a < b) return b; + else return a; +} /* END */ + +/***=====================================================================***/ +static double fifdmin1(double a,double b) +/************************************************************************ +FIFDMIN1: +returns the minimum of two numbers a and b +************************************************************************/ +/* a - first number */ +/* b - second number */ +{ + if (a < b) return a; + else return b; +} /* END */ + +/***=====================================================================***/ +static double fifdsign(double mag,double sign) +/************************************************************************ +FIFDSIGN: +transfers the sign of the variable "sign" to the variable "mag" +************************************************************************/ +/* mag - magnitude */ +/* sign - sign to be transfered */ +{ + if (mag < 0) mag = -mag; + if (sign < 0) mag = -mag; + return mag; + +} /* END */ + +/***=====================================================================***/ +static long fifidint(double a) +/************************************************************************ +FIFIDINT: +Truncates a double precision number to a long integer +************************************************************************/ +/* a - number to be truncated */ +{ + if (a < 1.0) return (long) 0; + else return (long) a; +} /* END */ + +/***=====================================================================***/ +static long fifmod(long a,long b) +/************************************************************************ +FIFMOD: +returns the modulo of a and b +************************************************************************/ +/* a - numerator */ +/* b - denominator */ +{ + return a % b; +} /* END */ + +/***=====================================================================***/ +static void ftnstop(char* msg) +/************************************************************************ +FTNSTOP: +Prints msg to standard error and then exits +************************************************************************/ +/* msg - error message */ +{ + if (msg != NULL) fprintf(stderr,"*** CDFLIB ERROR: %s\n",msg); + /** exit(1); **/ /** RWCox - DON'T EXIT */ +} /* END */ + +/***=====================================================================***/ +static int ipmpar(int *i) +/* +----------------------------------------------------------------------- + + IPMPAR PROVIDES THE INTEGER MACHINE CONSTANTS FOR THE COMPUTER + THAT IS USED. IT IS ASSUMED THAT THE ARGUMENT I IS AN INTEGER + HAVING ONE OF THE VALUES 1-10. IPMPAR(I) HAS THE VALUE ... + + INTEGERS. + + ASSUME INTEGERS ARE REPRESENTED IN THE N-DIGIT, BASE-A FORM + + SIGN ( X(N-1)*A**(N-1) + ... + X(1)*A + X(0) ) + + WHERE 0 .LE. X(I) .LT. A FOR I=0,...,N-1. + + IPMPAR(1) = A, THE BASE. + + IPMPAR(2) = N, THE NUMBER OF BASE-A DIGITS. + + IPMPAR(3) = A**N - 1, THE LARGEST MAGNITUDE. + + FLOATING-POINT NUMBERS. + + IT IS ASSUMED THAT THE SINGLE AND DOUBLE PRECISION FLOATING + POINT ARITHMETICS HAVE THE SAME BASE, SAY B, AND THAT THE + NONZERO NUMBERS ARE REPRESENTED IN THE FORM + + SIGN (B**E) * (X(1)/B + ... + X(M)/B**M) + + WHERE X(I) = 0,1,...,B-1 FOR I=1,...,M, + X(1) .GE. 1, AND EMIN .LE. E .LE. EMAX. + + IPMPAR(4) = B, THE BASE. + + SINGLE-PRECISION + + IPMPAR(5) = M, THE NUMBER OF BASE-B DIGITS. + + IPMPAR(6) = EMIN, THE SMALLEST EXPONENT E. + + IPMPAR(7) = EMAX, THE LARGEST EXPONENT E. + + DOUBLE-PRECISION + + IPMPAR(8) = M, THE NUMBER OF BASE-B DIGITS. + + IPMPAR(9) = EMIN, THE SMALLEST EXPONENT E. + + IPMPAR(10) = EMAX, THE LARGEST EXPONENT E. + +----------------------------------------------------------------------- + + TO DEFINE THIS FUNCTION FOR THE COMPUTER BEING USED REMOVE + THE COMMENT DELIMITORS FROM THE DEFINITIONS DIRECTLY BELOW THE NAME + OF THE MACHINE + +*** RWCox: at this time, the IEEE parameters are enabled. + +----------------------------------------------------------------------- + + IPMPAR IS AN ADAPTATION OF THE FUNCTION I1MACH, WRITTEN BY + P.A. FOX, A.D. HALL, AND N.L. SCHRYER (BELL LABORATORIES). + IPMPAR WAS FORMED BY A.H. MORRIS (NSWC). THE CONSTANTS ARE + FROM BELL LABORATORIES, NSWC, AND OTHER SOURCES. + +----------------------------------------------------------------------- + .. Scalar Arguments .. +*/ +{ +static int imach[11]; +static int outval ; +/* MACHINE CONSTANTS FOR AMDAHL MACHINES. */ +/* + imach[1] = 2; + imach[2] = 31; + imach[3] = 2147483647; + imach[4] = 16; + imach[5] = 6; + imach[6] = -64; + imach[7] = 63; + imach[8] = 14; + imach[9] = -64; + imach[10] = 63; +*/ +/* MACHINE CONSTANTS FOR THE AT&T 3B SERIES, AT&T + PC 7300, AND AT&T 6300. */ +/* + imach[1] = 2; + imach[2] = 31; + imach[3] = 2147483647; + imach[4] = 2; + imach[5] = 24; + imach[6] = -125; + imach[7] = 128; + imach[8] = 53; + imach[9] = -1021; + imach[10] = 1024; +*/ +/* MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM. */ +/* + imach[1] = 2; + imach[2] = 33; + imach[3] = 8589934591; + imach[4] = 2; + imach[5] = 24; + imach[6] = -256; + imach[7] = 255; + imach[8] = 60; + imach[9] = -256; + imach[10] = 255; +*/ +/* MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM. */ +/* + imach[1] = 2; + imach[2] = 39; + imach[3] = 549755813887; + imach[4] = 8; + imach[5] = 13; + imach[6] = -50; + imach[7] = 76; + imach[8] = 26; + imach[9] = -50; + imach[10] = 76; +*/ +/* MACHINE CONSTANTS FOR THE BURROUGHS 6700/7700 SYSTEMS. */ +/* + imach[1] = 2; + imach[2] = 39; + imach[3] = 549755813887; + imach[4] = 8; + imach[5] = 13; + imach[6] = -50; + imach[7] = 76; + imach[8] = 26; + imach[9] = -32754; + imach[10] = 32780; +*/ +/* MACHINE CONSTANTS FOR THE CDC 6000/7000 SERIES + 60 BIT ARITHMETIC, AND THE CDC CYBER 995 64 BIT + ARITHMETIC (NOS OPERATING SYSTEM). */ +/* + imach[1] = 2; + imach[2] = 48; + imach[3] = 281474976710655; + imach[4] = 2; + imach[5] = 48; + imach[6] = -974; + imach[7] = 1070; + imach[8] = 95; + imach[9] = -926; + imach[10] = 1070; +*/ +/* MACHINE CONSTANTS FOR THE CDC CYBER 995 64 BIT + ARITHMETIC (NOS/VE OPERATING SYSTEM). */ +/* + imach[1] = 2; + imach[2] = 63; + imach[3] = 9223372036854775807; + imach[4] = 2; + imach[5] = 48; + imach[6] = -4096; + imach[7] = 4095; + imach[8] = 96; + imach[9] = -4096; + imach[10] = 4095; +*/ +/* MACHINE CONSTANTS FOR THE CRAY 1, XMP, 2, AND 3. */ +/* + imach[1] = 2; + imach[2] = 63; + imach[3] = 9223372036854775807; + imach[4] = 2; + imach[5] = 47; + imach[6] = -8189; + imach[7] = 8190; + imach[8] = 94; + imach[9] = -8099; + imach[10] = 8190; +*/ +/* MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200. */ +/* + imach[1] = 2; + imach[2] = 15; + imach[3] = 32767; + imach[4] = 16; + imach[5] = 6; + imach[6] = -64; + imach[7] = 63; + imach[8] = 14; + imach[9] = -64; + imach[10] = 63; +*/ +/* MACHINE CONSTANTS FOR THE HARRIS 220. */ +/* + imach[1] = 2; + imach[2] = 23; + imach[3] = 8388607; + imach[4] = 2; + imach[5] = 23; + imach[6] = -127; + imach[7] = 127; + imach[8] = 38; + imach[9] = -127; + imach[10] = 127; +*/ +/* MACHINE CONSTANTS FOR THE HONEYWELL 600/6000 + AND DPS 8/70 SERIES. */ +/* + imach[1] = 2; + imach[2] = 35; + imach[3] = 34359738367; + imach[4] = 2; + imach[5] = 27; + imach[6] = -127; + imach[7] = 127; + imach[8] = 63; + imach[9] = -127; + imach[10] = 127; +*/ +/* MACHINE CONSTANTS FOR THE HP 2100 + 3 WORD DOUBLE PRECISION OPTION WITH FTN4 */ +/* + imach[1] = 2; + imach[2] = 15; + imach[3] = 32767; + imach[4] = 2; + imach[5] = 23; + imach[6] = -128; + imach[7] = 127; + imach[8] = 39; + imach[9] = -128; + imach[10] = 127; +*/ +/* MACHINE CONSTANTS FOR THE HP 2100 + 4 WORD DOUBLE PRECISION OPTION WITH FTN4 */ +/* + imach[1] = 2; + imach[2] = 15; + imach[3] = 32767; + imach[4] = 2; + imach[5] = 23; + imach[6] = -128; + imach[7] = 127; + imach[8] = 55; + imach[9] = -128; + imach[10] = 127; +*/ +/* MACHINE CONSTANTS FOR THE HP 9000. */ +/* + imach[1] = 2; + imach[2] = 31; + imach[3] = 2147483647; + imach[4] = 2; + imach[5] = 24; + imach[6] = -126; + imach[7] = 128; + imach[8] = 53; + imach[9] = -1021; + imach[10] = 1024; +*/ +/* MACHINE CONSTANTS FOR THE IBM 360/370 SERIES, + THE ICL 2900, THE ITEL AS/6, THE XEROX SIGMA + 5/7/9 AND THE SEL SYSTEMS 85/86. */ +/* + imach[1] = 2; + imach[2] = 31; + imach[3] = 2147483647; + imach[4] = 16; + imach[5] = 6; + imach[6] = -64; + imach[7] = 63; + imach[8] = 14; + imach[9] = -64; + imach[10] = 63; +*/ +/* MACHINE CONSTANTS FOR THE IBM PC. */ +/* + imach[1] = 2; + imach[2] = 31; + imach[3] = 2147483647; + imach[4] = 2; + imach[5] = 24; + imach[6] = -125; + imach[7] = 128; + imach[8] = 53; + imach[9] = -1021; + imach[10] = 1024; +*/ +/* MACHINE CONSTANTS FOR THE MACINTOSH II - ABSOFT + MACFORTRAN II. */ +/* + imach[1] = 2; + imach[2] = 31; + imach[3] = 2147483647; + imach[4] = 2; + imach[5] = 24; + imach[6] = -125; + imach[7] = 128; + imach[8] = 53; + imach[9] = -1021; + imach[10] = 1024; +*/ +/* MACHINE CONSTANTS FOR THE MICROVAX - VMS FORTRAN. */ +/* + imach[1] = 2; + imach[2] = 31; + imach[3] = 2147483647; + imach[4] = 2; + imach[5] = 24; + imach[6] = -127; + imach[7] = 127; + imach[8] = 56; + imach[9] = -127; + imach[10] = 127; +*/ +/* MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR). */ +/* + imach[1] = 2; + imach[2] = 35; + imach[3] = 34359738367; + imach[4] = 2; + imach[5] = 27; + imach[6] = -128; + imach[7] = 127; + imach[8] = 54; + imach[9] = -101; + imach[10] = 127; +*/ +/* MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR). */ +/* + imach[1] = 2; + imach[2] = 35; + imach[3] = 34359738367; + imach[4] = 2; + imach[5] = 27; + imach[6] = -128; + imach[7] = 127; + imach[8] = 62; + imach[9] = -128; + imach[10] = 127; +*/ +/* MACHINE CONSTANTS FOR THE PDP-11 FORTRAN SUPPORTING + 32-BIT INTEGER ARITHMETIC. */ +/* + imach[1] = 2; + imach[2] = 31; + imach[3] = 2147483647; + imach[4] = 2; + imach[5] = 24; + imach[6] = -127; + imach[7] = 127; + imach[8] = 56; + imach[9] = -127; + imach[10] = 127; +*/ +/* MACHINE CONSTANTS FOR THE SEQUENT BALANCE 8000. */ +/* + imach[1] = 2; + imach[2] = 31; + imach[3] = 2147483647; + imach[4] = 2; + imach[5] = 24; + imach[6] = -125; + imach[7] = 128; + imach[8] = 53; + imach[9] = -1021; + imach[10] = 1024; +*/ +/* MACHINE CONSTANTS FOR THE SILICON GRAPHICS IRIS-4D + SERIES (MIPS R3000 PROCESSOR). */ +/* + imach[1] = 2; + imach[2] = 31; + imach[3] = 2147483647; + imach[4] = 2; + imach[5] = 24; + imach[6] = -125; + imach[7] = 128; + imach[8] = 53; + imach[9] = -1021; + imach[10] = 1024; +*/ +/* MACHINE CONSTANTS FOR IEEE ARITHMETIC MACHINES, SUCH AS THE AT&T + 3B SERIES, MOTOROLA 68000 BASED MACHINES (E.G. SUN 3 AND AT&T + PC 7300), AND 8087 BASED MICROS (E.G. IBM PC AND AT&T 6300). */ + + imach[1] = 2; + imach[2] = 31; + imach[3] = 2147483647; + imach[4] = 2; + imach[5] = 24; + imach[6] = -125; + imach[7] = 128; + imach[8] = 53; + imach[9] = -1021; + imach[10] = 1024; + +/* MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES. */ +/* + imach[1] = 2; + imach[2] = 35; + imach[3] = 34359738367; + imach[4] = 2; + imach[5] = 27; + imach[6] = -128; + imach[7] = 127; + imach[8] = 60; + imach[9] = -1024; + imach[10] = 1023; +*/ +/* MACHINE CONSTANTS FOR THE VAX 11/780. */ +/* + imach[1] = 2; + imach[2] = 31; + imach[3] = 2147483647; + imach[4] = 2; + imach[5] = 24; + imach[6] = -127; + imach[7] = 127; + imach[8] = 56; + imach[9] = -127; + imach[10] = 127; +*/ + outval = imach[*i]; + return outval ; +} + +/*************************************************************************/ +/*************************************************************************/ +/************************ End of cdflib inclusion ************************/ +/*************************************************************************/ +/*************************************************************************/ + +/*-----------------------------------------------------------------------*/ +typedef struct { double p,q ; } pqpair ; /* for returning p=cdf q=1-cdf */ +/*-----------------------------------------------------------------------*/ +#undef BIGG +#define BIGG 9.99e+37 /* a really big number (duh) */ +/*-----------------------------------------------------------------------*/ + +/*************************************************************************/ +/******** Internal functions for various statistical computations ********/ +/*************************************************************************/ + +/*--------------------------------------------------------------- + F statistic +-----------------------------------------------------------------*/ + +static double fstat_pq2s( pqpair pq , double dofnum , double dofden ) +{ + int which , status ; + double p , q , f , dfn , dfd , bound ; + + which = 2 ; + p = pq.p ; if( p <= 0.0 ) return 0.0 ; + q = pq.q ; if( q <= 0.0 ) return BIGG ; + f = 0.0 ; + dfn = dofnum ; + dfd = dofden ; + + cdff( &which , &p , &q , &f , &dfn , &dfd , &status , &bound ) ; + return f ; +} + +/*------------------------------*/ + +static pqpair fstat_s2pq( double ff , double dofnum , double dofden ) +{ + int which , status ; + double p , q , f , dfn , dfd , bound ; + pqpair pq={0.0,1.0} ; + + which = 1 ; + p = 0.0 ; + q = 1.0 ; + f = ff ; if( f <= 0.0 ) return pq; + dfn = dofnum ; if( dfn <= 0.0 ) return pq ; + dfd = dofden ; if( dfd <= 0.0 ) return pq ; + + cdff( &which , &p , &q , &f , &dfn , &dfd , &status , &bound ) ; + pq.p = p ; pq.q = q ; return pq ; +} + +/*--------------------------------------------------------------- + noncentral F statistic +-----------------------------------------------------------------*/ + +static double fnonc_pq2s( pqpair pq , double dofnum , double dofden , double nonc ) +{ + int which , status ; + double p , q , f , dfn , dfd , bound , pnonc ; + + which = 2 ; + p = pq.p ; if( p <= 0.0 ) return 0.0 ; + q = pq.q ; if( q <= 0.0 ) return BIGG ; + f = 0.0 ; + dfn = dofnum ; + dfd = dofden ; + pnonc = nonc ; + + cdffnc( &which , &p , &q , &f , &dfn , &dfd , &pnonc , &status , &bound ) ; + return f ; +} + +/*------------------------------*/ + +static pqpair fnonc_s2pq( double ff , double dofnum , double dofden , double nonc ) +{ + int which , status ; + double p , q , f , dfn , dfd , bound , pnonc ; + pqpair pq={0.0,1.0} ; + + which = 1 ; + p = 0.0 ; + q = 1.0 ; + f = ff ; if( f <= 0.0 ) return pq ; + dfn = dofnum ; if( dfn <= 0.0 ) return pq ; + dfd = dofden ; if( dfd <= 0.0 ) return pq ; + pnonc = nonc ; if( pnonc < 0.0 ) return pq ; + + cdffnc( &which , &p , &q , &f , &dfn , &dfd , &pnonc , &status , &bound ) ; + pq.p = p ; pq.q = q ; return pq ; +} + +/*--------------------------------------------------------------- + Standard Normal distribution +-----------------------------------------------------------------*/ + +static pqpair normal_s2pq( double zz ) +{ + double p , q , x=zz ; + pqpair pq ; + + cumnor( &x, &p, &q ) ; + pq.p = p ; pq.q = q ; return pq ; +} + +/*------------------------------*/ + +static double normal_pq2s( pqpair pq ) +{ + double p=pq.p , q=pq.q ; + + if( p <= 0.0 ) return -BIGG ; + if( q <= 0.0 ) return BIGG ; + return dinvnr( &p,&q ) ; +} + +/*---------------------------------------------------------------- + Chi-square +------------------------------------------------------------------*/ + +static pqpair chisq_s2pq( double xx , double dof ) +{ + int which , status ; + double p,q,x,df,bound ; + pqpair pq={0.0,1.0} ; + + which = 1 ; + p = 0.0 ; + q = 1.0 ; + x = xx ; if( x <= 0.0 ) return pq ; + df = dof ; if( dof <= 0.0 ) return pq ; + + cdfchi( &which , &p , &q , &x , &df , &status , &bound ) ; + pq.p = p ; pq.q = q ; return pq ; +} + +/*------------------------------*/ + +static double chisq_pq2s( pqpair pq , double dof ) +{ + int which , status ; + double p,q,x,df,bound ; + + which = 2 ; + p = pq.p ; if( p <= 0.0 ) return 0.0 ; + q = pq.q ; if( q <= 0.0 ) return BIGG ; + x = 0.0 ; + df = dof ; + + cdfchi( &which , &p , &q , &x , &df , &status , &bound ) ; + return x ; +} + +/*---------------------------------------------------------------- + noncentral Chi-square +------------------------------------------------------------------*/ + +static pqpair chsqnonc_s2pq( double xx , double dof , double nonc ) +{ + int which , status ; + double p,q,x,df,bound , pnonc ; + pqpair pq={0.0,1.0} ; + + which = 1 ; + p = 0.0 ; + q = 1.0 ; + x = xx ; if( x <= 0.0 ) return pq ; + df = dof ; if( df <= 0.0 ) return pq ; + pnonc = nonc ; if( pnonc < 0.0 ) return pq ; + + cdfchn( &which , &p , &q , &x , &df , &pnonc , &status , &bound ) ; + pq.p = p ; pq.q = q ; return pq ; +} + +/*------------------------------*/ + +static double chsqnonc_pq2s( pqpair pq , double dof , double nonc ) +{ + int which , status ; + double p,q,x,df,bound , pnonc ; + + which = 2 ; + p = pq.p ; if( p <= 0.0 ) return 0.0 ; + q = pq.q ; if( q <= 0.0 ) return BIGG ; + x = 0.0 ; + df = dof ; + pnonc = nonc ; + + cdfchn( &which , &p , &q , &x , &df , &pnonc , &status , &bound ) ; + return x ; +} + +/*---------------------------------------------------------------- + Beta distribution +------------------------------------------------------------------*/ + +static pqpair beta_s2pq( double xx , double aa , double bb ) +{ + int which , status ; + double p,q,x,y,a,b,bound ; + pqpair pq={0.0,1.0} ; + + which = 1 ; + p = 0.0 ; + q = 1.0 ; + x = xx ; if( x <= 0.0 ) return pq ; + y = 1.0 - xx ; if( y <= 0.0 ){ pq.p=1.0; pq.q=0.0; return pq; } + a = aa ; if( a < 0.0 ) return pq ; + b = bb ; if( b < 0.0 ) return pq ; + + cdfbet( &which , &p , &q , &x , &y , &a , &b , &status , &bound ) ; + pq.p = p ; pq.q = q ; return pq ; +} + +/*------------------------------*/ + +static double beta_pq2s( pqpair pq , double aa , double bb ) +{ + int which , status ; + double p,q,x,y,a,b,bound ; + + which = 2 ; + p = pq.p ; if( p <= 0.0 ) return 0.0 ; + q = pq.q ; if( q <= 0.0 ) return 1.0 ; + x = 0.0 ; + y = 1.0 ; + a = aa ; + b = bb ; + + cdfbet( &which , &p , &q , &x , &y , &a , &b , &status , &bound ) ; + return x ; +} + +/*---------------------------------------------------------------- + Binomial distribution + (that is, the probability that more than ss out of ntrial + trials were successful). +------------------------------------------------------------------*/ + +static pqpair binomial_s2pq( double ss , double ntrial , double ptrial ) +{ + int which , status ; + double p,q, s,xn,pr,ompr,bound ; + pqpair pq={0.0,1.0} ; + + which = 1 ; + p = 0.0 ; + q = 1.0 ; + s = ss ; if( s < 0.0 ) return pq ; + xn = ntrial ; if( xn <= 0.0 ) return pq ; + pr = ptrial ; if( pr < 0.0 ) return pq ; + ompr = 1.0 - ptrial ; + + cdfbin( &which , &p , &q , &s , &xn , &pr , &ompr , &status , &bound ) ; + pq.p = p ; pq.q = q ; return pq ; +} + +/*------------------------------*/ + +static double binomial_pq2s( pqpair pq , double ntrial , double ptrial ) +{ + int which , status ; + double p,q, s,xn,pr,ompr,bound ; + + which = 2 ; + p = pq.p ; + q = pq.q ; + s = 0.0 ; + xn = ntrial ; + pr = ptrial ; + ompr = 1.0 - ptrial ; + + cdfbin( &which , &p , &q , &s , &xn , &pr , &ompr , &status , &bound ) ; + return s ; +} + +/*---------------------------------------------------------------- + Gamma distribution. +------------------------------------------------------------------*/ + +static pqpair gamma_s2pq( double xx , double sh , double sc ) +{ + int which , status ; + double p,q, x,shape,scale,bound ; + pqpair pq={0.0,1.0} ; + + which = 1 ; + p = 0.0 ; + q = 1.0 ; + x = xx ; if( x <= 0.0 ) return pq ; + shape = sh ; if( shape <= 0.0 ) return pq ; + scale = sc ; if( scale <= 0.0 ) return pq ; + + cdfgam( &which , &p , &q , &x , &shape , &scale , &status , &bound ) ; + pq.p = p ; pq.q = q ; return pq ; +} + +/*------------------------------*/ + +static double gamma_pq2s( pqpair pq , double sh , double sc ) +{ + int which , status ; + double p,q, x,shape,scale,bound ; + + which = 2 ; + p = pq.p ; if( p <= 0.0 ) return 0.0 ; + q = pq.q ; if( q <= 0.0 ) return BIGG ; + x = 0.0 ; + shape = sh ; + scale = sc ; + + cdfgam( &which , &p , &q , &x , &shape , &scale , &status , &bound ) ; + return x ; +} + +/*---------------------------------------------------------------- + Poisson distribution +------------------------------------------------------------------*/ + +static pqpair poisson_s2pq( double xx , double lambda ) +{ + int which , status ; + double p,q, s,xlam,bound ; + pqpair pq={0.0,1.0} ; + + which = 1 ; + p = 0.0 ; + q = 1.0 ; + s = xx ; if( s < 0.0 ) return pq ; + xlam = lambda ; if( xlam < 0.0 ) return pq ; + + cdfpoi( &which , &p , &q , &s , &xlam , &status , &bound ) ; + pq.p = p ; pq.q = q ; return pq ; +} + +/*------------------------------*/ + +static double poisson_pq2s( pqpair pq , double lambda ) +{ + int which , status ; + double p,q, s,xlam,bound ; + + which = 2 ; + p = pq.p ; + q = pq.q ; + s = 0.0 ; + xlam = lambda ; + + cdfpoi( &which , &p , &q , &s , &xlam , &status , &bound ) ; + return s ; +} + +/*---------------------------------------------------------------- + T distribution. +------------------------------------------------------------------*/ + +static pqpair student_s2pq( double xx , double dof ) +{ + int which , status ; + double p,q, s,xlam,bound ; + pqpair pq={0.0,1.0} ; + + which = 1 ; + p = 0.0 ; + q = 1.0 ; + s = xx ; + xlam = dof ; if( xlam <= 0.0 ) return pq ; + + cdft( &which , &p , &q , &s , &xlam , &status , &bound ) ; + pq.p = p ; pq.q = q ; return pq ; +} + +/*------------------------------*/ + +double student_pq2s( pqpair pq , double dof ) +{ + int which , status ; + double p,q, s,xlam,bound ; + + which = 2 ; + p = pq.p ; + q = pq.q ; + s = 0.0 ; + xlam = dof ; + + cdft( &which , &p , &q , &s , &xlam , &status , &bound ) ; + return s ; +} + +/****************************************************************************/ +/* For the distributions below here, cdflib can't do what we want directly. */ +/****************************************************************************/ + +/*---------------------------------------------------------------- + Null correlation distribution. + Let x = (rr+1)/2; then x is Beta(dof/2,dof/2). +------------------------------------------------------------------*/ + +static pqpair correl_s2pq( double rr , double dof ) /* fake it with cdflib */ +{ + return beta_s2pq( 0.5*(rr+1.0) , 0.5*dof , 0.5*dof ) ; +} + +/*------------------------------*/ + +static double correl_pq2s( pqpair pq , double dof ) +{ + double xx = beta_pq2s( pq , 0.5*dof , 0.5*dof ) ; + return (2.0*xx-1.0) ; +} + +/*---------------------------------------------------------------- + Uniform U(0,1) distribution. +------------------------------------------------------------------*/ + +static pqpair uniform_s2pq( double xx ) /* this isn't too hard */ +{ + pqpair pq ; + if( xx <= 0.0 ) pq.p = 0.0 ; + else if( xx >= 1.0 ) pq.p = 1.0 ; + else pq.p = xx ; + pq.q = 1.0-xx ; return pq ; +} + +/*------------------------------*/ + +static double uniform_pq2s( pqpair pq ) +{ + return pq.p ; /* that was easy */ +} + +/*---------------------------------------------------------------- + standard Logistic distribution. +------------------------------------------------------------------*/ + +static pqpair logistic_s2pq( double xx ) /* this isn't hard, either */ +{ + pqpair pq ; + if( xx >= 0.0 ){ pq.q = 1.0/(1.0+exp( xx)); pq.p = 1.0-pq.q; } + else { pq.p = 1.0/(1.0+exp(-xx)); pq.q = 1.0-pq.p; } + return pq ; +} + +/*------------------------------*/ + +static double logistic_pq2s( pqpair pq ) +{ + if( pq.p <= 0.0 ) return -BIGG ; + else if( pq.q <= 0.0 ) return BIGG ; + + if( pq.p < pq.q ) return -log(1.0/pq.p-1.0) ; + else return log(1.0/pq.q-1.0) ; +} + +/*---------------------------------------------------------------- + standard Laplace distribution. +------------------------------------------------------------------*/ + +static pqpair laplace_s2pq( double xx ) /* easy */ +{ + pqpair pq ; + + if( xx >= 0.0 ){ pq.q = 0.5*exp(-xx) ; pq.p = 1.0-pq.q ; } + else { pq.p = 0.5*exp( xx) ; pq.q = 1.0-pq.p ; } + return pq ; +} + +/*------------------------------*/ + +static double laplace_pq2s( pqpair pq ) +{ + if( pq.p <= 0.0 ) return -BIGG ; + else if( pq.q <= 0.0 ) return BIGG ; + + if( pq.p < pq.q ) return log(2.0*pq.p) ; + else return -log(2.0*pq.q) ; +} + +/*---------------------------------------------------------------- + noncentral T distribution = hard calculation +------------------------------------------------------------------*/ + +/**************************************************************************** + Noncentral t distribution function by + Professor K. Krishnamoorthy + Department of Mathematics + University of Louisiana at Lafayette + Manually translated from Fortran by RWC. +*****************************************************************************/ + +#if 0 +static double alng( double x ) /* log(Gamma(x)) from K */ +{ + int indx ; + double xx,fterm,sum,valg ; + double b[9] = { 0.0 , + 8.33333333333333e-2, 3.33333333333333e-2, + 2.52380952380952e-1, 5.25606469002695e-1, + 1.01152306812684e0, 1.51747364915329e0, + 2.26948897420496e0, 3.00991738325940e0 } ; + + if( x < 8.0 ){ xx = x + 8.0 ; indx = 1 ; } + else { xx = x ; indx = 0 ; } + + fterm = (xx-0.5)*log(xx) - xx + 9.1893853320467e-1 ; + sum = b[1]/(xx+b[2]/(xx+b[3]/(xx+b[4]/(xx+b[5]/(xx+b[6]/ + (xx+b[7]/(xx+b[8]))))))) ; + valg = sum + fterm ; + if(indx) + valg = valg-log(x+7.0)-log(x+6.0)-log(x+5.0) + -log(x+4.0)-log(x+3.0)-log(x+2.0)-log(x+1.0)-log(x) ; + return valg ; +} +#else +static double alng( double x ) /*-- replace with cdflib function --*/ +{ + double xx=x ; return alngam( &xx ) ; +} +#endif + +/*---------------------------------------------------------------------------*/ + +#if 0 +static double gaudf( double x ) /* N(0,1) cdf from K */ +{ + static double p0=913.16744211475570 , p1=1024.60809538333800, + p2=580.109897562908800, p3=202.102090717023000, + p4=46.0649519338751400, p5=6.81311678753268400, + p6=6.047379926867041e-1,p7=2.493381293151434e-2 ; + static double q0=1826.33488422951125, q1=3506.420597749092, + q2=3044.77121163622200, q3=1566.104625828454, + q4=523.596091947383490, q5=116.9795245776655, + q6=17.1406995062577800, q7=1.515843318555982, + q8=6.25e-2 ; + static double sqr2pi=2.506628274631001 ; + int check ; + double reslt,z , first,phi ; + + if(x > 0.0){ z = x ; check = 1 ; } + else { z =-x ; check = 0 ; } + + if( z > 32.0 ) return (x > 0.0) ? 1.0 : 0.0 ; + + first = exp(-0.5*z*z) ; + phi = first/sqr2pi ; + + if (z < 7.0) + reslt = first* (((((((p7*z+p6)*z+p5)*z+p4)*z+p3)*z+p2)*z+p1)*z+p0) + /((((((((q8*z+q7)*z+q6)*z+q5)*z+q4)*z+q3)*z+q2)*z+q1)*z+q0); + else + reslt = phi/(z+1.0/(z+2.0/(z+3.0/(z+4.0/(z+6.0/(z+7.0)))))) ; + + if(check) reslt = 1.0 - reslt ; + return reslt ; +} +#else +static double gaudf( double x ) /*-- replace with cdflib func --*/ +{ + double xx=x , p,q ; + cumnor( &xx, &p, &q ); return p; +} +#endif + +/*---------------------------------------------------------------------------*/ + +#if 0 +static double betadf( double x , double p , double q ) /* Beta cdf from K */ +{ + int check , ns ; + double result,betf,psq,xx,cx,pp,qq ; + double term,ai,rx,temp ; + + if( x >= 1.0 ) return 1.0 ; + if( x <= 0.0 ) return 0.0 ; + + betf = alng(p)+alng(q)-alng(p+q) ; + result=x ; + psq=p+q ; + cx=1.0-x ; + if(p < psq*x){ xx=cx ; cx=x ; pp=q ; qq=p ; check=1 ; } + else { xx=x ; pp=p ; qq=q ; check=0 ; } + + term=1.0 ; + ai=1.0 ; + result=1.0 ; + ns=(int)(qq+cx*psq) ; + rx=xx/cx ; +L3: + temp=qq-ai ; + if(ns == 0) rx=xx ; +L4: + term=term*temp*rx/(pp+ai) ; + result=result+term ; + temp=fabs(term) ; + if(temp <= 1.e-14 && temp <= 1.e-14*result) goto L5 ; + ai=ai+1.0 ; + ns=ns-1 ; + if(ns >= 0) goto L3 ; + temp=psq ; + psq=psq+1.0 ; + goto L4 ; + +L5: + result=result*exp(pp*log(xx)+(qq-1.0)*log(cx)-betf)/pp ; + if(check) result=1.0-result ; + return result ; +} +#else +static double betadf( double x , double p , double q ) /*-- cdflib func --*/ +{ + double xx=x,yy=1.0-x , aa=p,bb=q , pp,qq ; + cumbet( &xx,&yy , &aa,&bb , &pp,&qq ) ; return pp ; +} +#endif + +/*---------------------------------------------------------------------------*/ +/* Krishnamoorthy's function for cdf of noncentral t, for df > 0, + translated into C by RW Cox [Mar 2004]. + Note the original fails for delta=0, so we call the cdflib func for this. + A couple of other minor fixes are also included. +-----------------------------------------------------------------------------*/ + +static pqpair tnonc_s2pq( double t , double df , double delta ) +{ + int indx , k , i ; + double x,del,tnd,ans,y,dels,a,b,c ; + double pkf,pkb,qkf,qkb , pgamf,pgamb,qgamf,qgamb ; + double pbetaf,pbetab,qbetaf,qbetab ; + double ptermf,qtermf,ptermb,qtermb,term ; + double rempois,delosq2,sum,cons,error ; + + pqpair pq={0.0,1.0} ; /* will be return value */ + double ab1 ; + + /*-- stupid user? --*/ + + if( df <= 0.0 ) return pq ; + + /*-- non-centrality = 0? --*/ + + if( fabs(delta) < 1.e-8 ) return student_s2pq(t,df) ; + + /*-- start K's code here --*/ + + if( t < 0.0 ){ x = -t ; del = -delta ; indx = 1 ; } /* x will be */ + else { x = t ; del = delta ; indx = 0 ; } /* positive */ + + ans = gaudf(-del) ; /* prob that x <= 0 = Normal cdf */ + + /*-- the nearly trivial case of x=0 --*/ + + if( x == 0.0 ){ pq.p = ans; pq.q = 1.0-ans; return pq; } + + if( df == 1.0 ) df = 1.0000001 ; /** df=1 is BAD **/ + + y = x*x/(df+x*x) ; /* between 0 and 1 */ + dels = 0.5*del*del ; /* will be positive */ + k = (int)dels ; /* 0, 1, 2, ... */ + a = k+0.5 ; /* might be as small as 0.5 */ + c = k+1.0 ; + b = 0.5*df ; /* might be as small as 0.0 */ + + pkf = exp(-dels+k*log(dels)-alng(k+1.0)) ; + pkb = pkf ; + qkf = exp(-dels+k*log(dels)-alng(k+1.0+0.5)) ; + qkb = qkf ; + + pbetaf = betadf(y, a, b) ; + pbetab = pbetaf ; + qbetaf = betadf(y, c, b) ; + qbetab = qbetaf ; + + ab1 = a+b-1.0 ; /* might be as small as -0.5 */ + + /*-- RWCox: if a+b-1 < 0, log(Gamma(a+b-1)) won't work; + instead, use Gamma(a+b-1)=Gamma(a+b)/(a+b-1) --*/ + + if( ab1 > 0.0 ) + pgamf = exp(alng(ab1)-alng(a)-alng(b)+(a-1.0)*log(y)+b*log(1.0-y)) ; + else + pgamf = exp(alng(a+b)-alng(a)-alng(b)+(a-1.0)*log(y)+b*log(1.0-y))/ab1 ; + + pgamb = pgamf*y*(ab1)/a ; + + /*-- we can't have c+b-1 < 0, so the above patchup isn't needed --*/ + + qgamf = exp(alng(c+b-1.0)-alng(c)-alng(b)+(c-1.0)*log(y) + b*log(1.0-y)) ; + qgamb = qgamf*y*(c+b-1.0)/c ; + + rempois = 1.0 - pkf ; + delosq2 = del/1.4142135623731 ; + sum = pkf*pbetaf+delosq2*qkf*qbetaf ; + cons = 0.5*(1.0 + 0.5*fabs(delta)) ; + i = 0 ; +L1: + i = i + 1 ; + pgamf = pgamf*y*(a+b+i-2.0)/(a+i-1.0) ; + pbetaf = pbetaf - pgamf ; + pkf = pkf*dels/(k+i) ; + ptermf = pkf*pbetaf ; + qgamf = qgamf*y*(c+b+i-2.0)/(c+i-1.0) ; + qbetaf = qbetaf - qgamf ; + qkf = qkf*dels/(k+i-1.0+1.5) ; + qtermf = qkf*qbetaf ; + term = ptermf + delosq2*qtermf ; + sum = sum + term ; + error = rempois*cons*pbetaf ; + rempois = rempois - pkf ; + + if( i > k ){ + if( error <= 1.e-12 || i >= 9999 ) goto L2 ; + goto L1 ; + } else { + pgamb = pgamb*(a-i+1.0)/(y*(a+b-i)) ; + pbetab = pbetab + pgamb ; + pkb = (k-i+1.0)*pkb/dels ; + ptermb = pkb*pbetab ; + qgamb = qgamb*(c-i+1.0)/(y*(c+b-i)) ; + qbetab = qbetab + qgamb ; + qkb = (k-i+1.0+0.5)*qkb/dels ; + qtermb = qkb*qbetab ; + term = ptermb + delosq2*qtermb ; + sum = sum + term ; + rempois = rempois - pkb ; + if (rempois <= 1.e-12 || i >= 9999) goto L2 ; + goto L1 ; + } +L2: + tnd = 0.5*sum + ans ; + + /*-- return a pqpair, not just the cdf --*/ + + if( indx ){ pq.p = 1.0-tnd; pq.q = tnd ; } + else { pq.p = tnd ; pq.q = 1.0-tnd; } + return pq ; +} + +/*------------------------------*/ +/* Inverse to above function; + uses cdflib dstinv()/dinvr() + to solve the equation. +--------------------------------*/ + +static double tnonc_pq2s( pqpair pq , double dof , double nonc ) +{ + double t ; /* will be result */ + double tbot,ttop , dt ; + double T6=1.e-50,T7=1.e-8 ; + double K4=0.5,K5=5.0 ; + double fx ; + unsigned long qhi,qleft ; + int status , qporq , ite ; + pqpair tpq ; + + if( dof <= 0.0 ) return BIGG ; /* bad user */ + if( pq.p <= 0.0 ) return -BIGG ; + if( pq.q <= 0.0 ) return BIGG ; + + t = student_pq2s(pq,dof) ; /* initial guess */ + + if( fabs(nonc) < 1.e-8 ) return t ; + + t += 0.5*nonc ; /* adjust up or down */ + + dt = 0.1 * fabs(t) ; if( dt < 1.0 ) dt = 1.0 ; /* stepsize */ + + /* scan down for lower bound, below which cdf is < p */ + + tbot = t ; + for( ite=0 ; ite < 1000 ; ite++ ){ + tpq = tnonc_s2pq( tbot , dof , nonc ) ; + if( tpq.p <= pq.p ) break ; + tbot -= dt ; + } + if( ite >= 1000 ) return -BIGG ; + + /* scan up for upper bound, above which cdf is > p */ + + ttop = tbot+0.5*dt ; + for( ite=0 ; ite < 1000 ; ite++ ){ + tpq = tnonc_s2pq( ttop , dof , nonc ) ; + if( tpq.p >= pq.p ) break ; + ttop += dt ; + } + if( ite >= 1000 ) return BIGG ; + + t = 0.5*(tbot+ttop) ; /* initial guess in middle */ + + /* initialize searching parameters */ + + dstinv(&tbot,&ttop,&K4,&K4,&K5,&T6,&T7); + + status = 0 ; qporq = (pq.p <= pq.q) ; + + while(1){ + + dinvr(&status,&t,&fx,&qleft,&qhi) ; + + if( status != 1 ) return t ; /* done! */ + + tpq = tnonc_s2pq( t , dof , nonc ) ; /* get cdf */ + + /* goal of dinvr is to drive fx to zero */ + + fx = (qporq) ? pq.p-tpq.p : pq.q-tpq.q ; + } + + return BIGG ; /* unreachable */ +} + +/*---------------------------------------------------------------- + Chi distribution (sqrt of chi-squared, duh). +------------------------------------------------------------------*/ + +static pqpair chi_s2pq( double xx , double dof ) +{ + pqpair pq={0.0,1.0} ; + + if( xx <= 0.0 || dof <= 0.0 ) return pq ; + return chisq_s2pq( xx*xx , dof ) ; +} + +/*------------------------------*/ + +static double chi_pq2s( pqpair pq , double dof ) +{ + if( pq.p <= 0.0 ) return 0.0 ; + if( pq.q <= 0.0 ) return BIGG ; + return sqrt(chisq_pq2s(pq,dof)) ; +} + +/*---------------------------------------------------------------- + Extreme value type I: cdf(x) = exp(-exp(-x)). +------------------------------------------------------------------*/ + +static pqpair extval1_s2pq( double x ) +{ + double p,q,y ; pqpair pq ; + + if( x > -5.0 ){ y = exp(-x) ; p = exp(-y) ; } + else { y = 1.0 ; p = 0.0 ; } + + if( y >= 1.e-4 ) q = 1.0-p ; + else q = y*(1.0+y*(-0.5+y*(1.0/6.0-y/24.0))) ; + pq.p = p ; pq.q = q ; return pq ; +} + +/*------------------------------*/ + +static double extval1_pq2s( pqpair pq ) +{ + if( pq.p <= 0.0 ) return -BIGG ; + else if( pq.p >= 1.0 ) return BIGG ; + return -log(-log(pq.p)) ; +} + +/*---------------------------------------------------------------- + Weibull distribution: cdf(x) = 1 - exp( -x^c ) for x>0 and c>0. +------------------------------------------------------------------*/ + +static pqpair weibull_s2pq( double x , double c ) +{ + double y ; + pqpair pq={0.0,1.0} ; + + if( x <= 0.0 || c <= 0.0 ) return pq ; + + y = pow(x,c) ; pq.q = exp(-y) ; + if( y >= 1.e-4 ) pq.p = 1.0-pq.q ; + else pq.p = y*(1.0+y*(-0.5+y*(1.0/6.0-y/24.0))) ; + return pq ; +} + +/*------------------------------*/ + +static double weibull_pq2s( pqpair pq , double c ) +{ + if( pq.p <= 0.0 || c <= 0.0 ) return 0.0 ; + else if( pq.q <= 0.0 ) return BIGG ; + return pow( -log(pq.q) , 1.0/c ) ; +} + +/*---------------------------------------------------------------- + Inverse Gaussian: + density proportional to exp(-0.5*c(x+1/x))/x^1.5 (x,c >0). +------------------------------------------------------------------*/ + +static pqpair invgauss_s2pq( double x, double c ) +{ + double y , p1,q1 , p2,q2 , v ; + pqpair pq={0.0,1.0} ; + + if( x <= 0.0 || c <= 0.0 ) return pq ; + + y = sqrt(c/x) ; + v = y*(x-1.0) ; cumnor( &v , &p1,&q1 ) ; + v = -y*(x+1.0) ; cumnor( &v , &p2,&q2 ) ; + pq.p = p1 ; + if( p2 > 0.0 ) pq.p += exp(2.0*c+log(p2)) ; + pq.q = 1.0-pq.p ; return pq ; +} + +/*------------------------------*/ +/* Inverse to above function; + uses cdflib dstinv()/dinvr() + to solve the equation. +--------------------------------*/ + +static double invgauss_pq2s( pqpair pq , double c ) +{ + double t ; /* will be result */ + double tbot,ttop , dt ; + double T6=1.e-50,T7=1.e-8 ; + double K4=0.5,K5=5.0 ; + double fx ; + unsigned long qhi,qleft ; + int status , qporq , ite ; + pqpair tpq ; + + if( c <= 0.0 ) return BIGG ; /* bad user */ + if( pq.p <= 0.0 ) return 0.0 ; + if( pq.q <= 0.0 ) return BIGG ; + + /* initial guess is t=1; scan down for lower bound */ + + tbot = 1.01 ; dt = 0.9 ; + for( ite=0 ; ite < 1000 ; ite++ ){ + tpq = invgauss_s2pq( tbot , c ) ; + if( tpq.p <= pq.p ) break ; + tbot *= dt ; + } + if( ite >= 1000 ) return 0.0 ; + + /* scan up for upper bound */ + + dt = 1.1 ; ttop = tbot*dt ; + for( ite=0 ; ite < 1000 ; ite++ ){ + tpq = invgauss_s2pq( ttop , c ) ; + if( tpq.p >= pq.p ) break ; + ttop *= dt ; + } + if( ite >= 1000 ) return BIGG ; + + t = sqrt(tbot*ttop) ; /* start at geometric mean */ + + /* initialize searching parameters */ + + dstinv(&tbot,&ttop,&K4,&K4,&K5,&T6,&T7); + + status = 0 ; qporq = (pq.p <= pq.q) ; + + while(1){ + + dinvr(&status,&t,&fx,&qleft,&qhi) ; + + if( status != 1 ) return t ; /* done! */ + + tpq = invgauss_s2pq( t , c ) ; + + /* goal is to drive fx to zero */ + + fx = (qporq) ? pq.p-tpq.p : pq.q-tpq.q ; + } + + return BIGG ; /* unreachable */ +} + +/*--------------------------------------------------------------------------*/ +/*! Given a value, calculate both its cdf and reversed cdf (1.0-cdf). + If an error occurs, you'll probably get back {0.0,1.0}. + All the actual work is done in utility functions for each distribution. +----------------------------------------------------------------------------*/ + +static pqpair stat2pq( double val, int code, double p1,double p2,double p3 ) +{ + pqpair pq={0.0,1.0} ; + + switch( code ){ + + case NIFTI_INTENT_CORREL: pq = correl_s2pq ( val, p1 ) ; break; + case NIFTI_INTENT_TTEST: pq = student_s2pq ( val, p1 ) ; break; + case NIFTI_INTENT_FTEST: pq = fstat_s2pq ( val, p1,p2 ) ; break; + case NIFTI_INTENT_ZSCORE: pq = normal_s2pq ( val ) ; break; + case NIFTI_INTENT_CHISQ: pq = chisq_s2pq ( val, p1 ) ; break; + case NIFTI_INTENT_BETA: pq = beta_s2pq ( val, p1,p2 ) ; break; + case NIFTI_INTENT_BINOM: pq = binomial_s2pq( val, p1,p2 ) ; break; + case NIFTI_INTENT_GAMMA: pq = gamma_s2pq ( val, p1,p2 ) ; break; + case NIFTI_INTENT_POISSON: pq = poisson_s2pq ( val, p1 ) ; break; + case NIFTI_INTENT_FTEST_NONC: pq = fnonc_s2pq ( val, p1,p2,p3 ); break; + case NIFTI_INTENT_CHISQ_NONC: pq = chsqnonc_s2pq( val, p1,p2 ); break; + case NIFTI_INTENT_TTEST_NONC: pq = tnonc_s2pq ( val, p1,p2 ) ; break; + case NIFTI_INTENT_CHI: pq = chi_s2pq ( val, p1 ) ; break; + + /* these distributions are shifted and scaled copies of a standard case */ + + case NIFTI_INTENT_INVGAUSS: + if( p1 > 0.0 && p2 > 0.0 ) pq = invgauss_s2pq( val/p1,p2/p1 ) ; break; + + case NIFTI_INTENT_WEIBULL: + if( p2 > 0.0 && p3 > 0.0 ) pq = weibull_s2pq ((val-p1)/p2,p3) ; break; + + case NIFTI_INTENT_EXTVAL: + if( p2 > 0.0 ) pq = extval1_s2pq ( (val-p1)/p2 ) ; break; + + case NIFTI_INTENT_NORMAL: + if( p2 > 0.0 ) pq = normal_s2pq ( (val-p1)/p2 ) ; break; + + case NIFTI_INTENT_LOGISTIC: + if( p2 > 0.0 ) pq = logistic_s2pq( (val-p1)/p2 ) ; break; + + case NIFTI_INTENT_LAPLACE: + if( p2 > 0.0 ) pq = laplace_s2pq ( (val-p1)/p2 ) ; break; + + case NIFTI_INTENT_UNIFORM: + if( p2 > p1 ) pq = uniform_s2pq((val-p1)/(p2-p1)); break; + + /* this case is trivial */ + + case NIFTI_INTENT_PVAL: pq.p = 1.0-val ; pq.q = val ; break; + } + + return pq ; +} + +/*--------------------------------------------------------------------------*/ +/*! Given a pq value (cdf and 1-cdf), compute the value that gives this. + If an error occurs, you'll probably get back a BIGG number. + All the actual work is done in utility functions for each distribution. +----------------------------------------------------------------------------*/ + +static double pq2stat( pqpair pq, int code, double p1,double p2,double p3 ) +{ + double val=BIGG ; + + if( pq.p < 0.0 || pq.q < 0.0 || pq.p > 1.0 || pq.q > 1.0 ) return val ; + + switch( code ){ + + case NIFTI_INTENT_CORREL: val = correl_pq2s ( pq , p1 ) ; break; + case NIFTI_INTENT_TTEST: val = student_pq2s ( pq , p1 ) ; break; + case NIFTI_INTENT_FTEST: val = fstat_pq2s ( pq , p1,p2 ) ; break; + case NIFTI_INTENT_ZSCORE: val = normal_pq2s ( pq ) ; break; + case NIFTI_INTENT_CHISQ: val = chisq_pq2s ( pq , p1 ) ; break; + case NIFTI_INTENT_BETA: val = beta_pq2s ( pq , p1,p2 ) ; break; + case NIFTI_INTENT_BINOM: val = binomial_pq2s( pq , p1,p2 ) ; break; + case NIFTI_INTENT_GAMMA: val = gamma_pq2s ( pq , p1,p2 ) ; break; + case NIFTI_INTENT_POISSON: val = poisson_pq2s ( pq , p1 ) ; break; + case NIFTI_INTENT_FTEST_NONC: val = fnonc_pq2s ( pq , p1,p2,p3 ); break; + case NIFTI_INTENT_CHISQ_NONC: val = chsqnonc_pq2s( pq , p1,p2 ); break; + case NIFTI_INTENT_TTEST_NONC: val = tnonc_pq2s ( pq , p1,p2 ) ; break; + case NIFTI_INTENT_CHI: val = chi_pq2s ( pq , p1 ) ; break; + + /* these distributions are shifted and scaled copies of a standard case */ + + case NIFTI_INTENT_INVGAUSS: + if( p1 > 0.0 && p2 > 0.0 ) val = p1*invgauss_pq2s ( pq,p2/p1); break; + + case NIFTI_INTENT_WEIBULL: + if( p2 > 0.0 && p3 > 0.0 ) val = p1+p2*weibull_pq2s ( pq, p3 ) ; break; + + case NIFTI_INTENT_EXTVAL: + if( p2 > 0.0 ) val = p1+p2*extval1_pq2s ( pq ) ; break; + + case NIFTI_INTENT_NORMAL: + if( p2 > 0.0 ) val = p1+p2*normal_pq2s ( pq ) ; break; + + case NIFTI_INTENT_LOGISTIC: + if( p2 > 0.0 ) val = p1+p2*logistic_pq2s( pq ) ; break; + + case NIFTI_INTENT_LAPLACE: + if( p2 > 0.0 ) val = p1+p2*laplace_pq2s ( pq ) ; break; + + case NIFTI_INTENT_UNIFORM: + if( p2 > p1 ) val = p1+(p2-p1)*uniform_pq2s(pq) ; break; + + /* this case is trivial */ + + case NIFTI_INTENT_PVAL: val = pq.q ; break; + } + + return val ; +} + +/****************************************************************************/ +/*[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]*/ +/*..........................................................................*/ +/*............. AT LAST! Functions to be called by the user! ..............*/ +/*..........................................................................*/ +/*[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]*/ +/****************************************************************************/ + +/**************************************************************************** + Statistical codes implemented here: + + NIFTI_INTENT_CORREL = correlation statistic + NIFTI_INTENT_TTEST = t statistic (central) + NIFTI_INTENT_FTEST = F statistic (central) + NIFTI_INTENT_ZSCORE = N(0,1) statistic + NIFTI_INTENT_CHISQ = Chi-squared (central) + NIFTI_INTENT_BETA = Beta variable (central) + NIFTI_INTENT_BINOM = Binomial variable + NIFTI_INTENT_GAMMA = Gamma distribution + NIFTI_INTENT_POISSON = Poisson distribution + NIFTI_INTENT_FTEST_NONC = noncentral F statistic + NIFTI_INTENT_CHISQ_NONC = noncentral chi-squared + NIFTI_INTENT_TTEST_NONC = noncentral t statistic + NIFTI_INTENT_CHI = Chi statistic (central) + NIFTI_INTENT_INVGAUSS = inverse Gaussian variable + NIFTI_INTENT_WEIBULL = Weibull distribution + NIFTI_INTENT_EXTVAL = Extreme value type I + NIFTI_INTENT_NORMAL = N(mu,variance) normal + NIFTI_INTENT_LOGISTIC = Logistic distribution + NIFTI_INTENT_LAPLACE = Laplace distribution + NIFTI_INTENT_UNIFORM = Uniform distribution + NIFTI_INTENT_PVAL = "p-value" +*****************************************************************************/ + +static char *inam[]={ NULL , NULL , + "CORREL" , "TTEST" , "FTEST" , "ZSCORE" , + "CHISQ" , "BETA" , "BINOM" , "GAMMA" , + "POISSON" , "NORMAL" , "FTEST_NONC" , "CHISQ_NONC" , + "LOGISTIC" , "LAPLACE" , "UNIFORM" , "TTEST_NONC" , + "WEIBULL" , "CHI" , "INVGAUSS" , "EXTVAL" , + "PVAL" , + NULL } ; + +#include +#include + +/*--------------------------------------------------------------------------*/ +/*! Given a string name for a statistic, return its integer code. + Returns -1 if not found. +----------------------------------------------------------------------------*/ + +int nifti_intent_code( char *name ) +{ + char *unam , *upt ; + int ii ; + + if( name == NULL || *name == '\0' ) return -1 ; + + unam = strdup(name) ; + for( upt=unam ; *upt != '\0' ; upt++ ) *upt = (char)toupper(*upt) ; + + for( ii=NIFTI_FIRST_STATCODE ; ii <= NIFTI_LAST_STATCODE ; ii++ ) + if( strcmp(inam[ii],unam) == 0 ) break ; + + free(unam) ; + return (ii <= NIFTI_LAST_STATCODE) ? ii : -1 ; +} + +/*--------------------------------------------------------------------------*/ +/*! Given a value, return its cumulative distribution function (cdf): + - val = statistic + - code = NIFTI_INTENT_* statistical code + - p1,p2,p3 = parameters of the distribution + + If an error occurs, you'll probably get back 0.0. +----------------------------------------------------------------------------*/ + +double nifti_stat2cdf( double val, int code, double p1,double p2,double p3 ) +{ + pqpair pq ; + pq = stat2pq( val, code, p1,p2,p3 ) ; + return pq.p ; +} + +/*--------------------------------------------------------------------------*/ +/*! Given a value, return its reversed cumulative distribution function + (1-cdf): + - val = statistic + - code = NIFTI_INTENT_* statistical code + - p1,p2,p3 = parameters of the distribution + + If an error transpires, you'll probably get back 1.0. +----------------------------------------------------------------------------*/ + +double nifti_stat2rcdf( double val, int code, double p1,double p2,double p3 ) +{ + pqpair pq ; + pq = stat2pq( val, code, p1,p2,p3 ) ; + return pq.q ; +} + +/*--------------------------------------------------------------------------*/ +/*! Given a cdf probability, find the value that gave rise to it. + - p = cdf; 0 < p < 1 + - code = NIFTI_INTENT_* statistical code + - p1,p2,p3 = parameters of the distribution + + If an error transpires, you'll probably get back a BIGG number. +----------------------------------------------------------------------------*/ + +double nifti_cdf2stat( double p , int code, double p1,double p2,double p3 ) +{ + pqpair pq ; + pq.p = p ; pq.q = 1.0-p ; + return pq2stat(pq,code,p1,p2,p3) ; +} + +/*--------------------------------------------------------------------------*/ +/*! Given a reversed cdf probability, find the value that gave rise to it. + - q = 1-cdf; 0 < q < 1 + - code = NIFTI_INTENT_* statistical code + - p1,p2,p3 = parameters of the distribution + + If an error transpires, you'll probably get back a BIGG number. +----------------------------------------------------------------------------*/ + +double nifti_rcdf2stat( double q , int code, double p1,double p2,double p3 ) +{ + pqpair pq ; + pq.p = 1.0-q ; pq.q = q ; + return pq2stat(pq,code,p1,p2,p3) ; +} + +/*--------------------------------------------------------------------------*/ +/*! Given a statistic, compute a z-score from it. That is, the output + is z such that cdf(z) of a N(0,1) variable is the same as the cdf + of the given distribution at val. +----------------------------------------------------------------------------*/ + +double nifti_stat2zscore( double val , int code, double p1,double p2,double p3 ) +{ + pqpair pq ; + + if( code == NIFTI_INTENT_ZSCORE ) return val ; /* trivial */ + if( code == NIFTI_INTENT_NORMAL ) return (val-p1)/p2 ; /* almost so */ + + pq = stat2pq( val, code, p1,p2,p3 ) ; /* find cdf */ + return normal_pq2s( pq ) ; /* find z */ +} + +/*--------------------------------------------------------------------------*/ +/*! Given a statistic, compute a half-z-score from it. That is, the output + is z such that cdf(z) of a half-N(0,1) variable is the same as the cdf + of the given distribution at val. A half-N(0,1) variable has density + zero for z < 0 and twice the usual N(0,1) density for z > 0. +----------------------------------------------------------------------------*/ + +double nifti_stat2hzscore( double val, int code, double p1,double p2,double p3 ) +{ + pqpair pq ; + + pq = stat2pq( val, code, p1,p2,p3 ) ; /* find cdf */ + pq.q = 0.5*(1.0-pq.p) ; pq.p = 0.5*(1.0+pq.p) ; /* mangle it */ + return normal_pq2s( pq ) ; /* find z */ +} + +/****************************************************************************/ +/*[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]*/ +/****************************************************************************/ + +/*--------------------------------------------------------------------------*/ +/* Sample program to test the above functions. Otherwise unimportant. +----------------------------------------------------------------------------*/ + +int main( int argc , char *argv[] ) +{ + double val , p , q , p1=0.0,p2=0.0,p3=0.0 ; + double vbot,vtop,vdel ; + int code , iarg=1 , doq=0 , dod=0 , doi=0 , doz=0 , doh=0 ; + + /*-- print some help for the pitiful user --*/ + + if( argc < 3 || strstr(argv[1],"help") != NULL ){ + int ii ; + printf("\n") ; + printf("Demo program for computing NIfTI statistical functions.\n") ; + printf("Usage: nifti_stats [-q|-d|-1|-z] val CODE [p1 p2 p3]\n") ; + printf(" val can be a single number or in the form bot:top:step.\n") ; + printf(" default ==> output p = Prob(statistic < val).\n") ; + printf(" -q ==> output is 1-p.\n") ; + printf(" -d ==> output is density.\n") ; + printf(" -1 ==> output is x such that Prob(statistic < x) = val.\n") ; + printf(" -z ==> output is z such that Normal cdf(z) = p(val).\n") ; + printf(" -h ==> output is z such that 1/2-Normal cdf(z) = p(val).\n"); + printf(" Allowable CODEs:\n") ; + for( ii=NIFTI_FIRST_STATCODE ; ii <= NIFTI_LAST_STATCODE ; ii++ ){ + printf(" %-10s",inam[ii]); if((ii-NIFTI_FIRST_STATCODE)%6==5)printf("\n"); + } + printf("\n") ; + printf(" Following CODE are distributional parameters, as needed.\n"); + printf("\n") ; + printf("Results are written to stdout, 1 number per output line.\n") ; + printf("Example (piping output into AFNI program 1dplot):\n") ; + printf(" nifti_stats -d 0:4:.001 INVGAUSS 1 3 | 1dplot -dx 0.001 -stdin\n"); + printf("\n") ; + printf("Author - RW Cox - SSCC/NIMH/NIH/DHHS/USA/EARTH - March 2004\n") ; + printf("\n") ; + exit(0) ; + } + + /*-- check first arg to see if it is an output option; + if so, set the appropriate output flag to determine what to compute --*/ + + if( strcmp(argv[iarg],"-q") == 0 ){ doq = 1 ; iarg++ ; } + else if( strcmp(argv[iarg],"-d") == 0 ){ dod = 1 ; iarg++ ; } + else if( strcmp(argv[iarg],"-1") == 0 ){ doi = 1 ; iarg++ ; } + else if( strcmp(argv[iarg],"-z") == 0 ){ doz = 1 ; iarg++ ; } + else if( strcmp(argv[iarg],"-h") == 0 ){ doh = 1 ; iarg++ ; } + + /*-- get the value(s) to process --*/ + + vbot=vtop=vdel = 0.0 ; + sscanf( argv[iarg++] , "%lf:%lf:%lf" , &vbot,&vtop,&vdel ) ; + if( vbot >= vtop ) vdel = 0.0 ; + if( vdel <= 0.0 ) vtop = vbot ; + + /*-- decode the CODE into the integer signifying the distribution --*/ + + code = nifti_intent_code(argv[iarg++]) ; + if( code < 0 ){ fprintf(stderr,"illegal code=%s\n",argv[iarg-1]); exit(1); } + + /*-- get the parameters, if present (defaults are 0) --*/ + + if( argc > iarg ) p1 = strtod(argv[iarg++],NULL) ; + if( argc > iarg ) p2 = strtod(argv[iarg++],NULL) ; + if( argc > iarg ) p3 = strtod(argv[iarg++],NULL) ; + + /*-- loop over input value(s), compute output, write to stdout --*/ + + for( val=vbot ; val <= vtop ; val += vdel ){ + if( doq ) /* output = 1-cdf */ + p = nifti_stat2rcdf( val , code,p1,p2,p3 ) ; + else if( dod ) /* output = density */ + p = 1000.0*( nifti_stat2cdf(val+.001,code,p1,p2,p3) + -nifti_stat2cdf(val ,code,p1,p2,p3)) ; + else if( doi ) /* output = inverse */ + p = nifti_cdf2stat( val , code,p1,p2,p3 ) ; + else if( doz ) /* output = z score */ + p = nifti_stat2zscore( val , code,p1,p2,p3 ) ; + else if( doh ) /* output = halfz score */ + p = nifti_stat2hzscore( val , code,p1,p2,p3 ) ; + else /* output = cdf */ + p = nifti_stat2cdf( val , code,p1,p2,p3 ) ; + + printf("%.9g\n",p) ; + if( vdel <= 0.0 ) break ; /* the case of just 1 value */ + } + + /*-- terminus est --*/ + + exit(0) ; +} + diff --git a/Toolboxes/spm12/@nifti/private/nifti_stats.m b/Toolboxes/spm12/@nifti/private/nifti_stats.m new file mode 100644 index 0000000000000000000000000000000000000000..47d5437729b621b7d41fac6dc18ce83a9aa3af66 --- /dev/null +++ b/Toolboxes/spm12/@nifti/private/nifti_stats.m @@ -0,0 +1,41 @@ +function varargout = nifti_stats(varargin) +% Conversion among various statistics +% FORMAT P = nifti_stats(VAL,CODE,OPT,PARAM) +% CODE can be one of +% 'CORREL' 'TTEST' 'FTEST' 'ZSCORE' +% 'CHISQ' 'BETA' 'BINOM' 'GAMMA' +% 'POISSON' 'NORMAL' 'FTEST_NONC' 'CHISQ_NONC' +% 'LOGISTIC' 'LAPLACE' 'UNIFORM' 'TTEST_NONC' +% 'WEIBULL' 'CHI' 'INVGAUSS' 'EXTVAL' +% 'PVAL' +% With only one input argument, CODE defaults to 'ZSCORE' +% +% OPT can be one of +% '-p' ==> output P = Prob(statistic < VAL). +% '-q' ==> output is 1-p. +% '-d' ==> output is probability density. +% '-1' ==> output is X such that Prob(statistic < x) = VAL. +% '-z' ==> output is Z such that Normal cdf(Z) = p(VAL). +% '-h' ==> output is Z such that 1/2-Normal cdf(Z) = p(VAL). +% With less than three input arguments, OPT defaults to '-p'. +% +% PARAM are up to three distribution parameters. +% These default to zero if unspecified. +% +% P is an array with the same dimensions as VAL. +% +%__________________________________________________________________________ +% 99.99% of the work by RW Cox - SSCC/NIMH/NIH/DHHS/USA/EARTH - March 2004 +% 0.01% of the work (the mex wrapper) by John Ashburner - FIL/ION/UCL +% Copyright (C) 2005-2017 Wellcome Trust Centre for Neuroimaging + +% +% $Id: nifti_stats.m 7147 2017-08-03 14:07:01Z spm $ + + +fprintf('******************************************\n'); +fprintf('Compile the nifti_stats function with\n'); +fprintf(' mex nifti_stats.c nifti_stats_mex.c -O\n'); +fprintf('******************************************\n'); + +error('nifti_stats is not compiled.'); diff --git a/Toolboxes/spm12/@nifti/private/nifti_stats_mex.c b/Toolboxes/spm12/@nifti/private/nifti_stats_mex.c new file mode 100644 index 0000000000000000000000000000000000000000..412b4316cd49f7d6330dfa57b3237e8eca01a65f --- /dev/null +++ b/Toolboxes/spm12/@nifti/private/nifti_stats_mex.c @@ -0,0 +1,124 @@ +#ifndef lint +static char svnid[] = "$Id: nifti_stats_mex.c 7147 2017-08-03 14:07:01Z spm $"; +#endif +/* + * This is a MATLAB MEX interface for Bob Cox's extensive nifti_stats.c + * functionality. See nifti_stats.m for documentation. + */ + +#include +#include +#include +#include "mex.h" + +#include "nifti1.h" +extern int nifti_intent_code( char *name ); +extern double nifti_stat2cdf( double val, int code, double p1,double p2,double p3 ); +extern double nifti_stat2rcdf( double val, int code, double p1,double p2,double p3 ); +extern double nifti_stat2cdf( double val, int code, double p1,double p2,double p3 ); +extern double nifti_cdf2stat( double val, int code, double p1,double p2,double p3 ); +extern double nifti_stat2zscore( double val, int code, double p1,double p2,double p3 ); +extern double nifti_stat2hzscore( double val, int code, double p1,double p2,double p3 ); + +void mexFunction(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) +{ + double *val, *p, p1=0.0,p2=0.0,p3=0.0 ; + int code=5, dop=1, doq=0, dod=0, doi=0, doz=0, doh=0 ; + int ndim, i, n; + const int *dim; + + if (nlhs>1) mexErrMsgTxt("Too many output arguments."); + if (nrhs<1) mexErrMsgTxt("Not enough input arguments."); + if (nrhs>4) mexErrMsgTxt("Too many input arguments."); + + /* VAL */ + if (!mxIsNumeric(prhs[0]) || !mxIsDouble(prhs[0]) || mxIsComplex(prhs[0])) + mexErrMsgTxt("Wrong datatype for 1st argument."); + ndim = mxGetNumberOfDimensions(prhs[0]); + dim = mxGetDimensions(prhs[0]); + n = 1; + for(i=0,n=1; i=2) + { + if (mxIsChar(prhs[1])) + { + int buflen; + char *buf; + buflen = mxGetN(prhs[1])*mxGetM(prhs[1])+1; + buf = (char *)mxCalloc(buflen,sizeof(char)); + mxGetString(prhs[1],buf,buflen); + code = nifti_intent_code(buf);